/* REXX find string outside of member and show the member list */
/* (c) Copyright IBM Corp, 1995, 1999  All rights Reserved     */
/*                                                             */
/* *** WARNING ***                                             */
/*   This depends on internal structures within ISPF.  These   */
/*   structures are not an intended programming interface and  */
/*   are subject to change at any time.                        */
/*                                                             */
/*   IBM PROVIDES THIS CODE ON AN "AS IS" BASIS WITHOUT        */
/*   WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,          */
/*   INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES     */
/*   OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR            */
/*   PURPOSE.                                                  */
/*-------------------------------------------------------------*/
/* Invocation:                                                 */
/*    This is an edit macro.  If it is called SCANPDS then     */
/*    the invocation is                                        */
/*                                                             */
/*          SCANPDS string                                     */
/*                                                             */
/*    where string is a quoted or non-quoted string.           */
/*    The search is case-insensitive.                          */
/*    The result is a member list of members containing the    */
/*    string.  Concatenations are honored.                     */
/*                                                             */
/*    Version 1.00 - June 12, 1999 - Initial release           */
/*    Version 1.01 - June 14, 1999 - use popup for status      */
/*    Version 1.02 - Sept 14, 1999 - free allocated dd names   */
/*    Version 1.03 - Sept 14, 1999 - fix 1.02 (oops)           */
/*    Version 1.04 - Mar  17, 2006 - Add Numeric Digits        */
/*                                                             */
/*  Author: Doug Nadel                                         */
/*          nadel@us.ibm.com                                   */
/*-------------------------------------------------------------*/
unitname = 'VIO'    /* Change this if allocations fail  */
 
Parse Source . . mname .
Address isredit
'MACRO (INPARMS)';
If rc>0 Then
  Do; Say mname 'must be invoked as an edit command.' ;Exit 0 ;End
If inparms='' Then
Do;Say 'The 'mname' command requires a string to find.';Exit 12;End
Numeric Digits 10
If substr(inparms,1,1)="'" Then Parse Var inparms "'" inparms "'" rest
Else
If substr(inparms,1,1)='"' Then Parse Var inparms '"' inparms '"' rest
Else rest=''
rest=translate(space(rest))
If rest\='' Then rest=','rest
Upper inparms
Call getdsns
Parse Value zdsn.0 zdsn.1 zdsn.2 zdsn.3 With zdsn0 zdsn1 zdsn2 zdsn3
'(MEMBER) = MEMBER'
If member = '' Then
  Do
   zerrsm='Must be partitioned'
   zerrlm=mname' is only valid with partitioned data sets.'
   zerrhm='*'
   zerralrm='YES'
   Address ispexec 'SETMSG MSG(ISRZ002)'
   Exit 12
  End
Address 'TSO'
'ALLOC F(SYSIN) REUSE NEW DEL UNIT('unitname') LRECL(80) RECFM(F B)
 SPACE(10,10) TRACK RELEASE DSO(PS) BLKSIZE(80)'
Do queued();Pull;End
Queue 'SRCHFOR '''inparms''''rest
Address 'TSO'   'EXECIO 1 DISKW SYSIN (FINIS'
'ALLOC F(NEWDD) DA('strip(zdsn.0 zdsn.1 zdsn.2 zdsn.3)') SHR REUSE'
rdd='$'right(time(s),7,'0')
'ALLOC F('rdd') DA('strip(zdsn.0 zdsn.1 zdsn.2 zdsn.3)') SHR REUSE'
'ALLOC F(OUTDD) REUSE NEW DEL UNIT('unitname') LRECL(80) RECFM(F B)
SPACE(10,10) TRACK RELEASE DSO(PS)'
supparm='SRCHCMP,ANYC,LMTO,NOSUMS,NOPRTCC,CKPACKL'
a=1
'ALLOC NEW DEL F($UPDPAN) DSO(PO) DIR(1) SP(3,3) TRACK
        REUSE RECFM(F B) BLKSIZE(0) LRECL(80) UNIT('unitname')'
Do Until substr(line,1,7)='/*PANEL'
  line = sourceline(a)
  a=a+1
End
Parse Var line . panelname .
Address ispexec
'LMINIT DATAID(TMPPNL) ENQ(EXCLU) DDNAME($UPDPAN)'
'LMOPEN DATAID('tmppnl') OPTION(OUTPUT)'
Do Until substr(line,1,4)=')END'
  line = sourceline(a)
  'LMPUT DATAID(&TMPPNL) MODE(INVAR) DATALOC(LINE) DATALEN(80)'
  a=a+1
End
'LMMADD DATAID(&TMPPNL) MEMBER('panelname')'
'LMFREE DATAID(&TMPPNL)'
'LIBDEF ISPPLIB LIBRARY ID($UPDPAN) STACK'
'ADDPOP'
'CONTROL DISPLAY LOCK'
'DISPLAY PANEL(POPUP)'
'SELECT PGM(ISRSUPC) PARM(&SUPPARM)'
supercrc=rc
'REMPOP'
'LIBDEF ISPPLIB '
Address tso
'FREE F($UPDPAN)'
If supercrc=1 Then
  Do
    'EXECIO * DISKR OUTDD (FINIS STEM MEM.'
    Address ispexec
    'CONTROL ERRORS RETURN'
    'LMINIT DATAID(DATAID) DDNAME('rdd') ENQ(SHR)'
    'LMOPEN DATAID('dataid')'
    'CONTROL NONDISPL END'
   zerrsm='Found in 'mem.0-5' members'
   zerrlm='The string "'inparms'" was found in 'mem.0-5' members.'
   zerrhm='*'
   zerralrm='NO'
   Address ispexec 'SETMSG MSG(ISRZ002)'
    option='DISPLAY) COMMANDS(ANY'
    zcmd = ''
    Do a=6 to mem.0
       Parse Var mem.a member .
       'LMMDISP DATAID('dataid') OPTION('option') ',
                               'MEMBER('member')'
       If rc<=8 Then  /* ignore bad names for now */
         option='ADD'
       Else
         'CONTROL NONDISPL END' /* don't display next attempt*/
    End
    address tso 'FREE F(NEWDD SYSIN OUTDD)'
    zlmember=''
    Do Until disprc>0
      'LMMDISP DATAID('dataid')  OPTION(DISPLAY) COMMANDS(ANY) ,
               TOP('zlmember')'
      disprc=rc
      If disprc=0 & zlmember\='' Then
        Do
          service = ''
          SELECT
            When (zllcmd='V') Then service='VIEW'
            When (zllcmd='B') Then service='BROWSE'
            When (zllcmd='S') Then service='EDIT'
            When (zllcmd='/') Then service='EDIT'
            When (zllcmd='E') Then service='EDIT'
            Otherwise
             Do
            zerrsm='Invalid command:'zllcmd
            zerrlm='Use B for BROWSE, V for VIEW or E, S or / for EDIT.'
            zerrhm='*'
            zerralrm='YES'
            Address ispexec 'SETMSG MSG(ISRZ002)'
             End
          End
          If service \= '' Then
           Do
            service 'DATAID('dataid') MEMBER('zlmember')'
            If rc>=12 Then 'SETMSG MSG(ISRZ002)'
           End
        End
    End
    'LMMDISP DATAID('dataid')  OPTION(FREE)'
    'LMFREE DATAID('dataid')'
  End
Else
  Do
   zerrsm='String not found'
   zerrlm='The string "'inparms'" was not found in any members.'
   zerrhm='*'
   zerralrm='YES'
   Address ispexec 'SETMSG MSG(ISRZ002)'
   address tso 'FREE F(NEWDD SYSIN OUTDD)'
  End
address tso 'FREE F('rdd')'
 
Exit 0
getdsns: Procedure Expose zdsn. panel zwidth
zdsn.=''
tfdp = ptr(76+ptr(640+ptr(ptr(24+ptr(112+ptr(132+ptr(540)))))))
panel=storage(d2x(344+ptr(ptr(24+ptr(112+ptr(132+ptr(540)))))),8)
Do a=0 to 3
  Parse Value storage(d2x(ptr(140+a*4+tfdp)),46) With d 3 n
  If d>'0000'x Then zdsn.a="'"strip(n)"'"
End
Return
ptr: Return c2d(bitand(storage(d2x(Arg(1)),4),'7FFFFFFF'x))
/*PANEL POPUP
)ATTR
 @ type(pt)
 + type(nt)
 / type(text) color(red)
)BODY window(60,15)
+                 @Searching Data Set(s)+
+
+String:   /&inparms
+Data sets:%&zdsn0
+         :%&zdsn1
+         :%&zdsn2
+         :%&zdsn3
)END
*/