|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/**********************************************************************
/* UTILITY: APPLCMPR *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: THIS UTILITY COMPARES ALL THE ELEMENTS OF AN APPLICATION *
/* USING THE LISTAD ELEMENT AND CREATING PRINTS OF EACH OF *
/* THESE COMPONENT ELEMENTS BEGINNING AT DEVL AND BEGINNING *
/* AT QUAL (WITH THE SEARCH OPTION). THIS OUTPUT IS THEN *
/* WRITTEN TO TWO PDS'S AND THEY ARE COMPARED. *
/**********************************************************************
PROC 1 CSP_APPLICATION +
ROMSL1('QDEVL.STRMSV.MSL') +
ROMSL2('QQUAL.STRMSV.MSL') +
ROMSL3('MMODO.STRMSV.MSL') +
ROMSL4('PEMER.STRMSV.MSL') +
ROMSL5('PPROD.STRMSV.MSL') +
ACCESS(DIRECT) +
ENVIRON(QUAL) +
STAGE1(D) +
STAGE2(Q) +
TYPE(LISTAD) +
SYSTEM(STR) +
SUBSYS(UNIPAC) +
CCID(UTILITY) +
CLASS('1,TIME=(1,00)') +
BATCH +
USERID() +
UTILITY(APPLCMPR) +
EDIT +
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
/**********************************************************************
/* CHECK TO SEE IF THE USER IS IN ENDEVOR FIRST *
/**********************************************************************
IF &BATCH ¬= BATCH THEN +
DO
ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') +
MACRO(APPLCHKM)
IF &LASTCC = 14 THEN +
DO
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** PLEASE EXIT ENDEVOR BEFORE +
EXECUTING "APPLCMPR" ***)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT
END
END
02
/**********************************************************************
/* GET THE USER'S FULL NAME *
/**********************************************************************
IF &STR(&USER) > THEN GOTO SETVAR
SET USERID = &STR(&SYSUID)
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
/**********************************************************************
/* LOAD THE MSL CONCATENATION TABLE *
/**********************************************************************
SET OLDMSLS =
SET NEWMSLS =
ISPEXEC TBCREATE TEMPMSL NOWRITE REPLACE KEYS(MSLNAME)
DO &I = 1 TO 20
SET MSLNAME = &STR(&SYSNSUB(2,&&ROMSL&I))
IF &STR(&MSLNAME) > THEN +
DO
IF &I > 1 THEN +
SET OLDMSLS = &STR(&OLDMSLS,ROMSL&I)
SET NEWMSLS = &STR(&NEWMSLS,ROMSL&I)
ISPEXEC TBADD TEMPMSL
END
ELSE +
SET I = 21
END
SET NEWMSLS = &SUBSTR(2:&LENGTH(&STR(&NEWMSLS)),&STR(&NEWMSLS))
SET OLDMSLS = &SUBSTR(2:&LENGTH(&STR(&OLDMSLS)),&STR(&OLDMSLS))
02
/**********************************************************************
/* ESTABLISH SOME PROCESSING VARIABLES *
/**********************************************************************
SETVAR: +
CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&USERID '
SET APPL = &STR(&CSP_APPLICATION)
SET COMMENTS = &STR(&APPL COMPARE¦&USERID¦&SYSSDATE¦&SYSSTIME)
SET TMESTAMP = &STR(D)+
&SUBSTR(1:2,&STR(&SYSSDATE))+
&SUBSTR(4:5,&STR(&SYSSDATE))+
&SUBSTR(7:8,&STR(&SYSSDATE))+
&STR(.T)+
&SUBSTR(1:2,&STR(&SYSTIME))+
&SUBSTR(4:5,&STR(&SYSTIME))+
&SUBSTR(7:8,&STR(&SYSTIME))
SET TEMPJCL = &STR(&USERID..TEMP.APPLCMPR.&TMESTAMP..JCL)
SET TEMPFILE = &STR(&USERID..TEMP.APPLCMPR.&TMESTAMP..ENDEVOR)
SET EXITCC = 0
SET LP = &STR((
SET RP = &STR()
/**********************************************************************
/* INFORM THE USER *
/**********************************************************************
SET ZEDLMSG = &STR(*** PREPARING TO CALL ENDEVOR TO EXTRACT THE +
"LISTAD" FOR "&APPL" ***)
IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG)
ELSE +
DO
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(MSGPANEL)
END
/**********************************************************************
/* PREPARE FOR A CALL TO ENDEVOR *
/**********************************************************************
FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01)
ALLOC DD(SYSPRINT) DUMMY
IF &DBGSWTCH = ON THEN +
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 ELEMENTS '&APPL')
PUTFILE BSTIPT01
SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR( STAGE '&STAGE1' )
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 NOSEARCH )
PUTFILE BSTIPT01
SET BSTIPT01 = &STR(. )
PUTFILE BSTIPT01
CLOSFILE BSTIPT01
SET ZEDLMSG = &STR(*** EXTRACTING THE "LISTAD" FOR "&APPL" FROM +
ENDEVOR ***)
IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG)
ELSE +
DO
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(MSGPANEL)
END
ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000)
SET NDVRCC = &LASTCC
FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01)
ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(APPLMACR)
/**********************************************************************
/* GET OUT IF THERE IS NO LISTAD TYPE *
/**********************************************************************
ISPEXEC TBQUERY TEMPGET ROWNUM(ROWS)
IF &ROWS = 0 THEN +
DO
SET EXITCC = &NDVRCC
IF NDVRCC < 8 THEN +
DO
SET ZEDLMSG = &STR(*** NO LISTAD ELEMENT FOUND FOR +
APPLICATION "&APPL" ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
ELSE +
DO
SET ZEDLMSG = &STR(*** ENDEVOR CC: &NDVRCC TRYING TO +
LIST "&TYPE" ELEMENTS ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
EXIT CODE(&NDVRCC)
END
/**********************************************************************
/* INFORM THE USER *
/**********************************************************************
SET ZEDLMSG = &STR(*** GENERATING JCL TO COMPARE "&APPL" ***)
IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG)
ELSE +
DO
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(MSGPANEL)
END
/**********************************************************************
/* GENERATE JCL TO DO THE COMPARE *
/**********************************************************************
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 APPLCMPR
SET SAVECC = &LASTCC
ISPEXEC FTCLOSE
FREE DDNAME(ISPFILE)
IF &EDIT = EDIT THEN +
DO
IF &SAVECC > 0 THEN +
DO
ISPEXEC VGET ZERRLM
SET ZEDSMSG = &STR(JCL CREATION ERROR)
SET ZEDLMSG = &STR(&ZERRLM)
ISPEXEC SETMSG MSG(UTLZ001)
ISPEXEC EDIT DATASET('&TEMPJCL')
END
ELSE +
DO
SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS +
JCL YOURSELF ***)
ISPEXEC SETMSG MSG(UTLZ000W)
ISPEXEC EDIT DATASET('&TEMPJCL')
END
END
ELSE +
DO
IF &SAVECC > 0 THEN +
DO
ISPEXEC VGET ZERRLM
SET ZEDSMSG = &STR(JCL CREATION ERROR)
SET ZEDLMSG = &STR(&ZERRLM)
ISPEXEC SETMSG MSG(UTLZ001)
ISPEXEC EDIT DATASET('&TEMPJCL')
END
ELSE +
DO
SUBMIT '&TEMPJCL'
SET ZEDSMSG = &STR(JOB SUBMITTED)
SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED +
***)
ISPEXEC SETMSG MSG(UTLZ000)
END
END
/**********************************************************************
/* CLEANUP AND GET OUT *
/**********************************************************************
FINISH: +
EXIT
/**********************************************************************
/* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY *
/**********************************************************************
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR APPLCMPR UTILITY +
*** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
|
|
