IDENTIFICATION DIVISION. PROGRAM-ID. MODELRSP. AUTHOR. SYBASE ICD. DATE-WRITTEN. SEPTEMBER 15, 1993. ***************************************************************** * MODELRSP - SAMPLE TO ILLUSTRATE SQLDA USAGE. * * * * THIS SAMPLE STORED PROCEDURE HAS A LOT OF INTERNAL * * DOCUMENTATION TO HELP EXPLAIN AND ILLUSTRATE THE PROPER * * USAGE OF THE SQLDA FOR A DB2 OUTPUT PIPE. A ROW IS SET UP * * FOR ALL DATATYPES AND ALL WILL BE SET TO ALLOW NULLS. * * * ***************************************************************** ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION.
01 FILLER PIC X(27) VALUE
'WORKING-STORAGE STARTS HERE'.
01 COMMAREA-POINTER USAGE IS POINTER.
01 SQLDA-POINTER USAGE IS POINTER.
01 EMPLOYEE-DATA-POINTER USAGE IS POINTER.
01 INDICATOR-VAR-POINTER USAGE IS POINTER.
01 SQLDA-SIZE PIC S9(8) COMP.
01 WS-LITERALS.
05 WS-STATUS PIC X(06) VALUE 'STATUS'.
05 WS-MESSAGE PIC X(07) VALUE 'MESSAGE'.
05 WS-COMMIT PIC X(06) VALUE 'COMMIT'.
05 WS-ROLLBACK PIC X(08) VALUE 'ROLLBACK'.
05 WS-OPENPIPE PIC X(08) VALUE 'OPENPIPE'.
05 WS-PUTPIPE PIC X(07) VALUE 'PUTPIPE'.
05 WS-GETPIPE PIC X(07) VALUE 'GETPIPE'.
05 WS-CLOSPIPE PIC X(08) VALUE 'CLOSPIPE'.
01 MESSAGES.
05 ERROR1-MSG.
07 ERROR1-TEXT1 PIC X(19) VALUE
'ERROR WITH CALL TO '.
07 ERROR1-CALL PIC X(10) VALUE SPACES.
07 ERROR1-TEXT2 PIC X(14) VALUE
' - SPRC CODE: '.
07 ERROR1-SPRC PIC X(03) VALUE SPACES.
05 ERROR2-MSG.
07 ERROR2-TEXT2 PIC X(46) VALUE SPACES.
05 WS-LONG-VARCHAR-TEXT.
07 FILLER PIC X(50) VALUE
'THIS IS A LINE OF VERY LONG TEXT TO DEMONSTRATE TH'.
07 FILLER PIC X(50) VALUE
'AT A LONG VARCHAR DATATYPE CAN BE SENT DOWN A DB2 '.
07 FILLER PIC X(50) VALUE
'OUTPUT PIPE WITH NO PROBLEMS, WORRIES, OR CONSTERN'.
07 FILLER PIC X(50) VALUE
'ATION, AS LONG AS ONE REMEMBERS THAT LARGE AMOUNTS'.
07 FILLER PIC X(50) VALUE
' OF DATA WILL ALWAYS HAVE AN ELEMENT OF UNEXPECTED'.
07 FILLER PIC X(50) VALUE
'NESS. EVEN SO, USE SYBASE FOR ALL YOUR SOLUTIONS.'.
****************************************************************** * DESCRIPTION OF THE MODEL SQLDA * ****************************************************************** * * SQLTYPES USED IN SQLDA: * VALUE DATA TYPE NULLS ALLOWED * ======= =================== ============= * 384/385 DATE NO/YES * 388/389 TIME NO/YES * 392/393 TIMESTAMP NO/YES * 448/449 CHAR VARIABLE LENG NO/YES * 452/453 CHAR FIXED LENGTH NO/YES * 456/457 CHAR LONG VARIABLE NO/YES * 480/481 FLOATING-POINT NO/YES * 484/485 DECIMAL NO/YES * 496/497 LARGE INTEGER NO/YES * 500/501 SMALL INTEGER NO/YES ******************************************************** * NOTE: ALL DATATYPES IN THIS EXAMPLE ARE DEFINED AS NULLABLE ******************************************************** *------------------------------------------------------------* * MODEL-SQLDA IS USED TO HOLD THE COLUMN DESCRIPTIONS IN * * WORKING STORAGE. THIS IS DONE THIS WAY BECAUSE YOU CANNOT * * USE VALUE CLAUSES IN A COBOL LINKAGE SECTION.... * *------------------------------------------------------------* 01 MODEL-SQLDA.
* - EYE CATCHER - MUST ALWAYS SAY 'SQLDA '.
03 MS-SQLAID PIC X(08) VALUE 'SQLDA '.
* - SIZE OF SQLDA = 16 + (44 * SQLN VALUE)
03 MS-SQLDABC PIC S9(8) COMP VALUE 500.
* - NUMBER OF SQLVAR OCCURENCES
* - MUST MATCH VALUE OF MS-SQLD
03 MS-SQLN PIC S9(4) COMP VALUE 11.
* - NUMBER OF SQLVAR OCCURENCES ACTUALLY USED
* - MUST MATCH VALUE OF MS-SQLN
03 MS-SQLD PIC S9(4) COMP VALUE 11.
03 MS-COL01.
* - 1ST COLUMN DATATYPE = FIXED CHAR (LENGTH 1 - 256)
05 MS-COL01-SQLTYPE PIC S9(4) COMP VALUE 453.
05 MS-COL01-SQLLEN PIC S9(4) COMP VALUE 5.
* - SQLDATA WILL BE SET TO ADDRESS OF DATA FIELD
05 MS-COL01-SQLDATA USAGE IS POINTER.
* - SQLIND WILL BE SET TO ADDRESS OF A S9(4) COMP FIELD
* - WHEN COMP FIELD'S VALUE IS LESS THAN ZERO THEN
* - COLUMN IS NULL - ONLY USED WHEN COLUMN IS NULLABLE
05 MS-COL01-SQLIND USAGE IS POINTER VALUE NULL.
* - SQLNAMEL IS THE LENGTH OF THE COLUMN NAME
05 MS-COL01-SQLNAMEL PIC S9(4) COMP VALUE 10.
* - SQLNAME IS ALWAYS 30 IN LENGTH
05 MS-COL01-SQLNAME PIC X(30) VALUE 'FIXED_CHAR'.
03 MS-COL02.
* - 2ND COLUMN DATATYPE = DATE (LENGTH ALWAYS 10)
05 MS-COL02-SQLTYPE PIC S9(4) COMP VALUE 385.
05 MS-COL02-SQLLEN PIC S9(4) COMP VALUE 10.
05 MS-COL02-SQLDATA USAGE IS POINTER.
05 MS-COL02-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL02-SQLNAMEL PIC S9(4) COMP VALUE 4.
05 MS-COL02-SQLNAME PIC X(30) VALUE 'DATE'.
03 MS-COL03.
* - 3RD COLUMN DATATYPE = VARIABLE LENGTH CHAR (1-256)
05 MS-COL03-SQLTYPE PIC S9(4) COMP VALUE 449.
05 MS-COL03-SQLLEN PIC S9(4) COMP VALUE 30.
05 MS-COL03-SQLDATA USAGE IS POINTER
05 MS-COL03-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL03-SQLNAMEL PIC S9(4) COMP VALUE 7.
05 MS-COL03-SQLNAME PIC X(30) VALUE 'VARCHAR'.
03 MS-COL04.
* - 4TH COL - DATATYPE = SMALL INTEGER (LENGTH ALWAYS 2)
* - CORRESPONDING PIC S9(4) COMP - UP TO 5 DIGITS.
05 MS-COL04-SQLTYPE PIC S9(4) COMP VALUE 501.
05 MS-COL04-SQLLEN PIC S9(4) COMP VALUE 2.
05 MS-COL04-SQLDATA USAGE IS POINTER.
05 MS-COL04-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL04-SQLNAMEL PIC S9(4) COMP VALUE 9.
05 MS-COL04-SQLNAME PIC X(30) VALUE 'SMALL_INT'.
03 MS-COL05.
* - 5TH COL - DATATYPE = PACKED DECIMAL
05 MS-COL05-SQLTYPE PIC S9(4) COMP VALUE 485.
*--------------------------------------------------------------*
* - NOTE: FOR PACKED DECIMAL DATATYPES ONLY!!!!! *
* - LENGTH IS DECIMAL TRANSLATION OF HEX "PPSS" *
* (PRECISION AND SCALE) *
* - WHERE "PP" = NUMBER OF TOTAL DIGITS *
* - AND "SS" = NUMBER OF DIGITS TO RIGHT OF DECIMAL *
* - S9(3)V99 COMP-3 WOULD BE X'0502' OR IN DEC '1282' *
* - S9(11)V99 COMP-3 WOULD BE X'0D02' OR IN DEC '3330' *
* - SQLLEN = (PP * 256) + SS *
* - 1282=5*256+2==> FOR S9(3)V99 *
*--------------------------------------------------------------*
05 MS-COL05-SQLLEN PIC S9(4) COMP VALUE +1282.
05 MS-COL05-SQLDATA USAGE IS POINTER.
05 MS-COL05-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL05-SQLNAMEL PIC S9(4) COMP VALUE 10.
05 MS-COL05-SQLNAME PIC X(30) VALUE 'PACKED_DEC'.
03 MS-COL06.
* - 6TH COL - DATATYPE = TIME (LENGTH ALWAYS 8) 'HH.MM.SS'
05 MS-COL06-SQLTYPE PIC S9(4) COMP VALUE 389.
05 MS-COL06-SQLLEN PIC S9(4) COMP VALUE 8.
05 MS-COL06-SQLDATA USAGE IS POINTER.
05 MS-COL06-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL06-SQLNAMEL PIC S9(4) COMP VALUE 4.
05 MS-COL06-SQLNAME PIC X(30) VALUE 'TIME'.
03 MS-COL07.
* - 7TH COL - DATATYPE = TIMESTAMP (LENGTH 19 OR 26)
* - PIC X(19) VALUE 'YYYY-MM-DD:HH:MM:SS'
* - PIC X(26) VALUE 'YYYY-MM-DD:HH:MM:SS:NNNNNN'
05 MS-COL07-SQLTYPE PIC S9(4) COMP VALUE 393.
05 MS-COL07-SQLLEN PIC S9(4) COMP VALUE 26.
05 MS-COL07-SQLDATA USAGE IS POINTER.
05 MS-COL07-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL07-SQLNAMEL PIC S9(4) COMP VALUE 9.
05 MS-COL07-SQLNAME PIC X(30) VALUE 'TIMESTAMP'.
03 MS-COL08.
* - 8TH COL - DATATYPE = FLOAT (COMP-1 LENGTH ALWAYS 4)
* - SINGLE PRECISION FLOAT (COMP-1 LENGTH ALWAYS 4)
05 MS-COL08-SQLTYPE PIC S9(4) COMP VALUE 481.
05 MS-COL08-SQLLEN PIC S9(4) COMP VALUE 4.
05 MS-COL08-SQLDATA USAGE IS POINTER.
05 MS-COL08-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL08-SQLNAMEL PIC S9(4) COMP VALUE 10.
05 MS-COL08-SQLNAME PIC X(30) VALUE 'FLOATING_P'.
03 MS-COL09.
* - 9TH COL - DATATYPE = FLOAT (COMP-2 LENGTH ALWAYS 8)
* - DOUBLE PRECISION FLOAT (COMP-2 LENGTH ALWAYS 8)
05 MS-COL09-SQLTYPE PIC S9(4) COMP VALUE 481.
05 MS-COL09-SQLLEN PIC S9(4) COMP VALUE 8.
05 MS-COL09-SQLDATA USAGE IS POINTER.
05 MS-COL09-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL09-SQLNAMEL PIC S9(4) COMP VALUE 10.
05 MS-COL09-SQLNAME PIC X(30) VALUE 'DBL_FLOATP'.
03 MS-COL10.
* -10TH COL - DATATYPE = LARGE INTEGER (LENGTH ALWAYS 4)
* - CORRESPONDING PIC S9(8) COMP - UP TO 10 DIGITS.
05 MS-COL10-SQLTYPE PIC S9(4) COMP VALUE 497.
05 MS-COL10-SQLLEN PIC S9(4) COMP VALUE 4.
05 MS-COL10-SQLDATA USAGE IS POINTER.
05 MS-COL10-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL10-SQLNAMEL PIC S9(4) COMP VALUE 7.
05 MS-COL10-SQLNAME PIC X(30) VALUE 'INTEGER'.
03 MS-COL11.
* - 11TH COL DATATYPE = LONG VARIABLE LENGTH CHAR (1-32K)
05 MS-COL11-SQLTYPE PIC S9(4) COMP VALUE 457.
05 MS-COL11-SQLLEN PIC S9(4) COMP VALUE 300.
05 MS-COL11-SQLDATA USAGE IS POINTER.
05 MS-COL11-SQLIND USAGE IS POINTER VALUE NULL.
05 MS-COL11-SQLNAMEL PIC S9(4) COMP VALUE 8.
05 MS-COL11-SQLNAME PIC X(30) VALUE 'LVARCHAR'.
* THIS SWITCH IS USED FOR TESTING IF RPC CALL
77 RSPRPC-SWITCH PIC S9(4) COMP VALUE 0.
88 RPC-CALL VALUE 0.
LINKAGE SECTION.
**************************************************************
* THE LINKAGE SECTION DEFINES MASKS FOR DATA AREAS
* THAT ARE EITHER PASSED TO THE PROGRAM IN THE CASE OF THE
* COMMAREA OR CREATED BY THE PROGRAM IN THE CASE OF THE SQLDA
* AND DATA FIELDS.
*
* UNLIKE WORKING-STORAGE, STORAGE ASSOCIATED WITHIN THE LINKAGE
* SECTION IS AVAILABLE TO OTHER PROGRAMS BY PASSING ADDRESSES
* AND USING MASKS.
*
* IT IS IMPORTANT TO NOTE, THAT EVEN THOUGH THE DEFINES IN
* THE LINKAGE SECTION LOOK EXACTLY LIKE THOSE IN WORKING
* STORAGE, NO SPACE IS ASSOCIATED WITH THESE DEFINES IN LINKAGE
* UNTIL IT IS "GETMAINED".
**************************************************************
01 DFHCOMMAREA.
05 NOT-USED PIC X(1).
******************************************************************
* THIS IS THE ACTUAL SPAREA POINTER AND DEFINITION *
******************************************************************
01 LWKCOMMAREA.
COPY SPAREAC.
******************************************************************
* NULL INDICATOR VARIABLES - SET TO -1 IF NULL; 0 IF NOT NULL. *
* ONLY REQUIRED FOR COLUMNS DEFINED AS ALLOWING NULLS! *
******************************************************************
01 INDICATOR-VARIABLES.
10 FIXED-CHAR-IND PIC S9(4) COMP.
10 DATE-OUT-IND PIC S9(4) COMP.
10 VAR-CHAR-IND PIC S9(4) COMP.
10 SMALL-INT-IND PIC S9(4) COMP.
10 PACKED-DEC-IND PIC S9(4) COMP.
10 TIME-OUT-IND PIC S9(4) COMP.
10 TIMESTAMP-IND PIC S9(4) COMP.
10 FLOAT-SGL-IND PIC S9(4) COMP.
10 FLOAT-DBL-IND PIC S9(4) COMP.
10 LARGE-INT-IND PIC S9(4) COMP.
10 LARGE-VCHAR-IND PIC S9(4) COMP.
******************************************************************
* DESCRIPTION OF THE EMPLOYEE DATA *
******************************************************************
* NOTE THAT VARCHAR AND LONG-VARCHAR FIELDS ARE PRECEDED BY *
* A TWO-BYTE COMP LENGTH FIELD. SQLDA KNOWS NOT TO INCLUDE THE *
* EXTRA TWO BYTES IN THE LENGTH OF THE DATA. WANT TO SEE YOUR *
* REGION COME DOWN? TRY LEAVING THE LENGTH FIELD OUT... *
* THE FIRST TWO BYTES OF YOUR DATA WILL BE USED TO CALC THE *
* LENGTH OF YOUR DATA AND CICS WILL START TO EAT ITSELF... *
******************************************************************
01 EMPLOYEE-DATA.
10 FIXED-CHAR PIC X(05).
10 DATE-OUT PIC X(10).
10 VAR-CHAR.
15 VCHAR-LENGTH PIC S9(4) COMP.
15 VCHAR-DATA PIC X(30).
10 SMALL-INT PIC S9(4) USAGE COMP.
10 PACKED-DEC PIC S999V99 USAGE COMP-3.
10 TIME-OUT PIC X(08).
10 TIMESTAMP PIC X(26).
10 FLOAT-SGL COMP-1.
10 FLOAT-DBL COMP-2.
10 LARGE-INT PIC S9(8) USAGE COMP.
10 LARGE-VAR-CHAR.
15 L-VCHAR-LENGTH PIC S9(4) COMP.
15 L-VCHAR-DATA PIC X(300).
*----------------------------------------------------------------*
* SQLDA - THIS IS USED AS A PLACE HOLDER IN THE COMMUNICATION *
* AREA FOR THE COLUMN VALUES DESCRIBED IN THE MODEL- *
* SQLDA. THIS IS DONE BECAUSE SYBASE USES POINTERS TO *
* PASS DATA AND ADDRESS IN COBOL CAN ONLY BE SET IN THE *
* LINKAGE SECTION.......... *
*----------------------------------------------------------------*
01 SQLDA.
03 SQLDAID PIC X(8).
03 SQLDABC PIC S9(8) COMP.
03 SQLN PIC S9(4) COMP.
03 SQLD PIC S9(4) COMP.
03 SQLVARN OCCURS 11.
05 SQLTYPE PIC S9(4) COMP.
05 SQLLEN PIC S9(4) COMP.
05 SQLDATA USAGE IS POINTER.
05 SQLIND USAGE IS POINTER.
05 SQLNAMEL PIC S9(4) COMP.
05 SQLNAME PIC X(30).
*-------------------------------------------------------*
PROCEDURE DIVISION.
*-------------------------------------------------------*
EXEC CICS HANDLE CONDITION
INVREQ(9999-RETURN-TO-CALLER)
END-EXEC.
0000-MAIN-PROCESSING.
PERFORM 1000-INITIALIZATION THRU 1000-EXIT.
PERFORM 5000-PROCESS-DATA THRU 5000-EXIT.
PERFORM 9000-WRAP-UP THRU 9000-EXIT.
EXEC CICS
RETURN
END-EXEC.
GOBACK.
*-------------------------------------------------------*
1000-INITIALIZATION.
*-------------------------------------------------------*
PERFORM 1050-SPAREA-SETUP THRU 1050-EXIT.
PERFORM 1100-TEST-SQLDA THRU 1100-EXIT.
PERFORM 1200-GET-STORAGE THRU 1200-EXIT.
PERFORM 1300-SET-ADDRESSES THRU 1300-EXIT.
PERFORM 1400-OPEN-OUTPUT-PIPE THRU 1400-EXIT.
1000-EXIT.
EXIT.
*-------------------------------------------------------*
1050-SPAREA-SETUP.
*-------------------------------------------------------*
******************************************************
* IF THIS IS A RPC CALL, CALL RPSETUP TO INITIALIZE SPAREA
* AND OPEN SERVER (TRANSACTION ROUTER SERVICE)
* IF THIS IS A RSP CALL, SPAREA IS PASSED IN THE COMMAREA.
* (DIRECTCONNECT).
* FOR TRACING, MOVE 'Y' TO SPTRCOPT
******************************************************
MOVE EIBCALEN TO RSPRPC-SWITCH.
IF RPC-CALL
EXEC CICS GETMAIN
SET (COMMAREA-POINTER)
FLENGTH (LENGTH OF LWKCOMMAREA)
END-EXEC
SET ADDRESS OF LWKCOMMAREA TO COMMAREA-POINTER
CALL 'RPSETUP' USING SPAREA
ELSE
SET ADDRESS OF LWKCOMMAREA TO ADDRESS OF DFHCOMMAREA.
1050-EXIT.
EXIT.
1100-TEST-SQLDA.
*-------------------------------------------------------*
******************************************************
* CALCULATE THE CORRECT SQLDA SIZE INTO "SQLDA-SIZE"
MULTIPLY MS-SQLN BY 44 GIVING SQLDA-SIZE.
ADD +16 TO SQLDA-SIZE.
MOVE SQLDA-SIZE TO MS-SQLDABC.
******************************************************
* CHECK TO MAKE SURE THE CALCULATED SIZE EQUALS ACTUAL SIZE
* IF IT DOESN'T THEN A SQLDA FIELD IS MISSING OR ONE
* OF THE SQLDA FIELDS HAS THE WRONG PICTURE SIZE.
IF (LENGTH OF MODEL-SQLDA) NOT EQUAL SQLDA-SIZE
MOVE 'SQLDA/SQLN SIZE IN ERROR' TO ERROR2-TEXT2
PERFORM 9810-ERROR-MSG THRU 9810-EXIT
GO TO 9999-RETURN-TO-CALLER.
1100-EXIT.
EXIT.
1200-GET-STORAGE.
*-------------------------------------------------------*
******************************************************
* ALLOCATE A BLOCK OF STORAGE TO BE USED FOR THE SQLDA
* SET POINTER VARIABLE TO ADDRESS OF ALLOCATED STORAGE
* USE FLENGTH TO ALLOCATE STORAGE ABOVE THE 16M LINE
EXEC CICS GETMAIN
SET (SQLDA-POINTER)
FLENGTH (LENGTH OF SQLDA)
END-EXEC.
******************************************************
* ASSOCIATE THE LINKAGE SQLDA MASK TO THE ALLOCATED STORAGE
* BY SETTING THE MASK ADDRESS TO THE ADDRESS OF THE STORAGE
SET ADDRESS OF SQLDA TO SQLDA-POINTER.
******************************************************
* ALLOCATE A BLOCK OF STORAGE TO BE USED FOR THE DATA
* SET POINTER VARIABLE TO ADDRESS OF ALLOCATED STORAGE
EXEC CICS GETMAIN
SET(EMPLOYEE-DATA-POINTER)
FLENGTH(LENGTH OF EMPLOYEE-DATA)
END-EXEC.
SET ADDRESS OF EMPLOYEE-DATA TO EMPLOYEE-DATA-POINTER.
******************************************************
* ALLOCATE A BLOCK OF STORAGE TO BE USED FOR NULL INDICATORS
* ONLY REQUIRED FOR COLUMNS DEFINED AS ALLOWING NULLS
* SET POINTER VARIABLE TO ADDRESS OF ALLOCATED STORAGE
EXEC CICS GETMAIN
SET(INDICATOR-VAR-POINTER)
FLENGTH(LENGTH OF INDICATOR-VARIABLES)
END-EXEC.
SET ADDRESS OF INDICATOR-VARIABLES TO INDICATOR-VAR-POINTER.
1200-EXIT.
EXIT.
1300-SET-ADDRESSES.
*-------------------------------------------------------*
*********************************************************
* SET THE POINTER VARIABLES IN THE LINKAGE SECTION SQLDA TO
* THE ADDRESSES OF THE DATA LOCATIONS ALSO IN THE LINKAGE
* SECTION IE: THE DATA FIELDS IN EMPLOYEE-DATA
*
* THESE ADDRESSES MUST BE ADDRESSES ASSOCIATED WITH VARIABLES
* DEFINED IN THE LINKAGE SECTION BECAUSE THE OPEN SERVER API
* PROGRAM MUST BE ABLE TO ACCESS THIS STORAGE.
*
* THE MODEL-SQLDA IS MOVED TO THE SQLDA TO INITIALIZE
* THE COLUMN TYPES AND SIZES.........
*********************************************************
MOVE MODEL-SQLDA TO SQLDA.
SET SQLDATA(1) TO ADDRESS OF FIXED-CHAR.
SET SQLDATA(2) TO ADDRESS OF DATE-OUT.
SET SQLDATA(3) TO ADDRESS OF VAR-CHAR.
SET SQLDATA(4) TO ADDRESS OF SMALL-INT.
SET SQLDATA(5) TO ADDRESS OF PACKED-DEC.
SET SQLDATA(6) TO ADDRESS OF TIME-OUT.
SET SQLDATA(7) TO ADDRESS OF TIMESTAMP.
SET SQLDATA(8) TO ADDRESS OF FLOAT-SGL.
SET SQLDATA(9) TO ADDRESS OF FLOAT-DBL.
SET SQLDATA(10) TO ADDRESS OF LARGE-INT.
SET SQLDATA(11) TO ADDRESS OF LARGE-VAR-CHAR.
****************************************************
* SET SQLIND TO ADDRESS OF NULL INDICATOR FIELDS
* FOR ANY COLUMN DEFINED AS NULLABLE
****************************************************
SET SQLIND(1) TO ADDRESS OF FIXED-CHAR-IND.
SET SQLIND(2) TO ADDRESS OF DATE-OUT-IND.
SET SQLIND(3) TO ADDRESS OF VAR-CHAR-IND.
SET SQLIND(4) TO ADDRESS OF SMALL-INT-IND.
SET SQLIND(5) TO ADDRESS OF PACKED-DEC-IND.
SET SQLIND(6) TO ADDRESS OF TIME-OUT-IND.
SET SQLIND(7) TO ADDRESS OF TIMESTAMP-IND.
SET SQLIND(8) TO ADDRESS OF FLOAT-SGL-IND.
SET SQLIND(9) TO ADDRESS OF FLOAT-DBL-IND.
SET SQLIND(10) TO ADDRESS OF LARGE-INT-IND.
SET SQLIND(11) TO ADDRESS OF LARGE-VCHAR-IND.
1300-EXIT.
EXIT.
*-------------------------------------------------------*
1400-OPEN-OUTPUT-PIPE.
*-------------------------------------------------------*
*-------------------------------------------------------*
* AN OPEN PIPE WILL SET UP THE COLUMN INFORMATION, *
* WHICH WILL EVENTUALLY BE SENT TO THE CLIENT....... *
*-------------------------------------------------------*
MOVE 'OUTPUT' TO SPMODE.
MOVE 'DB2' TO SPFORMAT.
SET SPSQLDA TO ADDRESS OF SQLDA.
CALL 'OPENPIPE' USING SPAREA.
IF SPRC IS NOT EQUAL TO '000'
MOVE WS-OPENPIPE TO ERROR1-CALL
PERFORM 9800-PIPE-ERROR-MSG THRU 9800-EXIT
GO TO 9999-RETURN-TO-CALLER.
1400-EXIT.
EXIT.
*-------------------------------------------------------*
5000-PROCESS-DATA.
*-------------------------------------------------------*
PERFORM 5300-LOAD-A-ROW THRU 5300-EXIT.
PERFORM 5500-SEND-A-ROW THRU 5500-EXIT.
PERFORM 5400-LOAD-A-NULL-ROW THRU 5400-EXIT.
PERFORM 5500-SEND-A-ROW THRU 5500-EXIT.
5000-EXIT.
EXIT.
*-------------------------------------------------------*
5300-LOAD-A-ROW.
*-------------------------------------------------------*
*-------------------------------------------------------*
* COLUMN DATA IS HARDCODED FOR THIS EXAMPLE. *
*-------------------------------------------------------*
MOVE '00100' TO FIXED-CHAR.
MOVE '1993-09-16' TO DATE-OUT.
MOVE 30 TO VCHAR-LENGTH.
MOVE 'A ROSE BY ANY OTHER..' TO VCHAR-DATA.
MOVE 123 TO SMALL-INT.
MOVE 123.45 TO PACKED-DEC.
MOVE '11.35.25' TO TIME-OUT.
MOVE '1993-10-31:10:34:24' TO TIMESTAMP.
MOVE 1.00345 TO FLOAT-SGL.
MOVE 0.0023544 TO FLOAT-DBL.
MOVE 1234567 TO LARGE-INT.
MOVE 300 TO L-VCHAR-LENGTH.
MOVE WS-LONG-VARCHAR-TEXT TO L-VCHAR-DATA.
***************************************************
* MOVE ZERO TO NULL INDICATOR FIELDS TO INDICATE NOT NULL
MOVE 0 TO FIXED-CHAR-IND.
MOVE 0 TO DATE-OUT-IND.
MOVE 0 TO VAR-CHAR-IND.
MOVE 0 TO SMALL-INT-IND.
MOVE 0 TO PACKED-DEC-IND.
MOVE 0 TO TIME-OUT-IND.
MOVE 0 TO TIMESTAMP-IND.
MOVE 0 TO FLOAT-SGL-IND.
MOVE 0 TO FLOAT-DBL-IND.
MOVE 0 TO LARGE-INT-IND.
MOVE 0 TO LARGE-VCHAR-IND.
5300-EXIT.
EXIT.
*-------------------------------------------------------*
5400-LOAD-A-NULL-ROW.
*-------------------------------------------------------*
***************************************************
* MOVE -1 TO NULL INDICATOR FIELDS TO INDICATE NULL
* LEFTOVER DATA IN DATA FIELDS WILL BE IGNORED
MOVE -1 TO FIXED-CHAR-IND.
MOVE -1 TO DATE-OUT-IND.
MOVE -1 TO VAR-CHAR-IND.
MOVE -1 TO SMALL-INT-IND.
MOVE -1 TO PACKED-DEC-IND.
MOVE -1 TO TIME-OUT-IND.
MOVE -1 TO TIMESTAMP-IND.
MOVE -1 TO FLOAT-SGL-IND.
MOVE -1 TO FLOAT-DBL-IND.
MOVE -1 TO LARGE-INT-IND.
MOVE -1 TO LARGE-VCHAR-IND.
5400-EXIT.
EXIT.
*-------------------------------------------------------* 5500-SEND-A-ROW. *-------------------------------------------------------*
*-------------------------------------------------------*
* PUTPIPE SENDS A RESULT ROW TO THE OUTPUT BUFFER, WHICH*
* WILL EVENTUALLY BE SENT DOWN TO THE CLIENT.... *
*-------------------------------------------------------*
CALL 'PUTPIPE' USING SPAREA.
IF SPRC IS NOT EQUAL TO '000'
MOVE WS-PUTPIPE TO ERROR1-CALL
PERFORM 9800-PIPE-ERROR-MSG THRU 9800-EXIT
GO TO 9999-RETURN-TO-CALLER.
5500-EXIT.
EXIT.
*-------------------------------------------------------*
9000-WRAP-UP.
*-------------------------------------------------------*
PERFORM 9200-CLOSE-PIPE THRU 9200-EXIT.
PERFORM 9900-ALL-DONE THRU 9900-EXIT.
* IF THIS IS AN RPC CALL, PERFORM OPEN SERVER CLOSE
IF RPC-CALL
PERFORM 9950-RPDONE THRU 9950-EXIT.
9000-EXIT.
EXIT.
*-------------------------------------------------------*
9200-CLOSE-PIPE.
*-------------------------------------------------------*
*-------------------------------------------------------*
*CLOSEPIPE IS LIKE CLOSING A FILE, PLACES AN EOF MARKER*
*-------------------------------------------------------*
CALL 'CLOSPIPE' USING SPAREA.
IF SPRC IS NOT EQUAL TO '000'
MOVE WS-CLOSPIPE TO ERROR1-CALL
PERFORM 9800-PIPE-ERROR-MSG THRU 9800-EXIT
GO TO 9999-RETURN-TO-CALLER.
9200-EXIT.
EXIT.
*-------------------------------------------------------*
9800-PIPE-ERROR-MSG.
*-------------------------------------------------------*
********************************************************
* IF NO ERRORS, MOVE 'OK' TO SPSTATUS BEFORE CALLING MESSAGE.
* IF ERRORS, MOVE 'E' TO SPSTATUS.
* EITHER WAY MOVE A MESSAGE UP TO A 100 CHAR INTO SPMSG
********************************************************
*-------------------------------------------------------*
* MESSAGE WILL WRITE THE 100 BYTE SPMSG TO A MSG BUFFER,*
* WHICH WILL EVENTUALLY BE WRITTEN TO THE CLIENT... *
*-------------------------------------------------------*
MOVE SPRC TO ERROR1-SPRC.
MOVE ERROR1-MSG TO SPMSG.
MOVE 'E' TO SPSTATUS.
CALL 'MESSAGE' USING SPAREA.
9800-EXIT.
EXIT.
*-------------------------------------------------------*
9810-ERROR-MSG.
*-------------------------------------------------------*
*-------------------------------------------------------*
* MESSAGE WILL WRITE THE 100 BYTE SPMSG TO A MSG BUFFER,*
* WHICH WILL EVENTUALLY BE WRITTEN TO THE CLIENT... *
*-------------------------------------------------------*
MOVE ERROR2-MSG TO SPMSG.
MOVE 'E' TO SPSTATUS.
CALL 'MESSAGE' USING SPAREA.
9810-EXIT.
EXIT.
*-------------------------------------------------------*
9900-ALL-DONE.
*-------------------------------------------------------*
*************************************************************
* IF NO ERRORS, MOVE 'OK' TO SPSTATUS BEFORE CALLING STATUS*
* IF ERRORS, MOVE 'E' TO SPSTATUS BEFORE CALLING STATUS *
* CAN MOVE UP TO 8 CHARS INTO SPCODE (SPMSG IS IGNORED) *
* BUT EITHER WAY ALWAYS CALL STATUS AFTER CLOSPIPE *
* CALLING STATUS WILL AUTOMATIC CLOSE ANY OPEN PIPES *
* *
* CALLING STATUS WILL ALSO FLUSH ANY RESULTS AND/OR *
* MESSAGES FROM THE BUFFERS, TO THE CLIENT *
*************************************************************
MOVE 'OK' TO SPSTATUS.
CALL 'STATUS' USING SPAREA.
9900-EXIT.
EXIT.
*-------------------------------------------------------*
9950-RPDONE.
*-------------------------------------------------------*
********************************************************
* CLOSE OPEN SERVER
* IF THIS IS AN RPC CALL, PERFORM OPEN SERVER CLOSE
********************************************************
CALL 'RPDONE' USING SPAREA.
9950-EXIT.
EXIT.
*-------------------------------------------------------*
9999-RETURN-TO-CALLER.
*-------------------------------------------------------*
*******************************************************
* FOR EMERGENCY BAIL-OUT
CALL 'RPDONE' USING SPAREA.
EXEC CICS
RETURN
END-EXEC.
9999-EXIT.
EXIT.
