IDENTIFICATION DIVISION. PROGRAM-ID. CLI2MCI. AUTHOR. J LAHOOD. INSTALLATION. TDAT. REMARKS. THIS PROGRAM PROVIDES AN EXAMPLE OF HOW THE CLI2 * INTERFACE CAN BE USED TO PERFORM THE FOLLOWING FUNCTIONS: * * -- CALL ANOTHER PROGRAM TO DROP/CREATE A TABLE. AN * INITIALIZED DBCAREA CONTAINING THE LOGON STRING * IS PASSED TO THE CALLED PROGRAM. THE CALLED * PROGRAMWILL CONNECT AND DISCONNECT A SINGLE * SESSION. * * -- CONNECT MULTIPLE SESSIONS. * * -- CALL “DBCHWAT” TO WAIT ON AVAILABLE REQUEST (NO * IMPLICIT WAITS BY CLI2). * * -- TERMINATE A REQUEST AND INITIATE ANOTHER REQUEST * AFTER RESPONSE PARCELS HAVE BEEN FETCHED. * * -- THE INITIATED REQUEST IS A MULTI-STATEMENT * REQUEST CONTAINING FIVE INSERT AND FIVE UPDATES * STATEMENTS (ONE TRANSACTION). * * -- DISCONNECT SESSIONS WHEN ALL TRANSACTIONS HAVE * BEEN PROCESSED. * * NOTE: THIS VERSION OF THE SAMPLE PROGRAM IS DESIGNED * TO EXECUTE AS AN IMS MPP CONVERSATIONAL PROGRAM. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-370. OBJECT-COMPUTER. IBM-370. INPUT-OUTPUT SECTION. DATA DIVISION. WORKING-STORAGE SECTION. ****************************************************** * DATA DEFINITIONS * * * ****************************************************** * DL/I CALL FUNCTIONS * 77 GU-FUNC PIC X(4) VALUE ’GU ’. 77 GN-FUNC PIC X(4) VALUE ’GN ’. 77 ISRT-FUNC PIC X(4) VALUE ’ISRT’. * CONSTANTS. * FUNCTION TYPE TO BE INCLUDED IN ERROR MESSAGES. 77 TYPE-FUNC PIC X(8) VALUE SPACES. * NUMBER OF SESSIONS TO BE CONNECTED (1) 77 NUMLOG PIC 9999 COMP VALUE IS 3. * CURRENT NUMBER OF SESSIONS. 77 NUMBER-OF-SESSIONS PIC 9999 VALUE IS 0 COMP. * NUMBER OF INSERT/UPDATE TRANSACTIONS PER ITERATION (2) 77 MAXTRANS PIC S9(9) COMP VALUE IS +10. * TRANSACTION COUNTER 77 TRANS-COUNT PIC S9(9) COMP VALUE IS +0. * MAXIMUM RESPONSE BUFFER SIZE FOR FETCHING * (MUST BE SPECIFIED WHEN IN MOVE MODE). (3) 77 RESPBUF-SIZE PIC S9(9) COMP VALUE IS +4096. * WORD USED IN MESSAGE (SINGULAR/PLURAL FORM). 77 PASS-TYPE PIC X(7) VALUE SPACES. 77 PASS-FIL PIC X(1) VALUE SPACES. * LOGON STRING -- FROM IMS INPUT MESSAGE (FIRST PASS). 77 LOGON-STRING PIC X(40) VALUE SPACES. *77 LOGON-STRING PIC X(40) VALUE ’0/LAHOOD,J’. * LENGTH OF LOGON STRING 77 LOGON-LEN PIC 9(9) VALUE IS 30 COMP. * LENGTH OF VARIABLE LENGTH MESSAGES (OCCURS BY) 77 TEXT-LEN PIC 9999 COMP VALUE IS 0. * RUNNING COUNT OF LOGGED ON SESSIONS 77 LOGID PIC 9999 COMP VALUE IS 1. * SESSION ID RETURNED BY DBCHWAT 77 WAIT-SESSID PIC S9(9) VALUE +0 COMP. * TOKEN RETURNED BY DBCHWAT 77 WAIT-TOKEN PIC S9(9) VALUE +0 COMP. 77 BUSY-CODE PIC S9(9) VALUE +150 COMP. 77 EOF-CODE PIC S9(9) VALUE +33 COMP. 77 CRASH-CODE PIC S9(9) VALUE +286 COMP. 01 PASS-COUNT-DISP PIC ZZ9 . ****************************************************** * * * SCRATCH PAD AREA LAYOUT * (4) 01 SPA. 02 FILLER PIC X(6). 02 SPA-TRANCODE PIC X(8). 02 PASS-COUNT PIC S9(3) COMP. 88 FIRST-TIME VALUE +0. 02 NEXT-DATA-VALUES. 03 DATA1 PIC S9(9) COMP. 03 DATA2 PIC S9(9) COMP. 03 DATA3 PIC S9(9) COMP. 03 DATA4 PIC S9(9) COMP. 03 DATA5 PIC S9(9) COMP. 02 LOGON-STRING-SPA PIC X(40). 02 FILLER PIC X(2048). 01 INSERT-MORE-SW PIC X(1) VALUE ’Y’. 88 INSERT-MORE VALUE ’Y’. 01 INSERT-OK-SW PIC X(4) VALUE ’YES ’. 88 INSERT-OK VALUE ’YES ’. * INPUT MESSAGE AREA 01 INPUT-MESSAGE. 02 IN-LL1 PIC S9(3) COMP. 02 IN-ZZ1 PIC S9(3) COMP. 02 IN-TEXT PIC X(30) VALUE SPACES. 02 FILLER PIC X(132). * * * OUTPUT MESSAGE AREA * 01 OUTPUT-MESSAGE. 02 OUT-LL PIC S9(3) COMP VALUE +79. 02 OUT-ZZ PIC S9(3) COMP VALUE +0. 02 OUT-TEXT PIC X(132) VALUE SPACES. * ************************************************************ * REQUEST TO BE EXECUTED. (5) 01 MULTI-STMT-REQS. 05 FILL1 PIC X(50) VALUE IS ’USING V1 (INTEGER),V2 (INTEGER),V3 (INTEGER), ’. 05 FILL1 PIC X(50) VALUE IS ’ V4 (INTEGER),V5 (INTEGER) ’. 05 FILL2 PIC X(50) VALUE IS ’INSERT INTO MYTABLE2 (F1) VALUES(:V1); ’. 05 FILL3 PIC X(50) VALUE IS ’INSERT INTO MYTABLE2 (F1) VALUES(:V2); ’. 05 FILL4 PIC X(50) VALUE IS ’INSERT INTO MYTABLE2 (F1) VALUES(:V3); ’. 05 FILL5 PIC X(50) VALUE IS ’INSERT INTO MYTABLE2 (F1) VALUES(:V4); ’. 05 FILL6 PIC X(50) VALUE IS ’INSERT INTO MYTABLE2 (F1) VALUES(:V5); ’. 05 FILL7 PIC X(50) VALUE IS ’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V1; ’. 05 FILL8 PIC X(50) VALUE IS ’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V2; ’. 05 FILL9 PIC X(50) VALUE IS ’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V3; ’. 05 FILL10 PIC X(50) VALUE IS ’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V4; ’. 05 FILL11 PIC X(50) VALUE IS ’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V5; ’. 01 MULTI-STMT-REQ REDEFINES MULTI-STMT-REQS. 05 ENTIRE-REQUEST PIC X(600). * LENGTH OF REQUEST. 01 MULT-STMT-LEN PIC 9(9) VALUE IS 600 COMP. (6) 01 DATA-FOR-INSERT-UPDATE. 05 DATA1 PIC S9(9) COMP VALUE IS +1. 05 DATA2 PIC S9(9) COMP VALUE IS +2. 05 DATA3 PIC S9(9) COMP VALUE IS +3. 05 DATA4 PIC S9(9) COMP VALUE IS +4. 05 DATA5 PIC S9(9) COMP VALUE IS +5. 01 DATA-LEN PIC 9(9) VALUE IS 20 COMP. 01 DBCAREA. (7) COPY DBCAREAC. * CLI REQUIRED PARAMETERS 01 CLI-RETURN-CODE PIC S9(9) VALUE +0 COMP. 01 CLI-RC-DISPLAY PIC S9(9) SIGN IS LEADING SEPARATE. 01 DBCAREA-FUNC-ID-DISPLAY PIC S9(9) SIGN IS LEADING SEPARATE. 01 CONTEXT-PTR PIC S9(9) VALUE +0 COMP. * DBC FUNCTION CODES 01 FUNCTIONS. 05 CONNECT-FUNC PIC S9(9) VALUE +1 COMP. 05 DISCONNECT-FUNC PIC S9(9) VALUE +2 COMP. 05 RUN-STARTUP-FUNC PIC S9(9) VALUE +3 COMP. 05 INITIATE-REQ-FUNC PIC S9(9) VALUE +4 COMP. 05 FETCH-FUNC PIC S9(9) VALUE +5 COMP. 05 REWIND-FUNC PIC S9(9) VALUE +6 COMP. 05 ABORT-FUNC PIC S9(9) VALUE +7 COMP. 05 END-REQUEST-FUNC PIC S9(9) VALUE +8 COMP. * COMMON PARCEL FLAVORS 01 FLAVOR. 05 SUCCESS-TYPE PIC S9(9) VALUE +8 COMP. 05 FAILURE-TYPE PIC S9(9) VALUE +9 COMP. 05 RECORD-TYPE PIC S9(9) VALUE +10 COMP. 05 END-STATEMENT-TYPE PIC S9(9) VALUE +11 COMP. 05 END-REQUEST-TYPE PIC S9(9) VALUE +12 COMP. 05 ERROR-TYPE PIC S9(9) VALUE +49 COMP. 05 DATA-INFO-TYPE PIC S9(9) VALUE +71 COMP. * PARCEL WORK AREA FOR MOVE MODE PARCEL FETCHES 01 PARCEL PIC X(4096) VALUE LOW-VALUES. * SUCCESS PARCEL (RELEASE 3.0 AND LATER) 01 SUCCESS-PCL REDEFINES PARCEL. 05 STATEMENT-NO PIC S9(4) COMP. 05 ACTIVITY-COUNT PIC S9(9) COMP. 05 WARNING-CODE PIC S9(4) COMP. 05 FIELD-COUNT PIC S9(4) COMP. 05 ACTIVITY-TYPE PIC S9(4) COMP. 05 WARNING-LEN PIC S9(4) COMP. 05 WARNING-MSG PIC X(256). * FAILURE PARCEL 01 FAILURE-PCL REDEFINES PARCEL. 05 STATEMENT-NO PIC S9(4) COMP. 05 INFO PIC S9(4) COMP. 05 FAILURE-CODE PIC S9(4) COMP. 05 FAILURE-LEN PIC S9(4) COMP. 05 FAILURE-MSG PIC X(256). * ERROR PARCEL 01 ERROR-PCL REDEFINES PARCEL. 05 STATEMENT-NO PIC S9(4) COMP. 05 INFO PIC S9(4) COMP. 05 ERROR-CODE PIC S9(4) COMP. 05 ERROR-LEN PIC S9(4) COMP. 05 ERROR-MSG PIC X(256). (8) 01 VARMSG. 10 VTEXT OCCURS 1 TO 256 TIMES DEPENDING ON TEXT-LEN. 15 TEXT-DUM PIC X. (9) 01 TOKEN-ARRAY. 05 SESSION-DESCRIPT OCCURS 100 TIMES INDEXED BY TOKEN-INDEX. 10 SESSID PIC S9(9) COMP. 10 REQID PIC S9(9) COMP. 10 TOKEN PIC S9(9) COMP. 10 TDPSESS PIC S9(9) COMP. 10 TDPREQID PIC S9(9) COMP. 10 LAST-FUNCTION PIC X(8) . 01 MSG-INFO. 02 MSG-INFO-FUNC PIC S9(9) COMP. 02 MSG-INFO-RC PIC S9(9) COMP. 02 MSG-INFO-CLI-MSG PIC X(76). 02 MSG-INFO-FECODE PIC S9(9) COMP. 02 MSG-INFO-LEN PIC S9(4) COMP. 02 MSG-INFO-TEXT PIC X(256). EJECT LINKAGE SECTION. * * PCB FOR I/O PCB * 01 IOPCB. 02 LTERM PIC X(8). 02 FILLER PIC X(2). 02 IOPCB-STATUS PIC X(2). 02 PREFIX. 03 FILLER PIC X. 03 JULIAN-DATE PIC S9(9) COMPUTATIONAL-3. 03 TIME-O-DAY PIC S9(9) COMPUTATIONAL-3. 03 FILLER PIC XXX. * PROCEDURE DIVISION. (10) ENTRY ’DLITCBL’ USING IOPCB. * THE PROGRAM IS ENTERED WITH THE FOLLOWING * PROGRAM COMMUNICATION BLOCK (PCB) ADDRESSES: * * IOPCB - INPUT OUTPUT LOGICAL TERMINAL PERFORM READ-SPA. (11) PERFORM PROCESS-MSG UNTIL IOPCB-STATUS = ’QC’. GOBACK. PROCESS-MSG. IF FIRST-TIME PERFORM READ1 ELSE PERFORM READ2. IF INSERT-MORE (12) PERFORM INSERT-ROWS THRU INSERT-ROWS-EXIT ELSE STRING SPA-TRANCODE, (13) ’ TRANSACTION COMPLETED. USE BTEQ/ITEQ TO CHECK RESULTS.’ DELIMITED BY SIZE INTO OUT-TEXT MOVE ’NO ’ TO INSERT-OK-SW MOVE SPACES TO SPA-TRANCODE PERFORM ISRT-MSG. IF INSERT-OK THEN ADD +1 TO PASS-COUNT MOVE PASS-COUNT TO PASS-COUNT-DISP PERFORM SET-PASS-TYPE STRING PASS-COUNT-DISP, PASS-TYPE, ’ COMPLETED. ’, (14) ’ENTER YES TO CONTINUE OR NO TO END CONVERSATION.’ DELIMITED BY SIZE INTO OUT-TEXT PERFORM ISRT-MSG. PERFORM ISRT-SPA. PERFORM READ-SPA. READ-SPA. CALL ’CBLTDLI’ USING GU-FUNC, IOPCB, SPA. IF IOPCB-STATUS = SPACES OR ’QC’ THEN NEXT SENTENCE ELSE MOVE ’GU-SPA’ TO TYPE-FUNC PERFORM STATUS-ERROR. * * * READ1. MOVE SPACES TO IN-TEXT. CALL ’CBLTDLI’ USING GN-FUNC, IOPCB, INPUT-MESSAGE. IF IOPCB-STATUS NOT = SPACES MOVE ’GN 1’ TO TYPE-FUNC PERFORM STATUS-ERROR. MOVE IN-TEXT TO LOGON-STRING. MOVE SPACES TO LOGON-STRING-SPA. MOVE IN-TEXT TO LOGON-STRING-SPA. MOVE ’Y’ TO INSERT-MORE-SW. MOVE ’YES ’ TO INSERT-OK-SW. * * READ2. CALL ’CBLTDLI’ USING GN-FUNC, IOPCB, INPUT-MESSAGE. IF IOPCB-STATUS NOT = SPACES MOVE ’GN 2’ TO TYPE-FUNC PERFORM STATUS-ERROR. MOVE LOGON-STRING-SPA TO LOGON-STRING. MOVE IN-TEXT TO INSERT-MORE-SW. MOVE ’YES ’ TO INSERT-OK-SW. * * ISRT-SPA. CALL ’CBLTDLI’ USING ISRT-FUNC, IOPCB, SPA. IF IOPCB-STATUS NOT = SPACES MOVE ’ISRT-SPA’ TO TYPE-FUNC PERFORM STATUS-ERROR. * * ISRT-MSG. CALL ’CBLTDLI’ USING ISRT-FUNC, IOPCB, OUTPUT-MESSAGE. IF IOPCB-STATUS NOT = SPACES MOVE ’ISRT-MSG’ TO TYPE-FUNC PERFORM STATUS-ERROR. MOVE SPACES TO OUT-TEXT. STATUS-ERROR. STRING ’BAD IOPCB-STATUS -- FUNCTION = ’, TYPE-FUNC DELIMITED BY SIZE INTO OUT-TEXT. DISPLAY OUT-TEXT UPON CONSOLE. GOBACK. EJECT SET-PASS-TYPE. IF PASS-COUNT = 1 MOVE ’ PASS’ TO PASS-TYPE ELSE MOVE ’ PASSES’ TO PASS-TYPE. ****************************************************** INSERT-ROWS. (15) PERFORM DBC-INIT. * SET UP POINTER TO LOGON STRING (16) CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-LOGON-PTR, LOGON-STRING. * SET UP LENGTH OF LOGON STRING MOVE LOGON-LEN TO DBCAREA-LOGON-LEN. * ON FIRST PASS ONLY: * CALL A PROGRAM TO DROP THEN CREATE THE TABLE “MYTABLE2". IF FIRST-TIME (17) CALL ’CLI2CTB’ USING DBCAREA, MSG-INFO (18) PERFORM CHECK-CALL (19) MOVE +1 TO DATA1 OF DATA-FOR-INSERT-UPDATE MOVE +2 TO DATA2 OF DATA-FOR-INSERT-UPDATE MOVE +3 TO DATA3 OF DATA-FOR-INSERT-UPDATE MOVE +4 TO DATA4 OF DATA-FOR-INSERT-UPDATE MOVE +5 TO DATA5 OF DATA-FOR-INSERT-UPDATE ELSE MOVE CORRESPONDING NEXT-DATA-VALUES OF SPA TO DATA-FOR-INSERT-UPDATE. PERFORM DBCAREA-SETUP. MOVE ZERO TO NUMBER-OF-SESSIONS. MOVE ZERO TO TRANS-COUNT. (20) PERFORM CLI-CONNECT VARYING LOGID FROM 1 BY 1 UNTIL LOGID GREATER NUMLOG. (21) PERFORM WAIT-FETCH-IRQ UNTIL NUMBER-OF-SESSIONS = ZERO. MOVE CORRESPONDING DATA-FOR-INSERT-UPDATE TO NEXT-DATA-VALUES OF SPA. INSERT-ROWS-EXIT. EXIT. * CHECK CODES AND MESSAGES FROM CALLED PROGRAM. CHECK-CALL. IF MSG-INFO-RC NOT = ZERO MOVE MSG-INFO-FUNC TO DBCAREA-FUNC-ID MOVE MSG-INFO-RC TO CLI-RETURN-CODE MOVE MSG-INFO-CLI-MSG TO DBCAREA-MSG-TEXT PERFORM DISP-ERROR ELSE IF MSG-INFO-LEN NOT = ZERO MOVE MSG-INFO-LEN TO TEXT-LEN MOVE MSG-INFO-TEXT TO VARMSG STRING VARMSG DELIMITED BY SIZE INTO OUT-TEXT PERFORM END-TRANS. END-TRANS. PERFORM ISRT-MSG. MOVE SPACES TO SPA-TRANCODE. MOVE ’NO ’ TO INSERT-OK-SW. GO TO INSERT-ROWS-EXIT. *********** WAIT FOR AVAILABLE REQUEST. ********** *********** USE TOKEN FROM WAIT AS INDEX TO ********** *********** OBTAIN SESSID AND REQID. ********** *********** FETCH PARCELS -- ********** *********** WHEN EOF,INITIATE INSERT REQUEST. ********** WAIT-FETCH-IRQ. MOVE BUSY-CODE TO CLI-RETURN-CODE. (22) PERFORM CLI-WAIT UNTIL CLI-RETURN-CODE NOT = BUSY-CODE AND CLI-RETURN-CODE NOT = CRASH-CODE. (23) SET TOKEN-INDEX TO WAIT-TOKEN. (24) MOVE SESSID(TOKEN-INDEX) TO DBCAREA-I-SESS-ID. MOVE REQID(TOKEN-INDEX) TO DBCAREA-I-REQ-ID. (25) PERFORM CLI-FETCH-PARCELS UNTIL CLI-RETURN-CODE = EOF-CODE OR CLI-RETURN-CODE = BUSY-CODE OR CLI-RETURN-CODE = CRASH-CODE. IF CLI-RETURN-CODE = EOF-CODE AND (26) LAST-FUNCTION(TOKEN-INDEX) = ’LOGON’ MOVE DBCAREA-O-SESS-ID TO TDPSESS(TOKEN-INDEX). IF CLI-RETURN-CODE = EOF-CODE THEN (27) PERFORM CLI-END-REQUEST IF TRANS-COUNT < MAXTRANS (28) PERFORM IRQ-CALL ELSE PERFORM CLI-DISCONNECT (29) SUBTRACT 1 FROM NUMBER-OF-SESSIONS. *************************************************** ******** WAIT FOR AVAILABLE REQUEST ************ CLI-WAIT. * WAIT THEN SET UP DBCAREA IDS CALL ’DBCHWAT’ USING CLI-RETURN-CODE, CONTEXT-PTR, WAIT-SESSID, WAIT-TOKEN. IF CLI-RETURN-CODE NOT = 0 MOVE CLI-RETURN-CODE TO CLI-RC-DISPLAY STRING ’WAIT ERROR, RETURN CODE = ’, CLI-RC-DISPLAY DELIMITED BY SIZE INTO OUT-TEXT PERFORM ISRT-MSG STRING DBCAREA-MSG-TEXT DELIMITED BY SIZE INTO OUT-TEXT PERFORM END-TRANS. MOVE SESSID(TOKEN-INDEX) TO DBCAREA-I-SESS-ID. MOVE REQID(TOKEN-INDEX) TO DBCAREA-I-REQ-ID. *************************************************** ********* FETCH PARCELS ********** CLI-FETCH-PARCELS. MOVE FETCH-FUNC TO DBCAREA-FUNC-ID. CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = EOF-CODE AND CLI-RETURN-CODE NOT = BUSY-CODE AND CLI-RETURN-CODE NOT = CRASH-CODE PERFORM DISPLAY-PARCEL. *************************************************** *********** INITIATE INSERT REQUEST ******** IRQ-CALL. MOVE SESSID(TOKEN-INDEX) TO DBCAREA-I-SESS-ID. MOVE TOKEN(TOKEN-INDEX) TO DBCAREA-TOKEN. MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC-ID. CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE = ZERO MOVE ’INSERT’ TO LAST-FUNCTION(TOKEN-INDEX) MOVE DBCAREA-O-REQ-ID TO REQID(TOKEN-INDEX) MOVE DBC-TDP-REQNO TO TDPREQID(TOKEN-INDEX) ADD +1 TO TRANS-COUNT. ADD +5 TO DATA1 OF DATA-FOR-INSERT-UPDATE, DATA2 OF DATA-FOR-INSERT-UPDATE, DATA3 OF DATA-FOR-INSERT-UPDATE, DATA4 OF DATA-FOR-INSERT-UPDATE, DATA5 OF DATA-FOR-INSERT-UPDATE. *************************************************** ******** TERMINATE REQUEST ********** CLI-END-REQUEST. MOVE END-REQUEST-FUNC TO DBCAREA-FUNC-ID. CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = 0 PERFORM DISP-ERROR. *************************************************** *********** DISCONNECT SESSION ********** CLI-DISCONNECT. MOVE DISCONNECT-FUNC TO DBCAREA-FUNC-ID. CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = 0 PERFORM DISP-ERROR. *************************************************** *********** DISPLAY PARCEL ********** DISPLAY-PARCEL. IF DBCAREA-FET-PARCEL-FLAVOR = ERROR-TYPE STRING ’ERROR PARCEL RECEIVED ’ DELIMITED BY SIZE INTO OUT-TEXT PERFORM ISRT-MSG MOVE ERROR-LEN TO TEXT-LEN MOVE ERROR-MSG TO VARMSG STRING VARMSG DELIMITED BY SIZE INTO OUT-TEXT PERFORM END-TRANS ELSE IF DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE STRING ’FAILURE PARCEL RECEIVED ’ DELIMITED BY SIZE INTO OUT-TEXT PERFORM ISRT-MSG MOVE FAILURE-LEN TO TEXT-LEN MOVE FAILURE-MSG TO VARMSG STRING VARMSG DELIMITED BY SIZE INTO OUT-TEXT PERFORM END-TRANS. *************************************************** ********** DISPLAY ERROR MESSAGE ********** DISP-ERROR. MOVE CLI-RETURN-CODE TO CLI-RC-DISPLAY. MOVE DBCAREA-FUNC-ID TO DBCAREA-FUNC-ID-DISPLAY. STRING ’FUNCTION = ’,DBCAREA-FUNC-ID-DISPLAY,’RETURN CODE’ CLI-RC-DISPLAY DELIMITED BY SIZE INTO OUT-TEXT. PERFORM ISRT-MSG. STRING DBCAREA-MSG-TEXT DELIMITED BY SIZE INTO OUT-TEXT. PERFORM END-TRANS. *************************************************** ********** INITIALIZE DBCAREA ********** DBC-INIT. CALL ’DBCHINI’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = 0 MOVE CLI-RETURN-CODE TO CLI-RC-DISPLAY STRING ’CLI RETURN CODE AFTER INIT = ’, CLI-RC-DISPLAY DELIMITED BY SIZE INTO OUT-TEXT, PERFORM ISRT-MSG, STRING DBCAREA-MSG-TEXT DELIMITED BY SIZE INTO OUT-TEXT, PERFORM END-TRANS. ***************** CONNECT SESSION ********** CLI-CONNECT. SET TOKEN-INDEX TO LOGID. MOVE LOGID TO DBCAREA-TOKEN. MOVE CONNECT-FUNC TO DBCAREA-FUNC-ID. CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CODE NOT = 0 PERFORM DISP-ERROR. MOVE DBC-TDP-REQNO TO TDPREQID(TOKEN-INDEX). ADD 1 TO NUMBER-OF-SESSIONS. * SAVE TOKEN, SESSION ID , REQUEST ID , AND LAST-FUNCTION. MOVE LOGID TO TOKEN(TOKEN-INDEX). MOVE DBCAREA-O-SESS-ID TO SESSID(TOKEN-INDEX). MOVE DBCAREA-O-REQ-ID TO REQID(TOKEN-INDEX). MOVE ’LOGON’ TO LAST-FUNCTION(TOKEN-INDEX). ***************************************************** (30) DBCAREA-SETUP. ***************************************************** * SET UP DBCHSAD CALLS (STORE ADDRESSES IN DBCAREA) * * AND OTHER DBCAREA CONSTANTS. * ***************************************************** *** SET UP POINTER TO DBC/SQL STATEMENT. (31) CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-REQ-PTR, MULTI-STMT-REQ. *** SET UP LENGTH OF DBC/SQL STATEMENT. (32) MOVE MULT-STMT-LEN TO DBCAREA-REQ-LEN. *** SET UP POINTER TO USING DATA (33) CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-USING-DATA-PTR, DATA-FOR-INSERT- *** SET UP LENGTH OF DATA FOR DBC/SQL STATEMENT. MOVE DATA-LEN TO DBCAREA-USING-DATA-LEN. (34) *** SET UP POINTER TO PARCEL AREA (MOVE MODE) (35) CALL ’DBCHSAD’ USING CLI-RETURN-CODE, DBCAREA-FET-DATA-PTR, PARCEL. *** SET UP MAX SIZE FOR PARCEL (REQUIRED FOR MOVE MODE) (36) MOVE RESPBUF-SIZE TO DBCAREA-FET-MAX-DATA-LEN. *** SET UP MAXIMUM NUMBER OF SESSIONS. (37) MOVE NUMLOG TO DBCAREA-MAX-NUM-SESS. ****************************************************** * * * SET OPTION FLAGS * ****************************************************** * SET MOVE-MODE OPTION FOR COBOL PROGRAMS. * * * ****************************************************** (38) MOVE ’N’ TO DBCAREA-LOC-MODE. ****************************************************** * SET NO WAIT-FOR-RESPONSE OPTION. * * (TECHNIQUE USED BY THIS SAMPLE PROGRAM) * ****************************************************** (39) MOVE ’N’ TO DBCAREA-WAIT-FOR-RESP. ****************************************************** * SET ’N’ FOR CRASH-WAIT OPTION. * * (TECHNIQUE USED BY THIS SAMPLE PROGRAM) * ****************************************************** (40) MOVE ’N’ TO DBCAREA-WAIT-ACROSS-CRASH. ****************************************************** * SET ’Y’ FOR CRASH-TELL OPTION. * * (TECHNIQUE USED BY THIS SAMPLE PROGRAM) * ****************************************************** MOVE ’Y’ TO DBCAREA-TELL-ABOUT-CRASH. ****************************************************** * SET ’Y’ TO TRIGGER CHANGED OPTIONS. * * * ****************************************************** MOVE ’Y’ TO DBCAREA-CHANGE-OPTS. * END OF SOURCE CODE.