Search code examples
cobolmainframe

Data validation for file and formatting the output


I'm trying to code a program to determine if different kinds of errors appear in a given file. I'm going to post my entire code, because I honestly have no idea where I'm going wrong here. It's just abending on me. The data validation is 2100-error-checking.

   IDENTIFICATION DIVISION.
   PROGRAM-ID. ASSIGNMENT1.
   AUTHOR.  AARON.

  ******************************************************************
   ENVIRONMENT DIVISION.
  *  defines the external files - an input file and output file
   INPUT-OUTPUT SECTION.
   FILE-CONTROL.


       SELECT DATVAL02 ASSIGN TO DATAIN
          FILE STATUS IS EF-STATUS.

       SELECT REPORT-FILE ASSIGN TO DATAOUT
          FILE STATUS IS PF-STATUS.

   DATA DIVISION.

   FILE SECTION.
   FD DATVAL02.
   01 SALES-RECORD.
       05 RECORD-CODE   PIC XX.
       05 FILLER        PIC X.
       05 VEND-NUM      PIC X(8).
       05 DATE-DUE.
            05 YEAR-DUE      PIC XX.
            05 MONTH-DUE     PIC XX.
            05 DAY-DUE       PIC XX.
       05 VEND-NAME     PIC X(20).
       05 FILLER        PIC XXX.
       05 AMT-DUE       PIC S9(6)V99.


   FD REPORT-FILE.
   01 REPORT-RECORD                PIC X(80).

   WORKING-STORAGE SECTION.

   01 FLAGS-AND-ACCUMLATORS.
       05 VALID-RECORDS     PIC S99 VALUE 0.
       05 INVALID-RECORDS   PIC S99 VALUE 0.
       05 EF-STATUS       PIC 99  VALUE 0.
       05 PF-STATUS       PIC 99  VALUE 0.
       05 A-ERROR           PIC X VALUE SPACE.
       05 C-ERROR           PIC X VALUE SPACE.
       05 E-ERROR           PIC X VALUE SPACE.
       05 F-ERROR           PIC X VALUE SPACE.
       05 B-ERROR           PIC X VALUE SPACE.
       05 D-ERROR           PIC X VALUE SPACE.
       05 G-ERROR           PIC X VALUE SPACE.
       05 H-ERROR           PIC X VALUE SPACE.
       05 I-ERROR           PIC X VALUE SPACE.
       05 A-AST             PIC XX VALUE SPACES.
       05 BC-AST            PIC X(8) VALUE SPACES.
       05 D-AST             PIC XX VALUE SPACES.
       05 E-AST             PIC XX VALUE SPACES.
       05 F-AST             PIC XX VALUE SPACES.
       05 G-AST             PIC X(15) VALUE SPACES.
       05 H-AST             PIC X(15) VALUE SPACES.
       05 I-AST             PIC X(8) VALUE SPACES.
       05 END-OF-FILE      PIC XXX VALUE "NO".
       05 ERROR-FLAG        PIC XXX VALUE SPACES.
       05 ERROR-FLAG2       PIC XXX VALUE SPACES.
       05 ERROR-FILLER      PIC XXX VALUE SPACES.
       05 VC                PIC XX VALUE "VC".
       05 NOO               PIC XX VALUE "NO".
       05 D-CHECK           PIC S9999999V99.
       05 DAY-DUE-NUM       PIC 99.
       05 MONTH-DUE-NUM     PIC 99.


   01 HEADING-LINE-1.
       05           PIC X(15) VALUE SPACES.
       05           PIC X(24) VALUE
            "VENDOR RECORD VALIDATION".
       05           PIC X(24) VALUE SPACES.
       05           PIC X(6)  VALUE
            "PAGE 1".

   01 HEADING-LINE-2.
       05           PIC XX VALUE
            "RC".
       05           PIC X VALUE SPACE.
       05           PIC X(8) VALUE
            "VENDOR #".
       05           PIC XX VALUE SPACES.
       05           PIC X(8) VALUE
            "DATE DUE".
       05           PIC XX VALUE SPACES.
       05           PIC X(11) VALUE
            "VENDOR NAME".
       05           PIC X(6) VALUE SPACES.
       05           PIC X(10) VALUE
            "AMOUNT DUE".
       05           PIC XXX VALUE SPACES.
       05           PIC X(16) VALUE
            "-- ERROR CODES--".

    01 DETAIL-LINE.
       05 RECORD-CODE-OUT           PIC XX.
       05                           PIC X VALUE SPACE.
       05 VEND-NUM-OUT              PIC X(8).
       05                           PIC XX VALUE SPACES.
       05 YEAR-DUE-OUT              PIC XX.
       05 MONTH-DUE-OUT             PIC XX.
       05 DAY-DUE-OUT               PIC XX.
       05                           PIC XX VALUE SPACES.
       05 VEND-NAME-OUT             PIC X(20).
       05                           PIC XX VALUE SPACES.
       05 AMT-DUE-OUT               PIC 999,999.99.
       05                           PIC XX VALUE SPACES.
       05 A-ERROR-OUT               PIC X VALUE SPACES.
       05                           PIC XX VALUE SPACES.
       05 B-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 C-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 D-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 E-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 F-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 G-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 H-ERROR-OUT               PIC X VALUE SPACE.
       05                           PIC XX VALUE SPACES.
       05 I-ERROR-OUT               PIC X VALUE SPACE.

   01 ASTERISK-LINE.
       05 A-AST-OUT                 PIC XX VALUE SPACES.
       05                           PIC X VALUE SPACE.
       05 BC-AST-OUT                PIC X(8) VALUE SPACES.
       05                           PIC XX VALUE SPACES.
       05 D-AST-OUT                 PIC XX VALUE SPACES.
       05                           PIC X VALUE SPACE.
       05 E-AST-OUT                 PIC XX VALUE SPACES.
       05                           PIC X VALUE SPACE.
       05 F-AST-OUT                 PIC XX VALUE SPACES.
       05                           PIC XX VALUE SPACES.
       05 G-AST-OUT                 PIC X(15) VALUE SPACES.
       05                           PIC XX VALUE SPACES.
       05 I-AST-OUT                 PIC X(8) VALUE SPACES.
       05                           PIC XX VALUE SPACES.
       05 H-AST-OUT                 PIC X(8) VALUE SPACES.


   01 RECORD-TOTALS.
       05                           PIC X(16) VALUE
            "VALID RECORDS: ".
       05 VALID-RECORDS-OUT         PIC 99.
       05                           PIC XX VALUE SPACES.
       05                           PIC X(17) VALUE
            "INVALID RECORDS: ".
       05 INVALID-RECORDS-OUT       PIC 99.

   PROCEDURE DIVISION.

   1000-MAIN-CONTROL.
       PERFORM 2000-INITIALIZE.
       PERFORM UNTIL END-OF-FILE = "YES"
         READ DATVAL02
           AT END
             MOVE "YES" TO END-OF-FILE
           NOT AT END
             PERFORM 2100-ERROR-ROUTINE
             IF ERROR-FLAG = "YES"
                PERFORM 2500-PROCESS
                PERFORM 3000-PROCESS
                PERFORM 4200-REINITILIZE
             END-IF
             IF ERROR-FLAG = "NO"
                PERFORM 2500-PROCESS
             END-IF
         END-READ
       END-PERFORM.
       PERFORM 4000-PROCESS.
       PERFORM 4500-TERMINATE.
       STOP RUN.

   2000-INITIALIZE.
       OPEN INPUT DATVAL02.
       OPEN OUTPUT REPORT-FILE.

       WRITE REPORT-RECORD         FROM HEADING-LINE-1.
       WRITE REPORT-RECORD         FROM HEADING-LINE-2.

   2100-ERROR-ROUTINE.
       MOVE "NO"                   TO ERROR-FLAG.
       MOVE "NO"                   TO ERROR-FLAG2.

       IF VEND-NUM = SPACES
           MOVE "YES"              TO ERROR-FLAG
           MOVE "********"         TO BC-AST-OUT
           MOVE "B"               TO B-ERROR-OUT
       END-IF.

       IF VEND-NUM IS NOT NUMERIC AND ERROR-FLAG = NOO
           MOVE "YES"              TO ERROR-FLAG
           MOVE "********"        TO BC-AST-OUT
           MOVE "C"                TO C-ERROR-OUT
       END-IF.

       IF RECORD-CODE IS NOT = VC
           MOVE "YES"              TO ERROR-FLAG
           MOVE "**"               TO A-AST-OUT
           MOVE "A"                TO A-ERROR-OUT
       END-IF.

       IF DATE-DUE IS NOT NUMERIC
           MOVE "YES"              TO ERROR-FLAG2
           MOVE "YES"              TO ERROR-FLAG
           MOVE "**"               TO D-AST-OUT
           MOVE "D"               TO D-ERROR-OUT
           MOVE "**"              TO E-AST-OUT
           MOVE "**"              TO F-AST-OUT
       END-IF.

       IF DATE-DUE = 0 AND ERROR-FLAG2 = NOO
          IF AMT-DUE IS > 0
              MOVE "YES"           TO ERROR-FLAG
              MOVE "YES"           TO ERROR-FLAG2
              MOVE "**"           TO D-AST-OUT
              MOVE "D"             TO D-ERROR-OUT
              MOVE "**"           TO E-AST-OUT
              MOVE "**"           TO F-AST-OUT
          END-IF
       END-IF.

       MOVE DAY-DUE TO DAY-DUE-NUM.
       MOVE MONTH-DUE TO MONTH-DUE-NUM.

       IF DAY-DUE-NUM > 31 OR DAY-DUE < 0 AND ERROR-FLAG2 = NOO
           MOVE "YES"              TO ERROR-FLAG
           MOVE "**"              TO E-AST-OUT
           MOVE "E"                TO E-ERROR-OUT
       END-IF.

       IF MONTH-DUE-NUM > 12 OR < 1 AND ERROR-FLAG2 = NOO
           MOVE "YES"              TO ERROR-FLAG
           MOVE "**"             TO F-AST-OUT
           MOVE "F"                TO F-ERROR-OUT
       END-IF.

       IF VEND-NAME = SPACES
           MOVE "YES"              TO ERROR-FLAG
           MOVE "***************"               TO G-AST-OUT
           MOVE "G"                TO G-ERROR-OUT
       END-IF.

       IF VEND-NAME(1:1) IS EQUAL TO SPACE
           MOVE "YES"              TO ERROR-FLAG
           MOVE "***************"         TO H-AST-OUT
           MOVE "H"                TO H-ERROR-OUT

       IF AMT-DUE IS NOT NUMERIC
           MOVE "YES"              TO ERROR-FLAG
           MOVE "********"               TO I-AST-OUT
           MOVE "I"               TO I-ERROR-OUT
       END-IF.

       IF ERROR-FLAG = "YES"
            ADD 1 TO INVALID-RECORDS
       END-IF.

       IF ERROR-FLAG = "NO"
           ADD 1 TO VALID-RECORDS
       END-IF.



   2500-PROCESS.
       MOVE RECORD-CODE    TO RECORD-CODE-OUT.
       MOVE VEND-NUM       TO VEND-NUM-OUT.
       MOVE YEAR-DUE       TO YEAR-DUE-OUT.
       MOVE MONTH-DUE      TO MONTH-DUE-OUT.
       MOVE DAY-DUE        TO DAY-DUE-OUT.
       MOVE VEND-NAME      TO VEND-NAME-OUT.
       MOVE AMT-DUE        TO AMT-DUE-OUT.

       WRITE REPORT-RECORD FROM DETAIL-LINE.

   3000-PROCESS.
       WRITE REPORT-RECORD FROM ASTERISK-LINE.

   4000-PROCESS.
       MOVE VALID-RECORDS      TO VALID-RECORDS-OUT.
       MOVE INVALID-RECORDS    TO INVALID-RECORDS-OUT.
       WRITE REPORT-RECORD     FROM RECORD-TOTALS.

   4200-REINITILIZE.
       MOVE A-ERROR            TO A-ERROR-OUT.
       MOVE B-ERROR            TO B-ERROR-OUT.
       MOVE C-ERROR            TO C-ERROR-OUT.
       MOVE D-ERROR            TO D-ERROR-OUT.
       MOVE E-ERROR            TO E-ERROR-OUT.
       MOVE F-ERROR            TO F-ERROR-OUT.
       MOVE G-ERROR            TO G-ERROR-OUT.
       MOVE H-ERROR            TO H-ERROR-OUT.
       MOVE I-ERROR            TO I-ERROR-OUT.
       MOVE A-AST              TO A-AST-OUT.
       MOVE BC-AST             TO BC-AST-OUT.
       MOVE D-AST              TO D-AST-OUT.
       MOVE E-AST              TO E-AST-OUT.
       MOVE F-AST              TO F-AST-OUT.
       MOVE G-AST              TO G-AST-OUT.
       MOVE H-AST              TO H-AST-OUT.
       MOVE I-AST              TO I-AST-OUT.
       MOVE ERROR-FILLER       TO ERROR-FLAG.
       MOVE ERROR-FILLER       TO ERROR-FLAG2.
       MOVE A-AST              TO DAY-DUE-NUM.
       MOVE A-AST              TO MONTH-DUE-NUM.
   4500-TERMINATE.
       CLOSE DATVAL02, REPORT-FILE.

