Cobol storing file to table - cobol

I'm trying to store a pattern received from text file into a table in COBOL.
I am using READ.. INTO.. statement to do so, and here is what I have so far.
WORKING-STORAGE SECTION.
01 ROWCOL.
03 NROW PIC 9(3).
03 NCOL PIC 9(2).
01 PATT-INIT.
03 ROW PIC X OCCURS 1 TO 80 TIMES
DEPENDING ON NCOL.
01 PATT.
03 COL OCCURS 1 TO 80 TIMES
DEPENDING ON NCOL.
05 ROW OCCURS 1 TO 100 TIMES
DEPENDING ON NROW PIC X.
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
OPEN INPUT INPUT-FILE.
READ INPUT-FILE INTO ROWCOL.
PERFORM READ-PATTERN
STOP RUN.
READ-PATTERN.
READ INPUT-FILE INTO PATT-INIT(1:NCOL).
The pattern in the input.txt would look something like this:
011000
001010
010100
The thing about this is that, I'm not sure how to place the PATT-INIT array into the PATT 2d-array. I'm only using the PATT-INIT array to receive row-by-row the pattern in each line. Then, I'm trying to store it into PATT 2d array such that I can access each number by the index numbers. e.g. PATT(1:2) would return 1.
Please give me some pointers on how to implement this. If READ.. INTO.. is not the way to go, I'm more than happy to receive other suggestions.

I think part of your problem is that you think things like (1:NCOL) are doing one thing, when in fact they mean something completely different. The notation indicate "reference modification". You probably are expecting ordinary subscripting, or at least "reference modification" from a variable starting point with a fixed length of one.
01 a-nicely-name-table.
05 FILLER OCCURS 80 TIMES.
10 a-nicely-named-row-entry.
15 FILLER OCCURS 6 TIMES.
20 a-nicely-named-column-entry PIC X.
The data from your READ goes into a-nicely-name-row-entry ( subscripted ). Once everything is there, you can reference a paricular column on a particula row by a-nicely-named-column-entry ( a-row-subcript, a-column-subscript ).
Note, without the ":" this is subscripting, not "reference modification". The comma is optional.
You need to ensure that you don't go "outside" the bounds of the number of rows you put in the table, and also that you do not "overflow" the table with input data.
You can use indexes for subscripting (INDEXED BY on the OCCURS definition). I haven't in the example, as it is unclear what you are trying to achieve.

If I am understanding your question properly, there may be a couple of problems. Bill an Bruce have noted
that you seem to be mixing up subscript and reference modification. Basically
something like:
DISPLAY PATT-INT (1:3)
will display the first 3 characters of PATT-INT. This is a reference modification. While
DISPLAY ROW OF PATT (1, 3)
will display the character at COL 1, ROW 3 of the PATT table. Notice that you need to reference the "lowest" level element name here so maybe renaming some of your data structures make it a little easier to "follow".
The other problem might be a confusion between rows and columns...
The input-txt file you gave has 3 lines of data (rows). Each line has 6 characters (columns). Your
declaration of PATT-INIT seems to re-enforce that since it has an OCCURS NCOL times. When you read one
line of data you get 6 columns for that row. However, the PATT
table flips this on its side. It is declared with a Column then Row layout.
This layout means you cannot read directly into it from input.txt because the table declaration
does not follow the file layout.
Two solutions to that problem.
This is the one I think you might have been trying to work toward:
Read each input.txt line and store it in PATT such that it
becomes 6 columns in PATT for the same row. For example the first row of input: 011000 would be
stored in PATT (1, 1) through PATT (6, 1), 6 columns, 1 row. Note: You
indicated that ROW OF PATT (1, 2) should have a value of '1' - here ROW OF PATT (2, 1) would be '1'.
That aside, you could read one line of input into a single dimension array (PATT-INIT) and then
redistribute it into
the PATT table. Here is a program outline:
MAIN-PARAGRAPH.
OPEN INPUT INPUT-FILE
READ INPUT-FILE INTO ROWCOL
PERFORM VARYING WS-R FROM 1 BY 1
UNTIL WS-R > NROW
PERFORM READ-1-ROW
END-PERFORM
CLOSE INPUT-FILE
.
READ-1-ROW.
READ INPUT-FILE INTO PATT-INIT (1:NCOL)
PERFORM VARYING WS-C FROM 1 BY 1
UNTIL WS-C > NCOL
MOVE ROW OF PATT-INIT (WS-C) TO ROW OF PATT (WS-C, WS-R)
END-PERFORM
.
The other solution might to be redefine PATT as
01 PATT.
03 ROW OCCURS 1 TO 100 TIMES
DEPENDING ON NROW.
05 COL OCCURS 1 TO 80 TIMES
DEPENDING ON NCOL PIC X.
Now you can simply read as follows:
MAIN-PARAGRAPH.
OPEN INPUT INPUT-FILE
READ INPUT-FILE INTO ROWCOL
PERFORM VARYING WS-R FROM 1 BY 1
UNTIL WS-R > NROW
READ INPUT-FILE INTO ROW (WS-R) (1:NCOL)
END-PERFORM
CLOSE INPUT-FILE
You can drop the PATT-INIT working storage since it is no longer referenced.
Note: With this layout COL OF PATT (1, 2) = '1'
Flesh out the above with proper data edits, bounds checks and FILE-STATUS checking after each I/O to
complete the program.

