rexx-things/samples/mvs/redit.rex
2025-03-12 20:50:48 +00:00

161 lines
6.5 KiB
Rexx

/* $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;