* Copyright © Oracle Corporation 1995. All Rights Reserved. IDENTIFICATION DIVISION. PROGRAM-ID. SQL$DIST_TRANS. * * This program displays a menu and calls subroutines to add employees to * or delete employees from company databases or to transfer employees * from one division to another. * * This program uses three databases: * - The Oracle CODASYL DBMS PARTS database, which is used as the company's * central database * - Two copies of the Oracle Rdb PERSONNEL database, which are used * as the company's east and west division databases * * This program calls the following programs: * * - RDB_ADD_EAST.COB, a COBOL program that calls SQL module * procedures in SQL$DIST_TRANS_MOD_COB.SQLMOD to add employee * records to the EAST database. * - RDB_DEL_WEST.COB, a COBOL program that calls SQL module * procedures in SQL$DIST_TRANS_MOD_COB.SQLMOD to delete employee * records from the WEST database. * - TRANSFER_EAST.COB, a COBOL program that calls SQL module * procedures in SQL$DIST_TRANS_MOD_COB.SQLMOD to transfer * employee records from the WEST database to the EAST database. * - SQL$DIST_TRANS_COB.SQLMOD, an SQL module that contains procedures * to add, delete, or transfer employee records. * - RDB_DEL_EAST.SCO, an SQL precompiled COBOL program that deletes * employee records from the EAST database. * - RDB_ADD_WEST.SCO, an SQL precompiled COBOL program that adds * employee records to the WEST database. * - TRANSFER_WEST.SCO, an SQL precompiled COBOL program that transfers * employee records from the EAST database to the WEST database. * - DBMS_ADD.COB, a COBOL program that adds employee records to the * central database. * - DBMS_DEL.COB, a COBOL program that deletes employee records from the * central database. * - SQL$DIST_TRANS_ERROR.SCO, a precompiled COBOL program that * handles errors. * DATA DIVISION. WORKING-STORAGE SECTION. * * Local variables. * * Variables for menu control. 01 MAIN-CHOICE PIC 9. 88 ADD-EMP VALUE IS 1. 88 TRANS-EW VALUE IS 2. 88 TRANS-WE VALUE IS 3. 88 DEL-EMP VALUE IS 4. 88 LEAVE VALUE IS 5. 88 VALID-CHOICE VALUES ARE 1 THRU 5. * * Variables for employee info. 01 DB-CHOICE PIC X. 88 EAST VALUES ARE "E" "e". 88 WEST VALUES ARE "W" "w". 01 EMP-INFO. 05 EMPLOYEE-ID PIC X(5). 05 LAST-NAME PIC X(14). 05 FIRST-NAME PIC X(10). * * Declare the variables needed for the DECdtm system services. 01 IOSB. 05 COND-VAL PIC 9(4) COMP. 05 BYTE-CNT PIC 9(4) COMP. 05 DEV-INFO PIC 9(9) COMP. 01 RET-STATUS PIC S9(9) COMP. 01 TID. 05 LOW_DATE PIC 9(9) COMP. 05 HIGH_DATE PIC 9(9) COMP. 05 DATE_INCARN PIC 9(4) COMP. 05 NODE_ID PIC 9(4) COMP. 05 NODE_IDH PIC 9(9) COMP. PROCEDURE DIVISION. MAIN-LOOP. PERFORM MAIN-SECTION THRU MAIN-SECTION-EXIT UNTIL LEAVE. STOP RUN. MAIN-SECTION. MOVE ZEROS TO MAIN-CHOICE. PERFORM DISPLAY-GET-CHOICE THRU DISPLAY-GET-CHOICE-EXIT UNTIL VALID-CHOICE. IF NOT LEAVE THEN PERFORM DISPATCH-TRANS THRU DISPATCH-TRANS-EXIT. MAIN-SECTION-EXIT. EXIT. * * Display the main menu and accept the user's choice. * DISPLAY-GET-CHOICE. DISPLAY "" ERASE SCREEN. DISPLAY "Main Menu". DISPLAY "Sample 2PC Application". DISPLAY "". DISPLAY "1. Add an Employee". DISPLAY "2. Transfer Employee from East to West". DISPLAY "3. Transfer Employee from West to East". DISPLAY "4. Delete an Employee". DISPLAY "5. Exit". DISPLAY "". DISPLAY "$Select one: > " WITH NO ADVANCING. ACCEPT MAIN-CHOICE. DISPLAY-GET-CHOICE-EXIT. EXIT. DISPATCH-TRANS. * * Invoke the SYS$START_TRANSW system service and check the value of the * I/O status block (IOSB). DISPLAY "". DISPLAY "Starting distributed transaction". * * Start the transaction. CALL "SYS$START_TRANSW" USING OMITTED, OMITTED, BY REFERENCE IOSB, OMITTED, OMITTED, BY REFERENCE TID GIVING RET-STATUS. * Check return status of the call. IF RET-STATUS IS FAILURE THEN CALL "LIB$STOP" USING BY VALUE RET-STATUS. * Check the IOSB. IF COND-VAL IS FAILURE THEN CALL "LIB$STOP" USING BY VALUE COND-VAL. * * Do transaction-specific processing. IF ADD-EMP PERFORM ADD-EMPLOYEE THRU ADD-EMPLOYEE-EXIT. IF TRANS-EW PERFORM TRANSFER-EW THRU TRANSFER-EW-EXIT. IF TRANS-WE PERFORM TRANSFER-WE THRU TRANSFER-WE-EXIT. IF DEL-EMP PERFORM DEL-EMPLOYEE THRU DEL-EMPLOYEE-EXIT. * * Invoke the SYS$END_TRANSW system service to end the distributed * transaction. DISPLAY "Ending distributed transaction". CALL "SYS$END_TRANSW" USING OMITTED, OMITTED, BY REFERENCE IOSB, OMITTED, OMITTED, BY REFERENCE TID GIVING RET-STATUS. * Check the return status of the call. IF RET-STATUS IS FAILURE THEN CALL "LIB$STOP" USING BY VALUE RET-STATUS. * Check the IOSB. IF COND-VAL IS FAILURE THEN CALL "LIB$STOP" USING BY VALUE COND-VAL. DISPATCH-TRANS-EXIT. EXIT. ADD-EMPLOYEE. * * This paragraph solicits employee info and calls other subprograms to add * an employee record to one of the Oracle Rdb databases and to the Oracle * CODASYL DBMS database. * DISPLAY "". DISPLAY "Add employee". DISPLAY "$Employee location (E)ast or (W)est:" WITH NO ADVANCING. ACCEPT DB-CHOICE. IF EAST THEN * * Call the subprogram RDB_ADD_EAST and pass parameters for the data * and the distributed TID. * DISPLAY "" DISPLAY "Entering 2pceast database" CALL "RDB_ADD_EAST" USING EMP-INFO, TID * * Call the subprogram DBMS_ADD and pass parameters for the data and the * distributed TID. * DISPLAY "Entering 2pcdbms database" CALL "DBMS_ADD" USING EMP-INFO, TID ELSE IF WEST THEN * * Call the subprogram RDB_ADD_WEST and pass parameters for the data and * the distributed TID. * DISPLAY "" DISPLAY "Entering 2pcwest database" CALL "RDB_ADD_WEST" USING EMP-INFO, TID * * Call the subprogram DBMS_ADD and pass parameters for the data and the * distributed TID. * DISPLAY "Entering 2pcdbms database" CALL "DBMS_ADD" USING EMP-INFO, TID ELSE DISPLAY "Invalid location" BELL. ADD-EMPLOYEE-EXIT. EXIT. TRANSFER-EW. DISPLAY "". DISPLAY "Transfer east to west". CALL "TRANSFER_WEST" USING TID. TRANSFER-EW-EXIT. EXIT. TRANSFER-WE. DISPLAY "". DISPLAY "Transfer west to east". CALL "TRANSFER_EAST" USING TID. TRANSFER-WE-EXIT. EXIT. DEL-EMPLOYEE. * * This paragraph calls other subprograms to delete an employee record * from one of the Oracle Rdb databases and from the Oracle CODASYL DBMS * database. * DISPLAY "". DISPLAY "Delete employee". DISPLAY "$Employee location (E)ast or (W)est:" WITH NO ADVANCING. ACCEPT DB-CHOICE. IF EAST THEN * * Call the subprogram RDB_DEL_EAST and pass parameters for the data * and the distributed TID. * DISPLAY "" DISPLAY "Entering 2pceast database" CALL "RDB_DEL_EAST" USING EMPLOYEE-ID, TID * * Call the subprogram DBMS_DEL and pass parameters for the data and the * distributed TID. * DISPLAY "Entering 2pcdbms database" CALL "DBMS_DEL" USING EMPLOYEE-ID, TID ELSE IF WEST THEN * * Call the subprogram RDB_DEL_WEST and pass parameters for the data * and the distributed TID. * DISPLAY "" DISPLAY "Entering 2pcwest database" CALL "RDB_DEL_WEST" USING EMPLOYEE-ID, TID * * Call the subprogram DBMS_DEL and pass parameters for the data and the * distributed TID. * DISPLAY "Entering 2pcdbms database" CALL "DBMS_DEL" USING EMPLOYEE-ID, TID ELSE DISPLAY "Invalid location" BELL. DEL-EMPLOYEE-EXIT. EXIT.