17.00 - CLI2CTB 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. CLI2CTB 
       AUTHOR. J  LAHOOD. 
       INSTALLATION. TDAT. 
       REMARKS. THIS PROGRAM PROVIDES AN EXAMPLE OF HOW A CLI2
      * PROGRAM CAN CALL ANOTHER PROGRAM TO PERFORM SUB FUNCTIONS. 
      * THIS PROGRAM IS CALLED BY THE FOLLOWING SAMPLE PROGRAMS: 
      * 
      * 
      *   CLI2MCB (MULTI-SESSION/COBOL/BATCH) 
      *   CLI2MCI (MULTI-SESSION/COBOL/IMS) 
      *   CLI2MPB (MULTI-SESSION/PLI/BATCH) 
      *   CLI2MPI (MULTI-SESSION/PLI/IMS) 
      * 
      *  -- TO DROP THEN CREATE THE TABLE “MYTABLE2". 
      * 
      * THE “DBCAREA” USED BY THE THIS PROGRAM IS LOCATED 
      * IN THE WORKING STORAGE(COBOL) OR STATIC STORAGE (PL/I) 
      * OF THE CALLING PROGRAM. THIS PROGRAM DEFINES THE 
      * DBCAREA IN ITS LINKAGE SECTION. 
      * 
      * 
      * THE CONNECT FUNCTION IS PERFORMED BY THE CALLING PROGRAM. 
      *
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. IBM-370. 
       OBJECT-COMPUTER. IBM-370. 
       INPUT-OUTPUT SECTION. 
       DATA DIVISION. 
       WORKING-STORAGE SECTION.
      ************************************************************ 
      * DATA DEFINITIONS                                         * 
      *                                                          *
      ************************************************************
      *  CONSTANTS.
      *                 CURRENT NUMBER OF SESSIONS. 
       77  NUMBER-OF-SESSIONS  PIC 9999 VALUE IS 0  COMP.
      *            MAXIMUM RESPONSE BUFFER SIZE FOR FETCHING
      *            (MUST BE SPECIFIED WHEN IN MOVE MODE).
       77  RESPBUF-SIZE PIC S9(9) COMP VALUE IS +4096.
      *            DBC/SQL REQUEST TO BE EXECUTED. 
       77  REQUEST-BUF  PIC X(60) VALUE IS SPACES.
      *            LENGTH OF DBC/SQL REQUEST. 
       77  REQ-LEN      PIC 9(9)  VALUE IS 60            COMP.
      *            LENGTH OF VARIABLE LENGTH MESSAGES (OCCURS BY) 
       77  TEXT-LEN     PIC 9999 COMP VALUE IS 0.
      *            CLI RETURN CODES
       77  EOF-CODE     PIC S9(9)  VALUE +33             COMP.
       77  CRASH-CODE   PIC S9(9)  VALUE +286            COMP.
      *            LAST REQUEST IRQ’D 
       77  LAST-REQUEST   PIC X(6) VALUE IS SPACES.
********************************************************************
       01  DBC-SQL-REQUESTS.
           05  FILLER PIC X(6) VALUE ’DROP’. 
           05  FILLER PIC X(60) VALUE
               ’DROP TABLE MYTABLE2;’.
           05  FILLER PIC X(6) VALUE ’CT’. 
           05  FILLER PIC X(60) VALUE
               ’CT MYTABLE2,NO FALLBACK (F1 INTEGER,F2 INTEGER);’.
           05  FILLER PIC X(6) VALUE ’ENDREQ’. 
           05  FILLER PIC X(60) VALUE ’DUMMY’.
       01  DBC-SQL-TEST-DRIVER    REDEFINES DBC-SQL-REQUESTS. 
           05  DBC-SQL-REQUEST OCCURS 3 TIMES INDEXED BY REQUEST-INDEX. 
               10 REQUEST-TYPE  PIC X(6). 
               10 REQUEST  PIC X(60).
