図 149 に示すのは、サブファイルを使用する発注照会プログラムの例 ORDINQ です。 対応する DDS も示します (得意先マスター・ファイル CUSMSTP の DDS を除く)。 CUSMSTP の DDS については 図 132 を参照してください。
ORDINQ は、要求された注文番号に対応するすべての明細注文レコードを表示します。 このプログラムは、表示する注文番号を入力するようプロンプトを出します。 その注文番号を、注文ヘッダー・ファイルの ORDHDRP と比較します。 その注文番号が存在していれば、 その注文ヘッダー・ファイルからアクセスされた得意先番号が、得意先マスター・ファイル CUSMSTP のものと比較されます。 要求された注文に対する ORDDTLP 中のすべての明細注文レコードが読み取られ、サブファイルに書き込まれます。 サブファイル制御レコード様式に対する書き込みが処理され、サブファイル中の明細注文レコードが表示されます。 このプログラムは、F12 を押すと終了します。
....+....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
....+....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'
....+....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
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 2
ソ ー ス
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 3
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 4
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
+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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 5
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
+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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 6
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
+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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 7
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 8
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 9
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
*** 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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 10
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
*** 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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/ORDINQ ISERIES1 06/02/15 15:06:50 ページ 11
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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.
* * * * * ソ ー ス 仕 様 の 終 わ り * * * * *
これは、ワークステーションに表示される最初の注文入力プロンプトの表示画面です。
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
最初の表示画面に入力された注文番号に対応する得意先に対する詳細注文レコードが存在する場合、次の表示画面が表示されます。
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
次の表示画面は、最初の表示画面に入力された注文番号に対応するレコードが ORDHDRP ファイルに含まれていないときに表示されるものです。
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, 2006. All Rights Reserved.