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