 /* $EDIT -- EDIT DATASET SPECIFIED (NO QUOTES REQ'D) -- REXX*/
/*PROC 1 DSNAME  MACRO(RCVYWARN) NEW PANEL() TRACE */
/*$EDIT     AUTHOR: DAVID MCRITCHIE, CREATED 1985/12/04 IS03
            "The REXX Macros Toolbox",  DMcRitchie@hotmail.com
            UPDATED 1991/12/24 11:33 IS03
            UPDATED 1993/10/18 16:24 IS03 CONVERTED TO REXX
            UPDATED 1994/02/22 14:30 IS03 FOR GDG(-n) relative
           PURPOSE: EDIT A DATASET FROM WITHIN EDIT OR OTHER
                    ISPF PANEL -- DSNAME REQUIRED UPON ENTRY.
                               -- CHECKS EXISTANCE AND RACF ACCESS.
           CONTRIBUTED:   F. David McRitchie 1985/12/04
           USER CONTACT:  F. David McRitchie "The REXX Macros Toolbox"
           CODE MAINT.:   SYSTECH GROUP
           $BROWSE IS now PATTERNED ON THE $EDIT (this) CLIST
  ****************************************************************
     A COMPLETE DSNAME MUST BE PROVIDED
        -- CAN BE ENCLOSED IN QUOTES, IF YOU SO WISH.
        -- MEMBERNAME MAY BE INCLUDED AS PART OF DSNAME.
        -- WILL NOT PREFIX THE USERID TO THE DSNAME.
     A DATASET LEVELNAME MAY BE PROVIDED IN WHICH CASE
        -- ALL OTHER OPTIONS WILL BE IGNORED, MEMBERNAME NOT ALLOWED
           E.G.  ==> $BROWSE IS03.*.TEXT
  *****************************************************************/
      /*  ---INSURE DSNAME IS SURROUNDED BY QUOTES AND ...  */
      /*  --- CREATE RDSNAME (WITHOUT MEMBERNAME) TO CHECK RACF */
        PARSE ARG TOKEN; TOKEN=TRANSLATE(TOKEN)
        PARSE VAR TOKEN DSNAME ' ' TOKEN
        SYSUID = SYSVAR('SYSUID')
        TOKEN = ' '||TOKEN||' '
        MACRO=KEYWORD('MACRO')
        NEW =PROCESS('NEW')
        PANEL=KEYWORD('PANEL')
        TRACE=PROCESS('TRACE')

        IF TOKEN \= '' THEN
           SAY 'UNRESOLVED OPERANDS ARE:' TOKEN

        L = LENGTH(DSNAME)
        XX = SUBSTR(DSNAME,1,1)SUBSTR(DSNAME,L,1)
        IF XX = "''" THEN DSNAME = SUBSTR(DSNAME,2,L-2)
        /* MUST NOT HAVE MEMBERNAME*/
        CDSNAME = DSNAME
        PARSE VAR CDSNAME LEVEL '(' MEMBER ')'
        if member \= '' then cdsname = level
        if datatype(member, "Whole number") = 1 then do
           /* dealing with a GDG dataset so get the correct dsn*/
           Call OutTrap "ListCat.", "*", "noconcat"
           "ListCat Entry('"cdsname"') GDG all"
           if rc > 0 then signal failure
           if member > 0 then
               errmsg('GDG relative numbers > 0 do not exist')
           lineno = listcat.0  + member  /* relative goes backward*/
           parse var listcat.lineno "NONVSAM--" cdsname
           member = ""  /* finished with relative number as member*/
        end;
        RDSNAME = CDSNAME       /* RACF NAME */
        I = POS('*',cdsname)
        IF  I  \= 0 THEN DO
          /* E.G.   ==> TSO $BROWSE IS03.*.CNTL */
          ADDRESS "ISPEXEC" "VGET ZDLDSNLV PROFILE"
          OLD = ZDLDSNLV
          ZDLDSNLV = CDSNAME
          ADDRESS "ISPEXEC" " VPUT ZDLDSNLV PROFILE"
          /* ACCORDING TO Q417856 QUALIFIED DATASET*/
          /* SHOULD HAVE USED LMMDISP. */
          /* METHOD USED HAS PANEL OPTIONS AVAILABLE*/
          ADDRESS "ISPEXEC" "SELECT PGM(ISRUDL) PARM(ISRUDLP)"
          ZDLDSNLV = OLD
          ADDRESS "ISPEXEC" "VPUT ZDLDSNLV PROFILE"
          RETURN 0
        END
        RMEMBER = MEMBER
      /*  ----------- CHECK FOR EXISTENCE OF THE DATASET ----*/
        IF MEMBER \= '' THEN IF POS('*',MEMBER) = 0 ,
           THEN CDSNAME = DSNAME
        CHK =  SYSDSN("'"CDSNAME"'")
        IF CHK = 'MEMBER NOT FOUND' THEN DO
          IF NEW = "NEW" THEN CHK = "OK"
          ELSE SAY CHK||" -- USE OPTION ""NEW"" TO ALLOW"
       END
       IF CHK = "OK" THEN DO
          /*  ------- MAKE AVAILABLE TO OTHER CLISTS --------*/
          ADDRESS "ISPEXEC" " VPUT DSNAME SHARED"
          ADDRESS "ISPEXEC" " VPUT RDSNAME SHARED"
          /*  ------- TRAP SYSOUT FOR RACF CHECKING ---------*/
          TRAP.=
          X = OUTTRAP("TRAP.","*")
             "LD DATASET('"RDSNAME"') GENERIC"
          X= OUTTRAP("OFF")
          IF SUBSTR(TRAP.1,1,3) = "ICH" THEN
              IF SUBSTR(TRAP.1,1,8) \= ICH35003 ,
                THEN DO
                   ZEDSMSG = 'NOT AUTHORIZED'
                   ZEDLMSG = TRAP.1 '-- HIT',
                     'ENTER NOT PFK-3'
                   ADDRESS "ISPEXEC" " SETMSG MSG(ISRZ000)"
                   RETURN 12
               END
          /*  ------- DATASET EXISTS AND RACF S/B HAPPY ------*/
       BYPX:
          ADDRESS "ISPEXEC" "CONTROL ERRORS RETURN"
          ADDRESS "ISPEXEC" "EDIT DATASET('"DSNAME"')" MACRO PANEL
          RCX = RC
          SELECT;
            WHEN RCX = 0 THEN DO; ZEDSMSG="SAVED";
             zedlmsg="$EDIT 0 - Normal completion, data was saved";end;
            WHEN RCX = 4 THEN DO; ZEDSMSG=""; zedlmsg="$EDIT RC=4",
             "- Normal completion, data was not saved"; end;
            when rcx = 16 then do; zedsmsg="No members";
             zedlmsg="$EDIT 16 - No members in library";end
            otherwise
             if zerrsm = "DATA SET IN USE" then  /* RC=14 */
                 Address "TSO" "WHOGOT" dsname
             zedsmsg = zerrsm
             zedlmsg = zerrlm 'RC='rcx
             address "ISPEXEC" "setmsg msg(isrz000)"
             exit 1
          end /* of select and other-wise statements(s) */
          if rcx \= 4 then
             ADDRESS "ISPEXEC" " SETMSG MSG(ISRZ000)"
          X = MSG('OFF')
          ADDRESS "TSO" "FREE DATASET('"RDSNAME"')"
          X = MSG('ON')
          RETURN RCX
       END
       /* ----------- DATASET DOES NOT EXIST ----------------*/
       SAY "'"DSNAME"'"   CHK
       ZEDSMSG = 'INVALID DSN'
       ZEDLMSG = "FAILED -- "CHK" -- '"DSNAME"'"
       ADDRESS "ISPEXEC" " SETMSG MSG(ISRZ000)"
       SAY "TSO $EDIT" DSNAME "FAILED DUE TO '"CHK"'"
       SAY "AN EXAMPLE WITH A CORRECT SYNTAX IS      ===> TSO $EDIT" ,
         SYSUID".LIBR.CNTL"
       SAY "TSO $EDIT FAILED FOR    DSNAME="DSNAME"   DUE TO '"CHK"'"
       RETURN 12
PROCESS: PROCEDURE EXPOSE TOKEN
 ARG SUBTOKEN
 I = POS(' '||SUBTOKEN||' ',TOKEN)
 IF I=0 THEN RETURN ''
 TOKENX = SUBSTR(TOKEN,1,I) || SUBSTR(TOKEN,I+2+LENGTH(SUBTOKEN))
 TOKEN = TOKENX
 RETURN SUBTOKEN
 KEYWORD:
  PARSE ARG KEY
  KEY1 = ' '||KEY||'('
  PARSE VAR TOKEN  LEFT   (KEY1) VALUE ')' RIGHT
  TOKEN = LEFT RIGHT
  IF VALUE = "" THEN RETURN ''
  RETURN KEY"("VALUE")"
ErrMsg: Procedure expose RC;
   Parse arg Text;
   Say Center(" "Text" ", 79, "*");
   RC = 12;
   Exit RC;   /* do not return */

/* In the event of a failure following ListCat, emit it */
Failure:
   Do I = 1 to ListCat.0;
      Say ListCat.I;
   End;
   Exit RC;