相対ファイルの更新

このプログラムでは、CRTREL プログラムで作成された販売実績レコードのファイルを、順次アクセスを使って更新します。 更新プログラムは、新しい年のレコードを追加し、最も古い年のレコードを RELATIVE-FILE から削除します。

入力レコードは、前年の週ごとの販売実績レコードを表しています。 RELATIVE-FILE の RELATIVE KEY は、入力レコードの中に INPUT-WEEK として含まれています。

図 125. 相対ファイル更新プログラムの例
 5722WDS V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/UPDTREL         ISERIES1   06/02/15 14:50:35        ページ    2
                                     ソ ー ス
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
     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 V5R4M0  060210 LN  IBM ILE COBOL                 CBLGUIDE/UPDTREL         ISERIES1   06/02/15 14:50:35        ページ    3
  STMT PL SEQNO  -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN  S コピー名   変更日付
    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
                           * * * * *   ソ ー ス 仕 様 の 終 わ り   * * * * *