Panel using dynamic area to build scrollable or non-scrollable display The document contains the following sections 1. The documentation 2. The panel source 3. A sample REXX program I suggest that you start by reading section 1 and the help portion of the REXX program. 1. The documentation Highlights - Show the screen buffer. - Update variables associated with input field areas. - Calculate new top-of-panel pointer when scrolling request. - Return a list of line commands with data pointer. General information The panel receives a buffer with the lines either filled out, or ending in a new-line character. The panel displays the buffer in a dynamic area, The buffer may contain a top fixed section, a scrollable section or both. Scrolling is only handled if there is a scrollable section, so the scroll control panel field (the field to the right of the command input field) can be there, but may not actually be used. The top fixed section may contain named input fields, the named variables are retrieved and updated by the panel. The scrollable section may contain line command fields, in which case the panel returns changed line command values together with the line number of the underlying data structure (stem). The panel can optionally validate the line commands entered and only return to the calling program when all are valid. If a scrolling command is entered, then the panel calculates an adjusted top of display pointer. Panel attribute characters are externalized, so can be used in the calling program (see sample later). Users guide The panel requires a number of data- and control variables. Variables set by the program before displaying the panel PDAAREA The screeen buffer, with lines either filled to width, or ending in the new-line char, see the 'Panel attribute characters' section later. Note - the formats cannot be mixed. PDASHADV Optional screeen area shadow variable. It can be used to highligt certain characters in the display, typically the minimum allowed characters for a command. See the 'Panel attribute characters' section later. PDACSRP Optional cursor position, from the start of the dynamic area. The value is set to null by the panel to avoid later conflicts. PDAFIXN The number of lines in the optional top fixed area. See the note below. Default is 0 (none). PDAHDR A header line. It will be centered automatically. PDAMAX The number of records in the underlying data structure. Required for scrolling. PDAPOS The position in the data structure. Default is 1. PDASELC A list of valid line commands if line command fields are defined and validation is to be performed. If the first command is specified as =command, then it becomes the point and shoot line command, i.e. PDASELC='=A B C'. PDASCRW The screen width, 80 to width of logical screen. This variable is required. PDAVARS List of input variable names in the fixed top area. It must match the number of fields defined. Note that the number of scrollable lines are the total number of visible lines in the area minus the PDAFIXN value. If the number is less than 1 then scrolling is not checked. Variables set or updated by the panel PDAAREA The updated screeen buffer. PDAATTR An INTERPRETable value for defining attribute characters, see the section 'Panel attribute characters' below. PDADPTH Vertical size (depth) of dynamic area adjusted for split screen. PDAMAXD Maximum panel depth (copy of the ZSCRMAXD ISPF variable). PDAMAXW Maximum panel width (copy of the ZSCRMAXW ISPF variable). PDAPOS The new calculated position in the data structure after a scroll command. PDALCMDL A comma separated list of line commands in the format line#1,cmd1,..,line#n,cmd, A null cmd may be set if an earlier set line command is cleared. Panel attribute characters The panel will assign the hexadecimal values x'01' to x'19' to variables named PDA@xxx with alias @xxx (see the panel for details). The entire set is put in the INTERPRETable variable PDAATTR, so that the driving program have an easy method to set those attribute variables like so: pdascrw=80 Address Ispexec "Control nondispl enter" Address Ispexec "Display panel(isppda#s)" Interpret pdaattr Panel shadow area 4 attribute characters are defined for the shadow area for coloring and/or highlighting single characters in the display without having normal attribute characters looking like blanks. The characters are in variables PDA@SV1-4, or the short form (recommended) @SV1-4. The color and highlighting for each character are defined by the variable sets PDA@SVnC and PDA@SVnH, or @SVnC and @SVnH, where n is a number 1-4, corresponding to the PDA@SVn / @SVn nummber. The default colors are as follows 1: WHITE, 2: YELLOW, 3: BLUE, and 4: GREEN There is no default highlighting, valid values are USCORE, REVERSE or BLINK. The variable PDASHADC is use to simplify use of the shadow variables. It may contain 1-4 non-spaced characters, each defining a readable equvivalent for the @SV1-4 variables. Sample 1 using actual variables @sv1c='yellow' /* set color */ pdaarea =@tg'Line cmds: Browse Listcat' /* Area var */ pdaashad=copies(' ',12)@sv1' '@sv1 /* 1st char is yellow */ Sample 2 using substitution character pdashadc='{' /* readable @SV1 */ pdaarea =@tg'Line cmds: Browse Listcat' /* Area var */ pdaashad=copies(' ',12)'{ {' /* 1st char is white */ 2. Panel source - PDAPNL01 )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. */ /* 2026-03-09 Add long shadow vars PDA@SVx to PDAATTR. */ /* 2026-03-10 Add warning for missing PDAMAX var. */ /* 2026-03-31 Add @PRESP to PROC, add tracing. */ /* */ /* 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 pdaselc, @pdaarea pdapos pdamax pdafixn pdavars &pdavars pdaattr pdatrace) upper pdatrace ?trc=(pdatrace='A' | pdatrace='I') if ?trc then, say 'pdapnl_init pdascrw('pdascrw') pdamaxw('pdamaxw')' parse value xrange('1A'x,'1D'x), /* shadow vars */ with pda@sv1 +1 pda@sv2 +1 pda@sv3 +1 pda@sv4, 0 @sv1 +1 @sv2 +1 @sv3 +1 @sv4 if pdaattr='' then pdaattr=, "pda@all=xrange('01'x,'1D'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 pda@sv1 +1 pda@sv2 +1 pda@sv3 +1 pda@sv4 +1 .", "=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", "+1 @sv1 +1 @sv2 +1 @sv3 +1 @sv4 +1 .;", "pda@inp=xrange(pda@ir,pda@ui4);@inp=pda@inp;", "pdamaxd="pdamaxd";pdamaxw="pdamaxw interpret pdaattr /* 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 if length(l)>pdascrw & ?trc then, say 'pdapnl_init long line' l 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, @presp,zverb zscrolla zscrolln zedlmsg, pdascrw pdafixn pdapos pdamax, pdavars &pdavars pdaattr pdaselc pdalcmdl pdatrace) upper pdatrace ?trc=(pdatrace='A' | pdatrace='P') if ?trc then say 'pdapnl_proc cmd('zcmd') verb('zverb')', 'scrolla('zscrolla') scrolln('zscrolln')' 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 if wordpos(zverb,'DOWN UP')>0 & pdamax='' then, say '*** Variable PDAMAX, required for scrolling, is not set' 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 ?trc then say 'pdapnl_proc pos('pdapos')' if errmsg<>'' then do if ?trc then say 'pdapnl_proc error('errmsg')' zrxrc=8 zedlmsg=errmsg zrxmsg='ISRZ000' end else @errpos='' *ENDREXX )End 3. Sample REXX program /* rexx Author Willy Jensen mail willy@harders-jensen.com web http://harders-jensen.com History 2026-03-10 Initial */ Signal on novalue name ErrNoVal Signal on syntax name ErrSyntax Address ispexec "control errors return" panel='PDAPNL01' Call PdaInit /* get panel attr chars */ pdashadc = '{' /* shadow var char(s) */ pdaselc = '=S I X' /* line command(s) */ base.0=0 Call PcReset parse value 'N' with dsstat dsmask savedsmask savedsstat parse value 'turq uscore' with @ui1c @ui1h . pdavars = 'dsmask dsstat' pdahdr = 'Demo Panel Dynamic Area (PDA)' /* Main */ Do $main=1 to 999999 /* make panel */ Call PdaReinit call pdaline @tg' Primary cmds '@tt'Find c d RESet Where c H', right(@tb'Count' right(scrl.0,5),33),, ' { {{{ { {' call pdaline @tg' Line cmds '@tt'Select Info eXclude',, ' { { { ' call pdaline '' Call Pdaline @tg || ' Dsn mask' || pda@ui1 || left(' ',30), @tg || ' Get stats' || pda@ui1 || ' ' || @tb'N/y' call pdaline '' call pdaline @tw'S 'Left('Dataset',44) 'Dstype Volser' pdafixn=pdalines /* # fixed lines */ do n=pdapos to scrl.0 for pdamaxd /* add scrollables */ parse var scrl.n dsn','vol','dsorg','recfm',', lrecl','blksz','size','used','ext . call Pdaline @sf' '@tg||left(dsn,44)@tb||left(dsorg,6)' 'vol end /* display and check response */ zcmd='' Address Ispexec "Display panel("panel")" if rc>8 then exit ispmsg('Bad rc from panel:' rc zerrlm)+8 if rc>0 then leave /* End or Return command */ do while pdalcmdl<>'' /* handle select fields */ parse var pdalcmdl cpos','cval','pdalcmdl select when cval='S' then Call LCmdS scrl.cpos when cval='I' then Call LCmdI scrl.cpos when cval='X' then Call LCmdX cpos otherwise call Ispmsg '*Invalid lcmd' cval /* shouldn't come here */ end end if zcmd<>'' then call PCmds 'ALL',zcmd /* handle primary commands */ if dsmask<>savedsmask, | dsstat<>savedsstat then call MkData dsmask,dsstat savedsmask=dsmask savedsstat=dsstat end call quit Quit: if arg(1)<>'' then say arg(1) exit 0 ErrNoVal: say '*Novalue raised for line' sigl '-' say strip(sourceline(sigl),'t') return 12 ErrSyntax: signal off syntax say '*Syntax' rc 'in line' sigl':' Errortext(rc) say Sourceline(sigl) return 12 PChelp: procedure expose pdaattr pdamaxd panel /* Help command */ trace off Interpret pdaattr parse value 0 0 with o k do n=1 to sourceline() trace off select when sourceline(n)='' ' then base.o=@tt||substr(base.o,2) else base.o=overlay(@tb,base.o,1) end end trace off base.0=o call PcReset /* make SCRL. stem */ /* build panel */ parse value 80 'Help' with pdascrw pdahdr Do forever Call PdaReinit Call Pdaline '' /* fixed blank line at top */ pdafixn=1 /* for better looks */ do #=pdapos to scrl.0 for pdamaxd Call Pdaline @tt scrl.# end zcmd='' Address Ispexec "Display panel("panel")" if rc>8 then return ispmsg('Display rc' rc zerrlm) if rc<>0 then return 0 if zcmd<>'' then call PCmds '',zcmd /* handle primary commands */ End return 0 LCmdS: procedure expose pdaattr pdamaxd panel /* S line command */ trace off Interpret pdaattr arg dsn',' . zz=outtrap('scrl.') address tso "listc ent('"dsn"') all" zz=outtrap('off') pdamax=scrl.0 /* required for scrolling */ do #=0 to scrl.0;base.#=scrl.#;end /* for RESET */ /* build panel */ address ispexec 'vget zscrmaxw' parse value zscrmaxw 1 scrl.0 'Listcat' dsn with pdascrw pdapos pdamax pdahdr if pdascrw>120 then pdascrw=120 Do forever Call PdaReinit Call Pdaline '' /* fixed blank line at top */ pdafixn=1 /* for better looks */ do #=pdapos to scrl.0 for pdamaxd Call Pdaline @tt scrl.# end zcmd='' Address Ispexec "Display panel("panel")" if rc>8 then return ispmsg('Display rc' rc zerrlm) if rc<>0 then return 0 if zcmd<>'' then call PCmds '',zcmd /* handle primary commands */ End return 0 LCmdI: procedure expose pdaattr pdamaxd panel /* I line command */ trace off Interpret pdaattr arg dsn','vol','dsorg','recfm','lrecl','blksz','size','used','ext . pdamax=0 /* don't scroll */ pdascrw=80 /* don't scroll */ /* build panel */ Call PdaReinit pdahdr='Info for' dsn Do forever Call Pdaline '' /* fixed blank line at top */ Call Pdaline @tg'Dsname '@tt dsn Call Pdaline @tg'Dsorg '@tt dsorg Call Pdaline @tg'Recfm '@tt recfm Call Pdaline @tg'Lrecl '@tt lrecl Call Pdaline @tg'Blksz '@tt blksz Call Pdaline @tg'Size '@tt size Call Pdaline @tg'Used '@tt used Call Pdaline @tg'Extent '@tt ext pdafixn=pdalines /* don't scroll */ zcmd='' Address Ispexec "addpop" Address Ispexec "Display panel("panel")" cc=rc Address Ispexec "rempop" if cc>8 then return ispmsg('Display rc' rc zerrlm) if cc<>0 then return 0 if zcmd<>'' then call Ispmsg '*Commands not allowed' End return 0 LCmdX: Procedure expose scrl. pdalcmdl /* delete line (lcmd X) */ arg v . o=v-1 do p=v+1 to scrl.0 /* remove line (back up from pointer) */ o=o+1 scrl.o=scrl.p end scrl.0=o return LcmdlAdj(-1) LcmdlAdj: Procedure expose pdalcmdl arg a /* 1 or -1 */ c='' /* adjust */ do while pdalcmdl<>'' /* lcmd lnrs */ parse var pdalcmdl p','l','pdalcmdl c=c || p+a','l',' end pdalcmdl=space(c) return 0 IspMsg: parse arg zedlmsg address ispexec "setmsg msg(isrz000)" return 0 Requote: if arg(1)='' then return '';else return "'"Unquote(arg(1))"'" Unquote: return strip(space(translate(arg(1)," ","'"))) PCmds: arg q,cverb cdata Select when abbrev('FIND',cverb,1) then Return PcFind(cdata) when abbrev('WHERE',cverb,1) then Return PcWhere(cdata) when abbrev('RESET',cverb,3) then Return PcReset() when q='ALL' & cverb='H' then Return PcHelp() otherwise Return ispmsg('*Invalid command' zcmd)+99 end return 99 /* shouldn't come here */ PcFind: /* find string in list */ if cdata='' & symbol('findsave')='VAR' then cdata=findsave if cdata='' then return ispmsg('Missing argument') parse value words(cdata) word(cdata,1) word(cdata,words(cdata)), wordindex(cdata,words(cdata)) with wc w1 wl wlp select /* get directives */ when wordpos(w1,'FIRST LAST PREV NEXT')>0 then, parse var cdata dir cdata when wordpos(wl,'FIRST LAST PREV NEXT')>0 then , parse var cdata cdata =(wlp) dir otherwise dir='NEXT' end cdata=strip(cdata) if cdata='*' then cdata=findsave findsave=cdata select /* set options for scan */ when dir='FIRST' then parse value 1 0+scrl.0 1 with ff ft fb when dir='LAST' then parse value 0+scrl.0 1 '-1' with ff ft fb when dir='PREV' then parse value pdapos-1 1 '-1' with ff ft fb otherwise parse value pdapos+1 0+scrl.0 1 with ff ft fb /* next */ end do #=ff to ft by fb until ? ?=pos(cdata,scrl.#)>0 end if \? then return ispmsg(cdata 'not found') pdapos=# drop cd cn fd fl fp fb ft return 0 PcWhere: /* show only where text match */ o=0 c='' if left(cdata,1)='\' then parse var cdata c +1 cdata /* handle NOT match */ cdata=strip(cdata) Interpret, "do #=1 to scrl.0;", "if pos('"cdata"',scrl.#)"c"=0 then iterate;", "o=o+1;", "scrl.o=scrl.#;", "end" scrl.0=o if scrl.0=0 then call ispmsg 'Filter left no records' pdapos=1 pdamax=scrl.0 return 0 MkData: Procedure expose scrl. base. pdapos pdamax /* Make dataset list */ arg dsmask .,dsstat . dsstat=word(dsstat 'N',1) if wordpos(dsstat,'N Y')=0 then return ispmsg('Invalid getstat value') if dsmask='' then return ispmsg('Please enter mask') address ispexec "control errors return" address ispexec "LmdInit listid(dsldid) level("dsmask")" if rc<>0 then return ispmsg('LmdInit rc' rc zerrlm) #=0 drop base. if dsstat='Y' then dsstat='STATS(YES)' else dsstat='' parse value '' with dsn zdlvol zdldsorg zdlrecfm zdllrecl, zdlblksz zdlsize zdlused zdlext do forever /*until #> 80*/ Address Ispexec "LMDLIST LISTID("dsldid")", "OPTION(LIST) DATASET(dsn)" dsstat if rc>8 then call quit 'lmdlist(list) failed rc' rc if rc<>0 then leave parse var dsn q1'.'q2'.'q3'.'qr if q2='SOUT' then iterate if left(q2,3)='SPF' then iterate #=#+1 if zdldsorg='PO' then zdldsorg='PDS' else if zdldsorg='PO-E' then zdldsorg='PDS-E' if zdlvol='*ALIAS' then parse value 'ALIAS' with zdldsorg zdlvol else if zdlvol='*VSAM*' then parse value 'CLUST' with zdldsorg zdlvol base.#=space(translate(dsn','zdlvol','zdldsorg','zdlrecfm','zdllrecl, ||','zdlblksz','zdlsize','zdlused','zdlext,' ','ff'x),0) end base.0=# address ispexec "LmdFree listid("dsldid")" return PcReset() PcReset: drop scrl. do #=0 to base.0 scrl.#=base.# end pdapos=1 pdamax=base.0 return 0 /* PDA mods */ Pdaline: /* 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 PdaInit: /* get panel attr chars */ Address Ispexec "vget (zscrmaxd zscrmaxw)" pdascrw=80 /* reqd for 1st call */ Address Ispexec "Control nondispl enter" Address Ispexec "Display panel("panel")" Interpret pdaattr Return 0 PdaReinit: /* reset some vars */ parse value 0 0 with pdalines pdafixn pdaarea pdashadv if symbol('PDAPOS')<>'VAR' then pdapos=1 else if pdapos<1 then pdapos=1 return 0