I was working on a brute-force implementation of this RosettaCode challenge. I wanted to be able to handle numbers bigger than USAGE BINARY-DOUBLE so I wrote a dead simple bignum routine for adding.
If I want to limit myself to a certain number of iterations and that number is greater than 9(18) then that's tricky. So I hit upon the idea of an 88 on a particular element of the array, thus the code below.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
03 FILLER REDEFINES DIGITS1.
05 FILLER pic 9999999999.
05 FILLER pic 999999999.
05 filler pic 9.
88 EOR value 1.
05 filler pic 9999999999.
05 filler pic 9999999999.
So I'm still wondering if this is the only way to go or is there some other way of handling when I get to 10^20.
This is the full "solution". It's a mess but it almost working.
identification division.
program-id. Program1.
data division.
working-storage section.
01 COUNTER.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
03 FILLER REDEFINES DIGITS1.
05 filler pic 9999999999.
05 FILLER pic 9999999999.
05 filler pic 9999999999.
05 filler pic 999.
05 filler pic 9.
88 EOR value 1.
05 filler pic 999999.
01 INCREMENTOR.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 ACCUMULATOR.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 IN-NUMBER usage binary-double unsigned.
01 I USAGE BINARY-DOUBLE UNSIGNED.
01 N USAGE BINARY-DOUBLE UNSIGNED.
01 THREE-COUNTER USAGE BINARY-CHAR value 1.
88 IS-THREE VALUE 3.
01 FIVE-COUNTER USAGE BINARY-CHAR value 1.
88 IS-FIVE VALUE 5.
01 ANSWER pic x(40).
procedure division.
initialize COUNTER ACCUMULATOR incrementor.
10-MAIN-PROCEDURE.
move 1 to IN-NUMBER.
call "MOVENUMTOBIGNUM" using by content in-number
by reference incrementor.
move 1 to IN-NUMBER.
call "MOVENUMTOBIGNUM" using by content in-number
by reference counter.
PERFORM 20-INNER-LOOP WITH TEST AFTER UNTIL eor.
move ACCUMULATOR to ANSWER.
inspect answer REPLACING LEADING '0'
by space.
DISPLAY answer.
STOP RUN.
20-INNER-LOOP.
IF IS-THREE OR IS-FIVE
call "ADDBIGNUMS" using by content counter
by reference accumulator
IF IS-THREE
MOVE 1 TO THREE-COUNTER
ELSE
ADD 1 TO THREE-COUNTER
END-IF
IF IS-FIVE
MOVE 1 TO FIVE-COUNTER
ELSE
ADD 1 TO FIVE-COUNTER
END-IF
ELSE
ADD 1 TO FIVE-COUNTER END-ADD
ADD 1 TO THREE-COUNTER END-ADD
END-IF.
call "ADDBIGNUMS" using by content INCREMENTOR
by reference counter.
EXIT.
end program Program1.
identification division.
PROGRAM-ID. MOVENUMTOBIGNUM.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 num-MOD usage binary-CHAR.
01 num-DIV usage binary-DOUBLE unsigned.
01 IN-COUNTER usage binary-char.
LINKAGE SECTION.
01 num usage binary-double.
01 BIGNUM.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
PROCEDURE DIVISION USING NUM BIGNUM.
10-MOVE.
move 40 to IN-COUNTER.
perform until num = 0
divide num by 10
giving num-DIV
REMAINDER num-MOD
end-divide
move num-MOD to DIGITS1 of BIGNUM(IN-COUNTER)
move NUM-DIV to NUM
subtract 1 from IN-COUNTER end-subtract
END-PERFORM.
GOBACK.
END PROGRAM MOVENUMTOBIGNUM.
*Add Bignum to Bignum, modifying second Bignum in situ
identification division.
program-id. ADDBIGNUMS.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 IN-COUNTER usage binary-char.
01 ADD-FLAG pic 9.
88 STILL-ADDING VALUE 0.
88 DONE-ADDING VALUE 9.
01 CARRIER usage binary-char.
01 REGISTER-A usage binary-char.
LINKAGE SECTION.
01 BIGNUM1.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
01 BIGNUM2.
03 DIGITS1 OCCURS 40 TIMES PIC 9.
PROCEDURE DIVISION USING BIGNUM1 BIGNUM2.
10-ADD-WITH-CARRY.
move zero to CARRIER.
move 40 to IN-COUNTER.
move zero to ADD-FLAG.
perform until DONE-ADDING
add DIGITS1 of BIGNUM1(IN-COUNTER)
DIGITS1 of BIGNUM2(IN-COUNTER)
CARRIER GIVING REGISTER-A
END-ADD
move zero to CARRIER
if REGISTER-A > 9
divide REGISTER-A by 10
giving CARRIER
remainder REGISTER-A
end-divide
else
if REGISTER-A = zero
move 9 to ADD-FLAG
END-IF
end-if
if STILL-ADDING
move REGISTER-A to DIGITS1 of BIGNUM2(IN-COUNTER)
subtract 1 from IN-COUNTER end-subtract
end-if
END-PERFORM.
goback.
END PROGRAM ADDBIGNUMS.
Although you already don't seem to like the structure, I'll stick to it. It will work with your structure as well. No need for the REDEFINES or those other FILLERs.
05 FILLER.
10 FILLER OCCURS 40 TIMES.
15 DIGITS1 PIC 9.
88 DIGITS1-MEANS-SOMETHING
VALUE 1.
01 NAME-THAT-REVEALS-INFORMATION BINARY PIC 9(4).
IF DIGITS1-MEANS-SOMETHING
( NAME-THAT-REVEALS-INFORMATION )
do some stuff
END-IF
I've changed you PIC 9 to PIC X. Unless you are doing calculations, there is never a need to define a field as 9 for "numeric". If a field happens to contain numbers, or happens to have the word number, or something like that in its name, don't be tricked into defining it as a number.
Extra (generated) code ensues and it carries the meaning "numeric stuff will be done with this", so misleads. If/when you need to do a "numeric edit" for output, there's always the REDEFINES at that point. Doesn't have to have these other costs to make that happen.
I've now reverted to your PIC 9, as, after your edit, I can see you are using it for calculations :-)
Related
I am a newbie of COBOL, I am facing the following problem.
I have a input file with content:
2 3 2 4
4 numbers are in the same row and separated with exactly one space.
the 4 numbers can be in 1 digit, 2 digit and 3 digit
Can I put those 4 numbers to 4 variables with PIC?
such as: PIC XXX XXX XXX XXX (This is not working.)
currently I am using substring to achieve the task, but this is not efficient and messy, is there any other way i can finish the task easily?
Thanks
You can do this by two ways. Number one is to use unstring sentence. Or you can declare a variable level 01 and define in it every variable of the string separately.
For example:
01 WS-FILE.
05 WS-FIELD-01 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-02 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-03 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-04 PIC 9.
05 FILLER PIC X.
And when you read the file use:
READ FILE INTO WS-FILE.
You can use an UNSTRING function (i dont know if you refer to that with substring)
UNSTRING WS-FILE-RECORD DELIMITED BY SPACE
INTO WS-FIELD1
WS-FIELD2
WS-FIELD3
WS-FIELD4
END-UNSTRING
with this if you have:
WS-FILE-RECORD="1 2 3 4"
WS-FIELD1 = "1"
WS-FIELD2 = "2"
WS-FIELD3 = "3"
WS-FIELD4 = "4"
or if you have:
WS-FILE-RECORD="1 22 333 4444"
WS-FIELD1 = "1"
WS-FIELD2 = "22"
WS-FIELD3 = "333"
WS-FIELD4 = "4444"
01 YOUR-NUMBERS.
03 YOUR-NUMBER PIC 9(04) OCCURS 4.
01 INDEX-YOUR-NUMBERS PIC 9(01).
01 YOUR-RECORD.
03 YOUR-RECORD-4.
05 YOUR-RECORD-4-NUM PIC X(04).
05 FILLER PIC X(01).
05 YOUR-RECORD-4-REST.
07 FILLER PIC X(09).
07 YOUR-RECORD-4-END PIC X(05).
03 YOUR-RECORD-3 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-3-NUM PIC X(03).
05 FILLER PIC X(01).
05 YOUR-RECORD-3-REST.
07 FILLER PIC X(11).
07 YOUR-RECORD-3-END PIC X(04).
03 YOUR-RECORD-2 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-2-NUM PIC X(02).
05 FILLER PIC X(01).
05 YOUR-RECORD-2-REST.
07 FILLER PIC X(13).
07 YOUR-RECORD-2-END PIC X(03).
03 YOUR-RECORD-1 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-1-NUM PIC X(01).
05 FILLER PIC X(01).
05 YOUR-RECORD-1-REST.
07 FILLER PIC X(15).
07 YOUR-RECORD-1-END PIC X(02).
MOVE SPACES TO YOUR-RECORD.
READ YOUR-RECORD.
PERFORM 0100-FIND-NUMBERS
VARYING INDEX-YOUR-NUMBERS
FROM 1
TO 4.
0100-FIND-NUMBERS.
IF YOUR-RECORD-4-NUM IS NUMERIC
MOVE YOUR-RECORD-4-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-4-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-4-END
ELSE
IF YOUR-RECORD-3-NUM IS NUMERIC
MOVE YOUR-RECORD-3-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-3-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-3-END
ELSE
IF YOUR-RECORD-2-NUM IS NUMERIC
MOVE YOUR-RECORD-2-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-2-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-2-END
ELSE
MOVE YOUR-RECORD-1-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-1-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-1-END.
Here's a way to do it. Maybe not a good way. Maybe not an efficient way. Maybe not an easy way. But certainly a way that doesn't involve string/unstring - using PIC only. ish.
You could create a little state machine that ran through and calculated every number as it goes. There are many advantages to approaching things on a character by character basis for parsing. The code is usually very simple, especially with a simple regex like number or whitespace.
Identification Division.
Program-ID. PARSENUM.
Data Division.
Working-Storage Section.
01 II comp-5 pic s9(8) value 0.
01 Num-Val comp-5 pic s9(8) value 0.
01 In-Str pic x(80).
01 In-Ch pic 9.
01 pic x(1).
88 In-Number value 'N'.
88 In-Whitespace value 'W'.
Procedure Division.
*> Fake up some data...
Move '1 212 303 44 5678 6 75 888 976' to In-Str
*> Parse Numbers
Set In-Whitespace to true
Perform varying II from 1 by 1
until II > Length of In-Str
If In-Str (II:1) is numeric
Move In-Str (II:1) to In-Ch
Evaluate true
when In-Whitespace
Compute Num-Val = In-Ch
Set In-Number to true
when In-Number
Compute Num-Val = (Num-Val * 10) + In-Ch
End-Evaluate
Else
If In-Number
Display 'Found Number: ' Num-Val
Set In-Whitespace to true
End-If
End-If
End-Perform
Goback.
You should get output that looks like:
Found Number: +0000000001
Found Number: +0000000212
Found Number: +0000000303
Found Number: +0000000044
Found Number: +0000005678
Found Number: +0000000006
Found Number: +0000000075
Found Number: +0000000888
Found Number: +0000000976
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.
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.
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...
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.