How to Input Variable Length Record File 2

[rasETL]

I have a COBOL process running in IBM Z/OS.

I have a process where I would like to allow file(s) with any record length to be input. I have left the "RECORD CONTAINS" clause out of the program, and by specifiying the LRECL in the JCL, can get File(s) in no prblem.

The problem, however, is when reading the records. I have set up the FD area as PIC X(2000) so records up to that length can be processed. This causes COBOL to return 2000 bytes of information for each record, regardless of their length.

Example, if the record is 100 bytes long, the 1st READ brings in the first 20 records, the 2nd READ bring in records 2-21, the 3rd brings in 3-22, etc. You will notice the program recognizes the records, but bring in additional data to fill the 2000 bytes.

We have tried READ...INTO and READ FD then MOVE, and both have the same bad result.

Does anyone know how to eliminate this from happening without knowing the actual Record Length?

 

[rasETL]

Craig

Sorry, but I do not know what is so magical about the number 9992.

However, a quick and dirty way of handling this problem would be to establish to input files - one that would handle anything less than 9992, and one that would handle anything over 9992.

Then, allocate the file in the JCL to the appropriate DD Statement. In the program, issue an Open to the FD that is appropriate based on the record length of the file you are processing. Or, open the first FD, and, if on the first read you have an end-of-file, you know you will be processing from the second input file.

Hope that helps

 

[CraigJConrad]

I had thought of that as well, but (for me, at least), it won't let me successfully do an override larger than 9992 (9996, of course, in JCL), regardless of the real file LRECL.

In other words, if the real file is 20,004, then the program's FD cannot be 21,000 and use a DD override of 21,004 -- get the same file status of '90' on the open. Therefore, I can't handle files over 9992 unless I have an FD for that specific size.

Interestingly, when the file is 20,000 (+4), and the program FD is 9992, I *can* use a DD override to 9996 AND IT OPENS and processes! Of course, the file I used didn't really have any records with more than about 1500 bytes, so I don't know what would happen if a record came in with more than 9992 bytes in it. I wonder why, if 9992/6 is a real maximum override, that the JCL doesn't fail, instead of the read. Also, why status 90?

I really appreciate all your assistance thus far.

Craig

 

[3gm]

Sounds almost like an S9(4) COMP/TRUNC problem??

Regards.

Glenn

 

[CraigJConrad]

Glenn,

Could you explain further? Keeping in mind that the failure occurs at OPEN, I don't think that any of my variables are involved. If it were at the READ, then I could suspect InA-V-Rec-Len, but even that is defined 9(05). The code below represents the largest override that I can successfully open (9992/9996).

Is there an IBM support channel for something like this (to explain the illogical status code 90, the magic 9992 number, etc)?

Thanks!! ... Craig

Select FD-InA-V Assign to INA Status IO-Status.
:
:
FD FD-InA-V
Recording Mode is V
Block Contains 0
Record Varying 1 to 9992 Depending on InA-V-Rec-Len.
01 InA-V-Rec.
05 Filler Occurs 1 to 9992
Depending on InA-V-Rec-Len Pic X(01).
:
:
05 InA-V-Rec-Len Pic 9(05) Value 0.
:
:
//INA DD DSN=ABC.SFILE1,
// DCB=(LRECL=9996),
// DISP=SHR

 

[3gm]

Craig -

BLKSIZE and LRECL are halfwords in the DCB (which one might describe as S9(4) COMP). The OPEN processing includes a bunch of preprocessing of the DCB by LE. I was simply wondering if somehow LE was applying the TRUNC option or equivalent logic so that file sizes above 9999 get screwed up. Just for kicks, have you tried changing the TRUNC option?

I would think you could open an APAR with IBM on this issue, but I've not done that in quite a while and am not sure of the route to take. You might also run this by gary.hasler "@" escape.net.au. Gary knows LE/COBOL inside and out and might be able to get you to the right folks for resolution.

Regards.

Glenn

 

[razalas]

Long shot, but try checking with your systems people to be sure that they don't have some kind of SMS rule set up that doesn't allow QSAM datasets over 9996.

"Code what you mean,
and mean what you code!
But by all means post your code!"

Razalas

 

[CraigJConrad]

