このプログラムは、CRTREL プログラムで作成された販売実績ファイルを、動的アクセスを使って検索します。
INPUT-FILE のレコードには 1 つの必要フィールド (INPUT-WEEK) が含まれており、 これが RELATIVE-FILE の RELATIVE KEY です。 また 1 つのオプショナル・フィールド (END-WEEK) も含まれています。 INPUT-WEEK にデータが含まれていて、END-WEEK にスペースが含まれている入力レコードは、 その 1 つの特定の RELATIVE-RECORD の印刷出力を要求します。 そのレコードはランダム・アクセスによって検索されます。 INPUT-WEEK と END-WEEK の両方にデータが含まれている入力レコードは、RELATIVE KEY が INPUT-WEEK から END-WEEK までの範囲にある RELATIVE-FILE レコードのすべての印刷出力を要求します。 それらのレコードは、順次アクセスによって取り出されます。
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 06/02/15 14:51:40 ページ 2
ソ ー ス
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
1 000100 IDENTIFICATION DIVISION.
2 000200 PROGRAM-ID. RTRVREL.
000300
3 000400 ENVIRONMENT DIVISION.
4 000500 CONFIGURATION SECTION.
5 000600 SOURCE-COMPUTER. IBM-ISERIES
6 000700 OBJECT-COMPUTER. IBM-ISERIES.
7 000800 INPUT-OUTPUT SECTION.
8 000900 FILE-CONTROL.
9 001000 SELECT RELATIVE-FILE ASSIGN TO DISK-FILED
11 001100 ORGANIZATION IS RELATIVE
12 001200 ACCESS IS DYNAMIC
13 001300 RELATIVE KEY INPUT-WEEK
14 001400 FILE STATUS IS RELATIVE-FILE-STATUS.
15 001500 SELECT INPUT-FILE ASSIGN TO DISK-FILEF
17 001600 FILE STATUS IS INPUT-FILE-STATUS.
18 001700 SELECT PRINT-FILE ASSIGN TO PRINTER-QSYSPRT
20 001800 FILE STATUS IS PRINT-FILE-STATUS.
001900
21 002000 DATA DIVISION.
22 002100 FILE SECTION.
23 002200 FD RELATIVE-FILE.
24 002300 01 RELATIVE-RECORD-01.
25 002400 05 RELATIVE-RECORD OCCURS 5 TIMES INDEXED BY REL-INDEX.
26 002500 10 RELATIVE-YEAR PICTURE 99.
27 002600 10 RELATIVE-WEEK PICTURE 99.
28 002700 10 RELATIVE-UNIT-SALES PICTURE S9(6).
29 002800 10 RELATIVE-DOLLAR-SALES PICTURE S9(9)V99.
30 002900 FD INPUT-FILE.
31 003000 01 INPUT-RECORD.
32 003100 05 INPUT-WEEK PICTURE 99.
33 003200 05 END-WEEK PICTURE 99.
34 003300 FD PRINT-FILE.
35 003400 01 PRINT-RECORD.
36 003500 05 PRINT-WEEK PICTURE 99.
37 003600 05 FILLER PICTURE X(5).
38 003700 05 PRINT-YEAR PICTURE 99.
39 003800 05 FILLER PICTURE X(5).
40 003900 05 PRINT-UNIT-SALES PICTURE ZZZ,ZZ9.
41 004000 05 FILLER PICTURE X(5).
42 004100 05 PRINT-DOLLAR-SALES PICTURE $$$$,$$$,$$$.99.
004200
43 004300 WORKING-STORAGE SECTION.
44 004400 77 RELATIVE-FILE-STATUS PICTURE XX.
45 004500 77 INPUT-FILE-STATUS PICTURE XX.
46 004600 77 PRINT-FILE-STATUS PICTURE XX.
47 004700 77 HIGH-WEEK PICTURE 99 VALUE 53.
48 004800 77 OP-NAME PICTURE X(9).
49 004900 01 INPUT-END PICTURE X(9).
50 005000 88 THE-END-OF-INPUT VALUE "E".
005100
51 005200 PROCEDURE DIVISION.
52 005300 DECLARATIVES.
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 06/02/15 14:51:40 ページ 3
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
005400 RELATIVE-FILE-ERROR SECTION.
005500 USE AFTER STANDARD ERROR PROCEDURE ON RELATIVE-FILE.
005600 RELATIVE-ERROR-PARA.
53 005700 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR RELATIVE-FILE".
54 005800 DISPLAY "FILE STATUS IS ", RELATIVE-FILE-STATUS.
55 005900 DISPLAY "PROCESSING ENDED"
56 006000 STOP RUN.
006100
006200 INPUT-FILE-ERROR SECTION.
006300 USE AFTER STANDARD ERROR PROCEDURE ON INPUT-FILE.
006400 INPUT-ERROR-PARA.
57 006500 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR INPUT-FILE ".
58 006600 DISPLAY "FILE STATUS IS ", INPUT-FILE-STATUS.
59 006700 DISPLAY "PROCESSING ENDED"
60 006800 STOP RUN.
006900
007000 PRINT-FILE-ERROR SECTION.
007100 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE.
007200 PRINT-ERROR-MSG.
61 007300 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR PRINT-FILE ".
62 007400 DISPLAY "FILE STATUS IS ", PRINT-FILE-STATUS.
63 007500 DISPLAY "PROCESSING ENDED"
64 007600 STOP RUN.
007700 END DECLARATIVES.
007800
007900 MAIN-PROGRAM SECTION.
008000 MAINLINE.
65 008100 MOVE "OPEN" TO OP-NAME.
66 008200 OPEN INPUT INPUT-FILE
008300 RELATIVE-FILE
008400 OUTPUT PRINT-FILE.
008500
67 008600 MOVE SPACES TO PRINT-RECORD.
68 008700 PERFORM READ-INPUT-FILE.
69 008800 PERFORM CONTROL-PROCESS THRU READ-INPUT-FILE
008900 UNTIL THE-END-OF-INPUT.
009000
70 009100 MOVE "CLOSE" TO OP-NAME.
71 009200 CLOSE RELATIVE-FILE
009300 INPUT-FILE
009400 PRINT-FILE.
72 009500 STOP RUN.
009600
009700 CONTROL-PROCESS.
73 009800 IF (END-WEEK = SPACES OR END-WEEK = 00)
74 009900 MOVE "READ" TO OP-NAME
75 010000 READ RELATIVE-FILE
76 010100 PERFORM PRINT-SUMMARY VARYING REL-INDEX FROM 1 BY 1
010200 UNTIL REL-INDEX > 5
010300 ELSE
77 010400 MOVE "READ" TO OP-NAME
78 010500 READ RELATIVE-FILE
79 010600 PERFORM READ-REL-SEQ
010700 UNTIL RELATIVE-WEEK(1) GREATER THAN END-WEEK
010800 END-IF.
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 06/02/15 14:51:40 ページ 4
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
010900
011000 READ-INPUT-FILE.
80 011100 MOVE "READ" TO OP-NAME.
81 011200 READ INPUT-FILE
82 011300 AT END SET THE-END-OF-INPUT TO TRUE
011400 END-READ.
011500
011600 READ-REL-SEQ.
83 011700 PERFORM PRINT-SUMMARY VARYING REL-INDEX FROM 1 BY 1
011800 UNTIL REL-INDEX > 5.
84 011900 MOVE "READ NEXT" TO OP-NAME.
85 012000 READ RELATIVE-FILE NEXT RECORD
86 012100 AT END MOVE HIGH-WEEK TO RELATIVE-WEEK(1)
012200 END-READ.
012300
012400 PRINT-SUMMARY.
87 012500 MOVE RELATIVE-YEAR (REL-INDEX) TO PRINT-YEAR.
88 012600 MOVE RELATIVE-WEEK (REL-INDEX) TO PRINT-WEEK.
89 012700 MOVE RELATIVE-UNIT-SALES (REL-INDEX) TO PRINT-UNIT-SALES.
90 012800 MOVE RELATIVE-DOLLAR-SALES(REL-INDEX) TO PRINT-DOLLAR-SALES.
91 012900 MOVE "WRITE" TO OP-NAME.
92 013000 WRITE PRINT-RECORD AFTER ADVANCING 2 LINES
013100 END-WRITE.
* * * * * ソ ー ス 仕 様 の 終 わ り * * * * *
(C) Copyright IBM Corporation 1992, 2006. All Rights Reserved.