I have a field containing article-numbers (PIC X(25)).
Example article number: 12345-6789.
The problem is the "-", I need to delete the "-" and put together the 5 and 6, result example: 123456789
Using Micro Focus Net Express 5.1 running on a UNIX server. The position of the dash is not fixed.
Take this code for a spin.
Update: Good catch, Bill. I just wanted to give options, depending what the needs and demands truly were.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
* ClassIncludeList and ClassExcludeList can now be referenced much like NUMERIC
CLASS ClassIncludeList IS '0123456789'
CLASS ClassExcludeList IS '-'
.
WORKING-STORAGE SECTION.
01 InputStringText PIC X(1000).
01 InputStringLength PIC 9(04) COMP.
01 OutputStringText PIC X(1000).
01 OutputStringLength PIC 9(04) COMP.
01 ByteSubscript PIC 9(04) COMP.
PROCEDURE DIVISION.
MOVE article-numbers TO InputStringText.
MOVE FUNCTION LENGTH(article-numbers) TO InputStringLength.
PERFORM IncludeCharacters.
* Use OutputStringText(OutputStringLength)
PERFORM ExcludeCharacters.
* Use OutputStringText(OutputStringLength)
IncludeCharacters.
MOVE SPACES TO OutputStringText
MOVE ZERO TO OutputStringLength
PERFORM
VARYING ByteSubscript FROM 1 BY 1
UNTIL ByteSubscript > InputStringLength
IF (InputStringText(ByteSubscript:1) IS ClassIncludeList)
ADD 1 TO OutputStringLength
MOVE InputStringText(ByteSubscript:1)
TO OutputStringText(OutputStringLength:1)
END-IF
END-PERFORM
.
ExcludeCharacters.
MOVE SPACES TO OutputStringText
MOVE ZERO TO OutputStringLength
PERFORM
VARYING ByteSubscript FROM 1 BY 1
UNTIL ByteSubscript > InputStringLength
IF (InputStringText(ByteSubscript:1) IS ClassExcludeList)
CONTINUE
ELSE
ADD 1 TO OutputStringLength
MOVE InputStringText(ByteSubscript:1)
TO OutputStringText(OutputStringLength:1)
END-IF
END-PERFORM
.
There's always UNSTRING and STRING if your Cobol supports them, and if there is a limit to how many 'parts' there are going to be in the text.
01 ARTICLE-NUMBER PIC X(25).
01 PARTS.
05 PART1 PIC X(25).
05 PART2 PIC X(25).
05 PART3 PIC X(25).
05 PART4 PIC X(25).
01 RESULT PIC X(25).
........
INITIALIZE PARTS, RESULT.
UNSTRING ARTICLE-NUMBER
DELIMITED BY '-'
INTO PART1, PART2, PART3, PART4
ON OVERFLOW
DISPLAY "Too many parts!!!"
END-UNSTRING.
STRING PART1, PART2, PART3, PART4
DELIMITED BY SPACE INTO RESULT.
Hope this helps.
The following should work on any modern COBOL:
01 INPUT-STRING PIC X(25).
01 OUTPUT-STRING PIC X(25).
01 IX PIC S9(8) COMP SYNC.
01 OX PIC S9(8) COMP SYNC.
...
MOVE +1 TO OX.
MOVE ALL ' ' TO OUTPUT-STRING.
PERFORM VARYING IX FROM 1 BY 1
UNTIL IX > 25
IF NOT INPUT-STRING(IX:1) = '-'
THEN
MOVE INPUT-STRING(IX:1) TO OUTPUT-STRING(OX:1)
ADD +1 TO OX
END-IF
END-PERFORM.
Related
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 :-)
I am a newbie of COBOL, I am facing the following problem.
I have a input file with content:
2 3 2 4
4 numbers are in the same row and separated with exactly one space.
the 4 numbers can be in 1 digit, 2 digit and 3 digit
Can I put those 4 numbers to 4 variables with PIC?
such as: PIC XXX XXX XXX XXX (This is not working.)
currently I am using substring to achieve the task, but this is not efficient and messy, is there any other way i can finish the task easily?
Thanks
You can do this by two ways. Number one is to use unstring sentence. Or you can declare a variable level 01 and define in it every variable of the string separately.
For example:
01 WS-FILE.
05 WS-FIELD-01 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-02 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-03 PIC 9.
05 FILLER PIC X.
05 WS-FIELD-04 PIC 9.
05 FILLER PIC X.
And when you read the file use:
READ FILE INTO WS-FILE.
You can use an UNSTRING function (i dont know if you refer to that with substring)
UNSTRING WS-FILE-RECORD DELIMITED BY SPACE
INTO WS-FIELD1
WS-FIELD2
WS-FIELD3
WS-FIELD4
END-UNSTRING
with this if you have:
WS-FILE-RECORD="1 2 3 4"
WS-FIELD1 = "1"
WS-FIELD2 = "2"
WS-FIELD3 = "3"
WS-FIELD4 = "4"
or if you have:
WS-FILE-RECORD="1 22 333 4444"
WS-FIELD1 = "1"
WS-FIELD2 = "22"
WS-FIELD3 = "333"
WS-FIELD4 = "4444"
01 YOUR-NUMBERS.
03 YOUR-NUMBER PIC 9(04) OCCURS 4.
01 INDEX-YOUR-NUMBERS PIC 9(01).
01 YOUR-RECORD.
03 YOUR-RECORD-4.
05 YOUR-RECORD-4-NUM PIC X(04).
05 FILLER PIC X(01).
05 YOUR-RECORD-4-REST.
07 FILLER PIC X(09).
07 YOUR-RECORD-4-END PIC X(05).
03 YOUR-RECORD-3 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-3-NUM PIC X(03).
05 FILLER PIC X(01).
05 YOUR-RECORD-3-REST.
07 FILLER PIC X(11).
07 YOUR-RECORD-3-END PIC X(04).
03 YOUR-RECORD-2 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-2-NUM PIC X(02).
05 FILLER PIC X(01).
05 YOUR-RECORD-2-REST.
07 FILLER PIC X(13).
07 YOUR-RECORD-2-END PIC X(03).
03 YOUR-RECORD-1 REDEFINES YOUR-RECORD-4.
05 YOUR-RECORD-1-NUM PIC X(01).
05 FILLER PIC X(01).
05 YOUR-RECORD-1-REST.
07 FILLER PIC X(15).
07 YOUR-RECORD-1-END PIC X(02).
MOVE SPACES TO YOUR-RECORD.
READ YOUR-RECORD.
PERFORM 0100-FIND-NUMBERS
VARYING INDEX-YOUR-NUMBERS
FROM 1
TO 4.
0100-FIND-NUMBERS.
IF YOUR-RECORD-4-NUM IS NUMERIC
MOVE YOUR-RECORD-4-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-4-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-4-END
ELSE
IF YOUR-RECORD-3-NUM IS NUMERIC
MOVE YOUR-RECORD-3-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-3-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-3-END
ELSE
IF YOUR-RECORD-2-NUM IS NUMERIC
MOVE YOUR-RECORD-2-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-2-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-2-END
ELSE
MOVE YOUR-RECORD-1-NUM TO YOUR-NUMBER(INDEX-YOUR-NUMBERS)
MOVE YOUR-RECORD-1-REST TO YOUR-RECORD-4
MOVE SPACES TO YOUR-RECORD-1-END.
Here's a way to do it. Maybe not a good way. Maybe not an efficient way. Maybe not an easy way. But certainly a way that doesn't involve string/unstring - using PIC only. ish.
You could create a little state machine that ran through and calculated every number as it goes. There are many advantages to approaching things on a character by character basis for parsing. The code is usually very simple, especially with a simple regex like number or whitespace.
Identification Division.
Program-ID. PARSENUM.
Data Division.
Working-Storage Section.
01 II comp-5 pic s9(8) value 0.
01 Num-Val comp-5 pic s9(8) value 0.
01 In-Str pic x(80).
01 In-Ch pic 9.
01 pic x(1).
88 In-Number value 'N'.
88 In-Whitespace value 'W'.
Procedure Division.
*> Fake up some data...
Move '1 212 303 44 5678 6 75 888 976' to In-Str
*> Parse Numbers
Set In-Whitespace to true
Perform varying II from 1 by 1
until II > Length of In-Str
If In-Str (II:1) is numeric
Move In-Str (II:1) to In-Ch
Evaluate true
when In-Whitespace
Compute Num-Val = In-Ch
Set In-Number to true
when In-Number
Compute Num-Val = (Num-Val * 10) + In-Ch
End-Evaluate
Else
If In-Number
Display 'Found Number: ' Num-Val
Set In-Whitespace to true
End-If
End-If
End-Perform
Goback.
You should get output that looks like:
Found Number: +0000000001
Found Number: +0000000212
Found Number: +0000000303
Found Number: +0000000044
Found Number: +0000005678
Found Number: +0000000006
Found Number: +0000000075
Found Number: +0000000888
Found Number: +0000000976
How 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.
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.