cobol-java-v3/benchmark-programs/01-matching-1-1/main-matching-1-1.cbl

      *> ============================================================
      *> main-matching-1-1 : 请求书↔支付对账 (Invoice↔Payment Matching)
      *> Input : FILE-MAST (MASTER.DAT: 请求书), FILE-DETL (DETAIL.DAT: 支付)
      *> Output: FILE-OUT (OUTPUT.DAT: 一致), FILE-ERR (ERROR.DAT: 不一致)
      *> Coverage: MT-N001, MT-N004, MT-N005, MT-N006, MT-R001
      *> ============================================================
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MATCHING-11.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FILE-MAST ASSIGN TO "MASTER.DAT"
               ORGANIZATION IS SEQUENTIAL
               FILE STATUS IS WS-FS1.

           SELECT FILE-DETL ASSIGN TO "DETAIL.DAT"
               ORGANIZATION IS SEQUENTIAL
               FILE STATUS IS WS-FS2.

           SELECT FILE-OUT  ASSIGN TO "OUTPUT.DAT"
               ORGANIZATION IS SEQUENTIAL.

           SELECT FILE-ERR  ASSIGN TO "ERROR.DAT"
               ORGANIZATION IS SEQUENTIAL.

       DATA DIVISION.
       FILE SECTION.
       FD FILE-MAST RECORD CONTAINS 40 CHARACTERS.
       01 MAST-REC.
           05 M-KEY        PIC X(10).
           05 M-NAME       PIC X(20).
           05 M-AMOUNT     PIC 9(10).

       FD FILE-DETL RECORD CONTAINS 40 CHARACTERS.
       01 DETL-REC.
           05 D-KEY        PIC X(10).
           05 D-NAME       PIC X(20).
           05 D-AMOUNT     PIC 9(10).

       FD FILE-OUT RECORD CONTAINS 40 CHARACTERS.
       01 OUT-REC.
           05 O-KEY        PIC X(10).
           05 O-NAME       PIC X(20).
           05 O-AMOUNT     PIC 9(10).

       FD FILE-ERR RECORD CONTAINS 80 CHARACTERS.
       01 ERR-REC.
           05 ERR-TYPE     PIC X(10).
           05 ERR-KEY      PIC X(10).
           05 ERR-NAME     PIC X(20).
           05 ERR-AMOUNT   PIC 9(10).
           05 ERR-FILLER   PIC X(30).

       WORKING-STORAGE SECTION.
       01 WS-FS1           PIC X(2).
       01 WS-FS2           PIC X(2).
       01 WS-EOF1          PIC X(1) VALUE 'N'.
           88 WS-EOF1-Y    VALUE 'Y' FALSE 'N'.
       01 WS-EOF2          PIC X(1) VALUE 'N'.
           88 WS-EOF2-Y    VALUE 'Y' FALSE 'N'.
       01 WS-READ-MAST     PIC 9(10).
       01 WS-READ-DETL     PIC 9(10).
       01 WS-WRITTEN       PIC 9(10).
       01 WS-UNMATCH-MAST  PIC 9(10).
       01 WS-UNMATCH-DETL  PIC 9(10).

       PROCEDURE DIVISION.
       MAIN.
           DISPLAY "MATCHING-11: Starting 1:1 matching"

           OPEN INPUT FILE-MAST FILE-DETL.
           OPEN OUTPUT FILE-OUT FILE-ERR.
           IF WS-FS1 NOT = "00" OR WS-FS2 NOT = "00"
               DISPLAY "OPEN FAIL: MAST=" WS-FS1 " DETL=" WS-FS2
               STOP RUN RETURNING 1
           END-IF.

           READ FILE-MAST INTO MAST-REC
               AT END SET WS-EOF1-Y TO TRUE
           END-READ.
           READ FILE-DETL INTO DETL-REC
               AT END SET WS-EOF2-Y TO TRUE
           END-READ.

           PERFORM UNTIL WS-EOF1-Y AND WS-EOF2-Y
               IF WS-EOF1-Y
                   PERFORM WRITE-DETL-REMAINING
               ELSE IF WS-EOF2-Y
                   PERFORM WRITE-MAST-REMAINING
               ELSE
                   IF M-KEY = D-KEY
                       PERFORM MATCH-FOUND
                   ELSE IF M-KEY < D-KEY
                       PERFORM MAST-UNMATCHED
                   ELSE
                       PERFORM DETL-UNMATCHED
                   END-IF
               END-IF
           END-PERFORM.

           CLOSE FILE-MAST FILE-DETL FILE-OUT FILE-ERR.

           DISPLAY "MATCH: MASTER-READ=" WS-READ-MAST
                   " DETL-READ=" WS-READ-DETL
           DISPLAY "MATCH: MATCHED=" WS-WRITTEN
                   " UNMATCH-MAST=" WS-UNMATCH-MAST
                   " UNMATCH-DETL=" WS-UNMATCH-DETL

           IF WS-WRITTEN > 0
               DISPLAY "MATCHING-11: PASS"
               STOP RUN RETURNING 0
           ELSE
               DISPLAY "MATCHING-11: FAIL - no matches"
               STOP RUN RETURNING 1
           END-IF
           .

       MATCH-FOUND.
           ADD 1 TO WS-READ-MAST WS-READ-DETL WS-WRITTEN.
           MOVE M-KEY TO O-KEY.
           MOVE M-NAME TO O-NAME.
           MOVE M-AMOUNT TO O-AMOUNT.
           WRITE OUT-REC.

           READ FILE-MAST INTO MAST-REC
               AT END SET WS-EOF1-Y TO TRUE
           END-READ.
           READ FILE-DETL INTO DETL-REC
               AT END SET WS-EOF2-Y TO TRUE
           END-READ.
           .

       MAST-UNMATCHED.
           ADD 1 TO WS-READ-MAST WS-UNMATCH-MAST.
           MOVE "MAST-UNMTC" TO ERR-TYPE.
           MOVE M-KEY TO ERR-KEY.
           MOVE M-NAME TO ERR-NAME.
           MOVE M-AMOUNT TO ERR-AMOUNT.
           WRITE ERR-REC.

           READ FILE-MAST INTO MAST-REC
               AT END SET WS-EOF1-Y TO TRUE
           END-READ.
           .

       DETL-UNMATCHED.
           ADD 1 TO WS-READ-DETL WS-UNMATCH-DETL.
           MOVE "DETL-UNMTC" TO ERR-TYPE.
           MOVE D-KEY TO ERR-KEY.
           MOVE D-NAME TO ERR-NAME.
           MOVE D-AMOUNT TO ERR-AMOUNT.
           WRITE ERR-REC.

           READ FILE-DETL INTO DETL-REC
               AT END SET WS-EOF2-Y TO TRUE
           END-READ.
           .

       WRITE-DETL-REMAINING.
           ADD 1 TO WS-READ-DETL WS-UNMATCH-DETL.
           MOVE "DETL-REMAIN" TO ERR-TYPE.
           MOVE D-KEY TO ERR-KEY.
           MOVE D-NAME TO ERR-NAME.
           MOVE D-AMOUNT TO ERR-AMOUNT.
           WRITE ERR-REC.
           READ FILE-DETL INTO DETL-REC
               AT END SET WS-EOF2-Y TO TRUE
           END-READ.
           .

       WRITE-MAST-REMAINING.
           ADD 1 TO WS-READ-MAST WS-UNMATCH-MAST.
           MOVE "MAST-REMAIN" TO ERR-TYPE.
           MOVE M-KEY TO ERR-KEY.
           MOVE M-NAME TO ERR-NAME.
           MOVE M-AMOUNT TO ERR-AMOUNT.
           WRITE ERR-REC.
           READ FILE-MAST INTO MAST-REC
               AT END SET WS-EOF1-Y TO TRUE
           END-READ.
           .

       END PROGRAM MATCHING-11.