Mainframe Utility: LABLPROF

Return to Mainframe Utilities Page

Module


ISREDIT MACRO (PARM OLDNAME)
ISPEXEC CONTROL ERRORS RETURN
/**** 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
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
/*****************************************************************/
/* EDIT MACRO "LABLPROF" - SET/INSERT LABELS FOR A SPECIFIC FILE */
/* WHICH ARE STORED IN AN ISPF PROFILE VARIABLE OF THE SAME NAME.*/
/* DAVID LEIGH - 4-11-90                                         */
/*****************************************************************/

ISREDIT (SLN,SCL) = CURSOR
ISREDIT (MBR) = MEMBER
ISREDIT (DSN) = DATASET
IF &SYSINDEX(&STR(&SYSUID..PANVALET.),&STR(&DSN)) = 1 THEN +
    DO
        ISPEXEC VGET PMBR
        SET MBR = &PMBR
    END
IF &STR(&MBR) =     THEN +
    DO
        SET MBR = &STR(&DSN)
        DO WHILE &SYSINDEX(&STR(.),&STR(&MBR)) > 0
            SET A = &SYSINDEX(&STR(.),&STR(&MBR))
            SET B = &LENGTH(&STR(&MBR))
            SET A = &A + 1
            SET MBR = &SUBSTR(&A:&B,&STR(&MBR))
        END
    END
SET ZEDLMSG = &STR(*** VALID PARAMETERS ARE:  +
                   HELP, SET, SHOW, RENAME HILITE ***)
SELECT &STR(&PARM)
    WHEN (HELP)                      GOTO HELPSEC
    WHEN (HILITE)                    GOTO HILISEC
    WHEN (SET)                       GOTO SETSEC
    WHEN (SHOW)                      GOTO SHOWSEC
    WHEN (RENAME)                    GOTO RENAMESEC
    WHEN (COPY)                      GOTO COPYSEC
    WHEN ()                          GOTO INSLABEL
    OTHERWISE                        ISPEXEC SETMSG MSG(UTLZ001)
END

EXIT

/*****************************************************************/
/* SET THE VARIABLE TO A NEW VALUE                               */
/*****************************************************************/
SETSEC: +
ISREDIT (B1,B2) = BOUNDS
ISREDIT LOCATE FIRST LABEL
SET SAVECC = &LASTCC
SET X = 0
DO WHILE &SAVECC = 0
    SET X = &X + 1
    ISREDIT (FLINE,NULL) = DISPLAY_LINES
    ISREDIT (LBL,NULL) = LABEL &FLINE
    SET LBL = &LBL
    SET SAVELBL = &STR(&SAVELBL &LBL)
    ISREDIT (DLINE) = LINE &LBL
    SET DLINE = &SUBSTR(&B1:&B2,&NRSTR(&DLINE))
    ISREDIT (LN,CL) = CURSOR
    SET TEMP = &NRSTR(&TEMP)+
               &STR(ISREDITLABEL=&LBL)&NRSTR(ISREDITLINE=&DLINE)
    IF &SYSINDEX(&STR('),&NRSTR(&DLINE)) > 0 THEN SET QTS = &STR(")
    ELSE SET QTS = &STR(')
    ISREDIT SEEK ALL &QTS&NRSTR(&DLINE)&QTS
    ISREDIT (NULL,SCOUNT) = SEEK_COUNTS
    IF &SCOUNT > 1 THEN +
        DO
            ISREDIT SEEK FIRST &QTS&NRSTR(&DLINE)&QTS
            SET FINDCC = &LASTCC
            ISREDIT (XLN,CL) = CURSOR
            SET A = 1
            DO WHILE &FINDCC = 0 AND &XLN < &LN
                ISREDIT SEEK NEXT &QTS&NRSTR(&DLINE)&QTS
                SET FINDCC = &LASTCC
                ISREDIT (XLN,CL) = CURSOR
                IF &FINDCC = 0 THEN SET A = &A + 1
            END
            SET TEMP = &NRSTR(&TEMP)&STR(ISREDITOCCURANCE=&A)
        END
    ISREDIT CURSOR = &LN 1
    ISREDIT LOCATE NEXT LABEL
    SET SAVECC = &LASTCC
END

SET SAVELBL = &SAVELBL
IF &NRSTR(&TEMP) >      THEN +
    DO
        SET &&MBR = &NRSTR(&TEMP)
        ISPEXEC VPUT &MBR PROFILE
        SET ZEDLMSG = &STR(LABEL PROFILE = &SAVELBL)
        ISPEXEC SETMSG MSG(UTLZ000W)
    END
ELSE +
    DO
        SET ZEDLMSG = &STR(*** NO LABELS FOUND.  NO "LABEL PROFILE" +
                           WAS STORED ***)
        ISPEXEC SETMSG MSG(UTLZ001)
    END
ISREDIT CURSOR = &SLN &SCL

EXIT

/*****************************************************************/
/* GET THE VARIABLE AND APPLY LABEL VALUES TO THE FILE.          */
/*****************************************************************/
INSLABEL: +
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)

IF &STR(&TEMP) =     THEN +
    DO
        SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
                           "LABLPROF SET" WILL STORE THEM ***)
        ISPEXEC SETMSG MSG(UTLZ000)
        EXIT
    END

SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))

DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
    SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
    SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
    SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
    SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
    SET DLEN = &LENGTH(&NRSTR(&DLINE))
    SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
    SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
    IF &Y = 0 THEN SET Y = &DLEN + 1
    IF &Z < &Y AND &Z > 0 THEN +
        DO
            SET OPOS = &Z + 17
            SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
            IF &X < 1 THEN SET X = &DLEN
            SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
            SET OCCR = &OCCR
            SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    ELSE +
        DO
            SET OCCR = 1
            SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    ISREDIT FIND FIRST '&NRSTR(&DLINE)'
    SET SAVECC = &LASTCC
    SET X = 1
    DO WHILE &X < &OCCR
        ISREDIT RFIND
        SET SAVECC = &LASTCC
        SET X = &X + 1
    END
    IF &SAVECC = 0 THEN +
        DO
            SET LABCOUNT = &LABCOUNT + 1
            ISREDIT LABEL .ZCSR = &LBL 0
            ISREDIT FIND ALL P'=' .ZCSR .ZCSR
        END
    ELSE SET BADCOUNT = &BADCOUNT + 1
    SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END

IF &BADCOUNT = 0 THEN +
    DO
        SET ZEDLMSG = &STR(*** SUCCESSFULLY LABELED &MBR +
                           LINES (&LABCOUNT OF THEM) ***)
        ISPEXEC SETMSG MSG(UTLZ000)
    END
ELSE +
    DO
        SET TCOUNT = &BADCOUNT + &LABCOUNT
        SET ZEDLMSG = &STR(* ONLY &LABCOUNT OF &TCOUNT LINES LABELED +
                        ("LABLPROF SET" TO RESET LABEL PROFILE) *)
        ISPEXEC SETMSG MSG(UTLZ001)
    END

ISREDIT CURSOR = &SLN &SCL

EXIT

/*****************************************************************/
/* INSERT MESSAGE LINES WHICH SHOW WHAT LABELS ARE IN THE PROFILE*/
/*****************************************************************/
SHOWSEC: +
ISREDIT SEEK NEXT P'=' 1
ISREDIT SEEK NEXT P'=' 1
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)

IF &STR(&TEMP) =     THEN +
    DO
        SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
                           "LABLPROF SET" WILL STORE THEM ***)
        ISPEXEC SETMSG MSG(UTLZ000)
        EXIT
    END

SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))

DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
    SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
    SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
    SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
    SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
    SET DLEN = &LENGTH(&NRSTR(&DLINE))
    SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
    SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
    IF &Y = 0 THEN SET Y = &DLEN + 1
    IF &Z < &Y AND &Z > 0 THEN +
        DO
            SET OPOS = &Z + 17
            SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
            IF &X < 1 THEN SET X = &DLEN
            SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
            SET OCCR = &OCCR
            SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    ELSE +
        DO
            SET OCCR = 1
            SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    SET MSG = &STR(&SUBSTR(1:8,&STR(&LBL        ))&SYSNSUB(1,&DLINE))
    ISREDIT LINE_BEFORE .ZCSR = MSGLINE (MSG)

    SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END

ISREDIT CURSOR = &SLN &SCL

EXIT

/*****************************************************************/
/* HILIGHT EACH LINE WHICH HAS AN EDIT LABEL FROM THE PROFILE    */
/* ***** HAVE NOT GOTTEN THIS TO WORK YET! ********************* */
/*****************************************************************/
HILISEC: +
ISREDIT SEEK NEXT P'=' 1
ISREDIT SEEK NEXT P'=' 1
ISPEXEC VGET &MBR PROFILE
SET TEMP = &STR(&&&MBR)

IF &STR(&TEMP) =     THEN +
    DO
        SET ZEDLMSG = &STR(*** NO LABEL PROFILE STORED FOR "&MBR." +
                           "LABLPROF SET" WILL STORE THEM ***)
        ISPEXEC SETMSG MSG(UTLZ000)
        EXIT
    END

SET TLEN = &LENGTH(&STR(&TEMP))
SET LABCOUNT = 0
SET BADCOUNT = 0
SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))

