Figure 149 shows an example of an order inquiry program, ORDINQ, that uses subfiles. The associated DDS is also shown, except for the DDS for the customer master file, CUSMSTP. Refer to Figure 132 for the DDS for CUSMSTP.
ORDINQ displays all the detail order records for the requested order number. The program prompts you to enter the order number that is to be reviewed. The order number is checked against the order header file, ORDHDRP. If the order number exists, the customer number accessed from the order header file is checked against the customer master file, CUSMSTP. All detail order records in ORDDTLP for the requested order are read and written to the subfile. A write for the subfile control record format is processed, and the detail order records in the subfile are displayed for you to review. You end the program by pressing F12.
Figure 146. Data Description Specifications for an Order Inquiry Program - Order Detail File
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+.... A** PHYSICAL ORDDTLP ORDER DETAIL FILE A A UNIQUE A* A R ORDDTL TEXT('ORDER DETAIL RECORD') A* A CUST 5 CHECK(MF) A COLHDG('CUSTOMER' 'NUMBER') A* A ORDERN 5 0 COLHDG('ORDER' 'NUMBER') A* A LINNUM 3 0 A COLHDG('LINE' 'NO') A TEXT('LINE NUMBER OF LINE IN ORDER' A ) A* A ITEM 5 0 CHECK(M10) A COLHDG('ITEM' 'NUMBER') A QTYORD 3 0 A COLHDG('QUANTITY' 'ORDERED') A TEXT('QUANTITY ORDERED') A* A DESCRP 30 COLHDG('ITEM' 'DESCRIPTION') A* A PRICE 6 2 CMP(GT 0) A COLHDG('PRICE') A TEXT('SELLING PRICE') A EDTCDE(J) A EXTENS 8 2 COLHDG('EXTENSION') A TEXT('EXTENSION AMOUNT OF QTYORD X A PRICE') A* A WHSLOC 3 CHECK(MF) A COLHDG('BIN' 'NO.') A* A ORDDAT 6 0 TEXT('DATE ORDER WAS ENTERED') A* A CUSTYP 1 0 RANGE(1 5) A COLHDG('CUST' 'TYPE') A TEXT('CUSTOMER TYPE 1=GOV 2=SCH + A 3=BUS 4=PVT 5=OT') A* A STATE 2 CHECK(MF) A COLHDG('STATE') A* A ACTMTH 2 0 COLHDG('ACCT' 'MTH') A TEXT('ACCOUNTING MONTH OF SALE') A* A ACTYR 2 0 COLHDG('ACCT' 'YEAR') A TEXT('ACCOUNTING YEAR OF SALE') A A K ORDERN A K LINNUM |
Figure 147. Data Description Specifications for an Order Inquiry Program - Order Review File
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+.... A* ORDINQD EXISTING ORDER REVIEW DISPLAY FILE A A* A R SUB1 SFL A ITEM 5 0 10 2TEXT('ITEM NUMBER') A QTYORD 3 0 10 9TEXT('QUANTITY ORDERED') A DESCRP 30 10 14TEXT('ITEM DESCRIPTION') A PRICE 6 2 10 46TEXT('SELLING PRICE') A EXTENS 8 2 10 56EDTCDE(J) A TEXT('EXTENSION AMOUNT OF QTYORD + A X PRICE') A A R SUBCTL1 SFLCTL(SUB1) A 58 SFLCLR A 57 SFLDSP A N58 SFLDSPCTL A SFLSIZ(57) A SFLPAG(14) A 57 SFLEND A OVERLAY A LOCK A N45 AON47 ROLLUP(97 'CONTINUE DISPLAY') A CA12(98 'END OF PROGRAM') A SETOFF(57 'DISPLAY SUBFILE') A SETOFF(58 'OFF = DISPLAY SUBCTL1 O+ A N = CLEAR SUBFILE') A 1 2'EXISTING ORDER INQUIRY' A 3 2'ORDER' A ORDERN 5Y 0B 3 8TEXT('ORDER NUMBER') A 61 ERRMSG('ORDER NUMBER NOT FOUND' 61) A 47 ERRMSG('NO LINE FOR THIS ORDER' 47) A 62 ERRMSG('NO CUSTOMER RECORD' 62) A 4 2'DATE' A ORDDAT 6 0 4 7TEXT('DATE ORDER WAS ENTERED') A 5 2'CUST #' A CUST 5 5 9TEXT('CUSTOMER NUMBER') A NAME 25 3 16TEXT('CUSTOMER NAME') A ADDR 20 4 16TEXT('CUSTOMER ADDRESS') A CITY 20 5 16TEXT('CUSTOMER CITY') A STATE 2 6 16TEXT('CUSTOMER STATE') A ZIP 5 0 6 31TEXT('ZIP CODE') A 1 44'TOTAL' A ORDAMT 8 2 1 51TEXT('TOTAL AMOUNT OF ORDER') A 2 44'STATUS' A STSORD 12 2 51 A 3 44'OPEN' A STSOPN 12 3 51 A 4 44'CUSTOMER ORDER' A CUSORD 15 4 59TEXT('CUSTOMER PURCHASE ORDER + A NUMBER') A 5 44'SHIP VIA' A SHPVIA 15 5 59TEXT('SHIPPING INSTRUCTIONS') A 6 44'PRINTED DATE' A PRTDAT 6 0 6 57TEXT('DATE ORDER WAS PRINTED') A 7 29'INVOICE' A INVNUM 5 0 7 38TEXT('INVOICE NUMBER') A 7 64'MTH' A ACTMTH 2 0 7 68TEXT('ACCOUNTING MONTH OF SALE') A 7 72'YEAR' A ACTYR 2 0 7 77TEXT('ACCOUNTING YEAR OF SALE') A 8 2'ITEM' A 8 8'QTY' A 8 14'ITEM DESCRIPTION' A 8 46'PRICE' A 8 55'EXTENSION' |
Figure 148. Data Description Specifications for an Order Inquiry Program - Order Header File
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+.... A* THIS IS THE ORDER HEADER FILE ** ORDHDRP A A A UNIQUE A R ORDHDR TEXT('ORDER HEADER RECORD') A CUST 5 TEXT('CUSTOMER NUMBER') A ORDERN 5 00 TEXT('ORDER NUMBER') A ORDDAT 6 00 TEXT('DATE ORDER ENTERED') A CUSORD 15 TEXT('CUSTOMER PURCHASE ORDER + A NUMBER') A SHPVIA 15 TEXT('SHIPPING INSTRUCTIONS') A ORDSTS 1 00 TEXT('ORDER SATAUS 1PCS 2CNT + 3CHK 4RDY 5PRT 6PCK') A OPRNAM 10 TEXT('OPERATOR WHO ENTERED ORD') A ORDAMT 8 02 TEXT('DOLLAR AMOUNT OF ORDER') A CUSTYP 1 00 TEXT('CUSTOMER TYPE 1=GOV 2=SCH + A 3=BUS 4=PVT 5=OT') A INVNUM 5 00 TEXT('INVOICE NUMBER') A PRTDAT 6 00 TEXT('DATE ORDER WAS PRINTED') A OPNSTS 1 00 TEXT('ORDER OPEN STATUS 1=OPEN + 2= CLOSE 3=CANCEL') A TOTLIN 3 00 TEXT('TOTAL LINE ITEMS IN ORDER') A ACTMTH 2 00 TEXT('ACCOUNTING MONTH OF SALE') A ACTYR 2 00 TEXT('ACCOUNTING YEAR OF SALE') A STATE 2 TEXT('STATE') A AMPAID 8 02 TEXT('AMOUNT PAID') K ORDERN |
Figure 149. Example of an Order Inquiry Program
5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 2 S o u r c e STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 1 000100 IDENTIFICATION DIVISION. 2 000200 PROGRAM-ID. ORDINQ. 000300* SAMPLE ORDER INQUIRY PROGRAM 000400 3 000500 ENVIRONMENT DIVISION. 4 000600 CONFIGURATION SECTION. 5 000700 SOURCE-COMPUTER. IBM-ISERIES 6 000800 OBJECT-COMPUTER. IBM-ISERIES 7 000900 INPUT-OUTPUT SECTION. 8 001000 FILE-CONTROL. 9 001100 SELECT ORDER-HEADER-FILE 10 001200 ASSIGN TO DATABASE-ORDHDRP 11 001300 ORGANIZATION IS INDEXED 12 001400 ACCESS MODE IS RANDOM 13 001500 RECORD KEY IS ORDERN OF ORDER-HEADER-RECORD. 14 001600 SELECT ORDER-DETAIL-FILE 15 001700 ASSIGN TO DATABASE-ORDDTLP 16 001800 ORGANIZATION IS INDEXED 17 001900 ACCESS IS DYNAMIC 18 002000 RECORD KEY IS ORDER-DETAIL-RECORD-KEY. 19 002100 SELECT CUSTOMER-MASTER-FILE 20 002200 ASSIGN TO DATABASE-CUSMSTP 21 002300 ORGANIZATION IS INDEXED 22 002400 ACCESS IS RANDOM 23 002500 RECORD KEY IS CUST OF CUSTOMER-MASTER-RECORD. 24 002600 SELECT EXISTING-ORDER-DISPLAY-FILE 25 002700 ASSIGN TO WORKSTATION-ORDINQD 26 002800 ORGANIZATION IS TRANSACTION 27 002900 ACCESS IS DYNAMIC 28 003000 RELATIVE KEY IS SUBFILE-RECORD-NUMBER 29 003100 FILE STATUS IS STATUS-CODE-ONE. 003200 30 003300 DATA DIVISION. 31 003400 FILE SECTION. 32 003500 FD ORDER-HEADER-FILE. 33 003600 01 ORDER-HEADER-RECORD. 003700 COPY DDS-ORDHDR OF ORDHDRP. +000001* I-O FORMAT:ORDHDR FROM FILE ORDHDRP OF LIBRARY CBLGUIDE ORDHDR +000002* ORDER HEADER RECORD ORDHDR +000003* USER SUPPLIED KEY BY RECORD KEY CLAUSE ORDHDR 34 +000004 05 ORDHDR. ORDHDR 35 +000005 06 CUST PIC X(5). ORDHDR +000006* CUSTOMER NUMBER ORDHDR 36 +000007 06 ORDERN PIC S9(5) COMP-3. ORDHDR +000008* ORDER NUMBER ORDHDR 37 +000009 06 ORDDAT PIC S9(6) COMP-3. ORDHDR +000010* DATE ORDER ENTERED ORDHDR 38 +000011 06 CUSORD PIC X(15). ORDHDR +000012* CUSTOMER PURCHASE ORDER NUMBER ORDHDR 39 +000013 06 SHPVIA PIC X(15). ORDHDR +000014* SHIPPING INSTRUCTIONS ORDHDR 40 +000015 06 ORDSTS PIC S9(1) COMP-3. ORDHDR +000016* ORDER SATAUS 1PCS 2CNT 3CHK 4RDY 5PRT 6PCK ORDHDR 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 41 +000017 06 OPRNAM PIC X(10). ORDHDR +000018* OPERATOR WHO ENTERED ORD ORDHDR 42 +000019 06 ORDAMT PIC S9(6)V9(2) COMP-3. ORDHDR +000020* DOLLAR AMOUNT OF ORDER ORDHDR 43 +000021 06 CUSTYP PIC S9(1) COMP-3. ORDHDR +000022* CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT ORDHDR 44 +000023 06 INVNUM PIC S9(5) COMP-3. ORDHDR +000024* INVOICE NUMBER ORDHDR 45 +000025 06 PRTDAT PIC S9(6) COMP-3. ORDHDR +000026* DATE ORDER WAS PRINTED ORDHDR 46 +000027 06 OPNSTS PIC S9(1) COMP-3. ORDHDR +000028* ORDER OPEN STATUS 1=OPEN 2= CLOSE 3=CANCEL ORDHDR 47 +000029 06 TOTLIN PIC S9(3) COMP-3. ORDHDR +000030* TOTAL LINE ITEMS IN ORDER ORDHDR 48 +000031 06 ACTMTH PIC S9(2) COMP-3. ORDHDR +000032* ACCOUNTING MONTH OF SALE ORDHDR 49 +000033 06 ACTYR PIC S9(2) COMP-3. ORDHDR +000034* ACCOUNTING YEAR OF SALE ORDHDR 50 +000035 06 STATE PIC X(2). ORDHDR +000036* STATE ORDHDR 51 +000037 06 AMPAID PIC S9(6)V9(2) COMP-3. ORDHDR +000038* AMOUNT PAID ORDHDR 003800 52 003900 FD ORDER-DETAIL-FILE. 53 004000 01 ORDER-DETAIL-RECORD. 004100 COPY DDS-ORDDTL OF ORDDTLP. +000001* I-O FORMAT:ORDDTL FROM FILE ORDDTLP OF LIBRARY CBLGUIDE ORDDTL +000002* ORDER DETAIL RECORD ORDDTL +000003* USER SUPPLIED KEY BY RECORD KEY CLAUSE ORDDTL 54 +000004 05 ORDDTL. ORDDTL 55 +000005 06 CUST PIC X(5). ORDDTL +000006* CUSTOMER NUMBER ORDDTL 56 +000007 06 ORDERN PIC S9(5) COMP-3. ORDDTL +000008* ORDER NUMBER ORDDTL 57 +000009 06 LINNUM PIC S9(3) COMP-3. ORDDTL +000010* LINE NUMBER OF LINE IN ORDER ORDDTL 58 +000011 06 ITEM PIC S9(5) COMP-3. ORDDTL +000012* ITEM NUMBER ORDDTL 59 +000013 06 QTYORD PIC S9(3) COMP-3. ORDDTL +000014* QUANTITY ORDERED ORDDTL 60 +000015 06 DESCRP PIC X(30). ORDDTL +000016* ITEM DESCRIPTION ORDDTL 61 +000017 06 PRICE PIC S9(4)V9(2) COMP-3. ORDDTL +000018* SELLING PRICE ORDDTL 62 +000019 06 EXTENS PIC S9(6)V9(2) COMP-3. ORDDTL +000020* EXTENSION AMOUNT OF QTYORD X PRICE ORDDTL 63 +000021 06 WHSLOC PIC X(3). ORDDTL +000022* BIN NO. ORDDTL 64 +000023 06 ORDDAT PIC S9(6) COMP-3. ORDDTL +000024* DATE ORDER WAS ENTERED ORDDTL 65 +000025 06 CUSTYP PIC S9(1) COMP-3. ORDDTL +000026* CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT ORDDTL 66 +000027 06 STATE PIC X(2). ORDDTL +000028* STATE ORDDTL 67 +000029 06 ACTMTH PIC S9(2) COMP-3. ORDDTL 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 4 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000030* ACCOUNTING MONTH OF SALE ORDDTL 68 +000031 06 ACTYR PIC S9(2) COMP-3. ORDDTL +000032* ACCOUNTING YEAR OF SALE ORDDTL 69 004200 66 ORDER-DETAIL-RECORD-KEY RENAMES ORDERN THRU LINNUM. 004300 70 004400 FD CUSTOMER-MASTER-FILE. 71 004500 01 CUSTOMER-MASTER-RECORD. 004600 COPY DDS-CUSMST OF CUSMSTP. +000001* I-O FORMAT:CUSMST FROM FILE CUSMSTP OF LIBRARY CBLGUIDE CUSMST +000002* CUSTOMER MASTER RECORD CUSMST +000003* USER SUPPLIED KEY BY RECORD KEY CLAUSE CUSMST 72 +000004 05 CUSMST. CUSMST 73 +000005 06 CUST PIC X(5). CUSMST +000006* CUSTOMER NUMBER CUSMST 74 +000007 06 NAME PIC X(25). CUSMST +000008* CUSTOMER NAME CUSMST 75 +000009 06 ADDR PIC X(20). CUSMST +000010* CUSTOMER ADDRESS CUSMST 76 +000011 06 CITY PIC X(20). CUSMST +000012* CUSTOMER CITY CUSMST 77 +000013 06 STATE PIC X(2). CUSMST +000014* STATE CUSMST 78 +000015 06 ZIP PIC S9(5) COMP-3. CUSMST +000016* ZIP CODE CUSMST 79 +000017 06 SRHCOD PIC X(6). CUSMST +000018* CUSTOMER NUMBER SEARCH CODE CUSMST 80 +000019 06 CUSTYP PIC S9(1) COMP-3. CUSMST +000020* CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT CUSMST 81 +000021 06 ARBAL PIC S9(6)V9(2) COMP-3. CUSMST +000022* ACCOUNTS REC. BALANCE CUSMST 82 +000023 06 ORDBAL PIC S9(6)V9(2) COMP-3. CUSMST +000024* A/R AMT. IN ORDER FILE CUSMST 83 +000025 06 LSTAMT PIC S9(6)V9(2) COMP-3. CUSMST +000026* LAST AMT. PAID IN A/R CUSMST 84 +000027 06 LSTDAT PIC S9(6) COMP-3. CUSMST +000028* LAST DATE PAID IN A/R CUSMST 85 +000029 06 CRDLMT PIC S9(6)V9(2) COMP-3. CUSMST +000030* CUSTOMER CREDIT LIMIT CUSMST 86 +000031 06 SLSYR PIC S9(8)V9(2) COMP-3. CUSMST +000032* CUSTOMER SALES THIS YEAR CUSMST 87 +000033 06 SLSLYR PIC S9(8)V9(2) COMP-3. CUSMST +000034* CUSTOMER SALES LAST YEAR CUSMST 004700 88 004800 FD EXISTING-ORDER-DISPLAY-FILE. 89 004900 01 EXISTING-ORDER-DISPLAY-RECORD. 005000 COPY DDS-ALL-FORMATS OF ORDINQD. 90 +000001 05 ORDINQD-RECORD PIC X(171). <-ALL-FMTS +000002* I-O FORMAT:SUB1 FROM FILE ORDINQD OF LIBRARY CBLGUIDE <-ALL-FMTS +000003* <-ALL-FMTS 91 +000004 05 SUB1 REDEFINES ORDINQD-RECORD. <-ALL-FMTS 92 +000005 06 ITEM PIC S9(5). <-ALL-FMTS +000006* ITEM NUMBER <-ALL-FMTS 93 +000007 06 QTYORD PIC S9(3). <-ALL-FMTS +000008* QUANTITY ORDERED <-ALL-FMTS 94 +000009 06 DESCRP PIC X(30). <-ALL-FMTS 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 5 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000010* ITEM DESCRIPTION <-ALL-FMTS 95 +000011 06 PRICE PIC S9(4)V9(2). <-ALL-FMTS +000012* SELLING PRICE <-ALL-FMTS 96 +000013 06 EXTENS PIC S9(6)V9(2). <-ALL-FMTS +000014* EXTENSION AMOUNT OF QTYORD X PRICE <-ALL-FMTS +000015* INPUT FORMAT:SUBCTL1 FROM FILE ORDINQD OF LIBRARY CBLGUIDE <-ALL-FMTS +000016* <-ALL-FMTS 97 +000017 05 SUBCTL1-I REDEFINES ORDINQD-RECORD. <-ALL-FMTS 98 +000018 06 SUBCTL1-I-INDIC. <-ALL-FMTS 99 +000019 07 IN97 PIC 1 INDIC 97. <-ALL-FMTS +000020* CONTINUE DISPLAY <-ALL-FMTS 100 +000021 07 IN98 PIC 1 INDIC 98. <-ALL-FMTS +000022* END OF PROGRAM <-ALL-FMTS 101 +000023 07 IN57 PIC 1 INDIC 57. <-ALL-FMTS +000024* DISPLAY SUBFILE <-ALL-FMTS 102 +000025 07 IN58 PIC 1 INDIC 58. <-ALL-FMTS +000026* OFF = DISPLAY SUBCTL1 ON = CLEAR SUBFILE <-ALL-FMTS 103 +000027 07 IN61 PIC 1 INDIC 61. <-ALL-FMTS +000028* ORDER NUMBER NOT FOUND <-ALL-FMTS 104 +000029 07 IN47 PIC 1 INDIC 47. <-ALL-FMTS +000030* NO LINE FOR THIS ORDER <-ALL-FMTS 105 +000031 07 IN62 PIC 1 INDIC 62. <-ALL-FMTS +000032* NO CUSTOMER RECORD <-ALL-FMTS 106 +000033 06 ORDERN PIC S9(5). <-ALL-FMTS +000034* ORDER NUMBER <-ALL-FMTS +000035* OUTPUT FORMAT:SUBCTL1 FROM FILE ORDINQD OF LIBRARY CBLGUIDE <-ALL-FMTS +000036* <-ALL-FMTS 107 +000037 05 SUBCTL1-O REDEFINES ORDINQD-RECORD. <-ALL-FMTS 108 +000038 06 SUBCTL1-O-INDIC. <-ALL-FMTS 109 +000039 07 IN58 PIC 1 INDIC 58. <-ALL-FMTS +000040* OFF = DISPLAY SUBCTL1 ON = CLEAR SUBFILE <-ALL-FMTS 110 +000041 07 IN57 PIC 1 INDIC 57. <-ALL-FMTS +000042* DISPLAY SUBFILE <-ALL-FMTS 111 +000043 07 IN45 PIC 1 INDIC 45. <-ALL-FMTS 112 +000044 07 IN47 PIC 1 INDIC 47. <-ALL-FMTS +000045* NO LINE FOR THIS ORDER <-ALL-FMTS 113 +000046 07 IN61 PIC 1 INDIC 61. <-ALL-FMTS +000047* ORDER NUMBER NOT FOUND <-ALL-FMTS 114 +000048 07 IN62 PIC 1 INDIC 62. <-ALL-FMTS +000049* NO CUSTOMER RECORD <-ALL-FMTS 115 +000050 06 ORDERN PIC S9(5). <-ALL-FMTS +000051* ORDER NUMBER <-ALL-FMTS 116 +000052 06 ORDDAT PIC S9(6). <-ALL-FMTS +000053* DATE ORDER WAS ENTERED <-ALL-FMTS 117 +000054 06 CUST PIC X(5). <-ALL-FMTS +000055* CUSTOMER NUMBER <-ALL-FMTS 118 +000056 06 NAME PIC X(25). <-ALL-FMTS +000057* CUSTOMER NAME <-ALL-FMTS 119 +000058 06 ADDR PIC X(20). <-ALL-FMTS +000059* CUSTOMER ADDRESS <-ALL-FMTS 120 +000060 06 CITY PIC X(20). <-ALL-FMTS +000061* CUSTOMER CITY <-ALL-FMTS 121 +000062 06 STATE PIC X(2). <-ALL-FMTS +000063* CUSTOMER STATE <-ALL-FMTS 122 +000064 06 ZIP PIC S9(5). <-ALL-FMTS 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 6 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000065* ZIP CODE <-ALL-FMTS 123 +000066 06 ORDAMT PIC S9(6)V9(2). <-ALL-FMTS +000067* TOTAL AMOUNT OF ORDER <-ALL-FMTS 124 +000068 06 STSORD PIC X(12). <-ALL-FMTS 125 +000069 06 STSOPN PIC X(12). <-ALL-FMTS 126 +000070 06 CUSORD PIC X(15). <-ALL-FMTS +000071* CUSTOMER PURCHASE ORDER NUMBER <-ALL-FMTS 127 +000072 06 SHPVIA PIC X(15). <-ALL-FMTS +000073* SHIPPING INSTRUCTIONS <-ALL-FMTS 128 +000074 06 PRTDAT PIC S9(6). <-ALL-FMTS +000075* DATE ORDER WAS PRINTED <-ALL-FMTS 129 +000076 06 INVNUM PIC S9(5). <-ALL-FMTS +000077* INVOICE NUMBER <-ALL-FMTS 130 +000078 06 ACTMTH PIC S9(2). <-ALL-FMTS +000079* ACCOUNTING MONTH OF SALE <-ALL-FMTS 131 +000080 06 ACTYR PIC S9(2). <-ALL-FMTS +000081* ACCOUNTING YEAR OF SALE <-ALL-FMTS 005100 132 005200 WORKING-STORAGE SECTION. 133 005300 01 EXISTING-ORDER-DISPLAY-KEY. 134 005400 05 SUBFILE-RECORD-NUMBER PIC 9(2) 005500 VALUE ZERO. 005600 135 005700 01 ORDER-STATUS-COMMENT-VALUES. 136 005800 05 FILLER PIC X(12) 005900 VALUE "1-IN PROCESS". 137 006000 05 FILLER PIC X(12) 006100 VALUE "2-CONTINUED ". 138 006200 05 FILLER PIC X(12) 006300 VALUE "3-CREDIT CHK". 139 006400 05 FILLER PIC X(12) 006500 VALUE "4-READY PRT ". 140 006600 05 FILLER PIC X(12) 006700 VALUE "5-PRINTED ". 141 006800 05 FILLER PIC X(12) 006900 VALUE "6-PICKED ". 142 007000 05 FILLER PIC X(12) 007100 VALUE "7-INVOICED ". 143 007200 05 FILLER PIC X(12) 007300 VALUE "8-INVALID ". 144 007400 05 FILLER PIC X(12) 007500 VALUE "9-CANCELED ". 007600 145 007700 01 ORDER-STATUS-COMMENT-TABLE 007800 REDEFINES ORDER-STATUS-COMMENT-VALUES. 146 007900 05 ORDER-STATUS OCCURS 9 TIMES. 147 008000 10 ORDER-STATUS-COMMENT PIC X(12). 008100 148 008200 01 OPEN-STATUS-COMMENT-VALUES. 149 008300 05 FILLER PIC X(12) 008400 VALUE "1-OPEN ". 150 008500 05 FILLER PIC X(12) 008600 VALUE "2-CLOSED ". 151 008700 05 FILLER PIC X(12) 008800 VALUE "3-CANCELED ". 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 7 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 008900 152 009000 01 OPEN-STATUS-COMMENT-TABLE 009100 REDEFINES OPEN-STATUS-COMMENT-VALUES. 153 009200 05 OPEN-STATUS OCCURS 3 TIMES. 154 009300 10 OPEN-STATUS-COMMENT PIC X(12). 009400 155 009500 01 ERRHDL-PARAMETERS. 156 009600 05 STATUS-CODE-ONE PIC X(2). 157 009700 88 SUBFILE-IS-FULL VALUE "0M". 009800 158 009900 01 ERRPGM-PARAMETERS. 159 010000 05 DISPLAY-PARAMETER PIC X(8) 010100 VALUE "ORD220D ". 160 010200 05 DUMMY-ONE PIC X(6) 010300 VALUE SPACES. 161 010400 05 DUMMY-TWO PIC X(8) 010500 VALUE SPACES. 162 010600 05 STATUS-CODE-TWO. 163 010700 10 PRIMARY PIC X(1). 164 010800 10 SECONDARY PIC X(1). 165 010900 10 FILLER PIC X(5) 011000 VALUE SPACES. 011100 166 011200 01 SWITCH-AREA. 167 011300 05 SW01 PIC 1. 168 011400 88 NO-MORE-DETAIL-LINE-ITEMS VALUE B"1". 169 011500 88 MORE-DETAIL-LINE-ITEMS-EXIST VALUE B"0". 170 011600 05 SW02 PIC 1. 171 011700 88 WRITE-DISPLAY VALUE B"1". 172 011800 88 READ-DISPLAY VALUE B"0". 173 011900 05 SW03 PIC 1. 174 012000 88 SUBCTL1-FORMAT VALUE B"1". 175 012100 88 NOT-SUBCTL1-FORMAT VALUE B"0". 176 012200 05 SW04 PIC 1. 177 012300 88 SUB1-FORMAT VALUE B"1". 178 012400 88 NOT-SUB1-FORMAT VALUE B"0". 012500 179 012600 01 INDICATOR-AREA. 180 012700 05 IN98 PIC 1 INDIC 98. 181 012800 88 END-OF-EXISTING-ORDER-INQUIRY VALUE B"1". 182 012900 05 IN97 PIC 1 INDIC 97. 183 013000 88 CONTINUE-DETAIL-LINES-DISPLAY VALUE B"1". 184 013100 05 IN62 PIC 1 INDIC 62. 185 013200 88 CUSTOMER-NOT-FOUND VALUE B"1". 186 013300 88 CUSTOMER-EXIST VALUE B"0". 187 013400 05 IN61 PIC 1 INDIC 61. 188 013500 88 ORDER-NOT-FOUND VALUE B"1". 189 013600 88 ORDER-EXIST VALUE B"0". 190 013700 05 IN58 PIC 1 INDIC 58. 191 013800 88 CLEAR-SUBFILE VALUE B"1". 192 013900 88 DISPLAY-SUBFILE-CONTROL VALUE B"0". 193 014000 05 IN57 PIC 1 INDIC 57. 194 014100 88 DISPLAY-SUBFILE VALUE B"1". 195 014200 05 IN47 PIC 1 INDIC 47. 196 014300 88 NO-DETAIL-LINES-FOR-ORDER VALUE B"1". 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 8 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 197 014400 88 DETAIL-LINES-FOR-ORDER-EXIST VALUE B"0". 198 014500 05 IN45 PIC 1 INDIC 45. 199 014600 88 END-OF-ORDER VALUE B"1". 014700 200 014800 PROCEDURE DIVISION. 014900 201 015000 DECLARATIVES. 015100 TRANSACTION-ERROR SECTION. 015200 USE AFTER STANDARD ERROR PROCEDURE 015300 EXISTING-ORDER-DISPLAY-FILE. 015400 WORK-STATION-ERROR-HANDLER. 202 015500 IF NOT (SUBFILE-IS-FULL) THEN 203 015600 DISPLAY "WORK-STATION ERROR" STATUS-CODE-ONE 015700 END-IF. 015800 END DECLARATIVES. 015900 016000 MAIN-PROGRAM SECTION. 016100 MAINLINE. 204 016200 OPEN INPUT ORDER-HEADER-FILE 016300 ORDER-DETAIL-FILE 016400 CUSTOMER-MASTER-FILE 016500 I-O EXISTING-ORDER-DISPLAY-FILE. 205 016600 MOVE SPACES TO CUST OF SUBCTL1-O 016700 NAME OF SUBCTL1-O 016800 ADDR OF SUBCTL1-O 016900 CITY OF SUBCTL1-O 017000 STATE OF SUBCTL1-O 017100 STSORD OF SUBCTL1-O 017200 STSOPN OF SUBCTL1-O 017300 CUSORD OF SUBCTL1-O. 206 017400 MOVE ZEROS TO ORDERN OF SUBCTL1-O 017500 ORDDAT OF SUBCTL1-O 017600 ZIP OF SUBCTL1-O 017700 ORDAMT OF SUBCTL1-O 017800 PRTDAT OF SUBCTL1-O 017900 INVNUM OF SUBCTL1-O 018000 ACTMTH OF SUBCTL1-O 018100 ACTYR OF SUBCTL1-O. 207 018200 MOVE B"0" TO INDICATOR-AREA. 208 018300 SET READ-DISPLAY 018400 NOT-SUBCTL1-FORMAT 018500 NOT-SUB1-FORMAT TO TRUE. 209 018600 MOVE CORR INDICATOR-AREA TO SUBCTL1-O-INDIC. *** CORRESPONDING items for statement 209: *** IN62 *** IN61 *** IN58 *** IN57 *** IN47 *** IN45 *** End of CORRESPONDING items for statement 209 210 018700 WRITE EXISTING-ORDER-DISPLAY-RECORD FORMAT IS "SUBCTL1" 018800 END-WRITE 211 018900 READ EXISTING-ORDER-DISPLAY-FILE RECORD. 212 019000 MOVE CORR SUBCTL1-I-INDIC TO INDICATOR-AREA. 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 9 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE *** CORRESPONDING items for statement 212: *** IN97 *** IN98 *** IN57 *** IN58 *** IN61 *** IN47 *** IN62 *** End of CORRESPONDING items for statement 212 019100 213 019200 PERFORM EXISTING-ORDER-INQUIRY 019300 UNTIL END-OF-EXISTING-ORDER-INQUIRY. 019400 214 019500 CLOSE ORDER-HEADER-FILE 019600 ORDER-DETAIL-FILE 019700 CUSTOMER-MASTER-FILE 019800 EXISTING-ORDER-DISPLAY-FILE. 215 019900 STOP RUN. 020000 020100 EXISTING-ORDER-INQUIRY. 216 020200 IF CONTINUE-DETAIL-LINES-DISPLAY THEN 217 020300 PERFORM READ-NEXT-ORDER-DETAIL-RECORD 218 020400 IF MORE-DETAIL-LINE-ITEMS-EXIST THEN 219 020500 IF ORDERN OF ORDER-DETAIL-RECORD IS NOT EQUAL TO 020600 ORDERN OF ORDER-HEADER-RECORD THEN 220 020700 SET DISPLAY-SUBFILE TO TRUE 221 020800 SET NO-DETAIL-LINES-FOR-ORDER TO TRUE 020900 ELSE 222 021000 PERFORM SUBFILE-SET-UP 021100 END-IF 021200 ELSE 223 021300 SET DISPLAY-SUBFILE TO TRUE 224 021400 SET NO-DETAIL-LINES-FOR-ORDER TO TRUE 021500 END-IF 021600 ELSE 225 021700 PERFORM ORDER-NUMBER-VALIDATION 021800 END-IF 226 021900 MOVE CORR INDICATOR-AREA TO SUBCTL1-O-INDIC. *** CORRESPONDING items for statement 226: *** IN62 *** IN61 *** IN58 *** IN57 *** IN47 *** IN45 *** End of CORRESPONDING items for statement 226 227 022000 SET WRITE-DISPLAY TO TRUE. 228 022100 SET SUBCTL1-FORMAT TO TRUE. 229 022200 WRITE EXISTING-ORDER-DISPLAY-RECORD FORMAT IS "SUBCTL1". 230 022300 READ EXISTING-ORDER-DISPLAY-FILE RECORD. 231 022400 MOVE CORR SUBCTL1-I-INDIC TO INDICATOR-AREA. *** CORRESPONDING items for statement 231: *** IN97 *** IN98 *** IN57 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 10 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE *** IN58 *** IN61 *** IN47 *** IN62 *** End of CORRESPONDING items for statement 231 022500 022600 ORDER-NUMBER-VALIDATION. 232 022700 PERFORM READ-ORDER-HEADER-FILE. 233 022800 IF ORDER-EXIST THEN 234 022900 PERFORM READ-CUSTOMER-MASTER-FILE 235 023000 IF CUSTOMER-EXIST THEN 236 023100 PERFORM READ-FIRST-ORDER-DETAIL-RECORD 237 023200 IF DETAIL-LINES-FOR-ORDER-EXIST THEN 238 023300 PERFORM SUBFILE-SET-UP 023400 END-IF 023500 END-IF 023600 END-IF. 023700 023800 READ-ORDER-HEADER-FILE. 239 023900 MOVE ORDERN OF SUBCTL1-I OF EXISTING-ORDER-DISPLAY-RECORD 024000 TO ORDERN OF ORDER-HEADER-RECORD. 240 024100 READ ORDER-HEADER-FILE 241 024200 INVALID KEY SET ORDER-NOT-FOUND TO TRUE 024300 END-READ. 024400 024500 READ-CUSTOMER-MASTER-FILE. 242 024600 MOVE CUST OF ORDER-HEADER-RECORD 024700 TO CUST OF CUSTOMER-MASTER-RECORD. 243 024800 READ CUSTOMER-MASTER-FILE 244 024900 INVALID KEY SET CUSTOMER-NOT-FOUND TO TRUE 025000 END-READ. 025100 025200 READ-FIRST-ORDER-DETAIL-RECORD. 245 025300 MOVE ORDERN OF ORDER-HEADER-RECORD 025400 TO ORDERN OF ORDER-DETAIL-RECORD. 246 025500 MOVE 1 TO LINNUM OF ORDER-DETAIL-RECORD. 247 025600 READ ORDER-DETAIL-FILE 248 025700 INVALID KEY SET NO-DETAIL-LINES-FOR-ORDER TO TRUE 025800 END-READ. 025900 026000 SUBFILE-SET-UP. 249 026100 SET CLEAR-SUBFILE TO TRUE. 250 026200 MOVE CORR INDICATOR-AREA TO SUBCTL1-O-INDIC. *** CORRESPONDING items for statement 250: *** IN62 *** IN61 *** IN58 *** IN57 *** IN47 *** IN45 *** End of CORRESPONDING items for statement 250 251 026300 SET WRITE-DISPLAY TO TRUE. 252 026400 SET SUBCTL1-FORMAT TO TRUE. 253 026500 WRITE EXISTING-ORDER-DISPLAY-RECORD FORMAT IS "SUBCTL1" 026600 END-WRITE 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 03/09/15 15:06:50 Page 11 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 254 026700 SET DISPLAY-SUBFILE-CONTROL TO TRUE. 255 026800 PERFORM BUILD-DISPLAY-SUBFILE 026900 UNTIL NO-MORE-DETAIL-LINE-ITEMS OR SUBFILE-IS-FULL. 256 027000 MOVE CORR ORDHDR OF ORDER-HEADER-RECORD 027100 TO SUBCTL1-O OF EXISTING-ORDER-DISPLAY-RECORD. *** CORRESPONDING items for statement 256: *** CUST *** ORDERN *** ORDDAT *** CUSORD *** SHPVIA *** ORDAMT *** INVNUM *** PRTDAT *** ACTMTH *** ACTYR *** STATE *** End of CORRESPONDING items for statement 256 257 027200 MOVE CORR CUSMST OF CUSTOMER-MASTER-RECORD 027300 TO SUBCTL1-O OF EXISTING-ORDER-DISPLAY-RECORD. *** CORRESPONDING items for statement 257: *** CUST *** NAME *** ADDR *** CITY *** STATE *** ZIP *** End of CORRESPONDING items for statement 257 258 027400 MOVE ORDER-STATUS(ORDSTS) TO STSORD. 259 027500 MOVE OPEN-STATUS(OPNSTS) TO STSOPN. 260 027600 SET MORE-DETAIL-LINE-ITEMS-EXIST TO TRUE. 261 027700 MOVE ZEROS TO SUBFILE-RECORD-NUMBER. 027800 027900 BUILD-DISPLAY-SUBFILE. 262 028000 MOVE CORR ORDDTL OF ORDER-DETAIL-RECORD 028100 TO SUB1 OF EXISTING-ORDER-DISPLAY-RECORD. *** CORRESPONDING items for statement 262: *** ITEM *** QTYORD *** DESCRP *** PRICE *** EXTENS *** End of CORRESPONDING items for statement 262 263 028200 SET WRITE-DISPLAY TO TRUE. 264 028300 SET SUB1-FORMAT TO TRUE. 265 028400 ADD 1 TO SUBFILE-RECORD-NUMBER. 266 028500 WRITE SUBFILE EXISTING-ORDER-DISPLAY-RECORD FORMAT IS "SUB1" 028600 END-WRITE 267 028700 IF SUBFILE-IS-FULL THEN 268 028800 SET DISPLAY-SUBFILE TO TRUE 028900 ELSE 269 029000 PERFORM READ-NEXT-ORDER-DETAIL-RECORD 270 029100 IF MORE-DETAIL-LINE-ITEMS-EXIST THEN 271 029200 IF ORDERN OF ORDER-DETAIL-RECORD IS NOT EQUAL TO 029300 ORDERN OF ORDER-HEADER-RECORD THEN 272 029400 SET DISPLAY-SUBFILE TO TRUE 273 029500 SET NO-MORE-DETAIL-LINE-ITEMS TO TRUE 029600 END-IF 029700 END-IF 029800 END-IF. 029900 030000 READ-NEXT-ORDER-DETAIL-RECORD. 274 030100 READ ORDER-DETAIL-FILE NEXT RECORD 275 030200 AT END SET DISPLAY-SUBFILE TO TRUE 276 030300 SET NO-MORE-DETAIL-LINE-ITEMS TO TRUE 030400 END-READ. * * * * * E N D O F S O U R C E * * * * * |
This is the initial order-entry prompt display written to the workstation:
+--------------------------------------------------------------------------------+ |Existing Order Entry Total 000000000 | | Status | |Order 12400 Open | |Date 000000 Customer order | |Cust # Ship via | | 00000 Printed date 000000 | | Invoice 00000 Mth 00 Year 00 | |Item Qty Item Description Price Extension | | | +--------------------------------------------------------------------------------+
This display appears if there are detail order records for the customer whose order number was entered in the first display:
+--------------------------------------------------------------------------------+ |Existing Order Entry Total 007426656 | | Status 7-INVOICED | |Order 17924 ABC HARDWARE LTD. Open 2-CLOSED | |Date 110896 123 ANYWHERE AVE. Customer order TESTCS17933001I | |Cust # 11200 TORONTO Ship via TRUCKCO | | ONT M4K 0A0 Printed date 110896 | | Invoice 17924 Mth 12 Year 88 | |Item Qty Item Description Price Extension | |33001 003 TORQUE WRENCH 75LB 14 INCH 009115 273.45 | |33100 001 TORQUE WRENCH W/GAUGE 200 LB 015777 650.95 | |44529 004 WOOD CHISEL - 3 1/4 006840 56.87 | |44958 002 POWER DRILL 1/2 REV 008200 797.50 | |46102 001 WROUGHT IRON RAILING 4FTX6FT 007930 237.75 | |46201 001 WROUGHT IRON HAND RAIL 6FT 007178 77.35 | |47902 002 ESCUTCHEON BRASS 15X4 INCHES 044488 213.00 | +--------------------------------------------------------------------------------+
This display appears if the ORDHDRP file does not contain a record for the order number entered on the first display:
+--------------------------------------------------------------------------------+ |Existing Order Entry Total 000000000 | | Status | |Order 12400 Open | |Date 000000 Customer order | |Cust # Ship via | | 00000 Printed date 000000 | | Invoice 00000 Mth 00 Year 00 | |Item Qty Item Description Price Extension | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |Order number not found | | | +--------------------------------------------------------------------------------+
(C) Copyright IBM Corporation 1992, 2005. All Rights Reserved.