All I have is a CLIST, sorry: But here it is:
PROC 0
/* SYSTEM.SP.CLIST(SHOWALC)
/* 04-20-93
/* DISPLAYS SYSTEM ALLOCATED FILES - ABLE TO BROWSE/EDIT THRU ISPF */
ISPEXEC TBCREATE TSODD NAMES(SDDNAME SDSN SDISP) NOWRITE REPLACE
SET SYSOUTTRAP = 1000
LISTALC STATUS SYSNAMES
SET SYSOUTTRAP = 0
SET LINECOUNT = &SYSOUTLINE
SET SDSN = &STR()
SET I = 1
DO WHILE &I <= &LINECOUNT
SET CURLINE = &&SYSOUTLINE&I
SET PARSED = NO
SET LINELEN = &LENGTH(&STR(&CURLINE))
IF &STR(&CURLINE) ¬= &STR() THEN DO
IF &LINELEN >= 12 THEN DO
IF &SUBSTR(1:2,&STR(&CURLINE)) = &STR( ) THEN DO
SET PARSED = YES
SET SDDNAME = &SUBSTR(3:10,&STR(&CURLINE))
SET SDISP = &SUBSTR(12:&LINELEN,&STR(&CURLINE))
ISPEXEC TBADD TSODD
SET SDSN = &STR()
END
END
IF &PARSED = NO THEN DO
IF &LINELEN >= 11 THEN DO
IF &SUBSTR(1:10,&STR(&CURLINE)) = &STR(TERMFILE ) THEN DO
SET PARSED = YES
SET SDDNAME = &SUBSTR(11:&LINELEN,&STR(&CURLINE))
SET SDSN = &STR((TERMINAL))
SET SDISP = &STR(*)
ISPEXEC TBADD TSODD
SET SDSN = &STR()
END
END
END
IF &PARSED = NO THEN DO
SET SDSN = &STR(&CURLINE)
END
END
SET I = &I + 1
END
ISPEXEC TBTOP TSODD
SET OLDCRP = 0
SET DONE = NO
DO WHILE &DONE = NO
SET SELDSN = &STR()
ISPEXEC CONTROL DISPLAY REFRESH
ISPEXEC TBDISPL TSODD PANEL(SHOWALC) CSRROW(&OLDCRP) +
AUTOSEL(NO) POSITION(CRPNUM)
IF &STR(&SELDSN) = &STR() THEN DO
SET DONE = YES
END
ELSE DO
SET OLDCRP = &CRPNUM
SET SKIPNUM = &ZTDTOP - &CRPNUM
ISPEXEC TBSKIP TSODD NUMBER(&SKIPNUM) NOREAD
IF &SUBSTR(1:1,&STR(&SELDSN)) = &STR(*) THEN DO
SET SELDSN = &SUBSTR(2:&LENGTH(&STR(&SELDSN)),&STR(&SELDSN))
END
IF &STR(&SELDSN) = &STR((TERMINAL)) THEN DO
SET ZEDSMSG = &STR(ALLOCATED TO TERMINAL)
SET ZEDLMSG = &STR(THE TERMINAL CANNOT BE BROWSED.)
ISPEXEC SETMSG MSG(ISRZ001)
END
ELSE DO
CONTROL NOFLUSH
SET SYSOUTTRAP = 10
LISTDS '&SELDSN'
SET SYSOUTTRAP = 0
CONTROL FLUSH
SET LINECOUNT = &SYSOUTLINE
IF &LINECOUNT ¬= 5 THEN DO
SET ZEDSMSG = &STR(UNABLE TO BROWSE)
IF &LINECOUNT = 2 THEN DO
SET ZEDLMSG = &SYSOUTLINE2
END
ELSE DO
SET ZEDLMSG = &STR( AN UNKNOWN ERROR HAS OCCURRED.)
END
ISPEXEC SETMSG MSG(ISRZ001)
END
ELSE DO
SET DSORGHEADER = &STR(&SYSOUTLINE2)
SET DSORGVALUE = &STR(&SYSOUTLINE3)
SET VOLHEADER = &STR(&SYSOUTLINE4)
SET VOLVALUE = &STR(&SYSOUTLINE5)
SET DSORG = &STR(** )
SET VOLSER = &STR(******)
IF &STR(&DSORGHEADER) = &STR(--RECFM-LRECL-BLKSIZE-DSORG) +
THEN DO
SET DSORG = &SUBSTR(24:25,&STR((&DSORGVALUE))
END
ELSE IF &STR(&DSORGHEADER) = &STR(--LRECL--DSORG-) THEN DO
SET DSORG = &SUBSTR(11:12,&STR(&DSORGVALUE))
END
IF &STR(&VOLHEADER) = &STR(--VOLUMES--) THEN DO
SET VOLSER = &SUBSTR(3:8,&STR(&VOLVALUE))
END
IF (&STR(&DSORG) ¬= &STR(PS)) AND (&STR(&DSORG) ¬= &STR(PO)) +
THEN DO
IF &STR(&DSORG) = &STR(**) THEN DO
SET ZEDSMSG = &STR(DATA SET HAS NO DSORG)
END
ELSE DO
SET ZEDSMSG = &STR(DSORG IS '&DSORG')
END
SET ZEDLMSG = &STR(DATA SET ORGANIZATION MUST BE +
'PS' OR 'PO'.)
ISPEXEC SETMSG MSG(ISRZ001)
END
ELSE DO
ISPEXEC CONTROL ERRORS RETURN
IF &X = &STR(E) THEN DO
ISPEXEC EDIT DATASET('&SELDSN') VOLUME(&VOLSER)
END
ELSE DO
ISPEXEC BROWSE DATASET('&SELDSN') VOLUME(&VOLSER)
END
SET BROWSECC = &LASTCC
ISPEXEC CONTROL ERRORS CANCEL
IF &BROWSECC ¬= 0 THEN DO
IF &BROWSECC = 12 THEN DO
SET ZEDSMSG = &STR(EMPTY DATA SET)
SET ZEDLMSG = &STR(THIS DATA SET IS EMPTY.)
END
ELSE IF &BROWSECC = 16 THEN DO
SET ZEDSMSG = &STR(NO MEMBERS)
SET ZEDLMSG = &STR(THIS PDS CONTAINS NO MEMBERS)
END
ELSE DO
SET ZEDSMSG = &STR(UNABLE TO BROWSE)
SET ZEDLMSG = &STR(RETURN CODE WAS &BROWSECC.)
END
ISPEXEC SETMSG MSG(ISRZ001)
END
END
END
END
END
END
ISPEXEC TBEND TSODD
ISPEXEC LIBDEF ISPPLIB
EXIT CODE(0)
Good luck. Of course you can always use TSO ISRDDN. :-)
Ren
Ext 1448
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of Richards, Robert B.
Sent: Tuesday, May 03, 2016 2:22 PM
To: [email protected]
Subject: Re: Rexx EXEC SHOWALC Panel Member
Now that we have the panel, I'm missing the EXEC! :-)
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of Brenton, Ren
Sent: Tuesday, May 03, 2016 1:24 PM
To: [email protected]
Subject: Re: Rexx EXEC SHOWALC Panel Memeber
Here is the panel we have for SHOWALC:
)ATTR FORMAT(MIX)
@ TYPE(OUTPUT) INTENS(LOW) CAPS(OFF)
! TYPE(INPUT) INTENS(HIGH) CAPS(ON) PAD(_) )BODY
+SHOWALC --------------%CURRENT TSO DATASET ALLOCATIONS+-----------------------
+ &ZDATE &ZTIME
%COMMAND ===>_ZCMD %SCROLL%===>_VSVS
+
%SEL DD NAME DATASET NAMES IN ORDER OF CONCATENATION DISPOSITION
+--- -------- --------------------------------------- --------------
)MODEL
!X+ @SDDNAME @SDSN @SDISP
)INIT
&X = ' '
IF (&VSVS = '')
&VSVS = 'PAGE'
)REINIT
)PROC
IF (&ZTDSELS ¬= 0000)
&SELDSN = &SDSN
VPUT (VSVS) PROFILE
)END
Ren
Ext 1448
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of George Rodriguez
Sent: Tuesday, May 03, 2016 9:56 AM
To: [email protected]
Subject: Rexx EXEC SHOWALC Panel Memeber
Is there someone that knows anything about this EXEC? I'm missing the panel
member for the EXEC.
*George Rodriguez*
*Specialist II - IT Solutions*
*IT Enterprise Applications*
*PX - 47652*
*(561) 357-7652 (office)*
*(954) 415-7586 (mobile)*
*School District of Palm Beach County*
*3348 Forest Hill Blvd.*
*Room B-251*
*West Palm Beach, FL. 33406-5869*
*Florida's Only A-Rated Urban District For Eight Consecutive Years*
--
*Disclaimer: *Under Florida law, e-mail addresses are public records. If you do
not want your e-mail address released in response to a public records request,
do not send electronic mail to this entity. Instead, contact this office by
phone or in writing.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected]<mailto:[email protected]> with the message:
INFO IBM-MAIN
The information contained in this message is proprietary and/or confidential.
If you are not the intended recipient, please: (i) delete the message and all
copies; (ii) do not disclose, distribute or use the message in any manner; and
(iii) notify the sender immediately. In addition, please be aware that any
message addressed to our domain is subject to archiving and review by persons
other than the intended recipient. Thank you.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected] with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected] with the message: INFO IBM-MAIN
The information contained in this message is proprietary and/or confidential.
If you are not the intended recipient, please: (i) delete the message and all
copies; (ii) do not disclose, distribute or use the message in any manner; and
(iii) notify the sender immediately. In addition, please be aware that any
message addressed to our domain is subject to archiving and review by persons
other than the intended recipient. Thank you.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
