Transfer, Share, Convert and Compare
http://www.simotime.com
|
|
Data File
Transitions Transfer, Share, Convert and Compare http://www.simotime.com |
| When technology complements business | Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
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.
For additional information of if you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
This example illustrates the following functions.
| 1. | Demonstrate how to use JCL and IEBGENER
to create an EBCDIC-encoded, sequential file with eighty byte fixed length
records.
|
||||||||||
| 2. | Demonstrate how to use JCL and IDCAMS to
define an EBCDIC-encoded, VSAM, KSDS cluster with 512 byte records.
|
||||||||||
| 3. | Demonstrate how to use JCL and a COBOL
program to read a sequential file, reformat the data (i.e. six byte key to
twelve byte key) and populate an EBCDIC-encoded VSAM, KSDS.
|
||||||||||
| 4. | Demonstrate how to use JCL and a COBOL
program to read the EBCDIC-encoded VSAM, KSDS and produces four-across mailing
labels.
|
||||||||||
| 5. | Demonstrate how to use JCL and IDCAMS and
the REPRO function to read an EBCDIC-encoded VSAM, KSDS and create an
EBCDIC-encoded Sequential File.
|
||||||||||
| 6. | Describe how to use FTP from a Windows
System to transfer the EBCDIC-encoded sequential file in BINARY mode from the
Mainframe System to a Windows System.
|
||||||||||
| 7. | Demonstrate how to do file format and
file content conversion from an EBCDIC-encoded Record Sequential to an
ASCII-encoded VSAM, KSDS. The content conversion must be done at the field
level.
|
||||||||||
| 8. | Demonstrate how to use a COBOL program to
read the ASCII-encoded VSAM, KSDS and produces four-across mailing
labels.
|
||||||||||
| 9. | Demonstrate how to compare two data
files
|
||||||||||
| 10. | Demonstrate how to extract data from a
VSAM, KSDS to a Sequential file with the record structure in a Comma Separated
Values format.
|
This suite of samples programs will run on the following platforms.
| 1. | All of the programs in this example will compile and execute on Windows/XP System using Micro Focus Net Express 5.0 with the Server for Mainframe Migration option. |
| 2. | May be ported to run on the UNIX platforms supported by Micro Focus COBOL. |
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.
This section describes the JCL members (or Mainframe Job Control Language) used in this suite of sample programs.
The following member (CUSC80J1.JCL) is a two (2) step job. The first step will use IEFBR14 with a DD statement to delete a file that was created by a previous execution of this job. The second step will use IEBGENER and in-line data to create a sequential file of 80-byte records with customer information.
//CUSC80J1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Create a Sequential Data Set on disk using IEBGENER. //* Author - SimoTime Enterprises //* Date - January 24, 1996 //* //* The first job step (QSAMDELT) will delete any previously created //* file. The second job step (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* *******qsam* //* * //* * //* ************ //* * 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 Marlow 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) //
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.
//CUDDELJ1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//* Subject: JCL to delete a VSAM Data Set using the IDCAMS Utility *
//* Author: SimoTime Enterprises *
//* Date: January 1, 1998 *
//*-------------------------------------------------------------------*
//* The following example is more than what is usually required to *
//* delete a VSAM Data Set. However, the purpose is to illustrate the *
//* functions of the IDCAMS utility. *
//* PURGE: A VSAM Data Set may be date-protected. The DEFINE Cluster *
//* has the option of specifying a retention date. If this *
//* retention date has not expired then the PURGE option will *
//* be required in order to delete the data set. *
//* The default is NOPURGE. *
//* ERASE: The standard operation by the VSAM DELETE is to delete *
//* the catalog entry of the cluster and mark the space used *
//* by the cluster as reclaimable. The data contents of the *
//* cluster is no longer generally available but it is still *
//* present until the area is reused. This introduces a *
//* potential problem or security exposure for sensitive data.*
//* The information could be retrieved using some special *
//* class of DUMP/RESTORE utilities that are often used by *
//* data center staff. The ERASE function will write over the *
//* data area used by the cluster and the original data is *
//* destroyed. The default is NOERASE. *
//*********************************************************************
//*
// EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE SIMOTIME.DATA.CUSTMAST -
FILE (CUSTMAST) -
PURGE -
ERASE -
CLUSTER
SET MAXCC = 0
/*
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
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2010 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create an empty VSAM, KSDS data set using IDCAMS.
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* This job will create a VSAM, KSDS data set. The key is twelve
//* characters starting at the first position in the record.
//* The record length is 512 characters.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* *******************************************************************
//* Step 1 This is a single step job.
//*
//CUCRTS01 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))
/*
//*
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=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Read 80-Byte input and populate a VSAM, KSDS. //* Author - SimoTime Enterprises //* Date - November 24, 2004 //* Version - 07.01.22 //* //* This job uses a COBOL program to read a sequential file. //* The sequential file is then used as input to update the KSDS. //* //* ******************************************************************* //* Step 1 of 1 Delete previous files. //* //* //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=* //*
The following member (STAMLRJ1.JCL) 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.. 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).
The following member (CUSK2RJ1.JCL) is a two (2) step job. The first step will use IEFBR14 with a DD statement to delete a file that was created by a previous execution of this job. The second step will use IDCAMS and the REPRO function to read the Customer Master File and create a sequential file with the same record structure. and content.
//CUSK2RJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* THIS PROGRAM IS PROVIDED BY: * //* SIMOTIME ENTERPRISES, LLC * //* (C) COPYRIGHT 1987-2010 ALL RIGHTS RESERVED * //* WEB SITE URL: HTTP://WWW.SIMOTIME.COM * //* E-MAIL: HELPDESK@SIMOTIME.COM * //* ******************************************************************* //* //* TEXT - COPY (OR REPRO) A KSDS TO A SEQUENTIAL FILE //* AUTHOR - SIMOTIME ENTERPRISES //* DATE - JANUARY 01, 1989 //* //* ******************************************************************* //* Step 1 of 2 Delete any previously created file... //* //QSAMDELT EXEC PGM=IEFBR14 //SEQ51201 DD DSN=SIMOTIME.DATA.CUSR512,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... //* // EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=A //KSD51201 DD DSN=SIMOTIME.DATA.CUSTMAST,DISP=(SHR) //SEQ51201 DD DSN=SIMOTIME.DATA.CUSR512, // SPACE=(TRK,(10,1),RLSE), // DISP=(NEW,CATLG,DELETE), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //SYSIN DD * REPRO - INFILE(KSD51201) - OUTFILE(SEQ51201) /*
This section describes the CMD or Windows Command Files used in this suite of sample programs.
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
The following member (CUREKAE1.CMD) is the Windows Command File that will use the FTP Utility program to download the EBCDIC-encoded, Record-Sequential file from the Mainframe System to the Windows System.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read EBCDIC Customer Master, write ASCII Customer Master.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The job will read an EBCDIC-encoded Customer Master File and write
rem * write to a new ASCII-encoded Customer Master File.
rem *
rem * ************
rem * * CUREKAE1 *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * Env1PROD *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * SimoNOTE *
rem * ********cmd*
rem * *
rem * *
rem * ************
rem * * RUN *****************************
rem * ********rts* *
rem * * ************ ************ ************
rem * * * CUSRE512 ******* CUREKAC1 ******* CUSKS512 *
rem * * *******rseq* ********cbl* *******ksds*
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Step 1, Set Environment Variables
rem * Delete any previously created ASCII-encoded file...
rem *
call Env1PROD
set CmdName=CUSE2AE1
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep Step-1, Housekeeping tasks"
set CUSRE512=%BaseLib1%\DataLibE\DYN1\SIMOTIME.DATA.CUSR512.DAT
set CUSKS512=%BaseLib1%\DataLibA\Wrk1\SIMOTIME.DATA.CUSKS12.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"
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%
The following member (CUP303E1.CMD) is the Windows Command File that will use a COBOL program to compare the contents of two data files. The files contain records that are defined by the copy file for the Customer Master File (CUSTCB01.CPY).
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read a file of JUSTIFY info, do justify, write output.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The job will read an 80-byte file that contains JUSTIFY
rem * information. The job will also write a file containing the results
rem * of the justify functions..
rem *
rem * *******************************************************************
rem * Step 1 Set the environment...
rem *
call Env1PROD
set CmdName=CUP303E1
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%"
set CUACTUAL=%BaseLib1%\DataLibA\Dyn1\SIMOTIME.DATA.CUSTMAST.DAT
set CUEXPECT=%BaseLib1%\DataLibE\Dyn1\SIMOTIME.DATA.CUSTMAST.DAT
rem *
rem * *******************************************************************
rem * Step 2 Edit input, create a new output file...
rem *
run CUP303C1
if not ERRORLEVEL = 0 set JobStatus=0001
if not %JobStatus% == 0000 goto :EojNok
rem *
:EojAok
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The 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.
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 * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read Customer Master File, write ASCII-Record-Sequential.
rem * Author - SimoTime Enterprises
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 Delete any previously created file...
rem *
call Env1PROD
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"
set CUSTMAST=%BaseLib1%\DataLibA\Dyn1\SIMOTIME.DATA.CUSTMAST.DAT
set CUSTRCSV=%BaseLib1%\DataLibA\Dyn1\SIMOTIME.DATA.CUSTRCSV.DAT
if exist %CUSTRCSV% del %CUSTRCSV%
rem *
rem * *******************************************************************
rem * Step 2 Edit input, create a new output file...
rem *
:ExecuteFileFormatConversion
call SimoNOTE "Identify JobStep ExecuteFileFormatConversion
run CUSCSVC1
echo %errorlevel%
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%
The following member (CUSCSVE2.CMD) is the Windows Command File that will use a COBOL program to read the record sequential file and create a line sequential file with the records structured to a Comma Separated Values format.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Read ASCII-Record-Sequential, write ASCII/Text file.
rem * Author - SimoTime Enterprises
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 Env1PROD
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%\DataLibA\Dyn1\SIMOTIME.DATA.CUSTRCSV.DAT
set Dat01KLS=%BaseLib1%\DataLibA\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%
This section describes the COBOL programs used in this suite of sample programs.
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 ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2007-11-05 Generation Time: 23:39:52:81 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUST0080 SEQUENTIAL FIXED 00080 *
* *
* OUTPUT CUSTMAST INDEXED VARIABLE 00512 00001 *
* 00012 00012 *
* *
* Translation Mode is ASCII to ASCII *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUST0080-FILE ASSIGN TO CUST0080
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CUST0080-STATUS.
SELECT CUSTMAST-FILE ASSIGN TO CUSTMAST
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
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 using the SYSMASK2.TXT file as input.*
* *
* The SYSMASK2 provides for the sequential reading of the input *
* file and the random writing of the output file. *
* *
* If the output file is indexed then the input file does not *
* need to be in sequence by the field that will be used to *
* provide the key for the output file. *
* *
* New records will be added and existing records will be *
* updated. If duplicate keys are provided from the input file *
* then only the information from the last duplicate key record *
* of the input file will be reflected in the output file. *
* *
* This program mask will have the ASCII/EBCDIC table inserted *
* for use by the /TRANSLATE function of SimoZAPS. *
* *
* For additional information contact SimoTime Enterprises. *
* *
* 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 'File Copy and Reformatting, 80/512'.
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 '* CUSI80C1 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 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 CUST0080-RECORD-FOUND pic X value 'N'.
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 CUSTMAST-RECORD-FOUND pic X value 'N'.
01 CUST0080-LRECL pic 9(5) value 00080.
01 CUSTMAST-LRECL pic 9(5) value 00512.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBL512C1 '.
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 CUST0080-TOTAL.
05 CUST0080-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Read count for CUST0080'.
01 CUSTMAST-TOTAL-ADDS.
05 CUSTMAST-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(17) value 'Adds for CUSTMAST'.
01 CUSTMAST-TOTAL-UPDATES.
05 CUSTMAST-UPD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(20) value 'Updates for CUSTMAST'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform CUST0080-OPEN
perform CUSTMAST-OPEN
perform UNTIL CUST0080-EOF = 'Y'
if CUST0080-EOF = 'N'
perform CUST0080-READ
if CUST0080-EOF = 'N'
add 1 to CUST0080-RDR
perform BUILD-OUTPUT-RECORD
perform CUSTMAST-READ
perform BUILD-OUTPUT-RECORD
if CUSTMAST-RECORD-FOUND = 'Y'
add 1 to CUSTMAST-UPD
perform CUSTMAST-REWRITE
else
add 1 to CUSTMAST-ADD
perform CUSTMAST-WRITE
end-if
end-if
end-if
end-perform.
move CUST0080-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-TOTAL-ADDS to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-TOTAL-UPDATES 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 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)
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-REWRITE.
if CUSTMAST-OPEN-FLAG = 'C'
perform CUSTMAST-OPEN
end-if
rewrite 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 'REWRITE 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 I-O 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-READ.
move 'N' to CUSTMAST-RECORD-FOUND
move 'N' to CUSTMAST-EOF
add 12 to ZERO giving APPL-RESULT
read CUSTMAST-FILE
evaluate CUSTMAST-STATUS
when '00' move 'Y' to CUSTMAST-RECORD-FOUND
subtract APPL-RESULT from APPL-RESULT
when '23' move 'N' to CUSTMAST-RECORD-FOUND
subtract APPL-RESULT from APPL-RESULT
when '10' move 'N' to CUSTMAST-RECORD-FOUND
move 'Y' to CUSTMAST-EOF
subtract APPL-RESULT from APPL-RESULT
end-evaluate.
if APPL-AOK
CONTINUE
else
move 'READ Failure with CUSTMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUSTMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUSTMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2007-11-05 Generation Time: 23:39:52:82 *
*****************************************************************
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.
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 ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2007-11-06 Generation Time: 15:44:22:93 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUSRE512 SEQUENTIAL FIXED 00512 *
* *
* OUTPUT CUSKS512 INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* *
* Translation Mode is UNKNOWN *
* *
*****************************************************************
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 using the SYSMASK3.TXT file as the *
* template for the File I/O. It is intended for use with the *
* TransCALL facility that makes a call to a routine that does *
* the actual conversion between EBCDIC and ASCII. For more *
* information or questions contact SimoTime Enterprises. *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* The SYSMASK3 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* If the output file is indexed then the input file must be in *
* sequence by the field that will be used to provide the key *
* for the output file. *
* *
* If the key field is not in sequence then refer to SYSMASK4 *
* to provide for a random add or update of the indexed file. *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CUREKAC1 '.
05 T2 pic X(34) value 'Convert CUSRE512 EBCDIC to ASCII '.
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 '* CUREKAC1 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 CUSRE512-STATUS.
05 CUSRE512-STATUS-L pic X.
05 CUSRE512-STATUS-R pic X.
01 CUSRE512-EOF pic X value 'N'.
01 CUSRE512-OPEN-FLAG pic X value 'C'.
01 CUSKS512-STATUS.
05 CUSKS512-STATUS-L pic X.
05 CUSKS512-STATUS-R pic X.
01 CUSKS512-EOF pic X value 'N'.
01 CUSKS512-OPEN-FLAG pic X value 'C'.
01 CUSRE512-LRECL pic 9(5) value 00512.
01 CUSKS512-LRECL pic 9(5) value 00512.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CUREKAC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 PROGRAM-NAME pic X(8) value 'CUREKAC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 CUSRE512-TOTAL.
05 CUSRE512-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUSRE512'.
01 CUSKS512-TOTAL.
05 CUSKS512-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for CUSKS512'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform CUSRE512-OPEN
perform CUSKS512-OPEN
perform until CUSRE512-STATUS not = '00'
perform CUSRE512-READ
if CUSRE512-STATUS = '00'
add 1 to CUSRE512-RDR
perform BUILD-OUTPUT-RECORD
perform CUSKS512-WRITE
if CUSKS512-STATUS = '00'
add 1 to CUSKS512-ADD
end-if
end-if
end-perform
move CUSRE512-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform CUSKS512-CLOSE
perform CUSRE512-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
*> TransCALL process...
move CUSRE512-REC to CUSKS512-REC
call 'CUREKAR1' using CUSKS512-REC
add 00512 to ZERO giving CUSKS512-LRECL
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
CUSRE512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSRE512-FILE
if CUSRE512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSRE512-READ.
read CUSRE512-FILE
if CUSRE512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSRE512-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to CUSRE512-EOF
else
move 'READ Failure with CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUSRE512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUSRE512-FILE
if CUSRE512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSRE512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUSRE512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSRE512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
CUSKS512-WRITE.
if CUSKS512-OPEN-FLAG = 'C'
perform CUSKS512-OPEN
end-if
write CUSKS512-REC
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSKS512-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'WRITE Failure with CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSKS512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT CUSKS512-FILE
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSKS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSKS512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSKS512-FILE
if CUSKS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CUSKS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with CUSKS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSKS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* 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: 15:44:22:93 *
*****************************************************************
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 ENTERPRISES.
*****************************************************************
* This routine was generated by SimoREC1 *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* Generation Date: 2007/11/06 Generation Time: 15:44:23:10 *
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 IX-1 PIC 9(5) VALUE 0.
01 RM-1 PIC 9(5) VALUE 0.
01 RO-1 PIC 9(5) VALUE 0.
01 IX-2 PIC 9(5) VALUE 0.
01 RM-2 PIC 9(5) VALUE 0.
01 RO-2 PIC 9(5) VALUE 0.
COPY ASCEBCB1.
COPY ASCEBCB2.
*****************************************************************
LINKAGE SECTION.
COPY CUSTCB01.
*****************************************************************
PROCEDURE DIVISION using CUST-RECORD.
inspect CUST-NUMBER converting E-INFO to A-INFO
inspect CUST-STATUS converting E-INFO to A-INFO
inspect CUST-LAST-NAME converting E-INFO to A-INFO
inspect CUST-FIRST-NAME converting E-INFO to A-INFO
inspect CUST-MID-NAME converting E-INFO to A-INFO
inspect CUST-ADDRESS-1 converting E-INFO to A-INFO
inspect CUST-ADDRESS-2 converting E-INFO to A-INFO
inspect CUST-CITY converting E-INFO to A-INFO
inspect CUST-STATE converting E-INFO to A-INFO
inspect CUST-POSTAL-CODE converting E-INFO to A-INFO
inspect CUST-PHONE-HOME converting E-INFO to A-INFO
inspect CUST-PHONE-WORK converting E-INFO to A-INFO
inspect CUST-PHONE-CELL converting E-INFO to A-INFO
* Packed CUST-CREDIT-LIMIT
* Group10 CUST-DISCOUNT occurs 00003 times
* Group 00015
* Table CUST-DISCOUNT-CODE
* Binary CUST-DISCOUNT-CODE
* Table CUST-DISCOUNT-RATE
add 0000306 to ZERO giving RM-1
add 0000015 to ZERO giving RO-1
perform 00003 times
inspect CUST-RECORD(RM-1:00005)
converting E-NUMB to A-NUMB
add RO-1 to RM-1
end-perform
* Table CUST-DISCOUNT-DATE
perform varying IX-1 from 1 by 1 until IX-1 > 00003
inspect CUST-DISCOUNT-DATE(IX-1)
converting E-INFO to A-INFO
end-perform
* Group10 End-Group10
inspect CUST-LADATE converting E-INFO to A-INFO
inspect CUST-LATIME converting E-INFO to A-INFO
* Decimal CUST-TOKEN
inspect CUST-RECORD(365:3) converting E-NUMB to A-NUMB
* Filler A Non-Unique Reference to a Data Item
inspect CUST-RECORD(368:145) converting E-INFO to A-INFO
GOBACK.
The 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 ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2007-11-06 Generation Time: 16:34:57:21 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CUACTUAL INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* OUTPUT CUEXPECT INDEXED VARIABLE 00512 00001 *
* 00512 00012 *
* *
* Translation Mode is UNKNOWN *
* *
*****************************************************************
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 *
* Enterprises. *
* *
* 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 'Data File Content Comparison '.
05 T3 pic X(10) value 'v05.12.23 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CUP303C1 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 CUACTUAL-STATUS.
05 CUACTUAL-STATUS-L pic X.
05 CUACTUAL-STATUS-R pic X.
01 CUACTUAL-EOF pic X value 'N'.
01 CUACTUAL-OPEN-FLAG pic X value 'C'.
01 CUEXPECT-STATUS.
05 CUEXPECT-STATUS-L pic X.
05 CUEXPECT-STATUS-R pic X.
01 CUEXPECT-EOF pic X value 'N'.
01 CUEXPECT-OPEN-FLAG pic X value 'C'.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CUP303C1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 READ-FLAGS.
05 READ-1 pic X value 'Y'.
05 READ-2 pic X value 'Y'.
01 DUMP-FLAGS.
05 DUMP-ASC pic X value 'Y'.
05 DUMP-EBC pic X value 'Y'.
05 DUMP-HEX pic X value 'Y'.
01 COMPARE-STATUS pic XX value 'EQ'.
01 FLAG-EQ pic XX value 'EQ'.
01 FLAG-NE pic XX value 'NE'.
01 FLAG-QT pic XX value 'QT'.
01 DELTA-LINE pic X(1024) value all '-'.
01 PTR-1 pic 9(5) value 0.
01 PTR-2 pic 9(5) value 0.
01 IDX-2 pic 9(5) value 0.
01 DELTA-MAXIMUM-X pic X(5) value '00005'.
01 DELTA-MAXIMUM redefines DELTA-MAXIMUM-X pic 9(5).
01 DELTA-PROCESS pic X(4) value 'EOF '.
01 YES-YES pic XX value 'YY'.
01 N-BYTE pic X value 'N'.
01 Y-BYTE pic X value 'Y'.
01 KEY-ACTIVE pic X value 'Y'.
01 KEY-CONTROL-1.
05 PS-1 pic 9(5) value 00001.
05 LN-1 pic 9(5) value 00012.
01 KEY-CONTROL-2.
05 PS-2 pic 9(5) value 00001.
05 LN-2 pic 9(5) value 00012.
01 CUACTUAL-LRECL pic 9(5) value 00512.
01 LEN-1 pic 9(5) value 128.
01 POS-1 pic 9(5) value 1.
01 CUEXPECT-LRECL pic 9(5) value 00512.
01 LEN-2 pic 9(5) value 128.
01 POS-2 pic 9(5) value 1.
01 D-LEN pic 9(5) value 128.
01 D-POS pic 9(5) value 1.
01 CONTINUE-FLAG pic X value 'Y'.
01 ASC-OR-EBC pic 9(3) comp value 0.
01 ASC-OR-EBC-R redefines ASC-OR-EBC.
05 ASC-A pic X.
05 EBC-A pic X.
* Header row for positional indicator...
01 DUMP-H10.
05 FILLER pic X(5) value '....:'.
05 POS-NO pic 9(5) value 10.
01 DUMP-HEADER pic X(1024) value all '.'.
01 D-P1 pic 9(5) value 0.
01 RECORD-HEADER.
05 RECORD-ID pic X(8) value 'CUACTUAL'.
05 filler pic X(2) value '..'.
05 REC-NUMBER pic 9(9) value 0.
05 filler pic X value '('.
05 RECORD-POS pic 9(5) value 0.
05 filler pic X value ':'.
05 RECORD-LEN pic 9(5) value 0.
05 filler pic X value ')'.
01 BANNER-STARS.
05 filler pic X(128) value all '*'.
01 BANNER-TEXT.
05 filler pic X(2) value '* '.
05 filler pic X(49) value is SPACES.
05 filler pic X(26) value 'Data File Content Compare '.
05 filler pic X(49) value is SPACES.
05 filler pic X(2) value ' *'.
01 INFO-STATEMENT.
05 INFO-SHORT.
10 INFO-ID pic X(8) value 'Starting'.
10 filler pic X(32)
value ' - Data File Content Comparison'.
05 filler pic X(32)
value ' by SimoTime Enterprises, LLC '.
01 CUACTUAL-TOTAL.
05 CUACTUAL-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for CUACTUAL'.
01 CUEXPECT-TOTAL.
05 CUEXPECT-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(25) value 'Record count for CUEXPECT'.
01 COMPARE-NE-TOTAL.
05 COMPARE-NE pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Unequal count'.
01 FORMAT-TYPE pic X value 'B'.
COPY PASSHEX4.
COPY PASSLOGS.
*****************************************************************
PROCEDURE DIVISION.
perform JOB-STARTING
perform
until COMPARE-STATUS = 'QT'
or CUACTUAL-STATUS not = '00'
or CUEXPECT-STATUS not = '00'
if READ-1 = 'Y'
perform CUACTUAL-READ
end-if
if READ-2 = 'Y'
perform CUEXPECT-READ
end-if
if CUACTUAL-STATUS = '00'
and CUEXPECT-STATUS = '00'
move 'EQ' to COMPARE-STATUS
if KEY-ACTIVE = 'Y'
perform COMPARE-KEYS
end-if
if COMPARE-STATUS = FLAG-EQ
perform COMPARE-RECORDS
end-if
if COMPARE-STATUS = FLAG-NE
add 1 to COMPARE-NE
end-if
end-if
if DELTA-PROCESS = 'QUIT'
and COMPARE-NE > DELTA-MAXIMUM
move 'The Not Equal count exceeds Maximum limit...'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
end-perform
perform JOB-FINISHED
GOBACK.
*****************************************************************
COMPARE-RECORDS.
*> Compare...
if CUACTUAL-REC(00001:00303) not = CUEXPECT-REC(00001:00303)
move FLAG-NE to COMPARE-STATUS
if COMPARE-NE < DELTA-MAXIMUM
add 00001 to ZERO giving POS-1
add 00001 to ZERO giving POS-2
add 00303 to ZERO giving LEN-1
add 00303 to ZERO giving LEN-2
add 00303 to ZERO giving PASSHEX4-LENGTH
perform DUMP-PRIMARY-RECORD
perform DUMP-SECONDARY-RECORD
perform DUMP-POSITION-DIFFERENCE
end-if
end-if
exit.
*****************************************************************
COMPARE-KEYS.
move YES-YES to READ-FLAGS
if CUACTUAL-REC(PS-1:LN-1)
< CUEXPECT-REC(PS-2:LN-2)
move N-BYTE to READ-2
end-if
if CUACTUAL-REC(PS-1:LN-1)
> CUEXPECT-REC(PS-2:LN-2)
move N-BYTE to READ-1
end-if
exit.
*****************************************************************
DUMP-TO-LOG.
*> HexDump...
* Dump DD Name, Record-Number, (position,length)
move RECORD-HEADER to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
* DUMP position indicator
perform DUMP-POSITION-INDICATOR
if DUMP-ASC = 'Y'
move PASSHEX4-ASCII(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-HEX = 'Y'
move PASSHEX4-UPPER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move PASSHEX4-LOWER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
if DUMP-EBC = 'Y'
move PASSHEX4-EBCDIC(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
exit.
*****************************************************************
* Build the position header row...
*****************************************************************
DUMP-POSITION-INDICATOR.
add 9 to D-POS giving POS-NO
perform varying D-P1 from 1 by 10 until D-P1 > 1020
move DUMP-H10 to DUMP-HEADER(D-P1:10)
inspect DUMP-HEADER(D-P1 + 5:5)
replacing leading ZEROES by '.'
add 10 to POS-NO
end-perform
move DUMP-HEADER(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-PRIMARY-RECORD.
move SPACES to PASSHEX4-SOURCE
if READ-1 = 'Y'
and CUACTUAL-EOF = 'N'
add POS-1 to ZERO giving RECORD-POS
add LEN-1 to ZERO giving RECORD-LEN
add POS-1 to ZERO giving D-POS
add LEN-1 to ZERO giving D-LEN
move 'CUACTUAL..' to RECORD-ID
add CUACTUAL-RDR to ZERO giving REC-NUMBER
move CUACTUAL-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
else
move 'CUACTUAL..Record is missing from CUACTUAL file'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
exit.
*****************************************************************
DUMP-SECONDARY-RECORD.
move SPACES to PASSHEX4-SOURCE
if READ-2 = 'Y'
and CUEXPECT-EOF = 'N'
add POS-2 to ZERO giving RECORD-POS
add LEN-2 to ZERO giving RECORD-LEN
add POS-2 to ZERO giving D-POS
add LEN-2 to ZERO giving D-LEN
move 'CUEXPECT..' to RECORD-ID
add CUEXPECT-RDR to ZERO giving REC-NUMBER
move CUEXPECT-REC(D-POS:D-LEN) to PASSHEX4-SOURCE
call 'SIMOHEX4' using PASSHEX4-PASS-AREA
perform DUMP-TO-LOG
else
move 'CUEXPECT..Record is missing from CUEXPECT file'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
DUMP-POSITION-DIFFERENCE.
if READ-FLAGS = 'YY'
move all '-' to DELTA-LINE
add POS-1 to ZERO giving PTR-1
add POS-2 to ZERO giving PTR-2
add 1 to ZERO giving IDX-2
perform until IDX-2 > 1024
or IDX-2 > D-LEN
if CUACTUAL-REC(PTR-1:1)
= CUEXPECT-REC(PTR-2:1)
move '=' to DELTA-LINE(IDX-2:1)
else
move '#' to DELTA-LINE(IDX-2:1)
end-if
add 1 to PTR-1
add 1 to PTR-2
add 1 to IDX-2
end-perform
else
move all '#' to DELTA-LINE
end-if
move DELTA-LINE(1:D-LEN) to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move '*' to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
exit.
*****************************************************************
JOB-FINISHED.
perform CUEXPECT-CLOSE
perform CUACTUAL-CLOSE
move 'Summary ' to INFO-ID
move INFO-SHORT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move CUACTUAL-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move CUEXPECT-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if CUACTUAL-RDR not = CUEXPECT-RDR
move 'WARNING! - Record counts are not equal'
to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
end-if
move COMPARE-NE-TOTAL to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if CUACTUAL-EOF = 'Y'
and CUEXPECT-EOF = 'Y'
move 'Finished' to INFO-ID
else
move 'ABENDING' to INFO-ID
end-if
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
if COMPARE-NE > 0
or CUACTUAL-RDR not = CUEXPECT-RDR
add 4 to ZERO giving RETURN-CODE
end-if
exit.
*****************************************************************
JOB-STARTING.
perform Z-POST-COPYRIGHT
perform Z-DETERMINE-ENVIRONMENT
perform CUACTUAL-OPEN
perform CUEXPECT-OPEN
move 'Y' to READ-1
move 'Y' to READ-2
if DELTA-MAXIMUM not numeric
add 100 to ZERO giving DELTA-MAXIMUM
end-if
if PS-1 > 0
and PS-2 > 0
and LN-1 > 0
and LN-2 > 0
move 'Y' to KEY-ACTIVE
move 'Key control is ENABLED...'
to MESSAGE-TEXT
else
move 'N' to KEY-ACTIVE
move 'Key control is NOT enabled...'
to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
move 'DUMP' to PASSHEX4-REQUEST
add 128 to ZERO giving PASSHEX4-LENGTH
move 'NOTE' to SIMOLOGS-REQUEST
move SPACES to SIMOLOGS-MESSAGE
move BANNER-STARS to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move INFO-STATEMENT to SIMOLOGS-MESSAGE
call 'SIMOLOGS' using SIMOLOGS-PASS-AREA
move BANNER-STARS 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-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-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 CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2007-11-06 Generation Time: 16:34:57:25 *
*****************************************************************
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.
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 ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
*****************************************************************
* This base program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* 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 Enterprises, LLC '.
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 Enterprises, LLC '.
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 upon console
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 upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
Z-THANK-YOU.
display SIM-THANKS-01 upon console
display SIM-THANKS-02 upon console
exit.
*****************************************************************
* This program is provided by: *
* SimoTime Enterprises, LLC *
* (C) Copyright 1987-2010 All Rights Reserved *
* Web Site URL: http://www.simotime.com *
* e-mail: helpdesk@simotime.com *
*****************************************************************
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 ENTERPRISES.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 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 Enterprises. *
* *
* 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 Enterprises, LLC'.
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 Enterprises *
* 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 *
*****************************************************************
This section provides additional detail about application build process.
Compiler directives may be individually specified in the source code of a COBOL program, as part of a Net Express project or grouped together in a directives file that may be referenced by the project or command that is doing the compile. This suite of examples uses directives files, one for the batch environment and one for the on-line environment.
| Batch
Directives OS390AscBatch.DIR |
Online
Directives OS390AscOnline.DIR |
| DIALECT"OS390" | DIALECT"OS390" |
| CHARSET"ASCII" | CHARSET"ASCII" |
| ASSIGN"EXTERNAL" | CICSECM() |
| IBMCOMP | IBMCOMP |
| NOTRUNC | NOTRUNC |
| HOSTNUMMOVE | HOSTNUMMOVE |
| HOSTNUMCOMPARE | HOSTNUMCOMPARE |
| NOSIGNFIXUP | NOSIGNFIXUP |
| HOSTARITHMETIC | HOSTARITHMETIC |
| CHECKNUM | CHECKNUM |
| ANIM | ANIM |
| NOOPTIONAL-FILE | outdd"SYSOUT 132 L" |
| outdd"SYSOUT 132 L" | SHARE-OUTDD |
| SHARE-OUTDD | DATAMAP |
| DATAMAP | settings |
| settings | LIST() |
| LIST() | NOFORM |
| NOFORM |
Note: the NOFORM directive must follow the LIST() directive. The LIST directive will set FORM"60".
Note: the NOFORM directive must follow the LIST() directive. The LIST directive will set FORM"60".
When the NOFORM directive is used the listing will be created without print carriage control and page headers. This makes for easier viewing from the screen and produces a listing file with the included copy files. This listing file could be renamed with a .CBL extension and compiled.
A command file (Env1PROD.CMD 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.
rem * *******************************************************************
rem * Set the commonly used environment variables. This is used to
rem * provide a single point for managing the commonly used environment
rem * variables.
rem *
set BaseLib1=c:\SimoSAM1
set SYSLOG=%BaseLib1%\LOGS\SYSLOG_USER.TXT
set SimoNOTE=%BaseLib1%\LOGS\SIMONOTE_USER.TXT
call SimoNOTE "*"
rem *
set SYSOUT=%BaseLib1%\LOGS\SYSOUT_USER.TXT
set LRSTOKEN=%BaseLib1%\DataLibA\Txt1\LRSTOKEN.TXT
set CobCpy=%BaseLib1%\CobCpy1;c:\SimoLIBR
rem *
rem * set MFTRACE_CONFIG=%BaseLib1%\LOGS\TRACE001\ctfrtsfs.cfg
rem * set MFTRACE_LOGS=%BaseLib1%\LOGS\TRACE001
rem *
rem * The following SORTSPACE of 1 gigabyte is used when sorting very
rem * large files. The value is the digit one (1) followed by nine (9)
rem * zeroes. To allocate this amount of memory for sorting requires a
rem * minimum of two (2) gigabytes of RAM.
rem set SORTSPACE=1000000000
rem *
rem * For large file support and record locking control of File Handler
set EXTFH=%BaseLib1%\SysLibA1\EXTFH4AE.CFG
rem * Set environment for MFBSI (Micro Focus Batch Scheduling Interface)
set ES_EMP_EXIT_1=mfbsiemx
set MFBSI_DIR=%BaseLib1%\BSIA\%ezServerName%
set MFBSIEOP_CMD=ENABLE
set MFBSIEOP_CSV=ENABLE
rem *
rem * The following is used to map the location of files that are to be
rem * allocated using JCL with ES/MTO.
set ES_ALLOC_OVERRIDE=%BaseLib1%\SysLibA1\CatMapA1.cfg
rem *
rem * Set the environment for Core Dump on System error, CBLCORE file
rem set COBCONFIG_=%BaseLib1%\SysLibA1\Diagnose.CFG
set COBCONFIG_=
rem *
rem * Specify the location of the IDY files when animating
set COBIDY=%BaseLib1%\COBOL
rem *
rem * The following may need to be adjusted based on individual systems
rem * and the various versions of the Operating System, Sub-Systems and
rem * other software.
if "%ENV1PROD%" == "Y" goto :NOPATH
set iexplore=C:\Program Files\Internet Explorer
set path="C:\Program Files\Micro Focus\Net Express 5.0\Base\";"C:\Program Files\Micro Focus\Net Express 5.0\Base\bin";%PATH%;
rem set path="C:\Program Files\Micro Focus\Server 5.0\Base\";"C:\Program Files\Micro Focus\Server 5.0\Base\bin";%PATH%;
:NOPATH
set cobpath=%BaseLib1%\ProdLibA;%BaseLib1%\ProdLibA\UTIL;c:\SimoLIBR
set JobStatus=0000
set StepStatus=0000
set ENV1PROD=Y
call SimoNOTE "BaseLib1 is %BaseLib1%"
The following is a listing of the contents of the (SimoNOTE.CMD) command file.
@echo OFF rem * ******************************************************************* rem * This program is provided by: * rem * SimoTime Enterprises, LLC * rem * (C) Copyright 1987-2010 All Rights Reserved * rem * Web Site URL: http://www.simotime.com * rem * e-mail: helpdesk@simotime.com * rem * ******************************************************************* rem * rem * Text - Display message on screen and write to a log file. rem * Author - SimoTime Enterprises rem * rem * This script may be called from other scripts and expects a rem * single parameter enclosed in double quotes. The double quotes rem * will be removed. Before writing to the log file a date and time rem * stamp 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
The purpose of this suite of programs is to provide examples for transferring, sharing, converting and comparing various formats of a Customer Master File.
Permission to use, copy, modify and distribute this software for any commercial purpose requires a fee to be paid to SimoTime Enterprises. Once the fee is received by SimoTime the latest version of the software will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
Permission to use, copy, modify and distribute this software for a non-commercial purpose and without fee is hereby granted, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software.
You may download this example at
http://www.simotime.com/sim4dzip.htm#datcyc01
or view the complete list of SimoTime Examples at
http://www.simotime.com/sim4dzip.htm.
Note: You must be attached to the Internet to download a Z-Pack or view the list.
The batch application that prints the mailing labels or the on-line maintenance program for the Customer Master File may be downloaded as separate examples from the SimoTime Web Site.
The SimoMODS Z-Pack is a package of commonly used or shared members that are used by other sample programs available from SimoTime Enterprises. This package may be downloaded for educational and evaluation purposes. A valid license should be obtained from SimoTime Enterprises if the members are deployed or used for any other purpose.
Most of the COBOL programs used in this suite of sample programs were generated using the SimoZAPS and SimoREC1 technologies. The SimoZAPS Utility Program has the capability of generating a COBOL program that will do the conversion of sequential and VSAM (KSDS) files between EBCDIC and ASCII. SimoZAPS can also read a sequential file in EBCDIC format and create an ASCII/CRLF file or VSAM KSDS file in ASCII format. The conversion tables may be viewed or modified to meet unique requirements. The Hexcess/2 function provides the capability of viewing, finding or patching the contents of a file in hexadecimal.
This item will provide a link to an ASCII or EBCDIC translation table. A column for decimal, hexadecimal and binary is also included.
Check out The VSAM - QSAM Connection for more examples of mainframe VSAM and QSAM accessing techniques and sample code.
This document provides a quick summary of the File Status Key for VSAM data sets and QSAM files.
Check out The SimoTime Library for a wide range of topics for Programmers, Project Managers and Software Developers.
To review all the information available on this site start at The SimoTime Home Page .
Check out The SimoTime Glossary for a list of terms and definitions used in the documents provided by SimoTime.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
We appreciate your comments and feedback.
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complimentary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |
| Version 06.11.01 |