1 | TMGSRCH1 ;TMG/kst/Search API ; 6/4/10
|
---|
2 | ;;1.0;TMG-LIB;**1**;05/19/10
|
---|
3 | ;
|
---|
4 | ;"TMG FILEMAN SEARCH API
|
---|
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 | ;
|
---|
31 | FNPTR(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 | ;
|
---|
52 | PATHTO(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 | ;
|
---|
91 | GETFLD(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 | ;
|
---|
110 | FLDNUM(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)
|
---|
125 | FLDNDN QUIT +Y
|
---|
126 | ;
|
---|
127 | FIXCOMP(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."
|
---|
143 | FCDN QUIT RESULT
|
---|
144 | ;
|
---|
145 | FIXCOMB(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 | ;
|
---|
155 | STDDATE(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 | ;
|
---|
166 | GETAFSUB(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 | ;
|
---|
219 | GAFS0 SET TMGOUT(0)="1^Success"
|
---|
220 | GAFSDN MERGE ^TMG("TMP","RPC",1)=TMGOUT
|
---|
221 | QUIT
|
---|
222 | ;
|
---|
223 | SETUPLS(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 | ;
|
---|
244 | GETFLDSB(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 | ;
|
---|
326 | GFSB0 SET TMGOUT(0)="1^Success"
|
---|
327 | GFSBDN QUIT
|
---|
328 | ;
|
---|
329 | ADDINFO(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
|
---|