source: cprs/branches/tmg-cprs/m_files/TMGSRCH1.m@ 1742

Last change on this file since 1742 was 894, checked in by Kevin Toppenberg, 14 years ago

interval update

File size: 16.6 KB
RevLine 
[796]1TMGSRCH1 ;TMG/kst/Search API ; 6/4/10
2 ;;1.0;TMG-LIB;**1**;05/19/10
3 ;
[894]4 ;"UTILITIES FOR TMG FILEMAN SEARCH API
[796]5 ;
6 ;"Copyright Kevin Toppenberg MD 5/19/10
7 ;"Released under GNU General Public License (GPL)
8 ;"
9 ;"NOTE: this function depends on new version of LIST^DIC, from G. Timpson Patch
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;"FNPTR(FNUMPTR) -- Resolve a FNUMPTR, finding ultimate target file
14 ;"PATHTO(FROMFILE,TOFILE,COUNT) -- Find a 'path' of fields that gets from file A -->B
15 ;"FLDNUM(TMGFILE,TMGNAME) --Turn a field name into number, and change FILE to pointed-to-file
16 ;"=======================================================================
17 ;"PRIVATE API FUNCTIONS
18 ;"=======================================================================
19 ;"GETFLD(STR) -- Separate field name from comparator
20 ;"FIXCOMP(COMP,ERR) --Standardize value comparators, e.g. <> becomes '=
21 ;"FIXCOMB(COMB,ERR) --Standardize expression combiners, e.g. | becomes OR
22 ;"STDDATE(TMGDATE,ERR) --Standardized date, or report error
23 ;"=======================================================================
24 ;"=======================================================================
25 ;"Dependencies:
26 ;" ^DIC, TMGSTUTL, XLFSTR, %DT, XLFDT
27 ;"=======================================================================
28 ;"=======================================================================
29 ;
30 ;
31FNPTR(FNUMPTR) ;
32 ;"Puprose: To resolve a FNUMPTR, finding ultimate target file
33 ;"Input: FNUMPTR: Format: FNUM:FLDA[:FLDB[:FLDC...]] FNUM is filenumber that
34 ;" contain search field, and then fields used to point to *TARGET* FILENUM
35 ;"Results: -1^Error message if error, otherwise returns pointed to file
36 NEW RESULT,FILE,FLD,I,DONE
37 SET FILE=+$GET(FNUMPTR)
38 SET RESULT=0
39 SET DONE=0
40 FOR I=2:1:999 DO QUIT:(+RESULT=-1)!(DONE=1)
41 . SET FLD=$PIECE(FNUMPTR,":",I)
42 . IF FLD="" SET DONE=1 QUIT
43 . IF $DATA(^DD(FILE,FLD,0))=0 DO QUIT
44 . . SET RESULT="-1^Field ["_FLD_"] was not found in file ["_FILE_"]"
45 . NEW FLDTYPE SET FLDTYPE=$PIECE(^DD(+FILE,+FLD,0),"^",2)
46 . IF FLDTYPE'["P" DO QUIT
47 . . SET RESULT="-1^Field ["_FLD_"] does not point to another file."
48 . SET FILE=+$PIECE(FLDTYPE,"P",2)
49 SET RESULT=FILE
50 QUIT RESULT
51 ;
52PATHTO(FROMFILE,TOFILE,COUNT) ;
53 ;"Purpose: to find a "path" of fields that gets from file A -->B (if possible)
54 ;" E.g. From TIU DOCUMENT to PATIENT would yield ".01:.01", meaning
55 ;" that the .01 field of TIU DOCUMENT-->IHS PATIENT, and
56 ;" .01 field of IHS PATIEN-->PATIENT
57 ;"Input: FROMFILE -- The starting file number
58 ;" TOFILE -- The target file number
59 ;" COUNT -- used when calling self reiteratively. Leave blank on first call.
60 ;"Note: This fill only allow the length of the path to be 3 links long.
61 ;" Also, the search is stopped after the first link is found.
62 ;" NOTE: If the file link is changed to be longer than 3, then
63 ;" GETAFSUB() must also be changed
64 ;"Results: Returns field link, e.g. ".01;2;.01"
65 SET COUNT=+$GET(COUNT)
66 NEW RESULT SET RESULT=""
67 SET FROMFILE=+$GET(FROMFILE)
68 NEW FLD SET FLD=0
69 FOR SET FLD=$ORDER(^DD(FROMFILE,FLD)) QUIT:(+FLD'>0)!(RESULT'="") DO
70 . NEW INFO SET INFO=$PIECE($GET(^DD(FROMFILE,FLD,0)),"^",2)
71 . IF INFO'["P" QUIT
72 . NEW PT SET PT=+$PIECE(INFO,"P",2)
73 . IF PT=FROMFILE QUIT ;"ignore pointers to self
74 . IF PT=TOFILE SET RESULT=FROMFILE_":"_FLD_"->"_TOFILE QUIT
75 . IF COUNT>2 QUIT
76 . NEW TEMP SET TEMP=$$PATHTO(PT,TOFILE,COUNT+1)
77 . IF TEMP'="" SET RESULT=FROMFILE_":"_FLD_"->"_TEMP
78 IF COUNT=0 DO
79 . NEW TEMP,I
80 . SET TEMP=""
81 . FOR I=1:1:$LENGTH(RESULT,"->") DO
82 . . NEW PART SET PART=$PIECE(RESULT,"->",I)
83 . . NEW PART2 SET PART2=$PIECE(PART,":",2)
84 . . IF PART2="" QUIT
85 . . IF TEMP'="" SET TEMP=TEMP_":"
86 . . SET TEMP=TEMP_PART2
87 . SET RESULT=FROMFILE_":"_TEMP_"^"_RESULT
88 QUIT RESULT
89 ;
90 ;
91GETFLD(STR) ;
92 ;"Purpose: To separate field name from comparator
93 ;"Input: STR -- PASS BY REFERENCE -- the string to pull field from
94 ;"Results: returns extracted field.
95 NEW FLD
96 IF +STR>0 DO
97 . SET FLD=+STR
98 . SET STR=$PIECE(STR,FLD,2,999)
99 ELSE DO
100 . IF $EXTRACT(STR,1)="""" DO
101 . . SET FLD=$$MATCHXTR^TMGSTUTL(STR,"""",,,"""")
102 . . IF FLD'="" SET STR=$EXTRACT(STR,$LENGTH(FLD)+3,9999)
103 . ELSE DO
104 . . SET FLD=""
105 . . NEW P FOR P=1:1:$LENGTH(STR) QUIT:"'<>=[:{"[$EXTRACT(STR,P) DO
106 . . . SET FLD=FLD_$EXTRACT(STR,P)
107 . . IF FLD'="" SET STR=$EXTRACT(STR,$LENGTH(FLD)+1,9999)
108 QUIT FLD
109 ;
110FLDNUM(TMGFILE,TMGNAME) ;
111 ;"Purpose: To turn a field name into number, and change FILE to pointed-to-file
112 ;"Input: TMGFILE -- PASS BY REFERENCE. Input is current file. Output is new pointed-to-file
113 ;" TMGNAME -- PASS BY REFERENCE. The field name to look up. Name will be cleaned up.
114 NEW DIC,X,Y SET Y=0
115 IF TMGNAME="" SET TMGFILE=0 GOTO FLDNDN
116 SET DIC="^DD("_+TMGFILE_","
117 SET TMGNAME=$$TRIM^XLFSTR(TMGNAME,," ")
118 SET TMGNAME=$$TRIM^XLFSTR(TMGNAME,,"""")
119 SET X=TMGNAME
120 DO ^DIC
121 IF +Y'>0 GOTO FLDNDN
122 NEW INFO SET INFO=$PIECE($GET(^DD(+TMGFILE,+Y,0)),"^",2)
123 IF INFO'["P" SET TMGFILE=0 GOTO FLDNDN
124 SET TMGFILE=+$PIECE(INFO,"P",2)
125FLDNDN QUIT +Y
126 ;
127FIXCOMP(COMP,ERR) ;
128 ;"Purpose: to standardize value comparators, e.g. <> becomes '=
129 NEW RESULT SET RESULT=""
130 IF COMP="=" SET RESULT=COMP GOTO FCDN
131 NEW COMPSAV SET COMPSAV=COMP
132 SET COMP=$$UP^XLFSTR(COMP)
133 IF (COMP="<>") SET COMP="'="
134 ELSE IF (COMP=">=") SET COMP="'<"
135 ELSE IF (COMP="<=") SET COMP="'>"
136 ELSE IF (COMP="{") SET COMP="IN"
137 NEW NOT
138 SET NOT=$EXTRACT(COMP,1) IF NOT="'" SET COMP=$EXTRACT(COMP,2,999)
139 ELSE SET NOT=""
140 IF (COMP="=")!(COMP="[")!(COMP="IN")!(COMP="<")!(COMP=">") DO
141 . SET RESULT=NOT_COMP
142 ELSE SET ERR="-1^'"_COMPSAV_"' is not a valid comparator."
143FCDN QUIT RESULT
144 ;
145FIXCOMB(COMB,ERR) ;
146 ;"Purpose: to standardize expression combiners, e.g. | becomes OR
147 NEW COMBSAV SET COMBSAV=COMB
148 IF (COMB="|")!(COMB="||")!(COMB="!") SET COMB="OR"
149 ELSE IF (COMB="&")!(COMB="&&") SET COMB="AND"
150 ELSE IF (COMB="'")!(COMB="ANDNOT") SET COMB="NOT"
151 IF (COMB'="AND")&(COMB'="OR")&(COMB'="NOT") SET COMB=""
152 IF COMB="" SET ERR="-1^'"_COMBSAV_"' is not a valid set combiner."
153 QUIT COMB
154 ;
155STDDATE(TMGDATE,ERR) ;
156 ;"Purpose: return a standardized date, or report error
157 NEW X,Y,%DT
158 NEW RESULT SET RESULT=""
159 SET %DT="T"
160 SET X=TMGDATE
161 DO ^%DT
162 IF Y=-1 SET ERR="-1^Invalid date: ["_X_"]"
163 ELSE SET RESULT=$$FMTE^XLFDT(Y,5)
164 QUIT RESULT
165 ;
166GETAFSUB(TMGOUT,TMGPARAMS) ;"GET ALLOW FILES SUBSET
167 ;"Purpose: For a given file to be searched, return sublist of allowed
168 ;" related files which can be used as search terms. NOTE: only
169 ;" files that point back to the original search file are allowed.
170 ;" NOTE: This function will return not only files that point
171 ;" directly back to search file, but also files that point to
172 ;" other files that point to search file. In fact, there can
173 ;" be a distance of 3 files between returned file and search file.
174 ;" If this allowed distance of 3 files is changed, then PATHTO()
175 ;" must also be changed.
176 ;" NOTE: Subfiles not currently supported
177 ;"Input: TMGPARAMS -- FileNum^ListStartValue^direction^MaxCount(optional, def=44)^Simple
178 ;" FileNum -- this is the search file, results must point back to this
179 ;" ListStartValue -- OPTIONAL -- text to $ORDER() from
180 ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
181 ;" MaxCount -- OPTIONAL. Default is 44 values returned.
182 ;" Simple -- OPTIONAL Default is 0 (false). If 1, then
183 ;" a very limited list of files returned, with
184 ;" more user-friendly pseudo names
185 ;"Output: TMGRESULTS is filled as follows.
186 ;" TMGRESULT(0)="1^Success" or "-1^Message"
187 ;" TMGRESULT(1)=IEN^FileName
188 ;" TMGRESULT(2)=IEN^FileName
189 ;"NOTE: Any files that don't have data are excluded.
190 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
191 IF TMGFILE'>0 DO GOTO GAFSDN
192 . SET TMGOUT(0)="-1^No file number supplied"
193 NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
194 NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
195 IF TMGDIR'=-1 SET TMGDIR=1
196 NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
197 IF TMGMAXCT=0 SET TMGMAXCT=44
198 NEW TMGSIMPLE SET TMGSIMPLE=+$PIECE(TMGPARAMS,"^",5)
199 ;
200 IF (TMGFILE=2),(TMGSIMPLE=1) DO GOTO GAFS0
201 . SET TMGOUT(1)="2^1. PATIENT INFO"
202 . SET TMGOUT(2)="8925^2. NOTES"
203 . SET TMGOUT(3)="120.5^3. VITALS"
204 . SET TMGOUT(4)="9000010^4. VISIT"
205 . SET TMGOUT(5)="9000010.18^5. LINKED CPT CODE"
206 ;
207 NEW TMGREF SET TMGREF=$NAME(^TMP("TMG","TMGSRCH",$J,"ALLOWED FILES",TMGFILE))
208 IF $DATA(@TMGREF)=0 DO
209 . DO SETUPLS(TMGREF,TMGFILE)
210 NEW TMGSTARTIEN SET TMGSTARTIEN=""
211 NEW TMGI SET TMGI=0
212 FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
213 . NEW TMGIEN SET TMGIEN=TMGSTARTIEN
214 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0)!(TMGI'<TMGMAXCT) DO
215 . . SET TMGI=TMGI+1
216 . . ;"SET TMGOUT(TMGI)=TMGIEN_"^"_TMGFROM_"^"_$GET(@TMGREF@("B",TMGFROM,TMGIEN))
217 . . SET TMGOUT(TMGI)=TMGIEN_"^"_TMGFROM
218 ;
219GAFS0 SET TMGOUT(0)="1^Success"
220GAFSDN MERGE ^TMG("TMP","RPC",1)=TMGOUT
221 QUIT
222 ;
223SETUPLS(POUT,FILENUM,CT) ;
224 ;"Purpose: to return a list of pointers in to file
225 ;"Input: POUT -- PASS BY NAME, An OUT PARAMETER
226 ;" FILE -- The file for which pointers IN should be added.
227 ;" CT -- This is used when passing self reiteratively. Leave blank first time.
228 ;"NOTE: Any files that don't have data are excluded.
229 SET CT=$GET(CT,1)
230 NEW NAME
231 SET NAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
232 IF NAME'="",$DATA(@POUT@("B",NAME,FILENUM))=0 DO
233 . SET @POUT@("B",NAME,FILENUM)=""
234 NEW AFILE SET AFILE=0
235 FOR SET AFILE=$ORDER(^DD(FILENUM,0,"PT",AFILE)) QUIT:(+AFILE'>0) DO
236 . SET NAME=$PIECE($GET(^DIC(AFILE,0)),"^",1) QUIT:NAME=""
237 . SET GL=$GET(^DIC(AFILE,0,"GL")) QUIT:(GL="")
238 . SET GL=GL_"0)" NEW INFO SET INFO=$GET(@GL)
239 . NEW NUMRECS SET NUMRECS=+$PIECE(INFO,"^",4) QUIT:NUMRECS'>0
240 . SET @POUT@("B",NAME,AFILE)=""
241 . IF CT<3 DO SETUPLS(POUT,AFILE,CT+1)
242 QUIT
243 ;
244GETFLDSB(TMGOUT,TMGPARAMS) ;
245 ;"Purpose: Get FIELD list subset, for file
246 ;"Input: TMGPARAMS -- FileNum^ListStartValue^direction^MaxCount(optional, def=44)^Simple
247 ;" FileNum -- this is the file to get fields in
248 ;" ListStartValue -- OPTIONAL -- text to $ORDER() from
249 ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
250 ;" MaxCount -- OPTIONAL. Default is 44 values returned.
251 ;" Simple -- OPTIONAL Default is 0 (false). If 1, then
252 ;" a very limited list of files returned, with
253 ;" more user-friendly pseudo names
254 ;"Output: TMGRESULTS is filled as follows.
255 ;" TMGRESULT(0)="1^Success" or "-1^Message"
256 ;" TMGRESULT(1)=FldNum^Name^InfoNodes2-4
257 ;" TMGRESULT(2)=FldNum^Name^InfoNodes2-4
258 ;"NOTE: Any files that don't have data are excluded. Subfiles also excluded
259 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
260 IF TMGFILE'>0 DO GOTO GFSBDN
261 . SET TMGOUT(0)="-1^No file number supplied"
262 NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
263 NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
264 IF TMGDIR'=-1 SET TMGDIR=1
265 NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
266 IF TMGMAXCT=0 SET TMGMAXCT=44
267 NEW TMGSIMPLE SET TMGSIMPLE=+$PIECE(TMGPARAMS,"^",5)
268 ;
269 NEW TMGI SET TMGI=0
270 NEW HANDLED SET HANDLED=0
271 IF TMGSIMPLE DO
272 . IF TMGFILE=2 DO ;"2^PATIENT INFO"
273 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^NAME"
274 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".02^SEX"
275 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^DATE OF BIRTH"
276 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".033^AGE"
277 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^MARITAL STATUS"
278 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^OCCUPATION"
279 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".09^SOCIAL SECURITY NUMBER"
280 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".114^CITY"
281 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".115^STATE"
282 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".116^ZIP CODE"
283 . . SET HANDLED=1
284 . IF TMGFILE=8925 DO ;"8925^NOTES"
285 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^TYPE OF NOTE"
286 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^STATUS"
287 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^BEGINNING DATE"
288 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".08^ENDING DATE"
289 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="2^NOTE TEXT"
290 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1201^CREATION DATE"
291 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1202^AUTHOR/DICTATOR"
292 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1204^EXPECTED SIGNER"
293 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1211^VISIT LOCATION"
294 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1502^SIGNED BY"
295 . . SET HANDLED=1
296 . IF TMGFILE=120.5 DO ;"120.5^VITALS"
297 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^DATE/TIME TAKEN"
298 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^VITAL TYPE"
299 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^LOCATION"
300 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1.2^VALUE"
301 . . SET HANDLED=1
302 . IF TMGFILE=9000010 DO ;"9000010^VISIT"
303 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^DATE/TIME"
304 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^TYPE"
305 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".22^LOCATION"
306 . . SET HANDLED=1
307 . IF TMGFILE=9000010.18 DO ;"9000010.18^LINKED CPT CODE"
308 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^CPT NAME"
309 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".04^PROVIDER NARRATIVE"
310 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^DIAGNOSIS"
311 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^PRINCIPLE PROCEDURE"
312 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1204^ENCOUNTER PROVIDER"
313 . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="80201^CATEGORY"
314 . . SET HANDLED=1
315 IF HANDLED DO ADDINFO(TMGFILE,.TMGOUT) GOTO GFSB0
316 ;
317 NEW TMGREF SET TMGREF=$NAME(^DD(TMGFILE))
318 FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
319 . NEW TMGFLD SET TMGFLD=""
320 . FOR SET TMGFLD=$ORDER(@TMGREF@("B",TMGFROM,TMGFLD),TMGDIR) QUIT:(+TMGFLD'>0)!(TMGI'<TMGMAXCT) DO
321 . . NEW INFO SET INFO=$PIECE($GET(^DD(TMGFILE,TMGFLD,0)),"^",2,4)
322 . . IF +INFO>0,($$ISWPFLD^TMGDBAPI(TMGFILE,TMGFLD)=0) QUIT ;"Don't return subfile fields (for now)
323 . . SET TMGI=TMGI+1
324 . . SET TMGOUT(TMGI)=TMGFLD_"^"_TMGFROM_"^"_INFO
325 ;
326GFSB0 SET TMGOUT(0)="1^Success"
327GFSBDN QUIT
328 ;
329ADDINFO(TMGFILE,TMGOUT);
330 ;"Purpose: To add INFO to field entries, as created in GETFLDSB
331 NEW I SET I=0
332 FOR SET I=$ORDER(TMGOUT(I)) QUIT:(+I'>0) DO
333 . NEW ENTRY SET ENTRY=$GET(TMGOUT(I)) QUIT:(ENTRY="")
334 . NEW TMGFLD SET TMGFLD=+ENTRY
335 . NEW INFO SET INFO=$PIECE($GET(^DD(TMGFILE,TMGFLD,0)),"^",2,4)
336 . SET TMGOUT(I)=ENTRY_"^"_INFO
337 QUIT
Note: See TracBrowser for help on using the repository browser.