convert date DD-MMM-YYYY to YYYYMMDD in cobol - cobol

I'm trying to change the date format from DD-MON-YYYY to YYYY/MM/DD in COBOL and I was wondeing if that was possible.
I've been searching and I couldn't find any utilities or date function to change it.
What I've tried:
Use unstring and converted JAN to 01, FEB to 02 and so on.

COBOL suffers from a paucity of useful libraries and utilities.
Mostly COBOL programers just re-invent wheels and code stuff up themselves.
Something like (untested code!):----
01 OLD-DATE.
05 OLD-DD PIC XX.
05 FILLER PIC X.
05 OLD-MON PIC XXX.
05 FILLER PIC X.
05 OLD-YEAR PIC XXXX.
01 NEW-DATE.
05 NEW-YEAR PIC XXXX.
05 FIRST-SLASH PIC X VALUE '/'.
05 NEW-MM PIC 99.
05 SECOND-SLASH PIC X VALUE '/'.
05 NEW-DD PIC XX.
01 M-TAB.
M PIC XXX OCCURS 12.
01 M-VALS REDEFINES M-TAB VALUE 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'.
01 M-X PIC S9(8) COMP VALUE 0.
.......
MOVE OLD-YEAR TO NEW-YEAR.
PERFORM VARYING M-X FROM 1 TO 12
IF OLD-MON = M(M-X)
MOVE M-X TO NEW-MM
END IF
END PERFORM.
MOVE OLD-DD TO NEW-DD.

Related

I can't figure out why my filler spaces aren't being displayed in my COBOL application

Ok so I'm making this application for school, which requires a certain format of spacing between the entries read in from .txt file. I've created the header using the filler term and the spacing works just fine, however when I apply the same method to the formatting of the records imported from the .txt it doesn't seem to work. I've tried everything under the sun and I can't make it work for the life of me!
This is what the output looks like now:
PARTNUMBER PARTNAME QUANTITY VALUE
1111111screws robertson 10 43210200Ajax
2222222screws robertson 08 41000100Ajax
2222233screws robertson 06 43210200Ajax
3333333screws robertson 04 41000100Ajax
4444444bolts dead 10 43210200Robo
5555555bolts dead 80 01000100Robo
But, it should be something like:
PARTNUMBER PARTNAME QUANTITY VALUE
1111111 screws robertson 10 43210200 Ajax
2222222 screws robertson 08 41000100 Ajax
2222233 screws robertson 06 43210200 Ajax
3333333 screws robertson 04 41000100 Ajax
4444444 bolts dead 10 43210200 Robo
5555555 bolts dead. 80 01000100 Robo
Below is the code that I think I need to make this happen, but again I'm just not sure why it isn't working
FILE SECTION.
FD INVENT-FILE-IN.
01 INVENT-RECORD-IN PIC X(49).
WORKING-STORAGE SECTION.
01 DISPLAY-HEADERS.
05 DISPLAY-PART-NUMBER PIC A(11)
VALUE "PARTNUMBER".
05 FILLER PIC X(1).
05 DISPLAY-PART-NAME PIC A(9)
VALUE "PARTNAME".
05 FILLER PIC X(4).
05 DISPLAY-QUANTITY PIC A(8)
VALUE "QUANTITY".
05 FILLER PIC X(2).
05 DISPLAY-VALUE PIC A(5)
VALUE "VALUE".
01 DISPLAY-RECORDS.
05 WS-INVENTORY-PART-NUMBER PIC 9(7).
05 FILLER PIC X(4) VALUE SPACES.
05 WS-INVENTORY-PART-NAME PIC X(20).
05 FILLER PIC X(4) VALUE SPACES.
05 WS-INVENTORY-QUANTITY PIC 9(4).
05 FILLER PIC X(2) VALUE SPACES.
05 WS-INVENTORY-VALUE PIC 9(8).
05 FILLER PIC X(1) VALUE SPACES.
05 WS-INVENTORY-SUPPLIER-CODE PIC X(5).
PROCEDURE DIVISION.
100-PROCESS-INVENTORY-FILE.
PERFORM 201-OPEN-INVENT-FILE.
PERFORM 202-DISPLAY-HEADER.
PERFORM 204-INPUT-INVENT-FILE
PERFORM 206-DISPLAY-RECORDS
UNTIL EOF-SWITCH = "Y".
PERFORM 205-TERMINATE-INVENTORY-FILE.
STOP RUN.
201-OPEN-INVENT-FILE.
OPEN INPUT INVENT-FILE-IN.
202-DISPLAY-HEADER.
DISPLAY DISPLAY-HEADERS.
206-DISPLAY-RECORDS.
MOVE INVENT-RECORD-IN TO DISPLAY-RECORDS.
DISPLAY DISPLAY-RECORDS.
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.
204-INPUT-INVENT-FILE.
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.
205-TERMINATE-INVENTORY-FILE.
CLOSE INVENT-FILE-IN.
As previously stated in the comments, in paragraph 206-DISPLAY-RECORDS, you are moving the entire input record to DISPLAY-RECORDS.
The problem here is that your input record is not formatted the same as your output record. This just means that you have to format it yourself. The easiest way to do this is to define your input input record differently. Something like this should do the trick:
FILE SECTION.
FD INVENT-FILE-IN.
01 INVENT-RECORD-IN.
05 INVENT-PART-NUMBER PIC 9(7).
05 INVENT-PART-NAME PIC X(20).
05 INVENT-QUANTITY PIC 9(4).
05 INVENT-VALUE PIC 9(8).
05 INVENT-SUPPLIER-CODE PIC X(5).
From here, its as easy as moving this fields to their equivalent spot in you DISPLAY-RECORDS:
206-DISPLAY-RECORDS.
MOVE INVENT-PART-NUMBER TO WS-INVENTORY-PART-NUMBER
MOVE INVENT-PART-NAME TO WS-INVENTORY-PART-NAME
MOVE INVENT-QUANTITY TO WS-INVENTORY-QUANTITY
MOVE INVENT-VALUE TO WS-INVENTORY-VALUE
MOVE INVENT-SUPPLIER-CODE TO WS-INVENTORY-SUPPLIER-CODE
READ INVENT-FILE-IN
AT END
MOVE "Y" TO EOF-SWITCH
NOT AT END
COMPUTE READ-COUNTER = READ-COUNTER + 1
END-READ.

