Mainframe Utility: DUMPTABL

Return to Mainframe Utilities Page

Module


PROC 1 TABLE TLIB() DEBUG
ISPEXEC CONTROL ERRORS RETURN
IF &DEBUG = DEBUG THEN +
    CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS
ELSE +
    CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS
IF &TABLE = HELP THEN GOTO HELPSEC
/**********************************************************************
/* CLIST : DUMPTABL                                                   *
/* AUTHOR : DAVE LEIGH                                                *
/* DATE : 7-6-90                                                      *
/* FUNCTION : THIS CLIST DUMPS THE CONTENTS OF ISPF TABLES INTO 2     *
/*            FILES.  THE FIRST IS A FLAT FILE.  THE SECOND IS AN     *
/*            EXECUTABLE CLIST WHICH, WHEN EXECUTED, WILL "SELF-LOAD" *
/*            THE TABLE.                                              *
/**********************************************************************

IF &STR(&TLIB) >      THEN +
    DO
        ISPEXEC LIBDEF ISPTLIB DATASET ID('&TLIB') UNCOND
        SET LIBCC = &LASTCC
        IF &LIBCC > 0 THEN +
            DO
                SET ZEDLMSG = &STR(*** RC = &LIBCC FOR +
                                   LIBDEF OF &TLIB ***)
                ISPEXEC SETMSG MSG(UTLZ001)
                EXIT
            END
    END

SET RP = &STR())
SET PLUS = &STR(+)
/*** ATTEMPT TO OPEN THE TABLE THE USER PASSED AS INPUT ***/
ISPEXEC TBOPEN &TABLE NOWRITE
SET SAVECC = &LASTCC
IF &SAVECC > 0 THEN +
    DO
        SET ZEDLMSG = &STR(*** RC = &SAVECC TRYING TO OPEN &TABLE ***)
        IF &SAVECC = 12 THEN GOTO KEEPON
/*          DO
/*              ISPEXEC TBSTATS &TABLE STATUS1(S1) STATUS2(S2)
/*              IF &S1 = 1 AND &S2 = 4 THEN SET CLOSE = NO
/*              ELSE +
/*                  DO
/*                      ISPEXEC SETMSG MSG(UTLZ001)
/*                      EXIT
/*                  END
/*          END
        ELSE +
            DO
                ISPEXEC SETMSG MSG(UTLZ001)
                EXIT
            END
    END

/*** GET THE # AND NAME OF THE FIELDS IN THE TABLE AND # OF ROWS ***/
KEEPON: +
ISPEXEC TBQUERY &TABLE KEYS(TKEYS) NAMES(TNAMES) KEYNUM(X) NAMENUM(Y) +
                       ROWNUM(NUMROWS)
IF &STR(&TKEYS) >    THEN +
    DO
        SET A = &LENGTH(&STR(&TKEYS))
        SET A = &A - 1
        SET SYSDVAL = &SUBSTR(2:&A,&STR(&TKEYS))
    END
IF &STR(&TNAMES) >    THEN +
    DO
        SET A = &LENGTH(&STR(&TNAMES))
        SET A = &A - 1
        IF &STR(&SYSDVAL) >     THEN +
            SET SYSDVAL = &STR(&SYSDVAL &SUBSTR(2:&A,&STR(&TNAMES)))
        ELSE +
            SET SYSDVAL = &SUBSTR(2:&A,&STR(&TNAMES))
    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 NUMFLDS = &X + &Y

CLEAR
WRITE
WRITE *** DETERMINING LRECL OF LONGEST TABLE ROW FOR "&TABLE" ***
ISPEXEC TBTOP &TABLE
ISPEXEC TBSKIP &TABLE

DO WHILE &LASTCC = 0
    SET X = 0
    DO WHILE &X < &NUMFLDS
        ERROR DO
            RETURN
        END
        SET X = &X + 1
        SET Y = &SYSNSUB(2,&&F&X)
        SET Y = &LENGTH(&SYSNSUB(3,&&&Y))
        SET Z = &STR(&SYSNSUB(2,&&L&X))
        IF &Y > &Z THEN SET L&X = &Y
        ERROR OFF
    END
    ISPEXEC TBSKIP &TABLE
END

/*** CALC THE LRECL FROM THE INDIVIDUAL FIELD LENGTHS ***/
SET X = 0
SET LRECL = 0

DO WHILE &X < &NUMFLDS
    SET X = &X + 1
    SET Y = &STR(&SYSNSUB(2,&&L&X))
    IF &Y = 0 THEN SET Y = 1
    SET LRECL = &LRECL + &Y
END

/*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE FLAT FILE ***/
ISPEXEC SELECT CMD(%BLKSIZE &LRECL &NUMROWS DEVICE(3380) BATCH)
ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED
SET X = &EVAL(&TRKSREQ / 10)
IF &X < 1 THEN SET X = 1

