Micro Focus Server
http://www.simotime.com
|
|
Populate
the Catalog Micro Focus Server http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
When doing an "application migration" or "transferring and sharing data" between a Mainframe System and a Windows System with Micro Focus Server it can be a challenge to create and populate the Server Catalog entries for Data Files, Partitioned Data Sets and GDG Base Definitions. This document describes a possible solution to this challenge.
The process described in this document was originally intended to automate the creation of a catalog and the rebuilding of a suite of data files to be used for Quality Assurance and System Testing of a migrated mainframe application executing on a Windows platform with a Micro Focus Server. The process starts with a list of files in an Excel spreadsheet. The spreadsheet is saved as a Line Sequential (LSEQ) file with the records formatted as a text string of Comma-Separated-Values (CSV).
Note: Line Sequential or LSEQ is another term used to reference an ASCII/Text File.
| Step | Description | ||||
| 1. | Using a Windows Command file
(CATPOPE1.CMD) do the following tasks.
|
||||
| 2. | Submit a job (CATPOPJ2.JCL) to read the Record Sequential (RSEQ) file with CSV formatted records and write to a Record Sequential (RSEQ) file with a Fixed-Field Record Format. | ||||
| 3. | Submit a job (CATPOPJ3.JCL) to create the catalog entries for the Partitioned Data Set (PDS or DSORG=PO) with the JCL Members. This is required in order to submit jobs to the Internal Reader (INTRDR). | ||||
| 4. | Submit a job (CATPOPJ4.JCL) to read the Record Sequential (RSEQ) file with fixed fields and for each active record submit a job to the internal reader (INTRDR) of the Micro Focus Server that will define a cluster for a VSAM Data Set or create a catalog entry for a Sequential File or PDS. This job provides for user defined jobs and job override capability. |
The preceding items are discussed in more detail in the following sections of this document. Step 4 uses standard Mainframe JCL that is generated based on the information supplied in the "List of Files" file. This generated JCL is then submitted to the internal reader. When a file allocation process such as this is executed it is a good practice to backup any data files. This sample process should be executed to create the catalog entries prior to downloading or copying the data files.
In the world of programming there are many ways to solve a problem. This suite of programs is provided as a COBOL programming example of one of the possible solutions to the problem of moving and sharing data in an application migration or data sharing environment. This example may serve as a tutorial for new programmers and as a reference for experienced programmers. Additional information is provided in the Downloads and Links to Similar Pages section of this document.
The following is the column structure for an Excel spreadsheet to be used as a startting point to populate the catalog.
| Column | Column Header | Description |
| A | Level Number | This should be a "1" for the primary file definition information. |
| B | DSN | This is a forty-four (44) byte text string that is the fully-qualified MVS Data Set Name (DSN) or VSAM Cluster Name |
| C | DD Name | This is the eight (8) character DD Name. |
| D | DSORG | This is the Data Set Organization. |
| E | RECFM | This is the Record Format. |
| F | lrecl-MIN | This is a five (5) digit field for the minimum or average record length. |
| G | lrecl-MAX | This is a five (5) digit field for the maximum record length. |
| H | KeyPos | This is a five (5) digit field for the key starting position. The first position in a record is 1 |
| I | KeyLen | This is a five (5) digit field for the length of the key. |
| J | VSAM Data Name | This is a forty-four (44) byte text string that is the VSAM Data Name for KSDS and ESDS |
| K | VSAM Index Name | This is a forty-four (44) byte text string that is the VSAM Index Name for KSDS |
| L | Override Job | This is an eight (8) byte JCL Member name that will be used to override the generated JCL that is used to create the catalog entry. |
| M | User Job 1 | This is an eight (8) byte JCL Member name for a job that will be submitted to the internal reader after the catalog creation process is complete. |
| N | User Job 2 | This is an eight (8) byte JCL Member name for a job that will be submitted to the internal reader after the previous steps are completed. |
Thie following COBOL Copy File (CATPOPB1.CPY) shows the record layout for the Record Sequential File with a Fixed Field Format..
*****************************************************************
* Copy File for a List of Files. *
*****************************************************************
*
01 FINFO-WS-RECORD.
05 FINFO-WS-LEVEL-CHR.
10 FINFO-WS-LEVEL-NBR PIC 9(2).
05 FINFO-WS-FILE-INFO.
10 FINFO-WS-DSN PIC X(54).
10 FINFO-WS-DD-NAME PIC X(17).
10 FINFO-WS-DSORG PIC X(4).
10 FINFO-WS-RECFM PIC X(4).
10 FINFO-WS-LRECL-MIN PIC 9(5).
10 FINFO-WS-LRECL-MAX PIC 9(5).
10 FINFO-WS-KEYPOS PIC 9(5).
10 FINFO-WS-KEYLEN PIC 9(5).
10 FINFO-WS-VSAM-DAT PIC X(44).
10 FINFO-WS-VSAM-IDX PIC X(44).
05 FINFO-WS-JOB-INFO.
10 FINFO-WS-JCL-OVR1 PIC X(8).
10 FINFO-WS-JCL-USR1 PIC X(8).
10 FINFO-WS-JCL-USR2 PIC X(8).
05 FILLER PIC X(299).
* CATPOPB1 - End-of-Copy File...
When doing an "application migration" or "transferring and sharing data" between a Mainframe System and a Windows System with Micro Focus Server it can be a challenge to create and populate the Server Catalog entries and make this a repeatable process. This document describes a possible solution to this challenge. The process described in this document starts with a list of files in an Excel spreadsheet. The spreadsheet is saved as a Line Sequential (LSEQ) file with the records formatted as a text string of Comma-Separated-Values (CSV).
Note: Line Sequential or LSEQ is another term used to reference an ASCII/Text File.
The flowcharts in this example use the following color coding schemes. The blue boxes are unique to the mainframe or Micro Focus Mainframe Express (MFE). The red boxes are unique to the Windows platform using Micro Focus Net Express. The COBOL members (identified by the green box) are coded to the ANSI/85 standard and run on an IBM Mainframe (with MVS or OS/390) or Windows (with Micro Focus COBOL).
This WIndows Command File and COBOL program (CATPOPE1.CMD and L2R00512.CBL) will read a Line Sequential file and reproduce the record content to a Record Sequential file. The data in each record is treated as a 512-byte text string with trailing spaces. For this example each record represents a row from an Excel spreadsheet that has been saved in a Comma-Separated-Value (or CSV) format. Once the file has been converted the (CATPOPJ1.JCL) is submitted to the SImoBatA server to create a catalog entry for the Record Sequential file. Once the list of files has been stored in a Record Sequential file the remaining steps to populate the catalog can be done using standard mainframe jobs (JCL) and COBOL programs compiled with a mainframe dialect.
This is the 1st phase or step of the bootstrap or preparation process for populating a catalog
|
Start the Job | ||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|
|
|
|
Delete previously created file then copy Excel CSV file to RSEQ file with CSV format for records. | ||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|
|
Submit job to SimoBatA server to create a Catalog Entry for FPRCSVD1 | ||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
End-of-Job | ||||||||||||||||||||||||||
This job (CATPOPJ2.JCL and CATPOPC2.CBL) will read the Record Sequential file of 512-byte fixed length records and convert the Comma-Separated fields to fixed field records.
This is the 2nd phase or step of the bootstrap or preparation process for populating a catalog
|
Submit the Job to the SimoBatA Server | ||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|
|
Delete previously created file. | ||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|
|
|
|
Copy RSEQ file with CSV text string to RSEQ file with Fixed-Field format. | ||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
End-of-Job | ||||||||||||||||||||||||||
This job (CATPOPJ3.JCL) will create PDS entries in the catalog for the SimoBatA Server. This PDS is required prior to executing the jobs that are submitted to the INTRDR .
This is the 3rd and last phase or step of the bootstrap or preparation process for populating a catalog
|
Submit the Job to the SimoBatA Server | ||||||||||||||
|
|
|||||||||||||||
|
|
|
Create and catalog the PDS for JCL Members. | ||||||||||||
|
|
|||||||||||||||
|
End-of-Job | ||||||||||||||
The job and COBOL program (CATPOPJ4.JCL and CATPOPC1.CBL) will read the record sequential file and submit a programatically created job to the internal reader (INTRDR) of the Micro Focus Server that will define a cluster for a VSAM Data Set or create a catalog entry for a Sequential File. This job provides for user defined jobs and job override capability.
This is the 1st and only phase or step that does the actual population of the catalog.
|
Submit the Job to the SimoBatA Server | ||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
|
|
|
|
Submit Jobs to the Internal Reader | ||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||
|
End-of-Job | ||||||||||||||||||||||||||
There are two (2) Windows Command files provided with this suite of sample programs. The 1st Command file is used to execute the four steps that are necessary to take a list of file information from an Excel spreadsheet and create catalog entries in a Micro Focus Server (SimoBatA) for each row of file information.
The 2nd Command file (referred to as the Bootstrap or Preparation script) will execute the sample programs that will convert the Line Sequential file with CSV formatted records to a Record Sequential file with a single text sring in CSV format. After converting the file this command will submit a job to the Micro Focus Server (SimoBatA) to make a catalog entry for the Record Sequential File.
The following is the Windows Command file (ezCATPOP.CMD) that will execute the jobs required to populate an empty catalog for a Micro Focus Server (SimoBatA). The command will first call
@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 - An example, populating a catalog for a Micro Focus Server.
rem * Author - SimoTime Enterprises
rem * Date - June 24, 2007
rem *
rem * *******************************************************************
rem * Step 1 of 5, Prepare Environment, Delete a previously created file.
rem *
set JobName=ezCATPOP
call ezPROD01 %JobName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%JobName%"
call SimoNOTE "Starting JobName %JobName%"
rem *
rem * *******************************************************************
rem * Step 2 of 5, Create and Catalog the FILEC512 file.
rem *
call SimoNOTE "Starting JobStep Create and Catalog the FILEC512 file."
call CATPOPE1 nopause
rem *
rem * *******************************************************************
rem * Step 3 of 5, Convert FILEC512 to FILELIST.
rem *
call SimoNOTE "Starting JobStep Convert FILEC512 to FILELIST."
call ezSCHEDULE SimoBatA CATPOPJ2
rem *
rem * *******************************************************************
rem * Step 4 of 5, Catalog a PDS needed to complete the process.
rem *
call SimoNOTE "Starting JobStep Catalog a PDS needed to complete the process."
call ezSCHEDULE SimoBatA CATPOPJ3
rem *
rem * *******************************************************************
rem * Step 5 of 5, Create the catalog entries based on the information
rem * provided in FILELIST.
rem *
call SimoNOTE "Starting JobStep Create the catalog entries from FILELIST info."
call ezSCHEDULE SimoBatA CATPOPJ4
call SimoNOTE "Finished JobName %JobName%"
The following is the Windows Command file (CATPOPE1.CMD) that is required to run as a job on a Windows System with Micro Focus Net Express. This command will convert the Line Sequential file with CSV formatted records to a Record Sequential file with a single text sring in CSV format. After converting the file this command will submit a job to the Micro Focus Server (SimoBatA) to make a catalog entry for the Record Sequential File. This command and some of the programs use a syntax or dialect that is unique to Windows and/or Micro Focus. After this process is executed the remaining steps can be accomplished using JCL and standard mainframe COBOL dialects.
@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 - Convert LSEQ0512 to RSEQ0512.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * The job will reproduce an LSEQ file of variable length records to
rem * an RSEQ file of 512-byte fixed length records.
rem *
rem * ************
rem * * CATPOPE1 *
rem * ********cmd*
rem * *
rem * ************ ************
rem * * If Exist *-----* RSEQ0512 * DISP=DELETE
rem * ********cbl* *******rseq*
rem * *
rem * ************ ************ ************
rem * * LSEQ0512 *-----* L2R00512 *-----* RSEQ0512 *
rem * *******lseq* ********cbl* *******rseq*
rem * *
rem * ************ ************
rem * * CATPOPJ1 *-----* RSEQ0512 * DISP=CATLG
rem * ********jcl* *******rseq*
rem * *
rem * ************
rem * * EOJ *
rem * ************
rem *
rem *
rem * *******************************************************************
rem * Step 1 of 3, Prepare Environment, Delete a previously created file.
rem *
set CmdName=CATPOPE1
call ezPROD01 %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%"
:DeleteQSAM
call SimoNOTE "StepInfo Map File Names, Delete previously created file"
set LSEQ0512=%DataLib1%\Txt1\SIMOTIME.DATA.EXCELCSV.CSV
set RSEQ0512=%DataLib1%\Dyn1\SIMOTIME.DATA.FILEC512.DAT
if exist %RSEQ0512% del %RSEQ0512%
rem *
rem * *******************************************************************
rem * Step 2 of 3, Convert the Line Sequential File to a Record
rem * Sequential file with CSV formatted records.
rem * Note: This step will only do File Format conversion. The file
rem * content (format of records such as field structure and encoding
rem * schemas) is not changed.
rem *
call SimoNOTE "StepInfo Execute the File Format Conversion"
run L2R00512
if not ERRORLEVEL = 0 set JobStatus=0010
if not %JobStatus% == 0000 goto :EojNok
call SimoNOTE "DataTake %LSEQ0512%"
call SimoNOTE "DataMake %RSEQ0512%"
rem *
rem * *******************************************************************
rem * Step 3 of 3, Define a Catalog entry for SIMOTIME.DATA.FILEC512
rem * in the Catalog for the SimoBatA Server.
rem * Note: This step requires the SimoBatA Server to be started.
rem *
call SimoNOTE "StepInfo Define a Catalog entry for SIMOTIME.DATA.FILEC512"
call ezSCHEDULE SimoBatA CATPOPJ1
if not ERRORLEVEL = 0 set JobStatus=0030
if not %JobStatus% == 0000 goto :EojNok
rem *
if exist %RSEQ0512% goto :EojAok
set JobStatus=0020
goto :EojNok
:EojAok
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
if not "%1" == "nopause" pause
There are four (4) JCL members provided with this suite of sample programs. The following describes each of the members in more detail.
The following is the JCL Member (CATPOPJ1.JCL) that will create the catalog entry for the Record Sequential file that contains 512 byte records that are formatted as a text string of Comma-Separated-Values (or CSV format). The rightmost positions of the record will be padded with spaces.
//CATPOPJ1 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 catalog entry for an RSEQ0512 Sequential file. //* Author - SimoTime Enterprises //* Date - January 24, 1996 //* //* ******************************************************************* //* Step 1, Create a Catalog Entry for the FILEC512. This is the file //* with records of a single text string of 512 bytes. The text //* string is variable lengths fields separated by a comma. //* The records are padded with trailing spaces. //* //EXECC512 EXEC PGM=IEFBR14 //FILEC512 DD DSN=SIMOTIME.DATA.FILEC512,DISP=(NEW,CATLG,CATLG), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //*
The following is the JCL member (CATPOPJ2.JCL) that will convert the CSV formatted file to a file with fixed-field length. This will allow the remaining steps of the process to use standard COBOL dialect and processing techniques.
//CATPOPJ2 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 - Copy RSEQ file with record content reformatting. //* Author - SimoTime Enterprises //* Date - January 24, 1996 //* //* The job will read a 512-byte file that contains CSV formatted text //* strings. The program will write records to a new file in a fixed //* field format. //* //* This set of programs will run on a mainframe under MVS or on a //* Personal Computer with Windows and Micro Focus Mainframe Express. //* //* ************ //* * CATPOPJ2 * //* ********jcl* //* * //* ************ //* * IEFBR14 * //* ********utl* //* * //* ************ ************ ************ //* * FILEC512 *-----* CATPOPC2 *-----* FILELIST * //* *******rseq* ********cbl* *******rseq* //* * * //* * * ************ //* * *-call--* SIMOPARS * //* * ********cbl* //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 Delete a previously created file. //* //TOSSFILE EXEC PGM=IEFBR14 //PUTRS512 DD DSN=SIMOTIME.DATA.FILELIST,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //* //* ******************************************************************* //* Step 2 Create a new file with fixed-field format... //* //MAKE0512 EXEC PGM=CATPOPC2 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //GETRS512 DD DSN=SIMOTIME.DATA.FILEC512,DISP=SHR //PUTRS512 DD DSN=SIMOTIME.DATA.FILELIST, // DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=512,DSORG=PS) //SYSOUT DD SYSOUT=* //
The following is the JCL member (CATPOPJ3.JCL) that will create the catalog entry for the PDS that contains the JCL members. This is necessary in order to be able to use a COBOL program to submit jobs to the Interal Reader.
//CATPOPJ3 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1, // COND=(0,LT) //* ******************************************************************* //* 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: Define a PDS using the IEFBR14 with a DD Statement //* Author: SimoTime Enterprises //* Date: January 1,1998 //* //* Technically speaking, IEFBR14 is not a utility program because it //* does nothing. The name is derived from the fact that it contains //* two assembler language instruction. The first instruction clears //* register 15 (which sets the return code to zero) and the second //* instruction is a BR 14 which performs an immediate return to the //* operating system. //* //* IEFBR14's only purpose is to help meet the requirements that a //* job must have at least one EXEC statement. The real purpose is to //* allow the disposition of the DD statement to occur. //* //* For example, the following DISP=(NEW,CATLG) will cause the //* specified DSN (i.e. PDS) to be allocated. //* Note: a PDS may also be referred to as a library. //********************************************************************* //* //IEFBR14 EXEC PGM=IEFBR14 //MAKEPARM DD DISP=(NEW,CATLG),DSN=SIMOTIME.PDS.JCL, // STORCLAS=MFI, // SPACE=(TRK,(45,15,50)), // DCB=(RECFM=LSEQ,LRECL=80,DSORG=PO) //*MFE: %PCDSN=C:\SIMOSAM1\JCL\*.JCL //*
The following is the JCL member (CATPOPJ4.JCL) that will submit jobs to create a catalog entry based in the information in each record of the file list..
//CATPOPJ4 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 - Read a file containing a list of file definitions. //* Author - SimoTime Enterprises //* Date - January 24, 1996 //* //* The job will read a file with 512-byte records that contains file //* information. A catalog entry will be created based on the content //* of each record in the file. //* //* This set of programs will run on a mainframe under MVS or on a //* Personal Computer with Windows and Micro Focus Mainframe Express. //* //* ************ //* * CATPOPJ4 * //* ********jcl* //* * //* ************ ************ ************ //* * FILELIST *-----* CATPOPC1 *-----* SUBTORDR * //* *******rseq* ********cbl* ********dat* //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 Submit a job to the INTRDR based on record content... //* //MAKE0512 EXEC PGM=CATPOPC1 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //FILELIST DD DSN=SIMOTIME.DATA.FILELIST,DISP=SHR //SUBTORDR DD SYSOUT=(,INTRDR) //SYSOUT DD SYSOUT=* //
The suite of sample programs uses the following two (2) COBOL programs in the process of creating catalog entryies for the Micro Focus Server.
This program (CATPOPC1.CBL) will read a file that is a list if files. For each record in the file a job will be submitted to the internal reader to create a catalog entry for the specified file.
IDENTIFICATION DIVISION.
PROGRAM-ID. CATPOPC1.
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 program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
* MAINTENANCE
* -----------
* 1994/02/27 Simmons, Created program.
*
*****************************************************************
* Source Member: CATPOPC1.CBL
* Copy Files: none...
* Calls to: none...
*****************************************************************
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT FILELIST SEQUENTIAL FIXED 00512 *
* OUTPUT SUBTORDR SEQUENTIAL FIXED 00080 *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILELIST-FILE ASSIGN TO FILELIST
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FILELIST-STATUS.
SELECT SUBTORDR-FILE ASSIGN TO SUBTORDR
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SUBTORDR-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD FILELIST-FILE
DATA RECORD IS FILELIST-REC
.
01 FILELIST-REC.
05 FILELIST-DATA-01 PIC X(00512).
FD SUBTORDR-FILE
DATA RECORD IS SUBTORDR-REC
.
01 SUBTORDR-REC.
05 SUBTORDR-DATA-01 PIC X(00080).
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CATPOPC1 '.
05 T2 pic X(34) value 'A COBOL Program, Submit to INTRDR '.
05 T3 pic X(10) value ' v08.06.23'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CATPOPC1 '.
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 FILELIST-STATUS.
05 FILELIST-STATUS-L pic X.
05 FILELIST-STATUS-R pic X.
01 FILELIST-EOF pic X value 'N'.
01 FILELIST-OPEN-FLAG pic X value 'C'.
01 SUBTORDR-STATUS.
05 SUBTORDR-STATUS-L pic X.
05 SUBTORDR-STATUS-R pic X.
01 SUBTORDR-EOF pic X value 'N'.
01 SUBTORDR-OPEN-FLAG pic X value 'C'.
01 FILELIST-LRECL pic 9(5) value 00512.
01 SUBTORDR-LRECL pic 9(5) value 00080.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CATPOPC1 '.
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 'CATPOPC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 CHANGE-JOB-CLASS pic X value 'Y'.
01 CHR-05.
05 NBR-05 pic 9(5) value 0.
01 JOB-CARD.
05 FILLER pic X(2) value '//'.
05 JOB-NAME pic X(8) value '&&&&&&&&'.
05 FILLER pic X(5) value ' JOB '.
05 JOB-ACCT pic X(8) value 'SIMOTIME'.
05 FILLER pic X(7) value ',CLASS='.
05 JOB-CLASS pic X value '1'.
05 FILLER pic X(10) value ',MSGCLASS='.
05 JOB-MSGCLASS pic X value '0'.
05 FILLER pic X(8) value ',NOTIFY='.
05 JOB-NOTIFY pic X(8) value 'CSIP1 '.
05 FILLER pic X(22) value SPACES.
01 DD-CARD.
05 FILLER pic X(2) value '//'.
05 DD-CARD-NAME pic X(8) value '&&&&&&&&'.
05 FILLER pic X value SPACE.
05 FILLER pic X(2) value 'DD'.
05 FILLER pic X(2) value SPACES.
05 FILLER pic X(4) value 'DSN='.
05 DD-CARD-DSN pic X(44) value SPACES.
01 SUBTORDR-CARD.
05 FILLER pic X(10) value '//SUBTORDR'.
05 FILLER pic X value SPACE.
05 FILLER pic X(2) value 'DD'.
05 FILLER pic X(2) value SPACES.
05 FILLER pic X(17) value 'SYSOUT=(*,INTRDR)'.
01 SYSOUT-CARD.
05 FILLER pic X(10) value '//SYSOUT '.
05 FILLER pic X value SPACE.
05 FILLER pic X(2) value 'DD'.
05 FILLER pic X(2) value SPACES.
05 FILLER pic X(8) value 'SYSOUT=*'.
01 JCLINPUT-CARD.
05 FILLER pic X(10) value '//JCLINPUT'.
05 FILLER pic X value SPACE.
05 FILLER pic X(2) value 'DD'.
05 FILLER pic X(2) value SPACES.
05 FILLER pic X(4) value 'DSN='.
05 FILLER pic X(17) value 'SIMOTIME.PDS.JCL('.
05 JCLINPUT-NAME pic X(8) value '&&&&&&&&'.
01 JCL-COMMENT-DSN.
05 FILLER pic X(4) value '//* '.
05 FILLER pic X(21) value 'Do Catalog Entry for '.
05 JCL-CMT-DSN pic X(44) value SPACES.
01 JCL-COMMENT-OVR.
05 FILLER pic X(4) value '//* '.
05 FILLER pic X(20) value 'Submit Override for '.
05 JCL-CMT-OVR pic X(44) value SPACES.
01 JCL-COMMENT-USR.
05 FILLER pic X(4) value '//* '.
05 FILLER pic X(20) value 'Submit User Job for '.
05 JCL-CMT-USR pic X(44) value SPACES.
01 JCLINPUT-TRAILER pic X(10) value '),DISP=SHR'.
01 DCB-RECFM-FB-DSORG-PS.
05 FILLER pic X(15) value '// '.
05 FILLER pic X(20) value 'DCB=(DSORG=PS,LRECL='.
05 DCB-LRECL-PS pic 9(5) value 80.
05 FILLER pic X(12) value ',RECFM=&&&& '.
01 DCB-RECFM-FB-DSORG-PO.
05 FILLER pic X(15) value '// '.
05 FILLER pic X(20) value 'DCB=(DSORG=PO,LRECL='.
05 DCB-LRECL-PO pic 9(5) value 80.
05 FILLER pic X(12) value ',RECFM=&&&& '.
01 FILELIST-TOTAL.
05 FILELIST-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for FILELIST'.
01 SUBTORDR-TOTAL.
05 SUBTORDR-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for SUBTORDR'.
COPY CATPOPB1.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform FILELIST-OPEN
perform until FILELIST-STATUS not = '00'
perform FILELIST-READ
if FILELIST-STATUS = '00'
add 1 to FILELIST-RDR
perform BUILD-OUTPUT-RECORD
end-if
end-perform
move FILELIST-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SUBTORDR-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 FILELIST-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
if FILELIST-REC(1:2) = '01'
move FILELIST-REC to FINFO-WS-RECORD
if FINFO-WS-JCL-OVR1 not = SPACES
perform SUBMIT-FOR-OVR1
else
evaluate FINFO-WS-DSORG
when 'KS ' perform KSDS-DEFINE-CLUSTER
when 'ES ' perform ESDS-DEFINE-CLUSTER
when 'PS ' perform DSORG-IS-PS
when 'PO ' perform DSORG-IS-PO
when 'GDG ' perform GDG-DEFINE-BASE
when other perform ERROR-DSORG
end-evaluate
end-if
if FINFO-WS-JCL-USR1 not = SPACES
perform SUBMIT-FOR-USR1
end-if
if FINFO-WS-JCL-USR2 not = SPACES
perform SUBMIT-FOR-USR2
end-if
end-if
exit.
*****************************************************************
KSDS-DEFINE-CLUSTER.
perform SUBTORDR-OPEN
move SPACES to SUBTORDR-DATA-01
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01 replacing first '&&&&&&&&'
by 'MAKEKSDS'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-DSN
move JCL-COMMENT-DSN to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//KSDEFINE EXEC PGM=IDCAMS' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSPRINT DD SYSOUT=*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSIN DD *' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move ' DEFINE CLUSTER' to SUBTORDR-DATA-01
move '(NAME(' to SUBTORDR-DATA-01(17:6)
move FINFO-WS-DSN to SUBTORDR-DATA-01(23:44)
inspect SUBTORDR-DATA-01(23:48) replacing first ' ' by ')'
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'TRACKS(45,15)' to SUBTORDR-DATA-01(17:13)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'INDEXED)' to SUBTORDR-DATA-01(17:8)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'DATA (NAME(' to SUBTORDR-DATA-01(12:11)
move FINFO-WS-VSAM-DAT to SUBTORDR-DATA-01(23:44)
inspect SUBTORDR-DATA-01(23:48) replacing first ' ' by ')'
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'KEYS(&&&&&,&&&&&)' to SUBTORDR-DATA-01(17:17)
inspect SUBTORDR-DATA-01(17:17) replacing
first '&&&&&'
by FINFO-WS-KEYLEN
subtract 1 from FINFO-WS-KEYPOS giving NBR-05
inspect SUBTORDR-DATA-01(21:17) replacing
first '&&&&&'
by NBR-05
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'RECORDSIZE(&&&&&,&&&&&)' to SUBTORDR-DATA-01(17:23)
inspect SUBTORDR-DATA-01(17:23) replacing
first '&&&&&'
by FINFO-WS-LRECL-MIN
inspect SUBTORDR-DATA-01(17:23) replacing
first '&&&&&'
by FINFO-WS-LRECL-MAX
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'FREESPACE(10,15)' to SUBTORDR-DATA-01(17:16)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'CISZ(8192))' to SUBTORDR-DATA-01(17:11)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'INDEX (NAME(' to SUBTORDR-DATA-01(11:12)
move FINFO-WS-VSAM-IDX to SUBTORDR-DATA-01(23:44)
inspect SUBTORDR-DATA-01(23:48) replacing first ' ' by '))'
perform INTRDR-WRITE
move '/*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move 'MAKEKSDS' to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
ESDS-DEFINE-CLUSTER.
perform SUBTORDR-OPEN
move SPACES to SUBTORDR-DATA-01
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01 replacing first '&&&&&&&&'
by 'MAKEESDS'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-DSN
move JCL-COMMENT-DSN to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//ESDEFINE EXEC PGM=IDCAMS' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSPRINT DD SYSOUT=*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSIN DD *' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move ' DEFINE CLUSTER(' to SUBTORDR-DATA-01
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'NAME(' to SUBTORDR-DATA-01(15:5)
move FINFO-WS-DSN to SUBTORDR-DATA-01(20:48)
inspect SUBTORDR-DATA-01(27:48) replacing first ' ' by ')'
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'NONINDEXED' to SUBTORDR-DATA-01(15:10)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'SHR (2 3)' to SUBTORDR-DATA-01(15:9)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'CYL (9 9)' to SUBTORDR-DATA-01(15:9)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'VOL(*))' to SUBTORDR-DATA-01(15:7)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'DATA(' to SUBTORDR-DATA-01(12:5)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'NAME(' to SUBTORDR-DATA-01(15:5)
move FINFO-WS-VSAM-DAT to SUBTORDR-DATA-01(20:44)
inspect SUBTORDR-DATA-01(27:48) replacing first ' ' by ')'
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'RECSZ(&&&&&,&&&&&)' to SUBTORDR-DATA-01(15:23)
inspect SUBTORDR-DATA-01(21:23) replacing
first '&&&&&'
by FINFO-WS-LRECL-MIN
inspect SUBTORDR-DATA-01(21:23) replacing
first '&&&&&'
by FINFO-WS-LRECL-MAX
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'CISZ(8192)' to SUBTORDR-DATA-01(15:10)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'FREESPACE(0,0))' to SUBTORDR-DATA-01(15:15)
perform INTRDR-WRITE
move '/*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move 'MAKEESDS' to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
GDG-DEFINE-BASE.
perform SUBTORDR-OPEN
move SPACES to SUBTORDR-DATA-01
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01 replacing first '&&&&&&&&'
by 'MAKEAGDG'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-DSN
move JCL-COMMENT-DSN to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//GDGIDXX1 EXEC PGM=IDCAMS' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSPRINT DD SYSOUT=*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSIN DD *' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move ' DEFINE GDG(' to SUBTORDR-DATA-01
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'NAME(' to SUBTORDR-DATA-01(11:5)
move FINFO-WS-DSN to SUBTORDR-DATA-01(16:48)
inspect SUBTORDR-DATA-01(16:48) replacing first ' ' by ')'
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'LIMIT(003)' to SUBTORDR-DATA-01(11:10)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'NOEMPTY' to SUBTORDR-DATA-01(11:7)
move '-' to SUBTORDR-DATA-01(70:1)
perform INTRDR-WRITE
move 'SCRATCH)' to SUBTORDR-DATA-01(11:8)
perform INTRDR-WRITE
move '/*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move 'MAKEAGDG' to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
SUBMIT-FOR-OVR1.
perform SUBTORDR-OPEN
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by 'MAKEOVR1'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-OVR
move JCL-COMMENT-OVR to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//OVR1EXEC EXEC PGM=CBLSUBC1' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move JCLINPUT-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by FINFO-WS-JCL-OVR1
inspect SUBTORDR-DATA-01
replacing first ' ' by JCLINPUT-TRAILER
perform INTRDR-WRITE
move SUBTORDR-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move SYSOUT-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move FINFO-WS-JCL-OVR1 to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
SUBMIT-FOR-USR1.
perform SUBTORDR-OPEN
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by 'MAKEUSR1'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-USR
move JCL-COMMENT-USR to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//USR1EXEC EXEC PGM=CBLSUBC1' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move JCLINPUT-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by FINFO-WS-JCL-USR1
inspect SUBTORDR-DATA-01
replacing first ' ' by JCLINPUT-TRAILER
perform INTRDR-WRITE
move SUBTORDR-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move SYSOUT-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move FINFO-WS-JCL-USR1 to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
SUBMIT-FOR-USR2.
perform SUBTORDR-OPEN
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by 'MAKEUSR2'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-USR
move JCL-COMMENT-USR to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//USR2EXEC EXEC PGM=CBLSUBC1' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move JCLINPUT-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by FINFO-WS-JCL-USR2
inspect SUBTORDR-DATA-01
replacing first ' ' by JCLINPUT-TRAILER
perform INTRDR-WRITE
move SUBTORDR-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move SYSOUT-CARD to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move FINFO-WS-JCL-USR2 to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
DSORG-IS-PS.
perform SUBTORDR-OPEN
move SPACES to SUBTORDR-DATA-01
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by 'MAKERSEQ'
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-DSN
move JCL-COMMENT-DSN to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//PSDEFINE EXEC PGM=IEFBR14' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSOUT DD SYSOUT=*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move FINFO-WS-DSN to DD-CARD-DSN
move DD-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&&&&&&&&&&'
by FINFO-WS-DD-NAME
inspect SUBTORDR-DATA-01
replacing first ' ' by ', '
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'DISP=(NEW,CATLG,CATLG),' to SUBTORDR-DATA-01(16:23)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'STORCLAS=MFI,' to SUBTORDR-DATA-01(16:13)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'SPACE=(TRK,5),' to SUBTORDR-DATA-01(16:14)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
* DCB=(RECFM=FB,LRECL=80,DSORG=PS)
add FINFO-WS-LRECL-MAX to ZERO giving DCB-LRECL-PS
move DCB-RECFM-FB-DSORG-PS to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01(16:56)
replacing first '&&&&'
by FINFO-WS-RECFM
inspect SUBTORDR-DATA-01(16:56)
replacing first ' '
by ') '
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move 'MAKERSEQ' to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
DSORG-IS-PO.
perform SUBTORDR-OPEN
move SPACES to SUBTORDR-DATA-01
* Create a JOB Card...
move JOB-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&' by 'MAKEPO '
perform INTRDR-WRITE
* Create a JCL Comment Statement.
move FINFO-WS-DSN to JCL-CMT-DSN
move JCL-COMMENT-DSN to SUBTORDR-DATA-01
perform INTRDR-WRITE
* Create an EXEC Statement...
move '//PODEFINE EXEC PGM=IEFBR14' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move '//SYSOUT DD SYSOUT=*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move FINFO-WS-DSN to DD-CARD-DSN
move DD-CARD to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01
replacing first '&&&&&&&&&&&&&&&&&'
by FINFO-WS-DD-NAME
inspect SUBTORDR-DATA-01
replacing first ' ' by ', '
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'DISP=(NEW,CATLG,CATLG),' to SUBTORDR-DATA-01(16:23)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'STORCLAS=MFI,' to SUBTORDR-DATA-01(16:13)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
move 'SPACE=(TRK,5),' to SUBTORDR-DATA-01(16:14)
perform INTRDR-WRITE
move '//' to SUBTORDR-DATA-01(1:2)
* DCB=(RECFM=FB,LRECL=80,DSORG=PS)
add FINFO-WS-LRECL-MAX to ZERO giving DCB-LRECL-PO
move DCB-RECFM-FB-DSORG-PO to SUBTORDR-DATA-01
inspect SUBTORDR-DATA-01(16:56)
replacing first '&&&&'
by FINFO-WS-RECFM
inspect SUBTORDR-DATA-01(16:56)
replacing first ' '
by ') '
perform INTRDR-WRITE
move '//*' to SUBTORDR-DATA-01
perform INTRDR-WRITE
move 'MAKEPDSS' to MESSAGE-TEXT
move FINFO-WS-DSN to MESSAGE-TEXT(10:48)
perform Z-DISPLAY-MESSAGE-TEXT
perform SUBTORDR-CLOSE
exit.
*****************************************************************
ERROR-DSORG.
move FINFO-WS-RECORD(1:50) to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
INTRDR-WRITE.
move SUBTORDR-DATA-01 to MESSAGE-TEXT
perform SUBTORDR-WRITE
if SUBTORDR-STATUS = '00'
add 1 to SUBTORDR-ADD
move SPACES to SUBTORDR-DATA-01
end-if
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
FILELIST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close FILELIST-FILE
if FILELIST-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 FILELIST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move FILELIST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
FILELIST-READ.
read FILELIST-FILE
if FILELIST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if FILELIST-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 FILELIST-EOF
else
move 'READ Failure with FILELIST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move FILELIST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
FILELIST-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input FILELIST-FILE
if FILELIST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to FILELIST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with FILELIST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move FILELIST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
SUBTORDR-WRITE.
if SUBTORDR-OPEN-FLAG = 'C'
perform SUBTORDR-OPEN
end-if
write SUBTORDR-REC
if SUBTORDR-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if SUBTORDR-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 SUBTORDR' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SUBTORDR-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SUBTORDR-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT SUBTORDR-FILE
if SUBTORDR-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SUBTORDR-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with SUBTORDR' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SUBTORDR-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SUBTORDR-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SUBTORDR-FILE
if SUBTORDR-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to SUBTORDR-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with SUBTORDR' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SUBTORDR-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: 2008-04-28 Generation Time: 18:02:52:62 *
*****************************************************************
This program (CATPOPC2.CBL) will convert a Record Sequential file with records that are formatted as a CSV Text string to a file with records that are formatted with Fixed-Field lengths.
IDENTIFICATION DIVISION.
PROGRAM-ID. CATPOPC2.
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: 2008-06-21 Generation Time: 11:44:14:01 *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT GETRS512 SEQUENTIAL FIXED 00512 *
* *
* OUTPUT PUTRS512 SEQUENTIAL FIXED 00512 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GETRS512-FILE ASSIGN TO GETRS512
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS GETRS512-STATUS.
SELECT PUTRS512-FILE ASSIGN TO PUTRS512
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS PUTRS512-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD GETRS512-FILE
DATA RECORD IS GETRS512-REC
.
01 GETRS512-REC.
05 GETRS512-DATA-01 PIC X(00512).
FD PUTRS512-FILE
DATA RECORD IS PUTRS512-REC
.
01 PUTRS512-REC.
05 PUTRS512-DATA-01 PIC X(00512).
*****************************************************************
* 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 '* CATPOPC2 '.
05 T2 pic X(34) value 'Convert ASCII CSV to Fixed Field '.
05 T3 pic X(10) value ' v08.06.24'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CATPOPC2 '.
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 GETRS512-STATUS.
05 GETRS512-STATUS-L pic X.
05 GETRS512-STATUS-R pic X.
01 GETRS512-EOF pic X value 'N'.
01 GETRS512-OPEN-FLAG pic X value 'C'.
01 PUTRS512-STATUS.
05 PUTRS512-STATUS-L pic X.
05 PUTRS512-STATUS-R pic X.
01 PUTRS512-EOF pic X value 'N'.
01 PUTRS512-OPEN-FLAG pic X value 'C'.
01 GETRS512-LRECL pic 9(5) value 00512.
01 PUTRS512-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 '* CATPOPC2 '.
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 'CATPOPC2'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 GETRS512-TOTAL.
05 GETRS512-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for GETRS512'.
01 PUTRS512-TOTAL.
05 PUTRS512-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for PUTRS512'.
01 IX-1 pic 9(5) value 0.
01 ERROR-MESSAGE.
05 ERROR-RECORD pic 9(9) value 0.
05 FILLER pic X(3) value ' - '.
05 ERROR-TEXT pic X(64) value SPACES.
01 WORK-05.
05 WORK-05-NUMERIC pic 9(5) value 0.
01 FLAGS-FOR-ACTION.
05 FLAG-WRITE pic X value 'N'.
COPY CATPOPB1.
COPY PASSPARS.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform GETRS512-OPEN
perform PUTRS512-OPEN
perform until GETRS512-STATUS not = '00'
perform GETRS512-READ
if GETRS512-STATUS = '00'
add 1 to GETRS512-RDR
perform BUILD-OUTPUT-RECORD
if FLAG-WRITE = 'Y'
perform PUTRS512-WRITE
if PUTRS512-STATUS = '00'
add 1 to PUTRS512-ADD
end-if
end-if
end-if
end-perform
move GETRS512-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUTRS512-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 PUTRS512-CLOSE
perform GETRS512-CLOSE
GOBACK.
*****************************************************************
BUILD-OUTPUT-RECORD.
move '0' to PRS-REQUEST
move ',' to PRS-DELIMITER
move 'Y' to PRS-KEEP-NULL-FIELDS
add 512 to ZERO giving PRS-BUFFER-SIZE
move GETRS512-REC to PRS-BUFFER
call 'SIMOPARS' using PRS-PARAMETERS
initialize FINFO-WS-RECORD
add 1 to ZERO giving IX-1
if PRS-POSITION(IX-1) = 1
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 3
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-LEVEL-CHR
if FINFO-WS-LEVEL-CHR(2:1) = SPACE
move FINFO-WS-LEVEL-CHR(1:1)
to FINFO-WS-LEVEL-CHR(2:1)
move '0' to FINFO-WS-LEVEL-CHR(1:1)
end-if
if FINFO-WS-LEVEL-NBR not NUMERIC
move ZERO to FINFO-WS-LEVEL-NBR
end-if
evaluate FINFO-WS-LEVEL-NBR
when 1 perform BUILD-OUTPUT-RECORD-2
move 'Y' to FLAG-WRITE
when other move 'N' to FLAG-WRITE
end-evaluate
else
move 'N' to FLAG-WRITE
end-if
move FINFO-WS-RECORD to PUTRS512-REC
exit.
*****************************************************************
* Possible DD Name
BUILD-OUTPUT-RECORD-2.
* Possible DSN
add 2 to ZERO giving IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 49
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-DSN
else
move 'FINFO-WS-DSN is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible DD Name
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 18
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-DD-NAME
else
move 'FINFO-WS-DD-NAME is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible DSORG
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 5
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-DSORG
else
move 'FINFO-WS-DSORG is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible RECFM
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 9
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-RECFM
else
move 'FINFO-WS-RECFM is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible LRECL-MIN
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 6
move SPACES to WORK-05
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-05
perform RIGHT-ADJUST-WORK-05
move WORK-05 to FINFO-WS-LRECL-MIN
else
move 'FINFO-WS-LRECL-MIN is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible LRECL-MAX
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 6
move SPACES to WORK-05
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-05
perform RIGHT-ADJUST-WORK-05
move WORK-05 to FINFO-WS-LRECL-MAX
else
move 'FINFO-WS-LRECL-MAX is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible KEYPOS
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 6
move SPACES to WORK-05
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-05
perform RIGHT-ADJUST-WORK-05
move WORK-05 to FINFO-WS-KEYPOS
else
move 'FINFO-WS-KEYPOS is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible KEYLEN
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < 6
move SPACES to WORK-05
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-05
perform RIGHT-ADJUST-WORK-05
move WORK-05 to FINFO-WS-KEYLEN
else
move 'FINFO-WS-KEYLEN is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible VSAM-DAT
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < LENGTH OF FINFO-WS-VSAM-DAT + 1
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-VSAM-DAT
end-if
* Possible VSAM-IDX
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < LENGTH OF FINFO-WS-VSAM-IDX + 1
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-VSAM-IDX
end-if
* Possible JCL-OVR1
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < LENGTH OF FINFO-WS-JCL-OVR1 + 1
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-JCL-OVR1
else
move 'FINFO-WS-JCL-OVR1 is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible JCL-USR1
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < LENGTH OF FINFO-WS-JCL-USR1 + 1
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-JCL-USR1
else
move 'FINFO-WS-JCL-USR1 is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
* Possible JCL-USR2
add 1 to IX-1
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) > 0
and PRS-SIZE(IX-1) < LENGTH OF FINFO-WS-JCL-USR2 + 1
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to FINFO-WS-JCL-USR2
else
move 'FINFO-WS-JCL-USR2 is invalid' to ERROR-TEXT
perform Z-DISPLAY-ERROR-MESSAGE
end-if
exit.
*****************************************************************
RIGHT-ADJUST-WORK-05.
perform until WORK-05(5:1) not = SPACE
move WORK-05(4:1) to WORK-05(5:1)
move WORK-05(3:1) to WORK-05(4:1)
move WORK-05(2:1) to WORK-05(3:1)
move WORK-05(1:1) to WORK-05(2:1)
move ZERO to WORK-05(1:1)
end-perform
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
GETRS512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close GETRS512-FILE
if GETRS512-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 GETRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move GETRS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
GETRS512-READ.
read GETRS512-FILE
if GETRS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if GETRS512-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 GETRS512-EOF
else
move 'READ Failure with GETRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move GETRS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
GETRS512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input GETRS512-FILE
if GETRS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to GETRS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with GETRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move GETRS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
PUTRS512-WRITE.
if PUTRS512-OPEN-FLAG = 'C'
perform PUTRS512-OPEN
end-if
write PUTRS512-REC
if PUTRS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if PUTRS512-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 PUTRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUTRS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
PUTRS512-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT PUTRS512-FILE
if PUTRS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to PUTRS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with PUTRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUTRS512-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
PUTRS512-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close PUTRS512-FILE
if PUTRS512-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to PUTRS512-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with PUTRS512' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUTRS512-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 ERROR messages... *
*****************************************************************
Z-DISPLAY-ERROR-MESSAGE.
add GETRS512-RDR to ZERO giving ERROR-RECORD
move ERROR-MESSAGE to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move all SPACES to ERROR-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-21 Generation Time: 11:44:14:01 *
*****************************************************************
This copy file (CATPOPB1.CPY) defines the record layout for the records in the FILELIST.DAT that have a "01" in positions 1-2 of the record.
*****************************************************************
* Copy File for a List of Files. *
*****************************************************************
*
01 FINFO-WS-RECORD.
05 FINFO-WS-LEVEL-CHR.
10 FINFO-WS-LEVEL-NBR PIC 9(2).
05 FINFO-WS-FILE-INFO.
10 FINFO-WS-DSN PIC X(54).
10 FINFO-WS-DD-NAME PIC X(17).
10 FINFO-WS-DSORG PIC X(4).
10 FINFO-WS-RECFM PIC X(4).
10 FINFO-WS-LRECL-MIN PIC 9(5).
10 FINFO-WS-LRECL-MAX PIC 9(5).
10 FINFO-WS-KEYPOS PIC 9(5).
10 FINFO-WS-KEYLEN PIC 9(5).
10 FINFO-WS-VSAM-DAT PIC X(44).
10 FINFO-WS-VSAM-IDX PIC X(44).
05 FINFO-WS-JOB-INFO.
10 FINFO-WS-JCL-OVR1 PIC X(8).
10 FINFO-WS-JCL-USR1 PIC X(8).
10 FINFO-WS-JCL-USR2 PIC X(8).
05 FILLER PIC X(299).
* CATPOPB1 - End-of-Copy File...
The purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. In the world of programming there are many ways to solve a problem. This suite of programs is provided as a COBOL programming example of one of the possible solutions to the case conversion requirements.
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to Simotime Enterprises. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any 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, documentation or training material.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
You may download this example at http://www.simotime.com/sim4dzip.htm#zPackCatPop01 as a Z-Pack. The Z-Packs provide individual programming examples, documentation and test data files in a single package. The Z-Packs are usually in zip format to reduce the amount of time to download.
Please view the complete list of SimoTime Z-Pack 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 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.
Take a look at The JCL Scanner to gather file information from DD statements and DELETE/DEFINE statements used by IDCAMS.
To save information collected by the JCL Scanner in the File Properties Repository refer to the File Properties Repository Management provided in separate document.
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 .
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com.
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com.
| Return-to-Top |
| Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |
| Version 06.11.08 |