How to add page numbers (COBOL) - cobol

OK so I'm doing assignment but then I found that I was asked to add page numbers and change pages for each 4 records. Since it's an online course and I don't think there is anything about page numbers in lecture videos. So the main problems are
To add a heading that contains date and page number,
Print 4 records per page, which means page needs to be changed after printing 4 records.
I really have no idea how to do this.
Here is the code I have finished:
ENVIRONMENT DIVISION.
FILE-CONTROL. SELECT STOCK-IN ASSIGN TO 'F:/CS201S13/PROJECT2.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT STOCK-OUT ASSIGN TO 'F:/CS201S13/PROJECT2OUTPUT.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD STOCK-IN.
01 STOCK-RECORD.
05 ST-TRANSACTION-INFORMATION.
10 ST-TRANSACTION-SHARES PIC 9(3).
10 ST-TRANSACTION-STOCK PIC X(14).
05 ST-PURCHASE-INFORMATION.
10 ST-PURCHASE-PRICE PIC 9(5)V99.
10 ST-PURCHASE-DATE.
15 ST-PURCHASE-YEAR PIC 99.
15 ST-PURCHASE-MONTH PIC 99.
15 ST-PURCHASE-DAY PIC 99.
05 ST-SALE-INFORMATION.
10 ST-SALE-PRICE PIC 9(5)V99.
10 ST-SALE-DATE.
15 ST-SALE-YEAR PIC 99.
15 ST-SALE-MONTH PIC 99.
15 ST-SALE-DAY PIC 99.
FD STOCK-OUT.
01 STOCK-RECORD-OUT.
05 ST-TRANSACTION-INFORMATION-OUT.
10 ST-TRANSACTION-SHARES-OUT PIC 9(3).
10 ST-TRANSACTION-STOCK-OUT PIC X(14).
05 TOTAL-PURCHASE PIC 9(8)V99.
05 PIC X(4).
05 TOTAL-SALE PIC 9(8)V99.
05 PIC X(4).
05 TOTAL-PROFIT PIC 9(8)V99.
05 PIC X(4).
05 ST-PURCHASE-DATE-OUT.
10 ST-PURCHASE-YEAR-OUT PIC 99.
10 PIC X VALUE '/'.
10 ST-PURCHASE-MONTH-OUT PIC 99.
10 PIC X VALUE '/'.
10 ST-PURCHASE-DAY-OUT PIC 99.
05 PIC X(4).
05 ST-SALE-DATE-OUT.
10 ST-SALE-YEAR-OUT PIC 99.
10 PIC X VALUE '/'.
10 ST-SALE-MONTH-OUT PIC 99.
10 PIC X VALUE '/'.
10 ST-SALE-DAY-OUT PIC 99.
05 PIC X(4).
05 RECORD-OUT PIC 9 VALUE 0.
05 PAGE-OUT PIC 9.
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'.
01 IS-THIS-PAGE-FULL PIC XXX VALUE 'NO '.
PROCEDURE DIVISION.
100-MAIN-PROCESS.
OPEN INPUT STOCK-IN
OUTPUT STOCK-OUT
MOVE ST-TRANSACTION-INFORMATION TO ST-TRANSACTION-INFORMATION-OUT
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
READ STOCK-IN
AT END
MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 200-PROCEDURE-RTN
ADD 1 TO RECORD-OUT
END-READ
END-PERFORM
CLOSE STOCK-IN
STOCK-OUT
STOP RUN.
200-PROCEDURE-RTN.
IF RECORD-OUT = 4
MOVE 'YES' TO IS-THIS-PAGE-FULL
MOVE 0 TO RECORD-OUT
MOVE 'NO ' TO IS-THIS-PAGE-FULL
ADD 1 TO PAGE-OUT
END-IF
MULTIPLY ST-PURCHASE-PRICE BY ST-TRANSACTION-SHARES GIVING TOTAL-PURCHASE
MULTIPLY ST-SALE-PRICE BY ST-TRANSACTION-SHARES GIVING TOTAL-SALE
SUBTRACT TOTAL-PURCHASE FROM TOTAL-SALE GIVING TOTAL-PROFIT
WRITE STOCK-RECORD-OUT.

You are both close, and far away.
"Close" because you need a little bit of code in between setting IS-THIS-PAGE-FULL to YES and NO.
"Far away" as you have quite a lot to do rather than just "patch up" what you have.
Is the program writing an output file (STOCK-OUT) and a report, or is STOCK-OUT the report? If it is a report, change the names so that it is clear that it is a report, not an output file.
Don't worry if this seems a lot. You should be learning how to Program in Cobol, as well as learning Cobol. Doesn't happen overnight.
In no particular order:
Include FILE-STATUS checking for all IO operations on all files, always. At the moment, if your input fails to open and the system does not fail the program (even if yours does, you are presumably learning Cobol to be able to work with any system, not just the one you have) then no records will be read, your "end of file test" will never be YES and you'll have a BFL (Big Fat Loop). With the FILE-STATUS checking, produce useful messages, including key/reference/record number as appropriate for failed READ or WRITE.
You may feel that this is a lot of work. However, put together some "template" files with all the stuff in, and then paste (or even COPY) those into your program each time.
You have VALUE clause in the FD. These will not do what you think.
You have single digit for your page count, which is unlikely to have general application.
Why use YES and NO as literals? Look at the SET verb, in relation to "condition names", use 88's for tests and "flags/switches".
You have "MOVE ST-TRANSACTION-INFORMATION" after the input is opened but before a record is read, and only have one reference to it in the program. This is not going to work.
For reading files, have a look at the "priming read" approach.
read input
loop until end-of-file (88 on file-status)
process data
read input
end-loop
This avoids the AT END/NOT AT END, allows processing of headers (if present) and "empty files" without clogging-up the main logic. The code "expands" with headers/trailers (including the correct number of them), sequence-checking of keys, etc, but you only need to code it once then "template" it.
According to your VALUE clauses in your FD, you expect RECORD-OUT to be zero, so the test for 4 will actually get you five on the first page, and four thereafter.
You always assume there will be a "profit" (a positive amount), which is not realistic, yet you don't allow a signed value for the "profit".
Now, for the report.
For your report FD, just make it a simple thing, length of your print line.
In WORKING-STORAGE, define data for the headings and titles that you need. Define data for a print line. Since you're in the WORKING-STORAGE, put VALUEs for everything which will not have data MOVEd to it in the PROCEDURE DIVISION.
When you have written four items (or when your program tells you this) and you have a fifth, write the headings and titles, remembering to update the page number.
I say "or when your program tells you this" because you can set your original value of "records written" to 4. Comment it, so that it is clear that it is what you want, and why you want it. The reason is, you don't have to then deal with "first time" headings and othe things. For first time, or on a "contol break" (I guess you'll get to those soon) set the " done on a page already" to the maximum for a page, and the headings will pop out when you want.
Format the print line. PERFORM a para to print it (which is where the "page full" test will be).
Note: You can use VALUEs for your "/"s in the dates, or you can use the "/" editing character in the PICture, like this:
05 an-input-date PIC X(8) (can be other definitions).
...
05 date-to-print PIC X(4)/XX/XX.
...
MOVE an-input-date TO date-to-print
I like to see that you are using "minimal full-stops/periods". You can go a little further.
MOVE an-input-date TO date-to-print
.
Then you get your final full-stop/period in a paragraph, without having it "attached" to any particular line of code, which makes "tossing code around" easier, as you don't have to think "do I need/not need that full-stop/period there".
You could also look through some of the Cobol questions here, and get a handle on some general tips and advice.

