source: smart/trunk/p/C0SNHIN.m@ 1571

Last change on this file since 1571 was 1571, checked in by George Lilly, 12 years ago

fix for lab units not found and C0STBL analysis routines
File size: 10.2 KB
Line 
1C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05
2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
3 ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
22 ;
23 K GARY,GNARY,GIDX,C0SDOCID
24 K ZRTN
25 N GN
26 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
27 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
28 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
29 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
30 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
31 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
32 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
33 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
34 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
35 Q
36 ;
37PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
38 ;
39 N ZG
40 S ZG=$NA(^TMP("PQRIXML",$J))
41 K @ZG
42 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
43 N C0SDOCID
44 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
45 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
46 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
47 Q
48 ;
49PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
50 ;
51 ;N GG
52 D GETXML^C0SMXP("GG","PQRI ONE MEASURE")
53 D PROCESS(ZRTN,"GG","root",1)
54 Q
55 ;
56PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
57 ; ZRTN IS PASSED BY REFERENCE
58 ; ZXML IS PASSED BY NAME
59 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
60 ;
61 N GN
62 S GN=$NA(^TMP("C0SPROCESS",$J))
63 K @GN
64 M @GN=@ZXML
65 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
66 K @GN
67 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
68 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
69 Q
70 ;
71LOADSMRT ;
72 ;
73 K ^GPL("SMART")
74 S GN=$NA(^GPL("SMART",1))
75 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
76 Q
77 ;
78SMART ; TRY IT WITH SMART
79 ;
80 S GN=$NA(^GPL("SMART"))
81 ;K ^TMP("MXMLDOM",$J)
82 K ^TMP("MXMLERR",$J)
83 S C0SDOCID=$$PARSE(GN,"SMART")
84 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
85 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
86 Q
87 ;
88CCR ; TRY IT WITH A CCR
89 ;
90 S GN=$NA(^GPL("CCR"))
91 ;K ^TMP("MXMLDOM",$J)
92 K ^TMP("MXMLERR",$J)
93 S C0SDOCID=$$PARSE(GN,"CCR")
94 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
95 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
96 Q
97 ;
98MED ; TRY IT WITH A CCR MED SECTION
99 ;
100 S GN=$NA(^GPL("MED"))
101 K ^TMP("MXMLDOM",$J)
102 K ^TMP("MXMLERR",$J)
103 S C0SDOCID=$$PARSE(GN,"MED")
104 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
105 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
106 Q
107 ;
108CCD ; TRY IT WITH A CCD
109 ;
110 S GN=$NA(^GPL("CCD"))
111 ;K ^TMP("MXMLDOM",$J)
112 K ^TMP("MXMLERR",$J)
113 S C0SDOCID=$$PARSE(GN,"CCD")
114 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
115 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
116 Q
117 ;
118TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
119 ; PARSED WITH MXML
120 ; RUN THROUGH XPATH
121 K GARY,GIDX,C0SDOCID
122 S GN=$NA(^GPL("NHIN"))
123 ;S GN=$NA(^GPL("DOMI"))
124 S C0SDOCID=$$PARSE(GN,"GPLTEST")
125 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
126 K ^GPL("GNARY")
127 M ^GPL("GNARY")=GNARY
128 Q
129 ;
130TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
131 ;
132 S GN=$NA(^GPL("GNARY"))
133 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")
134 D OUTXML^C0SDOM("G",C0SDOCID)
135 K ^GPL("DOMI")
136 M ^GPL("DOMI")=G
137 Q
138 ;
139TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
140 ; PARSED WITH MXML
141 ; RUN THROUGH XPATH
142 K GARY,GIDX,C0SDOCID
143 ;S GN=$NA(^GPL("NHIN"))
144 S GN=$NA(^GPL("DOMI"))
145 S C0SDOCID=$$PARSE(GN,"GPLTEST")
146 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
147 Q
148 ;
149DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
150 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
151 ; THE XPATH ARRAY XPARY, PASSED BY NAME
152 ; ZOID IS THE STARTING OID
153 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
154 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
155 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
156 I $G(ZREDUX)="" S ZREDUX=""
157 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
158 N NEWNUM S NEWNUM=""
159 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
160 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
161 I $G(ZREDUX)'="" D ; REDUX PROVIDED?
162 . N GT S GT=$P(NEWPATH,ZREDUX,2)
163 . I GT'="" S NEWPATH=GT
164 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
165 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
166 I $D(GA) D ; PROCESS THE ATTRIBUTES
167 . N ZI S ZI=""
168 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
169 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
170 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
171 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
172 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
173 I $D(GD(2)) D ;
174 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
175 E I $D(GD(1)) D ;
176 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
177 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
178 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
179 I ZFRST'=0 D ; THERE IS A CHILD
180 . N ZNUM
181 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
182 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
183 N GNXT S GNXT=$$NXTSIB(ZOID)
184 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
185 I GNXT'=0 D ;
186 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
187 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
188 . . N ZNUM S ZNUM=1 ;
189 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
190 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
191 Q
192 ;
193ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
194 ;
195 N ZZI,ZZJ,ZZN
196 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
197 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
198 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
199 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
200 I ZZI'["]" D ; A SINGLETON
201 . S ZZN=1
202 E D ; THERE IS AN [x] OCCURANCE
203 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
204 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
205 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
206 Q
207 ;
208PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
209 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
210 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
211 ;Q $$EN^MXMLDOM(INXML)
212 Q $$EN^MXMLDOM(INXML,"W")
213 ;
214ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
215 N ZN
216 ;I $$TAG(ZOID)["entry" B
217 S ZN=$$NXTSIB(ZOID)
218 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
219 Q 0
220 ;
221FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
222 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
223 ;
224PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
225 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
226 ;
227ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
228 S HANDLE=C0SDOCID
229 K @RTN
230 D GETTXT^MXMLDOM("A")
231 Q
232 ;
233TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
234 ;I ZOID=149 B ;GPLTEST
235 N X,Y
236 S Y=""
237 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
238 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
239 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
240 Q Y
241 ;
242NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
243 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
244 ;
245DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
246 ;N ZT,ZN S ZT=""
247 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
248 ;Q $G(@C0SDOM@(ZOID,"T",1))
249 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
250 Q
251 ;
252OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
253 ;
254 S C0SDOCID=INID
255 D START^C0SMXMLB($$TAG(1),,"G")
256 D NDOUT($$FIRST(1))
257 D END^C0SMXMLB ;END THE DOCUMENT
258 M @ZRTN=^TMP("MXMLBLD",$J)
259 K ^TMP("MXMLBLD",$J)
260 Q
261 ;
262NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
263 N ZI S ZI=$$FIRST(ZOID)
264 I ZI'=0 D ; THERE IS A CHILD
265 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
266 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
267 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
268 . ;W "DOING",ZOID,!
269 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
270 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
271 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
272 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
273 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
274 Q
275 ;
276WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
277 ;
278 N GN,GN2
279 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
280 S GN2=$NA(@GN@(1))
281 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
282 Q
283 ;
284TESTNARY ; TEST MAKING A NHIN ARRAY
285 N ZI S ZI=""
286 N ZH ; DOM HANDLE
287 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
288 S ZH=C0SDOCID ; SET THE HANDLE
289 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
290 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE
291 . N ZATT
292 . D MNARY(.ZATT,ZH,ZI)
293 . N ZPRE,ZN
294 . S ZPRE=$$PRE(ZI)
295 . S ZN=$P(ZPRE,",",2)
296 . S ZPRE=$P(ZPRE,",",1)
297 . ;I $D(ZATT) ZWR ZATT
298 . N ZJ S ZJ=""
299 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE
300 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
301 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
302 Q
303 ;
304PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
305 ;
306 N GI,GI2,GPT,GJ,GN
307 S GI=$$PARENT(ZNODE) ; PARENT NODE
308 I GI=0 Q "" ; NO PARENT
309 S GPT=$$TAG(GI) ; TAG OF PARENT
310 S GI2=$$PARENT(GI) ; PARENT OF PARENT
311 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
312 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
313 I GJ=ZNODE Q:$$TAG(GI)_",1"
314 F GN=2:1 Q:GJ=ZNODE D ;
315 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
316 Q GPT_","_GN
317 ;
318MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
319 ; RETURNED IN ZRTN, PASSED BY REFERENCE
320 ; ZHANDLE IS THE DOM DOCUMENT ID
321 ; ZOID IS THE DOM NODE
322 D ATT("ZRTN",ZOID)
323 Q
324 ;
Note: See TracBrowser for help on using the repository browser.