相対ファイルの検索

このプログラムは、CRTREL プログラムで作成された販売実績ファイルを、動的アクセスを使って検索します。

INPUT-FILE のレコードには 1 つの必要フィールド (INPUT-WEEK) が含まれており、 これが RELATIVE-FILE の RELATIVE KEY です。 また 1 つのオプショナル・フィールド (END-WEEK) も含まれています。 INPUT-WEEK にデータが含まれていて、END-WEEK にスペースが含まれている入力レコードは、 その 1 つの特定の RELATIVE-RECORD の印刷出力を要求します。 そのレコードはランダム・アクセスによって検索されます。 INPUT-WEEKEND-WEEK の両方にデータが含まれている入力レコードは、RELATIVE KEY が INPUT-WEEK から END-WEEK までの範囲にある RELATIVE-FILE レコードのすべての印刷出力を要求します。 それらのレコードは、順次アクセスによって取り出されます。

図 126. 相対ファイル検索プログラムの例
  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.
                           * * * * *   ソ ー ス 仕 様 の 終 わ り   * * * * *