Changeset 1569 for smart/trunk/p/C0SDOM.m
- Timestamp:
- Oct 11, 2012, 1:42:56 PM (13 years ago)
- File:
-
- 1 edited
-
smart/trunk/p/C0SDOM.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/p/C0SDOM.m
r1540 r1569 1 C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:052 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 23 ;Copyright 2011,2012 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 12 ;This program is distributed in the hope that it will be useful,13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ;GNU General Public License for more details.16 ;17 ;You should have received a copy of the GNU General Public License along18 ;with this program; if not, write to the Free Software Foundation, Inc.,19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.20 ;21 Q22 ;23 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE24 ; THE XPATH INDEX ZXIDX, PASSED BY NAME25 ; THE XPATH ARRAY XPARY, PASSED BY NAME26 ; ZOID IS THE STARTING OID27 ; ZPATH IS THE STARTING XPATH, USUALLY "/"28 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE29 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT30 I $G(ZREDUX)="" S ZREDUX=""31 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY32 N NEWNUM S NEWNUM=""33 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"34 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE35 I $G(ZREDUX)'="" D ; REDUX PROVIDED?36 . N GT S GT=$P(NEWPATH,ZREDUX,2)37 . I GT'="" S NEWPATH=GT38 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX39 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE40 I $D(GA) D ; PROCESS THE ATTRIBUTES41 . N ZI S ZI=""42 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE43 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE44 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY45 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE46 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE47 I $D(GD(2)) D ;48 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY49 E I $D(GD(1)) D ;50 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY51 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY52 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD53 I ZFRST'=0 D ; THERE IS A CHILD54 . N ZNUM55 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE56 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD57 N GNXT S GNXT=$$NXTSIB(ZOID)58 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES59 I GNXT'=0 D ;60 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?61 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES62 . . N ZNUM S ZNUM=1 ;63 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB64 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB65 Q66 ;67 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY68 ;69 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES70 ;71 N ZZI,ZZJ,ZZN72 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY73 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE74 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY75 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .76 I ZZI'["]" D ; A SINGLETON77 . S ZZN=178 E D ; THERE IS AN [x] OCCURANCE79 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE80 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]81 I ZZJ'="" D ; TIME TO ADD THE VALUE82 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE83 Q84 ;85 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME86 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW87 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML88 ;Q $$EN^MXMLDOM(INXML)89 Q $$EN^MXMLDOM(INXML,"W")90 ;91 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE92 N ZN93 ;I $$TAG(ZOID)["entry" B94 S ZN=$$NXTSIB(ZOID)95 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG96 Q 097 ;98 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID99 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)100 ;101 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID102 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)103 ;104 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID105 S HANDLE=C0SDOCID106 K @RTN107 D GETTXT^MXMLDOM("A")108 Q109 ;110 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE111 ;I ZOID=149 B ;GPLTEST112 N X,Y113 S Y=""114 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE115 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y116 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)117 Q Y118 ;119 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING120 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)121 ;122 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE123 ;N ZT,ZN S ZT=""124 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))125 ;Q $G(@C0SDOM@(ZOID,"T",1))126 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)127 Q128 ;129 OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM130 ;131 S C0SDOCID=INID132 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation133 D START^C0SMXMLB($$TAG(1),,"G",NO1ST)134 D NDOUT($$FIRST(1))135 D END^C0SMXMLB ;END THE DOCUMENT136 M @ZRTN=^TMP("MXMLBLD",$J)137 K ^TMP("MXMLBLD",$J)138 Q139 ;140 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE141 N ZI S ZI=$$FIRST(ZOID)142 I ZI'=0 D ; THERE IS A CHILD143 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT144 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN145 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT146 . ;W "DOING",ZOID,!147 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA148 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES149 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN150 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING151 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS152 Q153 ;154 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE155 ;156 N GN,GN2157 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML158 S GN2=$NA(@GN@(1))159 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")160 Q161 ;162 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY163 ; ZGOUT AND ZGIN ARE PASSED BY NAME164 N C0SDOCID165 W !,ZGOUT," ",ZGIN166 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM167 D OUTXML(ZGOUT,C0SDOCID)168 Q169 ;170 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN171 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)172 ;173 ;GNARY("med",1,"doses.dose@dose")=10174 ;GNARY("med",1,"doses.dose@noun")="TABLET"175 ;GNARY("med",1,"doses.dose@route")="PO"176 ;GNARY("med",1,"doses.dose@schedule")="QD"177 ;GNARY("med",1,"doses.dose@units")="MG"178 ;GNARY("med",1,"doses.dose@unitsPerDose")=1179 ;GNARY("med",1,"facility@code")=100180 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"181 ;GNARY("med",1,"form@value")="TAB"182 ;GNARY("med",1,"id@value")="1N;O"183 ;GNARY("med",1,"location@code")=5184 ;GNARY("med",1,"location@name")="3 WEST"185 ;GNARY("med",1,"name@value")="LISINOPRIL TAB"186 ;GNARY("med",1,"orderID@value")=294187 ;GNARY("med",1,"ordered@value")=3110531.001233188 ;GNARY("med",1,"orderingProvider@code")=63189 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"190 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"191 ;GNARY("med",1,"products.product.vaGeneric@code")=1990192 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"193 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380194 ;GNARY("med",1,"products.product.vaProduct@code")=8118195 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"196 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593197 ;GNARY("med",1,"products.product@code")=6174198 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"199 ;GNARY("med",1,"products.product@role")="D"200 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"201 ;GNARY("med",1,"sig@xml:space")="preserve"202 ;GNARY("med",1,"status@value")="active"203 ;GNARY("med",1,"type@value")="OTC"204 ;GNARY("med",1,"vaType@value")="N"205 ;206 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM207 ; it returns 0 or 1 based on success.208 ;209 ; INARY is passed by name and has the format shown above210 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will211 ; be supported eventually - initial implementation is for MXML212 ;213 ; PARENT is the node id or tag of the parent under which the DOM will214 ; be populated. If it is numeric, it is a node. If it is a string, the DOM215 ; will be searched to find the tag. If not found and there is no root,216 ; it will be inserted as the root. If not found and there is a root, it217 ; will be inserted under the root.218 ;219 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")220 ; because "results" is the root tag. Use OUTXML to render the xml from221 ; the DOM.222 ;223 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM224 ;225 N ZPARNODE226 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0227 I '$D(INARY) Q 0 ; NO ARRAY PASSED228 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM229 ;I PARENT="" S PARENT="root"230 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID231 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL232 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE233 . S ZPARNODE=1 ;234 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET235 N ZEXARY236 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY237 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED238 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE239 Q HANDLE ; SUCCESS240 ;241 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES242 N ZI S ZI=""243 N ZTAG244 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION245 . N ZELEADD S ZELEADD=0246 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES247 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG248 . . K ZATT ; CLEAR OUT LAST ONE249 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY250 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE251 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE252 . I $O(@ZARY@(ZI,""))="" D ;END NODE253 . . S ZTAG=ZI ; USE ZI FOR THE TAG254 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE255 . . S ZELEADD=1 ; ADDED AN ELEMENT256 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE257 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL258 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING259 . N NEWARY ; INDENTED ARRAY260 . N ZN S ZN=0261 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE262 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG263 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY264 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY265 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG266 Q267 ;268 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED269 ; CONSISTENT FORMAT270 ; GNARY("patient",1,"facilities[2].facility@code")="050"271 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"272 ; for easier processing (this is fileman format genius)273 ; basically removes the dot notation from the strings274 ;275 N ZZI276 S ZZI=""277 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;278 . N ZZN S ZZN=0279 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;280 . . N ZZS S ZZS=""281 . . N GA ;PUSH STACK282 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;283 . . . K GA ; NEW STACK284 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT285 . . . N ZZV ; PLACE TO STASH THE VALUE286 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE287 . . . W !,"VALUE:",ZZV288 . . . N GK ; COUNTER289 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE290 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]291 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG292 . . . . I GM["[" D ; IT'S A MULTIPLE293 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER294 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG295 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES296 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME297 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG298 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2)299 . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ;300 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"301 . . . N GZI S GZI="" ; STRING FOR THE INDEX302 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS303 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG304 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY305 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE306 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST307 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME308 . . . W !,GZI309 . . . S @GZI2=ZZV ; REMEMBER THE VALUE?310 Q311 ;312 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE313 N CBK,SUCCESS,LEVEL,NODE,HANDLE314 K ^TMP("MXMLERR",$J)315 L +^TMP("MXMLDOM",$J):5316 E Q 0317 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""318 L -^TMP("MXMLDOM",$J)319 Q HANDLE320 ;1 C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 2011,2012 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 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 Q 22 ; 23 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 24 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 25 ; THE XPATH ARRAY XPARY, PASSED BY NAME 26 ; ZOID IS THE STARTING OID 27 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 28 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 29 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 30 I $G(ZREDUX)="" S ZREDUX="" 31 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 32 N NEWNUM S NEWNUM="" 33 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 34 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 35 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 36 . N GT S GT=$P(NEWPATH,ZREDUX,2) 37 . I GT'="" S NEWPATH=GT 38 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 39 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 40 I $D(GA) D ; PROCESS THE ATTRIBUTES 41 . N ZI S ZI="" 42 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 43 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE 44 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 45 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 46 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 47 I $D(GD(2)) D ; 48 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 49 E I $D(GD(1)) D ; 50 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 51 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 52 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 53 I ZFRST'=0 D ; THERE IS A CHILD 54 . N ZNUM 55 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 56 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 57 N GNXT S GNXT=$$NXTSIB(ZOID) 58 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 59 I GNXT'=0 D ; 60 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 61 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 62 . . N ZNUM S ZNUM=1 ; 63 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 64 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 65 Q 66 ; 67 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 68 ; 69 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES 70 ; 71 N ZZI,ZZJ,ZZN 72 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 73 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 74 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 75 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 76 I ZZI'["]" D ; A SINGLETON 77 . S ZZN=1 78 E D ; THERE IS AN [x] OCCURANCE 79 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 80 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 81 I ZZJ'="" D ; TIME TO ADD THE VALUE 82 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 83 Q 84 ; 85 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 86 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 87 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 88 ;Q $$EN^MXMLDOM(INXML) 89 Q $$EN^MXMLDOM(INXML,"W") 90 ; 91 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 92 N ZN 93 ;I $$TAG(ZOID)["entry" B 94 S ZN=$$NXTSIB(ZOID) 95 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 96 Q 0 97 ; 98 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 99 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) 100 ; 101 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 102 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) 103 ; 104 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 105 S HANDLE=C0SDOCID 106 K @RTN 107 D GETTXT^MXMLDOM("A") 108 Q 109 ; 110 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 111 ;I ZOID=149 B ;GPLTEST 112 N X,Y 113 S Y="" 114 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 115 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 116 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) 117 Q Y 118 ; 119 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 120 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) 121 ; 122 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 123 ;N ZT,ZN S ZT="" 124 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) 125 ;Q $G(@C0SDOM@(ZOID,"T",1)) 126 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) 127 Q 128 ; 129 OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 130 ; 131 S C0SDOCID=INID 132 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 133 D START^C0SMXMLB($$TAG(1),,"G",NO1ST) 134 D NDOUT($$FIRST(1)) 135 D END^C0SMXMLB ;END THE DOCUMENT 136 M @ZRTN=^TMP("MXMLBLD",$J) 137 K ^TMP("MXMLBLD",$J) 138 Q 139 ; 140 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 141 N ZI S ZI=$$FIRST(ZOID) 142 I ZI'=0 D ; THERE IS A CHILD 143 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 144 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN 145 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 146 . ;W "DOING",ZOID,! 147 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 148 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 149 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 150 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 151 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 152 Q 153 ; 154 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 155 ; 156 N GN,GN2 157 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 158 S GN2=$NA(@GN@(1)) 159 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 160 Q 161 ; 162 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 163 ; ZGOUT AND ZGIN ARE PASSED BY NAME 164 N C0SDOCID 165 W !,ZGOUT," ",ZGIN 166 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM 167 D OUTXML(ZGOUT,C0SDOCID) 168 Q 169 ; 170 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN 171 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA) 172 ; 173 ;GNARY("med",1,"doses.dose@dose")=10 174 ;GNARY("med",1,"doses.dose@noun")="TABLET" 175 ;GNARY("med",1,"doses.dose@route")="PO" 176 ;GNARY("med",1,"doses.dose@schedule")="QD" 177 ;GNARY("med",1,"doses.dose@units")="MG" 178 ;GNARY("med",1,"doses.dose@unitsPerDose")=1 179 ;GNARY("med",1,"facility@code")=100 180 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION" 181 ;GNARY("med",1,"form@value")="TAB" 182 ;GNARY("med",1,"id@value")="1N;O" 183 ;GNARY("med",1,"location@code")=5 184 ;GNARY("med",1,"location@name")="3 WEST" 185 ;GNARY("med",1,"name@value")="LISINOPRIL TAB" 186 ;GNARY("med",1,"orderID@value")=294 187 ;GNARY("med",1,"ordered@value")=3110531.001233 188 ;GNARY("med",1,"orderingProvider@code")=63 189 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL" 190 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS" 191 ;GNARY("med",1,"products.product.vaGeneric@code")=1990 192 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL" 193 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380 194 ;GNARY("med",1,"products.product.vaProduct@code")=8118 195 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB" 196 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593 197 ;GNARY("med",1,"products.product@code")=6174 198 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D" 199 ;GNARY("med",1,"products.product@role")="D" 200 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY" 201 ;GNARY("med",1,"sig@xml:space")="preserve" 202 ;GNARY("med",1,"status@value")="active" 203 ;GNARY("med",1,"type@value")="OTC" 204 ;GNARY("med",1,"vaType@value")="N" 205 ; 206 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM 207 ; it returns 0 or 1 based on success. 208 ; 209 ; INARY is passed by name and has the format shown above 210 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will 211 ; be supported eventually - initial implementation is for MXML 212 ; 213 ; PARENT is the node id or tag of the parent under which the DOM will 214 ; be populated. If it is numeric, it is a node. If it is a string, the DOM 215 ; will be searched to find the tag. If not found and there is no root, 216 ; it will be inserted as the root. If not found and there is a root, it 217 ; will be inserted under the root. 218 ; 219 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results") 220 ; because "results" is the root tag. Use OUTXML to render the xml from 221 ; the DOM. 222 ; 223 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM 224 ; 225 N ZPARNODE 226 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0 227 I '$D(INARY) Q 0 ; NO ARRAY PASSED 228 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM 229 ;I PARENT="" S PARENT="root" 230 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID 231 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL 232 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE 233 . S ZPARNODE=1 ; 234 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET 235 N ZEXARY 236 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY 237 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED 238 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 239 Q HANDLE ; SUCCESS 240 ; 241 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 242 N ZI S ZI="" 243 N ZTAG 244 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION 245 . N ZELEADD S ZELEADD=0 246 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES 247 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG 248 . . K ZATT ; CLEAR OUT LAST ONE 249 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY 250 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE 251 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE 252 . I $O(@ZARY@(ZI,""))="" D ;END NODE 253 . . S ZTAG=ZI ; USE ZI FOR THE TAG 254 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE 255 . . S ZELEADD=1 ; ADDED AN ELEMENT 256 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE 257 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL 258 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING 259 . N NEWARY ; INDENTED ARRAY 260 . N ZN S ZN=0 261 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE 262 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG 263 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY 264 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY 265 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 266 Q 267 ; 268 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 269 ; CONSISTENT FORMAT 270 ; GNARY("patient",1,"facilities[2].facility@code")="050" 271 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" 272 ; for easier processing (this is fileman format genius) 273 ; basically removes the dot notation from the strings 274 ; 275 N ZZI 276 S ZZI="" 277 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; 278 . N ZZN S ZZN=0 279 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; 280 . . N ZZS S ZZS="" 281 . . N GA ;PUSH STACK 282 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; 283 . . . K GA ; NEW STACK 284 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT 285 . . . N ZZV ; PLACE TO STASH THE VALUE 286 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE 287 . . . W !,"VALUE:",ZZV 288 . . . N GK ; COUNTER 289 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE 290 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] 291 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG 292 . . . . I GM["[" D ; IT'S A MULTIPLE 293 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER 294 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG 295 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES 296 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME 297 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG 298 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) 299 . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; 300 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 301 . . . N GZI S GZI="" ; STRING FOR THE INDEX 302 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS 303 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG 304 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY 305 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE 306 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST 307 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME 308 . . . W !,GZI 309 . . . S @GZI2=ZZV ; REMEMBER THE VALUE? 310 Q 311 ; 312 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 313 N CBK,SUCCESS,LEVEL,NODE,HANDLE 314 K ^TMP("MXMLERR",$J) 315 L +^TMP("MXMLDOM",$J):5 316 E Q 0 317 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 318 L -^TMP("MXMLDOM",$J) 319 Q HANDLE 320 ;
Note:
See TracChangeset
for help on using the changeset viewer.
