17.00 - CLI2MCI Program Listing - IBM IMS Interface for Teradata

IBM IMS Interface for Teradata® Reference

prodname
IBM IMS Interface for Teradata
vrm_release
17.00
created_date
June 2020
category
Programming Reference
featnum
B035-2447-220K
 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.