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.