Changeset 1330 for ccr/branches/ohum/p/C0CMXML.m
- Timestamp:
- Jan 3, 2012, 11:45:29 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CMXML.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CMXML.m
r1329 r1330 1 C0CMXML 2 ;;0.1;C0C;nopatch;noreleasedate;Build 38 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 TEST 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 TEST2 43 44 45 46 47 TEST3 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 TEST3A 72 73 74 75 76 77 78 79 80 TESTQ 81 82 83 84 85 86 87 88 89 90 91 92 93 TESTQ2 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 TEST4 110 111 112 113 114 115 116 117 118 119 TEST5 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 PARSE(INXML,INDOC) 177 178 179 180 181 182 ISMULT(ZOID) 183 184 185 186 187 188 189 FIRST(ZOID) 190 191 192 PARENT(ZOID) 193 194 195 ATT(RTN,NODE) 196 197 198 199 200 201 TAG(ZOID) 202 203 204 205 206 207 208 209 210 NXTSIB(ZOID) 211 212 213 DATA(ZT,ZOID) 214 215 216 217 218 219 220 OUTXML(ZRTN,INID) 221 222 223 224 225 226 227 228 229 230 NDOUT(ZOID) 231 232 233 234 235 236 237 238 239 240 241 242 243 244 UPDIE 245 246 247 248 249 250 251 252 253 254 1 C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05 2 ;;0.1;C0C;nopatch;noreleasedate;Build 1 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.
