How does COBOL actually accept numeric values? - cobol

I have a very simple COBOL code here that has a given input data and output data. The problem is that, it shows an error on line 60 which is the MOVE STUD-AGE TO AGE-OUT. and everytime I run OpenCOBOLIDE, I always get and error which is:
libcob: test.cob: 60: 'STUD-AGE' not numeric: ' '
WARNING - Implicit CLOSE of STUDENT-OUT ('C:\STUD-OUT.DAT')
WARNING - Implicit CLOSE of STUDENT-IN ('C:\STUD-IN.DAT')
And I don't know exactly what's wrong with it. Here is supposedly the input file I created:
----5---10---15---20---25---30---35---40--
00-123345 ALISON MARTIN WOLF 1912056
00-789012 KEN DENNIOS ROME 1914156
00-345678 JACK ADRIAN TOCKSIN 1622234
00-901234 EJHAYZ ALONEY 2045645
00-567890 CHARLES JOHN GUINNIVER 1813243
00-123457 JEAN MICHAEL YARTER 2034253
Here's the code to it:
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT".
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT".
DATA DIVISION.
FILE SECTION.
FD STUDENT-IN.
01 STUD-REC.
02 STUD-NO PIC X(10).
02 STUD-NAME PIC X(25).
02 STUD-AGE PIC 99.
02 STUD-ALLOWANCE PIC 999V99.
FD STUDENT-OUT.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 HDG-1.
02 FILLER PIC X(20) VALUE SPACES.
02 FILLER PIC X(22) VALUE "WILLOW PARK UNIVERSITY".
02 FILLER PIC X(14) VALUE " OF MADAGASCAR".
01 HDG-2.
02 FILLER PIC X(9) VALUE SPACES.
02 FILLER PIC X(14) VALUE "STUDENT NUMBER".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(12) VALUE "STUDENT NAME".
02 FILLER PIC X(15) VALUE SPACES.
02 FILLER PIC X(3) VALUE "AGE".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(9) VALUE "ALLOWANCE".
01 PRINT-LINE.
02 FILLER PIC X(9) VALUE SPACES.
02 SNO-OUT PIC X(10).
02 FILLER PIC X(12) VALUE SPACES.
02 SNAME-OUT PIC X(25).
02 FILLER PIC X(2) VALUE SPACE.
02 AGE-OUT PIC Z9.
02 FILLER PIC X(9) VALUE SPACES.
02 ALL-OUT PIC ZZZ.99.
01 E-O-F PIC XXX VALUE "NO".
PROCEDURE DIVISION.
OPEN INPUT STUDENT-IN
OUTPUT STUDENT-OUT.
WRITE PRINT-REC FROM HDG-1 BEFORE 1 LINE.
WRITE PRINT-REC FROM HDG-2 AFTER 2 LINES.
MOVE SPACES TO PRINT-REC.
WRITE PRINT-REC AFTER 1 LINE.
PERFORM READ-RTN UNTIL E-O-F = "YES".
PERFORM CLOSE-RTN.
READ-RTN.
READ STUDENT-IN AT END MOVE "YES" TO E-O-F.
MOVE STUD-NO TO SNO-OUT.
MOVE STUD-NAME TO SNAME-OUT.
MOVE STUD-AGE TO AGE-OUT.
MOVE STUD-ALLOWANCE TO ALL-OUT.
WRITE PRINT-REC FROM PRINT-LINE AFTER 1 LINE.
CLOSE-RTN.
CLOSE STUDENT-IN, STUDENT-OUT.
STOP RUN.
What I want to achieve is just to output the file correctly but the error only inputs the HDG-1 and then the rest blank.