Data in looks as such...

VC 10045380051005ABC ELECTRONICS        00001298
VT         000000                       00020000

Looking to achieve this

XX 9AAA9999  99/99/99       SHIFTED      12A 4GL 78   A   C   E F   H I
** ********     ** **  ***************   *** *** **

where * are under errors in the data. And letters show what errors are found.


Solution

  • In your latest version, you have made a group item (DATE-DUE) but you have not adjusted the level-numbers for the other date fields which are subordinate to it. I have made those three level 10. To use SYSIN data to be convenient for me, I added a 32-byte FILLER to the end of the input record.

    I compile, gets an RC/CC of 4, so the linkedit/binder runs.

    I used this data from your other question:

    VC 10045380051005ABC ELECTRONICS 00001298 VC 050926XYZ COMPANY 00R00549 VT 12348760051115QUALITY ASSURANCE CO 00400053 VC A14BCF80051201 00100930

    And got this output, with no abend:

                   VENDOR RECORD VALIDATION                        PAGE 1        
    RC VENDOR #  DATE DUE  VENDOR NAME      AMOUNT DUE   -- ERROR CODES--        
    VC 10045380  051005  ABC ELECTRONICS       000,012.98                        
    VC           050926  XYZ COMPANY           009,005.49     B                  
       ********                                                                  
    VT 12348760  051115  QUALITY ASSURANCE CO  004,000.53  A                     
    **                                                                           
    VC A14BCF80  051201                        001,009.30        C           G  H
       ********            ***************            ********                   
    VALID RECORDS:  01  INVALID RECORDS: 03 
    

    I have pasted the data from your other question.

    Note, if your actual data is incorrect, you may get an abend with the amount field.

    Note also what has happened to the R in the amount field. You haven't validated that for NUMERIC.


    I have now compiled and run your program with the two corrections (the VALUE clauses for the two counts, and the END-READ). Here is the output:

                   VENDOR RECORD VALIDATION                        PAGE 1
    RC VENDOR #  DATE DUE  VENDOR NAME      AMOUNT DUE   -- ERROR CODES--
    VC 10045380  051005  ABC ELECTRONICS       000,01298                 
    VT        0  000000                        000,20000     B           
       ********                                                          
    VALID RECORDS:  01  INVALID RECORDS: 01                              
    

    I used a fixed-length file, as I don't have access to your actual file, which must be variable-length (it is good to be explicit in the FD, then you don't get those I-informational messages at the end of your compile).

    You still have some things to sort out, but the program is running and producing output. If you make those code changes and still have problems, then it is your file that is in error.

    You have a very frustrating problem which seems to be down to the "environment". You need to be able to see your compile listings. If the compile fails (RC/CC above 4) then your linkedit/binder step won't run, and you won't get a new executable program. I think that is your problem, but you need help from your tutor to sort out how to find the compile listing and confirm that there are no errors.

    I have not used Rational Developer and don't know if you are using zPDT or are compiling on the Mainframe or how you'd look at the compiler output in either case from your Rational Developer session.

    Your code is basically OK for a learner, and probably has been for a couple of days. You have been struggling with a problem not directly to do with the code, but to do with not knowing your program had compile errors. Basically, except for a couple of typos, it was there.

    When you do get it running in your environment, update your Code Review question please.


    A really good thing to know is what compile produced the version of the program that you ran, whether or not it abended.

    You can display the date and time that the program was compiled:

       WORKING-STORAGE SECTION.
       01  W-WHEN-COMPILED                      PIC X(8)BX(8).
       ...
    

    Before doing anything else, other than identifying that it is the first time in a CALLed sub-program, something like this:

       MOVE WHEN-COMPILED                TO W-WHEN-COMPILED
       DISPLAY 
               "Program XXXXXXXX compiled on "
               W-WHEN-COMPILED
    

    The output you get will be the date/time from the actual compile of that program, matching exactly to the date/time on the compile listing.

    I've used code like that, and recommended it to others, for over 30 years, and it has saved shed-loads of time.

    There is also an intrinsic FUNCTION, WHEN-COMPILED. This is the same, but with a four-digit year. Since for the forseeable future the CC in the year will be 20 you can chose which one to do. Both are resolved at compile-time, and impact on run-time will be minimal.


    You have no END-READ. This gives you an E-level diagnostic from the compile, a Return-Code/Condition-Code of 8, and you linkedit/binder step following probably hasn't run (have a look at the COND for the step in file 2 of the spool for your job).

    Here is your code as a reminder:

     PERFORM UNTIL END-OF-FILE = "YES"
         READ DATVAL02
           AT END
             MOVE "YES" TO END-OF-FILE
           NOT AT END
             PERFORM 2100-ERROR-ROUTINE
             IF ERROR-FLAG = "YES"
                PERFORM 2500-PROCESS
                PERFORM 3000-PROCESS
             END-IF
             IF ERROR-FLAG = "NO"
                PERFORM 2500-PROCESS
             END-IF
       END-PERFORM.
    

    Here is what it could look like with the END-READ:

     PERFORM UNTIL END-OF-FILE = "YES"
         READ DATVAL02
           AT END
             MOVE "YES" TO END-OF-FILE
           NOT AT END
             PERFORM 2100-ERROR-ROUTINE
             IF ERROR-FLAG = "YES"
                PERFORM 2500-PROCESS
                PERFORM 3000-PROCESS
             END-IF
             IF ERROR-FLAG = "NO"
                PERFORM 2500-PROCESS
             END-IF
           END-READ
       END-PERFORM
    

    Since no new program has been linked, you are running the old program still and getting the old error still.


    You are adding to non-binary fields which you have not given an initial value.

       05 VALID-RECORDS     PIC S99.
       05 INVALID-RECORDS   PIC S99.
    
       IF ERROR-FLAG = "YES"
            ADD 1 TO INVALID-RECORDS
       END-IF.
    
       IF ERROR-FLAG = "NO"
           ADD 1 TO VALID-RECORDS
       END-IF.
    

    Without an initial value (either from a VALUE clause, or a MOVE or even the dread INITIALIZE), the value is undefined and is unlikely to be valid for a zoned-decimal field, so S0C7.

    Have a look at this: https://stackoverflow.com/a/17102485/1927206 to see if you can work out from that exactly where it is failing in your program.


    Program which compiles clean, with RC 0 and no diagnostic messages, and runs without abend:

       ID DIVISION.                                                     
       PROGRAM-ID. VARA.                                                
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
    
    
           SELECT DATVAL02 ASSIGN TO DATAIN
              FILE STATUS IS EF-STATUS.
    
           SELECT REPORT-FILE ASSIGN TO DATAOUT
              FILE STATUS IS PF-STATUS.
    
       DATA DIVISION.
    
       FILE SECTION.
       FD DATVAL02 RECORDING MODE F.
       01 SALES-RECORD.
           05 RECORD-CODE   PIC XX.
           05 FILLER        PIC X.
           05 VEND-NUM      PIC X(8).
           05 YEAR-DUE      PIC 99.
           05 MONTH-DUE     PIC 99.
           05 DAY-DUE       PIC 99.
           05 VEND-NAME     PIC X(20).
           05 FILLER        PIC XXX.
           05 AMT-DUE       PIC S9(6)V99.
           05  FILLER PIC X(32).
    
       FD REPORT-FILE RECORDING MODE F.
       01 REPORT-RECORD                PIC X(80).
    
       WORKING-STORAGE SECTION.
       01  W-WHEN-COMPILED             PIC X(8)BX(8).
    
       01 FLAGS-AND-ACCUMLATORS.
           05 VALID-RECORDS     PIC S99 VALUE ZERO.
           05 INVALID-RECORDS   PIC S99 VALUE ZERO.
           05   EF-STATUS       PIC 99  VALUE 0.
           05   PF-STATUS       PIC 99  VALUE 0.
           05 A-ERROR           PIC X VALUE SPACE.
           05 C-ERROR           PIC X VALUE SPACE.
           05 E-ERROR           PIC X VALUE SPACE.
           05 F-ERROR           PIC X VALUE SPACE.
           05 B-ERROR           PIC X VALUE SPACE.
           05 D-ERROR           PIC X VALUE SPACE.
           05 G-ERROR           PIC X VALUE SPACE.
           05 H-ERROR           PIC X VALUE SPACE.
           05 I-ERROR           PIC X VALUE SPACE.
           05 A-AST             PIC XX VALUE SPACES.
           05 BC-AST            PIC X(8) VALUE SPACES.
           05 D-AST             PIC XX VALUE SPACES.
           05 E-AST             PIC XX VALUE SPACES.
           05 F-AST             PIC XX VALUE SPACES.
           05 G-AST             PIC X(15) VALUE SPACES.
           05 I-AST             PIC X(8) VALUE SPACES.
           05  END-OF-FILE      PIC XXX VALUE "NO".
           05 ERROR-FLAG        PIC XXX VALUE SPACES.
           05 ERROR-FLAG2       PIC XXX VALUE SPACES.
           05 VC                PIC XX VALUE "VC".
           05 NOO               PIC XX VALUE "NO".
           05 D-CHECK           PIC S9999999V99.
    
    
       01 HEADING-LINE-1.
           05           PIC X(15) VALUE SPACES.
           05           PIC X(24) VALUE
                "VENDOR RECORD VALIDATION".
           05           PIC X(24) VALUE SPACES.
           05           PIC X(6)  VALUE
                "PAGE 1".
    
       01 HEADING-LINE-2.
           05           PIC XX VALUE
                "RC".
           05           PIC X VALUE SPACE.
           05           PIC X(8) VALUE
                "VENDOR #".
           05           PIC XX VALUE SPACES.
           05           PIC X(8) VALUE
                "DATE DUE".
           05           PIC XX VALUE SPACES.
           05           PIC X(11) VALUE
                "VENDOR NAME".
           05           PIC X(6) VALUE SPACES.
           05           PIC X(10) VALUE
                "AMOUNT DUE".
           05           PIC XXX VALUE SPACES.
           05           PIC X(16) VALUE
                "-- ERROR CODES--".
    
       01 DETAIL-LINE.
           05 RECORD-CODE-OUT           PIC XX.
           05                           PIC X VALUE SPACE.
           05 VEND-NUM-OUT              PIC 9(8).
           05                           PIC XX VALUE SPACES.
           05 YEAR-DUE-OUT              PIC XX.
           05 MONTH-DUE-OUT             PIC XX.
           05 DAY-DUE-OUT               PIC XX.
           05                           PIC XX VALUE SPACES.
           05 VEND-NAME-OUT             PIC X(20).
           05                           PIC XX VALUE SPACES.
           05 AMT-DUE-OUT               PIC 999,999.99.
           05                           PIC XX VALUE SPACES.
           05 A-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 B-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 C-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 D-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 E-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 F-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 G-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 H-ERROR-OUT               PIC X.
           05                           PIC XX VALUE SPACES.
           05 I-ERROR-OUT               PIC X.
    
       01 ASTERISK-LINE.
           05 A-AST-OUT                 PIC XX.
           05                           PIC X VALUE SPACE.
           05 BC-AST-OUT                PIC X(8).
           05                           PIC XX VALUE SPACES.
           05 D-AST-OUT                 PIC XX.
           05                           PIC X VALUE SPACE.
           05 E-AST-OUT                 PIC XX.
           05                           PIC X VALUE SPACE.
           05 F-AST-OUT                 PIC XX.
           05                           PIC XX VALUE SPACES.
           05 G-AST-OUT                 PIC X(15).
           05                           PIC XX VALUE SPACES.
           05 I-AST-OUT                 PIC X(8).
           05                           PIC XX VALUE SPACES.
           05 H-AST-OUT                 PIC X(8).
    
       01 RECORD-TOTALS.
           05                           PIC X(16) VALUE
                "VALID RECORDS: ".
           05 VALID-RECORDS-OUT         PIC 99.
           05                           PIC XX VALUE SPACES.
           05                           PIC X(17) VALUE
                "INVALID RECORDS: ".
           05 INVALID-RECORDS-OUT       PIC 99.
    
       PROCEDURE DIVISION.
    
       1000-MAIN-CONTROL.
           MOVE WHEN-COMPILED         TO W-WHEN-COMPILED
           DISPLAY
                   "TEST PROGRAM COMPILED ON "
                   W-WHEN-COMPILED
           PERFORM 2000-INITIALIZE.
           PERFORM UNTIL END-OF-FILE = "YES"
             READ DATVAL02
               AT END
                 MOVE "YES" TO END-OF-FILE
               NOT AT END
                 PERFORM 2100-ERROR-ROUTINE
                 IF ERROR-FLAG = "YES"
                    PERFORM 2500-PROCESS
                    PERFORM 3000-PROCESS
                 END-IF
                 IF ERROR-FLAG = "NO"
                    PERFORM 2500-PROCESS
                 END-IF
             END-READ
           END-PERFORM.
           PERFORM 4000-PROCESS.
           PERFORM 4500-TERMINATE.
           STOP RUN.
    
       2000-INITIALIZE.
           OPEN INPUT DATVAL02.
           OPEN OUTPUT REPORT-FILE.
    
           WRITE REPORT-RECORD         FROM HEADING-LINE-1.
           WRITE REPORT-RECORD         FROM HEADING-LINE-2.
    
       2100-ERROR-ROUTINE.
           MOVE "NO"                   TO ERROR-FLAG.
           MOVE "NO"                   TO ERROR-FLAG2.
    
           IF VEND-NUM = SPACES
               MOVE "YES"              TO ERROR-FLAG
               MOVE "********"         TO BC-AST-OUT
               MOVE "B"                TO B-ERROR-OUT
           END-IF.
    
    
           IF ERROR-FLAG = "YES"
                ADD 1 TO INVALID-RECORDS
           END-IF.
    
           IF ERROR-FLAG = "NO"
               ADD 1 TO VALID-RECORDS
           END-IF.
    
    
    
       2500-PROCESS.
           MOVE RECORD-CODE    TO RECORD-CODE-OUT.
           MOVE VEND-NUM       TO VEND-NUM-OUT.
           MOVE YEAR-DUE       TO YEAR-DUE-OUT.
           MOVE MONTH-DUE      TO MONTH-DUE-OUT.
           MOVE DAY-DUE        TO DAY-DUE-OUT.
           MOVE VEND-NAME      TO VEND-NAME-OUT.
           MOVE AMT-DUE        TO AMT-DUE-OUT.
    
           WRITE REPORT-RECORD FROM DETAIL-LINE.
    
       3000-PROCESS.
           WRITE REPORT-RECORD FROM ASTERISK-LINE.
    
       4000-PROCESS.
           MOVE VALID-RECORDS      TO VALID-RECORDS-OUT.
           MOVE INVALID-RECORDS    TO INVALID-RECORDS-OUT.
           WRITE REPORT-RECORD     FROM RECORD-TOTALS.
    
       4500-TERMINATE.
           CLOSE DATVAL02, REPORT-FILE.