/*** ALLOCATE THE OUTPUT FLAT FILE ***/
DELETE '&SYSUID..TEMP.&TABLE..FLAT'
FREE DDNAME(FLATFILE)
ALLOC DD(FLATFILE) DSN('&SYSUID..TEMP.&TABLE..FLAT') +
      NEW CATALOG +
      UNIT(SYSDA) VOLUME(WRK$$$) +
      SPACE(&TRKSREQ,&X) TRACKS RELEASE +
      RECFM(F B) LRECL(&LRECL) BLKSIZE(&BLKSIZE) DSORG(PS)

/*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE LOAD FILE ***/
ISPEXEC SELECT CMD(%BLKSIZE 255 &EVAL(&NUMROWS * &NUMFLDS + 500) +
                   DEVICE(3380) BATCH)
ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED
SET X = &EVAL(&TRKSREQ / 10)
IF &X < 1 THEN SET X = 1

/*** ALLOCATE THE OUTPUT LOAD FILE ***/
DELETE '&SYSUID..TEMP.&TABLE..LOAD'
FREE DDNAME(LOADFILE)
ALLOC DD(LOADFILE) DSN('&SYSUID..TEMP.&TABLE..LOAD') +
      NEW CATALOG +
      UNIT(SYSDA) VOLUME(WRK$$$) +
      SPACE(&TRKSREQ,&X) TRACKS RELEASE +
      RECFM(F B) LRECL(255) BLKSIZE(&BLKSIZE) DSORG(PS)

/*** CREATE A "SUFFIX" SPACE VARIABLE = TO THE LRECL LENGTH ***/
SET SPACE = &STR( )
SET X = 0

DO WHILE &X < &LRECL
    SET X = &X + 1
    SET SPACE = &STR( &SPACE)
END

