This program uses sequential access to update the file of summary sales records created in the CRTREL program. The updating program adds a record for the new year and deletes the oldest year's records from RELATIVE-FILE.
The input record represents the summary sales record for one week of the preceding year. The RELATIVE KEY for the RELATIVE-FILE is in the input record as INPUT-WEEK.
Figure 125. Example of a Relative File Update Program
5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/UPDTREL ISERIES1 03/09/15 14:50:35 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. UPDTREL. 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 SEQUENTIAL 13 001300 RELATIVE KEY INPUT-WEEK 14 001400 FILE STATUS RELATIVE-FILE-STATUS. 15 001500 SELECT INPUT-FILE ASSIGN TO DISK-FILES2 17 001600 ORGANIZATION IS SEQUENTIAL 18 001700 ACCESS IS SEQUENTIAL 19 001800 FILE STATUS INPUT-FILE-STATUS. 001900 20 002000 DATA DIVISION. 21 002100 FILE SECTION. 22 002200 FD RELATIVE-FILE. 23 002300 01 RELATIVE-RECORD PICTURE X(105). 24 002400 FD INPUT-FILE. 25 002500 01 INPUT-RECORD. 26 002600 05 INPUT-YEAR PICTURE 99. 27 002700 05 INPUT-WEEK PICTURE 99. 28 002800 05 INPUT-UNIT-SALES PICTURE S9(6). 29 002900 05 INPUT-DOLLAR-SALES PICTURE S9(9)V99. 003000 30 003100 WORKING-STORAGE SECTION. 31 003200 77 RELATIVE-FILE-STATUS PICTURE XX. 32 003300 77 INPUT-FILE-STATUS PICTURE XX. 33 003400 77 OP-NAME PICTURE X(7). 34 003500 01 WORK-RECORD. 35 003600 05 FILLER PICTURE X(21). 36 003700 05 CURRENT-WORK-YEARS PICTURE X(84). 37 003800 05 NEW-WORK-YEAR. 38 003900 10 WORK-YEAR PICTURE 99. 39 004000 10 WORK-WEEK PICTURE 99. 40 004100 10 WORK-UNIT-SALES PICTURE S9(6). 41 004200 10 WORK-DOLLAR-SALES PICTURE S9(9)V99. 42 004300 66 WORK-OUT-RECORD RENAMES 004400 CURRENT-WORK-YEARS THROUGH NEW-WORK-YEAR. 43 004500 01 INPUT-END PICTURE X VALUE SPACE. 44 004600 88 THE-END-OF-INPUT VALUE "E". 004700 45 004800 PROCEDURE DIVISION. 46 004900 DECLARATIVES. 005000 INPUT-ERROR SECTION. 005100 USE AFTER STANDARD ERROR PROCEDURE ON INPUT-FILE. 005200 INPUT-ERROR-PARA. 47 005300 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR INPUT-FILE ". 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/UPDTREL ISERIES1 03/09/15 14:50:35 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 48 005400 DISPLAY "FILE STATUS IS ", INPUT-FILE-STATUS. 49 005500 DISPLAY "PROCESSING ENDED" 50 005600 STOP RUN. 005700 005800 I-O-ERROR SECTION. 005900 USE AFTER STANDARD ERROR PROCEDURE ON RELATIVE-FILE. 006000 I-O-ERROR-PARA. 51 006100 DISPLAY "UNEXPECTED ERROR ON ", OP-NAME, " FOR RELATIVE-FILE". 52 006200 DISPLAY "FILE STATUS IS ", RELATIVE-FILE-STATUS. 53 006300 DISPLAY "PROCESSING ENDED" 54 006400 STOP RUN. 006500 END DECLARATIVES. 006600 006700 MAIN-PROGRAM SECTION. 006800 MAINLINE. 55 006900 MOVE "OPEN" TO OP-NAME. 56 007000 OPEN INPUT INPUT-FILE 007100 I-O RELATIVE-FILE. 007200 57 007300 MOVE "READ" TO OP-NAME. 58 007400 READ RELATIVE-FILE INTO WORK-RECORD 59 007500 AT END SET THE-END-OF-INPUT TO TRUE 007600 END-READ. 60 007700 READ INPUT-FILE INTO NEW-WORK-YEAR 61 007800 AT END SET THE-END-OF-INPUT TO TRUE 007900 END-READ. 008000 62 008100 PERFORM UNTIL THE-END-OF-INPUT 63 008200 MOVE "REWRITE" TO OP-NAME 64 008300 REWRITE RELATIVE-RECORD FROM WORK-OUT-RECORD 008400 65 008500 MOVE "READ" TO OP-NAME 66 008600 READ RELATIVE-FILE INTO WORK-RECORD 67 008700 AT END SET THE-END-OF-INPUT TO TRUE 008800 END-READ 68 008900 READ INPUT-FILE INTO NEW-WORK-YEAR 69 009000 AT END SET THE-END-OF-INPUT TO TRUE 009100 END-READ 009200 END-PERFORM. 009300 70 009400 MOVE "CLOSE" TO OP-NAME. 71 009500 CLOSE INPUT-FILE 009600 RELATIVE-FILE. 72 009700 STOP RUN. 009800 * * * * * E N D O F S O U R C E * * * * * |
(C) Copyright IBM Corporation 1992, 2005. All Rights Reserved.