This may or may not help, if LINAGE is not supported you'll have to do some explicit counting.
*****************************************************************
* Example of LINAGE File Descriptor
* Author: Brian Tiffin
* Date: 10-July-2008
* Tectonics: $ cobc -x linage.cob
* $ ./linage <filename ["linage.cob"]>
* $ cat -n mini-report
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. linage-demo.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
select optional data-file assign to file-name
organization is line sequential
file status is data-file-status.
select mini-report assign to "mini-report".
DATA DIVISION.
FILE SECTION.
FD data-file.
01 data-record.
88 endofdata value high-values.
02 data-line pic x(80).
FD mini-report
linage is 16 lines
with footing at 15
lines at top 2
lines at bottom 2.
01 report-line pic x(80).
WORKING-STORAGE SECTION.
01 command-arguments pic x(1024).
01 file-name pic x(160).
01 data-file-status pic 99.
01 lc pic 99.
01 report-line-blank.
02 filler pic x(18) value all "*".
02 filler pic x(05) value spaces.
02 filler pic x(34)
VALUE "THIS PAGE INTENTIONALLY LEFT BLANK".
02 filler pic x(05) value spaces.
02 filler pic x(18) value all "*".
01 report-line-data.
02 body-tag pic 9(6).
02 line-3 pic x(74).
01 report-line-header.
02 filler pic x(6) VALUE "PAGE: ".
02 page-no pic 9999.
02 filler pic x(24).
02 filler pic x(5) VALUE " LC: ".
02 header-tag pic 9(6).
02 filler pic x(23).
02 filler pic x(6) VALUE "DATE: ".
02 page-date pic x(6).
01 page-count pic 9999.
PROCEDURE DIVISION.
accept command-arguments from command-line end-accept.
string
command-arguments delimited by space
into file-name
end-string.
if file-name equal spaces
move "linage.cob" to file-name
end-if.
open input data-file.
read data-file
at end
display
"File: " function trim(file-name)
" open error or empty"
end-display
go to early-exit
end-read.
open output mini-report.
write report-line
from report-line-blank
end-write.
move 1 to page-count.
accept page-date from date end-accept.
move page-count to page-no.
write report-line
from report-line-header
after advancing page
end-write.
perform readwrite-loop until endofdata.
display
"Normal termination, file name: "
function trim(file-name)
" ending status: "
data-file-status
end-display.
close mini-report.
* Goto considered harmful? Bah! :)
early-exit.
close data-file.
exit program.
stop run.
****************************************************************
readwrite-loop.
move data-record to report-line-data
move linage-counter to body-tag
write report-line from report-line-data
end-of-page
add 1 to page-count end-add
move page-count to page-no
move linage-counter to header-tag
write report-line from report-line-header
after advancing page
end-write
end-write
read data-file
at end set endofdata to true
end-read
.
*****************************************************************
* Commentary
* LINAGE is set at a 20 line logical page
* 16 body lines
* 2 top lines
* A footer line at 15 (inside the body count)
* 2 bottom lines
* Build with:
* $ cobc -x -Wall -Wtruncate linage.cob
* Evaluate with:
* $ ./linage
* This will read in linage.cob and produce a useless mini-report
* $ cat -n mini-report
*****************************************************************
END PROGRAM linage-demo.

Related

Read and jump first line and anothers lines in file

