17.00 - CLI2/MPI 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
*PROCESS MAR(2,72,1); /* THIS PROGRAM PROVIDES AN EXAMPLE OF HOW THE CLI2 INTER-  */
 /* FACE 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.                   */
 /*                                                          */
 /*    -- 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    */
 /*       (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.  */
 /*                                                          */
 /* AUTHOR: J. LAHOOD                                        */
 /*                                                          */
1CLI2MPI: PROC(PCBPTR) OPTIONS(MAIN); 
   DCL   PLITDLI ENTRY EXTERNAL;
   DCL   PLIXOPT CHAR(24) VAR
          INIT(’ISA(4K),NOSTAE,NOSPIE’) STATIC EXTERNAL;
   DCL   PCBPTR POINTER, 
      1 IOPCB BASED(PCBPTR),
        2  LTERM   CHAR(8),
        2  FILLER  CHAR(2),
        2  IOPCB_STATUS CHAR(2),
        2  PREFIX CHAR(12);
   DCL (STG,SUBSTR,ADDR) BUILTIN;
 /*                                                          */
 /*----------------------------------------------------------*/
 /* * DATA DEFINITIONS                                       */
 /* *                                                        */
 /* ---------------------------------------------------------*/
 /*                 DL/I CALL FUNCTIONS                      */
   DCL GU_FUNC    CHAR(4)  STATIC INIT(’GU  ’),
       GN_FUNC    CHAR(4)  STATIC INIT(’GN  ’),
       ISRT_FUNC  CHAR(4)  STATIC INIT(’ISRT’);
 /*                                                          */
 /*           PL/I PARAMETER COUNTER                         */
 /*                                                          */
   DCL THREE      FIXED BIN(31) INIT(3);
 /*                                                          */
 /*    CLI2 SUBROUTINES AND CLICTAB (CREATES TABLE)          */
 /*                                                          */
   DCL (DBCHINI, 
        DBCHCL, 
        DBCHWAT, 
        CLI2CTB, 
        DBCHCLN) ENTRY EXTERNAL OPTIONS(ASSEMBLER, INTER);
 /*   CONSTANTS                                              */
 /*  TYPE OF FUNCTION -- USED IN MESSAGES                    */
   DCL TYPE_FUNC  CHAR(8) STATIC,
 /*   NUMBER OF SESSIONS TO BE CONNECTED                     */
 /*                                                          */
 /*                                                          */
        NUMLOG              FIXED BIN(15) STATIC INIT(3),
 /*                                                          */
 /*   CURRENT NUMBER OF SESSIONS.                            */
 /*                                                          */
        NUMBER_OF_SESSIONS  FIXED BIN(15) STATIC INIT(0), 
 /*                                                          */
 /*   NUMBER OF INSERT/UPDATE TRANSACTIONS PER ITERATION     */
 /*                                                          */
        MAXTRANS            FIXED BIN(31) STATIC INIT(10),
 /*                                                          */
 /*   TRANSACTION COUNTER                                    */
 /*                                                          */
        TRANS_COUNT         FIXED BIN(31) STATIC INIT(0),
 /*                                                          */
 /*   MAXIMUM RESPONSE BUFFER SIZE FOR FETCHING              */
 /*                                                          */
        RESPBUF_SIZE        FIXED BIN(31) STATIC INIT(4096),
 /*                                                          */
 /*   WORD USED IN MESSAGE (SINGULAR/PLURAL FORM).           *
 /*                                                          */
        PASS_TYPE           CHAR(7) STATIC,
 /*                                                          */
 /*   LOGON STRING -- FROM IMS INPUT MESSAGE (FIRST PASS).   */
 /*   LOGON_STRING     CHAR(4) STATIC INIT(’0/LAHOOD,J’)     */
 /*                                                          */
        LOGON_STRING        CHAR(40) STATIC, 
 /*                                                          */
 /*   LENGTH OF LOGON STRING -- OBTAINED VIA PL/I ’STG’      */
 /*   FUNCTION.                                              */
 /*     MY_LOGON_LEN        FIXED BIN(31) STATIC INIT(30),
 /*                                                          */
 /*                                                          */
 /*   RUNNING COUNT OF LOGGED ON SESSIONS                    */
 /*                                                          */
        LOGID               FIXED BIN(15) STATIC INIT(1),
 /*                                                          */
 /*   SESSION ID RETURNED BY DBCHWAT                         */
 /*                                                          */
        WAIT_SESSID         FIXED BIN(31) STATIC INIT(0),
 /*                                                          */
 /*   INDEX USED TO ACCESS TOKEN_ARRAY                       */
 /*                                                          */
      TOKEN_INDEX           FIXED BIN(31) STATIC INIT(0),
 /*                                                          */
 /*   TOKEN RETURNED BY DBCHWAT                              */
 /*                                                          */
      WAIT_TOKEN            FIXED BIN(31) STATIC INIT(0),
 /*                                                          */
 /*   CLI CODES                                              */
 /*                                                          */
      BUSY_CODE             FIXED BIN(31) STATIC INIT(150),
      EOF_CODE              FIXED BIN(31) STATIC INIT(33),
      CRASH_CODE            FIXED BIN(31) STATIC INIT(286);
 /*                                                          */
 /*    SCRATCH PAD AREA LAYOUT                               */
 /*                                                          */
   DCL 1  SPA STATIC,
           2  LL   FIXED BIN(31),
           2  ZZ   FIXED BIN(31),
           2  SPA_TRANCODE  CHAR(8),
           2  PASS_COUNT    FIXED BIN(15),
           2  NEXT_DATA_VALUES,
               03 DATA1     FIXED BIN(31),
               03 DATA2     FIXED BIN(31),
               03 DATA3     FIXED BIN(31),
               03 DATA4     FIXED BIN(31),
               03 DATA5     FIXED BIN(31),
           2   LOGON_STRING_SPA CHAR(40),
           2   FILLER           CHAR(2048);
 /*                                                          */
 /*                                                          */
   DCL   INSERT_MORE       CHAR(1) STATIC INIT(’Y’),
         INSERT_OK         CHAR(4) STATIC INIT(’YES ’);
 /*                                                          */
 /*   INPUT/OUTPUT AREAS                                     */
 /*                                                          */
   DCL 1   INPUT_MESSAGE STATIC, 
           2  IN_LL1         FIXED BIN(31), 
           2  IN_ZZ1         FIXED BIN(15), 
           2  IN_TEXT        CHAR(30), 
           2  FILLER         CHAR(132),
       1   OUTPUT_MESSAGE STATIC, 
           2  OUT_LL1        FIXED BIN(31) INIT(79), 
           2  OUT_ZZ         FIXED BIN(15) INIT(’0’B), 
           2  OUT_TEXT       CHAR(80);
 /*                                                          */
 /*    DBC/SQL REQUESTS TO BE EXECUTED                       */
 /*                                                          */
   DCL 1  MULTI_STMT_REQS STATIC, 
           2 L1     CHAR(50)  INIT
             (’USING V1 (INTEGER),V2 (INTEGER),V3 (INTEGER), ’),
           2 L2     CHAR(50)  INIT
             (’ V4 (INTEGER),V5 (INTEGER)                    ’), 
           2 L3     CHAR(50)  INIT
             (’INSERT INTO MYTABLE2 (F1) VALUES(:V1);        ’), 
           2 L4     CHAR(50)  INIT
             (’INSERT INTO MYTABLE2 (F1) VALUES(:V2);        ’), 
           2 L5     CHAR(50) INIT
             (’INSERT INTO MYTABLE2 (F1) VALUES(:V3);        ’), 
           2 L6     CHAR(50) INIT
             (’INSERT INTO MYTABLE2 (F1) VALUES(:V4);        ’), 
           2 L7    CHAR(50) INIT
             (’INSERT INTO MYTABLE2 (F1) VALUES(:V5);        ’), 
           2 L8    CHAR(50) INIT
             (’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V1;   ’), 
           2 L9    CHAR(50) INIT
             (’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V2;   ’), 
           2 L10   CHAR(50) INIT
             (’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V3;   ’), 
           2 L11   CHAR(50) INIT
             (’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V4;   ’), 
           2 L12   CHAR(50) INIT
             (’UPDATE MYTABLE2 SET F2 = F1+1 WHERE F1=:V5;   ’),
       
       1 MULTI_STMT_REQ   DEF MULTI_STMT_REQS, 
           2 EACH_REQUEST(12)  CHAR(50),
       MULT_STMT_LEN    FIXED BIN(31) STATIC INIT(600),
       1  DATA_FOR_INS_UPD STATIC, 
           2  DATA1    FIXED BIN(31) INIT(1), 
           2  DATA2    FIXED BIN(31) INIT(2), 
           2  DATA3    FIXED BIN(31) INIT(3), 
           2  DATA4    FIXED BIN(31) INIT(4), 
           2  DATA5    FIXED BIN(31) INIT(5),
       1  DATA_LEN    FIXED BIN(31) STATIC INIT(20);
       %INCLUDE DBCAREAP; 
       %INCLUDE CLIPARMP;
 /*                                                          */
 /*                                                          */
   DCL 1  TOKEN_ARRAY(20), 
          2  SESSID          FIXED BIN(31), 
          2  REQID           FIXED BIN(31), 
          2  TOKEN           FIXED BIN(31), 
          2  TDPSESS         FIXED BIN(31), ‘
          2  TDPREQID        FIXED BIN(31), 
          2  LAST_FUNCTION   CHAR(8);
   DCL 1  MSG_INFO,
          2 MSG_INFO_FUNC    FIXED BIN(31),
          2 MSG_INFO_RC      FIXED BIN(31),
          2 MSG_INFO_CLI_MSG CHAR(76),
          2 MSG_INFO_FECODE  FIXED BIN(31),
          2 MSG_INFO_LEN     FIXED BIN(15),
          2 MSG_INFO_TEXT    CHAR(256);
