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

      *> ============================================================
      *> main-matching-1-N : 合同↔通话明细匹配 (Contract↔CDR 1:N)
      *> Input : FILE-MAST (MASTER.DAT: 合同), FILE-DETL (DETAIL.DAT: CDR)
      *> Output: FILE-OUT (OUTPUT.DAT: 一致), FILE-ERR (ERROR.DAT: 不一致)
      *> Coverage: MT-N002, MT-N004, MT-N005, MT-R001
      *> ============================================================
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MATCHING-1N.

       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 60 CHARACTERS.
       01 OUT-REC.
           05 O-M-KEY      PIC X(10).
           05 O-M-NAME     PIC X(20).
           05 O-D-NAME     PIC X(20).
           05 O-AMOUNT     PIC 9(10).

       FD FILE-ERR RECORD CONTAINS 40 CHARACTERS.
       01 ERR-REC          PIC X(40).

       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-MAST-COUNT    PIC 9(10).
       01 WS-DETL-COUNT    PIC 9(10).
       01 WS-MATCH-COUNT   PIC 9(10).
       01 WS-MAST-REMAIN   PIC 9(10).
       01 WS-DETL-REMAIN   PIC 9(10).
       01 WS-MAST-KEY      PIC X(10).
       01 WS-MAST-NAME     PIC X(20).
       01 WS-MAST-AMT      PIC 9(10).
       01 WS-HAVE-MAST     PIC X(1) VALUE 'N'.
           88 WS-HAVE-MAST-Y VALUE 'Y' FALSE 'N'.

       PROCEDURE DIVISION.
       MAIN.
           DISPLAY "MATCHING-1N: Starting 1:N 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.

           PERFORM READ-MASTER.
           PERFORM UNTIL WS-EOF1-Y
               IF NOT WS-HAVE-MAST-Y
                   EXIT PERFORM
               END-IF

               MOVE M-KEY TO WS-MAST-KEY
               MOVE M-NAME TO WS-MAST-NAME
               MOVE M-AMOUNT TO WS-MAST-AMT
               ADD 1 TO WS-MAST-COUNT

               PERFORM READ-MASTER

               PERFORM UNTIL WS-EOF2-Y
                   IF D-KEY NOT = WS-MAST-KEY
                       EXIT PERFORM
                   END-IF
                   MOVE WS-MAST-KEY TO O-M-KEY
                   MOVE WS-MAST-NAME TO O-M-NAME
                   MOVE D-NAME TO O-D-NAME
                   MOVE D-AMOUNT TO O-AMOUNT
                   WRITE OUT-REC
                   ADD 1 TO WS-MATCH-COUNT
                   ADD 1 TO WS-DETL-COUNT
                   READ FILE-DETL INTO DETL-REC
                       AT END SET WS-EOF2-Y TO TRUE
                   END-READ
               END-PERFORM

               IF D-KEY > WS-MAST-KEY AND NOT WS-EOF2-Y
                   ADD 1 TO WS-MAST-REMAIN
                   STRING "MAST-REMAIN " WS-MAST-KEY
                       DELIMITED BY SIZE INTO ERR-REC
                   END-STRING
                   WRITE ERR-REC
               END-IF
           END-PERFORM.

           PERFORM UNTIL WS-EOF2-Y
               ADD 1 TO WS-DETL-REMAIN WS-DETL-COUNT
               STRING "DETL-REMAIN " D-KEY
                   DELIMITED BY SIZE INTO ERR-REC
               END-STRING
               WRITE ERR-REC
               READ FILE-DETL INTO DETL-REC
                   AT END SET WS-EOF2-Y TO TRUE
               END-READ
           END-PERFORM.

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

           DISPLAY "MATCH-1N: MASTER=" WS-MAST-COUNT
                   " DETL=" WS-DETL-COUNT
           DISPLAY "MATCH-1N: MATCHED=" WS-MATCH-COUNT
                   " M-REMAIN=" WS-MAST-REMAIN
                   " D-REMAIN=" WS-DETL-REMAIN

           IF WS-MATCH-COUNT > 0
               DISPLAY "MATCHING-1N: PASS"
               STOP RUN RETURNING 0
           ELSE
               DISPLAY "MATCHING-1N: FAIL"
               STOP RUN RETURNING 1
           END-IF
           .

       READ-MASTER.
           READ FILE-MAST INTO MAST-REC
               AT END
                   SET WS-EOF1-Y TO TRUE
                   MOVE 'N' TO WS-HAVE-MAST
               NOT AT END
                   SET WS-HAVE-MAST TO TRUE
           END-READ
           .

       END PROGRAM MATCHING-1N.