/* REXX exec to do cursor sensitive data extraction from an ISPF */ /* Screen. */ /* Uses undocumented/Unsupported variables zscreeni & Zscreenc */ /* available in ISPF for OS/390 R2.5 (ISPF4.5). */ /* */ /*------------------------------------------------------------------ */ /* ---> NOTE: ZSCREENI and ZSCREENC may give odd results in some */ /* ---> situations such as command line at the bottom!!!! */ /* ---> If this is a problem, force a call to subroutine */ /* ---> GET_ZSCREEN_VALUES instead of using ISPF's variables. */ /*------------------------------------------------------------------ */ /* */ /* Screen image may translate attr bytes to dsn chars causing */ /* extra characters like '#' to be added to the dsname */ /* */ /* Will not work in popups if invoked with the SUSPEND keyword. */ /* Note that the default command table entry for TSO does have */ /* the SUSPEND keyword. */ /* */ /* Usage: */ /* Name this VCURSOR, set a pfkey to VCURSOR and */ /* create a command table entry: */ /* VCURSOR 0 SELECT CMD(%VCURSOR) */ /* (Or setting pfkey to TSO %VCURSOR will work in most cases) */ /* Then place cursor on dsname and press the pf key. */ /* ZSCREENC may be wrong if initial command doesn't start */ /* with a percent or have MODE(FSCR) on the SELECT statement. */ /* */ /* Author : Doug Nadel April 24, 1999 */ /* Updates: Apr 26, 1999 now views PDS members also. */ /* Aug 18, Allow dsname in parentheses. */ /* Added additional information re MODE(FSCR). */ /* Bypass ZSCREENI and ZSCREENC if needed. */ /* (ISPF version <4.5 but will work in 4.5+) */ /* March 31, 2000 Added basic recognition of GDG names */ /* and view/edit/browse customization */ /* April 3, 2000 Added prompt panel. */ /*------------------------------------------------------------------ */ /* Customization to set service to view edit or browse */ /* or to use prompt panel. */ /*------------------------------------------------------------------ */ service='PROMPT' /* set to VIEW, EDIT, or BROWSE */ /* or PROMPT. */ /*------------------------------------------------------------------ */ 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 view 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 view 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 view*/ 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='PROMPT' Then Call getservice If service<>"" Then service 'DATAID('vcursor')' mem /* View 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 Exit 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)) getservice: Procedure Expose service name omem 'VGET ZSCREEN' service='EDIT' dsn=name Parse Source . . me . If omem <> "" Then Do If substr(dsn,1,1)='''' Then dsn=substr(dsn,1,length(dsn)-1)'('omem')''' Else dsn=dsn'('omem')' End Address tso ddname='$VCSR$'zscreen 'alloc f('ddname') reuse new del dso(po) dir(1) sp(1)' , 'track recfm(f b) lrecl(80)' Address ispexec 'LMINIT DATAID(DID) DDNAME('ddname') ENQ(EXCLU)' 'LMOPEN DATAID(&DID) OPTION(OUTPUT)' Call write ")ATTR" Call write "+ TYPE(NT)" Call write "@ TYPE(PT)" Call write "? TYPE(CH)" Call write "# TYPE(output) just(asis) caps(off)" Call write ")BODY WINDOW(60,14)" Call write " @Cursor Sensitive Action+" Call write "+%" Call write "+Dataset:+&DSN" Call write "+" Call write "? Select action:" Call write " _Z% 1. Edit" Call write " %#VCAXXY +" Call write " %#VCAXXZ +" Call write " " Call write "? Press%END?to cancel this action." Call write " " Call write "? To avoid this panel, modify your "me" exec." Call write ")INIT" Call write " VGET (VCACTNX) PROFILE" Call write " .ZVARS = 'VCACTNX'" Call write " &VCAXXY = ' 2. View'" Call write " &VCAXXZ = ' 3. Browse'" Call write ")REINIT" Call write " REFRESH(*)" Call write ")PROC" Call write " IF (.CURSOR = VCAXXY) &VCACTNX = '2' /* allow csr selct*/" Call write " IF (.CURSOR = VCAXXZ) &VCACTNX = '3'" Call write " VER (&VCACTNX, NB ,LIST,1,2,3)" Call write " IF (.MSG NE &Z) &VCACTNX=1" Call write " VPUT (VCACTNX) PROFILE" Call write ")END" 'LMMADD DATAID(&DID) MEMBER(FOO)' 'LMFREE DATAID(&DID)' 'LIBDEF ISPPLIB LIBRARY ID('ddname')' 'ADDPOP' 'DISPLAY PANEL(FOO)' If rc>0 Then service="" Else If vcactnx=2 Then service='VIEW' Else If vcactnx=3 Then service='BROWSE' 'REMPOP' 'LIBDEF ISPPLIB' Address tso 'FREE F('ddname')' Return write: Parse Arg p1 "LMPUT DATAID(&DID) MODE(INVAR) DATALOC(P1) DATALEN(80)" Return