16.20 - 2PC COBOL Sample Using Preprocessor2 - IBM CICS Interface for Teradata

IBM CICS Interface for Teradata® Reference

prodname
IBM CICS Interface for Teradata
vrm_release
16.20
created_date
October 2018
category
Programming Reference
featnum
B035-2448-106K

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

        
        ****************************************************************
        * 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 TO EITHER A TERADATA DBS BY ITSELF OR    *
        *             TO OTHER ADDITIONAL DBMS SYSTEMS IN THE SAME     *
        *             LUW.                                             *
        *                                                              *
        * TABLES:     EMPLOYEE TABLE SUPPLIED WITH SAMPLES.            *
        *                                                              *
        * CICS DEFS:  PPT FOR THE PPC2PC01 SAMPLE PROGRAM.             *
        *              DFHPPT TYPE=ENTRY,PROGRAM=PPC2PC01,PGMLANG=COBOL*
        *             PCT FOR THE PPC2PC01 SAMPLE PROGRAM.             *
        *              DFHPCT TYPE=ENTRY,PROGRAM=PPC2PC01,TRANSID=SAM1,*
        *                     TPURGE=NO,SPURGE=NO,TRNPRTY=255          *
        *                                                              *     
        ****************************************************************
        IDENTIFICATION DIVISION.
        PROGRAM-ID. PPC2PC01.
        AUTHOR. TERADATA STV.
        
        ENVIRONMENT DIVISION.
        
        DATA DIVISION.
        ***************************************************************
        WORKING-STORAGE SECTION.
        ***************************************************************
        
        01  LOGON-STRING.
            49 FILLER         PIC S9(4) COMP VALUE +80.
            49 FILLER         PIC X(80)      VALUE ’tdpid/userid,pswd’.
        
        
        01  UPD-STATEMENT.
            49 STMT-LEN       PIC S9(4) COMP VALUE +72.
            49 FILLER         PIC X(44)
                    VALUE ’UPDATE EMPLOYEE SET SALARY_AMOUNT = 2010210 ’.
            49 FILLER         PIC X(28)
                    VALUE ’WHERE EMPLOYEE_NUMBER = 1021’.
        
        01  MYSQLDA.
            05 SQLDAID              PIC X(8).
            05 SQLDABC              PIC S9(9) COMP.
            05 SQLN                 PIC S9(4) COMP VALUE +9.
            05 SQLD                 PIC S9(4) COMP.
            05 SQLVAR OCCURS 9 TIMES.
               10 SQLTYPE           PIC S9(4) COMP.
               10 SQLLEN            PIC S9(4) COMP.
               10 SQLDATA           PIC X(4).
               10 SQLIND            PIC X(4).
               10 SQLNAME           PIC X(32).
        
         01  SCREEN-MESSAGE.
             05 SCREEN-MSG     PIC  X(70).
        
         01  ERROR-MSG.
             49 FILLER         PIC S9(4) COMP.
             49 ERROR-TXT      PIC X(255).
        
         01  ERROR-CODE        PIC S9(9) COMP.
         01  MAX-LENGTH        PIC S9(4) COMP VALUE +255.
         01  OUT-CODE          PIC -(15)9.
        
         01  REQUEST-TYPE      PIC X(8).
        
             EXEC SQL INCLUDE SQLCA END-EXEC.
        
        ***************************************************************
         PROCEDURE DIVISION.
        ***************************************************************
         000-MAIN SECTION.
        
             MOVE ’EXECUTING 2PC COBOL SAMPLE PROGRAM...’ TO SCREEN-MSG.
             PERFORM 800-SEND-MSG.
        
             PERFORM 100-LOGON.
             PERFORM 200-UPDATE.
             PERFORM 810-COMMIT-SYNCPOINT.
             PERFORM 900-LOGOFF.
        
             EXEC CICS RETURN END-EXEC.
             GOBACK.
        
        ***************************************************************
         100-LOGON SECTION.
        ***************************************************************
        
             MOVE ’LOGON’ TO REQUEST-TYPE.
        
             EXEC SQL
                      LOGON :LOGON-STRING
             END-EXEC.
        
             PERFORM 820-ERROR-CHECK.
        
             IF (SQLCODE = 0)
                  NEXT SENTENCE
             ELSE
                  MOVE ’ERROR IN LOGON...’ TO SCREEN-MSG
                  PERFORM 800-SEND-MSG.
        
         100-LOGON-EXIT.
             EXIT.
        
              
        ***************************************************************
         200-UPDATE SECTION.
        ***************************************************************
        
             MOVE ’STARTING TO UPDATE...’ TO SCREEN-MSG.
             PERFORM 800-SEND-MSG.
        
             MOVE ’UPDATE’ TO REQUEST-TYPE.
        
             PERFORM 210-UPDATE-OTHER-DBMS.
        
             MOVE ’BEGIN TO EXECUTE IMMEDIATE UPDATE’
                   TO SCREEN-MSG.
             PERFORM 800-SEND-MSG.
             EXEC SQL
                       EXECUTE IMMEDIATE :UPD-STATEMENT
             END-EXEC.
        
             PERFORM 820-ERROR-CHECK.
        
             IF  (SQLCODE = 0)
             THEN
                 MOVE ’EMPLOYEE UPDATED...’ TO SCREEN-MSG
                 PERFORM 800-SEND-MSG.
        
         200-UPDATE-EXIT.
             EXIT.
        
        ***************************************************************
        *    UPDATE-OTHER-DBMS
        *     - ADD CODE TO UPDATE OTHER DBMS SUCH AS VSAM, DLI, ETC.
        ***************************************************************
         210-UPDATE-OTHER-DBMS SECTION.
        
             MOVE ’UPDATE2’ TO REQUEST-TYPE.
        
             MOVE ’ADD CODE FOR UPDATING OTHER DBMS...’ TO SCREEN-MSG
             PERFORM 800-SEND-MSG.
        
         210-UPDATE-OTHER-DBMS-EXIT.
             EXIT.
        
        ***************************************************************
        *     LOGOFF
        *     PGM MUST TAKE A SYNCPOINT BEFORE LOGOFF DBC
        ***************************************************************
         900-LOGOFF SECTION.
             MOVE ’LOGOFF’ TO REQUEST-TYPE.
             MOVE ’UPDATE COMPLETED, LOGGING OFF SYSTEM...’ TO
                   SCREEN-MSG.
             PERFORM 800-SEND-MSG.
        
             EXEC SQL
                      LOGOFF
             END-EXEC.
        
             PERFORM 820-ERROR-CHECK.
        
         900-LOGOFF-EXIT.
             EXIT.
        
        
        ***************************************************************
        *     SEND MSG TO CICS
        ***************************************************************
         800-SEND-MSG SECTION.
        
             EXEC CICS
                 SEND TEXT FROM(SCREEN-MESSAGE)
                      LENGTH(70) FREEKB ERASE
             END-EXEC.
        
         800-SEND-MSG-EXIT.
             EXIT.
        
        ***************************************************************
        *     COMMIT LOGIC
        ***************************************************************
         810-COMMIT-SYNCPOINT SECTION.
        
             MOVE ’AT THE COMMIT LOGIC...’ TO SCREEN-MSG.
             PERFORM 800-SEND-MSG.
        
             EXEC CICS SYNCPOINT
             END-EXEC.
        
         810-COMMIT-SYNCPOINT-EXIT.
             EXIT.
        
        ***************************************************************
        *     ERROR CHECK
        ***************************************************************
         820-ERROR-CHECK SECTION.
        
             IF (SQLCODE NOT = 0)
                 THEN
                      MOVE SPACES TO ERROR-TXT
                      CALL ’PPRTEXT’ USING SQL-RDTRTCON,
                                           ERROR-CODE,
                                           ERROR-MSG,
                                           MAX-LENGTH
                      MOVE ERROR-MSG TO SCREEN-MSG
                      PERFORM 800-SEND-MSG.
        
         820-ERROR-CHECK-EXIT.
             EXIT.