 |
 |
 |
|
|
|
|
|
|---|
|
This program reads the input from the portfolio ISPF panel example, substitutes values in the ISPF JCL
skeleton example and generates the IMS Image Copy utility jobs in the REXX output example. |
/**************** REXX ****************/
/* This REXX processes Option "O" from the main menu and
build JCL for the IMS Online Image Copy utility */
/* Allocate the Dialog Manager data sets under TSO */
ADDRESS TSO
"ALLOC DATASET(ISPPLIB) DDNAME(ISPPLIB) SHR REUSE"
"ALLOC DATASET(ISPSLIB) DDNAME(ISPSLIB) SHR REUSE"
/* Allocate the Dialog Manager data sets under ISPF */
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID(ISPPLIB)"
"LIBDEF ISPSLIB DATASET ID(ISPSLIB)"
/* Get the invoking TSO userid */
TSOUID = USERID()
/* Display the Online Image Copy utility input panel */
PANL:
ADDRESS ISPEXEC
"DISPLAY PANEL(IMAGECPY)"
/* Test if the user pressed the PF3 END key. If the DISPLAY
PANEL return code was not 0 display the IMAGECPY panel
again */
IF PFKEY = 'END'
THEN SIGNAL PGMEXIT
ELSE IF RC \= 0
THEN SIGNAL PANL
ELSE NOP
/* If the user entered P to indicate a production application
then expand the variable to PROD, otherwise, default to TEST
IMS applications */
IF IMSSYS = 'P'
THEN IMSSYS = 'PROD'
ELSE IMSSYS = 'TEST'
/* Test the Schedule input field and place the correct literal
into the schedule variable */
IF JSCHED = 'D'
THEN SCHEDLIT = 'DAILY'
ELSE IF JSCHED = 'W'
THEN SCHEDLIT = 'WEEKLY'
ELSE IF JSCHED = 'M'
THEN SCHEDLIT = 'MONTHLY'
/* Get the date in format yyyymmdd and reformat it as
mm/dd/yyyy */
TEMP = DATE('S')
DATVAR = SUBSTR(TEMP,5,2) ]] '/' ]],
SUBSTR(TEMP,7,2) ]] '/' ]] SUBSTR(TEMP,1,4)
/* Allocate the REXX statements data set under TSO */
EXECUTE = '"ALLOC',
'DSNAME(''' ]] USERID() ]] '.IMSCNTL' ]],
''')' 'DDNAME(IMSCNTL) SHR REUSE"'
ADDRESS TSO
INTERPRET EXECUTE
/* Read the REXX assignment statements onto the stack. In this
example, data set TSOUID.IMSCNTL contains the following
assignment statements
IMSSYSID = USERID() ]] '.IMSSYSID'
JCLCC = USERID() ]] '.JCLCC'
JCL = USERID() ]] '.JCL'
ENDEVLIB = 'SYST.ENDEVOR.LOADLIB'
IMSDYN = 'IMST.DYNLIB'
IMSRES = 'IMST.RESLIB'
IMSBMC = 'SYST.BMC.LOADLIB'
IMSCOB2 = 'SYS1.COB2LIB'
IMSDBD = 'IMST.DBDLIB'
IMSPSB = 'IMST.PSBLIB'
IMSPROC = 'IMST.PROCLIB' */
NEWSTACK
"EXECIO * DISKR IMSCNTL 1 (FIFO OPEN)"
/* Test the EXECIO return code. If non-zero, close the control
data set and display an error message. If return code is 0,
close the variable control data set and continue */
IF RC \= 0
THEN DO
"EXECIO * DISKR IMSCNTL (FINIS)"
ADDRESS ISPEXEC
SAY 'ERROR READING IMS CONTROL FILE'
SIGNAL PANL
END
ELSE "EXECIO * DISKR IMSCNTL (FINIS)"
/* Get the number of lines read onto the stack. If the line
count is 0, display an error message. If the line count is
greater than 0, continue */
LINENO = QUEUED()
IF LINENO \> 0
THEN DO
SAY 'NO DATA IN IMS CONTROL FILE'
SIGNAL PANL
END
ELSE NOP
/* Pull the REXX assignment statements off the stack and
INTERPRET the statements to assign data set names to program
variables. In our example, the assignment statements are:
IMSSYSID = TSOUID.IMSSYSID
JCLCC = TSOUID.JCLCC
JCL = TSOUID.JCL
ENDEVLIB = 'SYST.ENDEVOR.LOADLIB'
IMSDYN = 'IMST.DYNLIB'
IMSRES = 'IMST.RESLIB'
IMSBMC = 'SYST.BMC.LOADLIB'
IMSCOB2 = 'SYS1.COB2LIB'
IMSDBD = 'IMST.DBDLIB'
IMSPSB = 'IMST.PSBLIB'
IMSPROC = 'IMST.PROCLIB'
After all the lines are INTERPRETed, delete the stack */
DO I = 1 TO LINENO
PULL EXECUTE
INTERPRET EXECUTE
END
DELSTACK
/* Allocate the IMS data base control file which contains
variable information for the different IMS applications.
The data set name was in one of the assignment
statements INTERPRETed above */
EXECUTE = '"ALLOC',
'DSNAME(''' ]] IMSSYSID ]] ''')',
'DDNAME(IMSSYSID) SHR REUSE"'
ADDRESS TSO
INTERPRET EXECUTE
/* Test the ALLOCATE return code. If not 0, display an error
message and exit. If return code is 0, then continue */
IF RC \= 0
THEN DO
SAY 'CONTROL FILE ALLOCATE FAILED'
EXIT
END
ELSE NOP
/* Read the IMS application control information onto the stack.
In our example, the data set TSOUID.IMSSYSID contains:
AP DBDACPAY IMS.TEST.ACCOUNTS.PAYABLE
AR DBDACREC IMS.TEST.ACCOUNTS.RECEIVE
PL DBDPLAN IMS.TEST.PLANNING
PY DBDPAYRO IMS.TEST.PAYROLL
RE DBDRESR IMS.TEST.RESEARCH
TX DBDTAX IMS.TEST.TAX */
NEWSTACK
"EXECIO * DISKR IMSSYSID 1 (FIFO OPEN)"
/* Test the EXECIO return code. If non-zero, close the IMS
control data set and display an error message. If return code
is 0, close the IMS control data set */
IF RC \= 0
THEN DO
"EXECIO * DISKR IMSSYSID (FINIS)"
ADDRESS ISPEXEC
SAY 'ERROR READING IMS APPLICATION FILE'
SIGNAL PANL
END
ELSE "EXECIO * DISKR IMSSYSID (FINIS)"
/* Get the number of IMS application lines on the stack. If
there are no lines, then display an error message and exit.
If there are lines on the stack, then continue. */
L = QUEUED()
IF L \> 0
THEN DO
SAY 'NO LINES IN IMS APPLICATION FILE'
EXIT
END
ELSE NOP
/* Create the dialog manager table that will contain the IMS
control variables. The variable are IMS application ID, IMS
DBD name, IMS data set name. The table key is the IMS
application ID. */
ADDRESS ISPEXEC
EXECUTE = '"TBCREATE IMSTBL'
EXECUTE = EXECUTE 'KEYS(TIMSID)'
EXECUTE = EXECUTE 'NAMES(TDBDNAM TDSNAM)'
EXECUTE = EXECUTE 'REPLACE NOWRITE"'
INTERPRET EXECUTE
/* Pull each line from the stack and parse it into the table
variables. Add the table row. Decrement the number of lines
of the stack and continue pulling the lines until the entire
table is built, i.e., L=0 */
TBLPULL:
PULL TIMSID TDBDNAM TDSNAM
"TBADD IMSTBL"
L = L - 1
IF L > 0
THEN SIGNAL TBLPULL
ELSE NOP
/* Delete the stack after all the lines are processed */
TBLDONE:
ADDRESS TSO
"DELSTACK"
/* Find the IMS application ID that the user keyed into the panel
in the IMS application table. If the application ID is found,
get the table row */
ADDRESS ISPEXEC
"TBTOP IMSTBL"
TIMSID = IMSID
"TBSCAN IMSTBL ARGLIST(TIMSID) CONDLIST(EQ)"
IF RC \= 0
THEN DO
SAY 'IMS APPLICATION ID NOT FOUND'
SIGNAL PANL
END
ELSE NOP
"TBGET IMSTBL"
/* If JCC is Y(es) then build the control card member name. IC
at the end of the member name represents image copy For prod
tax system with no duplicate copy the name is PTX0IC. For test
tax system with a duplicate copy the name is TTXDIC. */
CCMEMBER = SUBSTR(IMSSYS,1,1) ]] TIMSID ]] JDUP ]] 'IC'
/* Build the JCL member name. For prod payroll system with no
duplicate copy and default job character and suffix character
the name is PPY00O. For test payroll system with a duplicate
copy and default job character and suffix character the name
is TPYD0O. Build the JCL jobname */
JCLMEMBR = CCMEMBER
JNAME = SUBSTR(IMSSYS,1,1) ]] TIMSID ]] JDUP ]]
JCHAR ]] JSUF
/* If user entered Y in JCC build the utility control cards by
using the control card skeleton in .ISPSLIB(ICCC) and writing
the control cards to a temporary data set. The name of the
temporary data set is in variable ZTEMPF. Copy the control
cards from the temporary data set to the permanent control
card data set. Display the control cards to the user in the
event the user wants to edit them */
IF JCC = 'Y'
THEN DO
ADDRESS ISPEXEC
"FTOPEN TEMP"
"FTINCL ICCC"
"FTCLOSE"
"VGET (ZTEMPF) SHARED"
ADDRESS TSO
JCLCCDSN = JCLCC ]] '(' ]] CCMEMBER ]] ')'
EXECUTE = '"SMCOPY FDS(''' ]] ZTEMPF ]] ''')'
EXECUTE = EXECUTE 'TDS(''' ]] JCLCCDSN ]] ''')"'
INTERPRET EXECUTE
EXECUTE = '"EDIT DATASET('''
EXECUTE = EXECUTE ]] JCLCCDSN ]] ''')"'
ADDRESS ISPEXEC
INTERPRET EXECUTE
END
ELSE NOP
/* Build the Image Copy job JCL by using the JCL skeleton in
.ISPSLIB(ICJCL) and write the JCL to a temporary data set.
Copy the temporary data set to a permanent data set member.
Display the JCL to the user in the event the user wants to
edit them */
ADDRESS ISPEXEC
"FTOPEN TEMP"
"FTINCL ICJCL"
"FTCLOSE"
"VGET (ZTEMPF) SHARED"
ADDRESS TSO
JCLDSN = JCL ]] '(' ]] JNAME ]] ')'
EXECUTE = '"SMCOPY FDS(''' ]] ZTEMPF ]] ''')'
EXECUTE = EXECUTE 'TDS(''' ]] JCLDSN ]] ''')"'
INTERPRET EXECUTE
EXECUTE = '"EDIT DATASET('''
EXECUTE = EXECUTE ]] JCLDSN ]] ''')"'
ADDRESS ISPEXEC
INTERPRET EXECUTE
/* After the JCL and control cards are saved, delete the table
and display the Image Copy panel again until the user presses
the PF3-END key while viewing the panel */
"TBEND IMSTBL"
SIGNAL PANL
/* Come here when the user presses the PF3-END key to end the
program. Free and deallocate the data sets then return */
PGMEXIT:
ADDRESS ISPEXEC
"LIBDEF ISPSLIB"
"LIBDEF ISPPLIB"
ADDRESS TSO
"FREE DDNAME(ISPSLIB)"
"FREE DDNAME(ISPPLIB)"
RETURN
|