507 lines
49 KiB
HTML
507 lines
49 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: RPG program" />
|
||
|
|
<meta name="DC.subject" content="example, programming, RPG/400 language, RPG/400, examples" />
|
||
|
|
<meta name="keywords" content="example, programming, RPG/400 language, RPG/400, examples" />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="rbal1progxmp.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="rbal1exrpgprogram" />
|
||
|
|
<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: RPG program</title>
|
||
|
|
</head>
|
||
|
|
<body id="rbal1exrpgprogram"><a name="rbal1exrpgprogram"><!-- --></a>
|
||
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
||
|
|
<h1 class="topictitle1">Example: RPG program</h1>
|
||
|
|
<div><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="example"> <div class="fignone" id="rbal1exrpgprogram__rbal1rpgxmp"><a name="rbal1exrpgprogram__rbal1rpgxmp"><!-- --></a><span class="figcap">Figure 1. RPG program example</span><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 1
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
100 **************************************************************** 03/29/92
|
||
|
|
200 * * 03/29/92
|
||
|
|
300 * DESCRIPTIVE NAME = D-DB SAMPLE APPLICATION * 03/29/92
|
||
|
|
400 * REORDER POINT PROCESSING * 03/29/92
|
||
|
|
500 * AS/400 * 03/29/92
|
||
|
|
600 * * 03/29/92
|
||
|
|
700 * FUNCTION = THIS MODULE PROCESS THE PART_STOCK TABLE AND * 03/29/92
|
||
|
|
800 * FOR EACH PART BELOW THE ROP (REORDER POINT) * 03/29/92
|
||
|
|
900 * CREATES A SUPPLY ORDER AND PRINTS A REPORT. * 03/29/92
|
||
|
|
1000 * * 03/29/92
|
||
|
|
1100 * * 03/29/92
|
||
|
|
1200 * INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 03/29/92
|
||
|
|
1300 * * 03/29/92
|
||
|
|
1400 * LOCADB LOCAL DB NAME * 03/29/92
|
||
|
|
1500 * REMODB REMOTE DB NAME * 03/29/92
|
||
|
|
1600 * * 03/29/92
|
||
|
|
1700 * TABLES = PART-STOCK - LOCAL * 03/29/92
|
||
|
|
1800 * PART_ORDER - REMOTE * 03/29/92
|
||
|
|
1900 * PART_ORDLN - REMOTE * 03/29/92
|
||
|
|
2000 * SHIPMENTLN - REMOTE * 03/29/92
|
||
|
|
2100 * * 03/29/92
|
||
|
|
2200 * INDICATORS = *IN89 - '0' ORDER HEADER NOT DONE * 03/29/92
|
||
|
|
2300 * '1' ORDER HEADER IS DONE * 03/29/92
|
||
|
|
2400 * *IN99 - '1' ABNORMAL END (SQLCOD<0) * 03/29/92
|
||
|
|
2500 * * 03/29/92
|
||
|
|
2600 * TO BE COMPILED WITH COMMIT(*CHG) RDB(remotedbname) * 03/29/92
|
||
|
|
2700 * * 03/29/92
|
||
|
|
2800 * INVOKE BY : CALL DDBPT6RG PARM(localdbname remotedbname) * 03/29/92
|
||
|
|
2900 * * 03/29/92
|
||
|
|
3000 * CURSORS WILL BE CLOSED IMPLICITLY (BY CONNECT) BECAUSE * 03/29/92
|
||
|
|
3100 * THERE IS NO REASON TO DO IT EXPLICITLY * 03/29/92
|
||
|
|
3200 * * 03/29/92
|
||
|
|
3300 **************************************************************** 03/29/92
|
||
|
|
3400 * 03/29/92
|
||
|
|
3500 FQPRINT O F 33 OF PRINTER 03/29/92
|
||
|
|
3600 F* 03/29/92
|
||
|
|
3700 I* 03/29/92
|
||
|
|
3800 IMISC DS 03/29/92
|
||
|
|
3900 I B 1 20SHORTB 03/29/92
|
||
|
|
4000 I B 3 60LONGB 03/29/92
|
||
|
|
4100 I B 7 80INDNUL 03/29/92
|
||
|
|
4200 I 9 13 PRTTBL 03/29/92
|
||
|
|
4300 I 14 29 LOCTBL 03/29/92
|
||
|
|
4400 I I 'SQLA' 30 33 LOC 03/29/92
|
||
|
|
4500 I* 03/29/92
|
||
|
|
4600 I* 03/29/92
|
||
|
|
4700 C* 03/29/92
|
||
|
|
4800 C *LIKE DEFN SHORTB NXTORD NEW ORDER NR 03/29/92
|
||
|
|
4900 C *LIKE DEFN SHORTB NXTORL ORDER LINE NR 03/29/92
|
||
|
|
5000 C *LIKE DEFN SHORTB RTCOD1 RTCOD NEXT_PART 03/29/92
|
||
|
|
5100 C *LIKE DEFN SHORTB RTCOD2 RTCOD NEXT_ORD_ 03/29/92
|
||
|
|
5200 C *LIKE DEFN SHORTB CURORD ORDER NUMBER 03/29/92
|
||
|
|
5300 C *LIKE DEFN SHORTB CURORL ORDER LINE 03/29/92
|
||
|
|
5400 C *LIKE DEFN LONGB QUANTI FOR COUNTING 03/29/92
|
||
|
|
5500 C *LIKE DEFN LONGB QTYSTC QTY ON STOCK 03/29/92
|
||
|
|
5600 C *LIKE DEFN LONGB QTYORD REORDER QTY 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 2
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
5700 C *LIKE DEFN LONGB QTYROP REORDER POINT 03/29/92
|
||
|
|
5800 C *LIKE DEFN LONGB QTYREQ QTY ORDERED 03/29/92
|
||
|
|
5900 C *LIKE DEFN LONGB QTYREC QTY RECEIVED 03/29/92
|
||
|
|
6000 C* 03/29/92
|
||
|
|
6100 C* 03/29/92
|
||
|
|
6200 C**************************************************************** 03/29/92
|
||
|
|
6300 C* PARAMETERS * 03/29/92
|
||
|
|
6400 C**************************************************************** 03/29/92
|
||
|
|
6500 C* 03/29/92
|
||
|
|
6600 C *ENTRY PLIST 03/29/92
|
||
|
|
6700 C PARM LOCADB 18 LOCAL DATABASE 03/29/92
|
||
|
|
6800 C PARM REMODB 18 REMOTE DATABASE 03/29/92
|
||
|
|
6900 C* 03/29/92
|
||
|
|
7000 C* 03/29/92
|
||
|
|
7100 C**************************************************************** 03/29/92
|
||
|
|
7200 C* SQL CURSOR DECLARATIONS * 03/29/92
|
||
|
|
7300 C**************************************************************** 03/29/92
|
||
|
|
7400 C* 03/29/92
|
||
|
|
7500 C* NEXT PART WHICH STOCK QUANTITY IS UNDER REORDER POINTS QTY 03/29/92
|
||
|
|
7600 C/EXEC SQL 03/29/92
|
||
|
|
7700 C+ DECLARE NEXT_PART CURSOR FOR 03/29/92
|
||
|
|
7800 C+ SELECT PART_NUM, 03/29/92
|
||
|
|
7900 C+ PART_QUANT, 03/29/92
|
||
|
|
8000 C+ PART_ROP, 03/29/92
|
||
|
|
8100 C+ PART_EOQ 03/29/92
|
||
|
|
8200 C+ FROM PART_STOCK 03/29/92
|
||
|
|
8300 C+ WHERE PART_ROP > PART_QUANT 03/29/92
|
||
|
|
8400 C+ AND PART_NUM > :PRTTBL 03/29/92
|
||
|
|
8500 C+ ORDER BY PART_NUM ASC 03/29/92
|
||
|
|
8600 C/END-EXEC 03/29/92
|
||
|
|
8700 C* 03/29/92
|
||
|
|
8800 C* ORDERS WHICH ARE ALREADY MADE FOR CURRENT PART 03/29/92
|
||
|
|
8900 C/EXEC SQL 03/29/92
|
||
|
|
9000 C+ DECLARE NEXT_ORDER_LINE CURSOR FOR 03/29/92
|
||
|
|
9100 C+ SELECT A.ORDER_NUM, 03/29/92
|
||
|
|
9200 C+ ORDER_LINE, 03/29/92
|
||
|
|
9300 C+ QUANT_REQ 03/29/92
|
||
|
|
9400 C+ FROM PART_ORDLN A, 03/29/92
|
||
|
|
9500 C+ PART_ORDER B 03/29/92
|
||
|
|
9600 C+ WHERE PART_NUM = :PRTTBL 03/29/92
|
||
|
|
9700 C+ AND LINE_STAT <> 'C' 03/29/92
|
||
|
|
9800 C+ AND A.ORDER_NUM = B.ORDER_NUM 03/29/92
|
||
|
|
9900 C+ AND ORDER_TYPE = 'R' 03/29/92
|
||
|
|
10000 C/END-EXEC 03/29/92
|
||
|
|
10100 C* 03/29/92
|
||
|
|
10200 C**************************************************************** 03/29/92
|
||
|
|
10300 C* SQL RETURN CODE HANDLING * 03/29/92
|
||
|
|
10400 C**************************************************************** 03/29/92
|
||
|
|
10500 C/EXEC SQL 03/29/92
|
||
|
|
10600 C+ WHENEVER SQLERROR GO TO DBERRO 03/29/92
|
||
|
|
10700 C/END-EXEC 03/29/92
|
||
|
|
10800 C/EXEC SQL 03/29/92
|
||
|
|
10900 C+ WHENEVER SQLWARNING CONTINUE 03/29/92
|
||
|
|
11000 C/END-EXEC 03/29/92
|
||
|
|
11100 C* 03/29/92
|
||
|
|
11200 C* 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 3
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
11300 C**************************************************************** 03/29/92
|
||
|
|
11400 C* PROCESS - MAIN PROGRAM LOGIC * 03/29/92
|
||
|
|
11500 C* MAIN PROCEDURE WORKS WITH LOCAL DATABASE * 03/29/92
|
||
|
|
11600 C**************************************************************** 03/29/92
|
||
|
|
11700 C* 03/29/92
|
||
|
|
11800 C*CLEAN UP TO PERMIT RE-RUNNING OF TEST DATA 03/29/92
|
||
|
|
11900 C EXSR CLEANU 03/29/92
|
||
|
|
12000 C* 03/29/92
|
||
|
|
12100 C* 03/29/92
|
||
|
|
12200 C RTCOD1 DOUEQ100 03/29/92
|
||
|
|
12300 C* 03/29/92
|
||
|
|
12400 C/EXEC SQL 03/29/92
|
||
|
|
12500 C+ CONNECT TO :LOCADB 03/29/92
|
||
|
|
12600 C/END-EXEC 03/29/92
|
||
|
|
12700 C/EXEC SQL 03/29/92
|
||
|
|
12800 C+ OPEN NEXT_PART 03/29/92
|
||
|
|
12900 C/END-EXEC 03/29/92
|
||
|
|
13000 C/EXEC SQL 03/29/92
|
||
|
|
13100 C+ FETCH NEXT_PART 03/29/92
|
||
|
|
13200 C+ INTO :PRTTBL, 03/29/92
|
||
|
|
13300 C+ :QTYSTC, 03/29/92
|
||
|
|
13400 C+ :QTYROP, 03/29/92
|
||
|
|
13500 C+ :QTYORD 03/29/92
|
||
|
|
13600 C/END-EXEC 03/29/92
|
||
|
|
13700 C MOVE SQLCOD RTCOD1 03/29/92
|
||
|
|
13800 C/EXEC SQL 03/29/92
|
||
|
|
13900 C+ COMMIT 03/29/92
|
||
|
|
14000 C/END-EXEC 03/29/92
|
||
|
|
14100 C RTCOD1 IFNE 100 03/29/92
|
||
|
|
14200 C EXSR CHECKO 03/29/92
|
||
|
|
14300 C ENDIF 03/29/92
|
||
|
|
14400 C* 03/29/92
|
||
|
|
14500 C ENDDO 03/29/92
|
||
|
|
14600 C* 03/29/92
|
||
|
|
14700 C GOTO SETLR 03/29/92
|
||
|
|
14800 C* 03/29/92
|
||
|
|
14900 C* 03/29/92
|
||
|
|
15000 C***************************************************************** 03/29/92
|
||
|
|
15100 C* SQL RETURN CODE HANDLING ON ERROR SITUATIONS * 03/29/92
|
||
|
|
15200 C***************************************************************** 03/29/92
|
||
|
|
15300 C* 03/29/92
|
||
|
|
15400 C DBERRO TAG 03/29/92
|
||
|
|
15500 C* *-------------* 03/29/92
|
||
|
|
15600 C EXCPTERRLIN 03/29/92
|
||
|
|
15700 C MOVE *ON *IN99 03/29/92
|
||
|
|
15800 C/EXEC SQL 03/29/92
|
||
|
|
15900 C+ WHENEVER SQLERROR CONTINUE 03/29/92
|
||
|
|
16000 C/END-EXEC 03/29/92
|
||
|
|
16100 C/EXEC SQL 03/29/92
|
||
|
|
16200 C+ ROLLBACK 03/29/92
|
||
|
|
16300 C/END-EXEC 03/29/92
|
||
|
|
16400 C/EXEC SQL 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 4
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
16500 C+ WHENEVER SQLERROR GO TO DBERRO 03/29/92
|
||
|
|
16600 C/END-EXEC 03/29/92
|
||
|
|
16700 C* 03/29/92
|
||
|
|
16800 C* 03/29/92
|
||
|
|
16900 C SETLR TAG 03/29/92
|
||
|
|
17000 C* *-------------* 03/29/92
|
||
|
|
17100 C/EXEC SQL 03/29/92
|
||
|
|
17200 C+ CONNECT RESET 03/29/92
|
||
|
|
17300 C/END-EXEC 03/29/92
|
||
|
|
17400 C MOVE *ON *INLR 03/29/92
|
||
|
|
17500 C* 03/29/92
|
||
|
|
17600 C***************************************************************** 03/29/92
|
||
|
|
17700 C* THE END OF THE PROGRAM * 03/29/92
|
||
|
|
17800 C***************************************************************** 03/29/92
|
||
|
|
17900 C* 03/29/92
|
||
|
|
18000 C* 03/29/92
|
||
|
|
18100 C**************************************************************** 03/29/92
|
||
|
|
18200 C* SUBROUTINES TO WORK WITH REMOTE DATABASES * 03/29/92
|
||
|
|
18300 C**************************************************************** 03/29/92
|
||
|
|
18400 C* 03/29/92
|
||
|
|
18500 C* 03/29/92
|
||
|
|
18600 C CHECKO BEGSR 03/29/92
|
||
|
|
18700 C* *---------------* 03/29/92
|
||
|
|
18800 C***************************************************************** 03/29/92
|
||
|
|
18900 C* CHECKS WHAT IS CURRENT ORDER AND SHIPMENT STATUS FOR THE PART * 03/29/92
|
||
|
|
19000 C* IF ORDERED AND SHIPPED IS LESS THAN REORDER POINT OF PART, * 03/29/92
|
||
|
|
19100 C* PERFORMS A SUBROUTINE WHICH MAKES AN ORDER. * 03/29/92
|
||
|
|
19200 C***************************************************************** 03/29/92
|
||
|
|
19300 C* 03/29/92
|
||
|
|
19400 C MOVE 0 RTCOD2 03/29/92
|
||
|
|
19500 C MOVE 0 QTYREQ 03/29/92
|
||
|
|
19600 C MOVE 0 QTYREC 03/29/92
|
||
|
|
19700 C* 03/29/92
|
||
|
|
19800 C/EXEC SQL 03/29/92
|
||
|
|
19900 C+ CONNECT TO :REMODB 03/29/92
|
||
|
|
20000 C/END-EXEC 03/29/92
|
||
|
|
20100 C/EXEC SQL 03/29/92
|
||
|
|
20200 C+ OPEN NEXT_ORDER_LINE 03/29/92
|
||
|
|
20300 C/END-EXEC 03/29/92
|
||
|
|
20400 C* 03/29/92
|
||
|
|
20500 C RTCOD2 DOWNE100 03/29/92
|
||
|
|
20600 C* 03/29/92
|
||
|
|
20700 C/EXEC SQL 03/29/92
|
||
|
|
20800 C+ FETCH NEXT_ORDER_LINE 03/29/92
|
||
|
|
20900 C+ INTO :CURORD, 03/29/92
|
||
|
|
9 ...+... 0
|
||
|
|
21000 C+ :CURORL, 03/29/92
|
||
|
|
21100 C+ :QUANTI 03/29/92
|
||
|
|
21200 C/END-EXEC 03/29/92
|
||
|
|
21300 C* 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 5
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+...
|
||
|
|
21400 C SQLCOD IFEQ 100 03/29/92
|
||
|
|
21500 C MOVE 100 RTCOD2 03/29/92
|
||
|
|
21600 C ELSE 03/29/92
|
||
|
|
21700 C ADD QUANTI QTYREQ 03/29/92
|
||
|
|
21800 C* 03/29/92
|
||
|
|
21900 C/EXEC SQL 03/29/92
|
||
|
|
22000 C+ SELECT SUM(QUANT_RECV) 03/29/92
|
||
|
|
22100 C+ INTO :QUANTI:INDNUL
|
||
|
|
22200 C+ FROM SHIPMENTLN 03/29/92
|
||
|
|
22300 C+ WHERE ORDER_LOC = :LOC 03/29/92
|
||
|
|
22400 C+ AND ORDER_NUM = :CURORD 03/29/92
|
||
|
|
22500 C+ AND ORDER_LINE = :CURORL 03/29/92
|
||
|
|
22600 C/END-EXEC 03/29/92
|
||
|
|
22700 C* 03/29/92
|
||
|
|
22800 C INDNUL IFGE 0 03/29/92
|
||
|
|
22900 C ADD QUANTI QTYREC 03/29/92
|
||
|
|
23000 C ENDIF 03/29/92
|
||
|
|
23100 C* 03/29/92
|
||
|
|
23200 C ENDIF 03/29/92
|
||
|
|
23300 C ENDDO 03/29/92
|
||
|
|
23400 C* 03/29/92
|
||
|
|
23500 C/EXEC SQL 03/29/92
|
||
|
|
23600 C+ CLOSE NEXT_ORDER_LINE 03/29/92
|
||
|
|
23700 C/END-EXEC 03/29/92
|
||
|
|
23800 C* 03/29/92
|
||
|
|
23900 C QTYSTC ADD QTYREQ QUANTI 03/29/92
|
||
|
|
24000 C SUB QUANTI QTYREC 03/29/92
|
||
|
|
24100 C* 03/29/92
|
||
|
|
24200 C QTYROP IFGT QUANTI 03/29/92
|
||
|
|
24300 C EXSR ORDERP 03/29/92
|
||
|
|
24400 C ENDIF 03/29/92
|
||
|
|
24500 C* 03/29/92
|
||
|
|
24600 C/EXEC SQL 03/29/92
|
||
|
|
24700 C+ COMMIT 03/29/92
|
||
|
|
24800 C/END-EXEC 03/29/92
|
||
|
|
24900 C* 03/29/92
|
||
|
|
25000 C ENDSR CHECKO 03/29/92
|
||
|
|
25100 C* 03/29/92
|
||
|
|
25200 C* 03/29/92
|
||
|
|
25300 C ORDERP BEGSR 03/29/92
|
||
|
|
25400 C* *---------------* 03/29/92
|
||
|
|
25500 C***************************************************************** 03/29/92
|
||
|
|
25600 C* MAKES AN ORDER. IF FIRST TIME, PERFORMS THE SUBROUTINE, WHICH * 03/29/92
|
||
|
|
25700 C* SEARCHES FOR NEW ORDER NUMBER AND MAKES THE ORDER HEADER. * 03/29/92
|
||
|
|
25800 C* AFTER THAT MAKES ORDER LINES USING REORDER QUANTITY FOR THE * 03/29/92
|
||
|
|
25900 C* PART. FOR EVERY ORDERED PART WRITES A LINE ON REPORT. * 03/29/92
|
||
|
|
26000 C***************************************************************** 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 7
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
26100 C* 03/29/92
|
||
|
|
26200 C *IN89 IFEQ *OFF FIRST ORDER ? 03/29/92
|
||
|
|
26300 C EXSR STRORD 03/29/92
|
||
|
|
26400 C MOVE *ON *IN89 ORD.HEAD.DONE 03/29/92
|
||
|
|
26500 C EXCPTHEADER WRITE HEADERS 03/29/92
|
||
|
|
26600 C ENDIF 03/29/92
|
||
|
|
26700 C* 03/29/92
|
||
|
|
26800 C ADD 1 NXTORL NEXT ORD.LIN 03/29/92
|
||
|
|
26900 C/EXEC SQL 03/29/92
|
||
|
|
27000 C+ INSERT 03/29/92
|
||
|
|
27100 C+ INTO PART_ORDLN 03/29/92
|
||
|
|
27200 C+ (ORDER_NUM, 03/29/92
|
||
|
|
27300 C+ ORDER_LINE, 03/29/92
|
||
|
|
27400 C+ PART_NUM, 03/29/92
|
||
|
|
27500 C+ QUANT_REQ, 03/29/92
|
||
|
|
27600 C+ LINE_STAT) 03/29/92
|
||
|
|
27700 C+ VALUES (:NXTORD, 03/29/92
|
||
|
|
27800 C+ :NXTORL, 03/29/92
|
||
|
|
27900 C+ :PRTTBL, 03/29/92
|
||
|
|
28000 C+ :QTYORD, 03/29/92
|
||
|
|
28100 C+ 'O') 03/29/92
|
||
|
|
28200 C/END-EXEC 03/29/92
|
||
|
|
28300 C* 03/29/92
|
||
|
|
28400 C *INOF IFEQ *ON 03/29/92
|
||
|
|
28500 C EXCPTHEADER 03/29/92
|
||
|
|
28600 C END 03/29/92
|
||
|
|
28700 C EXCPTDETAIL 03/29/92
|
||
|
|
28800 C* 03/29/92
|
||
|
|
28900 C ENDSR ORDERP 03/29/92
|
||
|
|
29000 C* 03/29/92
|
||
|
|
29100 C* 03/29/92
|
||
|
|
29200 C STRORD BEGSR 03/29/92
|
||
|
|
29300 C* *---------------* 03/29/92
|
||
|
|
29400 C***************************************************************** 03/29/92
|
||
|
|
29500 C* SEARCHES FOR NEXT ORDER NUMBER AND MAKES AN ORDER HEADER * 03/29/92
|
||
|
|
29600 C* USING THAT NUMBER. WRITES ALSO HEADERS ON REPORT. * 03/29/92
|
||
|
|
29700 C***************************************************************** 03/29/92
|
||
|
|
29800 C* 03/29/92
|
||
|
|
29900 C/EXEC SQL 03/29/92
|
||
|
|
30000 C+ SELECT (MAX(ORDER_NUM) + 1) 03/29/92
|
||
|
|
30100 C+ INTO :NXTORD 03/29/92
|
||
|
|
30200 C+ FROM PART_ORDER 03/29/92
|
||
|
|
30300 C/END-EXEC 03/29/92
|
||
|
|
30400 C/EXEC SQL 03/29/92
|
||
|
|
30500 C+ INSERT 03/29/92
|
||
|
|
30600 C+ INTO PART_ORDER 03/29/92
|
||
|
|
30700 C+ (ORDER_NUM, 03/29/92
|
||
|
|
30800 C+ ORIGIN_LOC, 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 8
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
30900 C+ ORDER_TYPE, 03/29/92
|
||
|
|
31000 C+ ORDER_STAT, 03/29/92
|
||
|
|
31100 C+ CREAT_TIME) 03/29/92
|
||
|
|
31200 C+ VALUES (:NXTORD, 03/29/92
|
||
|
|
31300 C+ :LOC, 03/29/92
|
||
|
|
31400 C+ 'R', 03/29/92
|
||
|
|
31500 C+ 'O', 03/29/92
|
||
|
|
31600 C+ CURRENT TIMESTAMP) 03/29/92
|
||
|
|
31700 C/END-EXEC 03/29/92
|
||
|
|
31800 C ENDSR STRORD 03/29/92
|
||
|
|
31900 C* 03/29/92
|
||
|
|
32000 C* 03/29/92
|
||
|
|
32100 C CLEANU BEGSR 03/29/92
|
||
|
|
32200 C* *---------------* 03/29/92
|
||
|
|
32300 C***************************************************************** 03/29/92
|
||
|
|
32400 C* THIS SUBROUTINE IS ONLY REQUIRED IN A TEST ENVIRONMENT 03/29/92
|
||
|
|
32500 C* TO RESET THE DATA TO PERMIT RE-RUNNING OF THE TEST 03/29/92
|
||
|
|
32600 C***************************************************************** 03/29/92
|
||
|
|
32700 C* 03/29/92
|
||
|
|
32800 C/EXEC SQL 03/29/92
|
||
|
|
32900 C+ CONNECT TO :REMODB 03/29/92
|
||
|
|
33000 C/END-EXEC 03/29/92
|
||
|
|
33100 C/EXEC SQL 03/29/92
|
||
|
|
33200 C+ DELETE 03/29/92
|
||
|
|
33300 C+ FROM PART_ORDLN 03/29/92
|
||
|
|
33400 C+ WHERE ORDER_NUM IN 03/29/92
|
||
|
|
33500 C+ (SELECT ORDER_NUM 03/29/92
|
||
|
|
33600 C+ FROM PART_ORDER 03/29/92
|
||
|
|
33700 C+ WHERE ORDER_TYPE = 'R') 03/29/92
|
||
|
|
33800 C/END-EXEC 03/29/92
|
||
|
|
33900 C/EXEC SQL 03/29/92
|
||
|
|
34000 C+ DELETE 03/29/92
|
||
|
|
34100 C+ FROM PART_ORDER 03/29/92
|
||
|
|
34200 C+ WHERE ORDER_TYPE = 'R' 03/29/92
|
||
|
|
34300 C/END-EXEC 03/29/92
|
||
|
|
34400 C/EXEC SQL 03/29/92
|
||
|
|
34500 C+ COMMIT 03/29/92
|
||
|
|
34600 C/END-EXEC 03/29/92
|
||
|
|
34700 C* 03/29/92
|
||
|
|
34800 C ENDSR CLEANU 03/29/92
|
||
|
|
34900 C* 03/29/92
|
||
|
|
35000 C* 03/29/92
|
||
|
|
35100 C***************************************************************** 03/29/92
|
||
|
|
35200 O* OUTPUTLINES FOR THE REPORT * 03/29/92
|
||
|
|
35300 O***************************************************************** 03/29/92
|
||
|
|
35400 O* 03/29/92
|
||
|
|
35500 OQPRINT E 2 HEADER 03/29/92
|
||
|
|
35600 O + 0 '***** ROP PROCESSING' 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div class="example"><div class="fignone"><pre>5738PW1 V2R1M1 920327 SEU SOURCE LISTING 03/29/92 17:12:48 PAGE 9
|
||
|
|
SOURCE FILE . . . . . . . DRDA/QRPGSRC
|
||
|
|
MEMBER . . . . . . . . . DDBPT6RG
|
||
|
|
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
|
||
|
|
35700 O + 1 'REPORT *****' 03/29/92
|
||
|
|
35800 O* 03/29/92
|
||
|
|
35900 OQPRINT E 2 HEADER 03/29/92
|
||
|
|
36000 O + 0 ' ORDER NUMBER = ' 03/29/92
|
||
|
|
36100 O NXTORDZ + 0 03/29/92
|
||
|
|
36200 O* 03/29/92
|
||
|
|
36300 OQPRINT E 1 HEADER 03/29/92
|
||
|
|
36400 O + 0 '------------------------' 03/29/92
|
||
|
|
36500 O + 0 '---------' 03/29/92
|
||
|
|
36600 O* 03/29/92
|
||
|
|
36700 OQPRINT E 1 HEADER 03/29/92
|
||
|
|
36800 O + 0 ' LINE ' 03/29/92
|
||
|
|
36900 O + 0 'PART ' 03/29/92
|
||
|
|
37000 O + 0 'QTY ' 03/29/92
|
||
|
|
37100 O* 03/29/92
|
||
|
|
37200 OQPRINT E 1 HEADER 03/29/92
|
||
|
|
37300 O + 0 ' NUMBER ' 03/29/92
|
||
|
|
37400 O + 0 'NUMBER ' 03/29/92
|
||
|
|
37500 O + 0 'REQUESTED ' 03/29/92
|
||
|
|
37600 O* 03/29/92
|
||
|
|
37700 OQPRINT E 11 HEADER 03/29/92
|
||
|
|
37800 O + 0 '------------------------' 03/29/92
|
||
|
|
37900 O + 0 '---------' 03/29/92
|
||
|
|
38000 O* 03/29/92
|
||
|
|
38100 OQPRINT EF1 DETAIL 03/29/92
|
||
|
|
38200 O NXTORLZ + 4 03/29/92
|
||
|
|
38300 O PRTTBL + 4 03/29/92
|
||
|
|
38400 O QTYORD1 + 4 03/29/92
|
||
|
|
38500 O* 03/29/92
|
||
|
|
38600 OQPRINT T 2 LRN99 03/29/92
|
||
|
|
38700 O + 0 '------------------------' 03/29/92
|
||
|
|
38800 O + 0 '---------' 03/29/92
|
||
|
|
38900 OQPRINT T 1 LRN99 03/29/92
|
||
|
|
39000 O + 0 'NUMBER OF LINES ' 03/29/92
|
||
|
|
39100 O + 0 'CREATED = ' 03/29/92
|
||
|
|
39200 O NXTORLZ + 0 03/29/92
|
||
|
|
39300 O* 03/29/92
|
||
|
|
39400 OQPRINT T 1 LRN99 03/29/92
|
||
|
|
39500 O + 0 '------------------------' 03/29/92
|
||
|
|
39600 O + 0 '---------' 03/29/92
|
||
|
|
39700 O* 03/29/92
|
||
|
|
39800 OQPRINT T 2 LRN99 03/29/92
|
||
|
|
39900 O + 0 '*********' 03/29/92
|
||
|
|
40000 O + 0 ' END OF PROGRAM ' 03/29/92
|
||
|
|
40100 O + 0 '********' 03/29/92
|
||
|
|
40200 O* 03/29/92
|
||
|
|
40300 OQPRINT E 2 ERRLIN 03/29/92
|
||
|
|
40400 O + 0 '** ERROR **' 03/29/92
|
||
|
|
40500 O + 0 '** ERROR **' 03/29/92
|
||
|
|
40600 O + 0 '** ERROR **' 03/29/92
|
||
|
|
40700 OQPRINT E 1 ERRLIN 03/29/92
|
||
|
|
40800 O + 0 '* SQLCOD:' 03/29/92
|
||
|
|
40900 O SQLCODM + 0 03/29/92
|
||
|
|
41000 O 33 '*' 03/29/92
|
||
|
|
41100 OQPRINT E 1 ERRLIN 03/29/92
|
||
|
|
41200 O + 0 '* SQLSTATE:' 03/29/92
|
||
|
|
41300 O SQLSTT + 2 03/29/92
|
||
|
|
41400 O 33 '*' 03/29/92
|
||
|
|
41500 OQPRINT E 1 ERRLIN 03/29/92
|
||
|
|
41600 O + 0 '** ERROR **' 03/29/92
|
||
|
|
41700 O + 0 '** ERROR **' 03/29/92
|
||
|
|
41800 O + 0 '** ERROR **' 03/29/92</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div>
|
||
|
|
<div class="familylinks">
|
||
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="rbal1progxmp.htm" title="This example application for distributed relational database use is written in RPG/400, COBOL/400, Java and ILE C/400 programming languages. This example shows how to use a distributed relational database for functional specification tasks.">Examples: Application programming</a></div>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
</body>
|
||
|
|
</html>
|