To answer your question: COBOL accept numeric data however you define it.
So for "text data" (as long as it isn't UTF-16 or another multibyte encoded file) PIC 99 (which says "two digits in the default USAGE DISPLAY - so one byte per digit) is perfectly fine.
As with every other language: "never trust input data" is something I can recommend. For example: someone could run this program with a file that was saved with an UTF-8 encoded character in the name and then it "looks" right but the code has an unexpected shift in its data. For COBOL things like FUNCTION TEST-NUMVAL(inp) [ignores spaces and allows decimal-point] or IS NUMERIC (strict class test) can be useful.
Using data-check you could for example also skip empty lines or leading/trailing extra data (temporary rulers, headline, summary, ...).
For the actual problem:
It looks like you feed the program with a "common" text file, but you actually did not specify this so your COBOL implementation uses the default SEQUENTIAL. Because of the missing check of the input data you did not spot this directly.
To align expectations and code:
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.

Related

Best way to create a key-value "dict" in COBOL

I'm pretty new to Cobol, and got stuck trying to create something like a python dictionary, where we pass a key and the dictionary returns its value.
Python example:
>>> dict
{'AC': 'Acre', 'AL': 'Alagoas', 'AP': 'Amapa'}
>>> dict['AC']
'Acre'
I'm trying to do this in cobol, using redefines to create two arrays (one for the keys, other for the values).
I already created the arrays, but got stucked to associate these two arrays in a key-value function, once I can only access an array with integer values.
Here goes my data division, if someone can help with code samples.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WRK-KEYS.
02 FILLER PIC X(2) VALUE "AC".
02 FILLER PIC X(2) VALUE "AL".
02 FILLER PIC X(2) VALUE "AP".
01 WRK-TABLE-KEYS REDEFINES WRK-KEYS.
02 WRK-KEY PIC X(2) OCCURS 3 TIMES.
01 WRK-VALUES.
02 FILLER PIC X(19) VALUE "Acre".
02 FILLER PIC X(19) VALUE "Alagoas".
02 FILLER PIC X(19) VALUE "Amapa".
01 WRK-TABLE-VALUES REDEFINES WRK-VALUES.
02 WRK-VALUE PIC X(10) OCCURS 3 TIMES.
You can use a table, as shown in the example below:
IDENTIFICATION DIVISION.
PROGRAM-ID. STATES.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 STATES-TABLE.
05 FILLER PIC X(2) VALUE "AC".
05 FILLER PIC X(7) VALUE "Acre ".
05 FILLER PIC X(2) VALUE "AL".
05 FILLER PIC X(7) VALUE "Alagoas".
05 FILLER PIC X(2) VALUE "AP".
05 FILLER PIC X(7) VALUE "Amapá ".
01 RDF-STATES-TABLE REDEFINES STATES-TABLE.
05 STATE-GROUP OCCURS 3 TIMES.
10 STATE-CODE PIC X(2).
10 STATE-NAME PIC X(7).
PROCEDURE DIVISION.
DISPLAY "STATES : "STATES-TABLE.
DISPLAY 'STATE-CODE(1) : ' STATE-CODE(1).
DISPLAY 'STATE-NAME(1) : ' STATE-NAME(1).
DISPLAY 'STATE-CODE(2) : ' STATE-CODE(2).
DISPLAY 'STATE-NAME(2) : ' STATE-NAME(2).
DISPLAY 'STATE-CODE(3) : ' STATE-CODE(3).
DISPLAY 'STATE-NAME(3) : ' STATE-NAME(3).
STOP RUN.
Resulting in:
$ ./states
STATES : ACAcre ALAlagoasAPAmapá
STATE-CODE(1) : AC
STATE-NAME(1) : Acre
STATE-CODE(2) : AL
STATE-NAME(2) : Alagoas
STATE-CODE(3) : AP
STATE-NAME(3) : Amapá
Remember that á uses two bytes in UTF-8.

COBOL error: group item cannot have PICTURE clause

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".

COBOL COMPUTE decimal values from a file

Trying to understand compute. Would it be correct to calculate the sum of the earned credits using FSemesterTotal which is a PIC 99V99 like this? COMPUTE FSemesterTotal = Earned + Earned. I think there is supposed to be a counter in my loop to check if i read in the first earned value so i can add it to the second value coming in not sure how to accomplish this in COBOL.
Currently my input is like this,
CMPS161 ALGORITHM DSGN/IMPLMNT I A 3.00
ENGL322 INTRO TO PROF/TECH WRITING A 3.00
MATH241 ELEM STATISTICS B 3.00
ART 106 SURV WORLD ART HIST II A 3.00
BIOL152 GENERAL BIOL LAB I B 1.00
CMPS257 DISCRETE STRUCTURE A 3.00
CMPS28O ALGORITHM DSGN/IMPLEM II B 3.00
CMPS290 COMPUTER ORGANIZATION A 3.00
CMPS390 DATA STRUCTURES B 3.00
GBIO153 GENERAL BIOL II B 3.00
CMPS294 INTERNET PROGRAMMING B 3.00
CMPS315 SYSTEM ADMINISTRATION A 3.00
CMPS329 COMPUTER NETWORKING SECURITY A 3.00
CMPS383 INFORMATION SYSTEMS A 3.00
CMPS415 INTERGRATED TECH SYSTEMS B 3.00
COBOL CODE
IDENTIFICATION DIVISION.
PROGRAM-ID. P2.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT myInFile ASSIGN TO "P2In.dat".
SELECT myOutFile ASSIGN TO "P2Out.dat".
DATA DIVISION.
FILE SECTION.
FD myInFile.
01 inRecord.
02 Course PIC X(13).
02 Title PIC X(32).
02 Grade PIC X(4).
02 Earned PIC 9V99.
02 FILLER PIC X(3).
FD myOutFile.
01 outRecord.
02 myCourse PIC X(13).
02 myTitle PIC X(32).
02 myGrade PIC X(4).
02 myEarned PIC 9.99.
02 FILLER PIC X(3).
WORKING-STORAGE SECTION.
01 E0F PIC X(3) VALUE "NO ".
01 NAME-HDR.
05 FILLER PIC X(10) VALUE "NAME HERE ".
01 SCHOOLID-HDR.
05 FILLER PIC X(8) VALUE "SCHOOLID"
01 COLUMN-HDR.
05 CCourse PIC X(6) VALUE "COURSE".
05 CSpace PIC X(7) VALUE SPACES.
05 HTitle PIC X(5) VALUE "TITLE".
05 HSpace PIC X(27) VALUE SPACES.
05 CGrade PIC XX VALUE "GR".
05 CSpace PIC XXX VALUE SPACES.
05 CEarned PIC X(6) VALUE "EARNED".
05 QSpace PIC X(4) VALUE SPACES.
05 Qpts PIC X(4) VALUE "Qpts".
01 FOOTER-SMS.
05 FSemester PIC X(28) VALUE " SEMESTER".
05 FSpaces PIC x(21) VALUE SPACES.
05 FSemesterTotal PIC 99V99.
01 FOOTER-CUMUL.
05 FCumulative PIC X(30) VALUE" CUMULATIVE".
05 FSpaces PIC X(19) VALUE SPACES.
05 FCumulTotal PIC 99V99.
01 QPTS-VAL.
05 QSpace PIC X(5) VALUE SPACES.
05 QPtsValue PIC 99V99.
01 GPA.
05 GSpace PIC XX VALUE SPACES.
05 GpaScore PIC 9.99.
PROCEDURE DIVISION.
MAIN-PROGRAM.
PERFORM HEADER.
PERFORM FILE-IO.
PERFORM CLOSING.
STOP RUN.
HEADER.
OPEN INPUT myInFile
OUTPUT myOutFile.
WRITE outRecord FROM NAME-HDR.
WRITE outRecord FROM SCHOOLID-HDR
AFTER ADVANCING 1 LINE.
WRITE outRecord FROM COLUMN-HDR
AFTER ADVANCING 2 LINES.
MOVE SPACES TO outRecord.
WRITE outRecord
AFTER ADVANCING 1 LINE.
FILE-IO.
READ myInFile
AT END
MOVE "YES" TO EOF.
DISPLAY NAME-HDR.
DISPLAY SCHOOLID-HDR.
DISPLAY SPACES.
DISPLAY SPACES.
DISPLAY "FALL 2014"
DISPLAY COLUMN-HDR.
PERFORM PROCESS-RECORD
UNTIL EOF = "YES".
PROCESS-RECORD.
MOVE Course to myCourse.
MOVE Title to myTitle.
MOVE Grade to myGrade.
MOVE Earned to myEarned.
WRITE outRecord
AFTER ADVANCING 1 LINE.
READ myInFile
AT END
MOVE "YES" TO EOF.
NOT AT END
IF myCourse = "ART 106 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "SPRING 2015"
END-IF.
IF myCourse = "CMPS285 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "FALL 2015"
END-IF.
IF myCourse = "CMPS294 " THEN
DISPLAY FOOTER-SMS, QPTS-VAL, GPA
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA
DISPLAY SPACES.
DISPLAY "SPRING 2016"
END-IF.
CLOSING.
DISPLAY FOOTER-SMS, QPTS-VAL, GPA.
DISPLAY FOOTER-CUMUL, QPTS-VAL, GPA.
CLOSE myInFile
myOutFile.
The question was: "Can I use COMPUTE this way?"
The answer is:
Yes, but you likely want to add a ON SIZE ERROR to cater for a possible size overflow, just in case your input data has too many entries.
If the question behind the question is: "Will the program work?"
The answer is no:
Despite the issues Brian already pointed out: you'll need a de-editing to change the data from 9.99 (4 bytes, not usable for arithmetic) to 9v99 (3 bytes, usable for arithmetic.
And if you don't use an ISAM file which is validated by the runtime: Always validate file input (the file may be broken and you likely don't want to abend or produce wrong results).

