A Function Provided by CA-Panvalet
|
The ++INCLUDE Statement in JCL A Function Provided by CA-Panvalet |
| When technology complements business | Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
| The SimoTime Home Page |
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.
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.
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 |
This section describes the source code before and after the scan and replace processing.
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 |
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. |
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 Enterprises *
rem * (C) Copyright 1987-2012 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%\DatalibA\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%
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
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
pause
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
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 Enterprises *
rem * (C) Copyright 1987-2012 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 Enterprises
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
This section provides additional detail about the secondary CMD files and programs that are used in this set of sample programs.
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 Enterprises *
rem * (C) Copyright 1987-2012 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 Enterprises
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 BaseLib1=c:\SimoSAM1\DEVL
set BaseLib8=c:\SimoSAM8
set SAM1ANIM=C:\SIMOSAM1\DEVL\SAM1SOL1\SAMBATG1\bin\x86\Debug
set BASEAPP=%BaseLib1%
set BASESYS=%BaseLib1%\SYS1
set BASECAT=%BaseLib1%\DATA
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\SYSOUT_SIMONOTE.TXT
set SimoNOTE=%BASEAPP%\LOGS\SYSOUT_SIMONOTE.TXT
set MIFOBASE="C:\Program Files (x86)\Micro Focus\Studio Enterprise Edition 6.0\Base"
set MIFOBIN=%MIFOBASE%\bin
rem *
set SimoLIBR=c:\SimoLIBR
set JESSERVERNAME=SIMOBATA
rem * set SIMOMODE=PAUSE
rem *
set MAINFRAME_FLOATING_POINT=true
set CobCpy=%BASEAPP%\CobCpy1;%BASEAPP%\CobCpy6;c:\SimoLIBR;%MIFOBASE%\SOURCE
set COBIDY=%BASEAPP%\COBIDY
rem * For large file support and record locking control of File Handler
set EXTFH=%BASESYS%\CONFIG\EXTFHBIG.CFG
rem * For Sort Resource Allocation and Performance
set SORTSPACE=1000000
set ES_ALLOC_OVERRIDE=%BASESYS%\CONFIG\CATMAPA1.cfg
set COBCONFIG_=%BASESYS%\CONFIG\diagnose.cfg
rem * Set environment for MFBSI (Micro Focus Batch Scheduling Interface)
set ES_EMP_EXIT_1=mfbsiemx
set MFBSI_DIR=%BASESYS%\LOGS\%ezServerName%
set MFBSIEOP_CMD=ENABLE
set MFBSIEOP_CSV=ENABLE
set MFBSIEOP_HTM=ENABLE
set MFBSIEOP_XML=ENABLE
rem * Set Behavior and Trace Flags for GETJOBDD
set JDDFLAGS=nnnWnnnn/nnnnnnnn
rem *
if "%SIMOPATH%" == "Y" goto JUMPPATH
set path=%MIFOBASE%;%MIFOBIN%;%PATH%;
set COBPATH=.;%BASEAPP%\LOADLIB;%BASESYS%\LOADLIB;C:\SimoLIBR
set LIBPATH=.;%BASEAPP%\LOADLIB;%BASESYS%\LOADLIB;C:\SimoLIBR
set TXDIR=%BASESYS%\LOADLIB;%MIFOBASE%
:JUMPPATH
set SIMOPATH=Y
set JobStatus=0000
call SimoNOTE "* Settings CmdName Env1BASE.CMD, Version 10.04.19"
call SimoNOTE "* BaseAPP is %BASEAPP%"
The following is a listing of the contents of the SimoNOTE.CMD command file.
@echo OFF rem * ******************************************************************* rem * This program is provided by SimoTime Enterprises * rem * (C) Copyright 1987-2012 All Rights Reserved * rem * Web Site URL: http://www.simotime.com * rem * e-mail: helpdesk@simotime.com * rem * ******************************************************************* rem * rem * Text - Display message on screen and write to a log file. rem * Author - SimoTime Enterprises rem * rem * This script may be called from other scripts and expects a 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
This section described the COBOL programs used by this suite of programs that scans JCL members and replaces ++INCLUDE statements with standard INCLUDE statements.
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 ENTERPRISES.
*****************************************************************
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* -------- -------- ------------ -------- ------- ------- *
* INPUT 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-RECORD.
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-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
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 Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
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 ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2012 SimoTime Enterprises. *
* *
* 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 expressed 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 *
* *
*****************************************************************
*
*****************************************************************
* 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 Offset/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 Enterprises *
* 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.
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 ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2012 SimoTime Enterprises. *
* *
* 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 Enterprises. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* Permission to use, copy 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 *
* Enterprises. *
* *
* SimoTime Enterprises 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 *
* 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 *
* *
*****************************************************************
*
*****************************************************************
* 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 *
* ********cbl* ******dsply*
* *
* *
* ************
* * SIMOSUB1 *
* ********cbl*
*
*****************************************************************
*
* 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
move SPACES to SUB-BUFFER-TARGET
subtract SUB-PTR from SUB-PTR
inspect SUB-BUFFER-SOURCE
tallying SUB-PTR
for CHARACTERS
before initial SUB-SEARCH-STRING(1:SUB-SEARCH-LENGTH)
if SUB-PTR < SOURCE-SIZE - 1
add 1 to SUB-PTR giving I-1
add 1 to SUB-PTR giving I-2
move SPACES to SUB-BUFFER-TARGET
move SUB-BUFFER-SOURCE(1:SUB-PTR) to SUB-BUFFER-TARGET
move SUB-REPLACE-STRING(1:SUB-REPLACE-LENGTH)
to SUB-BUFFER-TARGET(I-2:SUB-REPLACE-LENGTH)
add SUB-SEARCH-LENGTH to I-1
add SUB-REPLACE-LENGTH to I-2
move SUB-BUFFER-SOURCE(I-1:SOURCE-SIZE - I-1)
to SUB-BUFFER-TARGET(I-2:TARGET-SIZE - I-2)
else
move SUB-BUFFER-SOURCE to SUB-BUFFER-TARGET
end-if
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* 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.
The purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. In the world of programming there are many ways to solve a problem. This document and the links to other documents are intended to provide a choice of alternatives.
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Enterprises. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
This section includes links to documents with additional information that is beyond the scope and purpose of this document. The first sub-section requires an internet connection, the second sub-section references locally available documents.
Note: A SimoTime License is required for the items to be made available on a local server.
The following links will require an internet connect.
A good place to start is The SimoTime Home Page for access to white papers, program examples and product information.
This suite of programs and documentation is available for download. Link to an Evaluation zPAK Option that includes the program members, documentation and control files.
Explore The JCL Connection in the SimoTime Library for more examples of JCL coding techniques and batch utility programs.
Explore The COBOL Connection in the SimoTime Library for more examples of COBOL programming techniques and sample code.
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 to interpret the results of accessing VSAM data sets and QSAM files.
Explore The Micro Focus Web Site for more information about products and services available from Micro Focus.
The following links may be accessible without an internet connection.
Explore The File Status Return Codes to interpret the results of accessing VSAM data sets and QSAM files.
Check out The SimoTime Glossary for a list of terms and definitions used in the documents provided by SimoTime.
This document was created and is maintained by SimoTime Enterprises.
If you have any questions, suggestions, comments or feedback please call or send an e-mail to: helpdesk@simotime.com
We appreciate hearing from you.
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Scan JCL Members and replace ++INCLUDE with Standard JCL Statements |
| Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |