Need help with my COBOL homework - cobol

Sorry to bother you all but I am stuck on my homework for COBOL. I've made two attempts, neither of which is working as expected.
The two attempts and their output are shown below followed by the final results it needs to be. I thank you all for your help.
First attempt:
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIL-LABEL.
*
******************************************************************
* This program prints duplicate side by side mailing labels.
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LABEL-FILE-IN
ASSIGN TO 'MAIL-LABEL.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT LABEL-FILE-OUT
ASSIGN TO 'MAIL-LABEL.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD LABEL-FILE-IN.
01 LABEL-RECORD-IN.
05 NAME-IN PIC X(20).
05 ADDRESS-IN PIC X(20).
05 CITY-STATE-ZIP-IN PIC X(20).
FD LABEL-FILE-OUT.
01 LABEL-RECORD-OUT.
05 LEFT-LABEL-OUT PIC X(20).
05 BLANK-OUT PIC X(15).
05 RIGHT-LABEL-OUT PIC X(20).
05 BLANK-A-OUT PIC X(5).
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT LABEL-FILE-IN
OPEN OUTPUT LABEL-FILE-OUT
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO'
READ LABEL-FILE-IN
AT END
MOVE 'NO' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE LABEL-FILE-IN
CLOSE LABEL-FILE-OUT
STOP RUN.
200-PROCESS-ONE-RECORD.
MOVE NAME-IN TO LEFT-LABEL-OUT
MOVE ADDRESS-IN TO BLANK-OUT
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT.
This produces:
*IAN HENDERSON 1309 SPRINGBANKDETROIT MI 48024
*JANET LEASA 12700 GRATIOT SWARREN MI 48077
*COREY HAYES 400 BRUSH ST. DETROIT MI 48024
*SCOTT TOKLEY 2003 INDIAN RD.TAYLOR MI 48075
*JUDY FISHER 2200 WOODWARD ADETROIT MI 48025
*SHAWN MITCHELL 510 HOLLYWOOD PDETROIT MI 48025
*MARCUS PILLON 1450 JOY RD DEARBORN MI 48077
*BRIAN GUENETTE 456 TRUMBULL STDETROIT MI 48024
*KIM MIKA 456 LAFAYETTE SDETROIT MI 48024
*KYLE THOMPSON 1617 MAPLE RD. WARREN MI 48056
*SUE DONALDSON 11 CASS AVE. DETROIT MI 48024
My second attempt:
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIL-LABEL.
*
******************************************************************
* This program prints duplicate side by side mailing labels.
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LABEL-FILE-IN
ASSIGN TO 'MAIL-LABEL.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT LABEL-FILE-OUT
ASSIGN TO 'MAIL-LABEL.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD LABEL-FILE-IN.
01 LABEL-RECORD-IN.
05 NAME-IN PIC X(20).
05 ADDRESS-IN PIC X(20).
05 CITY-STATE-ZIP-IN PIC X(20).
FD LABEL-FILE-OUT.
01 LABEL-RECORD-OUT.
05 LEFT-LABEL-OUT PIC X(20).
05 BLANK-OUT PIC X(15).
05 RIGHT-LABEL-OUT PIC X(20).
05 BLANK-A-OUT PIC X(5).
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT LABEL-FILE-IN
OPEN OUTPUT LABEL-FILE-OUT
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO'
READ LABEL-FILE-IN
AT END
MOVE 'NO' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE LABEL-FILE-IN
CLOSE LABEL-FILE-OUT
STOP RUN.
200-PROCESS-ONE-RECORD.
MOVE NAME-IN TO LEFT-LABEL-OUT
MOVE ADDRESS-IN TO LEFT-LABEL-OUT
MOVE CITY-STATE-ZIP-IN TO LEFT-LABEL-OUT
MOVE SPACES TO BLANK-OUT
MOVE NAME-IN TO RIGHT-LABEL-OUT
MOVE ADDRESS-IN TO RIGHT-LABEL-OUT
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT
produced:
*DETROIT MI 48024 DETROIT MI 48024
*WARREN MI 48077 WARREN MI 48077
*DETROIT MI 48024 DETROIT MI 48024
*TAYLOR MI 48075 TAYLOR MI 48075
*DETROIT MI 48025 DETROIT MI 48025
*DETROIT MI 48025 DETROIT MI 48025
*DEARBORN MI 48077 DEARBORN MI 48077
*DETROIT MI 48024 DETROIT MI 48024
*DETROIT MI 48024 DETROIT MI 48024
*WARREN MI 48056 WARREN MI 48056
*DETROIT MI 48024 DETROIT MI 48024
What I need to end up with is something like:
*IAN HENDERSON IAN HENDERSON
*1309 SPRINGBANK ST. 1309 SPRINGBANK ST.
*DETROIT MI 48024 DETROIT MI 48024
*JANET LEASA JANET LEASA
*12700 GRATIOT ST. 12700 GRATIOT ST.
*WARREN MI 48077 WARREN MI 48077
*COREY HAYES COREY HAYES
*400 BRUSH ST. 400 BRUSH ST.
*DETROIT MI 48024 DETROIT MI 48024
*SCOTT TOKLEY SCOTT TOKLEY
*2003 INDIAN RD. 2003 INDIAN RD.
*TAYLOR MI 48075 TAYLOR MI 48075
What's wrong with my code?