When I add slashes I get numbers added to the record

01 EMPLOYEE-RECORD1.
...
05 EMPLOYEEDOB1.
10 MONTH1 PIC 99.
*> here 10 FILLER PIC X(1) VALUE "/".
10 DAY11 PIC 99.
*> here 10 FILLER PIC X(1) VALUE "/".
10 YEARS1 PIC 9(4).
*> here
05 EMPLOYEE_YEARLYPAY1 PIC ZZ,ZZZV99.
...
There is more to the program and I will provide the code if necessary. In short my program takes input from a file and then loads it into a temp record. Then I copy the data from the temp record into the record for the output file and it writes it to the output file. When it writes it I lose the pay data and it adds numbers for the DOB instead of slashes. Why? What am I doing wrong?
program-id. Program1 as "NAME403.Program1".
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EMPFILE
ASSIGN TO "C:\COBOLClass\DataFiles\NAME402.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT NEWEMPFILE
ASSIGN TO "C:\COBOLClass\DataFiles\NAME403.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
data division.
FILE SECTION.
FD EMPFILE.
01 EMPLOYEE-RECORD.
05 EMPLOYEE_ADDRESS.
10 BLDGNUMB-AND-STREET PIC X(10).
10 CITY PIC X(10).
10 STATE PIC X(10).
10 ZIPCODE PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEENUMB PIC 9(6).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEEDOB.
10 MONTH PIC 99.
10 DAY1 PIC 99.
10 YEARS PIC 9(4).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_FNAME PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_MNAME PIC X(2).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_LNAME PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_YEARLYPAY PIC ZZ,ZZZ.99.
FD NEWEMPFILE.
01 EMPLOYEE-RECORD1.
05 EMPLOYEENUMB1 PIC 9(6).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_FNAME1 PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_MNAME1 PIC X(2).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_LNAME1 PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEEDOB1.
10 MONTH1 PIC 99.
10 FILLER PIC X VALUE "/".
10 DAY11 PIC 99.
10 FILLER PIC X VALUE "/".
10 YEARS1 PIC 9(4).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_YEARLYPAY1 PIC ZZ,ZZZ.99.
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_ADDRESS1.
10 BLDGNUMB-AND-STREET1 PIC X(10).
10 CITY1 PIC X(10).
10 FILLER PIC X(10) VALUE SPACE.
10 STATE1 PIC X(10).
10 FILLER PIC X(10) VALUE SPACE.
10 ZIPCODE1 PIC X(10).
10 FILLER PIC X(166) VALUE "---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------".
05 EMPLOYEE_LNAME PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_YEARLYPAY PIC ZZ,ZZZ.99.
FD NEWEMPFILE.
01 EMPLOYEE-RECORD1.
05 EMPLOYEENUMB1 PIC 9(6).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_FNAME1 PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_MNAME1 PIC X(2).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_LNAME1 PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEEDOB1.
10 MONTH1 PIC 99.
10 FILLER PIC X VALUE "/".
10 DAY11 PIC 99.
10 FILLER PIC X VALUE "/".
10 YEARS1 PIC 9(4).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_YEARLYPAY1 PIC ZZ,ZZZ.99.
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_ADDRESS1.
10 BLDGNUMB-AND-STREET1 PIC X(10).
10 CITY1 PIC X(10).
10 FILLER PIC X(10) VALUE SPACE.
10 STATE1 PIC X(10).
10 FILLER PIC X(10) VALUE SPACE.
10 ZIPCODE1 PIC X(10).
10 FILLER PIC X(166) VALUE ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------".
working-storage section.
01 EMPLOYEE-RECORD-TEMP.
05 EMPLOYEE_ADDRESS-TEMP.
10 BLDGNUMB-AND-STREET-TEMP PIC X(10).
10 CITY-TEMP PIC X(10).
10 STATE-TEMP PIC X(10).
10 ZIPCODE-TEMP PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEENUMB-TEMP PIC 9(6).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEEDOB-TEMP.
10 MONTH-TEMP PIC 99.
10 DAY1-TEMP PIC 99.
10 YEARS-TEMP PIC 9(4).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_FNAME-TEMP PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_MNAME-TEMP PIC X(2).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_LNAME-TEMP PIC X(10).
05 FILLER PIC X(10) VALUE SPACE.
05 EMPLOYEE_YEARLYPAY-TEMP PIC ZZ,ZZZ.99.
01 SWITCHES.
05 CUSTMAST-EOF-SWITCH PIC X VALUE "N".
02 COUNTER PIC 9 VALUE 1.
procedure division.
000-STARTPROGRAM.
open input EMPFILE
output NEWEMPFILE.
PERFORM 100-GET-INFROMATION
UNTIL CUSTMAST-EOF-SWITCH="Y".
display "END OF SESSION.".
stop run.
100-GET-INFROMATION.
read EMPFILE into EMPLOYEE-RECORD-TEMP
at END
MOVE EMPLOYEE_ADDRESS-TEMP TO EMPLOYEE_ADDRESS1.
MOVE BLDGNUMB-AND-STREET-TEMP TO BLDGNUMB-AND-STREET1.
MOVE CITY-TEMP TO CITY1.
MOVE STATE-TEMP TO STATE1.
MOVE ZIPCODE-TEMP TO ZIPCODE1.
MOVE EMPLOYEENUMB-TEMP TO EMPLOYEENUMB1.
MOVE MONTH-TEMP TO MONTH1.
MOVE DAY1-TEMP TO DAY11.
MOVE YEARS-TEMP TO YEARS1.
MOVE EMPLOYEE_FNAME-TEMP TO EMPLOYEE_FNAME1.
MOVE EMPLOYEE_MNAME-TEMP TO EMPLOYEE_MNAME1.
move EMPLOYEE_LNAME-TEMP TO EMPLOYEE_LNAME1.
move EMPLOYEE_YEARLYPAY-TEMP to EMPLOYEE_YEARLYPAY1.
WRITE EMPLOYEE-RECORD1.
if COUNTER=5
close EMPFILE
close NEWEMPFILE
move "Y" to CUSTMAST-EOF-SWITCH
ELSE ADD 1 to COUNTER.
The actual MOVE or READ ... INTO are missing but I assume you (directly or indirectly) move a PIC 9(06) item to EMPLOYEEDOB1 which is a different format actual a PIC X(08).
As long as the question isn't improved (by showing both the data definition and the statement for the "copy") I say the answer to "What am I doing wrong?" is: You use the wrong definition for EMPLOYEEDOB1 and/or "copy" the data in falsely.
The target field definition must either match the original data or be changed to an edited field like PIC 99/99/99 (where the / are added automatically in the DISPLAY/WRITE you do with it) - in the later case: be aware that you cannot do any arithmetic with an edited field.
Alternative: MOVE all three parts of the date-of-birth (DOB) on their own and you can keep your definition (only useful if you want to do anything with the three parts afterwards).

