I am in the last course I will have for COBOL in college, and I have to write interacting programs that are supposed to keep track of inventory for a business. I have reached a few parts that I am having problems with. The first is verifying that the date is between the years 2011 and 2012, and the second is that the month and day numbers are between 1-12 and 1-31, respectively. When I run my program, it always says in the error report that the year is wrong, even when I put it in right. Here is my code for that part:
WORKING-STORAGE SECTION.
05 POLI-DATE-REQUESTED-S.
10 POLI-DATE-REQUESTED-S-1 PIC XX.
10 POLI-DATE-REQUESTED-S-2 PIC XX.
10 POLI-DATE-REQUESTED-S-3 PIC XX.
10 POLI-DATE-REQUESTED-S-4 PIC XX.
SCREEN SECTION.
01 SCREEN-IMAGE.
05 BLANK SCREEN
BACKGROUND-COLOR 0.
05 LINE 02 COLUMN 02 PIC X(8)
FROM TIME-HHMMSSXX-COLONS
FOREGROUND-COLOR 15.
05 LINE 02 COLUMN 25
VALUE 'Purchase Order Line Item Maintenance'
FOREGROUND-COLOR 14.
05 LINE 02 COLUMN 70 PIC X(8)
FROM DATE-MMDDYY-SLASHES
FOREGROUND-COLOR 15.
05 LINE 04 COLUMN 02 VALUE 'FUNCTION CODE:'
FOREGROUND-COLOR 10.
05 LINE 04 COLUMN 18 PIC X(3)
USING FUNCTION-CODE-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 04 COLUMN 23 VALUE '(ADD, CHG, DEL, INQ, END)'
FOREGROUND-COLOR 11.
05 LINE 07 COLUMN 23 VALUE 'NUMBER:'
FOREGROUND-COLOR 10.
05 LINE 07 COLUMN 50 PIC X(4)
USING POLI-VEND-NUMBER-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 08 COLUMN 23 VALUE 'ORDER ID:'
FOREGROUND-COLOR 10.
05 LINE 08 COLUMN 50 PIC X(8)
USING POLI-ORDER-ID-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 09 COLUMN 23 VALUE 'LINE ITEM:'
FOREGROUND-COLOR 10.
05 LINE 09 COLUMN 50 PIC X(4)
USING POLI-LINE-ITEM-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 10 COLUMN 23 VALUE 'ITEM ID:'
FOREGROUND-COLOR 10.
05 LINE 10 COLUMN 50 PIC X(10)
USING POLI-ITEM-ID-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 11 COLUMN 23 VALUE 'QUANTITY:'
FOREGROUND-COLOR 10.
05 LINE 11 COLUMN 50 PIC X(5)
USING POLI-QUANTITY-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 12 COLUMN 23 VALUE 'DATE REQUESTED (YYYYMMDD):'
FOREGROUND-COLOR 10.
05 LINE 12 COLUMN 50 PIC X(8)
USING POLI-DATE-REQUESTED-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 13 COLUMN 23 VALUE 'QUOTED COST:'
FOREGROUND-COLOR 10.
05 LINE 13 COLUMN 50 PIC X(7)
USING POLI-QUOTED-COST-S
FOREGROUND-COLOR 15 AUTO.
05 LINE 17 COLUMN 23 VALUE 'DATE ADDED:'
FOREGROUND-COLOR 10.
05 LINE 17 COLUMN 40 PIC X(10)
USING POLI-DATE-ADDED-S
FOREGROUND-COLOR 15.
05 LINE 18 COLUMN 23 VALUE 'DATE-CHANGED:'
FOREGROUND-COLOR 10.
05 LINE 18 COLUMN 40 PIC X(10)
USING POLI-DATE-CHANGED-S
FOREGROUND-COLOR 15.
05 LINE 23 COLUMN 23 PIC X(55)
FROM ERROR-MESSAGE-S
FOREGROUND-COLOR 12.
PROCEDURE DIVISION.
900-VALIDATE-THE-FIELDS.
IF POLI-DATE-REQUESTED-S-1 IS NOT = 20
MOVE 'Year must be 2011 OR 2012' TO ERROR-MESSAGE-S
GO TO 999-EXIT
END-IF
IF POLI-DATE-REQUESTED-S-2 IS NOT = 11 OR 12
MOVE 'Year Must Be 2011 Or 2012' TO ERROR-MESSAGE-S
GO TO 999-EXIT
END-IF
IF POLI-DATE-REQUESTED-S-3 IS < 1 OR > 12
MOVE 'Month Must Be 1 Through 12' TO ERROR-MESSAGE-S
GO TO 999-EXIT
END-IF
IF POLI-DATE-REQUESTED-S-4 IS < 1 OR > 31
MOVE 'Day Must Be 1 Through 31' TO ERROR-MESSAGE-S
GO TO 999-EXIT
END-IF.
Also, I have to make sure that a record in a field called POLI-ITEM-ID already exists in another indexed file called ITEM-MASTER. I am not exactly sure how to do this, but I assume that it involves temporarily opening the file and searching it. If anyone could show me how to do this I would be grateful, as these two things seem to be the only things holding me back today. I thank everyone for all the help in advance.
Edit: The input data is written on a screen image that is part of the program. Thus I know that what I put in in correct at the time of entry. If it helps, I have put the SCREEN SELECTION in the code, but I do not think it has any bearing on why my date entry is considered an error (i.e. I put in "2011" and it tells me on the screen "Year must be 2011 OR 2012").
05 POLI-DATE-REQUESTED-S.
10 POLI-DATE-REQUESTED-S-1 PIC 9999.
88 Year-Valid value 2011 thru 2012.
10 POLI-DATE-REQUESTED-S-2 PIC 99.
88 Month-Valid value 01 thru 12.
10 POLI-DATE-REQUESTED-S-4 PIC 99.
88 Day-Valid value 01 thru 31.
Try redefining your fields like this. Then you can do a simple test of the fields with:
IF not Year-Valid
MOVE 'Year must be 2011 OR 2012' TO ERROR-MESSAGE-S
Else
IF not Month-Valid
MOVE 'Month Must Be 1 Through 12' TO ERROR-MESSAGE-S
Else
IF not Day-Valid
MOVE 'Day Must Be 1 Through 31' TO ERROR-MESSAGE-S
END-IF
END-IF
END-IF
To deal with your lookup, do a direct read on the ITEM-MASTER file. That will involve something like this:
SELECT ITEM-MASTER ASSIGN TO "fname.txt"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS ITEM-MASTER-KEY.
and then do a direct read:
READ ITEM-MASTER
KEY IS POLI-ITEM-ID
INVALID KEY DISPLAY "error or something"
END-READ
Be careful - the accepted solution does not guarantee numeric values.
The following program illustrates the point:
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TXT-VALUE PIC X(4).
01 NUM-VALUE PIC 9(4).
88 WS-VALID-NUM VALUE 2000 THRU 2999.
PROCEDURE DIVISION.
MOVE '21b1' TO TXT-VALUE
MOVE TXT-VALUE TO NUM-VALUE
DISPLAY 'NUM-VALUE: ' NUM-VALUE
IF WS-VALID-NUM
DISPLAY 'passed the range test.'
END-IF
IF NUM-VALUE IS NUMERIC
DISPLAY 'passed numeric test.'
ELSE
DISPLAY 'failed numeric test.'
END-IF
Which results in the following output:
NUM-VALUE: 21b1
passed the range test.
failed numeric test.
Lesson: Always validate numeric fields with an IS NUMERIC test and then a range test.
Furthermore, unless input data have been pre-edited for validity,
it is not a good idea to read external data directly into numeric
data types. Reading '1b' from an
input file directly into a PIC 9(2) data item yields the value 12 (in an ebcdic based
environment). This will now pass an IS NUMERIC test as well as range tests even though
the actual input data were not numeric. The reasons for the "automatic" conversion are
a bit beyond this discussion - lets just say data movement rules in COBOL are
much more complex than most people appreciate.
Joe Zitzelberger's post is the recommended and 'clean' way to do this.
I would just point out that the error in your original code was to mix up XX and numeric types. You should either have used character literals in your tests:
IF POLI-DATE-REQUESTED-S-1 IS NOT = '20'
or, better, defined your data values as numbers:
10 POLI-DATE-REQUESTED-S-1 PIC 99.
01 FILLER.
05 POLI-DATE-REQUESTED-S.
10 POLI-DATE-REQUESTED-S-1 PIC XXXX.
88 YEAR-VALID VALUE "2011" THRU "2012".
10 POLI-DATE-REQUESTED-S-2 PIC XX.
88 MONTH-VALID VALUE "01" THRU "12".
88 MONTH-IS-FEB VALUE "02".
88 MONTH-IS-30-DAYS VALUE "04" "06" "09" "11".
10 POLI-DATE-REQUESTED-S-4 PIC XX.
88 DAY-MAY-BE-VALID VALUE "01" THRU "31".
88 VALID-FEB-DAYS VALUE "01" THRU "28".
88 VALID-30-DAYS VALUE "01" THRU "30".
Then the "first cut", with a student who doesn't have to worry about the actual number of days a month has:
MOVE SPACE TO ERROR-MESSAGE-S
EVALUATE TRUE
WHEN NOT POLI-DATE-REQUESTED-S NUMERIC
MOVE 'DATE MUST ONLY BE NUMBERS'
TO ERROR-MESSAGE-S
WHEN NOT YEAR-VALID
MOVE 'YEAR MUST BE 2011 OR 2012'
TO ERROR-MESSAGE-S
WHEN NOT MONTH-VALID
MOVE 'MONTH MUST BE 01 THROUGH 12'
TO ERROR-MESSAGE-S
WHEN NOT DAY-MAY-BE-VALID
MOVE "DAY IS ZERO OR MORE THAN 31"
TO ERROR-MESSAGE-S
END-EVALUATE
And then amended later for the actual number of days.
MOVE SPACE TO ERROR-MESSAGE-S
EVALUATE TRUE
WHEN NOT POLI-DATE-REQUESTED-S NUMERIC
MOVE 'DATE MUST ONLY BE NUMBERS'
TO ERROR-MESSAGE-S
WHEN NOT YEAR-VALID
MOVE 'YEAR MUST BE 2011 OR 2012'
TO ERROR-MESSAGE-S
WHEN NOT MONTH-VALID
MOVE 'MONTH MUST BE 01 THROUGH 12'
TO ERROR-MESSAGE-S
WHEN NOT DAY-MAY-BE-VALID
MOVE "DAY IS ZERO OR MORE THAN 31"
TO ERROR-MESSAGE-S
WHEN ( MONTH-IS-FEB
AND NOT VALID-FEB-DAYS )
MOVE 'TOO MANY DAYS FOR FEBRUARY'
TO ERROR-MESSAGE-S
WHEN ( MONTH-IS-30-DAYS
AND NOT VALID-30-DAYS )
MOVE 'NO 31ST THIS MONTH'
TO ERROR-MESSAGE-S
END-EVALUATE
Related
EDIT: Figured it out. I needed to call the read again at the end of A420-COUNT-MARKS
Edit: Working on a z/OS mainframe that I'm accessing via Vista TN3270. The program is submitted using JCL which was provided by the teacher.
I'm in school for programming and I have a COBOL assignment where my program reads a file full of subject names and codes and a file full of student marks and an associated subject code. It must use this info to create a report that lists all the subjects and count the number of students that received grades of A , B, C, D or F for each subject. It then totals up the amount of each grade at the bottom.
Report example:
01 ABC COLLEGE TESTING CENTER
02 TEST RESULTS SUMMARY DATE: yyyy/mm/dd
03
04 SUBJECT NAME A B C D F
05
06 xxxxxxxxxxxxxxxxxxxx 9,999 9,999 9,999 9,999 9,999
07 xxxxxxxxx 9,999 9,999 9,999 9,999 9,999
19
20 TOTAL 99,999 99,999 99,999 99,999 99,999
The problem is that my program is only outputting the header rows, but won't output the detail rows or the grand total row. I've written functions to perform these things but they're not getting any errors so I have no idea what's going wrong.
Here's my file control and file section:
FILE-CONTROL.
SELECT F01-SUBJ-FILE ASSIGN TO F01SUBJ.
SELECT F02-MARK-FILE ASSIGN TO F02MARK.
SELECT F03-REPT-FILE ASSIGN TO F03REPT.
FILE SECTION.
FD F01-SUBJ-FILE
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS F01-SUBJ-RECORD.
01 F01-SUBJ-RECORD.
05 F01-SUBJ-CODE PIC X(6).
05 F01-SUBJ-NAME PIC X(20).
05 PIC X(54).
FD F02-MARK-FILE
RECORDING MODE IS F
RECORD CONTAINS 80 CHARACTERS
DATA RECORD IS F02-MARK-RECORD
01 F02-MARK-RECORD.
05 F02-STUD-NAME PIC X(20).
05 F02-SUBJ-CODE PIC X(6).
05 PIC X.
05 F02-DATE-TEST PIC X(8).
05 F02-STUD-MARK PIC 9(3).
05 PIC X(42).
FD F03-REPT-FILE
RECORDING MODE IS F
RECORD CONTAINS 120 CHARACTERS
DATA RECORD IS F03-REPT-RECORD.
01 F03-REPT-RECORD.
05 PIC X(120).
Here's working storage:
WORKING-STORAGE SECTION.
01 W01-EOF-SWITCH.
05 W01-MARK-EOF PIC X VALUE 'N'.
05 W01-SUBJ-EOF PIC X VALUE 'N'.
01 W02-TEST-TABLE.
05 W02-SUBJ-COUNT PIC 99 VALUE 0.
05 W02-SUBJ-MAX PIC 99 VALUE 50.
05 W02-TEST-ROW OCCURS 1 TO 50
DEPENDING ON W02-SUBJ-COUNT
ASCENDING KEY IS W02-SUBJ-CODE
INDEXED BY W02-IDX.
10 W02-SUBJ-CODE PIC X(6) VALUE SPACES.
10 W02-SUBJ-NAME PIC X(20) VALUE SPACES.
10 W02-A-CTR PIC 9999 VALUE 0.
10 W02-B-CTR PIC 9999 VALUE 0.
10 W02-C-CTR PIC 9999 VALUE 0.
10 W02-D-CTR PIC 9999 VALUE 0.
10 W02-F-CTR PIC 9999 VALUE 0.
01 W03-REPT.
05 W03-HEADER-ROW1.
10 PIC X(9) VALUE SPACES.
10 PIC X(3) VALUE 'ABC'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'COLLEGE'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'TESTING'.
10 PIC X VALUE SPACES.
10 PIC X(6) VALUE 'CENTER'.
10 PIC X(85) VALUE SPACES.
05 W03-HEADER-ROW2.
10 PIC X(9) VALUE SPACES.
10 PIC X(4) VALUE 'TEST'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'RESULTS'.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'SUMMARY'.
10 PIC X(11) VALUE SPACES.
10 PIC X(5) VALUE 'DATE:'.
10 PIC X VALUE SPACES.
10 W03-YEAR PIC 9999.
10 PIC X VALUE '/'.
10 W03-MONTH PIC 99.
10 PIC X VALUE '/'.
10 W03-DAY PIC 99.
10 PIC X(64) VALUE SPACES.
05 W03-HEADER-ROW3.
10 PIC X VALUE SPACES.
10 PIC X(7) VALUE 'SUBJECT'.
10 PIC X VALUE SPACES.
10 PIC X(4) VALUE 'NAME'.
10 PIC X(15) VALUE SPACES.
10 PIC X VALUE 'A'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'B'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'C'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'D'.
10 PIC X(7) VALUE SPACES.
10 PIC X VALUE 'F'.
10 PIC X(59) VALUE SPACES.
05 W03-DETAIL-ROW.
10 PIC X VALUE SPACES.
10 W03-SUBJ-NAME PIC X(20).
10 PIC XXX VALUE SPACES.
10 W03-A-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-B-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-C-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-D-CTR PIC Z,ZZ9.
10 PIC XXX VALUE SPACES.
10 W03-F-CTR PIC Z,ZZ9.
10 PIC X(59) VALUE SPACES.
01 W04-SYS-DATE.
05 W04-YEAR PIC 9999.
05 W04-MONTH PIC 99.
05 W04-DAY PIC 99.
01 W05-TOTALS.
05 W05-TOTAL-A PIC 99999 VALUE 0.
05 W05-TOTAL-B PIC 99999 VALUE 0.
05 W05-TOTAL-C PIC 99999 VALUE 0.
05 W05-TOTAL-D PIC 99999 VALUE 0.
05 W05-TOTAL-F PIC 99999 VALUE 0.
Here's procedure division
PROCEDURE DIVISION.
PERFORM A100-OPEN-FILES
PERFORM A200-WRITE-HEADINGS
PERFORM A300-PROCESS-SUBJECTS
PERFORM A400-PROCESS-MARKS
PERFORM A500-WRITE-TOTALS
PERFORM A600-CLOSE-FILES
STOP RUN
.
A100-OPEN-FILES.
* OPENS FILES
OPEN INPUT F01-SUBJ-FILE
F02-MARK-FILE
OPEN OUTPUT F03-REPT-FILE
.
A200-WRITE-HEADINGS.
* WRITES HEADERS TO THE REPORT FILE
MOVE W03-HEADER-ROW1 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE FUNCTION CURRENT-DATE (1:8) TO W04-SYS-DATE
MOVE W04-YEAR TO W03-YEAR
MOVE W04-MONTH TO W03-MONTH
MOVE W04-DAY TO W03-DAY
MOVE W03-HEADER-ROW2 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE W03-HEADER-ROW3 TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
.
A300-PROCESS-SUBJECTS.
* MOVES SUBJECT NAMES AND CODES INTO W02-TEST-TABLE
PERFORM A310-READ-RECORD
PERFORM UNTIL W01-SUBJ-EOF = 'Y'
IF W02-SUBJ-COUNT < W02-SUBJ-MAX
ADD 1 TO W02-SUBJ-COUNT
SET W02-IDX TO W02-SUBJ-COUNT
MOVE F01-SUBJ-CODE TO W02-SUBJ-CODE(W02-IDX)
MOVE F01-SUBJ-NAME TO W02-SUBJ-NAME(W02-IDX)
ELSE
DISPLAY "ERROR - SUBJECT FILE EXCEEDS MAX OF "
W02-SUBJ-MAX " RECORDS, RECORD IGNORED"
END-IF
PERFORM A310-READ-RECORD
END-PERFORM
.
A310-READ-RECORD.
* READS FROM THE SUBJECT FILE INTO THE SUBJECT RECORD
READ F01-SUBJ-FILE
AT END MOVE 'Y' TO W01-SUBJ-EOF
END-READ
.
A400-PROCESS-MARKS.
PERFORM A410-READ-RECORD
PERFORM A420-COUNT-MARKS
UNTIL W01-MARK-EOF = 'Y'
.
A410-READ-RECORD.
* READS FROM THE MARK FILE INTO THE MARK RECORD
READ F02-MARK-FILE
AT END MOVE 'Y' TO W01-MARK-EOF
END-READ
.
A420-COUNT-MARKS.
* COUNTS GRADE TOTALS
SET W02-IDX TO 1
SEARCH ALL W02-TEST-ROW
AT END DISPLAY 'INVALID INPUT RECORD: ' F02-MARK-RECORD
WHEN W02-SUBJ-CODE(W02-IDX) = F02-SUBJ-CODE
EVALUATE F02-STUD-MARK
WHEN "80" THRU "100"
ADD 1 TO W05-TOTAL-A
ADD 1 TO W02-A-CTR(W02-IDX)
WHEN "70" THRU "79"
ADD 1 TO W05-TOTAL-B
ADD 1 TO W02-B-CTR(W02-IDX)
WHEN "60" THRU "69"
ADD 1 TO W05-TOTAL-C
ADD 1 TO W02-C-CTR(W02-IDX)
WHEN "50" THRU "59"
ADD 1 TO W05-TOTAL-D
ADD 1 TO W02-D-CTR(W02-IDX)
WHEN OTHER
ADD 1 TO W05-TOTAL-F
ADD 1 TO W02-F-CTR(W02-IDX)
END-EVALUATE
END-SEARCH
.
A500-WRITE-TOTALS.
PERFORM A510-WRITE-SUBJ-GRADE-TOTALS
PERFORM A520-WRITE-GRADE-GRAND-TOTALS
.
A510-WRITE-SUBJ-GRADE-TOTALS.
PERFORM VARYING W02-IDX FROM 1 BY 1
UNTIL W02-IDX > W02-SUBJ-COUNT
MOVE W02-SUBJ-NAME(W02-IDX) TO W03-SUBJ-NAME
MOVE W02-A-CTR(W02-IDX) TO W03-A-CTR
MOVE W02-B-CTR(W02-IDX) TO W03-B-CTR
MOVE W02-C-CTR(W02-IDX) TO W03-C-CTR
MOVE W02-D-CTR(W02-IDX) TO W03-D-CTR
MOVE W02-F-CTR(W02-IDX) TO W03-F-CTR
MOVE W03-DETAIL-ROW TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
END-PERFORM
.
A520-WRITE-GRADE-GRAND-TOTALS.
* WRITES THE GRADE GRAND TOTALS TO THE REPORT FILE
* AFTER INSERTING A BLANK ROW
MOVE SPACES TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
MOVE W05-TOTAL-A TO W03-TOTAL-A
MOVE W05-TOTAL-B TO W03-TOTAL-B
MOVE W05-TOTAL-C TO W03-TOTAL-C
MOVE W05-TOTAL-D TO W03-TOTAL-D
MOVE W05-TOTAL-F TO W03-TOTAL-F
MOVE W03-TOTAL-ROW TO F03-REPT-RECORD
WRITE F03-REPT-RECORD
.
A600-CLOSE-FILES.
* CLOSES THE FILES
CLOSE F01-SUBJ-FILE
F02-MARK-FILE
F03-REPT-FILE
.
I'm glad you figured it out, Tom.
I hope you're not turned off and will explore further. FYI, while ISPF, TSO/E, and other classic user interfaces still work (and some people still like them, and they'll continue to work "forever"), nowadays developers often use and prefer graphical user interfaces. There are some free ones, for example IBM Explorer for z/OS and its Remote System Explorer (RSE):
https://developer.ibm.com/mainframe/products/zosexplorer/
That works just fine on its own on a Mac or PC (Linux or Windows), as you prefer (with the RSE part on z/OS). All free. Or, if you wish, you can add a more "COBOL aware" editor (among several other features) if you add the IBM Z Open Development plug-ins:
https://developer.ibm.com/mainframe/products/ibm-z-open-development/
And that works too, free for 90 days. At the end of the 90 days you can either pay the going price to keep those plug-ins or uninstall them and just use the base/free Explorer for z/OS functions.
Maybe this'd be good feedback to your instructor/professor? Yes, your first experience with any programming language can be (for example) via emacs and a terminal emulator. Yes, you can write Apple Swift code (for example) with emacs, ISPF, or vi. However, these classic user interfaces aren't everybody's favorite firsts. Again, if you like a particular UI, and it works for you, no problem! But from a pedagogical perspective it's probably best to start with something more familiar to the audience.
On edit: As another example, if you happen to prefer Microsoft Visual Studio Code, then you can add IBM Z Open Editor free of charge to that IDE.
I figured out what was wrong with my program by placing a DISPLAY at the start of each function which output what function was running. I saw that it was in an infinite loop in A420-COUNT-MARKS and that I forgot to add a PERFORM A410-READ-RECORD at the end of it.
I wrote this after I read that Cobol supports Report Writer, only to discover afterwards the version of z/OS we have here at school doesn't actually support it.
I'm wondering if there is a way for this to easily be converted to basic Cobol or if there is any kind of compiler i might find and use.
Thanks for any help you can offer.
Having seen the REPORT SECTION; yes, it may be easily converted.
For the conversion, a choice needs to be made between using IBM POSITIONING or standard COBOL ADVANCING in the WRITE statement; and END-OF-PAGE exception or writing your own code for moving to the next page.
I adjusted some spacing and made a few corrections to the original. I generated 120 records for test data, all random numbers.
REPORT SECTION.
RD PRODUCT-REPORT
PAGE LIMIT 59
HEADING 1
FIRST DETAIL 6
LAST DETAIL 59.
01 HEAD1 TYPE PH.
03 LINE 1.
05 COLUMN 1 PIC X(5) VALUE 'DATE:'.
05 COLUMN 8 PIC 9(2) SOURCE WS-CD-MONTH.
05 COLUMN 10 PIC X VALUE '/'.
05 COLUMN 11 PIC 9(2) SOURCE WS-CD-DAY.
05 COLUMN 13 PIC X VALUE '/'.
05 COLUMN 14 PIC 9(2) SOURCE WS-CD-YEAR.
05 COLUMN 33 PIC X(19) VALUE 'MASTER PRODUCT LIST'.
05 COLUMN 72 PIC X(5) VALUE 'PAGE:'.
05 COLUMN 77 PIC ZZ9 SOURCE PAGE-COUNTER.
03 LINE 2.
05 COLUMN 1 PIC X(5) VALUE 'TIME:'.
05 COLUMN 9 PIC 9(2) SOURCE WS-CD-HOURS.
05 COLUMN 11 PIC X VALUE ':'.
05 COLUMN 12 PIC 9(2) SOURCE WS-CD-MINUTES.
05 COLUMN 72 PIC X(8) VALUE 'PRODLIST'.
03 LINE 4.
05 COLUMN 1 PIC X(5) VALUE 'CODE:'.
05 COLUMN 8 PIC X(5) VALUE 'TYPE:'.
05 COLUMN 18 PIC X(12) VALUE 'DESCRIPTION:'.
05 COLUMN 66 PIC X(6) VALUE 'PRICE:'.
03 LINE 5.
05 COLUMN 1 PIC X(80) VALUE ALL '='.
01 PRODLINE TYPE DE.
03 LINE PLUS 1.
05 COLUMN 1 PIC X(5) SOURCE PRODCODE.
05 COLUMN 8 PIC X(8) SOURCE PRODTYPE.
05 COLUMN 18 PIC X(32) SOURCE PRODDESC.
05 COLUMN 66 PIC $ZZZ,ZZZ,ZZ9 SOURCE PRODCOST.
Ran the program and got this partial output.
DATE: 11/08/18 MASTER PRODUCT LIST PAGE: 1
TIME: 15:54 PRODLIST
CODE: TYPE: DESCRIPTION: PRICE:
================================================================================
47638 54784935 48116892 $ 1,461,160
26450 06251370 81421270 $ 7,765,877
The IBM COBOL family does provide Report Writer. All you need is a compiler "plug-in". Look for product 5798-DYR COBOL Report writer Precompiler. It works seamlessly. No need to convert any code. Ask for free on-line user manual.
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 :-)
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.
Hey all, I got one more assignment to complete for the quarter in COBOL and I am out. The thing is I am getting a syntax error at the ACCEPT SCREEN-IMAGE command and this program needs to have user input. I don't see what I am doing wrong so I am stuck. I believe that everything else is put in right so once this is figured out I am done. Here is the code:
SCREEN SECTION.
01 SCREEN-IMAGE.
05 BLANK SCREEN
BACKGROUND-COLOR 0
FOREGROUND-COLOR 15.
05 LINE 02 COLUMN 02 PIC X(8)
FROM CURRENT-TIME.
05 LINE 02 COLUMN 26 PIC X(28)
FROM TITLE-LINE
FOREGROUND-COLOR 09.
05 LINE 02 COLUMN 40 PIC X(8)
FROM DATE-TODAY.
05 LINE 05 COLUMN 02
VALUE 'FUNCTION CODE:'
FOREGROUND-COLOR 09.
05 LINE 05 COLUMN 12 PIC X(3)
FROM CODE-SCREEN AUTO.
05 LINE 05 COLUMN 17
VALUE '<ADD, CHG, DEL, INQ, END>'.
05 LINE 09 COLUMN 17
VALUE 'REP CODE:'
FOREGROUND-COLOR 09.
05 LINE 09 COLUMN 29 PIC X(3)
FROM REP-SCREEN AUTO.
05 LINE 11 COLUMN 17
VALUE 'NAME:'
FOREGROUND-COLOR 09.
05 LINE 11 COLUMN 29 PIC X(3)
FROM NAME-SCREEN AUTO.
05 LINE 13 COLUMN 17
VALUE 'DISTRICT:'
FOREGROUND-COLOR 09.
05 LINE 13 COLUMN 29 PIC X(3)
FROM DIST-SCREEN AUTO.
05 LINE 15 COLUMN 17
VALUE 'COMMISSION RATE:'
FOREGROUND-COLOR 09.
05 LINE 15 COLUMN 29 PIC X(3)
FROM COM-SCREEN AUTO.
05 LINE 17 COLUMN 17
VALUE 'DATE ADDED:'
FOREGROUND-COLOR 09.
05 LINE 17 COLUMN 29 PIC X(10)
FROM ADD-DATE.
05 LINE 19 COLUMN 17
VALUE 'DATE CHANGED:'
FOREGROUND-COLOR 09.
05 LINE 19 COLUMN 29 PIC X(3)
FROM CHANGE-DATE.
05 LINE 24 COLUMN 17 PIC X(29)
FROM ERROR-DISPLAY.
PROCEDURE DIVISION.
100-MAIN.
OPEN I-O REP-MASTER-FILE
CALL 'DATETIME' USING DATE-TIME-PASS-AREA
MOVE DATE-MMDDYY-SLASHES TO DATE-TODAY
MOVE TIME-HHMMSSXX-COLONS TO CURRENT-TIME
PERFORM UNTIL CODE-SCREEN = 'END' OR 'end'
DISPLAY SCREEN-IMAGE
ACCEPT SCREEN-IMAGE
MOVE 0 TO ERROR-COUNT
PERFORM 150-CHECK-COM
PERFORM 140-CHECK-DIST
PERFORM 130-CHECK-NAME
PERFORM 120-CHECK-REP
PERFORM 110-CHECK-CODE
IF ERROR-COUNT = 0
PERFORM 200-PROCESS-ONE-RECORD
END-IF
END-PERFORM
CLOSE REP-MASTER-FILE
STOP RUN.
Any and all help will be appreciated.
#Gabe Contrary to what many people believe, a period (full stop) is not the only way to end a statement in COBOL.
Move A To B
Move C To D
is logically equivalent to
Move A To B.
Move C To D.
Where it gets squirrelly is
If A = B
Move C To D
Add 1 To E.
If I put a period after the D, 1 will be added to E unconditionally. The COBOL 85 standard added explicit scope terminators to many statements, so we got the more easily visually parsed construct
If A = B
Move C To D
Add 1 To E
End-If
Now if I put a period after the D I will get a compile error. Most COBOL programmers I know now use explicit scope terminators and only end paragraph names and paragraphs with a period, otherwise banishing them from the Procedure Division.
Maybe you need a few input and/or update fields on your screen in order to ACCEPT it? I think input fields have a TO phrase in their descriptions and update fields have a USING phrase. The only thing I see in your screen description are literals and FROM phrases. Basically, nothing to ACCEPT!