2PC COBOL Sample Using CLIv2 - IBM CICS Interface for Teradata

IBM CICS Interface for Teradata® Reference

Product
IBM CICS Interface for Teradata
Release Number
17.00
Published
June 2020
Language
English (United States)
Last Update
2020-06-19
dita:mapPath
xhj1544831946672.ditamap
dita:ditavalPath
obe1474387269547.ditaval
dita:id
B035-2448
Product Category
Teradata Tools and Utilities

The following CICS CLIv2 sample is written in COBOL. It uses 2PC processing.

        ID DIVISION.
        
        PROGRAM-ID. CCX05.
        
        ******************************************************************
        * TITLE:      SAMPLE PROGRAM IN COBOL FOR 2PC PROTOCOL           *
        *                                                                *
        * PROGRAM:    THIS SAMPLE PROGRAM SHOWS ONE POSSIBLE METHOD FOR  *
        *             CODING A COBOL APPLICATION THAT UTILIZES THE       *
        *             TWO PHASE COMMIT PROTOCOL FOR PERFORMING UPDATES.  *
        *                                                                *
        * TABLES:     EMPLOYEE TABLE SUPPLIED WITH SAMPLES.              *
        *                                                                *
        * CICS DEFS:  PPT FOR THE CLC2PC01 SAMPLE PROGRAM.               *
        *              DFHPPT TYPE=ENTRY,PROGRAM=CLC2PC01,PGMLANG=COBOL  *
        *             PCT FOR THE PPC2PC01 SAMPLE PROGRAM.               *
        *              DFHPCT TYPE=ENTRY,PROGRAM=CLC2PC01,TRANSID=SAM4,  *
        *                     TPURGE=NO,SPURGE=NO,TRNPRTY=255            *
        *                                                                *
        ******************************************************************
        *  MULTIPLE SESSIONS,USES MULTIPLE ACTIVE REQUESTS (ON 1 SESSION)*
        *                                                                *
        *  REQUEST THREAD 1: SELECT EMPLOYEE_NUMBER , LAST_NAME FROM     *
        *                    EMPLOYEE                                    *
        *  REQUEST THREAD 2: UPDATE EMPLOYEE SET HIRE_DATE = ’84/05/07’  *
        *                    WHERE EMPLOYEE_NUMBER = ?                   *
        *                                                                *
        *  FOR TWO PHASE COMMIT,  CONNECT WITH 2PC=’Y’                   *
        *  TO COMMIT WORK USE ’ISSUE-REQUEST-PROTOCOL’ FUNCTION ’T’’     *
        *     THIS WILL ’PIGGY-BACK’ A VOTE AND TERMINATE PARCEL TO THE  *
        *     APPLICATION REQUEST PARCEL.  THE ENTIRE UNIT OF WORK WILL  *
        *     BE COMMITTED OR ROLLED BACK.                               *
        *                                                                *
        *  ALTERNATIVE TO VOTE&TERMINATE IS CICS SYNCPOINT OR            *
        *  SYNCPOINT ROLLBACK.  THE SYNCPOINT TO COMMIT WORK MUST BE     *
        *  ISSUED BEFORE DISCONNECT. (DISCONNECT WILL ROLL BACK          *
        *  UNCOMMITTED UNITS OF WORK.)                                   *
        *                                                                *
        *----------------------------------------------------------------*
        
        ENVIRONMENT DIVISION.
        
        DATA DIVISION.
        
        WORKING-STORAGE SECTION.
        
        01  SESSION-INFO.
           05   FAILURES           PIC S9(9)  COMP VALUE  0.
           05   SESS-INDX          PIC S9(9)  COMP VALUE  0.
           05   REQT-INDX          PIC S9(9)  COMP VALUE  0.
           05   SESSION-DATA       OCCURS 5   TIMES.
           10   SESSION-NUM        PIC S9(9)  COMP.
           10   REQUEST-NUM        PIC S9(9)  COMP
                              OCCURS 15  TIMES.
        
        01  PGM-FAILURE             PIC X(3)     VALUE ’NO ’.
        01  LOGON-STRING            PIC X(35)    VALUE
                              VALUE         ’tdpid/userid,pswd’.
        
        01  QUERY-SOURCE.
           05  QUERY-STMT-LEN      PIC S9(4)    COMP.
           05  QUERY-STMT          PIC X(256)   VALUE SPACES.
        
        01  SELECT-STMT.
           05  FILLER              PIC X(25) VALUE
          ’SELECT EMPLOYEE_NUMBER   ’.
           05  FILLER              PIC X(25) VALUE
          ’, LAST_NAME (CHAR(12))   ’.
           05  FILLER              PIC X(25) VALUE
          ’FROM EMPLOYEE ORDER BY   ’.
           05  FILLER              PIC X(25) VALUE
          ’EMPLOYEE_NUMBER          ’.
        
        01  SELECT-STMT-LEN         PIC S9(4) VALUE +100 COMP.
        01  UPDATE-STMT.
           05  FILLER              PIC X(30) VALUE
          ’UPDATE EMPLOYEE SET HIRE_DATE=’ .
           05  UPDATE-HIRE-DATE    PIC X(12) VALUE ’’’84/05/07’’’ .
           05  FILLER              PIC X(25) VALUE
          ’ WHERE EMPLOYEE_NUMBER = ’.
           05  UPDATE-EMPLOYEE-NUM PIC 9999  .
           05  FILLER              PIC X(25) VALUE
          ’ ;                       ’.
        
        01  UPDATE-STMT-LEN         PIC S9(4) VALUE +90  COMP.
        
           COPY DBCAREAC.
        
           COPY CLIPARMC.
        
        01  FILLER                  REDEFINES PARCEL.
           05  EMPNO               PIC S9(9) COMP.
           05  NAME                PIC X(12).
        
        01  FUDGE.
           05   END-OF-BUFFER      PIC S9(9)  COMP VALUE 33.
           05   WS-2PC-FUNC        PIC X(1).
           05   CON-2PC-NONE       PIC X(1)   VALUE ’N’.
           05   CON-2PC-VOTE-TERM  PIC X(1)   VALUE ’T’.
           05   CON-2PC-VOTE       PIC X(1)   VALUE ’V’.
        
        01  MESSAGES.
           05   MSG                PIC X(80)  VALUE SPACES.
           05   MSG-1              PIC X(80)  VALUE SPACES.
           05   MSG-2              PIC X(80)  VALUE SPACES.
           05   MSG-3              PIC X(80)  VALUE SPACES.
           05   MSG-4              PIC X(80)  VALUE SPACES.
           05   MSG-5              PIC X(80)  VALUE SPACES.
           05   MSG-6              PIC X(80)  VALUE SPACES.
           05   MSG-FLAVOR.
           10   MSG-FLAVOR-A       PIC X(14)  VALUE ’PARCEL FLAVOR ’.
           10   MSG-FLAVOR-B       PIC +99,999 DISPLAY.
           10   FILLER             PIC X(9)   VALUE SPACES.
           10   MSG-FLAVOR-C       PIC X(20).
           10   FILLER             PIC X(30)  VALUE SPACES.
        
        *---------------------------------------------------------------*
        *  MAIN PROGRAM LOGIC                                           *
        *---------------------------------------------------------------*
        
        PROCEDURE DIVISION.
           MOVE 1 TO SESS-INDX.
           MOVE 1 TO REQT-INDX.
           PERFORM Z000-INITIALIZE-DBCAREA.
           IF PGM-FAILURE = ’YES’
         MOVE ’INTIALIZATION FAILURE - PROGRAM TERMINATING’ TO
              MSG
         PERFORM 0000-DISPLAY-80
         PERFORM 0000-GOBACK.
        
           PERFORM Z100-CONNECT-SESSION.
           IF PGM-FAILURE = ’YES’
         MOVE ’CONNECT FAILED - PROGRAM TERMINATING’ TO MSG
         PERFORM 0000-DISPLAY-80
         PERFORM Z900-TERMINATE-DBCAREA
         PERFORM 0000-GOBACK.
        
           MOVE ’  CONNECTED ’ TO MSG.
           PERFORM 0000-DISPLAY-80.
        
           MOVE    SELECT-STMT TO QUERY-STMT.
           MOVE    SELECT-STMT-LEN TO QUERY-STMT-LEN.
        
           PERFORM B000-ISSUE-REQUEST.
           IF PGM-FAILURE = ’YES’
         MOVE ’REQUEST FAILED - PROGRAM TERMINATING’ TO MSG
         PERFORM 0000-DISPLAY-80
         PERFORM Z200-DISCONNECT-SESSION
         PERFORM Z900-TERMINATE-DBCAREA
         PERFORM 0000-GOBACK.
        
           MOVE DBCAREA-O-REQ-ID TO DBCAREA-I-REQ-ID.
        
           PERFORM A900-FETCH-PRINT-UPDATE
              UNTIL CLI-RETURN-CD NOT = 0
                 OR PGM-FAILURE       = ’YES’.
        
           MOVE ’NO ’ TO PGM-FAILURE.
        
           MOVE 1 TO SESS-INDX.
           MOVE 1 TO REQT-INDX.
           PERFORM D000-END-REQUEST.
           IF PGM-FAILURE = ’YES’
         MOVE ’END REQUEST FAILED’ TO MSG
         PERFORM 0000-DISPLAY-80
         PERFORM Z200-DISCONNECT-SESSION
         PERFORM Z900-TERMINATE-DBCAREA
         PERFORM 0000-GOBACK.
        
           PERFORM Z200-DISCONNECT-SESSION.
           IF PGM-FAILURE = ’YES’
         MOVE ’CONNECT FAILED - PROGRAM TERMINATING’ TO MSG
         PERFORM 0000-DISPLAY-80
         PERFORM Z900-TERMINATE-DBCAREA
         PERFORM 0000-GOBACK.
        
           PERFORM Z900-TERMINATE-DBCAREA.
           IF PGM-FAILURE = ’YES’
         MOVE ’TERMINATION FAILURE’  TO MSG
         PERFORM 0000-DISPLAY-80 .
        
        PERFORM 0000-GOBACK.
        
        *----------------------------------------------------------------*
        *  SEND THE MESSAGE BUFFER                                       *
        *     ISOLATE THE CICS DISPLAY.  TO AID MOVING THE PROGRAM TO    *
        *     OTHER ENVIRONMENTS.
        *----------------------------------------------------------------*
        0000-DISPLAY-80       SECTION.
           EXEC CICS SEND FROM(MSG) LENGTH(80) END-EXEC.
        
        
        *----------------------------------------------------------------*
        *  ROLLBACK ANY UPDATES                                          *
        *----------------------------------------------------------------*
        0000-SYNCPOINT-ROLL   SECTION.
           EXEC CICS SYNCPOINT ROLLBACK END-EXEC.
        
        *----------------------------------------------------------------*
        *  COMMIT ANY UPDATES                                            *
        *----------------------------------------------------------------*
        0000-SYNCPOINT         SECTION.
           EXEC CICS SYNCPOINT END-EXEC.
        
        
        *----------------------------------------------------------------*
        *  0000-GOBACK                                                   *
        *    ISOLATES END OF TASK PROCESSING TO AID MOVING THE PROGRAM   *
        *     OTHER ENVIRONMENTS.
        *----------------------------------------------------------------*
        0000-GOBACK            SECTION.
           MOVE ’  END OF TRANSACTION ’ TO MSG.
         PERFORM 0000-DISPLAY-80.
        
           EXEC CICS RETURN END-EXEC.
        
        *----------------------------------------------------------------*
        *  FETCH AND PRINT A PARCEL                                      *
        *----------------------------------------------------------------*
        
        A900-FETCH-PRINT-UPDATE SECTION.
           MOVE 1               TO REQT-INDX.
           PERFORM C000-FETCH-RESPONSE.
        
           IF PGM-FAILURE = ’YES’
         GO TO A900-EXIT.
        
           PERFORM Y300-PRINT-PARCEL.
        
           IF DBCAREA-FET-PARCEL-FLAVOR = RECORD-TYPE THEN
         PERFORM A900-UPDATE.
        
           PERFORM A900-EXIT.
        
        A900-EXIT. EXIT.
        
        *----------------------------------------------------------------*
        *                                                                *
        *  MAKE A SINGLE ROW UPDATE, USING REQUEST THREAD 2              *
        *     ASSIGN THE HOST VARIABLES                                  *
        *     BUILD THE SQL STATEMENT                                    *
        *     ISSUE THE UPDATE REQUET                                    *
        *     RETRIEVE THE FEEDBACK PARCELS (SUCCESS/FAILURE)            *
        *     SET THE FAILURE PROFILE AS APPROPRIATE                     *
        *                                                                *
        *----------------------------------------------------------------*
        A900-UPDATE  SECTION.
           MOVE 2               TO REQT-INDX.
        
           MOVE EMPNO  TO UPDATE-EMPLOYEE-NUM.
        
           MOVE UPDATE-STMT     TO QUERY-STMT.
           MOVE UPDATE-STMT-LEN TO QUERY-STMT-LEN.
        
           MOVE QUERY-STMT TO MSG.
           PERFORM 0000-DISPLAY-80.
        
           PERFORM B000-ISSUE-REQUEST.
           IF DBCAREA-RETURN-CD = 0 THEN
         PERFORM C000-FETCH-RESPONSE
         PERFORM Y300-PRINT-PARCEL
         PERFORM D000-END-REQUEST.
           PERFORM A901-EXIT.
        A901-EXIT. EXIT.
        *----------------------------------------------------------------*
        *                                                                *
        *  ISSUE A REQUEST                                               *
        *                                                                *
        *  THIS INITIATE REQUEST DOES NOT USE A DATA PARCEL              *
        *                                                                *
        *  DURING REQUEST INITIATION THE FOLLOWING FIELDS MUST BE SET:   *
        *                                                                *
        *      DBCAREA-FUNC                                              *
        *      DBCAREA-I-SESS-ID                                         *
        *      DBCAREA-REQ-PTR                                           *
        *      DBCAREA-REQ-LEN                                           *
        *      DBCAREA-DATA-PTR                                          *
        *      DBCAREA-DATA-LEN                                          *
        *                                                                *
        *  REQUEST INITIATION RETURNS DBCAREA-O-REQ-ID                   *
        *                                                                *
        *----------------------------------------------------------------*
        
        B000-ISSUE-REQUEST SECTION.
        
           MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC.
        
           MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID.
           MOVE ZERO                   TO DBCAREA-I-REQ-ID.
        
           CALL ’DBCHSAD’ USING CLI-RETURN-CD,
                           DBCAREA-REQ-PTR,
                           QUERY-STMT .
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO B000-EXIT.
        
           MOVE QUERY-STMT-LEN TO DBCAREA-REQ-LEN.
        
        *    IDENTIFY A NULL DATA PARCEL
        
           MOVE 0 TO DBCAREA-USING-DATA-LEN,
                DBCAREA-USING-DATA-PTR.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO B000-EXIT.
        
           MOVE DBCAREA-O-REQ-ID TO REQUEST-NUM(SESS-INDX, REQT-INDX).
        
        B000-EXIT. EXIT.
        
        
        *----------------------------------------------------------------*
        *                                                                *
        *  ISSUE A REQUEST WITH PROTOCOL FUNCTION PIGGY BACK             *
        *                                                                *
        *  THIS INITIATE REQUEST DOES NOT USE A DATA PARCEL              *
        *                                                                *
        *  DURING REQUEST INITIATION THE FOLLOWING FIELDS MUST BE SET:   *
        *                                                                *
        *      DBCAREA-FUNC                                              *
        *      DBCAREA-I-SESS-ID                                         *
        *      DBCAREA-REQ-PTR                                           *
        *      DBCAREA-REQ-LEN                                           *
        *      DBCAREA-DATA-PTR                                          *
        *      DBCAREA-DATA-LEN                                          *
        *                                                                *
        *  REQUEST INITIATION RETURNS DBCAREA-O-REQ-ID                   *
        *                                                                *
        *----------------------------------------------------------------*
        
        B000-ISSUE-REQUEST-PROTOCOL SECTION.
        
           MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC.
        
           MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID.
           MOVE ZERO                   TO DBCAREA-I-REQ-ID.
        
        
           CALL ’DBCHSAD’ USING CLI-RETURN-CD,
                           DBCAREA-REQ-PTR,
                           SELECT-STMT.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO B000-EXIT.
        
           MOVE SELECT-STMT-LEN TO DBCAREA-REQ-LEN.
        
        *    IDENTIFY A NULL DATA PARCEL
        
           MOVE 0 TO DBCAREA-USING-DATA-LEN,
                DBCAREA-USING-DATA-PTR.
        
           MOVE INIT-WITH-2PC-FUNC TO DBCAREA-FUNC.
           MOVE WS-2PC-FUNC        TO DBCAREA-IWPF-FUNCTION.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO B000-EXIT.
        
           MOVE DBCAREA-O-REQ-ID TO REQUEST-NUM(SESS-INDX, REQT-INDX).
           GO TO B000-EXIT.
        
        
        *----------------------------------------------------------------*
        *                                                                *
        *  RETURN ONE PARCEL AT A TIME FROM THE RESPONSE BUFFER          *
        *                                                                *
        *  DURING FETCH THE FOLLOWING DBCAREA FIELDS MUST BE SET:        *
        *                                                                *
        *       DBCAREA-FUNC                                             *
        *       DBCAREA-I-SESS-ID                                        *
        *       DBCAREA-I-REQ-ID                                         *
        *       DBCAREA-FET-MAX-DATA-LEN                                 *
        *       DBCAREA-FET-DATA-PTR                                     *
        *                                                                *
        *  NOTES 1) FET-DATA-PTR REPRESENTS THE LOCATION OF THE WORKING  *
        *           STORAGE AREA TO RECEIVE THE RESPONSE PARCEL          *
        *                                                                *
        *        2) FET-MAX-DATA-LEN IS THE LENGTH OF THE WORKING        *
        *           STORAGE AREA TO RECEIVE THE RESPONSE PARCEL.         *
        *                                                                *
        *----------------------------------------------------------------*
        
        C000-FETCH-RESPONSE SECTION.
        
        
           MOVE FETCH-FUNC TO DBCAREA-FUNC.
           MOVE SPACES TO PARCEL.
           MOVE SESSION-NUM(SESS-INDX)            TO DBCAREA-I-SESS-ID.
           MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-I-REQ-ID.
           MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-O-REQ-ID.
        
        
           CALL ’DBCHSAD’ USING CLI-RETURN-CD,
                           DBCAREA-FET-DATA-PTR,
                           PARCEL.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO C000-EXIT.
        
           MOVE +4096 TO DBCAREA-FET-MAX-DATA-LEN.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO C000-EXIT.
        
        C000-EXIT. EXIT.
        
        
        *----------------------------------------------------------------*
        *                                                                *
        *  END THE REQUEST TO PREMIT REUSE OF THE RESPONSE BUFFERS       *
        *                                                                *
        *  PRIOR TO CALLING THIS ROUTINE, THE FOLLOWING FIELDS MUST BE   *
        *  SET:                                                          *
        *                                                                *
        *      DBCAREA-I-SESS-ID                                         *
        *      DBCAREA-I-REQ-ID                                          *
        *                                                                *
        *  NOTE: END REQUEST HAS NO EFFECT UPON ACTIVE TRANSACTIONS.     *
        *        IT WILL DISCARD ANY SPOOL SPACE RESERVED ON THE DBC     *
        *        FOR THIS RESPONSE.                                      *
        *                                                                *
        *----------------------------------------------------------------*
        
        D000-END-REQUEST SECTION.
        
           MOVE END-REQUEST-FUNC TO DBCAREA-FUNC.
           MOVE SESSION-NUM(SESS-INDX)            TO DBCAREA-I-SESS-ID.
           MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-I-REQ-ID.
           MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-O-REQ-ID.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO D000-EXIT.
        
           PERFORM 0000-DISPLAY-80.
        
        D000-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *  CLI RETURN CODE ERROR PROCESSING                             *
        *---------------------------------------------------------------*
        
        Y000-ERROR SECTION.
        
           MOVE ’YES’ TO PGM-FAILURE.
           MOVE  DBCAREA-MSG-TEXT TO MSG.
           PERFORM 0000-DISPLAY-80 .
        
        Y000-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *  PRINT A PARCEL                                               *
        *---------------------------------------------------------------*
        
        Y300-PRINT-PARCEL SECTION.
        
           MOVE ’FLAVOR - ’ TO MSG-FLAVOR-A.
           MOVE DBCAREA-FET-PARCEL-FLAVOR TO MSG-FLAVOR-B
        
           IF DBCAREA-FET-PARCEL-FLAVOR = SUCCESS-TYPE
         MOVE ’SUCCESS PARCEL’ TO MSG-FLAVOR-C.
        
           IF DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE
         ADD 1 TO FAILURES GIVING FAILURES
         MOVE ’FAILURE’ TO MSG-FLAVOR-C.
        
           IF DBCAREA-FET-PARCEL-FLAVOR = ERROR-TYPE
         MOVE ’ERROR’   TO MSG-FLAVOR-C.
        
           IF DBCAREA-FET-PARCEL-FLAVOR = RECORD-TYPE
         MOVE   ’RECORD FLAVOR’ TO MSG-FLAVOR-A
         MOVE   EMPNO   TO MSG-FLAVOR-B
         MOVE   NAME    TO MSG-FLAVOR-C
        
           IF DBCAREA-FET-PARCEL-FLAVOR = END-STATEMENT-TYPE
         MOVE ’END STATEMENT’ TO MSG-FLAVOR-C.
        
           IF DBCAREA-FET-PARCEL-FLAVOR = END-REQUEST-TYPE
         MOVE ’END REQUEST’ TO MSG-FLAVOR-C.
        
           MOVE MSG-FLAVOR TO MSG.
           PERFORM 0000-DISPLAY-80 .
        Y300-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *  INITIALIZE DBCAREA                                           *
        *---------------------------------------------------------------*
        
        Z000-INITIALIZE-DBCAREA SECTION.
        
           CALL ’DBCHINI’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD        NOT = ZERO
         PERFORM Y000-ERROR
         GO TO Z000-EXIT.
        
           MOVE +512   TO DBCAREA-REQ-BUF-LEN.
           MOVE +32767 TO DBCAREA-RESP-BUF-LEN.
           MOVE +1     TO DBCAREA-MAX-NUM-SESS.
           MOVE ’Y’    TO DBCAREA-CHANGE-OPTS.
           MOVE ’R’    TO DBCAREA-RESP-MODE.
           MOVE ’N’    TO DBCAREA-USE-PRESENCE-BITS.
           MOVE ’N’    TO DBCAREA-KEEP-RESP.
           MOVE ’N’    TO DBCAREA-WAIT-ACROSS-CRASH.
           MOVE ’Y’    TO DBCAREA-TELL-ABOUT-CRASH.
           MOVE ’Y’    TO DBCAREA-GIVE-MSG.
           MOVE ’N’    TO DBCAREA-LOC-MODE.
           MOVE ’N’    TO DBCAREA-VAR-LEN-REQ.
           MOVE ’N’    TO DBCAREA-VAR-LEN-FETCH.
           MOVE ’Y’    TO DBCAREA-SAVE-RESP-BUF.
           MOVE ’Y’    TO DBCAREA-TWO-RESP-BUFS.
           MOVE ’N’    TO DBCAREA-RET-TIME.
           MOVE ’Y’    TO DBCAREA-PARCEL-MODE.
           MOVE ’Y’    TO DBCAREA-WAIT-FOR-RESP.
           MOVE ’E’    TO DBCAREA-REQ-PROC-OPT.
           MOVE ’N’    TO DBCAREA-MSG-SECURITY.
        
        Z000-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *                                                               *
        *  CONNECT A SESSION                                            *
        *                                                               *
        *  THIS ROUTINE CREATES DBCAREA-0-SESS-ID AND MOVES THAT        *
        *  NUMBER TO DBCAREA-I-SESS-ID                                  *
        *                                                               *
        *  THIS IS AN EXAMPLE OF TWO PHASE CONNECT WITH WAIT FOR        *
        *  RESPONSE SET TO YES                                          *
        *                                                               *
        *---------------------------------------------------------------*
        
        Z100-CONNECT-SESSION SECTION.
        
           MOVE CONNECT-FUNC TO DBCAREA-FUNC.
           MOVE ZERO         TO DBCAREA-RUN-PTR
                           DBCAREA-RUN-LEN.
           MOVE ’C’          TO DBCAREA-CONNECT-TYPE.
           MOVE ’Y’          TO DBCAREA-TWO-PHASE-COMMIT.
        
           CALL ’DBCHSAD’ USING CLI-RETURN-CD,
                           DBCAREA-LOGON-PTR,
                           LOGON-STRING.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO Z100-EXIT.
        
           MOVE +35          TO DBCAREA-LOGON-LEN.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO Z100-EXIT.
        
        * A CONNECTION REQUEST GENERATES A SESSION ID AND A REQUEST ID. *
        * THIS IS DUE TO THE CONNECT (LOGON) BEGIN A REQUEST FOR DBC    *
        * SERVICES.                                                     *
        *                                                               *
        * TO COMPLETE THE CONNECT REQUEST, A FETCH REQUEST MUST FOLLOW  *
        * THE CONNECT REQUEST.                                          *
        *                                                               *
        * THE FETCH WILL RETURN A SUCCESS PARCEL IF THE CONNECT IS      *
        * COMPLETE.                                                     *
        *                                                               *
        
           MOVE FETCH-FUNC        TO DBCAREA-FUNC.
           MOVE DBCAREA-O-SESS-ID TO DBCAREA-I-SESS-ID.
           MOVE DBCAREA-O-REQ-ID  TO DBCAREA-I-REQ-ID.
        
           MOVE +4096             TO DBCAREA-FET-MAX-DATA-LEN.
           MOVE SPACES            TO PARCEL.
        
           CALL ’DBCHSAD’ USING CLI-RETURN-CD,
                           DBCAREA-FET-DATA-PTR,
                           PARCEL.
        
           IF CLI-RETURN-CD NOT = ZERO
         MOVE ’YES’ TO PGM-FAILURE
         GO TO Z100-EXIT.
        
           CALL ’DBCHCL’  USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD = END-OF-BUFFER
         GO TO Z100-EXIT.
        
           IF CLI-RETURN-CD = 0
         AND DBCAREA-FET-PARCEL-FLAVOR = SUCCESS-TYPE
             MOVE    ’CONNECT SESS -’   TO MSG-FLAVOR-A
             MOVE    DBCAREA-O-SESS-ID  TO MSG-FLAVOR-B
             MOVE    DBCAREA-O-SESS-ID  TO
                     SESSION-NUM( SESS-INDX )
             MOVE MSG-FLAVOR TO MSG
             PERFORM 0000-DISPLAY-80
             GO TO Z100-EXIT.
        
           MOVE   ’CONNECT FAILED’ TO MSG-FLAVOR-A.
           MOVE    ZERO TO MSG-FLAVOR-B.
           MOVE MSG-FLAVOR TO MSG.
           PERFORM 0000-DISPLAY-80.
        
           IF CLI-RETURN-CD = 0
         MOVE ’YES’ TO PGM-FAILURE
         PERFORM Y300-PRINT-PARCEL
         GO TO Z100-EXIT.
        
           PERFORM Y000-ERROR.
        
        Z100-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *                                                               *
        *  DISCONNECT A SESSION                                         *
        *                                                               *
        *  PRIOR TO CALLING THIS ROUTINE, DBCAREA-I-SESS-ID MUST BE     *
        *  ESTABLISHED.                                                 *
        *                                                               *
        *  FOR 2PC APPLICATIONS,  SYNCPOINT OR VOTE&TERMINATE WILL      *
        *  COMMIT UPDATES.  WITHOUT SP/VT, CHANGES WILL ROLL.           *
        *                                                               *
        *  NOTE: THE DISCONNECT WILL CAUSE TRANSACTION FAILURE FOR ANY  *
        *        ACTIVE TRANSACTIONS AND/OR REQUESTS.  ANY RESPONSES    *
        *        STILL ON THE DBC FOR THIS SESSION WILL BE DISCARDED.   *
        *                                                               *
        *---------------------------------------------------------------*
        
        Z200-DISCONNECT-SESSION SECTION.
        
           IF FAILURES = 0 THEN
         PERFORM 0000-SYNCPOINT.
           IF FAILURES > 0 THEN
         PERFORM 0000-SYNCPOINT-ROLL.
        
           MOVE DISCONNECT-FUNC        TO DBCAREA-FUNC.
           MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID.
        
           CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO Z200-EXIT.
        
        Z200-EXIT. EXIT.
        
        *---------------------------------------------------------------*
        *                                                               *
        *  RELEASE ACQUIRED STORAGE                                     *
        *                                                               *
        *  NOTE: TERMINATION WILL CAUSE TRANSACTION FAILURE FOR ANY     *
        *        ACTIVE TRANSACTIONS AND/OR REQUESTS FOR ANY OPEN       *
        *        SESSIONS.  ALL RESPONSES HELD ON THE DBC BY THIS       *
        *        PROGRAM WILL BE DISCARDED.                             *
        *                                                               *
        *---------------------------------------------------------------*
        
        Z900-TERMINATE-DBCAREA SECTION.
        
           CALL ’DBCHCLN’ USING CLI-RETURN-CD, CONTEXT-PTR.
        
           IF CLI-RETURN-CD NOT = ZERO
         PERFORM Y000-ERROR
         GO TO Z900-EXIT.
        
        Z900-EXIT. EXIT.