COBOL File input, numbers separated with space

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

How to skip a record in COBOL with an if statement

FD STUDENTS-FILE-IN.
01 STUDENTS-RECORD-IN.
05 SSN-IN PIC X(9).
05 STUDENT-NAME-IN PIC X(11).
05 PIC X(5).
05 GRAD-STATUS-IN PIC X.
05 CLASS-STANDING-IN PIC X.
05 MAJOR-IN PIC X(3).
05 CREDIT-HOURS-IN PIC 9(3).
05 CREDIT-POINTS-IN PIC 9(3).
FD STUDENTS-FILE-OUT.
01 STUDENTS-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
01 PAGE-NUMBER PIC 99 VALUE ZERO.
01 LINE-COUNT PIC 99 VALUE ZERO.
01 SSID-BREAK.
03 FIRST-PART PIC X(3).
03 SECOND-PART PIC X(2).
03 THIRD-PART PIC X(4).
01 NAME-BREAK.
03 FIRST-LETTER PIC X(1).
03 MIDDLE-LETTER PIC X(1).
03 LAST-LETTER PIC X(10).
01 GRAD-CHECK PIC X.
01 WS-DATE.
05 RUN-YEAR PIC XX.
05 RUN-MONTH PIC XX.
05 RUN-DAY PIC XX.
01 HEADING-LINE-ONE.
05 PIC X(21) VALUE SPACES.
05 PIC X(33)
VALUE 'RHODES STATE COLLEGE GRADE REPORT'.
05 PIC X(6) VALUE SPACES.
05 HEADING-LINE-DATE.
10 MONTH-NOW PIC XX.
10 PIC X VALUE '/'.
10 DAY-NOW PIC XX.
10 PIC X VALUE '/'.
10 YEAR-NOW PIC XX.
05 PIC X(3) VALUE SPACES.
05 PIC X(4) VALUE 'PAGE'.
05 HL-1-PAGE-NUMBER PIC Z9 VALUE ZEROS.
01 HEADING-LINE-TWO.
05 PIC X(10) VALUE 'SOC SEC NO'.
05 PIC X(4) VALUE SPACES.
05 PIC X(12) VALUE 'STUDENT NAME'.
05 PIC X(3) VALUE SPACES.
05 PIC X(8) VALUE 'STANDING'.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'MAJOR'.
05 PIC X(10) VALUE SPACES.
05 PIC X(5) VALUE 'HOURS'.
05 PIC X(2) VALUE SPACES.
05 PIC X(6) VALUE 'POINTS'.
05 PIC X(5) VALUE SPACES.
05 PIC X(3) VALUE 'GPA'.
01 DETAIL-LINE.
05 DL-SSID.
10 SSID-1 PIC X(3).
10 PIC X VALUE "-".
10 SSID-2 PIC X(2).
10 PIC X VALUE "-".
10 SSID-3 PIC X(4).
05 BLANK-B PIC X(3) VALUE SPACES.
05 DL-NAME .
10 FIRST-INI PIC X.
10 PIC X VALUE SPACES.
10 MID-INI PIC X.
10 PIC X VALUE SPACES.
10 LAST-NAME PIC X(10).
05 BLANK-C PIC X(3) VALUE SPACES.
05 YEAR-STATUS PIC X(9).
05 BLANK-D PIC X(3) VALUE SPACES.
05 STUDENT-MAJOR PIC X(13).
05 BLANK-E PIC X(5) VALUE SPACES.
05 STUDNET-HOURS PIC ZZ9.
05 BLANK-F PIC X(5) VALUE SPACES.
05 STUDENT-POINTS PIC ZZ9.
05 BLANK-G PIC X(4) VALUE SPACES.
05 STUDENT-GPA PIC 9V99.
01 TOTALS-LINE.
05 TOTALS PIC X(6) VALUE 'TOTALS'.
05 PIC X(34) VALUE SPACES.
05 HITS-TOTAL PIC ZZZ,ZZZ.
05 PIC X(9) VALUE SPACES.
05 BATS-TOTAL PIC ZZZ,ZZZ.
05 PIC X(10) VALUE SPACES.
05 AVG-TOTAL PIC .999.
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT STUDENTS-FILE-IN
OPEN OUTPUT STUDENTS-FILE-OUT
ACCEPT WS-DATE FROM DATE
MOVE RUN-MONTH TO MONTH-NOW
MOVE RUN-DAY TO DAY-NOW
MOVE RUN-YEAR TO YEAR-NOW
PERFORM 300-WRITE-HEADINGS
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
READ STUDENTS-FILE-IN
AT END
MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE STUDENTS-FILE-IN
CLOSE STUDENTS-FILE-OUT
STOP RUN.
200-PROCESS-ONE-RECORD.
IF LINE-COUNT >= 53
PERFORM 300-WRITE-HEADINGS
END-IF
* IF GRAD-STATUS-IN NOT = '1' AND NOT = '2'
* PERFORM 400-WRITE-TOTALS.
* END-IF
MOVE SSN-IN TO SSID-BREAK
MOVE FIRST-PART TO SSID-1
MOVE SECOND-PART TO SSID-2
MOVE THIRD-PART TO SSID-3
MOVE STUDENT-NAME-IN TO NAME-BREAK
MOVE FIRST-LETTER TO FIRST-INI
MOVE MIDDLE-LETTER TO MID-INI
MOVE LAST-LETTER TO LAST-NAME
MOVE GRAD-STATUS-IN TO GRAD-CHECK
IF GRAD-CHECK = 'Y'
END-IF
MOVE DETAIL-LINE TO STUDENTS-RECORD-OUT
WRITE STUDENTS-RECORD-OUT
AFTER ADVANCING 1 LINES
ADD 1 TO LINE-COUNT.
The input file looks like this
307662099KRAlexander Y2NES005017
Basically certain files won't meet the requirements and we are just suppose to just skip over them. This is an example of the file that we don't want to write to the output file and skip over. I apologize if I explained this poorly but I am really struggling with COBOL.
Your 200- paragraph needs to do something like this:
IF NOT ( <condition-for-skipping )
PERFORM PROCESS-THIS-RECORD
ELSE
PERFORM IGNORE-THIS-RECORD
END-IF
You can swap the conditions easily
IF ( <condition-for-skipping )
PERFORM IGNORE-THIS-RECORD
ELSE
PERFORM PROCESS-THIS-RECORD
END-IF
All the stuff you have in the 200- paragraph currently, you put in to a new paragrpah PROCESS-THIS-RECORD. You should have a new paragraph IGNORE-THIS-RECORD. If nothing else, it can count the records which are ignored. Then if you count the records which are processed, and count the input records, at the end you can check that everything is either processed or ignored.
You should check file-statuses. It is good to use scope-delimiters (like the END-IF) and keep full-stops/periods to a minimum.
88s are good to use for conditions. Saves lots of literals hanging about to make maintenance more complex.

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