| When
technology complements business |
Micro
Focus Server |
|
|
|
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 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.
| 1.1 |
Execute a COBOL program (L2R00512.CBL) to convert the Line Sequential
(LSEQ) file to a Record Sequential (RSEQ) file with CSV formatted to
records. |
| 1.2 |
Submit a job (CATPOPJ1.JCL) to the Micro Focus Server to create
a catalog entry for the RSEQ file to be created in the next task. |
|
| 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. |
| 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 Fixed-Field format for records. |
| |
|
|
|
|
|
|
| |
|
|
|
|
|
Submit job to SimoBatA server to create a Catalog Entry for
FILEC512 |
| |
|
|
|
|
|
|
| |
|
|
|
|
|
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-2008 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 steaps 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-2008 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-2008 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-2008 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-2008 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-2008 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 (CATPOPC1CBL) 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-2008 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.
*****************************************************************
