cIRFIND ; Open-M/SQL find multiple strings in routines   ; Compiled December 8, 2011 12:06:20
 ; zie ook %RFAND waarvan deze door KU op 24.11.04 van afgeleid is;
 ; DAS351 01/19/01  ; Compiled May 30, 2003 17:07:39
 ;%system.INC ; STC421 01/13/03
 ;%ST.INC PWC637 05/22/02
 ; %system.inc: compiled for USEDYNPIDTAB
 ; %system.inc: compiled for USEDYNTTYHASH
 ; %system.inc: compiled for USETTYHASH
 ; +--------------------------------------------------------+
 ; | Copyright 1986-2003 by InterSystems Corporation,       |
 ; | Cambridge, Massachusetts, U.S.A.                       |
 ; | All rights reserved.                                   |
 ; |                                                        |
 ; | Confidential, unpublished property of InterSystems.    |
 ; |                                                        |
 ; | This media contains an authorized copy or copies       |
 ; | of material copyrighted by InterSystems and is the     |
 ; | confidential, unpublished property of InterSystems.    |
 ; | This copyright notice and any other copyright notices  |
 ; | included in machine readable copies must be reproduced |
 ; | on all authorized copies.                              |
 ; +--------------------------------------------------------+
1 N CH,ANY,EXACT,R,J,POP,SELF,%msub,I,II,NL
 N %A,%E,%X,%ANS,IO,IOF,IOM,IOST,IOT,IOBS,IOPAR,IOSL,RMSDF
 W !,"Find routines that contain all of a set of strings."
 D LIST QUIT:'CH  W ! S POP=0,EXACT=1
 I ANY S EXACT=($$YN("Exact Upper/Lowercase Match","Y")="Y") QUIT:POP  W !
 D ^%RSETN("Routine(s): ","SD","MAC,INT,INC,BAS","DEVN") G KILL:POP
 I $O(^mtemp(%msub,""))="" G KILL
 W !!,"Display results on"
 d OUT^%IS g KILL:POP s SELF=($I=IO)
 S $ze="",$zt="EXIT^"_$zn D DOIT
EXIT S $zt="" I 'SELF U IO W @IOF C IO
 U 0 I ($ze'="") W !,"Error: "_$p($p($ze,">"),"<",2)
KILL I $D(%msub) K ^mtemp(%msub)
 QUIT
LIST K CH S CH=0,ANY=0 F  D ASKR Q:R=""  S CH=CH+1,CH(CH,"R")=R
 QUIT
ASKR W !,$J(CH+1,2)_". "_$S(CH:"and ",1:"    ")_"Search For:  "
 R R S:R?.E1A.E ANY=1 QUIT
DOIT ;do the search, given EXACT and CH() and list of routines
 N SD,SYS,DIR,BRACKET,EXT,VER,ROU
 N HIT,GOT,%T,%B,%O,T,X,OT
 I 'EXACT F CH=1:1:CH S CH(CH,"R")=$$UC(CH(CH,"R"))
 I 'SELF U IO D HEADER ;display stuff on other devices
 S SD=""
SD S SD=$O(^mtemp(%msub,SD)) I SD="" QUIT
 S SYS=$P(SD,"@"),DIR=$P(SD,"@",2),EXT=""
EXT S EXT=$O(^mtemp(%msub,SD,EXT)) I EXT="" G SD
 S BRACKET="",VER=""
 S:DIR]"" BRACKET="["""_DIR_""""_$S(SYS]"":","""_SYS_"""]",1:"]")
 U 0 W !,BRACKET,! I 'SELF U IO W !,BRACKET,!
VER S VER=$O(^mtemp(%msub,SD,EXT,VER)),ROU="" I VER="" G EXT
ROU S ROU=$O(^mtemp(%msub,SD,EXT,VER,ROU)) I ROU="" G VER
 D ONEROU G ROU
ONEROU ;for one routine, figure it all out
 N NSP S NSP=$p($p(BRACKET,"[",2),"]",1)
 I EXT="INT" N VER S VER=0
 ;DAS351+
 I EXT="BAS" N VER S VER=0
 ;DAS351-
 S HIT=0,%B="",%O=1,NL=$$LENGTH^%R(ROU_"."_EXT_"."_VER,NSP) I 'NL QUIT
 ; U 0 W:$X+16>80 ! W ?$X+15\16*16,ROU_"."_EXT_$S((",MAC,INC,"[(","_EXT_","))&(VER>0):"."_VER,1:"")
 U IO 
 ; KU : 24.11.04
 K FCH M FCH=CH K GOT
 F II=1:1:NL S (OT,T)=$$LINE^%R(ROU_"."_EXT_"."_VER,II,NSP) D TAG,FIND(T) ;search each line
 ; KU : 24.11.04
 I '$L($O(FCH(""))) D PRINT 
 U IO W:HIT ! QUIT
 ; TAG I $E(OT)'="#",$P(OT," ")]"" S %B=$P($P(OT," "),"("),%O=0
 ; S %T=$S(%O:%B_"+"_%O,1:$P(OT," ")),%O=%O+1 QUIT
TAG I $E(OT)'="#" {
    Set intro=$e(OT)
       If (intro'=" ") && (intro'=$c(9)) {
          Set spaceoff=$Find(OT," "),taboff=$Find(OT,$c(9))
          If taboff && (taboff<spaceoff) Set delim=$c(9)
          Else  Set delim=" "
          S %B=$P($P(OT,delim),"("),%O=0
    }
 }
 Set spaceoff=$Find(OT," "),taboff=$Find(OT,$c(9))
 If taboff && (taboff<spaceoff) Set delim=$c(9)
 Else  Set delim=" "
 S %T=$S(%O:%B_"+"_%O,1:$P(OT,delim)),%O=%O+1 QUIT
FIND(T) ;search for hits in T from CH() (EXACT or not)  print out if any hits
 I 'EXACT S T=$$UC(T) ;make all uppercase if not exact case
 ; KU : 24.11.04
 S GOT=0 F I=1:1:CH I T[CH(I,"R") S GOT=1 K FCH(I) S GOT(II,1)=%T,GOT(II,2)=T
 ; KU : 24.11.04
 ; I 'GOT QUIT
 QUIT
 ;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PRINT U IO I 'HIT W !,BRACKET_ROU_"."_EXT_$S(((",MAC,INC,")[(","_EXT_","))&(VER>0):"."_VER,1:"")
 S HIT=1 
 S II="" F  S II=$O(GOT(II)) Q:II=""  S %T=GOT(II,1),OT=GOT(II,2) D PRINTA
 QUIT
PRINTA W !,%T_" ",?12
 If $E(OT)'="#" {
    Set spaceoff=$Find(OT," "),taboff=$Find(OT,$c(9))
    If taboff && (taboff<spaceoff) Set OT=$Piece(OT,$c(9),2,255)
    Else  Set OT=$Piece(OT," ",2,255)
 }
PONE S X=$X W $E(OT,1,IOM-X) S OT=$E(OT,IOM-X+1,32767) I OT]"" W !?12 G PONE
 QUIT
 ; PRINT U IO I 'HIT,'SELF W !,BRACKET_ROU_"."_EXT_$S(((",MAC,INC,")[(","_EXT_","))&(VER>0):"."_VER,1:"")
 ; S HIT=1 
 ; S II="" F  S II=$O(GOT(II)) Q:II=""  S %T=GOT(II,1),OT=GOT(II,2) D PRINTA
 ; QUIT
 ; PRINTA W !,%T_" ",?12 S:$E(OT)'="#" OT=$P(OT," ",2,255)
 ; PONE S X=$X W $E(OT,1,IOM-X) S OT=$E(OT,IOM-X+1,32767) I OT]"" W !?12 G PONE
 ; QUIT
HEADER U IO W @IOF,!?20,"Find routine lines with strings "_$$Now()
 I ANY W !?25,"Case "_$S(EXACT:"S",1:"Ins")_"ensitive"
 W !!,"Searching for "
 F I=1:1:CH W """"_CH(I,"R")_"""" W:I<CH " and " W:$X+30>IOM !?15
 W !! QUIT
Now() QUIT ($$DO($H,2)_"  "_$$TO($P($H,",",2)))
DO(%DN,f) QUIT $ZD(%DN,+$G(f)) ;'f' is format
TO(%TN) N h,m,a S a=" am",h=%TN\3600,m=%TN\60#60 S:h>11 a=" pm",h=h-12
 S:'h h=12 QUIT ($J(h,2)_":"_$E(m+100,2,3)_a) ;'hh:mm am' version of '%TN'
YN(P,D,t) N R,X S P=$G(P),D=$E($G(D)_"?"),t=$G(t) ;ask Yes/No w/ Prompt,Default
 S D=$S("Yy"[D:"Yes => ","Nn"[D:"No => ",1:"") ;Yes, No or no default
 F  W !,P_"? "_D Read:t R:t Read:'t R DO  I "^YN"[R Q  ;timed or non-timed read
 . S X=R,R=$TR($E(R_D_"?"),"yn","YN") I "^YN"'[R W "  enter Yes or No, please"
 S POP=(R="^") W $E($S(R="N":"No",R="Y":"Yes",1:""),$L(X)+1,3) Q R
UC(x) q $zcvt(x,"u")
	;
ZZ	; 05.04.05 -  8 u 52 * V8.03