Changeset 1569 for smart/trunk/p/C0SNHIN.m
- Timestamp:
- Oct 11, 2012, 1:42:56 PM (13 years ago)
- File:
-
- 1 edited
-
smart/trunk/p/C0SNHIN.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/p/C0SNHIN.m
r1540 r1569 1 C0SNHIN 2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 23 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 EN(ZRTN,ZDFN,ZPART,KEEP) 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 PQRI(ZOUT,KEEP) 38 39 40 41 42 43 44 45 46 47 48 49 PQRI2(ZRTN) 50 51 52 53 54 55 56 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 LOADSMRT 72 73 74 75 76 77 78 SMART 79 80 81 82 83 84 85 86 87 88 CCR 89 90 91 92 93 94 95 96 97 98 MED 99 100 101 102 103 104 105 106 107 108 CCD 109 110 111 112 113 114 115 116 117 118 TEST1 119 120 121 122 123 124 125 126 127 128 129 130 TEST2 131 132 133 134 135 136 137 138 139 TEST3 140 141 142 143 144 145 146 147 148 149 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) 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 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 ADDNARY(ZXP,ZVALUE) 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 PARSE(INXML,INDOC) 209 210 211 212 213 214 ISMULT(ZOID) 215 216 217 218 219 220 221 FIRST(ZOID) 222 223 224 PARENT(ZOID) 225 226 227 ATT(RTN,NODE) 228 229 230 231 232 233 TAG(ZOID) 234 235 236 237 238 239 240 241 242 NXTSIB(ZOID) 243 244 245 DATA(ZT,ZOID) 246 247 248 249 250 251 252 OUTXML(ZRTN,INID) 253 254 255 256 257 258 259 260 261 262 NDOUT(ZOID) 263 264 265 266 267 268 269 270 271 272 273 274 275 276 WNHIN(ZDFN) 277 278 279 280 281 282 283 284 TESTNARY 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 PRE(ZNODE) 305 306 307 308 309 310 311 312 313 314 315 316 317 318 MNARY(ZRTN,ZHANDLE,ZOID) 319 320 321 322 323 324 1 C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/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 ;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 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT 22 ; 23 K GARY,GNARY,GIDX,C0SDOCID 24 K ZRTN 25 N GN 26 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL 27 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM 28 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS 29 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML 30 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL 31 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 32 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS 33 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 34 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) 35 Q 36 ; 37 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE 38 ; 39 N ZG 40 S ZG=$NA(^TMP("PQRIXML",$J)) 41 K @ZG 42 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML 43 N C0SDOCID 44 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML 45 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS 46 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 47 Q 48 ; 49 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE 50 ; 51 ;N GG 52 D GETXML^C0SMXP("GG","PQRI ONE MEASURE") 53 D PROCESS(ZRTN,"GG","root",1) 54 Q 55 ; 56 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML 57 ; ZRTN IS PASSED BY REFERENCE 58 ; ZXML IS PASSED BY NAME 59 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED 60 ; 61 N GN 62 S GN=$NA(^TMP("C0SPROCESS",$J)) 63 K @GN 64 M @GN=@ZXML 65 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 66 K @GN 67 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS 68 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 69 Q 70 ; 71 LOADSMRT ; 72 ; 73 K ^GPL("SMART") 74 S GN=$NA(^GPL("SMART",1)) 75 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" 76 Q 77 ; 78 SMART ; TRY IT WITH SMART 79 ; 80 S GN=$NA(^GPL("SMART")) 81 ;K ^TMP("MXMLDOM",$J) 82 K ^TMP("MXMLERR",$J) 83 S C0SDOCID=$$PARSE(GN,"SMART") 84 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") 85 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 86 Q 87 ; 88 CCR ; TRY IT WITH A CCR 89 ; 90 S GN=$NA(^GPL("CCR")) 91 ;K ^TMP("MXMLDOM",$J) 92 K ^TMP("MXMLERR",$J) 93 S C0SDOCID=$$PARSE(GN,"CCR") 94 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") 95 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 96 Q 97 ; 98 MED ; TRY IT WITH A CCR MED SECTION 99 ; 100 S GN=$NA(^GPL("MED")) 101 K ^TMP("MXMLDOM",$J) 102 K ^TMP("MXMLERR",$J) 103 S C0SDOCID=$$PARSE(GN,"MED") 104 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") 105 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 106 Q 107 ; 108 CCD ; TRY IT WITH A CCD 109 ; 110 S GN=$NA(^GPL("CCD")) 111 ;K ^TMP("MXMLDOM",$J) 112 K ^TMP("MXMLERR",$J) 113 S C0SDOCID=$$PARSE(GN,"CCD") 114 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") 115 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 116 Q 117 ; 118 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 119 ; PARSED WITH MXML 120 ; RUN THROUGH XPATH 121 K GARY,GIDX,C0SDOCID 122 S GN=$NA(^GPL("NHIN")) 123 ;S GN=$NA(^GPL("DOMI")) 124 S C0SDOCID=$$PARSE(GN,"GPLTEST") 125 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") 126 K ^GPL("GNARY") 127 M ^GPL("GNARY")=GNARY 128 Q 129 ; 130 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") 131 ; 132 S GN=$NA(^GPL("GNARY")) 133 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") 134 D OUTXML^C0SDOM("G",C0SDOCID) 135 K ^GPL("DOMI") 136 M ^GPL("DOMI")=G 137 Q 138 ; 139 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 140 ; PARSED WITH MXML 141 ; RUN THROUGH XPATH 142 K GARY,GIDX,C0SDOCID 143 ;S GN=$NA(^GPL("NHIN")) 144 S GN=$NA(^GPL("DOMI")) 145 S C0SDOCID=$$PARSE(GN,"GPLTEST") 146 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") 147 Q 148 ; 149 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 150 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 151 ; THE XPATH ARRAY XPARY, PASSED BY NAME 152 ; ZOID IS THE STARTING OID 153 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 154 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 155 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 156 I $G(ZREDUX)="" S ZREDUX="" 157 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 158 N NEWNUM S NEWNUM="" 159 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 160 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 161 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 162 . N GT S GT=$P(NEWPATH,ZREDUX,2) 163 . I GT'="" S NEWPATH=GT 164 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 165 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 166 I $D(GA) D ; PROCESS THE ATTRIBUTES 167 . N ZI S ZI="" 168 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 169 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE 170 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 171 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 172 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 173 I $D(GD(2)) D ; 174 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 175 E I $D(GD(1)) D ; 176 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 177 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 178 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 179 I ZFRST'=0 D ; THERE IS A CHILD 180 . N ZNUM 181 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 182 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 183 N GNXT S GNXT=$$NXTSIB(ZOID) 184 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 185 I GNXT'=0 D ; 186 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 187 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 188 . . N ZNUM S ZNUM=1 ; 189 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 190 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 191 Q 192 ; 193 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 194 ; 195 N ZZI,ZZJ,ZZN 196 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 197 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 198 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 199 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 200 I ZZI'["]" D ; A SINGLETON 201 . S ZZN=1 202 E D ; THERE IS AN [x] OCCURANCE 203 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 204 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 205 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 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(C0SDOCID,ZOID) 223 ; 224 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 225 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) 226 ; 227 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 228 S HANDLE=C0SDOCID 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(C0SCBK("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(C0SDOCID,ZOID) 240 Q Y 241 ; 242 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 243 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) 244 ; 245 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 246 ;N ZT,ZN S ZT="" 247 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) 248 ;Q $G(@C0SDOM@(ZOID,"T",1)) 249 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) 250 Q 251 ; 252 OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 253 ; 254 S C0SDOCID=INID 255 D START^C0SMXMLB($$TAG(1),,"G") 256 D NDOUT($$FIRST(1)) 257 D END^C0SMXMLB ;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^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(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^C0SMXMLB("",$$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 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 277 ; 278 N GN,GN2 279 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 280 S GN2=$NA(@GN@(1)) 281 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 282 Q 283 ; 284 TESTNARY ; TEST MAKING A NHIN ARRAY 285 N ZI S ZI="" 286 N ZH ; DOM HANDLE 287 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM 288 S ZH=C0SDOCID ; SET THE HANDLE 289 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) 290 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE 291 . N ZATT 292 . D MNARY(.ZATT,ZH,ZI) 293 . N ZPRE,ZN 294 . S ZPRE=$$PRE(ZI) 295 . S ZN=$P(ZPRE,",",2) 296 . S ZPRE=$P(ZPRE,",",1) 297 . ;I $D(ZATT) ZWR ZATT 298 . N ZJ S ZJ="" 299 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE 300 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! 301 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) 302 Q 303 ; 304 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE 305 ; 306 N GI,GI2,GPT,GJ,GN 307 S GI=$$PARENT(ZNODE) ; PARENT NODE 308 I GI=0 Q "" ; NO PARENT 309 S GPT=$$TAG(GI) ; TAG OF PARENT 310 S GI2=$$PARENT(GI) ; PARENT OF PARENT 311 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT 312 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB 313 I GJ=ZNODE Q:$$TAG(GI)_",1" 314 F GN=2:1 Q:GJ=ZNODE D ; 315 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING 316 Q GPT_","_GN 317 ; 318 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE 319 ; RETURNED IN ZRTN, PASSED BY REFERENCE 320 ; ZHANDLE IS THE DOM DOCUMENT ID 321 ; ZOID IS THE DOM NODE 322 D ATT("ZRTN",ZOID) 323 Q 324 ;
Note:
See TracChangeset
for help on using the changeset viewer.
