Problem:
We are moving a host applicaiton to PC environment, but 'Record Contains 0 Characters' is being flagged. The same program compiled and ran fine on the MVS host. The program could open and read datasets of varying lengths without modifications. Net Express gives a bad file status code of 3904. Is there a way to have this work in Net Express without a host dialect?
Resolution:
This is an IBM extension. They document this:
----------
Enterprise COBOL for z/OS and OS/390
Language Reference Version 3 Release 2
Document Number SC27-1408-01
http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/IGY3LR10/5.2.5.1?SHELF=&DT=20020920180651
Format 1 specifies the number of bytes for fixed-length records.
___ Format 1 ___________________________________________________________
| |
| >>__RECORD__ __________ __integer-3__ ____________ _________________>< |
| |_CONTAINS_| |_CHARACTERS_| |
| |
integer-3
Must be an unsigned integer that specifies the number of bytes contained
in each record in the file. The RECORD CONTAINS 0 CHARACTERS clause can be specified for input QSAM files containing fixed-length records; the record size
is determined at object time from the DD statement parameters or the data set label. If, at object time, the actual record is larger than the 01 record description, then only the 01 record length is available. If the actual record is shorter, then only the actual record length can be referred to. Otherwise, uninitialized data or an addressing exception can be produced.
Note: If the RECORD CONTAINS 0 clause is specified, then the SAME AREA,
SAME RECORD AREA, or APPLY WRITE-ONLY clauses cannot be specified.
Do not specify the RECORD CONTAINS 0 clause for an SD entry.
----------
This will work in Net Express 40. Here is a sample batch file and Cobol program:
set anyi500=in500.dat
set anyi32k=in32k.dat
set in500r32=in500.dat
set in32r500=in32k.dat
cobol lorince anim noobj assign"external" apost outdd(sysout.txt) setting(col3) list();
mfnetx /debug:lorince
Identification Division.
Program-Id. LORINCE.
Environment Division.
Input-Output Section.
File-Control.
Select In500 Assign to Anyi500
Organization is Sequential
Access Mode is Sequential
File Status is FsCode.
Select In32k Assign to Anyi32k
Organization is Sequential
Access Mode is Sequential
File Status is FsCode.
Select I32r500 Assign to In32r500
Organization is Sequential
Access Mode is Sequential
File Status is FsCode.
Select I500r32 Assign to In500r32
Organization is Sequential
Access Mode is Sequential
File Status is FsCode.
Data Division.
File Section.
Fd In500
Recording Mode F
Record contains 0 Characters.
1 In500Rec Pic X(500).
Fd In32k
Recording Mode F
Record contains 0 Characters.
1 In32kRec Pic X(32000).
Fd I32r500
Recording Mode F
Record contains 0 Characters.
1 In500Rec Pic X(32000).
Fd I500r32
Recording Mode F
Record contains 0 Characters.
1 In500Rec Pic X(500).
Working-Storage Section.
1 Trackers.
2 AtEnd Pic X.
2 Ctr Pic 9(2).
2 FsCode Pic 9(2).
1 My32k Pic X(32000).
1 My500 Pic X(500).
Procedure Division.
P1.
Perform P2
Perform P3
Perform P4
Perform P5
Stop Run.
P2.
Initialize Trackers My32k My500
Move 'n' to AtEnd
Display ' Processing Input File of 500 Bytes '
Open Input In500
If FsCode Not = '00'
Display ' OPEN Error FsCode ==>' FsCode
Stop Run
End-If
Display ' OPEN for 500 Bytes = ' FsCode
Perform Until AtEnd = 'y'
Read In500 Into My500
At End
Move 'y' to AtEnd
Not At End
If FsCode Not = '00'
Display ' READ Error FsCode ==>' FsCode
Stop Run
Else
Add 1 to Ctr
Display ' READ for 500 Bytes = ' FsCode
Display ' Record = ' Ctr
End-If
End-Read
End-Perform
Close In500
If FsCode Not = '00'
Display ' CLOSE Error FsCode ==>' FsCode
Stop Run
End-If
Display ' CLOSE for 500 Bytes = ' FsCode.
P3.
Initialize Trackers My32k My500
Move 'n' to AtEnd
Display ' Processing Input File of 32000 Bytes '
Open Input In32k
If FsCode Not = '00'
Display ' OPEN Error FsCode ==>' FsCode
Stop Run
End-If
Display ' OPEN for 32000 Bytes = ' FsCode
Perform Until AtEnd = 'y'
Read In32k Into My32k
At End
Move 'y' to AtEnd
Not At End
If FsCode Not = '00'
Display ' READ Error FsCode ==>' FsCode
Stop Run
Else
Add 1 to Ctr
Display ' READ for 32000 Bytes = ' FsCode
Display ' Record = ' Ctr
End-If
End-Read
End-Perform
Close In32k
If FsCode Not = '00'
Display ' CLOSE Error FsCode ==>' FsCode
Stop Run
End-If
Display ' CLOSE for 32000 Bytes = ' FsCode.
P4.
Initialize Trackers My32k My500
Move 'n' to AtEnd
Display ' Processing Input File of 32000 Bytes as 500 '
Open Input I32r500
If FsCode Not = '00'
Display ' OPEN Error FsCode ==>' FsCode
Stop Run
End-If
Display ' OPEN as 32000 Bytes = ' FsCode
Perform Until AtEnd = 'y'
Read I32r500 Into My32k
At End
Move 'y' to AtEnd
Not At End
If FsCode Not = '00'
Display ' READ Error FsCode ==>' FsCode
Stop Run
Else
Add 1 to Ctr
Display ' READ as 32000 Bytes = ' FsCode
Display ' Record = ' Ctr
End-If
End-Read
End-Perform
Close I32r500
If FsCode Not = '00'
Display ' CLOSE Error FsCode ==>' FsCode
Stop Run
End-If
Display ' CLOSE as 32000 Bytes = ' FsCode.
P5.
Initialize Trackers My32k My500
Move 'n' to AtEnd
Display ' Processing Input File of 500 Bytes as 32000 '
Open Input I500r32
If FsCode Not = '00'
Display ' OPEN Error FsCode ==>' FsCode
Stop Run
End-If
Display ' OPEN as 500 Bytes = ' FsCode
Perform Until AtEnd = 'y'
Read I500r32 Into My500
At End
Move 'y' to AtEnd
Not At End
If FsCode Not = '00'
Display ' READ Error FsCode ==>' FsCode
Stop Run
Else
Add 1 to Ctr
Display ' READ as 500 Bytes = ' FsCode
Display ' Record = ' Ctr
End-If
End-Read
End-Perform
Close I500r32
If FsCode Not = '00'
Display ' CLOSE Error FsCode ==>' FsCode
Stop Run
End-If
Display ' CLOSE as 500 Bytes = ' FsCode.
#COBOL
#RMCOBOL
#netexpress
#AcuCobol
#ServerExpress