WRITE
WRITE *** LOADING BOTH THE "FLAT" FILE AND THE "LOAD" FILE ***
/*** PUT BEGINNING CLIST LINES IN THE LOAD FILE ***
OPENFILE LOADFILE OUTPUT
SET LOADFILE = +
&NRSTR(PROC 0 TABLE(&TABLE)                               )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(ISPEXEC VGET (DBGSWTCH) PROFILE                    )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&DBGSWTCH = &STR(ON) THEN +                    )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS  )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(ELSE +                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE *********************************************)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * THIS CLIST LOADS A TABLE THAT WAS UNLOADED )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * ON &SYSDATE AT &SYSTIME BY THE NAME OF     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * "&TABLE".  DEFAULT EXECUTION OF THIS       )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * CLIST WILL APPEND "&TABLE" WITH THE ROWS   )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * WHICH WERE PREVIOUSLY UNLOADED.  YOU MUST  )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * SPECIFY FULLY QUALIFIED DATASET NAME       )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * WHICH IS THE ISPF TABLE LIBRARY INTO WHICH )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * "&TABLE" IS TO BE STORED.  YOU MAY ALSO    )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * RELOAD "&TABLE" INTO A DIFFERENT TABLE     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * NAME.  YOU MAY ALSO SPECIFY WHETHER YOU    )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * WOULD LIKE TO "CREATE", "REPLACE", OR      )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * "APPEND" A GIVEN TABLE.  SUCCESSFUL        )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE * APPENDING ASSUMES "LIKE-NAMED" FIELDS.     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE *********************************************)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITE                                              )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITENR ENTER TABLE LIBRARY NAME HERE ==>          )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(READ TLIB                                          )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&TLIB =      THEN +                            )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    DO                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        SET ZEDLMSG = &STR(&&)STR(*** NO TABLE LIBRARY &PLUS
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(           ENTERED *** NO PROCESSING PERFORMED ***&RP)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        ISPEXEC SETMSG MSG(UTLZ001)                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        EXIT                                       )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    END                                            )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(SET TLIB = &&STR(&&SYSCAPS(&&TLIB))                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(ISPEXEC LIBDEF ISPTABL                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(ISPEXEC LIBDEF ISPTABL DATASET ID('&&TLIB')        )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(SET SAVECC = &&LASTCC                              )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&SAVECC > 0 THEN +                              )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    DO                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        SET ZEDLMSG = &STR(&&)STR(*** "ISPTABL LIBDEF" &PLUS
PUTFILE LOADFILE
SET LOADFILE = +
&STR(           OF "&&TLIB" FAILED WITH RC = &&SAVECC ***&RP)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        ISPEXEC SETMSG MSG(UTLZ001)                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        EXIT                                       )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    END                                            )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITENR ENTER NEW TABLE NAME HERE, OR PRESS +      )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(         TO USE "&TABLE" ==>                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(READ XTABLE                                        )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&XTABLE >       THEN SET TABLE = &&XTABLE        )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(SET ACTION = APPEND                                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(WRITENR ENTER (C)REATE, OR (R)EPLACE.  JUST PRESS +)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(         TO (A)PPEND ==>                    )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(READ XACTION                                       )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&XACTION >      THEN SET ACTION = &&SYSCAPS(&&XACTION))
PUTFILE LOADFILE
SET LOADFILE = +
&STR(SET ACTION = &&SUBSTR(1:1,&&ACTION)                  )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&ACTION ¬= A AND +                              )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(   &&ACTION ¬= C AND +                              )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(   &&ACTION ¬= R THEN +                             )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    DO                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        SET ZEDLMSG = &STR(&&)STR(*** ACTION MUST BE &PLUS
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(           (A)PPEND, (C)REATE, OR (R)EPLACE ***&RP)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        ISPEXEC SETMSG MSG(UTLZ001)                )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(        EXIT                                       )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    END                                            )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&ACTION = R THEN +                              )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    DO                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        ISPEXEC TBERASE &&TABLE                     )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        SET SAVECC = &&LASTCC                       )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        IF &&SAVECC = 8 THEN +                      )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(            WRITE *** "&&TABLE" DOES NOT EXIST IN + )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(                  "&&TLIB" *** CONTINUING ***       )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        IF &&SAVECC = 12 THEN +                     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(            DO                                     )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(                SET ZEDLMSG = &STR(&&)STR(*** "&&TABLE" &PLUS
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                   IN USE, CANNOT REPLACE IT ***&RP)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                ISPEXEC SETMSG MSG(UTLZ001)        )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                ISPEXEC LIBDEF ISPTABL             )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                EXIT                               )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(            END                                    )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    END                                            )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(IF &&ACTION = R OR &&ACTION = C THEN                 )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    DO                                             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        ISPEXEC TBCREATE &&TABLE +                  )
PUTFILE LOADFILE
SET X = 0
SET PLS = &STR(+)
SET NME = &STR(NAMES)
SET NLP = &STR((
SET NRP =
SET KYS = &STR(KEYS)
SET KLP = &STR((
SET KRP =
DO WHILE &X < &NUMFLDS
    SET X = &X + 1
    SET Y = &SYSNSUB(2,&&F&X)
    IF &SYSINDEX(&Y,&STR(&TNAMES)) > 0 THEN +
        DO
            SET NAMESWITCH = ON
            IF &X = 1 THEN +
                DO

                    SET LOADFILE = +
                        &NRSTR(                         KEYS() &PLS)
                    PUTFILE LOADFILE
                END
        END
    IF &NAMESWITCH = ON THEN +
        DO
            IF &X = &NUMFLDS THEN SET NRP = &STR())
            SET LOADFILE = +
                &NRSTR(                         &NME&NLP&Y&NRP &PLS)
            SET NME = &STR(     )
            SET NLP = &STR( )
        END
    ELSE +
        DO
            SET Q = &X + 1
            SET Q = &SYSNSUB(2,&&F&Q)
            IF &SYSINDEX(&Q,&STR(&TKEYS)) = 0 THEN SET KRP = &STR())
            SET LOADFILE = +
                &NRSTR(                         &KYS&KLP&Y&KRP &PLS)
            SET KYS = &STR(    )
            SET KLP = &STR( )
        END
    PUTFILE LOADFILE
END
SET LOADFILE = +
&NRSTR(                         LIBRARY(ISPTABL) &PLS     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                         WRITE                     )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        SET SAVECC = &&LASTCC                       )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(        IF &&SAVECC > 4 THEN &PLS                   )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(            DO                                     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                ISPEXEC LIBDEF ISPTABL             )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(                SET ZEDLMSG = &STR(&&)STR(*** COULD NOT &PLS)
PUTFILE LOADFILE
SET LOADFILE = +
&STR(                   CREATE A NEW "&&TABLE". &PLS     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                   "TBCREATE" FAILED W/RC = &PLS   )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(                   &&SAVECC ***&RP)
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                ISPEXEC SETMSG MSG(UTLZ001)        )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(                EXIT                               )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(            END                                    )


PUTFILE LOADFILE
SET LOADFILE = +
&STR(        ISPEXEC TBCLOSE &&TABLE                     )
PUTFILE LOADFILE
SET LOADFILE = +
&NRSTR(    END                                            )
PUTFILE LOADFILE
SET LOADFILE = +
&STR(ISPEXEC TBOPEN &&TABLE WRITE)
PUTFILE LOADFILE

OPENFILE FLATFILE OUTPUT
SET FLATFILE = &STR(&SPACE)
ISPEXEC TBTOP &TABLE
ISPEXEC TBVCLEAR &TABLE
SET WRITESWITCH = ON
ISPEXEC TBSKIP &TABLE

WRITE
WRITE *** THIS IS THE LAYOUT FOR "&SYSUID..TEMP.&TABLE..FLATFILE" ***
WRITE *** !!! SCREEN PRINT THIS !!! ***
SET RWS = 0
DO WHILE &LASTCC = 0
    SET RWS = &RWS + 1
    SET X = 0
    SET A = 0
    DO WHILE &X < &NUMFLDS
        SET X = &X + 1
        SET Y = &STR(&SYSNSUB(2,&&L&X))
        IF &Y = 0 THEN +
            DO
                SET Y = 1
                SET FFLD = &STR( )
                SET LFLD = &STR( )
                IF &WRITESWITCH = ON THEN +
                    WRITE NOTE : FIELD "&SYSNSUB(2,&&F&X)" HAD NO +
                          NON-NULL VALUES...SUBSTITUTING 1 SPACE
            END
        ELSE +
            DO
ERROR DO
    SET ERRCC = &LASTCC
    WRITE *** ERR001 ERROR CC: &ERRCC PROCESSING RECORD #&RWS ***
    WRITE &STR(*** FIELD 1 NAME = "&F1")
    WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)")
    WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+
          &STR( IT WILL BE SET TO "?")
    SET ERRF = &STR(&SYSNSUB(2,&&F&X))
    SET &&ERRF = &STR(?)
    RETURN
END
                SET LFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X))
                SET LFLD = &STR(&LFLD)
                IF &STR(&LFLD) =     THEN SET LFLD = &STR( )
                SET FFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X))&STR(&SPACE)
                SET FFLD = &SUBSTR(1:&Y,&STR(&FFLD))
ERROR OFF
            END
ERROR DO
    SET ERRCC = &LASTCC
    WRITE *** ERR002 ERROR CC: &ERRCC PROCESSING RECORD #&RWS ***
    WRITE &STR(*** FIELD 1 NAME = "&F1")
    WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)")
    WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+
          &STR( IT WILL BE SET TO "?")
    SET ERRF = &STR(&SYSNSUB(2,&&F&X))
    SET &&ERRF = &STR(?)
    RETURN
END
        SET B = &Y + 1
        SET LOADFILE = +
            &STR(SET &SYSNSUB(2,&&F&X) = +
            &STR(&&STR(&&SYSNSUB(0,&STR(&SYSNSUB(1,&LFLD)))))
        PUTFILE LOADFILE
        IF &A = 0 THEN +
            SET FLATFILE = &STR(&FFLD)+
                           &SUBSTR(&B:&LRECL,&STR(&FLATFILE))
        ELSE +
            SET FLATFILE = &SUBSTR(1:&A,&STR(&FLATFILE))+
                           &STR(&FFLD)+
                           &SUBSTR(&B:&LRECL,&STR(&FLATFILE))
ERROR OFF
        IF &WRITESWITCH = ON THEN +
            WRITE FIELD : "&SYSNSUB(2,&&F&X)" IS AT POSITION +
                  &EVAL(&A + 1) FOR A LENGTH OF &Y
        SET A = &A + &Y
    END
    SET WRITESWITCH = OFF
    SET LOADFILE = &STR(ISPEXEC TBADD &&TABLE)
    PUTFILE LOADFILE
    PUTFILE FLATFILE
    IF &EVAL(&RWS//10) = 0 THEN +
        DO
            SET LOADFILE = &STR(WRITE &RWS ROWS LOADED INTO &&TABLE)
            PUTFILE LOADFILE
            WRITE &STR(&RWS ROWS DUMPED FOR TABLE &TABLE)
        END
    ISPEXEC TBSKIP &TABLE
END

SET LOADFILE = &STR(ISPEXEC TBCLOSE &&TABLE)
PUTFILE LOADFILE
/* SET LOADFILE = &STR(ISPEXEC LIBDEF ISPTABL)
/* PUTFILE LOADFILE

FINAL: +
CLOSFILE LOADFILE
FREE DDNAME(LOADFILE)
CLOSFILE FLATFILE
FREE DDNAME(FLATFILE)
FREE ATTRLIST(ATTRIB1)

IF &CLOSE ¬= NO THEN ISPEXEC TBEND &TABLE
IF &STR(&TLIB) >      THEN ISPEXEC LIBDEF ISPTLIB
ISPEXEC BROWSE DATASET('&SYSUID..TEMP.&TABLE..FLAT')

EXIT

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


Documentation


 DUMPTABL allows you to specify an ISPF table name which is currently in the
 ISPTLIB concatenation and it will automatically create a flat file containing
 all of the records in the table in a consistant record layout.  It also creates
 a CLIST which, when run will re-load the table.  The flatfile could also
 subsequently be used as input to the ISPFTABL utility to load a table.
            


Leave a Reply

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