Normally, I wouldn't give this much help for homework but, since you've put a fair bit of effort into it already and you're unlikely to find many of us dinosaurs here, I'll help you out.
Your problem is here (ignore the things in parentheses on the right, they're just comments to help you out):
200-PROCESS-ONE-RECORD.
MOVE NAME-IN TO LEFT-LABEL-OUT
MOVE ADDRESS-IN TO LEFT-LABEL-OUT (overwrite)
MOVE CITY-STATE-ZIP-IN TO LEFT-LABEL-OUT (overwrite)
MOVE SPACES TO BLANK-OUT
MOVE NAME-IN TO RIGHT-LABEL-OUT
MOVE ADDRESS-IN TO RIGHT-LABEL-OUT (overwrite)
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT (overwrite)
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT (only wrote one line)
This is the paragraph that processes one record. What you are doing here is putting three things into both the left and right output sections (so that the first two are being overwritten).
What you need is a toggle variable to select whether you're processing a left value or a right value, and the ability to store the left data so you can output them both when you process the right data, something like:
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
01 DOING-LEFT PIC X(3) VALUE 'YES'.
01 LEFT-NAME-IN PIC X(20).
01 LEFT-ADDRESS-IN PIC X(20).
01 LEFT-CITY-STATE-ZIP-IN PIC X(20).
Then modify your record processing code thus (check the IF syntax, it's been a while since I cut any COBOL code):
200-PROCESS-ONE-RECORD.
IF DOING-LEFT = 'YES' THEN
PERFORM 201-PROCESS-LEFT-RECORD
ELSE
PERFORM 202-PROCESS-RIGHT-RECORD.
201-PROCESS-LEFT-RECORD.
MOVE NAME-IN TO LEFT-NAME-IN. (just store it)
MOVE ADDRESS-IN TO LEFT-ADDRESS-IN.
MOVE CITY-STATE-ZIP-IN TO LEFT-CITY-STATE-ZIP.
MOVE 'NO' TO DOING-LEFT. (and toggle to right)
202-PROCESS-RIGHT-RECORD.
MOVE LEFT-NAME-IN TO LEFT-LABEL-OUT. (first line, both sides)
MOVE SPACES TO BLANK-OUT.
MOVE NAME-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.
MOVE LEFT-ADDRESS-IN TO LEFT-LABEL-OUT. (second line, both sides)
MOVE SPACES TO BLANK-OUT.
MOVE ADDRESS-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.
MOVE LEFT-CITY-STATE-ZIP-IN TO LEFT-LABEL-OUT. (third line, both sides)
MOVE SPACES TO BLANK-OUT.
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.
MOVE 'YES' TO DOING-LEFT. (toggle back to left)
Then, at the end, after the file has been fully read, you need to detect if you've populated the left data (i.e., there was an odd number of input lines). This will be the case if DOING-LEFT is set to 'NO'.
I'll leave that to you but it involves moving the left data and populating the right data with spaces, in a manner very similar to 202-PROCESS-RIGHT-RECORD above (nudge, nudge,wink, wink).
And, now that I've had a good look at the desired output, it appears you actually need two copies of each address on both the left and the right. Are you sure that's the way you want to do it since it's a pretty unusual requirement for a mailing label program?
In any case, I'll leave all that code in above since it's a good way to do the one-each method of mailing labels but the code you seem to need is much simpler, a very slight variation of the 202-PROCESS-RIGHT-RECORD paragraph.
Forget all the extra working storage I mentioned, and just change 200-PROCESS-ONE-RECORD to:
200-PROCESS-ONE-RECORD.
MOVE NAME-IN TO LEFT-LABEL-OUT.
MOVE SPACES TO BLANK-OUT.
MOVE NAME-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.
MOVE ADDRESS-IN TO LEFT-LABEL-OUT.
MOVE SPACES TO BLANK-OUT.
MOVE ADDRESS-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.
MOVE CITY-STATE-ZIP-IN TO LEFT-LABEL-OUT.
MOVE SPACES TO BLANK-OUT.
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT.
MOVE SPACES TO BLANK-A-OUT.
WRITE LABEL-RECORD-OUT.

I think your second attempt was nearly correct. As Paxdiablo pointed out in
his answer, the problem you have is overwriting data.
If I understand your problem correctly, you read in a single record
containing a complete address (Name, Address, City-State-Zip) and have to
print out two copies of it side by side.
Notice that for every line you read, you need to print 3. Also notice that you
only have one output record buffer. This means you can only process one output line at a
time. The solution is to move each address component into the left and right hand side
of the ouput line, output the line and then move on to the next address component. Since
there are 3 address components, you end up printing 3 lines for each one read.
Try modifying paragraph 200-PROCESS-ONE-RECORD as follows
200-PROCESS-ONE-RECORD.
MOVE NAME-IN TO LEFT-LABEL-OUT
MOVE SPACES TO BLANK-OUT
MOVE NAME-IN TO RIGHT-LABEL-OUT
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT
MOVE ADDRESS-IN TO LEFT-LABEL-OUT
MOVE SPACES TO BLANK-OUT
MOVE ADDRESS-IN TO RIGHT-LABEL-OUT
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT
MOVE CITY-STATE-ZIP-IN TO LEFT-LABEL-OUT
MOVE SPACES TO BLANK-OUT
MOVE CITY-STATE-ZIP-IN TO RIGHT-LABEL-OUT
MOVE SPACES TO BLANK-A-OUT
WRITE LABEL-RECORD-OUT
This takes one input line, produces 3 output lines. You might want to output
a fourth blank line to separate addresses (as illustrated in your sample output - I will
let you figure out how to get that done).
I think Paxdiablo's solution solved a slightly different problem
where you would be printing one copy of each address but printing addresses 2 across.
BTW... Despite the number of disparaging "drive by" comments your question got, COBOL
is still actively used in some segments of this industry.

Your question is already well answered about the overwrites, but I would add two things that will greatly improve your Cobol code in readability and maintainability.
You are using a Cobol '74 meme here with the ARE-THERE-MORE-RECORDS variable and moving 'YES' and 'NO' literals to it. This is very brittle and prone to breakage. A much nicer, less brittle, more readable approach is to use the conditionals that Cobol provides, also known as 88's:
05 Filler Pic x(1) Value 'Y'.
88 More-Records Value 'Y'.
88 No-More-Records Value 'N'.
You can test it with:
Perform until No-More-Records
And trigger it with:
Set No-More-Records to true
This does several things for you.
Nobody will ever accidentally maintain one of your literals to 'no' instead of 'NO' or otherwise munge up your source code. This can be a real problem on older systems that make assumptions about upper/lower case for their users and their attached terminals.
Nobody can move 'BOB' to your flag because you didn't give it a name, you made it filler. They have to go way out of their way to assign to that variable instead of using the condition names. And if they are capable enough to go that far out of their way, they are capable enough to know why they SHOULDN'T do it.
It gives your loop control and file control checks meaningful names. Granted, ARE-THERE-MORE-RECORDS 'YES'/'NO' is pretty meaningful, but in true production code you will encounter many different conditions, often with unusual names and twisted logic behind them, sometimes 'YES'/'NO' isn't as clear as it could be. Giving a nice, 30 character long condition name is much easier for the programmers that will follow you to do maintenance.
The other thing you do is use the paragraph numbering system. It was a poorly though out idea back when graph paper flow charts were all the documentation you had and source control was not yet a twinkle in anyones eye.
100-MAIN.
200-PROCESS-ONE-RECORD.
It doesn't really buy you anything, and it comes with several downsides.
With modern source control, changes to all the other paragraph numbers that are not germane to the specific change you are making will stand out like a sore thumb. (Assuming anyone ever renumbers their paragraphs when their logic changes, which they never do)
It encourages really crappy paragraph names. Consider this, perfectly valid under the paragraph numbering system:
100-Read-File
200-Read-File
300-Read-File
110-Write-File
210-Write-File
310-Write-File
We obviously have three different files, or at least three combinations of files and read types, but absolutely no indication of what is different by the paragraph name. It is also prone to the cut&paste error where someone copies a paragraph, renumbers it, and doesn't fully change the content to hit the new file or set the new conditional flags for the separate file, thus creating subtle and hard to find bugs.
A much better approach is:
Read-Master-File
Read-Transaction-File
Write-Master-File
Write-Transaction-File
Write-Log-File
That is easier to do right and harder to do wrong.
Remember you write source code for other humans to read, the compiler will take any sort of crap, but your maintenance is 90% of a programs lifecycle and that means other people* will spend ten times as much time trying to understand what you wrote as you spent writing it. Make it easy for them.
Very often, this will be you, but you will not recognize the code you wrote six months ago...

Related

cobol & JCL removing extra spaces

I am trying to accept input from jcl for example 'John Snow' and run it from my cobol program Im using JUSTIFIED RIGHT VALUE SPACES to move the string to the right side however I need to delete the extra spaces using my cobol pgm.
example
my working storage is:
01 ALPHA-ITEM PIC X(50).
01 MOVE-ITEM REDEFINES ALPHA-ITEM PIC X(50).
01 NUM-ITEM PIC X(50) JUSTIFIED RIGHT VALUE SPACES.
and in my PROCEDURE DIVISION
ACCEPT ALPHA-ITEM.
MOVE MOVE-ITEM TO NUM-ITEM.
DISPLAY NUM-ITEM.
it displays 'John Snow' on the right of the screen however i don't know how to remove the extra spaces.
you need something like this:
01 ALPHA-ITEM PIC X(50).
01 WS-INDEX PIC 99.
ACCEPT ALPHA-ITEM
PERFORM VARYING WS-INDEX
FROM 50 BY -1
UNTIL ALPHA-ITEM(WS-INDEX:1) NOT EQUAL SPACE
OR WS-INDEX < 1
END-PERFORM
DISPLAY ALPHA-ITEM(1:WS-INDEX).
This code will accept the alpha item, then run a loop to find out how long the data actually is. Then it will display that field starting from position 1 until the counter that was set in the loop.
There is also.. Unpopular for some reason.
UNSTRING MOVE-ITEM DELIMITED BY SPACES INTO NUM-ITEM.

Report with Report Writer duplicating last line

I find myself sorting an input file, and using a control break to compute some data. We need headers in the control break, the report writer is duplicating the header each time and I can not figure it out for the life of me. The write statement in the break paragraph is written twice, but if I use a DISPLAY it is only displayed once. Where am I going wrong with the Report Writer? The break itself is calculating the data correctly (but probably terribly)
environment division.
configuration section.
input-output section.
file-control.
SELECT corpranks
ASSIGN TO
"corpranks.txt"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT out-file
ASSIGN TO
"report"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT sortfile
ASSIGN TO
"SortFile".
data division.
file section.
FD corpranks
RECORD CONTAINS 80 CHARACTERS.
01 gf-rec.
05 first-initial PIC x.
05 middle-initial PIC x.
05 last-name PIC x(14).
05 rank-code PIC 9.
05 Filler PIC x(15).
05 rank PIC x(3).
05 salary PIC 9(6).
05 corporation PIC x(29) VALUE SPACE.
FD out-file
REPORT IS corp-report.
01 of-rec PIC x(80).
SD sortfile.
01 Sortrec.
05 PIC x(16).
05 SR-rank PIC xxx.
05 PIC x(22).
05 SR-corporation PIC x(29).
working-storage section.
77 EOF PIC x VALUE "N".
77 current-corp PIC x(29).
77 total-salary PIC 9(6) VALUE 0.
77 current-salary PIC 9(6).
77 converted-month PIC x(3).
77 concatenated-date PIC x(28).
77 formatted-date PIC x(80) JUSTIFIED RIGHT.
77 formatted-name PIC x(20).
77 tally-counter PIC 9.
77 inp-len PIC 9.
01 current-date.
05 YYYY PIC x(4).
05 MM PIC x(2).
05 DD PIC x(2).
01 corporation-header.
05 FILLER pic x(18) VALUE SPACES.
05 FILLER pic x(13) VALUE "Corporation: ".
05 ch-corp pic x(40).
01 corporation-subheader.
05 FILLER pic x(5) VALUE SPACES.
05 FILLER pic x(4) VALUE "RANK".
05 FILLER pic x(5) VALUE SPACES.
05 FILLER pic x(4) VALUE "NAME".
05 FILLER pic x(15) VALUE SPACES.
05 FILLER pic x(6) VALUE "SALARY".
77 csh-underline pic x(40) Value
"========================================".
01 main-header.
05 FILLER PIC x(5).
05 header-content PIC x(69) VALUE "Jacksonville Computer App
"lications Support Personnel Salaries".
report section.
RD corp-report.
01 REPORT-LINE
TYPE DETAIL
LINE PLUS 2.
05 COLUMN 6 PIC x(3) SOURCE rank.
05 COLUMN 12 PIC x(20) SOURCE formatted-name.
05 COLUMN 37 PIC 9(6) SOURCE salary.
procedure division.
0000-MAIN.
Sort Sortfile on ascending key SR-corporation
on ascending key SR-rank
Using corpranks
giving corpranks.
OPEN
INPUT corpranks
OUTPUT out-file
INITIATE corp-report.
WRITE of-rec FROM main-header.
ACCEPT current-date from DATE YYYYMMDD.
PERFORM 3000-CONVERT-MONTH.
STRING "As of: " DELIMITED BY SIZE
DD DELIMITED BY SIZE
SPACE
converted-month DELIMITED BY SIZE
SPACE
YYYY DELIMITED BY SIZE
INTO concatenated-date.
MOVE concatenated-date TO formatted-date.
WRITE of-rec FROM formatted-date.
PERFORM 2000-GENERATE-REPORT UNTIL EOF = 1.
TERMINATE corp-report.
stop run.
2000-GENERATE-REPORT.
PERFORM 3100-TRIM-FIELDS
GENERATE REPORT-LINE
READ corpranks
AT END
CLOSE corpranks
out-file
MOVE 1 TO eof
NOT AT END
IF current-corp = SPACE
MOVE corporation to current-corp
MOVE current-corp to ch-corp
WRITE of-rec FROM corporation-header
WRITE of-rec FROM corporation-subheader
WRITE of-rec FROM csh-underline
END-IF
IF current-corp NOT = corporation
PERFORM 2500-CONTROL-BREAK
END-IF
COMPUTE total-salary = total-salary + salary
MOVE corporation to current-corp
END-READ.
2500-CONTROL-BREAK.
WRITE of-rec FROM corporation
MOVE 0 to total-salary
.
3000-CONVERT-MONTH.
EVALUATE mm
WHEN "01" MOVE "JAN" TO converted-month
WHEN "02" MOVE "FEB" TO converted-month
WHEN "03" MOVE "MAR" TO converted-month
WHEN "04" MOVE "APR" TO converted-month
WHEN "05" MOVE "MAY" TO converted-month
WHEN "06" MOVE "JUN" TO converted-month
WHEN "07" MOVE "JUL" TO converted-month
WHEN "08" MOVE "AUG" TO converted-month
WHEN "09" MOVE "SEP" TO converted-month
WHEN "10" MOVE "OCT" TO converted-month
WHEN "11" MOVE "NOV" TO converted-month
WHEN "12" MOVE "DEC" TO converted-month
WHEN OTHER MOVE mm to converted-month
END-EVALUATE.
3100-TRIM-FIELDS.
INSPECT last-name TALLYING tally-counter FOR trailing
spaces.
COMPUTE inp-len = LENGTH OF last-name - tally-counter
MOVE last-name(1: inp-len) to formatted-name
STRING last-name(1: inp-len) DELIMITED BY SIZE
SPACE
first-initial DELIMITED BY SIZE
INTO formatted-name
MOVE 0 TO tally-counter
end program Program2.
Some report output: (at the beginning header, csh-underline is the last thing written, the === underline displays twice. At the corporation control breaks, the next corp name is the last thing written, and is written twice)
Jacksonville Computer Applications Support Personnel Salaries
As of: 18 FEB 2015
Corporation: Alltel Information Services
RANK NAME SALARY
========================================
========================================
EVP COLUMBUS C 100000
SVP ADAMS S 042500
VP REAGAN R 081000
VP FRANKLIN B 080000
A&P FORD G 060000
A&P HAYES R 050000
A&P JACKSON A 057600
A&P TYLER J 069000
A&P HARRISON B 052000
A&P TAFT W 070500
A&P HOOVER H 035000
A&P PIERCE F 044000
American Express
American Express
EVP JOHNSON L 098000
SVP CLINTON W 086000
VP ROOSEVELT F 072000
A&P HARDING W 040000
....
Here's a link to some Report Writer documentation from Micro Focus. It is not the only documentation they provide, but it is all that I have scanned through: http://documentation.microfocus.com/help/index.jsp?topic=%2Fcom.microfocus.eclipse.infocenter.studee60win%2FGUID-48E4E734-F1A4-41C4-BA30-38993C8FE100.html
If you loot at Report File under Enterprise > Micro Focus Studio Enterprise Edition 6.0 > General Reference > COBOL Language Reference > Part 3. Additional Topics > Report Writer you will see this:
Report File
A report file is an output file having sequential organization. A
report file has a file description entry containing a REPORT clause.
The content of a report file consists of records that are written
under control of the RWCS.
A report file is named by a file control entry and is described by a
file description entry containing a REPORT clause. A report file is
referred to and accessed by the OPEN, GENERATE, INITIATE, SUPPRESS,
TERMINATE, USE BEFORE REPORTING, and CLOSE statements.
Although this does not definitively say "Don't use your own WRITE statements and hope that they will work" I think it is clear that you should not. What happens when you do that is not defined, or is "undefined behaviour".
You are getting repeated lines before a break, and after a break, exactly where the Report Writer will be checking if there is anything it needs to do. Although I know nothing at all about the implementation of the Report Writer in Micro Focus COBOL, I am pretty certain that you have correctly identified that the repetition happens and is beyond your control. I think the above quote confirms that, and within other parts of Micro Focus's documentation this may be made more explicit.
You either need to use the Report Writer fully (if the task is to use the Report Writer) or not use it at all. You can't mix automatic and manual on the same report file, it seems, and that makes sense to me.
Remember, it does not matter that some of your WRITE statements seem to work, because this is a computer and you need them all to work.
Some general comments on your program:
In main-header you have a FILLER without a VALUE clause, which can cause problems when written to a file for printing. Whether that is way those five bytes don't show on your output or whether it is due to formatting in the posting here, I don't know.
Also in main-header you have a long literal, continued onto a second line. I can't see the continuation marker, and that may be a feature of how it is done in that Micro Focus COBOL, but it always makes things easier if literals are not continued. Define two smaller fields one after the other, with smaller literals which taken together make up the whole.
You have this:
COMPUTE total-salary = total-salary + salary
This, however, is considered clearer:
ADD salary TO total-salary
You are using STRING. You should be aware that the data-transfer from the sending fields ceases when the receiving field is filled, or when all the sending fields have been processed. In the latter case, automatic space-padding is not carried out, unlike the behaviour of a MOVE statement. You need to set your receiving field to an initial value before the STRING is executed, else you will retain data from the previous execution of STRING when the current execution of STRING has less actual data.
After the STRING you do this:
MOVE 0 TO tally-counter
This means your INSPECT, several statements earlier, but where tally-counter is used, is relying on a previous value for tally-counter for the code after that to work. This is not good practice. Make tally-counter an initial value before it is used in the INSPECT.
If you go with the Report Writer your PROCEDURE DIVISION code will be significantly reduced, because the definition of the report elements defines the automatic processing.
The Report Write feature of COBOL is very powerful. It allows you to define a complex report in the REPORT SECTION of a COBOL program, with headings, column headings, detail lines, control-break totals etc. In the PROCEDURE DIVISION you only need as little as make the source-data available (say with a READ) and then GENERATE the report, and COBOL does the rest for you.
However, you have defined a very simple report, and are attempting to do headings, totals etc yourself. I have never done this, and don't know if it works in general, or if it works for your compiler.
From your testing, it seems like there may be a problem with doing this, and it may be, erroneously, repeating the line you yourself have written. You need to check that that particular line is not output elsewhere in your program.
We need to see the outstanding answers to questions from comments, and, unless it is an excessive size, your entire program.
If your exercise is specifically to use the Report Writer, then I think you need to define a more "complex" report, which will produce, automatically from the definition, everything that you want.
If you do not have to use the Report Writer for this exercise, don't use it, just do the detail-line formatting yourself and WRITE it as you are already doing for headings and totals.
On the assumption (later proved false) that you were using the Report Writer to do everything you need, the problem would have been manually writing to the same output file that the Report Writer was using.
If using the full features of the Report Writer, simply make this change and remove any other WRITEs to that output file, and use the Report Writer features for everything:
2500-CONTROL-BREAK.
MOVE 0 to total-salary
.

COBOL Error Code 18

I have an error code 18 in COBOL when I'm trying to write the output to a file. I'm using Micro Focus VS 2012. I have tried everything but it seem doesn't print the output correctly at this time.
...
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GRADE-FILE ASSIGN TO 'Grades.txt'.
SELECT PRINT-FILE ASSIGN TO 'Output.txt'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD GRADE-FILE
LABEL RECORDS ARE STANDARD.
01 GRADE-RECORD.
05 I-STUDENT PIC X(14).
05 I-GRADE1 PIC 999.
05 I-GRADE2 PIC 999.
05 I-GRADE3 PIC 999.
05 I-GRADE4 PIC 999.
05 I-GRADE5 PIC 999.
05 I-GRADE6 PIC 999.
FD PRINT-FILE
LABEL RECORDS ARE STANDARD.
01 PRINT-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 PROGRAM-VARIABLES.
05 W-AVERAGE PIC 999V99.
05 W-EOF-FLAG PIC X VALUE 'N'.
01 PAGE-TITLE.
05 PIC X(46) VALUE
' S I X W E E K G R A D E R E P O R T'.
01 HEADING-LINE1.
05 PIC X(51) VALUE
' Student T e s t S c o r e s Average'.
01 HEADING-LINE2.
05 PIC X(51) VALUE
'--------------------------------------------------'.
01 DETAIL-LINE.
05 PIC X VALUE SPACE.
05 O-STUDENT PIC X(14).
05 PIC X VALUE SPACE.
05 O-GRADE1 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE2 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE3 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE4 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE5 PIC ZZ9.
05 PIC X VALUE SPACE.
05 O-GRADE6 PIC ZZ9.
05 PIC X(4) VALUE SPACE.
05 O-AVERAGE PIC ZZ9.99.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN INPUT GRADE-FILE
OUTPUT PRINT-FILE
PERFORM 20-PRINT-HEADINGS
PERFORM 30-PROCESS-LOOP
CLOSE GRADE-FILE
PRINT-FILE
STOP RUN.
20-PRINT-HEADINGS.
MOVE PAGE-TITLE TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 1 LINE
MOVE HEADING-LINE1 TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 3 LINES
MOVE HEADING-LINE2 TO PRINT-RECORD
WRITE PRINT-RECORD AFTER ADVANCING 1 LINE.
30-PROCESS-LOOP.
* PERFORM 40-READ-RECORD
READ GRADE-FILE
PERFORM UNTIL W-EOF-FLAG = 'Y'
PERFORM 50-COMPUTE-GRADE-AVERAGE
PERFORM 60-PRINT-DETAIL-LINE
READ GRADE-FILE
* PERFORM 40-READ-RECORD
END-PERFORM.
*40-READ-RECORD.
* READ GRADE-FILE
* AT END MOVE 'Y' TO W-EOF-FLAG.
50-COMPUTE-GRADE-AVERAGE.
COMPUTE W-AVERAGE ROUNDED = (I-GRADE1 + I-GRADE2 + I-GRADE3 + I-GRADE4 + I-GRADE5 + I-GRADE6 ) / 6.
60-PRINT-DETAIL-LINE.
MOVE SPACES TO DETAIL-LINE
MOVE I-STUDENT TO O-STUDENT
MOVE I-GRADE1 TO O-GRADE1
MOVE I-GRADE2 TO O-GRADE2
MOVE I-GRADE3 TO O-GRADE3
MOVE I-GRADE4 TO O-GRADE4
MOVE I-GRADE5 TO O-GRADE5
MOVE I-GRADE6 TO O-GRADE6
MOVE W-AVERAGE TO O-AVERAGE
WRITE PRINT-RECORD FROM DETAIL-LINE AFTER ADVANCING 1 LINE.
end program "GradeReport.Program1"
S I X W E E K G R A D E R E P O R T
Student T e s t S c o r e s Average
--------------------------------------------------
KellyAntonetz0 700 500 980 800 650 852 747.00
obertCain09708 207 907 309 406 2;1 25> 400.67
Dehaven0810870 940 850 930 892 122 981 785.83
rmon0760770800 810 750 92; 142 9>1 <1> 816.33
g0990930890830 940 901 =1> 41= ?82 65 872.50
06707108408809 6=9 ;52 565 <<0 900 870 924.33
78052076089Woo 493 9>4 520 760 760 830 734.50
Something prior to your COBOL program has pickled your file by removing all the spaces and shuffling the data to the left.
Your first student shows as KellyAntonetz but likely should be Kelly Antonetz. Since only one space was removed, the grade data has moved only one place to the left, so the numbers are still recognizable and although the average is a factor of 10 out, it is approximately correct.
It is not actually correct (except for the power of 10) because of that 2 following the 85. Where did that 2 come from?
It came from the next record, where the first-name should be Robert but you show as obertCain09708. The ASCII code for the letter R is X'82'. When treated as a number by COBOL the 8 will be ignored (or will cause a crash when in the trailing byte of a number). Your compiler doesn't cause the code to crash, but does treat the R as the number 2.
obertCain is only 9 bytes out of the 14 you have for the name. The five spaces/blanks which have been "lost" this time cause the numerics to be pulled-left by five bytes. From that point onward, explaining how the output you show fits the presumed input becomes an academic exercise only.
Further support is a reference for what would be a FILE STATUS code of 18 from a Micro Focus compiler, here: http://www.simotime.com/vsmfsk01.htm
Which says, for 18:
Read part record error: EOF before EOR or file open in wrong mode
(Micro Focus).
Your final record would "finish" before expected, with end-of-file being detected before 32 bytes have been read.
Note that the error is on your input file, not your output file.
Losing the spaces in that way can be done in many ways, so I can't guess what you are doing to the file before it gets to the COBOL program, but neither COBOL itself nor your code is doing that.
Take note of Emmad Kareem's comments. Use the FILE STATUS. Check the file-status field (define one per file) after each IO, so that you know when a problem occurs, and what the problem is.
Testing the file-status field for 10 on a file you are reading sequentially gives cleaner code than the AT END on the READ.
Note also that if your program had not crashed there, it would either loop infinitely or crash shortly afterwards. Probably in trying to fix your problem, you have commented-out your use of the "read paragraph" and in that paragraph is the only place you are setting end-of-file.
If you use the file-status instead of AT END, you don't need to define a flag/switch you can use an 88 on the file-status field and have the COBOL run-time set it for you directly, without you having to code it.
Just a couple of points about your DETAIL-LINE.
There is no need to MOVE SPACE to it, as you MOVE to each named field, and the (un-named) FILLERs have VALUE SPACE.
You don't necessarily need the (un-named) FILLERS. Try this:
01 DETAIL-LINE.
05 O-STUDENT PIC BX(14).
05 O-GRADE1 PIC ZZZ9.
05 O-GRADE2 PIC ZZZ9.
05 O-GRADE3 PIC ZZZ9.
05 O-GRADE4 PIC ZZZ9.
05 O-GRADE5 PIC ZZZ9.
05 O-GRADE6 PIC ZZZ9.
05 O-AVERAGE PIC Z(6)9.99.
If you work with COBOL, you may see this type of thing, so it is good to know. With massive amounts of output there is probably a small performance penalty. You may find it more convenient for "lining-up" output to headings.
Ah. Putting together you non-use of LINE SEQUENTIAL for your input file, I predict you have a "script" running some time before the COBOL program which is supposed to remove the record-terminators (whatever those are on your OS) at the end of each logical record, but that you have accidentally removed all whitespace from all positions of your record instead.
With LINE SEQUENTIAL you can have records of fixed-length which also happen to be "terminated". Unless the exercise specifically includes the removal of the record terminators, just use LINE SEQUENTIAL.
If you are supposed to remove the terminators, don't do so for whitespace which covers too much (be specific) and also "anchor" the change to the end of the record.

Issues with GO TO statement on execution past the first time

Having issues with using the GO-TO statement. This is suppose to run until the user types 'END'. If I type 'END' when I first open the program it will close out but if I type it after entering valid data for the first pass thru it just continues to bring back the user input data screen.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT USED-CAR-FILE-OUT
ASSIGN TO 'USED-CAR.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD USED-CAR-FILE-OUT.
01 USED-CAR-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 FIRST-RECORD PIC X(3) VALUE 'YES'.
01 ID-CODE PIC X(3).
01 TOTAL-CASH-PAYMENT PIC 9(5).
01 MONTHLY-PAYMENT PIC 9(4).
01 NUMBER-OF-MONTHS PIC 9(3).
01 TOTAL-BALANCE PIC S9(6)V99 VALUE ZEROS.
01 INTEREST-COLLECTED PIC 99V99 VALUE ZEROS.
01 MONTH-DIFF PIC 99 VALUE ZEROS.
01 MONTH-NUM PIC 99 VALUE ZEROS.
01 YEAR-NUM PIC 99 VALUE ZEROS.
01 ID-HOLD PIC X(3) VALUE SPACES.
01 PAYMENT-HOLD PIC X(3) VALUE SPACES.
01 DETAIL-LINE.
05 ID-CODE-DL PIC X(3).
05 PIC X(3) VALUE SPACES.
05 PIC X(4) VALUE 'Yr='.
05 YEAR-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(4) VALUE 'MO='.
05 MONTH-NUMBER-DL PIC Z9.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Pmt='.
05 PAYMENT-DL PIC $$$,$$$.
05 PIC X(4) VALUE SPACES.
05 PIC X(5) VALUE 'Int='.
05 INTEREST-EARNED-DL PIC $$$$.99.
05 PIC X(3) VALUE SPACES.
05 PIC X(5) VALUE 'Bal='.
05 BALANCE-DL PIC $$$,$$$.99.
PROCEDURE DIVISION.
100-MAIN.
OPEN OUTPUT USED-CAR-FILE-OUT
PERFORM 200-USER-INPUT THRU 299-EXIT
CLOSE USED-CAR-FILE-OUT
STOP RUN.
200-USER-INPUT.
DISPLAY 'Used Car Sales Report'
DISPLAY 'Enter the ID code (or END) - maxium three char.'
ACCEPT ID-CODE
IF ID-CODE = 'END'
GO TO 299-EXIT
END-IF
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
DISPLAY 'Enter the Monthly Payment - maximum four digits'
ACCEPT MONTHLY-PAYMENT
DISPLAY 'Enter the Number of Months - maximum three digits'
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
299-EXIT.
EXIT.
300-RECORD-PROCESS.
IF TOTAL-CASH-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE TOTAL-CASH-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
MOVE 'NO' TO FIRST-RECORD
END-IF
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERORM 200-USER-INPUT
END-IF
IF MONTHLY-PAYMENT > 0
IF FIRST-RECORD = 'YES'
MOVE ID-CODE TO ID-CODE-DL
MOVE 1 TO YEAR-NUMBER-DL
MOVE 1 TO YEAR-NUM
move 1 to MONTH-NUMBER-DL
MOVE 'NO' TO FIRST-RECORD
END-IF
MOVE MONTHLY-PAYMENT TO PAYMENT-DL
MOVE PAYMENT-DL TO MONTHLY-PAYMENT
ADD MONTHLY-PAYMENT TO TOTAL-BALANCE
COMPUTE INTEREST-COLLECTED ROUNDED = TOTAL-BALANCE
* .0175 / 12
MOVE INTEREST-COLLECTED TO INTEREST-EARNED-DL
ADD INTEREST-COLLECTED TO TOTAL-BALANCE
MOVE TOTAL-BALANCE TO BALANCE-DL
ADD 1 TO MONTH-DIFF
MOVE MONTH-DIFF TO MONTH-NUMBER-DL
IF MONTH-NUMBER-DL > 13
ADD 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUMBER-DL = 13
MOVE 1 TO MONTH-NUM
MOVE MONTH-NUM TO MONTH-NUMBER-DL
END-IF
IF MONTH-NUM = 1
ADD 1 TO YEAR-NUM
MOVE YEAR-NUM TO YEAR-NUMBER-DL
END-IF
MOVE DETAIL-LINE TO USED-CAR-RECORD-OUT
WRITE USED-CAR-RECORD-OUT
AFTER ADVANCING 1 LINE
MOVE ID-HOLD TO ID-CODE-DL
IF TOTAL-CASH-PAYMENT > 0
MOVE 0 TO TOTAL-CASH-PaYMENT
MOVE 0 TO PAYMENT-DL
END-IF
IF MONTH-DIFF < NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS
END-IF
PERFORM 200-USER-INPUT
END-IF.
EDIT solved the issue below
I also am having issues if months > 24. I step through the program and it shows my last detail line as the correct result but yet my output stops at 24 months. Thanks in advance.
AAAAAAAk!
PERFORM SEVERE-BEATING-ON-WHOEVER-MENTIONED-PERFORM-THROUGH
USING HEAVY-OBJECT
UNTIL PROMISE-EXTRACTED-TO-NEVER-DO-IT-AGAIN.
PERFORM THOUGH is EVIL. It causes layout-dependent code.
At the top control-level, use
PERFORM 200-USER-INPUT
UNTIL ID-CODE = 'END'.
(or possibly use 88 USER-INPUT-ENDED on ID-CODE - matter of style)
How you then determine whether to continue with input in 200-... is your choice, either
IF NOT USER-INPUT-ENDED
DISPLAY 'Enter the Total Cash Payment - maximum five digits'
ACCEPT TOTAL-CASH-PAYMENT
...
ACCEPT NUMBER-OF-MONTHS
PERFORM 300-RECORD-PROCESS.
OR
IF NOT USER-INPUT-ENDED
PERFORM 210-ACCEPT-DETAILS.
210-ACCEPT-DETAILS.
DISPLAY 'Enter the Total Cash Payment - maximum five digits'.
ACCEPT TOTAL-CASH-PAYMENT.
...
ACCEPT NUMBER-OF-MONTHS.
PERFORM 300-RECORD-PROCESS.
Since you PERFORMED 200-... then only 200-... will be executed; 210-... is a new paragraph which can only be reached from 200-... IF END is not entered.
Next step is to slightly modify 300-...
Move the initialisation ( FIRST-RECORD = 'YES' code) before the PERFORM 300-... in 200-... and then modify the PERFORM 300-RECORD-PROCESS. to
PERFORM 300-RECORD-PROCESS
UNTIL TOTAL-BALANCE = 0.
(I'm assuming here that this is the report-terination condition; if it isn't, substitute your report-termination condition)
You can now restructure 300-... to calculate the interest payable, modify the year and month numbers and show the result. ALL of the PERFORMs in 300-... will disappear.
So, in essence you have
MAIN:perform user-input until end-detected.
user-input: get user data; perform calculations until balance is zero.
calculations: one month's calculations at a time.
This also has the advantage that if you choose, you could insert
IF MONTHLY-PAYMENT IS LESS THAN INTEREST-COLLECTED
MOVE 'ERR' TO ID-CODE.
And use 'ERR' in ID-CODE to produce an appropriate error-message in 300-... instead of the progressive report lines AND at the same time assign 0 to TOTAL-BALANCE which terminates the PERFORM 300-... UNTIL ....
Your use of GO TO and PERFORM THROUGH paragraph ranges has corrupted the procedure return mechanism that COBOL
uses to maintain proper program flow of control. In essence, you have a program that is invalid - it might compile
without error but is still an invalid program according to the rules of COBOL.
Here is an outline of what your program is doing from a flow of control perspective. The
mainline program is essentially:
100-MAIN.
PERFORM 200-USER-INPUT THRU 299-EXIT
This is asking COBOL to execute all the code found from the beginning of
200-USER-INPUT through to the end of 299-EXIT. The outline for these
procedures is:
200-USER-INPUT.
IF some condition GO TO 299-EXIT
...
PERFORM 300-RECORD-PROCESS
.
299-EXIT.
Notice that if some condition is true, program flow will skip past the end
of 200-USER-INPUT and jump into 299-EXIT. 299-EXIT does not do anything
very interesting, it is just an empty paragraph serving as the end of a
PERFORMed range of paragraphs.
In paragraph 300-RECORD-PROCESS you have a fair bit of code. The interesting
bit is:
300-RECORD-PROCESS.
...
PERFORM 200-USER-INPUT
Notice that PERFORM 200-USER-INPUT this is not a PERFORM THRU, as you had coded in 100-MAIN.
The problem is that when you get back into 200-USER-INPUT and some codition becomes
true (as it will when you enter 'EXIT'), the flow of control
jumps to 299-EXIT which is past the end of the paragraph
you are currently performing. From this point
forward the flow of control mechanism used by COBOL to manage return from PERFORM verbs has
been corrupted. There is no longer a normal flow of control mechanism to return back to where 200-USER-INPUT
was performed from in 300-RECORD-PROCESS.
What happens next is not what most programmers would expect. Most programmers seem to expect
that when the end of 299-EXIT is reached program flow should return to wherever the last PERFORM
was done. In this case, just after PERFORM 200-USER-INPUT. No, COBOL doesn't work that way, flow of control
will continue with the next executable statement following 299-EXIT. This gets you
right back to the first executable statement in 300-RECORD-PROCESS! And that is why you
are not getting expected behaviour from this program.
Logic flow in COBOL programs must ensure that the end of performed procedures are
always reached in the reverse order from which they were made. This corresponds to the call/return
stack semantics that
most programmers are familiar with.
My advice to you is to avoid the use of PERFORM THRU and GO TO. These are two of the biggest
evils left in the COBOL programming language today. These constructs are hang-overs from a
bygone era of programming and have no constructive benefit today.
Your problem is that you have created an infinite loop for yourself. You 200- paragraph PERFORMs the 300- paragraph, and your 300- paragraph PERFORMS your 200- paragraph.
You need to restructure your program.
A paragraph called 200-USER-INPUT should just concern itself with that.
repeat until end of input
get some input
if there is input to process
process the input
Yoiks! I just noticed you also PERFORM 300- from within 300-!

Adding a header to address label program in COBOL

Hello I am total beginner in cobol and needing some homework help. I am trying to write a program that prints address labels on the ouput. But in the output there has to be a header, page number, and date. I have successfully got the program to print the addresses in label format but cannot seem to get the heading line (with the page and date) to show up above it. With my program the way it is there is an error code stating that I have the wrong access mode for the data file. I am unsure what this means. Here is my program. I got rid of the date part just to try and get the heading line in above the addresses. *EDIT: I have added the open and close for "print header out" but now it gives me the error code "file locked" Can anyone shed some light on this.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LABEL-FILE-IN
ASSIGN TO 'C0603.DAT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT LABEL-FILE-OUT
ASSIGN TO 'C0603.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-HEADER-OUT
ASSIGN TO 'C0603.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD LABEL-FILE-IN.
01 LABEL-RECORD-IN.
05 CUST-NAME-IN PIC X(20).
05 ADDRESS-IN PIC X(20).
05 CITY-STATE-ZIP-IN PIC X(20).
FD LABEL-FILE-OUT.
01 LABEL-RECORD-OUT.
05 PRINT-LABEL-OUT PIC X(20).
FD PRINT-HEADER-OUT.
01 REPORT-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
01 HEADING-LINE1.
05 PIC X(40) VALUE SPACES.
05 PIC X(12) VALUE
"MAILING LIST".
01 DATE-WS.
05 MONTH-WS PIC XX.
05 YEAR-WS PIC XX.
01 DATE-WS-OUT.
05 PIC X(45) VALUE SPACES.
05 MONTH-WS-OUT PIC XX.
05 VALUE "/".
05 YEAR-WS-OUT PIC XX.
PROCEDURE DIVISION.
000-MAIN-MODULE.
PERFORM 100-INITIALIZATION-MODULE.
PERFORM 200-PROCESS-ONE-RECORD
UNTIL ARE-THERE-MORE-RECORDS = "NO ".
PERFORM 900-TERMINATION-MODULE.
STOP RUN.
100-INITIALIZATION-MODULE.
OPEN OUTPUT PRINT-HEADER-OUT
OPEN INPUT LABEL-FILE-IN
OPEN OUTPUT LABEL-FILE-OUT
ACCEPT DATE-WS FROM DATE.
MOVE MONTH-WS TO MONTH-WS-OUT.
MOVE YEAR-WS TO YEAR-WS-OUT.
PERFORM 600-READ-MODULE.
PERFORM 300-TOP-OF-PAGE-MODULE.
200-PROCESS-ONE-RECORD.
MOVE SPACES TO PRINT-LABEL-OUT
MOVE CUST-NAME-IN TO PRINT-LABEL-OUT
WRITE LABEL-RECORD-OUT
MOVE ADDRESS-IN TO PRINT-LABEL-OUT
WRITE LABEL-RECORD-OUT
MOVE CITY-STATE-ZIP-IN TO PRINT-LABEL-OUT
WRITE LABEL-RECORD-OUT
PERFORM 600-READ-MODULE.
300-TOP-OF-PAGE-MODULE.
MOVE HEADING-LINE1 TO REPORT-OUT.
WRITE REPORT-OUT AFTER ADVANCING 9 LINES.
MOVE DATE-WS-OUT TO REPORT-OUT.
WRITE REPORT-OUT AFTER ADVANCING 1 LINES.
600-READ-MODULE.
READ LABEL-FILE-IN
AT END MOVE "NO " TO ARE-THERE-MORE-RECORDS
END-READ.
900-TERMINATION-MODULE.
CLOSE PRINT-HEADER-OUT.
CLOSE LABEL-FILE-IN.
CLOSE LABEL-FILE-OUT.
I think the problem you are having is that both LABEL-FILE and HEADER-FILE point to the
same physically file ('C0603.RPT'). You can do this, but only one of them may be open at a time. This is
the source of the "file locked" message when you try to open it a second time under a different
name.
The typical way of doing this is to open one file but have multiple record definitions for
writing to it.
Drop the:
SELECT PRINT-HEADER-OUT
ASSIGN TO 'C0603.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
and change the FD's for LABEL-FILE-OUT to include the Header record...
FD LABEL-FILE-OUT.
01.
05 LABEL-BUFFER PIC X(80).
05 LABEL-RECORD-OUT REDEFINES LABEL-BUFFER.
10 PRINT-LABEL-OUT PIC X(20).
10 PIC X(60).
05 PRINT-HEADER-OUT REDEFINES LABEL-BUFFER.
10 REPORT-OUT PIC X(80).
There are other ways of doing this, but the basic idea is to have an output buffer that is the
at least as big as the largest ouput record andREDEFINE it for multiple usages (LABEL or HEADER).
When writing a label line or header line just use WRITE LABEL-BUFFER and then move SPACES to it
after each write to ensure it gets properly initialized before re-populating any of the subordiante
data items.
The "error code stating that I have the wrong access mode for the data file" is because the PRINT-HEADER-OUT file is not OPEN when you execute the statement WRITE REPORT-OUT. All files must be OPENed before they are used and should always be CLOSEd when you are finished with them.

Resources