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.
Related
Another COBOL question again. I have to create a COBOL program that will read three record fields namely, a Student Number, a Student Name, and the Gender Key from an input file. Then, I have to separate male and female students into two separate files. I have created an input function and then store it into a DAT file and that DAT file will be read and returns another DAT file that contains the Male / Female students. I haven't check if the program would actually work because I have been encountering this error:
exercise1.cob:69: error: group item 'STUD-NAME-OUT' cannot have PICTURE clause
Line 69 in this problem is 02 STUD-NAME-OUT PIC X(25). in this group item:
01 OUT-PRINT-REC.
02 FILLER PIC X(19) VALUE SPACES.
02 STUD-NO-OUT PIC X(10).
02 FILLER PIC X(23) VALUE SPACES.
02 STUD-NAME-OUT PIC X(25).
I've checked other Stack Overflow which is this and checking by the user's problem in that question and to this question, apparently, I think I did it right but I wasn't sure why this particular OUT-PRINT-REC group item is not working.
And here's the main code :
IDENTIFICATION DIVISION.
PROGRAM-ID. exercise-one.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "BSIT21.DAT".
SELECT STUDENT-DATA ASSIGN TO "BSIT21.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT BSITMALE ASSIGN TO "BSITMALE.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
* SELECT BSITFEM ASSIGN TO "BSITFEM.DAT"
* ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD STUDENT-IN.
01 PRINT-REC PIC X(80).
FD STUDENT-DATA.
01 STUD-REC.
02 OUT-STUD-NO PIC X(10).
02 OUT-STUD-NAME PIC X(25).
02 OUT-STUD-GEND-IN-KEY PIC 9.
FD BSITMALE.
01 PRINT-MALE-REC PIC X(80).
* FD BSITFEM.
* 01 PRINT-FEMALE-REC PIC X(80).
WORKING-STORAGE SECTION.
* -----------------------------
01 PRINT-LINE.
02 STUD-NO-IN PIC X(10).
02 STUD-NAME-IN PIC X(25).
02 STUD-GEND-IN PIC 9.
01 ANS PIC X VALUE 'Y'.
88 NO-MORE-DATA VALUE 'N'.
88 MORE-DATA VALUE 'Y'.
01 L PIC 9.
01 STUD-NO PIC X(10).
01 STUD-NAME PIC X(25).
01 STUD-GEND-KEY PIC 9.
* -----------------------------
01 HDG-1.
02 FILLER PIC X(20) VALUE SPACES.
02 FILLER PIC X(22) VALUE "xxxxxxxxxxx University".
02 FILLER PIC X(19) VALUE " of the xxxxxxxxxxx".
01 HDG-2.
02 FILLER PIC X(32) VALUE SPACES.
02 FILLER PIC X(18) VALUE "xxxxxx xxxx xxxxx".
01 HDG-MALE.
02 FILLER PIC X(23) VALUE SPACES.
02 FILLER PIC X(21) VALUE "List of Male Students".
02 FILLER PIC X(14) VALUE " from xxx 4-1".
01 HDG-FEMALE.
02 FILLER PIC X(23) VALUE SPACES.
02 FILLER PIC X(23) VALUE "List of Female Students".
02 FILLER PIC X(14) VALUE " from xxxx 2-1".
01 HDG-4.
02 FILLER PIC X(19) VALUE SPACES.
02 FILLER PIC X(14) VALUE "STUDENT NUMBER".
02 FILLER PIC X(18) VALUE SPACES.
02 FILLER PIC X(12) VALUE "STUDENT NAME".
01 OUT-PRINT-REC.
02 FILLER PIC X(19) VALUE SPACES.
02 STUD-NO-OUT PIC X(10).
02 FILLER PIC X(23) VALUE SPACES.
02 STUD-NAME-OUT PIC X(25).
05 E-O-F PIC XXX VALUE "NO".
SCREEN SECTION.
01 BSCRN.
02 BLANK SCREEN.
* --------------------------------------
PROCEDURE DIVISION.
OPEN OUTPUT STUDENT-IN.
PERFORM INPUT-RTN UNTIL MORE-DATA.
PERFORM PRINT-MALE-RTN.
PERFORM CLOSE-RTN.
* --------------------------------------------
INPUT-RTN.
DISPLAY BSCRN.
MOVE 5 TO L.
DISPLAY "ENTER STUDENT NUMBER: " LINE L COLUMN 5.
ACCEPT STUD-NO LINE L COLUMN 35.
ADD 1 TO L.
DISPLAY "ENTER STUDENT NAME: " LINE L COLUMN 5.
ACCEPT STUD-NAME LINE L COLUMN 35.
ADD 1 TO L.
DISPLAY "MALE = 1 / FEMALE = 2" LINE L COLUMN 5.
ADD 1 TO L.
DISPLAY "ENTER STUDENT GENDER KEY: " LINE L COLUMN 5.
ACCEPT STUD-GEND-KEY LINE L COLUMN 35.
ADD 2 TO L.
MOVE STUD-NO TO STUD-NO-IN.
MOVE STUD-NAME TO STUD-NAME-IN.
MOVE STUD-GEND-KEY TO STUD-GEND-IN.
WRITE PRINT-REC FROM PRINT-LINE BEFORE 1 LINE.
DISPLAY "ENTER ANOTHER RECORD(Y/N)" LINE L COLUMN 30.
ACCEPT ANS.
* --------------------------------------------
PRINT-MALE-RTN.
WRITE PRINT-MALE-REC FROM HDG-1 BEFORE 1 LINE.
WRITE PRINT-MALE-REC FROM HDG-2 AFTER 1 LINE.
WRITE PRINT-MALE-REC FROM HDG-MALE AFTER 2 LINES.
WRITE PRINT-MALE-REC FROM HDG-4 AFTER 2 LINES.
MOVE SPACES TO PRINT-MALE-REC.
WRITE PRINT-MALE-REC AFTER 1 LINE.
PERFORM MALE-READ-RTN UNTIL E-O-F = "YES".
MALE-READ-RTN.
READ STUDENT-DATA AT END MOVE "YES" TO E-O-F.
IF OUT-STUD-GEND-IN-KEY = 1
MOVE OUT-STUD-NO TO STUD-NO-OUT.
MOVE OUT-STUD-NAME TO STUD-NAME-OUT.
WRITE PRINT-MALE-REC FROM OUT-PRINT-REC AFTER 1 LINE.
* --------------------------------------------
CLOSE-RTN.
CLOSE STUDENT-IN.
STOP RUN.
Expected Output:
xxxxxxxxxxx UNIVERSITY OF THE xxxxxxxxxxx
xxxxxx xxxx xxxxxx
List of Male Students from xxxx 4-1
STUDENT NUMBER STUDENT NAME
00-123345 Leon Paulus
00-123456 John Walker
I haven't also done writing the code since I wanna test if it would spew the correct answer when I input data but I guess this error keeps blocking me from doing the next step.
Also, it seems a little confusing with the way I named all my variables but I'll deal with that issue later on, and sorry for that.
From the comment by Rick Smith,
05 E-O-F PIC XXX VALUE "NO".
should have been:
01 E-O-F PIC XXX VALUE "NO".
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 :-)
I am a newbie of COBOL, I am facing the following problem.
I have a input file with content:
2 3 2 4
4 numbers are in the same row and separated with exactly one space.
the 4 numbers can be in 1 digit, 2 digit and 3 digit
Can I put those 4 numbers to 4 variables with PIC?
such as: PIC XXX XXX XXX XXX (This is not working.)
currently I am using substring to achieve the task, but this is not efficient and messy, is there any other way i can finish the task easily?
Thanks
You can do this by two ways. Number one is to use unstring sentence. Or you can declare a variable level 01 and define in it every variable of the string separately.
For example:
01 WS-FILE.
05 WS-FIELD-01 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-02 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-03 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-04 PIC 9.
05 FILLER PIC X.
And when you read the file use:
READ FILE INTO WS-FILE.
You can use an UNSTRING function (i dont know if you refer to that with substring)
UNSTRING WS-FILE-RECORD DELIMITED BY SPACE
INTO WS-FIELD1
WS-FIELD2
WS-FIELD3
WS-FIELD4
END-UNSTRING
with this if you have:
WS-FILE-RECORD="1 2 3 4"
WS-FIELD1 = "1"
WS-FIELD2 = "2"
WS-FIELD3 = "3"
WS-FIELD4 = "4"
or if you have:
WS-FILE-RECORD="1 22 333 4444"
WS-FIELD1 = "1"
WS-FIELD2 = "22"
WS-FIELD3 = "333"
WS-FIELD4 = "4444"
01 YOUR-NUMBERS.
03 YOUR-NUMBER PIC 9(04) OCCURS 4.
01 INDEX-YOUR-NUMBERS PIC 9(01).
01 YOUR-RECORD.
03 YOUR-RECORD-4.
05 YOUR-RECORD-4-NUM PIC X(04).
05 FILLER PIC X(01).
05 YOUR-RECORD-4-REST.
07 FILLER PIC X(09).
07 YOUR-RECORD-4-END PIC X(05).
03 YOUR-RECORD-3 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-3-NUM PIC X(03).
05 FILLER PIC X(01).
05 YOUR-RECORD-3-REST.
07 FILLER PIC X(11).
07 YOUR-RECORD-3-END PIC X(04).
03 YOUR-RECORD-2 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-2-NUM PIC X(02).
05 FILLER PIC X(01).
05 YOUR-RECORD-2-REST.
07 FILLER PIC X(13).
07 YOUR-RECORD-2-END PIC X(03).
03 YOUR-RECORD-1 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-1-NUM PIC X(01).
05 FILLER PIC X(01).
05 YOUR-RECORD-1-REST.
07 FILLER PIC X(15).
07 YOUR-RECORD-1-END PIC X(02).
MOVE SPACES TO YOUR-RECORD.
READ YOUR-RECORD.
PERFORM 0100-FIND-NUMBERS
VARYING INDEX-YOUR-NUMBERS
FROM 1
TO 4.
0100-FIND-NUMBERS.
IF YOUR-RECORD-4-NUM IS NUMERIC
MOVE YOUR-RECORD-4-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-4-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-4-END
ELSE
IF YOUR-RECORD-3-NUM IS NUMERIC
MOVE YOUR-RECORD-3-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-3-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-3-END
ELSE
IF YOUR-RECORD-2-NUM IS NUMERIC
MOVE YOUR-RECORD-2-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-2-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-2-END
ELSE
MOVE YOUR-RECORD-1-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-1-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-1-END.
Here's a way to do it. Maybe not a good way. Maybe not an efficient way. Maybe not an easy way. But certainly a way that doesn't involve string/unstring - using PIC only. ish.
You could create a little state machine that ran through and calculated every number as it goes. There are many advantages to approaching things on a character by character basis for parsing. The code is usually very simple, especially with a simple regex like number or whitespace.
Identification Division.
Program-ID. PARSENUM.
Data Division.
Working-Storage Section.
01 II comp-5 pic s9(8) value 0.
01 Num-Val comp-5 pic s9(8) value 0.
01 In-Str pic x(80).
01 In-Ch pic 9.
01 pic x(1).
88 In-Number value 'N'.
88 In-Whitespace value 'W'.
Procedure Division.
*> Fake up some data...
Move '1 212 303 44 5678 6 75 888 976' to In-Str
*> Parse Numbers
Set In-Whitespace to true
Perform varying II from 1 by 1
until II > Length of In-Str
If In-Str (II:1) is numeric
Move In-Str (II:1) to In-Ch
Evaluate true
when In-Whitespace
Compute Num-Val = In-Ch
Set In-Number to true
when In-Number
Compute Num-Val = (Num-Val * 10) + In-Ch
End-Evaluate
Else
If In-Number
Display 'Found Number: ' Num-Val
Set In-Whitespace to true
End-If
End-If
End-Perform
Goback.
You should get output that looks like:
Found Number: +0000000001
Found Number: +0000000212
Found Number: +0000000303
Found Number: +0000000044
Found Number: +0000005678
Found Number: +0000000006
Found Number: +0000000075
Found Number: +0000000888
Found Number: +0000000976
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
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!