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.
28200