このプログラムでは、CRTIND プログラムで作成された索引付きファイルを、動的アクセスを使って更新します。
入力レコードには、レコードのキー、預金者の名前、および取引き (トランザクション) 額が含まれています。
プログラムは、入力レコードを読み込んでから、次のことを判別します。
トランザクション・レコードを更新して印刷するのには、ランダム・アクセスを使用します。 1 つの総称クラスの中のすべてのレコードの検索と印刷には、順次アクセスを使用します。
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/UPDTIND ISERIES1 06/02/15 14:54:04 ページ 2
ソ ー ス
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
1 000100 IDENTIFICATION DIVISION.
2 000200 PROGRAM-ID. UPDTIND.
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 INDEXED-FILE ASSIGN TO DISK-INDXFILE
11 001100 ORGANIZATION IS INDEXED
12 001200 ACCESS IS DYNAMIC
13 001300 RECORD KEY IS INDEX-KEY
14 001400 FILE STATUS IS INDEXED-FILE-STATUS.
15 001500 SELECT INPUT-FILE ASSIGN TO DISK-FILEH
17 001600 FILE STATUS IS INPUT-FILE-STATUS.
18 001700 SELECT PRINT-FILE ASSIGN TO PRINTER-OSYSPRT
20 001800 FILE STATUS IS PRINT-FILE-STATUS.
001900
21 002000 DATA DIVISION.
22 002100 FILE SECTION.
23 002200 FD INDEXED-FILE.
24 002300 01 INDEX-RECORD.
25 002400 05 INDEX-KEY.
26 002500 10 INDEX-GEN-FLD PICTURE X(5).
27 002600 10 INDEX-DET-FLD PICTURE X(5).
28 002700 05 INDEX-FLD1 PICTURE X(10).
29 002800 05 INDEX-NAME PICTURE X(20).
30 002900 05 INDEX-BAL PICTURE S9(5)V99.
31 003000 FD INPUT-FILE.
32 003100 01 INPUT-REC.
33 003200 05 INPUT-KEY.
34 003300 10 INPUT-GEN-FLD PICTURE X(5).
35 003400 10 INPUT-DET-FLD PICTURE X(5).
36 003500 05 INPUT-NAME PICTURE X(20).
37 003600 05 INPUT-AMT PICTURE S9(5)V99.
38 003700 FD PRINT-FILE
003800 LINAGE 12 LINES FOOTING AT 9.
39 003900 01 PRINT-RECORD-1.
40 004000 05 PRINT-KEY PICTURE X(10).
41 004100 05 FILLER PICTURE X(5).
42 004200 05 PRINT-NAME PICTURE X(20).
43 004300 05 FILLER PICTURE X(5).
44 004400 05 PRINT-BAL PICTURE $$$,$$9.99-.
45 004500 05 FILLER PICTURE X(7).
46 004600 05 PRINT-AMT PICTURE $$$,$$9.99-.
47 004700 05 FILLER PICTURE X(5).
48 004800 05 PRINT-NEW-BAL PICTURE $$$,$$9.99-.
49 004900 01 PRINT-RECORD-2 PICTURE X(89).
005000
50 005100 WORKING-STORAGE SECTION.
51 005200 77 INDEXED-FILE-STATUS PICTURE XX.
52 005300 77 INPUT-FILE-STATUS PICTURE XX.
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/UPDTIND ISERIES1 06/02/15 14:54:04 ページ 3
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
53 005400 77 PRINT-FILE-STATUS PICTURE XX.
54 005500 77 OP-NAME PICTURE X(9).
55 005600 77 LINES-TO-FOOT PICTURE 99.
56 005700 01 PAGE-HEAD.
57 005800 05 FILLER PICTURE X(38) VALUE SPACES.
58 005900 05 FILLER PICTURE X(13) VALUE "UPDATE REPORT".
59 006000 05 FILLER PICTURE X(38) VALUE SPACES.
60 006100 01 COLUMN-HEAD.
61 006200 05 FILLER PICTURE X(6) VALUE "KEY ID".
62 006300 05 FILLER PICTURE X(9) VALUE SPACES.
63 006400 05 FILLER PICTURE X(4) VALUE "NAME".
64 006500 05 FILLER PICTURE X(21) VALUE SPACES.
65 006600 05 FILLER PICTURE X(11) VALUE "CUR BALANCE".
66 006700 05 FILLER PICTURE X(6) VALUE SPACES.
67 006800 05 FILLER PICTURE X(13) VALUE "UPDATE AMOUNT".
68 006900 05 FILLER PICTURE X(4) VALUE SPACES.
69 007000 05 FILLER PICTURE X(11) VALUE "NEW BALANCE".
70 007100 05 FILLER PICTURE X(4) VALUE SPACES.
71 007200 01 PAGE-FOOT.
72 007300 05 FILLER PICTURE X(81) VALUE SPACES.
73 007400 05 FILLER PICTURE A(6) VALUE "PAGE ".
74 007500 05 PG-NUMBER PICTURE 99 VALUE 00.
007600
75 007700 01 INPUT-END PICTURE X VALUE SPACE.
76 007800 88 THE-END-OF-INPUT VALUE "E".
007900
77 008000 PROCEDURE DIVISION.
78 008100 DECLARATIVES.
008200 INPUT-ERROR SECTION.
008300 USE AFTER STANDARD ERROR PROCEDURE ON INPUT-FILE.
008400 INPUT-ERROR-PARA.
79 008500 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR INPUT-FILE ".
80 008600 DISPLAY "FILE STATUS IS ", INPUT-FILE-STATUS.
81 008700 DISPLAY "PROCESSING ENDED"
82 008800 STOP RUN.
008900
009000 I-O-ERROR SECTION.
009100 USE AFTER STANDARD ERROR PROCEDURE ON INDEXED-FILE.
009200 I-O-ERROR-PARA.
83 009300 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR INDEXED-FILE ".
84 009400 DISPLAY "FILE STATUS IS ", INDEXED-FILE-STATUS.
85 009500 DISPLAY "PROCESSING ENDED"
86 009600 STOP RUN.
009700
009800 OUTPUT-ERROR SECTION.
009900 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE.
010000 OUTPUT-ERROR-PARA.
87 010100 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR PRINT-FILE ".
88 010200 DISPLAY "FILE STATUS IS ", PRINT-FILE-STATUS.
89 010300 DISPLAY "PROCESSING ENDED"
90 010400 STOP RUN.
010500 END DECLARATIVES.
010600
010700 MAIN-PROGRAM SECTION.
010800 MAINLINE.
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/UPDTIND ISERIES1 06/02/15 14:54:04 ページ 4
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
91 010900 MOVE "OPEN" TO OP-NAME.
92 011000 OPEN INPUT INPUT-FILE
011100 I-O INDEXED-FILE
011200 OUTPUT PRINT-FILE.
011300
93 011400 PERFORM PAGE-START.
94 011500 PERFORM READ-INPUT-FILE.
95 011600 PERFORM PROCESS-DATA THRU READ-INPUT-FILE
011700 UNTIL THE-END-OF-INPUT.
96 011800 PERFORM PAGE-END.
011900
97 012000 MOVE "CLOSE" TO OP-NAME.
98 012100 CLOSE INPUT-FILE
012200 INDEXED-FILE
012300 PRINT-FILE.
99 012400 STOP RUN.
012500
012600 PROCESS-DATA.
100 012700 IF INPUT-DET-FLD EQUAL SPACES
101 012800 MOVE INPUT-GEN-FLD TO INDEX-GEN-FLD
102 012900 MOVE "START" TO OP-NAME
103 013000 START INDEXED-FILE
013100 KEY IS NOT LESS THAN INDEX-GEN-FLD
013200 END-START
104 013300 PERFORM SEQUENTIAL-PROCESS
013400 UNTIL INPUT-GEN-FLD NOT EQUAL INDEX-GEN-FLD
013500 ELSE
105 013600 MOVE INPUT-KEY TO INDEX-KEY
106 013700 MOVE "READ" TO OP-NAME
107 013800 READ INDEXED-FILE
108 013900 IF INPUT-GEN-FLD EQUAL INDEX-GEN-FLD THEN
109 014000 MOVE INDEX-KEY TO PRINT-KEY
110 014100 MOVE INDEX-NAME TO PRINT-NAME
111 014200 MOVE INDEX-BAL TO PRINT-BAL
112 014300 MOVE INPUT-AMT TO PRINT-AMT
113 014400 ADD INPUT-AMT TO INDEX-BAL
114 014500 MOVE INDEX-BAL TO PRINT-NEW-BAL
115 014600 PERFORM PRINT-DETAIL
116 014700 MOVE "REWRITE" TO OP-NAME
117 014800 REWRITE INDEX-RECORD
014900 END-IF
015000 END-IF.
015100
015200 READ-INPUT-FILE.
118 015300 MOVE "READ" TO OP-NAME.
119 015400 READ INPUT-FILE
120 015500 AT END SET THE-END-OF-INPUT TO TRUE
015600 END-READ.
015700
015800 SEQUENTIAL-PROCESS.
121 015900 MOVE "READ NEXT" TO OP-NAME.
122 016000 READ INDEXED-FILE NEXT RECORD
123 016100 AT END MOVE HIGH-VALUE TO INDEX-GEN-FLD
016200 END-READ.
124 016300 IF INPUT-GEN-FLD EQUAL INDEX-GEN-FLD THEN
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/UPDTIND ISERIES1 06/02/15 14:54:04 ページ 5
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
125 016400 MOVE INDEX-KEY TO PRINT-KEY
126 016500 MOVE INDEX-NAME TO PRINT-NAME
127 016600 MOVE INDEX-BAL TO PRINT-NEW-BAL
128 016700 PERFORM PRINT-DETAIL
016800 END-IF.
016900
017000 PRINT-DETAIL.
129 017100 MOVE "WRITE" TO OP-NAME.
130 017200 WRITE PRINT-RECORD-1
017300 AT END-OF-PAGE
131 017400 PERFORM PAGE-END THROUGH PAGE-START
017500 END-WRITE.
132 017600 MOVE SPACES TO PRINT-RECORD-1.
017700
017800 PAGE-END.
133 017900 MOVE "WRITE" TO OP-NAME.
134 018000 ADD 1 TO PG-NUMBER.
135 018100 SUBTRACT LINAGE-COUNTER OF PRINT-FILE FROM 12
018200 GIVING LINES-TO-FOOT.
136 018300 MOVE SPACES TO PRINT-RECORD-1.
137 018400 WRITE PRINT-RECORD-1
018500 AFTER ADVANCING LINES-TO-FOOT
018600 END-WRITE.
138 018700 WRITE PRINT-RECORD-2 FROM PAGE-FOOT
018800 BEFORE ADVANCING PAGE
018900 END-WRITE.
019000
019100 PAGE-START.
139 019200 WRITE PRINT-RECORD-2 FROM PAGE-HEAD
019300 AFTER ADVANCING 1 LINE
019400 END-WRITE.
140 019500 MOVE SPACES TO PRINT-RECORD-2.
141 019600 WRITE PRINT-RECORD-2 FROM COLUMN-HEAD
019700 AFTER ADVANCING 1 LINE
019800 END-WRITE.
142 019900 MOVE SPACES TO PRINT-RECORD-2.
* * * * * ソ ー ス 仕 様 の 終 わ り * * * * *
(C) Copyright IBM Corporation 1992, 2006. All Rights Reserved.