********************************************************************
      *    CLI REQUIRED PARAMETERS
       01  CLI-RETURN-CODE         PIC S9(9) VALUE +0   COMP.
       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.
      *    FAILURE OR ERROR PARCEL
       01  FAIL-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).
       01  VARMSG.
            10 VTEXT  OCCURS 1 TO 256 TIMES DEPENDING ON TEXT-LEN.
                  15 TEXT-DUM PIC X.
       LINKAGE SECTION. 
       01  DBCAREA.
           COPY DBCALS.
       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).
       PROCEDURE DIVISION USING DBCAREA, MSG-INFO.
       BEGIN.
           PERFORM DBCAREA-SETUP. 
           PERFORM CLI-CONNECT. 
           SET REQUEST-INDEX TO 1. 
           MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF. 
           PERFORM FETCH-THEN-IRQ UNTIL NUMBER-OF-SESSIONS = ZERO. 
           GOBACK.
      ************************************************************ 
      *                 PERFORMED PARAGRAPHS.                    *
      ************************************************************
      *********  FETCH PARCELS FOR PREVIOUS IRQ OR CONNECT    **** 
      *********  IF EOF, INITIATE INSERT REQUEST        **********
       FETCH-THEN-IRQ.
           PERFORM CLI-FETCH-PARCELS UNTIL CLI-RETURN-CODE = EOF-CODE 
                                     OR  CLI-RETURN-CODE = CRASH-CODE.
           IF CLI-RETURN-CODE = EOF-CODE THEN 
              PERFORM CLI-END-REQUEST 
              IF REQUEST-TYPE(REQUEST-INDEX) = ’ENDREQ’
                 PERFORM CLI-DISCONNECT 
              ELSE
                 PERFORM CLI-IRQ 
                 PERFORM ADVANCE-TO-NEXT-REQUEST
           ELSE PERFORM DISP-ERROR.
      ************************************************************
      *****************  ADVANCE TO NEXT REQUEST        **********
       ADVANCE-TO-NEXT-REQUEST. 
           SET REQUEST-INDEX UP BY 1 
           MOVE REQUEST(REQUEST-INDEX) TO REQUEST-BUF.
      ************************************************************
      *****************  FETCH PARCELS                  **********
       CLI-FETCH-PARCELS. 
           MOVE FETCH-FUNC TO DBCAREA-FUNC. 
           CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. 
           IF CLI-RETURN-CODE  NOT = EOF-CODE
                 PERFORM DISPLAY-PARCEL.
      ************************************************************
      *****************  INITIATE INSERT REQUEST        **********
       CLI-IRQ.
           MOVE REQUEST-TYPE(REQUEST-INDEX) TO LAST-REQUEST. 
           MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC. 
           CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. 
           IF CLI-RETURN-CODE  = ZERO
                 MOVE DBCAREA-O-REQ-ID  TO DBCAREA-I-REQ-ID 
           ELSE PERFORM DISP-ERROR.
      ************************************************************
      *****************  TERMINATE REQUEST              **********
       CLI-END-REQUEST.
           MOVE END-REQUEST-FUNC TO DBCAREA-FUNC. 
           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. 
           CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. 
           IF CLI-RETURN-CODE NOT = 0
                 PERFORM DISP-ERROR. 
           SUBTRACT 1 FROM NUMBER-OF-SESSIONS.
      ************************************************************
      *****************  DISPLAY PARCEL                 **********
       DISPLAY-PARCEL.
           IF (DBCAREA-FET-PARCEL-FLAVOR = ERROR-TYPE OR 
                       DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE) 
                       AND LAST-REQUEST NOT = ’DROP’
              MOVE ERROR-LEN TO MSG-INFO-LEN 
              MOVE ERROR-MSG TO MSG-INFO-TEXT 
              GOBACK.
      ************************************************************
      *****************  DISPLAY ERROR MESSAGE          **********
       DISP-ERROR.
               MOVE CLI-RETURN-CODE TO MSG-INFO-RC. 
               IF DBCAREA-MSG-LEN GREATER ZERO
               MOVE DBCAREA-MSG-TEXT TO MSG-INFO-CLI-MSG. 
            GOBACK.
      ************************************************************
      *****************  CONNECT SESSION                **********
       CLI-CONNECT.
           MOVE CONNECT-FUNC TO DBCAREA-FUNC. 
           CALL ’DBCHCL’ USING CLI-RETURN-CODE, CONTEXT-PTR, DBCAREA. 
           IF CLI-RETURN-CODE NOT = 0
              PERFORM DISP-ERROR.
           MOVE DBCAREA-O-SESS-ID TO DBCAREA-I-SESS-ID. 
           MOVE DBCAREA-O-REQ-ID  TO DBCAREA-I-REQ-ID. 
           ADD +1 TO NUMBER-OF-SESSIONS.
      ************************************************************
       DBCAREA-SETUP.
      ************************************************************ 
      *     SET UP DBCHSAD CALLS (STORE ADDRESSES IN DBCAREA)    * 
      *     AND OTHER DBCAREA CONSTANTS.                         * 
      ************************************************************
      ****** SET UP POINTER TO TERADATA SQL STATEMENT.
           CALL ’DBCHSAD’ USING CLI-RETURN-CODE, 
                                DBCAREA-SQL-PTR, REQUEST-BUF.
      ****** SET UP LENGTH OF TERADATA SQL STATEMENT.
           MOVE REQ-LEN TO DBCAREA-SQL-LEN.
      ****** SET UP POINTER TO PARCEL AREA (MOVE MODE)
           CALL ’DBCHSAD’ USING CLI-RETURN-CODE, 
                                DBCAREA-FET-DATA-PTR, PARCEL.
      ******* SET UP MAX SIZE FOR PARCEL (REQUIRED FOR MOVE MODE)
           MOVE RESPBUF-SIZE TO DBCAREA-FET-I-MAX-DATA-LEN. 
      ************************************************************ 
      *  SET MOVE-MODE OPTION FOR COBOL PROGRAMS,                * 
      *    I.E. “NO” LOCATE MODE .                               *
      ************************************************************
           MOVE ’N’ TO DBCAREA-LOC-MODE.
      ************************************************************ 
      * SET ’Y’ FOR WAIT-ACROSS-CRASH OPTION.                    * 
      *     (TECHNIQUE USED BY THIS SAMPLE PROGRAM)              * 
      ************************************************************
           MOVE ’Y’ TO DBCAREA-WAIT-ACROSS-CRASH.
      ************************************************************ 
      * SET ’N’ FOR TELL-ABOUT-CRASH OPTION.                     * 
      *     (TECHNIQUE USED BY THIS SAMPLE PROGRAM)              * 
      ************************************************************
           MOVE ’N’ TO DBCAREA-TELL-ABOUT-CRASH.
      ************************************************************ 
      * SET ’Y’ TO TRIGGER CHANGED OPTIONS.                      * 
      *                                                          * 
      ************************************************************
           MOVE ’Y’ TO DBCAREA-CHANGE-OPTS.
           MOVE ZERO TO MSG-INFO-RC. 
           MOVE ZERO TO MSG-INFO-LEN. 
           MOVE SPACES TO MSG-INFO-CLI-MSG. 
           MOVE SPACES TO MSG-INFO-TEXT.
      * END OF SOURCE CODE.