I get
Field is out of screen boundary error detected at offset
This is my code:
IDENTIFICATION DIVISION.
PROGRAM-ID. LALABS.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-PC.
OBJECT-COMPUTER. IBM-PC.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUTFILE ASSIGN TO 'NATS'.
DATA DIVISION.
FILE SECTION.
FD OUTFILE
LABEL RECORD IS OMITTED
DATA RECORD IS OUTREC.
01 OUTREC.
02 FILLER PIC X(80).
WORKING-STORAGE SECTION.
01 BC PIC 9 VALUE 0.
01 TCF PIC 99 VALUE 0.
01 RFC PIC 9(5) VALUE 0.
01 PTF PIC 9(5) VALUE 0.
01 ES PIC 9(5) VALUE 0.
01 RS PIC 9(5) VALUE 0.
01 EOFSW PIC 9 VALUE 0.
01 IR PIC 9(5) VALUE 0.
01 INPUTZ PIC X VALUE SPACES.
01 LALAGYANZZ.
02 LALAGYAN1 PIC 9(5) VALUE 0.
02 LALAGYAN2 PIC 9(5) VALUE 0.
02 LALAGYAN3 PIC 9(5) VALUE 0.
01 CTR-STUDENTS.
02 MAIN-S PIC 9(5) VALUE 0.
02 COMMON-S PIC 9(5) VALUE 0.
02 SJ-S PIC 9(5) VALUE 0.
02 TAG-S PIC 9(5) VALUE 0.
SCREEN SECTION.
01 SCRE.
02 BLANK SCREEN.
PROCEDURE DIVISION.
MAIN-RTN.
PERFORM INIT-RTN THRU INIT-RTN-END.
PERFORM PROCESS-RTN UNTIL INPUTZ = 'N' OR 'n'.
STOP RUN.
INIT-RTN.
GO TO INIT-RTN-END.
INIT-RTN-END.
PROCESS-RTN.
DISPLAY SCRE.
DISPLAY(5, 20) 'POLYTECHNIC UNIVERSITY OF THE PHILIPPINES'.
DISPLAY(6, 30) 'STA. MESA, MANILA'.
DISPLAY(9, 30) 'METRO BRANCH CAMPUS'.
DISPLAY(10, 30) 'POPULATION REPORT'.
DISPLAY(11, 30) 'FIRST SEMESTER'.
DISPLAY(12, 30) '2014-2015'.
PERFORM A.
A. DISPLAY(14, 15) 'LOCATION BRANCH CODE:(1/2/3/4)'.
ACCEPT(14, 55) BC.
IF BC > 4 OR BC < 1 PERFORM A.
DISPLAY(15, 15) 'LOCATION NAME:'.
IF BC = 1 PERFORM MEYN-RTN.
IF BC = 2 PERFORM COMMON-RTN.
IF BC = 3 PERFORM SJ-RTN.
IF BC = 4 PERFORM TAG-RTN.
DISPLAY(16, 15) 'TOTAL NO. OF COURSE OFFERED:'.
ACCEPT(16, 55) TCF.
DISPLAY(17, 15) 'TOTAL NO. OF REGULAR FACULTY:'.
ACCEPT(17, 55) RFC.
DISPLAY(18, 15) 'TOTAL NO. OF PART-TIME FACULTY:'.
ACCEPT(18, 55) PTF .
DISPLAY(19, 15) 'TOTAL NO. OF ENROLLED STUDENTS:'.
ACCEPT(19, 55) ES.
DISPLAY(20, 15) 'TOTAL NO, OF REGULAR STUDENTS:'.
ACCEPT(20, 55) RS.
PERFORM IR-RTN.
DISPLAY(21, 15) 'TOTAL NO: OF IRREGULAR STUDENTS:'.
DISPLAY(21, 55) IR .
PERFORM J.
J. DISPLAY(22, 15) 'INPUT ANOTHER RECORD(Y/N)?:'.
ACCEPT(22, 55) INPUTZ.
IF INPUTZ = 'Y' OR 'N' NEXT SENTENCE ELSE PERFORM J.
IF INPUTZ = 'Y' PERFORM PROCESS-RTN ELSE PERFORM TOTZ-RTN.
IR-RTN.
COMPUTE IR = ES - RS.
TOTZ-RTN.
DISPLAY(23, 15) 'LARGEST NO. :'.
DISPLAY(23, 30) LALAGYAN3.
DISPLAY(26, 15) 'BRANCH NAME:'.
MEYN-RTN.
DISPLAY(15, 50) 'STA. MESA, MAIN'.
ADD ES TO MAIN-S.
COMMON-RTN.
DISPLAY(15, 50) 'COMMONWEALTH'.
ADD ES TO COMMON-S.
SJ-RTN.
DISPLAY(15, 50) 'SAN JUAN'.
ADD ES TO SJ-S.
TAG-RTN.
DISPLAY(15, 50) 'TAGUIG'.
ADD ES TO TAG-S.
DISPLAY(23, 15) 'LARGEST NO. :'.
DISPLAY(23, 30) LALAGYAN3.
DISPLAY(26, 15) 'BRANCH NAME:'.
Unless you have a 26 line screen (or 27 if it's zero-based), that last display may be causing an issue. If you're limited to 25 lines, that's almost certainly the case and you should change the coordinates so that it's placed correctly within the screen bounds.
SCREEN SECTION.
01 SCRE.
02 BLANK SCREEN.
Your screen section are both group items - No picture clause, wen the compiler compiles this the length will either be 0 or indeterminate depending on the compiler. BTW - what platform / Cobol compiler are you using?
Related
Another COBOL question here again. I have been playing around with COBOL and the problem is, I have to input a decimal value in the input file. So the output in the input file should look something like this:
2019-00042Alexander Bell 1.501.752.25
...
The numbers are grades in a quiz. 1.00 to 5.00.
So I'm assuming in the print line, which is named as INF-PRINT-LINE in my code, I have to declare it as:
01 INF-PRINT-LINE.
02 SNO-IN PIC X(10).
02 SNAME-IN PIC X(25).
02 Q1-IN PIC 9.9(2).
02 Q2-IN PIC 9.9(2).
02 Q3-IN PIC 9.9(2).
Now on the WORKING-STORAGE SECTION I have declared three separate variables (STUD-QX-IN) so that I'll move it later on to the INF-PRINT-LINE variables (QX-IN) which can be seen here:
01 STUD-Q1-IN PIC 999.
01 STUD-Q2-IN PIC 999.
01 STUD-Q3-IN PIC 999.
Now, when this program is executed, I'd get a chance to see what's the value of STUD-QX-IN and QX-IN because of the DISPLAY line that will be shown on Column 45 so the program should look now something like this in the command line:
ENTER STUDENT NUMBER: 2019-00042
ENTER STUDENT NAME: Alexander Bell
ENTER QUIZ 1: 150 150 0.00
ENTER QUIZ 2: 175 175 5.00
ENTER QUIZ 3: 225 225 5.00
ENTER ANOTHER STUDENT(Y/N)
Now as you can see, what has passed down into the QX-IN variable is just the last digit of STUD-QX-IN, and the input file now would like something like this instead of what I was thinking about:
2019-00042Alexander Bell 0.005.005.00
...
What should I declare on the STUD-QX-IN so that I can pass down the correct value to QX-IN? I did try PIC 9V99 on STUD-QX-IN but it also doesn't work. Is the QX-IN PIC clause value were wrong after all?
Here's the full code:
* -----------------------------
IDENTIFICATION DIVISION.
PROGRAM-ID. exercise.
* -----------------------------
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
* INPUT
* OUTPUT
SELECT INF-STUD-GRADES ASSIGN TO "STUDENTGRADES.DAT".
DATA DIVISION.
FILE SECTION.
FD INF-STUD-GRADES.
01 INF-PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
*> INPUT THE ANSWER IN THIS SECTION
01 INF-PRINT-LINE.
02 SNO-IN PIC X(10).
02 SNAME-IN PIC X(25).
02 Q1-IN PIC 9.9(2).
02 Q2-IN PIC 9.9(2).
02 Q3-IN PIC 9.9(2).
01 ANS PIC X VALUE 'Y'.
01 L PIC 9.
01 STUD-NO-IN PIC X(10).
01 STUD-NAME-IN PIC X(25).
01 STUD-Q1-IN PIC 999.
01 STUD-Q2-IN PIC 999.
01 STUD-Q3-IN PIC 999.
SCREEN SECTION.
01 BSCRN.
02 BLANK SCREEN.
PROCEDURE DIVISION.
OPEN OUTPUT INF-STUD-GRADES.
PERFORM INPUT-GRADES-RTN UNTIL ANS = 'N' OR ANS = 'n'.
PERFORM CLOSE-INPUT-GRADES-RTN.
PERFORM FINAL-CLOSE-RTN.
INPUT-GRADES-RTN.
DISPLAY BSCRN.
MOVE 4 TO L.
DISPLAY "ENTER STUDENT NUMBER: " LINE L COLUMN 5.
ACCEPT STUD-NO-IN LINE L COLUMN 35.
MOVE STUD-NO-IN TO SNO-IN.
ADD 1 TO L.
DISPLAY "ENTER STUDENT NAME: " LINE L COLUMN 5.
ACCEPT STUD-NAME-IN LINE L COLUMN 35.
MOVE STUD-NAME-IN TO SNAME-IN.
ADD 1 TO L.
DISPLAY "ENTER QUIZ 1: " LINE L COLUMN 5.
ACCEPT STUD-Q1-IN LINE L COLUMN 35.
DISPLAY STUD-Q1-IN LINE L COLUMN 45.
MOVE STUD-Q1-IN TO Q1-IN.
DISPLAY Q1-IN LINE L COLUMN 55.
ADD 1 TO L.
DISPLAY "ENTER QUIZ 2: " LINE L COLUMN 5.
ACCEPT STUD-Q2-IN LINE L COLUMN 35.
DISPLAY STUD-Q2-IN LINE L COLUMN 45.
MOVE STUD-Q2-IN TO Q2-IN.
DISPLAY Q2-IN LINE L COLUMN 55.
ADD 1 TO L.
DISPLAY "ENTER QUIZ 3: " LINE L COLUMN 5.
ACCEPT STUD-Q3-IN LINE L COLUMN 35.
DISPLAY STUD-Q3-IN LINE L COLUMN 45.
MOVE STUD-Q3-IN TO Q3-IN.
DISPLAY Q3-IN LINE L COLUMN 55.
ADD 2 TO L.
WRITE INF-PRINT-REC FROM INF-PRINT-LINE BEFORE 1 LINE.
DISPLAY "ENTER ANOTHER STUDENT(Y/N)" LINE L COLUMN 30.
ACCEPT ANS.
CLOSE-INPUT-GRADES-RTN.
CLOSE INF-STUD-GRADES.
FINAL-CLOSE-RTN.
STOP RUN.
You need to move fields defined as 9v99 to the output fields. The v means assumed decimal place.
What you can do is
01 work fields
03 STUD-Q1-IN PIC 999.
03 STUD-Q1-IN-V redefines STUD-Q1-IN PIC 9v99.
03 STUD-Q2-IN PIC 999.
03 STUD-Q2-IN-V redefines STUD-Q2-IN PIC 9v99.
03 STUD-Q3-IN PIC 999.
03 STUD-Q3-IN-V redefines STUD-Q3-IN PIC 9v99.
You would then do
MOVE STUD-Q1-IN-V TO Q1-IN.
You could also do
compute Q1-IN = STUD-Q1-IN / 100
end-compute
Redefines keyword
The Redefines keyword lets you give a different definition to a field
So if you do
Move 123 to STUD-Q1-IN.
Then
STUD-Q1-IN = 123
STUD-Q1-IN-V = 1.23
I was working on a brute-force implementation of this RosettaCode challenge. I wanted to be able to handle numbers bigger than USAGE BINARY-DOUBLE so I wrote a dead simple bignum routine for adding.
If I want to limit myself to a certain number of iterations and that number is greater than 9(18) then that's tricky. So I hit upon the idea of an 88 on a particular element of the array, thus the code below.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
03 FILLER REDEFINES DIGITS1.
05 FILLER pic 9999999999.
05 FILLER pic 999999999.
05 filler pic 9.
88 EOR value 1.
05 filler pic 9999999999.
05 filler pic 9999999999.
So I'm still wondering if this is the only way to go or is there some other way of handling when I get to 10^20.
This is the full "solution". It's a mess but it almost working.
identification division.
program-id. Program1.
data division.
working-storage section.
01 COUNTER.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
03 FILLER REDEFINES DIGITS1.
05 filler pic 9999999999.
05 FILLER pic 9999999999.
05 filler pic 9999999999.
05 filler pic 999.
05 filler pic 9.
88 EOR value 1.
05 filler pic 999999.
01 INCREMENTOR.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 ACCUMULATOR.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 IN-NUMBER usage binary-double unsigned.
01 I USAGE BINARY-DOUBLE UNSIGNED.
01 N USAGE BINARY-DOUBLE UNSIGNED.
01 THREE-COUNTER USAGE BINARY-CHAR value 1.
88 IS-THREE VALUE 3.
01 FIVE-COUNTER USAGE BINARY-CHAR value 1.
88 IS-FIVE VALUE 5.
01 ANSWER pic x(40).
procedure division.
initialize COUNTER ACCUMULATOR incrementor.
10-MAIN-PROCEDURE.
move 1 to IN-NUMBER.
call "MOVENUMTOBIGNUM" using by content in-number
by reference incrementor.
move 1 to IN-NUMBER.
call "MOVENUMTOBIGNUM" using by content in-number
by reference counter.
PERFORM 20-INNER-LOOP WITH TEST AFTER UNTIL eor.
move ACCUMULATOR to ANSWER.
inspect answer REPLACING LEADING '0'
by space.
DISPLAY answer.
STOP RUN.
20-INNER-LOOP.
IF IS-THREE OR IS-FIVE
call "ADDBIGNUMS" using by content counter
by reference accumulator
IF IS-THREE
MOVE 1 TO THREE-COUNTER
ELSE
ADD 1 TO THREE-COUNTER
END-IF
IF IS-FIVE
MOVE 1 TO FIVE-COUNTER
ELSE
ADD 1 TO FIVE-COUNTER
END-IF
ELSE
ADD 1 TO FIVE-COUNTER END-ADD
ADD 1 TO THREE-COUNTER END-ADD
END-IF.
call "ADDBIGNUMS" using by content INCREMENTOR
by reference counter.
EXIT.
end program Program1.
identification division.
PROGRAM-ID. MOVENUMTOBIGNUM.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 num-MOD usage binary-CHAR.
01 num-DIV usage binary-DOUBLE unsigned.
01 IN-COUNTER usage binary-char.
LINKAGE SECTION.
01 num usage binary-double.
01 BIGNUM.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
PROCEDURE DIVISION USING NUM BIGNUM.
10-MOVE.
move 40 to IN-COUNTER.
perform until num = 0
divide num by 10
giving num-DIV
REMAINDER num-MOD
end-divide
move num-MOD to DIGITS1 of BIGNUM(IN-COUNTER)
move NUM-DIV to NUM
subtract 1 from IN-COUNTER end-subtract
END-PERFORM.
GOBACK.
END PROGRAM MOVENUMTOBIGNUM.
*Add Bignum to Bignum, modifying second Bignum in situ
identification division.
program-id. ADDBIGNUMS.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 IN-COUNTER usage binary-char.
01 ADD-FLAG pic 9.
88 STILL-ADDING VALUE 0.
88 DONE-ADDING VALUE 9.
01 CARRIER usage binary-char.
01 REGISTER-A usage binary-char.
LINKAGE SECTION.
01 BIGNUM1.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 BIGNUM2.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
PROCEDURE DIVISION USING BIGNUM1 BIGNUM2.
10-ADD-WITH-CARRY.
move zero to CARRIER.
move 40 to IN-COUNTER.
move zero to ADD-FLAG.
perform until DONE-ADDING
add DIGITS1 of BIGNUM1(IN-COUNTER)
DIGITS1 of BIGNUM2(IN-COUNTER)
CARRIER GIVING REGISTER-A
END-ADD
move zero to CARRIER
if REGISTER-A > 9
divide REGISTER-A by 10
giving CARRIER
remainder REGISTER-A
end-divide
else
if REGISTER-A = zero
move 9 to ADD-FLAG
END-IF
end-if
if STILL-ADDING
move REGISTER-A to DIGITS1 of BIGNUM2(IN-COUNTER)
subtract 1 from IN-COUNTER end-subtract
end-if
END-PERFORM.
goback.
END PROGRAM ADDBIGNUMS.
Although you already don't seem to like the structure, I'll stick to it. It will work with your structure as well. No need for the REDEFINES or those other FILLERs.
05 FILLER.
10 FILLER OCCURS 40 TIMES.
15 DIGITS1 PIC 9.
88 DIGITS1-MEANS-SOMETHING
VALUE 1.
01 NAME-THAT-REVEALS-INFORMATION BINARY PIC 9(4).
IF DIGITS1-MEANS-SOMETHING
( NAME-THAT-REVEALS-INFORMATION )
do some stuff
END-IF
I've changed you PIC 9 to PIC X. Unless you are doing calculations, there is never a need to define a field as 9 for "numeric". If a field happens to contain numbers, or happens to have the word number, or something like that in its name, don't be tricked into defining it as a number.
Extra (generated) code ensues and it carries the meaning "numeric stuff will be done with this", so misleads. If/when you need to do a "numeric edit" for output, there's always the REDEFINES at that point. Doesn't have to have these other costs to make that happen.
I've now reverted to your PIC 9, as, after your edit, I can see you are using it for calculations :-)
here is the code i am running (it is not mine, it is from my professor but I can't seem to make it work. Help please.
IDENTIFICATION DIVISION.
PROGRAM-ID. ACPTDSP1.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GRDFILE ASSIGN TO DISK.
DATA DIVISION.
FILE SECTION.
FD GRDFILE
DATA RECORD IS GRDREC
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS "C:\COBOL\GRDFILE.TXT".
01 GRDREC.
05 FILLER PIC X(80).
WORKING-STORAGE SECTION.
* INPUT DATA USING *
* ACCEPT & DISPLAY *
01 NAME PIC X(25).
01 MIDGRD PIC 9V99.
01 FINGRD PIC 9V99.
01 AVE PIC 9V99.
01 ANS PIC X.
* OUTPUT FILE *
01 HDG.
05 FILLER PIC X(32) VALUE SPACES.
05 FILLER PIC X(25) VALUE "STUDENT'S GRADE".
05 FILLER PIC X(33) VALUE SPACES.
01 COLHDG.
05 FILLER PIC X(14) VALUE SPACES.
05 FILLER PIC X(12) VALUE "STUDENT NAME".
05 FILLER PIC X(28) VALUE SPACES.
05 FILLER PIC X(12) VALUE "FINAL GRADE ".
01 GRDDATA.
05 FILLER PIC X(14) VALUE SPACES.
05 NAME-OUT PIC X(25).
05 FILLER PIC X(20) VALUE SPACES.
05 AVE-OUT PIC 9.99.
SCREEN SECTION.
01 CLRSCR.
05 BLANK SCREEN.
PROCEDURE DIVISION.
MAIN-RTN.
DISPLAY CLRSCR.
OPEN OUTPUT GRDFILE.
WRITE GRDREC FROM HDG.
WRITE GRDREC FROM COLHDG.
PERFORM PROCESS-RTN THRU PROCESS-END
UNTIL ANS = 'N' OR ANS = 'n'.
CLOSE GRDFILE.
STOP RUN.
PROCESS-RTN.
DISPLAY (5, 15) "Enter Name: ".
ACCEPT (5, 30) NAME.
DISPLAY (7, 15) "Enter Midterm Grade: ".
ACCEPT (7, 40) MIDGRD.
DISPLAY (9, 15) "Enter Final Grade: ".
ACCEPT (9, 40) FINGRD.
COMPUTE AVE = (MIDGRD + FINGRD) / 2.
MOVE NAME TO NAME-OUT.
MOVE AVE TO AVE-OUT.
DISPLAY (11, 15) "Average Grade is: ", AVE-OUT.
WRITE GRDREC FROM GRDDATA .
DISPLAY (15, 15) "ENTER ANOTHER [Y/N]? ".
ACCEPT ANS.
PROCESS-END.
The problem I have is that when i open the grdfile, it shows random characters like cross and chinese characters.
if you have any idea, please do help. I want to learn. TIA
Seems to work perfectly well for me.
You should note that the size of HDG is 32+25+33=90, of COLHDG is 14+12+28+12=66 and GRDDATA is 14+25+20+4=63.
It may be that the compiler you are using is outputting random data on those short records as the output records are of length 80. I'd pad the short records out to 80 with filler pic x(14) value spaces and pic x(17) for the second and see whether that cures the problem.
Remember, the output will appear to be one giant string as far as a text editor is concerned...
This is a homework assignment that involves reading in an input file, doing some processing, and printing the processed data to an output file in a neat and readable format.
The first record prints to the output file perfectly. Every record after that, it seems like when the record was read-in from the input file, it was read in with an added space; shifting the position of all of my input data and making it useless. Every line it seems like another space is being added.
I suspect that
A.) Despite my best efforts I do not fully understand the READ verb
and/or B.) There may be a problem with my compiler.
Any help is appreciated.
IDENTIFICATION DIVISION.
PROGRAM-ID.
payroll.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT payroll-in-file ASSIGN TO 'input.txt'.
SELECT payroll-out-file ASSIGN TO 'output.txt'.
DATA DIVISION.
FILE SECTION.
FD payroll-in-file
LABEL RECORDS ARE STANDARD.
01 payroll-in-record.
05 i-unused-01 PIC X.
05 i-emp-num PIC X(5).
05 i-dpt-num PIC X(5).
05 1-unused-02 PIC X(6).
05 i-hrs-wkd PIC 9(4).
05 i-base-pay-rt PIC 9(2)v99.
05 i-mncpl-code PIC X(2).
FD payroll-out-file
LABEL RECORDS ARE STANDARD.
01 payroll-out-record.
05 o-emp-num PIC X(5).
05 FILLER PIC XX.
05 o-hrs-wkd PIC 9(5).
05 FILLER PIC XX.
05 o-base-pay-rt PIC 9(3).99.
05 FILLER PIC XX.
05 o-grs-pay PIC 9(5).99.
05 FILLER PIC XX.
05 o-fed-tax PIC 9(5).99.
05 FILLER PIC XX.
05 o-state-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-city-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-net-pay PIC 9(5).99.
WORKING-STORAGE SECTION.
01 w-out-of-data-flag PIC X.
01 w-grs-pay PIC 99999V99.
01 w-fed-tax PIC 99999V99.
01 w-state-tax PIC 9999V99.
01 w-city-tax PIC 9999V99.
PROCEDURE DIVISION.
A000-main-line-routine.
OPEN INPUT payroll-in-file
OUTPUT payroll-out-file.
MOVE 'N' TO w-out-of-data-flag.
READ payroll-in-file
AT END MOVE 'Y' TO w-out-of-data-flag.
PERFORM B010-process-payroll
UNTIL w-out-of-data-flag = 'Y'.
CLOSE payroll-in-file
payroll-out-file.
STOP RUN.
B010-process-payroll.
MOVE SPACES TO payroll-out-record.
IF i-hrs-wkd IS NOT GREATER THAN 37.5
MULTIPLY i-hrs-wkd BY i-base-pay-rt GIVING w-grs-pay ROUNDED
ELSE
COMPUTE w-grs-pay ROUNDED =
(i-base-pay-rt * 37.5) + (1.5 * (i-base-pay-rt) * (i-hrs-wkd - 37.5))
END-IF.
MULTIPLY w-grs-pay BY 0.25
GIVING w-fed-tax ROUNDED.
MULTIPLY w-grs-pay BY 0.05
GIVING w-state-tax ROUNDED.
IF i-mncpl-code = 03
MULTIPLY w-grs-pay BY 0.015 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 07
MULTIPLY w-grs-pay BY 0.02 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 15
MULTIPLY w-grs-pay BY 0.0525 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 23
MULTIPLY w-grs-pay BY 0.0375 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 77
MULTIPLY w-grs-pay BY 0.025 GIVING w-city-tax ROUNDED
END-IF.
input file:
AA34511ASD 0037115003
AA45611WER 0055120007
BB98722TYU 0025075015
BB15933HUJ 0080200023
FF35799CGB 0040145077
(each line begins with 1 space, which corresponds to "i-unused-01" in the code)
output file (so far):
AA345 00037 011.50 00425.50 00106.38 0021.28 0006.38 00291.46 AA45 0 005 051.20 00425.50 00106.38 0021.28 0006.38 00291.46
BB9 0 00 025.07 00425.50 00106.38 0021.28 0006.38 00291.465
BB 0 0 008.02 00425.50 00106.38 0021.28 0006.38 00291.4623
F 0 000.40 10673.10 02668.28 0533.66 0006.38 07464.78
^it prints just like that!
Using OpenCOBOL compiler in Linux.
I didn't look at the code in detail, but two things are worth looking at.
Firstly, the output file should probably be "line sequential", as this will insert a delimiter (carraige return/newline), which means that the output file will print as one record per line.
Also, there may be a difference of one character, between the number of characters in your input record, i.e. your actual data, and the the number of characters defined in your input FD.
As colemanj said, you need to change the output file to line sequential
But you also need to change the input file / input file definition.
The 2 options are
1) change the Input file to line sequential (bring the definition into line with the file
2) Remove carraige returns from the input file to (all on one line):
AA34511ASD 0037115003 AA45611WER 0055120007 BB98722TYU 0025075015 BB15933HUJ 0080200023 FF35799CGB 0040145077
The current input file definition indicates there is no carriage returns in the file.
--------------------------------------------------
This might be due to the Mingw Open COBOL version you use. As it is documented here
ORGANIZATION IS LINE SEQUENTIAL
These are files with the simplest of all internal structures. Their contents are structured simply as a series of data records, each terminated by a special end-of-record delimiter character. An ASCII line-feed character (hexadecimal 0A) is the end-of-record delimiter character used by any UNIX or pseudo-UNIX (MinGW, Cygwin, MacOS) OpenCOBOL build. A truly native Windows build would use a carriage-return, line-feed (hexadecimal 0D0A) sequence.
Hi i need some help on this i cannot save if the user will input only 2 items and not more than 5 items.i can only save 5 items but when i input only 3 items i could not save i get run time error.maybe i have problem in looping.Thank you in advance
I am using mscobol 2.20
here is my code i put it back the file status
IDENTIFICATION DIVISION.
PROGRAM-ID. SOENTRY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SYSTEM-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS SYS-FY
FILE STATUS IS SYSTEM-STATUS.
SELECT CUSTOMER-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS CUSNO
FILE STATUS IS CUSTOMER-STATUS.
SELECT ITEM-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS ITMNO
FILE STATUS IS ITEM-STATUS.
SELECT SO-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS SONO
FILE STATUS IS SO-STATUS.
SELECT SOD-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS SODKEY
FILE STATUS IS SOD-STATUS.
DATA DIVISION.
FILE SECTION.
FD SYSTEM-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "SYSTEM.DAT".
01 SYSTEM-RECORD.
03 SYS-FY PIC 9(4).
03 SYS-CONAME PIC X(50).
03 SYS-COADDR PIC X(50).
03 SYS-USER PIC 9(10).
03 SYS-PWORD PIC 9(10).
03 SYS-LASTCUSNO PIC 9(5).
03 SYS-LASTITMNO PIC 9(5).
03 SYS-LASTSONO PIC 9(7).
03 SYS-LASTSINO PIC 9(7).
03 SYS-LASTORNO PIC 9(7).
03 SYS-RECSTAT PIC A.
FD CUSTOMER-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "CUSTOMER.DAT".
01 CUSTOMER-RECORD.
03 CUSNO PIC 9(5).
03 CUSNAME PIC X(40).
03 CUSADDR PIC X(40).
03 CUSCONTACTPERSON PIC X(40).
03 CUSCONTACTNO PIC 9(18).
03 CUSCREDITLIMIT PIC 9(7)V99.
03 CUSBALANCE PIC S9(7)V99.
03 CUSLASTSONO PIC 9(7).
03 CUSLASTSINO PIC 9(7).
03 CUSLASTORNO PIC 9(7).
03 CUSRECSTAT PIC A.
FD ITEM-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "ITEM.DAT".
01 ITEM-RECORD.
03 ITMNO PIC 9(5).
03 ITMDESC PIC X(40).
03 ITMUM PIC X(3).
03 ITMPRICE PIC S9(6)V99.
03 ITMQTYONHAND PIC 9(4).
03 ITMQTYONORDER PIC 9(4).
03 ITMLASTONO PIC 9(7).
03 ITMLASTSINO PIC 9(7).
03 ITMRECSTAT PIC X.
FD SO-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "SO.DAT".
01 SO-RECORD.
03 SONO PIC 9(7).
03 SODATE PIC 9(8).
03 SOCUSNO PIC 9(5).
03 SOPAYMODE PIC XX.
03 SOTOTAL PIC 9(7)V99.
03 SOPREPBY PIC X(30).
03 SOAPPRBY PIC X(30).
03 SORECSTAT PIC X.
FD SOD-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "SOD.DAT".
01 SOD-RECORD.
03 SODKEY.
05 SODSONO PIC 9(7).
05 SODITMNO PIC 9(5).
03 SODQTYORD PIC 9(4).
03 SODQTYINV PIC 9(4).
03 SODUPRICE PIC 9(6)V99.
03 SODAMOUNT PIC 9(6)V99.
03 SODRECSTAT PIC X.
WORKING-STORAGE SECTION.
01 ESC-CODE PIC 99 VALUE 0.
88 ESC-KEY VALUE 1.
88 F2 VALUE 3.
88 F10 VALUE 11.
01 ERRMSG PIC X(75) VALUE SPACES.
01 ERR PIC 9 VALUE 0.
01 TEMP-VAR VALUE ZEROES.
03 VAR-ITMNO PIC 9(5) OCCURS 5 TIMES.
03 VAR-ITMPRICE PIC 9(6) OCCURS 5 TIMES.
03 VAR-ITMQTYONORDER PIC 9(4) OCCURS 5 TIMES.
03 VAR-SODITMQTYORDER PIC 9(4) OCCURS 5 TIMES.
03 VAR-AMOUNT PIC 9(6) OCCURS 5 TIMES.
01 TEMP-STR VALUE SPACES.
03 VAR-ITMDESC PIC X(40) OCCURS 5 TIMES.
03 VAR-ITMUM PIC X(3) OCCURS 5 TIMES.
01 QTYORD PIC 9(4).
01 ROW PIC 9.
01 R PIC 9.
01 EDIT-PRICE.
03 E-PRICE PIC ZZZ,ZZ9.99.
01 MY-DATE.
03 MY-YEAR PIC 9(4).
03 MY-MONTH PIC 9(2).
03 MY-DAY PIC 9(2).
01 AMOUNT PIC 9(6)V99.
01 TOTAL-AMOUNT PIC 9(7)V99.
01 CUSTOMER.
03 VAR-CRDLIMIT PIC Z,ZZZ,ZZ9.99.
03 VAR-BALANCE PIC Z,ZZZ,ZZ9.99.
01 EDIT-AMOUNT.
03 E-AMOUNT PIC ZZZ,ZZ9.99.
03 E-TOTAL PIC Z,ZZZ,ZZ9.99.
01 MOD PIC XX.
01 FLAG PIC 9.
01 LBL.
03 LBLSONO PIC 9(7).
01 APP-PREV.
03 PREPBY PIC X(30).
03 APPBY PIC X(30).
01 VAR-ITEM.
03 VAR-QTYONHAND PIC 9(4).
03 TOTAL-QTYONORDER PIC 9(4).
01 CHECK-STATUS.
03 SYSTEM-STATUS PIC XX.
03 CUSTOMER-STATUS PIC XX.
03 ITEM-STATUS PIC XX.
03 SO-STATUS PIC XX.
03 SOD-STATUS PIC XX.
SCREEN SECTION.
01 HEADER.
03 BLANK SCREEN BACKGROUND-COLOR 0.
01 ENTRY-FORM.
03 LINE 1 COLUMN 31 PIC X(50)
FROM SYS-CONAME HIGHLIGHT.
03 LINE 3 COLUMN 55 VALUE "SO NO :".
03 LINE 4 COLUMN 55 VALUE "SO DATE:".
03 LINE 4 COLUMN 68 VALUE "/".
03 LINE 4 COLUMN 73 VALUE "/".
03 LINE 4 COLUMN 2 VALUE "CUSTOMER N0:".
03 LINE 4 COLUMN 15 PIC 9(5) USING CUSNO.
03 LINE 6 COLUMN 2 VALUE "NAME :".
03 LINE 7 COLUMN 2 VALUE "ADDRESS :".
03 LINE 17 COLUMN 53 VALUE "TOTAL ======> ".
03 LINE 17 COLUMN 66 PIC Z,ZZZ,ZZ9.99
FROM TOTAL-AMOUNT.
03 LINE 19 COLUMN 2 "PREPARED BY: ".
03 LINE 19 COLUMN 14 PIC X(30) USING SOPREPBY.
03 LINE 20 COLUMN 2 "APPROVED BY: ".
03 LINE 20 COLUMN 14 PIC X(30) USING SOAPPRBY.
03 LINE 19 COLUMN 48 VALUE "CRDTLIMIT : ".
03 LINE 19 COLUMN 64 PIC Z,ZZZ,ZZ9.99
FROM VAR-CRDLIMIT.
03 LINE 20 COLUMN 48 VALUE "BALANCE : ".
03 LINE 20 COLUMN 64 PIC Z,ZZZ,ZZ9.99
FROM VAR-BALANCE.
03 LINE 21 COLUMN 48 VALUE "ITMQTYHAND : ".
03 LINE 21 COLUMN 64 PIC 9(4)
FROM ITMQTYONHAND.
03 LINE 6 COLUMN 55 VALUE "PAYMENT MODE:".
01 CLEAR-CUSNO.
03 LINE 4 COLUMN 15 VALUE "00000".
01 CUST-PRO.
03 LINE 6 COLUMN 15 PIC X(40)
FROM CUSNAME BACKGROUND-COLOR 0.
03 LINE 7 COLUMN 15 PIC X(40)
FROM CUSADDR BACKGROUND-COLOR 0.
01 ITEM-HEADER.
03 LINE 9 COLUMN 2 "ITEM NO" BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 10 " " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 12 " DESCRPTION " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 30 " " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 41 " UOM " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 47 " QTY " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 53 " UNIT PRICE " BACKGROUND-COLOR 9.
03 LINE 9 COLUMN 67 " AMOUNT " BACKGROUND-COLOR 9.
01 FUNCTION-KEYS.
03 LINE 24 COLUMN 5 "Esc" HIGHLIGHT.
03 "=Exit ".
03 "F2" HIGHLIGHT.
03 "=Save ".
03 "F10" HIGHLIGHT.
03 "=Cancel".
01 ERROR-MESSAGE.
03 LINE 25 COLUMN 5 PIC X(70) FROM ERRMSG HIGHLIGHT.
01 CLEAR-SCREEN.
03 BLANK SCREEN BACKGROUND-COLOR 0.
PROCEDURE DIVISION.
MAIN.
OPEN I-O SYSTEM-FILE CUSTOMER-FILE ITEM-FILE
SO-FILE SOD-FILE.
IF SOD-STATUS not = '00'
DISPLAY "error" SOD-STATUS
STOP RUN.
IF SOD-STATUS = '05'
DISPLAY "error" SOD-STATUS
STOP RUN.
IF SO-STATUS = '00'
DISPLAY "error" SO-STATUS
STOP RUN.
IF SO-STATUS = '05'
DISPLAY "error" SO-STATUS
STOP RUN.
MOVE 2012 TO SYS-FY.
READ SYSTEM-FILE INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
DISPLAY "SYSTEM RECORD NOT FOUND."
ELSE
PERFORM INITIALIZE-ITEMREC
DISPLAY HEADER
PERFORM ENTRY1 UNTIL ESC-KEY
DISPLAY CLEAR-SCREEN.
CLOSE SYSTEM-FILE CUSTOMER-FILE ITEM-FILE
SO-FILE SOD-FILE.
STOP RUN.
ENTRY1.
COMPUTE SONO = SYS-LASTSONO + 1.
MOVE SONO TO LBLSONO.
DISPLAY ENTRY-FORM ITEM-HEADER FUNCTION-KEYS ERROR-MESSAGE.
DISPLAY (3 , 65) LBLSONO.
MOVE 2012 TO MY-YEAR.
DISPLAY ( 4 , 74) MY-YEAR.
MOVE 1 TO FLAG.
PERFORM ENTER-MONTH UNTIL FLAG = 0 OR ESC-KEY
OR F2 OR F10.
MOVE 1 TO FLAG.
PERFORM ENTER-DAY UNTIL FLAG = 0 OR ESC-KEY
OR F2 OR F10.
MOVE 1 TO ERR.
PERFORM ENTER-CUSNO UNTIL ERR = 0 OR ESC-KEY
OR F2 OR F10.
DISPLAY CUST-PRO.
MOVE CUSCREDITLIMIT TO VAR-CRDLIMIT.
MOVE CUSBALANCE TO VAR-BALANCE.
DISPLAY(19 , 66) VAR-CRDLIMIT.
DISPLAY(20 , 66) VAR-BALANCE.
MOVE 1 TO ERR.
PERFORM ENTER-PREP UNTIL ERR = 0 OR ESC-KEY.
MOVE 1 TO ERR.
PERFORM ENTER-APP UNTIL ERR = 0 OR ESC-KEY.
MOVE 1 TO FLAG.
PERFORM CHCK-MOD UNTIL FLAG = 0 OR ESC-KEY.
PERFORM ITM-INPUT.
IF F2 PERFORM SAVE-ENTRIES
ELSE IF F10 PERFORM CANCEL-ENTRIES.
ENTER-MONTH.
ACCEPT(4 , 65)MY-MONTH.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F2
PERFORM SAVE-ENTRIES
ELSE IF F10
PERFORM CANCEL-ENTRIES
ELSE IF MY-MONTH 12
MOVE "INVALID MONTH" TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO FLAG.
ENTER-DAY.
ACCEPT(4 , 70)MY-DAY.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F2
PERFORM SAVE-ENTRIES
ELSE IF F10
PERFORM CANCEL-ENTRIES
ELSE IF MY-DAY 31
MOVE "INVALID DAY" TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO FLAG.
ENTER-CUSNO.
ACCEPT (4 , 15) CUSNO.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F2
PERFORM SAVE-ENTRIES
ELSE IF F10
PERFORM CANCEL-ENTRIES
ELSE IF CUSNO = ZEROES
MOVE 1 TO ERR
ELSE
MOVE SPACES TO ERRMSG
PERFORM VALIDATE-CUSNO.
VALIDATE-CUSNO.
MOVE 0 TO ERR.
READ CUSTOMER-FILE INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
MOVE "CUSTOMER NO. NOT FOUND" TO ERRMSG
MOVE 1 TO ERR
DISPLAY CLEAR-CUSNO
DISPLAY ERROR-MESSAGE
PERFORM CLEAN
ELSE
DISPLAY ERROR-MESSAGE.
CHCK-MOD.
ACCEPT (6 , 69) MOD.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF ESC-KEY
DISPLAY CLEAR-SCREEN
STOP RUN
IF F2 PERFORM SAVE-ENTRIES
ELSE IF F10 PERFORM CANCEL-ENTRIES.
IF MOD = "CA" OR "CR"
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO FLAG
ELSE
MOVE "INVALID INPUT." TO ERRMSG
DISPLAY ERROR-MESSAGE.
ENTER-PREP.
ACCEPT (19 , 14 ) SOPREPBY.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF ESC-KEY
DISPLAY CLEAR-SCREEN
STOP RUN
ELSE IF SOPREPBY = SPACES
MOVE 1 TO ERRMSG
MOVE "PLEASE FILL-IN" TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO ERR.
ENTER-APP.
ACCEPT (20 , 14 ) SOAPPRBY.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF ESC-KEY
DISPLAY CLEAR-SCREEN
STOP RUN
ELSE IF SOAPPRBY = SPACES
MOVE 1 TO ERR
MOVE "PLEASE FILL-IN" TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO ERR.
ITM-INPUT.
MOVE 10 TO LIN.
MOVE 0 TO TOTAL-AMOUNT.
MOVE 1 TO ROW.
PERFORM ITM-INPUT1 VARYING R FROM 1 BY 1 UNTIL R > 5.
ITM-INPUT1.
MOVE 1 TO ERR.
PERFORM ITM-INPUT2 UNTIL ERR = 0 OR F2 OR F10.
ITM-INPUT2.
ACCEPT (LIN, 4) ITMNO.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF ESC-KEY
DISPLAY CLEAR-SCREEN
STOP RUN
ELSE IF F2
PERFORM SAVE-ENTRIES
ELSE IF F10
PERFORM CANCEL-ENTRIES
ELSE
MOVE SPACES TO ERRMSG
PERFORM ITM-INPUT3.
ITM-INPUT3.
MOVE 0 TO ERR
READ ITEM-FILE INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
MOVE "ITMNO NO. NOT FOUND." TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
DISPLAY ERROR-MESSAGE
PERFORM ITM-INPUT4.
ITM-INPUT4.
DISPLAY (LIN , 10) ITMDESC
DISPLAY (LIN , 41) ITMUM
MOVE ITMPRICE TO E-PRICE
DISPLAY (LIN , 52) E-PRICE
DISPLAY (21 , 66 ) ITMQTYONHAND
PERFORM VALIDATE-ITMQTY.
VALIDATE-ITMQTY.
ACCEPT (LIN , 48)QTYORD.
MOVE QTYORD TO VAR-SODITMQTYORDER(R).
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF ESC-KEY
DISPLAY CLEAR-SCREEN
STOP RUN
ELSE IF VAR-SODITMQTYORDER (R) > ITMQTYONHAND
MOVE "INSUFFICIENT STOCK" TO ERRMSG
DISPLAY ERROR-MESSAGE
ELSE
COMPUTE AMOUNT = VAR-SODITMQTYORDER (R) * ITMPRICE
MOVE AMOUNT TO E-AMOUNT
DISPLAY (LIN , 66)E-AMOUNT
ADD 1 TO LIN
MOVE ITMNO TO VAR-ITMNO(R)
* MOVE ITMQTYONORDER TO VAR-ITMQTYONORDER(R).
MOVE ITMDESC TO VAR-ITMDESC(R)
MOVE ITMUM TO VAR-ITMUM(ROW)
COMPUTE TOTAL-QTYONORDER = ITMQTYONORDER +
VAR-SODITMQTYORDER (ROW)
MOVE ITMPRICE TO VAR-ITMPRICE(R)
MOVE AMOUNT TO VAR-AMOUNT(R)
COMPUTE TOTAL-AMOUNT = TOTAL-AMOUNT + AMOUNT
MOVE TOTAL-AMOUNT TO E-TOTAL
DISPLAY (17 , 66) E-TOTAL
COMPUTE VAR-QTYONHAND = ITMQTYONHAND
- VAR-SODITMQTYORDER(R)
ADD 1 TO ROW.
SAVE-ENTRIES.
PERFORM SAVE-SOD VARYING R FROM 1 BY 1 UNTIL
R = ROW.
PERFORM SAVE-SO.
MOVE LBLSONO TO CUSLASTSONO.
REWRITE CUSTOMER-RECORD.
MOVE LBLSONO TO SYS-LASTSONO.
REWRITE SYSTEM-RECORD.
MOVE "ENTRIES RECORDED." TO ERRMSG.
DISPLAY ERROR-MESSAGE.
PERFORM INITIALIZE-ITEMREC.
SAVE-SOD.
MOVE LBLSONO TO SODSONO.
MOVE VAR-ITMNO(R) TO SODITMNO.
MOVE VAR-SODITMQTYORDER(R) TO SODQTYORD.
MOVE VAR-ITMPRICE(R) TO SODUPRICE.
MOVE VAR-AMOUNT(R) TO SODAMOUNT.
WRITE SOD-RECORD.
PERFORM SAVE-ITEM.
SAVE-ITEM.
MOVE VAR-ITMNO(R) TO SODITMNO.
READ ITEM-FILE.
MOVE VAR-QTYONHAND TO ITMQTYONHAND.
MOVE TOTAL-QTYONORDER TO ITMQTYONORDER.
MOVE LBLSONO TO ITMLASTONO.
REWRITE ITEM-RECORD.
SAVE-SO.
MOVE LBLSONO TO SONO.
MOVE MY-DATE TO SODATE.
MOVE CUSNO TO SOCUSNO.
MOVE TOTAL-AMOUNT TO SOTOTAL.
* MOVE PREPBY TO SOPREPBY.
* MOVE APPBY TO SOAPPRBY.
MOVE "O" TO SORECSTAT.
WRITE SO-RECORD.
CANCEL-ENTRIES.
MOVE "ENTRIES CANCELLED" TO ERRMSG.
PERFORM INITIALIZE-ITEMREC.
INITIALIZE-ITEMREC.
MOVE ZEROES TO CUSTOMER-RECORD.
MOVE ZEROES TO CUSNO ITMNO.
MOVE ZEROES TO CUSBALANCE CUSCREDITLIMIT.
MOVE ZEROES TO SODAMOUNT SODUPRICE.
MOVE ZEROES TO TOTAL-AMOUNT SORECSTAT.
MOVE 0 TO R.
MOVE SPACES TO TEMP-STR.
MOVE SPACES TO SOPREPBY SOAPPRBY.
MOVE "A" TO ITMRECSTAT.
MOVE 'O' TO SODRECSTAT.
MOVE SPACE TO SOPAYMODE MOD.
MOVE ZEROES TO SODQTYINV ITMQTYONHAND.
MOVE SPACES TO CUSNAME CUSADDR.
CLEAN.
MOVE SPACES TO CUSNAME.
MOVE SPACES TO CUSADDR.
I did not use when like your example because i don't know how to use it.it gives me an error,when compiling.By the way sir why is that if i have file status checking my program will not be runtime and it iwll write to the so.dat and sod.dat and my sono will be generated but if i will remove the file status my program will have input output error when inputing only 3 or less than 5 items.can you please enlighten my mind.Thank you in advance.
I would highly recommend tidying up your code using END-IF statements, as this would make the code a bit easier to understand and read. If you just rely on the full-stops then you run the risk of missing one out, which seems to be the case for the "STOP RUN" line in the "CHK-MOD" paragraph. While that may not be the problem with your file error.
Also, I would recommend you figure out how to use EVALUATE statements as these can make the code a lot more readable. Consider the following alternative to your ENTER-MONTH paragraph:
ENTER-MONTH.
ACCEPT(4 , 65)MY-MONTH.
ACCEPT ESC-CODE FROM ESCAPE KEY.
EVALUATE TRUE
WHEN F2
PERFORM SAVE-ENTRIES
WHEN F10
PERFORM CANCEL-ENTRIES
WHEN MY-MONTH > 12
MOVE "INVALID MONTH" TO ERRMSG
DISPLAY ERROR-MESSAGE
WHEN OTHER
MOVE SPACES TO ERRMSG
DISPLAY ERROR-MESSAGE
MOVE 0 TO FLAG
END-EVALUATE.
Your SAVE-ITEM paragraph is a bit of a mystery. The key for the ITEM-FILE is ITMNO, but you are moving the Item No into SODITMNO before the READ. Also, you are assuming that the ITEM-FILE record exists and always doing a REWRITE. What if the record doesn't exist?
Lastly, I'm not sure if this is significant, but you don't have a DECLARATIVES section defined. That's usually the way to trap I/O errors and carry on from them.
I would also put 88 Level values on your file statuses (ITEM-STATUS, SO-STATUS, SOD-STATUS, etc) so that you can test for those instead of the status values. For example, you might have an 88 level value for ITEM-NOT-FOUND under the ITEM-STATUS.
If you can, edit your source code with these readability improvements and we might be able to see your error better.