Return to Mainframe Utilities Page
Module
/*******************************************************************/
/* CLIST : ISPFTABL */
/* CREATED BY : DAVID LEIGH */
/* DATE : 6-9-89 */
/* DESCRIPTION : THIS CLIST ALLOWS THE USER TO CREATE ISPF TABLES */
/* INTERACTIVELY AND/OR LOAD THEM FROM A DATASET. */
/*******************************************************************/
PROC 0
/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS
ELSE +
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
/********************************************************************/
/* HANDLE ALL ERRORS HERE */
/********************************************************************/
ISPEXEC CONTROL ERRORS RETURN
/********************************************************************/
/* SET INITIAL VARIABLES FOR USE IN THIS CLIST - MAKE CHANGES HERE! */
/********************************************************************/
SET SAVENAME = &STR(________)
SET SAVEDSN = &STR(________.________.________.________.________)
SET SAVETDSN = &STR(________.________.________.________.________)
SET SORTEDIT = N
SET SCALE =
SET IMAGE =
SET VARLINE1 =
SET VARLINE2 =
SET VARLINE3 =
SET FSTG =
SET PREVNEXT =
SET BREC =
SET EREC =
SET INCR =
SET TSTAT = 1
SET ZTDSELS = &STR(0000)
SET KEY =
ISPEXEC VPUT KEY SHARED
/********************************************************************/
/* CREATE THE TEMPORARY TABLE. */
/********************************************************************/
ISPEXEC TBCREATE $$$$ITUT WRITE REPLACE +
NAMES(FIELD KEY COL1 COL2 DEFAULT)
/********************************************************************/
/********************************************************************/
/* M A I N L I N E */
/********************************************************************/
/********************************************************************/
MAINLINE: +
ISPEXEC VPUT (SCALE TSTAT IMAGE VARLINE1 VARLINE2 VARLINE3 FSTG +
PREVNEXT LINENUM SORTEDIT) SHARED
ISPEXEC TBDISPL $$$$ITUT PANEL(ISPFTABL)
SET SAVECC = &LASTCC
IF &STR(&SAVETDSN) ¬= &STR(&TDSN) AND &STR(&TDSN) > THEN +
DO
ISPEXEC LIBDEF ISPTABL
ISPEXEC LIBDEF ISPTABL DATASET ID('&TDSN')
SET SAVETDSN = &STR(&TDSN)
END
ISPEXEC VGET (SCALE TSTAT IMAGE VARLINE1 VARLINE2 VARLINE3 FSTG +
PREVNEXT LINENUM SORTEDIT) SHARED
SET SYSDVAL = &STR(&ZCMD)
READDVAL XCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 OPT11
/********************************************************************/
/* BRANCH TO SECTIONS TO HANDLE ENTERED COMMAND */
/********************************************************************/
MAIN0001: +
SET ZEDLMSG = &STR(VALID COMMANDS ARE: INSERT SAVE USE)
IF &ZTDSELS > &STR(0000) THEN GOTO ROWSEC
ELSE GOTO MAIN0002
MAIN0002: +
IF &SAVECC > 7 THEN GOTO FINAL
IF &TNAME ¬= &SAVENAME THEN GOTO TABLESEC
MAIN0003: +
SELECT &STR(&XCMD)
WHEN (INSERT ¦ I) GOTO INSESEC
WHEN (SAVE ¦ S) GOTO SAVESEC
WHEN (USE ¦ U) GOTO USESEC
WHEN (DEBUG ¦ D) GOTO DBUGSEC
WHEN () GOTO MAIN0004
OTHERWISE ISPEXEC SETMSG MSG(UTLZ001)
END
MAIN0004: +
IF &LSCROLL > AND &STR(&SYSNSUB(1,&FSTG)) > AND +
&LOADDSN > THEN +
DO
SET ZEDLMSG = &STR(*** CANNOT BOTH "SCROLL" AND "FIND" ***)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAINEXIT
END
IF &LSCROLL > AND &LOADDSN = THEN +
DO
SET ZEDLMSG = &STR(*** NO LOAD DATASET, SCROLL IGNORED ***)
ISPEXEC SETMSG MSG(UTLZ000)
SET LSCROLL =
SET SCNUM =
GOTO MAIN0005
END
SELECT &STR(&LSCROLL)
WHEN (U) GOTO UPSCRL
WHEN (D) GOTO DOWNSCRL
WHEN (L) GOTO LEFTSCRL
WHEN (R) GOTO RGHTSCRL
WHEN () GOTO MAIN0005
END
MAIN0005: +
IF &FCOMP = Y THEN GOTO PROCESS
ELSE GOTO MAIN0006
MAIN0006: +
IF &LOADDSN > AND &LOADFILE = OR +
&LOADDSN > AND &LOADDSN ¬= &SAVEDSN THEN GOTO FILEALOC
ELSE GOTO MAIN0007
MAIN0007: +
IF &STR(&SYSNSUB(1,&FSTG)) > AND &LOADDSN = THEN +
DO
SET ZEDLMSG = &STR(*** NO LOAD DATASET, FIND IGNORED ***)
ISPEXEC SETMSG MSG(UTLZ000)
SET FSTG =
GOTO MAIN0008
END
IF &STR(&SYSNSUB(1,&FSTG)) > THEN GOTO FINDSEC
ELSE GOTO MAIN0008
MAIN0008: +
IF &SORTEDIT = Y AND &SORTDSN = THEN +
DO
SET ZEDLMSG = &STR(*** NO SORT DATASET, EDIT IGNORED ***)
ISPEXEC SETMSG MSG(UTLZ000)
SET SORTEDIT = N
GOTO MAINEXIT
END
IF &SORTEDIT = Y THEN GOTO SORTSEC
ELSE GOTO MAINEXIT
MAINEXIT: +
IF &STR(&ZCMD) = THEN +
DO
ISPEXEC TBTOP $$$$ITUT
ISPEXEC TBSKIP $$$$ITUT NUMBER(&ZTDTOP)
ISPEXEC VGET (ZVERB ZSCROLLN)
IF &ZVERB = &STR(UP) THEN +
ISPEXEC TBSKIP $$$$ITUT NUMBER(-&ZSCROLLN)
IF &ZVERB = &STR(DOWN) THEN +
ISPEXEC TBSKIP $$$$ITUT NUMBER(&ZSCROLLN)
END
SET ZCMD =
IF &SAVECC > 7 THEN GOTO FINAL
GOTO MAINLINE
/********************************************************************/
/********************************************************************/
/* F I N A L I Z A T I O N */
/********************************************************************/
/********************************************************************/
FINAL: +
ERROR RETURN
CLOSFILE LOADFILE
ERROR OFF
ISPEXEC TBCLOSE &TNAME
ISPEXEC TBCLOSE $$$$ITUT
ISPEXEC LIBDEF ISPTABL
EXIT
/********************************************************************/
/********************************************************************/
/* S U B R O U T I N E S */
/********************************************************************/
/********************************************************************/
/********************************************************************/
/* PROCESS PENDING SELECTED ROWS */
/********************************************************************/
DBUGSEC: +
IF &DEBUG = &STR(YES) THEN DO
SET DEBUG = &STR(NO)
SET ZEDLMSG = &STR(*** DEBUGGING IS OFF ***)
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
END
ELSE DO
SET DEBUG = &STR(YES)
SET ZEDLMSG = &STR(*** DEBUGGING IS ON ***)
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS
END
ISPEXEC SETMSG MSG(UTLZ000)
GOTO MAINEXIT
ROWSEC: +
DO WHILE &ZTDSELS ¬= &STR(0000)
IF &KEY = D THEN +
ISPEXEC TBDELETE $$$$ITUT
ELSE +
DO
SET XFIELD = &FIELD
SET XKEY = &KEY
SET XCOL1 = &COL1
SET XCOL2 = &COL2
SET XDEFAULT = &STR(&SYSNSUB(1,&DEFAULT))
ISPEXEC TBGET $$$$ITUT ROWID(SAVEROW)
SET YFIELD = &FIELD
ISPEXEC TBTOP $$$$ITUT
ISPEXEC TBVCLEAR $$$$ITUT
SET FIELD = &XFIELD
SET X = 0
ISPEXEC TBSCAN $$$$ITUT ARGLIST(FIELD) CONDLIST(EQ)
DO WHILE &LASTCC = 0
SET X = &X + 1
ISPEXEC TBSCAN $$$$ITUT ARGLIST(FIELD) CONDLIST(EQ)
END
ISPEXEC TBSKIP $$$$ITUT ROW(&SAVEROW)
IF &X > 0 AND &STR(&YFIELD) = &STR('''''''') OR +
&X > 1 AND &STR(&YFIELD) ¬= &STR('''''''') THEN +
DO
SET ZEDLMSG = &STR("&XFIELD" ALREADY EXISTS....)+
FIELD NAMES MUST BE UNIQUE)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO NEXTROW
END
IF &XCOL2 < &XCOL1 THEN +
DO
SET ZEDLMSG = &STR(COLUMN 2 MUST BE )+
GREATER THAN OR EQUAL TO COLUMN 1)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO NEXTROW
END
IF &XCOL2 > AND &XCOL1 > AND +
&STR(&SYSNSUB(1,&DEFAULT)) > THEN +
DO
SET ZEDLMSG = &STR(DEFAULT VALUES OR COLUMNS MAY +
BE SPECIFIED....NOT BOTH)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO NEXTROW
END
SET X = &SYSINDEX(&STR('),&STR(&XFIELD))
SET X = &X - 1
IF &X > 0 THEN +
SET FIELD = &SUBSTR(1:&X,&STR(&XFIELD))
ELSE +
SET FIELD = &XFIELD
SET KEY = &XKEY
SET COL1 = &XCOL1
SET COL2 = &XCOL2
SET DEFAULT = &STR(&SYSNSUB(1,&XDEFAULT))
ISPEXEC TBPUT $$$$ITUT
NEXTROW: +
END
IF &ZTDSELS > &STR(0001) THEN ISPEXEC TBDISPL $$$$ITUT
ELSE SET ZTDSELS = &STR(0000)
END
ISPEXEC TBSAVE $$$$ITUT
GOTO MAIN0002
/********************************************************************/
/* PROCESS INSERT ('I') COMMAND - INSERT 'N' NEW BLANK ROWS */
/********************************************************************/
INSESEC: +
IF &STR(&OPT1) = THEN SET OPT1 = 1
IF &STR(&OPT2) > THEN +
DO
SET ZEDLMSG = &STR(ONLY ONE OPTION MAY BE SPECIFIED FOR "I")
ISPEXEC SETMSG MSG(UTLZ001)
END
ELSE +
IF &DATATYPE(&STR(&OPT1)) = NUM THEN +
DO
SET X = 0
ISPEXEC TBVCLEAR $$$$ITUT
SET FIELD = &STR('''''''')
DO WHILE &X < &OPT1
ISPEXEC TBADD $$$$ITUT
SET X = &X + 1
END
ISPEXEC TBTOP $$$$ITUT
END
ELSE +
DO
SET ZEDLMSG = &STR(INSERT NUMBER MUST BE NUMERIC)
ISPEXEC SETMSG MSG(UTLZ001)
END
GOTO MAIN0004
/********************************************************************/
/* PROCESS SAVE ('S') COMMAND - SAVE THE SPEC TABLE TO ANOTHER */
/********************************************************************/
SAVESEC: +
DO WHILE &OPT1 =
WRITENR PLEASE ENTER A TABLE NAME TO SAVE TO OR "CANCEL" ==>
READ OPT1
END
IF &STR(&OPT2) = CANCEL THEN GOTO MAIN0004
ELSE +
PDS '&TDSN' REPRO $$$$ITUT TO(&OPT1) REPLACE
GOTO MAIN0004
/********************************************************************/
/* PROCESS USE ('U') COMMAND - USE ANOTHER TABLE FOR $$$$ITUT */
/********************************************************************/
USESEC: +
DO WHILE &OPT1 =
WRITENR PLEASE ENTER A TABLE NAME TO USE OR "CANCEL" ==>
READ OPT1
END
IF &STR(&OPT2) = CANCEL THEN GOTO MAIN0004
ELSE +
DO
ISPEXEC TBOPEN &OPT1 NOWRITE
ISPEXEC TBSKIP &OPT1
DO WHILE &LASTCC = 0
ISPEXEC TBADD $$$$ITUT
ISPEXEC TBSKIP &OPT1
END
ISPEXEC TBEND &OPT1
ISPEXEC TBTOP $$$$ITUT
END
GOTO MAIN0004
/********************************************************************/
/* OPEN THE LOAD FILE, DEFINE THE SCALE AND GET THE FIRST ROW */
/********************************************************************/
FILEALOC: +
SET SAVEDSN = &LOADDSN
ERROR RETURN
CLOSFILE LOADFILE
ERROR OFF
LISTDSI '&LOADDSN'
IF &LASTCC > 0 THEN +
DO
SET ZEDLMSG = &STR("&LOADDSN" PROBLEM : &SYSDSN('&LOADDSN'))
ISPEXEC SETMSG MSG(UTLZ001)
SET LOADDSN =
GOTO MAINEXIT
END
SET X = 50
SET SC = &STR(----+----1----+----2----+----3----+----4----+----5)
DO WHILE &X < &SYSLRECL
SET SC = &STR(&SC----+----6----+----7----+----8----+----9----+----0)
SET SC = &STR(&SC----+----1----+----2----+----3----+----4----+----5)
SET X = &X + 100
END
IF &SYSLRECL > 79 THEN SET ENDCOL = 79
ELSE SET ENDCOL = &SYSLRECL
SET SCALE = &SUBSTR(1:&ENDCOL,&STR(&SC))
FREE DDNAME(LOADFILE)
ALLOC DDNAME(LOADFILE) +
DSN('&LOADDSN') +
SHR KEEP
ERROR +
DO
SET ERRCC = &LASTCC
SELECT (&ERRCC)
WHEN (400) DO
SET EOF = YES
SET ZEDLMSG = &STR(*** "&LOADDSN" IS EMPTY ***)
ISPEXEC SETMSG MSG(UTLZ001)
SET LOADDSN =
SET LOADFILE =
GOTO MAIN0007
END
WHEN (588) RETURN
OTHERWISE DO
WRITE *** PROBLEM WITH CLIST ISPFTABL ***
WRITE *** RETURN CODE = &ERRCC ***
GOTO FINAL
END
END
END
SET EOF = NO
OPENFILE LOADFILE INPUT
GETFILE LOADFILE
ERROR OFF
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(1:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(1:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
SET BEGCOL = 1
SET LINENUM = 1
SET SAVEDSN = &LOADDSN
SET PREVNEXT = N
SET BREC = 1
SET EREC = 9999999
SET INCR = 1
GOTO MAIN0007
/********************************************************************/
/* SCROLL THE LOAD FILE UPWARDS */
/********************************************************************/
UPSCRL: +
IF &LINENUM = 1 THEN +
DO
SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***)
ISPEXEC SETMSG MSG(UTLZ000)
GOTO MAINEXIT
END
IF &SCNUM < 1 THEN SET SCNUM = 1
SET LINENUM = &LINENUM - &SCNUM
IF &LINENUM < 1 THEN SET LINENUM = 1
SET X = 0
CLOSFILE LOADFILE
OPENFILE LOADFILE INPUT
DO WHILE &X < &LINENUM
GETFILE LOADFILE
SET X = &X + 1
END
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
SET LSCROLL =
GOTO MAINEXIT
/********************************************************************/
/* SCROLL THE LOAD FILE DOWNWARDS */
/********************************************************************/
DOWNSCRL: +
ERROR +
DO
SET ERRCC = &LASTCC
SELECT (&ERRCC)
WHEN (400) DO
SET EOF = YES
RETURN
END
OTHERWISE DO
WRITE *** PROBLEM WITH CLIST ISPFTABL ***
WRITE *** RETURN CODE = &ERRCC ***
GOTO FINAL
END
END
END
IF &SCNUM < 1 THEN SET SCNUM = 1
SET X = 0
DO WHILE &X < &SCNUM AND &EOF = NO
GETFILE LOADFILE
SET LINENUM = &LINENUM + 1
SET X = &X + 1
END
ERROR OFF
IF &EOF = YES THEN +
DO
SET LINENUM = &LINENUM - 1
SET ZEDLMSG = &STR(*** BOTTOM OF LOAD FILE ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
SET LSCROLL =
GOTO MAINEXIT
/********************************************************************/
/* SCROLL THE LOAD FILE LEFT */
/********************************************************************/
LEFTSCRL: +
IF &BEGCOL = 1 THEN +
DO
SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE LEFT BOUNDRY ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
ELSE +
DO
IF &SCNUM < 1 THEN SET SCNUM = 79
SET X = &BEGCOL - &SCNUM
IF &X < 1 THEN +
DO
SET SCNUM = &X + &SCNUM - 1
SET &BEGCOL = &BEGCOL - &SCNUM
END
ELSE +
SET &BEGCOL = &BEGCOL - &SCNUM
SET &ENDCOL = &ENDCOL - &SCNUM
END
SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC))
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
SET LSCROLL =
GOTO MAINEXIT
/********************************************************************/
/* SCROLL THE LOAD FILE RIGHT */
/********************************************************************/
RGHTSCRL: +
IF &ENDCOL = &SYSLRECL THEN +
DO
SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE RIGHT BOUNDRY ***)
ISPEXEC SETMSG MSG(UTLZ000)
END
ELSE +
DO
IF &SCNUM < 1 THEN SET SCNUM = 79
SET X = &ENDCOL + &SCNUM
IF &X > &SYSLRECL THEN +
DO
SET SCNUM = &SYSLRECL - &ENDCOL
SET ENDCOL = &ENDCOL + &SCNUM
END
ELSE +
SET ENDCOL = &ENDCOL + &SCNUM
SET BEGCOL = &BEGCOL + &SCNUM
END
SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC))
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
SET LSCROLL =
GOTO MAINEXIT
/********************************************************************/
/* FIND A STRING IN THE FILE */
/********************************************************************/
FINDSEC: +
IF &PREVNEXT ¬= N AND &PREVNEXT ¬= P THEN SET &PREVNEXT = N
IF &PREVNEXT = P THEN +
DO
IF &LINENUM = 1 THEN +
DO
SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAIN0008
END
CLOSFILE LOADFILE
OPENFILE LOADFILE INPUT
SET X = 0
SET Y = 0
SET LINENUM = &LINENUM - 1
SET ZEDLMSG =
DO WHILE &X < &LINENUM
SET X = &X + 1
GETFILE LOADFILE
IF &SYSINDEX(&STR(&SYSNSUB(1,&FSTG)),+
&STR(&SYSNSUB(1,&LOADFILE))) > 0 THEN +
DO
SET ZEDLMSG = &STR(*** FOUND +
"&STR(&SYSNSUB(1,&FSTG))" ***)
ISPEXEC SETMSG MSG(UTLZ000)
SET Y = &X
END
END
IF &Y > 0 THEN +
DO
CLOSFILE LOADFILE
OPENFILE LOADFILE INPUT
SET X = 0
DO WHILE &X < &Y
SET X = &X + 1
GETFILE LOADFILE
END
SET LINENUM = &X
END
ELSE +
DO
SET LINENUM = &LINENUM + 1
GETFILE LOADFILE
SET ZEDLMSG = &STR(*** "&STR(&SYSNSUB(1,&FSTG))" +
NOT FOUND ***)
ISPEXEC SETMSG MSG(UTLZ001)
END
END
ELSE +
DO
ERROR DO
SET ERRCC = &LASTCC
SELECT (&ERRCC)
WHEN (400) DO
SET EOF = YES
SET ZEDLMSG = &STR(*** END OF FILE REACHED ***)
ISPEXEC SETMSG MSG(UTLZ001)
RETURN
END
WHEN (588) RETURN
OTHERWISE DO
WRITE *** PROBLEM WITH CLIST ISPFTABL ***
WRITE *** RETURN CODE = &ERRCC ***
GOTO FINAL
END
END
END
SET EOF = NO
SET X = 0
SET ZEDLMSG =
GETFILE LOADFILE
DO WHILE &EOF = NO AND &STR(&ZEDLMSG) =
SET X = &X + 1
IF &SYSINDEX(&STR(&SYSNSUB(1,&FSTG)),+
&STR(&SYSNSUB(1,&LOADFILE))) > 0 THEN +
DO
SET ZEDLMSG = &STR(*** FOUND +
"&STR(&SYSNSUB(1,&FSTG))" ***)
ISPEXEC SETMSG MSG(UTLZ000)
SET LINENUM = &LINENUM + &X
END
ELSE +
GETFILE LOADFILE
END
ERROR OFF
IF &STR(&ZEDLMSG) = &STR(*** END OF FILE REACHED ***) THEN +
DO
CLOSFILE LOADFILE
OPENFILE LOADFILE INPUT
SET X = 0
DO WHILE &X < &LINENUM
SET X = &X + 1
GETFILE LOADFILE
END
END
END
SET DATALEN = &LENGTH(&STR(&SYSNSUB(1,&LOADFILE)))
IF &DATALEN > &ENDCOL THEN +
SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SYSNSUB(1,&LOADFILE)))
ELSE +
SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&STR(&SYSNSUB(1,&LOADFILE)))
GOTO MAIN0008
/********************************************************************/
/* LOAD THE TABLE (CREATE IF NECESSARY) */
/********************************************************************/
PROCESS: +
ERROR RETURN
CLOSFILE LOADFILE
ERROR OFF
IF &LASTCC > 4 THEN +
DO
SET ZEDLMSG = &STR(*** ISPTABL LIBDEF UNSUCCESSFUL : +
RC = &LASTCC)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAINEXIT
END
ISPEXEC TBSTATS &TNAME STATUS1(TSTAT)
IF &TSTAT > 1 THEN +
DO
SET XKEYS =
SET XNAMES =
ISPEXEC TBVCLEAR $$$$ITUT
ISPEXEC TBTOP $$$$ITUT
DO WHILE &LASTCC = 0
IF &KEY > THEN SET &XKEYS = &STR(&XKEYS &FIELD)
ELSE SET &XNAMES = &STR(&XNAMES &FIELD)
ISPEXEC TBSKIP $$$$ITUT
END
ISPEXEC TBCREATE &TNAME WRITE KEYS(&XKEYS) NAMES(&XNAMES)
IF &LASTCC > 4 THEN +
DO
SET ZEDLMSG = &STR(*** TABLE CREATE UNSUCCESSFUL : +
RC = &LASTCC)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAINEXIT
END
END
ELSE +
DO
ISPEXEC TBOPEN &TNAME WRITE
IF &LASTCC > 4 THEN +
DO
SET ZEDLMSG = &STR(*** TABLE OPEN UNSUCCESSFUL : +
RC = &LASTCC)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAINEXIT
END
END
SET INPUTDSN = &LOADDSN
IF &SORTDSN > THEN +
DO
SET ZEDLMSG = &STR(*** SORTING DATA FROM +
"&LOADDSN" ***)
ISPEXEC SETMSG MSG(UTLZ000)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(ISPFTABL)
FREE ATTRLIST(ATTRIB2)
ATTRIB ATTRIB2 OUTPUT +
RECFM(&SYSRECFM) +
LRECL(&SYSLRECL) +
BLKSIZE(&SYSBLKSIZE)
FREE DDNAME(SORTIN)
ALLOC DDNAME(SORTIN) +
DSN('&LOADDSN') +
SHR KEEP
IF &SYSUNITS = BLOCK THEN +
SET SYSUNITS = &STR(&SYSUNITS(&SYSBLKSIZE))
DELETE SORTOUT
FREE DDNAME(SORTOUT)
ALLOC DDNAME(SORTOUT) +
DSN(SORTOUT) +
NEW CATALOG +
UNIT(SYSDA) +
SPACE(&SYSPRIMARY,&SYSSECONDS) &SYSUNITS RELEASE +
USING(ATTRIB2)
FREE DDNAME(SYSIN)
ALLOC DDNAME(SYSIN) +
DSN('&SORTDSN') +
SHR KEEP
FREE DDNAME(SORTMSG)
ALLOC DDNAME(SORTMSG) DUMMY
FREE DDNAME(SYSOUT)
IF &DBGSWTCH = &STR(ON) OR +
&DEBUG = &STR(YES) THEN +
ALLOC DDNAME(SYSOUT) DSN(*)
ELSE +
ALLOC DDNAME(SYSOUT) DUMMY
SORT
SET SORTRC = &LASTCC
FREE ATTRLIST(ATTRIB2)
FREE DDNAME(SORTIN)
FREE DDNAME(SORTOUT)
FREE DDNAME(SORTMSG)
FREE DDNAME(SYSOUT)
FREE DDNAME(SYSIN)
SET INPUTDSN = &SYSUID..SORTOUT
END
IF &SORTRC ¬= 0 THEN DO
SET ZEDLMSG = &STR(*** RETURN CODE FROM THE SORT WAS &SORTRC ***)
ISPEXEC SETMSG MSG(UTLZ001)
GOTO MAINEXIT
END
SET ZEDLMSG = &STR(*** LOADING DATA FROM "&LOADDSN" INTO "&TNAME" ***)
ISPEXEC SETMSG MSG(UTLZ000)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY PANEL(ISPFTABL)
FREE DDNAME(INFILE)
ALLOC DD(INFILE) +
DSN('&INPUTDSN') +
SHR KEEP
ERROR +
DO
SET ERRCC = &LASTCC
SELECT (&ERRCC)
WHEN (400) DO
SET EOF = YES
RETURN
END
WHEN (1:15) RETURN
WHEN (588) DO
SET &&FIELD =
RETURN
END
OTHERWISE DO
WRITE *** PROBLEM WITH CLIST ISPFTABL ***
WRITE *** RETURN CODE = &ERRCC ***
WRITE *** IN SECTION : PROCESS ***
WRITE *** WORKING ON RECORD # &X
WRITE *** RECORD VALUE = &STR(&SYSNSUB(1,&INFILE))
WRITE *** WORKING ON TABLE ROW # &CRP ID = &ROWID
WRITE *** FIELD = &FIELD
GOTO FINAL
END
END
END
SET EOF = NO
SET X = 0
SET Y = 0
OPENFILE INFILE INPUT
GETFILE INFILE
DO WHILE &EOF = NO
SET X = &X + 1
IF &EVAL(&X//10) = 0 THEN +
DO
SET ZEDLMSG = &STR(*** WORKING ON RECORD: &X)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
END
SET ERRCC = 0
ISPEXEC TBTOP $$$$ITUT
SET SKIPCC = &LASTCC
DO WHILE &SKIPCC = 0
IF &COL1 > 0 AND &COL2 > 0 THEN +
SET &&FIELD = &SUBSTR(&COL1:&COL2,+
&STR(&SYSNSUB(1,&INFILE)))
IF &STR(&SYSNSUB(1,&DEFAULT)) > THEN +
SET &&FIELD = &STR(&DEFAULT)
ISPEXEC TBSKIP $$$$ITUT ROWID(ROWID) POSITION(CRP)
SET SKIPCC = &ERRCC
END
ISPEXEC TBADD &TNAME
IF &LASTCC > 0 THEN SET Y = &Y + 1
GETFILE INFILE
END
ERROR OFF
CLOSFILE INFILE
FREE DDNAME(INFILE)
ISPEXEC TBCLOSE &TNAME
SET Y = &X - &Y
SET ZEDLMSG = &STR(*** LOADED &Y OF &X RECORDS INTO &TNAME ***)
ISPEXEC SETMSG MSG(UTLZ000)
ISPEXEC LIBDEF ISPTABL
GOTO FINAL
/********************************************************************/
/* LOAD THE TEMP TABLE WITH THE EXISTING TABLE'S FIELDS */
/********************************************************************/
TABLESEC: +
ISPEXEC TBOPEN &TNAME
IF &LASTCC = 8 THEN +
DO
SET TSTAT = 2
GOTO MAIN0003
END
ELSE SET TSTAT = 1
SET SAVENAME = &TNAME
ISPEXEC TBEND $$$$ITUT
ISPEXEC TBCREATE $$$$ITUT WRITE NAMES(FIELD KEY COL1 COL2 DEFAULT)
ISPEXEC TBVCLEAR $$$$ITUT
ISPEXEC LIBDEF ISPTLIB
ISPEXEC LIBDEF ISPTLIB DATASET ID('&TDSN')
ISPEXEC TBQUERY &TNAME KEYS(TBKEYS) +
NAMES(TBNAMES) +
KEYNUM(TBKEYNUM) +
NAMENUM(TBNAMNUM) +
ROWNUM(TBROWS)
SET L1 = &LENGTH(&STR(&SYSNSUB(1,&TBKEYS)))
SET TBKEYS = &SUBSTR(2:&L1-1,&STR(&SYSNSUB(1,&TBKEYS)))
SET L1 = &LENGTH(&STR(&SYSNSUB(1,&TBNAMES)))
SET TBNAMES = &SUBSTR(2:&L1-1,&STR(&SYSNSUB(1,&TBNAMES)))
SET X = &STR(&TBKEYS &TBNAMES)
SET X = &X
DO WHILE &X >
SET A = &SYSINDEX(&STR( ),&STR(&X))
SET A = &A - 1
IF &A < 1 THEN SET A = &LENGTH(&STR(&X))
IF &A > 0 THEN +
DO
ISPEXEC TBVCLEAR $$$$ITUT
SET FIELD = &SUBSTR(1:&A,&STR(&X))
IF &SYSINDEX(&STR(&FIELD),&STR(&TBKEYS)) > 0 THEN +
SET KEY = K
ELSE +
SET KEY =
ISPEXEC TBADD $$$$ITUT ORDER
SET A = &A + 2
SET SLEN = &LENGTH(&STR(&X))
IF &A > &SLEN THEN SET X =
ELSE +
SET &X = &SUBSTR(&A:&SLEN,&STR(&X))
END
ELSE SET X =
END
ISPEXEC TBEND &TNAME
ISPEXEC TBTOP $$$$ITUT
SET SAVENAME = &TNAME
GOTO MAIN0003
/********************************************************************/
/* EDIT THE SORT DATASET */
/********************************************************************/
SORTSEC: +
ISPEXEC EDIT DATASET('&SORTDSN')
IF &LASTCC > 8 THEN +
DO
SET ZEDLMSG = &STR(*** COULD NOT EDIT "&SORTDSN" +
BROWSING IT INSTEAD ***)
ISPEXEC SETMSG MSG(UTLZ000)
ISPEXEC BROWSE DATASET('&SORTDSN')
IF &LASTCC > 8 THEN +
DO
SET ZEDLMSG = &STR(*** COULD NOT ACCESS "&SORTDSN" +
***)
ISPEXEC SETMSG MSG(UTLZ001)
END
END
SET SORTEDIT = N
GOTO MAINEXIT
Documentation
This utility allows you to load or append an ISPF table from a sequential file
or PDS member. If the ISPF table exists, its table definition will be
displayed, and the user can then specify which dataset columns go into which
fields, or what default value will go into a field. If the ISPF table does not
exist, the user can define the fields that will go into the table and in
addition to loading the table, it will be created as well. The dataset from
which the data will be loaded is also displayed with a column scale and can be
scrolled 4 ways and strings can be found. Finally, the load dataset can be
sorted/stripped prior to load via SyncSort by specifying a sort cards dataset
(this may be edited from the ISPFTABL panel also).
0 Comments