Changeset 1544 for ccr/trunk/p/C0CDOM.m
- Timestamp:
- Oct 1, 2012, 9:32:46 PM (13 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
C0CDOM.m (modified) (1 diff, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p merged eligible /ccr/branches/ohum/o-old/p 1290 /ccr/branches/ohum/p/p 1287-1289
-
Property svn:mergeinfo
set to (toggle deleted branches)
-
ccr/trunk/p/C0CDOM.m
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p/C0CDOM.m merged eligible /ccr/branches/ohum/o-old/p/C0CDOM.m 1290 /ccr/branches/ohum/p/p/C0CDOM.m 1287-1289
r1336 r1544 1 1 C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05 2 ;;0.1;C0C;nopatch;noreleasedate;Build 38 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU4 ;General Public License See attached copy of the License.5 ;6 ;This program is free software; you can redistribute it and/or modify7 ;it under the terms of the GNU General Public License as published by8 ;the Free Software Foundation; either version 2 of the License, or9 ;(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 of13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ;GNU General Public License for more details.15 ;16 ;You should have received a copy of the GNU General Public License along17 ;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 Q21 ;2 ;;1.2;C0C;;May 11, 2012;Build 47 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 21 ; 22 22 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 23 ; THE XPATH INDEX ZXIDX, PASSED BY NAME24 ; THE XPATH ARRAY XPARY, PASSED BY NAME25 ; ZOID IS THE STARTING OID26 ; ZPATH IS THE STARTING XPATH, USUALLY "/"27 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE28 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT29 I $G(ZREDUX)="" S ZREDUX=""30 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY31 N NEWNUM S NEWNUM=""32 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"33 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE34 I $G(ZREDUX)'="" D ; REDUX PROVIDED?35 . N GT S GT=$P(NEWPATH,ZREDUX,2)36 . I GT'="" S NEWPATH=GT37 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX38 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE39 I $D(GA) D ; PROCESS THE ATTRIBUTES40 . N ZI S ZI=""41 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE42 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE43 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY44 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE45 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE46 I $D(GD(2)) D ;47 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY48 E I $D(GD(1)) D ;49 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY50 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY51 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD52 I ZFRST'=0 D ; THERE IS A CHILD53 . N ZNUM54 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE55 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD56 N GNXT S GNXT=$$NXTSIB(ZOID)57 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES58 I GNXT'=0 D ;59 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?60 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES61 . . N ZNUM S ZNUM=1 ;62 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB63 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB64 Q65 ;66 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY67 ;68 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES69 ;70 N ZZI,ZZJ,ZZN71 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY72 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE73 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY74 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .75 I ZZI'["]" D ; A SINGLETON76 . S ZZN=177 E D ; THERE IS AN [x] OCCURANCE78 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE79 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]80 I ZZJ'="" D ; TIME TO ADD THE VALUE81 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE82 Q83 ;23 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 24 ; THE XPATH ARRAY XPARY, PASSED BY NAME 25 ; ZOID IS THE STARTING OID 26 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 27 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 28 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 29 I $G(ZREDUX)="" S ZREDUX="" 30 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 31 N NEWNUM S NEWNUM="" 32 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 33 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 34 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 35 . N GT S GT=$P(NEWPATH,ZREDUX,2) 36 . I GT'="" S NEWPATH=GT 37 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 38 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 39 I $D(GA) D ; PROCESS THE ATTRIBUTES 40 . N ZI S ZI="" 41 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 42 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE 43 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 44 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 45 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 46 I $D(GD(2)) D ; 47 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 48 E I $D(GD(1)) D ; 49 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 50 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 51 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 52 I ZFRST'=0 D ; THERE IS A CHILD 53 . N ZNUM 54 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 55 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 56 N GNXT S GNXT=$$NXTSIB(ZOID) 57 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 58 I GNXT'=0 D ; 59 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 60 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 61 . . N ZNUM S ZNUM=1 ; 62 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 63 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 64 Q 65 ; 66 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 67 ; 68 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES 69 ; 70 N ZZI,ZZJ,ZZN 71 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 72 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 73 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 74 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 75 I ZZI'["]" D ; A SINGLETON 76 . S ZZN=1 77 E D ; THERE IS AN [x] OCCURANCE 78 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 79 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 80 I ZZJ'="" D ; TIME TO ADD THE VALUE 81 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 82 Q 83 ; 84 84 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 85 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW86 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML87 ;Q $$EN^MXMLDOM(INXML)88 Q $$EN^MXMLDOM(INXML,"W")89 ;85 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 86 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 87 ;Q $$EN^MXMLDOM(INXML) 88 Q $$EN^MXMLDOM(INXML,"W") 89 ; 90 90 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 91 N ZN92 ;I $$TAG(ZOID)["entry" B93 S ZN=$$NXTSIB(ZOID)94 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG95 Q 096 ;91 N ZN 92 ;I $$TAG(ZOID)["entry" B 93 S ZN=$$NXTSIB(ZOID) 94 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 95 Q 0 96 ; 97 97 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 98 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)99 ;98 Q $$CHILD^MXMLDOM(C0CDOCID,ZOID) 99 ; 100 100 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 101 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)102 ;101 Q $$PARENT^MXMLDOM(C0CDOCID,ZOID) 102 ; 103 103 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 104 S HANDLE=C0CDOCID105 K @RTN106 D GETTXT^MXMLDOM("A")107 Q108 ;104 S HANDLE=C0CDOCID 105 K @RTN 106 D GETTXT^MXMLDOM("A") 107 Q 108 ; 109 109 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 110 ;I ZOID=149 B ;GPLTEST111 N X,Y112 S Y=""113 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE114 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y115 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)116 Q Y117 ;110 ;I ZOID=149 B ;GPLTEST 111 N X,Y 112 S Y="" 113 S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 114 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 115 I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID) 116 Q Y 117 ; 118 118 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 119 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)120 ;119 Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID) 120 ; 121 121 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 122 ;N ZT,ZN S ZT=""123 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))124 ;Q $G(@C0CDOM@(ZOID,"T",1))125 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)126 Q127 ;122 ;N ZT,ZN S ZT="" 123 ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 124 ;Q $G(@C0CDOM@(ZOID,"T",1)) 125 S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT) 126 Q 127 ; 128 128 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 129 ;130 S C0CDOCID=INID131 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation132 D START^C0CMXMLB($$TAG(1),,"G",NO1ST)133 D NDOUT($$FIRST(1))134 D END^C0CMXMLB ;END THE DOCUMENT135 M @ZRTN=^TMP("MXMLBLD",$J)136 K ^TMP("MXMLBLD",$J)137 Q138 ;129 ; 130 S C0CDOCID=INID 131 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 132 D START^C0CMXMLB($$TAG(1),,"G",NO1ST) 133 D NDOUT($$FIRST(1)) 134 D END^C0CMXMLB ;END THE DOCUMENT 135 M @ZRTN=^TMP("MXMLBLD",$J) 136 K ^TMP("MXMLBLD",$J) 137 Q 138 ; 139 139 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 140 N ZI S ZI=$$FIRST(ZOID)141 I ZI'=0 D ; THERE IS A CHILD142 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT143 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN144 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT145 . ;W "DOING",ZOID,!146 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA147 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES148 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN149 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING150 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS151 Q152 ;153 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE154 ;155 N GN,GN2156 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML157 S GN2=$NA(@GN@(1))158 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")159 Q160 ;161 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY162 ; ZGOUT AND ZGIN ARE PASSED BY NAME163 N C0CDOCID164 W !,ZGOUT," ",ZGIN165 S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM166 D OUTXML(ZGOUT,C0CDOCID)167 Q168 ;169 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN170 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)171 ;172 ;GNARY("med",1,"doses.dose@dose")=10173 ;GNARY("med",1,"doses.dose@noun")="TABLET"174 ;GNARY("med",1,"doses.dose@route")="PO"175 ;GNARY("med",1,"doses.dose@schedule")="QD"176 ;GNARY("med",1,"doses.dose@units")="MG"177 ;GNARY("med",1,"doses.dose@unitsPerDose")=1178 ;GNARY("med",1,"facility@code")=100179 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"180 ;GNARY("med",1,"form@value")="TAB"181 ;GNARY("med",1,"id@value")="1N;O"182 ;GNARY("med",1,"location@code")=5183 ;GNARY("med",1,"location@name")="3 WEST"184 ;GNARY("med",1,"name@value")="LISINOPRIL TAB"185 ;GNARY("med",1,"orderID@value")=294186 ;GNARY("med",1,"ordered@value")=3110531.001233187 ;GNARY("med",1,"orderingProvider@code")=63188 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"189 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"190 ;GNARY("med",1,"products.product.vaGeneric@code")=1990191 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"192 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380193 ;GNARY("med",1,"products.product.vaProduct@code")=8118194 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"195 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593196 ;GNARY("med",1,"products.product@code")=6174197 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"198 ;GNARY("med",1,"products.product@role")="D"199 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"200 ;GNARY("med",1,"sig@xml:space")="preserve"201 ;GNARY("med",1,"status@value")="active"202 ;GNARY("med",1,"type@value")="OTC"203 ;GNARY("med",1,"vaType@value")="N"204 ;205 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM206 ; it returns 0 or 1 based on success.207 ;208 ; INARY is passed by name and has the format shown above209 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will210 ; be supported eventually - initial implementation is for MXML211 ;212 ; PARENT is the node id or tag of the parent under which the DOM will213 ; be populated. If it is numeric, it is a node. If it is a string, the DOM214 ; will be searched to find the tag. If not found and there is no root,215 ; it will be inserted as the root. If not found and there is a root, it216 ; will be inserted under the root.217 ;218 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")219 ; because "results" is the root tag. Use OUTXML to render the xml from220 ; the DOM.221 ;222 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM223 ;224 N ZPARNODE225 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0226 I '$D(INARY) Q 0 ; NO ARRAY PASSED227 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM228 ;I PARENT="" S PARENT="root"229 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID230 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL231 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE232 . S ZPARNODE=1 ;233 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET234 N ZEXARY235 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY236 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED237 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE238 Q HANDLE ; SUCCESS239 ;240 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES241 N ZI S ZI=""242 N ZTAG243 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION244 . N ZELEADD S ZELEADD=0245 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES246 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG247 . . K ZATT ; CLEAR OUT LAST ONE248 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY249 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE250 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE251 . I $O(@ZARY@(ZI,""))="" D ;END NODE252 . . S ZTAG=ZI ; USE ZI FOR THE TAG253 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE254 . . S ZELEADD=1 ; ADDED AN ELEMENT255 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE256 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL257 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING258 . N NEWARY ; INDENTED ARRAY259 . N ZN S ZN=0260 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE261 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG262 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY263 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY264 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG265 Q266 ;267 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED268 ; CONSISTENT FORMAT269 ; GNARY("patient",1,"facilities[2].facility@code")="050"270 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"271 ; for easier processing (this is fileman format genius)272 ; basically removes the dot notation from the strings273 ;274 N ZZI275 S ZZI=""276 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;277 . N ZZN S ZZN=0278 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;279 . . N ZZS S ZZS=""280 . . N GA ;PUSH STACK281 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;282 . . . K GA ; NEW STACK283 . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT284 . . . N ZZV ; PLACE TO STASH THE VALUE285 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE286 . . . W !,"VALUE:",ZZV287 . . . N GK ; COUNTER288 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE289 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]290 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG291 . . . . I GM["[" D ; IT'S A MULTIPLE292 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER293 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG294 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES295 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME296 . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG297 . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)298 . . . . E D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;299 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"300 . . . N GZI S GZI="" ; STRING FOR THE INDEX301 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS302 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG303 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY304 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE305 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST306 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME307 . . . W !,GZI308 . . . S @GZI2=ZZV ; REMEMBER THE VALUE?309 Q310 ;311 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE312 N CBK,SUCCESS,LEVEL,NODE,HANDLE313 K ^TMP("MXMLERR",$J)314 L +^TMP("MXMLDOM",$J):5315 E Q 0316 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""317 L -^TMP("MXMLDOM",$J)318 Q HANDLE319 ;140 N ZI S ZI=$$FIRST(ZOID) 141 I ZI'=0 D ; THERE IS A CHILD 142 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 143 . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN 144 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 145 . ;W "DOING",ZOID,! 146 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 147 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 148 . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 149 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 150 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 151 Q 152 ; 153 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 154 ; 155 N GN,GN2 156 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 157 S GN2=$NA(@GN@(1)) 158 W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 159 Q 160 ; 161 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 162 ; ZGOUT AND ZGIN ARE PASSED BY NAME 163 N C0CDOCID 164 W !,ZGOUT," ",ZGIN 165 S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM 166 D OUTXML(ZGOUT,C0CDOCID) 167 Q 168 ; 169 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN 170 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA) 171 ; 172 ;GNARY("med",1,"doses.dose@dose")=10 173 ;GNARY("med",1,"doses.dose@noun")="TABLET" 174 ;GNARY("med",1,"doses.dose@route")="PO" 175 ;GNARY("med",1,"doses.dose@schedule")="QD" 176 ;GNARY("med",1,"doses.dose@units")="MG" 177 ;GNARY("med",1,"doses.dose@unitsPerDose")=1 178 ;GNARY("med",1,"facility@code")=100 179 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION" 180 ;GNARY("med",1,"form@value")="TAB" 181 ;GNARY("med",1,"id@value")="1N;O" 182 ;GNARY("med",1,"location@code")=5 183 ;GNARY("med",1,"location@name")="3 WEST" 184 ;GNARY("med",1,"name@value")="LISINOPRIL TAB" 185 ;GNARY("med",1,"orderID@value")=294 186 ;GNARY("med",1,"ordered@value")=3110531.001233 187 ;GNARY("med",1,"orderingProvider@code")=63 188 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL" 189 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS" 190 ;GNARY("med",1,"products.product.vaGeneric@code")=1990 191 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL" 192 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380 193 ;GNARY("med",1,"products.product.vaProduct@code")=8118 194 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB" 195 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593 196 ;GNARY("med",1,"products.product@code")=6174 197 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D" 198 ;GNARY("med",1,"products.product@role")="D" 199 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY" 200 ;GNARY("med",1,"sig@xml:space")="preserve" 201 ;GNARY("med",1,"status@value")="active" 202 ;GNARY("med",1,"type@value")="OTC" 203 ;GNARY("med",1,"vaType@value")="N" 204 ; 205 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM 206 ; it returns 0 or 1 based on success. 207 ; 208 ; INARY is passed by name and has the format shown above 209 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will 210 ; be supported eventually - initial implementation is for MXML 211 ; 212 ; PARENT is the node id or tag of the parent under which the DOM will 213 ; be populated. If it is numeric, it is a node. If it is a string, the DOM 214 ; will be searched to find the tag. If not found and there is no root, 215 ; it will be inserted as the root. If not found and there is a root, it 216 ; will be inserted under the root. 217 ; 218 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results") 219 ; because "results" is the root tag. Use OUTXML to render the xml from 220 ; the DOM. 221 ; 222 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM 223 ; 224 N ZPARNODE 225 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0 226 I '$D(INARY) Q 0 ; NO ARRAY PASSED 227 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM 228 ;I PARENT="" S PARENT="root" 229 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID 230 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL 231 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE 232 . S ZPARNODE=1 ; 233 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET 234 N ZEXARY 235 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY 236 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED 237 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 238 Q HANDLE ; SUCCESS 239 ; 240 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 241 N ZI S ZI="" 242 N ZTAG 243 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION 244 . N ZELEADD S ZELEADD=0 245 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES 246 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG 247 . . K ZATT ; CLEAR OUT LAST ONE 248 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY 249 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE 250 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE 251 . I $O(@ZARY@(ZI,""))="" D ;END NODE 252 . . S ZTAG=ZI ; USE ZI FOR THE TAG 253 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE 254 . . S ZELEADD=1 ; ADDED AN ELEMENT 255 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE 256 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL 257 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING 258 . N NEWARY ; INDENTED ARRAY 259 . N ZN S ZN=0 260 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE 261 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG 262 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY 263 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY 264 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 265 Q 266 ; 267 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 268 ; CONSISTENT FORMAT 269 ; GNARY("patient",1,"facilities[2].facility@code")="050" 270 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" 271 ; for easier processing (this is fileman format genius) 272 ; basically removes the dot notation from the strings 273 ; 274 N ZZI 275 S ZZI="" 276 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; 277 . N ZZN S ZZN=0 278 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; 279 . . N ZZS S ZZS="" 280 . . N GA ;PUSH STACK 281 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; 282 . . . K GA ; NEW STACK 283 . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT 284 . . . N ZZV ; PLACE TO STASH THE VALUE 285 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE 286 . . . W !,"VALUE:",ZZV 287 . . . N GK ; COUNTER 288 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE 289 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] 290 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG 291 . . . . I GM["[" D ; IT'S A MULTIPLE 292 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER 293 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG 294 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES 295 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME 296 . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG 297 . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2) 298 . . . . E D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ; 299 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 300 . . . N GZI S GZI="" ; STRING FOR THE INDEX 301 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS 302 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG 303 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY 304 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE 305 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST 306 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME 307 . . . W !,GZI 308 . . . S @GZI2=ZZV ; REMEMBER THE VALUE? 309 Q 310 ; 311 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 312 N CBK,SUCCESS,LEVEL,NODE,HANDLE 313 K ^TMP("MXMLERR",$J) 314 L +^TMP("MXMLDOM",$J):5 315 E Q 0 316 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 317 L -^TMP("MXMLDOM",$J) 318 Q HANDLE 319 ; -
Property svn:mergeinfo
set to (toggle deleted branches)
Note:
See TracChangeset
for help on using the changeset viewer.