Glenn -- I would expect that the DCB fields are being processed in system code (SVCs, probably) -- runtime stuff. I assume that "TRUNC" is a compiler option (I hadn't known of it before) and would only affect code generated in the compile process. But, anything is worth trying and, if I can, I will check it out this weekend.

I have sent an email to Gary, as you suggested -- I am grateful for the reference!

Razalas -- I'm not sure who to ask at this shop (my team are all contractors working remotely), but I'll see if I can find out. Thanks!

... Craig

 

[slade]

Hi Craig,

If I remember correctly, the DCB merge will use the info in the FD if it's coded there.

You may want to try the following; it may get you past the OPEN. But then you have the READ to worry about.

What the hey, give it a shot.

FD  FD-InA-V
    Recording Mode is V
    Block Contains 32764
    Record Varying 1 to 32760 Depending on InA-V-Rec-Len.
01  InA-V-Rec.
    05 Filler   Occurs 1 to 32760
       Depending on InA-V-Rec-Len Pic X(01).
:
:
05  InA-V-Rec-Len  Pic 9(05) Value 0.
:
:
//INA      DD DSN=ABC.SFILE1,
//            DISP=SHR

Regards, Jack.

 

[CraigJConrad]

Slade -- I tried that (just now). The compiler needed an 8-byte spread between Block & record size, and any override on the DD LRECL greater than 32760 gives immediate JCL error, so I used 32764 and 32756 in the code. However, when testing with a file that is defined as LRECL of 20,000 (+4), the OPEN fails. If there is no LRECL override, it fails with an LRECL mismatch. If there is an LRECL override, it fails with that strange

"IGZ0201W A file attribute mismatch was detected. File FD-INA-V in program CCMATCH had a record length of 32760 and the file specified in the ASSIGN clause had a record length of 20004"

And the OPEN status code is 90 (illogical). As my earlier post noted, it appears that no JCL DD override works greater than 9996. Exact matches work, but not overrides.

Thanks for taking the time to help! ... Craig

 

[slade]

Hi Craig,

When you attempted to process the larger LRECLs, did you use RECFM=VB along w/the LRECL?

Regards, Jack.

 

[CraigJConrad]

Slade -- actually, no, I didn't add the "RECFM=VB" ... do I need to?

Craig

 

[CraigJConrad]

Slade -- I just tried it and it still gives Status Code 90 on the OPEN ...

I'll try anything!

 

[slade]

Hi Craig,

I feel your pain. :-(
I guess we're at the WAG phase of the project.

It sounds like what you have should work as it did for the FB files. The governing rules are almost identical.

There's always IBM. Talk it over w/your sysprogs and see if you can get them to get IBM involved. The may even be able to solve it themselves.

Regards, Jack.

 

[CraigJConrad]

Cobol Friends:

I am now working on the output side of my problem (the input is still not fully working, by the way), in which I need to be able to create FB files whose record lengths are not known at compile time. The actual lengths must be determined either from: (a) the JCL's DCB info; or (b) user input via SYSIN. The use of RECFM=U (undefined) had been suggested, and I just went down that path. In my ignorance, I now wonder why we thought it might work, as it still seems to have to have the block size specified in the Cobol FD at compile time. Also, once the program has run, I need the file to appear to be RECFM=FB,BLKSIZE=xxx, not RECFM=U,LRECL=xxx, for any subsequent programs that will read it. I had thought that RECFM=U would let me build the blocks the way I want them (exactly as if the files had been RECFM=FB), and would leave the file as really RECFM=FD.

Is this the wrong path, or have I missed something on this? The other suggestion had been to use a Cobol subprogram or an assembler program to which the opened file would be passed and the called program would manipulate the DCB to the sizes known at runtime. In thinking about that now, I'm not sure that fits, either. Can anyone elaborate on this option? An example would be MUCH APPRECIATED!

Thanks, Craig

 

[WMK]

The "trick" for modifying the DCB is to do someting like:

FD File-Name.
01 Rec-Name Pic X(80).
..
Call "program-to-modify-dcb" using File-Name

do *not* do a

Call "program-to-modify-dcb" using Rec-Name

The subprogram can then set the DCB values BEFORE you do the OPEN.

I have *not* personally done this, but know that others have.

***

Once again, as stated earlier what you are trying to do is NOT something that COBOL (IBM or ANSI/ISO Standard) intends to work. Therefore, anything that you get to work today MAY fail in the future; it simply is not supported. (See for examples in changes for RECFM=U processing in recent releases of LE).

As you are running on an IBM mainframe, I would really look at something like (batch) ISPF "Library Access Services" - see:

http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/ISPZSG30/1.5.3

Bill Klein

 

[CraigJConrad]

Bill,

Thanks for the additional information. I actually tried that approach last week and it gave appearances as if it would succeed (the FD is truly a DCB). However, except for system subfiles (eg. SYSOUT), Cobol appears to always re-assert the original FD LRECL immediately prior to performing the OPEN. This was tried on two very different host systems/compilers to the same effect.

After struggling for a LONG time (and searching many places) to now have a way for my Cobol application to set the LRECL of its output files at run time, although it uses an assembler routine. I am sharing the results below.

First, let me thank David Foyle for the "extra-mile" assistance, coaching, and code samples to get this accomplished.

This assembler code acts as a little file processing system, and handles up to 20 concurrently open files (easy to increase). The Cobol program uses the DDNAME as a "handle" for the OPEN, WRITE, and CLOSE processes. With the OPEN, you can specify the LRECL you want.

I will split this into multiple posts, to avoid any limits. Sorry if the formatting is not "pretty" in these posts (it was in the original code!).

 

[CraigJConrad]

CCMATFA CSECT , * Enter Program
***********************************************************************
* Craig J. Conrad, Harrisburg, NC SEPTEMBER 1, 2004 *
* *
* The ideas for this program were drawn from several sources, *
* including: (a) David T. Foyle (ideas, coaching, coding) *
* ** MANY THANKS TO DAVID! ** *
* (b) IBM Cobol & Assembler References *
* (c) Trial and Error *
* *
* This routine is to be called from Cobol for handling the I/O *
* support for QSAM Output files. *
* *
* COBOL REQUIREMENTS: DATA(24) compiler option *
* *
* JCL REQUIREMENTS: Each file you use must have a DD statement *
* in the JCL. Of course, the DDNAME you pass to this module *
* must match a DDNAME in the JCL. If you will be overriding *
* the JCL, the following works well (no LRECL or BLKSIZE *
* is specified). MVS will use your supplied LRECL, and will *
* calculate the most efficient BLKSIZE for the storage type. *
* *
* //OUT01 DD DSN=PD01.CIS000.TEMP1,DCB=RECFM=FB),UNIT=SYSDA, *
* DISP=(NEW,CATLG),SPACE=(CYL,(10,100),RLSE) *
* *
* *
* Calling from COBOL: *
* WORKING-STORAGE. *
* 01 File-Request. *
* 05 FR-DDName Pic X(08). *
* 05 FR-Request Pic X(08). *
* 05 FR-RetCode Pic S9(09) Comp. *
* 05 FR-LRecl Pic S9(04) Comp. *
* 05 FR-Data Pic X(32760). *
* PROCEDURE DIVISION. *
* * To Open a file, be sure to populate DDNAME, LRECL: *
* Move 'OUT01' to FR-DDName. *
* Move 'OPENQO' to FR-Request. *
* Move 80 to FR-LRecl. *
* Call 'CCMATFA' using File-Request. *
* If (FR-RetCode not = 0) *
* Display '* Open Failure ' FR-RetCode *
* ' on "' FR-DDName '"' *
* Move 12 to Return-Code *
* Stop Run *
* End-if. *
* * To Write to a file, populate DDNAME, DATA: *
* Move 'OUT01' to FR-DDName. *
* Move 'Test Record Data' to FR-Data. *
* Move 'WRITE' to FR-Request. *
* Call 'CCMATFA' using File-Request. *
* If (FR-RetCode not = 0) *
* Display '* Write Failure ' FR-RetCode *
* ' on "' FR-DDName '"' *
* Move 12 to Return-Code *
* Stop Run *
* End-if. *
* * To Close a file, populate DDNAME: *
* Move 'OUT01' to FR-DDName. *
* Move 'CLOSE' to FR-Request. *
* Call 'CCMATFA' using File-Request. *
* If (FR-RetCode not = 0) *
* Display '* Close Failure ' FR-RetCode *
* ' on "' FR-DDName '"' *
* Move 12 to Return-Code *
* Stop Run *
* End-if. *
***********************************************************************
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
MAXTBL EQU 20
***********************************************************************
* On Entry, R1 points to the parmlist; In this case, there is only
* one parm, a Cobol structure of the interface.
***********************************************************************
USING *,R15 * Temp base reg
STM R14,R12,12(R13) * Save caller's regs
BAS R11,*+76 * Branch around my save area
DROP R15 * Drop temp base
USING *,R13 * Base reg & save area ptr
DC 18F'0' * Save Area
ST R11,8(R13) * Forward chain (save area)
ST R13,4(R11) * Backward chain (save area)
LR R13,R11 * Set Addr of save & base reg
L R8,0(R1) * Set R8 to addr of 1st Cobol Parm
USING PARM1,R8 * Base reg for passed parm1
*
* Check the parms (minimal validation)
***********************************************************************
CLI PDDNAME,C' ' * Was DDName passed?
BE PARMBAD If so...
*
* Search the DCB Table to see if any of them already
* have the requested DDNAME. If so, we will use that
* DCB entry without regard to its status (any problems
* with doing so are user errors, anyway!)
***********************************************************************
LA R4,DDTABLE * Start with first table entry
LA R5,MAXTBL * Maximum table entries
INLOOP DS 0H
L R6,8(R4) * Get DCB for this table entry
USING IHADCB,R6 * Base R6 for DCB
CLC 0(8,R4),PDDNAME * Is this entry for this DDNAME?
BE INFOUND If so, go use this entry
LA R4,DDSIZE(R4) * Advance to next entry
BCT R5,INLOOP * Keep looking (if more in table)
* * DDName isn't in the table...
CLC PREQ,REQOPQO * Request to Open QSAM for Output?
BE OPENQO If so, handle Open
B PARMBAD Else, provided DDName invalid!

 

[CraigJConrad]

!!! PART 2 of 2 !!!

INFOUND DS 0H
CLC PREQ,REQWRITE * Request to WRITE?
BE WRITE If so...
CLC PREQ,REQCLOSE * Request to CLOSE?
BE CLOSE If so...
* * Dup OPEN request would come here
PARMBAD DS 0H
LA R15,15 * Set RC to 'invalid parm'
ST R15,PRETCODE in user area
B EXIT * Return to Caller
*
***********************************************************************
OPENQO DS 0H
LA R4,DDTABLE * Start with first table entry
LA R5,MAXTBL * Maximum table entries
OPLOOP DS 0H
L R6,8(R4) * Get DCB for this table entry
USING IHADCB,R6 * Base R6 for DCB
CLI 0(R4),X'FF' * Is entry available?
BE OPAVAIL If so, go use this entry
LA R4,DDSIZE(R4) * Advance to next entry
BCT R5,OPLOOP * Keep looking (if more in table)
* * No entries available
LA R15,13 * Set RC to 'no space left'
ST R15,PRETCODE in user area
B EXIT * Exit with error
OPAVAIL DS 0H
MVC 0(8,R4),PDDNAME * Claim the entry for this DDName
MVC DCBDDNAM,PDDNAME * Update DCB with DDName
MVC DCBLRECL,PLRECL * Update DCB with LRECL
OPEN ((R6),OUTPUT) * Open file for output
ST R15,PRETCODE * Put Open RC into call area
LTR R15,R15 * Open successful?
BNZ EXIT If not...
TM DCBOFLGS,DCBOFOPN * Open successful?
BNZ EXITOK If so, return to caller
LA R15,12 * Set RC to 'unknown open failure'
ST R15,PRETCODE in user area
B EXIT
*
***********************************************************************
WRITE DS 0H
PUT (R6),PDATA * Write the record
B EXITOK
*
***********************************************************************
CLOSE DS 0H
CLOSE ((R6)) * Close file
ST R15,PRETCODE * Put Close RC into call area
MVI 0(R4),X'FF' * Make entry available
B EXIT
*
***********************************************************************
EXITOK DS 0H
LA R15,0 * Set RC to 'OK'
ST R15,PRETCODE in user area
EXIT DS 0H
L R13,4(R13) * Restore R13
RETURN (14,12),RC=(15) * Restore R14 to R12
*
***********************************************************************
LTORG

REQOPQO DC CL8'OPENQO'
REQWRITE DC CL8'WRITE'
REQCLOSE DC CL8'CLOSE'

DDTABLE DS 0D
DC XL8'FFFFFFFFFFFFFFFF',A(DCB01)
DDSIZE EQU *-DDTABLE
DC XL8'FFFFFFFFFFFFFFFF',A(DCB02)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB03)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB04)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB05)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB06)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB07)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB08)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB09)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB10)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB11)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB12)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB13)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB14)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB15)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB16)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB17)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB18)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB19)
DC XL8'FFFFFFFFFFFFFFFF',A(DCB20)

PRINT NOGEN
DCB01 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB02 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB03 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB04 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB05 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB06 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB07 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB08 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB09 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB10 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB11 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB12 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB13 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB14 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB15 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB16 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB17 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB18 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB19 DCB DSORG=PS,RECFM=FB,MACRF=PM
DCB20 DCB DSORG=PS,RECFM=FB,MACRF=PM
*
DCBD DSORG=PS,DEVD=DA
*
PARM1 DSECT
PDDNAME DS CL8
PREQ DS CL8
PRETCODE DS F
PLRECL DS H
PDATA DS C
END