source: ccr/trunk/p/C0CMCCD.m@ 630

Last change on this file since 630 was 630, checked in by George Lilly, 14 years ago

reorganizing MXML routines
File size: 10.7 KB
Line 
1C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05
2 ;;0.1;C0C;nopatch;noreleasedate
3 ;Copyright 2009 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
21 ;
22TEST ;
23 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
24 K GARY
25 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
26 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
27 S REDUX="//ContinuityOfCareRecord/Body"
28 D XPATH(1,"/","GIDX","GARY",,REDUX)
29 Q
30 ;
31TEST2 ;
32 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
33 D XPATH(1,"/","GIDX","GARY","",REDUX)
34 Q
35 ;
36TEST3
37 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
38 K GARY,GTMP,GIDX
39 K @C0CXMLIN
40 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
41 D CLEANARY("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
42 K @C0CXMLIN
43 M @C0CXMLIN=GTMP
44 K GTMP
45 D STRIPTXT("GTMP",C0CXMLIN)
46 K @C0CXMLIN
47 M @C0CXMLIN=GTMP
48 K GTMP
49 S C0CDOCID=$$PARSCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
50 S REDUX="//ClinicalDocument/component/structuredBody"
51 D FINDTID ; FIND THE TEMPLATE IDS
52 D FINDALT ; FIND ALTERNATE TAGS
53 D SETCBK ; SET THE CALLBACK ROUTINE FOR TAGS
54 D XPATH(1,"/","GIDX","GARY",,REDUX)
55 K C0CCBK("TAG")
56 D SEPARATE("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
57 ;S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER
58 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
59 Q
60 ;
61TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
62 ;
63 D TEST ; SET UP THE DOM
64 D START^C0CMXMLB($$TAG(1),,"G")
65 D NDOUT($$FIRST(1))
66 D END^C0CMXMLB ;END THE DOCUMENT
67 M ZCCR=^TMP("MXMLBLD",$J)
68 ZWR ZCCR
69 Q
70 ;
71TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
72 S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
73 K GARY,GTMP,GIDX
74 K @C0CXMLIN
75 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
76 D CLEANARY("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
77 K @C0CXMLIN
78 M @C0CXMLIN=GTMP
79 K GTMP
80 D STRIPTXT("GTMP",C0CXMLIN)
81 K @C0CXMLIN
82 M @C0CXMLIN=GTMP
83 K GTMP
84 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER
85 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
86 D OUTXML("ZCCD",C0CDOCID)
87 ;D START^C0CMXMLB($$TAG(1),,"G")
88 ;D NDOUT($$FIRST(1))
89 ;D END^C0CMXMLB ;END THE DOCUMENT
90 ;M ZCCD=^TMP("MXMLBLD",$J)
91 ZWR ZCCD(1:30)
92 Q
93 ;
94PARSCCD(DOC,OPTION) ; THIS WAS COPIED FROM EN^MXMLDOM TO CUSTIMIZE FOR
95 ; PROCESSING CCDS
96 N CBK,SUCCESS,LEVEL,NODE,HANDLE
97 K ^TMP("MXMLERR",$J)
98 L +^TMP("MXMLDOM",$J):5
99 E Q 0
100 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
101 L -^TMP("MXMLDOM",$J)
102 S CBK("STARTELEMENT")="STARTELE^C0CMXML" ; ONLY THIS ONE IS CHANGED ;GPL
103 S CBK("ENDELEMENT")="ENDELE^MXMLDOM"
104 S CBK("COMMENT")="COMMENT^MXMLDOM"
105 S CBK("CHARACTERS")="CHAR^MXMLDOM"
106 S CBK("ENDDOCUMENT")="ENDDOC^MXMLDOM"
107 S CBK("ERROR")="ERROR^MXMLDOM"
108 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0,OPTION=$G(OPTION,"V1")
109 D EN^MXMLPRSE(DOC,.CBK,OPTION)
110 D:'SUCCESS DELETE^MXMLDOM(HANDLE)
111 Q $S(SUCCESS:HANDLE,1:0)
112 ; Start element
113 ; Create new child node and push info on stack
114STARTELE(ELE,ATTR) ; COPIED FROM STARTELE^MXMLDOM AND MODIFIED TO TREAT
115 ; ATTRIBUTES AS SUBELEMENTS TO MAKE CCD XPATH PROCESSING EASIER
116 N PARENT
117 S PARENT=LEVEL(LEVEL),NODE=NODE+1
118 S:PARENT ^TMP("MXMLDOM",$J,HANDLE,PARENT,"C",NODE)=ELE
119 S LEVEL=LEVEL+1,LEVEL(LEVEL)=NODE,LEVEL(LEVEL,0)=ELE
120 S ^TMP("MXMLDOM",$J,HANDLE,NODE)=ELE,^(NODE,"P")=PARENT
121 ;M ^("A")=ATTR
122 N ZI S ZI="" ; INDEX FOR ATTR
123 F S ZI=$O(ATTR(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
124 . N ELE,TXT ; ABOUT TO RECURSE
125 . S ELE=ZI ; TAG
126 . S TXT=ATTR(ZI) ; DATA
127 . D STARTELE(ELE,"") ; CREATE A NEW SUBNODE
128 . D TXT^MXMLDOM("T") ; INSERT DATA TO TAG
129 . D ENDELE^MXMLDOM(ELE) ; POP BACK UP A LEVEL
130 Q
131 ;
132CLEANARY(OUTARY,INARY) ; GOES THROUGH AN ARRAY AND CALLS CLEAN ON EACH NODE
133 ; INARY AND OUTARY PASSED BY NAME
134 N ZI S ZI=""
135 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH NODE
136 . S @OUTARY@(ZI)=$$CLEAN(@INARY@(ZI)) ; CLEAN THE NODE
137 Q
138 ;
139CLEAN(STR) ; extrinsic function; returns string
140 ;; Removes all non printable characters from a string.
141 ;; STR by Value
142 N TR,I
143 F I=0:1:31 S TR=$G(TR)_$C(I)
144 S TR=TR_$C(127)
145 QUIT $TR(STR,TR)
146 ;
147STRIPTXT(OUTARY,ZARY) ; STRIPS THE "TEXT" PORTION OUT OF AN XML FILE
148 ; THIS IS USED TO DELETE THE NARATIVE HTML OUT OF THE CCD XML FILES BECAUSE
149 ; THEY DO NOT WORK RIGHT WITH THE PARSER
150 ;N ZWRK,ZBLD,ZI ; WORK ARRAY,BUILD ARRAY, AND COUNTER
151 S ZI=$O(@ZARY@("")) ; GET FIRST LINE NUMBER
152 D C0CBEGIN("ZWRK",ZI) ; INSERT FIRST LINE IN WORK ARRAY
153 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH LINE OF THE ARRAY
154 . I $O(@ZARY@(ZI))="" D Q ; AT THE END
155 . . D C0CEND("ZWRK",ZI) ; INCLUDE LAST LINE IN WORK ARRAY
156 . I ZI=1 D C0CBEGIN("ZWRK",ZI) ; START WITH FIRST LINE
157 . I @ZARY@(ZI)["<text" D C0CEND("ZWRK",ZI-1) ;PREV LINE IS AN END
158 . I @ZARY@(ZI)["</text>" D C0CBEGIN("ZWRK",ZI+1) ;NEXT LINE IS A BEGIN
159 S ZI=""
160 F S ZI=$O(ZWRK(ZI)) Q:ZI="" D ; MAKE A BUILD LIST FROM THE WORK ARRAY
161 . D QUEUE^C0CXPATH("ZBLD",ZARY,$P(ZWRK(ZI),"^",1),$P(ZWRK(ZI),"^",2))
162 D BUILD^C0CXPATH("ZBLD",OUTARY) ; BUILD NEW ARRAY WITHOUT TEXT SECTIONS
163 K @OUTARY@(0) ; GET RID OF THE LINE COUNT
164 Q
165 ;
166C0CBEGIN(ZA,LN) ; INSERTS A BEGIN LINE LN INTO ARRAY ZWRK, PASSED BY NAME
167 N ZI
168 S ZI=$O(@ZA@(""),-1)
169 I ZI="" S ZI=1
170 E S ZI=ZI+1 ; INCREMENT COUNT IN WORK ARRAY
171 S $P(@ZA@(ZI),"^",1)=LN
172 Q
173 ;
174C0CEND(ZB,LN) ; INSERTS AN END LINE LN INTO ARRAY ZWRK, PASSED BY NAME
175 N ZI
176 S ZI=$O(@ZB@(""),-1)
177 I ZI="" S ZI=1
178 S $P(@ZB@(ZI),"^",2)=LN
179 Q
180 ;
181SEPARATE(OUTARY,INARY) ; SEPARATES XPATH VARIABLES ACCORDING TO THEIR
182 ; ROOT ; /Problems/etc/etc goes to @OUTARY@("Problems","/Problems/etc/etc")
183 S ZI=""
184 F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ; FOR EACH ELEMENT OF THE ARRAY
185 . S ZJ=$P(ZI,"/",2) ;
186 . I ZJ="" S ZJ=$P(ZI,"/",3) ;
187 . S @OUTARY@(ZJ,ZI)=@INARY@(ZI)
188 Q
189 ;
190FINDTID ; FIND TEMPLATE IDS IN DOM 1
191 S C0CDOCID=1
192 S ZD=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
193 S ZN=""
194 S CURSEC=""
195 S TID=""
196 F S ZN=$O(@ZD@(ZN)) Q:ZN="" D ;
197 . I $$TAG(ZN)="root" D ;
198 . . I $$TAG($$PARENT(ZN))="templateId" D ; ONLY LOOKING FOR TEMPLATES
199 . . . S ZG=$$PARENT($$PARENT(ZN))
200 . . . S ZG2=$$PARENT(ZG) ;COMPONENT THAT HOLDS THIS SECTION
201 . . . S CMT=$G(@ZD@(ZG,"X",1))
202 . . . I CMT="" S CMT="?"
203 . . . I $$TAG(ZG)="section" D ;START OF A SECTION
204 . . . . S CURSEC=$$PARENT(ZG)
205 . . . . S SECCMT=$G(@ZD@(CURSEC,"X",1))
206 . . . . I SECCMT="" S SECCMT="?"
207 . . . . S SECTID=$G(@ZD@(ZN,"T",1)) ;SECTION TEMPLATE ID
208 . . . S TID=$G(@ZD@(ZN,"T",1)) ;TEMPLATE ID
209 . . . I CURSEC'="" D ; IF WE ARE IN A SECTION
210 . . . . S CCDDIR(ZG2,CURSEC,$$TAG(ZG2),CMT,SECCMT)=TID
211 . . . . S DOMMAP(ZG2)=CURSEC_U_$$TAG(ZG2)_U_TID_U_SECTID
212 . . . W !,$$TAG(ZG2)," ",$G(@ZD@(ZG,"X",1))
213 . . . W " root ",ZN," ",@ZD@(ZN,"T",1)
214 Q
215 ;
216FINDALT ; PROCESS THE DOMMAP AND FIND THE ALT TAGS FOR COMPONENTS
217 ;
218 S ZI=""
219 F S ZI=$O(DOMMAP(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE MAP
220 . S ZJ=DOMMAP(ZI) ;
221 . S PARNODE=$P(ZJ,U,1) ;PARENT NODE
222 . S TAG=$P(ZJ,U,2) ;THIS TAG
223 . S TID=$P(ZJ,U,3) ;THIS TEMPLATE ID
224 . S PARTID=$P(ZJ,U,4) ;PARENT TEMPLATE ID
225 . S ZIEN=$O(^C0CXDS(178.101,"TID",TID,"")) ;THIS NODE IEN
226 . S PARIEN=$O(^C0CXDS(178.101,"TID",PARTID,"")) ;PARENT NODE IEN
227 . I ZI=PARNODE D ; IF THIS IS A SECTION NODE
228 . . S ALTTAG=$$GET1^DIQ(178.101,PARIEN_",",.03) ;ALT TAG FIELD FOR PARENT
229 . . S NAME=$$GET1^DIQ(178.101,ZIEN_",",.01) ;NAME OF THIS NODE'S TEMPLATE
230 . . W ZI," ",TAG," ",ALTTAG," ",NAME,!
231 . . S C0CTAGS(ZI)=ALTTAG
232 . E D ; NOT A SECTION NODE
233 . . N ZJ S ZJ=""
234 . . S ZJ=$O(^C0CXDS(178.101,"D",PARIEN,ZIEN,"")) ;A WHEREUSED POINTER?
235 . . I ZJ'="" D ; THERE IS A NEW LABEL FOR THIS NODE
236 . . . N ZK
237 . . . S ZK=$$GET1^DIQ(178.111,ZJ_","_ZIEN_",",2)
238 . . . I ZK'="" D ;
239 . . . . W "FOUND ",ZK,!
240 . . . . S C0CTAGS(ZI)=ZK ; NEW TAG FOR INTERSECTION
241 Q
242 ;
243ALTTAG(NODE) ; SET Y EQUAL TO THE ALT TAG FOUND IN C0CTAGS IF NODE IF FOUND
244 ;
245 S Y=$G(C0CTAGS(NODE))
246 Q
247 ;
248SETCBK ; SET THE TAG CALLBACK FOR XPATH PROCESSSING OF THE CCD
249 S C0CCBK("TAG")="D ALTTAG(ZOID)"
250 Q
251 ;
252OUTCCD ; OUTPUT THE PARSED CCD TO A TEXT FILE
253 D TEST3
254 N ZT S ZT=$NA(^TMP("CCDOUT",$J))
255 N ZI,ZJ
256 S ZI=1 S ZJ=""
257 K @ZT
258 F S ZJ=$O(GARY(ZJ)) Q:ZJ="" D ;
259 . S @ZT@(ZI)=ZJ_"^"_GARY(ZJ)
260 . S ZI=ZI+1
261 S ONAME=$NA(@ZT@(1))
262 W $$OUTPUT^C0CXPATH(ONAME,"CCDOUT.txt","/home/vademo2/CCR")
263 K @ZT
264 Q
265 ;
266GENXDS(ZD) ; GENERATE THE XDS PROTOTYPE RECORDS FROM A CCDDIR ARRAY
267 ; ARRAY ELEMENTS LOOK LIKE:
268 ; CCDDIR(1659,1634,"observation"," Result observaion template "," Vital signs section template ")="2.16.840.1.113883.10.20.1.31"
269 ;or CCDDIR(cur node,section node,cur tag,cur name,sec name)=templateId
270 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
271 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
272 S DONE=0
273 F Q:DONE D ;
274 . W @ZI,!
275 . S ZJ=$QS(ZI,5)
276 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
277 . S C0CFDA(ZF,"?+1,",.01)=ZJ
278 . S C0CFDA(ZF,"?+1,",.02)=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
279 . S C0CFDA(ZF,"?+1,",1)=@ZI
280 . D UPDIE
281 . S ZI=$Q(@ZI)
282 . I ZI="" S DONE=1
283 Q
284 ;
285WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
286 ; CCDDIR PASS BY NAME
287 ; ARRAY ELEMENTS LOOK LIKE:
288 ; CCDDIR(1634," Vital signs section template ",1659,"observation"," Result observaion template ")="2.16.840.1.113883.10.20.1.31"
289 ;or CCDDIR(section node,sec name, cur node,cur tag,cur name)=templateId
290 S ZF=178.101 ; FILE NUMBER FOR THE C0C XDS PROTOTYPE FILE
291 S ZSF=178.111 ; WHERE USED SUBFILE OF C0C XDS PROTOTYPE FILE
292 S ZI=$Q(@ZD@("")) ;FIRST ARRAY ELEMENT
293 S DONE=0
294 F Q:DONE D ;
295 . W @ZI
296 . S ZIEN=$O(^C0CXDS(178.101,"TID",@ZI,"")) ; IEN FOR THIS NODE'S TEMPLATE
297 . W " IEN:",ZIEN
298 . S ZJ=$QS(ZI,2)
299 . S ZJ=$E(ZJ,2,$L(ZJ)) ;STRIP THE LEADING SPACE
300 . S ZPIEN=$O(^C0CXDS(178.101,"B",ZJ,"")) ; PARENT IEN
301 . W " PARENT IEN:",ZPIEN
302 . S ZTAG=$QS(ZI,4) ; TAG FOR THIS TEMPLATE
303 . W " TAG:",ZTAG,!
304 . I ZIEN'=ZPIEN D ; ONLY FOR CHILD TEMPLATES
305 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",.01)=ZPIEN ; NEW SUBFILE ENTRY WITH PAR PTR
306 . . S C0CFDA(ZSF,"?+1,"_ZIEN_",",1)=ZTAG ; TAG FOR NEW ENTRY
307 . . D UPDIE
308 . ;S C0CFDA(ZF,"?+1,",1)=@ZI
309 . ;D UPDIE
310 . S ZI=$Q(@ZI)
311 . I ZI="" S DONE=1
312 Q
313 ;
314UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
315 K ZERR
316 D CLEAN^DILF
317 D UPDATE^DIE("","C0CFDA","","ZERR")
318 I $D(ZERR) D ;
319 . W "ERROR",!
320 . ZWR ZERR
321 . B
322 K C0CFDA
323 Q
324 ;
Note: See TracBrowser for help on using the repository browser.