374 lines
19 KiB
HTML
374 lines
19 KiB
HTML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE html
|
|
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|
<html lang="en-us" xml:lang="en-us">
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
|
<meta name="security" content="public" />
|
|
<meta name="Robots" content="index,follow" />
|
|
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
|
|
<meta name="DC.Type" content="reference" />
|
|
<meta name="DC.Title" content="Example: Update trigger written in ILE COBOL" />
|
|
<meta name="abstract" content="This example shows the running of the ILE COBOL trigger program when a record is updated in the ATMTRANS file." />
|
|
<meta name="description" content="This example shows the running of the ILE COBOL trigger program when a record is updated in the ATMTRANS file." />
|
|
<meta name="DC.Relation" scheme="URI" content="rbaforzahftri.htm" />
|
|
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
|
|
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
|
|
<meta name="DC.Format" content="XHTML" />
|
|
<meta name="DC.Identifier" content="rbaforzahftrk" />
|
|
<meta name="DC.Language" content="en-us" />
|
|
<!-- All rights reserved. Licensed Materials Property of IBM -->
|
|
<!-- US Government Users Restricted Rights -->
|
|
<!-- Use, duplication or disclosure restricted by -->
|
|
<!-- GSA ADP Schedule Contract with IBM Corp. -->
|
|
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
|
|
<link rel="stylesheet" type="text/css" href="./ic.css" />
|
|
<title>Example: Update trigger written in ILE COBOL</title>
|
|
</head>
|
|
<body id="rbaforzahftrk"><a name="rbaforzahftrk"><!-- --></a>
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
|
<h1 class="topictitle1">Example: Update trigger written in ILE COBOL</h1>
|
|
<div><p>This example shows the running of the ILE COBOL trigger program
|
|
when a record is updated in the ATMTRANS file. </p>
|
|
<div class="section"><div class="note"><span class="notetitle">Note:</span> By using the code examples, you agree to the terms of the <a href="codedisclaimer.htm">Code license and disclaimer information</a>.</div>
|
|
</div>
|
|
<div class="section"><div class="p"><pre> 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 </pre>
|
|
</div>
|
|
</div>
|
|
<div class="section"><p>After 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.</p>
|
|
</div>
|
|
<div class="section"><div class="p">
|
|
<table cellpadding="4" cellspacing="0" border="1" class="tableborder"><tr><td>
|
|
<table cellpadding="4" cellspacing="0" summary="" width="100%" border="0"><thead align="left"><tr><th align="center" valign="bottom" width="33.33333333333333%" id="d0e35">ATMN</th>
|
|
<th align="center" valign="bottom" width="33.33333333333333%" id="d0e37">LOCAT</th>
|
|
<th align="center" valign="bottom" width="33.33333333333333%" id="d0e39">ATMAMT</th>
|
|
</tr>
|
|
</thead>
|
|
<tbody><tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e35 ">10001</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e37 ">MN</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e39 ">275.00</td>
|
|
</tr>
|
|
<tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e35 ">10002</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e37 ">MN</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e39 ">750.00</td>
|
|
</tr>
|
|
<tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e35 ">10003</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e37 ">CA</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e39 ">750.00</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
</td></tr></table>
|
|
|
|
<table cellpadding="4" cellspacing="0" border="1" class="tableborder"><tr><td>
|
|
<table cellpadding="4" cellspacing="0" summary="" width="100%" border="0"><thead align="left"><tr><th align="center" valign="bottom" width="33.33333333333333%" id="d0e70">ACCTN</th>
|
|
<th align="center" valign="bottom" width="33.33333333333333%" id="d0e72">BAL</th>
|
|
<th align="center" valign="bottom" width="33.33333333333333%" id="d0e74">ACTACC</th>
|
|
</tr>
|
|
</thead>
|
|
<tbody><tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e70 ">20001</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e72 ">175.00</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e74 ">A</td>
|
|
</tr>
|
|
<tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e70 ">20002</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e72 ">350.00</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e74 ">A</td>
|
|
</tr>
|
|
<tr><td align="center" valign="top" width="33.33333333333333%" headers="d0e70 ">20003</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e72 ">500.00</td>
|
|
<td align="center" valign="top" width="33.33333333333333%" headers="d0e74 ">C</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
</td></tr></table>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
<div>
|
|
<div class="familylinks">
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="rbaforzahftri.htm" title="This topic provides examples of trigger programs written in C, COBOL, and RPG.">Examples: Trigger programs</a></div>
|
|
</div>
|
|
</div>
|
|
</body>
|
|
</html> |