2PC COBOL Sample Using Preprocessor2
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.