How I can read a .dat file with struct like that: ( A = ALPHANUMERIC && N = NUMERIC )
0AAAAAAAANNNN (233 BLANK SPACES ) 999999 ( SEQUENTIAL NUMBER ONE BY ONE )
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
9 (245 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
So, I know, how I can make a program to read this in C/C++ or in C#, but, I try to make in Cobol, just for study....
But, I don't know what the command I need to use to open the file with this style ( I just know the:
ORGANIZATION IS LINE SEQUENTIAL.
I think, exist a another command to open with custon instructions... i don't know...
So, btw, how I can open the file and read the informations ??
( i just need to read the line 1 on time, and, I need to read the line 2 and 3 always paried ... 4 and 5 && 6 and 7 && 8 and 9 ... )
and, I whant to show that information with DISPLAY ( just for study )
Thanks :)
Something like this below your FD:
01 INPUT-RECORD.
05 IR-RECORD-TYPE PIC X.
88 INPUT-RECORD-IS-HEADER VALUE '0'.
88 INPUT-RECORD-IS-DATA1 VALUE '1'.
88 INPUT-RECORD-IS-DATA2 VALUE '2'.
88 INPUT-RECORD-IS-TRAILER VALUE '9'.
05 FILLER PIC X(whatever).
You may need a "trailing" byte for a record-delimiter, I don't know, and you'll have to sort out the lengths, as they seem to vary.
These in Working-Storage:
01 INPUT-RECORD-HEADER.
05 IRH-RECORD-TYPE PIC X.
05 IRH-ITEM1 PIC X(8).
05 IRH-ITEM2 PIC 9(4).
05 FILLER PIC X(233).
05 IRH-SEQUENCE PIC X(6)
01 INPUT-RECORD-DATA1.
05 IRD1-RECORD-TYPE PIC X.
05 IRD1-ITEM1 PIC 9(14).
05 IRD1-ITEM1 PIC X(19).
05 FILLER PIC X(194).
05 IRD1-SEQUENCE PIC X(6)
01 INPUT-RECORD-DATA2.
05 IRD2-RECORD-TYPE PIC X.
05 IRD2-ITEM1 PIC X(33).
05 FILLER PIC X(194).
05 IRD2-SEQUENCE PIC X(6)
01 INPUT-RECORD-TRAILER.
05 IRT-RECORD-TYPE PIC X.
05 FILLER PIC X(245).
05 IRT-SEQUENCE PIC X(6).
You have to read each record, one at a time. Identify it. Put it in the correct W-S definition. When you read a "2" you can process the "1" you have stored along with the "2".
My datanames aren't very good, as I don't know what your data is. Also I have not "formatted" the definitions, which will make them more readable when you do it.
For OpenCOBOL, here is a sample standard in/standard out filter program:
>>SOURCE FORMAT IS FIXED
*> ***************************************************************
*><* ===========
*><* filter
*><* ===========
*><* :Author: Brian Tiffin
*><* :Date: 20090207
*><* :Purpose: Standard IO filters
*><* :Tectonics: cobc -x filter.cob
*> ***************************************************************
identification division.
program-id. filter.
environment division.
configuration section.
input-output section.
file-control.
select standard-input assign to keyboard.
select standard-output assign to display.
data division.
file section.
fd standard-input.
01 stdin-record pic x(32768).
fd standard-output.
01 stdout-record pic x(32768).
working-storage section.
01 file-status pic x value space.
88 end-of-file value high-value
when set to false is low-value.
*> ***************************************************************
procedure division.
main section.
00-main.
perform 01-open
perform 01-read
perform
until end-of-file
perform 01-transform
perform 01-write
perform 01-read
end-perform
.
00-leave.
perform 01-close
.
goback.
*> end main
support section.
01-open.
open input standard-input
open output standard-output
.
01-read.
read standard-input
at end set end-of-file to true
end-read
.
*> All changes here
01-transform.
move stdin-record to stdout-record
.
*>
01-write.
write stdout-record end-write
.
01-close.
close standard-input
close standard-output
.
end program filter.
*><*
*><* Last Update: dd-Mmm-yyyy
and here is a demonstration of using LINAGE that just happens to read in a text file.
*****************************************************************
* Example of LINAGE File Descriptor
* Author: Brian Tiffin
* Date: 10-July-2008
* Tectonics: $ cocb -x linage-demo.cob
* $ ./linage-demo <filename ["linage-demo.cob"]>
* $ cat -n mini-report
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. linage-demo.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
select optional data-file assign to file-name
organization is line sequential
file status is data-file-status.
select mini-report assign to "mini-report".
DATA DIVISION.
FILE SECTION.
FD data-file.
01 data-record.
88 endofdata value high-values.
02 data-line pic x(80).
FD mini-report
linage is 16 lines
with footing at 15
lines at top 2
lines at bottom 2.
01 report-line pic x(80).
WORKING-STORAGE SECTION.
01 command-arguments pic x(1024).
01 file-name pic x(160).
01 data-file-status pic 99.
01 lc pic 99.
01 report-line-blank.
02 filler pic x(18) value all "*".
02 filler pic x(05) value spaces.
02 filler pic x(34)
VALUE "THIS PAGE INTENTIONALLY LEFT BLANK".
02 filler pic x(05) value spaces.
02 filler pic x(18) value all "*".
01 report-line-data.
02 body-tag pic 9(6).
02 line-3 pic x(74).
01 report-line-header.
02 filler pic x(6) VALUE "PAGE: ".
02 page-no pic 9999.
02 filler pic x(24).
02 filler pic x(5) VALUE " LC: ".
02 header-tag pic 9(6).
02 filler pic x(23).
02 filler pic x(6) VALUE "DATE: ".
02 page-date pic x(6).
01 page-count pic 9999.
PROCEDURE DIVISION.
accept command-arguments from command-line end-accept.
string
command-arguments delimited by space
into file-name
end-string.
if file-name equal spaces
move "linage-demo.cob" to file-name
end-if.
open input data-file.
read data-file
at end
display
"File: " function trim(file-name) " open error"
end-display
go to early-exit
end-read.
open output mini-report.
write report-line
from report-line-blank
end-write.
move 1 to page-count.
accept page-date from date end-accept.
move page-count to page-no.
write report-line
from report-line-header
after advancing page
end-write.
perform readwrite-loop until endofdata.
display
"Normal termination, file name: "
function trim(file-name)
" ending status: "
data-file-status
end-display.
close mini-report.
* Goto considered harmful? Bah! :)
early-exit.
close data-file.
exit program.
stop run.
****************************************************************
readwrite-loop.
move data-record to report-line-data
move linage-counter to body-tag
write report-line from report-line-data
end-of-page
add 1 to page-count end-add
move page-count to page-no
move linage-counter to header-tag
write report-line from report-line-header
after advancing page
end-write
end-write
read data-file
at end set endofdata to true
end-read
.
*****************************************************************
* Commentary
* LINAGE is set at a 20 line logical page
* 16 body lines
* 2 top lines
* A footer line at 15 (inside the body count)
* 2 bottom lines
* Build with:
* $ cobc -x -Wall -Wtruncate linage-demo.cob
* Evaluate with:
* $ ./linage-demo
* This will read in linage-demo.cob and produce mini-report
* $ cat -n mini-report
*****************************************************************
END PROGRAM linage-demo.
With those samples, along with Gilbert's answer, you should have enough to tackle your problem, with the caveat that these examples are shy on proper error handling, so be careful is this is homework or a paid assignment. For an example of standard input/output or by filename depending on command line arguments (or lack thereof), see the ocdoc.cob program in the OpenCOBOL FAQ.
Offtopic: Output of an ocdoc pass over ocdoc.cob itself can be seen at http://opencobol.add1tocobol.com/ocdoc.html (Why mention it? The COBOL lexicon highlighter for Pygments has just been accepted into main. Any Pygments pulled after version 1.6 will allow for COBOL (context free) lexical highlighting.)
You write an ordinary Cobol program that reads a file.
The first byte (character) of the record is either 0, 1, 2, or 9.
Define a Working-Storage area (01 level) for each of the 4 record types. Then, after you read the record, you move it from the input area to the appropriate Working-Storage area for the record.
Then you process the record how you wish from one of the 4 Working-Storage areas.

