I'm trying to userstand how this works:
WORKING-STORAGE SECTION.
01 PAY-TABLE.
05 PAY-VALUES OCCURS 25 TIMES PIC 9(3)V99.
01 WORKING-VALUES.
05 SUB PIC 9(2) VALUE ZERO.
PROCEDURE DIVISION.
INITIALIZE-ROUTINE.
INITIALIZE PAY-TABLE
MAINLINE-ROUTINE.
PERFORM LOAD-TABLE
VARYING SUB FROM 1
BY 1
UNTIL SUB>10.
DISPLAY-ROUTINE.
DISPLAY PAY-VALUE (SUB)
LOAD-TABLE.
MOVE SUB TO PAY-VALUE (SUB).
I have this code as a review code in the book. There are several questions according to this code, with answers, however, I don't really understand why should it be exactly this answer.
The DISPLAY statement will display the value _____ on the monitor.
Answer: unknown
When the value of SUB in the PERFORM statement is equal to 9, the value in PAY-VALUE (SUB), before the PERFORM executes, will be equal to:
Answer:10
When the LOAD-TABLE routine has executed for the last time, the value in PAY-VALUE (25) will be:
Answer: 26
I've tried to read tutorials about tables but still don't understand how this example works.
Note that much of this depends on the environment -- some COBOL compilers behave differently and there are also variances between platforms. (I've had a lot of fun with this porting code from HP3000 COBOL to Linux NetCOBOL.) But generally speaking...
1) The book may say the answer is "unknown" because compilers may initialize things differently. INITIALIZE PAY-TABLE may set each instance of PAY-VALUE to zero or it may set PAY-TABLE (the 125 byte character field that is comprised of the 25 PAY-VALUEs) to spaces. What it should be, however, (as in the former case,) is zero.
2) This is incorrect. Again, there is the possibility of variance (due to the reason mentioned in #1) but it should be zero. Because nothing has happened to PAY-VALUE yet (before the PERFORM for SUB=9), it would still be the value to which it had been initialized.
3) As in #2, with the same caveats, the answer should be zero. Because the LOAD-TABLE paragraph is only performed until SUB becomes greater than 10, PAY-VALUE (25) will never change from its initialized value.
Note also that the program is poorly written -- without a STOP RUN. at the end of the MAINLINE-ROUTINE, the program will continue on and execute the DISPLAY-ROUTINE and LOAD-TABLE paragraphs one last time.
There are also, a number of typos, most notably the definition of PAY-VALUES (with an S) and the usage of PAY-VALUE (no S).
Here is a sample run (I added displays before and after the MOVE statement in LOAD-TABLE and after the PERFORM LOAD-TABLE statement has completed. Note the extra displays.)
Before move -- Sub: 01 PV: 00000
After move -- PV: 00100
Before move -- Sub: 02 PV: 00000
After move -- PV: 00200
Before move -- Sub: 03 PV: 00000
After move -- PV: 00300
Before move -- Sub: 04 PV: 00000
After move -- PV: 00400
Before move -- Sub: 05 PV: 00000
After move -- PV: 00500
Before move -- Sub: 06 PV: 00000
After move -- PV: 00600
Before move -- Sub: 07 PV: 00000
After move -- PV: 00700
Before move -- Sub: 08 PV: 00000
After move -- PV: 00800
Before move -- Sub: 09 PV: 00000
After move -- PV: 00900
Before move -- Sub: 10 PV: 00000
After move -- PV: 01000
Completed Perform of LOAD-TABLE.
PAY-VALUE(25): 00000
00000
Before move -- Sub: 11 PV: 00000
After move -- PV: 01100
Bear in mind that the PAY-VALUE values show as hundreds (e.g., 00100 instead of 1) because the field is defined as 9(03)V99 meaning there is an implied decimal place and two digits to the right of it.
Hope this helps!
Related
Is there a kind of "Wait" function in COBOL?
I wrote a calculator, and to make it more 50s, i Print " Computing." "Computing.." ecc
For example:
DISPLAY "SECONDO NUMERO"
ACCEPT B
COMPUTE C= A * B
DISPLAY "Computing"
DISPLAY "Computing."
DISPLAY "Computing.."
DISPLAY "Computing..."
DISPLAY "Computing...."
DISPLAY "Computing....."
DISPLAY "Computing......"
DISPLAY A "x" B " FA..."
DISPLAY C
Now, is there a way to make a little delay (half a second) on COBOL where I put the "Computing" piece? I created a github repo (https://github.com/aIDserse/Super-utility-Submachine-COBOL-CALCULATOR) to this project, look at it (refer to version 1.3) for the complete code (and maybye spread it hahah). Thx!!!
There is a statement for sleeping in standard COBOL, but only with COBOL 202x:
CONTINUE AFTER arithmetic-expression SECONDS
As this standard is in the committee draft state it is hard to find an implementation, but as you've asked for GnuCOBOL - GnuCOBOL 3.1 already implements it.
Other than this there are some dialect specific library routines that can be used, like CALL "C$SLEEP" originating from ACUCOBOL-GT (also implemented with GnuCOBOL, but be aware that pre 3.1-versions only use the non-decimal part, so "0.9" will sleep zero seconds).
For OpenCOBOL/GnuCOBOL you can call the CBL_OC_NANOSLEEP/CBL_GC_NANOSLEEP library routines.
For any COBOL environment that can call native routines you have variants of CALL "sleep".
As mentioned by Rick Smith Many COBOL implementations also implement a callable SYSTEM where you may use something like a ping localhost with a timeout, but whatever you call may not be available (or the process running the COBOL environment has no access to it).
Stephen Gennard mentioned a very common extension:
ACCEPT something WITH TIMEOUT
which has a "beware" that different environments use a different scale (some seconds, some milliseconds). This has the pro/con that the user can "break" out by pressing a key (normally a function key); and the additional issue that it may only work in "graphical" environments.
Anton's answer highlights the IBM library routine CEE3DLY.
There's no wait statement in any ISO Standard COBOL.
However, if you got built in system routines available either C$SLEEP (for seconds) or CBL_GC_NANOSLEEP (for nanoseconds) should do the trick.
Example (sleeps for half a second):
call "CBL_GC_NANOSLEEP" using "500000000" end-call
For IBM's Enterprise COBOL (LE enabled) the CEE3DLY routine is most suitable (there are also other legacy routines available).
For GnuCobol call the C$SLEEP with the number of seconds you want to wait.
CALL "C$SLEEP" USING 2 END-CALL
COBOL has no build in language feature to handle waiting. This is a system specific request and I believe always requires calling an external module to interface with said system.
There is no wait or delay statement in standard COBOL. There may be, for GnuCOBOL, a CALL "SYSTEM" to effect a delay.
I took some code that I use for elapsed time measurement and modified the code to create a procedure for a delay.
Wherever you need a delay, insert the statement PERFORM timed-delay. Of course, the delay may be changed. This code is set to work even if the delay crosses midnight.
Code:
working-storage section.
01 t pic 9(8).
01 t-start.
03 t-start-hour pic 99.
03 t-start-minute pic 99.
03 t-start-second pic 99v99.
01 t-end.
03 t-end-hour pic 99.
03 t-end-minute pic 99.
03 t-end-second pic 99v99.
77 t-elapsed pic 9(7)v99.
procedure division.
begin.
accept t from time
display t
perform timed-delay
accept t from time
display t
stop run
.
timed-delay.
accept t-start from time
move 0 to t-elapsed
perform until t-elapsed > 0.5 *> one-half second
accept t-end from time
perform get-elapsed
end-perform
.
get-elapsed.
if t-start > t-end
move 86400 to t-elapsed
else
move 0 to t-elapsed
end-if
compute t-elapsed = t-elapsed
+ (t-end-hour - t-start-hour) * 3600
+ (t-end-minute - t-start-minute) * 60
+ (t-end-second - t-start-second)
end-compute
.
Output: (shows a delay of 0.55 seconds)
21424364
21424419
The initial PERFORM WITH TEST AFTER ... is nothing like the code I provided in: Cobol-Restart from the program , so I turned it into comments. It should be removed.
If you want to use SLEEP-SEC instead of a fixed value, replace the 0.5 with SLEEP-SEC; but provide a VALUE clause for SLEEP-SEC or MOVE a value to it before the displaying the menu.
For example, in your code (with most code removed):
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SLEEP-SEC PIC S9(2)V9(2).
01 A PIC S9(7)V9(7).
01 B PIC S9(7)V9(7).
01 C PIC S9(7)V9(7).
01 D PIC S9(11)V9(7).
01 INPUT1 PIC 9(14).
01 Q PIC X VALUE "Y".
01 t-start.
03 t-start-hour pic 99.
03 t-start-minute pic 99.
03 t-start-second pic 99v99.
01 t-end.
03 t-end-hour pic 99.
03 t-end-minute pic 99.
03 t-end-second pic 99v99.
77 t-elapsed pic 9(7)v99.
PROCEDURE DIVISION.
MAIN.
* PERFORM WITH TEST AFTER
* UNTIL Q ="YES" OR "Y" OR "y" OR "yes" OR "Yes"
* END-PERFORM.
DISPLAY "CALCULATOR".
DISPLAY "WHAT DO YOU WANT DO DO?".
DISPLAY "1 ADDITION".
DISPLAY "15 EXIT"
DISPLAY "CHOOSE AN OPTION"
ACCEPT INPUT1
EVALUATE INPUT1
WHEN = 15
DISPLAY "OK, GOOD JOB :)"
STOP RUN
WHEN = 1
DISPLAY "FIRST NUMBER"
ACCEPT A
DISPLAY "SECOND NUMBER"
ACCEPT B
COMPUTE C= A + B
DISPLAY "Computing"
PERFORM timed-delay
DISPLAY "(" A ")" "+" "(" B ")" "RESULTS..."
DISPLAY C
END-EVALUATE
IF INPUT1 NOT = 15
DISPLAY "DO YOU WANT TO DO OTHER CALCULATIONS?"
ACCEPT Q
IF Q = "YES" OR "Y" OR "y" OR "yes" OR "Yes" GO TO MAIN
ELSE DISPLAY "OK, GOOD JOB :)"
END-IF
STOP RUN.
timed-delay.
accept t-start from time
move 0 to t-elapsed
perform until t-elapsed > 0.5 *> one-half second
accept t-end from time
perform get-elapsed
end-perform
.
get-elapsed.
if t-start > t-end
move 86400 to t-elapsed
else
move 0 to t-elapsed
end-if
compute t-elapsed = t-elapsed
+ (t-end-hour - t-start-hour) * 3600
+ (t-end-minute - t-start-minute) * 60
+ (t-end-second - t-start-second)
end-compute
.
I've been trying to read my input and write it to output file but can't find any mistakes in code. The JCL I'm submiting is good, because it was written by my mainframe lecturer, so I know the problem is somewhere in COBOL code... double checked everything, tried to find something with him in class - worthless... Line alignment, spacing, etc. are Ok I believe.
IDENTIFICATION DIVISION.
PROGRAM-ID. NAME.
AUTHOR. MYNAME.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT10 ASSIGN TO INPUTFIL.
SELECT OUTPUT10 ASSIGN TO OUTFIL.
DATA DIVISION.
FILE SECTION.
FD INPUT10
BLOCK CONTAINS 0 RECORDS
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS.
01 PLAYER-DETAILS.
03 PLAYER-ID PIC 9(07).
03 PLAYER-NAME.
05 NAME PIC X(08).
05 INITIALS PIC A(02).
03 PLAYER-BDAY PIC 9(08).
03 PLAYER-NR PIC 9(02).
FD OUTPUT10
BLOCK CONTAINS 0 RECORDS
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS.
01 OUTPUT-DETAILS.
03 OUTPUT-ID PIC 9(07).
03 OUTPUT-NAME.
05 O-NAME PIC X(08).
05 O-INITIALS PIC A(02).
03 OUTPUT-BDAY PIC 9(08).
03 OUTPUT-NR PIC 9(02).
WORKING-STORAGE SECTION.
01 WS-INDICATORS.
10 WS-EOF-IND PIC X(01) VALUE 'N'.
88 WS-END-OF-FILE VALUE 'Y'.
PROCEDURE DIVISION.
MAINFLOW.
OPEN INPUT INPUT10
OPEN OUTPUT OUTPUT10
READ INPUT10
AT END SET WS-END-OF-FILE TO TRUE
END-READ
PERFORM UNTIL WS-END-OF-FILE
MOVE PLAYER-ID TO OUTPUT-ID
MOVE NAME TO O-NAME
MOVE INITIALS TO O-INITIALS
MOVE PLAYER-BDAY TO OUTPUT-BDAY
MOVE PLAYER-NR TO OUTPUT-NR
READ INPUT10
AT END SET WS-END-OF-FILE TO TRUE
END-READ
WRITE OUTPUT10
END-WRITE
END-PERFORM
CLOSE INPUT10
CLOSE OUTPUT10
STOP RUN.
here is the code of JCL
//useridX JOB ,
// MSGCLASS=H,
// MSGLEVEL=(1,1),
// CLASS=A,
// REGION=0M,
// NOTIFY=&SYSUID
//COBOL1 EXEC IGYWCLG,REGION=50M,
// PARM.COBOL='TEST,RENT,APOST,OBJECT,NODYNAM,LIB,SIZE(1048376)'
//COBOL.STEPLIB DD DSN=IGY420.SIGYCOMP,
// DISP=SHR
//COBOL.SYSIN DD DISP=SHR,DSN=userid.KURS.COBOL(PROG2)
//GO.INPUTFIL DD DISP=SHR,DSN=userid.KURS.PLAYERS
//GO.OUTFIL DD DISP=SHR,DSN=userid.KURS.REPORT
and it works for other students, so I'm pretty sure the cause of maxcc=12 is COBOL's part
Any suggestions?
Thanks.
P.S. I cannot check my job logs - something is wrong with my mainframe account or mainframe itself. This is the main cause why I can't find the problem
OK - I have run this successfully after some code changes. You really need to get your output sorted - are you using the correct MSGCLASS. Check - do not assume.
Program errors:
Look at PROGRAM-ID
Look at record lengths and compare to what you describe the record lengths of the files
Look at what you are writing.
Improvements:
Always check your status after any file operation - OPEN READ WRITE CLOSE.
Your indentation is not good. If it is on your machine then take more care when posting.
The input file and output file is declared as Fixed and is of length 80.
But both input and output variables are of length less than 80. They have length of 27.So in player-details and output details add filler variable with length 80 - 27 = 53
Also make sure the input and output file length are 80.
We have to find more than one way to get the ascii value of a character.
On top of that we also need to get the sum of all the characters's ascii values.
I currently have the below and works alright for the first section where you need individual values
.
I just need to know if there is an easier way or a function to do this in Cobol?
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-COUNTERS.
03 WS-COUNTER PIC 9(05).
03 WS-INPUT PIC X(01).
03 WS-DISPLAY PIC 9(03).
01 W1-ARRAY.
03 ALPHABETIC-CHARS OCCURS 26 TIMES PIC X.
01 W3-ARRAY.
03 NUMERIC-CHARS OCCURS 26 TIMES PIC X.
PROCEDURE DIVISION.
A000-MAIN SECTION.
BEGIN.
PERFORM B000-INITIALIZE.
PERFORM C000-PROCESS UNTIL WS-COUNTER > 26.
PERFORM D000-END.
A099-EXIT.
STOP RUN.
B000-INITIALIZE SECTION.
ACCEPT WS-INPUT.
MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO W1-ARRAY.
MOVE "01234567890000000000000000" TO W3-ARRAY.
MOVE 1 TO WS-COUNTER.
MOVE 0 TO WS-DISPLAY.
B099-EXIT.
EXIT.
C000-PROCESS SECTION.
C001-BEGIN.
IF WS-INPUT IS NUMERIC
IF NUMERIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 48 - 1
END-IF
ELSE
IF ALPHABETIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 65 - 1
END-IF
END-IF.
ADD 1 TO WS-COUNTER.
C099-EXIT.
EXIT.
Have a look at FUNCTION ORD and keep in mind that you will get the ordinal number in the program's collating sequence (which may be EBCDIC or not the full ASCII).
As this function was introduced in the COBOL85 standard it should be available in most compilers (your question misses the compiler/machine you use).
With Microsoft COBOL Compiler version 2.2 and I have this code that completely worked fine.
IDENTIFICATION DIVISION.
PROGRAM-ID. COCENTRY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COC-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS COCNO
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD COC-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "COC.DAT".
01 COC-RECORD.
03 COCNO PIC 9(5).
03 COCDESC PIC X(40).
WORKING-STORAGE SECTION.
01 FILE-STATUS PIC XX.
01 ESC-CODE PIC 99 VALUE 0.
88 ESC-KEY VALUE 1.
88 F2 VALUE 3.
88 F10 VALUE 11.
01 ERRMSG PIC X(70) VALUE SPACES.
01 ERR PIC 9 VALUE 0.
SCREEN SECTION.
01 FORM1.
03 BLANK SCREEN BACKGROUND-COLOR 1.
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
03 LINE 25 COLUMN 1 PIC X(70) FROM ERRMSG HIGHLIGHT.
01 FORM2.
03 LINE 1 COLUMN 14 PIC 9(5)
USING COCNO REVERSE-VIDEO.
03 LINE 2 COLUMN 14 PIC X(40)
USING COCDESC REVERSE-VIDEO.
03 LINE 24 COLUMN 1 PIC 99
USING ESC-CODE.
PROCEDURE DIVISION.
MAIN.
OPEN I-O COC-FILE.
IF FILE-STATUS NOT = '00'
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE.
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
CLOSE COC-FILE.
STOP RUN.
ENTRY1.
MOVE SPACES TO COC-RECORD.
MOVE ZEROES TO COCNO.
ENTRY2.
DISPLAY FORM1 FORM2.
ACCEPT FORM2.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F10
MOVE 'Entries canceled...' TO ERRMSG
GO ENTRY1
ELSE IF F2
GO ENTRY3
ELSE IF ESC-KEY
GO ENTRYX
ELSE
GO ENTRY2.
ENTRY3.
MOVE 0 TO ERR.
WRITE COC-RECORD INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
MOVE 'Duplicate key not allowed...' TO ERRMSG
GO ENTRY2
ELSE
MOVE 'Entries recorded...' TO ERRMSG
GO ENTRY1.
ENTRYX.
EXIT.
Now I am using OpenCobol IDE 4.3.0 having GNUCobol version 1.1.0 and I am being prompted with this lines of
syntax error, unexpected "Literal", expecting LEADING or TRAILING
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
So I fix them by adding VALUE keyword:
03 LINE 1 COLUMN 1 VALUE 'COCNO'.
03 LINE 2 COLUMN 1 VALUE 'COCDESC'.
03 LINE 24 COLUMN 1 VALUE "Esc=Exit F2=Save F10=Cancel".
but as soon as I do this I get a another prompt of
'ACCEPT .. FROM ESCAPE KEY' not implemented
on this line
ACCEPT ESC-CODE FROM ESCAPE KEY.
What could be the possible cause of this? And what could be the fix for this?
Your actual answer is here, https://sourceforge.net/p/open-cobol/discussion/help/thread/26a01c5f/, on the GnuCOBOL part of SourceForge. With minor changes your code will "completely work" with the change you've already made to include the VALUE clause, and if you use release 2.0 or higher of the GnuCOBOL compiler.
Your code may "completely work" but it is spaghetti code.
The term comes from the old days, and relates to the use of many branches in programs, a common practice at that time, but which made trying to follow the logic a process like trying to follow one strand of cooked spaghetti which is part of a pile of cooked spaghetti.
If you change this:
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
To this:
PERFORM ENTRY1 THRU ENTRYX.
Your program will still work. Confused? Yes, because you have spaghetti. Your program flow will only ever get to ENTRYX once. The value when it arrives at ENTRYX is ESC-KEY, but that is superfluous, because it can only ever get there once, when it is ESC-KEY. Clear? No? Because you have spaghetti.
Here is your logic, re-written:
PROCEDURE DIVISION.
OPEN I-O COC-FILE
IF FILE-STATUS NOT = '00'
[the following code is a horror. Deal with this outside the
program. Crash for an unexpected FILE STATUS on OPEN]
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE
END-IF
PERFORM PROCESS-USER-INPUT
UNTIL ESC-KEY
CLOSE COC-FILE
IF FILE-STATUS NOT = '00'
[something bad has happened, so don't go quietly]
END-IF
GOBACK
.
PROCESS-USER-INPUT.
PERFORM BLANK-OUTPUT-RECORD
PERFORM PROCESS-COC
UNTIL ESC-KEY
.
PROCESS-COC.
DISPLAY FORM1 FORM2
ACCEPT FORM2
ACCEPT ESC-CODE FROM ESCAPE KEY
EVALUATE TRUE
WHEN F10
MOVE 'Entries canceled...' TO ERRMSG
WHEN F2
PERFORM CREATE-OUTPUT
END-EVALUATE
.
CREATE-OUTPUT.
WRITE COC-RECORD
IF ATTEMPT-TO-WRITE-DUPLICATE [22 on the FILE STATUS field]
MOVE 'Duplicate key not allowed...' TO ERRMSG
ELSE
MOVE 'Entries recorded...' TO ERRMSG
PERFORM BLANK-OUTPUT-RECORD
END-IF
.
BLANK-OUTPUT-RECORD.
MOVE SPACES TO COC-RECORD
MOVE ZEROES TO COCNO
.
Does that make your program look simpler? Easier to follow, change, understand what it does when someone else looks at it (or when you do in two weeks time)?
There are other things, like why set COC-RECORD to space, and then COCNO to zero? Move the spaces to COCDESC.
Make your data/procedure names good and descriptive. FILE STATUS having a good name (don't call it FILE-STATUS) and one per file when you have more than one file. Use full-stops/periods only where you have to, and use scope-delimiters for all conditional constructs that you use. Use FILE STATUS checking for all IO, and don't use the tortuous AT on IO.
If you look now the first code in your program is quite long, executes only once, and is (should be) irrelevant to the business function of your program. So stick all that in a paragraph, and PERFORM that. Same for the close. Then you can have as much code as you need when starting up and closing down, without making your program more difficult to follow.
The screen and keyboard I/O was a MicroSoft Cobol specific flavor. You will likely need to tweak that a bit to make it work with OpenCobol.
PROCEDURE DIVISION.
SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'.
SET ENVIRONMENT 'COB_SCREEN_ESC' TO 'Y'.
Escape: IF cob-crt-status = 2005......
Enter: IF cob-crt-status = 0........
F1: IF cob-crt-status = 1001......
F2: IF cob-crt-status = 1002......
Having issues with using the GO-TO statement. This is suppose to run until the user types 'END'. If I type 'END' when I first open the program it will close out but if I type it after entering valid data for the first pass thru it just continues to bring back the user input data screen.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT USED-CAR-FILE-OUT
ASSIGN TO 'USED-CAR.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD USED-CAR-FILE-OUT.
01 USED-CAR-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 FIRST-RECORD PIC X(3) VALUE 'YES'.
01 ID-CODE PIC X(3).
01 TOTAL-CASH-PAYMENT PIC 9(5).
01 MONTHLY-PAYMENT PIC 9(4).
01 NUMBER-OF-MONTHS PIC 9(3).
01 TOTAL-BALANCE PIC S9(6)V99 VALUE ZEROS.
01 INTEREST-COLLECTED PIC 99V99 VALUE ZEROS.
01 MONTH-DIFF PIC 99 VALUE ZEROS.
01 MONTH-NUM PIC 99 VALUE ZEROS.
01 YEAR-NUM PIC 99 VALUE ZEROS.
01 ID-HOLD PIC X(3) VALUE SPACES.
01 PAYMENT-HOLD PIC X(3) VALUE SPACES.
01 DETAIL-LINE.
05 ID-CODE-DL PIC X(3).
05 PIC X(3) VALUE SPACES.
05 PIC X(4) VALUE 'Yr='.
05 YEAR-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(4) VALUE 'MO='.
05 MONTH-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Pmt='.
05 PAYMENT-DL PIC $$$,$$$.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Int='.
05 INTEREST-EARNED-DL PIC $$$$.99.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'Bal='.
05 BALANCE-DL PIC $$$,$$$.99.
PROCEDURE DIVISION.
100-MAIN.
OPEN OUTPUT USED-CAR-FILE-OUT
PERFORM 200-USER-INPUT THRU 299-EXIT
CLOSE USED-CAR-FILE-OUT
STOP RUN.
200-USER-INPUT.
DISPLAY 'Used Car Sales Report'
DISPLAY 'Enter the ID code (or END) - maxium three char.'
ACCEPT ID-CODE
IF ID-CODE = 'END'
GO TO 299-EXIT
END-IF
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
DISPLAY 'Enter the Monthly Payment - maximum four digits'
ACCEPT MONTHLY-PAYMENT
DISPLAY 'Enter the Number of Months - maximum three digits'
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
299-EXIT.
EXIT.
300-RECORD-PROCESS.
IF TOTAL-CASH-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE TOTAL-CASH-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
MOVE 'NO' TO FIRST-RECORD
END-IF
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERORM 200-USER-INPUT
END-IF
IF MONTHLY-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE 'NO' TO FIRST-RECORD
END-IF
MOVE MONTHLY-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF TOTAL-CASH-PAYMENT > 0
MOVE 0 TO TOTAL-CASH-PaYMENT
MOVE 0 TO PAYMENT-DL
END-IF
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERFORM 200-USER-INPUT
END-IF.
EDIT solved the issue below
I also am having issues if months > 24. I step through the program and it shows my last detail line as the correct result but yet my output stops at 24 months. Thanks in advance.
AAAAAAAk!
PERFORM SEVERE-BEATING-ON-WHOEVER-MENTIONED-PERFORM-THROUGH
USING HEAVY-OBJECT
UNTIL PROMISE-EXTRACTED-TO-NEVER-DO-IT-AGAIN.
PERFORM THOUGH is EVIL. It causes layout-dependent code.
At the top control-level, use
PERFORM 200-USER-INPUT
UNTIL ID-CODE = 'END'.
(or possibly use 88 USER-INPUT-ENDED on ID-CODE - matter of style)
How you then determine whether to continue with input in 200-... is your choice, either
IF NOT USER-INPUT-ENDED
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
...
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
OR
IF NOT USER-INPUT-ENDED
PERFORM 210-ACCEPT-DETAILS.
210-ACCEPT-DETAILS.
DISPLAY 'Enter the Total Cash Payment - maximum five digits'.
ACCEPT TOTAL-CASH-PAYMENT.
...
ACCEPT NUMBER-OF-MONTHS.
PERFORM 300-RECORD-PROCESS.
Since you PERFORMED 200-... then only 200-... will be executed; 210-... is a new paragraph which can only be reached from 200-... IF END is not entered.
Next step is to slightly modify 300-...
Move the initialisation ( FIRST-RECORD = 'YES' code) before the PERFORM 300-... in 200-... and then modify the PERFORM 300-RECORD-PROCESS. to
PERFORM 300-RECORD-PROCESS
UNTIL TOTAL-BALANCE = 0.
(I'm assuming here that this is the report-terination condition; if it isn't, substitute your report-termination condition)
You can now restructure 300-... to calculate the interest payable, modify the year and month numbers and show the result. ALL of the PERFORMs in 300-... will disappear.
So, in essence you have
MAIN:perform user-input until end-detected.
user-input: get user data; perform calculations until balance is zero.
calculations: one month's calculations at a time.
This also has the advantage that if you choose, you could insert
IF MONTHLY-PAYMENT IS LESS THAN INTEREST-COLLECTED
MOVE 'ERR' TO ID-CODE.
And use 'ERR' in ID-CODE to produce an appropriate error-message in 300-... instead of the progressive report lines AND at the same time assign 0 to TOTAL-BALANCE which terminates the PERFORM 300-... UNTIL ....
Your use of GO TO and PERFORM THROUGH paragraph ranges has corrupted the procedure return mechanism that COBOL
uses to maintain proper program flow of control. In essence, you have a program that is invalid - it might compile
without error but is still an invalid program according to the rules of COBOL.
Here is an outline of what your program is doing from a flow of control perspective. The
mainline program is essentially:
100-MAIN.
PERFORM 200-USER-INPUT THRU 299-EXIT
This is asking COBOL to execute all the code found from the beginning of
200-USER-INPUT through to the end of 299-EXIT. The outline for these
procedures is:
200-USER-INPUT.
IF some condition GO TO 299-EXIT
...
PERFORM 300-RECORD-PROCESS
.
299-EXIT.
Notice that if some condition is true, program flow will skip past the end
of 200-USER-INPUT and jump into 299-EXIT. 299-EXIT does not do anything
very interesting, it is just an empty paragraph serving as the end of a
PERFORMed range of paragraphs.
In paragraph 300-RECORD-PROCESS you have a fair bit of code. The interesting
bit is:
300-RECORD-PROCESS.
...
PERFORM 200-USER-INPUT
Notice that PERFORM 200-USER-INPUT this is not a PERFORM THRU, as you had coded in 100-MAIN.
The problem is that when you get back into 200-USER-INPUT and some codition becomes
true (as it will when you enter 'EXIT'), the flow of control
jumps to 299-EXIT which is past the end of the paragraph
you are currently performing. From this point
forward the flow of control mechanism used by COBOL to manage return from PERFORM verbs has
been corrupted. There is no longer a normal flow of control mechanism to return back to where 200-USER-INPUT
was performed from in 300-RECORD-PROCESS.
What happens next is not what most programmers would expect. Most programmers seem to expect
that when the end of 299-EXIT is reached program flow should return to wherever the last PERFORM
was done. In this case, just after PERFORM 200-USER-INPUT. No, COBOL doesn't work that way, flow of control
will continue with the next executable statement following 299-EXIT. This gets you
right back to the first executable statement in 300-RECORD-PROCESS! And that is why you
are not getting expected behaviour from this program.
Logic flow in COBOL programs must ensure that the end of performed procedures are
always reached in the reverse order from which they were made. This corresponds to the call/return
stack semantics that
most programmers are familiar with.
My advice to you is to avoid the use of PERFORM THRU and GO TO. These are two of the biggest
evils left in the COBOL programming language today. These constructs are hang-overs from a
bygone era of programming and have no constructive benefit today.
Your problem is that you have created an infinite loop for yourself. You 200- paragraph PERFORMs the 300- paragraph, and your 300- paragraph PERFORMS your 200- paragraph.
You need to restructure your program.
A paragraph called 200-USER-INPUT should just concern itself with that.
repeat until end of input
get some input
if there is input to process
process the input
Yoiks! I just noticed you also PERFORM 300- from within 300-!