Example: Update trigger written in ILE COBOL
This trigger program runs after a record is updated in the ATMTRANS file.
By using the code examples, you agree to the terms of the Code license and disclaimer information.
100 IDENTIFICATION DIVISION. 200 PROGRAM-ID. UPDTRG. 300 ********************************************************************** 400 **** Program Name : UPDTRG * 500 ***** * 600 ***** This trigger program is called when a record is updated * 700 ***** in the ATMTRANS file. * 800 ***** This program will check the balance of ACCTS and * 900 ***** the total amount in ATMS.If either one of the amounts * 1000 ***** is not enough to meet the withdrawal, an exception * 1100 ***** message is signalled to the application. * 1200 ***** If both ACCTS and ATMS files have enough money, this * 1300 ***** program will update both files to reflect the changes. * 1400 ***** * 1500 ***** ATMIDs of 10001 and 10002 will be updated in the ATMTRANS * 1600 ***** file with the following data: * 1700 ***** * 1800 ***** ATMID ACCTID TCODE AMOUNT * 1900 ***** -------------------------------- * 2000 ***** 10001 20001 W 25.00 * 2100 ***** 10002 20002 W 900.00 * 2200 ***** 10003 20003 D 500.00 * 2300 ***** * 2400 ******************************************************************* 2500 ************************************************************* 2600 ENVIRONMENT DIVISION. 2700 CONFIGURATION SECTION. 2800 SOURCE-COMPUTER. IBM-AS400. 2900 OBJECT-COMPUTER. IBM-AS400. 3000 SPECIAL-NAMES. I-O-FEEDBACK IS FEEDBACK-JUNK. 3100 INPUT-OUTPUT SECTION. 3200 FILE-CONTROL. 3300 SELECT ACC-FILE ASSIGN TO DATABASE-ACCTS 3400 ORGANIZATION IS INDEXED 3500 ACCESS IS RANDOM 3600 RECORD KEY IS ACCTN 3700 FILE STATUS IS STATUS-ERR1. 3800 3900 SELECT ATM-FILE ASSIGN TO DATABASE-ATMS 4000 ORGANIZATION IS INDEXED 4100 ACCESS IS RANDOM 4200 RECORD KEY IS ATMN 4300 FILE STATUS IS STATUS-ERR2. 4400 4500 ************************************************************* 4600 * COMMITMENT CONTROL AREA. * 4700 ************************************************************* 4800 I-O-CONTROL. 4900 COMMITMENT CONTROL FOR ATM-FILE, ACC-FILE. 5000 5100 ************************************************************* 5200 * DATA DIVISION * 5300 **************************************************************** 5400 5500 DATA DIVISION. 5600 FILE SECTION. 5700 FD ATM-FILE 5800 LABEL RECORDS ARE STANDARD. 5900 01 ATM-REC. 6000 COPY DDS-ATMFILE OF ATMS. 6100 6200 FD ACC-FILE 6300 LABEL RECORDS ARE STANDARD. 6400 01 ACC-REC. 6500 COPY DDS-ACCFILE OF ACCTS. 6600 7000 7100 ************************************************************* 7200 * WORKING-STORAGE SECTION * 7300 ************************************************************* 7400 WORKING-STORAGE SECTION. 7500 01 STATUS-ERR1 PIC XX. 7600 01 STATUS-ERR2 PIC XX. 7700 01 TEMP-PTR USAGE IS POINTER. 7800 7900 01 NUMBERS-1. 8000 03 NUM1 PIC 9(10). 8100 03 NUM2 PIC 9(10). 8200 03 NUM3 PIC 9(10). 8300 8400 01 FEEDBACK-STUFF PIC X(500) VALUE SPACES. 8500 8600 ************************************************************* 8700 * MESSAGE FOR SIGNALLING ANY TRIGGER ERROR * 8800 * - Define any message ID and message file in the following* 8900 * message data. * 9000 ************************************************************* 9100 01 SNDPGMMSG-PARMS. 9200 03 SND-MSG-ID PIC X(7) VALUE "TRG9999". 9300 03 SND-MSG-FILE PIC X(20) VALUE "MSGF LIB1 ". 9400 03 SND-MSG-DATA PIC X(25) VALUE "Trigger Error". 9500 03 SND-MSG-LEN PIC 9(8) BINARY VALUE 25. 9600 03 SND-MSG-TYPE PIC X(10) VALUE "*ESCAPE ". 9700 03 SND-PGM-QUEUE PIC X(10) VALUE "* ". 9800 03 SND-PGM-STACK-CNT PIC 9(8) BINARY VALUE 1. 9900 03 SND-MSG-KEY PIC X(4) VALUE " ". 10000 03 SND-ERROR-CODE. 10100 05 PROVIDED PIC 9(8) BINARY VALUE 66. 10200 05 AVAILABLE PIC 9(8) BINARY VALUE 0. 10300 05 RTN-MSG-ID PIC X(7) VALUE " ". 10400 05 FILLER PIC X(1) VALUE " ". 10500 05 RTN-DATA PIC X(50) VALUE " ". 10600 10700 ************************************************************* 10800 * LINKAGE SECTION * 10900 * PARM 1 is the trigger buffer * 11000 * PARM 2 is the length of the trigger buffer * 11100 ************************************************************* 11200 LINKAGE SECTION. 11300 01 PARM-1-AREA. 11400 03 FILE-NAME PIC X(10). 11500 03 LIB-NAME PIC X(10). 11600 03 MEM-NAME PIC X(10). 11700 03 TRG-EVENT PIC X. 11800 03 TRG-TIME PIC X. 11900 03 CMT-LCK-LVL PIC X. 12000 03 FILLER PIC X(3). 12100 03 DATA-AREA-CCSID PIC 9(8) BINARY. 12200 03 FILLER PIC X(8). 12300 03 DATA-OFFSET. 12400 05 OLD-REC-OFF PIC 9(8) BINARY. 12500 05 OLD-REC-LEN PIC 9(8) BINARY. 12600 05 OLD-REC-NULL-MAP PIC 9(8) BINARY. 12700 05 OLD-REC-NULL-LEN PIC 9(8) BINARY. 12800 05 NEW-REC-OFF PIC 9(8) BINARY. 12900 05 NEW-REC-LEN PIC 9(8) BINARY. 13000 05 NEW-REC-NULL-MAP PIC 9(8) BINARY. 13100 05 NEW-REC-NULL-LEN PIC 9(8) BINARY. 13200 05 FILLER PIC X(16). 13300 03 RECORD-JUNK. 13400 05 OLD-RECORD PIC X(16). 13500 05 OLD-NULL-MAP PIC X(4). 13600 05 NEW-RECORD PIC X(16). 13700 05 NEW-NULL-MAP PIC X(4). 13800 13900 01 PARM-2-AREA. 14000 03 TRGBUFL PIC X(2). 14100 14200 01 INPUT-RECORD2. 14300 COPY DDS-TRANS OF ATMTRANS. 14400 14500 05 OFFSET-NEW-REC2 PIC 9(8) BINARY. 14600 14700 ***************************************************************** 14800 ****** PROCEDURE DIVISION * 14900 ***************************************************************** 15000 PROCEDURE DIVISION USING PARM-1-AREA, PARM-2-AREA. 15100 MAIN-PROGRAM SECTION. 15200 000-MAIN-PROGRAM. 15300 OPEN I-O ATM-FILE. 15400 OPEN I-O ACC-FILE. 15500 15600 MOVE 0 TO BAL. 15700 15800 ************************************************************* 15900 * SET UP THE OFFSET POINTER AND COPY THE NEW RECORD. * 16000 ************************************************************* 16100 SET TEMP-PTR TO ADDRESS OF PARM-1-AREA. 16200 SET TEMP-PTR UP BY NEW-REC-OFFSET. 16300 SET ADDRESS OF INPUT-RECORD2 TO TEMP-PTR. 16400 MOVE INPUT-RECORD2 TO INPUT-RECORD. 16500 16600 ************************************************************ 16700 * READ THE RECORD FROM THE ACCTS FILE * 16800 ************************************************************ 16900 MOVE ACCTID TO ACCTN. 17000 READ ACC-FILE 17100 INVALID KEY PERFORM 900-OOPS 17200 NOT INVALID KEY PERFORM 500-ADJUST-ACCOUNT. 17300 17400 ************************************************************* 17500 * READ THE RECORD FROM THE ATMS FILE. * 17600 ************************************************************* 17700 MOVE ATMID TO ATMN. 17800 READ ATM-FILE 17900 INVALID KEY PERFORM 950-OOPS 18000 NOT INVALID KEY PERFORM 550-ADJUST-ATM-BAL. 18100 CLOSE ATM-FILE. 18200 CLOSE ACC-FILE. 18300 GOBACK. 18400 18500 ******************************************************************* 18600 ******************************************************************* 18700 ******************************************************************* 18800 ******************************************************************* 18900 ****** THIS PROCEDURE IS USED IF THERE IS NOT ENOUGH MONEY IN THE **** 19000 ****** ACCTS FOR THE WITHDRAWAL. **** 19100 ******************************************************************* 19200 200-NOT-ENOUGH-IN-ACC. 19300 DISPLAY "NOT ENOUGH MONEY IN ACCOUNT.". 19400 CLOSE ATM-FILE. 19500 CLOSE ACC-FILE. 19600 PERFORM 999-SIGNAL-ESCAPE. 19700 GOBACK. 19800 19900 ******************************************************************* 20000 ****** THIS PROCEDURE IS USED IF THERE IS NOT ENOUGH MONEY IN THE 20100 ****** ATMS FOR THE WITHDRAWAL. 20200 ******************************************************************* 20300 250-NOT-ENOUGH-IN-ATM. 20400 DISPLAY "NOT ENOUGH MONEY IN ATM.". 20500 CLOSE ATM-FILE. 20600 CLOSE ACC-FILE. 20700 PERFORM 999-SIGNAL-ESCAPE. 20800 GOBACK. 20900 21000 ******************************************************************* 21100 ****** THIS PROCEDURE IS USED TO ADJUST THE BALANCE FOR THE ACCOUNT OF 21200 ****** THE PERSON WHO PERFORMED THE TRANSACTION. 21300 ******************************************************************* 21400 500-ADJUST-ACCOUNT. 21500 IF TCODE = "W" THEN 21600 IF (BAL < AMOUNT) THEN 21700 PERFORM 200-NOT-ENOUGH-IN-ACC 21800 ELSE 21900 SUBTRACT AMOUNT FROM BAL 22000 REWRITE ACC-REC 22100 ELSE IF TCODE = "D" THEN 22200 ADD AMOUNT TO BAL 22300 REWRITE ACC-REC 22400 ELSE DISPLAY "TRANSACTION CODE ERROR, CODE IS: ", TCODE. 22500 22600 ******************************************************************* 22700 ****** THIS PROCEDURE IS USED TO ADJUST THE BALANCE OF THE ATM FILE *** 22800 ****** FOR THE AMOUNT OF MONEY IN ATM AFTER A TRANSACTION. *** 22900 ******************************************************************* 23000 550-ADJUST-ATM-BAL. 23100 IF TCODE = "W" THEN 23200 IF (ATMAMT < AMOUNT) THEN 23300 PERFORM 250-NOT-ENOUGH-IN-ATM 23400 ELSE 23500 SUBTRACT AMOUNT FROM ATMAMT 23600 REWRITE ATM-REC 23700 ELSE IF TCODE = "D" THEN 23800 ADD AMOUNT TO ATMAMT 23900 REWRITE ATM-REC 24000 ELSE DISPLAY "TRANSACTION CODE ERROR, CODE IS: ", TCODE. 24100 24200 ************************************************************ ******* 24300 ****** THIS PROCEDURE IS USED IF THERE THE KEY VALUE THAT IS USED IS ** 24400 ****** NOT FOUND IN THE ACCTS FILE. ** 24500 ******************************************************************* 24600 900-OOPS. 24700 DISPLAY "INVALID KEY: ", ACCTN, " ACCOUNT FILE STATUS: ", 24800 STATUS-ERR1. 24900 CLOSE ATM-FILE. 25000 CLOSE ACC-FILE. 25100 PERFORM 999-SIGNAL-ESCAPE. 25200 GOBACK. 25300 25400 ******************************************************************* 25500 ****** THIS PROCEDURE IS USED IF THERE THE KEY VALUE THAT IS USED IS ** 25600 ****** NOT FOUND IN THE ATM FILE. ** 25700 ******************************************************************* 25800 950-OOPS. 25900 DISPLAY "INVALID KEY: ", ATMN, " ATM FILE STATUS: ", 26000 STATUS-ERR2. 26100 CLOSE ATM-FILE. 26200 CLOSE ACC-FILE. 26300 PERFORM 999-SIGNAL-ESCAPE. 26400 GOBACK. 26500 26600 ******************************************************************* 26700 ****** SIGNAL ESCAPE TO THE APPLICATION ******** 26800 ******************************************************************* 26900 999-SIGNAL-ESCAPE. 27000 27100 CALL "QMHSNDPM" USING SND-MSG-ID, 27200 SND-MSG-FILE, 27300 SND-MSG-DATA, 27400 SND-MSG-LEN, 27500 SND-MSG-TYPE, 27600 SND-PGM-QUEUE, 27700 SND-PGM-STACK-CNT, 27800 SND-MSG-KEY, 27900 SND-ERROR-CODE. 28000 *DISPLAY RTN-MSG-ID. 28100 *DISPLAY RTN-DATA. 28200After being updated from the ATMTRANS file by the update trigger programs, the ATMS and ACCTS files contain the following data. The update to the ATMID 10002 fails because of insufficient amount in the account.
ATMN LOCAT ATMAMT 10001 MN 275.00 10002 MN 750.00 10003 CA 750.00
ACCTN BAL ACTACC 20001 175.00 A 20002 350.00 A 20003 500.00 C
Parent topic:
Examples: Trigger programs