'WRITE not allowed' error received when file is open - cobol

When running the code below, which outputs a report of all those who get bonuses based on input files, I get the error, 'WRITE not allowed, file not open for output (status = 48)' on ln 159.
I have tried opening the file in the 500-HEADING module but receive an error saying 'file already open (status = 41)' and receive the original error with moving the OPEN statement around to the 100-MAIN module. Using I-O, INPUT-OUTPUT, and EXTEND return a syntax error.
IDENTIFICATION DIVISION.
PROGRAM-ID. ASSIGNMENT9_1_SORT.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PAYROLL-MASTER ASSIGN TO 'CH0901-UNSORTED.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT WORK-FILE ASSIGN TO 'TEMP.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT BONUS-REPORT ASSIGN TO 'BONUS REPORT SORTED.LST'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PAYROLL-MASTER.
01 PAYROLL-REC.
05 EMP-NO-IN PIC X(5).
05 NAME-IN PIC X(20).
05 TERRITORY-NO-IN PIC XX.
05 OFFICE-NO-IN PIC XX.
05 ANNUAL-SALARY-IN PIC 9(6).
05 PIC X(29).
05 DATE-HIRED-IN.
10 MONTH-IN PIC 99.
10 DAY-IN PIC 99.
10 YEAR-IN PIC 9999.
05 PIC X(10).
FD BONUS-REPORT.
01 BONUS-PRINT PIC X(80).
SD WORK-FILE.
01 SORT-REC.
05 EMP-NO PIC X(5).
05 S-NAME PIC X(20).
05 TERR PIC XX.
05 OFFICE PIC XX.
05 ANNUAL-SALARY PIC 9(6).
05 PIC X(29).
05 DATE-HIRED.
10 S-MONTH PIC 99.
10 S-DAY PIC 99.
10 S-YEAR PIC 9999.
05 PIC X(10).
WORKING-STORAGE SECTION.
01 BONUS-REC.
05 EMP-NO-OUT PIC X(5).
05 NAME-OUT PIC X(20).
05 TERRITORY-NO-OUT PIC XX.
05 OFFICE-NO-OUT PIC XX.
05 ANNUAL-SALARY-OUT PIC 9(6).
05 PIC X(29).
05 DATE-HIRED-OUT.
10 MONTH-OUT PIC 99.
10 DAY-OUT PIC 99.
10 YEAR-OUT PIC 9999.
05 PIC X(10).
01 WS-DATE.
05 WS-YEAR PIC 9999.
05 WS-MONTH PIC 99.
05 WS-DAY PIC 99.
01 HEADER1.
05 PIC X(40) VALUE SPACES.
05 PIC X(15) VALUE 'BONUS REPORT'.
05 PIC X(5) VALUE SPACES.
05 PIC X(5) VALUE 'PAGE '.
05 PAGE-NO PIC 99 VALUE 1.
05 PIC XXX.
05 TODAYS-DATE.
10 MONTH-FIELD PIC 99.
10 PIC X VALUE '/'.
10 DAY-FIELD PIC XX.
10 PIC X VALUE '/'.
10 YEAR-FIELD PIC 9999.
01 BLANK-LINE PIC X(80).
01 FIRST-RECORD PIC X VALUE 'Y'.
01 HEADER2.
05 PIC X(10) VALUE SPACES.
05 PIC X(13) VALUE 'TERRITORY --'.
05 TERRITORY-NO PIC 99.
01 HEADER3.
05 PIC X(20) VALUE SPACES.
05 PIC X(10) VALUE 'OFFICE --'.
05 OFFICE-NO PIC 99.
01 HEADER4.
05 PIC X(10) VALUE SPACES.
05 PIC X(15) VALUE 'EMPLOYEE NAME'.
05 PIC X(5) VALUE SPACES.
05 PIC X(5) VALUE 'BONUS'.
01 DATA1.
05 PIC X(6) VALUE SPACES.
05 NAME PIC X(20).
05 PIC XXXX.
05 BONUS PIC $ZZ,ZZZ.99 VALUE ZEROES.
01 ARE-THERE-MORE-RECORDS PIC X VALUE 'Y'.
01 LINE-COUNT PIC 99 VALUE 1.
PROCEDURE DIVISION.
100-MAIN.
SORT WORK-FILE
ON ASCENDING KEY TERR
ON ASCENDING KEY OFFICE
USING PAYROLL-MASTER
GIVING BONUS-REPORT
PERFORM 200-INPUT
STOP RUN.
200-INPUT.
OPEN INPUT BONUS-REPORT
MOVE FUNCTION CURRENT-DATE TO WS-DATE
MOVE WS-YEAR TO YEAR-FIELD
MOVE WS-MONTH TO MONTH-FIELD
MOVE WS-DAY TO DAY-FIELD
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'N'
READ BONUS-REPORT NEXT RECORD
AT END
MOVE 'N' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 300-MOVE
PERFORM 400-CALC
END-READ
CLOSE BONUS-REPORT
END-PERFORM.
300-MOVE.
MOVE EMP-NO-IN TO EMP-NO-OUT
MOVE NAME-IN TO NAME-OUT
MOVE TERRITORY-NO-IN TO TERRITORY-NO-OUT
MOVE OFFICE-NO-IN TO OFFICE-NO-OUT
MOVE ANNUAL-SALARY-IN TO ANNUAL-SALARY-OUT
MOVE DATE-HIRED-IN TO DATE-HIRED-OUT.
400-CALC.
MOVE ZEROES TO BONUS
IF YEAR-OUT IS LESS THAN 1994
COMPUTE BONUS = ANNUAL-SALARY-OUT * 0.10
END-IF
EVALUATE TRUE
WHEN FIRST-RECORD = 'Y'
MOVE TERRITORY-NO-OUT TO TERRITORY-NO
MOVE OFFICE-NO-OUT TO OFFICE-NO
PERFORM 500-HEADING
MOVE NAME-OUT TO NAME
WRITE BONUS-PRINT FROM DATA1
ADD 1 TO LINE-COUNT
MOVE 'N' TO FIRST-RECORD
WHEN FIRST-RECORD = 'N'
MOVE TERRITORY-NO-OUT TO TERRITORY-NO
MOVE OFFICE-NO-OUT TO OFFICE-NO
MOVE NAME-OUT TO NAME
IF LINE-COUNT > 10
MOVE 1 TO LINE-COUNT
ADD 1 TO PAGE-NO
PERFORM 500-HEADING
END-IF
WRITE BONUS-PRINT FROM DATA1
ADD 1 TO LINE-COUNT
END-EVALUATE.
500-HEADING.
WRITE BONUS-PRINT FROM BLANK-LINE
WRITE BONUS-PRINT FROM HEADER1
WRITE BONUS-PRINT FROM BLANK-LINE
WRITE BONUS-PRINT FROM HEADER2
WRITE BONUS-PRINT FROM BLANK-LINE
WRITE BONUS-PRINT FROM HEADER3
WRITE BONUS-PRINT FROM BLANK-LINE
WRITE BONUS-PRINT FROM BLANK-LINE
WRITE BONUS-PRINT FROM HEADER4.
`

Change
OPEN INPUT BONUS-REPORT
To
OPEN OUTPUT BONUS-REPORT
Upon further examination addition errors were found.
The SORT statement should have created different file to use as input, rather than the file that you intended to use for output. Or, as #Jim Castro implies in another answer, use the OUTPUT PROCEDURE to access the records. The differences below show the additional file and the OPEN and CLOSE statements for that file.
Also,the CLOSE statement needed to removed from the PERFORM. also noted by #Jim Castro.
Finally, the END-EVALUATE need to be placed before the WRITE statement.
The following is the output of a difference utility that identifies the changes.
OLD being the program you posted, NEW being the program after the changes I applied.
* Text File Comparison
*-------------------------------------------------------------------------------
* 000008/000008: mis-matched records
* OLD :-
SELECT WORK-FILE ASSIGN TO 'TEMP.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
* NEW :-
SELECT WORK-FILE ASSIGN TO 'TEMP.DAT'.
SELECT TEMP-BONUS-FILE ASSIGN TO "TEMP-BONUS.DAT"
ORGANIZATION LINE SEQUENTIAL.
*-------------------------------------------------------------------------------
* 000027/000028: extra NEW records :-
FD TEMP-BONUS-FILE.
01 TEMP-BONUS-REC.
05 T-EMP-NO PIC X(5).
05 T-NAME PIC X(20).
05 T-TERR PIC XX.
05 T-OFFICE PIC XX.
05 T-ANNUAL-SALARY PIC 9(6).
05 PIC X(29).
05 T-DATE-HIRED.
10 T-MONTH PIC 99.
10 T-DAY PIC 99.
10 T-YEAR PIC 9999.
05 PIC X(10).
*-------------------------------------------------------------------------------
* 000102/000116: mis-matched records
* OLD :-
GIVING BONUS-REPORT
* NEW :-
GIVING TEMP-BONUS-FILE
*-------------------------------------------------------------------------------
* 000107/000121: mis-matched records
* OLD :-
OPEN INPUT BONUS-REPORT
* NEW :-
OPEN INPUT TEMP-BONUS-FILE
OUTPUT BONUS-REPORT
*-------------------------------------------------------------------------------
* 000113/000128: mis-matched records
* OLD :-
READ BONUS-REPORT NEXT RECORD
* NEW :-
READ TEMP-BONUS-FILE NEXT RECORD
*-------------------------------------------------------------------------------
* 000120/000135: mis-matched records
* OLD :-
CLOSE BONUS-REPORT
END-PERFORM.
300-MOVE.
MOVE EMP-NO-IN TO EMP-NO-OUT
MOVE NAME-IN TO NAME-OUT
MOVE TERRITORY-NO-IN TO TERRITORY-NO-OUT
MOVE OFFICE-NO-IN TO OFFICE-NO-OUT
MOVE ANNUAL-SALARY-IN TO ANNUAL-SALARY-OUT
MOVE DATE-HIRED-IN TO DATE-HIRED-OUT.
* NEW :-
END-PERFORM
CLOSE BONUS-REPORT TEMP-BONUS-FILE.
300-MOVE.
MOVE T-EMP-NO TO EMP-NO-OUT
MOVE T-NAME TO NAME-OUT
MOVE T-TERR TO TERRITORY-NO-OUT
MOVE T-OFFICE TO OFFICE-NO-OUT
MOVE T-ANNUAL-SALARY TO ANNUAL-SALARY-OUT
MOVE T-DATE-HIRED TO DATE-HIRED-OUT.
*-------------------------------------------------------------------------------
* 000154/000169: mis-matched records
* OLD :-
WRITE BONUS-PRINT FROM DATA1
ADD 1 TO LINE-COUNT
END-EVALUATE.
* NEW :-
END-EVALUATE
WRITE BONUS-PRINT FROM DATA1
ADD 1 TO LINE-COUNT.
*-------------------------------------------------------------------------------
I should add that the 300-MOVE paragraph could be replaced by using INTO BONUS-REC on either a READ or RETURN statement; as in,
READ TEMP-BONUS-FILE NEXT RECORD INTO BONUS-REC
or
RETURN SORT-REC INTO BONUS-REC

Nice first attempt but you are doing many things wrong. You cannot open BONUS-REPORT as input if its the final formatted output of your program. Some files are I-O but this isn't the case here.
I would suggest using the SORT verb with USING with OUTPUT PROCEDURE IS version of the statement instead. RETURN the SORT-REC then format and WRITE the bonus report. You'll have to change your 300 and 400 paragraphs to move the right fields but it should work out for you in the end.
PROCEDURE DIVISION.
100-MAIN.
SORT WORK-FILE
ON ASCENDING KEY TERR
ON ASCENDING KEY OFFICE
USING PAYROLL-MASTER
OUTPUT PROCEDURE IS PERFORM 200-OUTPUT
GOBACK.
200-OUTPUT.
OPEN OUTPUT BONUS-REPORT
MOVE FUNCTION CURRENT-DATE TO WS-DATE
MOVE WS-YEAR TO YEAR-FIELD
MOVE WS-MONTH TO MONTH-FIELD
MOVE WS-DAY TO DAY-FIELD
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'N'
RETURN SORT-REC INTO BONUS-REC
AT END
MOVE 'N' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 400-CALC
END-RETURN
END-PERFORM.
CLOSE BONUS-REPORT.
Please note: move the close of BONUS-REPORT out of the PERFORM loop.

Related

OpenCOBOL can't find my external module to run the program

I'm trying to create a COBOL program using OpenCobol that has an external module when it does a calculation and then brings the result back into the main program using CALL. But everytime I try to run the program it says it can't find the module. I have already changed my module to Program Type "Module" from executable and I have added the module path as a Library path but nothing is working so far
Here is my main program code:
PROGRAM-ID. Project2 AS "Project2".
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*****The student input file
SELECT STUDENT-FILE-IN
ASSIGN TO "C:\STUFILE.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
*****The program input file
SELECT PROGRAM-FILE-IN
ASSIGN TO "C:\PROGRAM.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
*****The student report output file
SELECT STUDENT-REPORT-FILE-OUT
ASSIGN TO "C:\REPORT.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
*Student input file
FD STUDENT-FILE-IN.
01 STUDENT-RECORD.
05 STUDENT-NUMBER PIC 9(6).
05 TUITION-OWED-IN PIC 9(4)V99.
05 STUDENT-NAME-IN PIC X(40).
05 PROGRAM-OF-STUDY PIC X(5).
05 COURSE-CODE-1 PIC X(7).
05 COURSE-AVERAGE-1 PIC 9(3).
05 COURSE-CODE-2 PIC X(7).
05 COURSE-AVERAGE-2 PIC 9(3).
05 COURSE-CODE-3 PIC X(7).
05 COURSE-AVERAGE-3 PIC 9(3).
05 COURSE-CODE-4 PIC X(7).
05 COURSE-AVERAGE-4 PIC 9(3).
05 COURSE-CODE-5 PIC X(7).
05 COURSE-AVERAGE-5 PIC 9(3).
*Program input file
FD PROGRAM-FILE-IN.
01 PROGRAM-RECORD-IN.
05 PROGRAM-CODE-IN PIC X(5).
05 PROGRAM-NAME-IN PIC X(20).
*Student report output file
FD STUDENT-REPORT-FILE-OUT.
01 STUDENT-REPORT-RECORD-OUT PIC x(90).
WORKING-STORAGE SECTION.
*Table to hold program records
01 PROGRAM-RECORD.
05 PROGRAM-TABLE.
10 PROGRAM-CODE PIC X(5) OCCURS 20 TIMES.
10 PROGRAM-NAME PIC X(20) OCCURS 20 TIMES.
*The student report record
01 STUDENT-REPORT-RECORD.
05 STUDENT-NAME PIC X(40).
05 FILLER PIC X(2) VALUE SPACES.
05 PROGRAM-NAME-OUT PIC X(20).
05 FILLER PIC X(4) VALUE SPACES.
05 TUITION-OWED PIC Z,ZZ9.99.
*A line to make the output look good
01 HEADER-LINE.
05 FILLER PIC X(90) VALUE ALL "-".
*The column header
01 COLUMN-HEADER.
05 NAME-COLUMN PIC X(42) VALUE "NAME".
05 AVG-COLUMN PIC X(7) VALUE "AVE".
05 PROG-COLUMN PIC X(24) VALUE "PROGRAM NAME".
05 OWED-COLUMN PIC X(12) VALUE "TUITION OWED".
01 CONTROL-FIELDS.
05 STUFILE-EOF-FLAG PIC A(3).
05 PROG-EOF-FLAG PIC A(3).
05 PROG-SUB PIC 9(2).
05 FOUND-PROG-FLAG PIC A(3).
01 COUNTERS.
05 STUDENT-RECORDS-READ-CTR PIC 9(3).
05 STUDENT-REPORTS-WRITTEN-CTR PIC 9(3).
01 WW-SEND-AREA.
05 STUDENT-AVERAGE PIC 9(3).
01 WW-SUB-PROG PIC X(75)
VALUE 'C:\Users\google\Program3Call'.
PROCEDURE DIVISION.
PERFORM 200-INITIALIZATION-RTN.
*Read and process all student records
PERFORM 200-PROCESS-STUDENT-RECORD-RTN
UNTIL STUFILE-EOF-FLAG = "YES".
PERFORM 200-FINISH-RTN.
STOP RUN.
200-INITIALIZATION-RTN.
PERFORM 300-OPEN-FILES-RTN.
*****Load all program records into the table
PERFORM 300-LOAD-PROGRAM-TABLE-RTN
VARYING PROG-SUB FROM 1 BY 1
UNTIL PROG-SUB > 20 OR PROG-EOF-FLAG = "YES".
PERFORM 300-INITIALIZE-REPORT-FILE-RTN.
PERFORM 300-INITIALIZE-COUNTERS-RTN.
200-PROCESS-STUDENT-RECORD-RTN.
PERFORM 300-READ-STUDENT-RECORD-RTN.
IF STUFILE-EOF-FLAG NOT EQUALS "YES"
*********Get the program name
PERFORM 300-GET-PROGRAM-NAME-RTN
VARYING PROG-SUB FROM 1 BY 1 UNTIL
FOUND-PROG-FLAG = "YES" OR PROG-SUB > 20
PERFORM 300-GET-STUDENT-AVERAGE
PERFORM 300-PRINT-STUDENT-REPORT-RTN
END-IF.
200-FINISH-RTN.
PERFORM 300-PRINT-COUNTERS-RTN.
PERFORM 300-CLOSE-FILES-RTN.
300-OPEN-FILES-RTN.
OPEN INPUT STUDENT-FILE-IN.
OPEN INPUT PROGRAM-FILE-IN.
OPEN OUTPUT STUDENT-REPORT-FILE-OUT.
300-LOAD-PROGRAM-TABLE-RTN.
READ PROGRAM-FILE-IN
AT END MOVE "YES" TO PROG-EOF-FLAG
NOT AT END MOVE PROGRAM-CODE-IN TO PROGRAM-CODE (PROG-SUB)
MOVE PROGRAM-NAME-IN TO PROGRAM-NAME (PROG-SUB).
300-INITIALIZE-REPORT-FILE-RTN.
MOVE COLUMN-HEADER TO STUDENT-REPORT-RECORD-OUT.
WRITE STUDENT-REPORT-RECORD-OUT.
MOVE HEADER-LINE TO STUDENT-REPORT-RECORD-OUT.
WRITE STUDENT-REPORT-RECORD-OUT.
300-INITIALIZE-COUNTERS-RTN.
MOVE 0 TO STUDENT-RECORDS-READ-CTR.
MOVE 0 TO STUDENT-REPORTS-WRITTEN-CTR.
300-READ-STUDENT-RECORD-RTN.
READ STUDENT-FILE-IN
AT END MOVE "YES" TO STUFILE-EOF-FLAG
NOT AT END ADD 1 TO STUDENT-RECORDS-READ-CTR.
300-GET-PROGRAM-NAME-RTN.
IF PROGRAM-CODE (PROG-SUB) = PROGRAM-OF-STUDY
MOVE PROGRAM-NAME (PROG-SUB) TO PROGRAM-NAME-OUT
MOVE "YES" TO FOUND-PROG-FLAG
END-IF.
300-GET-STUDENT-AVERAGE.
CALL WW-SUB-PROG USING WW-SEND-AREA.
300-PRINT-STUDENT-REPORT-RTN.
MOVE "NO" TO FOUND-PROG-FLAG.
MOVE STUDENT-NAME-IN TO STUDENT-NAME.
MOVE TUITION-OWED-IN TO TUITION-OWED.
MOVE STUDENT-REPORT-RECORD TO STUDENT-REPORT-RECORD-OUT.
WRITE STUDENT-REPORT-RECORD-OUT.
ADD 1 TO STUDENT-REPORTS-WRITTEN-CTR.
300-PRINT-COUNTERS-RTN.
DISPLAY "Student records read: ", STUDENT-RECORDS-READ-CTR.
DISPLAY "Student reports written: ",
STUDENT-REPORTS-WRITTEN-CTR.
300-CLOSE-FILES-RTN.
CLOSE STUDENT-FILE-IN, PROGRAM-FILE-IN
STUDENT-REPORT-FILE-OUT.
END PROGRAM Project2.
Here is my Call Program:
******************************************************************
* Author: Desiree Hanuman
* Date: August 14th 2021
* Purpose:Call Section code for project 3
* Tectonics: cobc
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. Program3Call.
DATA DIVISION.
LINKAGE SECTION.
01 LS-STUDENT-AVERAGE-AREA.
05 COURSE-AVERAGE-1 PIC 9(3).
05 COURSE-AVERAGE-2 PIC 9(3).
05 COURSE-AVERAGE-3 PIC 9(3).
05 COURSE-AVERAGE-4 PIC 9(3).
05 COURSE-AVERAGE-5 PIC 9(3).
05 STUDENT-AVERAGE PIC 9(3).
PROCEDURE DIVISION.
MAIN-PROCEDURE.
100-STUDENT-AVERAGE.
PERFORM 300-CALCULATE-AVERAGE-RTN.
300-CALCULATE-AVERAGE-RTN.
COMPUTE STUDENT-AVERAGE ROUNDED = (COURSE-AVERAGE-1 +
COURSE-AVERAGE-2 + COURSE-AVERAGE-3 + COURSE-AVERAGE-4 +
COURSE-AVERAGE-5) / 5.
GOBACK.
The normal way to CALL in most COBOL implementations is to just specify the module name - without a path or extension.
Then you either do "static linking" (as in Scott's answer below for OpenCOBOL/GnuCOBOL just specify all sources on the command line and use either -x [fat executable] or -b [fat module, then callable for example with cobcrun], commonly with -static); or do "dynamic linking" (separate compilation of all modules) and specify the module path in a configuration file or by environment variable. For OpenCOBOL/GnuCOBOL this is COB_LIBRARY_PATH.
I am not a user of OpenCobol, but, according to their manual in section 7, there are many ways to accomplish what you want.
But the simplest would be to statically compile and link the main and sub programs in one command line:
cobc -x Project2.cbl Program3Call.cbl
This example work´s for me.
Please keep in mind that the name of the dll file routine module must be same as the routine name.
It is not necessary reconfigure OpenCobol path library.
I use OpenCobol 4.7.6.
The Code:
Main program (file build "MAINPROG.exe")
IDENTIFICATION DIVISION.
PROGRAM-ID. "MAINPROG".
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 X PIC X(1).
01 INPUTS.
05 PRM-LENGTH PIC S9(4) COMP.
05 INPUT1 PIC 9(2).
05 INPUT2 PIC 9(2).
PROCEDURE DIVISION.
MAIN-PARA.
MOVE 12 TO INPUT1.
MOVE 13 TO INPUT2.
CALL 'MFPROG1' USING PRM-LENGTH, INPUT1, INPUT2.
ACCEPT X.
STOP RUN.
END PROGRAM "MAINPROG".
Rutine program (file build module "MFPROG1.dll")
IDENTIFICATION DIVISION.
PROGRAM-ID. "MFPROG1".
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 OUTPUT-DATA PIC 9(4).
LINKAGE SECTION.
01 PARM-BUFFER.
05 PARM-LENGTH PIC S9(4) COMP.
05 PARM-INPUT1 PIC 9(2).
05 PARM-INPUT2 PIC 9(2).
PROCEDURE DIVISION USING PARM-BUFFER.
MAIN-PARA.
COMPUTE OUTPUT-DATA = PARM-INPUT1 + PARM-INPUT2.
DISPLAY 'PARM-INPUT1: ' PARM-INPUT1.
DISPLAY 'PARM-INPUT2: ' PARM-INPUT2.
DISPLAY 'SUM VALUE : ' OUTPUT-DATA.
GOBACK.
END PROGRAM "MFPROG1".

How do I fix duplication of fields in RPT file?

This program is to read in the SEQ file and take the data thru different validations, if it fails to comply with one of the validations the error message is moved to FIELD-NAME and FIELD-VALUE is the errored field.
After all data is processed all transaction are to be used to create the RPT file.
PROBLEM: When reviewing the RPT file, a weird issue is that ERROR FIELD NAME/ERROR FIELD VALUE keeps repeating the same error after entry is passed. I believe the problem is located in the 300, 310, 320, 330, 340, 350 sections.
Part number validation requirements Col. 01-05 must be a number, col 06 must be a capital, 07-08 must be a number in the range 01-68 or 78-99
Quantity validation requirements Leading spaces are allowed(can be all spaces), if not all spaces must be a number after leading spaces, zero value is allowed, value over 20,000 is an error
Date validation requirements month value must be 01-12, day value must be 01-31
Charge Number validation requirements cannot be blank, must be left justified(no leading spaces), and no more than one dash (hyphen) allowed
Initial validation requirements both must be letters (upper or lower case OK)
Transaction Code validation requirements must be REC, ISS, AJ+, or AJ-
If you run my attached program with the attached SEQ, your RPT will look like mine.
Below is the desired output. (pg 1)
SEQ:
11438A01 5000102667-X44 JBISS
12345A77 120103OK BY MIKELLREC
12789B02 14460606144-X22A AJ+
13168A02 31231722394 mkISS
13168A02 70102221-Q18 JBAJ-
2074B01 25 0532 OK BY JIMK RE
22109A04 20000325669-Y5Z DCISS
3077.B22 1000801144X MWAJ-
32149A01 10625567-X1 dcREC
39886B02 2000203517-AA JBAJ+
40442A2( 33 333-Q67 MKISS
43009B01 1440801899-23 MKISS
47890A02 30000422X-4-8 DCISS
49000B01 1000831901-Y6 MWAJ+
51111A011052X0905901-Y66 JBREC
52301A02 10228733876-X1 ABREC
55986b01 99990430A DCISS
57989A01 21130144X JBAJ+
57989A01 500831722394-XX MKISS
59901B0220300133X966-QQ22 MWREC
60022A01 400823 517-X1-33MWAJ+
66780B01 1000831722-YY BwREC
68999A01 21028123-Q88 MKISS
75312B01 500222966-32 BISS
77771A03 12780606 ABISS
78896B02 1000831123456-X13DCREC
80090B01 881$25983334-X25jbAJ
82432A05 420912722-X9 MWISS
83058C04 65000325Q1234 K*AJ+
85987D02 1061214Charge #32KBAJ-
87167B01 7000930144XX DCAJ+
91986 01 25072 900-23 MWISS
9576XA00 1001122j55 kbREC
96134B05 60214GOOD BSAJ-
98407C03254*00416Confirmed EHISS
Code:
IDENTIFICATION DIVISION.
PROGRAM-ID. INVTRAN.
* Tate
***************************************************************
* This program reads a fie of inventory transaction,
* validates the data, prints a report showing all transactions
* (with errors indicated), and writes a data file of
* all transactions without errors.
***************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INVENTORY-TRANS-FILE-IN
ASSIGN TO 'INVTRAN.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
* SELECT INVENTORY-TRANS-FILE-OUT
* ASSIGN TO 'INVTRAN.OUT'
* ORGANIZATION IS LINE SEQUENTIAL.
SELECT INVENTORY-TRANS-FILE-OUT-2
ASSIGN TO 'INVTRAN.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD INVENTORY-TRANS-FILE-IN.
01 INVENTORY-TRANS-RECORD-IN.
05 PART-NUMBER-IN.
10 PART-NUMERIC-1-IN PIC X(5).
10 PART-ALPHABETIC-IN PIC X.
10 PART-NUMERIC-2-IN PIC XX.
88 VALID-PART-NUMERIC-2 VALUE '01' THRU '68' '78' THRU '99'.
05 QUANTITY-IN.
10 QUANTITY-9-IN PIC 9(5).
05 DATE-IN.
10 MONTH-IN PIC XX.
88 VALID-MONTH-IN VALUE '01' THRU '12'.
10 DAY-IN PIC XX.
88 VALID-DAY-IN VALUE '01' THRU '31'.
05 CHARGE-NUMBER-IN PIC X(10).
05 INITIALS-IN.
10 INITIALS-1-IN PIC X.
10 INITIALS-2-IN PIC X.
05 TRANS-CODE-IN PIC X(3).
88 VALID-TRANS-CODE-IN VALUE 'REC' 'ISS' 'AJ+' 'AJ-'.
FD INVENTORY-TRANS-FILE-OUT-2.
01 INVENTORY-TRANS-RECORD-OUT-2 PIC X(80).
WORKING-STORAGE SECTION.
01 WS-FIRST-TIME-THRU PIC X(3) VALUE 'YES'.
01 LINES-PRINTED PIC 99 VALUE 99.
01 PAGE-NUMBER PIC 99 VALUE ZERO.
01 RECORDS-ERROR-SWITCH PIC X(3).
01 FIELD-ERROR-SWITCH PIC X(3).
01 WS-TOTAL PIC 99 VALUE ZERO.
01 WS-ERROR PIC 99 VALUE ZERO.
01 WS-GOOD PIC 99 VALUE ZERO.
01 WS-QUANTITY PIC 9(4) VALUE ZERO.
01 TOTAL-ERROR-COUNT PIC 9(3) VALUE ZERO.
01 TOTAL-GOOD-COUNT PIC 9(3) VALUE ZERO.
01 TOTAL-GOOD-QUANTITY PIC 9(5) VALUE ZERO.
01 WS-CURRENT-DATE-DATA.
05 WS-CURRENT-DATE.
10 RUN-YEAR PIC XX.
10 RUN-MONTH PIC XX.
10 RUN-DAY PIC XX.
01 HEADING-LINE-1.
05 PIC X(17) VALUE SPACES.
05 PIC X(35) VALUE 'INVENTORY TRANSACTIONS AUDIT TRAIL'.
05 PIC X(8) VALUE SPACES.
05 HL-1-DATE.
10 MONTH-1 PIC XX.
10 PIC X VALUE '/'.
10 DAY-1 PIC XX.
10 PIC X VALUE '/'.
10 YEAR-1 PIC XX.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'PAGE'.
05 HL-1-PAGE-NUMBER PIC Z9.
01 HEADING-LINE-2.
05 PIC X(10) VALUE 'PART NO'.
05 PIC X(5) VALUE 'QUAN'.
05 PIC X(5) VALUE 'DATE'.
05 PIC X(11) VALUE 'CHARGE NO'.
05 PIC X(3) VALUE 'IN'.
05 PIC X(4) VALUE 'TRN'.
05 PIC X(3) VALUE SPACES.
05 PIC X(20) VALUE 'ERROR FIELD NAME'.
05 PIC X(17) VALUE 'ERROR FIELD VALUE'.
01 DETAIL-LINE.
05 PART-NUMBER PIC X(8).
05 PIC X VALUE SPACE.
05 QUANTITY PIC X(5).
05 PIC X VALUE SPACE.
05 DATE-X PIC X(4).
05 PIC X VALUE SPACE.
05 CHARGE-NUMBER PIC X(10).
05 PIC X VALUE SPACE.
05 INITIALS PIC XX.
05 PIC X VALUE SPACE.
05 TRANS-CODE PIC X(3).
05 PIC X(4) VALUE SPACES.
05 FIELD-NAME PIC X(18).
05 PIC XX VALUE SPACES.
05 FIELD-VALUE PIC X(10).
01 TRANSACTIONS.
05 PIC X(41) VALUE 'Total Transactions:'.
05 T-1 PIC 99.
01 ERROR-TRANSACTIONS.
05 PIC X(41) VALUE 'Total Error Transactions:'.
05 T-2 PIC 99.
01 GOOD-TRANSACTIONS.
05 PIC X(41) VALUE 'Total Good Transactions:'.
05 T-3 PIC 99.
01 QUANTITY-TOTAL.
05 PIC X(41) VALUE 'Good Transactions Quantity Total:'.
05 Q-4 PIC 9,999.
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT INVENTORY-TRANS-FILE-IN
OPEN OUTPUT INVENTORY-TRANS-FILE-OUT-2
ACCEPT WS-CURRENT-DATE FROM DATE
MOVE RUN-MONTH TO MONTH-1
MOVE RUN-DAY TO DAY-1
MOVE RUN-YEAR TO YEAR-1
PERFORM 150-WRITE-HEADINGS
PERFORM UNTIL RECORDS-ERROR-SWITCH = 'YES'
READ INVENTORY-TRANS-FILE-IN
AT END
PERFORM 500-TRANSACTIONS
PERFORM 510-ERROR-TRANSACTIONS
PERFORM 520-GOOD-TRANSACTIONS
PERFORM 530-QUANTITY
MOVE 'YES' TO RECORDS-ERROR-SWITCH
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE INVENTORY-TRANS-FILE-IN
CLOSE INVENTORY-TRANS-FILE-OUT-2
STOP RUN.
150-WRITE-HEADINGS.
ADD 1 TO PAGE-NUMBER
MOVE PAGE-NUMBER TO HL-1-PAGE-NUMBER
MOVE HEADING-LINE-1 TO INVENTORY-TRANS-RECORD-OUT-2
IF WS-FIRST-TIME-THRU = 'YES'
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE 'NO' TO WS-FIRST-TIME-THRU
ELSE
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING PAGE
END-IF
MOVE HEADING-LINE-2 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE 1 TO LINES-PRINTED.
200-PROCESS-ONE-RECORD.
IF LINES-PRINTED > 54
PERFORM 150-WRITE-HEADINGS
END-IF
MOVE 'NO' TO RECORDS-ERROR-SWITCH
PERFORM 300-VALIDATE-PART-NUMBER
PERFORM 310-VALIDATE-QUANTITY
PERFORM 320-VALIDATE-DATE
PERFORM 330-VALIDATE-CHARGE-NUMBER
PERFORM 340-VALIDATE-INITIALS
PERFORM 350-VALIDATE-TRANSACTION-CODE
MOVE PART-NUMBER-IN TO PART-NUMBER
MOVE QUANTITY-IN TO QUANTITY
MOVE DATE-IN TO DATE-X
MOVE CHARGE-NUMBER-IN TO CHARGE-NUMBER
MOVE INITIALS-IN TO INITIALS
MOVE TRANS-CODE-IN TO TRANS-CODE
IF RECORDS-ERROR-SWITCH = 'NO'
ADD 1 TO TOTAL-GOOD-COUNT
ADD 1 TO TOTAL-GOOD-QUANTITY
MOVE DETAIL-LINE TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
ELSE
ADD 1 TO TOTAL-ERROR-COUNT
END-IF.
300-VALIDATE-PART-NUMBER.
IF NOT VALID-PART-NUMERIC-2
MOVE 'Part Number' TO FIELD-NAME
MOVE PART-NUMBER-IN TO FIELD-VALUE
END-IF.
310-VALIDATE-QUANTITY.
IF FUNCTION NUMVAL (QUANTITY-IN) IS GREATER THAN 20000
MOVE 'Quantity' TO FIELD-NAME
MOVE QUANTITY-IN TO FIELD-VALUE
END-IF.
320-VALIDATE-DATE.
IF NOT VALID-MONTH-IN
MOVE 'Date' TO FIELD-NAME
MOVE DATE-IN TO FIELD-VALUE
ELSE
IF NOT VALID-DAY-IN
MOVE 'Date' TO FIELD-NAME
MOVE DATE-IN TO FIELD-VALUE
END-IF
END-IF.
330-VALIDATE-CHARGE-NUMBER.
IF CHARGE-NUMBER-IN IS EQUAL TO ' '
MOVE 'Charge Number' TO FIELD-NAME
MOVE CHARGE-NUMBER-IN TO FIELD-VALUE
END-IF.
340-VALIDATE-INITIALS.
IF ((INITIALS-1-IN IS EQUAL TO ' ') OR (INITIALS-2-IN IS EQUAL TO ' '))
MOVE 'Initials' TO FIELD-NAME
MOVE INITIALS-IN TO FIELD-NAME
END-IF.
350-VALIDATE-TRANSACTION-CODE.
IF NOT VALID-TRANS-CODE-IN
MOVE 'Transaction Code' TO FIELD-NAME
MOVE TRANS-CODE-IN TO FIELD-VALUE
END-IF.
500-TRANSACTIONS.
MOVE WS-TOTAL TO TRANSACTIONS
MOVE T-1 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
510-ERROR-TRANSACTIONS.
MOVE WS-ERROR TO ERROR-TRANSACTIONS
MOVE T-2 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
520-GOOD-TRANSACTIONS.
MOVE WS-GOOD TO GOOD-TRANSACTIONS
MOVE T-3 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
530-QUANTITY.
MOVE WS-QUANTITY TO QUANTITY-TOTAL
MOVE Q-4 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
Please ask questions if you need more clarification.
Thank you.
The reason the content of FIELD-NAME and FIELD-VALUE are repeated is that nothing was done to change the content of those fields. At a minimum, it is necessary to move spaces into those fields after writing the report line. In 200-PROCESS-ONE-RECORD, insert a MOVE statement after writing the record, such as that shown below.
MOVE DETAIL-LINE TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE SPACES TO FIELD-NAME FIELD-VALUE

How do I fix duplication?

This program is to read in the SEQ file and take the data thru different validations, if it fails to comply with one of the validations the error message is moved to FIELD-NAME.
After all data is processed all transaction are to be used to create the RPT file.
PROBLEM: When reviewing the RPT file, everything is duplicated except the Heading-Line-1. Another weird issue is that ERROR FIELD NAME/ERROR FIELD VALUE keeps repeating the same error after entry is passed.
If you run the code provided with the SEQ also provide you will see how the data currently prints. Attached below is a link to how the first page of data should look.
Desired Output file
SEQ:
11438A01 5000102667-X44 JBISS
12345A77 120103OK BY MIKELLREC
12789B02 14460606144-X22A AJ+
13168A02 31231722394 mkISS
13168A02 70102221-Q18 JBAJ-
2074B01 25 0532 OK BY JIMK RE
22109A04 20000325669-Y5Z DCISS
3077.B22 1000801144X MWAJ-
32149A01 10625567-X1 dcREC
39886B02 2000203517-AA JBAJ+
40442A2( 33 333-Q67 MKISS
43009B01 1440801899-23 MKISS
47890A02 30000422X-4-8 DCISS
49000B01 1000831901-Y6 MWAJ+
51111A011052X0905901-Y66 JBREC
52301A02 10228733876-X1 ABREC
55986b01 99990430A DCISS
57989A01 21130144X JBAJ+
57989A01 500831722394-XX MKISS
59901B0220300133X966-QQ22 MWREC
60022A01 400823 517-X1-33MWAJ+
66780B01 1000831722-YY BwREC
68999A01 21028123-Q88 MKISS
75312B01 500222966-32 BISS
77771A03 12780606 ABISS
78896B02 1000831123456-X13DCREC
80090B01 881$25983334-X25jbAJ
82432A05 420912722-X9 MWISS
83058C04 65000325Q1234 K*AJ+
85987D02 1061214Charge #32KBAJ-
87167B01 7000930144XX DCAJ+
91986 01 25072 900-23 MWISS
9576XA00 1001122j55 kbREC
96134B05 60214GOOD BSAJ-
98407C03254*00416Confirmed EHISS
Code:
IDENTIFICATION DIVISION.
PROGRAM-ID. INVTRAN.
* Tate
***************************************************************
* This program reads a fie of inventory transaction,
* validates the data, prints a report showing all transactions
* (with errors indicated), and writes a data file of
* all transactions without errors.
***************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INVENTORY-TRANS-FILE-IN
ASSIGN TO 'INVTRAN.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
* SELECT INVENTORY-TRANS-FILE-OUT
* ASSIGN TO 'INVTRAN.OUT'
* ORGANIZATION IS LINE SEQUENTIAL.
SELECT INVENTORY-TRANS-FILE-OUT-2
ASSIGN TO 'INVTRAN.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD INVENTORY-TRANS-FILE-IN.
01 INVENTORY-TRANS-RECORD-IN.
05 PART-NUMBER-IN.
10 PART-NUMERIC-1-IN PIC X(5).
10 PART-ALPHABETIC-IN PIC X.
10 PART-NUMERIC-2-IN PIC XX.
88 VALID-PART-NUMERIC-2 VALUE '01' THRU '68' '78' THRU '99'.
05 QUANTITY-IN.
10 QUANTITY-9-IN PIC 9(5).
05 DATE-IN.
10 MONTH-IN PIC XX.
88 VALID-MONTH-IN VALUE '01' THRU '12'.
10 DAY-IN PIC XX.
88 VALID-DAY-IN VALUE '01' THRU '31'.
05 CHARGE-NUMBER-IN PIC X(10).
05 INITIALS-IN.
10 INITIALS-1-IN PIC X.
10 INITIALS-2-IN PIC X.
05 TRANS-CODE-IN PIC X(3).
88 VALID-TRANS-CODE-IN VALUE 'REC' 'ISS' 'AJ+' 'AJ-'.
FD INVENTORY-TRANS-FILE-OUT-2.
01 INVENTORY-TRANS-RECORD-OUT-2 PIC X(80).
WORKING-STORAGE SECTION.
01 WS-FIRST-TIME-THRU PIC X(3) VALUE 'YES'.
01 LINES-PRINTED PIC 99 VALUE 99.
01 PAGE-NUMBER PIC 99 VALUE ZERO.
01 RECORDS-ERROR-SWITCH PIC X(3).
01 FIELD-ERROR-SWITCH PIC X(3).
01 WS-TOTAL PIC 99 VALUE ZERO.
01 WS-ERROR PIC 99 VALUE ZERO.
01 WS-GOOD PIC 99 VALUE ZERO.
01 WS-QUANTITY PIC 9V999 VALUE ZERO.
01 TOTAL-ERROR-COUNT PIC 9(3) VALUE ZERO.
01 TOTAL-GOOD-COUNT PIC 9(3) VALUE ZERO.
01 TOTAL-GOOD-QUANTITY PIC 9(5) VALUE ZERO.
01 WS-CURRENT-DATE-DATA.
05 WS-CURRENT-DATE.
10 RUN-YEAR PIC XX.
10 RUN-MONTH PIC XX.
10 RUN-DAY PIC XX.
01 HEADING-LINE-1.
05 PIC X(17) VALUE SPACES.
05 PIC X(35) VALUE 'INVENTORY TRANSACTIONS AUDIT TRAIL'.
05 PIC X(8) VALUE SPACES.
05 HL-1-DATE.
10 MONTH-1 PIC XX.
10 PIC X VALUE '/'.
10 DAY-1 PIC XX.
10 PIC X VALUE '/'.
10 YEAR-1 PIC XX.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'PAGE'.
05 HL-1-PAGE-NUMBER PIC Z9.
01 HEADING-LINE-2.
05 PIC X(10) VALUE 'PART NO'.
05 PIC X(5) VALUE 'QUAN'.
05 PIC X(5) VALUE 'DATE'.
05 PIC X(11) VALUE 'CHARGE NO'.
05 PIC X(3) VALUE 'IN'.
05 PIC X(4) VALUE 'TRN'.
05 PIC X(3) VALUE SPACES.
05 PIC X(20) VALUE 'ERROR FIELD NAME'.
05 PIC X(17) VALUE 'ERROR FIELD VALUE'.
01 DETAIL-LINE.
05 PART-NUMBER PIC X(8).
05 PIC X VALUE SPACE.
05 QUANTITY PIC X(5).
05 PIC X VALUE SPACE.
05 DATE-X PIC X(4).
05 PIC X VALUE SPACE.
05 CHARGE-NUMBER PIC X(10).
05 PIC X VALUE SPACE.
05 INITIALS PIC XX.
05 PIC X VALUE SPACE.
05 TRANS-CODE PIC X(3).
05 PIC X(4) VALUE SPACES.
05 FIELD-NAME PIC X(18).
05 PIC XX VALUE SPACES.
05 FIELD-VALUE PIC X(10).
01 TRANSACTIONS.
05 PIC X(41) VALUE 'Total Transactions:'.
05 T-1 PIC 99.
01 ERROR-TRANSACTIONS.
05 PIC X(41) VALUE 'Total Error Transactions:'.
05 T-2 PIC 99.
01 GOOD-TRANSACTIONS.
05 PIC X(41) VALUE 'Total Good Transactions:'.
05 T-3 PIC 99.
01 QUANTITY-TOTAL.
05 PIC X(41) VALUE 'Good Transactions Quantity Total:'.
05 Q-4 PIC 9,999.
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT INVENTORY-TRANS-FILE-IN
OPEN OUTPUT INVENTORY-TRANS-FILE-OUT-2
ACCEPT WS-CURRENT-DATE FROM DATE
MOVE RUN-MONTH TO MONTH-1
MOVE RUN-DAY TO DAY-1
MOVE RUN-YEAR TO YEAR-1
PERFORM 150-WRITE-HEADINGS
PERFORM UNTIL RECORDS-ERROR-SWITCH = 'YES'
READ INVENTORY-TRANS-FILE-IN
AT END
PERFORM 500-TRANSACTIONS
PERFORM 510-ERROR-TRANSACTIONS
PERFORM 520-GOOD-TRANSACTIONS
PERFORM 530-QUANTITY
MOVE 'YES' TO RECORDS-ERROR-SWITCH
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE INVENTORY-TRANS-FILE-IN
CLOSE INVENTORY-TRANS-FILE-OUT-2
STOP RUN.
150-WRITE-HEADINGS.
ADD 1 TO PAGE-NUMBER
MOVE PAGE-NUMBER TO HL-1-PAGE-NUMBER
MOVE HEADING-LINE-1 TO INVENTORY-TRANS-RECORD-OUT-2
IF WS-FIRST-TIME-THRU = 'YES'
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE 'NO' TO WS-FIRST-TIME-THRU
ELSE
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING PAGE
END-IF
MOVE HEADING-LINE-2 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE 1 TO LINES-PRINTED.
200-PROCESS-ONE-RECORD.
IF LINES-PRINTED > 54
PERFORM 150-WRITE-HEADINGS
END-IF
MOVE 'NO' TO RECORDS-ERROR-SWITCH
PERFORM 300-VALIDATE-PART-NUMBER
PERFORM 310-VALIDATE-QUANTITY
PERFORM 320-VALIDATE-DATE
PERFORM 330-VALIDATE-CHARGE-NUMBER
PERFORM 340-VALIDATE-INITIALS
PERFORM 350-VALIDATE-TRANSACTION-CODE
MOVE PART-NUMBER-IN TO PART-NUMBER
MOVE QUANTITY-IN TO QUANTITY
MOVE DATE-IN TO DATE-X
MOVE CHARGE-NUMBER-IN TO CHARGE-NUMBER
MOVE INITIALS-IN TO INITIALS
MOVE TRANS-CODE-IN TO TRANS-CODE
IF RECORDS-ERROR-SWITCH = 'NO'
ADD 1 TO TOTAL-GOOD-COUNT
ADD 1 TO TOTAL-GOOD-QUANTITY
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE DETAIL-LINE TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
ELSE
ADD 1 TO TOTAL-ERROR-COUNT
END-IF.
300-VALIDATE-PART-NUMBER.
IF NOT VALID-PART-NUMERIC-2
MOVE 'Part Number' TO FIELD-NAME
MOVE PART-NUMBER-IN TO FIELD-VALUE
END-IF.
310-VALIDATE-QUANTITY.
IF QUANTITY-9-IN IS GREATER THAN '20,000'
MOVE 'Quantity' TO FIELD-NAME
MOVE QUANTITY-IN TO FIELD-VALUE
END-IF.
320-VALIDATE-DATE.
IF NOT VALID-MONTH-IN
MOVE 'Date' TO FIELD-NAME
MOVE DATE-IN TO FIELD-VALUE
ELSE
IF NOT VALID-DAY-IN
MOVE 'Date' TO FIELD-NAME
MOVE DATE-IN TO FIELD-VALUE
END-IF
END-IF.
330-VALIDATE-CHARGE-NUMBER.
IF CHARGE-NUMBER-IN IS EQUAL TO ''
MOVE 'Charge Number' TO FIELD-NAME
MOVE CHARGE-NUMBER-IN TO FIELD-VALUE
END-IF.
340-VALIDATE-INITIALS.
IF ((INITIALS-1-IN IS EQUAL TO '') OR (INITIALS-2-IN IS EQUAL TO ''))
MOVE 'Initials' TO FIELD-NAME
MOVE INITIALS-IN TO FIELD-NAME
END-IF.
350-VALIDATE-TRANSACTION-CODE.
IF NOT VALID-TRANS-CODE-IN
MOVE 'Transaction Code' TO FIELD-NAME
MOVE TRANS-CODE-IN TO FIELD-VALUE
END-IF.
500-TRANSACTIONS.
MOVE WS-TOTAL TO TRANSACTIONS
MOVE T-1 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
510-ERROR-TRANSACTIONS.
MOVE WS-ERROR TO ERROR-TRANSACTIONS
MOVE T-2 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
520-GOOD-TRANSACTIONS.
MOVE WS-GOOD TO GOOD-TRANSACTIONS
MOVE T-3 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
530-QUANTITY.
MOVE WS-QUANTITY TO QUANTITY-TOTAL
MOVE Q-4 TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2 AFTER ADVANCING 2 LINES.
If you have any questions please let me know.
The duplicate output occurs in the following code.
IF RECORDS-ERROR-SWITCH = 'NO'
ADD 1 TO TOTAL-GOOD-COUNT
ADD 1 TO TOTAL-GOOD-QUANTITY
WRITE INVENTORY-TRANS-RECORD-OUT-2
MOVE DETAIL-LINE TO INVENTORY-TRANS-RECORD-OUT-2
WRITE INVENTORY-TRANS-RECORD-OUT-2
The first WRITE statement prints a duplicate of the previous line. The second WRITE statement prints a new line, which is printed again on the next loop. Remove the first WRITE statement.
Other problems I noted are:
Invalid literals
330-VALIDATE-CHARGE-NUMBER.
IF CHARGE-NUMBER-IN IS EQUAL TO ''
340-VALIDATE-INITIALS.
IF ((INITIALS-1-IN IS EQUAL TO '') OR (INITIALS-2-IN IS EQUAL TO ''))
A zero-length literal is not permitted; thus, in each case, '' should be ' '.
Invalid numeric compare
310-VALIDATE-QUANTITY.
IF QUANTITY-9-IN IS GREATER THAN '20,000'
QUANTITY-9-IN is defined as PIC 9(5); however the data contains leading spaces and '20,000' is not valid for numeric comparisons. A proper numeric comparison could be:
IF FUNCTION NUMVAL (QUANTITY-IN) IS GREATER THAN 20000
These following were not investigated further than noted.
Print spacing does not match the desired output
There are no ADVANCING phrases for the lines written, thus only single-spacing is used.
Totals do not print correctly
WS-QUANTITY is defined as PIC 9V999. It should be 9999 or 9(4).
The data items for the totals are not being incremented.
The MOVE statements in the 500-, 510-, 520-, and 530- paragraphs overwrite fixed text.

COBOL report at end of program

I am trying to finish a program that I have started but am confused as to what I need to do and how to do the last step. The instructions are to:
At the end of report:
A. Print the number of personnel records processed.
B. The number of records where there was an unsuccessful search of the Dept Table.
C. The number of records where there was an unsuccessful search of the Title Table.
I have completed all of the program except this last step. Can someone please help me finish this program?
enter code here ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PERSONNEL-FILE
ASSIGN TO 'CH12PPPF.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT DEPT-TABLE-FILE
ASSIGN TO 'CH12PPDT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT TITLE-TABLE-FILE
ASSIGN TO 'CH12PPTT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-FILE
ASSIGN TO 'THORNTONCA4.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD PERSONNEL-FILE.
01 PERSONNEL-REC.
05 SSNO-IN PIC 9(9).
05 NAME-IN PIC X(20).
05 SALARY-IN PIC 9(6).
05 CAMPUS-CODE-IN PIC 9.
05 DEPT-CODE-IN PIC 99.
05 TITLE-CODE-IN PIC 999.
FD DEPT-TABLE-FILE.
01 DEPT-REC.
05 T-DEPT-NO PIC 99.
05 T-DEPT-NAME PIC X(10).
FD TITLE-TABLE-FILE.
01 TITLE-REC.
05 T-TITLE-CODE PIC 999.
05 T-TITLE-NAME PIC X(10).
FD PRINT-FILE.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 STORED-AREAS.
05 MORE-RECS PIC X(3) VALUE 'YES'.
05 WS-DATE.
10 WS-YEAR PIC 9999.
10 WS-MONTH PIC 99.
10 WS-DAY PIC 99.
05 WS-PAGE-CT PIC 99
VALUE ZERO.
05 WS-LINE-CT PIC 99
VALUE ZERO.
01 HDR1-OUT.
05 PIC X(25)
VALUE SPACES.
05 PIC X(20)
VALUE 'FINAL REPORT'.
05 DATE-OUT.
10 MONTH-OUT PIC 99.
10 PIC X
VALUE '/'.
10 DAY-OUT PIC 99.
10 PIC X
VALUE '/'.
10 YEAR-OUT PIC 9999.
05 PIC X(2)
VALUE SPACES.
05 PIC X(5)
VALUE 'PAGE'.
05 PAGE-OUT PIC Z9.
*****************************************************************
* The Campus Table consists of 5 10-position names and will be *
* accessed as a direct-referenced table. EACH_CAMPUS *
* subscriped by the CAMPUS_CODE_IN will provide the name. *
*****************************************************************
01 CAMPUTS-TABLE
VALUE 'UPSTATE DOWNSTATE CITY MELVILLE HUNTINGTON'.
05 EACH-CAMPUS
OCCURS 5 TIMES PIC X(10).
*****************************************************************
* The Dept Table will be accessed by a SEARCH. Even if the *
* table is entered in Dept No sequence, there would be no *
* real benefit to using a SEARCH ALL since there are only *
* 25 entries. *
*****************************************************************
01 DEPT-TABLE.
05 DEPT-ENTRIES OCCURS 25 TIMES INDEXED BY X1.
10 DEPT-NO PIC 99.
10 DEPT-NAME PIC X(10).
*****************************************************************
* The Title Talbe will be accessed by a SEARCH ALL. To use a *
* binary seach the entries must be in sequence by a key *
* field and the table should be relatively large. *
*****************************************************************
01 TITLE-TABLE.
05 TITLE-ENTRIES OCCURS 50 TIMES
ASCENDING KEY IS TITLE-NO INDEXED BY X2.
10 TITLE-NO PIC 999.
10 TITLE-NAME PIC X(10).
01 DETAIL-REC.
05 PIC X(1) VALUE SPACES.
05 SSNO-OUT PIC 999B99B9999.
05 PIC X(1) VALUE SPACES.
05 NAME-OUT PIC X(20).
05 PIC X(1) VALUE SPACES.
05 SALARY-OUT PIC $ZZZ,ZZZ.
05 PIC X(1) VALUE SPACES.
05 CAMPUS-OUT PIC X(10).
05 PIC X(1) VALUE SPACES.
05 DEPT-OUT PIC X(10).
05 PIC X(1) VALUE SPACES.
05 TITLE-OUT PIC X(10).
PROCEDURE DIVISION.
100-MAIN-MODULE.
OPEN INPUT PERSONNEL-FILE
DEPT-TABLE-FILE
TITLE-TABLE-FILE
OUTPUT PRINT-FILE
MOVE FUNCTION CURRENT-DATE TO WS-DATE
MOVE WS-MONTH TO MONTH-OUT
MOVE WS-DAY TO DAY-OUT
MOVE WS-YEAR TO YEAR-OUT
PERFORM 500-HDG-RTN.
PERFORM 200-LOAD-DEPT-TABLE
PERFORM 300-LOAD-TITLE-TABLE
PERFORM UNTIL MORE-RECS = 'NO '
READ PERSONNEL-FILE
AT END
MOVE 'NO ' TO MORE-RECS
NOT AT END
PERFORM 400-CALC-RTN
END-READ
END-PERFORM
CLOSE PERSONNEL-FILE
DEPT-TABLE-FILE
TITLE-TABLE-FILE
PRINT-FILE
STOP RUN.
200-LOAD-DEPT-TABLE.
PERFORM VARYING X1 FROM 1 BY 1
UNTIL X1 > 25
READ DEPT-TABLE-FILE
AT END DISPLAY 'NOT ENOUGH DEPT TABLE RECORDS'
STOP RUN
END-READ
MOVE DEPT-REC TO DEPT-ENTRIES (X1)
END-PERFORM.
300-LOAD-TITLE-TABLE.
PERFORM VARYING X2 FROM 1 BY 1
UNTIL X2 > 50
READ TITLE-TABLE-FILE
AT END DISPLAY 'NOT ENOUH TITLE TABLE RECORDS'
STOP RUN
END-READ
MOVE TITLE-REC TO TITLE-ENTRIES (X2)
IF X2 > 1 THEN
IF TITLE-NO (X2) <= TITLE-NO (X2 - 1)
DISPLAY 'TITLE RECORDS ARE NOT IN SEQUENCE'
STOP RUN
END-IF
END-IF
END-PERFORM.
400-CALC-RTN.
MOVE SPACES TO DETAIL-REC
MOVE SSNO-IN TO SSNO-OUT
MOVE NAME-IN TO NAME-OUT
MOVE SALARY-IN TO SALARY-OUT
IF CAMPUS-CODE-IN >= 1 AND <= 5
MOVE EACH-CAMPUS (CAMPUS-CODE-IN) TO CAMPUS-OUT
END-IF
SET X1 TO 1
SEARCH DEPT-ENTRIES
AT END MOVE 'XXXXXXXXXX' TO DEPT-OUT
WHEN DEPT-CODE-IN = DEPT-NO (X1)
MOVE DEPT-NAME (X1) TO DEPT-OUT
END-SEARCH
SEARCH ALL TITLE-ENTRIES
AT END MOVE 'XXXXXXXXXX' TO TITLE-OUT
WHEN TITLE-NO (X2) = TITLE-CODE-IN
MOVE TITLE-NAME (X2) TO TITLE-OUT
END-SEARCH
WRITE PRINT-REC FROM DETAIL-REC
AFTER ADVANCING 2 LINES.
500-HDG-RTN.
ADD 1 TO WS-PAGE-CT
MOVE WS-PAGE-CT TO PAGE-OUT
WRITE PRINT-REC FROM HDR1-OUT
AFTER ADVANCING PAGE
MOVE ZEROS TO WS-LINE-CT.
You need to:
Produce code to accumulate all the values you need to print at the end
Produce definition(s) of the final part of the report
Produce the final part of report once the main input file has been processed, ie after your first PERFORM and before the CLOSE
You should get into the habit of checking all file statuses after each IO operation, using FILE-STATUS, and accurately report when something unexpected happens.
You'll find it worthwhile to give good names even to indexes, and use 88s wherever possible for IF or EVALUATE and avoid using things like this "IF CAMPUS-CODE-IN >= 1 AND <= 5".

Occurs and Subscripts

I seem to have yet another problem dealing with COBOL. My teacher has assigned us with having to take a file of names and make it into two columns going 54 rows down. I thought this was going to be simple as I looked in the book as it was more or less using a new function to do what I had all ready been doing, but once I got home and put down my code it all went to heck. Th program I made, for some reason unknown to me, only writes one name in the first column of row one and the does the same ever 54 rows. I am obviously on the wrong track but in my mind it looks right. Here is what I got:
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
01 REPORT-START PIC X VALUE 'Y'.
01 LINE-COUNT PIC 99 VALUE ZEROS.
01 PAGE-NUMBER PIC 99 VALUE ZEROS.
01 NAME-COUNT PIC 9(3) VALUE ZEROS.
01 WORK-AREA-1.
05 N-COLUMN-1 PIC 99 VALUE ZEROS.
01 WORK-AREA-2.
05 N-COLUMN-2 PIC 9(3) VALUE 54.
01 NAME-STORAGE.
05 NAME-STO OCCURS 108 TIMES PIC X(30).
01 WS-DATE.
05 RUN-YEAR PIC XX.
05 RUN-MONTH PIC XX.
05 RUN-DAY PIC XX.
01 HEADING-LINE-1.
05 PIC X(32) VALUE SPACES.
05 PIC X(16)
VALUE 'NAME LIST REPORT'.
05 PIC X(6) VALUE SPACES.
05 HL-1-DATE.
10 MONTH-2 PIC XX.
10 PIC X VALUE '/'.
10 DAY-2 PIC XX.
10 PIC X VALUE '/'.
10 YEAR-2 PIC XX.
05 PIC X(4) VALUE SPACES.
05 PAGE-1 PIC X(4) VALUE 'PAGE'.
05 PIC X(1) VALUE SPACES.
05 NUMBER-PAGE PIC Z9.
01 DETAIL-LINE.
05 BLANK-A-OUT PIC X(4) VALUE SPACES.
05 DL-COLUMN-1 PIC X(30).
05 BLANK-E-OUT PIC X(20) VALUE SPACES.
05 DL-COLUMN-2 PIC X(30).
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT NAMELIST-FILE-IN
OPEN OUTPUT NAMELIST-FILE-OUT
ACCEPT WS-DATE FROM DATE
MOVE RUN-MONTH TO MONTH-2
MOVE RUN-DAY TO DAY-2
MOVE RUN-YEAR TO YEAR-2
PERFORM 200-NEXT-PAGE
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
READ NAMELIST-FILE-IN
AT END
MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 300-STORE-NAME
END-READ
END-PERFORM
CLOSE NAMELIST-FILE-IN
CLOSE NAMELIST-FILE-OUT
STOP RUN.
200-NEXT-PAGE.
ADD 1 TO PAGE-NUMBER
MOVE PAGE-NUMBER TO NUMBER-PAGE
MOVE HEADING-LINE-1 TO NAMELIST-RECORD-OUT
IF REPORT-START = 'N'
WRITE NAMELIST-RECORD-OUT
AFTER ADVANCING PAGE
ELSE
MOVE 'N' TO REPORT-START
WRITE NAMELIST-RECORD-OUT
AFTER ADVANCING 1 LINE
END-IF.
MOVE ZEROS TO LINE-COUNT.
300-STORE-NAME.
ADD 1 TO NAME-COUNT
MOVE NAME-IN TO NAME-STORAGE
IF NAME-COUNT > 54
PERFORM 400-PROCESS-FILE
END-IF.
400-PROCESS-FILE.
IF LINE-COUNT >= 52
PERFORM 200-NEXT-PAGE
END-IF
ADD 1 TO LINE-COUNT
ADD 1 TO N-COLUMN-1
ADD 1 TO N-COLUMN-2
MOVE NAME-STO (N-COLUMN-1) TO DL-COLUMN-1
MOVE NAME-STO (N-COLUMN-2) TO DL-COLUMN-2
MOVE DETAIL-LINE TO NAMELIST-RECORD-OUT
WRITE NAMELIST-RECORD-OUT
AFTER ADVANCING 1 LINE
IF N-COLUMN-2 = 108
MOVE 0 TO NAME-COUNT
MOVE 0 TO N-COLUMN-1
MOVE 54 TO N-COLUMN-2
END-IF.
This is not all I have to do, but until I figure this out I cannot continue.
I'm not familiar with this dialect of COBOL, but i thnk the problem is with:
MOVE NAME-IN TO NAME-STORAGE
I t should look like this:
MOVE NAME-IN TO NAME-STO OF NAME-STORAGE(NAME-COUNT)
Am i right am i wrong or am i just dreaming?

Resources