1/*                                                          */
 /*  START PROCESSING -- MAIN LOOP                           */
 /*                                                          */
 /*                                                          */
        CALL READ_SPA; 
        DO UNTIL(IOPCB_STATUS = ’QC’);
           CALL PROCESS_MSG; 
        END;
 /*                                                          */
 /*                                                          */
  PROCESS_MSG: PROC;
           IF SPA.PASS_COUNT = 0 THEN CALL READ1; 
           ELSE CALL READ2; 
           IF INSERT_MORE = ’Y’ THEN CALL INSERT_ROWS; 
           ELSE
            DO;
             OUT_TEXT =  SPA_TRANCODE ||
            ’ TRANSACTION COMPLETED. USE BTEQ TO CHECK RESULTS.’; 
             INSERT_OK = ’NO  ’; 
             SPA_TRANCODE = ’ ’; 
             CALL ISRT_MSG; 
             END;
           IF INSERT_OK = ’YES ’ THEN 
            DO;
            PASS_COUNT = PASS_COUNT + 1 ; 
            CALL SET_PASS_TYPE; 
            OUT_TEXT =
               PASS_COUNT ||  PASS_TYPE ||  ’ COMPLETED’ || 
               ’ ENTER YES TO CONTINUE OR NO TO END CONVERSATION.’;
            CALL ISRT_MSG; 
             END;
           CALL ISRT_SPA; 
           CALL READ_SPA;
  END PROCESS_MSG;
 /*                                                           */
 /*                                                           */
  READ_SPA: PROC;
           CALL PLITDLI(THREE,GU_FUNC,PCBPTR,SPA); 
           IF (IOPCB_STATUS = ’  ’)  |
              (IOPCB_STATUS = ’QC’) 
               THEN;
           ELSE DO;
                  TYPE_FUNC =  ’GU_SPA’; 
                  CALL STATUS_ERROR;
                END; 
  END  READ_SPA;
 /*                                                           */
 /*                                                           */
  READ1: PROC; 
           IN_TEXT = ’ ’; 
           CALL PLITDLI(THREE,GN_FUNC,PCBPTR, INPUT_MESSAGE); 
           IF IOPCB_STATUS = ’ ’ THEN
                DO;
                  TYPE_FUNC =  ’GN   1’; 
                  CALL STATUS_ERROR;
                END; 
           ELSE DO;
                  LOGON_STRING =  IN_TEXT; 
                  LOGON_STRING_SPA = ’ ’; 
                  LOGON_STRING_SPA = IN_TEXT; 
                  INSERT_MORE = ’Y’; 
                  INSERT_OK = ’YES’;
                END; 
  END READ1;
 /*                                                           */
 /*                                                           */
  READ2: PROC;
           CALL PLITDLI(THREE,GN_FUNC,PCBPTR,INPUT_MESSAGE); 
           IF IOPCB_STATUS = ’ ’   THEN
                DO;
                   TYPE_FUNC = ’GN   2’; 
                   CALL STATUS_ERROR;
                END; 
           ELSE DO;
                   LOGON_STRING = LOGON_STRING_SPA ; 
                   INSERT_MORE =  SUBSTR(IN_TEXT,1,1); 
                   INSERT_OK = ’YES ’;
                END; 
  END READ2;
 /*                                                          */
 /*                                                          */
  ISRT_SPA: PROC;
           CALL PLITDLI(THREE,ISRT_FUNC, PCBPTR, SPA); 
           IF IOPCB_STATUS = ’  ’ THEN
              DO;
                 TYPE_FUNC = ’ISRT_SPA’; 
                 CALL  STATUS_ERROR;
              END; 
  END ISRT_SPA;
 /*                                                          */
 /*                                                          */
  ISRT_MSG: PROC;
           CALL PLITDLI(THREE,ISRT_FUNC, PCBPTR,OUTPUT_MESSAGE); 
           IF IOPCB_STATUS  = ’  ’ THEN
              DO;
                 TYPE_FUNC = ’ISRT_MSG’; 
                 CALL STATUS_ERROR;
              END; 
           OUT_TEXT = ’ ’;
  END ISRT_MSG;
 /*                                                          */
 /*                                                          */
  STATUS_ERROR: PROC;
           OUT_TEXT = ’BAD IOPCB_STATUS -- FUNCTION = ’ 
           || TYPE_FUNC || ’ STATUS = ’ || IOPCB_STATUS; 
           CALL PLITDLI(THREE,ISRT_FUNC, PCBPTR,OUTPUT_MESSAGE); 
           SPA_TRANCODE = ’ ’; 
           CALL PLITDLI(THREE,ISRT_FUNC, PCBPTR, SPA); 
           GO TO IMMEDIATE_IMS_RETURN;
  END STATUS_ERROR;
 /*                                                          */
 /*                                                          */
  SET_PASS_TYPE: PROC;
               IF PASS_COUNT = 1 THEN PASS_TYPE = ’ PASS’; 
               ELSE PASS_TYPE = ’ PASSES’;
  END SET_PASS_TYPE;
 /*                                                          */
 /*                                                          */
 /* ************************************************************* */
  INSERT_ROWS: PROC; ‘
           CALL DBC_INIT;
    /*  SET UP POINTER TO LOGON STRING                       */ 
           DBCAREA.LOGON_PTR = ADDR(LOGON_STRING);
    /*   SET UP LENGTH OF LOGON STRING                       */ 
           DBCAREA.LOGON_LEN = STG(LOGON_STRING);
    /*   ON FIRST PASS ONLY:                                  */
    /*   CALL A PROGRAM TO DROP THEN CREATE THE TABLE “MYTABLE2". */
           IF PASS_COUNT = 0 THEN 
            DO;
             CALL CLI2CTB(DBCAREA, MSG_INFO); 
             CALL CHECK_CALL; 
             DATA_FOR_INS_UPD.DATA1 = 1; 
             DATA_FOR_INS_UPD.DATA2 = 2; 
             DATA_FOR_INS_UPD.DATA3 = 3; 
             DATA_FOR_INS_UPD.DATA4 = 4; 
             DATA_FOR_INS_UPD.DATA5 = 5;
            END; 
            ELSE
             DATA_FOR_INS_UPD = SPA.NEXT_DATA_VALUES; 
           CALL  DBCAREA_SETUP; 
           NUMBER_OF_SESSIONS = 0; 
           TRANS_COUNT = 0; 
           DO LOGID = 1 TO NUMLOG BY 1;
             CALL CLI_CONNECT; 
           END; 
           DO UNTIL(NUMBER_OF_SESSIONS = 0);
             CALL WAIT_FETCH_IRQ; 
            END;
           SPA.NEXT_DATA_VALUES =  DATA_FOR_INS_UPD; 
 END  INSERT_ROWS; 
 /*                                                          */ 
 /*                                                          */ 
