Back To LeighWeb Mainframe Utilities Page

/* REXX ***************************************************************/
/* UTILITY: IDFIX                                                     */
/* AUTHOR: DAVID LEIGH                                                */
/* FUNCTION: THIS UTILITY SCANS REGULAR PDS'S OR ISPF PROFILE PDS'S   */
/*           TO REPLACE OCCURANCES OF ONE'S OLD USER ID WITH ONE'S    */
/*           NEW USERID.                                              */
/*                                                                    */
/**********************************************************************/
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
/**********************************************************************/
/* GET THE ID EITHER PASSED IN OR PROMPT FOR IT                       */
/**********************************************************************/
PARSE UPPER ARG DSN OLDID

DO WHILE DSN = ''
    SAY 'PLEASE ENTER THE LIBRARY NAME TO SCAN OR "X" TO QUIT ==>'
    PULL DSN
    IF DSN = 'X' THEN EXIT
END

/**********************************************************************/
/* DETERMINE WHAT THE OLD ID WAS THAT YOU'RE CHANGING FROM            */
/**********************************************************************/

OLDID = SUBSTR(SYSVAR(SYSUID),1,2) ¦¦,
        SUBSTR(SYSVAR(SYSUID),4,3)

/**********************************************************************/
/* HAVE THE USER CONFIRM THIS AND GIVE THE OPPORTUNITY TO QUIT        */
/**********************************************************************/
ADDRESS ISPEXEC
"ADDPOP ROW(7) COLUMN(15)"

DO FOREVER
    "DISPLAY PANEL(IDFIX)"
    SELECT
        WHEN RC = 0 & OLDID > '' THEN DO
            "VPUT OLDID SHARED"
            LEAVE
        END
        WHEN RC = 8 THEN DO
            "REMPOP"
            EXIT
        END
        OTHERWISE NOP
    END
END

/**********************************************************************/
/* PREP THE DATASET NAME AND DETERMINE IF THIS IS THE ISPF PROFILE    */
/**********************************************************************/
QTE = "'"

IF POS(QTE,DSN) = 0 THEN DSN = QTE ¦¦ DSN ¦¦ QTE

IF DSN = "'" ¦¦ SYSVAR(SYSUID) ¦¦ ".ISPF.ISPPROF'" THEN
    PROFLIB = YES
ELSE
    PROFLIB = NO

/**********************************************************************/
/* SET UP THE PROCESSING MESSAGES TO GO TO A TEMPORARY FILE           */
/**********************************************************************/
ADDRESS TSO
DUMMY = OUTTRAP(NULL)
"FREE     DD(TEMPOUT)"
TEMPFILE = SYSVAR(SYSUID)".TEMP.IDFIX.D"SUBSTR(DATE('S'),3,6) ¦¦,
                                    ".T"SUBSTR(TIME('N'),1,2) ¦¦,
                                        SUBSTR(TIME('N'),4,2) ¦¦,
                                        SUBSTR(TIME('N'),7,2)
"DELETE '"TEMPFILE"'"
"ALLOCATE DD(TEMPOUT) DSN('"TEMPFILE"')" ,
                     "NEW CATALOG" ,
                     "UNIT(SYSDA) VOLUME(WRK$$$)" ,
                     "SPACE(1,1) CYLINDERS RELEASE" ,
                     "RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS)"
DROP NULL.

"NEWSTACK"
QUEUE "IDFIX RESULTS FOR DATASET: "DSN

"EXECIO 1 DISKW TEMPOUT"
"DELSTACK"

/**********************************************************************/
/* POINT TO THE DATASET TO BE PROCESSED AND DO A PRIMING MEMBER READ  */
/**********************************************************************/
ADDRESS ISPEXEC
"ADDPOP"
"LMINIT DATASET("DSN") DATAID(DID) ENQ(SHRW)"
IF PROFLIB = 'YES' THEN
    DO
        "LIBDEF ISPTLIB"
        "LIBDEF ISPTLIB LIBRARY ID(ISPPROF)"
        "VGET ZAPPLID"
    END

"LMOPEN DATAID("DID")"
"LMMLIST DATAID("DID") MEMBER(MBR) OPTION(LIST)"

/**********************************************************************/
/* LOOP THROUGH THE MEMBERS AND EDIT THEM TO FIX THEM.                */
/**********************************************************************/
DO WHILE RC = 0
    MBR = STRIP(MBR)
    IF PROFLIB = 'YES' THEN
        IF POS('PROF',MBR) = LENGTH(MBR) - 3 THEN
            DO
                APPL = SUBSTR(MBR,1,POS('PROF',MBR)-1)
                IF APPL ¬= 'ISPS' THEN
                    DO
                        IF APPL = ZAPPLID THEN
                            DO
                                APPL = ''
                                SAMEAPPL = 'YES'
                            END
                        ELSE
                            DO
                                APPL = "NEWAPPL("APPL")"
                                SAMEAPPL = 'NO'
                            END
                        "CONTROL DISPLAY LOCK"
                        "DISPLAY PANEL(IDFIX2)"
                        "SELECT CMD(%IDFIXPRF",
                                OLDID MBR SAMEAPPL ")" APPL
                    END
            END
        ELSE NOP
    ELSE
        DO
            "CONTROL DISPLAY LOCK"
            "DISPLAY PANEL(IDFIX2)"
            "EDIT DATAID("DID") MEMBER("MBR") MACRO(IDFIXLIB)"
            IF RC = 20 THEN DO
                XMBR = SUBSTR(MBR"        ",1,8) "-"
                QUEUE XMBR "RC = 20, MESSAGE:" ZERRLM
                ADDRESS TSO "EXECIO 1 DISKW TEMPOUT"
            END
        END
    "LMMLIST DATAID("DID") MEMBER(MBR) OPTION(LIST)"
END

/**********************************************************************/
/* CLEAN UP AND LET THE USER KNOW WHERE THE OUTPUT IS.                */
/**********************************************************************/
"LMMLIST DATAID("DID") MEMBER(MBR) OPTION(FREE)"
"LMCLOSE DATAID("DID")"
"LMFREE DATAID("DID")"
"REMPOP"
"REMPOP"

ADDRESS TSO
"EXECIO 0 DISKW TEMPOUT (FINIS"
"FREE DD(TEMPOUT)"

ADDRESS ISPEXEC "EDIT DATASET('"TEMPFILE"')"