>>SOURCE FORMAT IS FREE *> cobol-input-validation.cob - an edit program: *> check every field of a fixed-width payment feed, write every error *> with a code, pass the clean records on, and print control totals *> Dialect: GnuCOBOL 3.x, free format *> Status : desk-checked against the GnuCOBOL 3.2 source and the *> GnuCOBOL Programmer's Guide; compiled and run with GnuCOBOL *> 3.2 on 2026-10-29 *> Inputs : datasets/cobol-input-validation-class-inspect-test-numval.dat *> (LINE SEQUENTIAL, LF line endings, 80 bytes per record) *> Outputs: accepted.dat (clean records, 67 bytes) and errors.txt (one *> line per error) in the current folder; totals on standard *> output; RETURN-CODE 4 when any record is rejected *> Build : cobc -x -I code code/cobol-input-validation.cob *> Run : ./cobol-input-validation (from the site folder) IDENTIFICATION DIVISION. PROGRAM-ID. PAYMENT-EDIT. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. *> Letters as three runs, so the classes mean the same on EBCDIC CLASS Capital IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" CLASS Letter IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" "a" THRU "i" "j" THRU "r" "s" THRU "z" CLASS Name-Char IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" "a" THRU "i" "j" THRU "r" "s" THRU "z" " " "'" "-" "." CLASS Ref-Char IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" "0" THRU "9" "-". INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT In-File ASSIGN TO "datasets/cobol-input-validation-class-inspect-test-numval.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-In-Status. SELECT Good-File ASSIGN TO "accepted.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Good-Status. SELECT Err-File ASSIGN TO "errors.txt" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Err-Status. DATA DIVISION. FILE SECTION. FD In-File. COPY "cobol-input-validation-class-inspect-test-numval.cpy". FD Good-File. 01 Good-Record. 05 Good-Account PIC X(8). 05 Good-Name PIC X(24). 05 Good-Currency PIC X(3). 05 Good-Amount PIC 9(5)V99. 05 Good-Value-Date PIC 9(8). 05 Good-Type PIC X. 05 Good-Reference PIC X(16). FD Err-File. 01 Err-Record PIC X(75). WORKING-STORAGE SECTION. 01 WS-Statuses. 05 WS-In-Status PIC X(2). 88 Read-Usable VALUE "00" "04" "06" "09". 05 WS-Good-Status PIC X(2). 05 WS-Err-Status PIC X(2). 01 WS-Eof-Flag PIC X VALUE "N". 88 End-Of-Input VALUE "Y". 01 WS-Long-Flag PIC X VALUE "N". 88 In-Long-Line VALUE "Y". 01 WS-Counts. 05 WS-Read PIC 9(6) VALUE 0. 05 WS-Accepted PIC 9(6) VALUE 0. 05 WS-Rejected PIC 9(6) VALUE 0. 05 WS-Errors PIC 9(6) VALUE 0. 05 WS-Rec-Errors PIC 9(2) VALUE 0. 01 WS-Accepted-Total PIC 9(9)V99 VALUE 0. 01 WS-Work. 05 WS-Lead-Spaces PIC 9(2). 05 WS-Ref-Len PIC 9(2). 05 WS-Ref-Spaces PIC 9(2). 05 WS-Numval-Pos PIC 9(2). 05 WS-Date-Result PIC 9. 05 WS-Amount-Wide PIC S9(7)V9(11). 05 WS-Amount PIC S9(7)V99. 05 WS-I PIC 9(2). 01 WS-Err-Work. 05 WS-Err-No PIC 9(2). 05 WS-Err-Value PIC X(24). 05 WS-Err-Len PIC 9(2). 05 WS-Err-Pos PIC 9(2) VALUE 0. *> The message for error n is entry n; the code printed is "E" and n. 01 Error-Texts. 05 FILLER PIC X(28) VALUE "RECORD LONGER THAN 80 BYTES". 05 FILLER PIC X(28) VALUE "CONTROL CHARACTER IN RECORD". 05 FILLER PIC X(28) VALUE "ACCOUNT NOT NUMERIC". 05 FILLER PIC X(28) VALUE "ACCOUNT NOT ZERO-FILLED". 05 FILLER PIC X(28) VALUE "NAME MISSING". 05 FILLER PIC X(28) VALUE "NAME HAS A BAD CHARACTER". 05 FILLER PIC X(28) VALUE "CURRENCY NOT 3 CAPITALS". 05 FILLER PIC X(28) VALUE "CURRENCY NOT ACCEPTED". 05 FILLER PIC X(28) VALUE "AMOUNT NOT A NUMBER". 05 FILLER PIC X(28) VALUE "AMOUNT HAS OVER 2 DECIMALS". 05 FILLER PIC X(28) VALUE "AMOUNT NOT 0.01 TO 50000.00". 05 FILLER PIC X(28) VALUE "DATE NOT NUMERIC". 05 FILLER PIC X(28) VALUE "DATE YEAR NOT 1601-9999". 05 FILLER PIC X(28) VALUE "DATE MONTH NOT 01-12". 05 FILLER PIC X(28) VALUE "DATE DAY NOT IN MONTH". 05 FILLER PIC X(28) VALUE "TYPE NOT P OR R". 05 FILLER PIC X(28) VALUE "REFUND WITHOUT REFERENCE". 05 FILLER PIC X(28) VALUE "REFERENCE HAS A SPACE". 05 FILLER PIC X(28) VALUE "REFERENCE HAS BAD CHARACTER". 01 Error-Table REDEFINES Error-Texts. 05 Err-Text PIC X(28) OCCURS 19 TIMES. 01 Code-Counts. 05 Code-Count PIC 9(4) OCCURS 19 TIMES. 01 Err-Line. 05 EL-Record PIC ZZZZZ9. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X VALUE "E". 05 EL-Code PIC 99. 05 FILLER PIC X(2) VALUE SPACES. 05 EL-Text PIC X(28). 05 FILLER PIC X(2) VALUE SPACES. 05 EL-Value PIC X(26). 05 FILLER PIC X VALUE SPACE. 05 EL-At PIC X(2). 05 FILLER PIC X VALUE SPACE. 05 EL-Pos PIC ZZ. 01 WS-Count-Out PIC ZZZ,ZZ9. 01 WS-Total-Out PIC ZZZ,ZZZ,ZZ9.99. PROCEDURE DIVISION. Main-Paragraph. PERFORM Open-Files PERFORM Read-In PERFORM UNTIL End-Of-Input PERFORM Take-Record PERFORM Read-In END-PERFORM CLOSE In-File Good-File Err-File PERFORM Show-Totals IF WS-Rejected > 0 MOVE 4 TO RETURN-CODE END-IF STOP RUN. Open-Files. OPEN INPUT In-File IF WS-In-Status NOT = "00" DISPLAY "Cannot open the payment feed, status " WS-In-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF OPEN OUTPUT Good-File Err-File IF WS-Good-Status NOT = "00" OR WS-Err-Status NOT = "00" DISPLAY "Cannot open the output files, status " WS-Good-Status " " WS-Err-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF INITIALIZE Code-Counts. Read-In. READ In-File AT END SET End-Of-Input TO TRUE END-READ. *> GnuCOBOL 3.2 returns a line longer than the record in pieces, the *> first with status 06. Count lines, not reads, and drop the pieces. Take-Record. IF NOT Read-Usable DISPLAY "Read failed after line " WS-Read ", status " WS-In-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF IF In-Long-Line IF WS-In-Status NOT = "06" MOVE "N" TO WS-Long-Flag END-IF ELSE ADD 1 TO WS-Read IF WS-In-Status = "06" SET In-Long-Line TO TRUE END-IF PERFORM Validate-Record END-IF. *> 04, 06 and 09 are successful reads, so AT END was not taken. Validate-Record. MOVE 0 TO WS-Rec-Errors EVALUATE WS-In-Status WHEN "00" PERFORM Check-Account PERFORM Check-Name PERFORM Check-Currency PERFORM Check-Amount PERFORM Check-Date PERFORM Check-Type PERFORM Check-Reference WHEN "04" WHEN "06" MOVE 1 TO WS-Err-No MOVE 0 TO WS-Err-Len PERFORM Add-Error WHEN "09" MOVE 2 TO WS-Err-No MOVE 0 TO WS-Err-Len PERFORM Add-Error END-EVALUATE IF WS-Rec-Errors = 0 PERFORM Write-Good ELSE ADD 1 TO WS-Rejected END-IF. Check-Account. MOVE In-Account TO WS-Err-Value MOVE LENGTH OF In-Account TO WS-Err-Len IF In-Account IS NOT NUMERIC MOVE 0 TO WS-Lead-Spaces INSPECT In-Account TALLYING WS-Lead-Spaces FOR LEADING SPACES EVALUATE TRUE WHEN WS-Lead-Spaces = 0 OR WS-Lead-Spaces = LENGTH OF In-Account MOVE 3 TO WS-Err-No WHEN In-Account (WS-Lead-Spaces + 1:) IS NUMERIC MOVE 4 TO WS-Err-No WHEN OTHER MOVE 3 TO WS-Err-No END-EVALUATE PERFORM Add-Error END-IF. Check-Name. MOVE In-Name TO WS-Err-Value MOVE LENGTH OF In-Name TO WS-Err-Len EVALUATE TRUE WHEN In-Name = SPACES MOVE 5 TO WS-Err-No PERFORM Add-Error WHEN In-Name (1:1) IS NOT Letter OR In-Name IS NOT Name-Char MOVE 6 TO WS-Err-No PERFORM Add-Error END-EVALUATE. Check-Currency. MOVE In-Currency TO WS-Err-Value MOVE LENGTH OF In-Currency TO WS-Err-Len EVALUATE TRUE WHEN In-Currency IS NOT Capital MOVE 7 TO WS-Err-No PERFORM Add-Error WHEN NOT Currency-Accepted MOVE 8 TO WS-Err-No PERFORM Add-Error END-EVALUATE. Check-Amount. MOVE In-Amount TO WS-Err-Value MOVE LENGTH OF In-Amount TO WS-Err-Len MOVE FUNCTION TEST-NUMVAL (In-Amount) TO WS-Numval-Pos IF WS-Numval-Pos NOT = 0 MOVE 9 TO WS-Err-No MOVE WS-Numval-Pos TO WS-Err-Pos PERFORM Add-Error ELSE COMPUTE WS-Amount-Wide = FUNCTION NUMVAL (In-Amount) ON SIZE ERROR MOVE 11 TO WS-Err-No PERFORM Add-Error NOT ON SIZE ERROR MOVE WS-Amount-Wide TO WS-Amount EVALUATE TRUE WHEN WS-Amount NOT = WS-Amount-Wide MOVE 10 TO WS-Err-No PERFORM Add-Error WHEN WS-Amount < 0.01 OR WS-Amount > 50000.00 MOVE 11 TO WS-Err-No PERFORM Add-Error END-EVALUATE END-COMPUTE END-IF. Check-Date. MOVE In-Value-Date-X TO WS-Err-Value MOVE LENGTH OF In-Value-Date-X TO WS-Err-Len IF In-Value-Date IS NOT NUMERIC MOVE 12 TO WS-Err-No PERFORM Add-Error ELSE MOVE FUNCTION TEST-DATE-YYYYMMDD (In-Value-Date) TO WS-Date-Result IF WS-Date-Result NOT = 0 COMPUTE WS-Err-No = 12 + WS-Date-Result PERFORM Add-Error END-IF END-IF. Check-Type. MOVE In-Type TO WS-Err-Value MOVE LENGTH OF In-Type TO WS-Err-Len EVALUATE TRUE WHEN NOT Type-Valid MOVE 16 TO WS-Err-No PERFORM Add-Error WHEN Type-Refund AND In-Reference = SPACES MOVE In-Reference TO WS-Err-Value MOVE LENGTH OF In-Reference TO WS-Err-Len MOVE 17 TO WS-Err-No PERFORM Add-Error END-EVALUATE. Check-Reference. IF In-Reference NOT = SPACES MOVE In-Reference TO WS-Err-Value MOVE LENGTH OF In-Reference TO WS-Err-Len MOVE 0 TO WS-Ref-Len WS-Ref-Spaces INSPECT In-Reference TALLYING WS-Ref-Len FOR CHARACTERS BEFORE INITIAL SPACE WS-Ref-Spaces FOR ALL SPACES EVALUATE TRUE WHEN WS-Ref-Len = 0 OR WS-Ref-Len + WS-Ref-Spaces < LENGTH OF In-Reference MOVE 18 TO WS-Err-No PERFORM Add-Error WHEN In-Reference (1:WS-Ref-Len) IS NOT Ref-Char MOVE 19 TO WS-Err-No PERFORM Add-Error END-EVALUATE END-IF. Add-Error. ADD 1 TO WS-Rec-Errors WS-Errors ADD 1 TO Code-Count (WS-Err-No) MOVE WS-Read TO EL-Record MOVE WS-Err-No TO EL-Code MOVE Err-Text (WS-Err-No) TO EL-Text MOVE SPACES TO EL-Value EL-At IF WS-Err-Len > 0 STRING "[" WS-Err-Value (1:WS-Err-Len) "]" DELIMITED BY SIZE INTO EL-Value END-STRING END-IF IF WS-Err-Pos > 0 MOVE "at" TO EL-At END-IF MOVE WS-Err-Pos TO EL-Pos MOVE 0 TO WS-Err-Pos WRITE Err-Record FROM Err-Line. Write-Good. ADD 1 TO WS-Accepted ADD WS-Amount TO WS-Accepted-Total MOVE In-Account TO Good-Account MOVE In-Name TO Good-Name MOVE In-Currency TO Good-Currency MOVE WS-Amount TO Good-Amount MOVE In-Value-Date TO Good-Value-Date MOVE In-Type TO Good-Type MOVE In-Reference TO Good-Reference WRITE Good-Record. Show-Totals. MOVE WS-Read TO WS-Count-Out DISPLAY "Records read : " WS-Count-Out MOVE WS-Accepted TO WS-Count-Out DISPLAY "Records accepted : " WS-Count-Out MOVE WS-Rejected TO WS-Count-Out DISPLAY "Records rejected : " WS-Count-Out MOVE WS-Errors TO WS-Count-Out DISPLAY "Errors written : " WS-Count-Out MOVE WS-Accepted-Total TO WS-Total-Out DISPLAY "Accepted amount : " WS-Total-Out DISPLAY "Errors by code:" PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 19 MOVE Code-Count (WS-I) TO WS-Count-Out DISPLAY " E" WS-I WS-Count-Out " " Err-Text (WS-I) END-PERFORM.