Back To LeighWeb Mainframe Utilities Page

PROC 1 TABLE
ISPEXEC CONTROL ERRORS RETURN
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN +
     CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
IF &HELP = HELP THEN GOTO HELPSEC
/**********************************************************************
/* UTILITY : TBINFO                                                   *
/* AUTHOR : DAVID LEIGH                                               *
/* FUNCTION : LOAD INFORMATION ABOUT A TABLE INTO A FILE TO BE EDITED *
/*            OR READ PROGRAMATICALLY.                                *
/**********************************************************************

ISPEXEC TBSTATS &TABLE CDATE(CDATNAME)    CTIME(CTIMNAME)    +
                       UDATE(UDATNAME)    UTIME(UTIMNAME)    +
                       USER(USERNAME)     ROWCREAT(RCRTNAME) +
                       ROWCURR(RCURNAME)  ROWUPD(RUPDNAME)   +
                       TABLEUPD(TUPDNAME) SERVICE(SERVNAME)  +
                       RETCODE(RETCNAME)  STATUS1(STA1NAME)  +
                       STATUS2(STA2NAME)  STATUS3(STA3NAME)

IF &STR(&CDATNAME) =     THEN +
    DO
        ISPEXEC TBSTATS &TABLE CDATE(CDATNAME)    CTIME(CTIMNAME)    +

                               UDATE(UDATNAME)    UTIME(UTIMNAME)    +
                               USER(USERNAME)     ROWCREAT(RCRTNAME) +
                               ROWCURR(RCURNAME)  ROWUPD(RUPDNAME)   +
                               TABLEUPD(TUPDNAME) SERVICE(SERVNAME)  +
                               RETCODE(RETCNAME)  STATUS1(STA1NAME)  +
                               STATUS2(STA2NAME)  STATUS3(STA3NAME)  +
                               LIBRARY(ISPPROF)
        IF &STR(&CDATNAME) =     THEN +
            DO
                SET ZEDLMSG = &STR(*** TABLE "&TABLE" NOT FOUND ***)
                ISPEXEC SETMSG MSG(UTLZ001)
                EXIT CODE(8)
            END
        ELSE +
            DO
                ISPEXEC TBOPEN &TABLE NOWRITE SHARE LIBRARY(ISPPROF)
                SET OPENCC = &LASTCC
                ISPEXEC SELECT CMD(%FINDMOD &TABLE ISPPROF BATCH)
                IF &LASTCC = 0 THEN +
                    DO
                        ISPEXEC VGET DSN SHARED
                        SET XUTFILE = &STR(PHYSICAL TABLE LOCATION: +
                                           &DSN)
                    END
            END
    END
ELSE +
    DO
        ISPEXEC TBOPEN &TABLE NOWRITE SHARE
        SET OPENCC = &LASTCC
        ISPEXEC SELECT CMD(%FINDMOD &TABLE ISPTLIB BATCH)
        IF &LASTCC = 0 THEN +
            DO
                ISPEXEC VGET DSN SHARED
                SET XUTFILE = &STR(PHYSICAL TABLE LOCATION: &DSN)
            END
    END

SET TEMPFILE = &STR(&SYSUID..TEMP.TBINFO.&TABLE)
FREE DDNAME(OUTFILE)
DELETE '&TEMPFILE'
ALLOC DD(OUTFILE) DSN('&TEMPFILE') +
                  NEW CATALOG +
                  UNIT(SYSDA) VOLUME(WRK$$$) +
                  SPACE(1,1) TRACKS RELEASE +
                  RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)

OPENFILE OUTFILE OUTPUT

ISPEXEC TBQUERY &TABLE KEYS(TBKEYS) +
                       NAMES(TBNAMES) +
                       ROWNUM(TBROWNUM) +
                       KEYNUM(TBKEYNUM) +
                       NAMENUM(TBNAMNUM) +
                       POSITION(TBCRPNAM)

IF &STR(&TBKEYS) >    THEN +
    DO
        SET A = &LENGTH(&STR(&TBKEYS))
        SET A = &A - 1
        SET SYSDVAL = &SUBSTR(2:&A,&STR(&TBKEYS))
    END

IF &STR(&TBNAMES) >   THEN +
    DO
        SET A = &LENGTH(&STR(&TBNAMES))
        SET A = &A - 1
        IF &STR(&SYSDVAL) >     THEN +
            SET SYSDVAL = &STR(&SYSDVAL &SUBSTR(2:&A,&STR(&TBNAMES)))
        ELSE +
            SET SYSDVAL = &SUBSTR(2:&A,&STR(&TBNAMES))
    END

READDVAL F1  F2  F3  F4  F5  F6  F7  F8  F9  F10 +
         F11 F12 F13 F14 F15 F16 F17 F18 F19 F20 +
         F21 F22 F23 F24 F25 F26 F27 F28 F29 F30 +
         F31 F32 F33 F34 F35 F36 F37 F38 F39 F40 +
         F41 F42 F43 F44 F45 F46 F47 F48 F49 F50 +
         F51 F52 F53 F54 F55 F56 F57 F58 F59 F60 +
         F61 F62 F63 F64 F65 F66 F67 F68 F69 F70 +
         F71 F72 F73 F74 F75 F76 F77 F78 F79 F80 +
         F81 F82 F83 F84 F85 F86 F87 F88 F89 F90 +
         F91 F92 F93 F94 F95 F96 F97 F98 F99 F100

SET OUTFILE = &STR(&XUTFILE)
PUTFILE OUTFILE
SET OUTFILE = &STR(NUMBER OF KEY FIELDS: &TBKEYNUM)
PUTFILE OUTFILE
SET I = 1
DO &I = &I TO &TBKEYNUM
    SET X = &&F&I
    SET OUTFILE = &STR(FIELD NAME &I (KEY): )&X
    PUTFILE OUTFILE
END
SET OUTFILE = &STR(NUMBER OF NAME FIELDS: &TBNAMNUM)
PUTFILE OUTFILE
DO &I = &I TO &TBNAMNUM
    SET X = &&F&I
    SET OUTFILE = &STR(FIELD NAME &I.: )&X
    PUTFILE OUTFILE
END
SET OUTFILE = &STR(TOTAL NUMBER OF FIELDS: &EVAL(&TBNAMNUM + &TBKEYNUM))
PUTFILE OUTFILE
SET OUTFILE = &STR(ROW CURRENTLY BEING POINTED TO: &TBCRPNAM)
PUTFILE OUTFILE
SET OUTFILE = &STR(CREATION DATE: &CDATNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(CREATION TIME: &CTIMNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(LAST UPDATE DATE: &UDATNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(LAST UPDATE TIME: &UTIMNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(LAST UPDATE USER: &USERNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(INITIAL ROW COUNT: &RCRTNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(CURRENT ROW COUNT: &RCURNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(NUMBER OF UPDATED ROWS: &RUPDNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(NUMBER OF TIMES TABLE HAS BEEN UPDATED: &TUPDNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(LAST TABLE SERVICES COMMAND: &SERVNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(LAST TABLE SERVICES RETURN CODE: &RETCNAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(TABLE STATUS IN INPUT LIBRARY: &STA1NAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(TABLE STATUS IN THIS LOGICAL SCREEN: &STA2NAME)
PUTFILE OUTFILE
SET OUTFILE = &STR(TABLE STATUS FOR WRITE MODE USE: &STA3NAME)
PUTFILE OUTFILE

IF &OPENCC = 0 THEN ISPEXEC TBEND &TABLE

CLOSFILE OUTFILE
FREE DD(OUTFILE)
ISPEXEC EDIT DATASET('&TEMPFILE')

EXIT

HELPSEC: +                                                              02480000
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)                             02490000
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR TBINFO UTILITY +              02490000
                   *** NO PROCESSING PERFORMED ***)                     02490000
ISPEXEC SETMSG MSG(UTLZ000)                                             02490000
EXIT