| When technology
complements business |
Copyright
© 1987-2010 SimoTime Enterprises All Rights
Reserved |
| |
Table
of Contents |
Version
10.03.20 |
|
This document describes how to create, access and convert data files
that use variable-length-records. There are different ways to create and access
files with variable length records. The following list briefly describes three
possible methodologies. The examples provided in this suite of programs will
focus on the first methodology.
| 1. |
Define the record as a
single field (my-data-field) with the physical size equal to the maximum
record length. On the FD statement (in a COBOL program) use the
"DEPENDING ON field-name-for-my-record-size" to define a field that will
determine the size of the record to be written to a file. Next, determine the
length of the text string within the single field (my-data-field) that
defines the record layout. Place this value in the
field-name-for-my-record-size and write the record. This may be
accomplished by scanning the field to determine the position of the last
significant character or by counting the number of trailing
spaces.
Note:
When the file is accessed as input
the length of the record just read will be placed in the
"field-name-for-my-record-size" field. |
| 2. |
The file has multiple
record types. Usually each record in the file has a base segment that is
identical. User logic is created to determine the record type. For example, if
position 1 is an "A" the record format "A" is used, If position 1 is a "B" then
record format "B" is used. Each record format will have their own record layout
(or copy file) and they may be the same length or a different length.
Therefore, one way to create and access a file with variable length records is
to use multiple record types where the different record types have a different
record length. |
| 3. |
The technique of
defining an array (or table) as the last part of a record may be used.
For COBOL, the "OCCURS DEPENDING ON" (or ODO) is used to vary the number
of elements in the array (or table). Thus, the more elements in the
array the longer the record and the fewer elements in the array the shorter the
record. |
The preceding describes three of the methods that are commonly used by
COBOL application programmers to create and access files with variable length
records. Additional detail about other tips, tricks and techniques used to
manage files with variable length records are discussed in the following
sections of this document.
The source code for the COBOL programs is written using the VS COBOL II
dialect and also work with COBOL for MVS and COBOL/370. A JCL member is
provided to run the job as an MVS batch job on an IBM mainframe or as a project
with Micro Focus Mainframe Express (MFE) running on a PC with Windows. A
Windows Command (.CMD) file is provided to run the job on a PC with Micro Focus
Net Express. Additional information is provided in the
Downloads and Links to Similar Pages
section of this document.
The compare function that is used in this example uses the SimoLOGS and
SimoHEX4 routines and will require the
common modules to be downloaded.
The following is a list of the functions provided in this example.
| 1. |
Demonstrate how to
create a fixed-record-length, sequential file using mainframe JCL and the
IEBGENER Utility program. |
| 2. |
Demonstrate how to read
the fixed-record-length, sequential file and create a variable-record-length,
sequential file. |
| 3. |
Demonstrate how to read
the variable-record-length, sequential file and create a fixed-record-length,
sequential file. |
| 4. |
Demonstrate how to
compare the contents of two data files. |
The first task performed by the CRTF80J1.JCL or CRTF80E1.CMD routine is
to create a file of fixed-length, 80 byte records. The actual text string
within the records will vary in size. To create fixed length records the record
is padded with trailing spaces.
The second task performed will read the fixed, 80-byte-record file and
create a file containing variable-length records,. The trailing spaces will be
truncated.
The third task will read the file containing variable-length records and
create a file containing 80-byte, fixed length records.
The fourth and final step will compare the original 80-byte,
fixed-length file created in the first task with the 80-byte, fixed length file
created in the third task.
The input varies depending on the task being performed. Each task will
read a sequential file. The format of the file may be fixed, 80-byte records or
variable-length records. The output files will be sequential files and the
format may be fixed, 80-byte records or variable-length records. For
variable-length record the record length is determined by the number of
trailing spaces.
This suite of samples programs will run on the following platforms.
| 1. |
Executes on Windows/2000,
Windows/NT and Windows/XP using Micro Focus Net Express and the CMD file
provided. |
| 2. |
May be ported to run on the UNIX
platforms supported by Micro Focus COBOL. |
| 3. |
Executes on a mainframe with MVS or
Windows/2000, Windows/NT and Windows/XP using Micro Focus Mainframe Express and
the JCL file provided. |
The following diagram is an overview of how the demonstration program
fits into the example. The
BLUE
boxes are unique to the mainframe and Micro Focus Mainframe Express. The
RED
boxes are unique to the PC with Windows and Micro Focus Net Express. The
GREEN
boxes are platform independent and will execute on the mainframe or a PC with
Windows. Also, the
GREEN
boxes may be ported to a UNIX platform that is supported by Micro Focus COBOL.
The AQUA
boxes are used for data files.
The following process will create a sequential file containing
fixed-length, 80-byte records.
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Entry
Points |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Start
the job to create a file with fixed records. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Delete
previously created output file |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Create
a new file with fixed-length, 80-byte records. |
|
|
|
|
|
|
|
|
|
|
|
|
| |
|
|
|
|
|
|
|
End-of-Job |
|
| |
|
|
|
|
|
|
|
|
|
The following will read the file containing fixed length records and
create a file containing variable length records. This example creates variable
length records by removing the trailing space characters from the fixed length
records.
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Entry
Points |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Start
the job to create a file with variable records. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Delete
previously created output file |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Create a file containing variable-length records. |
|
| |
|
|
|
|
|
|
|
| |
|
|
|
|
|
End-of-Job |
|
| |
|
|
|
|
|
|
|
The following will read the file containing variable-length records and
create a file containing fixed-length records.
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Entry
Points |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Start
the job to convert a file with variable records to a file with fixed length
records. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Delete
previously created output file |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Create a file containing fixed-length records. |
|
| |
|
|
|
|
|
|
|
| |
|
|
|
|
|
End-of-Job |
|
| |
|
|
|
|
|
|
|
The following will read the two sequential files containing fixed-length
records and compare the contents of each record. If the contents are not equal
an entry will be written to a log file.
| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Entry
Points |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Start
the job to compare the two sequential files. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Delete
previously created log file |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Compare the two files containing fixed-length records. |
|
|
|
|
|
|
|
|
|
|
| |
|
|
|
|
|
|
|
| |
|
|
|
|
|
End-of-Job |
|
| |
|
|
|
|
|
|
|
This sample suite of programs has four CMD members. The following table
is a list of the sample CMD members.
| Command |
Description |
| CRTF80J1.CMD |
Create a sequential file containing
fixed-length, 80-byte records. |
| CBLV80J1.CMD |
Read the sequential file created in the
preceding job and write to a sequential file containing variable-length
records. |
| CBLV80J2.CMD |
Read the file created in the preceding
step and write a new sequential file containing fixed-length, 80-byte
records. |
| CBLV80J3.CMD |
Read the two sequential files containing
fixed-length, 80-byte records and compare the records. If not equal then write
an entry to a log file. |
The following is the CMD (CRTF80E1.CMD) that is used to create a sequential
file containing fixed-length, 80-byte records. The text string within the
records is variable-length with trailing spaces.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create Sequential Data Sets.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The 1st step (DeleteTEXT) will delete any previously created files.
rem *
rem * The 2nd step (CreateTEXT) will create a new ASCII/Text file.
rem *
rem * The 3rd job step (ConvertLSEQtoRSEQasc) will create a new Record
rem * Sequential file with ASCII-encoded, fixed length records.
rem *
rem * The 4th job step (ConvertLSEQtoRSEQebc) will create a new Record
rem * Sequential file with EBCDIC-encoded, fixed length records.
rem *
rem * This set of programs will run on a Personal Computer with
rem * Windows and Micro Focus Net Express.
rem * *******************************************************************
rem * Step 1 of 2 Set the global environment variables,
rem * Delete any previously created file...
rem *
set CmdName=CrtF80E1
call Env1PROD
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
:DeleteQSAM
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep DeleteQSAM"
set SQEDDF01=%BaseLib1%\DataLibA\Txt1\SQEDDF01.TXT
if exist %SQEDDF01% del %SQEDDF01%
REM *
REM * *******************************************************************
REM * Step 2 of 2 Create and populate a new TEXT file...
REM *
:CreateTEXT
call SimoNOTE Identify JobStep CreateQSAM"
rem *...:....1....:....2....:....3....:....4....:....5....:....6....:....7....:....8
echo 000000000001 A >>%SQEDDF01%
echo 000000000002 AB >>%SQEDDF01%
echo 000000000003 ABC >>%SQEDDF01%
echo 000000000004 ABCD >>%SQEDDF01%
echo 000000000005 ABCDE >>%SQEDDF01%
echo 000000000006 ABCDEF >>%SQEDDF01%
echo 000000000007 ABCDEFG >>%SQEDDF01%
echo 000000000008 ABCDEFGH >>%SQEDDF01%
echo 000000000009 ABCDEFGHI >>%SQEDDF01%
echo 000000000010 ABCDEFGHIJ >>%SQEDDF01%
echo 000000000011 ABCDEFGHIJK >>%SQEDDF01%
echo 000000000012 ABCDEFGHIJKL >>%SQEDDF01%
echo 000000000013 ABCDEFGHIJKLM >>%SQEDDF01%
echo 000000000014 ABCDEFGHIJKLMN >>%SQEDDF01%
echo 000000000015 ABCDEFGHIJKLMNO >>%SQEDDF01%
echo 000000000016 ABCDEFGHIJKLMNOP >>%SQEDDF01%
echo 000000000017 ABCDEFGHIJKLMNOPR >>%SQEDDF01%
echo 000000000018 ABCDEFGHIJKLMNOPQR >>%SQEDDF01%
echo 000000000019 ABCDEFGHIJKLMNOPQRS >>%SQEDDF01%
echo 000000000020 ABCDEFGHIJKLMNOPQRST >>%SQEDDF01%
echo 000000000021 ABCDEFGHIJKLMNOPQRSTU >>%SQEDDF01%
echo 000000000022 ABCDEFGHIJKLMNOPQRSTUV >>%SQEDDF01%
echo 000000000023 ABCDEFGHIJKLMNOPQRSTUVW >>%SQEDDF01%
echo 000000000024 ABCDEFGHIJKLMNOPQRSTUVWX >>%SQEDDF01%
echo 000000000025 ABCDEFGHIJKLMNOPQRSTUVWXY >>%SQEDDF01%
echo 000000000026 ABCDEFGHIJKLMNOPQRSTUVWXYZ >>%SQEDDF01%
echo 000000000027 ABCDEFGHIJKLMNOPQRSTUVWZXZ0123456789 >>%SQEDDF01%
echo 000000000028 ABCDEFGHIJKLMNOPQRSTUVWXYZ >>%SQEDDF01%
echo 000000000029 ABCDEFGHIJKLMNOPQRSTUVWXY >>%SQEDDF01%
echo 000000000030 ABCDEFGHIJKLMNOPQRSTUVWX >>%SQEDDF01%
echo 000000000031 ABCDEFGHIJKLMNOPQRSTUVW >>%SQEDDF01%
echo 000000000032 ABCDEFGHIJKLMNOPQRSTUV >>%SQEDDF01%
echo 000000000033 ABCDEFGHIJKLMNOPQRSTU >>%SQEDDF01%
echo 000000000034 ABCDEFGHIJKLMNOPQRST >>%SQEDDF01%
echo 000000000035 ABCDEFGHIJKLMNOPQRS >>%SQEDDF01%
echo 000000000036 ABCDEFGHIJKLMNOPQR >>%SQEDDF01%
echo 000000000037 ABCDEFGHIJKLMNOPQ >>%SQEDDF01%
echo 000000000038 ABCDEFGHIJKLMNOR >>%SQEDDF01%
echo 000000000039 ABCDEFGHIJKLMNO >>%SQEDDF01%
echo 000000000040 ABCDEFGHIJKLMN >>%SQEDDF01%
echo 000000000041 ABCDEFGHIJKLM >>%SQEDDF01%
echo 000000000042 ABCDEFGHIJKL >>%SQEDDF01%
echo 000000000043 ABCDEFGHIJK >>%SQEDDF01%
echo 000000000044 ABCDEFGHIJ >>%SQEDDF01%
echo 000000000045 ABCDEFGHI >>%SQEDDF01%
echo 000000000046 ABCDEFGH >>%SQEDDF01%
echo 000000000047 ABCDEFG >>%SQEDDF01%
echo 000000000048 ABCDEF >>%SQEDDF01%
echo 000000000049 ABCDE >>%SQEDDF01%
echo 000000000050 ABCD >>%SQEDDF01%
echo 000000000051 ABC >>%SQEDDF01%
echo 000000000052 AB >>%SQEDDF01%
echo 000000000053 A >>%SQEDDF01%
echo 000000000054 a >>%SQEDDF01%
echo 000000000055 ab >>%SQEDDF01%
echo 000000000056 abc >>%SQEDDF01%
echo 000000000057 abcd >>%SQEDDF01%
echo 000000000058 abcde >>%SQEDDF01%
echo 000000000059 abcdef >>%SQEDDF01%
echo 000000000060 abcdefg >>%SQEDDF01%
echo 000000000061 abcdefgh >>%SQEDDF01%
echo 000000000062 abcdefghi >>%SQEDDF01%
echo 000000000063 abcdefghij >>%SQEDDF01%
echo 000000000064 abcdefghijk >>%SQEDDF01%
echo 000000000065 abcdefghijkl >>%SQEDDF01%
echo 000000000066 abcdefghijklm >>%SQEDDF01%
echo 000000000067 abcdefghijklmn >>%SQEDDF01%
echo 000000000068 abcdefghijklmno >>%SQEDDF01%
echo 000000000069 abcdefghijklmnop >>%SQEDDF01%
echo 000000000070 abcdefghijklmnopr >>%SQEDDF01%
echo 000000000071 abcdefghijklmnopqr >>%SQEDDF01%
echo 000000000072 abcdefghijklmnopqrs >>%SQEDDF01%
echo 000000000073 abcdefghijklmnopqrst >>%SQEDDF01%
echo 000000000074 abcdefghijklmnopqrstu >>%SQEDDF01%
echo 000000000075 abcdefghijklmnopqrstuv >>%SQEDDF01%
echo 000000000076 abcdefghijklmnopqrstuvw >>%SQEDDF01%
echo 000000000077 abcdefghijklmnopqrstuvwx >>%SQEDDF01%
echo 000000000078 abcdefghijklmnopqrstuvwxy >>%SQEDDF01%
echo 000000000079 abcdefghijklmnopqrstuvwxyz >>%SQEDDF01%
echo 000000000080 abcdefghijklmnopqrstuvwzxz0123456789 >>%SQEDDF01%
echo 000000000081 abcdefghijklmnopqrstuvwxyz >>%SQEDDF01%
echo 000000000082 abcdefghijklmnopqrstuvwxy >>%SQEDDF01%
echo 000000000083 abcdefghijklmnopqrstuvwx >>%SQEDDF01%
echo 000000000084 abcdefghijklmnopqrstuvw >>%SQEDDF01%
echo 000000000085 abcdefghijklmnopqrstuv >>%SQEDDF01%
echo 000000000086 abcdefghijklmnopqrstu >>%SQEDDF01%
echo 000000000087 abcdefghijklmnopqrst >>%SQEDDF01%
echo 000000000088 abcdefghijklmnopqrs >>%SQEDDF01%
echo 000000000089 abcdefghijklmnopqr >>%SQEDDF01%
echo 000000000090 abcdefghijklmnopq >>%SQEDDF01%
echo 000000000091 abcdefghijklmnor >>%SQEDDF01%
echo 000000000092 abcdefghijklmno >>%SQEDDF01%
echo 000000000093 abcdefghijklmn >>%SQEDDF01%
echo 000000000094 abcdefghijklm >>%SQEDDF01%
echo 000000000095 abcdefghijkl >>%SQEDDF01%
echo 000000000096 abcdefghijk >>%SQEDDF01%
echo 000000000097 abcdefghij >>%SQEDDF01%
echo 000000000098 abcdefghi >>%SQEDDF01%
echo 000000000099 abcdefgh >>%SQEDDF01%
echo 000000000100 abcdefg >>%SQEDDF01%
echo 000000000101 abcdef >>%SQEDDF01%
echo 000000000102 abcde >>%SQEDDF01%
echo 000000000103 abcd >>%SQEDDF01%
echo 000000000104 abc >>%SQEDDF01%
echo 000000000105 ab >>%SQEDDF01%
echo 000000000106 a >>%SQEDDF01%
if exist %SQEDDF01% goto :ConvertLSEQtoRSEQasc
set JobStatus=0010
goto :EojNok
:Jump10
:ConvertLSEQtoRSEQasc
rem *
rem * *******************************************************************
rem * Step 3, Read the previously created Line Sequential File (LSEQ)
rem * and write a Record Sequential File (RSEQ) with 80-byte,
rem * ASCII-encoded records.
rem *
call SimoNOTE "Identify JobStep ConvertLSEQtoRSEQasc"
set GETLS080=%SQEDDF01%
set PUTRS080=%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.SQEDDF01.DAT
if exist %PUTRS080% del %PUTRS080%
run ALAR80C1
if not exist %PUTRS080% set JobStatus=0030
if not "%JobStatus%" == "0000" goto EojNok
call SimoNOTE "Produced DataSet %PUTRS080%"
rem *
:ConvertLSEQtoRSEQebc
rem *
rem * *******************************************************************
rem * Step 4, Read the previously created Line Sequential File (LSEQ)
rem * and write a Record Sequential File (RSEQ) with 80-byte,
rem * EBCDIC-encoded records.
rem *
call SimoNOTE "Identify JobStep ConvertLSEQtoRSEQebc"
set GETLS080=%SQEDDF01%
set PUTRS080=%BaseLib1%\DataLibA\Ebc1\SIMOTIME.DATA.SQEDDF01.DAT
if exist %PUTRS080% del %PUTRS080%
run ALER80C1
if not exist %PUTRS080% set JobStatus=0004
if not "%JobStatus%" == "0000" goto EojNok
call SimoNOTE "Produced DataSet %PUTRS080%"
:EojAok
call SimoNOTE "Produced %SQEDDF01%"
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The following is the CMD (CBLV80E1.CMD) used to read the file containing
fixed-length, 80-byte records and create a file containing variable-length
records. The input file was created in the preceding step (CRTF80E1.CMD) and
contains variable length text string with trailing space characters to make the
records fixed length. The output file will have variable length records
consisting of the text string with the trailing spaces removed.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read a file of fixed-length records, write to a file of
rem * variable-length records.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The first job step (DeleteQSAM) will delete any previously created
rem * file.
rem *
rem * The second job step (CreateQSAM) will read a file containing
rem * 80-byte, fixed length records and create a file containing
rem * variable length records
rem *
rem * This set of programs will run on a Personal Computer with
rem * Windows and Micro Focus Net Express.
rem *
rem * ********************************************************************
rem * Step 1 of 2, Set the global environment variables,
rem * Delete any previously created file...
rem *
set CmdName=CblV80E1
call Env1PROD
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep DeleteQSAM"
:DeleteQSAM
set SQEDDF01=%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.SQEDDF01.DAT
set VREDDV01=%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.VREDDV01.DAT
if exist %VREDDV01% del %VREDDV01%
rem *
rem * *******************************************************************
rem * Step 2 of 2, Repro, Read a file of fixed length records
rem * and write a file of variable length records.
rem *
:CreateQSAM
call SimoNOTE "Identify JobStep CreateQSAM"
run CblV80C1
if ERRORLEVEL 1 echo Error level is equal-to or greater-than 1 . . .
if ERRORLEVEL 1 set JobStatus=0020
if not "%JobStatus%" == "0000" goto :EojNOK
echo errorlevel is 0 . . .
rem *
if exist %VREDDV01% goto :EojAok
set JobStatus=0002
goto :EojNok
:EojAok
call SimoNOTE "Produced %VREDDV01%"
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The following is the CMD (CBLV80E2.CMD) used to read the file containing
variable length records and create a file containing fixed length records.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read a file containig variable-length records and write
rem * to a file containing fixed-length recorsds.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The first job step (DeleteQSAM) will delete any previously created
rem * file.
rem *
rem * The second job step (CreateQSAM) will read the file of variable
rem * length records and write to a file of fixed length records.
rem *
rem * This set of programs will run on a Personal Computer with
rem * Windows and Micro Focus Net Express.
rem *
rem * ********************************************************************
rem * Step 1 of 2, Set the global environment variables,
rem * Delete any previously created file...
rem *
set CmdName=CblV80E2
call Env1PROD
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.Identify JobStep DeleteQSAM"
:DeleteQSAM
set VREDDV01=%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.VREDDV01.DAT
set SQEDDF02=%BaseLib1%\DataLibA\Wrk1\SIMOTIME.DATA.SQEDDF02.DAT
if exist %SQEDDF02% del %SQEDDF02%
rem *
rem * *******************************************************************
rem * Step 2 of 2, Repro, Read a file of variable length records
rem * and write a file of fixed length records.
rem *
:CreateQSAM
call SimoNOTE "Identify JobStep CreateQSAM"
run CblV80C2
if errorlevel = 1 set JobStatus=0020
if not "%JobStatus%" == "0000" goto :EojNOK
rem *
if exist %SQEDDF02% goto :EojAok
set JobStatus=0002
goto :EojNok
:EojAok
call SimoNOTE "Produced %SQEDDF02%"
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The following is the CMD (CBLV80E3.CMD) used to compare the records within
the two sequential files created in the preceding steps. If an unequal
condition exist the records will be displayed and an entry will be written to
the log file.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Compare two sequential files.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The first job step (DeleteQSAM) will delete any previously created
rem * file.
rem *
rem * The second job step (CreateQSAM) will compare two sequential files.
rem * If the records are not equal the information is displayed and an
rem * entry is written to a log file.
rem *
rem * This set of programs will run on a Personal Computer with
rem * Windows and Micro Focus Net Express.
rem *
rem * ********************************************************************
rem * Step 1 of 2, Set the global environment variables,
rem * Delete any previously created file...
rem *
set CmdName=CblV80E3
call Env1PROD
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep SetEnvironment"
:SetEnvironment
set SQEDDF01=%BaseLib1%\DataLibA\Asc1\SIMOTIME.DATA.SQEDDF01.DAT
set SQEDDF02=%BaseLib1%\DataLibA\Wrk1\SIMOTIME.DATA.SQEDDF02.DAT
rem *
rem * *******************************************************************
rem * Step 2 of 2, Compare the files...
rem *
:CompareQSAM
call SimoNOTE "Identify JobStep CompareQSAM"
run CblV80C3
if ERRORLEVEL = 1 set JobStatus=0020
if not "%JobStatus%" == "0000" goto :EojNOK
:EojAok
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
This sample suite of programs has four JCL members. The following table
is a list of the sample JCL members.
| JCL
Member |
Description |
| CRTF80J1.JCL |
Create a sequential file containing
fixed-length, 80-byte records. |
| CBLV80J1.JCL |
Read the sequential file created in the
preceding job and write to a sequential file containing variable-length
records. |
| CBLV80J2.JCL |
Read the file created in the preceding
step and write a new sequential file containing fixed-length, 80-byte
records. |
| CBLV80J3.JCL |
Read the two sequential files containing
fixed-length, 80-byte records and compare the records. If not equal then write
an entry to a log file. |
The following is the JCL (CRTF80J1.JCL) that is used to create a sequential
file containing fixed-length, 80-byte records. The text string within the
records is variable-length with trailing spaces.
//CRTF80J1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create a Sequential Data Set on disk using IEBGENER.
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* The first job step (QSAMDELT) will delete any previously created
//* file. The second job step (QCRTDIN1) will create a new file.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* *******************************************************************
//* Step 1 Delete any previously created file...
//*
//QSAMDELT EXEC PGM=IEFBR14
//SYSUT2 DD DSN=SIMOTIME.DATA.SQEDDF01,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PS)
//*
//* *******************************************************************
//* Step 2 Create and populate a new QSAM file...
//*
//QCRTDIN1 EXEC PGM=IEBGENER
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY
//* :....1....:....2....:....3....:....4....:....5....:....6....:....7.
//SYSUT1 DD *
000000000001 A
000000000002 AB
000000000003 ABC
000000000004 ABCD
000000000005 ABCDE
000000000006 ABCDEF
000000000007 ABCDEFG
000000000008 ABCDEFGH
000000000009 ABCDEFGHI
000000000010 ABCDEFGHIJ
000000000011 ABCDEFGHIJK
000000000012 ABCDEFGHIJKL
000000000013 ABCDEFGHIJKLM
000000000014 ABCDEFGHIJKLMN
000000000015 ABCDEFGHIJKLMNO
000000000016 ABCDEFGHIJKLMNOP
000000000017 ABCDEFGHIJKLMNOPR
000000000018 ABCDEFGHIJKLMNOPQR
000000000019 ABCDEFGHIJKLMNOPQRS
000000000020 ABCDEFGHIJKLMNOPQRST
000000000021 ABCDEFGHIJKLMNOPQRSTU
000000000022 ABCDEFGHIJKLMNOPQRSTUV
000000000023 ABCDEFGHIJKLMNOPQRSTUVW
000000000024 ABCDEFGHIJKLMNOPQRSTUVWX
000000000025 ABCDEFGHIJKLMNOPQRSTUVWXY
000000000026 ABCDEFGHIJKLMNOPQRSTUVWXYZ
000000000027 ABCDEFGHIJKLMNOPQRSTUVWZXZ0123456789
000000000028 ABCDEFGHIJKLMNOPQRSTUVWXYZ
000000000029 ABCDEFGHIJKLMNOPQRSTUVWXY
000000000030 ABCDEFGHIJKLMNOPQRSTUVWX
000000000031 ABCDEFGHIJKLMNOPQRSTUVW
000000000032 ABCDEFGHIJKLMNOPQRSTUV
000000000033 ABCDEFGHIJKLMNOPQRSTU
000000000034 ABCDEFGHIJKLMNOPQRST
000000000035 ABCDEFGHIJKLMNOPQRS
000000000036 ABCDEFGHIJKLMNOPQR
000000000037 ABCDEFGHIJKLMNOPQ
000000000038 ABCDEFGHIJKLMNOR
000000000039 ABCDEFGHIJKLMNO
000000000040 ABCDEFGHIJKLMN
000000000041 ABCDEFGHIJKLM
000000000042 ABCDEFGHIJKL
000000000043 ABCDEFGHIJK
000000000044 ABCDEFGHIJ
000000000045 ABCDEFGHI
000000000046 ABCDEFGH
000000000047 ABCDEFG
000000000048 ABCDEF
000000000049 ABCDE
000000000050 ABCD
000000000051 ABC
000000000052 AB
000000000053 A
000000000054 a
000000000055 ab
000000000056 abc
000000000057 abcd
000000000058 abcde
000000000059 abcdef
000000000060 abcdefg
000000000061 abcdefgh
000000000062 abcdefghi
000000000063 abcdefghij
000000000064 abcdefghijk
000000000065 abcdefghijkl
000000000066 abcdefghijklm
000000000067 abcdefghijklmn
000000000068 abcdefghijklmno
000000000069 abcdefghijklmnop
000000000070 abcdefghijklmnopr
000000000071 abcdefghijklmnopqr
000000000072 abcdefghijklmnopqrs
000000000073 abcdefghijklmnopqrst
000000000074 abcdefghijklmnopqrstu
000000000075 abcdefghijklmnopqrstuv
000000000076 abcdefghijklmnopqrstuvw
000000000077 abcdefghijklmnopqrstuvwx
000000000078 abcdefghijklmnopqrstuvwxy
000000000079 abcdefghijklmnopqrstuvwxyz
000000000080 abcdefghijklmnopqrstuvwzxz0123456789
000000000081 abcdefghijklmnopqrstuvwxyz
000000000082 abcdefghijklmnopqrstuvwxy
000000000083 abcdefghijklmnopqrstuvwx
000000000084 abcdefghijklmnopqrstuvw
000000000085 abcdefghijklmnopqrstuv
000000000086 abcdefghijklmnopqrstu
000000000087 abcdefghijklmnopqrst
000000000088 abcdefghijklmnopqrs
000000000089 abcdefghijklmnopqr
000000000090 abcdefghijklmnopq
000000000091 abcdefghijklmnor
000000000092 abcdefghijklmno
000000000093 abcdefghijklmn
000000000094 abcdefghijklm
000000000095 abcdefghijkl
000000000096 abcdefghijk
000000000097 abcdefghij
000000000098 abcdefghi
000000000099 abcdefgh
000000000100 abcdefg
000000000101 abcdef
000000000102 abcde
000000000103 abcd
000000000104 abc
000000000105 ab
000000000106 a
/*
//SYSUT2 DD DSN=SIMOTIME.DATA.SQEDDF01,
// DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PS)
//
The following is the JCL (CBLV80J1.JCL) used to read the file containing
fixed-length, 80-byte records and create a file containing variable-length
records. The input file was created in the preceding step (CRTF80J1.JCL) and
contains variable length text string with trailing space characters to make the
records fixed length. The output file will have variable length records
consisting of the text string with the trailing spaces removed.
//CBLV80J1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//JOBLIB DD DISP=SHR,DSN=MFI01.SIMOPROD.LOADLIB1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Read fixed file, create variable file.
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* The first job step (QSAMDELT) will delete any previously created
//* file.
//* The second job step (CBLV80S1) will create a new sequential file
//* with variable length records.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* ALLOCATION - Is the amount of disk space needed for the data set.
//* The format for the space parameter is:
//*
//* SPACE=(SPACE-UNIT,(PRIMARY,SECONDARY),RLSE)
//*
//* SPACE-UNIT - The type of space to be allocated. It may be one
//* of the following:
//* TRK - For space allocated by tracks.
//* One track on 3390 disk = 47,476 bytes.
//* BLKSIZE - Where 'blksize' is a number indicating the blksize for
//* the data set (the upper limit being 23,476 (1/2 trk).
//* PRIMARY - The number of tracks or blocks allocated initially
//* to the data set.
//* SECONDARY - The number of tracks or blocks to allocate if the
//* primary allocation is exceeded (usually 10% of the
//* primary allocation is adequate).
//* Up to 15 secondary allocations can be made.
//*
//* An example of coding the space parameter is:
//*
//* SPACE=(TRK,(10,1),RLSE)
//*
//* Meaning that 10 tracks are allocated initially, and if this
//* allocation is exceeded, extensions of one track are added.
//* RLSE specifies that unused space will be released when the job step
//* ends. RLSE is coded only for sequential data sets.
//* The maximum space that can be allocated to this data set is:
//* 10 + 15(1) = 25 tracks
//* *******************************************************************
//* Step 1 Delete any previously created file...
//*
//QSAMDELT EXEC PGM=IEFBR14
//SYSUT2 DD DSN=SIMOTIME.DATA.VREDDV01,DISP=(MOD,DELETE,DELETE),
//* STORCLAS=MFI,
// UNIT=3390,VOL=SER=LARRYS,
// SPACE=(TRK,5),
// DCB=(RECFM=VB,LRECL=84,BLKSIZE=840,DSORG=PS)
//*
//* *******************************************************************
//* Step 2 Create and populate a new QSAM file. The SQEDDF01 file
//* is created using CRTF80J1.JCL.
//*
//CBLV80S1 EXEC PGM=CBLV80C1
//SQEDDF01 DD DSN=SIMOTIME.DATA.SQEDDF01,DISP=SHR
//VREDDV01 DD DSN=SIMOTIME.DATA.VREDDV01,DISP=(NEW,CATLG,CATLG),
//* STORCLAS=MFI,
// UNIT=3390,VOL=SER=LARRYS,
// SPACE=(TRK,(10,10),RLSE),
// DCB=(RECFM=VB,LRECL=84,BLKSIZE=840,DSORG=PS)
//SYSOUT DD SYSOUT=*
//
The following is the JCL (CBLV80J2.JCL) used to read the file containing
variable length records and create a file containing fixed length records.
//CBLV80J2 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create a Sequential Data Set on disk using IEBGENER.
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* The first job step (QSAMDELT) will delete any previously created
//* file. The second job step (QCRTDIN1) will create a new file.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* *******************************************************************
//* Step 1 Delete any previously created file...
//*
//QSAMDELT EXEC PGM=IEFBR14
//SYSUT2 DD DSN=SIMOTIME.DATA.SQEDDF02,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PS)
//*
//* *******************************************************************
//* Step 2 Create and populate a new QSAM file. The SQEDDF01 file
//* is created using CRTF80J1.JCL.
//*
//CBLV80S1 EXEC PGM=CBLV80C2
//VREDDV01 DD DSN=SIMOTIME.DATA.VREDDV01,DISP=SHR
//SQEDDF02 DD DSN=SIMOTIME.DATA.SQEDDF02,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PS)
//SYSOUT DD SYSOUT=*
//
The following is the JCL (CBLV80J3.JCL) used to compare the records within
the two sequential files created in the preceding steps. If an unequal
condition exist the records will be displayed and an entry will be written to
the log file.
//CBLV80J3 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Compare the two sequential files.
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* The first job step (DELTLOGS) will delete any previously created
//* log file. The second job step (FILECOMP) will compare the files.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* *******************************************************************
//* Step 1 Delete any previously created file...
//*
//DELTLOGS EXEC PGM=IEFBR14
//SYSLOG DD DSN=SIMOTIME.DATA.SYSLOGT1,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=V,LRECL=1055,DSORG=PS)
//*
//* *******************************************************************
//* Step 2 Create and populate a new QSAM file. The SQEDDF01 file
//* is created using CRTF80J1.JCL.
//*
//FILECOMP EXEC PGM=CBLV80C3
//SQEDDF01 DD DSN=SIMOTIME.DATA.SQEDDF01,DISP=SHR
//SQEDDF02 DD DSN=SIMOTIME.DATA.SQEDDF02,DISP=SHR
//SYSLOG DD DSN=SIMOTIME.DATA.SYSLOGT1,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=V,LRECL=1055,DSORG=PS)
//SYSOUT DD SYSOUT=*
//
The following is the source code listings for the three sample COBOL
program.
The following is the COBOL source code (CBLV80C1.CBL) used to read the input file
containing fixed-length, 80-byte records and create an output file containing
variable-length records. The output file will have variable length records
consisting of the text string with the trailing spaces removed.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLV80C1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2004-05-13 Generation Time: 10:54:27:41 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT SQEDDF01 SEQUENTIAL FIXED 00080 *
* *
* OUTPUT VREDDV01 SEQUENTIAL VARIABLE 00080 *
* 00001 *
* *
* Translation Mode is EBCDIC to EBCDIC *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SQEDDF01-FILE ASSIGN TO SQEDDF01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SQEDDF01-STATUS.
SELECT VREDDV01-FILE ASSIGN TO VREDDV01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS VREDDV01-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD SQEDDF01-FILE
DATA RECORD IS SQEDDF01-REC
.
01 SQEDDF01-REC.
05 SQEDDF01-DATA-01 PIC X(00080).
FD VREDDV01-FILE
DATA RECORD IS VREDDV01-REC
RECORDING MODE is V
RECORD is VARYING in SIZE from 1 to 80
DEPENDING ON VREDDV01-RECORD-SIZE.
01 VREDDV01-REC.
05 VREDDV01-DATA-01 PIC X(00080).
*****************************************************************
* This program was created using the SYSMASK1.TXT file as input.*
* The SYSMASK1 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* If the output file is indexed then the input file must be in *
* sequence by the field that will be used to provide the key *
* for the output file. *
* If the key field is not in sequence then refer to SYSMASK2 *
* to provide for a random add or update of the indexed file. *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLV80C1 '.
05 T2 pic X(34) value 'Read fixed-80, write variable '.
05 T3 pic X(10) value 'v04.02.23 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLV80C1 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 SQEDDF01-STATUS.
05 SQEDDF01-STATUS-L pic X.
05 SQEDDF01-STATUS-R pic X.
01 SQEDDF01-EOF pic X value 'N'.
01 SQEDDF01-OPEN-FLAG pic X value 'C'.
01 VREDDV01-STATUS.
05 VREDDV01-STATUS-L pic X.
05 VREDDV01-STATUS-R pic X.
01 VREDDV01-EOF pic X value 'N'.
01 VREDDV01-OPEN-FLAG pic X value 'C'.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBLV80C1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 PROGRAM-NAME pic X(8) value 'CBLV80C1'.
01 SYSTEM-DATE.
05 SYSTEM-DATE-YYYY pic X(4) value 'yyyy'.
05 SYSTEM-DATE-MM pic X(2) value 'mm'.
05 SYSTEM-DATE-DD pic X(2) value 'dd'.
01 SYSTEM-TIME.
05 SYSTEM-TIME-HH pic X(2) value 'hh'.
05 SYSTEM-TIME-MM pic X(2) value 'mm'.
05 SYSTEM-TIME-SS pic X(2) value 'ss'.
05 SYSTEM-TIME-00 pic X(2) value '00'.
01 EDITED-DATE.
05 EDITED-DATE-YYYY pic X(4) value 'yyyy'.
05 filler pic X value '/'.
05 EDITED-DATE-MM pic X(2) value 'mm'.
05 filler pic X value '/'.
05 EDITED-DATE-DD pic X(2) value 'dd'.
01 EDITED-TIME.
05 EDITED-TIME-HH pic X(2) value 'hh'.
05 filler pic X value ':'.
05 EDITED-TIME-MM pic X(2) value 'mm'.
05 filler pic X value ':'.
05 EDITED-TIME-SS pic X(2) value 'ss'.
05 filler pic X value ':'.
05 EDITED-TIME-00 pic X(2) value '00'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 VREDDV01-RECORD-SIZE pic 9(5) value 80.
01 TEXT-LENGTH pic 9(5) value 0.
01 SQEDDF01-TOTAL.
05 SQEDDF01-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for SQEDDF01'.
01 VREDDV01-TOTAL.
05 VREDDV01-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for VREDDV01'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform Z-GET-DATE-AND-TIME
perform SQEDDF01-OPEN
perform VREDDV01-OPEN
perform until SQEDDF01-STATUS not = '00'
perform SQEDDF01-READ
if SQEDDF01-STATUS = '00'
add 1 to SQEDDF01-RDR
perform BUILD-OUTPUT-RECORD
perform CALCULATE-STRING-LENGTH
add TEXT-LENGTH to ZERO giving VREDDV01-RECORD-SIZE
perform VREDDV01-WRITE
if VREDDV01-STATUS = '00'
add 1 to VREDDV01-ADD
end-if
end-if
end-perform
move SQEDDF01-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform VREDDV01-CLOSE
perform SQEDDF01-CLOSE
move ZERO to RETURN-CODE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
move ALL x'40' to VREDDV01-REC
move SQEDDF01-REC(1:80) to VREDDV01-REC(1:80)
exit.
*****************************************************************
CALCULATE-STRING-LENGTH.
add 80 to ZERO giving TEXT-LENGTH
* The following "IF" logic is used to reduce the number of
* loops in the following perform. This should be quicker for
* calculating the length of the test string within the record.
if SQEDDF01-REC(41:40) = all x'40'
add 40 to ZERO giving TEXT-LENGTH
if SQEDDF01-REC(21:20) = all x'40'
add 20 to ZERO giving TEXT-LENGTH
end-if
else
if SQEDDF01-REC(61:20) = all x'40'
add 60 to ZERO giving TEXT-LENGTH
end-if
end-if
perform
until TEXT-LENGTH = 0
or SQEDDF01-REC(TEXT-LENGTH:1) not = x'40'
if SQEDDF01-REC(TEXT-LENGTH:1) = x'40'
subtract 1 from TEXT-LENGTH
end-if
end-perform
if TEXT-LENGTH = 0
add 1 to TEXT-LENGTH
end-if
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
SQEDDF01-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SQEDDF01-READ.
read SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if SQEDDF01-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to SQEDDF01-EOF
else
move 'READ Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
SQEDDF01-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SQEDDF01-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
VREDDV01-WRITE.
if VREDDV01-OPEN-FLAG = 'C'
perform VREDDV01-OPEN
end-if
write VREDDV01-REC
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if VREDDV01-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'WRITE Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
VREDDV01-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT VREDDV01-FILE
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to VREDDV01-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
VREDDV01-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close VREDDV01-FILE
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to VREDDV01-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
* Get Date and Time *
*****************************************************************
Z-GET-DATE-AND-TIME.
accept SYSTEM-DATE from DATE YYYYMMDD
accept SYSTEM-TIME from TIME
move SYSTEM-DATE-YYYY to EDITED-DATE-YYYY
move SYSTEM-DATE-MM to EDITED-DATE-MM
move SYSTEM-DATE-DD to EDITED-DATE-DD
move SYSTEM-TIME-HH to EDITED-TIME-HH
move SYSTEM-TIME-MM to EDITED-TIME-MM
move SYSTEM-TIME-SS to EDITED-TIME-SS
move SYSTEM-TIME-00 to EDITED-TIME-00
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* Generation Date: 2004-05-13 Generation Time: 10:54:27:44 *
*****************************************************************
The following is the COBOL source code (CBLV80C2.CBL) used to read the file containing
variable length records and create a file containing fixed length records.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLV80C2.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2004-05-14 Generation Time: 05:11:58:46 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT VREDDV01 SEQUENTIAL VARIABLE 00080 *
* 00001 *
* OUTPUT SQEDDF02 SEQUENTIAL FIXED 00080 *
* *
* *
* Translation Mode is EBCDIC to EBCDIC *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VREDDV01-FILE ASSIGN TO VREDDV01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS VREDDV01-STATUS.
SELECT SQEDDF02-FILE ASSIGN TO SQEDDF02
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SQEDDF02-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD VREDDV01-FILE
DATA RECORD IS VREDDV01-REC
RECORDING MODE IS V.
01 VREDDV01-REC.
05 VREDDV01-DATA-01 PIC X(00080).
FD SQEDDF02-FILE
DATA RECORD IS SQEDDF02-REC.
01 SQEDDF02-REC.
05 SQEDDF02-DATA-01 PIC X(00080).
*****************************************************************
* This program was created using the SYSMASK1.TXT file as input.*
* The SYSMASK1 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* If the output file is indexed then the input file must be in *
* sequence by the field that will be used to provide the key *
* for the output file. *
* If the key field is not in sequence then refer to SYSMASK2 *
* to provide for a random add or update of the indexed file. *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLV80C2 '.
05 T2 pic X(34) value 'Read Variable, write fixed-80 '.
05 T3 pic X(10) value 'v04.10.08 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLV80C2 '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 VREDDV01-STATUS.
05 VREDDV01-STATUS-L pic X.
05 VREDDV01-STATUS-R pic X.
01 VREDDV01-EOF pic X value 'N'.
01 VREDDV01-OPEN-FLAG pic X value 'C'.
01 SQEDDF02-STATUS.
05 SQEDDF02-STATUS-L pic X.
05 SQEDDF02-STATUS-R pic X.
01 SQEDDF02-EOF pic X value 'N'.
01 SQEDDF02-OPEN-FLAG pic X value 'C'.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBLV80C2 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 PROGRAM-NAME pic X(8) value 'CBLV80C2'.
01 SYSTEM-DATE.
05 SYSTEM-DATE-YYYY pic X(4) value 'yyyy'.
05 SYSTEM-DATE-MM pic X(2) value 'mm'.
05 SYSTEM-DATE-DD pic X(2) value 'dd'.
01 SYSTEM-TIME.
05 SYSTEM-TIME-HH pic X(2) value 'hh'.
05 SYSTEM-TIME-MM pic X(2) value 'mm'.
05 SYSTEM-TIME-SS pic X(2) value 'ss'.
05 SYSTEM-TIME-00 pic X(2) value '00'.
01 EDITED-DATE.
05 EDITED-DATE-YYYY pic X(4) value 'yyyy'.
05 filler pic X value '/'.
05 EDITED-DATE-MM pic X(2) value 'mm'.
05 filler pic X value '/'.
05 EDITED-DATE-DD pic X(2) value 'dd'.
01 EDITED-TIME.
05 EDITED-TIME-HH pic X(2) value 'hh'.
05 filler pic X value ':'.
05 EDITED-TIME-MM pic X(2) value 'mm'.
05 filler pic X value ':'.
05 EDITED-TIME-SS pic X(2) value 'ss'.
05 filler pic X value ':'.
05 EDITED-TIME-00 pic X(2) value '00'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 VREDDV01-TOTAL.
05 VREDDV01-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for VREDDV01'.
01 SQEDDF02-TOTAL.
05 SQEDDF02-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for SQEDDF02'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform Z-GET-DATE-AND-TIME
perform VREDDV01-OPEN
perform SQEDDF02-OPEN
perform until VREDDV01-STATUS not = '00'
perform VREDDV01-READ
if VREDDV01-STATUS = '00'
add 1 to VREDDV01-RDR
perform BUILD-OUTPUT-RECORD
perform SQEDDF02-WRITE
if SQEDDF02-STATUS = '00'
add 1 to SQEDDF02-ADD
end-if
end-if
end-perform
move VREDDV01-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform SQEDDF02-CLOSE
perform VREDDV01-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
*> TransINIT process...
move ALL x'40' to SQEDDF02-REC
*> TransCOPY...
move VREDDV01-REC(00001:00080) to SQEDDF02-REC(00001:00080)
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
VREDDV01-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close VREDDV01-FILE
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
VREDDV01-READ.
move SPACES to VREDDV01-REC
read VREDDV01-FILE
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if VREDDV01-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to VREDDV01-EOF
else
move 'READ Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
VREDDV01-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input VREDDV01-FILE
if VREDDV01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to VREDDV01-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with VREDDV01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move VREDDV01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
SQEDDF02-WRITE.
if SQEDDF02-OPEN-FLAG = 'C'
perform SQEDDF02-OPEN
end-if
write SQEDDF02-REC
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if SQEDDF02-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'WRITE Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SQEDDF02-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT SQEDDF02-FILE
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SQEDDF02-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SQEDDF02-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SQEDDF02-FILE
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to SQEDDF02-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
* Get Date and Time *
*****************************************************************
Z-GET-DATE-AND-TIME.
accept SYSTEM-DATE from DATE YYYYMMDD
accept SYSTEM-TIME from TIME
move SYSTEM-DATE-YYYY to EDITED-DATE-YYYY
move SYSTEM-DATE-MM to EDITED-DATE-MM
move SYSTEM-DATE-DD to EDITED-DATE-DD
move SYSTEM-TIME-HH to EDITED-TIME-HH
move SYSTEM-TIME-MM to EDITED-TIME-MM
move SYSTEM-TIME-SS to EDITED-TIME-SS
move SYSTEM-TIME-00 to EDITED-TIME-00
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2004-05-14 Generation Time: 05:11:58:49 *
*****************************************************************
The following is the COBOL source code (CBLV80C3.CBL) that is used to compare the two
sequential, fixed-record length files.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLV80C3.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2004-12-30 Generation Time: 15:12:49:81 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT SQEDDF01 SEQUENTIAL FIXED 00080 *
* *
* OUTPUT SQEDDF02 SEQUENTIAL FIXED 00080 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SQEDDF01-FILE ASSIGN TO SQEDDF01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SQEDDF01-STATUS.
SELECT SQEDDF02-FILE ASSIGN TO SQEDDF02
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SQEDDF02-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD SQEDDF01-FILE
DATA RECORD IS SQEDDF01-REC
.
01 SQEDDF01-REC.
05 SQEDDF01-DATA-01 PIC X(00080).
FD SQEDDF02-FILE
DATA RECORD IS SQEDDF02-REC
.
01 SQEDDF02-REC.
05 SQEDDF02-DATA-01 PIC X(00080).
*****************************************************************
* This program was created using the SYSCOMP1.TXT file as the *
* template for the File I/O. For more information or questions *
* contact SimoTime Enterprises. *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* The SYSCOMP1 provides for the sequential reading of a primary *
* file and the sequential reading of a secondary file. *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLV80C3 '.
05 T2 pic X(34) value 'Data File Content Comparison '.
05 T3 pic X(10) value 'v04.10.20 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLV80C3 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 SQEDDF01-STATUS.
05 SQEDDF01-STATUS-L pic X.
05 SQEDDF01-STATUS-R pic X.
01 SQEDDF01-EOF pic X value 'N'.
01 SQEDDF01-OPEN-FLAG pic X value 'C'.
01 SQEDDF02-STATUS.
05 SQEDDF02-STATUS-L pic X.
05 SQEDDF02-STATUS-R pic X.
01 SQEDDF02-EOF pic X value 'N'.
01 SQEDDF02-OPEN-FLAG pic X value 'C'.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBLV80C3 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 READ-FLAGS.
05 READ-1 pic X value 'Y'.
05 READ-2 pic X value 'Y'.
01 DUMP-FLAGS.
05 DUMP-ASC pic X value 'Y'.
05 DUMP-EBC pic X value 'Y'.
05 DUMP-HEX pic X value 'Y'.
01 COMPARE-STATUS pic XX value 'EQ'.
01 FLAG-EQ pic XX value 'EQ'.
01 FLAG-NE pic XX value 'NE'.
01 FLAG-QT pic XX value 'QT'.
01 DELTA-LINE pic X(1024) value all '-'.
01 PTR-1 pic 9(5) value 0.
01 IDX-2 pic 9(5) value 0.
01 DELTA-MAXIMUM-X pic X(5) value '00100'.
01 DELTA-MAXIMUM redefines DELTA-MAXIMUM-X pic 9(5).
01 YES-YES pic XX value 'YY'.
01 N-BYTE pic X value 'N'.
01 Y-BYTE pic X value 'Y'.
01 KEY-ACTIVE pic X value 'Y'.
01 KEY-CONTROL-1.
05 PS-1 pic 9(5) value 00000.
05 LN-1 pic 9(5) value 00000.
01 KEY-CONTROL-2.
05 PS-2 pic 9(5) value 00000.
05 LN-2 pic 9(5) value 00000.
01 SQEDDF01-LRECL pic 9(5) value 00080.
01 SQEDDF02-LRECL pic 9(5) value 00080.
01 D-LEN pic 9(5) value 128.
01 D-POS pic 9(5) value 1.
01 ASC-OR-EBC pic 9(3) comp value 0.
01 ASC-OR-EBC-R redefines ASC-OR-EBC.
05 ASC-A pic X.
05 EBC-A pic X.
01 DUMP-HEADER.
05 filler pic X(20) value '....:....1....:....2'.
05 filler pic X(20) value '....:....3....:....4'.
05 filler pic X(20) value '....:....5....:....6'.
05 filler pic X(20) value '....:....7....:....8'.
05 filler pic X(20) value '....:....9....:...10'.
05 filler pic X(20) value '....:...11....:...12'.
05 filler pic X(20) value '....:...13....:...14'.
05 filler pic X(20) value '....:...15....:...16'.
05 filler pic X(20) value '....:...17....:...18'.
05 filler pic X(20) value '....:...19....:...20'.
05 filler pic X(20) value '....:...21....:...22'.
05 filler pic X(20) value '....:...23....:...24'.
05 filler pic X(20) value '....:...25....:...26'.
05 filler pic X(20) value '....:...27....:...28'.
05 filler pic X(20) value '....:...29....:...30'.
05 filler pic X(20) value '....:...31....:...32'.
05 filler pic X(20) value '....:...33....:...34'.
05 filler pic X(20) value '....:...35....:...36'.
05 filler pic X(20) value '....:...37....:...38'.
05 filler pic X(20) value '....:...39....:...40'.
05 filler pic X(20) value '....:...41....:...42'.
05 filler pic X(20) value '....:...43....:...44'.
05 filler pic X(20) value '....:...45....:...46'.
05 filler pic X(20) value '....:...47....:...48'.
05 filler pic X(20) value '....:...49....:...50'.
05 filler pic X(20) value '....:...51....:...52'.
05 filler pic X(20) value '....:...53....:...54'.
05 filler pic X(20) value '....:...55....:...56'.
05 filler pic X(20) value '....:...57....:...58'.
05 filler pic X(20) value '....:...59....:...60'.
05 filler pic X(20) value '....:...61....:...62'.
05 filler pic X(20) value '....:...63....:...64'.
05 filler pic X(20) value '....:...65....:...66'.
05 filler pic X(20) value '....:...67....:...68'.
05 filler pic X(20) value '....:...69....:...70'.
05 filler pic X(20) value '....:...71....:...72'.
05 filler pic X(20) value '....:...73....:...74'.
05 filler pic X(20) value '....:...75....:...76'.
05 filler pic X(20) value '....:...77....:...78'.
05 filler pic X(20) value '....:...79....:...80'.
05 filler pic X(20) value '....:...81....:...82'.
05 filler pic X(20) value '....:...83....:...84'.
05 filler pic X(20) value '....:...85....:...86'.
05 filler pic X(20) value '....:...87....:...88'.
05 filler pic X(20) value '....:...89....:...90'.
05 filler pic X(20) value '....:...91....:...92'.
05 filler pic X(20) value '....:...93....:...94'.
05 filler pic X(20) value '....:...95....:...96'.
05 filler pic X(20) value '....:...97....:...98'.
05 filler pic X(20) value '....:...99....:..100'.
05 filler pic X(20) value '....:..110....:..120'.
05 filler pic X(04) value '....'.
01 RECORD-HEADER.
05 RECORD-ID pic X(3) value '1ST'.
05 filler pic X(2) value ', '.
05 REC-NUMBER pic 9(9) value 0.
05 filler pic X value '('.
05 RECORD-POS pic 9(5) value 0.
05 filler pic X value ':'.
05 RECORD-LEN pic 9(5) value 0.
05 filler pic X value ')'.
01 BANNER-STARS.
05 filler pic X(79) value all '*'.
01 BANNER-TEXT.
05 filler pic X(2) value '* '.
05 filler pic X(24) value is SPACES.
05 filler pic X(26) value 'Data File Content Compare '.
05 filler pic X(25) value is SPACES.
05 filler pic X(2) value ' *'.
01 INFO-STATEMENT.
05 INFO-SHORT.
10 INFO-ID pic X(8) value 'Starting'.
10 filler pic X(32)
value ' - Data File Content Comparison'.
05 filler pic X(32)
value ' by SimoTime Enterprises, LLC '.
01 SQEDDF01-TOTAL.
05 SQEDDF01-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for SQEDDF01'.
01 SQEDDF02-TOTAL.
05 SQEDDF02-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for SQEDDF02'.
01 COMPARE-NE-TOTAL.
05 COMPARE-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Unequal count'.
01 FORMAT-TYPE pic X value 'B'.
COPY PASSHEX4.
COPY PASSLOGS.
*****************************************************************
PROCEDURE DIVISION.
perform JOB-STARTING
perform
until COMPARE-STATUS = 'QT'
or SQEDDF01-STATUS not = '00'
or SQEDDF02-STATUS not = '00'
if READ-1 = 'Y'
perform SQEDDF01-READ
end-if
if READ-2 = 'Y'
perform SQEDDF02-READ
end-if
if SQEDDF01-STATUS = '00'
and SQEDDF02-STATUS = '00'
move 'EQ' to COMPARE-STATUS
if KEY-ACTIVE = 'Y'
perform COMPARE-KEYS
end-if
if COMPARE-STATUS = FLAG-EQ
perform COMPARE-RECORDS
end-if
if COMPARE-STATUS = FLAG-NE
add 1 to COMPARE-NE
end-if
end-if
end-perform
perform JOB-FINISHED
GOBACK.
*****************************************************************
COMPARE-RECORDS.
*> Compare...
if SQEDDF01-REC(00001:00080) not = SQEDDF02-REC(00001:00080)
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
add 00001 to ZERO giving D-POS
add 00001 to ZERO giving RECORD-POS
add 00080 to ZERO giving D-LEN
add 00080 to ZERO giving PASSHEX4-LENGTH
add 00080 to ZERO giving RECORD-LEN
perform DUMP-PRIMARY-RECORD
perform DUMP-SECONDARY-RECORD
perform DUMP-POSITION-DIFFERENCE
end-if
end-if
exit.
*****************************************************************
COMPARE-KEYS.
move YES-YES to READ-FLAGS
if SQEDDF01-REC(PS-1:LN-1)
< SQEDDF02-REC(PS-2:LN-2)
move N-BYTE to READ-2
end-if
if SQEDDF01-REC(PS-1:LN-1)
> SQEDDF02-REC(PS-2:LN-2)
move N-BYTE to READ-1
end-if
exit.
*****************************************************************
DUMP-TO-LOG.
*> HexDump...
move RECORD-HEADER to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move DUMP-HEADER(D-POS:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if DUMP-ASC = 'Y'
move PASSHEX4-ASCII(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-HEX = 'Y'
move PASSHEX4-UPPER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move PASSHEX4-LOWER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-EBC = 'Y'
move PASSHEX4-EBCDIC(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
exit.
*****************************************************************
DUMP-PRIMARY-RECORD.
move SPACES to PASSHEX4-SOURCE
if READ-1 = 'Y'
and SQEDDF01-EOF = 'N'
move '1ST' to RECORD-ID
add SQEDDF01-RDR to ZERO giving REC-NUMBER
move SQEDDF01-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
else
move '1ST, Record is missing from SQEDDF01 file'
to SIMOLOGS-MESSAGE
end-if
exit.
*****************************************************************
DUMP-SECONDARY-RECORD.
move SPACES to PASSHEX4-SOURCE
if READ-2 = 'Y'
and SQEDDF02-EOF = 'N'
move '2ND' to RECORD-ID
add SQEDDF02-RDR to ZERO giving REC-NUMBER
move SQEDDF02-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
else
move '2ND, Record is missing from SQEDDF02 file'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCE.
if READ-FLAGS = 'YY'
move all '-' to DELTA-LINE
add D-POS to ZERO giving PTR-1
add 1 to ZERO giving IDX-2
perform until PTR-1 > 1024
or IDX-2 > D-LEN
if SQEDDF01-REC(PTR-1:1)
= SQEDDF02-REC(PTR-1:1)
move '=' to DELTA-LINE(PTR-1:1)
else
move '#' to DELTA-LINE(PTR-1:1)
end-if
add 1 to PTR-1
add 1 to IDX-2
end-perform
else
move all '#' to DELTA-LINE
end-if
move DELTA-LINE(D-POS:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move '*' to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
JOB-FINISHED.
perform SQEDDF02-CLOSE
perform SQEDDF01-CLOSE
move 'Summary ' to INFO-ID
move INFO-SHORT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SQEDDF01-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SQEDDF02-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if SQEDDF01-RDR not = SQEDDF02-RDR
move 'WARNING! - Record counts are not equal'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move COMPARE-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if SQEDDF01-EOF = 'Y'
and SQEDDF02-EOF = 'Y'
move 'Finished' to INFO-ID
else
move 'ABENDING' to INFO-ID
end-if
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if COMPARE-NE > 0
or SQEDDF01-RDR not = SQEDDF02-RDR
add 4 to ZERO giving RETURN-CODE
end-if
exit.
*****************************************************************
JOB-STARTING.
perform Z-POST-COPYRIGHT
perform Z-DETERMINE-ENVIRONMENT
perform SQEDDF01-OPEN
perform SQEDDF02-OPEN
move 'Y' to READ-1
move 'Y' to READ-2
if DELTA-MAXIMUM not numeric
add 100 to ZERO giving DELTA-MAXIMUM
end-if
if PS-1 > 0
and PS-2 > 0
and LN-1 > 0
and LN-2 > 0
move 'Y' to KEY-ACTIVE
move 'Key control is ENABLED...'
to MESSAGE-TEXT
else
move 'N' to KEY-ACTIVE
move 'Key control is NOT enabled...'
to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
move 'DUMP' to PASSHEX4-REQUEST
add 128 to ZERO giving PASSHEX4-LENGTH
move 'NOTE' to SIMOLOGS-REQUEST
move BANNER-STARS to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move BANNER-TEXT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move BANNER-STARS to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
* I/O Routines for the Primary File... *
*****************************************************************
SQEDDF01-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SQEDDF01-READ.
read SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
add 1 to SQEDDF01-RDR
else
if SQEDDF01-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to SQEDDF01-EOF
else
move 'READ Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
SQEDDF01-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input SQEDDF01-FILE
if SQEDDF01-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SQEDDF01-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with SQEDDF01' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF01-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the Secondary File... *
*****************************************************************
SQEDDF02-READ.
read SQEDDF02-FILE
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
add 1 to SQEDDF02-RDR
else
if SQEDDF02-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to SQEDDF02-EOF
else
move 'READ Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
SQEDDF02-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input SQEDDF02-FILE
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SQEDDF02-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SQEDDF02-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SQEDDF02-FILE
if SQEDDF02-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to SQEDDF02-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with SQEDDF02' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SQEDDF02-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
Z-DETERMINE-ENVIRONMENT.
add 16833 to ASC-OR-EBC
if ASC-A = 'A'
move 'Compiled for an ASCII environment...'
to MESSAGE-TEXT
else
if EBC-A = 'A'
move 'Compiled for an EBCDIC environment...'
to MESSAGE-TEXT
else
move 'Compiled for an UNKNOWN environment...'
to MESSAGE-TEXT
end-if
end-if
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2004-12-30 Generation Time: 15:12:49:85 *
*****************************************************************
The purpose of this document is to assist as a tutorial for new
programmers or as a quick reference for experienced programmers. This suite of
programs provides an example of how to create and access data files containing
variable length records.
Permission to use, copy, modify and distribute this software for any
commercial purpose requires a fee to be paid to SimoTime Enterprises. Once the
fee is received by SimoTime the latest version of the software will be
delivered and a license will be granted for use within an enterprise, provided
the SimoTime copyright notice appear on all copies of the software. The
SimoTime name or Logo may not be used in any advertising or publicity
pertaining to the use of the software without the written permission of
SimoTime Enterprises.
Permission to use, copy and modify this software for any non-commercial
purpose and without fee is hereby granted, provided the SimoTime copyright
notice appear on all copies of the software. The SimoTime name or Logo may not
be used in any advertising or publicity pertaining to the use of the software
without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the
suitability of the software for any purpose. It is provided "AS IS" without any
express or implied warranty, including the implied warranties of
merchantability, fitness for a particular purpose and non-infringement.
SimoTime Enterprises shall not be liable for any direct, indirect, special or
consequential damages resulting from the loss of use, data or projects, whether
in an action of contract or tort, arising out of or in connection with the use
or performance of this software.
If you have any questions, suggestions or comments please call or send
an e-mail to:
helpdesk@simotime.com
You may download this example at
http://www.simotime.com/sim4dzip.htm#CobolVariableLengthRecords
or view the complete list of SimoTime Examples at
http://www.simotime.com/sim4dzip.htm
.
Note:
You must be attached to
the Internet to download a Z-Pack or view the list.
Check out
The COBOL Connection in the
SimoTime Library for more examples of mainframe COBOL techniques and sample
code.
Check out
The JCL Connection in the
SimoTime Library for more mainframe JCL examples.
Check out
The SimoTime Library for a
wide range of topics for Programmers, Project Managers and Software
Developers.
To review all the information available on the SimoTIme Web Site start
at
http://www.SimoTime.com .
For more information about Micro Focus Mainframe Express refer to
http://www.microfocus.com .
If you have any questions, suggestions or comments please call or send
an e-mail to:
helpdesk@simotime.com
Founded in 1987, SimoTime Enterprises is a privately owned company. We
specialize in the creation and deployment of business applications using new or
existing technologies and services. We have a team of individuals that
understand the broad range of technologies being used in today's environments.
This includes the smallest thin client using the Internet and the very large
mainframe systems. There is more to making the Internet work for your company's
business than just having a nice looking WEB site. It is about combining the
latest technologies and existing technologies with practical business
experience. It's about the business of doing business and looking good in the
process. Quite often, to reach larger markets or provide a higher level of
service to existing customers it requires the newer Internet technologies to
work in a complementary manner with existing corporate mainframe systems.
Whether you want to use the Internet to expand into new market segments or as a
delivery vehicle for existing business functions simply give us a call or check
the web site at
http://www.simotime.com