CHECK_CALL: PROC;
           IF MSG_INFO_RC = 0 THEN 
              DO;
                 DBCAREA.FUNC =  MSG_INFO_FUNC; 
                 CLI_RETURN_CD =  MSG_INFO_RC; 
                 DBCAREA.MSG_TEXT = MSG_INFO_CLI_MSG; 
                 CALL DISP_ERROR;
              END; 
           ELSE
            IF MSG_INFO_LEN  = 0 THEN 
             DO;
               OUT_TEXT = ’FAILURE PARCEL RECEIVED IN CALLED PROG.’ || 
                ’ FAILURE CODE = ’ || MSG_INFO_FECODE ;
               CALL  ISRT_MSG; 
               OUT_TEXT = SUBSTR(MSG_INFO_TEXT,1,MSG_INFO_LEN); 
               CALL END_TRANS;
             END; 
 END CHECK_CALL; 
 /*                                                          */ 
 /*                                                          */ 
 END_TRANS: PROC;
           CALL ISRT_MSG; 
           SPA_TRANCODE = ’ ’; 
           CALL ISRT_SPA; 
           GO TO IMMEDIATE_IMS_RETURN;
 END  END_TRANS; 
 /*                                                          */ 
 /*                                                          */ 
 /*   ***********  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: PROC;
           CLI_RETURN_CD = BUSY_CODE; /* ENTER AT LEAST ONCE */ 
           DO UNTIL((CLI_RETURN_CD  = BUSY_CODE) &
                       (CLI_RETURN_CD  = CRASH_CODE)  ); 
              CALL CLI_WAIT;
           END; 
           TOKEN_INDEX = WAIT_TOKEN    /* USE TOKEN FROM DBCHWAT */; 
           DBCAREA.I_SESS_ID = SESSID(TOKEN_INDEX); 
           DBCAREA.I_REQ_ID  = REQID(TOKEN_INDEX) ; 
           DO UNTIL((CLI_RETURN_CD = EOF_CODE) |
                    (CLI_RETURN_CD = BUSY_CODE) | 
                    (CLI_RETURN_CD = CRASH_CODE));
             CALL CLI_FETCH_PARCELS; 
           END;
           IF (CLI_RETURN_CD = EOF_CODE) & 
                      (LAST_FUNCTION(TOKEN_INDEX) = ’LOGON’)
               THEN TDPSESS(TOKEN_INDEX) = DBCAREA.TDP_SESS_ID; 
           IF CLI_RETURN_CD = EOF_CODE THEN
            DO;
              CALL CLI_END_REQUEST; 
              IF TRANS_COUNT < MAXTRANS THEN
                 CALL IRQ_CALL; 
              ELSE DO;
                     CALL CLI_DISCONNECT; 
                     NUMBER_OF_SESSIONS = NUMBER_OF_SESSIONS - 1;
                   END; 
            END;
  END WAIT_FETCH_IRQ;
 /*                                                                 */ 
 /*                                                                 */ 
 /*  ****************************************************************/ 
 /*  *****************   WAIT FOR AVAILABLE REQUEST                 */
  CLI_WAIT: PROC;
     /*   WAIT FOR POSTED REQUEST                                   */ 
           CALL DBCHWAT(CLI_RETURN_CD, CONTEXT_PTR,
                                WAIT_SESSID, WAIT_TOKEN); 
           IF CLI_RETURN_CD = 0 THEN
            DO; 
              OUT_TEXT =
               ’WAIT ERROR, RETURN CODE = ’ || CLI_RETURN_CD ; 
              CALL ISRT_MSG; 
              OUT_TEXT =  DBCAREA.MSG_TEXT; 
              CALL END_TRANS;
            END;
           DBCAREA.I_SESS_ID = SESSID(TOKEN_INDEX) ; 
           DBCAREA.I_REQ_ID  = REQID(TOKEN_INDEX);
  END  CLI_WAIT;
   /*  ************************************************************/
   /*  *****************  FETCH PARCELS                           */
 CLI_FETCH_PARCELS: PROC; 
           DBCAREA.FUNC =  FETCH_FUNC ; 
           CALL DBCHCL(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF (CLI_RETURN_CD   = EOF_CODE) &
              (CLI_RETURN_CD    = BUSY_CODE) &
              (CLI_RETURN_CD    = CRASH_CODE) THEN
                 CALL DISPLAY_PARCEL; 
 END  CLI_FETCH_PARCELS; 
 /*  **************************************************************/
 /* ***********  INITIATE INSERT REQUEST                          */
 IRQ_CALL: PROC;
           DBCAREA.I_SESS_ID =  SESSID(TOKEN_INDEX); 
           DBCAREA.TOKEN     =  TOKEN_ARRAY.TOKEN(TOKEN_INDEX) ; 
           DBCAREA.FUNC      =  INITIATE_REQ_FUNC ; 
           CALL DBCHCL(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF CLI_RETURN_CD    = 0 THEN
            DO;
              LAST_FUNCTION(TOKEN_INDEX) = ’INSERT’; 
              REQID(TOKEN_INDEX) = DBCAREA.O_REQ_ID; 
              TDPREQID(TOKEN_INDEX) = DBCAREA.TDP_REQ_NO; 
              TRANS_COUNT = TRANS_COUNT + 1; 
              DATA_FOR_INS_UPD.DATA1 = DATA_FOR_INS_UPD.DATA1 + 5; 
              DATA_FOR_INS_UPD.DATA2 = DATA_FOR_INS_UPD.DATA2 + 5; 
              DATA_FOR_INS_UPD.DATA3 = DATA_FOR_INS_UPD.DATA3 + 5; 
              DATA_FOR_INS_UPD.DATA4 = DATA_FOR_INS_UPD.DATA4 + 5; 
              DATA_FOR_INS_UPD.DATA5 = DATA_FOR_INS_UPD.DATA5 + 5;
            END; 
           ELSE CALL DISP_ERROR;
 END  IRQ_CALL; 
 /*  **************************************************************/
 /*  *****************  TERMINATE REQUEST                     *****/
 CLI_END_REQUEST: PROC;
           DBCAREA.FUNC = END_REQUEST_FUNC; 
           CALL DBCHCL(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF CLI_RETURN_CD  = 0 THEN CALL DISP_ERROR;
 END  CLI_END_REQUEST; 
 /*   *************************************************************/
 /*   *****************  DISCONNECT SESSION                   *****/
 CLI_DISCONNECT: PROC;
           DBCAREA.FUNC = DISCONNECT_FUNC; 
           CALL DBCHCL(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF CLI_RETURN_CD = 0 THEN CALL DISP_ERROR;
 END  CLI_DISCONNECT; 
 /*  **************************************************************/
 /*   *****************  DISPLAY PARCEL                       *****/
 DISPLAY_PARCEL: PROC;
          IF DBCAREA.FET_PARCEL_FLAVOR = ERROR_TYPE THEN 
                   DO;
                    OUT_TEXT = ’ERROR PARCEL RECEIVED ’; 
                    CALL  ISRT_MSG; 
                    OUT_TEXT = SUBSTR(ERROR_MSG,1,ERROR_LEN); 
                    CALL END_TRANS;
                   END; 
          ELSE 
          IF DBCAREA.FET_PARCEL_FLAVOR = FAILURE_TYPE THEN
                   DO;
                    OUT_TEXT = ’FAILURE PARCEL RECEIVED ’; 
                    CALL  ISRT_MSG; 
                    OUT_TEXT = SUBSTR(FAILURE_MSG,1,FAILURE_LEN); 
                    CALL END_TRANS;
                   END;
 END  DISPLAY_PARCEL; 
 /*   ***********************************************************/ 
 /*   *****************  DISPLAY ERROR MESSAGE              *****/ 
 DISP_ERROR: PROC;
              OUT_TEXT = 
              ’FUNCTION = ’ || DBCAREA.FUNC || ’RETURN CODE = ’ ||
                         CLI_RETURN_CD; 
              CALL ISRT_MSG; 
              OUT_TEXT = DBCAREA.MSG_TEXT; 
              CALL  END_TRANS;
 END DISP_ERROR; 
 /*  ************************************************************/
 /*  *****************  INITIALIZE DBCAREA                  *****/
 DBC_INIT: PROC;
           CALL DBCHINI(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF CLI_RETURN_CD = 0 THEN
            DO;
               OUT_TEXT = ’CLI RETURN CODE AFTER INIT = ’ 
                    || CLI_RETURN_CD;
               CALL ISRT_MSG; 
               OUT_TEXT = DBCAREA.MSG_TEXT; 
               CALL  END_TRANS;
            END; 
 END  DBC_INIT; 
 /* *****************  CONNECT SESSION                      *****/ 
 CLI_CONNECT: PROC;
           TOKEN_INDEX =  LOGID; 
           DBCAREA.TOKEN = LOGID; 
           DBCAREA.FUNC  = CONNECT_FUNC; 
           CALL DBCHCL(CLI_RETURN_CD, CONTEXT_PTR, DBCAREA); 
           IF CLI_RETURN_CD = 0 THEN CALL DISP_ERROR; 
           TDPREQID(TOKEN_INDEX) = DBCAREA.TDP_REQ_NO; 
           NUMBER_OF_SESSIONS = NUMBER_OF_SESSIONS + 1;
   /*   SAVE TOKEN, SESSION ID, REQUEST ID, AND LAST_FUNCTION */ 
           TOKEN_ARRAY.TOKEN(TOKEN_INDEX) = LOGID; 
           SESSID(TOKEN_INDEX) = DBCAREA.O_SESS_ID; 
           REQID(TOKEN_INDEX)  = DBCAREA.O_REQ_ID; 
           LAST_FUNCTION(TOKEN_INDEX) = ’LOGON’;
 END  CLI_CONNECT; 
 /*   ***********************************************************/ 
 DBCAREA_SETUP: PROC; 
 /*   ***********************************************************/ 
 /*   *     SET UP DBCAREA CONSTANTS                            */ 
 /*   *                                                         */ 
 /*   ***********************************************************/ 
 /*   *** SET UP POINTER TO DBC/SQL STATEMENT.                  */
           DBCAREA.REQ_PTR= ADDR(MULTI_STMT_REQ);
 /*   *** SET UP LENGTH OF DBC/SQL STATEMENT.                   */
           DBCAREA.REQ_LEN = STG(MULTI_STMT_REQ); 
 /*   *** SET UP POINTER TO USING DATA                          */
           DBCAREA.USING_DATA_PTR =ADDR(DATA_FOR_INS_UPD);
 /*   *** SET UP LENGTH OF DATA FOR DBC/SQL STATEMENT.          */
           DBCAREA.USING_DATA_LEN = DATA_LEN;
 /*   *** SET UP POINTER TO PARCEL AREA (MOVE MODE)             */
 /*        CALL ’DBCHSAD’ USING CLI_RETURN_CD,                  */
 /*                             DBC_FET_DATA_PTR, PARCEL.       */
 /*   *** SET UP MAX SIZE FOR PARCEL (REQUIRED FOR MOVE MODE    */
 /*        MOVE RESPBUF_SIZE TO DBC_FET_I_MAX_DATA_LEN.         */
 /*   *** SET UP MAXIMUM NUMBER OF SESSIONS.                    */
           DBCAREA.MAX_NUM_SESS = NUMLOG;
 /*   ***********************************************************/
 /*   *                                                         */
 /*   *                 SET OPTION FLAGS                        */
 /*   ***********************************************************/
 /*   *  SET MOVE MODE OPTION FOR COBOL PROGRAMS.               */
 /*   *                                                         */
 /*   ***********************************************************/
 /*        MOVE ’N’ TO DBC_LOC_MODE.                            */
 /*   ***********************************************************/
 /*   * SET NO WAIT-FOR-RESPONSE OPTION.                        */
 /*   *        (TECHNIQUE USED BY THIS SAMPLE PROGRAM)          */
 /*   ***********************************************************/
           DBCAREA.WAIT_FOR_RESP = ’N’;
 /*   ***********************************************************/
 /*   * SET ’N’ FOR CRASH-WAIT OPTION.                          */
 /*   *     (TECHNIQUE USED BY THIS SAMPLE PROGRAM)             */
 /*   ***********************************************************/
           DBCAREA.WAIT_ACROSS_CRASH = ’N’;
 /*   ***********************************************************/
 /*   * SET ’Y’ FOR CRASH-TELL  OPTION.                         */
 /*   *        (TECHNIQUE USED BY THIS SAMPLE PROGRAM)          */
 /*   ***********************************************************/
           DBCAREA.TELL_ABOUT_CRASH = ’Y’;
 /*   ***********************************************************/
 /*   * SET ’Y’ TO TRIGGER CHANGED OPTIONS.                     */
 /*   *                                                         */
 /*   ***********************************************************/
           DBCAREA.CHANGE_OPTS = ’Y’; 
  END DBCAREA_SETUP;
 IMMEDIATE_IMS_RETURN: END CLI2MPI;