Can't get proper file output

This is a homework assignment that involves reading in an input file, doing some processing, and printing the processed data to an output file in a neat and readable format.
The first record prints to the output file perfectly. Every record after that, it seems like when the record was read-in from the input file, it was read in with an added space; shifting the position of all of my input data and making it useless. Every line it seems like another space is being added.
I suspect that
A.) Despite my best efforts I do not fully understand the READ verb
and/or B.) There may be a problem with my compiler.
Any help is appreciated.
IDENTIFICATION DIVISION.
PROGRAM-ID.
payroll.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT payroll-in-file ASSIGN TO 'input.txt'.
SELECT payroll-out-file ASSIGN TO 'output.txt'.
DATA DIVISION.
FILE SECTION.
FD payroll-in-file
LABEL RECORDS ARE STANDARD.
01 payroll-in-record.
05 i-unused-01 PIC X.
05 i-emp-num PIC X(5).
05 i-dpt-num PIC X(5).
05 1-unused-02 PIC X(6).
05 i-hrs-wkd PIC 9(4).
05 i-base-pay-rt PIC 9(2)v99.
05 i-mncpl-code PIC X(2).
FD payroll-out-file
LABEL RECORDS ARE STANDARD.
01 payroll-out-record.
05 o-emp-num PIC X(5).
05 FILLER PIC XX.
05 o-hrs-wkd PIC 9(5).
05 FILLER PIC XX.
05 o-base-pay-rt PIC 9(3).99.
05 FILLER PIC XX.
05 o-grs-pay PIC 9(5).99.
05 FILLER PIC XX.
05 o-fed-tax PIC 9(5).99.
05 FILLER PIC XX.
05 o-state-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-city-tax PIC 9(4).99.
05 FILLER PIC XX.
05 o-net-pay PIC 9(5).99.
WORKING-STORAGE SECTION.
01 w-out-of-data-flag PIC X.
01 w-grs-pay PIC 99999V99.
01 w-fed-tax PIC 99999V99.
01 w-state-tax PIC 9999V99.
01 w-city-tax PIC 9999V99.
PROCEDURE DIVISION.
A000-main-line-routine.
OPEN INPUT payroll-in-file
OUTPUT payroll-out-file.
MOVE 'N' TO w-out-of-data-flag.
READ payroll-in-file
AT END MOVE 'Y' TO w-out-of-data-flag.
PERFORM B010-process-payroll
UNTIL w-out-of-data-flag = 'Y'.
CLOSE payroll-in-file
payroll-out-file.
STOP RUN.
B010-process-payroll.
MOVE SPACES TO payroll-out-record.
IF i-hrs-wkd IS NOT GREATER THAN 37.5
MULTIPLY i-hrs-wkd BY i-base-pay-rt GIVING w-grs-pay ROUNDED
ELSE
COMPUTE w-grs-pay ROUNDED =
(i-base-pay-rt * 37.5) + (1.5 * (i-base-pay-rt) * (i-hrs-wkd - 37.5))
END-IF.
MULTIPLY w-grs-pay BY 0.25
GIVING w-fed-tax ROUNDED.
MULTIPLY w-grs-pay BY 0.05
GIVING w-state-tax ROUNDED.
IF i-mncpl-code = 03
MULTIPLY w-grs-pay BY 0.015 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 07
MULTIPLY w-grs-pay BY 0.02 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 15
MULTIPLY w-grs-pay BY 0.0525 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 23
MULTIPLY w-grs-pay BY 0.0375 GIVING w-city-tax ROUNDED
ELSE IF i-mncpl-code = 77
MULTIPLY w-grs-pay BY 0.025 GIVING w-city-tax ROUNDED
END-IF.
input file:
AA34511ASD 0037115003
AA45611WER 0055120007
BB98722TYU 0025075015
BB15933HUJ 0080200023
FF35799CGB 0040145077
(each line begins with 1 space, which corresponds to "i-unused-01" in the code)
output file (so far):
AA345 00037 011.50 00425.50 00106.38 0021.28 0006.38 00291.46 AA45 0 005 051.20 00425.50 00106.38 0021.28 0006.38 00291.46
BB9 0 00 025.07 00425.50 00106.38 0021.28 0006.38 00291.465
BB 0 0 008.02 00425.50 00106.38 0021.28 0006.38 00291.4623
F 0 000.40 10673.10 02668.28 0533.66 0006.38 07464.78
^it prints just like that!
Using OpenCOBOL compiler in Linux.
I didn't look at the code in detail, but two things are worth looking at.
Firstly, the output file should probably be "line sequential", as this will insert a delimiter (carraige return/newline), which means that the output file will print as one record per line.
Also, there may be a difference of one character, between the number of characters in your input record, i.e. your actual data, and the the number of characters defined in your input FD.
As colemanj said, you need to change the output file to line sequential
But you also need to change the input file / input file definition.
The 2 options are
1) change the Input file to line sequential (bring the definition into line with the file
2) Remove carraige returns from the input file to (all on one line):
AA34511ASD 0037115003 AA45611WER 0055120007 BB98722TYU 0025075015 BB15933HUJ 0080200023 FF35799CGB 0040145077
The current input file definition indicates there is no carriage returns in the file.
--------------------------------------------------
This might be due to the Mingw Open COBOL version you use. As it is documented here
ORGANIZATION IS LINE SEQUENTIAL
These are files with the simplest of all internal structures. Their contents are structured simply as a series of data records, each terminated by a special end-of-record delimiter character. An ASCII line-feed character (hexadecimal 0A) is the end-of-record delimiter character used by any UNIX or pseudo-UNIX (MinGW, Cygwin, MacOS) OpenCOBOL build. A truly native Windows build would use a carriage-return, line-feed (hexadecimal 0D0A) sequence.

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.

