How I can move data from example :
I-DATA PIC X7 VALUE ' 12.34'.
to
O-DATA PIC S9(13)V99 COMP-3.
05 I-DATA PIC X(7).
05 I-NUMERIC REDEFINES I-DATA PIC 9999.99.
.
.
MOVE I-NUMERIC TO O-DATA.
You need to redefine you AlphaNumerc as a Display Numeric which can then be moved to the packed decimal variable. Be careful as this will bomb out with an OC7 if there is anything other than numbers or spaces plus the '.' in the data.
Your pic clause for i-data is bad (it should be PIC X(7)).
Anyway to answer your question, use MOVE ... TO ... WITH CONVERSION ON EXCEPTION ... END-MOVE
05 I-DATA PIC X(7).
05 O-DATA PIC S9(13)V99 COMP-3.
05 HAD-ERROR-FLAG PIC X.
88 HAD-ERROR VALUE "Y" FALSE "N".
...
MOVE I-DATA TO O-DATA WITH CONVERSION
ON EXCEPTION
MOVE ZERO TO O-DATA
SET HAD-ERROR TO TRUE
NOT ON EXCEPTION
SET HAD-ERROR TO FALSE
END-MOVE
Related
Looking for solution on my problem. The values I need to convert was in alphanumeric.
05 WS-NUM-TX.
05 WS-NUM PIC P9(04).
05 WS-NUM1 PIC P9(03).
05 WS-NUM2 PIC P9(03).
MOVE '0001 222217' TO WS-NUM-TX.
MOVE WS-NUM-TX(1:4) TO WS-NUM.
MOVE WS-NUM-TX(6:3) TO WS-NUM1.
MOVE WS-NUM-TX(9:3) TO WS-NUM2.
I did COMPUTE WS-NUM = FUNCTION NUMVAL(WS-NUM-TX) for this to be numeric.
Now, the problem is, I need this values as decimal for computation. Need help to convert this values to become .0001, .222 and .217 however the declaration
I did for external decimal displayed with no decimal point. Please help. Thank You.
The P in the PICTURE clause is an error, as is the absence of a PICTURE clause for WS-NUM-TX. (As of the the 4th revision.)
Possibly,
05 WS-NUM-TX PIC X(11).
05 WS-NUM PIC .9(04).
05 WS-NUM1 PIC .9(03).
05 WS-NUM2 PIC .9(03).
MOVE '0001 222217' TO WS-NUM-TX.
COMPUTE WS-NUM = FUNCTION NUMVAL (WS-NUM-TX(1:4)) / 10000.
COMPUTE WS-NUM1 = FUNCTION NUMVAL (WS-NUM-TX(6:3)) / 1000.
COMPUTE WS-NUM2 = FUNCTION NUMVAL (WS-NUM-TX(9:3)) / 1000.
Based on the original post (revisions 1 and 2) with additional editing.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 FILLER.
05 WS-NUM-TX.
07 WS-NUM-TX1 PIC 9(4).
07 FILLER PIC X.
07 WS-NUM-TX2 PIC 9(3).
07 WS-NUM-TX3 PIC 9(3).
05 WS-NUM PIC .9(04).
05 WS-NUM1 PIC .9(03).
05 WS-NUM2 PIC .9(03).
PROCEDURE DIVISION.
BEGIN.
MOVE '0001 222217' TO WS-NUM-TX.
DIVIDE WS-NUM-TX1 BY 10000 GIVING WS-NUM.
DIVIDE WS-NUM-TX2 BY 1000 GIVING WS-NUM1.
DIVIDE WS-NUM-TX3 BY 1000 GIVING WS-NUM2.
DISPLAY WS-NUM
DISPLAY WS-NUM1
DISPLAY WS-NUM2
STOP RUN
.
Output:
.0001
.222
.217
Use V in the picture clause. This determines the position of the comma.
For example: PIC 9(05)V9(03) will result in 00000,000
Source: https://www.ibm.com/support/knowledgecenter/en/SS6SG3_4.2.0/com.ibm.entcobol.doc_4.2/PGandLR/ref/rlddesym.htm
I am still new to COBOL and have been working on a project for school for almost a week now. I am running OpenCobol 1.1.
When I try to compile it I get this error.
typeck.c:5912: Invalid type cast from 'null'
Tag 1 0 Tag 2 10
Aborting compile of lab4.cob at line 214
I've been frustrated because I've tried changing the code around a lot with no luck.
Procedure Division.
000-Main.
Perform 100-initialize
Perform Until EndOfFile = "Y"
Read Lab4-in-File
At End
Move "Y" To EndOfFile
Not At End
Perform 300-process
End-Read
End-Perform
Perform 900-finalize
Stop Run.
100-intialize.
Perform 110-open-files
Perform 120-get-data.
110-open-files.
Open Input Lab4-in-File
Output Ot-File.
120-get-date.
Accept WS-date from date yyyymmdd
Move WS-Year To PH-Year
Move WS-Month To PH-Month
Move WS-Day To PH-Day.
300-process.
Move Dept-no To dl-dep-no
Move Employee-no To dl-emp-no
If First-name Not = "Null"
String First-name Delimited By Size
" " Delimited By Size
Last-name Delimited By Size
Into dl-emp
else
Move Last-name To dl-emp
End-If
Move Job-title To dl-job
Move DOH To dl-doh
Move Mar-status To dl-marital
Move Dependents To dl-dependents
Move MCoverage To dl-insurance
Move DCoverage To dl-insurance
Move VCoverage To dl-insurance
Move 401K To dl-401k
Move Pay-code To dl-pay-code
If Pay-code = "C" Or "S"
Compute Pay-hold rounded =
Pay / 12
Move Pay-hold To dl-monthly-pay
else
Compute Pay-hold rounded =
Pay * HPW * 4
Move Pay-hold To dl-monthly-pay
End-If
If Pay-code = "C"
Compute Com-hold rounded =
Act-sale * C-rate
Move Com-hold To dl-commission
Else
Move 0 To dl-commission
End-If
Perform 800-print
Multiply C-rate By Act-sale Giving
total-sales
Add Pay To total-sales.
800-print.
If LineNum > LinesPerPage
Perform 825-new-page
End-If
Write Lab4-Record2 From Detail-Line
**After advancing 1 line** *> This is line 214
Add 1 To LineNum.
825-new-page.
If PageNum > 0
Write Lab4-Record2 From Blank-line
After advancing 1 line
End-If
Add 1 To PageNum
Move PageNum To PH-PageNo
Write Lab4-Record2 From Page-Header
After advancing page
Write Lab4-Record2 From Blank-line
After advancing 1 line
Write Lab4-Record2 From Column-Header
After advancing 1 line
Write Lab4-Record2 From Blank-line
After advancing 1 line
Move 5 To LineNum.
900-finalize.
Perform 950-print-monthly-total
Perform 999-close-files.
950-print-monthly-total.
If LineNum + 1 > LinesPerPage
Perform 825-new-page
End-If
Write Lab4-Record2 From Blank-line
After advancing 1 line
Move total-sales To Total-pay
Write Lab4-Record2 From Total-Line
After advancing 1 line
Add 2 To LineNum.
999-close-files.
Close Lab4-in-File Ot-File.
I would really appreciate it if someone could help me find what is causing the error. Thanks in advance!
Working-Storage Section.
01 EndOfFile Pic X Value "N".
01 Report-fields.
05 PageNum Pic 9(3) value 0.
05 LinesPerPage Pic 9(2) value 40.
05 LineNum Pic 9(2) value 41.
01 WS-date.
05 WS-Year Pic 9(4).
05 WS-Month Pic 99.
05 WS-Day Pic 99.
01 total-fields.
05 total-sales Pic 9(11)v99 Value 0.
01 Page-Header.
05 PH-Month Pic Z9/.
05 PH-Day Pic 99/.
05 PH-Year Pic 9999.
05 Pic X(7) Value Spaces.
05 Pic X(29) Value "Stomper &" &
" Wombat's Emporium"
05 Pic X(6) Value "Page:".
05 PH-PageNo Pic ZZ9.
01 Column-Header.
05 Pic X(8) Value "Dep #".
05 Pic X(15) Value "Emp #".
05 Pic X(27) Value "Employee".
05 Pic X(18) Value "Title".
05 Pic X(9) Value "DOH".
05 Pic X(9) Value "Marital".
05 Pic X(7) Value "#Deps".
05 Pic X(6) Value "Ins".
05 Pic X(6) Value "401K".
05 Pic X(6) Value "Pay".
05 Pic X(27) Value "Expected " &
"Pay + Commission".
01 Pay-hold Pic 9(9)V9(2) Value 0.
01 Com-hold Pic 9(9)V9(2) Value 0.
01 Detail-Line.
05 dl-dep-no Pic X(5).
05 Pic X(1) Value spaces.
05 dl-emp-no Pic X(5).
05 Pic X(1) Value spaces.
05 dl-emp Pic X(35).
05 Pic X(1) Value spaces.
05 dl-job Pic X(20).
05 Pic X(1) Value spaces.
05 dl-doh Pic X(8).
05 Pic X(1) Value spaces.
05 dl-marital Pic X.
05 Pic X(1) Value spaces.
05 dl-dependents Pic 9(2).
05 Pic X(1) Value spaces.
05 dl-insurance Pic X(3).
05 Pic X(1) Value spaces.
05 dl-401k Pic Z.9ZZ.
05 Pic X(1) Value spaces.
05 dl-pay-code Pic X.
05 Pic X(1) Value spaces.
05 dl-monthly-pay Pic $$$$,$$$,$$9.99.
05 Pic X(1) Value spaces.
05 dl-commission Pic $$$,$$9.99.
01 Total-Line.
05 Pic X(61) Value Spaces.
05 Pic X(24) Value "Total" &
" Expected Payroll: ".
05 Total-pay Pic $$$$,$$$,$$$,$$9.99.
01 Blank-line Pic X Value spaces.
The compiler has a broken parser. It is broken because of a coding error (still a compiler bug). In cases like this you only have the chance to either spot the error or - much better - use a newer version.
I've just put your code in an online compiler using the last release of the compiler: GnuCOBOL 2.2. I highly suggest to upgrade to at least this version.
See your code here - I've just added a minimal header and end.
Then click on "Execute" and you compile it online, leading to the following error messages:
main.cobc: 27: error: duplicate PICTURE clause
main.cobc: 27: error: duplicate VALUE clause
main.cobc: 64: error: a Z or * which is after the decimal point cannot follow 9
If you check the line 27 in this program you see
05 Pic X(29) Value "Stomper &" &
" Wombat's Emporium" *> <<- missing period
05 Pic X(6) Value "Page:".
Fixed code is also available.
I am getting errors concerning my procedure division in one of my assignments for class. It is a COBOL Program that is supposed to keep a running total of the average height and weight of applicants, number of brown-eyed applicants, number of male applicants, and number of female applicants. Also the program is supposed to print the info of applicants who meet a specific set of requirements but i'm getting errors for almost all of my perform statements
COBCH0034 Operand operand should be numeric
A numeric value is required in this context, and you have specified a nonnumeric value.
COBCH0014 Invalid operand
The operand you have specified is in some way incorrect, and cannot be processed by your COBOL system. For example, you might have specified a negative integer where only positive integers are allowed
identification division.
program-id. ELECTRA-MODELING-AGENCY.
******************************************************************
*THIS PROGRAM PRODUCES THE REPORT ACCORDING TO THE GIVEN PRINTER
*SPACING CHART *
******************************************************************
environment division.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO "INFILE.txt"
Organization is line sequential.
SELECT OUTPUT-FILE ASSIGN TO "CHOSEN-APLICANTS.TXT"
Organization is line sequential.
data division.
FILE SECTION.
FD INPUT-FILE.
01 INPUT-REC.
05 APPLICANTS-NAME PIC X(20).
05 APPLICANTS-WEIGHT PIC 9(3).
05 APPLICANTS-HEIGHT PIC 9(2).
05 APPLICANTS-EYE-CODE PIC X.
05 APPLICANTS-HAIR-CODE PIC X.
05 APPLICANTS-GENDER PIC X.
FD OUTPUT-FILE.
01 OUTPUT-REC PIC X(78).
WORKING-STORAGE SECTION.
01 EOF PIC X VALUE "N".
01 HEADING-1.
05 FILLER PIC X(41) VALUE "M"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "O"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "D"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "E"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "L"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "R"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "E"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "P"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "O"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "R"
JUSTIFIED RIGHT.
05 FILLER PIC X(2) VALUE "T"
JUSTIFIED RIGHT.
05 FILLER PIC X(16) VALUE SPACES.
01 HEADING-2.
05 FILLER PIC X(23) VALUE "NAME"
JUSTIFIED RIGHT.
05 FILLER PIC X(13) VALUE "SEX"
JUSTIFIED RIGHT.
05 FILLER PIC X(10) VALUE "WEIGHT"
JUSTIFIED RIGHT.
05 FILLER PIC X(8) VALUE "HEIGHT"
JUSTIFIED RIGHT.
05 FILLER PIC X(5) VALUE "EYE"
JUSTIFIED RIGHT.
05 FILLER PIC X(6) VALUE "COLOR"
JUSTIFIED RIGHT.
05 FILLER PIC X(6) VALUE "HAIR"
JUSTIFIED RIGHT.
05 FILLER PIC X(6) VALUE "COLOR"
JUSTIFIED RIGHT.
05 FILLER PIC X VALUE SPACES.
01 DETAIL-LINE.
05 FILLER PIC X(10) VALUE SPACES.
05 NAME-OUT PIC X(20).
05 FILLER PIC X(4) VALUE SPACES.
05 GENDER-OUT PIC X.
05 FILLER PIC X(6) VALUE SPACES.
05 WEIGHT-OUT PIC X(3).
05 FILLER PIC X(6) VALUE SPACES.
05 HEIGHT-OUT PIC XX.
05 FILLER PIC X(6) VALUE SPACES.
05 EYE-COLOR-OUT PIC X(5).
05 FILLER PIC X(6) VALUE SPACES.
05 HAIR-COLOR-OUT PIC X(6).
01 SUMMARY-LINE-01
05 FILLER PIC X(17) VALUE "AVERAGE"
JUSTIFIED RIGHT.
05 FILLER PIC X(7) VALUE "HEIGHT"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "OF"
JUSTIFIED RIGHT.
05 FILLER PIC X(4) VALUE "ALL"
JUSTIFIED RIGHT.
05 FILLER PIC X(12) VALUE "APPLICANTS:"
JUSTIFIED RIGHT.
05 FILLER PIC X.
05 AVERAGE-HEIGHT PIC ZZZ9.
05 FILLER PIC X(12) VALUE SPACES.
01 SUMMARY-LINE-02
05 FILLER PIC X(17) VALUE "AVERAGE"
JUSTIFIED RIGHT.
05 FILLER PIC X(7) VALUE "WEIGHT"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "OF"
JUSTIFIED RIGHT.
05 FILLER PIC X(4) VALUE "ALL"
JUSTIFIED RIGHT.
05 FILLER PIC X(12) VALUE "APPLICANTS:"
JUSTIFIED RIGHT.
05 FILLER PIC X.
05 AVERAGE-WEIGHT PIC ZZZ9.
05 FILLER PIC X(12) VALUE SPACES.
01 SUMMARY-LINE-03
05 FILLER PIC X(16) VALUE "NUMBER"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "OF"
JUSTIFIED RIGHT.
05 FILLER PIC X(11) VALUE "BROWN-EYED"
JUSTIFIED RIGHT.
05 FILLER PIC X(12) VALUE "APPLICANTS:"
JUSTIFIED RIGHT.
05 FILLER PIC XX.
05 BROWN-EYED-APPLICANTS PIC ZZZ9.
05 FILLER PIC X(12) VALUE SPACES.
01 SUMMARY-LINE-04
05 FILLER PIC X(16) VALUE "NUMBER"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "OF"
JUSTIFIED RIGHT.
05 FILLER PIC X(5) VALUE "MALE"
JUSTIFIED RIGHT.
05 FILLER PIC X(12) VALUE "APPLICANTS:"
JUSTIFIED RIGHT.
05 FILLER PIC X(8) VALUE SPACES.
05 MALE-APPLICANTS PIC ZZZ9.
05 FILLER PIC X(12) VALUE SPACES.
01 SUMMARY-LINE-05
05 FILLER PIC X(16) VALUE "NUMBER"
JUSTIFIED RIGHT.
05 FILLER PIC X(3) VALUE "OF"
JUSTIFIED RIGHT.
05 FILLER PIC X(7) VALUE "FEMALE"
JUSTIFIED RIGHT.
05 FILLER PIC X(11) VALUE "APPLICANTS:"
JUSTIFIED RIGHT.
05 FILLER PIC X(6) VALUE SPACES.
05 FEMALE-APPLICANTS PIC ZZZ9.
05 FILLER PIC X(12) VALUE SPACES.
procedure division.
100-main.
OPEN INPUT INPUT-FILE
OUTPUT OUTPUT-FILE
PERFORM UNTIL EOF = 'Y'
READ INPUT-FILE
AT END MOVE 'Y' TO EOF
NOT AT END
PERFORM 200-HEADING.
PERFORM 200-AVG-HEIGHT.
PERFORM 200-AVG-WEIGHT.
PERFORM 200-BROWN-EYED-APPS.
PERFORM 200-MALE-APPS.
PERFORM 200-FEMALE-APPS.
PERFORM 200-MALE-DETAIL-LINE.
PERFORM 200-FEMALE-DETAIL-LINE.
CLOSE INPUT-FILE, OUTPUT-FILE.
STOP RUN.
200-HEADING.
WRITE OUTPUT-REC FROM HEADING-1.
MOVE SPACES TO OUTPUT-REC.
WRITE OUTPUT-REC.
WRITE OUTPUT-REC FROM HEADING-2.
MOVE SPACES TO OUTPUT-REC.
WRITE OUTPUT-REC.
200-AVG-HEIGHT.
IF NOT AT END
ADD APPLICANTS-HEIGHT TO AVERAGE-HEIGHT
ELSE AT END
DIVIDE AVERAGE-HEIGHT BY 21.
WRITE OUTPUT-REC FROM SUMMARY-LINE-01.
200-AVG-WEIGHT.
IF NOT AT END
ADD APPLICANTS-WEIGHT TO AVERAGE-WEIGHT
ELSE AT END
DIVIDE AVERAGE-HEIGHT BY 21.
WRITE OUTPUT-REC FROM SUMMARY-LINE-02.
200-BROWN-EYED-APPS.
IF APPLICANTS-EYE-CODE = 2
ADD 1 TO BROWN-EYED-APPLICANTS
ELSE CONTINUE.
WRITE OUTPUT-REC FROM SUMMARY-LINE-03.
200-MALE-APPS.
IF APPLICANTS-GENDER = M
ADD 1 TO MALE-APPLICANTS
ELSE CONTINUE.
WRITE OUTPUT-REC FROM SUMMARY-LINE-04.
200-FEMALE-APPS.
IF APPLICANTS-GENDER = F
ADD 1 TO FEMALE-APPLICANTS
ELSE CONTINUE.
WRITE OUTPUT-REC FROM SUMMARY-LINE-05.
200-MALE-DETAIL-LINE.
IF APPLICANTS-HAIR-CODE = 1
IF APPLICANTS-EYE-CODE = 1
IF APPLICANTS-GENDER = M
IF APPLICANTS-HEIGHT >= 72
IF 185 <= APPLICANTS-WEIGHT <= 200
ELSE CONTINUE.
WRITE OUTPUT-REC FROM 01 DETAIL-LINE.
200-FEMALE-DETAIL-LINE.
IF APPLICANTS-HAIR-CODE = 2
IF APPLICANTS-EYE-CODE = 2
IF APPLICANTS-GENDER = F
IF 62 <= APPLICANTS-HEIGHT <= 64
IF 110 <= APPLICANTS-WEIGHT <= 125
ELSE CONTINUE.
WRITE OUTPUT-REC FROM 01 DETAIL-LINE.
end program ELECTRA-MODELING-AGENCY.
So you have several things that are going wrong here. Let me detail a few of them and give you some hints to fix them.
You are using periods to end statements, this is awful and bad when you mix it with some of the newer (and by newer, i mean only 30 years old) style of statements, like inline perform and read/at end/not at end/end-read.
Instead of this:
PERFORM UNTIL EOF = 'Y'
READ INPUT-FILE
AT END MOVE 'Y' TO EOF
NOT AT END
PERFORM 200-HEADING.
PERFORM 200-AVG-HEIGHT.
PERFORM 200-AVG-WEIGHT.
PERFORM 200-BROWN-EYED-APPS.
PERFORM 200-MALE-APPS.
PERFORM 200-FEMALE-APPS.
PERFORM 200-MALE-DETAIL-LINE.
PERFORM 200-FEMALE-DETAIL-LINE.
CLOSE INPUT-FILE, OUTPUT-FILE.
STOP RUN.
You need something like this:
PERFORM UNTIL EOF = 'Y' <--- This is better as an 88 level
READ INPUT-FILE
AT END MOVE 'Y' TO EOF
NOT AT END
PERFORM SOMETHING <--- You need to accumulate you data here
END-READ
END-PERFORM
PERFORM 200-HEADING
PERFORM 200-AVG-HEIGHT
PERFORM 200-AVG-WEIGHT
PERFORM 200-BROWN-EYED-APPS
PERFORM 200-MALE-APPS
PERFORM 200-FEMALE-APPS
PERFORM 200-MALE-DETAIL-LINE
PERFORM 200-FEMALE-DETAIL-LINE
CLOSE INPUT-FILE, OUTPUT-FILE
STOP RUN. <--- This is the only period you need
<--- In your mainline
You can not do this:
200-AVG-HEIGHT.
IF NOT AT END <--- NOT AT END and AT END only work
<--- in the context of a READ statement
ADD APPLICANTS-HEIGHT TO AVERAGE-HEIGHT
ELSE AT END
DIVIDE AVERAGE-HEIGHT BY 21.
WRITE OUTPUT-REC FROM SUMMARY-LINE-01.
While you are looping through the file, accumulate the total height by adding each applicants to APPLICANTS-HEIGHT and adding 1 to your APPLICANTS-COUNT. When you are ready to do your summary line for height, do this:
200-AVG-HEIGHT.
DIVIDE APPLICANTS-HEIGHT BY APPLICANTS-COUNT
WRITE OUTPUT-REC FROM SUMMARY-LINE-01
. <---- Again, you only need a single period to end a paragraph
In all of your paragraphs, you are trying to accumulate your data AND write your summary line. This does not work. See the perform loop above where I have the "Perform Something To Accumulate your data", this is the paragraph you want to put all of your code that adds up every applicant. You need separate paragraphs, as you have, to write the summary lines.
So this should happen every record:
200-MALE-DETAIL-LINE.
IF APPLICANTS-HAIR-CODE = 1
IF APPLICANTS-EYE-CODE = 1
IF APPLICANTS-GENDER = M
IF APPLICANTS-HEIGHT >= 72
IF 185 <= APPLICANTS-WEIGHT <= 200
ELSE CONTINUE. <--- you are doing nothing here
WRITE OUTPUT-REC FROM 01 DETAIL-LINE.
It is better written like this:
200-MALE-DETAIL-LINE.
IF APPLICANTS-HAIR-CODE = 1
AND APPLICANTS-EYE-CODE = 1
AND APPLICANTS-GENDER = M
AND APPLICANTS-HEIGHT >= 72
AND (185 <= APPLICANTS-WEIGHT <= 200)
WRITE OUTPUT-REC FROM 01-DETAIL-LINE
END-IF
That should get you going. You will need to apply these hints to all the other paragraphs. In brief, your program should generally look like this:
Open Files
Perform until EOF
Read a-record
not at end
Perform Do-Detail-Lines
at end
Set EOF to true
End-Read
End-Perform
Perform Do-Summary-Lines
Close files
Stop Run.
Do-Detail-Lines.
...add up all the things you are averaging and counting...
...populate detail line...
write output-rec from detail-line
.
Do-Summary-Lines.
...calculate all averages...
...populate summary line...
write output-red from summary-line
...repeat as needed for other summary-lines...
.
Happy coding :-)
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.
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.
I'm working on an assignment for my class, and I'm having an issue with getting a percentage to show the proper value for my COBOL Lab.
My issue is with PERCENT-DISCOUNT / WS-PERCENT-WITH-DISCOUNT (at least, I believe it is).
When the program is run, I get the result 50.0. The result I should be getting (assuming I did the math correctly by hand) is 55.6. I'm not too sure where I'm going wrong.
Here is the code that I currently have written for the program.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. LAB2.
AUTHOR. XXXXXXX XXXXXXXXXXX.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IPT-FILE ASSIGN TO 'LAB2.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRT-FILE ASSIGN TO 'LAB2_OUTPUT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
FD IPT-FILE
RECORD CONTAINS 80 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS INPUT-RECORD.
01 IPT-RECORD.
05 IPT-INV-NUMBER PIC 9(04).
05 IPT-INV-QUANTITY PIC 9(03).
05 IPT-INV-DESCRIPTION PIC X(13).
05 IPT-INV-UNITPRICE PIC 9999V99.
05 IPT-INV-PROD-CLASS PIC 9(01).
*
FD PRT-FILE
RECORD CONTAINS 132 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS PRT-LINE.
01 PRT-LINE.
05 FILLER PIC X(04).
05 PRT-INV-NUMBER PIC 9(04).
05 FILLER PIC X(02).
05 PRT-EXTENDED-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(04).
05 PRT-DISCOUNT-AMOUNT PIC ZZZ,ZZ9.99.
05 FILLER PIC X(03).
05 PRT-NET-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(10).
05 PRT-PRODUCT-CLASS PIC 9.
05 FILLER PIC X(07).
05 PRT-TRANS-PERCENT PIC Z9.9.
05 FILLER PIC X(05).
05 PRT-TRANS-CHARGE PIC ZZZ,ZZ9.99.
*
WORKING-STORAGE SECTION.
*
01 EOF-SWITCH PIC X VALUE 'N'.
*
01 WS-EXTENDED-COST PIC 9(07)V99.
01 WS-DISCOUNT-AMOUNT PIC 9(06)V99.
01 WS-NET-COST PIC 9(07)V99.
01 WS-TRANS-PERCENT PIC ZZ9V9.
01 WS-TRANS-COST PIC 9(06)V99.
*
01 WS-TOTAL-EXTENDED-COST PIC 9(09)V99 VALUE ZERO.
01 WS-TOTAL-NET-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-TRANS-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-WITH-DISCOUNT PIC 99V9 VALUE ZERO.
01 WS-TOTAL-ITEMS PIC 99V9 VALUE ZERO.
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
01 WS-TOTAL-NO-DISCOUNT PIC 99V9 VALUE ZERO.
*
01 HEADING-NAME.
05 MY-NAME PIC X(20) VALUE
'XXXXX XXXXXXX, LAB 2'.
01 HEADING-COLUMN-1.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-1-INV-NUM PIC X(03) VALUE 'INV'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-EXT-PRC PIC X(08) VALUE 'EXTENDED'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-DISC-AMT PIC X(08) VALUE 'DISCOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-NET-PRC PIC X(09) VALUE 'NET PRICE'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-CLASS PIC X(05) VALUE 'CLASS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-P PIC X(05) VALUE 'TRANS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-C PIC X(14) VALUE 'TRANSPORTATION'.
01 HEADING-COLUMN-2.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-INV-NUM PIC X(03) VALUE 'NUM'.
05 FILLER PIC X(09) VALUE SPACES.
05 COLUMN-2-EXT-PRC PIC X(08) VALUE 'PRICE'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-DISC-AMT PIC X(08) VALUE 'AMOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-NET-PRC PIC X(09) VALUE SPACES.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-CLASS PIC X(05) VALUE SPACES.
05 FILLER PIC X(08) VALUE SPACES.
05 COLUMN-2-TRANS-P PIC X(05) VALUE '%'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-TRANS-C PIC X(14) VALUE 'CHARGE'.
01 BLANK-LINE.
05 BLANK-SPACE PIC X VALUE SPACES.
01 TOTAL-FOOTER.
05 FILLER PIC X(07) VALUE SPACES.
05 TOTAL-EXTENDED-COST PIC $$$$,$$$,$$9.99.
05 FILLER PIC X(15) VALUE SPACES.
05 TOTAL-NET-COST PIC $$$,$$$,$$9.99.
05 FILLER PIC X(23) VALUE SPACES.
05 TOTAL-TRANS-COST PIC $$$,$$$,$$9.99.
01 TOTAL-NO-DISCOUNT-FOOTER.
05 TOTAL-SENTENCE PIC X(31) VALUE
'TOTAL ITEMS WITHOUT DISCOUNT = '.
05 TOTAL-NO-DISCOUNT PIC Z9.
01 PERCENT-DISCOUNT-FOOTER.
05 PERCENT-SENTENCE PIC X(44) VALUE
'PERCENT OF ITEMS THAT RECEIVED A DISCOUNT = '.
05 PERCENT-DISCOUNT PIC Z9.9.
*
PROCEDURE DIVISION.
*
OPEN INPUT IPT-FILE.
OPEN OUTPUT PRT-FILE.
*
WRITE PRT-LINE FROM HEADING-NAME AFTER ADVANCING 0 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-1 AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-2 AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
*
PERFORM MAIN-LOOP UNTIL EOF-SWITCH EQUALS 'Y'.
*
DIVIDE WS-TOTAL-WITH-DISCOUNT BY WS-TOTAL-ITEMS
GIVING WS-PERCENT-WITH-DISCOUNT.
MULTIPLY WS-PERCENT-WITH-DISCOUNT BY 100
GIVING WS-PERCENT-WITH-DISCOUNT.
*
MOVE WS-TOTAL-EXTENDED-COST TO TOTAL-EXTENDED-COST.
MOVE WS-TOTAL-NET-COST TO TOTAL-NET-COST.
MOVE WS-TOTAL-TRANS-COST TO TOTAL-TRANS-COST.
MOVE WS-TOTAL-NO-DISCOUNT TO TOTAL-NO-DISCOUNT.
MOVE WS-PERCENT-WITH-DISCOUNT TO PERCENT-DISCOUNT.
*
WRITE PRT-LINE FROM TOTAL-FOOTER AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM TOTAL-NO-DISCOUNT-FOOTER AFTER
ADVANCING 3 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM PERCENT-DISCOUNT-FOOTER AFTER ADVANCING
1 LINES.
*
CLOSE IPT-FILE, PRT-FILE.
STOP RUN.
*
MAIN-LOOP.
MOVE SPACES TO PRT-LINE.
*
MULTIPLY IPT-INV-QUANTITY BY IPT-INV-UNITPRICE
GIVING WS-EXTENDED-COST ROUNDED.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
*
ADD 1 TO WS-TOTAL-ITEMS
*
IF WS-EXTENDED-COST IS GREATER THAN 200 THEN
MULTIPLY WS-EXTENDED-COST BY 0.11 GIVING
WS-DISCOUNT-AMOUNT ROUNDED
ADD 1 TO WS-TOTAL-WITH-DISCOUNT
*
ELSE
MOVE ZERO TO WS-DISCOUNT-AMOUNT
ADD 1 TO WS-TOTAL-NO-DISCOUNT
END-IF.
*
IF IPT-INV-PROD-CLASS IS EQUAL TO 1 THEN
MOVE 27.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.27 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-PROD-CLASS IS EQUAL TO 2 THEN
MOVE 17.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.17 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-QUANTITY IS GREATER THAN 100 THEN
MOVE 13.5 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.135 GIVING
WS-TRANS-COST ROUNDED
*
ELSE
MOVE ZERO TO WS-TRANS-PERCENT
MOVE 25.00 TO WS-TRANS-COST
END-IF.
*
SUBTRACT WS-EXTENDED-COST FROM WS-DISCOUNT-AMOUNT
GIVING WS-NET-COST.
ADD WS-EXTENDED-COST TO WS-TOTAL-EXTENDED-COST.
ADD WS-NET-COST TO WS-TOTAL-NET-COST.
ADD WS-TRANS-COST TO WS-TOTAL-TRANS-COST.
*
MOVE IPT-INV-NUMBER TO PRT-INV-NUMBER.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
MOVE WS-DISCOUNT-AMOUNT TO PRT-DISCOUNT-AMOUNT.
MOVE WS-NET-COST TO PRT-NET-PRICE.
MOVE IPT-INV-PROD-CLASS TO PRT-PRODUCT-CLASS.
MOVE WS-TRANS-PERCENT TO PRT-TRANS-PERCENT.
MOVE WS-TRANS-COST TO PRT-TRANS-CHARGE.
*
WRITE PRT-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
Here is the information that the .dat file holds.
2047105TYPEWRITER 0800002
1742010HANDLE 0010001
2149150USB DRIVE 1200003
3761005TAPE 5000004
2791010BOLTS 0000751
3000100STAPLER 0002007
3001101OVERHEAD PROJ0099997
3002099PENCILS 0000097
4001184CANADIAN RUGS0150294
4003050CARPET 0040000
4005001WASTE BASKETS0003793
5001010HINGES 0010001
5003010PENS (GOLD) 0049992
5004400PENS (BLACK) 0002004
8888999HIGH CHAIR 9999991
8889412PLAY PEN 0074992
0001001LOW TEST 0000019
9999999LAST RECORD 0000011
Your problem is here:
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
When you do your divide, you store the result in that field. If you expect it to be 0.556, what you are storing is 0.5, because you have only defined one decimal place, so the two low-order decimal places are simply truncated.
When you then multiply by 100, you make that 50.0.
If you define that field with three decimal places, your expected answer should appear (I've not checked your data).
However, a better way to do it is to define more integer digits, so that the field is large enough to hold your intermediate result and multiply by 100 first. Then you can divide (and you may want to consider ROUNDED on that, but it depends on the spec for the program).
There are a few questions here on problems with COMPUTE. Reading those questions and understanding the answers will help you get a good grasp on this. In COBOL, you define the accuracy you require, and you do that by supplying the correct number of integer and decimal digits.
You could also look through some of the other COBOL questions, where you'll find lots of advice on using FILE STATUS on your files, and checking the result of each IO. You can also use the file-status field you define to check for end-of-file, rather than using AT END/NOT AT END: you should find that it needs less code, and is more easy to understand.
Ditch as many full-stops/periods as you can. You need one at the end of the PROCEDURE DIVISION header, one at the end of a procedure-name, one at the end of a procedure, and one at the end of the program (if you have no procedure-names). All the others are superfluous. Commas in code tend to distract, you may find it clearer to use indentation and formatting of the statements.
Whilst it is well-constructed, your nested-IF would be better as an EVALUATE.
You have many constants in your program. It is better to define those as data-items, with a well-chosen name, so that the code "reads", and no-one has to wonder about the significance of 0.27. You also have examples where you have two constants which are obviously related, 27.0 and 0.27 for instance, which are better served by just being one thing. If someone "maintains" the program, they may only change one of the values without changing the other (not expecting there to be another).
Look also at the use of 88-level condition names. The "switch = y" can become "end-of-invoice-file" for instance, and that 88 can be on the file-status for that file, with a value of "10".
You should test your program with an empty input file, and see if you like the results.
As a beginner with COBOL, it is not a bad shot at all.