Transfer, Share, Convert and Compare
|
Data File Transitions Transfer, Share, Convert and Compare |
|
| The SimoTime Home Page |
Introduction
In today's world there is a variety of systems that store data in a variety of formats using a variety of devices. The current processes for storing, retrieving, processing, transferring, sharing, converting or comparing data are continually evolving. New systems, devices and processes for managing data are being introduced and providing for higher volumes of data storage and faster access rates at lower cost per unit of storage.
This document and the associated suite of sample programs will focus on the transfer, share, convert and compare processes across multiple systems using currently available technologies.
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-2016
SimoTime Technologies
All Rights Reserved
Programming Objectives
This example illustrates the following functions.
| 1. | Demonstrate how to use JCL and IEBGENER
to create an EBCDIC-encoded, sequential file with eighty byte fixed length
records.
|
||||||||||
| 2. | Demonstrate how to use JCL and IDCAMS to
define an EBCDIC-encoded, VSAM, KSDS cluster with 512 byte records.
|
||||||||||
| 3. | Demonstrate how to use JCL and a COBOL
program to read a sequential file, reformat the data (i.e. six byte key to
twelve byte key) and populate an EBCDIC-encoded VSAM, KSDS.
|
||||||||||
| 4. | Demonstrate how to use JCL and a COBOL
program to read the EBCDIC-encoded VSAM, KSDS and produces four-across mailing
labels.
|
||||||||||
| 5. | Demonstrate how to use JCL and IDCAMS and
the REPRO function to read an EBCDIC-encoded VSAM, KSDS and create an
EBCDIC-encoded Sequential File.
|
||||||||||
| 6. | Describe how to use FTP from a Windows
System to transfer the EBCDIC-encoded sequential file in BINARY mode from the
Mainframe System to a Windows System.
|
||||||||||
| 7. | Demonstrate how to do file format and
file content conversion from an EBCDIC-encoded Record Sequential to an
ASCII-encoded VSAM, KSDS. The content conversion must be done at the field
level.
|
||||||||||
| 8. | Demonstrate how to use a COBOL program to
read the ASCII-encoded VSAM, KSDS and produces four-across mailing
labels.
|
||||||||||
| 9. | Demonstrate how to compare two data
files
|
||||||||||
| 10. | Demonstrate how to extract data from a
VSAM, KSDS to a Sequential file with the record structure in a Comma Separated
Values format.
|
System Requirements
This suite of samples programs will run on the following platforms.
| ||||||
| Platform Requirements |
The batch application that prints the mailing labels and the on-line application for Customer File Maintenance are not included in the Z-Pack for this example. These may be downloaded from the SimoTime Web Site as separate examples.
The compare program used in this example uses the SIMOLOGS and SIMODUMP programs of the SimoMODS package. These may be downloaded from the SimoTime Web Site.
For more information refer to the Downloads and Links to Similar Pages of this document.
The JCL Members
This section describes the JCL members (or Mainframe Job Control Language) used in this suite of sample programs.
Create a Record Sequential File with Customer Data using IEBGENER
The following member (CUSC80J1.jcl) is a two (2) step job. The first step will use IEFBR14 with a DD statement to delete a file that was created by a previous execution of this job. The second step will use IEBGENER and in-line data to create a sequential file of 80-byte records with customer information.
//CUSC80J1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* CUSC80J1.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2016 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 (QSAMCRT1) 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. //* //* ************ //* * QUSC80J1 * //* ********jcl* //* * //* * //* ************ ************ //* * IEFBR14 ******* CUST0080 * //* ********utl* ***delete*** //* * //* * //* ************ ************ ************ //* * SYSIN ******* IEBGENER ******* CUST0080 * //* ********jcl* ********utl* *******rseq* //* * //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 of 2 Delete any previously created file... //* //QSAMDELT EXEC PGM=IEFBR14 //CUST0080 DD DSN=SIMOTIME.DATA.CUST0080,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... //* //QSAMCRT1 EXEC PGM=IEBGENER //SYSPRINT DD SYSOUT=* //SYSIN DD DUMMY //* :....1....:....2....:....3....:....4....:....5....:....6....:....7. ..:....8 //SYSUT1 DD * 000100 Anderson Adrian 1113 Peachtree Plaza Atlanta GA 26101 000200 Brown Billie 224 Baker Boulevard Baltimore MD 35702 000300 Carson Cameron 336 Crenshaw Blvd. Cupertino CA 96154 000400 Davidson Dion 448 Main Street Wilmington DE 27323 000500 Everest Evan 55 5TH Avenue New York NY 10341 000600 Franklin Francis 6612 66TH Avenue Bedrock NY 11903 000700 Garfunkel Gwen 777 77TH Street New York NY 16539 000800 Harrison Hilary 888 88TH Street Pocatello ID 79684 000900 Isley Isabel 999 99TH Avenue Indianapolis IN 38762 001000 Johnson Jamie 1010 Paradise Drive Larkspur CA 90504 001100 Kemper Kelly 1111 Oak Circle Kansas City KS 55651 001200 Lemond Lesley 1212 Lockwood Road Mohave Desert AZ 80303 001300 Mitchell Marlowe 1313 Miller Creek Road Anywhere TX 77123 001400 Newman Noel 1414 Park Avenue Santa Monica CA 90210 001500 Osborn Owen 1515 Center Stage Rolling Rock PA 36613 001600 Powell Pierce PO Box 1616 Ventura CA 97712 001700 Quigley Quincy 1717 Farm Hill Road Oshkosh WI 43389 001800 Ripley Ray 1818 Alien Lane Wayout KS 55405 001900 Smith Sammy 1919 Carnoustie Drive Novato CA 94919 002000 Tucker Taylor 2020 Sanger Lane St. Paul MN 43998 002100 Underwood Ulysses 2121 Wall Street New York NY 17623 002200 Van Etten Valerie 2222 Vine Street Hollywood CA 98775 002300 Wilson Wiley 2323 Main Street Boston MA 01472 002400 Xray Xavier 2424 24TH Street Nashville TN 44190 002500 Young Yanni 2525 Yonge Street Toronto ON 6B74A6 002600 Zenith Zebulon 2626 26TH Street Dallas TX 71922 123456 Doe John 123 Main Street Anywhere OR 88156 /* //SYSUT2 DD DSN=SIMOTIME.DATA.CUST0080, // DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=800,DSORG=PS) //
Delete the VSAM Cluster for the Customer Master File
The following member (CUSDELJ1.jcl) is a one (1) step job. The job will use IDCAMS to delete the VSAM cluster for the Customer Master File.
//CUSDELJ1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=&SYSUID
//* *******************************************************************
//* CUSDELJ1.JCL - a JCL Member for Batch Job Processing *
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2016 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//* Subject: JCL to delete a VSAM Data Set using the IDCAMS Utility *
//* Author: SimoTime Technologies *
//* Date: January 1, 1998 *
//*-------------------------------------------------------------------*
//* The following example is more than what is usually required to *
//* delete a VSAM Data Set. However, the purpose is to illustrate the *
//* functions of the IDCAMS utility. *
//* PURGE: A VSAM Data Set may be date-protected. The DEFINE Cluster *
//* has the option of specifying a retention date. If this *
//* retention date has not expired then the PURGE option will *
//* be required in order to delete the data set. *
//* The default is NOPURGE. *
//* ERASE: The standard operation by the VSAM DELETE is to delete *
//* the catalog entry of the cluster and mark the space used *
//* by the cluster as reclaimable. The data contents of the *
//* cluster is no longer generally available but it is still *
//* present until the area is reused. This introduces a *
//* potential problem or security exposure for sensitive data.*
//* The information could be retrieved using some special *
//* class of DUMP/RESTORE utilities that are often used by *
//* data center staff. The ERASE function will write over the *
//* data area used by the cluster and the original data is *
//* destroyed. The default is NOERASE. *
//*********************************************************************
//*
// EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE SIMOTIME.DATA.CUSTMAST -
FILE (CUSTMAST) -
PURGE -
ERASE -
CLUSTER
SET MAXCC = 0
/*
Define a VSAM Cluster for the Customer Master File
The following member (CUSCRTJ1.jcl) is a one (1) step job. The job will use IDCAMS to create the VSAM cluster for the Customer Master File.
//CUSCRTJ1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* CUSCRTJ1.JCL - a JCL Member for Batch Job Processing *
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2016 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create an empty VSAM, KSDS data set using IDCAMS.
//* Author - SimoTime Technologies
//* Date - January 24, 1996
//*
//* This job will create a VSAM, KSDS data set. The key is twelve
//* characters starting at the first position in the record.
//* The record length is 512 characters.
//*
//* 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 This is a single step job.
//*
//KSDSMAKE EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEFINE CLUSTER (NAME(SIMOTIME.DATA.CUSTMAST) -
TRACKS(45,15) -
INDEXED) -
DATA (NAME(SIMOTIME.DATA.CUSTMAST.DAT) -
KEYS(12,0) -
RECORDSIZE(512,512) -
FREESPACE(10,15) -
CISZ(8192)) -
INDEX (NAME(SIMOTIME.DATA.CUSTMAST.IDX))
/*
//*
Read a Sequential File & Update the Customer Master File
The following member (CUSI80J1.jcl) is a one (1) step job that uses a COBOL program to read a sequential file, reformat the data (i.e. six byte key to twelve byte key) and populate the Customer Master File that is an EBCDIC-encoded VSAM, Key-Sequenced-Data-Set (KSDS).
//CUSI80J1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=&SYSUID //* ******************************************************************* //* CUSI80J1.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2016 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Read 80-Byte input and populate a VSAM, KSDS. //* Author - SimoTime Technologies //* Date - November 24, 2004 //* Version - 07.01.22 //* //* This job uses a COBOL program to read a sequential file. The //* information is then used to add records to the KSDS. The records //* must be in sequence determined by the key field. //* //* ******************************************************************* //* Step 1 of 1 Read Sequential File, add records to VSAM, KSDS. //* //STEP010 EXEC PGM=CUSI80C1 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //CUST0080 DD DSN=SIMOTIME.DATA.CUST0080, // DISP=SHR //CUSTMAST DD DSN=SIMOTIME.DATA.CUSTMAST, // DISP=SHR //SYSOUT DD SYSOUT=* //*
Print Four Across Mailing Labels
This is a four (4) step job. The first step is housekeeping to clean up any work files left from a previous execution of this job. The second step uses a COBOL program to read the Customer Master File and extract records that have a non-P.O. Box address to a Record Sequential file. The third step uses the SORT utility program to sort the sequential file into a new sequential file in Postal Code sequence. The fourth step uses a COBOL program to read the sorted file and create an output file of four-across mailing labels.
Explore How to Produce Four-Across Mailing Labels by selecting records from a VSAM Data Set then Sorting by Postal Code.
IDCAMS, Read Customer Master File & Reproduce a Sequential File
The following member (CUSK2RJ1.jcl) is a two (2) step job. The first step will use IEFBR14 with a DD statement to delete a file that was created by a previous execution of this job. The second step will use IDCAMS and the REPRO function to read the Customer Master File and create a sequential file with the same record structure and content.
//CUSK2RJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* CUSK2RJ1.JCL - a JCL Member for Batch Job Processing * //* This JCL Member is provided by SimoTime Technologies * //* (C) Copyright 1987-2016 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* TEXT - COPY (OR REPRO) A KSDS TO A SEQUENTIAL FILE //* AUTHOR - SIMOTIME TECHNOLOGIES //* DATE - JANUARY 01, 1989 //* //* ******************************************************************* //* Step 1 of 2, Delete any previously created file... //* //QSAMDELT EXEC PGM=IEFBR14 //SEQ51201 DD DSN=SIMOTIME.DATA.CUSRE512,DISP=(MOD,DELETE,DELETE), // SPACE=(TRK,(10,1),RLSE), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //* //* ******************************************************************* //* Step 2 of 2, Create and populate a new QSAM file... //* //REPROSEQ EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=A //KSD51201 DD DSN=SIMOTIME.DATA.CUSTMAST,DISP=(SHR) //SEQ51201 DD DSN=SIMOTIME.DATA.CUSRE512, // SPACE=(TRK,(10,1),RLSE), // DISP=(NEW,CATLG,DELETE), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //SYSIN DD * REPRO - INFILE(KSD51201) - OUTFILE(SEQ51201) /*
The Command Files
This section describes the CMD or Windows Command Files used in this suite of sample programs.
FTP a Sequential File from a Mainframe System to Windows System
The following is the FTP statements required to transfer a Record Sequential file from a Mainframe System to a Windows System. The FTP Utility program will download the EBCDIC-encoded, Record-Sequential file from the Mainframe System to the Windows System in BINARY mode.
userid Password CD .. PWD BINARY GET SIMOTIME.DATA.ZDDFSE01 C:\MFI01\FTPLIB01\ZDDFSE01.DAT QUIT
Convert EBCDIC-encoded, Record Sequential File to an ASCII-encoded Indexed File
The following member (CUREKAE1.cmd) is the Windows Command File that will use the FTP Utility program to download the EBCDIC-encoded, Record-Sequential file from the Mainframe System to the Windows System.
@echo OFF
rem * *******************************************************************
rem * CUREKAE1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2016 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read EBCDIC Customer Master, write ASCII Customer Master.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * The job will read an EBCDIC-encoded Customer Master File and write
rem * to a new ASCII-encoded Customer Master File (or VSAM, KSDS).
rem *
rem * ************
rem * * CUREKAE1 *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * Env1PROD *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * SimoNOTE *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * RUN *---------------------------*
rem * ********rts* *
rem * * ************ ************ ************
rem * * * CUSRE512 *-----* CUREKAC1 *-----* CUSKA512 *
rem * * *******rseq* ********cbl* *******ksds*
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Step 1, Set Environment Variables
rem * Delete any previously created ASCII-encoded file...
rem *
call ..\Env1BASE
set CmdName=CUSE2AE1
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep Step-1, Housekeeping tasks"
set CUSRE512=%BaseLib1%\DATA\EBC1\SIMOTIME.DATA.CUSRE512.DAT
set CUSKS512=%BaseLib1%\DATA\Wrk1\SIMOTIME.DATA.CUSKA512.DAT
if exist %CUSKS512% del %CUSKS512%
rem *
rem * *******************************************************************
rem * Step 2, Read EBCDIC-encoded KSDS, create a new ASCII-encoded KSDS
rem *
call SimoNOTE "Identify JobStep Step-2, Execute EBCDIC to ASCII Conversion"
call SimoNOTE "DataTake RSE CUSRE512=%CUSRE512%"
call SimoNOTE "DataMake KSA CUSKS512=%CUSKS512%"
run CUREKAC1
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto EojNOK
if exist %CUSKS512% goto EojAOK
set JobStatus=0020
goto EojNOK
:EojAOK
call SimoNOTE "Produced %CUSKS512%"
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNOK
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus%"
echo %DATE% - %TIME% Starting User ABEND Processing...>>%SYSLOG%
set >>%SYSLOG%
echo %DATE% - %TIME% Complete User ABEND Processing...>>%SYSLOG%
goto :End
:End
call SimoNOTE "Conclude SysOut is %SYSOUT%"
if not "%1" == "nopause" pause
exit /B %JobStatus%
Compare Two Data Files
The following member (CUP303W1.cmd) is the Windows Command File that will use a COBOL program to compare the contents of two data files. The files contain records that are defined by the copy file for the Customer Master File (CUSTCB01.CPY).
@echo OFF
rem * *******************************************************************
rem * CUP303W1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2016 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Compare two Customer Master Files.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * The job will compare the records in two Customer Files. Since
rem * a date and time stamp is located in the second half of a record
rem * only the first 303 bytes of each record are compared.
rem *
rem * Since the files are in sequence by the key-field the program
rem * will explicity identify deleted or added records.
rem *
rem * ************
rem * * CUP303W1 *
rem * ********cmd*
rem * *
rem * ************ ************ ************
rem * * CUEXPECT *--*--* CUP303C1 *-----* SYSLOG *
rem * *******ksds* * ********cbl* ************
rem * * *
rem * ************ * *
rem * * CUACTUAL *--* *
rem * *******ksds* *
rem * *
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Compare two VSAM KSDS's or Customer Master Files...
rem * The positions within the records to be compared are determined by
rem * the COMPARE statements in the Process Control File. This is done
rem * when the compare program is generated.
rem *
rem * The results of the compare processing is posted to the SYSLOG File.
rem * The results file must exist and new information is appended to the
rem * end of the file. For more information about how to create an empty
rem * log file refer to the CRTLOGJ1.JCL Member.
rem *
rem * *******************************************************************
rem * Step 1 of 2, Set the environment...
rem *
set CmdName=CUP303W1
call ..\Env1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
set syslog=%BaseLib1%\Data\APPL\SIMOTIME.SYSLOG.CUP303W1.DAT
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%"
run SYSLOGC8
set CUACTUAL=%BaseLib1%\Data\APPL\SIMOTIME.DATA.CUSTMAST.DAT
set CUEXPECT=%BaseLib1%\Data\APPL\SIMOTIME.DATA.CUS512D2.DAT
rem *
rem * *******************************************************************
rem * Step 2 of 2, Compare two VSAM KSDS's or Customer Master File...
rem *
call SimoNOTE "DataTake CUACTUAL=%CUACTUAL%"
call SimoNOTE "DataTake CUEXPECT=%CUEXPECT%"
run CUP303C1
set ERRORLEVELTWO=%ERRORLEVEL%
if not "%ERRORLEVELTWO%" == "0" set JobStatus=0010
if "%ERRORLEVELTWO%" == "4" set JobStatus=0004
if not %JobStatus% == 0000 goto :EojNok
rem *
rem * *******************************************************************
:EojAok
call SimoNOTE "DataMake SYSOUT=%SYSOUT%"
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus% "
goto :End
:EojNok
call SimoNOTE "DataMake SYSOUT=%SYSOUT%"
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus% "
:End
rem * Convert VREC to LSEQ and display using NotePad...
if not "SIMOGENS" == "BATCH" call SYSLOGW1
call SimoNOTE "Conclude Data Set Compare Status is %ERRORLEVELTWO% "
if not "SIMOGENS" == "BATCH" pause
Create Comma Separated Values File from Customer Master File
The creation of a sequential file with the records structured to a Comma Separated Values format is done in two (2) steps in order to take advantage of a COBOL program that runs on the mainframe. On the mainframe a COBOL program reads the Customer Master File and creates a record sequential file. This record sequential file may be downloaded to a Windows system using FTP in ASCII mode. This will convert an EBCDIC-encoded Record Sequential file into an ASCII-encoded Line Sequential (or ASCII/Text) file that can easily be imported into an Excel spreadsheet.
If the COBOL program that runs on the mainframe is transferred to a Windows system and compiled with Micro Focus COBOL running on Windows it will still create a Record Sequential file. Rather than modify the program a second program is used to read the Record Sequential file and write to a new Line Sequential file. This second program performs the same function as the FTP file transfer in ASCII mode accomplished.
Read Customer Master File and write to Record Sequential File with CSV Formatted Records
The following member (CUSCSVE1..cmd) is the Windows Command File that will use a COBOL program to read the Customer Master File and create a record sequential file with the records structured to a Comma Separated Values format.
@echo OFF
rem * *******************************************************************
rem * CUSCSVE1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2016 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read Customer Master File, write ASCII-Record-Sequential.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * The job will read the Customer Master File and write to a Line
rem * Sequential file with records formatted with Comma Separated Values.
rem *
rem * *******************************************************************
rem * Step 1 Housekeeping...
rem *
rem * Set environment variables.
call ..\Env1BASE
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
set CmdName=CusCsvE1
rem *
call SimoNOTE "*******************************************************%CmdName%.CMD"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
:DeleteQSAM
call SimoNOTE "Identify JobStep DeleteQSAM"
rem *
rem * Map the file names used by the program to the PC file names.
set CUSTMAST=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.CUSTMAST.DAT
set CUSTRCSV=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.CUSTRCSV.DAT
rem *
rem * delete possible file created by previous execution of this job
if exist %CUSTRCSV% del %CUSTRCSV%
rem *
rem * *******************************************************************
rem * Step 2 Edit input, create a new output file...
rem *
:ExecuteFileConversion
call SimoNOTE "Identify JobStep ExecuteFileConversion
run CUSCSVC1
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto EojNOK
if exist %CUSTRCSV% goto EojAOK
set JobStatus=0020
goto EojNOK
:EojAOK
call SimoNOTE "Produced %CUSTRCSV%"
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus%"
goto End
:EojNOK
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus%"
echo %DATE% - %TIME% Starting User ABEND Processing...>>%SYSLOG%
set >>%SYSLOG%
echo %DATE% - %TIME% Complete User ABEND Processing...>>%SYSLOG%
goto End
:End
call SimoNOTE "Conclude SysOut is %SYSOUT%"
if not "%1" == "nopause" pause
exit /B %JobStatus%
Read Record Sequential File with CSV Formatted Records and Write ASCII/Text File
The following member (CUSCSVE2..cmd) is the Windows Command File that will use a COBOL program to read the record sequential file and create a line sequential file with the records structured to a Comma Separated Values format.
@echo OFF
rem * *******************************************************************
rem * CUSCSVE2.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2016 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read ASCII-Record-Sequential, write ASCII/Text file.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * The job will read a Record Sequential File and write to a Line
rem * Sequential file.
rem *
rem * ************
rem * * CUSCSVE2 *
rem * ********cmd*
rem * *
rem * *
rem * ************ ************ ************
rem * * run ******* SIMOLOGS ******* CONSOLE *
rem * ********rts* * ********cbl* * ************
rem * * * *
rem * * * * ************
rem * * * **** SYSLOG *
rem * * * ********txt*
rem * * *
rem * * **************************
rem * * *
rem * * ************ ************ ************
rem * * * Dat01KRS ******* R2L01KC1 ******* Dat01KLS *
rem * * ********dat* ********cbl* ********csv*
rem * *
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Step 1 Delete any previously created file...
rem *
call ..\Env1BASE
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
set CmdName=R2L01KE2
rem *
call SimoNOTE "*******************************************************%CmdName%.CMD"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
:DeleteQSAM
call SimoNOTE "Identify JobStep DeleteQSAM"
set Dat01KRS=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.CUSTRCSV.DAT
set Dat01KLS=%BaseLib1%\DATA\Wrk1\SIMOTIME.DATA.CUSTLCSV.CSV
if exist %Dat01KLS% del %Dat01KLS%
rem *
rem * *******************************************************************
rem * Step 2 Edit input, create a new output file...
rem *
:ExecuteFileFormatConversion
call SimoNOTE "Identify JobStep ExecuteFileFormatConversion
run R2L01KC1
echo %errorlevel%
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto EojNOK
if exist %Dat01KLS% goto EojAOK
set JobStatus=0020
goto EojNOK
:EojAOK
call SimoNOTE "Produced %Dat01KLS%"
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus%"
goto End
:EojNOK
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus%"
echo %DATE% - %TIME% Starting User ABEND Processing...>>%SYSLOG%
set >>%SYSLOG%
echo %DATE% - %TIME% Complete User ABEND Processing...>>%SYSLOG%
goto End
:End
call SimoNOTE "Conclude SysOut is %SYSOUT%"
if not "%1" == "nopause" pause
exit /B %JobStatus%
The COBOL Programs
This section describes the COBOL programs used in this suite of sample programs.
Update the Customer Master File using Information from a Sequential File
The following program (CUSI80C1.cbl) will read a sequential file, reformat the data (i.e. six byte key to twelve byte key) and populate the Customer Master File that is a VSAM, Key-Sequenced-Data-Set (KSDS).
IDENTIFICATION DIVISION.
PROGRAM-ID. CUSI80C1.
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: 2010-07-07 Generation Time: 06:39:49:90 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUST0080 SEQUENTIAL FIXED 00080 *
* *
* OUTPUT CUSTMAST INDEXED VARIABLE 00512 00001 *
* 00012 00012 *
* *
* Translation Mode is ASCII to ASCII *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUST0080-FILE ASSIGN TO CUST0080
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CUST0080-STATUS.
SELECT CUSTMAST-FILE ASSIGN TO CUSTMAST
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CUSTMAST-PKEY-00001-00012
FILE STATUS IS CUSTMAST-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CUST0080-FILE
DATA RECORD IS CUST0080-REC
.
01 CUST0080-REC.
05 CUST0080-DATA-01 PIC X(00080).
FD CUSTMAST-FILE
DATA RECORD IS CUSTMAST-REC
.
01 CUSTMAST-REC.
05 CUSTMAST-PKEY-00001-00012 PIC X(00012).
05 CUSTMAST-DATA-00013-00500 PIC X(00500).
*****************************************************************
* 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 additional information contact SimoTime Technologies. *
* *
* 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 '* CUSI80C1 '.
05 T2 pic X(34) value 'Sequential, RSEQ-80 to KSEQ-512 '.
05 T3 pic X(10) value ' v10.07.06'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CUSI80C1 '.
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 CUST0080-STATUS.
05 CUST0080-STATUS-L pic X.
05 CUST0080-STATUS-R pic X.
01 CUST0080-EOF pic X value 'N'.
01 CUST0080-OPEN-FLAG pic X value 'C'.
01 CUSTMAST-STATUS.
05 CUSTMAST-STATUS-L pic X.
05 CUSTMAST-STATUS-R pic X.
01 CUSTMAST-EOF pic X value 'N'.
01 CUSTMAST-OPEN-FLAG pic X value 'C'.
01 CUST0080-LRECL pic 9(5) value 00080.
01 CUSTMAST-LRECL pic 9(5) value 00512.
*****************************************************************
* 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 '* CUSI80C1 '.
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 'CUSI80C1'.
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 'Sequential, RSEQ-80 to KSEQ-512 '.
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 CUST0080-TOTAL.
05 CUST0080-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUST0080'.
01 CUSTMAST-TOTAL.
05 CUSTMAST-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUSTMAST'.
*****************************************************************
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 CUST0080-OPEN
perform CUSTMAST-OPEN
perform until CUST0080-STATUS not = '00'
perform CUST0080-READ
if CUST0080-STATUS = '00'
add 1 to CUST0080-RDR
perform BUILD-OUTPUT-RECORD
perform CUSTMAST-WRITE
if CUSTMAST-STATUS = '00'
add 1 to CUSTMAST-ADD
end-if
end-if
end-perform
move CUST0080-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-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 CUSTMAST-CLOSE
perform CUST0080-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
*> TransMODE is A2A...
*> TransINIT process...
move ALL SPACES to CUSTMAST-REC
*> TransCOPY...
move CUST0080-REC(00001:00006) to CUSTMAST-REC(00007:00006)
*> TransCOPY...
move CUST0080-REC(00008:00015) to CUSTMAST-REC(00014:00015)
*> TransCOPY...
move CUST0080-REC(00023:00010) to CUSTMAST-REC(00042:00010)
*> TransCOPY...
move CUST0080-REC(00033:00024) to CUSTMAST-REC(00082:00024)
*> TransCOPY...
move CUST0080-REC(00057:00015) to CUSTMAST-REC(00178:00015)
*> TransCOPY...
move CUST0080-REC(00072:00003) to CUSTMAST-REC(00206:00003)
*> TransCOPY...
move CUST0080-REC(00075:00006) to CUSTMAST-REC(00234:00006)
*> TransFILL...
move
'000000'
to CUSTMAST-REC(00001:00006)
*> TransFILL...
move
X'0000250F'
to CUSTMAST-REC(00300:00004)
*> TransFILL...
move
X'0000'
to CUSTMAST-REC(00304:00002)
*> TransFILL...
move
'00000'
to CUSTMAST-REC(00306:00005)
*> TransFILL...
move
'00000000'
to CUSTMAST-REC(00311:00008)
*> TransFILL...
move
X'0000'
to CUSTMAST-REC(00319:00002)
*> TransFILL...
move
'00000'
to CUSTMAST-REC(00321:00005)
*> TransFILL...
move
'00000000'
to CUSTMAST-REC(00326:00008)
*> TransFILL...
move
X'0000'
to CUSTMAST-REC(00334:00002)
*> TransFILL...
move
'00000'
to CUSTMAST-REC(00336:00005)
*> TransFILL...
move
'00000000'
to CUSTMAST-REC(00341:00008)
*> TransFILL...
move
'20080124'
to CUSTMAST-REC(00349:00008)
*> TransFILL...
move
'13053000'
to CUSTMAST-REC(00357:00008)
*> TransFILL...
move
'000'
to CUSTMAST-REC(00365:00003)
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
CUST0080-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUST0080-FILE
if CUST0080-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 CUST0080' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUST0080-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUST0080-READ.
read CUST0080-FILE
if CUST0080-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUST0080-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 CUST0080-EOF
else
move 'READ Failure with CUST0080' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUST0080-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUST0080-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUST0080-FILE
if CUST0080-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUST0080-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUST0080' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUST0080-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
CUSTMAST-WRITE.
if CUSTMAST-OPEN-FLAG = 'C'
perform CUSTMAST-OPEN
end-if
write CUSTMAST-REC
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSTMAST-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 CUSTMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSTMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUSTMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUSTMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUSTMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-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.
*****************************************************************
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: 2010-07-07 Generation Time: 06:39:49:95 *
*****************************************************************
Convert Record Sequential, EBCDIC File to a Keyed-Indexed, ASCII File
The following programs will read an EBCDIC-encoded, Record Sequential file and update (or add records to) the Customer Master File that is an ASCII-encoded, VSAM, Key-Sequenced-Data-Set (KSDS). The mainline or primary program does the file I/O and calls a COBOL routine to do the conversion of the individual records. The secondary or called program does the conversion of the record at the field level based on the copy file definition.
The following two (2) sections of this document describes the mainline and secondary programs used to do the file format and file content conversion.
Mainline Program for File I/O with Call to Routine for Record Content Conversion
The following program (CUREKAC1.cbl) will read an EBCDIC-encoded, Record Sequential file and update existing records or add new records to the Customer Master File that is an ASCII-encoded, VSAM, Key-Sequenced-Data-Set (KSDS). This program does the file I/O and calls a second program to do the conversion of the records at the field level based on the copy file definition.
IDENTIFICATION DIVISION.
PROGRAM-ID. CUREKAC1.
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: 2011-10-14 Generation Time: 23:14:11:01 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUSRE512 SEQUENTIAL FIXED 00512 *
* *
* OUTPUT CUSKS512 INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* *
* Translation Mode is EBCDIC to ASCII *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSRE512-FILE ASSIGN TO CUSRE512
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CUSRE512-STATUS.
SELECT CUSKS512-FILE ASSIGN TO CUSKS512
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CUSKS512-PKEY-00001-00012
FILE STATUS IS CUSKS512-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CUSRE512-FILE
DATA RECORD IS CUSRE512-REC
.
01 CUSRE512-REC.
05 CUSRE512-DATA-01 PIC X(00512).
FD CUSKS512-FILE
DATA RECORD IS CUSKS512-REC
.
01 CUSKS512-REC.
05 CUSKS512-PKEY-00001-00012 PIC X(00012).
05 CUSKS512-DATA-00013-00500 PIC X(00500).
*****************************************************************
* This program was created with the SYSMASK3.TXT file as the *
* template for the File I/O. It is intended for use with the *
* TransCALL facility that makes a call to a routine that does *
* the actual conversion between EBCDIC and ASCII. For more *
* information or questions contact SimoTime Technologies. *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* The SYSMASK3 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* *
* This program mask is used with a callable subroutine that *
* will do ASCII/EBCDIC Conversion based on a COBOL Copy 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 SYSMASK4 *
* to provide for a random add or update of the indexed file. *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CUREKAC1 '.
05 T2 pic X(34) value 'Load ASCII/KSDS from EBCDIC/RSEQ '.
05 T3 pic X(10) value ' v10.07.06'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CUREKAC1 '.
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 CUSRE512-STATUS.
05 CUSRE512-STATUS-L pic X.
05 CUSRE512-STATUS-R pic X.
01 CUSRE512-EOF pic X value 'N'.
01 CUSRE512-OPEN-FLAG pic X value 'C'.
01 CUSKS512-STATUS.
05 CUSKS512-STATUS-L pic X.
05 CUSKS512-STATUS-R pic X.
01 CUSKS512-EOF pic X value 'N'.
01 CUSKS512-OPEN-FLAG pic X value 'C'.
01 CUSRE512-LRECL pic 9(5) value 00512.
01 CUSKS512-LRECL pic 9(5) value 00512.
*****************************************************************
* 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 '* CUREKAC1 '.
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 'CUREKAC1'.
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 'Load ASCII/KSDS from EBCDIC/RSEQ '.
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 CUSRE512-TOTAL.
05 CUSRE512-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUSRE512'.
01 CUSKS512-TOTAL.
05 CUSKS512-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUSKS512'.
*****************************************************************
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 CUSRE512-OPEN
perform CUSKS512-OPEN
perform until CUSRE512-STATUS not = '00'
perform CUSRE512-READ
if CUSRE512-STATUS = '00'
add 1 to CUSRE512-RDR
perform BUILD-OUTPUT-RECORD
perform CUSKS512-WRITE
if CUSKS512-STATUS = '00'
add 1 to CUSKS512-ADD
end-if
end-if
end-perform
move CUSRE512-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-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 CUSKS512-CLOSE
perform CUSRE512-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
*> TransMODE is E2A...
*> TransCALL process...
move CUSRE512-REC to CUSKS512-REC
call 'CUREKAR1' using CUSKS512-REC
add 00512 to ZERO giving CUSKS512-LRECL
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
CUSRE512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSRE512-FILE
if CUSRE512-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 CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSRE512-READ.
read CUSRE512-FILE
if CUSRE512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSRE512-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 CUSRE512-EOF
else
move 'READ Failure with CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUSRE512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUSRE512-FILE
if CUSRE512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSRE512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
CUSKS512-WRITE.
if CUSKS512-OPEN-FLAG = 'C'
perform CUSKS512-OPEN
end-if
write CUSKS512-REC
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSKS512-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 CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSKS512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT CUSKS512-FILE
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSKS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSKS512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSKS512-FILE
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUSKS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-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.
*****************************************************************
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: 2011-10-14 Generation Time: 23:14:11:05 *
*****************************************************************
Callable Routine to Convert the Fields within a Record based on the Copy File Definition
The following program (CUREKAR1.cbl) called routine that will convert the record in the pass area from EBCDIC to ASCII at the field level based on the copy file definition.
IDENTIFICATION DIVISION.
PROGRAM-ID. CUREKAR1.
AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* This routine was generated by SimoREC1 *
* 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: 2011/10/14 Generation Time: 23:14:11:23 *
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 IX-1 PIC 9(5) VALUE 0.
01 RM-1 PIC 9(5) VALUE 0.
01 RO-1 PIC 9(5) VALUE 0.
01 IX-2 PIC 9(5) VALUE 0.
01 RM-2 PIC 9(5) VALUE 0.
01 RO-2 PIC 9(5) VALUE 0.
COPY ASCEBCB1.
COPY ASCEBCB2.
*****************************************************************
LINKAGE SECTION.
COPY CUSTCB01.
*****************************************************************
PROCEDURE DIVISION using CUST-RECORD.
inspect CUST-NUMBER converting E-INFO to A-INFO
inspect CUST-STATUS converting E-INFO to A-INFO
inspect CUST-LAST-NAME converting E-INFO to A-INFO
inspect CUST-FIRST-NAME converting E-INFO to A-INFO
inspect CUST-MID-NAME converting E-INFO to A-INFO
inspect CUST-ADDRESS-1 converting E-INFO to A-INFO
inspect CUST-ADDRESS-2 converting E-INFO to A-INFO
inspect CUST-CITY converting E-INFO to A-INFO
inspect CUST-STATE converting E-INFO to A-INFO
inspect CUST-POSTAL-CODE converting E-INFO to A-INFO
inspect CUST-PHONE-HOME converting E-INFO to A-INFO
inspect CUST-PHONE-WORK converting E-INFO to A-INFO
inspect CUST-PHONE-CELL converting E-INFO to A-INFO
* Packed......... CUST-CREDIT-LIMIT
* Group10 CUST-DISCOUNT occurs 00003 times
* Group 00015
* Table Name..... CUST-DISCOUNT-CODE
* Binary......... CUST-DISCOUNT-CODE
* Table Name..... CUST-DISCOUNT-RATE
add 0000306 to ZERO giving RM-1
add 0000015 to ZERO giving RO-1
perform 00003 times
inspect CUST-RECORD(RM-1:00005)
converting E-NUMB to A-NUMB
add RO-1 to RM-1
end-perform
* Table Name..... CUST-DISCOUNT-DATE
add 1 to ZERO giving IX-1
perform 00003 times
inspect CUST-DISCOUNT-DATE(IX-1)
converting E-INFO to A-INFO
add 1 to IX-1
end-perform
* Group10 End-Group10
inspect CUST-LADATE converting E-INFO to A-INFO
inspect CUST-LATIME converting E-INFO to A-INFO
* Decimal........ CUST-TOKEN
inspect CUST-RECORD(365:3) converting E-NUMB to A-NUMB
* Filler......... A Non-Unique Reference to a Data Item
inspect CUST-RECORD(368:145) converting E-INFO to A-INFO
GOBACK.
*****************************************************************
* This routine was generated by SimoREC1 *
* 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: 2011/10/14 Generation Time: 23:14:11:23 *
*****************************************************************
Compare Two Data Files
following program (CUP303C1.cbl) will compare the content of two (2) data files. This program will compare the first 303 bytes of each record in the Customer Master Files.
IDENTIFICATION DIVISION.
PROGRAM-ID. CUP303C1.
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: 2012-07-09 Generation Time: 11:25:43:52 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUACTUAL INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* OUTPUT CUEXPECT INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUACTUAL-FILE ASSIGN TO CUACTUAL
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CUACTUAL-PKEY-00001-00012
FILE STATUS IS CUACTUAL-STATUS.
SELECT CUEXPECT-FILE ASSIGN TO CUEXPECT
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CUEXPECT-PKEY-00001-00012
FILE STATUS IS CUEXPECT-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CUACTUAL-FILE
DATA RECORD IS CUACTUAL-REC
.
01 CUACTUAL-REC.
05 CUACTUAL-PKEY-00001-00012 PIC X(00012).
05 CUACTUAL-DATA-00013-00500 PIC X(00500).
FD CUEXPECT-FILE
DATA RECORD IS CUEXPECT-REC
.
01 CUEXPECT-REC.
05 CUEXPECT-PKEY-00001-00012 PIC X(00012).
05 CUEXPECT-DATA-00013-00500 PIC X(00500).
*****************************************************************
* 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 11.01.08 *
* *
* 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 '* CUP303C1 '.
05 T2 pic X(34) value 'Comparison, CustMAST from 1 to 303'.
05 T3 pic X(10) value ' v12.04.19'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CUP303C1 '.
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 '* CUP303C1 '.
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 '* CUP303C1 '.
05 C2 pic X(32) value 'Please send all inquires or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
01 CUACTUAL-STATUS.
05 CUACTUAL-STATUS-L pic X.
05 CUACTUAL-STATUS-R pic X.
01 CUACTUAL-EOF pic X value 'N'.
01 CUACTUAL-OPEN-FLAG pic X value 'C'.
01 CUEXPECT-STATUS.
05 CUEXPECT-STATUS-L pic X.
05 CUEXPECT-STATUS-R pic X.
01 CUEXPECT-EOF pic X value 'N'.
01 CUEXPECT-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 '* CUP303C1 '.
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 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 DELTA-MAXIMUM-X pic X(5) value '00005'.
01 DELTA-MAXIMUM redefines DELTA-MAXIMUM-X pic 9(5).
01 DELTA-PROCESS pic X(4) value 'EOF '.
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 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 00001.
05 LN-1 pic 9(5) value 00012.
01 KEY-CONTROL-2.
05 PS-2 pic 9(5) value 00001.
05 LN-2 pic 9(5) value 00012.
01 CUACTUAL-LRECL pic 9(5) value 00512.
01 LEN-1 pic 9(5) value 128.
01 POS-1 pic 9(5) value 1.
01 CUEXPECT-LRECL pic 9(5) value 00512.
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 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.
01 DUMP-HEADER pic X(1024) value all '.'.
01 D-P1 pic 9(5) value 0.
01 RECORD-HEADER.
05 RECORD-ID pic X(8) value 'CUACTUAL'.
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 'Comparison, CustMAST from 1 to 303'.
05 filler pic X(33)
value ' http://www.SimoTime.com'.
01 CUACTUAL-TOTAL.
05 CUACTUAL-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for CUACTUAL'.
01 CUEXPECT-TOTAL.
05 CUEXPECT-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for CUEXPECT'.
01 COMPARE-NE-TOTAL.
05 COMPARE-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPARE-TAG pic X(25) value 'All Equal result for comp'.
05 filler pic X(25) value 'are of existing records '.
01 COMPACT-NE-TOTAL.
05 COMPACT-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPACT-TAG pic X(25) value 'All Equal result for comp'.
05 filler pic X(25) value 'act of existing records '.
01 FORMAT-TYPE pic X value 'B'.
COPY PASSHEX4.
COPY PASSLOGS.
COPY PAENVARS.
*****************************************************************
PROCEDURE DIVISION.
perform JOB-STARTING
perform
until COMPARE-STATUS = 'QT'
or CUACTUAL-STATUS not = '00'
or CUEXPECT-STATUS not = '00'
if READ-1 = 'Y'
perform CUACTUAL-READ
end-if
if READ-2 = 'Y'
perform CUEXPECT-READ
end-if
if CUACTUAL-STATUS = '00'
and CUEXPECT-STATUS = '00'
move 'EQ' to COMPARE-STATUS
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 COMPARE-STATUS = FLAG-NE
add 1 to COMPARE-NE
end-if
end-if
if DELTA-PROCESS = 'QUIT'
and COMPARE-NE > DELTA-MAXIMUM
move 'The Not Equal count exceeds Maximum limit...'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
if DELTA-PROCESS = 'EOF '
and COMPARE-NE > DELTA-MAXIMUM
move 'The Not Equal count exceeds Maximum limit...'
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...
move 'COMPARISON' to REC-CTYPE
move 'PHYSICAL ' to REC-CMODE
if CUACTUAL-REC(00001:00303) not = CUEXPECT-REC(00001:00303)
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
add 00001 to ZERO giving POS-1
add 00001 to ZERO giving POS-2
add 00303 to ZERO giving LEN-1
add 00303 to ZERO giving LEN-2
add 00303 to ZERO giving PASSHEX4-LENGTH
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 CUACTUAL-REC(PS-1:LN-1)
< CUEXPECT-REC(PS-2:LN-2)
move N-BYTE to READ-2
move FLAG-NE to COMPARE-STATUS
perform DUMP-PRIMARY-MISSING
end-if
if CUACTUAL-REC(PS-1:LN-1)
> CUEXPECT-REC(PS-2:LN-2)
move N-BYTE to READ-1
move FLAG-NE to COMPARE-STATUS
perform DUMP-SECONDARY-MISSING
end-if
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 position indicator
perform DUMP-POSITION-INDICATOR
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-POSITION-INDICATOR.
add 9 to D-POS giving POS-NO
perform varying D-P1 from 1 by 10 until D-P1 > 1020
move DUMP-H10 to DUMP-HEADER(D-P1:10)
inspect DUMP-HEADER(D-P1 + 5:5)
replacing leading ZEROES by '.'
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.
move 'CUACTUAL Record is missing from CUEXPECT file'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SPACES to PASSHEX4-SOURCE
add CUACTUAL-RDR to ZERO giving REC-NUMBER
add PS-1 to ZERO giving RECORD-POS
add LN-1 to ZERO giving RECORD-LEN
add PS-1 to ZERO giving D-POS
add LN-1 to ZERO giving D-LEN
move 'CUACTUAL..' to RECORD-ID
move CUACTUAL-REC(PS-1:LN-1) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
perform DUMP-POSITION-DIFFERENCE
exit.
*****************************************************************
DUMP-PRIMARY-RECORD.
add POS-1 to ZERO giving RECORD-POS
add LEN-1 to ZERO giving RECORD-LEN
add POS-1 to ZERO giving D-POS
add LEN-1 to ZERO giving D-LEN
move 'CUACTUAL..' to RECORD-ID
add CUACTUAL-RDR to ZERO giving REC-NUMBER
move CUACTUAL-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
display 'DEBUB-01A ' PASSHEX4-UPPER(1:5)
display 'DEBUB-01B ' PASSHEX4-LOWER(1:5)
perform DUMP-TO-LOG
exit.
*****************************************************************
DUMP-SECONDARY-MISSING.
move 'CUEXPECT Record is missing from CUACTUAL file'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SPACES to PASSHEX4-SOURCE
add CUEXPECT-RDR to ZERO giving REC-NUMBER
add PS-2 to ZERO giving RECORD-POS
add LN-2 to ZERO giving RECORD-LEN
add PS-2 to ZERO giving D-POS
add LN-2 to ZERO giving D-LEN
move 'CUEXPECT..' to RECORD-ID
move CUEXPECT-REC(PS-2:LN-2) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
perform DUMP-POSITION-DIFFERENCE
exit.
*****************************************************************
DUMP-SECONDARY-RECORD.
move SPACES to PASSHEX4-SOURCE
add POS-2 to ZERO giving RECORD-POS
add LEN-2 to ZERO giving RECORD-LEN
add POS-2 to ZERO giving D-POS
add LEN-2 to ZERO giving D-LEN
move 'CUEXPECT..' to RECORD-ID
add CUEXPECT-RDR to ZERO giving REC-NUMBER
move CUEXPECT-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCE.
if READ-FLAGS = 'YY'
move all '-' to DELTA-LINE-2
add POS-1 to ZERO giving PTR-1
add POS-2 to ZERO giving PTR-2
add 1 to ZERO giving IDX-2
perform until IDX-2 > 1024
or IDX-2 > D-LEN
if CUACTUAL-REC(PTR-1:1)
= CUEXPECT-REC(PTR-2:1)
move '=' to DELTA-LINE-2(IDX-2:1)
else
move '#' to DELTA-LINE-2(IDX-2:1)
end-if
add 1 to PTR-1
add 1 to PTR-2
add 1 to IDX-2
end-perform
else
move all '#' to DELTA-LINE-2
end-if
move DELTA-LINE-2(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move '*' to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
JOB-FINISHED.
if CUACTUAL-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform
until CUACTUAL-STATUS not = '00'
if READ-1 = 'Y'
perform CUACTUAL-READ
end-if
end-perform
end-if
if CUEXPECT-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform
until CUEXPECT-STATUS not = '00'
if READ-2 = 'Y'
perform CUEXPECT-READ
end-if
end-perform
end-if
perform CUEXPECT-CLOSE
perform CUACTUAL-CLOSE
move 'Conclude' to INFO-ID
move INFO-SHORT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move 'Finished' to INFO-ID
move CUACTUAL-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move CUEXPECT-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if CUACTUAL-RDR not = CUEXPECT-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
move 'ABENDING' to INFO-ID
move 'NOT' to COMPARE-TAG(1:3)
end-if
move COMPARE-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if FF-02 = '1'
if COMPACT-NE > 0
move 'ABENDING' to INFO-ID
move 'NOT' to COMPACT-TAG(1:3)
end-if
move COMPACT-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if CUACTUAL-EOF not = 'Y'
or CUEXPECT-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 CUACTUAL-RDR not = CUEXPECT-RDR
add 4 to ZERO giving RETURN-CODE
end-if
exit.
*****************************************************************
JOB-STARTING.
perform Z-POST-COPYRIGHT
perform Z-DETERMINE-ENVIRONMENT
perform CUACTUAL-OPEN
perform CUEXPECT-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 SYSLOG-OUTPUT to SIMOLOGS-REQUEST
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:80)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move all '*' to SIMOLOGS-MESSAGE(1:80)
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
exit.
*****************************************************************
* I/O Routines for the Primary File... *
*****************************************************************
CUACTUAL-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUACTUAL-FILE
if CUACTUAL-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 CUACTUAL' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUACTUAL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUACTUAL-READ.
read CUACTUAL-FILE
if CUACTUAL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
add 1 to CUACTUAL-RDR
else
if CUACTUAL-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 CUACTUAL-EOF
else
move 'READ Failure with CUACTUAL' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUACTUAL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUACTUAL-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUACTUAL-FILE
if CUACTUAL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUACTUAL-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUACTUAL' to MESSAGE-TEXT
perform Z-DISPLAY-TO-CONSOLE
perform Z-DISPLAY-MESSAGE-TEXT
move CUACTUAL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the Secondary File... *
*****************************************************************
CUEXPECT-READ.
read CUEXPECT-FILE
if CUEXPECT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
add 1 to CUEXPECT-RDR
else
if CUEXPECT-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 CUEXPECT-EOF
else
move 'READ Failure with CUEXPECT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUEXPECT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUEXPECT-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUEXPECT-FILE
if CUEXPECT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUEXPECT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUEXPECT' to MESSAGE-TEXT
perform Z-DISPLAY-TO-CONSOLE
perform Z-DISPLAY-MESSAGE-TEXT
move CUEXPECT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUEXPECT-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUEXPECT-FILE
if CUEXPECT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUEXPECT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUEXPECT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUEXPECT-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: 2012-07-09 Generation Time: 11:25:43:56 *
*****************************************************************
Extract Data from Customer File, Create a Comma Separated Values File
The following programs will read an ASCII-encoded, Customer Master File that is a VSAM, KSDS and write to a record sequential file with the records structured into a Comma-Separated-Values format. The fields will be concatenated, with the trailing spaces removed. The new variable length fields will be separated by a comma. If a data field contains a comma it will be changed to a user defined value.
The first program does the extract of data from the Customer Master File and writes to a Record Sequential file. This program will execute on an IBM Mainframe System or a Windows or UNIX system with Micro Focus.
If the first program is compiled and executed on a Mainframe System it will create an EBCDIC-encoded, Record Sequential file. When the file is transferred (via FTP in ASCII-mode) to a Windows or UNIX system it will be converted to an ASCII-encoded Line Sequential (or ASCII/Text) file. The secondary or called program does the conversion of the record at the filed level based on the copy file definition.
If the first program is compiled and executed on a Windows or UNIX System with Micro Focus it will probably be in an ASCII-encoded environment. To make it easier to import into an Excel spreadsheet or other non-mainframe environment it would be a good idea to convert the Record Sequential file to a Line Sequential (or ASCII/TEXT) file. This is the purpose of the second program.
The following two (2) sections of this document describes the primary and secondary programs used to do the file format and file content conversion.
Read Customer Master File and write to Record Sequential File with CSV Formatted Records
The following program (CUSCSVC1.cbl) will read an ASCII-encoded, Customer Master File that is a VSAM, Key-Sequenced-Data-Set (KSDS). and write to a Record Sequential file with the records structured into a Comma-Separated-Values format.
IDENTIFICATION DIVISION.
PROGRAM-ID. CUSCSVC1.
AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2016 SimoTime Technologies . *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute 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 *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. 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 *
* Technologies. *
* *
* SimoTime Technologies 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 *
* 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 *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
*****************************************************************
* This base 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 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUSTMAST SEQUENTIAL FIXED 00080 *
* OUTPUT CUSTRCSV ASCII/CRLF VARIABLE 00080 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
* The LINE SEQUENTIAL file organization is Micro Focus
* syntax for an ASCII/Text file.
SELECT CUSTMAST-FILE ASSIGN to CUSTMAST
ORGANIZATION is INDEXED
ACCESS MODE is SEQUENTIAL
RECORD KEY is CUST-NUMBER
FILE STATUS is CUSTMAST-STATUS.
SELECT CUSTRCSV-FILE ASSIGN TO CUSTRCSV
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CUSTRCSV-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CUSTMAST-FILE.
COPY CUSTCB01.
FD CUSTRCSV-FILE
DATA RECORD IS CUSTRCSV-RECORD.
01 CUSTRCSV-RECORD.
05 CUSTRCSV-DATA-01 PIC X(1024).
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Title and Copyright...
* ------------------------------------------------------------
01 SIM-TITLE.
05 T1 pic X(11) value '* CUSCSVC1 '.
05 T2 pic X(34) value 'Export Customer Info to CSV File '.
05 T3 pic X(10) value ' v07.11.06'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CUSCSVC1 '.
05 C2 pic X(20) value 'Copyright 2003-2008 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* CUSCSVC1 '.
05 C2 pic X(32) value 'Thank you for using this sample '.
05 C3 pic X(32) value 'by SimoTime Technologies '.
05 C4 pic X(04) value ' '.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* CUSCSVC1 '.
05 C2 pic X(32) value 'Please send comments or suggesti'.
05 C3 pic X(32) value 'ons to helpdesk@simotime.com '.
05 C4 pic X(04) value ' '.
01 CUSTMAST-STATUS.
05 CUSTMAST-STATUS-L pic X.
05 CUSTMAST-STATUS-R pic X.
01 CUSTMAST-EOF pic X value 'N'.
01 CUSTMAST-OPEN-FLAG pic X value 'C'.
01 CUSTRCSV-STATUS.
05 CUSTRCSV-STATUS-L pic X.
05 CUSTRCSV-STATUS-R pic X.
01 CUSTRCSV-OPEN-FLAG pic X value 'C'.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 IO-STATUS-4 pic 9(4) value 0.
01 IO-STATUS-4A redefines IO-STATUS-4 pic X(4).
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CUSCSVC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MESSAGE-BUFFER-SIZE pic 9(3) value 267.
01 MSG-PTR pic 9(3) value 0.
01 MSG-LEN pic 9(3) value 0.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 DOUBLE-QUOTE pic X value '"'.
01 DELIMITER-BYTE pic X value ','.
01 WORK-128 pic X(128) value SPACES.
01 WORK-50 pic X(50) value SPACES.
01 WORK-NUMBER-70-X.
05 WORK-NUMBER-70 pic 9(7) value 0.
01 DATA-HAS-DELIMITER pic X value 'N'.
01 REMOVE-DELIMITER pic X value 'N'.
01 REMOVE-DOUBLE-QUOTE pic X value 'N'.
01 TRANSLATE-PARAMETER pic X(3) value SPACES.
01 SIG-FIRST pic 9(3) value 0.
01 SIG-LAST pic 9(3) value 0.
01 SIG-LENGTH pic 9(3) value 0.
01 IDX-1 pic 9(3) value 0.
01 IDX-STOP pic 9(3) value 0.
01 CSV-X1 pic 9(3) value 0.
01 UPPER-CASE pic X(26) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
01 LOWER-CASE pic X(26) value 'abcdefghijklmnopqrstuvwxyz'.
COPY ASCEBCB1.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform CUSTMAST-OPEN
perform CUSTRCSV-OPEN
perform until CUSTMAST-STATUS not = '00'
perform CUSTMAST-READ
* If a successful read of the input file and the input
* record is not equal to SPACES then create an output.
if CUSTMAST-STATUS = '00'
perform BUILD-COMMA-DELIMITED-STRING
perform POST-STRING-WITH-CLEAR-AFTER
end-if
end-perform
perform CUSTRCSV-CLOSE
perform CUSTMAST-CLOSE
perform Z-THANK-YOU
GOBACK.
*****************************************************************
BUILD-COMMA-DELIMITED-STRING.
add 1 to ZERO giving CSV-X1
move CUST-NUMBER to WORK-50
perform PARSE-AND-POST
move CUST-LAST-NAME to WORK-50
perform PARSE-AND-POST
move CUST-FIRST-NAME to WORK-50
perform PARSE-AND-POST
move CUST-MID-NAME to WORK-50
perform PARSE-AND-POST
move CUST-ADDRESS-1 to WORK-50
perform PARSE-AND-POST
move CUST-ADDRESS-2 to WORK-50
perform PARSE-AND-POST
move CUST-CITY to WORK-50
perform PARSE-AND-POST
move CUST-STATE to WORK-50
perform PARSE-AND-POST
move CUST-POSTAL-CODE to WORK-50
perform PARSE-AND-POST
move CUST-PHONE-HOME to WORK-50
perform PARSE-AND-POST
move CUST-PHONE-WORK to WORK-50
perform PARSE-AND-POST
move CUST-PHONE-CELL to WORK-50
perform PARSE-AND-POST
add CUST-CREDIT-LIMIT to ZERO giving WORK-NUMBER-70
move WORK-NUMBER-70 to WORK-50
perform PARSE-AND-POST
move CUST-LADATE to WORK-50
perform PARSE-AND-POST
move CUST-LATIME to WORK-50
perform PARSE-AND-POST
move CUST-TOKEN to WORK-50
perform PARSE-AND-POST
* Set CSV-X1 to position of last character in string and
* remove the trailing comma...
subtract 1 from CSV-X1
if WORK-128(CSV-X1:2) = ', '
move ' ' to WORK-128(CSV-X1:2)
subtract 1 from CSV-X1
end-if
exit.
*****************************************************************
CONVERT-CUSTRCSV-RECORD-A2E.
inspect CUSTRCSV-RECORD converting A-INFO to E-INFO
exit.
*****************************************************************
CONVERT-CUSTRCSV-RECORD-E2A.
inspect CUSTRCSV-RECORD converting E-INFO to A-INFO
exit.
*****************************************************************
PARSE-AND-POST.
perform PARSE-WORK-50
perform POST-WORK-50
exit.
*****************************************************************
* Determine the position within the field of the first and last *
* significant characters of a text-string within a field. *
* Also, determine the length of the text-string within a field. *
*****************************************************************
PARSE-WORK-50.
subtract SIG-FIRST from SIG-FIRST
subtract SIG-LAST from SIG-LAST
subtract SIG-LENGTH from SIG-LENGTH
* The IDX-STOP is used to stop the perform loop by setting the
* number of characters to scan.
add 50 to ZERO giving IDX-STOP
* The following is for performance and will quickly reduce
* the number of times the perform loop executes.
if WORK-50(26:25) = SPACES
if WORK-50(13:13) = SPACES
add 12 to ZERO giving IDX-STOP
else
add 25 to ZERO giving IDX-STOP
end-if
else
if WORK-50(38:13) = SPACES
add 37 to ZERO giving IDX-STOP
else
add 50 to ZERO giving IDX-STOP
end-if
end-if
add 1 to ZERO giving IDX-1
move 'N' to DATA-HAS-DELIMITER
perform until IDX-1 GREATER THAN IDX-STOP
if WORK-50(IDX-1:1) = DELIMITER-BYTE
move 'Y' to DATA-HAS-DELIMITER
end-if
if WORK-50(IDX-1:1) not = SPACE
add IDX-1 to ZERO giving SIG-LAST
if SIG-FIRST = 0
add IDX-1 to ZERO giving SIG-FIRST
end-if
end-if
add 1 to IDX-1
end-perform
if SIG-FIRST GREATER THAN ZERO
compute SIG-LENGTH = SIG-LAST - SIG-FIRST + 1
end-if
exit.
*****************************************************************
* Move the field to the output buffer and insert a trailing *
* delimiter character. *
*****************************************************************
POST-WORK-50.
* The following will insert a leading Double-Quote if the
* data string contains a delimiter character.
if DATA-HAS-DELIMITER = 'Y'
move DOUBLE-QUOTE to WORK-128(CSV-X1:1)
add 1 to CSV-X1
end-if
* The following would be required if the delimiter byte is
* to be removed from the data string.
* Remove the delimiter characters from the data string.
if REMOVE-DELIMITER = 'Y'
inspect WORK-50(1:IDX-STOP)
replacing all DELIMITER-BYTE by SPACE
end-if
if REMOVE-DOUBLE-QUOTE = 'Y'
inspect WORK-50(1:IDX-STOP)
replacing all DOUBLE-QUOTE by SPACE
end-if
if SIG-FIRST GREATER THAN ZERO
move WORK-50(SIG-FIRST:SIG-LENGTH)
to WORK-128(CSV-X1:SIG-LENGTH)
add SIG-LENGTH to CSV-X1
* The following will insert a trailing Double-Quote if
* the data string contains a delimiter character.
if DATA-HAS-DELIMITER = 'Y'
move DOUBLE-QUOTE to WORK-128(CSV-X1:1)
add 1 to CSV-X1
end-if
*
move DELIMITER-BYTE to WORK-128(CSV-X1:1)
add 1 to CSV-X1
else
move DELIMITER-BYTE to WORK-128(CSV-X1:1)
add 1 to CSV-X1
end-if
exit.
*****************************************************************
* Write the comma delimited record to the output file. *
*****************************************************************
POST-STRING-WITH-CLEAR-AFTER.
move SPACES to CUSTRCSV-RECORD
move WORK-128 to CUSTRCSV-RECORD
evaluate TRANSLATE-PARAMETER
when 'E2A' perform CONVERT-CUSTRCSV-RECORD-E2A
when 'A2E' perform CONVERT-CUSTRCSV-RECORD-A2E
end-evaluate
perform CUSTRCSV-WRITE
move SPACES to WORK-128
exit.
*****************************************************************
* I/O ROUTINES FOR CUSTMAST... *
*****************************************************************
CUSTMAST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTMAST-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-READ.
read CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSTMAST-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 CUSTMAST-EOF
else
move 'CUSTMAST-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSTMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTMAST-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FOR CUSTRCSV... *
*****************************************************************
CUSTRCSV-WRITE.
if CUSTRCSV-OPEN-FLAG = 'C'
perform CUSTRCSV-OPEN
end-if
write CUSTRCSV-RECORD
if CUSTRCSV-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSTRCSV-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 'CUSTRCSV-Failure-WRITE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTRCSV-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTRCSV-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT CUSTRCSV-FILE
if CUSTRCSV-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSTRCSV-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTRCSV-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTRCSV-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTRCSV-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSTRCSV-FILE
if CUSTRCSV-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUSTRCSV-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTRCSV-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTRCSV-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.
display MESSAGE-BUFFER
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'
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-4
move IO-STAT1 to IO-STATUS-4A(1:1)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-4A
move IO-STATUS to IO-STATUS-4A(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
Z-THANK-YOU.
display SIM-THANKS-01
display SIM-THANKS-02
exit.
*****************************************************************
* This program is provided by: *
* SimoTime Technologies *
* (C) Copyright 1987-2016 All Rights Reserved *
* Web Site URL: http://www.simotime.com *
* e-mail: helpdesk@simotime.com *
*****************************************************************
Read a Record Sequential File and Write a Line Sequential File
The following program (R2L01KC1.cbl) will read an ASCII-encoded, Record Sequential file and write to an ASCII-encoded, Line Sequential (or ASCII/Text) file with the records structured into a Comma-Separated-Values format. The output file may be viewed with NotePAD or easily imported into an Excel spreadsheet.
IDENTIFICATION DIVISION.
PROGRAM-ID. R2L01kC1.
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: 2007-11-06 Generation Time: 17:41:57:15 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT DAT01KRS SEQUENTIAL VARIABLE 01024 *
* *
* OUTPUT DAT01KLS ASCII/CRLF VARIABLE 01024 *
* *
* *
* Translation Mode is UNKNOWN *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DAT01KRS-FILE ASSIGN EXTERNAL DAT01KRS
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS DAT01KRS-STATUS.
SELECT DAT01KLS-FILE ASSIGN EXTERNAL DAT01KLS
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS DAT01KLS-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD DAT01KRS-FILE
DATA RECORD IS DAT01KRS-REC
.
01 DAT01KRS-REC.
05 DAT01KRS-DATA-01 PIC X(01024).
FD DAT01KLS-FILE
DATA RECORD IS DAT01KLS-REC
.
01 DAT01KLS-REC.
05 DAT01KLS-DATA-01 PIC X(01024).
*****************************************************************
* 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. *
* *
* This program mask will have the ASCII/EBCDIC table inserted *
* for use by the /TRANSLATE function of SimoZAPS. *
* *
* For additional information contact SimoTime Technologies. *
* *
* 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 '* R2L01kC1 '.
05 T2 pic X(34) value 'Format Convert/Copy RS01K to LS01K'.
05 T3 pic X(10) value ' v07.11.04'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* R2L01kC1 '.
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 Technologies '.
01 DAT01KRS-STATUS.
05 DAT01KRS-STATUS-L pic X.
05 DAT01KRS-STATUS-R pic X.
01 DAT01KRS-EOF pic X value 'N'.
01 DAT01KRS-OPEN-FLAG pic X value 'C'.
01 DAT01KLS-STATUS.
05 DAT01KLS-STATUS-L pic X.
05 DAT01KLS-STATUS-R pic X.
01 DAT01KLS-EOF pic X value 'N'.
01 DAT01KLS-OPEN-FLAG pic X value 'C'.
01 DAT01KRS-LRECL pic 9(5) value 01024.
01 DAT01KLS-LRECL pic 9(5) value 01024.
*****************************************************************
* 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 '* R2L01kC1 '.
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 'R2L01kC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 DAT01KRS-TOTAL.
05 DAT01KRS-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for DAT01KRS'.
01 DAT01KLS-TOTAL.
05 DAT01KLS-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for DAT01KLS'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform DAT01KRS-OPEN
perform DAT01KLS-OPEN
perform until DAT01KRS-STATUS not = '00'
perform DAT01KRS-READ
if DAT01KRS-STATUS = '00'
add 1 to DAT01KRS-RDR
perform BUILD-OUTPUT-RECORD
perform DAT01KLS-WRITE
if DAT01KLS-STATUS = '00'
add 1 to DAT01KLS-ADD
end-if
end-if
end-perform
move DAT01KRS-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KLS-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 DAT01KLS-CLOSE
perform DAT01KRS-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
*> TransCOPY...
move DAT01KRS-REC(00001:01024) to DAT01KLS-REC(00001:01024)
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
DAT01KRS-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close DAT01KRS-FILE
if DAT01KRS-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 DAT01KRS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KRS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
DAT01KRS-READ.
read DAT01KRS-FILE
if DAT01KRS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if DAT01KRS-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 DAT01KRS-EOF
else
move 'READ Failure with DAT01KRS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KRS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
DAT01KRS-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input DAT01KRS-FILE
if DAT01KRS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to DAT01KRS-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with DAT01KRS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KRS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
DAT01KLS-WRITE.
if DAT01KLS-OPEN-FLAG = 'C'
perform DAT01KLS-OPEN
end-if
write DAT01KLS-REC
if DAT01KLS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if DAT01KLS-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 DAT01KLS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KLS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
DAT01KLS-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT DAT01KLS-FILE
if DAT01KLS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to DAT01KLS-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with DAT01KLS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KLS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
DAT01KLS-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close DAT01KLS-FILE
if DAT01KLS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to DAT01KLS-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with DAT01KLS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DAT01KLS-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.
*****************************************************************
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: 2007-11-06 Generation Time: 17:41:57:15 *
*****************************************************************
Ancillary Functions
This section provides additional detail about application build process.
Compiler Directives
This document provides information about how to specify and use the Micro Focus compiler directives that may be required to control program behavior in the Linux, UNIX or Windows environments in a manner compliant with the compiler options and subsequent execution on the Mainframe System. In the world of computer systems and programming there are many alternatives for providing solutions. The approaches described in this document offer a few alternatives.
Explore the Compiler Directives available for the Micro Focus COBOL technologies.
Set the Environment
A command file (ENV1BASE.cmd) that is located in the base directory named SimoSam1 is called from other command files to set commonly used environment variables. This provides a single point of definition. The following is a listing of the contents of the command file.
@echo OFF
rem * *******************************************************************
rem * ENV1BASE.cmd - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2015 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Provide a single point to set common environment variables.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * Set the commonly used environment variables. This is used to provide
rem * a single point for managing the commonly used environment variables.
rem *
set SimoLIBR=c:\SimoLIBR
set BaseLib1=c:\SIMOSAM1\DEVL
set BaseLib8=c:\SimoSAM8
set BaseWIP1=c:\SimoSAM1\WIP1
set DATAZERO=c:\SIMODATA\DEVL\DATA\ZERO
set BASEAPP=%BaseLib1%
set BASESYS=%BaseLib1%\SYS1
set BASECAT=%BaseLib1%\DATA
set SYSLOG=%BASESYS%\LOGS\SYSLOG_USER.DAT
set SYSOUT=%BASEAPP%\LOGS\SYSOUT_SIMSAM01.TXT
set SLZMSG=%BASEAPP%\LOGS\SLZMSG_USER.TXT
set PostNOTE=%BASEAPP%\LOGS\JOBLOG_SIMONOTE.TXT
set SimoNOTE=%BASEAPP%\LOGS\JOBLOG_SIMONOTE.TXT
call SIMONOTE "* SIMONOTE Log File is %SIMONOTE% "
rem *
set CATALINA_HOME=C:\APACHETC\apache-tomcat-7.0.52
set JAVABASE=C:\Program Files (x86)\Java\jdk1.7.0_51
set JAVASDK="%JAVABASE%\bin"
set JAVA_HOME=%JAVABASE%
set JRE_HOME=%JAVABASE%
rem *
set MIFOEDEV=C:\Program Files (x86)\Micro Focus\Enterprise Developer\bin
set MIFOBASE=C:\Program Files (x86)\Micro Focus\Studio Enterprise Edition 6.0\Base
set MIFOBIN=%MIFOBASE%\bin
set MIFOVCBL=C:\Program Files (x86)\Micro Focus\Visual COBOL\bin
rem * Large file support, performance tuning and record locking of the File Handler
set EXTFH=%BASESYS%\CONFIG\EXTFHBIG.CFG
rem * For IMS Support
set ES_IMSLIB=%BASEAPP%\IMSLIB
set ES_ACBLIB=%BASEAPP%\IMSLIB
rem * EZASOKETS Check EZASOKETS Enabled box or set ES_EZASOKET_SUPPORT=YES
set EZACONFG=BASESYS1\CONFIG\EZACONFG.dat
rem *
rem * Resource Allocation and Performance for SORT and non-Relational Data
rem set MFJSENGINE=SYNCSORT
set SORTSCHEME=1
set SORTSPACE=750000000
set TMP=C:\SORTWORK
rem *
set ES_ALLOC_OVERRIDE=%BASESYS%\CONFIG\CATMAPA1.cfg
rem * For CORE_ON_ERROR function, ABEND Dump
rem * set COBCONFIG_=%BASESYS%\CONFIG\diagnose.cfg
rem *
rem * Consolidated Trace Facility (CTF)
rem * set MFTRACE_CONFIG=%BASESYS%\CONFIG\ctf.cfg
rem * set MFTRACE_LOGS=c:\ctflogs
rem *
rem * For Job Restart, ABEND Recovery
set MF_UCC11=Y
set ES_JES_RESTART=Y
rem *
rem * Set environment for MFBSI (Micro Focus Batch Scheduling Interface)
set ES_EMP_EXIT_1=mfbsiemx
set MFBSI_DIR=%BASESYS%\LOGS\%JESSERVERNAME%
set MFBSIEOP_CMD=ENABLE
set MFBSIEOP_CSV=ENABLE
set MFBSIEOP_HTM=ENABLE
set MFBSIEOP_XML=ENABLE
rem *
rem * Set Behavior and Trace Flags for GETJOBDD
rem * Position=12345678/12345678
set JDDFLAGS=nnnWnnnn/YYnnnnnn
rem *
set MAINFRAME_FLOATING_POINT=true
set COBIDY=%BASEAPP%\COBIDY
set COBPATH=.;%BASEAPP%\LOADLIB;%BASESYS%\LOADLIB;%SimoLIBR%
set LIBPATH=.;%BASEAPP%\LOADLIB;%BASESYS%\LOADLIB;%SimoLIBR%
set TXDIR=%BASESYS%\LOADLIB;%MIFOBASE%
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOBASE%\SOURCE
rem *
if "%SIMOPATH%" == "Y" goto JUMPPATH
if "%MIFOSYS1%" == "ESTU" set path=%BASESYS%\LOADLIB;%MIFOBASE%;%MIFOBIN%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
if "%MIFOSYS1%" == "EDEV" set path=%BASESYS%\LOADLIB;%MIFOEDEV%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
if "%MIFOSYS1%" == "VCBL" set path=%MIFOVCBL%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
:JUMPPATH
set SIMOPATH=Y
rem *
set USERCLASS=%BASELIB1%\LOADLIB
set APACHEST=C:\Program Files (x86)\Apache Group\Apache2
set CLASSPATH=.
set CLASSPATH=%CLASSPATH%;%JAVABASE%
set CLASSPATH=%CLASSPATH%;%JAVABASE%\lib
set CLASSPATH=%CLASSPATH%;\%USERCLASS%
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\ap01jv01\WEB-INF\classes
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\ap01jv01\WEB-INF\classes\simpacks
if "%MIFOSYS1%" == "ESTU" set CLASSPATH=%CLASSPATH%;%MIFOBIN%
if "%MIFOSYS1%" == "EDEV" set CLASSPATH=%CLASSPATH%;%MIFOEDEV%
if "%MIFOSYS1%" == "VCBL" set CLASSPATH=%CLASSPATH%;%MIFOVCBL%
if "%MIFOSYS1%" == "VCBL" set CLASSPATH=%CLASSPATH%;%MIFOVCBL%\mfcobol.jar
rem *
set JobStatus=0000
call SimoNOTE "* Settings CmdName ENV1BASE.cmd, Version 14.03.28, %MIFOSYS1%"
call SimoNOTE "* BaseAPP ..... %BASEAPP%"
rem * call SimoNOTE "* MFBSIDIR .... %MFBSI_DIR% "
call SimoNOTE "* MFTRACE_LOGS Folder is %MFTRACE_LOGS% "
Display and Log Messages
The following is a listing of the contents of the (SIMONOTE.cmd) command file.
@echo OFF rem * ******************************************************************* rem * SIMONOTE.CMD - a Windows Command File * rem * This program is provided by SimoTime Technologies * rem * (C) Copyright 1987-2016 All Rights Reserved * rem * Web Site URL: http://www.simotime.com * rem * e-mail: helpdesk@simotime.com * rem * ******************************************************************* rem * rem * Text - Display message on screen and write to a log file. rem * Author - SimoTime Technologies rem * rem * This script may be called from other scripts and expects a single rem * parameter enclosed in double quotes. The double quotes will be rem * removed. Before writing to the log file a date and time stamp rem * will be inserted in front of the message text. rem * rem * Note: The tilde (~) removes leading/trailing double-quotes. rem * if "%SimoNOTE%" == "" set SimoNOTE=c:\SimoLIBR\LOGS\SimoTime.LOG echo %date% %time% %~1>> %SimoNOTE% echo %~1
Summary
The purpose of this document is 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 document and the links to other documents are intended to provide a choice of alternatives.
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 Enterprises. 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 Enterprises.
SimoTime Enterprises 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 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, 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 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 COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore an Extended List of Software Technologies that are available for review and evaluation. The software technologies (or Z-Packs) provide individual programming examples, documentation and test data files in a single package. The Z-Packs are usually in zip format to reduce the amount of time to download.
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 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 for download. 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 via Internet Connect for access to white papers, program examples and product information.
Explore The Micro Focus Web Site via Internet Connect for more information about products and services available from Micro Focus.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Comments or Feedback
This document was created and is copyrighted and maintained by SimoTime Technologies.
If you have any questions, suggestions, comments or feedback please call or send an e-mail to: helpdesk@simotime.com
We appreciate hearing from you.
Company Overview
Founded in 1987, SimoTime Technologies 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
| Return-to-Top |
| Data File Transitions with Transfer, Share, Convert and Compare |
| Copyright © 1987-2016 SimoTime Technologies All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |