/* rexx ?? list open tables ? List all open ISPF tables The displayed panel allows detailed list of the table(s) History 2026-02-08 Imbed the panel P0523782 with dynamic area 2026-02-09 Change primary display to use short states. Add linecmd L for TBLook, found in the CBT system. 2026-02-11 Add user- and date info to the Info screen. 2026-02-11 Add primary command RELOAD, line commands C and E. Sort list by name. Automatic reload after C and E. 2026-02-12 New function DROPNAME used after close and end. New linecmd Memlist, also primary cmd in Info. Restructure some for better start-up time. Add by-dsn displaymode. Consolidate End into Close, Author Willy Jensen mail willy@harders-jensen.com web http://harders-jensen.com Disclaimer > The product is totally freeware and can be distributed and modified as you like, though the author would like to know of enhancements made, so that they might be incooporated into the product. > The author accepts no responsibility for any damage caused by the product not behaving as expected or even as documented. It is after all free. > Questions and comments should be sent to the email address, enhancement requests are especially welcome. > If you experience problems then check the website for an updated version. */ ver='004.36 2026-02-12' if translate(arg(1))='VERSION' then return ver parse source . . $me . signal on syntax name PgmSyntax Signal on novalue name PgmNoVal numeric digits 12 parse value '' with pdsdd mbrdd stat. tbllib. liblist if MakePlib()<>0 then call quit Address Ispexec "Control errors return" parse value '? ? ?' with st1l. st2l. st3l. /* ----+----1----+----2----+----3----+----4----+----5*/ st1s.1= 'Yes' st1s.2= 'No' st1s.3= "Library not alloc'd" st1sh = 'Physical table' st1sl = 1+max(length(st1s.1),length(st1s.2),length(st1s.3),, length(st1sh)) st1l.1= 'Table exists in the table input library chain' st1l.2= 'Table does not exist in the table input library chain' st1l.3= 'Table input library is not allocated' st2s.1= 'Not open here' st2s.2= 'NOWRITE' st2s.3= 'WRITE' st2s.4= 'SHARED NOWRITE' st2s.5= 'SHARED WRITE' st2sh = 'State in screen' st2sl = 1+max(length(st2l.1),length(st2s.2),length(st2s.3),, length(st2s.4),length(st2l.5),length(st2sh)) st2l.1= 'Table is not open in this logical screen' st2l.2= 'Table is open in NOWRITE mode in this logical screen' st2l.3= 'Table is open in WRITE mode in this logical screen' st2l.4= 'Table is open in SHARED NOWRITE mode in this logical screen' st2l.5= 'Table is open in SHARED WRITE mode in this logical screen' st3s.1= 'Yes' st3s.2= 'No' st3sh = 'Write allowed' st3sl = 1+max(length(st3s.1),length(st3s.2),length(st3sh)) st3l.1= 'Table is available for WRITE mode' st3l.2= 'Table is not available for WRITE mode' Call PdaInit /* make list of table libraries */ parse value '' with l1 l2 address ispexec "qlibdef isptlib id(l1)" address ispexec "qbaselib isptlib id(l2)" liblist=translate(l1 'ispprof' l2," ","',") Call MakeList dmode='S' /* display mode Standard */ Do forever Call PdaReinit Call PdaLine, @tg' Primary cmds'@tt'Dsn-view Standard-view Reload',, ' ## ## ##' Call PdaLine @tg' Line cmds '@tt, 'Info Close table Memlist TBLook',, copies(' ',17)'# # # #' Call Pdaline @tb' Point-and-shoot will also select Info' Call PdaLine @tb if dmode='S' then, Call PdaLine @tw' Name 'left(st1sh,st1sl), left(st2sh,st2sl) left(st3sh,st3sl) if dmode='D' then, Call PdaLine @tw' Name 'left('Library',30), left(st2sh,st2sl) left(st3sh,st3sl) pdafixn=pdalines n=pdapos+pdadpth-pdafixn if n>list.0 then n=list.0 do #=pdapos to n for pdamaxd /* add scrollables */ parse var list.# front '\' st1 '\' st2 '\' st3 if dmode='S' then, Call pdaline left(front,13) || pda@tg || left(st1s.st1,st1sl), left(st2s.st2,st2sl) left(st3s.st3,st3sl) if dmode='D' then do parse var front . (@tt) name . Call pdaline left(front,13) || pda@tg, || left(tbllib.name,30), left(st2s.st2,st2sl) left(st3s.st3,st3sl) end end pdascln =pdalines-pdafixn /* number of scrollables */ zcmd='' pdaselc='=I *' pdahdr='List open ISPF tables' Address Ispexec "Display panel("pdapnl")" if rc>8 then exit ispmsg('Bad rc from panel:' rc zerrlm)+8 if rc>0 then leave /* End or return command entered */ /* line command handler */ do while pdalcmdl<>'' parse var pdalcmdl cpos','cval','pdalcmdl parse var list.cpos . (pda@tt) +1 name .'\' st1 '\' st2 '\' st3 select when cval='L' then call XBLook name,st1,st2,st3 when cval='C' then call TblClose name,st1,st2,st3 when cval='M' then call MbrList tbllib.name,st1,st2,st3 otherwise call LCmdI name,st1,st2,st3 end end /* primary command handler */ parse var zcmd cverb cdata select when zcmd='' then nop when Abbrev('LOCATE',cverb,1) & cdata<>'' then Call Locate cdata when Abbrev('RELOAD',cverb,2) then Call MakeList when Abbrev('DSN',cverb,2) then Call ByDsList when Abbrev('STANDARD',cverb,2) then dmode='S' otherwise call ispmsg 'Invalid command' zcmd end end Call Quit Quit: Call DropPlib exit 0 /* get panel attr chars */ PdaInit: /* get panel attr chars */ Address Ispexec "vget (zscrmaxd zscrmaxw)" pdapnl='P0523782' pdascrw=80 /* reqd for 1st call */ pdamaxd=zscrmaxd /* reqd for 1st call */ pdashadc='#' /* shadow var char(s) */ Address Ispexec "Control nondispl enter" Address Ispexec "Display panel("pdapnl")" Interpret pdaattr parse value 1 0 with pdapos pdamax pdavars pdaselc Return PdaReInit() PdaReinit: /* reset some vars */ parse value 0 0 with pdalines pdafixn pdaarea pdashadv if symbol('pdapos')<>'VAR' then pdapos=1 if symbol('pdamax')<>'VAR' then pdamax=1 if datatype(pdamax)<>'NUM' then pdamax=1 if pdapos<1 then pdapos=1 return 0 Pdaline: trace off /* add screen buffer line */ pdaarea=pdaarea || strip(arg(1),'t') || @nl /* add to area with newln */ pdashadv=pdashadv || strip(arg(2),'t') || @nl /* add to shadow with newln */ pdalines=pdalines+1 return 0 XMsg: if arg(1)<>'' then say arg(1);return word(arg(2) 0,1) ISPMSG: parse arg zedlmsg address ispexec "setmsg msg(isrz000)" return 0 ISPEx: zerrlm ='' address ispexec arg(1) isprc=rc return rc Silent: trace off; zz=outtrap(word(arg(2) '$.',1)) address tso arg(1);zz=outtrap('off');return rc DD2Dsn: zz=Listdsi(arg(1) 'file'); return sysdsname MakeList: drop list. list.='' listn=0 "qtabopen list(qtab.)" do n=1 to qtab.0 name=strip(qtab.n) "tbstats" name "service(srv) retcode(rtc)", "status1(st1) status2(st2) status3(st3)", "cdate(cdate) ctime(ctime) udate(udate) utime(utime)", "user(user) rowcreat(rowcreat) rowcurr(rowcurr)", "rowupd(rowupd) tableupd(tableupd)" /*if left(name,3)='DSB' then do say name 'user' user say 'cd' cdate 'ct' ctime 'ud' udate 'ut' utime say 'rowcreat' rowcreat 'rowcurr' rowcurr say 'rowupd' rowupd 'tableupd' tableupd end*/ /*lib=LocMbrDs(name) tbllib.name=lib*/ listn=listn+1 list.listn=pda@sf || ' ' || pda@tt || name '\'st1'\'st2'\'st3 _=strip(name) stat._='user('user') rowcurr('rowcurr')', 'cdate('cdate') ctime('ctime') udate('udate') utime('utime')' end list.0=listn pdamax=listn call bpxwunix 'sort', 'LIST.', 'LIST.', 'STDERR.' return 0 LocMbrDs: arg libmbr . do liblistn=1 to words(liblist) libds=word(liblist,liblistn) if pos('.',libds)=0 then libds=dd2dsn(libds) if libds<>'' then do zz="'"libds"("libmbr")'" if Sysdsn("'"libds"("libmbr")'")='OK' then return libds end end return '' /* list table info */ LCmdI: Procedure expose st1l. st2l. st3l. stat. tbllib. liblist list. trace off parse arg name .,st1,st2,st3 if st2=1 then nop /*return Ispmsg(name 'is not open here')*/ Call PdaInit pdahdr='Listing table' name Call pdaline pda@tb Call pdaline pda@tg'Primary cmds'@tt'Close Mbrlist',, ' # #' Call pdaline pda@tb if st1=1 & tbllib.name='' then, /* in a library */ tbllib.name=LocMbrDs(name) Call pdaline pda@tg || 'Library' || pda@tt || tbllib.name Call pdaline pda@tg Call pdaline pda@tg || 'State ' || pda@tt || st1l.st1 Call pdaline left(pda@tt,8) st2l.st2 Call pdaline left(pda@tt,8) st3l.st3 Call pdaline @tt /* various statistics */ parse var stat.name . 'user('user')' . 0 . 'rowcurr('rowcurr')', . 0 . 'cdate('cdate')' . 0 . 'ctime('ctime')', . 0 . 'udate('udate')' . 0 . 'utime('utime')' . ?addline=0 if user<>'' then, _=Pdaline(pda@tg || 'User ' || pda@tt || user)+Addline() if cdate<>'' then, _=Pdaline(pda@tg || 'Created' || pda@tt ||, nicedate(date('s',cdate,'o')) ctime)+Addline() if udate<>'NOUPDATE' then, _=Pdaline(pda@tg || 'Updated' || pda@tt ||, nicedate(date('s',udate,'o')) utime)+Addline() if ?addline then call Pdaline @tt /* various statistics end */ if st2<>1 then do /* 1= is not open here */ if IspEx("tbquery" name "names(nl) keys(kl) rownum(rows)")>0 then, say 'tbquery' arg(1) 'rc' isprc zerrlm Call LcmdiState 'Keys',translate(kl,' ','()') Call LcmdiState 'Names',translate(nl,' ','()') Call pdaline pda@tg || 'Rows ' || pda@tt || rows+0 end pdalines=length(pdaarea)/pdascrw /* number of lines */ pdafixn =pdalines /* number of lines */ do forever zcmd='' if IspEx('Display panel('pdapnl')')>8 then, return ispmsg('Bad rc from panel:' isprc zerrlm) if rc>0 then return 0 /* End or return command entered */ if Abbrev('MBRLIST',zcmd,1) then call MbrList tbllib.name if Abbrev('CLOSE',zcmd,1) then Return TblClose(name,st1,st2,st3) end return xmsg('***should not have come here') Addline: ?addline=1; return 0 LcmdIState: parse arg lbl,pl,ll pl=space(pl) do while pl<>'' parse var pl l pl ll=ll || left(l,9) end ll=strip(ll,'l') Call pdaline @tg || left(lbl,7) || @tt || subword(ll,1,6) do n=7 to 9999 by 6 while n1 then, /* return Ispmsg(name 'is not in a library')*/ Return TblEnd(name,st1,st2,st3) if st2=1 then return Ispmsg(name 'is not open here') if tbllib.name='' then tbllib.name=LocMbrDs(name) if \DoPrompt('Close table',, '>Close table'@tw || name || @tg'in'@tw || tbllib.name), then return 0 cc=BpxWdyn('alloc da('tbllib.name') shr rtddn(libdd)') if cc<>0 then return ispmsg('Alloc' tbllib.name 'failed rc' cc) cc=IspEx('TBCLOSE' name 'LIBRARY('libdd')') call BpxWdyn 'free dd('libdd')' if cc<>0 then return ispmsg('Close of' name 'failed rc' cc zerrlm) Return ispmsg('Table' name 'closed')+Dropname(name) MbrList: /* member list by dsn */ arg ds .,st1,st2,st3 if ds='' then return Ispmsg(name 'is not in a library') zerrlm='' "lminit dataid(mldid) dataset('"ds"')" if rc<>0 then return ispmsg('lmdinit for' ds 'failed' rc zerrlm) "memlist dataid("mldid") field(9)" parse value rc zerrlm with mrc merr zerrlm='' "lmfree dataid("mldid")" if mrc<>0 then call ispmsg 'Memlist for' ds 'failed' mrc merr return 0 /* End table */ TblEnd: trace off parse arg name .,st1,st2,st3 if st2=1 then return Ispmsg(name 'is not open here') if \DoPrompt('End table','>End table'@tw|| name) then return 0 if IspEx('TBEND' name)=0 then, Return ispmsg('Table' name 'ended')+Dropname(name) Return ispmsg('End of' name 'failed rc' cc zerrlm) Dropname: arg p . o=0 do n=1 to list.0 parse var list.n . (pda@tt) q '\' . if q=p then iterate o=o+1 list.o=list.n end list.0=o return 0 ByDsList: do n=1 to list.0 parse var list.n . (@tt) name . '\' st1 '\' . if st1=1 & tbllib.name='' then tbllib.name=LocMbrDs(name) end dmode='D' return 0 Locate: arg lname . p=0 l=length(lname) do n=1 to list.0 while p=0 parse var list.n . (pda@tt) name .'\' . if left(name,l)=lname then p=n end if p<>0 then do pdapos=p return 0 end return xmsg(lname 'not found')+8 NiceDate: return Insert('-',Insert('-',word(arg(1) date('s'),1),6),4) PgmSyntax: signal off syntax say '*Syntax' rc 'in line' sigl':' Errortext(rc) say Sourceline(sigl) exit 12 PgmNoVal: say '*Novalue raised for line' sigl '-' say strip(sourceline(sigl),'t') signal off novalue exit 12 DoPrompt: Procedure expose pdaattr pdascrw pdapnl parse arg pdahdr trace off interpret pdaattr Call PdaReinit pdapos=1 lp=' ' call PdaLine @tt do n = 2 to arg() /* build screen */ s=arg(n) if left(s,1)='>' then s=center(substr(s,2),pdascrw-8) else s=lp||s call PdaLine @tg||s end call PdaLine @tb if n<10 then call PdaLine @tb call PdaLine, @tg || center(pda@tb 'Press' || pda@tw || 'ENTER' || pda@tb, || 'to accept or' || pda@tw || 'END' || pda@tb || 'to terminate',, pdascrw-8) Address Ispexec "AddPop" Address Ispexec "Display panel("pdapnl")" cc=rc Address Ispexec "RemPop" return (cc=0) MakePlib: Procedure expose isppdd trace off cc=bpxwdyn('alloc new delete rtddn(isppdd) rtdsn(pds)', 'lrecl(80) recfm(f,b) blksize(0) dir(8)', 'tracks space(1,1) unit(sysda)') if cc<>0 then return xmsg('bpxwdyn pds failed' cc )+8 cc=bpxwdyn('alloc old rtddn(mbrdd) da('pds'(P0523782) close') if cc<>0 then return xmsg('bpxwdyn alloc member failed' cc )+8 do n=1 to sourceline() until sourceline(n)='/*PANEL';end address tso 'newstack' do m=n+1 to sourceline() while sourceline(m)<>'PANEL*/' queue sourceline(m) end address tso 'execio' queued() 'diskw' mbrdd '(finis)' cc=rc address tso 'delstack' if cc<>0 then return xmsg('write member failed' cc )+8 address ispexec 'libdef ispplib library id('isppdd') stack' if rc<>0 then return xmsg('Libdef failed' rc )+8 return 0 DropPlib: Procedure expose isppdd if symbol('ISPPDD')<>'VAR' then return 0 address ispexec 'libdef ispplib' return bpxwdyn('free dd('isppdd')') /*PANEL )Attr /* Panel using dynamic area to build scrollable or non-scrollable display */ /* History */ /* 2025-03-28 New, copied from ISPPDA#S, redefine shadow var feature */ /* 2026-02-10 * as catch-all line command, still allows POS. */ /* */ /* Author */ /* Willy Jensen */ /* mail: willy@harders-jensen.com */ /* web : http://harders-jensen.com */ + type(text ) color(turq ) caps(off) ! type(text ) color(yellow) caps(off) _ type(input ) color(turq ) caps(on ) hilite(uscore) | area(dynamic) extend(on) scroll(on) /* required */ /* Specials */ 01 type(dataout) color(blue ) caps(off) /* line break */ 02 type(datain ) color(turq ) caps(on ) hilite(uscore) /* sel field */ 03 type(datain ) color(red ) caps(on ) hilite(uscore) /* sel field */ /* Standard input */ 04 type(datain ) color(blue ) caps(off) /* PDA@IB @IB */ 05 type(datain ) color(green ) caps(off) /* PDA@IG @IG */ 06 type(datain ) color(pink ) caps(off) /* PDA@IP @IP */ 07 type(datain ) color(red ) caps(off) /* PDA@IR @IR */ 08 type(datain ) color(turq ) caps(off) /* PDA@IT @IT */ 09 type(datain ) color(white ) caps(off) /* PDA@IW @IW */ 0A type(datain ) color(yellow) caps(off) /* PDA@IY @IY */ /* User-defined input, color and hilite have only the short form */ 0B type(datain ) color(&@ui1c ) caps(off) hilite(&@ui1h) /* PDA@UI1 @UI1 */ 0C type(datain ) color(&@ui2c ) caps(off) hilite(&@ui2h) /* PDA@UI2 @UI2 */ 0D type(datain ) color(&@ui3c ) caps(off) hilite(&@ui3h) /* PDA@UI2 @UI2 */ 0E type(datain ) color(&@ui4c ) caps(off) hilite(&@ui4h) /* PDA@UI3 @UI3 */ /* Standard output */ 0F type(dataout) color(blue ) caps(off) /* PDA@OB @OB */ 10 type(dataout) color(green ) caps(off) /* PDA@OG @OG */ 11 type(dataout) color(pink ) caps(off) /* PDA@OP @OP */ 12 type(dataout) color(red ) caps(off) /* PDA@OR @OR */ 13 type(dataout) color(turq ) caps(off) /* PDA@OT @OT */ 14 type(dataout) color(white ) caps(off) /* PDA@OW @OW */ 15 type(dataout) color(yellow) caps(off) /* PDA@OY @OY */ /* User-defined output, color and hilite have only the short form */ 16 type(dataout) color(&@ut1c ) caps(off) hilite(&@ut1h) /* PDA@ut1 @ut1 */ 17 type(dataout) color(&@ut2c ) caps(off) hilite(&@ut2h) /* PDA@ut2 @ut2 */ 18 type(dataout) color(&@ut3c ) caps(off) hilite(&@ut3h) /* PDA@ut3 @ut3 */ 19 type(dataout) color(&@ut4c ) caps(off) hilite(&@ut4h) /* PDA@ut4 @ut4 */ /* Shadow var defs, only color and hilite can be referenced, in short form*/ 1A type(char) color(&@sv1c) hilite(&@sv1h) /* */ 1B type(char) color(&@sv2c) hilite(&@sv2h) /* */ 1C type(char) color(&@sv3c) hilite(&@sv3h) /* */ 1D type(char) color(&@sv4c) hilite(&@sv4h) /* */ )Body expand(\\) width(&pdascrw) %&pdahdr\ \+ %ISPF cmd ==>_zcmd \ \+Scrl_@sca+ !&pdaplmsg \ \+ |PDAAREA,PDASHADV\ \| )Init &@errpos = &Z if (&scrl EQ &Z) &scrl = 'CSR' if (&@sv1c EQ &Z) &@sv1c = 'WHITE' /* shadow color 1 */ if (&@sv2c EQ &Z) &@sv2c = 'YELLOW' /* shadow color 2 */ if (&@sv3c EQ &Z) &@sv3c = 'BLUE' /* shadow color 3 */ if (&@sv4c EQ &Z) &@sv4c = 'GREEN' /* shadow color 4 */ /* &pdashadv = '@sv1c @sv2c @sv3c @sv4c @sv1h @sv2h @sv3h @sv4h' */ &pdadpth = lvline(pdaarea) vget (zscrmaxd zscrmaxw) &pdamaxw = &zscrmaxw &pdamaxd = &zscrmaxd &@sca = 'CSR' *REXX(*,@pdascri pdascrw pdahdr @pdacsra @pdacsrp pdadpth @pdavmap, pdamaxd pdamaxw pdacsrp pdashadc pdashadv, @pdaarea pdapos pdamax pdafixn pdavars &pdavars pdaattr) pdaattr=, "pda@all=xrange('01'x,'19'x);", "parse var pda@all with", "=1 pda@nl +1 pda@sf +1 pda@se ", /* old long style */ "+1 pda@ib +1 pda@ig +1 pda@ip +1 pda@ir", "+1 pda@it +1 pda@iw +1 pda@iy", "+1 pda@ui1 +1 pda@ui2 +1 pda@ui3 +1 pda@ui4", "+1 pda@tb +1 pda@tg +1 pda@tp +1 pda@tr", "+1 pda@tt +1 pda@tw +1 pda@ty", "+1 pda@ut1 +1 pda@ut2 +1 pda@ut3 +1 pda@ut4", "=1 @nl +1 @sf +1 @se ", /* new short style */ "+1 @ib +1 @ig +1 @ip +1 @ir", "+1 @it +1 @iw +1 @iy", "+1 @ui1 +1 @ui2 +1 @ui3 +1 @ui4", "+1 @tb +1 @tg +1 @tp +1 @tr", "+1 @tt +1 @tw +1 @ty", "+1 @ut1 +1 @ut2 +1 @ut3 +1 @ut4;", "pda@inp=xrange(pda@ir,pda@ui4);@inp=pda@inp;", "pdamaxd="pdamaxd";pdamaxw="pdamaxw /*";pdashadv=''" */ interpret pdaattr parse value xrange('1A'x,'1D'x), /* shadow vars */ with pda@sv1 +1 pda@sv2 +1 pda@sv3 +1 pda@sv4 /* re-build area of it contains line breaks */ if pos(@nl,pdaarea)>0 then do /* expand area */ a=pdaarea pdaarea='' do while a<>'' parse var a l (pda@nl) +1 a pdaarea=pdaarea || left(l,pdascrw) end end if pos(@nl,pdashadv)>0 then do /* expand shadow */ a=pdashadv pdashadv='' do while a<>'' parse var a l (pda@nl) +1 a pdashadv=pdashadv || left(l,pdascrw) end end if pdashadv<>'' then pdashadv=translate(pdashadv,'1A1B1C1D'x,pdashadc) /* compute some values */ pdahdr=center(strip(pdahdr),pdascrw-2) if pdafixn='' then pdafixn=0 aln=length(pdaarea)/pdascrw /* total num of lines */ /* map variables and fill in data */ @pdavmap='' if pdavars<>'' then do vl=translate(pdavars) parse value 1 1 with p vln do forever p=Verify(pdaarea,pda@inp,'m',p) /* locate target field */ if p=0 then leave if vl='' then do say '*pnlvars overflow' leave end m=Verify(pdaarea,pda@all,'m',p+1) /* area end pos */ l=m-p-1 /* area length */ parse var vl vn vl /* get name */ pdaarea=overlay(value(vn),pdaarea,p+1,l,' ') /* insert value */ if substr(pdaarea,p,1)'' then do /* reposition in select fld */ if @pdacsrp='' then @pdacsrp=0 n=((@pdacsrp%pdascrw)*pdascrw)+1 if substr(pdaarea,n,1)=pda@sf | substr(pdaarea,n,1)=pda@se, then @pdacsrp=n+1 if pdacsrp<>'' then @pdacsrp=pdacsrp /* override cursor pos */ if pdacsrp<>'' then @pdacsra='PDAAREA' /* override cursor area */ end *ENDREXX if (&pdahelp NE &Z) .help = &pdahelp if (&@pdacsra EQ 'PDAAREA') .csrpos = &@pdacsrp .cursor = &@pdacsra else .cursor = ZCMD .csrpos = 1 )Reinit Refresh(*) )Proc &@pdacsrp = .csrpos &@pdacsra = .cursor &@presp = .resp &pdaresp = .resp &pdaplmsg = &Z &pdacsrp = &Z &zedlmsg = '' vget (zverb zscrolla zscrolln) shared *REXX(* @pdacsrp @pdacsra @errpos @pdavmap pdadpth,@pdaarea,@selp, zverb zscrolla zscrolln zedlmsg, pdascrw pdafixn pdapos pdamax, pdavars &pdavars pdaattr pdaselc pdalcmdl) errmsg='' interpret pdaattr parse value '' with pdasell pdaselv if pdapos='' then pdapos=1 /* reset lcmd errors */ do while @errpos<>'' parse var @errpos p @errpos pdaarea=overlay(pda@sf,pdaarea,p) end /* pull variable data from top section */ vm=@pdavmap do while vm<>'' parse var vm vn vp vl vm zz=value(vn,strip(substr(pdaarea,vp,vl),'t')) end /* pull line command(s) */ selc=pdaselc if left(selc,1)='=' then parse var selc =2 pas . =2 selc /* point-and-shoot */ else pas='' pdalcmdl='' p=(pdafixn*pdascrw)+1 selchrs=pda@sf || pda@se if wordpos(@presp,'END RETURN')=0 & length(pdaarea)>0 then do forever p=verify(pdaarea,selchrs,'m',p)+1 if p=1 then leave l=verify(pdaarea,pda@all,'m',p)-p if l<=0 then leave if substr(pdaarea,p,l)=substr(@pdaarea,p,l) then iterate s=translate(strip(substr(pdaarea,p,l))) if s<>'' & selc<>'' then, if wordpos(s,selc)=0 & wordpos('*',selc)=0 then do @errpos=p-1 errmsg='Bad linecmd' s pdaarea=overlay(pda@se,pdaarea,@errpos) @pdacsrp=@errpos+1 end pdalcmdl=pdalcmdl || pdapos+((p%pdascrw)-pdafixn)','s',' end if pas<>'' & pdalcmdl='', /* point-and-shoot */ & wordpos(zverb,'DOWN MAX')=0 then do n=(@pdacsrp%pdascrw) /* panel line nr */ if pos(pda@sf,substr(pdaarea,(n*pdascrw)+1,pdascrw))>0, /* selfld in line?*/ then pdalcmdl=n-pdafixn+pdapos','pas',' end /* handle scrolling */ if errmsg='' & zverb<>'' & wordpos(@presp,'END RETURN')=0 then do @csrline=(@pdacsrp%PDASCRW)+1 if @pdacsra='PDAAREA' & @csrline<=pdafixn then, /* cursor in fixed part */ parse value 'CSR' pdadpth with zscrolla zscrolln select when zverb zscrolla='DOWN MAX' then pdapos=pdamax-pdadpth+pdafixn+1 when zverb zscrolla='UP MAX' then pdapos=1 when zverb zscrolla='DOWN CSR' then pdapos=pdapos+zscrolln-pdafixn when zverb zscrolla='UP CSR' then pdapos=pdapos-zscrolln+pdafixn when zverb='DOWN' & datatype(zscrolla)='NUM' then, pdapos=pdapos+zscrolla when zverb='UP' & datatype(zscrolla)='NUM' then, pdapos=pdapos-zscrolla when zverb='DOWN' then pdapos=pdapos+zscrolln when zverb='UP' then pdapos=pdapos-zscrolln-pdafixn otherwise nop end if pdapos<1 then pdapos=1 if pdapos>pdamax then pdapos=pdamax end if pdapos<1 then pdapos=1 if pdapos>pdamax then pdapos=pdamax if errmsg<>'' then do zrxrc=8 zedlmsg=errmsg zrxmsg='ISRZ000' end else @errpos='' *ENDREXX )End PANEL*/