source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/ARJTDDKR.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1ARJTDDKR ;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 ;
27ALL(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 ;
56RSE(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 ;
87FEEDBACK(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 ;
105SEARCH(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 ;
187CONTAINS(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 ;
200CODEROU(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 ;
213RESULTS(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 ;
227ADDLINE(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 ;
Note: See TracBrowser for help on using the repository browser.