C Copyright © Oracle Corporation 1995. All Rights Reserved. C This program displays a menu and calls subroutines to add employees to C or delete employees from company databases or to transfer employees C from one division to another. C C This program uses three databases: C - The Oracle CODASYL DBMS PARTS database, which is used as the company's C central database C - Two copies of the Oracle Rdb PERSONNEL database, which are used C as the company's east and west division databases C This program calls the following programs: C C - RDB_ADD_EAST.FOR, a FORTRAN program that calls SQL module C procedures in SQL$DIST_TRANS_FOR.SQLMOD to add employee records c to the east database. C - RDB_DEL_WEST.FOR, a FORTRAN program that calls SQL module C procedures in SQL$DIST_TRANS_FOR.SQLMOD to delete employee records C from the west database. C - TRANSFER_EAST.FOR, a FORTRAN program that calls SQL module C procedures in SQL$DIST_TRANS_FOR.SQLMOD to transfer employee C records from the west database to the east database. C - SQL$DIST_TRANS_FOR.SQLMOD, an SQL module that contains procedures C to add, delete, or transfer employee records. C - RDB_DEL_EAST.SFO, an SQL precompiled FORTRAN program that deletes C employee records from the east database. C - RDB_ADD_WEST.SFO, an SQL precompiled FORTRAN program that adds C employee records to the west database. C - TRANSFER_WEST.SFO, an SQL precompiled FORTRAN program that transfers C employee records from the east database to the west database. C - DBMS_ADD.FOR, a FORTRAN program that adds employee records to the C central database. C - DBMS_DEL.FOR, a FORTRAN program that deletes employee records from the C central database. C - SQL$DIST_TRANS_ERROR.SFO, a precompiled FORTRAN program that C handles errors. IMPLICIT NONE INCLUDE '($SSDEF)' EXTERNAL LIB$STOP,SYS$START_TRANSW,SYS$END_TRANSW CHARACTER main_choice*1 LOGICAL main_exit C Declare the variables needed for the DECdtm system services. INTEGER*2 IOSB(4) INTEGER*4 STATUS,SYS$START_TRANSW,SYS$END_TRANSW INTEGER*4 DIST_TID(4) C Display the main menu and accept the user's choice. main_exit = .FALSE. DO WHILE (.NOT. main_exit) TYPE 1000 ACCEPT 1001, main_choice IF (main_choice .EQ. '5') THEN main_exit = .TRUE. ELSE C Invoke the SYS$START_TRANSW system service and check the value of the C the I/O status block (IOSB). PRINT *, 'Starting distributed transaction' IOSB (1) = 0 STATUS = SYS$START_TRANSW ( 1 %VAL(0), 2 %VAL(0), 3 IOSB, 4 %VAL(0), 5 %VAL(0), 6 DIST_TID) IF (.NOT. STATUS) THEN CALL LIB$STOP (%VAL(STATUS)) ELSE STATUS = IOSB(1) END IF IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) IF (main_choice .EQ. '1') THEN CALL add_employee(dist_tid) ELSE IF (main_choice .EQ. '2') THEN CALL transfer_west(dist_tid) ELSE IF (main_choice .EQ. '3') THEN CALL transfer_east(dist_tid) ELSE IF (main_choice .EQ. '4') THEN CALL del_employee(dist_tid) ELSE CONTINUE END IF C Invoke the SYS$END_TRANSW system service to end the distributed C transaction. PRINT *, 'Ending distributed transaction' IOSB (1) = 0 STATUS = SYS$END_TRANSW ( 1 %VAL(0), 2 %VAL(0), 3 IOSB, 4 %VAL(0), 5 %VAL(0), 6 DIST_TID) IF (.NOT. STATUS) THEN CALL LIB$STOP (%VAL(STATUS)) ELSE STATUS = IOSB(1) END IF IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) END IF END DO 1000 FORMAT (// ' Main Menu'/ 1 ' Sample 2PC Application'// 2 ' 1. Add an Employee'/ 3 ' 2. Transfer Employee from East to West'/ 4 ' 3. Transfer Employee from West to East'/ 5 ' 4. Delete an Employee'/ 6 ' 5. Exit'// 7 '$Select one: > ') 1001 FORMAT (A) END C This subroutine calls other subroutines to add an employee record to C one of the Oracle Rdb databases and to the Oracle CODASYL DBMS database. SUBROUTINE add_employee(dist_tid) IMPLICIT NONE CHARACTER db_choice*1 CHARACTER first_name*10,employee_id*5,last_name*14 INTEGER*4 dist_tid(4) TYPE 1050 ACCEPT 1051, db_choice 1050 FORMAT ('$Employee location (EAST or WEST): ') 1051 FORMAT (A) 1100 FORMAT ('ERROR in input') IF ((db_choice .EQ. 'E') .OR. 1 (db_choice .EQ. 'e')) THEN C Call the subroutine RDB_ADD_EAST and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pceast database' CALL RDB_ADD_EAST ( 1 employee_id, 2 last_name, 3 first_name, 4 dist_tid) C Call the subroutine DBMS_ADD and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pcdbms database' CALL DBMS_ADD ( 1 employee_id, 2 last_name, 3 first_name, 4 dist_tid) ELSE IF ((db_choice .EQ. 'W') .OR. 1 (db_choice .EQ. 'w')) THEN C Call the subroutine RDB_ADD_WEST and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pcwest database' CALL RDB_ADD_WEST ( 1 employee_id, 2 last_name, 3 first_name, 4 dist_tid) C Call the subroutine DBMS_ADD and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pcdbms database' CALL DBMS_ADD ( 1 employee_id, 2 last_name, 3 first_name, 4 dist_tid) ELSE TYPE 1100 END IF RETURN END C This subroutine calls other subroutines to delete an employee record from one C of the Oracle Rdb databases and from the Oracle CODASYL DBMS database. SUBROUTINE del_employee(dist_tid) IMPLICIT NONE CHARACTER db_choice*1 CHARACTER first_name*10,employee_id*5,last_name*14 INTEGER*4 dist_tid(4) TYPE 1050 ACCEPT 1051, db_choice 1050 FORMAT ('$Employee location (EAST or WEST): ') 1051 FORMAT (A) 1100 FORMAT ('ERROR in input') IF ((db_choice .EQ. 'E') .OR. 1 (db_choice .EQ. 'e')) THEN C Call the subroutine RDB_DEL_EAST and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pceast database' CALL RDB_DEL_EAST (employee_id,dist_tid) PRINT *, ' Entering 2pcdbms database' CALL DBMS_DEL (employee_id,dist_tid) ELSE IF ((db_choice .EQ. 'W') .OR. 1 (db_choice .EQ. 'w')) THEN C Call the subroutine RDB_DEL_WEST and pass parameters for the data C and the distributed TID. PRINT *, ' Entering 2pcwest database' CALL RDB_DEL_WEST (employee_id,dist_tid) PRINT *, ' Entering 2pcdbms database' CALL DBMS_DEL (employee_id,dist_tid) ELSE TYPE 1100 END IF RETURN END