Cobol, Finding a Percentage

I'm working on an assignment for my class, and I'm having an issue with getting a percentage to show the proper value for my COBOL Lab.
My issue is with PERCENT-DISCOUNT / WS-PERCENT-WITH-DISCOUNT (at least, I believe it is).
When the program is run, I get the result 50.0. The result I should be getting (assuming I did the math correctly by hand) is 55.6. I'm not too sure where I'm going wrong.
Here is the code that I currently have written for the program.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. LAB2.
AUTHOR. XXXXXXX XXXXXXXXXXX.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IPT-FILE ASSIGN TO 'LAB2.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRT-FILE ASSIGN TO 'LAB2_OUTPUT.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
FD IPT-FILE
RECORD CONTAINS 80 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS INPUT-RECORD.
01 IPT-RECORD.
05 IPT-INV-NUMBER PIC 9(04).
05 IPT-INV-QUANTITY PIC 9(03).
05 IPT-INV-DESCRIPTION PIC X(13).
05 IPT-INV-UNITPRICE PIC 9999V99.
05 IPT-INV-PROD-CLASS PIC 9(01).
*
FD PRT-FILE
RECORD CONTAINS 132 CHARACTERS
RECORDING MODE IS F
DATA RECORD IS PRT-LINE.
01 PRT-LINE.
05 FILLER PIC X(04).
05 PRT-INV-NUMBER PIC 9(04).
05 FILLER PIC X(02).
05 PRT-EXTENDED-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(04).
05 PRT-DISCOUNT-AMOUNT PIC ZZZ,ZZ9.99.
05 FILLER PIC X(03).
05 PRT-NET-PRICE PIC Z,ZZZ,ZZ9.99.
05 FILLER PIC X(10).
05 PRT-PRODUCT-CLASS PIC 9.
05 FILLER PIC X(07).
05 PRT-TRANS-PERCENT PIC Z9.9.
05 FILLER PIC X(05).
05 PRT-TRANS-CHARGE PIC ZZZ,ZZ9.99.
*
WORKING-STORAGE SECTION.
*
01 EOF-SWITCH PIC X VALUE 'N'.
*
01 WS-EXTENDED-COST PIC 9(07)V99.
01 WS-DISCOUNT-AMOUNT PIC 9(06)V99.
01 WS-NET-COST PIC 9(07)V99.
01 WS-TRANS-PERCENT PIC ZZ9V9.
01 WS-TRANS-COST PIC 9(06)V99.
*
01 WS-TOTAL-EXTENDED-COST PIC 9(09)V99 VALUE ZERO.
01 WS-TOTAL-NET-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-TRANS-COST PIC 9(08)V99 VALUE ZERO.
01 WS-TOTAL-WITH-DISCOUNT PIC 99V9 VALUE ZERO.
01 WS-TOTAL-ITEMS PIC 99V9 VALUE ZERO.
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
01 WS-TOTAL-NO-DISCOUNT PIC 99V9 VALUE ZERO.
*
01 HEADING-NAME.
05 MY-NAME PIC X(20) VALUE
'XXXXX XXXXXXX, LAB 2'.
01 HEADING-COLUMN-1.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-1-INV-NUM PIC X(03) VALUE 'INV'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-EXT-PRC PIC X(08) VALUE 'EXTENDED'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-DISC-AMT PIC X(08) VALUE 'DISCOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-NET-PRC PIC X(09) VALUE 'NET PRICE'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-CLASS PIC X(05) VALUE 'CLASS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-P PIC X(05) VALUE 'TRANS'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-1-TRANS-C PIC X(14) VALUE 'TRANSPORTATION'.
01 HEADING-COLUMN-2.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-INV-NUM PIC X(03) VALUE 'NUM'.
05 FILLER PIC X(09) VALUE SPACES.
05 COLUMN-2-EXT-PRC PIC X(08) VALUE 'PRICE'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-DISC-AMT PIC X(08) VALUE 'AMOUNT'.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-NET-PRC PIC X(09) VALUE SPACES.
05 FILLER PIC X(06) VALUE SPACES.
05 COLUMN-2-CLASS PIC X(05) VALUE SPACES.
05 FILLER PIC X(08) VALUE SPACES.
05 COLUMN-2-TRANS-P PIC X(05) VALUE '%'.
05 FILLER PIC X(05) VALUE SPACES.
05 COLUMN-2-TRANS-C PIC X(14) VALUE 'CHARGE'.
01 BLANK-LINE.
05 BLANK-SPACE PIC X VALUE SPACES.
01 TOTAL-FOOTER.
05 FILLER PIC X(07) VALUE SPACES.
05 TOTAL-EXTENDED-COST PIC $$$$,$$$,$$9.99.
05 FILLER PIC X(15) VALUE SPACES.
05 TOTAL-NET-COST PIC $$$,$$$,$$9.99.
05 FILLER PIC X(23) VALUE SPACES.
05 TOTAL-TRANS-COST PIC $$$,$$$,$$9.99.
01 TOTAL-NO-DISCOUNT-FOOTER.
05 TOTAL-SENTENCE PIC X(31) VALUE
'TOTAL ITEMS WITHOUT DISCOUNT = '.
05 TOTAL-NO-DISCOUNT PIC Z9.
01 PERCENT-DISCOUNT-FOOTER.
05 PERCENT-SENTENCE PIC X(44) VALUE
'PERCENT OF ITEMS THAT RECEIVED A DISCOUNT = '.
05 PERCENT-DISCOUNT PIC Z9.9.
*
PROCEDURE DIVISION.
*
OPEN INPUT IPT-FILE.
OPEN OUTPUT PRT-FILE.
*
WRITE PRT-LINE FROM HEADING-NAME AFTER ADVANCING 0 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-1 AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM HEADING-COLUMN-2 AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
*
PERFORM MAIN-LOOP UNTIL EOF-SWITCH EQUALS 'Y'.
*
DIVIDE WS-TOTAL-WITH-DISCOUNT BY WS-TOTAL-ITEMS
GIVING WS-PERCENT-WITH-DISCOUNT.
MULTIPLY WS-PERCENT-WITH-DISCOUNT BY 100
GIVING WS-PERCENT-WITH-DISCOUNT.
*
MOVE WS-TOTAL-EXTENDED-COST TO TOTAL-EXTENDED-COST.
MOVE WS-TOTAL-NET-COST TO TOTAL-NET-COST.
MOVE WS-TOTAL-TRANS-COST TO TOTAL-TRANS-COST.
MOVE WS-TOTAL-NO-DISCOUNT TO TOTAL-NO-DISCOUNT.
MOVE WS-PERCENT-WITH-DISCOUNT TO PERCENT-DISCOUNT.
*
WRITE PRT-LINE FROM TOTAL-FOOTER AFTER ADVANCING 3 LINES.
WRITE PRT-LINE FROM TOTAL-NO-DISCOUNT-FOOTER AFTER
ADVANCING 3 LINES.
WRITE PRT-LINE FROM BLANK-LINE AFTER ADVANCING 1 LINES.
WRITE PRT-LINE FROM PERCENT-DISCOUNT-FOOTER AFTER ADVANCING
1 LINES.
*
CLOSE IPT-FILE, PRT-FILE.
STOP RUN.
*
MAIN-LOOP.
MOVE SPACES TO PRT-LINE.
*
MULTIPLY IPT-INV-QUANTITY BY IPT-INV-UNITPRICE
GIVING WS-EXTENDED-COST ROUNDED.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
*
ADD 1 TO WS-TOTAL-ITEMS
*
IF WS-EXTENDED-COST IS GREATER THAN 200 THEN
MULTIPLY WS-EXTENDED-COST BY 0.11 GIVING
WS-DISCOUNT-AMOUNT ROUNDED
ADD 1 TO WS-TOTAL-WITH-DISCOUNT
*
ELSE
MOVE ZERO TO WS-DISCOUNT-AMOUNT
ADD 1 TO WS-TOTAL-NO-DISCOUNT
END-IF.
*
IF IPT-INV-PROD-CLASS IS EQUAL TO 1 THEN
MOVE 27.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.27 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-PROD-CLASS IS EQUAL TO 2 THEN
MOVE 17.0 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.17 GIVING
WS-TRANS-COST ROUNDED
*
ELSE IF IPT-INV-QUANTITY IS GREATER THAN 100 THEN
MOVE 13.5 TO WS-TRANS-PERCENT
MULTIPLY WS-EXTENDED-COST BY 0.135 GIVING
WS-TRANS-COST ROUNDED
*
ELSE
MOVE ZERO TO WS-TRANS-PERCENT
MOVE 25.00 TO WS-TRANS-COST
END-IF.
*
SUBTRACT WS-EXTENDED-COST FROM WS-DISCOUNT-AMOUNT
GIVING WS-NET-COST.
ADD WS-EXTENDED-COST TO WS-TOTAL-EXTENDED-COST.
ADD WS-NET-COST TO WS-TOTAL-NET-COST.
ADD WS-TRANS-COST TO WS-TOTAL-TRANS-COST.
*
MOVE IPT-INV-NUMBER TO PRT-INV-NUMBER.
MOVE WS-EXTENDED-COST TO PRT-EXTENDED-PRICE.
MOVE WS-DISCOUNT-AMOUNT TO PRT-DISCOUNT-AMOUNT.
MOVE WS-NET-COST TO PRT-NET-PRICE.
MOVE IPT-INV-PROD-CLASS TO PRT-PRODUCT-CLASS.
MOVE WS-TRANS-PERCENT TO PRT-TRANS-PERCENT.
MOVE WS-TRANS-COST TO PRT-TRANS-CHARGE.
*
WRITE PRT-LINE AFTER ADVANCING 1 LINES.
*
READ IPT-FILE AT END MOVE 'Y' TO EOF-SWITCH.
Here is the information that the .dat file holds.
2047105TYPEWRITER 0800002
1742010HANDLE 0010001
2149150USB DRIVE 1200003
3761005TAPE 5000004
2791010BOLTS 0000751
3000100STAPLER 0002007
3001101OVERHEAD PROJ0099997
3002099PENCILS 0000097
4001184CANADIAN RUGS0150294
4003050CARPET 0040000
4005001WASTE BASKETS0003793
5001010HINGES 0010001
5003010PENS (GOLD) 0049992
5004400PENS (BLACK) 0002004
8888999HIGH CHAIR 9999991
8889412PLAY PEN 0074992
0001001LOW TEST 0000019
9999999LAST RECORD 0000011
Your problem is here:
01 WS-PERCENT-WITH-DISCOUNT PIC 99V9.
When you do your divide, you store the result in that field. If you expect it to be 0.556, what you are storing is 0.5, because you have only defined one decimal place, so the two low-order decimal places are simply truncated.
When you then multiply by 100, you make that 50.0.
If you define that field with three decimal places, your expected answer should appear (I've not checked your data).
However, a better way to do it is to define more integer digits, so that the field is large enough to hold your intermediate result and multiply by 100 first. Then you can divide (and you may want to consider ROUNDED on that, but it depends on the spec for the program).
There are a few questions here on problems with COMPUTE. Reading those questions and understanding the answers will help you get a good grasp on this. In COBOL, you define the accuracy you require, and you do that by supplying the correct number of integer and decimal digits.
You could also look through some of the other COBOL questions, where you'll find lots of advice on using FILE STATUS on your files, and checking the result of each IO. You can also use the file-status field you define to check for end-of-file, rather than using AT END/NOT AT END: you should find that it needs less code, and is more easy to understand.
Ditch as many full-stops/periods as you can. You need one at the end of the PROCEDURE DIVISION header, one at the end of a procedure-name, one at the end of a procedure, and one at the end of the program (if you have no procedure-names). All the others are superfluous. Commas in code tend to distract, you may find it clearer to use indentation and formatting of the statements.
Whilst it is well-constructed, your nested-IF would be better as an EVALUATE.
You have many constants in your program. It is better to define those as data-items, with a well-chosen name, so that the code "reads", and no-one has to wonder about the significance of 0.27. You also have examples where you have two constants which are obviously related, 27.0 and 0.27 for instance, which are better served by just being one thing. If someone "maintains" the program, they may only change one of the values without changing the other (not expecting there to be another).
Look also at the use of 88-level condition names. The "switch = y" can become "end-of-invoice-file" for instance, and that 88 can be on the file-status for that file, with a value of "10".
You should test your program with an empty input file, and see if you like the results.
As a beginner with COBOL, it is not a bad shot at all.

COBOL Program to read a flat file sequentially and write it to an output file, not able to read at all loop is going infinite

I'm trying to write COBOL Program to read a flat file sequentially and write it to an output file, I'm able to read only one record at a time, not able to read next record what should I do?
Here is my code:
PROCEDURE DIVISION.
OPEN INPUT FILEX.
PERFORM READ-PARA THRU END-PARA UNTIL END-OF-FILE = 'Y'.
CLOSE FILEX.
STOP RUN.
READ-PARA.
READ FILEX
AT END
MOVE 'Y' TO END-OF-FILE
DISPLAY OFFCODE1
DISPLAY AGCODE1
DISPLAY POLNO1
DISPLAY EFFDATE1
DISPLAY EXPDATE
DISPLAY REPCODE
DISPLAY POLHOLDER1
DISPLAY LOCATION1
GO TO END-PARA.
END-PARA.
i, ve tried using the scope terminator, still not able to loop 'm getting S001 ABEND here is my code :
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILEX ASSIGN TO SYSUT1
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD FILEX.
01 FILEXREC.
02 OFFCODE1 PIC X(3).
02 FILLER PIC X.
02 AGCODE1 PIC X(3).
02 FILLER PIC X.
02 POLNO1 PIC X(6).
02 FILLER PIC X.
02 EFFDATE1 PIC X(8).
02 FILLER PIC X.
02 EXPDATE PIC X(8).
02 FILLER PIC X.
02 REPCODE PIC X(1)
02 FILLER PIC X.
02 POLHOLDER1 PIC X(8).
02 FILLER PIC X.
02 LOCATION1 PIC X(9).
02 FILLER PIC X(87).
WORKING-STORAGE SECTION.
77 FS PIC 9(2).
01 WS-INDICATORS.
10 WS-EOF-IND PIC X(01) VALUE 'N'.
88 WS-END-OF-FILE VALUE 'Y'.
PROCEDURE DIVISION.
OPEN INPUT FILEX.
PERFORM READ-PARA THRU END-PARA UNTIL WS-END-OF-FILE.
CLOSE FILEX.
STOP RUN.
READ-PARA.
READ FILEX
AT END
MOVE 'Y' TO WS-EOF-IND.
DISPLAY OFFCODE1
DISPLAY AGCODE1
DISPLAY POLNO1
DISPLAY EFFDATE1
DISPLAY EXPDATE
DISPLAY REPCODE
DISPLAY POLHOLDER1
DISPLAY LOCATION1
IF WS-END-OF-FILE
GO TO END-PARA.
END-PARA.
EXIT.
one more method i tried even in this works for only one record, again getting S001 ABEND while running the code. Here is the code:
IDENTIFICATION DIVISION.
PROGRAM-ID. ASSIGNMENT.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILEX ASSIGN TO SYSUT1
DATA DIVISION.
FILE SECTION.
FD FILEX.
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 140 CHARACTERS
BLOCK CONTAINS 00 RECORDS.
01 FILEXREC.
02 OFFCODE1 PIC 9(3).
02 FILLER PIC X.
02 AGCODE1 PIC X(3).
02 FILLER PIC X.
02 POLNO1 PIC X(6).
02 FILLER PIC X.
02 EFFDATE1 PIC X(8).
02 FILLER PIC X.
02 EXPDATE1 PIC X(8).
02 FILLER PIC X.
02 REPCODE1 PIC X(1).
02 FILLER PIC X.
02 POLHOLDER1 PIC X(8).
02 FILLER PIC X.
02 LOCATION1 PIC X(9).
02 FILLER PIC X(26).
WORKING-STORAGE SECTION.
01 WS-INDICATORS.
10 WS-EOF-IND PIC X(01) VALUE 'N'.
88 WS-END-OF-FILE VALUE 'Y'.
01 TEMP1.
02 OFFCODE2 PIC 9(3).
02 FILLER PIC X.
02 AGCODE2 PIC X(3).
02 FILLER PIC X.
02 POLNO2 PIC X(6).
02 FILLER PIC X.
02 EFFDATE2 PIC X(8).
02 FILLER PIC X.
02 EXPDATE2 PIC X(8).
02 FILLER PIC X.
02 REPCODE2 PIC X(1).
02 FILLER PIC X.
02 POLHOLDER2 PIC X(8).
02 FILLER PIC X.
02 LOCATION2 PIC X(9).
02 FILLER PIC X(26).
PROCEDURE DIVISION.
OPEN INPUT FILEX.
PERFORM READ-PARA THRU END-PARA UNTIL WS-END-OF-FILE.
CLOSE FILEX.
STOP RUN.
READ-PARA.
READ FILEX
INTO TEMP1
AT END
MOVE 'Y' TO WS-EOF-IND.
DISPLAY OFFCODE1
DISPLAY AGCODE1
DISPLAY POLNO1
DISPLAY EFFDATE1
DISPLAY EXPDATE1
DISPLAY REPCODE1
DISPLAY POLHOLDER1
DISPLAY LOCATION1
IF WS-END-OF-FILE
GO TO END-PARA.
END-PARA.
EXIT.
You really should use your END- terminators... END-PERFORM, END-IF, END-READ, etc.
As for you problem, if I were to guess, I'd say you're not reading only the first record, you're reading all records and displaying only the last one. Your READ statement has an AT END, where everything is done, but it doesn't have a NOT AT END to tell it what to do with records it's read successfully. I generally code my READ statements thusly:
READ FILE
AT END
SET FILE-EOF TO TRUE
NOT AT END
PERFORM PROCESS-RECORD
END-READ
Wrap that in a perform like this and it works pretty well:
SET FILE-NOT-EOF TO TRUE
PERFORM UNTIL FILE-EOF
READ FILE
AT END
SET FILE-EOF TO TRUE
NOT AT END
PERFORM PROCESS-RECORD
END-READ
END-PERFORM
Good luck, hope it works out for you. Writing solid COBOL can be very tough.
I guess you're not still waiting :-)
In one place file is 140, but definition is only 79.
You use file status, but don't check it. Your file probably does not open successfully, which you would have discovered if you checked the FS field (cunning name, but copied form IBM example maybe).
When you READ and get end-of-file, you set the flag, but still process as though you had got a record. Depending on "things" this gets you the wrong data, or gets you an abend.
There's no point in the GO TO END-PARA because END-PARA is immediately afterwards anyway.
Hopefully you went back and looked at the code NealB provided and got the thing going a few months ago...

Resources