|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/**********************************************************************
/* UTILITY: BINDCARD *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: THIS UTILITY GENERATES BIND PLAN CARDS AND ENDEVOR SCL *
/* FROM REQUESTS ENTERED ON A PANEL BY PROGRAMMERS. THESE *
/* BIND CARDS ARE THEN ENTERED INTO ENDEVOR BY THE DBA'S *
/* USING THE ENDEVOR SCL WHICH IS ALSO GENERATED. *
/**********************************************************************
PROC 0 TEMPJCL('&SYSUID..TEMP.BINDCARD.JCL') +
TEMPFILE(&SYSUID..TEMP.ENDEVOR) +
ENVIRON(QUAL) +
STAGE(D) +
TYPE(BINDBTCH) +
SYSTEM(STR) +
SUBSYS(UNIPAC) +
OWNER(BINDADM) +
VALIDATE(BIND) +
RETAIN(RETAIN) +
NUMAPPL(15) +
SENDDEST('D@UDAL D@UJEF D@ULJS') +
HELP
/**********************************************************************
/* MISCELLANEOUS INITIALIZATION *
/**********************************************************************
ISPEXEC CONTROL ERRORS RETURN
ISPEXEC VGET DBGSWTCH PROFILE 02
IF &DBGSWTCH = ON THEN + 02
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702
ELSE + 02
CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902
IF &HELP = HELP THEN GOTO HELPSEC
02
/**********************************************************************
/* GET THE USER'S FULL NAME *
/**********************************************************************
SET SYSOUTTRAP = 1000
ACF
LIST *
END
SET SYSOUTTRAP = 0
SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1))
READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5
SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5)
02
/**********************************************************************
/* ESTABLISH SOME PROCESSING VARIABLES *
/**********************************************************************
CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID '
ISPEXEC VPUT NUMAPPL SHARED
SET EXITCC = 0
SET LP = &STR((
SET RP = &STR()
/**********************************************************************
/* DISPLAY THE PANEL *
/**********************************************************************
REDISPLAY: +
SET GENERATE =
ISPEXEC DISPLAY PANEL(BINDCARD)
IF &LASTCC > 7 THEN +
DO
IF &STR(&GENERATE) = Y THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** SET GENERATE TO "N" BEFORE +
QUITTING OR PRESS TO +
GENERATE ***)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO REDISPLAY
END
GOTO FINISH
END
ELSE +
SELECT
/**********************************************************************/
/* PRESENT A LIST OF ELEMENTS OF THIS TYPE TO CHOOSE FROM */
/**********************************************************************/
WHEN (&STR(&APP0) = &STR(?)) DO
ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') +
MACRO(APPLCHKM)
IF &LASTCC = 14 THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** CANNOT CONTINUE UNTIL YOU +
ARE OUT OF ENDEVOR ***)
ISPEXEC SETMSG MSG(UTLZ001)
END
ELSE +
DO
ISPEXEC SELECT CMD(%BINDGET +
&STR(&ENVIRON) +
&STR(&STAGE) +
&STR(&TYPE) +
&STR(&SYSTEM) +
&STR(&SUBSYS))
ISPEXEC VGET APP0 SHARED
END
GOTO REDISPLAY
END
/**********************************************************************/
/* NOTHING TO DO NOW */
/**********************************************************************/
WHEN (&GENERATE = N AND &ACTION = ADD) GOTO REDISPLAY
/**********************************************************************/
/* GET A LIST OF CALLED APPLICATIONS FOR THIS APPLICATION */
/**********************************************************************/
WHEN (&GENERATE = N AND &ACTION ¬= ADD) DO
/*GOTO FIX_NDVRC1
ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') +
MACRO(APPLCHKM)
IF &LASTCC = 14 THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** CANNOT CONTINUE UNTIL YOU +
ARE OUT OF ENDEVOR ***)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO REDISPLAY
END
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** PREPARING TO CALL +
ENDEVOR TO FIND "&APP0" ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000)
FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01)
ALLOC DD(SYSPRINT) DUMMY
IF &DBGSWTCH = ON THEN + 02
ALLOC DD(C1MSGS1) DA(*)
ELSE +
ALLOC DD(C1MSGS1) DUMMY
ALLOC DD(C1PRINT) DUMMY
DELETE '&TEMPFILE'
ALLOC DD(PRINTDD) +
DSN('&TEMPFILE') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(1,1) CYLINDERS RELEASE +
RECFM(F B) LRECL(133) BLKSIZE(23408) DSORG(PS)
ALLOC DD(BSTIPT01) +
NEW CATALOG +
UNIT(SYSDA) +
SPACE(1,1) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
OPENFILE BSTIPT01 OUTPUT
SET BSTIPT01 = &STR(PRINT ELEMENT '&APP0' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( STAGE '&STAGE' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( SYSTEM '&SYSTEM' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( SUBSYSTEM '&SUBSYS' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( TYPE '&TYPE')
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( TO FILE 'PRINTDD' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR(OPTIONS SEARCH )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR(. )
PUTFILE BSTIPT01
CLOSFILE BSTIPT01
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** EXTRACTING "&APP0" +
FROM ENDEVOR ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000)
ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000)
SET NDVRCC = &LASTCC
FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01)
ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(BINDCRDM)
ISPEXEC VGET VARS SHARED
ISPEXEC VGET (&STR(&VARS)) SHARED
IF &EDITCC < 8 THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** VALUES FOR "&APP0" +
WERE SUCCESSFULLY EXTRACTED +
FROM ENDEVOR ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
ELSE +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** NO BIND CARDS FOR "&APP0" +
FOUND IN ENDEVOR ***)
ISPEXEC SETMSG MSG(UTLZ001)
END
GOTO REDISPLAY
END
END
/**********************************************************************
/* LOAD A TEMPORARY TABLE WITH ALL THE APPLICATIONS *
/**********************************************************************
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** GENERATING JCL TO UPDATE ENDEVOR ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000)
ISPEXEC TBCREATE TEMPTABL NOWRITE REPLACE KEYS(APPLICAT)
IF &STR(&DB2) = Y THEN +
DO
SET APPLICAT = &STR(&APP0)
ISPEXEC TBADD TEMPTABL
END
/**********************************************************************/
/* LOAD UP THE TABLE WITH THE PACKAGE LIST. */
/* */
/* 12/8/97 - GET RID OF OLD REFERENCES TO EP02A, EP03A AND SC50A */
/**********************************************************************/
DO &I = 1 TO &NUMAPPL
SET APPLICAT = &STR(&SYSNSUB(2,&&APP&I))
IF &STR(&APPLICAT) > AND +
&STR(&APPLICAT) ¬= &STR(EP02A) AND +
&STR(&APPLICAT) ¬= &STR(EP03A) AND +
&STR(&APPLICAT) ¬= &STR(SC50A) THEN
ISPEXEC TBADD TEMPTABL
END
/**********************************************************************
/* THE FOLLOWING SECTION ADDS STANDARD APPLICATIONS WHICH MUST BE *
/* PRESENT IN EVERY PLAN. SINCE THE TABLE IS KEYED, IF THEY EXIST, *
/* THEY WON'T BE ADDED TWICE, BUT IF THEY DON'T EXIST ALREADY, THEY *
/* WILL BE ADDED. *
/**********************************************************************
SET APPLICAT = &STR(EPB0002) /* ERROR PROCESSING APPLICATION */
ISPEXEC TBADD TEMPTABL
ISPEXEC TBTOP TEMPTABL
ISPEXEC TBQUERY TEMPTABL ROWNUM(ENDROW)
/**********************************************************************
/* USE FILE TAILORING TO CREATE THE JOB *
/**********************************************************************
DELETE '&TEMPJCL'
FREE DDNAME(ISPFILE)
ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(1,1) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
ISPEXEC FTOPEN
ISPEXEC FTINCL BINDCARD
SET SAVECC = &LASTCC
ISPEXEC FTCLOSE
FREE DDNAME(ISPFILE)
IF &SAVECC > 0 THEN +
DO
SET ZEDSMSG = &STR(JCL CREATION ERROR)
SET ZEDLMSG = &STR(ENDEVOR UPDATE JCL CREATION FAILED +
WITH RC: &SAVECC)
ISPEXEC SETMSG MSG(UTLZ001)
IF &JCLREVEW = Y THEN ISPEXEC EDIT DATASET('&TEMPJCL')
END
ELSE +
DO
IF &STR(&DEFAULTS) = N THEN +
DO
SEND '&STR("&FULLNAME" CREATED BATCH BIND PLAN +
REQUEST "&APP0" ON &SYSSDATE AT &SYSTIME)' +
USER(&SENDDEST) LOGON
SEND '&STR(!!!!! NON-DEFAULT VALUE(S) USED !!!!!)' +
USER(&SENDDEST) LOGON
END
IF &JCLREVEW = Y THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** YOU MUST SUBMIT THIS JOB +
YOURSELF ***)
ISPEXEC SETMSG MSG(UTLZ001)
ISPEXEC EDIT DATASET('&TEMPJCL')
END
ELSE +
DO
SUBMIT '&TEMPJCL'
SET ZEDSMSG = &STR(ENDEVOR JOB SUBMITTED)
SET ZEDLMSG = &STR(ENDEVOR UPDATE JOB WAS CREATED +
AND SUBMITTED)
ISPEXEC SETMSG MSG(UTLZ000)
END
END
GOTO REDISPLAY
/**********************************************************************
/* CLEANUP AND GET OUT *
/**********************************************************************
FINISH: +
EXIT
/**********************************************************************
/* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY *
/**********************************************************************
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(BINDCRDA)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR BINDCARD UTILITY +
*** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
|
|
