This program, using dynamic access, retrieves the summary file created by the CRTREL program.
The records of the INPUT-FILE contain one required field (INPUT-WEEK), which is the RELATIVE KEY for RELATIVE-FILE, and one optional field (END-WEEK). An input record containing data in INPUT-WEEK and spaces in END-WEEK requests a printout for that one specific RELATIVE-RECORD; the record is retrieved through random access. An input record containing data in both INPUT-WEEK and END-WEEK requests a printout of all the RELATIVE-FILE records within the RELATIVE KEY range of INPUT-WEEK through END-WEEK inclusive. These records are retrieved through sequential access.
Figure 126. Example of a Relative File Retrieval Program
5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 03/09/15 14:51:40 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. 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 V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 03/09/15 14:51:40 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 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 V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/RTRVREL ISERIES1 03/09/15 14:51:40 Page 4 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 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. * * * * * E N D O F S O U R C E * * * * * |
(C) Copyright IBM Corporation 1992, 2005. All Rights Reserved.