|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/**********************************************************************
/* UTILITY: INDEXCOL *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: THIS UTILITY PROMPTS FOR INPUT OF A DB2 INDEX NAME AND AN*
/* ASSOCIATED CREATOR ID. I THEN DETERMINES THE LENGTH OF *
/* THE INDEX. *
/**********************************************************************
PROC 0 CREATOR(USSTRD00) +
UTILITY(INDEXCOL) +
HELP +
DEBUG
/*** CHECK THE DEBUG SWITCH ***/
IF &DEBUG = DEBUG THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS
ELSE +
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
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 *
/**********************************************************************
SET DB2FILE = &STR(&SYSUID..TEMP.INDEXCOL.WORK)
SET SCANALL = ALL
SET ZTDMARK = &STR(**** ALL ROWS SHOWN ****)
SET LP = &STR((
SET RP = &STR()
/**********************************************************************
/* GET A LIST OF INDEXES FOR THE CURRENT CREATOR *
/**********************************************************************
INDEX_LIST: +
SET SCREATOR = &STR(&CREATOR)
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** EXTRACTING A LIST OF INDEXES FOR CREATOR +
"&CREATOR" FROM DB2 ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(MSGPANEL)
FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH)
IF &DEBUG = DEBUG THEN +
DO
ALLOC DD(SYSPRINT) DA(*)
ALLOC DD(SYSPUNCH) DA(*)
END
ELSE +
DO
ALLOC DD(SYSPRINT) DUMMY
ALLOC DD(SYSPUNCH) DUMMY
END
DELETE '&DB2FILE'
ALLOC DD(SYSREC00) DSN('&DB2FILE') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(1,1) TRACKS RELEASE DSORG(PS)
ALLOC DD(SYSIN) +
NEW +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(1,1) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
OPENFILE SYSIN OUTPUT
SET SYSIN = &STR(SYSADM2.INDEXCOL WHERE C LIKE '&CREATOR')
PUTFILE SYSIN
CLOSFILE SYSIN
DSN SYSTEM(DSNT)
RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) -
LIB('SYS4.DSN.DSNT.RUNLIB.LOAD')
END
FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH)
SET ZEDSMSG =
SET ZEDLMSG = &STR(*** LOADING THE LIST INTO AN ISPF TABLE ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(MSGPANEL)
ISPEXEC EDIT DATASET('&DB2FILE') MACRO(INDEXCM1)
/**********************************************************************
/* DISPLAY THE PANEL IF NO INPUT WAS PASSED *
/**********************************************************************
REDISPLAY: +
ISPEXEC TBDISPL TEMPNDXC PANEL(INDEXCOL)
IF &LASTCC > 7 THEN +
GOTO FINISH
ELSE +
IF &STR(&SCREATOR) ¬= &STR(&CREATOR) THEN GOTO INDEX_LIST
/**********************************************************************
/* PROCESS ANY SELECTED ROWS *
/**********************************************************************
IF &ZTDSELS ¬= &STR(0000) THEN +
DO
ISPEXEC CONTROL DISPLAY SAVE
DO WHILE &ZTDSELS ¬= &STR(0000)
SELECT (&STR(&SEL))
/************ EXCLUDE THIS LINE ************/
WHEN (X) DO
SET SEL = X
SET SCANALL = SCAN
ISPEXEC TBMOD TEMPNDXC
ISPEXEC TBVCLEAR TEMPNDXC
SET SEL = X
ISPEXEC TBSARG TEMPNDXC NAMECOND(SEL NE)
SET ZTDMARK = &STR(**** ROW(S) EXCLUDED ****)
END
OTHERWISE DO
SET SEL =
ISPEXEC TBMOD TEMPNDXC
SET ZEDSMSG =
SET ZEDLMSG = &STR("X" IS THE ONLY +
VALID LINE COMMAND)
ISPEXEC SETMSG MSG(UTLZ001)
END
END
NEXT_LINE: IF &ZTDSELS > &STR(0001) THEN +
DO
ISPEXEC CONTROL DISPLAY RESTORE
ISPEXEC TBDISPL TEMPNDXC
ISPEXEC CONTROL DISPLAY SAVE
END
ELSE +
DO
SET ZTDSELS = &STR(0000)
ISPEXEC CONTROL DISPLAY RESTORE
IF &STR(&ZCMD) > THEN GOTO SCROLL
END
END
END
/******************************/
/* PROCESS "PRIMARY" COMMANDS */
/******************************/
IF &STR(&ZCMD) = THEN GOTO SCROLL
SET SYSDVAL = &STR(&ZCMD)
READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10
SELECT (&ZCMD)
WHEN (DEBUG) DO
IF &OPT1 = &STR(ON) THEN +
DO
SET DEBUG = DEBUG
SET ZEDSMSG = &STR(DEBUG ON)
SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET ON)
ISPEXEC SETMSG MSG(UTLZ000)
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS
SET ZCMD =
GOTO SCROLL
END
IF &OPT1 = &STR(OFF) THEN +
DO
SET DEBUG = DEBUG
SET ZEDSMSG = &STR(DEBUG OFF)
SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET OFF)
ISPEXEC SETMSG MSG(UTLZ000)
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
SET ZCMD =
GOTO SCROLL
END
END
WHEN (E ¦ ED ¦ EDI ¦ EDIT) ISPEXEC EDIT DATASET('&DB2FILE')
WHEN (F ¦ FI ¦ FIN ¦ FIND) DO
SET ZEDSMSG = &STR("&OPT1" NOT FOUND)
SET ZEDLMSG = &STR(THE STRING "&OPT1" WAS NOT FOUND)
ISPEXEC SETMSG MSG(UTLZ001)
ISPEXEC TBTOP TEMPNDXC
ISPEXEC TBSKIP TEMPNDXC
DO WHILE &LASTCC = 0
IF &SYSINDEX(&SYSCAPS(&STR(&OPT1)),&STR(&INDEX)) > 0 +
THEN DO
SET ZEDSMSG = &STR("&OPT1" FOUND)
SET ZEDLMSG = &STR(THE STRING "&OPT1" WAS FOUND)
ISPEXEC SETMSG MSG(UTLZ000)
IF &STR(&SEL) = X THEN +
DO
SET SEL =
ISPEXEC TBMOD TEMPNDXC
END
GOTO FIND_CONTINUE
END
ISPEXEC TBSKIP TEMPNDXC
END
FIND_CONTINUE: +
END
WHEN (R ¦ RE ¦ RES ¦ RESE ¦ RESET) DO
SET SCANALL = ALL
SET ZEDSMSG =
SET ZEDLMSG = &STR(ALL ROWS SHOWN)
ISPEXEC SETMSG MSG(UTLZ000)
ISPEXEC TBTOP TEMPNDXC
ISPEXEC TBVCLEAR TEMPNDXC
SET SEL = X
ISPEXEC TBSARG TEMPNDXC NAMECOND(SEL EQ)
ISPEXEC TBSCAN TEMPNDXC
DO WHILE &LASTCC = 0
SET SEL =
ISPEXEC TBMOD TEMPNDXC
SET SEL = X
ISPEXEC TBSCAN TEMPNDXC
END
ISPEXEC TBTOP TEMPNDXC
ISPEXEC TBVCLEAR TEMPNDXC
SET ZTDMARK = &STR(**** ALL ROWS SHOWN ****)
GOTO SCROLL
END
OTHERWISE DO
SET ZEDLMSG = &STR(VALID PRIMARY COMMANDS: +
"EDIT", +
"FIND", +
"DEBUG ON¦OFF", +
"RESET")
ISPEXEC SETMSG MSG(UTLZ001)
END
END
/*****************************/
/* MAINTAIN THE TOP OF TABLE */
/*****************************/
SCROLL: +
IF &STR(&ZCMD) = THEN +
DO
ISPEXEC TBTOP TEMPNDXC
ISPEXEC TBSKIP TEMPNDXC NUMBER(&ZTDTOP)
ISPEXEC VGET (ZVERB ZSCROLLN)
IF &ZVERB = &STR(UP) THEN +
ISPEXEC TBSKIP TEMPNDXC NUMBER(-&ZSCROLLN)
IF &ZVERB = &STR(DOWN) THEN +
ISPEXEC TBSKIP TEMPNDXC NUMBER(&ZSCROLLN)
END
GOTO REDISPLAY
/**********************************************************************
/* GET OUT NOW *
/**********************************************************************
FINISH: EXIT
|
|
