source: cprs/branches/tmg-cprs/m_files/TMGSRCH2.m

Last change on this file was 895, checked in by Kevin Toppenberg, 14 years ago

fixing soft links
File size: 14.2 KB
Line 
1TMGSRCH2 ;TMG/kst/Search API ; 6/19/10
2 ;;1.0;TMG-LIB;**1**;06/19/10
3 ;
4 ;"TMG Search only in TIU documents for 1 patient
5 ;
6 ;"Copyright Kevin Toppenberg MD 6/19/10
7 ;"Released under GNU General Public License (GPL)
8 ;"
9 ;"=======================================================================
10 ;" RPC -- Public Functions.
11 ;"=======================================================================
12 ;"LAUNCHSR(DFN,TMGSRCH) --Launch background task to achieve search
13 ;"STATUS() -- Get status of background searching task
14 ;"RESULTS(OUT) -- get result from background search
15 ;"CLEAR -- Tell background task to stop, and clear data array
16 ;"STOP --Tell background task to stop searching
17 ;"=======================================================================
18 ;"PRIVATE API FUNCTIONS
19 ;"=======================================================================
20 ;"CHANGESRCH(BKJOB,DFN,TMGSRCH) -- tell background task to change search parameters
21 ;"MSG(BKJOB,MSG) -- Purpose to message background task
22 ;"SRCHTIU(DFN,TMGSRCH,PARENTJOB) -- search all of one patient's documents for requested words
23 ;"PREPSRCH(PARENTJOB,DFN,TMGSRCH,WORDS,IENLIST) -- Parse search phrase, user prior runs if possible.
24 ;"PARSSRCH(TMGSRCH,WORDS) -- Separate search phrase out into array of words
25 ;"SRCH1TIU(PARENTJOB,IEN,TERM) -- Search TIU DOCUMENT report text for TERM
26 ;"=======================================================================
27 ;"=======================================================================
28 ;"Dependencies:
29 ;"=======================================================================
30 ;"=======================================================================
31 ;
32LAUNCHSR(DFN,TMGSRCH) ;
33 ;"Purpose: Launch background task to achieve search
34 ;"Input: DFN -- The patient IEN to look up.
35 ;" TMGSRCH -- Search string. Notes:
36 ;" Each word (or partial word) to look up is separated by spaces
37 ;" All words are combined in AND fashion
38 ;" Search is NOT case sensitive.
39 ;" Exact pharases can be specified by quotes.
40 ;" Example: 'dog cat monkey "in a barrel"
41 NEW THISJOB SET THISJOB=$J
42 NEW STATUS SET STATUS=$GET(^TMG("TMP","SEARCH","SRCHTIU",THISJOB,"MSG"))
43 IF STATUS="BKGND RUNNING" DO
44 . DO CHANGESRCH(DFN,TMGSRCH)
45 ELSE DO
46 . NEW DEBUG SET DEBUG=0
47 . IF DEBUG=0 DO ;"Can be changed when stepping through code.
48 . . KILL ^TMG("TMP","SEARCH","SRCHTIU",THISJOB)
49 . . JOB SRCHTIU(DFN,TMGSRCH,THISJOB)
50 . . SET ^TMG("TMP","SEARCH","SRCHTIU",THISJOB,"BACKGROUND")=$ZJOB
51 . ELSE DO
52 . . DO SRCHTIU(DFN,TMGSRCH,THISJOB)
53 QUIT
54 ;
55 ;
56STATUS() ;
57 ;"Purpose: To check status of background searching task
58 ;"Input: none
59 ;"Output: returns 1^status string, or "1^" if none
60 NEW RESULT
61 SET RESULT=$GET(^TMG("TMP","SEARCH","SRCHTIU",$J,"MSG"))
62 IF +$PIECE(RESULT,"^",1)'=$PIECE(RESULT,"^",1) SET RESULT="1^"_RESULT
63STATDN QUIT RESULT
64 ;
65 ;
66RESULTS(OUT) ;
67 ;"Purpose: To get result from background search
68 ;"Input: OUT -- PASS BY REFERENCE. An OUT PARAMETER. Format
69 ;" OUT(0)=FoundCount^Success, or -1^Message
70 ;" OUT(1)=IEN1
71 ;" OUT(2)=IEN2 ... etc.
72 NEW STATUS SET STATUS=$$STATUS()
73 IF +STATUS=-1 SET OUT(0)=STATUS GOTO RSLTDN
74 ;"IF STATUS'="DONE" SET OUT(0)="-1^Search not completed"
75 NEW IENLIST MERGE IENLIST=^TMG("TMP","SEARCH","SRCHTIU",$J,"IEN LIST")
76 NEW CT SET CT=0
77 NEW IEN SET IEN=0
78 FOR SET IEN=$ORDER(IENLIST(IEN)) QUIT:(+IEN'>0) DO
79 . SET CT=CT+1
80 . SET OUT(CT)=IEN
81 IF $DATA(OUT)=0 SET OUT(0)="-1^No results found"
82 ELSE SET OUT(0)=(CT-1)_"^Success"
83RSLTDN QUIT
84 ;
85 ;
86CLEAR ;"Purpose: Tell background task to stop, and clear data array
87 DO STOP
88 KILL ^TMG("TMP","SEARCH","SRCHTIU",$J)
89 QUIT
90 ;
91 ;
92STOP ;"Purpose: Tell background task to stop searching
93 DO MSG("STOP")
94 QUIT
95 ;
96 ;
97CHANGESRCH(DFN,TMGSRCH) ;
98 ;"Purpose: to tell background task to change search parameters
99 DO MSG("RESTART^"_DFN_"^"_TMGSRCH)
100 QUIT
101 ;
102 ;
103MSG(MSG) ;
104 ;"Purpose to message background task
105 SET ^TMG("TMP","SEARCH","SRCHTIU",$J,"MSG")=MSG
106 QUIT
107 ;
108 ;
109 ;"==========================================================================
110SRCHTIU(DFN,TMGSRCH,PARENTJOB) ;
111 ;"Purpose: To search all of one patient's documents for requested words
112 ;"Input: DFN -- The patient IEN to look up.
113 ;" TMGSRCH -- Search string. Notes:
114 ;" Each word (or partial word) to look up is separated by spaces
115 ;" All words are combined in AND fashion
116 ;" Search is NOT case sensitive.
117 ;" Exact pharases can be specified by quotes.
118 ;" Example: 'dog cat monkey "in a barrel"
119 ;" PARENTJOB -- the job of the RPCBroker task that called this.
120 ;"NOTE: this routine will monitor global for messages:
121 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"MSG")=message
122 ;" If message of "STOP" is found, then search will be stopped.
123 ;"Output: Matching documents will be stored at:
124 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"IEN LIST",IEN)=""
125 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"IEN LIST",IEN)=""
126 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"DFN")=DFN
127 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"FILTER",FilterValue)=""
128 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"FILTER",FilterValue)=""
129 ;" When search is done, then message will be stored as
130 ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"MSG")="DONE"
131 ;"Results: none
132 ;"NOTE: This function is designed so that it can do searching on the fly,
133 ;" as the user is typing in additional terms. Thus, if a prior
134 ;" search is found, and the prior search doesn't contain any terms
135 ;" that are not in the current search, then this search cycle will
136 ;" start with the results of the prior search.
137 ;" --A consequence of this is that a search of all the documents
138 ;" will be done first for search term #1, and then term #2, RATHER
139 ;" THAN searching 1 document for all the search terms. This should
140 ;" not cause too much of a performace hit because searches for other
141 ;" terms will be limited to matches for earlier terms
142 ;
143 NEW ABORT,IEN,IENLIST
144 NEW DEBUGI SET DEBUGI=0
145 SET DFN=+$GET(DFN)
146 SET TMGSRCH=$GET(TMGSRCH)
147 NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB))
148L1 SET @REF@("MSG")="BKGND RUNNING"
149 DO PREPSRCH(PARENTJOB,DFN,TMGSRCH,.WORDS,.IENLIST)
150 SET ABORT=0
151 NEW TERMCT,TERM
152 FOR TERMCT=1:1 SET TERM=$GET(WORDS(TERMCT)) QUIT:(TERM="")!ABORT DO
153 . ;"SET @REF@("DEBUG",DEBUGI)="TERM="_TERM,DEBUGI=DEBUGI+1
154 . KILL @REF@("IEN LIST") ;"List will get progressively smaller. So kill and reset each cycle.
155 . ;"SET @REF@("DEBUG",DEBUGI)="@REF@('IENLIST') killed",DEBUGI=DEBUGI+1
156 . SET IEN=0
157 . FOR SET IEN=$ORDER(IENLIST(IEN)) QUIT:(+IEN'>0)!(ABORT) DO
158 . . ;"SET @REF@("DEBUG",DEBUGI)="IEN="_IEN,DEBUGI=DEBUGI+1
159 . . NEW MSG SET MSG=@REF@("MSG")
160 . . IF MSG="STOP" SET ABORT=1 QUIT
161 . . IF MSG="RESTART" SET ABORT=2 QUIT
162 . . NEW SRCHRSLT SET SRCHRSLT=$$SRCH1TIU(PARENTJOB,IEN,TERM)
163 . . ;"SET @REF@("DEBUG",DEBUGI)="Search 1 result="_SRCHRSLT,DEBUGI=DEBUGI+1
164 . . IF SRCHRSLT=0 KILL IENLIST(IEN)
165 . . ELSE IF (SRCHRSLT<0) SET ABORT=-SRCHRSLT
166 . . ;"SET @REF@("DEBUG",DEBUGI)="IENList count="_$$ListCt^TMGMISC("IENLIST"),DEBUGI=DEBUGI+1
167 . IF ABORT=0 DO
168 . . ;"SET @REF@("DEBUG",DEBUGI)="ABOUT TO MERGE00IENList count="_$$ListCt^TMGMISC("IENLIST"),DEBUGI=DEBUGI+1
169 . . ;"SET @REF@("DEBUG",DEBUGI)="merging",DEBUGI=DEBUGI+1
170 . . MERGE @REF@("IEN LIST")=IENLIST
171 . . ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1
172 . . ;"SET @REF@("DEBUG",DEBUGI)="REF="_REF,DEBUGI=DEBUGI+1
173 . . SET @REF@("FILTER",TERM)=""
174 ;"SET @REF@("DEBUG",DEBUGI)="ABORT="_ABORT,DEBUGI=DEBUGI+1
175 IF ABORT=2 GOTO L1 ;"Restart
176 ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1
177 SET @REF@("MSG")="DONE"
178 KILL @REF@("BACKGROUND")
179 ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1
180 QUIT ;"This will cause thie JOB'd task to exit and stop execution
181 ;
182 ;
183PREPSRCH(PARENTJOB,DFN,TMGSRCH,WORDS,IENLIST) ;
184 ;"Purpose: To Parse the search phrase, and look for prior runs, and use
185 ;" that work if possible.
186 ;"Input: PARENTJOB -- the job of the RPCBroker task that called this.
187 ;" DFN -- The patient IEN to look up.
188 ;" TMGSRCH -- The Search Phrase. See docs in SRCHTIU
189 ;" e.g: 'dog cat monkey "in a barrel"
190 ;" WORDS -- PASS BY REFERENCE. An OUT PARAMETER. Format:
191 ;" WORDS(WordOrPhrase)=""
192 ;" e.g. WORDS(1)="DOG"
193 ;" WORDS(2)="CAT"
194 ;" WORDS(3)="MONKEY"
195 ;" WORDS(4)="IN A BARREL"
196 ;" Note: If prior run is being built upon, then entries that
197 ;" have already been searched for will be removed.
198 ;"Results: none
199 DO PARSSRCH(TMGSRCH,.WORDS)
200 NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB))
201 KILL IENLIST
202 NEW NEWSRCH SET NEWSRCH=0 ;"Boolean for need to start over a new search
203 IF $GET(@REF@("DFN"))'=DFN SET NEWSRCH=1 GOTO NS
204 ;"Look through all prior filters and see if any filters applied that
205 ;" are not in current search
206 NEW FILTERS,CT
207 FOR CT=1:1 QUIT:$DATA(WORDS(CT))=0 SET FILTERS($GET(WORDS(CT)))=1
208 NEW OLDFILTER MERGE OLDFILTER=@REF@("FILTER")
209 NEW OFLTR SET OFLTR=""
210 FOR SET OFLTR=$ORDER(OLDFILTER(OFLTR)) QUIT:(OFLTR="")!NEWSRCH DO
211 . IF $GET(FILTERS(OFLTR))=1 KILL FILTERS(OFLTR) QUIT ;"filter term used before, so delete from use again
212 . ;"Now check if new filters contain a longer verson of old term. I.e. prior
213 . ;" filter term was 'kitt' and now it is 'kitten'
214 . NEW FOUND SET FOUND=0
215 . NEW F SET F=""
216 . FOR SET F=$ORDER(FILTERS(F)) QUIT:(F="")!FOUND DO
217 . . IF $EXTRACT(F,1,$LENGTH(OFLTR))'=OFLTR QUIT
218 . . SET FOUND=1
219 . . KILL @REF@("FILTER",OFLTR) ;"Remove old partial term from history
220 . IF FOUND=0 SET NEWSRCH=1 ;"A filter was put on old set that is not in new set, so start over
221NS IF NEWSRCH=1 DO
222 . MERGE IENLIST=^TIU(8925,"C",DFN)
223 . KILL @REF@("IEN LIST")
224 . KILL @REF@("FILTER")
225 ELSE DO
226 . MERGE IENLIST=^TMG("TMP","SEARCH","SRCHTIU",$J,"IEN LIST")
227 . ;"Recreate WORDS array as numbered list with just desired entries
228 . SET CT=0 FOR SET CT=$ORDER(WORDS(CT)) QUIT:(CT="") DO
229 . . IF $DATA(FILTERS(WORDS(CT)))=0 KILL WORDS(CT) ;"Kill all entries in WORDS not in FILTERS
230 . NEW I SET I=1
231 . NEW TEMP
232 . SET CT=0 FOR SET CT=$ORDER(WORDS(CT)) QUIT:(CT="") DO
233 . . SET TEMP(I)=$GET(WORDS(CT)),I=I+1
234 . KILL WORDS MERGE WORDS=TEMP
235 SET @REF@("DFN")=DFN
236 QUIT
237 ;
238 ;
239PARSSRCH(TMGSRCH,WORDS) ;
240 ;"Purpose: Separate search phrase out into array of words
241 ;"Input: TMGSRCH -- The Search Phrase. See docs in SRCHTIU
242 ;" e.g: 'dog cat monkey "in a barrel"
243 ;" WORDS -- PASS BY REFERENCE. An OUT PARAMETER. Format:
244 ;" WORDS(WordOrPhrase)=""
245 ;" e.g. WORDS(1)="DOG"
246 ;" WORDS(2)="CAT"
247 ;" WORDS(3)="MONKEY"
248 ;" WORDS(4)="IN A BARREL"
249 ;"Results: none
250 KILL WORDS
251 SET TMGSRCH=$GET(TMGSRCH)
252 NEW CT SET CT=0
253 NEW ENTRY,POS
254 FOR QUIT:(TMGSRCH="") DO
255 . SET TMGSRCH=$$TRIM^XLFSTR(TMGSRCH)
256 . IF $EXTRACT(TMGSRCH,1)="""" DO
257 . . SET ENTRY=$$GetWord^TMGSTUTL(TMGSRCH,2,"""","""")
258 . . IF ENTRY'="" DO
259 . . . SET CT=CT+1
260 . . . SET WORDS(CT)=$$UP^XLFSTR(ENTRY)
261 . . SET ENTRY=""""_ENTRY
262 . . IF $FIND(TMGSRCH,ENTRY_"""")>0 SET ENTRY=ENTRY_""""
263 . . NEW SPEC
264 . . SET SPEC(ENTRY)=""
265 . . SET SPEC(" ")=" "
266 . . SET TMGSRCH=$$REPLACE^XLFSTR(TMGSRCH,.SPEC)
267 . SET ENTRY=$PIECE(TMGSRCH," ",1)
268 . SET $PIECE(TMGSRCH," ",1)=""
269 . IF ENTRY'="" DO
270 . . SET CT=CT+1
271 . . SET WORDS(CT)=$$UP^XLFSTR(ENTRY)
272 QUIT
273 ;
274 ;
275SRCH1TIU(PARENTJOB,IEN,TERM) ;
276 ;"Purpose: Search TIU DOCUMENT report text for TERM
277 ;"Input: IEN -- IEN in 8925
278 ;" TERM -- a word, or phrase, to search for in report text
279 ;"NOTE: Not case sensitive
280 ;"Result: 1 if found, 0 if not found, -1 if Abort signal found, -2 if RESTART signal
281 NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB))
282 NEW FOUND SET FOUND=0 ;"default to not found
283 NEW LINE SET LINE=0
284 NEW CT SET CT=0
285 NEW ABORT SET ABORT=0
286 FOR SET LINE=$ORDER(^TIU(8925,IEN,"TEXT",LINE)) QUIT:(+LINE'>0)!FOUND!ABORT DO
287 . SET CT=CT+1
288 . IF CT#5=0 DO QUIT:ABORT ;"Check messages every 5 lines or so
289 . . SET CT=0
290 . . NEW MSG SET MSG=@REF@("MSG")
291 . . IF MSG="STOP" SET ABORT=1 QUIT
292 . . IF MSG="RESTART" SET ABORT=2 QUIT
293 . NEW ONELINE SET ONELINE=$$UP^XLFSTR($GET(^TIU(8925,IEN,"TEXT",LINE,0)))
294 . IF ONELINE[TERM SET FOUND=1
295 IF ABORT SET FOUND=-ABORT
296 QUIT FOUND
297 ;
Note: See TracBrowser for help on using the repository browser.