Example: RPG program

 

This example program is written in the RPG programming language.

By using the code examples, you agree to the terms of the Code license and disclaimer information. Figure 1. RPG program example

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

 

Parent topic:

Examples: Application programming