friedkiwi/ibm-information-center
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
master
ibm-information-center/dist/eclipse/plugins/i5OS.ic.dbp_5.4.0.1/rbaforzahftrk.htm

374 lines
19 KiB
HTML
Raw Permalink Normal View History

Add readme and dist folders
2024-04-02 14:02:31 +00:00
<?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 &lt; 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 &lt; 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>
Reference in New Issue Copy Permalink