Changeset 1204 for ccr/trunk/p/C0CMXML.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CMXML.m
r1184 r1204 1 C0CMXML ; GPL - MXML based XPath utilities;10/13/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 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER 22 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM 23 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD 24 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP 25 ; 26 TEST ; TEST DRIVER ASSUMES A CCR IN ^GPL("CCR") 27 ; LOOK FOR TEST RESULTS IN VARIABLE G 28 ; ACTUALLY, IF NO CCR IS THERE, IT WILL PUT ONE THERE FOR PAT DFN 2 29 ; 30 N GPLCCR S GPLCCR=$NA(^GPL("CCR")) 31 I '$D(@GPLCCR@(1)) D ; NO CCR THERE 32 . N TGPL 33 . D CCRRPC^C0CCCR(.TGPL,2) ; GET A CCR FOR PAT 2 34 . M @GPLCCR=TGPL ; PUT IT IN THE TEST GLOBAL 35 . K @GPLCCR@(0) ; KILL THE LINE COUNT FOR THE PARSER 36 D EN(.G,GPLCCR) 37 Q 38 ; 39 EN(ZRTN,C0CIN) ; PARSE THE CCR PASSED BY NAME IN C0CIN 40 ; AND RETURN THE XPATH ARRAY THAT RESULTS IN ZRTN, PASSED BY REFERENCE 41 I '$D(@C0CIN@(1)) Q ;NOTHING PASSED IN 42 K ZRTN 43 N C0CDOCID,REDUX,GARY,GARY2,GARY3 44 S C0CDOCID=$$PARSE(C0CIN) 45 S REDUX="//ContinuityOfCareRecord/Body" 46 D XPATH(1,"/","GIDX","GARY",,REDUX) 47 D SEPARATE^C0CMCCD("GARY2","GARY") 48 S ZI="" 49 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 50 . N GTMP,G2 51 . M G2=GARY2(ZI) 52 . D DEMUX2^C0CMXP("GTMP","G2",2) 53 . M GARY3(ZI)=GTMP 54 M ZRTN=GARY3 55 Q 56 ; 57 TEST0 ; 58 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 59 K GARY 60 M @C0CXMLIN=^GPL("CCR") 61 ;W $$FTG^%ZISH("/home/vademo2/CCR/","PAT_774_CCR_V1_0_0.xml",$NA(@C0CXMLIN@(1)),3) 62 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 63 S REDUX="//ContinuityOfCareRecord/Body" 64 D XPATH(1,"/","GIDX","GARY",,REDUX) 65 D SEPARATE^C0CMCCD("GARY2","GARY") 66 S ZI="" 67 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 68 . N GTMP,G2 69 . M G2=GARY2(ZI) 70 . D DEMUX2^C0CMXP("GTMP","G2",2) 71 . M GARY3(ZI)=GTMP 72 Q 73 ; 74 TEST2 ; 75 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 76 D XPATH(1,"/","GIDX","GARY","",REDUX) 77 Q 78 ; 79 TEST3 80 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 81 K GARY,GTMP,GIDX 82 K @C0CXMLIN 83 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 84 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 85 K @C0CXMLIN 86 M @C0CXMLIN=GTMP 87 K GTMP 88 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 89 K @C0CXMLIN 90 M @C0CXMLIN=GTMP 91 K GTMP 92 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 93 S REDUX="//ClinicalDocument/component/structuredBody" 94 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 95 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 96 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 97 D XPATH(1,"/","GIDX","GARY",,REDUX) 98 K C0CCBK("TAG") 99 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 100 D TEST3A 101 Q 102 ; 103 TEST3A ; INTERNAL ROUTINE 104 S ZI="" 105 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 106 . N GTMP,G2 107 . M G2=GARY2(ZI) 108 . D DEMUX2^C0CMXP("GTMP","G2",2) 109 . M GARY4(ZI)=GTMP 110 Q 111 ; 112 TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010 113 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 114 K GARY,GTMP,GIDX 115 K @C0CXMLIN 116 W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3) 117 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 118 K @C0CXMLIN 119 S GTMP(1)="<"_$P(GTMP(1),"<",2) 120 M @C0CXMLIN=GTMP 121 K GTMP 122 D TESTQ2 123 Q 124 ; 125 TESTQ2 ; SECOND PART OF TESTQ 126 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 127 K @C0CXMLIN 128 M @C0CXMLIN=GTMP 129 K GTMP 130 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 131 S REDUX="//ClinicalDocument/component/structuredBody" 132 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 133 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 134 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 135 D XPATH(1,"/","GIDX","GARY",,REDUX) 136 K C0CCBK("TAG") 137 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 138 D TEST3A 139 Q 140 ; 141 TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR 142 ; 143 D TEST ; SET UP THE DOM 144 D START^C0CMXMLB($$TAG(1),,"G") 145 D NDOUT($$FIRST(1)) 146 D END^C0CMXMLB ;END THE DOCUMENT 147 M ZCCR=^TMP("MXMLBLD",$J) 148 ZWR ZCCR 149 Q 150 ; 151 TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD 152 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 153 K GARY,GTMP,GIDX 154 K @C0CXMLIN 155 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 156 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 157 K @C0CXMLIN 158 M @C0CXMLIN=GTMP 159 K GTMP 160 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 161 K @C0CXMLIN 162 M @C0CXMLIN=GTMP 163 K GTMP 164 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER 165 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX) 166 D OUTXML("ZCCD",C0CDOCID) 167 ;D START^C0CMXMLB($$TAG(1),,"G") 168 ;D NDOUT($$FIRST(1)) 169 ;D END^C0CMXMLB ;EOND THE DOCUMENT 170 ;M ZCCD=^TMP("MXMLBLD",$J) 171 ZWR ZCCD(1:30) 172 Q 173 ; 174 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 175 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 176 ; THE XPATH ARRAY XPARY, PASSED BY NAME 177 ; ZOID IS THE STARTING OID 178 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 179 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 180 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 181 I $G(ZREDUX)="" S ZREDUX="" 182 N NEWPATH 183 N NEWNUM S NEWNUM="" 184 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 185 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 186 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 187 . N GT S GT=$P(NEWPATH,ZREDUX,2) 188 . I GT'="" S NEWPATH=GT 189 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 190 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 191 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 192 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 193 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 194 I ZFRST'=0 D ; THERE IS A CHILD 195 . N ZNUM 196 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 197 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 198 N GNXT S GNXT=$$NXTSIB(ZOID) 199 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 200 I GNXT'=0 D ; 201 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 202 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 203 . . N ZNUM S ZNUM=1 ; 204 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 205 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 206 Q 207 ; 208 PARSE(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 ; 214 ISMULT(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 ; 221 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 222 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 223 ; 224 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 225 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 226 ; 227 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 228 S HANDLE=C0CDOCID 229 K @RTN 230 D GETTXT^MXMLDOM("A") 231 Q 232 ; 233 TAG(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(C0CCBK("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(C0CDOCID,ZOID) 240 Q Y 241 ; 242 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 243 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 244 ; 245 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 246 ;N ZT,ZN S ZT="" 247 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 248 ;Q $G(@C0CDOM@(ZOID,"T",1)) 249 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 250 Q 251 ; 252 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 253 ; 254 S C0CDOCID=INID 255 D START^C0CMXMLB($$TAG(1),,"G") 256 D NDOUT($$FIRST(1)) 257 D END^C0CMXMLB ;END THE DOCUMENT 258 M @ZRTN=^TMP("MXMLBLD",$J) 259 K ^TMP("MXMLBLD",$J) 260 Q 261 ; 262 NDOUT(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^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(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^C0CMXMLB("",$$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 ; 276 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 277 K ZERR 278 D CLEAN^DILF 279 D UPDATE^DIE("","C0CFDA","","ZERR") 280 I $D(ZERR) D ; 281 . W "ERROR",! 282 . ZWR ZERR 283 . B 284 K C0CFDA 285 Q 286 ; 1 C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05 2 ;;0.1;C0C;nopatch;noreleasedate;Build 38 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 ; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER 22 ; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM 23 ; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD 24 ; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP 25 ; 26 TEST ; 27 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 28 K GARY 29 W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3) 30 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID 31 S REDUX="//ContinuityOfCareRecord/Body" 32 D XPATH(1,"/","GIDX","GARY",,REDUX) 33 D SEPARATE^C0CMCCD("GARY2","GARY") 34 S ZI="" 35 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 36 . N GTMP,G2 37 . M G2=GARY2(ZI) 38 . D DEMUX2^C0CMXP("GTMP","G2",2) 39 . M GARY3(ZI)=GTMP 40 Q 41 ; 42 TEST2 ; 43 S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail" 44 D XPATH(1,"/","GIDX","GARY","",REDUX) 45 Q 46 ; 47 TEST3 48 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 49 K GARY,GTMP,GIDX 50 K @C0CXMLIN 51 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 52 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 53 K @C0CXMLIN 54 M @C0CXMLIN=GTMP 55 K GTMP 56 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 57 K @C0CXMLIN 58 M @C0CXMLIN=GTMP 59 K GTMP 60 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 61 S REDUX="//ClinicalDocument/component/structuredBody" 62 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 63 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 64 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 65 D XPATH(1,"/","GIDX","GARY",,REDUX) 66 K C0CCBK("TAG") 67 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 68 D TEST3A 69 Q 70 ; 71 TEST3A ; INTERNAL ROUTINE 72 S ZI="" 73 F S ZI=$O(GARY2(ZI)) Q:ZI="" D ; 74 . N GTMP,G2 75 . M G2=GARY2(ZI) 76 . D DEMUX2^C0CMXP("GTMP","G2",2) 77 . M GARY4(ZI)=GTMP 78 Q 79 ; 80 TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010 81 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 82 K GARY,GTMP,GIDX 83 K @C0CXMLIN 84 W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3) 85 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 86 K @C0CXMLIN 87 S GTMP(1)="<"_$P(GTMP(1),"<",2) 88 M @C0CXMLIN=GTMP 89 K GTMP 90 D TESTQ2 91 Q 92 ; 93 TESTQ2 ; SECOND PART OF TESTQ 94 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 95 K @C0CXMLIN 96 M @C0CXMLIN=GTMP 97 K GTMP 98 S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID 99 S REDUX="//ClinicalDocument/component/structuredBody" 100 D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS 101 D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS 102 D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS 103 D XPATH(1,"/","GIDX","GARY",,REDUX) 104 K C0CCBK("TAG") 105 D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING 106 D TEST3A 107 Q 108 ; 109 TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR 110 ; 111 D TEST ; SET UP THE DOM 112 D START^C0CMXMLB($$TAG(1),,"G") 113 D NDOUT($$FIRST(1)) 114 D END^C0CMXMLB ;END THE DOCUMENT 115 M ZCCR=^TMP("MXMLBLD",$J) 116 ZWR ZCCR 117 Q 118 ; 119 TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD 120 S C0CXMLIN=$NA(^TMP("C0CMXML",$J)) 121 K GARY,GTMP,GIDX 122 K @C0CXMLIN 123 W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3) 124 D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS 125 K @C0CXMLIN 126 M @C0CXMLIN=GTMP 127 K GTMP 128 D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN) 129 K @C0CXMLIN 130 M @C0CXMLIN=GTMP 131 K GTMP 132 S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER 133 ;D XPATH(1,"/","GIDX2","GARY2",,REDUX) 134 D OUTXML("ZCCD",C0CDOCID) 135 ;D START^C0CMXMLB($$TAG(1),,"G") 136 ;D NDOUT($$FIRST(1)) 137 ;D END^C0CMXMLB ;EOND THE DOCUMENT 138 ;M ZCCD=^TMP("MXMLBLD",$J) 139 ZWR ZCCD(1:30) 140 Q 141 ; 142 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 143 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 144 ; THE XPATH ARRAY XPARY, PASSED BY NAME 145 ; ZOID IS THE STARTING OID 146 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 147 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 148 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 149 I $G(ZREDUX)="" S ZREDUX="" 150 N NEWPATH 151 N NEWNUM S NEWNUM="" 152 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 153 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 154 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 155 . N GT S GT=$P(NEWPATH,ZREDUX,2) 156 . I GT'="" S NEWPATH=GT 157 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 158 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 159 I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 160 E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 161 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 162 I ZFRST'=0 D ; THERE IS A CHILD 163 . N ZNUM 164 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 165 . D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD 166 N GNXT S GNXT=$$NXTSIB(ZOID) 167 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 168 I GNXT'=0 D ; 169 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 170 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 171 . . N ZNUM S ZNUM=1 ; 172 . . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 173 . E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB 174 Q 175 ; 176 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 177 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 178 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 179 ;Q $$EN^MXMLDOM(INXML) 180 Q $$EN^MXMLDOM(INXML,"W") 181 ; 182 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 183 N ZN 184 ;I $$TAG(ZOID)["entry" B 185 S ZN=$$NXTSIB(ZOID) 186 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 187 Q 0 188 ; 189 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 190 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 191 ; 192 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 193 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 194 ; 195 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 196 S HANDLE=C0CDOCID 197 K @RTN 198 D GETTXT^MXMLDOM("A") 199 Q 200 ; 201 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 202 ;I ZOID=149 B ;GPLTEST 203 N X,Y 204 S Y="" 205 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 206 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 207 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 208 Q Y 209 ; 210 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 211 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 212 ; 213 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 214 ;N ZT,ZN S ZT="" 215 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 216 ;Q $G(@C0CDOM@(ZOID,"T",1)) 217 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 218 Q 219 ; 220 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 221 ; 222 S C0CDOCID=INID 223 D START^C0CMXMLB($$TAG(1),,"G") 224 D NDOUT($$FIRST(1)) 225 D END^C0CMXMLB ;END THE DOCUMENT 226 M @ZRTN=^TMP("MXMLBLD",$J) 227 K ^TMP("MXMLBLD",$J) 228 Q 229 ; 230 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 231 N ZI S ZI=$$FIRST(ZOID) 232 I ZI'=0 D ; THERE IS A CHILD 233 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 234 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 235 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 236 . ;W "DOING",ZOID,! 237 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 238 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 239 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 240 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 241 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 242 Q 243 ; 244 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 245 K ZERR 246 D CLEAN^DILF 247 D UPDATE^DIE("","C0CFDA","","ZERR") 248 I $D(ZERR) D ; 249 . W "ERROR",! 250 . ZWR ZERR 251 . B 252 K C0CFDA 253 Q 254 ;
Note:
See TracChangeset
for help on using the changeset viewer.