COBOL issue - issue from a beginner , please guide

I want to acheive the below
a string of pic X(5) contains A1992 and is incremented to A9999 , after it reaches A9999 , the A should be replaced by B and the other characters should be reinitialized to 0000 ie B0000 , this should happen until Z9999 , is it possible somehow ?
or if you could show me how to increment A till Z that would be suffice
You will need to do some manual character manipulation on this one. There are several parts, first, you need to handle the simple addition of the numeric portion, then you need to handle the rollover of that to increment the alpha portion.
Data structures similar to this might be helpful:
01 Some-Work-Area.
02 Odometer-Char-Vals pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
02 Odometer-Char occurs 27 pic x.
02 Odo-Char-Ndx pic s9(8) binary.
01 My-Odometer.
88 End-Odometer-Value value 'Z9999'.
02 My-Odometer-X pic X.
02 My-Odometer-9 pic 9999.
88 Carry-Is-True value 9999.
This would be used with a simple perform loop like so:
Move 0 to My-Odometer-9
Move 1 to Odo-Char-Ndx
Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X
Perform until End-Odometer-Value
Add 1 to My-Odometer-9
Display My-Odometer
If Carry-Is-True
Move 0 to My-Odometer-9
Add 1 to Odo-Char-Ndx
Move Odometer-Char-Vals (Odo-Char-Ndx) to My-Odometer-X
End-If
End-Perform
That is one way you could do it.
Please note, the code above took some shortcuts (aka skanky hacks) -- like putting a pad cell in the Odometer-Char array so I don't have to range check it. You wouldn't want to use this for anything but examples and ideas.
I'd probably do this with a nested perform loop.
Storage:
01 ws-counter-def
03 ws-counter-def-alpha-list pic x(27) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
03 ws-counter-def-num pic 9(4) comp-3.
01 ws-counter redefines ws-counter-def
03 ws-counter-alpha occurs 27 times indexed by counter-idx pic x.
03 ws-counter-num pic 9(4) comp-3.
01 ws-variable
03 ws-variable-alpha pic X
03 ws-variable-num pic X(4).
Procedure:
Initialize counter-idx.
Move 1992 to ws-counter-num.
Perform varying counter-idx from 1 by 1 until counter-idx > 26
move ws-counter-alpha(counter-idx) to ws-variable-alpha
perform until ws-counter-num = 9999
add 1 to ws-counter-
move ws-counter-num to ws-variable-num.
*do whatever it is you need to do to the pic X(5) value in ws-variable*
end-perform
move zeros to ws-counter-num
end-perform.
Just can't help myself... How about this...
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01.
02 ALL-LETTERS PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
02 LETTERS REDEFINES ALL-LETTERS.
03 LETTER PIC X OCCURS 26 INDEXED BY I.
01 START-NUMBER PIC 9(4).
01 COUNTER.
02 COUNTER-LETTER PIC X.
02 COUNTER-NUMBER PIC 9(4).
PROCEDURE DIVISION.
MOVE 1992 TO START-NUMBER
PERFORM VARYING I FROM 1 BY 1 UNTIL I > LENGTH OF ALL-LETTERS
MOVE LETTER (I) TO COUNTER-LETTER
PERFORM TEST AFTER VARYING COUNTER-NUMBER FROM START-NUMBER BY 1
UNTIL COUNTER-NUMBER = 9999
DISPLAY COUNTER - or whatever else you need to do with the counter...
END-PERFORM
MOVE ZERO TO START-NUMBER
END-PERFORM
GOBACK
.
This will print all the "numbers" beginning with A1992 through to Z9999.
Basically stole Marcus_33's code and twiked it a tiny bit more. If you feel so inclined please upvote his answer, not mine
For lovers of obfuscated COBOL, here's the shortest (portable) version I can think of (assuming a compiler with Intrinsic Functions):
IDENTIFICATION DIVISION.
PROGRAM-ID. so.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ws-counter value "A00".
03 ws-alpha pic x.
03 ws-number pic 99.
PROCEDURE DIVISION.
1.
Perform with test after until ws-counter > "Z99"
Display ws-counter, " " with no advancing
Add 1 To ws-number
On size error
Move zero to ws-number
perform with test after until ws-alpha is alphabetic-upper or > "Z"
Move Function Char (Function Ord( ws-alpha ) + 1) to ws-alpha
end-perform
End-add
End-perform.
END PROGRAM so.
Tested on OpenVMS/COBOL. I shorten the value to X(3) since it's boring to watch run. A non-portable version (if you are aware of the Endianness of your platform) is to redefined the prefix as a S9(4) COMP and increment the low-order bits directly. But that solution wouldn't be any shorter...

A Strange Error (COBOL)

