File Access, Standard COBOL Dialect
|
Variable-Length Records File Access, Standard COBOL Dialect |
|
| The SimoTime Home Page |
Introduction
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.
| ||||||
| Alternatives to Create, Access and Convert Data Files that use Variable-Length-Records |
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 COBOL programs that do the conversion and comparison are generated to be compliant with 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. The compare function that is used in this example uses the SimoLOGS and SimoHEX4 routines and will require the SIMOMODS technology package to be downloaded.
Additional information is provided in the Downloads and Links section of this document.
We have made a significant effort to ensure the documents and software technologies are correct and accurate. We reserve the right to make changes without notice at any time. The function delivered in this version is based upon the enhancement requests from a specific group of users. The intent is to provide changes as the need arises and in a timeframe that is dependent upon the availability of resources.
Copyright © 1987-2025
SimoTime Technologies and Services
All Rights Reserved
Programming Objectives
The following is a list of the functions provided in this example.
| ||||||||
| Functions Described and Demonstrated by this Suite of Programs |
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.
Programming Input and Output
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.
Programming Requirements
This suite of samples programs will run on the following platforms.
| ||||||
| Requirements for an Operating System and Supporting Software |
Programming Overview
The following diagrams show the processing logic for each of the jobs in this suite of programs that create convert and compare data files.
Color Associations: The
Create a File with Fixed Length Records
The following process will create a sequential file containing fixed-length, 80-byte records.
|
|
|
|
| ||||||||||
| Summary of Command Files provided with this Suite of Programs |
Create a File with Fixed-Length Records
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
set CmdName=CRTF80E1
rem * *******************************************************************
rem * CRTF80E1.cmd - a Windows Command File *
rem * This Job Script is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 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 Technologies
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 *
call ..\Env1BASE
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 LS80TXT1=%BaseLib1%\DATA\TXT1\SIMOTIME.TEXT.LS80TXT1.TXT
if exist %LS80TXT1% del %LS80TXT1%
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 >>%LS80TXT1%
echo 000000000002 AB >>%LS80TXT1%
echo 000000000003 ABC >>%LS80TXT1%
echo 000000000004 ABCD >>%LS80TXT1%
echo 000000000005 ABCDE >>%LS80TXT1%
echo 000000000006 ABCDEF >>%LS80TXT1%
echo 000000000007 ABCDEFG >>%LS80TXT1%
echo 000000000008 ABCDEFGH >>%LS80TXT1%
echo 000000000009 ABCDEFGHI >>%LS80TXT1%
echo 000000000010 ABCDEFGHIJ >>%LS80TXT1%
echo 000000000011 ABCDEFGHIJK >>%LS80TXT1%
echo 000000000012 ABCDEFGHIJKL >>%LS80TXT1%
echo 000000000013 ABCDEFGHIJKLM >>%LS80TXT1%
echo 000000000014 ABCDEFGHIJKLMN >>%LS80TXT1%
echo 000000000015 ABCDEFGHIJKLMNO >>%LS80TXT1%
echo 000000000016 ABCDEFGHIJKLMNOP >>%LS80TXT1%
echo 000000000017 ABCDEFGHIJKLMNOPR >>%LS80TXT1%
echo 000000000018 ABCDEFGHIJKLMNOPQR >>%LS80TXT1%
echo 000000000019 ABCDEFGHIJKLMNOPQRS >>%LS80TXT1%
echo 000000000020 ABCDEFGHIJKLMNOPQRST >>%LS80TXT1%
echo 000000000021 ABCDEFGHIJKLMNOPQRSTU >>%LS80TXT1%
echo 000000000022 ABCDEFGHIJKLMNOPQRSTUV >>%LS80TXT1%
echo 000000000023 ABCDEFGHIJKLMNOPQRSTUVW >>%LS80TXT1%
echo 000000000024 ABCDEFGHIJKLMNOPQRSTUVWX >>%LS80TXT1%
echo 000000000025 ABCDEFGHIJKLMNOPQRSTUVWXY >>%LS80TXT1%
echo 000000000026 ABCDEFGHIJKLMNOPQRSTUVWXYZ >>%LS80TXT1%
echo 000000000027 ABCDEFGHIJKLMNOPQRSTUVWZXZ0123456789 >>%LS80TXT1%
echo 000000000028 ABCDEFGHIJKLMNOPQRSTUVWXYZ >>%LS80TXT1%
echo 000000000029 ABCDEFGHIJKLMNOPQRSTUVWXY >>%LS80TXT1%
echo 000000000030 ABCDEFGHIJKLMNOPQRSTUVWX >>%LS80TXT1%
echo 000000000031 ABCDEFGHIJKLMNOPQRSTUVW >>%LS80TXT1%
echo 000000000032 ABCDEFGHIJKLMNOPQRSTUV >>%LS80TXT1%
echo 000000000033 ABCDEFGHIJKLMNOPQRSTU >>%LS80TXT1%
echo 000000000034 ABCDEFGHIJKLMNOPQRST >>%LS80TXT1%
echo 000000000035 ABCDEFGHIJKLMNOPQRS >>%LS80TXT1%
echo 000000000036 ABCDEFGHIJKLMNOPQR >>%LS80TXT1%
echo 000000000037 ABCDEFGHIJKLMNOPQ >>%LS80TXT1%
echo 000000000038 ABCDEFGHIJKLMNOR >>%LS80TXT1%
echo 000000000039 ABCDEFGHIJKLMNO >>%LS80TXT1%
echo 000000000040 ABCDEFGHIJKLMN >>%LS80TXT1%
echo 000000000041 ABCDEFGHIJKLM >>%LS80TXT1%
echo 000000000042 ABCDEFGHIJKL >>%LS80TXT1%
echo 000000000043 ABCDEFGHIJK >>%LS80TXT1%
echo 000000000044 ABCDEFGHIJ >>%LS80TXT1%
echo 000000000045 ABCDEFGHI >>%LS80TXT1%
echo 000000000046 ABCDEFGH >>%LS80TXT1%
echo 000000000047 ABCDEFG >>%LS80TXT1%
echo 000000000048 ABCDEF >>%LS80TXT1%
echo 000000000049 ABCDE >>%LS80TXT1%
echo 000000000050 ABCD >>%LS80TXT1%
echo 000000000051 ABC >>%LS80TXT1%
echo 000000000052 AB >>%LS80TXT1%
echo 000000000053 A >>%LS80TXT1%
echo 000000000054 a >>%LS80TXT1%
echo 000000000055 ab >>%LS80TXT1%
echo 000000000056 abc >>%LS80TXT1%
echo 000000000057 abcd >>%LS80TXT1%
echo 000000000058 abcde >>%LS80TXT1%
echo 000000000059 abcdef >>%LS80TXT1%
echo 000000000060 abcdefg >>%LS80TXT1%
echo 000000000061 abcdefgh >>%LS80TXT1%
echo 000000000062 abcdefghi >>%LS80TXT1%
echo 000000000063 abcdefghij >>%LS80TXT1%
echo 000000000064 abcdefghijk >>%LS80TXT1%
echo 000000000065 abcdefghijkl >>%LS80TXT1%
echo 000000000066 abcdefghijklm >>%LS80TXT1%
echo 000000000067 abcdefghijklmn >>%LS80TXT1%
echo 000000000068 abcdefghijklmno >>%LS80TXT1%
echo 000000000069 abcdefghijklmnop >>%LS80TXT1%
echo 000000000070 abcdefghijklmnopr >>%LS80TXT1%
echo 000000000071 abcdefghijklmnopqr >>%LS80TXT1%
echo 000000000072 abcdefghijklmnopqrs >>%LS80TXT1%
echo 000000000073 abcdefghijklmnopqrst >>%LS80TXT1%
echo 000000000074 abcdefghijklmnopqrstu >>%LS80TXT1%
echo 000000000075 abcdefghijklmnopqrstuv >>%LS80TXT1%
echo 000000000076 abcdefghijklmnopqrstuvw >>%LS80TXT1%
echo 000000000077 abcdefghijklmnopqrstuvwx >>%LS80TXT1%
echo 000000000078 abcdefghijklmnopqrstuvwxy >>%LS80TXT1%
echo 000000000079 abcdefghijklmnopqrstuvwxyz >>%LS80TXT1%
echo 000000000080 abcdefghijklmnopqrstuvwzxz0123456789 >>%LS80TXT1%
echo 000000000081 abcdefghijklmnopqrstuvwxyz >>%LS80TXT1%
echo 000000000082 abcdefghijklmnopqrstuvwxy >>%LS80TXT1%
echo 000000000083 abcdefghijklmnopqrstuvwx >>%LS80TXT1%
echo 000000000084 abcdefghijklmnopqrstuvw >>%LS80TXT1%
echo 000000000085 abcdefghijklmnopqrstuv >>%LS80TXT1%
echo 000000000086 abcdefghijklmnopqrstu >>%LS80TXT1%
echo 000000000087 abcdefghijklmnopqrst >>%LS80TXT1%
echo 000000000088 abcdefghijklmnopqrs >>%LS80TXT1%
echo 000000000089 abcdefghijklmnopqr >>%LS80TXT1%
echo 000000000090 abcdefghijklmnopq >>%LS80TXT1%
echo 000000000091 abcdefghijklmnor >>%LS80TXT1%
echo 000000000092 abcdefghijklmno >>%LS80TXT1%
echo 000000000093 abcdefghijklmn >>%LS80TXT1%
echo 000000000094 abcdefghijklm >>%LS80TXT1%
echo 000000000095 abcdefghijkl >>%LS80TXT1%
echo 000000000096 abcdefghijk >>%LS80TXT1%
echo 000000000097 abcdefghij >>%LS80TXT1%
echo 000000000098 abcdefghi >>%LS80TXT1%
echo 000000000099 abcdefgh >>%LS80TXT1%
echo 000000000100 abcdefg >>%LS80TXT1%
echo 000000000101 abcdef >>%LS80TXT1%
echo 000000000102 abcde >>%LS80TXT1%
echo 000000000103 abcd >>%LS80TXT1%
echo 000000000104 abc >>%LS80TXT1%
echo 000000000105 ab >>%LS80TXT1%
echo 000000000106 a >>%LS80TXT1%
if exist %LS80TXT1% 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=%LS80TXT1%
set PUTRS080=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.RS80ASC1.DAT
if exist %PUTRS080% del %PUTRS080%
run CV80ALAR
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=%LS80TXT1%
set PUTRS080=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.RS80EBC1.DAT
if exist %PUTRS080% del %PUTRS080%
run CV80ALER
if not exist %PUTRS080% set JobStatus=0004
if not "%JobStatus%" == "0000" goto EojNok
call SimoNOTE "Produced DataSet %PUTRS080%"
:EojAok
call SimoNOTE "Produced %LS80TXT1%"
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
File Convert Jobs using CMD Files
Included in this suite of programs are two CMD files that will do File Conversion.
Fixed-Length to Variable-Length
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 * CBLV80E1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 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 Technologies
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 ..\Env1BASE
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%\DATA\Asc1\SIMOTIME.DATA.SQEDDF01.DAT
set VREDDV01=%BaseLib1%\DATA\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
Variable-Length to Fixed-Length
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 * CBLV80E2.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 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 Technologies
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 ..\Env1BASE
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
:DeleteQSAM
set VREDDV01=%BaseLib1%\DATA\Asc1\SIMOTIME.DATA.VREDDV01.DAT
set SQEDDF02=%BaseLib1%\DATA\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
Compare Two Files
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 * CBLV80E3.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 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 Technologies
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 ..\Env1BASE %CmdName%
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%\DATA\Asc1\SIMOTIME.DATA.SQEDDF01.DAT
set SQEDDF02=%BaseLib1%\DATA\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
The JCL Members
This sample suite of programs has four JCL members. The following table is a list of the sample JCL members.
| ||||||||||
| Summary of JCL Members provided with this Suite of Programs |
Create a File with Fixed-Length
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 //* ******************************************************************* //* CRTF80J1.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2019 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 Technologies //* 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 of 2, 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 of 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) //
File Convert Jobs using JCL Members
Included in this suite of programs are two JCL Members that will do File Conversion.
Fixed-Length to Variable-Length
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 //* ******************************************************************* //* CBLV80J1.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2019 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Read fixed file, create variable file. //* Author - SimoTime Technologies //* 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 of 2, 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 3 of 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=* //
Variable-Length to Fixed-Length
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 //* ******************************************************************* //* CBLV80J2.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2019 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 Technologies //* 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 of 2, 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 of 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=* //
Compare Two Files
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 //* ******************************************************************* //* CBLV80J3.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2019 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Compare the two sequential files. //* Author - SimoTime Technologies //* 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 of 2, 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 1 of 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 COBOL Programs
The following is the source code listings for the three sample COBOL program.
File Convert using COBOL Programs
Included in this suite of programs are two COBOL programs that will do File Conversion.
Convert, Fixed-Length to Variable-Length
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 TECHNOLOGIES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2018-10-10 Generation Time: 20:28:11:58 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* PRIMARY SQEDDF01 SEQUENTIAL FIXED 00080 *
* *
* SECONDARY VREDDV01 SEQUENTIAL VARIABLE 00080 *
* 00001 *
* *
*****************************************************************
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 VARYING FROM 00001 TO 00080
DEPENDING ON VREDDV01-LRECL
.
01 VREDDV01-REC.
05 VREDDV01-DATA-01 PIC X(00080).
*****************************************************************
* This program was created with 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. This is a sequential load process. *
* *
* If the key field is not in sequence then refer to SYSMASK2 *
* to provide for a random add or update of the indexed file. *
* *
* This program mask will have the ASCII/EBCDIC table inserted *
* for use by the /TRANSLATE function of SimoZAPS. *
* *
* For more information or questions please contact SimoTime *
* Technologies. The version control number is 16.01.01 *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLV80C1 '.
05 T2 pic X(34) value 'Convert RSEQ/80 to VREC 1-80 '.
05 T3 pic X(10) value ' v16.01.01'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLV80C1 '.
05 C2 pic X(32) value 'This Data File Convert Member wa'.
05 C3 pic X(32) value 's generated by SimoTime Technolo'.
05 C4 pic X(04) value 'gies'.
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'.
01 SQEDDF01-LRECL pic 9(5) value 00080.
01 VREDDV01-LRECL pic 9(5) value 00080.
01 SQEDDF01-LRECL-MAX pic 9(5) value 00080.
01 VREDDV01-LRECL-MAX pic 9(5) value 00080.
*****************************************************************
* 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(011) value '* CBLV80C1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(068) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MSG-LSB pic 9(5) value 267.
*****************************************************************
01 PROGRAM-NAME pic X(8) value 'CBLV80C1'.
01 INFO-STATEMENT.
05 INFO-SHORT.
10 INFO-ID pic X(8) value 'Starting'.
10 filler pic X(2) value ', '.
10 filler pic X(34)
value 'Convert RSEQ/80 to VREC 1-80 '.
05 filler pic X(24)
value ' http://www.SimoTime.com'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 WRITE-FLAG pic X value 'Y'.
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.
move all '*' to MESSAGE-TEXT-1
perform Z-DISPLAY-MESSAGE-TEXT
move INFO-STATEMENT to MESSAGE-TEXT-1
perform Z-DISPLAY-MESSAGE-TEXT
move all '*' to MESSAGE-TEXT-1
perform Z-DISPLAY-MESSAGE-TEXT
perform Z-POST-COPYRIGHT
perform SQEDDF01-OPEN
perform VREDDV01-OPEN
* USRSOJ Processing not specified...
perform until SQEDDF01-STATUS not = '00'
perform SQEDDF01-READ
if SQEDDF01-STATUS = '00'
add 1 to SQEDDF01-RDR
perform BUILD-OUTPUT-RECORD
if WRITE-FLAG = 'Y'
perform VREDDV01-WRITE
if VREDDV01-STATUS = '00'
add 1 to VREDDV01-ADD
end-if
end-if
end-if
end-perform
* USREOJ Processing not specified...
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 'Complete' to INFO-ID
else
move 'ABENDING' to INFO-ID
end-if
move INFO-STATEMENT to MESSAGE-TEXT(1:79)
perform Z-DISPLAY-MESSAGE-TEXT
perform VREDDV01-CLOSE
perform SQEDDF01-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
* TransCOPY...
move SQEDDF01-REC(00001:00080) to VREDDV01-REC(00001:00080)
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.
*****************************************************************
Z-CALCULATE-MESSAGE-LSB.
add 267 to ZERO giving MSG-LSB
perform until MSG-LSB < 80
or MESSAGE-BUFFER(MSG-LSB:1) not = SPACE
if MESSAGE-BUFFER(MSG-LSB:1) = SPACE
subtract 1 from MSG-LSB
end-if
end-perform
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB)
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 Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2018-10-10 Generation Time: 20:28:11:60 *
*****************************************************************
Convert, Variable-Length to Fixed-Length
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 TECHNOLOGIES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* 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 *
* *
* Note: For variable length records the minimum record length *
* is actually 4 to allow for the Record Descriptor Word (RDW). *
* *
*****************************************************************
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-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
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 Technologies *
* 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 *
*****************************************************************
Compare Two Files
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 TECHNOLOGIES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2020-06-25 Generation Time: 19:20:16:92 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* PRIMARY SQEDDF01 SEQUENTIAL FIXED 00080 *
* *
* SECONDARY 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 data file comparison. The positions to be *
* compared are determined at compile time. *
* *
* For more information or questions please contact SimoTime *
* Technologies. The version control number is 20.00.00 *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLV80C3 '.
05 T2 pic X(34) value 'Compare 80/80, key field is 1 - 12'.
05 T3 pic X(10) value ' v20.00.00'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLV80C3 '.
05 C2 pic X(32) value 'This Data File Compare Member wa'.
05 C3 pic X(32) value 's generated by SimoTime Technolo'.
05 C4 pic X(04) value 'gies'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* CBLV80C3 '.
05 C2 pic X(32) value 'A Data File Compare Program gene'.
05 C3 pic X(32) value 'rated by using SimoTime Technolo'.
05 C4 pic X(04) value 'gies'.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* CBLV80C3 '.
05 C2 pic X(32) value 'Please send all comments or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
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 SQEDDF01-LRECL pic 9(5) value 00080.
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'.
01 SQEDDF02-LRECL pic 9(5) value 00080.
*****************************************************************
* 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 KEY-ACTIVE pic X value 'Y'.
01 KEY-CONTROL-1.
05 K-PS-1 pic 9(5) value 00001.
05 K-LN-1 pic 9(5) value 00012.
01 KEY-CONTROL-2.
05 K-PS-2 pic 9(5) value 00001.
05 K-LN-2 pic 9(5) value 00012.
01 KEYRECID-ACTIVE pic X value 'N'.
01 KEYRECID-CONTROL-1.
05 E-PS-1 pic 9(5) value 00000.
05 E-LN-1 pic 9(5) value 00000.
01 KEYRECID-CONTROL-2.
05 E-PS-2 pic 9(5) value 00000.
05 E-LN-2 pic 9(5) value 00000.
01 READ-FLAGS.
05 READ-1 pic X value 'Y'.
05 READ-2 pic X value 'Y'.
01 DUMP-FLAGS.
05 DUMP-RPI pic X value 'Y'.
05 DUMP-ASC pic X value 'Y'.
05 DUMP-EBC pic X value 'Y'.
05 DUMP-HEX pic X value 'Y'.
05 DUMP-DET-GRP.
10 DUMP-DET pic X value 'Y'.
10 DUMP-DET-2 pic XX value 'NE'.
05 DUMP-SUM pic X value 'Y'.
05 DUMP-STATUS pic x VALUE 'Y'.
01 DUMP-PGM pic X(8) value 'DISABLED'.
01 DPOS-UT1 pic 9(5) value 1.
01 DLEN-UT1 pic 9(5) value 00000.
01 DPOS-UT2 pic 9(5) value 1.
01 DLEN-UT2 pic 9(5) value 00000.
01 FUNCTION-FLAGS.
05 FF-01 pic X value '1'.
05 FF-02 pic X value '0'.
05 FF-03 pic X value '0'.
01 COMPACT-STATUS pic XX value 'EQ'.
01 COMPACT-PENDED pic XX value 'EQ'.
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-1 pic X(1024) value all '-'.
01 DELTA-LINE-2 pic X(1024) value all '-'.
01 PTR-1 pic 9(5) value 0.
01 PTR-2 pic 9(5) value 0.
01 IDX-1 pic 9(5) value 0.
01 IDX-2 pic 9(5) value 0.
01 BYPASS-UT1-CTR pic 9(3) value 0.
01 BYPASS-UT2-CTR pic 9(3) value 0.
01 WORK-05 pic X(5) value SPACES.
01 WORK-LENGTH pic 9(5) value 0.
01 DELTA-MAX-ABEND.
05 FILLER pic X(10) value 'ABENDING, '.
05 FILLER pic X(24) value 'Not Equal count exceeds '.
05 FILLER pic X(22) value 'user-defined limit of '.
05 DELTA-MAXIMUM-X pic X(9) value '000000005'.
05 DELTA-MAXIMUM redefines DELTA-MAXIMUM-X pic 9(9).
05 FILLER pic X(19) value ', ABEND process is '.
05 DELTA-PROCESS pic X(4) value 'EOF '.
01 IFNECODE-GROUP.
05 IFNECODE-VALUE pic 9(4) value 0012.
01 YES-YES pic XX value 'YY'.
01 N-BYTE pic X value 'N'.
01 Y-BYTE pic X value 'Y'.
01 GROUP-DELIMITER pic X value 'Y'.
01 LEN-UT1 pic 9(5) value 128.
01 POS-UT1 pic 9(5) value 1.
01 LEN-UT2 pic 9(5) value 128.
01 POS-UT2 pic 9(5) value 1.
01 LEN-1 pic 9(5) value 128.
01 POS-1 pic 9(5) value 1.
01 LEN-2 pic 9(5) value 128.
01 POS-2 pic 9(5) value 1.
01 D-LEN pic 9(5) value 128.
01 D-POS pic 9(5) value 1.
01 W-LEN pic 9(5) value 0.
01 W-POS pic 9(5) value 10.
01 DUMP-RECL-MAX-S pic X value 'N'.
01 DUMP-RECL-MAX pic 9(5) value 00000.
01 CONTINUE-FLAG pic X value 'Y'.
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.
* Header row for positional indicator...
01 DUMP-H10.
05 FILLER pic X(5) value '....:'.
05 POS-NO pic 9(5) value 10.
05 FILLER pic X(10) value '....:.....'.
01 DUMP-W10.
05 FILLER pic X(5) value '....:'.
05 W10-POS-NO pic X(5) value '00000'.
05 FILLER pic X(10) value '....:.....'.
01 DUMP-HEADER pic X(1024) value all '.'.
01 D-P1 pic 9(5) value 0.
01 WK-1 pic 9(5) value 0.
01 WK-2 pic 9(5) value 0.
01 RECORD-HEADER.
05 RECORD-ID pic X(8) value 'SQEDDF01'.
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(2) value ') '.
05 REC-CTYPE pic X(10) value 'UNKNOWN '.
05 filler pic X(2) value SPACES.
05 REC-CMODE pic X(10) value 'UNKNOWN '.
01 SYSLOG-OUTPUT pic X(4) value 'OUT1'.
01 INFO-STATEMENT.
05 INFO-SHORT.
10 INFO-ID pic X(8) value 'Starting'.
10 filler pic X(4) value ' - '.
10 INFO-34 pic X(34)
value 'Compare 80/80, key field is 1 - 12'.
05 filler pic X(33)
value ' http://www.SimoTime.com'.
01 UT1-MISSING.
05 filler pic X(5) value 'This '.
05 filler pic X(31)
value 'record is MISSING from SQEDDF01'.
05 filler pic X(7) value ' - the '.
05 filler pic X(29)
value 'record is PRESENT in SQEDDF02'.
01 UT2-MISSING.
05 filler pic X(5) value 'This '.
05 filler pic X(29)
value 'record is PRESENT in SQEDDF01'.
05 filler pic X(7) value ' - the '.
05 filler pic X(31)
value 'record is MISSING from SQEDDF02'.
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 SQEDDF01-OMIT.
05 SQEDDF01-OMT pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Bypass count for SQEDDF01'.
01 SQEDDF02-OMIT.
05 SQEDDF02-OMT pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Bypass count for SQEDDF02'.
01 COMPARE-NE-TOTAL.
05 COMPARE-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPARE-TAG.
10 filler pic X(25) value 'NOT Equal count for compa'.
10 filler pic X(25) value 're of existing records '.
01 COMPACT-NE-TOTAL.
05 COMPACT-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPACT-TAG.
10 filler pic X(25) value 'NOT Equal count for compa'.
10 filler pic X(25) value 'ct of existing records '.
01 COMPARE-EQ-TOTAL.
05 COMPARE-EQ pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Number of matching record'.
05 filler pic X(25) value ' pairs for Compare Task '.
01 COMPACT-EQ-TOTAL.
05 COMPACT-EQ pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Number of matching record'.
05 filler pic X(25) value ' pairs for Compact Task '.
01 FORMAT-TYPE pic X value 'B'.
COPY PASSHEX4.
COPY PASSLOGS.
COPY PAENVARS.
*****************************************************************
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
move 'N' to DUMP-STATUS
move all '-' to DELTA-LINE-1
move all '-' to DELTA-LINE-2
if KEY-ACTIVE = 'Y'
and COMPARE-STATUS = FLAG-EQ
perform COMPARE-KEYS
end-if
if COMPARE-STATUS = FLAG-EQ
perform COMPARE-RECORDS
end-if
if DUMP-STATUS = 'Y'
if GROUP-DELIMITER = 'Y'
perform DUMP-ASTERISK-ONE
end-if
add DLEN-UT1 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-PRIMARY-RECORD
perform DUMP-POSITION-DIFFERENCES-1
perform DUMP-SECONDARY-RECORD
perform DUMP-POSITION-DIFFERENCES-2
add DLEN-UT2 to ZERO giving D-LEN
move 'N' to DUMP-STATUS
end-if
if COMPARE-STATUS = FLAG-NE
add 1 to COMPARE-NE
end-if
else
move 'NE' to COMPARE-STATUS
end-if
if COMPARE-STATUS = 'EQ'
add 1 to COMPARE-EQ
end-if
if DELTA-PROCESS = 'QUIT'
and COMPARE-NE > DELTA-MAXIMUM
perform JOB-FINISHED
move DELTA-MAX-ABEND to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
if DELTA-PROCESS = 'EOF '
and COMPARE-NE > DELTA-MAXIMUM
move DELTA-MAX-ABEND to MESSAGE-TEXT
perform Z-DISPLAY-TO-CONSOLE
move 'QT' to COMPARE-STATUS
end-if
end-perform
perform JOB-FINISHED
GOBACK.
*****************************************************************
COMPARE-RECORDS.
* Physical Comparison with NE Output of DISABLED
move 'COMPARISON' to REC-CTYPE
move 'PHYSICAL ' to REC-CMODE
if SQEDDF01-REC(00013:00068) not = SQEDDF02-REC(00013:00068)
move FLAG-NE to COMPARE-STATUS
add 1 to COMPARE-NE
move 'Y' to DUMP-STATUS
end-if
if DUMP-DET = 'Y'
add 00013 to ZERO giving POS-UT1
add 00013 to ZERO giving POS-UT2
add 00068 to ZERO giving LEN-UT1
add 00068 to ZERO giving LEN-UT2
add 00068 to ZERO giving PASSHEX4-LENGTH
perform CALC-DELTA-FOR-NE-EQ-NO
end-if
exit.
*****************************************************************
COMPARE-KEYS.
move YES-YES to READ-FLAGS
if SQEDDF01-REC(K-PS-1:K-LN-1)
< SQEDDF02-REC(K-PS-2:K-LN-2)
move N-BYTE to READ-2
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
and DUMP-DET-GRP = 'YNE'
perform DUMP-SECONDARY-MISSING
end-if
end-if
if SQEDDF01-REC(K-PS-1:K-LN-1)
> SQEDDF02-REC(K-PS-2:K-LN-2)
move N-BYTE to READ-1
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
and DUMP-DET-GRP = 'YNE'
perform DUMP-PRIMARY-MISSING
end-if
end-if
exit.
*****************************************************************
CALC-DELTA-FOR-NE-EQ-NO.
add POS-UT1 to ZERO giving PTR-1
add POS-UT2 to ZERO giving PTR-2
perform until PTR-1 > POS-UT1 + LEN-UT1 - 1
or PTR-2 > POS-UT2 + LEN-UT2 - 1
if SQEDDF01-REC(PTR-1:1)
= SQEDDF02-REC(PTR-2:1)
move '=' to DELTA-LINE-1(PTR-1:1)
move '=' to DELTA-LINE-2(PTR-2:1)
else
move '#' to DELTA-LINE-1(PTR-1:1)
move '#' to DELTA-LINE-2(PTR-2:1)
end-if
add 1 to PTR-1
add 1 to PTR-2
end-perform
exit.
*****************************************************************
DUMP-TO-LOG.
* HexDump...
* Dump DD Name, Record-Number, (position,length)
move RECORD-HEADER to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
* DUMP Record Position Indicator
* if DUMP-RPI = 'Y'
* perform DUMP-POSITION-INDICATOR
* end-if
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.
*****************************************************************
* Build the position header row...
*****************************************************************
DUMP-ASTERISK-ONE.
move SPACES to SIMOLOGS-MESSAGE
move '*' to SIMOLOGS-MESSAGE(1:1)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-INDICATOR.
add 10 to ZERO giving POS-NO
subtract 1 from D-POS giving WK-1
divide 10 into WK-1 giving WK-1 remainder WK-2
add 1 to WK-2
perform varying D-P1 from 1 by 10 until D-P1 > 1020
move DUMP-H10 to DUMP-W10
inspect W10-POS-NO replacing leading ZEROES by '.'
move DUMP-W10(WK-2:10) to DUMP-HEADER(D-P1:10)
add 10 to POS-NO
end-perform
move DUMP-HEADER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-PRIMARY-MISSING.
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
add DPOS-UT1 to ZERO giving RECORD-POS
add DLEN-UT1 to ZERO giving RECORD-LEN
add DPOS-UT1 to ZERO giving D-POS
add DLEN-UT1 to ZERO giving D-LEN
* Present in SQEDDF02, missing from SQEDDF01...
move UT1-MISSING to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
add DLEN-UT2 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-SECONDARY-RECORD
move SPACES to DELTA-LINE-2
move all '#' to DELTA-LINE-2(1:DLEN-UT2)
perform DUMP-POSITION-DIFFERENCES-2
exit.
*****************************************************************
DUMP-PRIMARY-RECORD.
add DPOS-UT1 to ZERO giving RECORD-POS
add DLEN-UT1 to ZERO giving RECORD-LEN
add DPOS-UT1 to ZERO giving D-POS
add DLEN-UT1 to ZERO giving D-LEN
move 'SQEDDF01..' 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
exit.
*****************************************************************
DUMP-SECONDARY-MISSING.
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
add DPOS-UT2 to ZERO giving RECORD-POS
add DLEN-UT2 to ZERO giving RECORD-LEN
add DPOS-UT2 to ZERO giving D-POS
add DLEN-UT2 to ZERO giving D-LEN
* Present in SQEDDF01, missing from SQEDDF02...
move UT2-MISSING to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
add DLEN-UT1 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-PRIMARY-RECORD
move SPACES to DELTA-LINE-1
move all '#' to DELTA-LINE-1(1:DLEN-UT1)
perform DUMP-POSITION-DIFFERENCES-1
exit.
*****************************************************************
DUMP-SECONDARY-RECORD.
move SPACES to PASSHEX4-SOURCE
add DPOS-UT2 to ZERO giving RECORD-POS
add DLEN-UT2 to ZERO giving RECORD-LEN
add DPOS-UT2 to ZERO giving D-POS
add DLEN-UT2 to ZERO giving D-LEN
move 'SQEDDF02..' 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
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCES-1.
if DUMP-RECL-MAX-S = 'Y'
and DUMP-RECL-MAX < SQEDDF01-LRECL
add DUMP-RECL-MAX to ZERO giving WORK-LENGTH
else
add SQEDDF01-LRECL to ZERO giving WORK-LENGTH
end-if
move DELTA-LINE-1(1:DLEN-UT1) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCES-2.
if DUMP-RECL-MAX-S = 'Y'
and DUMP-RECL-MAX < SQEDDF02-LRECL
add DUMP-RECL-MAX to ZERO giving WORK-LENGTH
else
add SQEDDF02-LRECL to ZERO giving WORK-LENGTH
end-if
move DELTA-LINE-2(1:DLEN-UT2) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
JOB-FINISHED.
if SQEDDF01-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform until SQEDDF01-STATUS not = '00'
perform SQEDDF01-READ
add 1 to COMPARE-NE
end-perform
end-if
if SQEDDF02-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform until SQEDDF02-STATUS not = '00'
perform SQEDDF02-READ
add 1 to COMPARE-NE
end-perform
end-if
perform SQEDDF02-CLOSE
perform SQEDDF01-CLOSE
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move 'Conclude' to INFO-ID
move INFO-SHORT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move 'Finished' to INFO-ID
move SQEDDF01-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if SQEDDF01-OMT > ZERO
move SQEDDF01-OMIT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move SQEDDF02-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if SQEDDF02-OMT > ZERO
move SQEDDF02-OMIT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if SQEDDF01-RDR not = SQEDDF02-RDR
move 'WARNING! - Record counts are not equal'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move 'ABENDING' to INFO-ID
end-if
if FF-01 = '1'
if COMPARE-NE = 0
inspect COMPARE-TAG
replacing first ' of existing records '
by ' is ZERO '
else
move 'ABENDING' to INFO-ID
end-if
move COMPARE-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move COMPARE-EQ-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if FF-02 = '1'
if COMPACT-NE = 0
inspect COMPACT-TAG
replacing first ' of existing records '
by ' is ZERO '
else
move 'ABENDING' to INFO-ID
end-if
move COMPACT-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if SQEDDF01-EOF not = 'Y'
or SQEDDF02-EOF not = 'Y'
move 'ABENDING' to INFO-ID
end-if
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move INFO-SHORT to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform Z-THANK-YOU.
if COMPARE-NE > 0
or SQEDDF01-RDR not = SQEDDF02-RDR
add IFNECODE-VALUE 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 K-PS-1 > 0
and K-PS-2 > 0
and K-LN-1 > 0
and K-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 SYSLOG-OUTPUT to SIMOLOGS-REQUEST
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SIM-TITLE to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SIM-COPYRIGHT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move all '*' to SIMOLOGS-MESSAGE(1:79)
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-TO-CONSOLE
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-TO-CONSOLE
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 to SYSOUT Device... *
*****************************************************************
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 CONSOLE messages... *
*****************************************************************
Z-DISPLAY-TO-CONSOLE.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
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-TO-CONSOLE
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-TO-CONSOLE
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
move SIM-TITLE to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-COPYRIGHT to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
Z-THANK-YOU.
move SIM-THANKS-01 to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-THANKS-02 to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2020-06-25 Generation Time: 19:20:16:95 *
*****************************************************************
Summary
This document describes how to create, access and convert data files that use variable-length-records. This document may be used to assist as a tutorial for new programmers or as a quick reference for experienced programmers.
In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.
SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the Contact or Feedback section of this document.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material 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 Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies 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, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the 
icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the 
icon.
Explore a complete list of the SimoTime Callable Routines or Utility Programs. This includes the callable routines and utility programs for the Micro Focus environment.
Explore the JCL Connection for more examples of JCL functionality with programming techniques and sample code.
Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore An Enterprise System Model that describes and demonstrates how Applications that were running on a Mainframe System and non-relational data that was located on the Mainframe System were copied and deployed in a Microsoft Windows environment with Micro Focus Enterprise Server.
Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.
Explore The File Status Return Codes that are used to interpret the results of accessing VSAM data sets and/or QSAM files.
Internet Access Required
The following links will require an internet connect.
This suite of programs and documentation is available to download for review and evaluation purposes. Other uses will require a SimoTime Software License. Link to an Evaluation zPAK Option that includes the program members, documentation and control files.
A good place to start is The SimoTime Home Page for access to white papers, program examples and product information. This link requires an Internet Connection
Explore The Micro Focus Web Site for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Contact or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
| 1. | Send an e-mail to our helpdesk. |
| 1.1. | helpdesk@simotime.com. |
| 2. | Our telephone numbers are as follows. |
| 2.1. | 1 415 763-9430 office-helpdesk |
| 2.2. | 1 415 827-7045 mobile |
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and 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. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
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. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
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
| Return-to-Top |
| Files with Variable Length Records, Processing with Standard COBOL Dialect |
| Copyright © 1987-2025 SimoTime Technologies and Services All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |