source: ccr/trunk/p/C0CNHIN.m@ 1203

Last change on this file since 1203 was 1203, checked in by George Lilly, 13 years ago

updates for certification

File size: 8.4 KB
Line 
1C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05
2 ;;0.1;C0C;nopatch;noreleasedate;Build 38
3 ;Copyright 2011 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) ; GENERATE AN NHIN ARRAY FOR A PATIENT
22 ;
23 K GARY,GNARY,GIDX,C0CDOCID
24 N GN
25 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
26 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
27 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
28 D GET^NHINV(.GN,ZDFN) ; CALL NHINV ROUTINES TO PULL XML
29 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
30 S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
31 D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
32 Q
33 ;
34LOADSMRT ;
35 ;
36 K ^GPL("SMART")
37 S GN=$NA(^GPL("SMART",1))
38 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
39 Q
40 ;
41SMART ; TRY IT WITH SMART
42 ;
43 S GN=$NA(^GPL("SMART"))
44 ;K ^TMP("MXMLDOM",$J)
45 K ^TMP("MXMLERR",$J)
46 S C0CDOCID=$$PARSE(GN,"SMART")
47 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
48 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
49 Q
50 ;
51CCR ; TRY IT WITH A CCR
52 ;
53 S GN=$NA(^GPL("CCR"))
54 ;K ^TMP("MXMLDOM",$J)
55 K ^TMP("MXMLERR",$J)
56 S C0CDOCID=$$PARSE(GN,"CCR")
57 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
58 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
59 Q
60 ;
61CCD ; TRY IT WITH A CCD
62 ;
63 S GN=$NA(^GPL("CCD"))
64 ;K ^TMP("MXMLDOM",$J)
65 K ^TMP("MXMLERR",$J)
66 S C0CDOCID=$$PARSE(GN,"CCD")
67 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
68 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
69 Q
70 ;
71TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
72 ; PARSED WITH MXML
73 ; RUN THROUGH XPATH
74 K GARY,GIDX,C0CDOCID
75 S GN=$NA(^GPL("NHIN"))
76 S C0CDOCID=$$PARSE(GN,"GPLTEST")
77 D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
78 Q
79 ;
80DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
81 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
82 ; THE XPATH ARRAY XPARY, PASSED BY NAME
83 ; ZOID IS THE STARTING OID
84 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
85 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
86 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
87 I $G(ZREDUX)="" S ZREDUX=""
88 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
89 N NEWNUM S NEWNUM=""
90 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
91 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
92 I $G(ZREDUX)'="" D ; REDUX PROVIDED?
93 . N GT S GT=$P(NEWPATH,ZREDUX,2)
94 . I GT'="" S NEWPATH=GT
95 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
96 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
97 I $D(GA) D ; PROCESS THE ATTRIBUTES
98 . N ZI S ZI=""
99 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
100 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
101 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
102 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
103 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
104 I $D(GD(2)) D ;
105 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
106 E I $D(GD(1)) D ;
107 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
108 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
109 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
110 I ZFRST'=0 D ; THERE IS A CHILD
111 . N ZNUM
112 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
113 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
114 N GNXT S GNXT=$$NXTSIB(ZOID)
115 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
116 I GNXT'=0 D ;
117 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
118 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
119 . . N ZNUM S ZNUM=1 ;
120 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
121 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
122 Q
123 ;
124ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
125 ;
126 N ZZI,ZZJ,ZZN
127 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
128 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
129 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
130 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
131 I ZZI'["]" D ; A SINGLETON
132 . S ZZN=1
133 E D ; THERE IS AN [x] OCCURANCE
134 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
135 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
136 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
137 Q
138 ;
139PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
140 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
141 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
142 ;Q $$EN^MXMLDOM(INXML)
143 Q $$EN^MXMLDOM(INXML,"W")
144 ;
145ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
146 N ZN
147 ;I $$TAG(ZOID)["entry" B
148 S ZN=$$NXTSIB(ZOID)
149 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
150 Q 0
151 ;
152FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
153 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
154 ;
155PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
156 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
157 ;
158ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
159 S HANDLE=C0CDOCID
160 K @RTN
161 D GETTXT^MXMLDOM("A")
162 Q
163 ;
164TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
165 ;I ZOID=149 B ;GPLTEST
166 N X,Y
167 S Y=""
168 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
169 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
170 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
171 Q Y
172 ;
173NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
174 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
175 ;
176DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
177 ;N ZT,ZN S ZT=""
178 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
179 ;Q $G(@C0CDOM@(ZOID,"T",1))
180 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
181 Q
182 ;
183OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
184 ;
185 S C0CDOCID=INID
186 D START^C0CMXMLB($$TAG(1),,"G")
187 D NDOUT($$FIRST(1))
188 D END^C0CMXMLB ;END THE DOCUMENT
189 M @ZRTN=^TMP("MXMLBLD",$J)
190 K ^TMP("MXMLBLD",$J)
191 Q
192 ;
193NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
194 N ZI S ZI=$$FIRST(ZOID)
195 I ZI'=0 D ; THERE IS A CHILD
196 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
197 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
198 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
199 . ;W "DOING",ZOID,!
200 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
201 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
202 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
203 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
204 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
205 Q
206 ;
207WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
208 ;
209 N GN,GN2
210 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
211 S GN2=$NA(@GN@(1))
212 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
213 Q
214 ;
215TESTNARY ; TEST MAKING A NHIN ARRAY
216 N ZI S ZI=""
217 N ZH ; DOM HANDLE
218 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
219 S ZH=C0CDOCID ; SET THE HANDLE
220 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
221 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE
222 . N ZATT
223 . D MNARY(.ZATT,ZH,ZI)
224 . N ZPRE,ZN
225 . S ZPRE=$$PRE(ZI)
226 . S ZN=$P(ZPRE,",",2)
227 . S ZPRE=$P(ZPRE,",",1)
228 . ;I $D(ZATT) ZWR ZATT
229 . N ZJ S ZJ=""
230 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE
231 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
232 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
233 Q
234 ;
235PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
236 ;
237 N GI,GI2,GPT,GJ,GN
238 S GI=$$PARENT(ZNODE) ; PARENT NODE
239 I GI=0 Q "" ; NO PARENT
240 S GPT=$$TAG(GI) ; TAG OF PARENT
241 S GI2=$$PARENT(GI) ; PARENT OF PARENT
242 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
243 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
244 I GJ=ZNODE Q:$$TAG(GI)_",1"
245 F GN=2:1 Q:GJ=ZNODE D ;
246 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
247 Q GPT_","_GN
248 ;
249MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
250 ; RETURNED IN ZRTN, PASSED BY REFERENCE
251 ; ZHANDLE IS THE DOM DOCUMENT ID
252 ; ZOID IS THE DOM NODE
253 D ATT("ZRTN",ZOID)
254 Q
255 ;
Note: See TracBrowser for help on using the repository browser.