The problem is not the read into it is with PATT-INIT(1:NCOL). This is called
Reference Modification.
Cobol does Line or record orientated IO. so
READ INPUT-FILE INTO PATT-INIT
is probably what you want. To access an array element use (i,j) not (i:j)

Related

PC COBOL program to JCL

I have the following simple COBOL program - written for the PC. It simply reads a file from the computer and writes to the file:
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSTOMER-FILE ASSIGN TO
"C:Customers.dat"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CUSTOMER-FILE.
01 CUSTOMER-RECORD.
05 FIRST-NAME PIC X(20).
05 LAST-NAME PIC X(20).
WORKING-STORAGE SECTION.
01 WS-CUSTOMER-RECORD.
05 WS-FIRST-NAME PIC X(20).
05 WS-LAST-NAME PIC X(20).
01 WS-EOF PIC X.
PROCEDURE DIVISION.
OPEN OUTPUT CUSTOMER-FILE
PERFORM UNTIL CUSTOMER-RECORD = SPACES
DISPLAY "Enter the first and last name for the customer"
ACCEPT CUSTOMER-RECORD
WRITE CUSTOMER-RECORD
END-PERFORM
CLOSE CUSTOMER-FILE
DISPLAY "Output from the Customer File:"
OPEN INPUT CUSTOMER-FILE.
PERFORM UNTIL WS-EOF = 'Y'
READ CUSTOMER-FILE INTO WS-CUSTOMER-RECORD
AT END MOVE 'Y' TO WS-EOF
NOT AT END DISPLAY WS-CUSTOMER-RECORD
END-READ
END-PERFORM.
CLOSE CUSTOMER-FILE.
GOBACK.
My question: I'm not too familiar with JCL. So if I were to put this program on a mainframe, what would I do for the JCL?
I presume your Identification Division got lost in a cut & paste incident on its way to Stack Overflow; you'll need that.
The current incarnation of IBM Enterprise COBOL does not allow free format source so in order to get your code to compile you would have to reformat and follow the traditional fixed format.
Rather than referring to your data file by name, your Assign clause must refer to a name (limited to 8 characters) which corresponds to a DD name in your JCL. Pick something meaningful, to the extent you can in 8 characters, maybe CUSTOMER.
Since you're running with JCL, your Accept statement will work a bit differently. Probably data will come from a SYSIN DD.
Your JCL will look something like this...
[job card, which is shop-specific]
//TOMSPGM EXEC PGM=yourProgramName
//STEPLIB DD DISP=SHR,DSN=mainframe.dataset.where.you.bound.your.program
//SYSIN DD *
[your customer records]
//CUSTOMER DD DISP=(NEW,CATLG,DELETE),
// DSN=mainframe.dataset.where.your.data.should.end.up,
// LRECL=40,
// AVGREC=U,
// RECFM=FB,
// SPACE=(40,(10,10),RLSE) Adjust to your needs
//SYSOUT SYSOUT=*
//CEEDUMP SYSOUT=*
I'm not sure how this will work with your creating the customer file and then reading it in the same program. In 30 years of mainframe work I've never seen that.
Adding to answer from #cschneid.
Great to see AVGREC is being used on the DD statement to allocate space for the data set. This is much better than using the old-fashioned CYL, or TRK units.
Unfortunately, IMHO, the IBM z/OS architects missed to implement a more modern was to specify space: KiB, or MiB. (ISPF supports KB, and MB as space unit, JCL doesn't.)
With AVGREC you tell the system that the SPACE= primary and secondary space values are number of records, instead of physical units such as tracks, or cylinders.
//CUSTOMER DD ...
// AVGREC=U,
// SPACE=(40,(10,20),RLSE)
Above statement tells the system that the records written will have an average length of 40 bytes (this completely is independent of RECFM=, or LRECL=!). With AVGREC=U (U means units), this further tells the system to allocate initial (primary) space for 10 records, and to add additional space for 20 records each time more space is needed (with an upper limit).
Physical allocations are still in tracks, or cylinders under the hood. The system calculates tracks, or cylinders needed from
"average record length" * "number of records" * avgrec-unit
For the primary allocation, this is
40 * 10 * 1 = 400 bytes
Good. But how can we specify our space needs in KiB or MiB using these keywords?
Remember that the average record length in the SPACE= parameter is completely unreleated to the actual record length specified via LRECL=. Great, so we can freely choose the average record length, and set it to, say, 1. And let us also change the wording "number of records* in above forumla to "number of units". The formula becomes:
1 * "number of units" * avgrec-unit
or
"number of units" * avgrec-unit
AVGREC= supports the units U (1), K (1024), and M (1024*1024). So, to allocate space in megabytes (MiB), we simply code:
//CUSTOMER DD ...
// AVGREC=M,
// SPACE=(1,(10,20),RLSE)
This will allocate 10 MiB primary space, and 20 MiB secondary space. Each allocation is rounded up to the next integral number of tracks, or cylinders, depending on physical disk structures. You simply don't have to care anymore. Neat, isn't it?

assumed decimal as input - tab and enter add trailing zeros

Good evening,
I just started learning Cobol, and to practice, I wanted to program a simple multiplication program, working with two decimal numbers given by the user.
So I wrote the following
IDENTIFICATION DIVISION.
PROGRAM-ID. exo.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 a PIC 9(2)V9.
77 b PIC 9(2)V9.
77 result PIC 9(4)V99.
screen section.
1 pla-title.
2 blank screen.
2 line 1 col 1 value 'Multiplication'.
1 pls-numbers.
2 line 4 col 2 value 'Number 1 : '.
2 PIC 9(2)V9 to a required.
2 line 5 col 2 value 'Number 2 : '.
2 PIC 9(2)V9 to b required.
1 pla-result.
2 line 7 col 2 PIC 9(2)V9 from a.
2 col 7 value 'x'.
2 col 9 PIC 9(2)V9 from b.
2 col 13 value '='.
2 col 15 PIC 9(4)V99 from result.
PROCEDURE DIVISION.
display pla-title.
accept pls-numbers.
compute result = a * b.
display pla-result.
END PROGRAM exo.
The issue here is not the multiplication part, which works perfectly. The problem is the input. Every time I press tab or enter, there is a 0 added at the end. For instance, typing 9,9,9,tab,9,9,9,enter multiplies 900 with 990, since the format only takes the last three digits of 99900 (tab+enter) and 9990 (enter).
I tried the same program with integers, it works perfectly. I tried the same with real decimals too (9(2).9), and the input works, but I have a problem with the multiplication (not a numeric value), that I will try to understand later, one problem at the time.
So in short, the question is to know why the input is modified by typing tab and enter, that in my understanding is used to navigate the accept fields.
Thank you very much for your help!
How the input is automatically adjusted on field change/finish of the accept depends on the compiler/runtime actually in use (it is good in most times to add this information in the question), but most COBOL variants want a "." (or in the case of DECIMAL-POINT IS COMMA a ",") entered to get the decimal part correct.
Actually the results with an implied decimal-point and ACCEPT may not be what you want it to do. I suggest to try using a numeric-edited field like ZZ9.99 (which is auto-de-edited on MOVE to a field you do the calculation with [if the stored data matches the editing symbols] after the ACCEPT) or a plain PIC X and a MOVE FUNCTION NUMVAL (input-field) TO a afterwards (this should work on any compiler including this function).

Data type in COBOL

I have written the following program, I am confused why when I compile the program I get an error saying that A-COL(1,1) is not a numeric value while displaying A-COL(1,1) gives me 1.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC 9(3).
01 ARRAY.
05 A-ROW OCCURS 99 TIMES.
10 A-COL OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO A-COL(1,1).
MOVE 2 TO A-COL(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = A-COL(1,1) - A-COL(2,1).
DISPLAY DIFF.
STOP RUN.
Change the A-COL definition to
"10 A-COL PIC 9(3) OCCURS 2 TIMES."
and remove the TABLE-CONTENT.
Group variables are considered alphanumeric (X type) so cannot be used in a computation.
Alternatively you may do this - refer to the address location using the actual numeric field.
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT(1,1).
MOVE 2 TO TABLE-CONTENT(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = TABLE-CONTENT(1,1) - TABLE-CONTENT(2,1).
DISPLAY DIFF.
Also you might want to make DIFF signed.
Additional Information
A-COL(1,1) displays "1" because it stores the data as "1xx" where x = space. That is not a numeric value. When you run the solutions here you will notice that display line produces "001".
Keep your WORKING-STORAGE structure the same. However, your data-elements are not A-COL, but THE-CONTENT. So use THE-CONTENT, not A-COL.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC S9(3).
01 ARRAY.
05 A-ROW
OCCURS 99 TIMES.
10 A-COL
OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT ( 1 1 )
MOVE 2 TO TABLE-CONTENT ( 2 1 )
DISPLAY
">"
TABLE-CONTENT ( 1 1 )
"<"
COMPUTE DIFF = TABLE-CONTENT ( 1 1 )
- TABLE-CONTENT ( 2 1 )
DISPLAY
">"
DIFF
"<"
STOP RUN
.
Your structure is better, because it is easier to maintain. If you ever want to REDEFINES TABLE-CONTENT, you can, without changing the structure. Not so if you "complicate" the structure now.
Yes, if you MOVE a numeric literal to a group-item, an alpha-numeric MOVE is carried out, the result will be your literal left-justified and space-padded to the right, or truncated to the right, or just fitting, depending on the size of your literal.
Although conceptually you have "columns" in your table (COBOL doesn't have arrays, it has tables with OCCURS), be aware that you cannot access a column as a whole. In storage you have row-1-col-1, row-1-col-2, row-2-col-1, row-2-col-2 through to row-99-col-1, row-99-col-2.
Any arithmetic (ADD, SUBTRACT, MULTIPLY, DIVIDE and COMPUTE) can only use numeric fields or literals as source-data. It is not enough that a field contains "a number", it must be a numeric field.
The GIVING (of ADD, SUBTRACT, MULTIPLY and DIVIDE) can place the result in a non-numeric field of a particular type, a numeric-edited field. This is a field with a PICture clause containing numeric-editing PICture symbols.

How to display an absolute value

Given the following code:
IDENTIFICATION DIVISION.
PROGRAM-ID. FABS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM PIC 9 VALUE ZEROS.
01 ABSVAL PIC 99 VALUE ZEROS.
PROCEDURE DIVISION.
PROGRAM-BEGIN.
DISPLAY "This program returns the absolute value of a number.".
DISPLAY SPACE.
DISPLAY "Input value: " WITH NO ADVANCING.
ACCEPT NUM.
IF (NUM = -0) THEN
COMPUTE ABSVAL = 0
ELSE
IF (NUM > 0) THEN
COMPUTE ABSVAL = 0
ELSE
COMPUTE ABSVAL = ABSVAL * -1
END-IF
END-IF.
DISPLAY "|", NUM "| = ", ABSVAL.
PROGRAM-DONE.
STOP RUN.
Why is the output zero? Is there something wrong? And how do you make a signed/negative input?
Thinking of your task, rather than why you get zero, it is easy.
Let's assume you get a signed value with your ACCEPT.
01 value-from-accept PIC S9.
01 absolute-value-for-output PIC 9.
MOVE value-from-accept TO absolute-value-for-output
DISPLAY
"|"
value-from-accept
"| = "
absolute-value-for-output
You may think that something is wrong with the output from value-from-accept (depending on compiler) but you can always MOVE it to a numeric-edited field and DISPLAY that.
Tip: To reverse the sign of a signed field.
SUBTRACT field-to-reverse-sign
FROM ZERO
GIVING the-reversed-field
SUBTRACT is faster than MULTIPLY.
You have defined your field which is ACCEPTed as unsigned.
The first two "legs" of your nested-IF set ABSVAL to zero. The remaining leg takes the existing value of ABSVAL (from the VALUE ZEROS, so it is zero) and multiplies it by minus one. Getting -ve zero (possibly), but then storing it in an unsigned field. So ABSVAL will always be zero when you come to the DISPLAY.
You define a signed field by prefixing the PICture string with an S:
01 a-signed-field PIC S9(5).
Depending on your compiler, you can type a - when entering the data and it'll be held happily as a negative value in a signed field (which you have to define) or you have to code for it yourself.
after your correction above
I am not sure how you are testing it but to just to ensure that the values are stored correct you may want to have both the fields signed i.e. pic S9 or pic S99. Its possible that without the preceding S (sign) the variables are not really storing the negative sign regardless of what the screen is showing.
pls observe what results you get then

Why is my if statement not determining the correct output in two nested performs?

I have this Cobol paragraph that will search one table which at this point in my example would have a table counter of 2 which is what the first INDEX loop does. The variable A represents an Occurs that is defined in a file (include) which has 5 occurrences. I can get to the if statement but it returns false. I read the information out of a ParmCard and store that in the table which is Table-B and the ParmCard is correct.
I did get it to find one value when was changing values around (conditional statements) but I know that both of the values that it is looking for in the ParmCard are in the file and should be found and it should find two results. I would have tried Expeditor but the system was down at work.
Is there something wrong with the index or may be I think that the perform's are working one way but they are really working a different way? This Search paragraph gets executed with every read of the ID file thus it will look in the table as many times as the ID file has an ID and ID symbols are unique.
Question: Why would the IF-STATEMENT not be working?
Code:
SEARCH-PARAGRAPH.
PERFORM VARYING SUB FROM 1 BY 1 UNTIL SUB > 2 <--DUPLICATE INDEXER
IF A(TAB) = TABLE-B(SUB) THEN
MOVE 6 TO TAB
MOVE 'TRUE' TO FOUND-IS
PERFORM WRITE-FILE THRU X-WF
PERFORM LOG-RESULT THRU X-LR
END-IF
END-PERFORM
X-SP. EXIT.
SEARCH-INDEX.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 2
DISPLAY 'INDEX --> ' I
PERFORM VARYING TAB FROM 1 BY 1 UNTIL TAB > 5
DISPLAY 'TAB --> ' TAB
PERFORM SEARCH-PARAGRPAH THRU X-SP
END-PERFORM
END-PERFORM.
X-SEARCH-INDEX. EXIT.
Here is the way that it works now and I do get the results I want. It is difficult to past the company code up because you never know who might have a problem.
New Code:
READ-PROV.
READ P-FILE
AT END
MOVE 'Y' TO EOF2
GO TO X-READ-PROV
NOT AT END
ADD 1 TO T-REC-READ
MOVE P-RECORD TO TEST-RECORD
PERFORM CHECK-MATCH THRU X-CHECK-MATCH
END-READ.
X-READ-PROV. EXIT.
CHECK-MATCH.
PERFORM VARYING SUB FROM 1 BY 1 UNTIL SUB > TABLECOUNTER
IF PID >= FROM(SUB) AND
PID <= THRU(SUB) THEN
IF TODAY < P-END-DTE THEN
IF TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 THEN
IF PBILLIND NOT EQUAL 'Y'
PERFORM VARYING TAB FROM 1 BY 1 UNTIL TAB > 5
IF P-CD(TAB) = TY(SUB) THEN
MOVE 6 TO TAB
DISPLAY('***Found***')
ADD 1 TO T-REC-FOUND
END-IF
END-PERFORM
END-IF
END-IF
END-IF
END-IF
END-PERFORM.
X-CM. EXIT.
We can't tell.
There is nothing "wrong" with your nested PERFORM. The IF test is failing simply because it is never true.
We can't get you further with that without seeing your data-definitions, sample input and expected output.
However... my guess would be that the problem is with your data from the PARM in the JCL. That is the most likely area.
It is of course possible that the problem is with the other definition.
A couple of things whilst waiting.
Please always post the actual code, always. We don't want to look for errors in what you have typed here, we want to see the actual code. You have not shown the actual code, because it will not compile, as INDEX is a Reserved Word in COBOL, so you can't use it for a data-name.
Please always bear in mind that what you think may be wrong may not be the problem, so post everything we are likely to need (data-definitions, data you used, actual results you got with the code (including anything you've added for problem-determination), results which were expected).
Some tips.
A paragraph requires a full-stop/period after the paragraph-name and before the next paragraph. If you put that second full-stop/period on a line of its own, and have no full-stops/periods attached to your PROCEDURE code itself, you'll make things look neater and avoid problems when you want to copy some lines which happen to have a full-stop/period to a place where they cause you a mess.
You are using literal values. This is bad. When the number of entries in one of your tables changes, you have to change those literal values. Say the 2 needs to be changed to 5. You have to look at every occurrence of the literal 2 and decide if it needs to be changed. Then change it to 5. Then you get another request, to change the table which originally had five entries so that it will have six. See how difficult/error-prone life can be?
If instead you have unique and well-named data-names for your maximum number of entries, you only have one place to make a change, and you know it can be changed without reference to the rest of the code (assuming someone clever hasn't seen it has a value they want for something, and use it despite its name, of course...).
The content of those fields you can set automatically:
01 TABLE-1.
05 FILLER OCCURS 2 TIMES.
10 A PIC X(10).
01 TABLE-2.
05 FILLER OCCURS 5 TIMES.
10 TABLE-B PIC X(10).
01 TABLE-1-NO-OF-ENTRIES COMP PIC 9(4).
01 TABLE-2-NO-OF-ENTRIES COMP PIC 9(4).
...
PROCEDURE DIVISION.
...
COMPUTE TABLE-1-NO-OF-ENTRIES = LENGTH OF TABLE-1
/ LENGTH OF A
COMPUTE TABLE-2-NO-OF-ENTRIES = LENGTH OF TABLE-2
/ LENGTH OF TABLE-B
DISPLAY TABLE-1-NO-OF-ENTRIES
DISPLAY TABLE-2-NO-OF-ENTRIES
That gives you the output 2 and 5.
The names I've used are a mixture of yours and some for demonstration purposes only. Make everything meaningful, and by that I don't mean trite, as my example names would be in real life.
If you insist on escaping from within your PERFORM like that (and take note of Bruce Martin's comment), you can calculate your escape value by using new, aptly-named, fields and giving them the value of the above plus one.
To do a nested loop when the outer loop only has two entries is overkill. You don't need to escape out of the loops like you do, if you have a termination condition on the loop.
That'll do for now until we see your definitions, data and results.

Resources