/* REXX B*/
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
ADDRESS ISREDIT "MACRO ("DSN") PROCESS"
'ISREDIT (ROW1, COL1) = CURSOR'
IF DSN <> "" THEN DO
IF DSN == 'DSN' THEN
DO
CALL BROWSE1
EXIT
END
ELSE
DO
SYSFILE1=DSN
END
END
ELSE DO
IF DATATYPE(COL1,'N')==1 THEN DO
IF COL1 = '00000' THEN EXIT
ADDRESS ISREDIT "(CURLINE) = LINE .ZCSR"
DELIM = "~'!%?&-_=+?\{};:`<,>/?*()@#$¬|" '"'
LOFLINE = LENGTH(CURLINE)
HQUAL = USERID()
START = LOFLINE - VERIFY(REVERSE(CURLINE),DELIM,"M",LOFLINE-COL1+1)+2
LOFLINE = VERIFY(CURLINE,DELIM,"M",COL1)-1
IF START <= LOFLINE THEN
SYSFILE1 = STRIP(SUBSTR(CURLINE,START,LOFLINE-START+1))
ELSE DO
ZEDSMSG = "INVALID CURSOR POSITION"
ZEDLMSG = "INVALID CURSOR POSITION. PLACE THE CURSOR OVER THE DATASET"
'ISPEXEC SETMSG MSG(ISRZ001)'
EXIT
END
TEMP =LISTDSI("'"SYSFILE1"'")
IF(SYSREASON /= '0000')
THEN DO
ZEDSMSG = "INVALID DATASET NAME"
ZEDLMSG = "INVALID DATASET NAME : '"SYSFILE1"'"
'ISPEXEC SETMSG MSG(ISRZ001)'
EXIT
END
END
END
ADDRESS ISPEXEC "BROWSE DATASET('"SYSFILE1"')"
EXIT
BROWSE1:
ADDRESS ISPEXEC
'VGET (ZSCREENI,ZSCREENC,ZENVIR)' /* EXTRACT SCREEN IMAGE,
CURSOR POS AND ISPF LEVEL */
IF SUBSTR(ZENVIR,5,4) < '4.5' THEN
CALL GET_ZSCREEN_VALUES
TRTABLE='ABCDEFGHIJKLMNOPQRSTUVWXYZ' /* SETUP VALID DSNAME CHARS */
TRTABLE=TRTABLE !! TRANSLATE(TRTABLE) !! '$#@0123456789.''-{()'
TRTABLE=TRANSLATE(XRANGE('00'X,'FF'X),,TRTABLE,' ')
ZSCREENI=TRANSLATE(ZSCREENI,,TRTABLE,' ') /* REMOVE NON-DSN CHARS */
IF SUBSTR(ZSCREENI,ZSCREENC+1,1) <> ' ' THEN /* MAYBE CSR ON DSN */
DO /* EXTRACT DSN FROM SCREEN IMAGE
AND BROSWE DATASET */
NAME=WORD(SUBSTR(ZSCREENI,1+LASTPOS(' ',ZSCREENI,ZSCREENC)),1)
NAME=TRANSLATE(STRIP(SUBSTR(NAME,1,56))) /* MAX OF 56 CHAR NAME */
IF SUBSTR(NAME,1,1)='(' THEN
PARSE VAR NAME '('NAME')'.
PARSE VAR NAME DSN '('MEM')' /* IS THERE A MEMBER NAME? */
OMEM=MEM
IF MEM<>'' THEN /* IF SO, REFORMAT FOR BROWSE
CMD */
DO
GDG=0
NAME=DSN /* GET DSN */
IF SUBSTR(NAME,1,1)='''' THEN /* IF ORIGINAL NAME STARTED WITH
QUOTES */
NAME=NAME'''' /* FIX QUOTES */
IF DATATYPE(MEM,'N') = 1 THEN /* GDG? */
DO
DROP OTRAP.
CALL OUTTRAP 'OTRAP.'
ADDRESS TSO 'LISTCAT ENT('NAME')' /* GET REAL GDG NAMES */
CALL OUTTRAP 'OFF'
IF OTRAP.0>(2-2*MEM) THEN /* IF ENOUGH LINES RETURNED */
DO
A=OTRAP.0-1+2*MEM /* PARSE LISTCAT OUTPUT */
N="'"SUBWORD(OTRAP.A,3,1)"'" /* GET REAL DSNAME */
IF SYSDSN(N)='OK' THEN /* VERIFY THAT DS EXISTS */
DO /* IF REAL GDG NAME EXISTS */
NAME=N /* USE REA NAME AS DSNAME */
MEM='' /* FORGET THE MEMBER NAME */
OMEM='' /* FORGET THE MEMBER NAME */
GDG=1 /* INDICATE WE FORGOT MEMBER
NAME */
END
END
END
IF GDG=0 THEN /* IF GDG CHECK FAILED */
MEM='MEMBER('MEM')' /* ADD MEMBER KEYWORD FOR BR */
END
'CONTROL ERRORS RETURN' /* RETURN ERRORS TO PROGRAM */
'LMINIT DATAID(VCURSOR) DATASET('NAME')' /* ALLOC W/ TSO NAMING */
IF RC>0 & SUBSTR(NAME,1,1) <> "'" THEN /* ALLOC W/O TSO NAME */
'LMINIT DATAID(VCURSOR) DATASET('''NAME''')'
IF RC=0 THEN
DO
SERVICE=TRANSLATE(SERVICE)
IF SERVICE<>"" THEN
SERVICE 'DATAID('VCURSOR')' MEM /* BROWSE THE DATASET */
END
ELSE /* ALLOCS FAILED: SET ORIGINAL
MESSAGE */
'LMINIT DATAID(VCURSOR) DATASET('NAME')'
IF RC>7 THEN
'SETMSG MSG(ISRZ002)' /* IF ERROR, SHOW MESSAGES */
'LMFREE DATAID(&VCURSOR)' /* FREE DS IF ALLOCATED */
END
ELSE /* CURSOR WAS NOT ON A DSNAME */
DO /* GIVE USER AN ERROR MESSAGE */
ZERRSM = 'INVALID CURSOR POSITION'
PARSE VALUE '* YES THE CURSOR WAS NOT ON A DATA SET NAME.',
WITH ZERRHM ZERRALRM ZERRLM
'SETMSG MSG(ISRZ002)'
END
XIT 0
GET_ZSCREEN_VALUES: /* OBTAIN THE SCREEN IMAGE */
ADDRESS ISPEXEC 'VGET (ZSCREENW,ZSCREEND)'
P = PTR(96+PTR(PTR(24+PTR(112+PTR(132+PTR(540))))))
ZSCREENI=TRANSLATE(STORAGE(D2X(P),,
ZSCREENW*ZSCREEND),,XRANGE('00'X,'3F'X))
ZSCREENC = C2D(STORAGE(,
D2X(164+PTR(PTR(24+PTR(112+PTR(132+PTR(540)))))),4))
RETURN
PTR: RETURN C2D(BITAND(STORAGE(D2X(ARG(1)),4),'7FFFFFFF'X)) |