Hey all, got one mountain of a problem here. I have completed a program I had to do for college homework, but when I run it the output shows almost nothing it is suppose to. This only happens when I RUN it though. If I hold F11 to STEP through the whole thing it shows the results as it is suppose to be. Normally I would not ask about something this big but I am stumped. Here is my code:
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SALESAMT-FILE-IN
ASSIGN TO 'SALESAMT.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SALESMAN-FILE-IN
ASSIGN TO 'SALESMAN.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SALESQTR-FILE-IN
ASSIGN TO 'SALESQTR.SEQ'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SALESAMT-FILE-OUT
ASSIGN TO 'SALESAMT.RPT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD SALESMAN-FILE-IN.
01 SALESMAN-RECORD-IN.
05 SM-NUMBER-IN PIC 99.
05 SM-NAME-IN PIC X(20).
FD SALESQTR-FILE-IN.
01 SALESQTR-RECORD-IN.
05 QUARTER-YEAR PIC X.
FD SALESAMT-FILE-IN.
01 SALESAMT-RECORD-IN.
05 SM-NUMBER PIC 99.
05 PIC X.
05 MONTH-NUMBER PIC 9.
05 PIC X.
05 SALES-AMOUNT PIC 9(5).
FD SALESAMT-FILE-OUT.
01 SALESAMT-RECORD-OUT PIC X(80).
WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'.
01 REPORT-START PIC X VALUE 'Y'.
01 LINE-COUNT PIC 99 VALUE ZEROS.
01 LINE-JUMP PIC X VALUE 'Y'.
01 PAGE-NUMBER PIC 99 VALUE ZEROS.
01 QUARTER-CHECK PIC X.
01 ROUTINE-CHECK PIC 99 VALUE ZEROS.
01 SALESMAN-MATH PIC 9(5) VALUE ZEROS.
01 SALESMAN-TOTAL PIC 9(6) VALUE ZEROS.
01 FINAL-M-TOTAL-1 PIC 9(7) VALUE ZEROS.
01 FINAL-M-TOTAL-3 PIC 9(7) VALUE ZEROS.
01 FINAL-M-TOTAL-2 PIC 9(7) VALUE ZEROS.
01 FINAL-TOTAL PIC 9(7) VALUE ZEROS.
01 SM-NUM-M PIC 99 VALUE ZEROS.
01 MORE-TABLE-RECS PIC X VALUE 'Y'.
01 SPACE-LINE PIC X VALUE SPACE.
01 MONTH-NAMES
VALUE 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'.
05 MONTH-TITLES OCCURS 12 TIMES PIC X(3).
01 MONTH-ARRAY.
05 THREE-MONTHS OCCURS 3 TIMES.
10 MONTH-TOTAL OCCURS 99 TIMES PIC 9(7) VALUE ZEROS.
01 SALESMAN-TABLE.
05 TABLE-ENTRIES OCCURS 99 TIMES
INDEXED BY IND-TABLE-ENTRIES.
10 SALESMAN-NUMBER PIC 99 VALUE ZEROS.
10 SALESMAN-NAME PIC X(20) VALUE SPACES.
01 SALESMAN-COUNT PIC 9(3) VALUE ZEROS.
01 WS-DATE.
05 RUN-YEAR PIC XX.
05 RUN-MONTH PIC XX.
05 RUN-DAY PIC XX.
01 HEADING-LINE-1.
05 PIC X(17) VALUE SPACES.
05 PIC X(35)
VALUE 'SALES AMOUNTS BY SALESMAN AND MONTH'.
05 PIC X(10) VALUE SPACES.
05 HL-1-DATE.
10 MONTH-2 PIC XX.
10 PIC X VALUE '/'.
10 DAY-2 PIC XX.
10 PIC X VALUE '/'.
10 YEAR-2 PIC XX.
05 PIC X(3) VALUE SPACES.
05 PAGE-1 PIC X(4) VALUE 'PAGE'.
05 PIC X(1) VALUE SPACES.
05 NUMBER-PAGE PIC Z9.
01 HEADING-LINE-2.
05 HL-NUM PIC X(3) VALUE 'NUM'.
05 HL-BLANK-A PIC XX VALUE SPACES.
05 HL-NAME PIC X(4) VALUE 'NAME'.
05 HL-BLANK-B PIC X(20) VALUE SPACES.
05 HL-MONTH-1 PIC X(3) VALUE SPACES.
05 HL-BLANK-C PIC X(8) VALUE SPACES.
05 HL-MONTH-2 PIC X(3) VALUE SPACES.
05 HL-BLANK-D PIC X(8) VALUE SPACES.
05 HL-MONTH-3 PIC X(3) VALUE SPACES.
05 HL-BLANK-E PIC X(10) VALUE SPACES.
05 HL-TOTAL PIC X(5) VALUE 'TOTAL'.
01 DETAIL-LINE.
05 DL-BLANK-A PIC X VALUE SPACES.
05 DL-NUM-COLUMN PIC 99.
05 DL-BLANK-B PIC XX VALUE SPACES.
05 DL-NAME-COLUMN PIC X(17).
05 DL-BLANK-C PIC X(4) VALUE SPACES.
05 DL-MONTH-1 PIC ZZ,Z(3).
05 DL-BLANK-D PIC X(5) VALUE SPACES.
05 DL-MONTH-2 PIC ZZ,Z(3).
05 DL-BLANK-E PIC X(5) VALUE SPACES.
05 DL-MONTH-3 PIC ZZ,Z(3).
05 DL-BLANK-F PIC X(8) VALUE SPACES.
05 DL-TOTAL PIC Z(3),Z(3).
01 TOTALS-LINE.
05 TL-WORDS PIC X(12)
VALUE 'Final Totals'.
05 TL-BLANK-A PIC X(12) VALUE SPACES.
05 MONTH-1-TOTAL PIC Z,Z(3),Z(3).
05 TL-BLANK-A PIC X(2) VALUE SPACES.
05 MONTH-2-TOTAL PIC Z,Z(3),Z(3).
05 TL-BLANK-A PIC X(2) VALUE SPACES.
05 MONTH-3-TOTAL PIC Z,Z(3),Z(3).
05 TL-BLANK-A PIC X(5) VALUE SPACES.
05 MONTH-FINAL-TOTAL PIC Z,Z(3),Z(3).
PROCEDURE DIVISION.
100-MAIN.
OPEN INPUT SALESAMT-FILE-IN, SALESMAN-FILE-IN,
SALESQTR-FILE-IN
OPEN OUTPUT SALESAMT-FILE-OUT
ACCEPT WS-DATE FROM DATE
MOVE RUN-MONTH TO MONTH-2
MOVE RUN-DAY TO DAY-2
MOVE RUN-YEAR TO YEAR-2
PERFORM 200-NEXT-PAGE
PERFORM 300-SALES-ARRAY
PERFORM 400-SALESMAN-NAME
PERFORM 500-PROCESS-FILE
PERFORM 600-FINAL-TOTALS
CLOSE SALESAMT-FILE-IN, SALESMAN-FILE-IN, SALESQTR-FILE-IN
CLOSE SALESAMT-FILE-OUT
STOP RUN.
200-NEXT-PAGE.
ADD 1 TO PAGE-NUMBER
MOVE PAGE-NUMBER TO NUMBER-PAGE
MOVE HEADING-LINE-1 TO SALESAMT-RECORD-OUT
IF REPORT-START = 'N'
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING PAGE
ELSE
MOVE 'N' TO REPORT-START
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING 1 LINE
PERFORM 210-MONTH-CHECK
END-IF.
MOVE HEADING-LINE-2 TO SALESAMT-RECORD-OUT
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING 2 LINES
MOVE ZEROS TO LINE-COUNT.
210-MONTH-CHECK.
READ SALESQTR-FILE-IN
AT END
CONTINUE
NOT AT END
PERFORM 220-MONTH-NAME
END-READ.
220-MONTH-NAME.
EVALUATE QUARTER-YEAR
WHEN = 1 MOVE MONTH-TITLES(1) TO HL-MONTH-1
MOVE MONTH-TITLES(2) TO HL-MONTH-2
MOVE MONTH-TITLES(3) TO HL-MONTH-3
WHEN = 2 MOVE MONTH-TITLES(4) TO HL-MONTH-1
MOVE MONTH-TITLES(5) TO HL-MONTH-2
MOVE MONTH-TITLES(6) TO HL-MONTH-3
WHEN = 3 MOVE MONTH-TITLES(7) TO HL-MONTH-1
MOVE MONTH-TITLES(8) TO HL-MONTH-2
MOVE MONTH-TITLES(9) TO HL-MONTH-3
WHEN = 4 MOVE MONTH-TITLES(10) TO HL-MONTH-1
MOVE MONTH-TITLES(11) TO HL-MONTH-2
MOVE MONTH-TITLES(12) TO HL-MONTH-3
END-EVALUATE.
300-SALES-ARRAY.
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
READ SALESAMT-FILE-IN
AT END
MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 310-STORE-DATA
END-READ
END-PERFORM.
310-STORE-DATA.
MOVE SM-NUMBER TO SM-NUM-M
EVALUATE MONTH-NUMBER
WHEN 1 PERFORM 320-FIRST-MONTH
WHEN 2 PERFORM 330-SECOND-MONTH
WHEN 3 PERFORM 340-THIRD-MONTH
END-EVALUATE.
320-FIRST-MONTH.
ADD SALES-AMOUNT TO
MONTH-TOTAL OF MONTH-ARRAY (1, SM-NUM-M).
330-SECOND-MONTH.
ADD SALES-AMOUNT TO
MONTH-TOTAL OF MONTH-ARRAY (2, SM-NUM-M).
340-THIRD-MONTH.
ADD SALES-AMOUNT TO
MONTH-TOTAL OF MONTH-ARRAY (3, SM-NUM-M).
400-SALESMAN-NAME.
PERFORM UNTIL MORE-TABLE-RECS = 'N'
READ SALESMAN-FILE-IN
AT END
MOVE 'N' TO MORE-TABLE-RECS
NOT AT END
PERFORM 450-TABLE-LOAD
END-READ
END-PERFORM.
450-TABLE-LOAD.
MOVE SM-NUMBER-IN TO SALESMAN-COUNT
MOVE SM-NUMBER-IN TO SALESMAN-NUMBER (SALESMAN-COUNT)
MOVE SM-NAME-IN TO SALESMAN-NAME (SALESMAN-COUNT).
500-PROCESS-FILE.
PERFORM UNTIL ROUTINE-CHECK = 99
ADD 1 TO ROUTINE-CHECK
PERFORM 510-TABLE-SEARCH
END-PERFORM.
510-TABLE-SEARCH.
SEARCH TABLE-ENTRIES
WHEN SALESMAN-NUMBER (ROUTINE-CHECK) = ROUTINE-CHECK
PERFORM 520-WRITE-FILE
WHEN SALESMAN-NUMBER (ROUTINE-CHECK) = 0
CONTINUE
END-SEARCH.
520-WRITE-FILE.
MOVE SALESMAN-NAME (ROUTINE-CHECK) TO DL-NAME-COLUMN
IF DL-NAME-COLUMN = SPACES
MOVE '*** Not Found ***' TO DL-NAME-COLUMN
END-IF
MOVE ROUTINE-CHECK TO DL-NUM-COLUMN
MOVE ROUTINE-CHECK TO SM-NUM-M
MOVE MONTH-TOTAL (1, SM-NUM-M) TO DL-MONTH-1
MOVE DL-MONTH-1 TO SALESMAN-MATH
ADD SALESMAN-MATH TO SALESMAN-TOTAL
ADD SALESMAN-MATH TO FINAL-M-TOTAL-1
ADD SALESMAN-MATH TO FINAL-TOTAL
MOVE MONTH-TOTAL (2, SM-NUM-M) TO DL-MONTH-2
MOVE DL-MONTH-2 TO SALESMAN-MATH
ADD SALESMAN-MATH TO SALESMAN-TOTAL
ADD SALESMAN-MATH TO FINAL-M-TOTAL-2
ADD SALESMAN-MATH TO FINAL-TOTAL
MOVE MONTH-TOTAL (3, SM-NUM-M) TO DL-MONTH-3
MOVE DL-MONTH-3 TO SALESMAN-MATH
ADD SALESMAN-MATH TO SALESMAN-TOTAL
ADD SALESMAN-MATH TO FINAL-M-TOTAL-3
ADD SALESMAN-MATH TO FINAL-TOTAL
IF SALESMAN-TOTAL > 0
MOVE SALESMAN-TOTAL TO DL-TOTAL
MOVE DETAIL-LINE TO SALESAMT-RECORD-OUT
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING 2 LINES
END-IF
MOVE ZEROS TO SALESMAN-TOTAL.
600-FINAL-TOTALS.
MOVE FINAL-M-TOTAL-1 TO MONTH-1-TOTAL
MOVE FINAL-M-TOTAL-2 TO MONTH-2-TOTAL
MOVE FINAL-M-TOTAL-3 TO MONTH-3-TOTAL
MOVE FINAL-TOTAL TO MONTH-FINAL-TOTAL
MOVE TOTALS-LINE TO SALESAMT-RECORD-OUT
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING 3 LINES.
To me it seems that the logic is right as it does work, but for some reason it (in my mind when i see the results) jumps completely over 520-WRITE-FILE when it runs. With this I do leave a few notes.
I know 510-TABLE-SEARCH makes little sense and I intend to change it later, but I need to fix this first and it works for the moment. Unless it is the main problem please don't harass me over it.
I will be willing to add the data in the SEQ files if someone asks me for it.
My code might be a bit complex and I admit to that, but I am doing the best I can with the teacher I have (I mostly have to learn this stuff on my own).
I appreciate any help I receive and thank anyone who tries to help in advance.
edit: I am using a compiler called Micro Focus, Net Express 5.1 Academic Edition and my OS is Windows Vista. As for what the program does show when I run it, it just shows my two heading lines and then my totals-line without anything but the first field showing. I hope that helps.
I don't know for certain if this is the problem, but I can see a logic flow that isn't going to work very well...
First: 400-SALESMAN-NAME reads salesmen records from a file into working storage table SALESMAN-TABLE.
The file probably looks something like:
01Sales Guy One
02Lance Winslow
03Scott Peterson
04Willy Loman
When the read loop is done, SALESMAN-NUMBER will equal the table index because of
the way you load the table (using SM-NUMBER-IN to set the table subscript). No problem so far...
Next: 500-PROCESS-FILE loops through all rows in the SALESMAN-TABLE by running subscript ROUTINE-CHECK from 1 to 99 and performing 510-TABLE-SEARCH to write out the report for the salesman where the subscript equals SALESMAN-NUMBER...
Next: The SEARCH statement. This is where it all goes strange and never performs 520-WRITE-FILE.
This is why.
The SEARCH statement implements a linear search (SEARCH ALL is a binary search). SEARCH just increments the index associated with the searched table and then runs through a bunch of WHEN tests until one of them "fires" or the index runs off the end of the table. The index for your TABLE-ENTRIES table is IND-TABLE-ENTRIES. But you never set or reference it (this is the root of the problem). I will explain in a moment...
Notice that the WHEN part of your SEARCH is using subscript ROUTINE-CHECK. ROUTINE-CHECK was set in 500-PROCESS-FILE. Also notice that you only get to 520-WRITE-FILE if the SALESMAN-NUMBER matches the value of ROUTINE-CHECK - which it will do if a salesman with that number was read from the input file. This could work because you loaded the table such that the row number equals the salesman number back in 450-TABLE-LOAD.
Now, what happens if the input file does not contain a salesman where SM-NUMBER-IN equals 01?
Lets go through it, blow by blow...
ROUTINE-CHECK is set to 1, SEARCH is invoked and because the IND-TABLE-ENTRIES index associated with the searched table is less than the number of occurs in the table (it got initialized to zero on program load), the WHEN clauses are executed.
The first test is WHEN SALESMAN-NUMBER (ROUTINE-CHECK) = ROUTINE-CHECK. Since Salesman 1 doesn't exist, the SALESMAN-NUMBER will be zero and the test fails (0<>1).
The next WHEN clause is tried and it succeeds because (0=0); but this is a 'do nothing' option so another cycle of SEARCH is entered after IND-TABLE-ENTRIES is incremented.
Same results on this and all subsequent iterations through the SEARCHed WHEN list (none of the clauses match)... Repeat this loop until IND-TABLE-ENTRIES is incremented beyond the end of the table.
At this point the SEARCH terminates and control flows back to the next loop in 500-PROCESS-FILE. Nothing has been printed.
500-PROCESS-FILE then increments ROUTINE-CHECK by 1 (now it is 2). We have a salesman with a SALESMAN-NUMBER of 02 so we should get some output - right? Wrong! But why?
If you read up on the SEARCH verb you will find it does not reset the table index (in this case: IND-TABLE-ENTRIES). It starts using whatever value it has when the SEARCH is entered. You never reset it so it is already set beyond the end of the table. SEARCH just terminates and nothing gets printed - ever again.
Fixing the problem
Given that you have loaded TABLE-ENTRIES by salesman number in the first place, I don't see the purpose of using SEARCH. Just do something like:
500-PROCESS-FILE.
PERFORM VARYING ROUTINE-CHECK FROM 1 BY 1
UNTIL ROUTINE-CHECK > 99
IF SALESMAN-NUMBER (ROUTINE-CHECK) = ZERO
CONTINUE
ELSE
PERFORM 520-WRITE-FILE
END-IF
END-PERFORM.
Might also be a good idea to have an initialization loop for the table so that every SALESMAN-NUMBER is explicitly set to zero before you read the salesman file.
If you must use SEARCH in this program, then don't forget to set and use the associated table index variable when referencing the table being searched.
I've added this as a second answer, which I think is correct !
520-WRITE-FILE is not being performed because the SEARCH to call it is failing.
In 510-TABLE-SEARCH, I believe you need to search on the index declared for the table,
IND-TABLE-ENTRIES. You will probably need to re-code 500-PROCESS-FILE and 510-TABLE-SEARCH.
In another question, you asked about the SEARCH verb. fmartin gave a link describing how it works, with examples.
Pls. Change to this:
SELECT SALESAMT-FILE-OUT
ASSIGN TO 'SALESAMT.RPT'
ORGANIZATION IS LINE SEQUENTIAL
File Status is FILESTATUS.
And add this:
01 FILESTATUS.
02 FILESTATUS-1 Pic 9.
88 SUCCESSFULL Value 0.
88 END-OF-FILE Value 1.
88 INVALID-KEY Value 2.
88 PERMANENT-ERROR Value 3, 9.
02 FILESTATUS-2 Pic 9.
88 DUPLICATE-KEY Value 2.
88 NO-RECORD-FOUND Value 3.
88 FILE-IS-FULL Value 4.
Check FILESTATUS every time u do something with SALESAMT-FILE-OUT. (u can do with the other files as well).
With the help of this modification u will be able to see if there is any error when u do an IO.
This is the first step, so this is not the final answare for ure question..
"it just shows my two heading lines and then my totals-line"
In your paragraph 520-WRITE-FILE, you have the following code
IF SALESMAN-TOTAL > 0
MOVE SALESMAN-TOTAL TO DL-TOTAL
MOVE DETAIL-LINE TO SALESAMT-RECORD-OUT
WRITE SALESAMT-RECORD-OUT
AFTER ADVANCING 2 LINES
END-IF
If SALESMAN-TOTAL is zero, your program will not print detail lines.
It looks like you have a data or logic error in your totalling of SALESMAN-TOTAL.
I think that you have a fairly simple problem, which has to do with your current working directory.
In the environment division, you declare the file handles and assign them to file names.
When you debug the program, the input files are in your current working directory and are therefore resolved correctly.
When you run the program, I guess you're running it from a different directory, so the input files are not resolved and therefore the output file contains only a single header line.

Resources