文件的数据验证和格式化输出
Data validation for file and formatting the output
我正在尝试编写程序以确定给定文件中是否出现不同类型的错误。我要 post 我的整个代码，因为老实说我不知道我哪里出错了。它只是在我身上消失了。数据校验为 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.
数据看起来是这样的...
VC 10045380051005ABC ELECTRONICS 00001298
VT 000000 00020000
希望实现这一目标
XX 9AAA9999 99/99/99 SHIFTED 12A 4GL 78 A C E F H I
** ******** ** ** *************** *** *** **
其中 * 在数据中存在错误。字母显示发现的错误。
在您的最新版本中，您创建了一个组项(DATE-DUE)，但您没有调整从属于它的其他日期字段的级别编号。这三个我都做了10级。为了方便我使用SYSIN数据，我在输入记录的末尾添加了一个32字节的FILLER。
我编译，得到 4 的 RC/CC，所以 linkedit/binder 运行s.
我使用了你另一个问题的数据：
VC 10045380051005ABC 电子 00001298
VC 050926XYZ 公司 00R00549
VT 12348760051115质量保证公司 00400053
VC A14BCF80051201 00100930
得到这个输出，没有异常结束：
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
我已经粘贴了你另一个问题的数据。
请注意，如果您的实际数据不正确，金额字段可能会异常终止。
另请注意金额字段中的 R 发生了什么。您尚未验证 NUMERIC。
我现在已经编译 运行 您的程序并进行了两次更正（两次计数的 VALUE 子句和 END-READ）。这是输出：
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
我使用了一个固定长度的文件，因为我无法访问你的实际文件，它必须是可变长度的（最好在 FD 中明确，然后你就不会得到那些我-编译结束时的信息性消息）。
您还有一些事情需要解决，但程序正在 运行 正在生成输出。如果您更改了这些代码但仍然有问题，那么就是您的文件有误。
您有一个非常令人沮丧的问题，似乎是 "environment" 造成的。您需要能够看到您的编译列表。如果编译失败（RC/CC 以上 4），那么您的 linkedit/binder 步骤将不会 运行，并且您不会获得新的可执行程序。我觉得是你的问题，但是需要你的导师帮忙整理一下如何找到编译清单并确认没有错误。
我没有使用过 Rational Developer，不知道您是在使用 zPDT 还是在大型机上进行编译，或者您如何看待 Rational Developer 会话中两种情况下的编译器输出。
您的代码对于初学者来说基本上还可以，可能已经用了几天了。您一直在努力解决与代码无关的问题，而是与不知道您的程序存在编译错误有关的问题。基本上，除了几个错别字外，它就在那里。
当您在您的环境中运行获得它时，请更新您的代码审查问题。
真正值得了解的是什么编译生成了您 运行 的程序版本，无论它是否异常终止。
您可以显示程序编译的日期和时间：
WORKING-STORAGE SECTION.
01 W-WHEN-COMPILED PIC X(8)BX(8).
...
在做任何事情之前，除了确定它是第一次在 CALLed 子程序中，像这样：
MOVE WHEN-COMPILED TO W-WHEN-COMPILED
DISPLAY
"Program XXXXXXXX compiled on "
W-WHEN-COMPILED
您得到的输出将是该程序实际编译的 date/time，与编译列表中的 date/time 完全匹配。
30 多年来，我一直使用这样的代码并将其推荐给其他人，它节省了大量时间。
还有一个内在函数，WHEN-COMPILED。这是相同的，但年份是四位数。因为在可预见的未来，一年中的CC将是20个，你可以选择做哪一个。两者都在编译时解决，对 运行 时间的影响将很小。
您没有 END-READ。这为您提供了来自编译的 E 级诊断，Return-Code/Condition-Code 为 8，而您接下来的 linkedit/binder 步骤可能没有 运行（查看中步骤的 COND文件 2 的假脱机为您的工作）。
这是您的代码作为提醒：
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.
这是 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
由于没有链接新程序，您运行仍在使用旧程序并且仍然遇到旧错误。
您正在向未提供初始值的非二进制字段添加内容。
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.
如果没有初始值（来自 VALUE 子句、MOVE 甚至可怕的 INITIALIZE），该值是未定义的并且不太可能对分区十进制字段有效，因此 S0C7.
看看这个： 看看您是否可以从中找出程序中失败的确切位置。
编译干净的程序，带有 RC 0 且没有诊断消息，运行s 没有异常终止：
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.
我正在尝试编写程序以确定给定文件中是否出现不同类型的错误。我要 post 我的整个代码，因为老实说我不知道我哪里出错了。它只是在我身上消失了。数据校验为 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.
数据看起来是这样的...
VC 10045380051005ABC ELECTRONICS 00001298
VT 000000 00020000
希望实现这一目标
XX 9AAA9999 99/99/99 SHIFTED 12A 4GL 78 A C E F H I
** ******** ** ** *************** *** *** **
其中 * 在数据中存在错误。字母显示发现的错误。
在您的最新版本中，您创建了一个组项(DATE-DUE)，但您没有调整从属于它的其他日期字段的级别编号。这三个我都做了10级。为了方便我使用SYSIN数据，我在输入记录的末尾添加了一个32字节的FILLER。
我编译，得到 4 的 RC/CC，所以 linkedit/binder 运行s.
我使用了你另一个问题的数据：
VC 10045380051005ABC 电子 00001298 VC 050926XYZ 公司 00R00549 VT 12348760051115质量保证公司 00400053 VC A14BCF80051201 00100930
得到这个输出，没有异常结束：
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
我已经粘贴了你另一个问题的数据。
请注意，如果您的实际数据不正确，金额字段可能会异常终止。
另请注意金额字段中的 R 发生了什么。您尚未验证 NUMERIC。
我现在已经编译 运行 您的程序并进行了两次更正（两次计数的 VALUE 子句和 END-READ）。这是输出：
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
我使用了一个固定长度的文件，因为我无法访问你的实际文件，它必须是可变长度的（最好在 FD 中明确，然后你就不会得到那些我-编译结束时的信息性消息）。
您还有一些事情需要解决，但程序正在 运行 正在生成输出。如果您更改了这些代码但仍然有问题，那么就是您的文件有误。
您有一个非常令人沮丧的问题，似乎是 "environment" 造成的。您需要能够看到您的编译列表。如果编译失败（RC/CC 以上 4），那么您的 linkedit/binder 步骤将不会 运行，并且您不会获得新的可执行程序。我觉得是你的问题，但是需要你的导师帮忙整理一下如何找到编译清单并确认没有错误。
我没有使用过 Rational Developer，不知道您是在使用 zPDT 还是在大型机上进行编译，或者您如何看待 Rational Developer 会话中两种情况下的编译器输出。
您的代码对于初学者来说基本上还可以，可能已经用了几天了。您一直在努力解决与代码无关的问题，而是与不知道您的程序存在编译错误有关的问题。基本上，除了几个错别字外，它就在那里。
当您在您的环境中运行获得它时，请更新您的代码审查问题。
真正值得了解的是什么编译生成了您 运行 的程序版本，无论它是否异常终止。
您可以显示程序编译的日期和时间：
WORKING-STORAGE SECTION.
01 W-WHEN-COMPILED PIC X(8)BX(8).
...
在做任何事情之前，除了确定它是第一次在 CALLed 子程序中，像这样：
MOVE WHEN-COMPILED TO W-WHEN-COMPILED
DISPLAY
"Program XXXXXXXX compiled on "
W-WHEN-COMPILED
您得到的输出将是该程序实际编译的 date/time，与编译列表中的 date/time 完全匹配。
30 多年来，我一直使用这样的代码并将其推荐给其他人，它节省了大量时间。
还有一个内在函数，WHEN-COMPILED。这是相同的，但年份是四位数。因为在可预见的未来，一年中的CC将是20个，你可以选择做哪一个。两者都在编译时解决，对 运行 时间的影响将很小。
您没有 END-READ。这为您提供了来自编译的 E 级诊断，Return-Code/Condition-Code 为 8，而您接下来的 linkedit/binder 步骤可能没有 运行（查看中步骤的 COND文件 2 的假脱机为您的工作）。
这是您的代码作为提醒：
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.
这是 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
由于没有链接新程序，您运行仍在使用旧程序并且仍然遇到旧错误。
您正在向未提供初始值的非二进制字段添加内容。
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.
如果没有初始值（来自 VALUE 子句、MOVE 甚至可怕的 INITIALIZE），该值是未定义的并且不太可能对分区十进制字段有效，因此 S0C7.
看看这个： 看看您是否可以从中找出程序中失败的确切位置。
编译干净的程序，带有 RC 0 且没有诊断消息，运行s 没有异常终止：
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.