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-2024
SimoTime Technologies and Services
All Rights Reserved
Files Types & Record Structures
The following provides a list of terms or abbreviations used when referring to the various file types and record structures.
| Term | Description of File Format |
|---|---|
| KSDS | File Format for a Key Sequencd Data Set or Indexedl File. The record structure contains a data area for the user records and an index area that contains a user defined key that is used to access the file in a sequential or randowm methodology. The record content may include text strings that conform to the ASCII or EBCDIC encoding schema. Numeric values may use a Zoned-Decimal, Packed-Decimal or Binary format.. |
| LSEQ | File Format for a Line Sequential File or ASCII/Text File. By default the record content should conform to the ASCII encoding schema. |
| RSEQ | File Format for a Record Sequential File. The record content may include text strings that conform to the ASCII or EBCDIC encoding schema. Numeric values may use a Zoned-Decimal, Packed-Decimal or Binary format. |
| Term | Description of Record Structure and Content |
| CSV | Comma Separated Values is a record structure containing variable length fields of text characters. Each field is separated by a delimiter character that is typically a comma. |
| FFL | Fixed Field Length is a record structure that contains fixed length fields. Each field may contain text or binary data. |
| Term | Description is a hybrid of the File Format and Record Structure |
| LCSV | Line Sequential file with a CSV Record Structure. |
| RFFL | Record Sequential file with a Fixed Field Length record structure. |
The preceding provides a list of terms or abbreviations used when referring to the various file types and record structures.
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. |
| 1.1. | The CUSC80J1.JCL member will create a sequential file of 80-byte records with customer information. |
| 1.2. | Uses IEFBR14 to delete a previously create file and then uses IEBGENER to create a new file. |
| 1.3. | This job will run with ZOS, MFE or ES/MTO configured for an EBCDIC-encoding. |
| 2. | Demonstrate how to use JCL and IDCAMS to define an EBCDIC-encoded, VSAM, KSDS cluster with 512 byte records. |
| 2.1. |
The CUSCRTJ1.JCL member will create a VSAM cluster for a Customer Master File. Note: if the CUSCRTJ1 job ends with a CC=8 this is usually caused be the existance of a Customer Master File. This existing file may be deleted by running the CUSDELJ1.JCL job. |
| 2.2. | The new KSDS will have 512-byte records with the primary key starting at position 1 with a key length of 12 bytes. |
| 2.3. | This job will run with ZOS, MFE or ES/MTO configured for an EBCDIC-encoding. |
| 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. |
| 3.1. | The CUSI80J1.JCL member will execute a COBOL program that will read a record sequential file of 80-byte records. The field sizes will be increased and the expanded field and record will be used to add records to the Customer Master File. If a record with an equal key is encountered it will be updated with the new information. |
| 3.2. | This job will run with ZOS, MFE or ES/MTO configured for an EBCDIC-encoding. |
| 4. | Demonstrate how to use JCL and a COBOL program to read the EBCDIC-encoded VSAM, KSDS and produces four-across mailing labels. |
| 4.1. | The STAMLRJ1.JCL member will read the EBCDIC-encoded Customer Master file and create a print-oriented file of four-across mailing labels with the records sorted in postal code sequence. |
| 4.2. | The format of the print-oriented file is an EBCDIC-encoded Record Sequential file of 192 byte records. |
| 4.3. | This job will run with ZOS, MFE or ES/MTO configured for an EBCDIC-encoding. |
| 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. |
| 5.1. | The CUSK2RJ1.JCL member will use IDCAMS to read the customer master file and create a record sequential file. The record layout is the same for the input and output. |
| 5.2. | The record sequential file may be transferred from the Mainframe System to a Windows System using FTP in BINARY mode. |
| 5.3. | This job will run with ZOS, MFE or ES/MTO configured for an EBCDIC-encoding. |
| 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. |
| 6.1. | The ftp4cmd1.htm document describes the FTP commands required. |
| 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. |
| 7.1. | The CUREKAE1.CMD Windows Command File executes a COBOL program that will read the Record Sequential File and write a new ASCII-encoded Customer Master File. |
| 7.2. | The record sequential file may have been transferred from the Mainframe System to a Windows System using FTP in BINARY mode. |
| 7.3. | This job will run with Micro Focus Net Express (NXE) or ES/MTO configured for ASCII-encoding when the COBOL program is compiled with CHARSET(ASCII). This job will run with MFE or ES/MTO configured for EBCDIC-encoding when the COBOL program is compiled with CHARSET(EBCDIC). |
| 8. | Demonstrate how to use a COBOL program to read the ASCII-encoded VSAM, KSDS and produces four-across mailing labels. |
| 8.1. | The STAMLRJ1.JCL member will read the ASCII-encoded Customer Master file and create a print-oriented file of four-across mailing labels with the records sorted in postal code sequence. |
| 8.2. | The format of the print-oriented file is an ASCII-encoded Record Sequential file of 192 byte records. |
| 8.3. | This job will run with NXE or ES/MTO configured for an ASCII-encoding. |
| 8.4. | The STAMLRE1.CMD Windows Command File is provided to run this job without using JCL. |
| 9. | Demonstrate how to compare two data files. |
| 9.1. | The CUP303E1.CMD member will compare the ASCII-encoded, record sequential file created in the Mainframe and ZOS environment to the ASCII-encoded Customer Master file created in the Windows and Micro Focus environment. |
| 9.2. | This job executes a COBOL program to do the file compare. Based on the files being in sequence by a key field the compare routine will track inserts and deletes. |
| 9.3. | This job will run with NXE or ES/MTO configured for ASCII-encoding when the COBOL program is compiled with CHARSET(ASCII). This job will run with MFE or ES/MTO configured for EBCDIC-encoding when the COBOL program is compiled with CHARSET(EBCDIC). |
| 9.4. | The CUP303E1.CMD Windows Command File is provided to run this job without using JCL. |
| 10. | Demonstrate how to extract data from a VSAM, KSDS to a Sequential file with the record structure in a Comma Separated Values format. |
| 10.1. | The CUSCSVE1.CMD Windows Command File executes a COBOL program that will read the Customer Master File and write to a record sequential file with the records constructed in a Comma Separated Values format. |
| 10.2. | May be ported to run on the Linux or UNIX platforms supported by Micro Focus COBOL. |
| 10.3. | This job will run with NXE or ES/MTO configured for an ASCII-encoded environment. |
| 10.4. | The CUSCSVE2.CMD Windows Command File executes a COBOL program that will read an ASCII-encoded, Record Sequential file and write to a Line Sequential file. The Line Sequential File (or ASCII/Text File) may be viewed with NotePAD or easily imported into an Excel spreadsheet since it has a CSV extension as part of the file name. |
| 10.5. | The CUSCSVJ1.JCL member executes a COBOL program that will read the Customer Master File and write to a record sequential file with the records constructed in a Comma Separated Values format. If this job is executed on a Z/OS Mainframe System it will create an EBCDIC-encoded record sequential file. If the record sequential file is transferred to a Windows System via FTP using ASCII-Mode it will be converted from a Record Sequential, EBCDIC-encoded file to an ASCII/Text file on the Windows System. |
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.
JCL Members, Customer Data
This section describes the JCL members (or Mainframe Job Control Language) used in this suite of sample programs.
Create RSEQ/FFL 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 Record Sequential (RSEQ) file of 80-byte records with customer information. The record structure is a fixed field length (FFL) format.
//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-2019 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Create a Sequential Data Set on disk using IEBGENER. //* Author - SimoTime Technologies //* Date - January 24, 1996 //* //* The first job step (QSAMDELT) will delete any previously created //* file. The second job step (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
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-2019 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. *
//*
//* *******************************************************************
//* Step 1 of 1, this is a single step job.
//*
// EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE SIMOTIME.DATA.CUSTMAST -
FILE (CUSTMAST) -
PURGE -
ERASE -
CLUSTER
SET MAXCC = 0
/*
Define a VSAM Cluster (KSDS)
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-2019 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. Refer to the INDEXED
//* parameter within the DEFINE CLUSTER.
//*
//* The key is twelve characters starting at the first position in
//* the record. Refer to the KEYS(12,0) parameter.
//*
//* The record length for the data set is 512 characters. Refer to
//* the RECORDIZE(512,512) where the first numeric value is the
//* AVERAGE and the second numeric value is the MAXIMUM length.
//*
//* This job script will run on an IBM Mainframe under ZOS or on a
//* Microsoft Windows System under Micro Focus Mainframe Express.
//*
//* *******************************************************************
//* Step 1 of 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 RSEQ/FFL, Update KSDS
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-2019 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 Repro, KSDS to RSEQ
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 (a VSAM/KSDS) and create a Record 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-2019 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) /*
Command Files, Customer Data
This section describes the CMD or Windows Command Files used in this suite of sample programs.
FTP for RSEQ, Mainframe to Windows
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-RSEQ to ASCII-KSDS
The following member (CUREKAW1.cmd) is the Windows Command File that will use to convert the EBCDIC-encoded, Record-Sequential file that was downloaded from an IBM Mainframe System (ZOS or VSE) to a Windows System.
@echo OFF
rem * *******************************************************************
rem * CUREKAW1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read 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 * * CUREKAW1 *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * ENV1BASE *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * SimoNOTE *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * RUN *---------------------------*
rem * ********rts* *
rem * * ************ ************ ************
rem * * * CUSRE512 *-----* CUREKAC1 *-----* CUSKA512 *
rem * * * Note-1 * ********cbl* * Note-2 *
rem * * *******rseq* *******ksds*
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * Note-1: CUSRE512 is an EBCDIC-encoded, record sequential (RSEQ)
rem * file. This file was downloaded from an IBM Mainframe
rem * System using FTP and BINARY MODE.
rem *
rem * Note-2: CUSKA512 is an ASCII-encoded,indexed file that may be
rem * referred to as a Key-Sequenced Data Set (KSDS). This
rem * file is created by this job.
rem *
rem * *******************************************************************
rem * Step 1, Set Environment Variables
rem * Delete any previously created ASCII-encoded file...
rem *
call ..\Env1BASE
set CmdName=CUSE2AW1
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
set CmdName=CUP303W1
rem * *******************************************************************
rem * CUP303W1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Compare two 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 *
call ..\Env1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
set SYSLOG=%BaseLib1%\LOGS\SYSLOG_RSEQ_CUP303W1.DAT
set SYSOUT=%BaseLib1%\LOGS\SYSOUT_LSEQ_CUP303W1.txt
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
Convert Customer KSDS to RSEQ/CSV
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 KSDS, write to RSEQ/CSV
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-2019 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 RSEQ/CSV and Write LSEQ/CSV
The following member (CUSCSVE2.cmd) is the Windows Command File that will use a COBOL program to read the Record Sequential (RSEQ) file and create a Line Sequential (LSEQ) 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-2019 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%
COBOL Programs, Customer Data
This section describes the COBOL programs used in this suite of sample programs.
Read RSEQ, Reformat, Update KSDS
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: 2018-10-10 Generation Time: 20:28:24:10 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* PRIMARY CUST0080 SEQUENTIAL FIXED 00080 *
* *
* SECONDARY 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 more information or questions please contact SimoTime *
* Technologies. The version control number is 16.01.01 *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CUSI80C1 '.
05 T2 pic X(34) value 'Sequential, RSEQ-80 to KSEQ-512 '.
05 T3 pic X(10) value ' v16.01.01'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* 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.
01 CUST0080-LRECL-MAX pic 9(5) value 00080.
01 CUSTMAST-LRECL-MAX 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(011) value '* CUSI80C1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(068) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MSG-LSB pic 9(5) value 267.
*****************************************************************
01 PROGRAM-NAME pic X(8) value '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 WRITE-FLAG pic X value 'Y'.
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
* USRSOJ Processing not specified...
perform until CUST0080-STATUS not = '00'
perform CUST0080-READ
if CUST0080-STATUS = '00'
add 1 to CUST0080-RDR
perform BUILD-OUTPUT-RECORD
if WRITE-FLAG = 'Y'
perform CUSTMAST-WRITE
if CUSTMAST-STATUS = '00'
add 1 to CUSTMAST-ADD
end-if
end-if
end-if
end-perform
* USREOJ Processing not specified...
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)
* TransDATE...
accept CUSTMAST-REC(00349:00008)
from DATE YYYYMMDD
* TransTIME...
accept CUSTMAST-REC(00357:00008)
from TIME
* 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.
*****************************************************************
Z-CALCULATE-MESSAGE-LSB.
add 267 to ZERO giving MSG-LSB
perform until MSG-LSB < 80
or MESSAGE-BUFFER(MSG-LSB:1) not = SPACE
if MESSAGE-BUFFER(MSG-LSB:1) = SPACE
subtract 1 from MSG-LSB
end-if
end-perform
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB)
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2018-10-10 Generation Time: 20:28:24:13 *
*****************************************************************
Convert RSEQ-EBC to KSDS-ASC
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
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: 2018-10-10 Generation Time: 20:28:14:56 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* PRIMARY CUSRE512 SEQUENTIAL FIXED 00512 *
* *
* SECONDARY 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 SYSMASK1.TXT file as input. *
* The SYSMASK1 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* *
* If the output file is indexed then the input file must be in *
* sequence by the field that will be used to provide the key *
* for the output file. This is a sequential load process. *
* *
* If the key field is not in sequence then refer to SYSMASK2 *
* to provide for a random add or update of the indexed file. *
* *
* This program mask will have the ASCII/EBCDIC table inserted *
* for use by the /TRANSLATE function of SimoZAPS. *
* *
* For more information or questions please contact SimoTime *
* Technologies. The version control number is 16.01.01 *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CUREKAC1 '.
05 T2 pic X(34) value 'Read EBCDIC/RSEQ, Load ASCII/KSDS '.
05 T3 pic X(10) value ' v16.01.01'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* 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.
01 CUSRE512-LRECL-MAX pic 9(5) value 00512.
01 CUSKS512-LRECL-MAX 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(011) value '* CUREKAC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(068) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MSG-LSB pic 9(5) value 267.
*****************************************************************
01 PROGRAM-NAME pic X(8) value '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 'Read EBCDIC/RSEQ, Load ASCII/KSDS '.
05 filler pic X(24)
value ' http://www.SimoTime.com'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 WRITE-FLAG pic X value 'Y'.
01 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'.
*****************************************************************
* The following copy file contains the translation tables for *
* the ASCII and EBCDIC conversion. Also, sections of the tables *
* may be used for case conversion. *
*****************************************************************
COPY ASCEBCB1.
*****************************************************************
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
* USRSOJ Processing not specified...
perform until CUSRE512-STATUS not = '00'
perform CUSRE512-READ
if CUSRE512-STATUS = '00'
add 1 to CUSRE512-RDR
perform BUILD-OUTPUT-RECORD
if WRITE-FLAG = 'Y'
perform CUSKS512-WRITE
if CUSKS512-STATUS = '00'
add 1 to CUSKS512-ADD
end-if
end-if
end-if
end-perform
* USREOJ Processing not specified...
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, Record Content Conversion...
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.
*****************************************************************
Z-CALCULATE-MESSAGE-LSB.
add 267 to ZERO giving MSG-LSB
perform until MSG-LSB < 80
or MESSAGE-BUFFER(MSG-LSB:1) not = SPACE
if MESSAGE-BUFFER(MSG-LSB:1) = SPACE
subtract 1 from MSG-LSB
end-if
end-perform
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB)
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2018-10-10 Generation Time: 20:28:14:58 *
*****************************************************************
Callable Routine to Convert the Fields
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: 2018/10/10 Generation Time: 20:28:14:89 *
*****************************************************************
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 AE0437B1.
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
* Table Element........ CUST-DISCOUNT-CODE 000001
* Binary............... CUST-DISCOUNT-CODE
* Table Element........ CUST-DISCOUNT-RATE 000001
inspect CUST-RECORD(0000306:0000005)
converting E-NUMB to A-NUMB
* Table Element........ CUST-DISCOUNT-DATE 000001
inspect CUST-DISCOUNT-DATE(1) converting E-INFO to A-INFO
* Table Element........ CUST-DISCOUNT-CODE 000002
* Binary............... CUST-DISCOUNT-CODE
* Table Element........ CUST-DISCOUNT-RATE 000002
inspect CUST-RECORD(0000321:0000005)
converting E-NUMB to A-NUMB
* Table Element........ CUST-DISCOUNT-DATE 000002
inspect CUST-DISCOUNT-DATE(2) converting E-INFO to A-INFO
* Table Element........ CUST-DISCOUNT-CODE 000003
* Binary............... CUST-DISCOUNT-CODE
* Table Element........ CUST-DISCOUNT-RATE 000003
inspect CUST-RECORD(0000336:0000005)
converting E-NUMB to A-NUMB
* Table Element........ CUST-DISCOUNT-DATE 000003
inspect CUST-DISCOUNT-DATE(3) converting E-INFO to A-INFO
inspect CUST-LADATE converting E-INFO to A-INFO
inspect CUST-LATIME converting E-INFO to A-INFO
* Zoned-Decimal-Nosign. 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: 2018/10/10 Generation Time: 20:28:14:89 *
*****************************************************************
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: 2020-06-25 Generation Time: 19:20:31:91 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* PRIMARY CUACTUAL INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* SECONDARY 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 20.00.00 *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CUP303C1 '.
05 T2 pic X(34) value 'Comparison, CustMAST from 1 to 303'.
05 T3 pic X(10) value ' v20.00.00'.
05 T4 pic X(24) value ' helpdesk@simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* 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 comments 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 CUACTUAL-LRECL pic 9(5) value 00512.
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'.
01 CUEXPECT-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 '* 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 KEY-ACTIVE pic X value 'Y'.
01 KEY-CONTROL-1.
05 K-PS-1 pic 9(5) value 00001.
05 K-LN-1 pic 9(5) value 00012.
01 KEY-CONTROL-2.
05 K-PS-2 pic 9(5) value 00001.
05 K-LN-2 pic 9(5) value 00012.
01 KEYRECID-ACTIVE pic X value 'N'.
01 KEYRECID-CONTROL-1.
05 E-PS-1 pic 9(5) value 00000.
05 E-LN-1 pic 9(5) value 00000.
01 KEYRECID-CONTROL-2.
05 E-PS-2 pic 9(5) value 00000.
05 E-LN-2 pic 9(5) value 00000.
01 READ-FLAGS.
05 READ-1 pic X value 'Y'.
05 READ-2 pic X value 'Y'.
01 DUMP-FLAGS.
05 DUMP-RPI pic X value 'Y'.
05 DUMP-ASC pic X value 'Y'.
05 DUMP-EBC pic X value 'Y'.
05 DUMP-HEX pic X value 'Y'.
05 DUMP-DET-GRP.
10 DUMP-DET pic X value 'Y'.
10 DUMP-DET-2 pic XX value 'NE'.
05 DUMP-SUM pic X value 'Y'.
05 DUMP-STATUS pic x VALUE 'Y'.
01 DUMP-PGM pic X(8) value 'SIMOLOGS'.
01 DPOS-UT1 pic 9(5) value 1.
01 DLEN-UT1 pic 9(5) value 00348.
01 DPOS-UT2 pic 9(5) value 1.
01 DLEN-UT2 pic 9(5) value 00348.
01 FUNCTION-FLAGS.
05 FF-01 pic X value '1'.
05 FF-02 pic X value '0'.
05 FF-03 pic X value '0'.
01 COMPACT-STATUS pic XX value 'EQ'.
01 COMPACT-PENDED pic XX value 'EQ'.
01 COMPARE-STATUS pic XX value 'EQ'.
01 FLAG-EQ pic XX value 'EQ'.
01 FLAG-NE pic XX value 'NE'.
01 FLAG-QT pic XX value 'QT'.
01 DELTA-LINE-1 pic X(1024) value all '-'.
01 DELTA-LINE-2 pic X(1024) value all '-'.
01 PTR-1 pic 9(5) value 0.
01 PTR-2 pic 9(5) value 0.
01 IDX-1 pic 9(5) value 0.
01 IDX-2 pic 9(5) value 0.
01 BYPASS-UT1-CTR pic 9(3) value 0.
01 BYPASS-UT2-CTR pic 9(3) value 0.
01 WORK-05 pic X(5) value SPACES.
01 WORK-LENGTH pic 9(5) value 0.
01 DELTA-MAX-ABEND.
05 FILLER pic X(10) value 'ABENDING, '.
05 FILLER pic X(24) value 'Not Equal count exceeds '.
05 FILLER pic X(22) value 'user-defined limit of '.
05 DELTA-MAXIMUM-X pic X(9) value '000000005'.
05 DELTA-MAXIMUM redefines DELTA-MAXIMUM-X pic 9(9).
05 FILLER pic X(19) value ', ABEND process is '.
05 DELTA-PROCESS pic X(4) value 'EOF '.
01 IFNECODE-GROUP.
05 IFNECODE-VALUE pic 9(4) value 0016.
01 YES-YES pic XX value 'YY'.
01 N-BYTE pic X value 'N'.
01 Y-BYTE pic X value 'Y'.
01 GROUP-DELIMITER pic X value 'Y'.
01 LEN-UT1 pic 9(5) value 128.
01 POS-UT1 pic 9(5) value 1.
01 LEN-UT2 pic 9(5) value 128.
01 POS-UT2 pic 9(5) value 1.
01 LEN-1 pic 9(5) value 128.
01 POS-1 pic 9(5) value 1.
01 LEN-2 pic 9(5) value 128.
01 POS-2 pic 9(5) value 1.
01 D-LEN pic 9(5) value 128.
01 D-POS pic 9(5) value 1.
01 W-LEN pic 9(5) value 0.
01 W-POS pic 9(5) value 10.
01 DUMP-RECL-MAX-S pic X value 'N'.
01 DUMP-RECL-MAX pic 9(5) value 00000.
01 CONTINUE-FLAG pic X value 'Y'.
01 ASC-OR-EBC pic 9(3) comp value 0.
01 ASC-OR-EBC-R redefines ASC-OR-EBC.
05 ASC-A pic X.
05 EBC-A pic X.
* Header row for positional indicator...
01 DUMP-H10.
05 FILLER pic X(5) value '....:'.
05 POS-NO pic 9(5) value 10.
05 FILLER pic X(10) value '....:.....'.
01 DUMP-W10.
05 FILLER pic X(5) value '....:'.
05 W10-POS-NO pic X(5) value '00000'.
05 FILLER pic X(10) value '....:.....'.
01 DUMP-HEADER pic X(1024) value all '.'.
01 D-P1 pic 9(5) value 0.
01 WK-1 pic 9(5) value 0.
01 WK-2 pic 9(5) value 0.
01 RECORD-HEADER.
05 RECORD-ID pic X(8) value '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 'LOG1'.
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 UT1-MISSING.
05 filler pic X(5) value 'This '.
05 filler pic X(31)
value 'record is MISSING from CUACTUAL'.
05 filler pic X(7) value ' - the '.
05 filler pic X(29)
value 'record is PRESENT in CUEXPECT'.
01 UT2-MISSING.
05 filler pic X(5) value 'This '.
05 filler pic X(29)
value 'record is PRESENT in CUACTUAL'.
05 filler pic X(7) value ' - the '.
05 filler pic X(31)
value 'record is MISSING from CUEXPECT'.
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 CUACTUAL-OMIT.
05 CUACTUAL-OMT pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Bypass count for CUACTUAL'.
01 CUEXPECT-OMIT.
05 CUEXPECT-OMT pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Bypass count for CUEXPECT'.
01 COMPARE-NE-TOTAL.
05 COMPARE-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPARE-TAG.
10 filler pic X(25) value 'NOT Equal count for compa'.
10 filler pic X(25) value 're of existing records '.
01 COMPACT-NE-TOTAL.
05 COMPACT-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 COMPACT-TAG.
10 filler pic X(25) value 'NOT Equal count for compa'.
10 filler pic X(25) value 'ct of existing records '.
01 COMPARE-EQ-TOTAL.
05 COMPARE-EQ pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Number of matching record'.
05 filler pic X(25) value ' pairs for Compare Task '.
01 COMPACT-EQ-TOTAL.
05 COMPACT-EQ pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Number of matching record'.
05 filler pic X(25) value ' pairs for Compact Task '.
01 FORMAT-TYPE pic X value 'B'.
COPY PASSHEX4.
COPY PASSLOGS.
COPY PAENVARS.
*****************************************************************
PROCEDURE DIVISION.
perform JOB-STARTING
perform
until COMPARE-STATUS = 'QT'
or 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
move 'N' to DUMP-STATUS
move all '-' to DELTA-LINE-1
move all '-' to DELTA-LINE-2
if KEY-ACTIVE = 'Y'
and COMPARE-STATUS = FLAG-EQ
perform COMPARE-KEYS
end-if
if COMPARE-STATUS = FLAG-EQ
perform COMPARE-RECORDS
end-if
if DUMP-STATUS = 'Y'
if GROUP-DELIMITER = 'Y'
perform DUMP-ASTERISK-ONE
end-if
add DLEN-UT1 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-PRIMARY-RECORD
perform DUMP-POSITION-DIFFERENCES-1
perform DUMP-SECONDARY-RECORD
perform DUMP-POSITION-DIFFERENCES-2
add DLEN-UT2 to ZERO giving D-LEN
move 'N' to DUMP-STATUS
end-if
if COMPARE-STATUS = FLAG-NE
add 1 to COMPARE-NE
end-if
else
move 'NE' to COMPARE-STATUS
end-if
if COMPARE-STATUS = 'EQ'
add 1 to COMPARE-EQ
end-if
if DELTA-PROCESS = 'QUIT'
and COMPARE-NE > DELTA-MAXIMUM
perform JOB-FINISHED
move DELTA-MAX-ABEND to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
if DELTA-PROCESS = 'EOF '
and COMPARE-NE > DELTA-MAXIMUM
move DELTA-MAX-ABEND to MESSAGE-TEXT
perform Z-DISPLAY-TO-CONSOLE
move 'QT' to COMPARE-STATUS
end-if
end-perform
perform JOB-FINISHED
GOBACK.
*****************************************************************
COMPARE-RECORDS.
* Physical Comparison with NE Output of SIMOLOGS
move 'COMPARISON' to REC-CTYPE
move 'PHYSICAL ' to REC-CMODE
move all '=' to DELTA-LINE-1(00001:00348)
move all '=' to DELTA-LINE-2(00001:00348)
if CUACTUAL-REC(00001:00348) not = CUEXPECT-REC(00001:00348)
move FLAG-NE to COMPARE-STATUS
move 'Y' to DUMP-STATUS
end-if
if DUMP-DET = 'Y'
and DUMP-STATUS = 'Y'
add 00001 to ZERO giving POS-UT1
add 00001 to ZERO giving POS-UT2
add 00348 to ZERO giving LEN-UT1
add 00348 to ZERO giving LEN-UT2
add 00348 to ZERO giving PASSHEX4-LENGTH
perform CALC-DELTA-FOR-NE-EQ-NO
end-if
exit.
*****************************************************************
COMPARE-KEYS.
move YES-YES to READ-FLAGS
if CUACTUAL-REC(K-PS-1:K-LN-1)
< CUEXPECT-REC(K-PS-2:K-LN-2)
move N-BYTE to READ-2
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
and DUMP-DET-GRP = 'YNE'
perform DUMP-SECONDARY-MISSING
end-if
end-if
if CUACTUAL-REC(K-PS-1:K-LN-1)
> CUEXPECT-REC(K-PS-2:K-LN-2)
move N-BYTE to READ-1
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
and DUMP-DET-GRP = 'YNE'
perform DUMP-PRIMARY-MISSING
end-if
end-if
exit.
*****************************************************************
CALC-DELTA-FOR-NE-EQ-NO.
add POS-UT1 to ZERO giving PTR-1
add POS-UT2 to ZERO giving PTR-2
perform until PTR-1 > POS-UT1 + LEN-UT1 - 1
or PTR-2 > POS-UT2 + LEN-UT2 - 1
if CUACTUAL-REC(PTR-1:1)
= CUEXPECT-REC(PTR-2:1)
move '=' to DELTA-LINE-1(PTR-1:1)
move '=' to DELTA-LINE-2(PTR-2:1)
else
move '#' to DELTA-LINE-1(PTR-1:1)
move '#' to DELTA-LINE-2(PTR-2:1)
end-if
add 1 to PTR-1
add 1 to PTR-2
end-perform
exit.
*****************************************************************
DUMP-TO-LOG.
* HexDump...
* Dump DD Name, Record-Number, (position,length)
move RECORD-HEADER to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
* DUMP Record Position Indicator
* if DUMP-RPI = 'Y'
* perform DUMP-POSITION-INDICATOR
* end-if
if DUMP-ASC = 'Y'
move PASSHEX4-ASCII(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-HEX = 'Y'
move PASSHEX4-UPPER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move PASSHEX4-LOWER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-EBC = 'Y'
move PASSHEX4-EBCDIC(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
exit.
*****************************************************************
* Build the position header row...
*****************************************************************
DUMP-ASTERISK-ONE.
move SPACES to SIMOLOGS-MESSAGE
move '*' to SIMOLOGS-MESSAGE(1:1)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-INDICATOR.
add 10 to ZERO giving POS-NO
subtract 1 from D-POS giving WK-1
divide 10 into WK-1 giving WK-1 remainder WK-2
add 1 to WK-2
perform varying D-P1 from 1 by 10 until D-P1 > 1020
move DUMP-H10 to DUMP-W10
inspect W10-POS-NO replacing leading ZEROES by '.'
move DUMP-W10(WK-2:10) to DUMP-HEADER(D-P1:10)
add 10 to POS-NO
end-perform
move DUMP-HEADER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-PRIMARY-MISSING.
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
add DPOS-UT1 to ZERO giving RECORD-POS
add DLEN-UT1 to ZERO giving RECORD-LEN
add DPOS-UT1 to ZERO giving D-POS
add DLEN-UT1 to ZERO giving D-LEN
* Present in CUEXPECT, missing from CUACTUAL...
move UT1-MISSING to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
add DLEN-UT2 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-SECONDARY-RECORD
move SPACES to DELTA-LINE-2
move all '#' to DELTA-LINE-2(1:DLEN-UT2)
perform DUMP-POSITION-DIFFERENCES-2
exit.
*****************************************************************
DUMP-PRIMARY-RECORD.
add DPOS-UT1 to ZERO giving RECORD-POS
add DLEN-UT1 to ZERO giving RECORD-LEN
add DPOS-UT1 to ZERO giving D-POS
add DLEN-UT1 to ZERO giving D-LEN
move '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
perform DUMP-TO-LOG
exit.
*****************************************************************
DUMP-SECONDARY-MISSING.
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
add DPOS-UT2 to ZERO giving RECORD-POS
add DLEN-UT2 to ZERO giving RECORD-LEN
add DPOS-UT2 to ZERO giving D-POS
add DLEN-UT2 to ZERO giving D-LEN
* Present in CUACTUAL, missing from CUEXPECT...
move UT2-MISSING to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
add DLEN-UT1 to ZERO giving D-LEN
if DUMP-RPI = 'Y'
perform DUMP-POSITION-INDICATOR
end-if
perform DUMP-PRIMARY-RECORD
move SPACES to DELTA-LINE-1
move all '#' to DELTA-LINE-1(1:DLEN-UT1)
perform DUMP-POSITION-DIFFERENCES-1
exit.
*****************************************************************
DUMP-SECONDARY-RECORD.
move SPACES to PASSHEX4-SOURCE
add DPOS-UT2 to ZERO giving RECORD-POS
add DLEN-UT2 to ZERO giving RECORD-LEN
add DPOS-UT2 to ZERO giving D-POS
add DLEN-UT2 to ZERO giving D-LEN
move '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-DIFFERENCES-1.
if DUMP-RECL-MAX-S = 'Y'
and DUMP-RECL-MAX < CUACTUAL-LRECL
add DUMP-RECL-MAX to ZERO giving WORK-LENGTH
else
add CUACTUAL-LRECL to ZERO giving WORK-LENGTH
end-if
move DELTA-LINE-1(1:DLEN-UT1) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCES-2.
if DUMP-RECL-MAX-S = 'Y'
and DUMP-RECL-MAX < CUEXPECT-LRECL
add DUMP-RECL-MAX to ZERO giving WORK-LENGTH
else
add CUEXPECT-LRECL to ZERO giving WORK-LENGTH
end-if
move DELTA-LINE-2(1:DLEN-UT2) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
JOB-FINISHED.
if CUACTUAL-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform until CUACTUAL-STATUS not = '00'
perform CUACTUAL-READ
add 1 to COMPARE-NE
end-perform
end-if
if CUEXPECT-STATUS = '00'
and DELTA-PROCESS = 'EOF '
perform until CUEXPECT-STATUS not = '00'
perform CUEXPECT-READ
add 1 to COMPARE-NE
end-perform
end-if
perform CUEXPECT-CLOSE
perform CUACTUAL-CLOSE
if GROUP-DELIMITER = 'Y'
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move 'Conclude' to INFO-ID
move INFO-SHORT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move 'Finished' to INFO-ID
move CUACTUAL-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if CUACTUAL-OMT > ZERO
move CUACTUAL-OMIT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move CUEXPECT-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if CUEXPECT-OMT > ZERO
move CUEXPECT-OMIT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
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
inspect COMPARE-TAG
replacing first ' of existing records '
by ' is ZERO '
else
move 'ABENDING' to INFO-ID
end-if
move COMPARE-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move COMPARE-EQ-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if FF-02 = '1'
if COMPACT-NE = 0
inspect COMPACT-TAG
replacing first ' of existing records '
by ' is ZERO '
else
move 'ABENDING' to INFO-ID
end-if
move COMPACT-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if 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 IFNECODE-VALUE 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 K-PS-1 > 0
and K-PS-2 > 0
and K-LN-1 > 0
and K-LN-2 > 0
move 'Y' to KEY-ACTIVE
move 'Key control is ENABLED...'
to MESSAGE-TEXT
else
move 'N' to KEY-ACTIVE
move 'Key control is NOT enabled...'
to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
move 'DUMP' to PASSHEX4-REQUEST
add 128 to ZERO giving PASSHEX4-LENGTH
move SYSLOG-OUTPUT to SIMOLOGS-REQUEST
move SPACES to SIMOLOGS-MESSAGE
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SIM-TITLE to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move SIM-COPYRIGHT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move all '*' to SIMOLOGS-MESSAGE(1:79)
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
* I/O Routines for the Primary File... *
*****************************************************************
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: 2020-06-25 Generation Time: 19:20:31:94 *
*****************************************************************
Extract Customer Data
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 KSDS, write to RSEQ/CSV
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-2019 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-2019 All Rights Reserved *
* Web Site URL: http://www.simotime.com *
* e-mail: helpdesk@simotime.com *
*****************************************************************
Read RSEQ/CSV, Write to LSEQ/CSV
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-2021 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 UMAPALIB=%BASECAT%\ASC1
set UMAPELIB=%BASECAT%\EBC1
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
set USERPOST=%BASEAPP%\LOGS\ASSIGNED_USER_POST_FILE.txt
if [%1]==[] goto NO_POST
set SYSOUT=%BaseLib1%\LOGS\SYSOUT_%1.txt
call SIMONOTE "+ ENV1BASE *"
call SIMONOTE "+ ENV1BASE ********************************************************************%1"
call SIMONOTE "+ ENV1BASE is preparing the System Environment..."
call SIMONOTE "+ SIMOLIBR is %SIMOLIBR%"
call SIMONOTE "+ MIFOSYS1 is %MIFOSYS1%"
call SIMONOTE "+ BASELIB1 is %BASELIB1%"
:NO_POST
call SIMONOTE "+ SIMONOTE Job Log File is %SIMONOTE% "
rem *
set MQBASE=C:\Program Files\IBM\WebSphere MQ
rem *
rem * Set the location for the Apache-Tomcat Server...
set CATALINA_HOME=C:\APACHETC\apache-tomcat-7.0.52
rem set CATALINA_HOME=C:\Program Files (x86)\Java\jdk1.8.0_112
rem *
rem * Set the Environment for the Java Environment...
rem set JAVABASE=C:\APACHETC\apache-tomcat-7.0.52
set JAVABASE=C:\Program Files (x86)\Java\jdk1.8.0_112
set JAVASDK="%JAVABASE%\bin"
set JAVA_HOME=%JAVABASE%
set JRE_HOME=%JAVABASE%
set SIMOTCAT=%CATALINA_HOME%\webapps\simotcat
set SIMPACKS=%CATALINA_HOME%\webapps\simotcat\WEB-INF\classes\simpacks
rem *
rem * Set the environment for the Micro Focus technology...
set MIFOEDEV=C:\Program Files (x86)\Micro Focus\Enterprise Developer
set MIFOVCBL=C:\Program Files (x86)\Micro Focus\Visual COBOL Build Tools
set MIFOESTU=C:\Program Files (x86)\Micro Focus\Studio Enterprise Edition 6.0
set MIFOEMFE="C:\Program Files (x86)\Micro Focus\Mainframe Express"
rem *
rem * Large file support, performance tuning and record locking of the File Handler
set EXTFH=%BASESYS%\CONFIG\EXTFHBIG.CFG
rem *
rem * For IMS Support
set ES_IMSLIB=%BASEAPP%\IMSLIB
set ES_ACBLIB=%BASEAPP%\IMSLIB
rem *
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 *
rem * If not already set then set the PATH for Micro Focus Directories
if "%SIMOPATH%" == "Y" goto JUMPPATH
if "%MIFOSYS1%" == "EDEV" goto JUMPEDEV
if "%MIFOSYS1%" == "VCBL" goto JUMPVCBL
if "%MIFOSYS1%" == "ESTU" goto JUMPESTU
if "%MIFOSYS1%" == "EMFE" goto JUMPEMFE
:JUMPEDEV
set path=%BASESYS%\LOADLIB;%MIFOEDEV%\bin;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOEDEV%\CPYLIB
set MIFOBASE=%MIFOEDEV%
goto JUMPPATH
:JUMPVCBL
set path=%MIFOVCBL%\bin;%MIFOVCBL%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set MIFOBASE=%MIFOVCBL%
goto JUMPPATH
:JUMPESTU
set MIFOBASE=%MIFOESTU%\Base
set MIFOBIN=%MIFOBASE%\bin
set path=%BASESYS%\LOADLIB;%MIFOBASE%;%MIFOBIN%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOBASE%\SOURCE
goto JUMPPATH
:JUMPEMFE
set MIFOBASE=%MIFOEMFE%\Base
set MIFOBIN=%MIFOBASE%\bin
set path=%BASESYS%\LOADLIB;%MIFOBASE%;%MIFOBIN%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOBASE%\SOURCE
goto JUMPPATH
rem *
:JUMPPATH
set SIMOPATH=Y
rem *
set MAINFRAME_FLOATING_POINT=true
set COBIDY=%BASEAPP%\COBIDY
set COBPATH=.;%BASEAPP%\LOADLIB;%BASEAPP%\LOADLIB\GNTS;%BASESYS%\LOADLIB;%SimoLIBR%
set LIBPATH=.;%BASEAPP%\LOADLIB;%BASEAPP%\LOADLIB\GNTS;%BASESYS%\LOADLIB;%SimoLIBR%
set TXDIR=%BASESYS%\LOADLIB;%MIFOBASE%
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%
rem *
set USERCLASS=%BASELIB1%\LOADLIB
set CLASSPATH=.
set CLASSPATH=%CLASSPATH%;%JAVABASE%
set CLASSPATH=%CLASSPATH%;%JAVABASE%\lib
set CLASSPATH=%CLASSPATH%;\%USERCLASS%\simpacks
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\simotcat\WEB-INF\classes
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\simotcat\WEB-INF\classes\simpacks
rem *
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%\bin\mfcobol.jar
rem *
set JobStatus=0000
call SIMONOTE "+ ENV1BASE is returning to caller"
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-2019 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
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. This document may be used as a tutorial for new programmers or as a quick reference for experienced programmers.
In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.
SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the Contact or Feedback section of this document.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the icon.
Explore 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 that are used to interpret the results of accessing VSAM data sets and/or QSAM files.
Internet Access Required
The following links will require an internet connect.
This suite of programs and documentation is available 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 for access to white papers, program examples and product information. This link requires an Internet Connection
Explore The Micro Focus Web Site for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Contact or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
| 1. | Send an e-mail to our helpdesk. |
| 1.1. | helpdesk@simotime.com. |
| 2. | Our telephone numbers are as follows. |
| 2.1. | 1 415 763-9430 office-helpdesk |
| 2.2. | 1 415 827-7045 mobile |
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Data File Transitions with Transfer, Share, Convert and Compare |
| Copyright © 1987-2024 SimoTime Technologies and Services All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |