Function Provided by CA-Panvalet
|
JCL using ++INCLUDE Function Provided by CA-Panvalet |
|
| The SimoTime Home Page |
Introduction
The ++INCLUDE is a function that is supported by CA-Panvalet for JCL Members stored and used on an IBM Mainframe. This function is not supported in the Micro Focus environment. When migrating a batch application that uses this function it will be necessary to change the ++INCLUDES to standard JCL statements that are supported in a Micro Focus environment and the mainframe. A conversion utility program (JCLALTC1.CBL) is available to do this conversion. A Windows command file is used to automate the process. Refer to JCLALTE1.CMD for more information.
We have made a significant effort to ensure the documents and software technologies are correct and accurate. We reserve the right to make changes without notice at any time. The function delivered in this version is based upon the enhancement requests from a specific group of users. The intent is to provide changes as the need arises and in a timeframe that is dependent upon the availability of resources.
Copyright © 1987-2024
SimoTime Technologies and Services
All Rights Reserved
Basic Functionality
This section will focus on the primary CMD and CBL files that do the actual processing of the JCL Source Members that contain the INCLUDE Statements.. The primary CMD File will call other command files to perform ancillary tasks. These secondary command files and programs will be described in the Ancillary Functionality section of this document.
Flowchart, Scan & Replace Function
This is an example of generating a numbered list of items.
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Note-1: LSEQ = Line Sequential File or ASCII/Text File | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Scan and Replace ++INCLUDE Statements with Standard JCLLIB and INCLUDE Statements |
JCL Samples for Input and Results
This section describes the source code before and after the scan and replace processing.
JCL with ++INCLUDE Statements
The following shows the JCL Member that contains the ++INCLUDE statements.
//JCLALTJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0
//*
++INCLUDE JCLALTI1
//*
//STEP0001 EXEC PGM=IEFBR14
//*
++INCLUDE JCLALTI2 |
| The JCL Member that contains the ++INCLUDE statements |
JCL with Standard JCLLIB & INCLUDE
The following shows the JCL Member that is created by the scan and replace process and contains standard JCLLIB and INCLDUEstatements.
//JCLALTJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0 //* //* CONVERT ++INCLUDE's to INCLUDE's preceded by a JCLLIB statement... // JCLLIB ORDER=SIMOTIME.PDS.JCLINC //* ++INCLUDE JCLALTI1 // INCLUDE MEMBER=JCLALTI1 //* //STEP0001 EXEC PGM=IEFBR14 //* //* ++INCLUDE JCLALTI2 // INCLUDE MEMBER=JCLALTI2 |
| The newly created JCL Member that contains standard JCLLIB and INCLUDE statements. |
CMD, Multiple Scan & Replace
The following is the Windows Command file (JCLALTE1.cmd) that will process multiple JCL Members based on the content of a list file.
@echo OFF
rem * *******************************************************************
rem * JCLALTE1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem * This procedure calls the following Windows Command Files.
rem * 1. Env1Base.CMD - this provides a single point for setting commonly
rem * used environment variables.
rem * 2. SimoNOTE.CMD - this provides a consistent process for displaying
rem * messages to the screen and writing to a journal or log file.
rem * ************************************************************************
set CmdName=JCLALTE1
call ..\Env1Base
set JobStatus=0000
rem *
call SimoNOTE "*******************************************%CmdName%.CMD"
call SimoNOTE "Starting JobName %CmdName%.CMD"
rem *
rem * Set the environment variable to use the default directives file.
set DIRGET=%BaseLib1%\JCL
set DIRPUT=%BaseLib1%\DATA\Wrk2
set DIRLIST=%BaseLib1%\Adm1\DATA\Wrk1\SIMOTIME.WORK.JCLALTL1.LST
rem *
dir /B /A-D /ONE %DIRGET%\*.JCL >%DIRLIST%
echo * Review the following listing before continuing...
start notepad %DIRLIST%
call SIMONOTE "JCL List is displayed in a separate window,"
call SIMONOTE "Press space bar to contine..."
call SIMONOTE "LIBRTAKE is %DIRGET%"
call SIMONOTE "LIBRMAKE is %DIRPUT%"
call SIMONOTE "JCL List is displayed in a separate window..."
pause
rem *
set AOK_Count=0
set NOK_Count=0
set JCSCANBF=00000000
set SCANMODE=PLUSPLUS
set SCANJLIB=SIMOTIME.PDS.JCLINC
for /F %%i in (%DIRLIST%) do call JCLALTEZ %%i
call SIMONOTE "LIBRTAKE is %DIRGET%"
call SIMONOTE "LIBRMAKE is %DIRPUT%"
rem *
call SimoNOTE "AOKcount Count for AOK is %AOK_Count% "
call SimoNOTE "NOKcount Count for NOK is %NOK_Count% "
call SimoNOTE "Finished JobName %CmdName%.CMD RC=%JobStatus%"
if not "%SimoGENS%" == "BATCH" pause
CMD, Single Scan & Replace
The following is the called Windows Command file (JCLALTEZ.cmd) that will process a single JCL Member.
rem * ************************************************************************
rem * It is the callers reponsibility to set the following environment
rem * variable prior to calling the command.
rem * 1. DIRGET - point to the base directory. This procedure uses various
rem * sub-directories under the base directory.
rem * 2. DIRPUT - point to the target directory.
rem *
rem * The following parameters are received from the calling command file.
rem * Parameter Description
rem * --------- ------------------------------------------------------------
rem * 1. Name of source member
rem * ************************************************************************
set CmdStatus=0000
set JCLOLD80=%DIRGET%\%1
set JCLNEW80=%DIRPUT%\%1
run JCLALTC1
if not "%ERRORLEVEL%" == "0" set CmdStatus=0010
if not "%CmdStatus%" == "0000" goto EOJNOK
rem * ************************************************************************
:EOJAOK
set /A AOK_Count=%AOK_Count% + 1
call SimoNOTE "Complete JCLALTEZ, RC=%Compile2GNTStatus%, PGM=%1"
goto :End
rem *
rem * ************************************************************************
:EOJNOK
set JobStatus=0016
set /A NOK_Count=%NOK_Count% + 1
call SimoNOTE "ABENDING JCLALTEZ, RC=%CmdStatus%, PGM=%1, !!!ABENDING!!!"
echo %1 - Error during Conversion, refer to %BaseLib1%\LOGS Directory>%BaseLib1%\LOGS\%1.ERR
goto :End
rem *
rem * ************************************************************************
:End
Create JCL ++INCLUDE Statements
The following is a Windows Command file (JCLALTE2.cmd) that will create a single JCL Member that contains ++INCLUDE statements for testing purposes.
@echo OFF
rem * *******************************************************************
rem * JCLALTE2.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create a Sequential Data Set on disk using ECHO Command.
rem * Author - SimoTime Technologies
rem * Date = January 24, 1996
rem *
rem * The first job step (DeleteTEXT) will delete any previously created
rem * files.
rem * The second job step (CreateTEXT) will create a new ASCII/Text file.
rem * The third step will convert the Line Sequential file to a Record
rem * Sequential file.
rem *
rem * This set of programs will run on a Personal Computer with Windows
rem * and Micro Focus Net Express.
rem *
set CmdName=JCLALTE2
call ..\Env1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%, User is %USERNAME%"
call SimoNOTE "StepInfo Delete previously created files"
set JCLALTT1=%BaseLib1%\JCL\JCLALTJ1.JCL
rem *
rem * *******************************************************************
rem * Step 1 of 1, Create and populate a new ASCII/TEXT file...
rem *
call SimoNOTE "StepInfo Create an ASCII/Text File"
if exist %JCLALTT1% del %JCLALTT1%
rem * :....1....:....2....:....3....:....4....:....5....:....6....:....7.
echo //JCLALTJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0 >>%JCLALTT1%
echo //* >>%JCLALTT1%
echo ++INCLUDE JCLALTI1 >>%JCLALTT1%
echo //* >>%JCLALTT1%
echo //STEP0001 EXEC PGM=IEFBR14 >>%JCLALTT1%
echo //* >>%JCLALTT1%
echo ++INCLUDE JCLALTI2 >>%JCLALTT1%
if exist %JCLALTT1% call SimoNOTE "DataMake %JCLALTT1%"
if not exist %JCLALTT1% set JobStatus=9001
if not %JobStatus% == 0000 goto :EojNok
rem *
:EojAok
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus% "
goto :End
:EojNok
call SimoNOTE "NOTE ABENDING CmdName %CmdName%, Job Status is %JobStatus% "
:End
if not "%1" == "nopause" pause
Ancillary Functionality
This section provides additional detail about the secondary CMD files and programs that are used in this set of sample programs.
Set the Environment
A command file (ENV1BASE.cmd) is called from other command files to set commonly used environment variables. This provides a single point of definition. The following is a listing of the contents of the command file.
@echo OFF
rem * *******************************************************************
rem * ENV1BASE.cmd - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2021 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Provide a single point to set common environment variables.
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * Set the commonly used environment variables. This is used to provide
rem * a single point for managing the commonly used environment variables.
rem *
set SimoLIBR=c:\SimoLIBR
set BASELIB1=c:\SIMOSAM1\DEVL
set BASELIB8=c:\SimoSAM8
set BaseWIP1=c:\SimoSAM1\WIP1
set DATAZERO=c:\SIMODATA\DEVL\DATA\ZERO
set BASEAPP=%BaseLib1%
set BASESYS=%BaseLib1%\SYS1
set BASECAT=%BaseLib1%\DATA
set UMAPALIB=%BASECAT%\ASC1
set UMAPELIB=%BASECAT%\EBC1
set SYSLOG=%BASESYS%\LOGS\SYSLOG_USER.DAT
set SYSOUT=%BASEAPP%\LOGS\SYSOUT_SIMSAM01.txt
set SLZMSG=%BASEAPP%\LOGS\SLZMSG_USER.TXT
set PostNOTE=%BASEAPP%\LOGS\JOBLOG_SIMONOTE.TXT
set SIMONOTE=%BASEAPP%\LOGS\JOBLOG_SIMONOTE.txt
set USERPOST=%BASEAPP%\LOGS\ASSIGNED_USER_POST_FILE.txt
if [%1]==[] goto NO_POST
set SYSOUT=%BaseLib1%\LOGS\SYSOUT_%1.txt
call SIMONOTE "+ ENV1BASE *"
call SIMONOTE "+ ENV1BASE ********************************************************************%1"
call SIMONOTE "+ ENV1BASE is preparing the System Environment..."
call SIMONOTE "+ SIMOLIBR is %SIMOLIBR%"
call SIMONOTE "+ MIFOSYS1 is %MIFOSYS1%"
call SIMONOTE "+ BASELIB1 is %BASELIB1%"
:NO_POST
call SIMONOTE "+ SIMONOTE Job Log File is %SIMONOTE% "
rem *
set MQBASE=C:\Program Files\IBM\WebSphere MQ
rem *
rem * Set the location for the Apache-Tomcat Server...
set CATALINA_HOME=C:\APACHETC\apache-tomcat-7.0.52
rem set CATALINA_HOME=C:\Program Files (x86)\Java\jdk1.8.0_112
rem *
rem * Set the Environment for the Java Environment...
rem set JAVABASE=C:\APACHETC\apache-tomcat-7.0.52
set JAVABASE=C:\Program Files (x86)\Java\jdk1.8.0_112
set JAVASDK="%JAVABASE%\bin"
set JAVA_HOME=%JAVABASE%
set JRE_HOME=%JAVABASE%
set SIMOTCAT=%CATALINA_HOME%\webapps\simotcat
set SIMPACKS=%CATALINA_HOME%\webapps\simotcat\WEB-INF\classes\simpacks
rem *
rem * Set the environment for the Micro Focus technology...
set MIFOEDEV=C:\Program Files (x86)\Micro Focus\Enterprise Developer
set MIFOVCBL=C:\Program Files (x86)\Micro Focus\Visual COBOL Build Tools
set MIFOESTU=C:\Program Files (x86)\Micro Focus\Studio Enterprise Edition 6.0
set MIFOEMFE="C:\Program Files (x86)\Micro Focus\Mainframe Express"
rem *
rem * Large file support, performance tuning and record locking of the File Handler
set EXTFH=%BASESYS%\CONFIG\EXTFHBIG.CFG
rem *
rem * For IMS Support
set ES_IMSLIB=%BASEAPP%\IMSLIB
set ES_ACBLIB=%BASEAPP%\IMSLIB
rem *
rem * EZASOKETS Check EZASOKETS Enabled box or set ES_EZASOKET_SUPPORT=YES
set EZACONFG=BASESYS1\CONFIG\EZACONFG.dat
rem *
rem * Resource Allocation and Performance for SORT and non-Relational Data
rem set MFJSENGINE=SYNCSORT
set SORTSCHEME=1
set SORTSPACE=750000000
set TMP=C:\SORTWORK
rem *
set ES_ALLOC_OVERRIDE=%BASESYS%\CONFIG\CATMAPA1.cfg
rem * For CORE_ON_ERROR function, ABEND Dump
rem * set COBCONFIG_=%BASESYS%\CONFIG\diagnose.cfg
rem *
rem * Consolidated Trace Facility (CTF)
rem * set MFTRACE_CONFIG=%BASESYS%\CONFIG\ctf.cfg
rem * set MFTRACE_LOGS=c:\ctflogs
rem *
rem * For Job Restart, ABEND Recovery
set MF_UCC11=Y
set ES_JES_RESTART=Y
rem *
rem * Set environment for MFBSI (Micro Focus Batch Scheduling Interface)
set ES_EMP_EXIT_1=mfbsiemx
set MFBSI_DIR=%BASESYS%\LOGS\%JESSERVERNAME%
set MFBSIEOP_CMD=ENABLE
set MFBSIEOP_CSV=ENABLE
set MFBSIEOP_HTM=ENABLE
set MFBSIEOP_XML=ENABLE
rem *
rem * Set Behavior and Trace Flags for GETJOBDD
rem * Position=12345678/12345678
set JDDFLAGS=nnnWnnnn/YYnnnnnn
rem *
rem * If not already set then set the PATH for Micro Focus Directories
if "%SIMOPATH%" == "Y" goto JUMPPATH
if "%MIFOSYS1%" == "EDEV" goto JUMPEDEV
if "%MIFOSYS1%" == "VCBL" goto JUMPVCBL
if "%MIFOSYS1%" == "ESTU" goto JUMPESTU
if "%MIFOSYS1%" == "EMFE" goto JUMPEMFE
:JUMPEDEV
set path=%BASESYS%\LOADLIB;%MIFOEDEV%\bin;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOEDEV%\CPYLIB
set MIFOBASE=%MIFOEDEV%
goto JUMPPATH
:JUMPVCBL
set path=%MIFOVCBL%\bin;%MIFOVCBL%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set MIFOBASE=%MIFOVCBL%
goto JUMPPATH
:JUMPESTU
set MIFOBASE=%MIFOESTU%\Base
set MIFOBIN=%MIFOBASE%\bin
set path=%BASESYS%\LOADLIB;%MIFOBASE%;%MIFOBIN%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOBASE%\SOURCE
goto JUMPPATH
:JUMPEMFE
set MIFOBASE=%MIFOEMFE%\Base
set MIFOBIN=%MIFOBASE%\bin
set path=%BASESYS%\LOADLIB;%MIFOBASE%;%MIFOBIN%;%JAVASDK%;%BASEAPP%\JAVA;%PATH%;
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%;%MIFOBASE%\SOURCE
goto JUMPPATH
rem *
:JUMPPATH
set SIMOPATH=Y
rem *
set MAINFRAME_FLOATING_POINT=true
set COBIDY=%BASEAPP%\COBIDY
set COBPATH=.;%BASEAPP%\LOADLIB;%BASEAPP%\LOADLIB\GNTS;%BASESYS%\LOADLIB;%SimoLIBR%
set LIBPATH=.;%BASEAPP%\LOADLIB;%BASEAPP%\LOADLIB\GNTS;%BASESYS%\LOADLIB;%SimoLIBR%
set TXDIR=%BASESYS%\LOADLIB;%MIFOBASE%
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy2;%BASEAPP%\CobCpy6;%SimoLIBR%
rem *
set USERCLASS=%BASELIB1%\LOADLIB
set CLASSPATH=.
set CLASSPATH=%CLASSPATH%;%JAVABASE%
set CLASSPATH=%CLASSPATH%;%JAVABASE%\lib
set CLASSPATH=%CLASSPATH%;\%USERCLASS%\simpacks
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\simotcat\WEB-INF\classes
set CLASSPATH=%CLASSPATH%;C:\APACHETC\apache-tomcat-7.0.52\webapps\simotcat\WEB-INF\classes\simpacks
rem *
if "%MIFOSYS1%" == "ESTU" set CLASSPATH=%CLASSPATH%;%MIFOBIN%
if "%MIFOSYS1%" == "EDEV" set CLASSPATH=%CLASSPATH%;%MIFOEDEV%
if "%MIFOSYS1%" == "VCBL" set CLASSPATH=%CLASSPATH%;%MIFOVCBL%
if "%MIFOSYS1%" == "VCBL" set CLASSPATH=%CLASSPATH%;%MIFOVCBL%\bin\mfcobol.jar
rem *
set JobStatus=0000
call SIMONOTE "+ ENV1BASE is returning to caller"
Display and Log Messages
The following is a listing of the contents of the (SIMONOTE.cmd) command file.
@echo OFF rem * ******************************************************************* rem * SIMONOTE.cmd - a Windows Command File * rem * This program is provided by SimoTime Technologies * rem * (C) Copyright 1987-2019 All Rights Reserved * rem * Web Site URL: http://www.simotime.com * rem * e-mail: helpdesk@simotime.com * rem * ******************************************************************* rem * rem * Text - Display message on screen and write to a log file. rem * Author - SimoTime Technologies rem * rem * This script may be called from other scripts and expects a single rem * parameter enclosed in double quotes. The double quotes will be rem * removed. Before writing to the log file a date and time stamp rem * will be inserted in front of the message text. rem * rem * Note: The tilde (~) removes leading/trailing double-quotes. rem * if "%SimoNOTE%" == "" set SimoNOTE=c:\SimoLIBR\LOGS\SimoTime.LOG echo %date% %time% %~1>> %SimoNOTE% echo %~1
Technical Details
This section described the COBOL programs used by this suite of programs that scans JCL members and replaces ++INCLUDE statements with standard INCLUDE statements.
COBOL Program
This section will focus on the primary program that does the actual processing of the COBOL Source Members. The primary program will call other command files to perform ancillary tasks. These secondary programs and associated links will be described in the Ancillary Functions section of this document.
The following (JCLALTC1.cbl) is the source code for the COBOL program that does the scan and replace for the JCL Members.
IDENTIFICATION DIVISION.
PROGRAM-ID. JCLALTC1.
AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* -------- -------- ------------ -------- ------- ------- *
* INPUT JCLOLD80 ASCII/CRLF VARIABLE 00080 *
* OUTPUT JCLNEW80 SEQUENTIAL FIXED 00512 *
*****************************************************************
*
* DSORG GDG IS PDSM PO PS VSAM UNKNOWN
*
* IF DSORG is non- VSAM then
* RECFM F FA FB FBA FBM FBS FM FS LSEQ U
* V VA VB VBA VBM VBS VM VS
*
* IF DSORG is VSAM then
* RECFM ESDS KSDS LDS RRDS
*
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT JCLOLD80-FILE ASSIGN EXTERNAL JCLOLD80
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS JCLOLD80-STATUS.
SELECT JCLNEW80-FILE ASSIGN EXTERNAL JCLNEW80
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS JCLNEW80-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD JCLOLD80-FILE
DATA RECORD IS JCLOLD80-REC.
01 JCLOLD80-REC.
05 JCLOLD80-DATA-01 PIC X(00080).
FD JCLNEW80-FILE
DATA RECORD IS JCLNEW80-REC.
01 JCLNEW80-REC.
05 JCLNEW80-DATA-01 PIC X(00080).
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* JCLALTC1 '.
05 T2 pic X(34) value 'Copy/Replace ++INCLUDE in JCL Code'.
05 T3 pic X(10) value ' v09.09.10'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* JCLALTC1 '.
05 C2 pic X(20) value 'Copyright 1987-2018 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 JCLOLD80-STATUS.
05 JCLOLD80-STATUS-L pic X.
05 JCLOLD80-STATUS-R pic X.
01 JCLOLD80-EOF pic X value 'N'.
01 JCLOLD80-OPEN-FLAG pic X value 'C'.
01 JCLNEW80-STATUS.
05 JCLNEW80-STATUS-L pic X.
05 JCLNEW80-STATUS-R pic X.
01 JCLNEW80-EOF pic X value 'N'.
01 JCLNEW80-OPEN-FLAG pic X value 'C'.
01 JCLOLD80-LRECL pic 9(5) value 00080.
01 JCLNEW80-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 '* JCLALTC1 '.
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 'JCLALTC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
*****************************************************************
01 SPS-QUIT pic X value 'N'.
01 JCL-DD-WORK.
05 JCL-DD-1-2 pic X(2) value SPACES.
05 DD-NAME pic X(17) value SPACES.
01 DSN-NAME pic X(54) value SPACES.
01 DD-CONTINUE pic X value 'N'.
01 DSN-NAME-2 pic X(54) value SPACES.
01 MEMBER-NAME pic X(12) value SPACES.
01 JCL-JOB-WORK.
05 JCL-JOB-1-2 pic X(2) value SPACES.
05 JOB-NAME pic X(17) value SPACES.
01 JCL-SET-WORK.
05 JCL-SET-1-2 pic X(2) value SPACES.
05 SET-NAME pic X(8) value SPACES.
01 JCL-EXEC-WORK.
05 JCL-EXEC-1-2 pic X(2) value SPACES.
05 STEP-NAME pic X(17) value SPACES.
01 EXEC-TYPE pic X(4) value SPACES.
01 EXEC-NAME pic X(8) value SPACES.
01 DCB-INFO pic X(80) value SPACES.
01 DCB-WORK.
05 DCB-DSORG pic X(8) value SPACES.
05 DCB-RECFM pic X(8) value SPACES.
05 DCB-LRECL-ALPHA.
10 DCB-LRECL pic 9(5) value 0.
01 SUB-TABLE occurs 25 times.
05 SUB-KEYWORD pic X(10) value SPACES.
05 SUB-VALUE pic X(64) value SPACES.
05 SUB-LENGTH pic 9(3) value 0.
01 SUB-TABLE-LIMIT pic 9(3) value 25.
01 SUB-LAST-ELEMENT pic 9(3) value 0.
01 SUB-IDX pic 9(3) value 0.
01 IDCAMS-WORK.
05 IDCAMS-CLUSTER-NAME pic X(54) value SPACES.
05 IDCAMS-DSORG pic X(8) value SPACES.
05 IDCAMS-RECFM pic X(8) value SPACES.
05 IDCAMS-LRECL-MIN-ALPHA.
10 IDCAMS-MIN-LRECL pic 9(5) value 0.
05 IDCAMS-LRECL-MAX-ALPHA.
10 IDCAMS-MAX-LRECL pic 9(5) value 0.
05 IDCAMS-KPOS-ALPHA.
10 IDCAMS-KPOS pic 9(5) value 0.
05 IDCAMS-KLEN-ALPHA.
10 IDCAMS-KLEN pic 9(5) value 0.
05 IDCAMS-DATA-NAME pic X(44) value SPACES.
05 IDCAMS-INDEX-NAME pic X(44) value SPACES.
05 IDCAMS-FUNCTION pic X(8) value SPACES.
05 IDCAMS-DATA-TYPE pic X(8) value SPACES.
01 T-POS pic 9(5) value 0.
01 T-LEN pic 9(5) value 0.
01 PAREN-COUNT pic 9(3) value 0.
01 MX-1 pic 9(3) value 0.
01 IX-1 pic 9(3) value 0.
01 IX-2 pic 9(3) value 0.
01 PT-1 pic 9(3) value 0.
01 PT-2 pic 9(3) value 0.
01 QUIT-PERFORM pic X value 'Q'.
01 QUIT-PERFORM-2 pic X value 'Q'.
01 INSTREAM-DATA pic X value 'N'.
01 EQUAL-SIGN pic X value 'N'.
01 BEHAVIOR-FLAGS.
05 BF-DEBUG pic 9 value 0.
05 BF-SYSOUT pic 9 value 0.
05 BF-DD-SUB pic 9 value 0.
05 BF-04 pic 9 value 0.
05 BF-05 pic 9 value 0.
05 BF-06 pic 9 value 0.
05 BF-07 pic 9 value 0.
05 BF-08 pic 9 value 0.
01 ACTIVITY-FLAGS.
05 AF-JCLLIB pic 9 value 0.
01 WORK-05 pic X(5) value SPACES.
01 WORK-08 pic X(8) value SPACES.
01 WORK-10 pic X(10) value SPACES.
01 WORK-48 pic X(48) value SPACES.
01 WORK-64 pic X(64) value SPACES.
01 STMT-CMT-01.
05 filler pic X(04) value '//* '.
05 filler pic X(30) value "CONVERT ++INCLUDE's to INCLUDE".
05 filler pic X(30) value "'s preceded by a JCLLIB statem".
05 filler pic X(06) value "ent...".
01 STMT-JCLLIB.
05 filler pic X(16) value '// JCLLIB '.
05 filler pic X(6) value 'ORDER='.
05 STMT-JCLLIB-ORDER pic X(44) value SPACES.
01 STMT-INCLUDE.
05 filler pic X(16) value '// INCLUDE'.
05 filler pic X(8) value ' MEMBER='.
05 STMT-INCLUDE-NAME pic X(44) value SPACES.
01 WRKLS080-LOC-TOTAL.
05 filler pic X(6) value 'Reads='.
05 WRKLS080-LOC-RDR pic 9(9) value 0.
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'JCL='.
05 WRKLS080-LOC-DATA pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'BLK='.
05 WRKLS080-LOC-SPACES pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'Cmt='.
05 WRKLS080-LOC-CMT pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'Oth='.
05 WRKLS080-LOC-OTH pic 9(5).
01 JCLOLD80-LOC-TOTAL.
05 filler pic X(6) value 'Reads='.
05 JCLOLD80-LOC-RDR pic 9(9) value 0.
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'JCL='.
05 JCLOLD80-LOC-DATA pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'BLK='.
05 JCLOLD80-LOC-SPACES pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'Cmt='.
05 JCLOLD80-LOC-CMT pic 9(5).
05 filler pic X(2) value ', '.
05 filler pic X(4) value 'Oth='.
05 JCLOLD80-LOC-OTH pic 9(5).
01 JCLNEW80-LOC-TOTAL.
05 filler pic X(6) value 'Write='.
05 JCLNEW80-LOC-ADD pic 9(9) value 0.
COPY PASSPARS.
COPY PASSSUB1.
COPY PASSPARK.
COPY PAENVARS.
*****************************************************************
PROCEDURE DIVISION.
perform ACTION-ONE
perform JCLOLD80-OPEN
perform JCLNEW80-OPEN
perform until JCLOLD80-STATUS not = '00'
move 'N' to DD-CONTINUE
perform JCLOLD80-READ
if JCLOLD80-STATUS = '00'
if JCLOLD80-REC(1:17) = ' ++INCLUDE '
if BF-SYSOUT > 0
move JCLOLD80-REC(1:71) to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if AF-JCLLIB = 0
move STMT-CMT-01 to JCLNEW80-REC
perform JCLNEW80-WRITE
move STMT-JCLLIB to JCLNEW80-REC
perform JCLNEW80-WRITE
add 1 to ZERO giving AF-JCLLIB
end-if
move JCLOLD80-REC to JCLNEW80-REC
move '//*' to JCLNEW80-REC(1:3)
perform JCLNEW80-WRITE
perform PARSE-THE-OLD-RECORD
move SPACES to STMT-INCLUDE-NAME
if PRS-SIZE(2) > 0
and PRS-SIZE(2) < 45
move PRS-BUFFER(PRS-POSITION(2):PRS-SIZE(2))
to STMT-INCLUDE-NAME
end-if
move STMT-INCLUDE to JCLNEW80-REC
perform JCLNEW80-WRITE
else
move JCLOLD80-REC to JCLNEW80-REC
perform JCLNEW80-WRITE
end-if
end-if
end-perform
compute JCLOLD80-LOC-OTH = JCLOLD80-LOC-RDR
- JCLOLD80-LOC-DATA
- JCLOLD80-LOC-SPACES
- JCLOLD80-LOC-CMT
if BF-SYSOUT > 0
move JCLOLD80-LOC-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLNEW80-LOC-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if APPL-EOF
if BF-SYSOUT > 0
move 'is Complete...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
else
move 'is ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if SUB-LAST-ELEMENT > 0
and BF-DEBUG > 1
perform varying IX-1 from 1 by 1
until IX-1 > SUB-LAST-ELEMENT
display SUB-TABLE(IX-1)
end-perform
end-if
perform JCLNEW80-CLOSE
perform JCLOLD80-CLOSE
add JCLOLD80-LOC-RDR to WRKLS080-LOC-RDR
add JCLOLD80-LOC-DATA to WRKLS080-LOC-DATA
add JCLOLD80-LOC-SPACES to WRKLS080-LOC-SPACES
add JCLOLD80-LOC-CMT to WRKLS080-LOC-CMT
add JCLOLD80-LOC-OTH to WRKLS080-LOC-OTH
move WRKLS080-LOC-TOTAL to PARK-PASS-BUFFER
move 'S' to PARK-PASS-REQUEST
call 'SIMOPARK' using PARK-PASS-AREA
GOBACK.
*****************************************************************
ACTION-ONE.
* Get Program Behavior Flags
move 'JCSCANBF' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if ENV-VAR-VALUE not = SPACES
and ENV-VAR-VALUE(1:8) is NUMERIC
move ENV-VAR-VALUE(1:8) to BEHAVIOR-FLAGS
end-if
if BF-SYSOUT > 0
perform Z-POST-COPYRIGHT
end-if
perform GET-MEMBER-NAME
move ZERO to JCLOLD80-LOC-RDR
move ZERO to JCLOLD80-LOC-DATA
move ZERO to JCLOLD80-LOC-SPACES
move ZERO to JCLOLD80-LOC-CMT
move ZERO to JCLOLD80-LOC-OTH
move ZERO to JCLNEW80-LOC-ADD
move '0' to PRS-REQUEST
move SPACE to PRS-DELIMITER
move ZERO to AF-JCLLIB
exit.
*****************************************************************
GET-MEMBER-NAME.
move SPACES to ENV-VAR-NAME
move 'JCLOLD80' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if RETURN-CODE = 0
and ENV-VAR-VALUE not = SPACES
if BF-SYSOUT > 0
move ENV-VAR-VALUE to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
else
move 'GET-ENV Failed...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
add 1 to ZERO giving PT-1
add 1 to ZERO giving PT-2
move 'L' to QUIT-PERFORM
perform until PT-1 > 256
or QUIT-PERFORM = 'Q'
if ENV-VAR-VALUE(PT-1:1) = '\'
add 1 to PT-1
add 1 to ZERO giving PT-2
move SPACES to MEMBER-NAME
end-if
if PT-2 < 13
move ENV-VAR-VALUE(PT-1:1) to MEMBER-NAME(PT-2:1)
add 1 to PT-1
add 1 to PT-2
else
add 1 to PT-1
end-if
if ENV-VAR-VALUE(PT-1:2) = ' '
move 'Q' to QUIT-PERFORM
end-if
end-perform
move 'SCANJLIB' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if ENV-VAR-VALUE not = SPACES
move ENV-VAR-VALUE(1:44) to STMT-JCLLIB-ORDER
end-if
exit.
*****************************************************************
* The ENV-VAR-NAME must contain the name of the variable...
GET-ENVIRONMENT-VARIABLE.
move SPACES to ENV-VAR-VALUE
move 'GET' to ENV-VAR-REQUEST
call 'MFENVARS' using ENV-VAR-PASSAREA
if RETURN-CODE not = 0
move SPACES to ENV-VAR-VALUE
end-if
exit.
*****************************************************************
PARSE-THE-OLD-RECORD.
move '0' to PRS-REQUEST
add 80 to ZERO giving PRS-BUFFER-SIZE
move SPACE to PRS-DELIMITER
move JCLOLD80-REC to PRS-BUFFER
call 'SIMOPARS' using PRS-PARAMETERS
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-MORE.
add 512 to ZERO giving PRS-BUFFER-SIZE
perform until PRS-BUFFER(PRS-LAST-SIG-BYTE:1) not = ','
or JCLOLD80-STATUS not = '00'
perform JCLOLD80-READ
if JCLOLD80-STATUS = '00'
move JCLOLD80-REC(16:64)
to PRS-BUFFER(PRS-LAST-SIG-BYTE + 1:64)
call 'SIMOPARS' using PRS-PARAMETERS
end-if
end-perform
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-03.
move ',' to PRS-DELIMITER
call 'SIMOPARS' using PRS-PARAMETERS
add 1 to ZERO giving IX-1
perform until IX-1 > PRS-NUMBER-OF-ITEMS
if PRS-POSITION(IX-1) > 0
and PRS-BUFFER(PRS-POSITION(IX-1):4) = 'DSN='
perform POSSIBLE-DD-STATEMENT-DSN
end-if
if PRS-POSITION(IX-1) > 0
and PRS-BUFFER(PRS-POSITION(IX-1):4) = 'DCB='
perform POSSIBLE-DD-STATEMENT-DCB
end-if
if PRS-POSITION(IX-1) > 0
and PRS-BUFFER(PRS-POSITION(IX-1):1) = '*'
perform POSSIBLE-DD-STATEMENT-ASTERISK
end-if
add 1 to IX-1
end-perform
if DSN-NAME = SPACES
move PRS-BUFFER(PRS-POSITION(1):54)
to DSN-NAME
end-if
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-ASTERISK.
if BF-DEBUG > 1
display JOB-NAME '-'
EXEC-NAME ' Found Instream data...'
end-display
end-if
move 'Y' to INSTREAM-DATA
move '*' to DSN-NAME
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-DCB.
* display 'DCB found' upon console
move PRS-BUFFER(PRS-POSITION(IX-1):50)
to DCB-INFO
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-DSN.
move PRS-BUFFER(PRS-POSITION(IX-1) + 4:PRS-SIZE(IX-1) - 4)
to DSN-NAME
if BF-DD-SUB > 0
perform POSSIBLE-DD-STATEMENT-DSN-SUB
end-if
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-DSN-SUB.
move DSN-NAME to DSN-NAME-2
add 1 to ZERO giving IX-2
move 'L' to QUIT-PERFORM
perform until QUIT-PERFORM = 'Q'
if DSN-NAME(IX-2:1) = '&'
add IX-2 to ZERO giving PT-1
add 1 to IX-2
move 'L' to QUIT-PERFORM-2
perform until QUIT-PERFORM-2 = 'Q'
if DSN-NAME(IX-2:1) = '.'
or DSN-NAME(IX-2:1) = ' '
or DSN-NAME(IX-2:1) = ','
add IX-2 to ZERO giving PT-2
compute SUB-SEARCH-LENGTH = PT-2 - PT-1 + 1
move DSN-NAME(PT-1:SUB-SEARCH-LENGTH)
to SUB-SEARCH-STRING
move 'Q' to QUIT-PERFORM-2
* subtitute the value from the table
perform POSSIBLE-DD-STATEMENT-DSN-SUB-2
add PT-1 to ZERO giving IX-2
end-if
if IX-2 < 54
and QUIT-PERFORM-2 = 'L'
add 1 to IX-2
else
move 'Q' to QUIT-PERFORM-2
end-if
end-perform
end-if
if IX-2 < 54
add 1 to IX-2
else
move 'Q' to QUIT-PERFORM
end-if
end-perform
exit.
*---------------------------------------------------------------*
POSSIBLE-DD-STATEMENT-DSN-SUB-2.
add 1 to ZERO giving SUB-IDX
move SPACES to WORK-10
move SUB-SEARCH-STRING(2:SUB-SEARCH-LENGTH - 2) to WORK-10
perform until SUB-IDX > SUB-TABLE-LIMIT
or SUB-VALUE(SUB-IDX) = SPACES
if WORK-10 = SUB-KEYWORD(SUB-IDX)
add SUB-LENGTH(SUB-IDX) to ZERO
giving SUB-REPLACE-LENGTH
move SUB-VALUE(SUB-IDX) to SUB-REPLACE-STRING
add 25 to ZERO giving SUB-IDX
end-if
add 1 to SUB-IDX
end-perform
move DSN-NAME to SUB-BUFFER-SOURCE
move SPACES to SUB-BUFFER-TARGET
call 'SIMOSUB1' using SUBSTITUTE-PARAMETERS
move SUB-BUFFER-TARGET(1:54) to DSN-NAME
exit.
*****************************************************************
POSSIBLE-EXEC-STATEMENT.
move '0' to PRS-REQUEST
add 80 to ZERO giving PRS-BUFFER-SIZE
move SPACE to PRS-DELIMITER
move JCLOLD80-REC to PRS-BUFFER
if JCLOLD80-REC(1:2) = '//'
call 'SIMOPARS' using PRS-PARAMETERS
if PRS-SIZE(2) = 4
and PRS-BUFFER(PRS-POSITION(2):PRS-SIZE(2)) = 'EXEC'
perform POSSIBLE-EXEC-STATEMENT-FOUND
move 'Y' to SPS-QUIT
end-if
else
move 'N' to SPS-QUIT
exit.
*---------------------------------------------------------------*
POSSIBLE-EXEC-STATEMENT-FOUND.
move PRS-BUFFER(PRS-POSITION(1):PRS-SIZE(1))
to JCL-EXEC-WORK
if PRS-BUFFER(PRS-POSITION(3):4) = 'PGM='
move 'PGM ' to EXEC-TYPE
move PRS-BUFFER(PRS-POSITION(3) + 4:8) to EXEC-NAME
else
move 'PROC' to EXEC-TYPE
move PRS-BUFFER(PRS-POSITION(3):8) to EXEC-NAME
end-if
inspect EXEC-NAME
replacing characters by SPACE after ','
inspect EXEC-NAME replacing all ',' by SPACE
exit.
*****************************************************************
POSSIBLE-JOB-STATEMENT.
move '0' to PRS-REQUEST
add 80 to ZERO giving PRS-BUFFER-SIZE
move SPACE to PRS-DELIMITER
move JCLOLD80-REC to PRS-BUFFER
if JCLOLD80-REC(1:2) = '//'
call 'SIMOPARS' using PRS-PARAMETERS
if PRS-SIZE(2) = 3
if PRS-BUFFER(PRS-POSITION(2):PRS-SIZE(2)) = 'JOB'
move PRS-BUFFER(PRS-POSITION(1):PRS-SIZE(1))
to JCL-JOB-WORK
move 'Y' to SPS-QUIT
end-if
end-if
else
move 'N' to SPS-QUIT
exit.
*****************************************************************
POSSIBLE-SET-STATEMENT.
move '0' to PRS-REQUEST
add 80 to ZERO giving PRS-BUFFER-SIZE
move SPACE to PRS-DELIMITER
move JCLOLD80-REC to PRS-BUFFER
if JCLOLD80-REC(1:2) = '//'
call 'SIMOPARS' using PRS-PARAMETERS
if PRS-SIZE(2) = 3
if PRS-BUFFER(PRS-POSITION(2):PRS-SIZE(2)) = 'SET'
perform POSSIBLE-SET-STATEMENT-02
end-if
end-if
else
move 'N' to SPS-QUIT
exit.
*****************************************************************
POSSIBLE-SET-STATEMENT-02.
move PRS-BUFFER(PRS-POSITION(1):PRS-SIZE(1))
to JCL-SET-WORK
move 'Y' to SPS-QUIT
if PRS-SIZE(3) > 0
if SUB-LAST-ELEMENT < SUB-TABLE-LIMIT
move PRS-BUFFER(PRS-POSITION(3):PRS-SIZE(3))
to WORK-64
add 1 to SUB-LAST-ELEMENT
add 1 to ZERO giving PT-1
add 1 to ZERO giving PT-2
move 'N' to EQUAL-SIGN
perform until PT-1 > PRS-SIZE(3)
or PT-1 > 64
if WORK-64(PT-1:1) = '='
add 1 to PT-1
move 'Y' to EQUAL-SIGN
add 1 to ZERO giving PT-2
end-if
if EQUAL-SIGN = 'Y'
move WORK-64(PT-1:1) to WORK-48(PT-2:1)
add 1 to PT-1
add 1 to PT-2
else
move WORK-64(PT-1:1) to WORK-10(PT-2:1)
add 1 to PT-1
add 1 to PT-2
end-if
end-perform
move WORK-10 to SUB-KEYWORD(SUB-LAST-ELEMENT)
move WORK-48 to SUB-VALUE(SUB-LAST-ELEMENT)
subtract 1 from PT-2
giving SUB-LENGTH(SUB-LAST-ELEMENT)
end-if
end-if
exit.
*****************************************************************
PROCESS-DCB-INFO.
move 'P' to QUIT-PERFORM
add 1 to ZERO giving IX-1
add 1 to ZERO giving IX-2
perform until QUIT-PERFORM = 'Q'
evaluate DCB-INFO(IX-1:6)
when 'DSORG=' perform PROCESS-DCB-INFO-DSORG
when 'RECFM=' perform PROCESS-DCB-INFO-RECFM
when 'LRECL=' perform PROCESS-DCB-INFO-LRECL
end-evaluate
add 1 to IX-1
if IX-1 > 50
move 'Q' to QUIT-PERFORM
end-if
end-perform
exit.
*---------------------------------------------------------------*
PROCESS-DCB-INFO-DSORG.
add 6 to IX-1
move DCB-INFO(IX-1:8) to DCB-DSORG
inspect DCB-DSORG
replacing characters by SPACE after ','
inspect DCB-DSORG replacing all ',' by SPACE
inspect DCB-DSORG replacing all ')' by SPACE
exit.
*---------------------------------------------------------------*
PROCESS-DCB-INFO-RECFM.
add 6 to IX-1
move DCB-INFO(IX-1:8) to DCB-RECFM
inspect DCB-RECFM
replacing characters by SPACE after ','
inspect DCB-RECFM replacing all ',' by SPACE
inspect DCB-RECFM replacing all ')' by SPACE
exit.
*---------------------------------------------------------------*
PROCESS-DCB-INFO-LRECL.
add 6 to IX-1
move DCB-INFO(IX-1:5) to WORK-05
inspect WORK-05
replacing characters by SPACE after ','
inspect WORK-05 replacing all ',' by SPACE
inspect WORK-05 replacing all ')' by SPACE
perform RIGHT-ADJUST-WORK-05
move WORK-05 to DCB-LRECL-ALPHA
exit.
*****************************************************************
PROCESS-INSTREAM-DATA.
if EXEC-NAME = 'IDCAMS '
or EXEC-NAME = '*IDCAMS '
perform PROCESS-INSTREAM-DATA-IDCAMS
end-if
exit.
*---------------------------------------------------------------*
PROCESS-INSTREAM-DATA-IDCAMS.
if BF-DEBUG > 1
display EXEC-NAME ' ' JCLOLD80-REC(1:68)
end-if
add 72 to ZERO giving PRS-BUFFER-SIZE
move SPACE to PRS-DELIMITER
move JCLOLD80-REC(1:72) to PRS-BUFFER
move ZERO to PAREN-COUNT
add 1 to ZERO giving MX-1
perform until MX-1 > 72
if PRS-BUFFER(MX-1:1) = '('
and PAREN-COUNT = 0
add 1 to PAREN-COUNT
end-if
if PRS-BUFFER(MX-1:1) = ')'
and PAREN-COUNT > 0
subtract 1 from PAREN-COUNT
end-if
if PAREN-COUNT = 1
and IDCAMS-FUNCTION = 'DEFINE '
and PRS-BUFFER(MX-1:1) = SPACE
move ',' to PRS-BUFFER(MX-1:1)
end-if
add 1 to MX-1
end-perform
move SPACE to PRS-DELIMITER
call 'SIMOPARS' using PRS-PARAMETERS
move SPACES to WORK-08
add 1 to ZERO giving IX-1
add 1 to ZERO giving IX-2
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) < 8
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-08
evaluate WORK-08
when 'DELETE ' move WORK-08 to IDCAMS-FUNCTION
add 1 to IX-1
when 'DEFINE ' move WORK-08 to IDCAMS-FUNCTION
add 1 to IX-1
if EXEC-NAME = SPACES
move '*IDCAMS ' to EXEC-NAME
end-if
move ZERO to BF-SYSOUT
end-evaluate
end-if
if IDCAMS-FUNCTION = 'DEFINE '
* and IDCAMS-DATA-TYPE = SPACES
if PRS-POSITION(IX-1) > 0
and PRS-SIZE(IX-1) < 9
move SPACES to WORK-08
move PRS-BUFFER(PRS-POSITION(IX-1):PRS-SIZE(IX-1))
to WORK-08
inspect WORK-08 replacing all '(' by SPACE
evaluate WORK-08
when 'CLUSTER ' move WORK-08 to IDCAMS-DATA-TYPE
add 1 to IX-1
move 'VSAM' to IDCAMS-DSORG
when 'DATA ' move WORK-08 to IDCAMS-DATA-TYPE
add 1 to IX-1
when 'INDEX ' move WORK-08 to IDCAMS-DATA-TYPE
add 1 to IX-1
move 'KSDS' to IDCAMS-RECFM
end-evaluate
end-if
end-if
if IDCAMS-FUNCTION = 'DEFINE '
and IDCAMS-DATA-TYPE = 'CLUSTER '
add PRS-POSITION(IX-1) to ZERO giving T-POS
add PRS-SIZE(IX-1) to ZERO giving T-LEN
if T-POS > 0
and T-LEN < 65
move SPACES to WORK-64
if PRS-BUFFER(T-POS:1) = '('
move PRS-BUFFER(T-POS + 1:T-LEN - 1)
to WORK-64
else
move PRS-BUFFER(T-POS:T-LEN)
to WORK-64
end-if
perform PROCESS-INSTREAM-DATA-IDCAMS-C
end-if
end-if
if IDCAMS-FUNCTION = 'DEFINE '
and IDCAMS-DATA-TYPE = 'DATA '
add PRS-POSITION(IX-1) to ZERO giving T-POS
add PRS-SIZE(IX-1) to ZERO giving T-LEN
if T-POS > 0
and T-LEN < 65
move SPACES to WORK-64
if PRS-BUFFER(T-POS:1) = '('
move PRS-BUFFER(T-POS + 1:T-LEN - 1)
to WORK-64
else
move PRS-BUFFER(T-POS:T-LEN)
to WORK-64
end-if
perform PROCESS-INSTREAM-DATA-IDCAMS-D
end-if
end-if
if IDCAMS-FUNCTION = 'DEFINE '
and IDCAMS-DATA-TYPE = 'INDEX '
add PRS-POSITION(IX-1) to ZERO giving T-POS
add PRS-SIZE(IX-1) to ZERO giving T-LEN
if T-POS > 0
and T-LEN < 65
move SPACES to WORK-64
if PRS-BUFFER(T-POS:1) = '('
move PRS-BUFFER(T-POS + 1:T-LEN - 1)
to WORK-64
else
move PRS-BUFFER(T-POS:T-LEN)
to WORK-64
end-if
perform PROCESS-INSTREAM-DATA-IDCAMS-I
end-if
end-if
exit.
*---------------------------------------------------------------*
PROCESS-INSTREAM-DATA-IDCAMS-C.
inspect WORK-64 replacing all ')' by SPACE
if WORK-64(1:5) = 'NAME('
inspect WORK-64
replacing characters by SPACE after initial SPACE
move WORK-64(6:57) to IDCAMS-CLUSTER-NAME
inspect IDCAMS-CLUSTER-NAME replacing all ')' by SPACE
end-if
if WORK-64(1:7) = 'INDEXED'
move 'VSAM' to IDCAMS-DSORG
move 'KSDS' to IDCAMS-RECFM
end-if
if WORK-64(1:10) = 'NONINDEXED'
move 'VSAM' to IDCAMS-DSORG
move 'ESDS' to IDCAMS-RECFM
end-if
perform PROCESS-INSTREAM-DATA-IDCAMS-D
exit.
*---------------------------------------------------------------*
PROCESS-INSTREAM-DATA-IDCAMS-D.
inspect WORK-64 replacing all ')' by SPACE
* inspect WORK-64
* replacing characters by SPACE after initial SPACE
if WORK-64(1:5) = 'NAME('
move WORK-64(6:57) to IDCAMS-DATA-NAME
inspect IDCAMS-DATA-NAME replacing all ')' by SPACE
end-if
if WORK-64(1:5) = 'KEYS('
add 6 to ZERO giving IX-1
move WORK-64(IX-1:5) to WORK-05
inspect WORK-05 replacing characters by SPACE after ','
inspect WORK-05 replacing characters by SPACE after ' '
inspect WORK-05 replacing all ',' by SPACE
inspect WORK-05 replacing all ')' by SPACE
perform RIGHT-ADJUST-WORK-05
move WORK-05 to IDCAMS-KLEN-ALPHA
* Find the comma...
move 'N' to QUIT-PERFORM
perform until QUIT-PERFORM = 'Y'
if WORK-64(IX-1:1) < 0
or WORK-64(IX-1:1) > 9
move 'Y' to QUIT-PERFORM
end-if
add 1 to IX-1
end-perform
move WORK-64(IX-1:5) to WORK-05
inspect WORK-05 replacing characters by SPACE after ','
inspect WORK-05 replacing characters by SPACE after ' '
inspect WORK-05 replacing characters by SPACE after ')'
inspect WORK-05 replacing all ',' by SPACE
inspect WORK-05 replacing all ')' by SPACE
perform RIGHT-ADJUST-WORK-05
move WORK-05 to IDCAMS-KPOS-ALPHA
add 1 to IDCAMS-KPOS
end-if
if WORK-64(1:11) = 'RECORDSIZE('
or WORK-64(1:6) = 'RECSZ('
add 7 to ZERO giving IX-1
if WORK-64(1:11) = 'RECORDSIZE('
add 5 to IX-1
end-if
move WORK-64(IX-1:5) to WORK-05
inspect WORK-05 replacing characters by SPACE after ','
inspect WORK-05 replacing characters by SPACE after ' '
inspect WORK-05 replacing all ',' by SPACE
inspect WORK-05 replacing all ')' by SPACE
perform RIGHT-ADJUST-WORK-05
move WORK-05 to IDCAMS-LRECL-MIN-ALPHA
* Find the comma...
move 'N' to QUIT-PERFORM
perform until QUIT-PERFORM = 'Y'
if WORK-64(IX-1:1) < 0
or WORK-64(IX-1:1) > 9
move 'Y' to QUIT-PERFORM
end-if
add 1 to IX-1
end-perform
move WORK-64(IX-1:5) to WORK-05
inspect WORK-05 replacing characters by SPACE after ','
inspect WORK-05 replacing characters by SPACE after ' '
inspect WORK-05 replacing characters by SPACE after ')'
inspect WORK-05 replacing all ',' by SPACE
inspect WORK-05 replacing all ')' by SPACE
perform RIGHT-ADJUST-WORK-05
move WORK-05 to IDCAMS-LRECL-MAX-ALPHA
end-if
exit.
*---------------------------------------------------------------*
PROCESS-INSTREAM-DATA-IDCAMS-I.
inspect WORK-64 replacing all ')' by SPACE
inspect WORK-64
replacing characters by SPACE after initial SPACE
if WORK-64(1:5) = 'NAME('
move WORK-64(6:57) to IDCAMS-INDEX-NAME
inspect IDCAMS-INDEX-NAME replacing all ')' by SPACE
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... *
*****************************************************************
JCLOLD80-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close JCLOLD80-FILE
if JCLOLD80-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 JCLOLD80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLOLD80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
JCLOLD80-READ.
read JCLOLD80-FILE
if JCLOLD80-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if JCLOLD80-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 JCLOLD80-EOF
else
move 'READ Failure with JCLOLD80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLOLD80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
JCLOLD80-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input JCLOLD80-FILE
if JCLOLD80-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to JCLOLD80-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with JCLOLD80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLOLD80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
JCLNEW80-WRITE.
if JCLNEW80-OPEN-FLAG = 'C'
perform JCLNEW80-OPEN
end-if
write JCLNEW80-REC
if JCLNEW80-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if JCLNEW80-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 JCLNEW80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLNEW80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
JCLNEW80-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT JCLNEW80-FILE
if JCLNEW80-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to JCLNEW80-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with JCLNEW80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLNEW80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
JCLNEW80-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close JCLNEW80-FILE
if JCLNEW80-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to JCLNEW80-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with JCLNEW80' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move JCLNEW80-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
JCLNEW80-REC-INIT.
initialize JCLNEW80-REC
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
GOBACK.
* STOP RUN.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
COBOL Parsing Routine
The following (SIMOPARS.cbl) is the source code for the COBOL program that does the parsing of the JCL Statements within a JCL Member. It is called from the primary program, the parsing information is posted to the pass area and control is returned to the primary program.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOPARS.
AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: SIMOPARS.CBL
* Copy Files PASSPARS.CPY
*****************************************************************
*
* SIMOPARS - Parse Buffer defined in pass area.
*
* CALLING PROTOCOL
* ----------------
* call 'SIMOPARS' using PRS-PARAMETERS
*
* 01 PRS-PARAMETERS.
* 05 PRS-REQUEST PIC X VALUE '0'.
* 05 PRS-STATUS PIC 9(4).
* 05 PRS-DELIMITER PIC X VALUE SPACE.
* 05 PRS-KEEP-NULL-FIELDS PIC X VALUE 'N'.
* 05 PRS-SUSPEND PIC X VALUE 'N'.
* 05 PRS-SUSPEND-BYTE PIC X VALUE SPACE.
* 05 PRS-TERMINATOR PIC X VALUE 'N'.
* 05 PRS-TERMINATOR-BYTE PIC X VALUE SPACE.
* 05 PRS-BUFFER-SIZE PIC 9(4) VALUE 2048.
* 05 PRS-BUFFER PIC X(2048).
* 05 PRS-TABLE-MAX PIC 9(4) VALUE 128.
* 05 PRS-NUMBER-OF-ITEMS PIC 9(4) VALUE 0.
* 05 PRS-LAST-SIG-BYTE PIC 9(4) VALUE 0.
* 05 PRS-POSITION OCCURS 128 TIMES
* PIC 9(4) VALUE 0.
* 05 PRS-SIZE OCCURS 128 TIMES
*
* This routine uses reference modification to identify the
* position of the first significant character after the
* delimiter character. This approach compensates for multiple
* leading or embedded delimiter characters. The string function
* of COBOL does not handle leading spaces.
*
* For example, if the delimiter character is a space then
* leading spaces will be ignored and multiple, embedded spaces
* will be treated as a single space.
*
* MAINTENANCE
* -----------
* 1998/01/02 Simmons, CREATED PROGRAM.
* 1998/01/02 Simmons, No changes to date...
*
*****************************************************************
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Program use... *
*****************************************************************
01 I-PTR pic 9(4) value 0.
01 O-PTR pic 9(4) value 0.
01 B-COUNT pic 9(4) value 0.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOPARS '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
LINKAGE SECTION.
COPY PASSPARS.
*****************************************************************
PROCEDURE DIVISION using PRS-PARAMETERS.
if PRS-REQUEST not = '2'
perform EDIT-LINKAGE-ITEMS
end-if
add 8 to ZERO giving RETURN-CODE
add 9 to ZERO giving PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
evaluate PRS-REQUEST
when '0' perform PARSE-BUFFER
when '1' perform INITIALIZE-TABLE-ELEMENTS
when '2' perform INITIALIZE-DEFAULT-VALUES
when OTHER add 12 to ZERO giving PRS-STATUS
end-evaluate
if PRS-STATUS = 9
subtract PRS-STATUS from PRS-STATUS
end-if
GOBACK.
*****************************************************************
EDIT-LINKAGE-ITEMS.
if PRS-TABLE-MAX not numeric
add 128 to ZERO giving PRS-TABLE-MAX
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-TABLE-MAX > 128
add 128 to ZERO giving PRS-TABLE-MAX
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE not numeric
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE > 2048
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
INITIALIZE-DEFAULT-VALUES.
move ',' to PRS-DELIMITER
move 'Y' to PRS-SPACE-TRUNCATION
move 'Y' to PRS-KEEP-NULL-FIELDS
add 128 to ZERO giving PRS-TABLE-MAX
add 2048 to ZERO giving PRS-BUFFER-SIZE
perform INITIALIZE-TABLE-ELEMENTS
move '0' to PRS-REQUEST
move ZERO to PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
move ZERO to PRS-LAST-SIG-BYTE
exit.
*****************************************************************
INITIALIZE-TABLE-ELEMENTS.
move 1 to I-PTR
move 1 to O-PTR
perform until O-PTR > PRS-TABLE-MAX
move 0 to PRS-POSITION(O-PTR)
move 0 to PRS-SIZE(O-PTR)
add 1 to O-PTR
end-perform
subtract RETURN-CODE from RETURN-CODE
exit.
*****************************************************************
PARSE-BUFFER.
*! Initialize Position/Length tables to zero (0).
perform INITIALIZE-TABLE-ELEMENTS
move ZERO to PRS-LAST-SIG-BYTE
*! Parse the Buffer.
add 1 to ZERO giving O-PTR
perform until I-PTR > PRS-BUFFER-SIZE
perform PARSE-BUFFER-10
end-perform
* Wrap-up the parse of this buffer...
if PRS-LAST-SIG-BYTE > 0
and PRS-BUFFER(PRS-LAST-SIG-BYTE:1) not = PRS-DELIMITER
add 1 to PRS-NUMBER-OF-ITEMS
end-if
if PRS-POSITION(O-PTR) = 0
subtract 1 from O-PTR
end-if
subtract RETURN-CODE from RETURN-CODE
exit.
*---------------------------------------------------------------*
PARSE-BUFFER-10.
if PRS-BUFFER(I-PTR:1) not = SPACE
add I-PTR to ZERO giving PRS-LAST-SIG-BYTE
end-if
if PRS-BUFFER(I-PTR:1) = PRS-DELIMITER
add 1 to B-COUNT
if PRS-KEEP-NULL-FIELDS = 'Y'
or B-COUNT = 1
and PRS-SIZE(O-PTR) > 0
if O-PTR < PRS-TABLE-MAX
add 1 to O-PTR
add 1 to PRS-NUMBER-OF-ITEMS
else
move PRS-BUFFER-SIZE to I-PTR
end-if
end-if
else
subtract B-COUNT from B-COUNT
add 1 to PRS-SIZE(O-PTR)
if PRS-SIZE(O-PTR) = 1
move I-PTR to PRS-POSITION(O-PTR)
end-if
end-if
add 1 to I-PTR
if PRS-TERMINATOR = 'Y'
and I-PTR not > PRS-BUFFER-SIZE
and PRS-BUFFER(I-PTR:1) = PRS-TERMINATOR-BYTE
if PRS-SIZE(O-PTR) > 0
add 1 to PRS-NUMBER-OF-ITEMS
end-if
add PRS-BUFFER-SIZE to 1 giving I-PTR
end-if
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.
*****************************************************************
* This example is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Note: The SIMOPARS program is part of the SIMOMODS suite of shared or common modules available from SimoTime.
COBOL Substitution Routine
The following (SIMOSUB1.cbl) is the source code for the COBOL program that does the parameter search and possible replacement within JCL Statements. It is called from the primary program, the parsing information is posted to the pass area and control is returned to the primary program.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOSUB1.
*AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy and modify this software for any *
* non-commercial purpose and without fee is hereby granted, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: SIMOSUB1.CBL
*****************************************************************
*
* SIMOSUB1 - String replacement of varying lengths.
*
* CALLING PROTOCOL
* ----------------
* Use standard procedure to RUN or ANIMATE.
*
* DESCRIPTION
* -----------
* This program provides an example of how to replace a text
* string with is field with a text string of a different length.
*
* ************
* * CBLREPJ1 *
* ********jcl*
* *
* *
* ************ ************
* * CBLREPC1 *-----* CONSOLE *
* *---call---* ******dsply*
* * SIMOSUB1 *
* ********cbl*
* *
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1987/05/22 Simmons, Created program.
* 1994/04/17 Simmons, Updated for PC.
*
*****************************************************************
*
ENVIRONMENT DIVISION.
DATA DIVISION.
*****************************************************************
WORKING-STORAGE SECTION.
01 I-1 pic 9(5) value 0.
01 I-2 pic 9(5) value 0.
01 SUB-PTR pic 9(5) value 0.
01 SOURCE-SIZE pic 9(5) value 0.
01 TARGET-SIZE pic 9(5) value 0.
*****************************************************************
LINKAGE SECTION.
COPY PASSSUB1.
*****************************************************************
PROCEDURE DIVISION using SUBSTITUTE-PARAMETERS.
if SUB-SEARCH-LENGTH = SUB-REPLACE-LENGTH
move SUB-BUFFER-SOURCE to SUB-BUFFER-TARGET
inspect SUB-BUFFER-TARGET replacing
all SUB-SEARCH-STRING(1:SUB-SEARCH-LENGTH)
by SUB-REPLACE-STRING(1:SUB-REPLACE-LENGTH)
else
perform INSPECT-AND-REPLACE-EXTENDED
end-if
GOBACK.
*****************************************************************
INSPECT-AND-REPLACE-EXTENDED.
add length of SUB-BUFFER-SOURCE to ZERO giving SOURCE-SIZE
add length of SUB-BUFFER-TARGET to ZERO giving TARGET-SIZE
add 1 to ZERO giving I-1
add 1 to ZERO giving I-2
perform until I-1 > SOURCE-SIZE - SUB-SEARCH-LENGTH
or I-2 > TARGET-SIZE - SUB-REPLACE-LENGTH
if SUB-BUFFER-SOURCE(I-1:1) not = SUB-SEARCH-STRING(1:1)
move SUB-BUFFER-SOURCE(I-1:1)
to SUB-BUFFER-TARGET(I-2:1)
add 1 to I-1
add 1 to I-2
else
if SUB-BUFFER-SOURCE(I-1:SUB-SEARCH-LENGTH)
not = SUB-SEARCH-STRING
move SUB-BUFFER-SOURCE(I-1:1)
to SUB-BUFFER-TARGET(I-2:1)
add 1 to I-1
add 1 to I-2
else
move SUB-REPLACE-STRING
to SUB-BUFFER-TARGET(I-2:SUB-REPLACE-LENGTH)
add SUB-SEARCH-LENGTH to I-1
add SUB-REPLACE-LENGTH to I-2
end-if
end-if
end-perform
exit.
*****************************************************************
* This example is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Note: The SIMOSUB1 program is part of the SIMOMODS suite of shared or common modules available from SimoTime.
Summary
The ++INCLUDE is a function that is supported by CA-Panvalet for JCL Members stored and used on an IBM Mainframe. This document may serve as a tutorial for new programmers or as a quick reference for experienced programmers.
In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.
SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the Contact or Feedback section of this document.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the 
icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the 
icon.
Explore the JCL Connection for more examples of JCL functionality with programming techniques and sample code.
Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore An Enterprise System Model that describes and demonstrates how Applications that were running on a Mainframe System and non-relational data that was located on the Mainframe System were copied and deployed in a Microsoft Windows environment with Micro Focus Enterprise Server.
Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.
Explore The File Status Return Codes that are used to interpret the results of accessing VSAM data sets and/or QSAM files.
Internet Access Required
The following links will require an internet connect.
This suite of programs and documentation is available to download for review and evaluation purposes. Other uses will require a SimoTime Software License. Link to an Evaluation zPAK Option that includes the program members, documentation and control files.
A good place to start is The SimoTime Home Page for access to white papers, program examples and product information. This link requires an Internet Connection
Explore The Micro Focus Web Site for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Contact or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
| 1. | Send an e-mail to our helpdesk. |
| 1.1. | helpdesk@simotime.com. |
| 2. | Our telephone numbers are as follows. |
| 2.1. | 1 415 763-9430 office-helpdesk |
| 2.2. | 1 415 827-7045 mobile |
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Scan JCL Members and replace ++INCLUDE with Standard JCL Statements |
| Copyright © 1987-2024 SimoTime Technologies and Services All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |