1 | ARJTDDKR ;WV/TOAD-FileMan Search All Routines ;5/24/2004 19:08
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999;
|
---|
3 | ;
|
---|
4 | ; Change History:
|
---|
5 | ;
|
---|
6 | ; 2004 05 24 modified to handle GT.M as well as DSM
|
---|
7 | ;
|
---|
8 | ; table of contents:
|
---|
9 | ; ALL - search all routines in current environment
|
---|
10 | ; RSE - search selected routines
|
---|
11 | ; FEEDBACK - give routine search feedback
|
---|
12 | ; SEARCH - search 1 routine
|
---|
13 | ; CONTAINS - function: does code contain what we're looking for
|
---|
14 | ; CODEROU - cross-reference results by code then routine
|
---|
15 | ; RESULTS - report results of search
|
---|
16 | ; ADDLINE - add a line to the Line WP field (2)
|
---|
17 | ;
|
---|
18 | ; input:
|
---|
19 | ; .CONTAINS(string)="" to search any line containing the string
|
---|
20 | ; FIND = optional. special search, e.g., "DSM"
|
---|
21 | ;
|
---|
22 | ; output:
|
---|
23 | ; .EXIT = returns 1 if interrupted.
|
---|
24 | ; report to current device
|
---|
25 | ;
|
---|
26 | ;
|
---|
27 | ALL(CONTAINS,FIND,EXIT) ; public subroutine: search all routines
|
---|
28 | ;
|
---|
29 | ; input: DSM-specific ^ () global (name = space)
|
---|
30 | ; called by ALL^ARJTDDK -- master search option
|
---|
31 | ; calls:
|
---|
32 | ; FEEDBACK - give routine search feedback
|
---|
33 | ; SEARCH - search each routine
|
---|
34 | ; RESULTS^ARJTDDKU - report results of search
|
---|
35 | ;
|
---|
36 | W !!,"Searching all routines"
|
---|
37 | K ^XTMP("DSMROUTINES")
|
---|
38 | S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
---|
39 | ;
|
---|
40 | S EXIT=0 ; not interrupted so far
|
---|
41 | N PRE S PRE="" ; trace shifting prefixes
|
---|
42 | N COUNT ; number of routines searched
|
---|
43 | N FOUND S FOUND=0 ; number of matching routines found
|
---|
44 | N ROU S ROU="" ; name of each routine
|
---|
45 | F COUNT=0:1 D Q:ROU=""!EXIT
|
---|
46 | . S ROU=$O(^ (ROU)) Q:ROU="" ; DSM stores rtn direc. in ^[space].
|
---|
47 | . I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
---|
48 | . D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
---|
49 | D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
---|
50 | Q:EXIT
|
---|
51 | D COMPILE^ARJTDDKS(1)
|
---|
52 | ;
|
---|
53 | QUIT ; end of ALL
|
---|
54 | ;
|
---|
55 | ;
|
---|
56 | RSE(CONTAINS,FIND,EXIT) ; public subroutine: search selected routines
|
---|
57 | ;
|
---|
58 | ; calls:
|
---|
59 | ; ^%RSEL - select routines to search
|
---|
60 | ; FEEDBACK - give routine search feedback
|
---|
61 | ; SEARCH - search each routine
|
---|
62 | ; RESULTS - report results of search
|
---|
63 | ; note: since DSM's ^%RSEL returns its list in the local %UTILITY
|
---|
64 | ; variable, a large symbol table size is needed to hold large lists.
|
---|
65 | ;
|
---|
66 | N %UTILITY D ^%RSEL Q:$O(%UTILITY(""))=""
|
---|
67 | W !!,"Searching selected routines"
|
---|
68 | K ^XTMP("DSMROUTINES")
|
---|
69 | S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
---|
70 | ;
|
---|
71 | S EXIT=0 ; not interrupted so far
|
---|
72 | N PRE S PRE="" ; trace shifting prefixes
|
---|
73 | N COUNT ; number of routines searched
|
---|
74 | N FOUND S FOUND=0 ; number of matching routines found
|
---|
75 | N ROU S ROU="" ; name of each routine
|
---|
76 | F COUNT=0:1 D Q:ROU=""!EXIT
|
---|
77 | . S ROU=$O(%UTILITY(ROU)) Q:ROU=""
|
---|
78 | . I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
---|
79 | . D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
---|
80 | D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
---|
81 | Q:EXIT
|
---|
82 | D COMPILE^ARJTDDKS()
|
---|
83 | ;
|
---|
84 | QUIT ; end of ALL
|
---|
85 | ;
|
---|
86 | ;
|
---|
87 | FEEDBACK(COUNT,ROU,PRE,EXIT) ; subroutine: give routine search feedback
|
---|
88 | ;
|
---|
89 | ; input:
|
---|
90 | ; COUNT = # searched so far
|
---|
91 | ; ROU = name of next routine to search
|
---|
92 | ; in/output: .PRE = 1st 2 letters of previous routine searched
|
---|
93 | ; called by: ALL, RSE
|
---|
94 | ;
|
---|
95 | S EXIT=0 ; not interrupted yet
|
---|
96 | N READ ; results of quick read command
|
---|
97 | W "." ; dots
|
---|
98 | I '(COUNT#1000) W !,$FN(COUNT,",")," routines searched so far" ; counts
|
---|
99 | I $E(ROU,1,2)'=PRE S PRE=$E(ROU,1,2) W " ",PRE,"*" ; changing prefixes
|
---|
100 | R READ:0 S EXIT=READ=U ; quick reads to allow ^-escape
|
---|
101 | ;
|
---|
102 | QUIT ; end of FEEDBACK
|
---|
103 | ;
|
---|
104 | ;
|
---|
105 | SEARCH(RTN,CONTAINS,FIND,FINDCNT) ; subroutine: search 1 routine
|
---|
106 | ;
|
---|
107 | ; input: RTN = name of routine to search
|
---|
108 | ; in/output: .FINDCNT = optional. increments # of instances found
|
---|
109 | ; called by: ALL, RSE
|
---|
110 | ; calls:
|
---|
111 | ; $$CONTAINS - test each line: does it contain what we're looking for
|
---|
112 | ; CHECK^ARJTDIM - search each line of code
|
---|
113 | ;
|
---|
114 | ; S.1. Traverse The Routine Lines
|
---|
115 | ;
|
---|
116 | Q:RTN="" ; need a routine name
|
---|
117 | N SKIP S SKIP=0 D Q:SKIP ; we skip routine if doesn't exist or too big
|
---|
118 | . ; if error, will probably be because too large, report & skip
|
---|
119 | . N $ET S $ET="S SKIP=1 W !?5,RTN,"" TOO LARGE!"",! S ($EC,$ZE)="""""
|
---|
120 | . S SKIP=$T(^@RTN)="" ; make sure 1st line exists
|
---|
121 | N FOUND S FOUND=0 ; flag success or failure for routine
|
---|
122 | N FIRST S FIRST=1 ; only report routine name on 1st hit
|
---|
123 | N FOUNDR S FOUNDR=0 ; any found within routine?
|
---|
124 | N RIEN ; the IEN of routine's entry in Cache Routine file (663075)
|
---|
125 | N LIEN ; the last line # in the Line WP field (2)
|
---|
126 | N NUM ; # lines
|
---|
127 | N LINE ; each line of code
|
---|
128 | N CODE ; the code part of each line
|
---|
129 | F NUM=1:1 S LINE=$T(+NUM^@RTN) Q:LINE="" I $$CONTAINS(LINE,.CONTAINS) D
|
---|
130 | . ;
|
---|
131 | . ; S.2. Parse each simply matching line using ARJTDIM
|
---|
132 | . ;
|
---|
133 | . I $G(MAH) W !!,"+",NUM," ",LINE
|
---|
134 | . S CODE=$P(LINE," ",2,99999) ; ARJTDIM doesn't deal with labels
|
---|
135 | . F Q:CODE="" Q:" ."'[$E(CODE) S $E(CODE)="" ; or spaces and periods
|
---|
136 | . Q:CODE="" ; skip line if nothing but labels, periods, and spaces
|
---|
137 | . D CHECK^ARJTDIM(CODE,FIND,.FOUND) ; parse line
|
---|
138 | . Q:'FOUND ; skip lines that don't match
|
---|
139 | . S FOUNDR=1,FOUND=0
|
---|
140 | . ;
|
---|
141 | . ; S.3. Count routine once if one of its lines completely matches
|
---|
142 | . ;
|
---|
143 | . I FIRST D ; when routine first gets a hit
|
---|
144 | . . W !?5,RTN ; make its name stand out
|
---|
145 | . . I $X>6 W ! ; try to keep first match line on same line with name
|
---|
146 | . . S RIEN=$O(^DIZ(663075,"B",RTN,0))
|
---|
147 | . . I '$D(^DIZ(663075,+RIEN,0)) D ; create a new entry if missing
|
---|
148 | . . . N RNODE S RNODE=$G(^DIZ(663075,0)) ; file header
|
---|
149 | . . . S RIEN=$P(RNODE,U,3) ; most recent IEN assigned
|
---|
150 | . . . F S RIEN=RIEN+1 Q:'$D(^DIZ(663075,RIEN)) ; find free IEN
|
---|
151 | . . . S $P(RNODE,U,3,4)=RIEN_U_($P(RNODE,U,4)+1) ; update recent & count
|
---|
152 | . . . S ^DIZ(663075,0)=RNODE ; update header
|
---|
153 | . . . S ^DIZ(663075,RIEN,0)=RTN ; new entry's Routine Name field (.01)
|
---|
154 | . . . S ^DIZ(663075,"B",RTN,RIEN)="" ; cross-reference new entry
|
---|
155 | . . S LIEN=$O(^DIZ(663075,RIEN,1," "),-1) ; find last line in WP
|
---|
156 | . . I LIEN>0 D ADDLINE(RIEN,.LIEN," ")
|
---|
157 | . . D ADDLINE(RIEN,.LIEN,$$HTE^XLFDT($H))
|
---|
158 | . S FIRST=0 ; no longer 1st hit
|
---|
159 | . S FINDCNT=$G(FINDCNT)+1 ; one more routine found
|
---|
160 | . ;
|
---|
161 | . ; S.4. Report each completely matching line
|
---|
162 | . ;
|
---|
163 | . W FINDCNT,"." ; for ease of using the report, # each match found
|
---|
164 | . W ?7 ; indent for clarity
|
---|
165 | . N LINEID ; how shall we ID the line?
|
---|
166 | . I $E(LINE)'=" " S LINEID=$P(LINE," ") ; as label, if any
|
---|
167 | . E S LINEID="+"_NUM ; otherwise as absolute offset
|
---|
168 | . S LINEID=LINEID_$J(" ",9-$L(LINEID)) ; ID then "tab" to col 16
|
---|
169 | . W LINEID ; display line ID to screen
|
---|
170 | . S LINE=$P(LINE," ",2,9999) ; remove label and ls
|
---|
171 | . N LINCHUNK ; each chunk of line to show
|
---|
172 | . F Q:'$L(LINE) D ; repeat until we're out of code
|
---|
173 | . . S LINCHUNK=$E(LINE,1,64)
|
---|
174 | . . W ?16,LINCHUNK,! ; write to screen what will fit
|
---|
175 | . . D ADDLINE(RIEN,.LIEN,LINEID_LINCHUNK) ; set ID + line chunk
|
---|
176 | . . S LINEID=" " ; just "tab" for remaining chunks
|
---|
177 | . . S $E(LINE,1,64)="" ; clear written code
|
---|
178 | I FOUNDR D
|
---|
179 | . W ! ; line feed to end list of matching lines for routine
|
---|
180 | . Q:FIND'="DSM" ; rest of block for John Harvey
|
---|
181 | . M ^XTMP("DSMROUTINES","ROU CODE",RTN)=FOUND("DSM")
|
---|
182 | . D CODEROU(RTN,.FOUND)
|
---|
183 | ;
|
---|
184 | QUIT ; end of SEARCH
|
---|
185 | ;
|
---|
186 | ;
|
---|
187 | CONTAINS(CODE,CONTAINS) ; function: does code contain what we're looking for
|
---|
188 | ;
|
---|
189 | ; input: CODE = line of code
|
---|
190 | ; output: true if line contains any of CONTAINS
|
---|
191 | ; called by: SEARCH
|
---|
192 | ;
|
---|
193 | N DOES I $D(CONTAINS)#2 S DOES=CODE[CONTAINS Q DOES
|
---|
194 | I $D(CONTAINS)>9 D Q DOES
|
---|
195 | . N SUB S SUB=""
|
---|
196 | . F S SUB=$O(CONTAINS(SUB)) Q:SUB="" S DOES=CODE[SUB Q:DOES
|
---|
197 | QUIT 0 ; end of CONTAINS
|
---|
198 | ;
|
---|
199 | ;
|
---|
200 | CODEROU(ROU,FOUND) ; subroutine: cross-reference results by code then routine
|
---|
201 | N NUM
|
---|
202 | N SUB S SUB="DSMROUTINES"
|
---|
203 | N CODE S CODE="" F D Q:CODE=""
|
---|
204 | . S CODE=$O(FOUND("DSM",CODE)) Q:CODE=""
|
---|
205 | . S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,ROU))+FOUND("DSM",CODE)
|
---|
206 | . S ^XTMP(SUB,"CODE ROU",CODE,ROU)=NUM
|
---|
207 | . ;
|
---|
208 | . S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,0))+FOUND("DSM",CODE)
|
---|
209 | . S ^XTMP(SUB,"CODE ROU",CODE,0)=NUM
|
---|
210 | Q
|
---|
211 | ;
|
---|
212 | ;
|
---|
213 | RESULTS(EXIT,COUNT,FOUND) ; subroutine: report results of search
|
---|
214 | ;
|
---|
215 | ; input:
|
---|
216 | ; COUNT = # of routines searched
|
---|
217 | ; FOUND = # of instances found
|
---|
218 | ; called by: ALL, RSE
|
---|
219 | ;
|
---|
220 | W !
|
---|
221 | I EXIT W !,"Search interrupted."
|
---|
222 | W !,COUNT," routine",$E("s",COUNT'=1)," searched."
|
---|
223 | W !,FOUND," instance",$E("s",FOUND'=1)," found."
|
---|
224 | QUIT ; end of RESULTS
|
---|
225 | ;
|
---|
226 | ;
|
---|
227 | ADDLINE(RIEN,LIEN,LINE) ; add a line to the Line WP field (2)
|
---|
228 | ;
|
---|
229 | ; Input:
|
---|
230 | ; LIEN = last line # in WP field
|
---|
231 | ; LINE = the line of text to append
|
---|
232 | ;
|
---|
233 | S LIEN=LIEN+1
|
---|
234 | S ^DIZ(663075,RIEN,1,LIEN,0)=LINE
|
---|
235 | QUIT ; end of ADDLINE
|
---|
236 | ;
|
---|