Mainframe Utility: ISPFTABL

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).
            


Leave a Reply

Your email address will not be published. Required fields are marked *