DO WHILE &TLEN > 0 AND &NEXTCHAR > 0
    SET LPOS = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP)) + 13
    SET DPOS = &SYSINDEX(&STR(ISREDITLINE=),&STR(&TEMP)) + 12
    SET LBL = &SUBSTR(&LPOS:&EVAL(&DPOS-13),&STR(&TEMP))
    SET DLINE = &SUBSTR(&DPOS:&TLEN,&STR(&TEMP))
    SET DLEN = &LENGTH(&NRSTR(&DLINE))
    SET Z = &SYSINDEX(&STR(ISREDITOCCURANCE=),&NRSTR(&DLINE))
    SET Y = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE))
    IF &Y = 0 THEN SET Y = &DLEN + 1
    IF &Z < &Y AND &Z > 0 THEN +
        DO
            SET OPOS = &Z + 17
            SET X = &SYSINDEX(&STR(ISREDITLABEL=),&NRSTR(&DLINE)) - 1
            IF &X < 1 THEN SET X = &DLEN
            SET OCCR = &SUBSTR(&OPOS:&X,&NRSTR(&DLINE))
            SET OCCR = &OCCR
            SET DLINE = &SUBSTR(1:&EVAL(&Z - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    ELSE +
        DO
            SET OCCR = 1
            SET DLINE = &SUBSTR(1:&EVAL(&Y - 1),&NRSTR(&DLINE))
            SET DLEN = &LENGTH(&NRSTR(&DLINE)
            SET X = &SYSINDEX(&NRSTR(&DLINE),&STR(&TEMP))
            SET X = &X + &DLEN - 1
            IF &X < &TLEN THEN +
                DO
                    SET TEMP = &SUBSTR(&X:&TLEN,&STR(&TEMP))
                    SET TLEN = &LENGTH(&STR(&TEMP))
                END
            ELSE SET TLEN = 0
        END
    ISREDIT FIND ALL P'@' &STR(&LBL) &STR(&LBL)
    SET NEXTCHAR = &SYSINDEX(&STR(ISREDITLABEL=),&STR(&TEMP))
END

ISREDIT CURSOR = &SLN &SCL

EXIT

/*****************************************************************/
/* RENAME ANOTHER PROFILE TO THIS MEMBER NAME                    */
/*****************************************************************/
RENAMESEC: +
IF &STR(&OLDNAME) =     THEN +
    DO
        SET ZEDLMSG = &STR(*** THE "RENAME FROM" MEMBER NAME MUST +
                           BE SPECIFIED ***)
        ISPEXEC SETMSG MSG(UTLZ001)
        EXIT CODE(12)
    END

ISPEXEC VGET &OLDNAME PROFILE
IF &LASTCC = 8 THEN +
    DO
        SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" DOES NOT +
                           EXIST TO RENAME.  USE "LABLPROF SET" ***)
        ISPEXEC SETMSG MSG(UTLZ001W)
        EXIT
    END
SET &MBR = &STR(&&&OLDNAME)
ISPEXEC VPUT &MBR PROFILE
ISPEXEC VERASE &OLDNAME PROFILE

ISREDIT CURSOR = &SLN &SCL

SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" RENAMED TO "&MBR" ***)
ISPEXEC SETMSG MSG(UTLZ00W)

EXIT

/*****************************************************************/
/* COPY ANOTHER PROFILE TO THIS MEMBER NAME                      */
/*****************************************************************/
COPYSEC: +
IF &STR(&OLDNAME) =     THEN +
    DO
        SET ZEDLMSG = &STR(*** THE "COPY FROM" MEMBER NAME MUST +
                           BE SPECIFIED ***)
        ISPEXEC SETMSG MSG(UTLZ001)
        EXIT CODE(12)
    END

ISPEXEC VGET &OLDNAME PROFILE
IF &LASTCC = 8 THEN +
    DO
        SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" DOES NOT +
                           EXIST TO COPY.  USE "LABLPROF SET" ***)
        ISPEXEC SETMSG MSG(UTLZ001W)
        EXIT
    END
SET &MBR = &STR(&&&OLDNAME)
ISPEXEC VPUT &MBR PROFILE

ISREDIT CURSOR = &SLN &SCL

SET ZEDLMSG = &STR(*** LABEL PROFILE "&OLDNAME" COPIED TO "&MBR" ***)
ISPEXEC SETMSG MSG(UTLZ00W)

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


Documentation


 This utility allows the user to set a series of labels in an edit session (via
 typing ".xxxxx" where xxxxx is a label name on an edit line number and pressing
 ENTER) and save them in a "label profile" specific to that member.  When they
 return to that member, they are able to reset all of their labels to the values
 in the "label profile".  To set a label profile, set the labels in the edit
 session and then type LABLPROF SET on the command line and press ENTER.  To
 label lines in a file from the saved "label profile" type LABLPROF and press
 ENTER (while in an edit session of the specific file).

 To see what lines are currently associated with which labels in the edit
 profile, type LABLPROF SHOW and press ENTER.  Message lines will be inserted
 which show you the name of the label (e.g. ".A") and the text on that line.

 When you rename a member, the label profile for that member is not
 automatically renamed.  You can rename the label profile by executing the
 LABLPROF edit macro and specifying the keyword RENAME and the OLD NAME that
 you're renaming from.  So, if you renamed member "A" to "B", while editing "B",
 you would type LABLPROF RENAME A and press enter, and the "A" label profile
 would be renamed to "B".

 Similar to the RENAME function is the COPY function.  In the previous example,
 if you had created member "B" as a COPY of member "A", you could copy the label
 profile by typing LABLPROF COPY A while editing member "B".
            


Leave a Reply

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