/*$BROWSE   AUTHOR: DAVID MCRITCHIE, CREATED 1985/07/13 IS03--rexx*/
/*          AT "The REXX Macros Toolbox"                        */
/*          UPDATED 1991/06/28 17:53 IS03                     */
/*PROC 1 DSNAME  PANEL() TRACE */
/*$BROWSE   AUTHOR: DAVID MCRITCHIE, CREATED 1985/12/04 IS03
            "The REXX Macros Toolbox",  now at 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
           USER CONTACT:  F. David McRitchie "The REXX Macros Toolbox"
           CODE MAINT.:   SYSTECH GROUP
           $BROWSE IS NOW PATTERNED ON THE $EDIT 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||' '
/*********not applicable to $BROWSE***********************************/
/*         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"'")
/************not applicable to $BROWSE********************************/
/*         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" "BROWSE DATASET('"DSNAME"')" PANEL
          RCX = RC
          /* not bothering much with $BROWSE errors */
          zedsmsg = zerrsm
          zedlmsg = zerrlm 'RC='rcx
          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 $BROWSE" DSNAME "FAILED DUE TO '"CHK"'"
       SAY "AN EXAMPLE WITH A CORRECT SYNTAX IS      ===> TSO $BROWSE" ,
         SYSUID".LIBR.CNTL"
       SAY "TSO $BROWSE 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;