Changeset 1569 for smart/trunk/p
- Timestamp:
- Oct 11, 2012, 1:42:56 PM (12 years ago)
- Location:
- smart/trunk/p
- Files:
-
- 13 edited
-
C0SDEM.m (modified) (1 diff)
-
C0SDOM.m (modified) (1 diff)
-
C0SLAB.m (modified) (1 diff)
-
C0SMART.m (modified) (1 diff)
-
C0SMED.m (modified) (1 diff)
-
C0SMXMLB.m (modified) (1 diff)
-
C0SNHIN.m (modified) (1 diff)
-
C0SNHINV.m (modified) (1 diff)
-
C0SPROB.m (modified) (1 diff)
-
C0SPROB2.m (modified) (1 diff)
-
C0STBL.m (modified) (1 diff)
-
C0SUTIL.m (modified) (1 diff)
-
C0SXPATH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/p/C0SDEM.m
r1540 r1569 1 C0SDEM 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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 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 PATIENT(GRTN,C0SARY) 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 AGES 279 280 281 282 283 284 285 286 287 288 289 1 C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 ;<?xml version="1.0" encoding="utf-8"?> 23 ;<rdf:RDF 24 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" 25 ; xmlns:sp="http://smartplatforms.org/terms#" 26 ; xmlns:dcterms="http://purl.org/dc/terms/" 27 ; xmlns:v="http://www.w3.org/2006/vcard/ns#" 28 ; xmlns:foaf="http://xmlns.com/foaf/0.1/"> 29 ; <sp:Demographics> 30 ; 31 ; <v:n> 32 ; <v:Name> 33 ; <v:given-name>Bob</v:given-name> 34 ; <v:additional-name>J</v:additional-name> 35 ; <v:family-name>Odenkirk</v:family-name> 36 ; </v:Name> 37 ; </v:n> 38 ; 39 ; <v:adr> 40 ; <v:Address> 41 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 42 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 43 ; 44 ; <v:street-address>15 Main St</v:street-address> 45 ; <v:extended-address>Apt 2</v:extended-address> 46 ; <v:locality>Wonderland</v:locality> 47 ; <v:region>OZ</v:region> 48 ; <v:postal-code>54321</v:postal-code> 49 ; <v:country>USA</v:country> 50 ; </v:Address> 51 ; </v:adr> 52 ; 53 ; <v:tel> 54 ; <v:Tel> 55 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 56 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 57 ; <rdf:value>800-555-1212</rdf:value> 58 ; </v:Tel> 59 ; </v:tel> 60 ; 61 ; <v:tel> 62 ; <v:Tel> 63 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" /> 64 ; <rdf:value>800-555-1515</rdf:value> 65 ; </v:Tel> 66 ; </v:tel> 67 ; 68 ; <foaf:gender>male</foaf:gender> 69 ; <v:bday>1959-12-25</v:bday> 70 ; <v:email>bob.odenkirk@example.com</v:email> 71 ; 72 ; <sp:medicalRecordNumber> 73 ; <sp:Code> 74 ; <dcterms:title>My Hospital Record 2304575</dcterms:title> 75 ; <dcterms:identifier>2304575</dcterms:identifier> 76 ; <sp:system>My Hospital Record</sp:system> 77 ; </sp:Code> 78 ; </sp:medicalRecordNumber> 79 ; 80 ; </sp:Demographics> 81 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?> 82 ;<rdf:RDF 83 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" 84 ; xmlns:sp="http://smartplatforms.org/terms#" 85 ; xmlns:dcterms="http://purl.org/dc/terms/" 86 ; xmlns:v="http://www.w3.org/2006/vcard/ns#" 87 ; xmlns:foaf="http://xmlns.com/foaf/0.1/"> 88 ; <sp:Demographics> 89 ; 90 ; <v:n> 91 ; <v:Name> 92 ; <v:given-name>Bob</v:given-name> 93 ; <v:additional-name>J</v:additional-name> 94 ; <v:family-name>Odenkirk</v:family-name> 95 ; </v:Name> 96 ; </v:n> 97 ; 98 ; <v:adr> 99 ; <v:Address> 100 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 101 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 102 ; 103 ; <v:street-address>15 Main St</v:street-address> 104 ; <v:extended-address>Apt 2</v:extended-address> 105 ; <v:locality>Wonderland</v:locality> 106 ; <v:region>OZ</v:region> 107 ; <v:postal-code>54321</v:postal-code> 108 ; <v:country>USA</v:country> 109 ; </v:Address> 110 ; </v:adr> 111 ; 112 ; <v:tel> 113 ; <v:Tel> 114 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 115 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 116 ; <rdf:value>800-555-1212</rdf:value> 117 ; </v:Tel> 118 ; </v:tel> 119 ; 120 ; <v:tel> 121 ; <v:Tel> 122 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" /> 123 ; <rdf:value>800-555-1515</rdf:value> 124 ; </v:Tel> 125 ; </v:tel> 126 ; 127 ; <foaf:gender>male</foaf:gender> 128 ; <v:bday>1959-12-25</v:bday> 129 ; <v:email>bob.odenkirk@example.com</v:email> 130 ; 131 ; <sp:medicalRecordNumber> 132 ; <sp:Code> 133 ; <dcterms:title>My Hospital Record 2304575</dcterms:title> 134 ; <dcterms:identifier>2304575</dcterms:identifier> 135 ; <sp:system>My Hospital Record</sp:system> 136 ; </sp:Code> 137 ; </sp:medicalRecordNumber> 138 ; 139 ; </sp:Demographics> 140 ;</rdf:RDF> 141 ;G(1)="nodeID:25591^rdf:type^v:Home" 142 ;G(2)="nodeID:25591^rdf:type^v:Pref" 143 ;G(3)="nodeID:25591^rdf:type^v:Tel" 144 ;G(4)="nodeID:25591^rdf:value^800-369-6403" 145 ;G(5)="nodeID:25611^rdf:type^v:Name" 146 ;G(6)="nodeID:25611^v:additional-name^N" 147 ;G(7)="nodeID:25611^v:family-name^Brooks" 148 ;G(8)="nodeID:25611^v:given-name^Brian" 149 ;G(9)="nodeID:25622^dcterms:identifier^981968" 150 ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" 151 ;G(11)="nodeID:25622^rdf:type^sp:Code" 152 ;G(12)="nodeID:25622^sp:system^My Hospital Record" 153 ;G(13)="nodeID:25623^rdf:type^v:Address" 154 ;G(14)="nodeID:25623^rdf:type^v:Home" 155 ;G(15)="nodeID:25623^rdf:type^v:Pref" 156 ;G(16)="nodeID:25623^v:locality^Bixby" 157 ;G(17)="nodeID:25623^v:postal-code^74008" 158 ;G(18)="nodeID:25623^v:region^OK" 159 ;G(19)="nodeID:25623^v:street-address^82 Lake St" 160 ;G(20)="smart:981968/demographics^foaf:gender^male" 161 ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" 162 ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" 163 ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" 164 ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" 165 ;G(25)="smart:981968/demographics^v:bday^1956-03-23" 166 ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" 167 ;G(27)="smart:981968/demographics^v:n^nodeID:25611" 168 ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" 169 Q 170 ; 171 PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, 172 ; is the return name of the graph created. "" if none 173 ; C0SARY is passed in by reference and is the NHIN array of patient 174 ; 175 I $O(C0SARY("patient",""))="" D Q ; 176 . I $D(DEBUG) W !,"No Patient array" 177 . S GRTN="" 178 S GRTN="" ; default to no patient 179 N C0SGRF 180 S C0SGRF="vistaSmart:"_ZPATID_"/patient" 181 S ZPAT=C0SGRF ; subject is the same as the graph name 182 I $D(DEBUG) W !,"Processing ",C0SGRF 183 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 184 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 185 N FARY S FARY="C0XFARY" 186 D USEFARY^C0XF2N(FARY) 187 D VOCINIT^C0XUTIL 188 ; 189 N ZPN,ZR 190 D STARTADD^C0XF2N 191 ; 192 ; First do the base demographic graph 193 ; 194 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient 195 N SEX S SEX=$G(@ZPN@("gender@value")) 196 I SEX="M" S SEX="male" 197 I SEX="F" S SEX="female" 198 S ZR("foaf:gender")=SEX 199 S ZR("rdf:type")="sp:Demographics" 200 S ZR("sp:belongsTo")=ZPAT 201 N PATIENT 202 S PATIENT=$P(ZPAT,"#",2) 203 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT 204 N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph 205 S ZR("sp:medicalRecordNumber")=NMREC 206 N NVADR S NVADR=$$ANONS^C0XF2N ; for address 207 S ZR("v:adr")=NVADR 208 N NNAME S NNAME=$$ANONS^C0XF2N ; for name 209 S ZR("v:n")=NNAME 210 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone 211 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists 212 N BDATE 213 S ZX="" 214 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format 215 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date 216 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens 217 I BDATE="" S BDATE="UNKNOWN" 218 N Z2,Z3 219 S Z2=$P(BDATE,"-",2) 220 S Z3=$P(BDATE,"-",3) 221 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 222 I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 223 S ZR("v:bday")=BDATE 224 I $D(C0SVISTA) D ; 225 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN 226 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN 227 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph 228 K ZR 229 ; 230 ; create address sub-graph 231 ; 232 S ZR("rdf:type")="v:Address" 233 S ZR("rdf:type")="v:Home" 234 S ZR("v:locality")=$G(@ZPN@("address@city")) 235 S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) 236 S ZR("v:region")=$G(@ZPN@("address@stateProvince")) 237 S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) 238 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address 239 K ZR 240 ; 241 ; create medical record subgraph 242 ; 243 S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) 244 S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") 245 S ZR("rdf:type")="sp:Code" 246 S ZR("sp:system")="VistA Patient Record" 247 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph 248 K ZR 249 ; 250 ; create name subgraph 251 ; 252 N ZNF,ZNL,ZNM,ZNAM 253 S ZR("rdf:type")="v:Name" 254 S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names 255 S ZNF=$P(ZX," ",1) ; first name is first piece 256 S ZNM=$P(ZX," ",2) ; middle names are the rest 257 S ZR("v:additional-name")=ZNM 258 S ZR("v:family-name")=$G(@ZPN@("familyName@value")) 259 S ZR("v:given-name")=ZNF 260 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph 261 K ZR 262 ; 263 ; create telephone subgraph 264 ; 265 D ; 266 . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) 267 . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph 268 . S ZR("rdf:type")="v:Tel" 269 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) 270 K ZR 271 ; 272 ; load the demographics graph and all sub graphs to the triple store 273 ; 274 D BULKLOAD^C0XF2N(.C0XFDA) 275 S GRTN=C0SGRF 276 Q 277 ; 278 AGES ; LIST ALL PATIENTS AND THEIR AGES 279 N ZI S ZI=0 280 F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT 281 . N ZDOB 282 . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB 283 . N ZNAME 284 . S ZNAME=$P(^DPT(ZI,0),U) 285 . N ZSEX 286 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") 287 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX 288 Q 289 ; -
smart/trunk/p/C0SDOM.m
r1540 r1569 1 C0SDOM 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 22 23 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 ADDNARY(ZXP,ZVALUE) 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 PARSE(INXML,INDOC) 86 87 88 89 90 91 ISMULT(ZOID) 92 93 94 95 96 97 98 FIRST(ZOID) 99 100 101 PARENT(ZOID) 102 103 104 ATT(RTN,NODE) 105 106 107 108 109 110 TAG(ZOID) 111 112 113 114 115 116 117 118 119 NXTSIB(ZOID) 120 121 122 DATA(ZT,ZOID) 123 124 125 126 127 128 129 OUTXML(ZRTN,INID,NO1ST) 130 131 132 133 134 135 136 137 138 139 140 NDOUT(ZOID) 141 142 143 144 145 146 147 148 149 150 151 152 153 154 WNHIN(ZDFN) 155 156 157 158 159 160 161 162 NARY2XML(ZGOUT,ZGIN) 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 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 DOMI(INARY,HANDLE,PARENT) 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 MAJOR(ZARY) 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 EXPAND(ZZOUT,ZZIN) 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 NEWDOM() 313 314 315 316 317 318 319 320 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 ; -
smart/trunk/p/C0SLAB.m
r1540 r1569 1 C0SLAB 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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 LAB(GRTN,C0SARY) 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 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 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 . I ZR("sp:unit")="" S ZR("sp:unit")=$G(@LRN@("test@value"))236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 SAMPLE 271 272 273 274 275 1 C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 ; sample VistA NHIN lab result 23 ; 24 ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 25 ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" 26 ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" 27 ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 28 ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" 29 ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" 30 ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" 31 ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" 32 ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" 33 ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 34 ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" 35 ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" 36 ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " 37 ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 38 ;^TMP("C0STBL",32,"lab",8,"result@value")=178 39 ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 40 ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" 41 ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" 42 ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" 43 ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" 44 ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" 45 ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" 46 ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" 47 ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 48 ; 49 ; sample Smart lab result triples 50 ; 51 ;G("loinc:29571-7","dcterms:identifier")="29571-7" 52 ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" 53 ;G("loinc:29571-7","rdf:type")="sp:Code" 54 ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" 55 ;G("loinc:38478-4","dcterms:identifier")="38478-4" 56 ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" 57 ;G("loinc:38478-4","rdf:type")="sp:Code" 58 ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" 59 ;G("qqWZZIew993","rdf:type")="sp:Attribution" 60 ;G("qqWZZIew993","sp:startDate")="2007-04-21" 61 ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" 62 ;G("qqWZZIew994","sp:value")="Normal" 63 ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" 64 ;G("qqWZZIew995","rdf:type")="sp:CodedValue" 65 ;G("qqWZZIew995","sp:code")="loinc:38478-4" 66 ;G("qqWZZIew997","rdf:type")="sp:Attribution" 67 ;G("qqWZZIew997","sp:startDate")="2007-09-08" 68 ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" 69 ;G("qqWZZIew998","sp:value")="Normal" 70 ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" 71 ;G("qqWZZIew999","rdf:type")="sp:CodedValue" 72 ;G("qqWZZIew999","sp:code")="loinc:29571-7" 73 ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" 74 ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" 75 ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" 76 ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" 77 ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" 78 ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" 79 ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" 80 ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" 81 ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" 82 ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" 83 ; 84 ; 85 ; another Smart example, this one with sp:quantitativeResult 86 ; 87 ;G("loinc:786-4","dcterms:identifier")="786-4" 88 ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" 89 ;G("loinc:786-4","rdf:type")="sp:Code" 90 ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" 91 ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" 92 ;G("nodeID:4439","sp:unit")="g/dL" 93 ;G("nodeID:4439","sp:value")=36.6 94 ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" 95 ;G("nodeID:4613","sp:unit")="g/dL" 96 ;G("nodeID:4613","sp:value")=32 97 ;G("nodeID:4672","rdf:type")="sp:Attribution" 98 ;G("nodeID:4672","sp:startDate")="2005-03-10" 99 ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" 100 ;G("nodeID:4866","sp:unit")="g/dL" 101 ;G("nodeID:4866","sp:value")=36 102 ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" 103 ;G("nodeID:4871","rdf:type")="sp:CodedValue" 104 ;G("nodeID:4871","sp:code")="loinc:786-4" 105 ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" 106 ;G("nodeID:5221","sp:normalRange")="nodeID:5282" 107 ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" 108 ;G("nodeID:5282","rdf:type")="sp:ValueRange" 109 ;G("nodeID:5282","sp:maximum")="nodeID:4866" 110 ;G("nodeID:5282","sp:minimum")="nodeID:4613" 111 ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" 112 ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" 113 ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" 114 ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" 115 ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" 116 ; 117 LAB(GRTN,C0SARY) ; GRTN, passed by reference, 118 ; is the return name of the graph created. "" if none 119 ; C0SARY is passed in by reference and is the NHIN array of lab 120 ; 121 I $O(C0SARY("lab",""))="" D Q ; 122 . I $D(DEBUG) W !,"No Labs" 123 S GRTN="" ; default to no labs 124 N C0SGRF 125 S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" 126 I $D(DEBUG) W !,"Processing ",C0SGRF 127 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 128 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 129 N FARY S FARY="C0XFARY" 130 D USEFARY^C0XF2N(FARY) 131 D VOCINIT^C0XUTIL 132 ; 133 D STARTADD^C0XF2N ; initialize to create triples 134 ; 135 N ZI S ZI="" 136 F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; 137 . N LRN,ZR ; ZR is the local array for building the new triples 138 . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result 139 . ; 140 . N RSLTID ; unique Id for this lab result 141 . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 142 . ; 143 . ; i don't like this because the same labs result gets a 144 . ; different ID every time it's reported. Can't trace it back to VistA 145 . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" 146 . ; .. either that or store an OID with the lab result - but that 147 . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 148 . ; 149 . N LOINC S LOINC=$G(@LRN@("loinc@value")) 150 . I LOINC="" D Q ; 151 . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" 152 . N LABTST S LABTST=$G(@LRN@("test@value")) 153 . I $D(DEBUG) D ; 154 . . W !,"Processing Lab Result ",RSLTID 155 . . W !,"test: ",LABTST 156 . . W !,"loinc: ",LOINC 157 . ; 158 . ; first do the base result graph 159 . ; 160 . S ZR("rdf:type")="sp:LabResult" 161 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results 162 . ; ie /vista/smart/99912345/lab_results 163 . ; 164 . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name 165 . S ZR("sp:labName")=LABNAME 166 . ; 167 . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result 168 . S ZR("sp:narrativeResult")=NARRSLT 169 . ; 170 . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result 171 . S ZR("sp:quantitativeResult")=QNTRSLT 172 . ; 173 . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected 174 . S ZR("sp:specimenCollected")=SPECCOLL 175 . ; 176 . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples 177 . K ZR ; clean up 178 . ; 179 . ; create the narrative result graph 180 . ; 181 . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L 182 . I IVAL'="" 183 . . S ZR("rdf:type")="sp:NarrativeResult" 184 . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L 185 . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" 186 . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" 187 . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" 188 . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" 189 . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) 190 . . K ZR 191 . ; 192 . ; create the quantitative result graph 193 . ; 194 . S ZR("rdf:type")="sp:QuantitativeResult" 195 . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph 196 . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph 197 . N HASNORMAL S HASNORMAL=0 198 . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 199 . I HASNORMAL S ZR("sp:normalRange")=NORMNM 200 . S ZR("sp:valueAndUnit")=VUNM 201 . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) 202 . K ZR 203 . ; 204 . ; create the normal range graph 205 . ; 206 . I HASNORMAL D ; 207 . . S ZR("rdf:type")="sp:ValueRange" 208 . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph 209 . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph 210 . . S ZR("sp:maximum")=MAXNM 211 . . S ZR("sp:minimum")=MINNM 212 . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) 213 . . K ZR 214 . . ; 215 . . ; create the maximum graph 216 . . ; 217 . . S ZR("rdf:type")="sp:ValueAndUnit" 218 . . S ZR("sp:unit")=$G(@LRN@("units@value")) 219 . . S ZR("sp:value")=$G(@LRN@("high@value")) 220 . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) 221 . . K ZR 222 . . ; 223 . . ; create the minimum graph 224 . . ; 225 . . S ZR("rdf:type")="sp:ValueAndUnit" 226 . . S ZR("sp:unit")=$G(@LRN@("units@value")) 227 . . S ZR("sp:value")=$G(@LRN@("low@value")) 228 . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) 229 . . K ZR 230 . ; 231 . ; create the value and unit graph 232 . ; 233 . S ZR("rdf:type")="sp:ValueAndUnit" 234 . S ZR("sp:unit")=$G(@LRN@("units@value")) 235 . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ;$G(@LRN@("test@value")) 236 . S ZR("sp:value")=$G(@LRN@("result@value")) 237 . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) 238 . K ZR 239 . ; 240 . ; create specimen collected graph 241 . ; 242 . S ZR("rdf:type")="sp:Attribution" 243 . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) 244 . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) 245 . K ZR 246 . ; 247 . ; create lab name graph - this contains the test name and code 248 . ; 249 . I LOINC'="" D ; 250 . . S ZR("rdf:type")="sp:CodedValue" 251 . . S ZR("dcterms:title")=LABTST 252 . . N LOINCNM S LOINCNM="loinc:"_LOINC 253 . . S ZR("sp:code")="loinc:"_LOINC 254 . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) 255 . . K ZR 256 . . S ZR("dcterms:identifier")=LOINC 257 . . S ZR("dcterms:title")=LABTST 258 . . S ZR("rdf:type")="sp:Code" 259 . . S ZR("sp:system")="http://loinc.org/codes/" 260 . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) 261 . . K ZR 262 . ; 263 . ; that's all for now folks (there is more to do like reference ranges 264 . ; and result values) 265 . ; 266 D BULKLOAD^C0XF2N(.C0XFDA) 267 S GRTN=C0SGRF 268 Q 269 ; 270 SAMPLE ; import sample lab tests to the triplestore 271 N GN 272 S GN=$NA(^rdf("lab_results")) 273 D INSRDF^C0XF2N(GN,"/smart/lab/samples") 274 Q 275 ; -
smart/trunk/p/C0SMART.m
r1540 r1569 1 C0SMART 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,ZPATID,ZTYP,ZFORM,DEBUG) 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 1 C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP 22 ; for patient ZPATID; ZFORM defaults to rdf 23 ; ZRTN is passed by reference 24 ; For now, ZPATID is the DFN 25 ; 26 I '$D(ZFORM) S ZFORM="rdf" 27 K ZRTN ; CLEAN RETURN 28 N C0SARY 29 I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") 30 E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) 31 I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; 32 . W !,"Error Retreiving Patient Record" 33 ; 34 K C0XFDA 35 ; 36 N C0SGR ; graph 37 ; 38 ; processing table 39 ; 40 N C0SCTRL 41 S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" 42 S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" 43 S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" 44 S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" 45 ; 46 I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; 47 N ZX 48 S ZX=C0SCTRL(ZTYP) 49 X ZX ; 50 ; 51 I '$D(C0SGR) Q ; 52 ; 53 D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) 54 ; 55 Q 56 ; -
smart/trunk/p/C0SMED.m
r1540 r1569 1 C0SMED 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 22 MED(GRTN,C0SARY) 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 RXNFN() 129 130 RXCUI(ZVUID) 131 132 133 134 135 136 137 138 139 140 141 142 NISTMAP(ZRXN) 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 1 C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 MED(GRTN,C0SARY) ; GRTN, passed by reference, 23 ; is the return name of the graph created. "" if none 24 ; C0SARY is passed in by reference and is the NHIN array of meds 25 ; 26 I $O(C0SARY("med",""))="" D Q ; 27 . I $D(DEBUG) W !,"No Meds" 28 S GRTN="" ; default to no meds 29 N C0SGRF 30 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP 31 I $D(DEBUG) W !,"Processing ",C0SGRF 32 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 33 N MEDTRP ; MEDS TRIPLES 34 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 35 N FARY S FARY="C0XFARY" 36 D USEFARY^C0XF2N(FARY) 37 D VOCINIT^C0XUTIL 38 ; 39 N DUPCHK S DUPCHK="" ; check for no duplicates 40 N ZI S ZI="" 41 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; 42 . N SDATE,SDTMP 43 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; 44 . . I $D(DEBUG) W !,"Expired Mediation, Skipping" 45 . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; 46 . . I $D(DEBUG) W !,"Inpatient Med, skipping" 47 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; 48 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" 49 . ; 50 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) 51 . I SDTMP="" D ; 52 . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) 53 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date 54 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens 55 . I SDATE="" S SDATE="UNKNOWN" 56 . N DNAME,VUID,DCODE,RXNORM,SIG 57 . S DNAME=$G(C0SARY("med",ZI,"name@value")) 58 . I DNAME="" D ; 59 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) 60 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) 61 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) 62 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) 63 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code 64 . I $P(RXNORM,"^",2)="RXNORM" D ; 65 . . S RXVER=$P(RXNORM,"^",3) 66 . . S RXNORM=$P(RXNORM,"^",1) 67 . E D Q ; 68 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" 69 . . I $D(DEBUG) W !,RXNORM 70 . I DNAME="" D Q ; 71 . . I $D(DEBUG) W !,"Error No Drug Name" 72 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) 73 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED 74 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF 75 . S DUPCHK(MEDGRF)="" 76 . I $D(DEBUG) D ; 77 . . W !,"Processing Medication ",MEDGRF 78 . . W !,DNAME 79 . . W !,RXNORM 80 . S SIG=$G(C0SARY("med",ZI,"sig")) 81 . I SIG["|" D ; 82 . . N SIGTMP 83 . . S SIGTMP=SIG 84 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig 85 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig 86 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig 87 . K C0XFARY 88 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) 89 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) 90 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject 91 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) 92 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) 93 . N NQTY,NQTY2,NFREQ,NFREQ2 94 . S NQTY=$$ANONS^C0XF2N ; anonomous subject 95 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) 96 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject 97 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) 98 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) 99 . I DOSE="" S DOSE="UNKNOWN" 100 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) 101 . I UNIT="" S UNIT="UNKNOWN" 102 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) 103 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) 104 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject 105 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject 106 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) 107 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) 108 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) 109 . I SCHED="" S SCHED="UNKNOWN" 110 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) 111 . I SCHUNIT="" S SCHUNIT="UNKNOWN" 112 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) 113 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) 114 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) 115 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) 116 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) 117 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) 118 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) 119 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) 120 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) 121 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) 122 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) 123 . D BULKLOAD^C0XF2N(.C0XFDA) 124 . K C0XFDA 125 S GRTN=C0SGRF 126 q 127 ; 128 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number 129 ; 130 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 131 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR 132 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT 133 I $G(ZVUID)="" Q "" 134 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED 135 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") 136 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES 137 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) 138 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED 139 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" 140 Q ZRSLT 141 ; 142 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 143 ; CONFORM TO NIST REQUIREMENTS 144 ;INPATIENT CERTIFICATION 145 I ZRXN=309362 S ZRXN=213169 146 I ZRXN=855318 S ZRXN=855320 147 I ZRXN=197361 S ZRXN=212549 148 ;OUTPATIENT CERTIFICATION 149 I ZRXN=310534 S ZRXN=205875 150 I ZRXN=617312 S ZRXN=617314 151 I ZRXN=310429 S ZRXN=200801 152 I ZRXN=628953 S ZRXN=628958 153 I ZRXN=745679 S ZRXN=630208 154 I ZRXN=311564 S ZRXN=979334 155 I ZRXN=836343 S ZRXN=836370 156 Q ZRXN 157 ; -
smart/trunk/p/C0SMXMLB.m
r1540 r1569 1 MXMLBLD 2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 23 4 5 6 7 8 START(DOC,DOCTYPE,FLAG,NO1ST) 9 10 11 12 13 14 15 16 END 17 18 19 20 21 22 ITEM(INDENT,TAG,ATT,VALUE) 23 24 25 26 27 28 29 MULTI(INDENT,TAG,ATT,DOITEM) 30 31 32 33 34 35 36 37 ATT(ATT) 38 39 40 41 42 43 44 Q(X) 45 46 47 48 49 50 51 52 53 54 XMLHDR() 55 56 57 OUTPUT(S) 58 59 60 61 62 63 CHARCHK(STR) 64 65 66 67 68 69 70 71 72 73 74 75 76 77 COMMENT(VAL) 78 79 80 81 82 83 84 85 86 PUSH(INDENT,TAG,ATT) 87 88 89 90 91 92 93 POP 94 95 96 97 98 99 100 BLS(I) 101 102 103 104 105 INDENT() 106 1 MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. 2 ;;8.0;KERNEL;;;Build 2 3 QUIT 4 ; 5 ;DOC - The top level tag 6 ;DOCTYPE - Want to include a DOCTYPE node 7 ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, 8 START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. 9 K ^TMP("MXMLBLD",$J) 10 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 11 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 12 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 13 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">") 14 Q 15 ; 16 END ;Call this once to close out the document 17 D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">") 18 I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) 19 K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") 20 Q 21 ; 22 ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item 23 N I,X 24 S ATT=$G(ATT) 25 I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q 26 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">") 27 Q 28 ;DOITEM is a callback to output the lower level. 29 MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule 30 N I,X,S 31 S ATT=$G(ATT) 32 D PUSH($G(INDENT),TAG,.ATT) 33 D @DOITEM 34 D POP 35 Q 36 ; 37 ATT(ATT) ;Output a string of attributes 38 I $D(ATT)<9 Q "" 39 N I,S,V 40 S S="",I="" 41 F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) 42 Q S 43 ; 44 Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 45 ;I X'[$C(34) Q $C(34)_X_$C(34) 46 I X'[$C(39) Q $C(39)_X_$C(39) 47 ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" 48 N Q,Y,I,Z S Q=$C(39),(Y,Z)="" 49 F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q 50 S Y=Y_$P(X,Q,$L(X,Q)) 51 ;Q $C(34)_Y_$C(34) 52 Q $C(39)_Y_$C(39) 53 ; 54 XMLHDR() ; -- provides current XML standard header 55 Q "<?xml version=""1.0"" encoding=""utf-8"" ?>" 56 ; 57 OUTPUT(S) ;Output 58 N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) 59 I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q 60 W S,! 61 Q 62 ; 63 CHARCHK(STR) ; -- replace xml character limits with entities 64 N A,I,X,Y,Z,NEWSTR 65 S (Y,Z)="" 66 ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z 67 ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" 68 I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) 69 I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" 70 I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" 71 I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" 72 I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" 73 ; 74 S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) 75 QUIT STR 76 ; 77 COMMENT(VAL) ;Add Comments 78 N I,L 79 ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q 80 I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q ;CHANGED BY GPL FOR GTM 81 S I="",L="<!--" 82 F S I=$O(ATT(I)) Q:I="" D OUTPUT(L_ATT(I)) S L="" 83 D OUTPUT("-->") 84 Q 85 ; 86 PUSH(INDENT,TAG,ATT) ;Write a TAG and save. 87 N CNT 88 S ATT=$G(ATT) 89 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") 90 S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG 91 Q 92 ; 93 POP ;Write last pushed tag and pop 94 N CNT,TAG,INDENT,X 95 S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 96 S INDENT=+X,TAG=$P(X,"^",2) 97 D OUTPUT($$BLS(INDENT)_"</"_TAG_">") 98 Q 99 ; 100 BLS(I) ;Return INDENT string 101 N S 102 S S="",I=$G(I) S:I>0 $P(S," ",I)=" " 103 Q S 104 ; 105 INDENT() ;Renturn indent level 106 Q +$G(^TMP("MXMLBLD",$J,"STK")) -
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 ; -
smart/trunk/p/C0SNHINV.m
r1540 r1569 1 C0SNHINV 2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 GTQ 41 42 43 RTN(X) 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 ALL() 67 68 69 70 ERR(X,VAL) 71 72 73 74 75 76 77 78 79 80 81 ESC(X) 82 83 84 85 86 87 88 89 90 91 92 ADD(X) 93 94 95 96 97 STRING(ARRAY) 98 99 100 101 102 103 104 105 106 107 FAC(X) 108 109 110 111 112 113 114 115 116 117 VUID(IEN,FILE) 118 1 C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version 2 ;;1.0;C0S;**1**;Oct 25, 2010;Build 11 3 ; 4 ; External References DBIA# 5 ; ------------------- ----- 6 ; ^DPT 10035 7 ; ^SC 10040 8 ; DIQ 2056 9 ; MPIF001 2701 10 ; VASITE 10112 11 ; XLFDT 10103 12 ; XLFSTR 10104 13 ; XUAF4 2171 14 ; 15 GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) 16 ; RPC = NHIN GET VISTA DATA 17 N ICN,NHINI,NHINTOTL 18 S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN 19 ; 20 ; parse & validate input parameters 21 S ICN=+$P(DFN,";",2),DFN=+$G(DFN) 22 I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) 23 I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ 24 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL 25 S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 26 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch 27 I STOP,$L(STOP,".")<2 S STOP=STOP_".24" 28 S ID=$G(ID) 29 ; 30 ; extract data 31 N NHINTYPE,NHINP,RTN 32 S NHINTYPE=TYPE D ADD("<results>") 33 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D 34 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q 35 . D @(RTN_"(DFN,START,STOP,MAX,ID)") 36 D ADD("</results>") 37 ; 38 I $G(NHINTOTL),$G(@NHIN@(1))="<results>" S @NHIN@(1)="<results total='"_NHINTOTL_"' >" 39 ; 40 GTQ ; end 41 Q 42 ; 43 RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X 44 S X=$$UP^XLFSTR(X),Y="NHINV" 45 I X="ACCESSION" S Y="NHINVLRA" 46 I X="ALLERGY" S Y="NHINVART" 47 I X="APPOINTMENT" S Y="NHINVAPT" 48 ; X="CONSULT" S Y="NHINVCON" 49 I X="DOCUMENT" S Y="NHINVTIU" 50 I X="IMMUNIZATION" S Y="NHINVIMM" 51 I X="LAB" S Y="NHINVLR" 52 I X="PANEL" S Y="NHINVLRO" 53 I X="MED" S Y="NHINVPS" 54 I X="RX" S Y="NHINVPSO" 55 ; X="ORDER" S Y="NHINVOR" 56 I X="PATIENT" S Y="NHINVPT" 57 I X="PROBLEM" S Y="NHINVPL" 58 I X="PROCEDURE" S Y="NHINVPRC" 59 I X="SURGERY" S Y="NHINVSR" 60 I X="VISIT" S Y="NHINVSIT" 61 I X="VITAL" S Y="NHINVIT" 62 I X="RADIOLOGY" S Y="NHINVRA" 63 I X="NEW" S Y="NHINVPR" 64 Q Y 65 ; 66 ALL() ; -- return string for all types of data 67 ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" 68 Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" 69 ; 70 ERR(X,VAL) ; -- return error message 71 N MSG S MSG="Error" 72 I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" 73 I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" 74 I X=99 S MSG="Unknown request" 75 ; 76 D ADD("<error>") 77 D ADD("<message>"_MSG_"</message>") 78 D ADD("</error>") 79 Q 80 ; 81 ESC(X) ; -- escape outgoing XML 82 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache 83 ; 84 N I,Y,QOT S QOT="""" 85 S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) 86 S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) 87 S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) 88 S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) 89 S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) 90 Q Y 91 ; 92 ADD(X) ; Add a line @NHIN@(n)=X 93 S NHINI=$G(NHINI)+1 94 S @NHIN@(NHINI)=X 95 Q 96 ; 97 STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string 98 N I,X,Y S Y="" 99 S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) 100 S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) 101 F S I=$O(ARRAY(I)) Q:I<1 D 102 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) 103 . I $E(X)=" " S Y=Y_$C(13,10)_X Q 104 . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X 105 Q Y 106 ; 107 FAC(X) ; -- return Institution file station# for location X 108 N HLOC,FAC,Y0,Y S Y="" 109 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien 110 ; Get P:4 via Med Ctr Div, if not directly linked 111 I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") 112 S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# 113 S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name 114 I $L(Y),'Y S $P(Y,U)=FAC 115 Q Y 116 ; 117 VUID(IEN,FILE) ; -- Return VUID for item 118 Q $$GET1^DIQ(FILE,IEN_",",99.99) -
smart/trunk/p/C0SPROB.m
r1540 r1569 1 C0SPROB 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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 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 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 PROB(GRTN,C0SARY) 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 1 C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 ; sample VistA NHIN problem list 23 ; 24 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" 25 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 26 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 27 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" 28 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 29 ;^TMP("C0STBL",91,"problem",1,"id@value")=100 30 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" 31 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" 32 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 33 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 34 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" 35 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 36 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 37 ;^TMP("C0STBL",91,"problem",1,"status@value")="A" 38 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 39 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 40 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" 41 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 42 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 43 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" 44 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 45 ;^TMP("C0STBL",91,"problem",2,"id@value")=108 46 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" 47 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 48 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 49 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" 50 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 51 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 52 ;^TMP("C0STBL",91,"problem",2,"status@value")="A" 53 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 54 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 55 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" 56 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 57 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 58 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" 59 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 60 ;^TMP("C0STBL",91,"problem",3,"id@value")=109 61 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" 62 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 63 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 64 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" 65 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 66 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 67 ;^TMP("C0STBL",91,"problem",3,"status@value")="A" 68 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 69 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 70 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 71 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 72 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" 73 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" 74 ;^TMP("C0STBL",91,"problem",4,"id@value")=115 75 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" 76 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" 77 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 78 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" 79 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 80 ;^TMP("C0STBL",91,"problem",4,"status@value")="A" 81 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 82 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 83 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 84 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 85 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" 86 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 87 ;^TMP("C0STBL",91,"problem",5,"id@value")=116 88 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" 89 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 90 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 91 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" 92 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 93 ;^TMP("C0STBL",91,"problem",5,"status@value")="A" 94 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 95 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 96 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 97 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 98 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" 99 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 100 ;^TMP("C0STBL",91,"problem",6,"id@value")=117 101 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" 102 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 103 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 104 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" 105 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 106 ;^TMP("C0STBL",91,"problem",6,"status@value")="A" 107 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 108 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 109 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 110 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 111 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" 112 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 113 ;^TMP("C0STBL",91,"problem",7,"id@value")=118 114 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" 115 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 116 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 117 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" 118 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 119 ;^TMP("C0STBL",91,"problem",7,"status@value")="A" 120 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 121 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 122 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 123 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 124 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" 125 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" 126 ;^TMP("C0STBL",91,"problem",8,"id@value")=119 127 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" 128 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," 129 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 130 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" 131 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 132 ;^TMP("C0STBL",91,"problem",8,"status@value")="A" 133 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 134 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 135 ; 136 ; sample Smart lab result triples 137 ; 138 ;G("node16rk1fgdvx10882","code")="snomed:40930008" 139 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" 140 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" 141 ;G("node16rk1fgdvx11051","code")="snomed:188155002" 142 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 143 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" 144 ;G("node16rk1fgdvx11073","code")="snomed:353295004" 145 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" 146 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" 147 ;G("node16rk1fgdvx11089","code")="snomed:54302000" 148 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" 149 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" 150 ;G("node16rk1fgdvx11351","code")="snomed:38341003" 151 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" 152 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" 153 ;G("node16rk1fgdvx11390","code")="snomed:44054006" 154 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" 155 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" 156 ;G("node16rk1fgdvx11558","code")="snomed:195967001" 157 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" 158 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" 159 ;G("node16rk1fgdvx11578","code")="snomed:254837009" 160 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" 161 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" 162 ;G("node16rk1fgdvx11687","code")="snomed:8517006" 163 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" 164 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" 165 ;G("node16rk1fgdvx11716","code")="snomed:55822004" 166 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" 167 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" 168 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" 169 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" 170 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" 171 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" 172 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" 173 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" 174 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" 175 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" 176 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" 177 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" 178 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" 179 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" 180 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" 181 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" 182 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" 183 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" 184 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" 185 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" 186 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" 187 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" 188 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" 189 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" 190 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" 191 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" 192 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" 193 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" 194 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" 195 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" 196 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" 197 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" 198 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" 199 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" 200 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" 201 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" 202 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" 203 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" 204 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" 205 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" 206 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" 207 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" 208 ;G("snomed:188155002","dcterms:identifier")=188155002 209 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 210 ;G("snomed:188155002","rdf:type")="sp:Code" 211 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 212 ;G("snomed:195967001","dcterms:identifier")=195967001 213 ;G("snomed:195967001","dcterms:title")="Asthma" 214 ;G("snomed:195967001","rdf:type")="sp:Code" 215 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 216 ;G("snomed:254837009","dcterms:identifier")=254837009 217 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" 218 ;G("snomed:254837009","rdf:type")="sp:Code" 219 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 220 ;G("snomed:353295004","dcterms:identifier")=353295004 221 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" 222 ;G("snomed:353295004","rdf:type")="sp:Code" 223 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 224 ;G("snomed:38341003","dcterms:identifier")=38341003 225 ;G("snomed:38341003","dcterms:title")="Essential hypertension" 226 ;G("snomed:38341003","rdf:type")="sp:Code" 227 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 228 ;G("snomed:40930008","dcterms:identifier")=40930008 229 ;G("snomed:40930008","dcterms:title")="Hypothyroidism" 230 ;G("snomed:40930008","rdf:type")="sp:Code" 231 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 232 ;G("snomed:44054006","dcterms:identifier")=44054006 233 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" 234 ;G("snomed:44054006","rdf:type")="sp:Code" 235 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 236 ;G("snomed:54302000","dcterms:identifier")=54302000 237 ;G("snomed:54302000","dcterms:title")="Disorder of breast" 238 ;G("snomed:54302000","rdf:type")="sp:Code" 239 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 240 ;G("snomed:55822004","dcterms:identifier")=55822004 241 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" 242 ;G("snomed:55822004","rdf:type")="sp:Code" 243 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 244 ;G("snomed:8517006","dcterms:identifier")=8517006 245 ;G("snomed:8517006","dcterms:title")="History of tobacco use" 246 ;G("snomed:8517006","rdf:type")="sp:Code" 247 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" 248 249 ; 250 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 251 ; is the return name of the graph created. "" if none 252 ; C0SARY is passed in by reference and is the NHIN array of problems 253 ; 254 I $O(C0SARY("problem",""))="" D Q ; 255 . I $D(DEBUG) W !,"No Problems" 256 S GRTN="" ; default to no problems 257 N C0SGRF 258 S C0SGRF="vistaSmart:"_ZPATID_"/problems" 259 I $D(DEBUG) W !,"Processing ",C0SGRF 260 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 261 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 262 N FARY S FARY="C0XFARY" 263 D USEFARY^C0XF2N(FARY) 264 D VOCINIT^C0XUTIL 265 ; 266 D STARTADD^C0XF2N ; initialize to create triples 267 ; 268 N ZI S ZI="" 269 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; 270 . N LRN,ZR ; ZR is the local array for building the new triples 271 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result 272 . ; 273 . N PROBID ; unique Id for this problem 274 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 275 . ; 276 . ; i don't like this because the same problems gets a 277 . ; different ID every time it's reported. Can't trace it back to VistA 278 . ; I'd rather be using id@value ie "id@value")="118" 279 . ; 280 . N SNOMED S SNOMED=$G(@LRN@("icd@value")) 281 . N SNOGRF S SNOGRF="snomed:"_SNOMED 282 . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) 283 . I $D(DEBUG) D ; 284 . . W !,"Processing Problem List ",PROBID 285 . . W !,"problem: ",SNOTIT 286 . . W !,"code: ",SNOMED 287 . ; 288 . ; first do the base result graph 289 . ; 290 . S ZR("rdf:type")="sp:Problem" 291 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems 292 . ; ie /vista/smart/99912345/problems 293 . ; 294 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name 295 . S ZR("sp:problemName")=PROBNAME 296 . ; 297 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) 298 . S ZR("sp:startDate")=STARTDT 299 . ; 300 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples 301 . K ZR ; clean up 302 . ; 303 . ; create the problemName graph 304 . ; 305 . S ZR("rdf:type")="sp:CodedValue" 306 . S ZR("sp:code")="snomed:"_SNOMED 307 . S ZR("dcterms:title")=$G(@LRN@("name@value")) 308 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) 309 . K ZR 310 . ; 311 . ; create snomed graph 312 . ; 313 . S ZR("rdf:type")="sp:Code" 314 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" 315 . S ZR("dcterms:identifier")=SNOMED 316 . S ZR("dcterms:title")=SNOTIT 317 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) 318 . K ZR 319 . ; 320 D BULKLOAD^C0XF2N(.C0XFDA) 321 S GRTN=C0SGRF 322 Q 323 ; -
smart/trunk/p/C0SPROB2.m
r1540 r1569 1 C0SPROB 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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 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 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 PROB(GRTN,C0SARY) 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 SNOMED(ZICD) 332 333 334 335 336 337 338 339 340 341 342 343 1 C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 ; sample VistA NHIN problem list 23 ; 24 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" 25 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 26 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 27 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" 28 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 29 ;^TMP("C0STBL",91,"problem",1,"id@value")=100 30 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" 31 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" 32 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 33 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 34 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" 35 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 36 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 37 ;^TMP("C0STBL",91,"problem",1,"status@value")="A" 38 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 39 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 40 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" 41 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 42 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 43 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" 44 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 45 ;^TMP("C0STBL",91,"problem",2,"id@value")=108 46 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" 47 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 48 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 49 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" 50 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 51 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 52 ;^TMP("C0STBL",91,"problem",2,"status@value")="A" 53 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 54 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 55 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" 56 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 57 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 58 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" 59 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 60 ;^TMP("C0STBL",91,"problem",3,"id@value")=109 61 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" 62 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 63 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 64 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" 65 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 66 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 67 ;^TMP("C0STBL",91,"problem",3,"status@value")="A" 68 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 69 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 70 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 71 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 72 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" 73 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" 74 ;^TMP("C0STBL",91,"problem",4,"id@value")=115 75 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" 76 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" 77 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 78 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" 79 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 80 ;^TMP("C0STBL",91,"problem",4,"status@value")="A" 81 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 82 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 83 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 84 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 85 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" 86 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 87 ;^TMP("C0STBL",91,"problem",5,"id@value")=116 88 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" 89 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 90 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 91 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" 92 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 93 ;^TMP("C0STBL",91,"problem",5,"status@value")="A" 94 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 95 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 96 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 97 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 98 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" 99 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 100 ;^TMP("C0STBL",91,"problem",6,"id@value")=117 101 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" 102 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 103 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 104 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" 105 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 106 ;^TMP("C0STBL",91,"problem",6,"status@value")="A" 107 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 108 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 109 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 110 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 111 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" 112 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 113 ;^TMP("C0STBL",91,"problem",7,"id@value")=118 114 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" 115 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 116 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 117 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" 118 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 119 ;^TMP("C0STBL",91,"problem",7,"status@value")="A" 120 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 121 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 122 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 123 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 124 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" 125 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" 126 ;^TMP("C0STBL",91,"problem",8,"id@value")=119 127 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" 128 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," 129 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 130 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" 131 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 132 ;^TMP("C0STBL",91,"problem",8,"status@value")="A" 133 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 134 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 135 ; 136 ; sample Smart lab result triples 137 ; 138 ;G("node16rk1fgdvx10882","code")="snomed:40930008" 139 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" 140 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" 141 ;G("node16rk1fgdvx11051","code")="snomed:188155002" 142 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 143 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" 144 ;G("node16rk1fgdvx11073","code")="snomed:353295004" 145 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" 146 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" 147 ;G("node16rk1fgdvx11089","code")="snomed:54302000" 148 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" 149 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" 150 ;G("node16rk1fgdvx11351","code")="snomed:38341003" 151 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" 152 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" 153 ;G("node16rk1fgdvx11390","code")="snomed:44054006" 154 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" 155 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" 156 ;G("node16rk1fgdvx11558","code")="snomed:195967001" 157 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" 158 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" 159 ;G("node16rk1fgdvx11578","code")="snomed:254837009" 160 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" 161 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" 162 ;G("node16rk1fgdvx11687","code")="snomed:8517006" 163 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" 164 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" 165 ;G("node16rk1fgdvx11716","code")="snomed:55822004" 166 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" 167 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" 168 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" 169 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" 170 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" 171 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" 172 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" 173 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" 174 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" 175 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" 176 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" 177 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" 178 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" 179 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" 180 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" 181 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" 182 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" 183 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" 184 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" 185 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" 186 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" 187 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" 188 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" 189 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" 190 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" 191 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" 192 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" 193 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" 194 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" 195 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" 196 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" 197 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" 198 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" 199 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" 200 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" 201 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" 202 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" 203 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" 204 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" 205 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" 206 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" 207 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" 208 ;G("snomed:188155002","dcterms:identifier")=188155002 209 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 210 ;G("snomed:188155002","rdf:type")="sp:Code" 211 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 212 ;G("snomed:195967001","dcterms:identifier")=195967001 213 ;G("snomed:195967001","dcterms:title")="Asthma" 214 ;G("snomed:195967001","rdf:type")="sp:Code" 215 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 216 ;G("snomed:254837009","dcterms:identifier")=254837009 217 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" 218 ;G("snomed:254837009","rdf:type")="sp:Code" 219 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 220 ;G("snomed:353295004","dcterms:identifier")=353295004 221 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" 222 ;G("snomed:353295004","rdf:type")="sp:Code" 223 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 224 ;G("snomed:38341003","dcterms:identifier")=38341003 225 ;G("snomed:38341003","dcterms:title")="Essential hypertension" 226 ;G("snomed:38341003","rdf:type")="sp:Code" 227 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 228 ;G("snomed:40930008","dcterms:identifier")=40930008 229 ;G("snomed:40930008","dcterms:title")="Hypothyroidism" 230 ;G("snomed:40930008","rdf:type")="sp:Code" 231 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 232 ;G("snomed:44054006","dcterms:identifier")=44054006 233 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" 234 ;G("snomed:44054006","rdf:type")="sp:Code" 235 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 236 ;G("snomed:54302000","dcterms:identifier")=54302000 237 ;G("snomed:54302000","dcterms:title")="Disorder of breast" 238 ;G("snomed:54302000","rdf:type")="sp:Code" 239 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 240 ;G("snomed:55822004","dcterms:identifier")=55822004 241 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" 242 ;G("snomed:55822004","rdf:type")="sp:Code" 243 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 244 ;G("snomed:8517006","dcterms:identifier")=8517006 245 ;G("snomed:8517006","dcterms:title")="History of tobacco use" 246 ;G("snomed:8517006","rdf:type")="sp:Code" 247 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" 248 249 ; 250 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 251 ; is the return name of the graph created. "" if none 252 ; C0SARY is passed in by reference and is the NHIN array of problems 253 ; 254 I $O(C0SARY("problem",""))="" D Q ; 255 . I $D(DEBUG) W !,"No Problems" 256 S GRTN="" ; default to no problems 257 N C0SGRF 258 S C0SGRF="vistaSmart:"_ZPATID_"/problems" 259 I $D(DEBUG) W !,"Processing ",C0SGRF 260 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 261 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 262 N FARY S FARY="C0XFARY" 263 D USEFARY^C0XF2N(FARY) 264 D VOCINIT^C0XUTIL 265 ; 266 D STARTADD^C0XF2N ; initialize to create triples 267 ; 268 N ZI S ZI="" 269 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; 270 . N LRN,ZR ; ZR is the local array for building the new triples 271 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result 272 . ; 273 . N PROBID ; unique Id for this problem 274 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 275 . ; 276 . ; i don't like this because the same problems gets a 277 . ; different ID every time it's reported. Can't trace it back to VistA 278 . ; I'd rather be using id@value ie "id@value")="118" 279 . ; 280 . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) 281 . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map 282 . N SNOGRF ; graph for SNOMED code 283 . I SNOMED="" D ; 284 . . S SNOMED=ICD ; if not found, return the ICD code 285 . . S SNOGRF="icd9:"_SNOMED 286 . E S SNOGRF="snomed:"_SNOMED 287 . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) 288 . I $D(DEBUG) D ; 289 . . W !,"Processing Problem List ",PROBID 290 . . W !,"problem: ",SNOTIT 291 . . W !,"code: ",SNOMED 292 . ; 293 . ; first do the base result graph 294 . ; 295 . S ZR("rdf:type")="sp:Problem" 296 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems 297 . ; ie /vista/smart/99912345/problems 298 . ; 299 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name 300 . S ZR("sp:problemName")=PROBNAME 301 . ; 302 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) 303 . S ZR("sp:startDate")=STARTDT 304 . ; 305 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples 306 . K ZR ; clean up 307 . ; 308 . ; create the problemName graph 309 . ; 310 . S ZR("rdf:type")="sp:CodedValue" 311 . ;S ZR("sp:code")="snomed:"_SNOMED 312 . S ZR("sp:code")=SNOGRF 313 . S ZR("dcterms:title")=$G(@LRN@("name@value")) 314 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) 315 . K ZR 316 . ; 317 . ; create snomed graph 318 . ; 319 . S ZR("rdf:type")="sp:Code" 320 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" 321 . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" 322 . S ZR("dcterms:identifier")=SNOMED 323 . S ZR("dcterms:title")=SNOTIT 324 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) 325 . K ZR 326 . ; 327 D BULKLOAD^C0XF2N(.C0XFDA) 328 S GRTN=C0SGRF 329 Q 330 ; 331 SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code 332 ; requires the mapping table installed in the triplestore 333 ; 334 N ZSN,ZARY,ZSUB,ZSUBS 335 I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots 336 D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code 337 S ZSUB=$O(ZSUBS("")) ; pick the first one 338 I ZSUB="" Q "" 339 D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") 340 S ZSN=$O(ZARY("")) 341 I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") 342 Q ZSN 343 ; -
smart/trunk/p/C0STBL.m
r1540 r1569 1 C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 3 ;Copyright 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(BEGDFN,DFNCNT,ZPART) ; START IS A DFN 22 I '$D(BEGDFN) S BDGDFN="" 23 I '$D(DFNCNT) S DFNCNT=150 24 I '$D(ZPART) S ZPART="" 25 N ZTBL S ZTBL=$NA(^TMP("C0STBL")) 26 N ZI,ZCNT,ZG 27 S ZI=BEGDFN 28 S ZCNT=0 29 F S ZI=$O(^DPT(ZI)) Q:(+ZI=0)!(ZCNT>DFNCNT) D ; 30 . S ZCNT=ZCNT+1 31 . W ZI," " 32 . K ZG 33 . D EN^C0SNHIN(.ZG,ZI,ZPART) 34 . M @ZTBL@(ZI)=ZG 35 . K G 36 . ;D EN^C0SMART(.G,ZI,"med") 37 . ;I $D(G) W !,$$output^C0XGET1("G") 38 . ;k G 39 . ;D EN^C0SMART(.G,ZI,"patient") 40 . ;I $D(G) W !,$$output^C0XGET1("G") 41 . ;K G 42 . ;D EN^C0SMART(.G,ZI,"lab") 43 . ;I $D(G) W !,$$output^C0XGET1("G") 44 . ;K G 45 . D EN^C0SMART(.G,ZI,"problem") 46 . ;I $D(G) W !,$$output^C0XGET1("G") 47 Q 48 ; 49 LOADHACK ; 50 N ZI 51 F ZI=2:1:374 D ; 52 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") 53 Q 54 ; 1 C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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(BEGDFN,DFNCNT,ZPART) ; START IS A DFN 22 I '$D(BEGDFN) S BDGDFN="" 23 I '$D(DFNCNT) S DFNCNT=150 24 I '$D(ZPART) S ZPART="" 25 N ZTBL S ZTBL=$NA(^TMP("C0STBL")) 26 N ZI,ZCNT,ZG 27 S ZI=$O(^DPT(BEGDFN),-1) 28 S ZCNT=1 29 F S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT)) D ; 30 . S ZCNT=ZCNT+1 31 . W ZI," " 32 . K ZG 33 . D EN^C0SNHIN(.ZG,ZI,ZPART) 34 . M @ZTBL@(ZI)=ZG 35 . K G 36 . N GDIR S GDIR="/home/vista/p/" 37 . D EN^C0SMART(.G,ZI,"med") 38 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR) 39 . k G 40 . D EN^C0SMART(.G,ZI,"patient") 41 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR) 42 . K G 43 . D EN^C0SMART(.G,ZI,"lab") 44 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR) 45 . K G 46 . D EN^C0SMART(.G,ZI,"problem") 47 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR) 48 Q 49 ; 50 LOADHACK ; 51 N ZI 52 F ZI=2:1:374 D ; 53 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") 54 Q 55 ; 56 LABCNT ; COUNT LAB TESTS AND LOINC CODES 57 K LABCNT,GLOINC,PATCNT 58 S (LABCNT,GLOINC,PATCNT)=0 59 N ZI S ZI="" 60 N GN S GN=$NA(^TMP("C0STBL")) 61 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 62 . S PATCNT=PATCNT+1 63 . I '$D(@GN@(ZI,"lab")) Q ; 64 . N ZJ S ZJ="" 65 . F S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ="" D ; 66 . . S LABCNT=LABCNT+1 67 . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value")) 68 . . I X'="" S GLOINC=GLOINC+1 69 W !,"Total number of patients: ",PATCNT 70 W !,"Total number of lab results: ",LABCNT 71 W !,"Total number of lab results with loinc codes: ",GLOINC 72 W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%" 73 Q 74 ; 75 PROBCNT ; COUNT PROBLEMS AND SNOMED CODES 76 K PROBCNT,GSNO,PATCNT 77 S (PROBCNT,GSNO,PATCNT)=0 78 N ZI S ZI="" 79 N GN S GN=$NA(^TMP("C0STBL")) 80 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 81 . S PATCNT=PATCNT+1 82 . I '$D(@GN@(ZI,"problem")) Q ; 83 . N ZJ S ZJ="" 84 . F S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ="" D ; 85 . . S PROBCNT=PROBCNT+1 86 . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value")) 87 . . S Y=$$SNOMED^C0SPROB2(X) 88 . . I Y'="" S GSNO=GSNO+1 89 W !,"Total number of patients: ",PATCNT 90 W !,"Total number of problems: ",PROBCNT 91 W !,"Total number of problems with snomed codes: ",GSNO 92 W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%" 93 Q 94 ; 95 MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS 96 K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE 97 S (MEDCNT,OMED,GSNO,PATCNT)=0 98 N ZI S ZI="" 99 N GN S GN=$NA(^TMP("C0STBL")) 100 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 101 . S PATCNT=PATCNT+1 102 . I '$D(@GN@(ZI,"med")) Q ; 103 . N ZJ S ZJ="" 104 . F S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ="" D ; 105 . . S MEDCNT=MEDCNT+1 106 . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D Q ; 107 . . . I $D(DEBUG) W !,"Expired Mediation, Skipping" 108 . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D Q ; 109 . . . I $D(DEBUG) W !,"Inpatient Med, skipping" 110 . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D Q ; 111 . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" 112 . . S OMED=OMED+1 113 . . S X=$G(@GN@(ZI,"med",ZJ,"form@value")) 114 . . S FORM(X)=$G(FORM(X))+1 115 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose")) 116 . . I X="" S X="UNKNOWN" 117 . . S DOSE(X)=$G(DOSE(X))+1 118 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units")) 119 . . I X="" S X="UNKNOWN" 120 . . S UNITS(X)=$G(UNITS(X))+1 121 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule")) 122 . . I X="" S X="UNKNOWN" 123 . . S SCHED(X)=$G(SCHED(X))+1 124 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route")) 125 . . I X="" S X="UNKNOWN" 126 . . S ROUTE(X)=$G(ROUTE(X))+1 127 W !,"Total number of patients: ",PATCNT 128 W !,"Total number of medications: ",MEDCNT 129 W !,"Total number of outpatient medications: ",OMED 130 W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",! 131 ZWR FORM 132 ZWR DOSE 133 ZWR UNITS 134 ZWR SCHED 135 ZWR ROUTE 136 Q 137 ; -
smart/trunk/p/C0SUTIL.m
r1540 r1569 1 C0SUTIL 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 22 SPDATE(ZDATE) 23 24 25 26 27 28 29 30 31 32 33 34 1 C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 2 ;;0.1;C0S;nopatch;noreleasedate;Build 2 3 ;Copyright 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 ; 22 SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd 23 ; ZDATE is a fileman format date 24 N TMPDT 25 S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date 26 S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens 27 I TMPDT="" S TMPDT="UNKNOWN" 28 N Z2,Z3 29 S Z2=$P(TMPDT,"-",2) 30 S Z3=$P(TMPDT,"-",3) 31 I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 32 I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 33 Q TMPDT 34 ; -
smart/trunk/p/C0SXPATH.m
r1540 r1569 1 C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am2 ;;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 22 23 24 OUTPUT(OUTARY,OUTNAME,OUTDIR) 25 26 27 28 29 30 31 32 PUSH(STK,VAL) 33 34 35 36 37 38 39 40 POP(STK,VAL) 41 42 43 44 45 46 47 48 49 50 51 52 PUSHA(ADEST,ASRC) 53 54 55 56 57 58 59 MKMDX(STK,RTN,INREDUX) 60 61 62 63 64 65 66 67 68 69 70 71 72 XNAME(ISTR) 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 XVAL(ISTR) 88 89 90 91 92 93 VDX2VDV(OUTVDV,INVDX) 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 VDX2XPG(OUTXPG,INVDX) 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 XML2XPG(OUTXPG,INXML) 130 131 132 133 134 135 136 137 DO 138 139 140 141 T1 142 143 144 145 146 147 148 149 XPG2XML(OUTXML,INXPG) 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 ZXO(WHAT) 191 192 193 194 195 ZXC(WHAT) 196 197 198 199 200 ZXVAL(WHAT,VAL) 201 202 203 204 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 MKLASD(OUTBUF,INARY) 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 CLEAN(STR,TR) 327 328 329 330 331 332 333 334 335 336 QUERY(IARY,XPATH,OARY) 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 XF(IDX,XPATH) 361 362 363 364 365 XL(IDX,XPATH) 366 367 368 369 370 START(ISTR) 371 372 373 374 375 FINISH(ISTR) 376 377 378 379 ARRAY(ISTR) 380 381 382 383 BUILD(BLIST,BDEST) 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 QUEUE(BLST,ARRAY,FIRST,LAST) 402 403 404 405 406 407 CP(CPSRC,CPDEST) 408 409 410 411 412 413 414 415 416 417 418 419 QOPEN(QOBLIST,QOXML,QOXPATH) 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 QCLOSE(QCBLIST,QCXML,QCXPATH) 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 INSERT(INSXML,INSNEW,INSXPATH) 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 INSINNER(INNXML,INNNEW,INNXPATH) 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 INSB4(XDEST,XNEW) 507 508 509 510 511 512 513 514 515 516 517 REPLACE(REXML,RENEW,REXPATH) 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 DELETE(REXML,REXPATH) 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 MISSING(IXML,OARY) 558 559 560 561 562 563 564 565 566 567 568 569 MAP(IXML,INARY,OXML) 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 DOFLD 600 601 602 603 TRIM(THEXML) 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 UNMARK(XSEC) 642 643 644 645 646 647 648 649 PARY(GLO,ZN) 650 651 652 653 654 655 656 657 H2ARY(IARYRTN,IHASH,IPRE) 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 XVARS(XVRTN,XVIXML) 684 685 686 687 688 689 690 691 692 693 694 DXVARS(DXIN) 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 TEST 711 712 713 714 ZTEST(WHICH) 715 716 717 718 719 720 721 TLIST 722 723 724 725 726 1 C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 2 ;;1.0;C0S;;May 19, 2009;Build 2 3 ;Copyright 2008-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 W "This is an XML XPATH utility library",! 21 W ! 22 Q 23 ; 24 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 25 ; 26 N Y 27 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 28 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR 29 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR 30 Q 31 ; 32 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 33 ; VAL IS A STRING AND STK IS PASSED BY NAME 34 ; 35 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 36 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 37 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 38 Q 39 ; 40 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 41 ; VAL AND STK ARE PASSED BY REFERENCE 42 ; 43 I @STK@(0)<1 D ; IF ARRAY IS EMPTY 44 . S VAL="" 45 . S @STK@(0)=0 46 I @STK@(0)>0 D ; 47 . S VAL=@STK@(@STK@(0)) 48 . K @STK@(@STK@(0)) 49 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 50 Q 51 ; 52 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME 53 ; 54 N ZGI 55 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY 56 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT 57 Q 58 ; 59 MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 60 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS 61 ; REDUX IS A STRING TO REMOVE FROM THE RESULT 62 S RTN="" 63 N I 64 ; W "STK= ",STK,! 65 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 66 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 67 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 68 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 69 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) 70 Q 71 ; 72 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 73 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 74 ; ISTR IS PASSED BY VALUE 75 N CUR,TMP 76 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 77 . S TMP=$P(ISTR,"<",2) 78 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 79 . S TMP=$P(TMP,"/",2) 80 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 81 ; W "CUR= ",CUR,! 82 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 83 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 84 ; W "CUR2= ",CUR,! 85 Q CUR 86 ; 87 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML 88 ; <NAME>VALUE</NAME> WILL RETURN VALUE 89 N G 90 S G=$P(ISTR,">",2) ;STRIP OFF <NAME> 91 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE 92 ; 93 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV 94 ; VDX: @INVDX@(XPATH)=VALUE 95 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE 96 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE 97 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS 98 ; @VDV@("XPATH",X1X2X3X4)="XPATH" 99 N ZA,ZI,ZW 100 S ZI="" 101 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 102 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME 103 . W ZW,! 104 . S @OUTVDV@(ZW)=@INVDX@(ZI) 105 . S @OUTVDV@("XPATH",ZW)=ZI 106 Q 107 ; 108 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG 109 ; VDX: @VDX@(XPATH)=VALUE 110 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE 111 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX 112 N ZA,ZI,ZW 113 S ZI="" 114 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 115 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // 116 . S ZW2=$P(ZW,"/",1) 117 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) 118 . ;ZWR ZA 119 . S ZW2=ZA(1) 120 . F ZK=2:1:ZA(0) D ; 121 . . S ZW2=ZW2_""","""_ZA(ZK) 122 . K ZA 123 . S ZW2=""""_ZW2_"""" 124 . W ZW2,! 125 . S ZN=OUTXPG_"("_ZW2_")" 126 . S @ZN=@INVDX@(ZI) 127 Q 128 ; 129 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY 130 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE 131 ; 132 ;N G1 133 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED 134 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM 135 Q 136 ; 137 DO 138 D XPG2XML("^GPL2B","^GPL2A") 139 Q 140 ; 141 T1 ; TEST OUT THESE ROUTINES 142 D XML2XPG("G2","^GPL") 143 D XPG2XML("G3","G2") 144 K ^GPLOUT 145 M ^GPLOUT=G3 146 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") 147 Q 148 ; 149 XPG2XML(OUTXML,INXPG) ; 150 N C0CN,FWD,ZA,G,GA,ZQ 151 S ZQ=0 ; QUIT FLAG 152 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING 153 . I '$D(C0CN) D ; FIRST TIME THROUGH 154 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR 155 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS 156 . . S G=$Q(@INXPG) ; THIS ONE 157 . . S GN=$Q(@G) ; NEXT ONE 158 . . S C0CN=1 ; SUBSCRIPT COUNT 159 . . S ZQ=0 ; QUIT FLAG 160 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML 161 . . I $QS(G,1)="ContinuityOfCareRecord" D ; 162 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK 163 . I FWD D ; GOING FORWARDS 164 . . I C0CN<$QL(G) D ; NOT A DATA NODE 165 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 166 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT 167 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ; 168 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">" 169 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE 170 . . E D ; AT THE DATA NODE 171 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 172 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE 173 . . . S FWD=0 ; GO BACKWARDS 174 . I 'FWD D ;GOING BACKWARDS 175 . . S GN=$Q(@G) ;NEXT XPATH 176 . . ;W "NEXT!",GN,! 177 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT 178 . . I GN'="" D ; 179 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT 180 . . . . D ZXC($QS(G,C0CN)) ; 181 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL 182 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH 183 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT 184 . . . . S FWD=1 ; GOING FORWARD NOW 185 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE 186 . . D ZXC($QS(G,C0CN)) ; LAST ONE 187 . . S ZQ=1 ; QUIT NOW 188 Q 189 ; 190 ZXO(WHAT) 191 D PUSH("GA",WHAT) 192 D PUSH(OUTXML,"<"_WHAT_">") 193 Q 194 ; 195 ZXC(WHAT) 196 D POP("GA",.TMP) 197 D PUSH(OUTXML,"</"_WHAT_">") 198 Q 199 ; 200 ZXVAL(WHAT,VAL) 201 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">") 202 Q 203 ; 204 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 205 ; an XPATH index; REDUX is a string to be removed from each xpath 206 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME 207 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE 208 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG 209 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME 210 ; @VDX@("XPATH")=VALUE 211 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE 212 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 213 ; XML SECTION 214 ; IZXML IS PASSED BY NAME 215 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE 216 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT 217 N C0CSTK ; LEAVE OUT FOR DEBUGGING 218 I '$D(REDUX) S REDUX="" 219 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX 220 N ZXML 221 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD 222 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP 223 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM 224 . S I="",LCNT=0 225 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 226 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY 227 I LCNT=0 D Q ; NO XML PASSED 228 . W "ERROR IN XML FILE",! 229 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX 230 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX 231 S C0CSTK(0)=0 ; INITIALIZE STACK 232 K LKASD ; KILL LOOKASIDE ARRAY 233 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES 234 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY 235 . S LINE=@IZXML@(I) 236 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED 237 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 238 . ;W LINE,! 239 . S FOUND=0 ; INTIALIZED FOUND FLAG 240 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 241 . I FOUND'=1 D 242 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 243 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS 244 . . . ; ON THE SAME LINE 245 . . . ; W "FOUND ",LINE,! 246 . . . S FOUND=1 ; SET FOUND FLAG 247 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 248 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 249 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 250 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX 251 . . . ; W "MDX=",MDX,! 252 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 253 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 254 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 255 . . . . ;W "DUP:",MDX,! 256 . . . . ;I '$D(CURVAL) S CURVAL="" 257 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL 258 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 259 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 260 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST 261 . . . . S CURVAL=$$XVAL(LINE) ; VALUE 262 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE 263 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED 264 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED 265 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS 266 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2) 267 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 268 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END 269 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 270 . . . ; W "FOUND ",LINE,! 271 . . . S FOUND=1 ; SET FOUND FLAG 272 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 273 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 274 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 275 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 276 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE 277 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 278 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 279 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING 280 . . . . Q 281 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING 282 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 283 . . . ; W "FOUND ",LINE,! 284 . . . S FOUND=1 ; SET FOUND FLAG 285 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 286 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 287 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 288 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 289 . . . ; W "MDX=",MDX,! 290 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 291 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 292 . . . . ;B 293 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 294 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 295 S @ZXML@("INDEXED")="" 296 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH 297 I NOINX K @ZXML ; DELETE UNWANTED INDEX 298 Q 299 ; 300 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES 301 ; 302 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 303 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY 304 . S ZLINE=@IZXML@(ZI) 305 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1) 306 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION 307 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME 308 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION 309 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 310 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE 311 . . . . S OUTBUF(CUR,ZI+1)="" 312 ;ZWR OUTBUF 313 S ZI="" 314 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE 315 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE 316 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; 317 . S OUTBUF(ZI,ZN)="" 318 S ZA=1,ZI="",ZN="" 319 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] 320 . S ZN="",ZA=1 321 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; 322 . . S OUTBUF(ZI,ZN)="["_ZA_"]" 323 . . S ZA=ZA+1 324 Q 325 ; 326 CLEAN(STR,TR) ; extrinsic function; returns string 327 ;; Removes all non printable characters from a string. 328 ;; STR by Value 329 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE 330 N TR,I 331 I '$D(TR) D ; 332 . F I=0:1:31 S TR=$G(TR)_$C(I) 333 . S TR=TR_$C(127) 334 QUIT $TR(STR,TR) 335 ; 336 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 337 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 338 ; IARY AND OARY ARE PASSED BY NAME 339 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 340 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 341 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 342 N TMP,I,J,QXPATH 343 S FIRST=1 344 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE 345 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK 346 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 347 I XPATH'="//" D ; NOT A ROOT QUERY 348 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 349 . S FIRST=$P(TMP,"^",1) 350 . S LAST=$P(TMP,"^",2) 351 K @OARY 352 S @OARY@(0)=+LAST-FIRST+1 353 S J=1 354 FOR I=FIRST:1:LAST D 355 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 356 . S J=J+1 357 ; ZWR OARY 358 Q 359 ; 360 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 361 ; INDEX WITH TWO PIECES START^FINISH 362 ; IDX IS PASSED BY NAME 363 Q $P(@IDX@(XPATH),"^",1) 364 ; 365 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 366 ; INDEX WITH TWO PIECES START^FINISH 367 ; IDX IS PASSED BY NAME 368 Q $P(@IDX@(XPATH),"^",2) 369 ; 370 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 371 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 372 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 373 Q $P(ISTR,";",2) 374 ; 375 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 376 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 377 Q $P(ISTR,";",3) 378 ; 379 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 380 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 381 Q $P(ISTR,";",1) 382 ; 383 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 384 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 385 ; DEST IS CLEARED TO START 386 ; USES PUSH TO DO THE COPY 387 N I 388 K @BDEST 389 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 390 . N J,ATMP 391 . S ATMP=$$ARRAY(@BLIST@(I)) 392 . I $G(DEBUG) W "ATMP=",ATMP,! 393 . I $G(DEBUG) W @BLIST@(I),! 394 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 395 . . ; FOR EACH LINE IN THIS INSTR 396 . . I $G(DEBUG) W "BDEST= ",BDEST,! 397 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 398 . . D PUSH(BDEST,@ATMP@(J)) 399 Q 400 ; 401 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 402 ; 403 I $G(DEBUG) W "QUEUEING ",BLST,! 404 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 405 Q 406 ; 407 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 408 ; KILLS CPDEST FIRST 409 N CPINSTR 410 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! 411 I @CPSRC@(0)<1 D ; BAD LENGTH 412 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 413 . Q 414 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 415 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 416 D BUILD("CPINSTR",CPDEST) 417 Q 418 ; 419 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 420 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 421 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 422 ; USED TO INSERT CHILDREN NODES 423 I @QOXML@(0)<1 D ; MALFORMED XML 424 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 425 . Q 426 I $G(DEBUG) W "DOING QOPEN",! 427 N S1,E1,QOT,QOTMP 428 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 429 I $D(QOXPATH) D ; XPATH PROVIDED 430 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 431 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 432 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 433 . S E1=@QOXML@(0)-1 434 D QUEUE(QOBLIST,QOXML,S1,E1) 435 ; S QOTMP=QOXML_"^"_S1_"^"_E1 436 ; D PUSH(QOBLIST,QOTMP) 437 Q 438 ; 439 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 440 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 441 ; USED TO FINISH INSERTING CHILDERN NODES 442 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 443 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 444 I @QCXML@(0)<1 D ; MALFORMED XML 445 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 446 I $G(DEBUG) W "GOING TO CLOSE",! 447 N S1,E1,QCT,QCTMP 448 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 449 I $D(QCXPATH) D ; XPATH PROVIDED 450 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 451 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 452 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 453 . S S1=@QCXML@(0) 454 D QUEUE(QCBLIST,QCXML,S1,E1) 455 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 456 Q 457 ; 458 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 459 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 460 ; OMITTED, INSERTION WILL BE AT THE ROOT 461 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 462 ; XML AT THE END OF THE XPATH POINT 463 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 464 N INSBLD,INSTMP 465 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 466 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 467 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY 468 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 469 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 470 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH 471 . I $D(INSXPATH) D ; XPATH PROVIDED 472 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 473 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") 474 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 475 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 476 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML 477 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 478 . I $D(INSXPATH) D ; XPATH PROVIDED 479 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 480 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 481 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 482 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 483 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 484 Q 485 ; 486 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 487 ; INTO INNXML AT THE INNXPATH XPATH POINT 488 ; 489 N INNBLD,UXPATH 490 N INNTBUF 491 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 492 I '$D(INNXPATH) D ; XPATH NOT PASSED 493 . S UXPATH="//" ; USE ROOT XPATH 494 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 495 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 496 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 497 . D BUILD("INNBLD",INNXML) 498 I @INNXML@(0)>0 D ; NOT EMPTY 499 . D QOPEN("INNBLD",INNXML,UXPATH) ; 500 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 501 . D QCLOSE("INNBLD",INNXML,UXPATH) 502 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 503 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 504 Q 505 ; 506 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST 507 ; BUT XDEST AN XNEW ARE PASSED BY NAME 508 N XBLD,XTMP 509 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT 510 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST 511 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION 512 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 513 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION 514 I $G(DEBUG) D PARY("XDEST") 515 Q 516 ; 517 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 518 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 519 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 520 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 521 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 522 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 523 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 524 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 525 S XFIRST=$P(XNODE,"^",1) 526 S XLAST=$P(XNODE,"^",2) 527 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG 528 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 529 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 530 I RENEW'="" D ; NEW XML IS NOT NULL 531 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 532 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 533 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 534 I $G(DEBUG) W "REPLACE PREBUILD",! 535 I $G(DEBUG) D PARY("REBLD") 536 D BUILD("REBLD","RTMP") 537 K @REXML ; KILL WHAT WAS THERE 538 D CP("RTMP",REXML) ; COPY IN THE RESULT 539 Q 540 ; 541 DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT 542 ; REXML IS PASSED BY NAME XPATH IS A VALUE 543 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 544 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 545 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 546 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 547 S XFIRST=$P(XNODE,"^",1) 548 S XLAST=$P(XNODE,"^",2) 549 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 550 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 551 I $G(DEBUG) D PARY("REBLD") 552 D BUILD("REBLD","RTMP") 553 K @REXML ; KILL WHAT WAS THERE 554 D CP("RTMP",REXML) ; COPY IN THE RESULT 555 Q 556 ; 557 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 558 ; W "Reporting on the missing",! 559 ; W OARY 560 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 561 N I 562 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 563 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 564 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 565 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 566 . . Q 567 Q 568 ; 569 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY 570 ; AND PUT THE RESULTS IN OXML 571 N XCNT 572 I '$D(DEBUG) S DEBUG=0 573 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q 574 I '$D(@IXML@(0)) D ; INITIALIZE COUNT 575 . S XCNT=$O(@IXML@(""),-1) 576 E S XCNT=@IXML@(0) ;COUNT 577 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 578 N I,J,TNAM,TVAL,TSTR 579 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT 580 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY 581 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 582 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 583 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS 584 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS 585 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! 586 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME 587 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED 588 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 589 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD 590 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 591 . . . . E D DOFLD ; PROCESS A FIELD 592 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE 593 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER 594 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES 595 . . I DEBUG W TSTR 596 I DEBUG W "MAPPED",! 597 Q 598 ; 599 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE 600 ; 601 Q 602 ; 603 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS 604 ; THEXML IS PASSED BY NAME 605 N I,J,TMPXML,DEL,FOUND,INTXT 606 S FOUND=0 607 S INTXT=0 608 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! 609 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY 610 . S J=@THEXML@(I) 611 . I J["<text>" D 612 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM 613 . . I $G(DEBUG) W "IN HTML SECTION",! 614 . N JM,JP,JPX ; JMINUS AND JPLUS 615 . S JM=@THEXML@(I-1) ; LINE BEFORE 616 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM 617 . S JP=@THEXML@(I+1) ; LINE AFTER 618 . I INTXT=0 D ; IF NOT IN AN HTML SECTION 619 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH 620 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES 621 . . . I $G(DEBUG) W I,J,JP,! 622 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 623 . . . S DEL(I)="" ; SET LINE TO DELETE 624 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE 625 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE 626 . . . I $G(DEBUG) W I,J,! 627 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 628 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED 629 . . . I JM=JPX D ; 630 . . . . I $G(DEBUG) W I,JM_J_JPX,! 631 . . . . S DEL(I-1)="" 632 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL 633 ; . I J'["><" D PUSH("TMPXML",J) 634 I FOUND D ; NEED TO DELETE THINGS 635 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES 636 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED 637 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY 638 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY 639 Q FOUND 640 ; 641 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML 642 ; XSEC IS A SECTION PASSED BY NAME 643 N XBLD,XTMP 644 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML 645 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 646 D CP("XTMP",XSEC) ; REPLACE PASSED XML 647 Q 648 ; 649 PARY(GLO,ZN) ;PRINT AN ARRAY 650 ; IF ZN=-1 NO LINE NUMBERS 651 N I 652 F I=1:1:@GLO@(0) D ; 653 . I $G(ZN)=-1 W @GLO@(I),! 654 . E W I_" "_@GLO@(I),! 655 Q 656 ; 657 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY 658 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE 659 I '$D(IPRE) S IPRE="" 660 N H2I S H2I="" 661 ; W $O(@IHASH@(H2I)),! 662 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH 663 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES 664 . . ;W H2I_"^"_@IHASH@(H2I),! 665 . . N IH,IHI 666 . . S IH=$NA(@IHASH@(H2I)) ; 667 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR 668 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE 669 . . S IHI="" ; INDEX INTO "M" MULTIPLES 670 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE 671 . . . ; W @IH@(IHI) 672 . . . S IH3=$NA(@IH2@(IHI)) 673 . . . ; W "HEY",IH3,! 674 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS 675 . . ; W IH,! 676 . . ; W "C0CZZ",! 677 . . ; W $NA(@IHASH@(H2I)),! 678 . . Q ; 679 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) 680 . ; W @IARYRTN@(0),! 681 Q 682 ; 683 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES 684 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ 685 ; XVRTN AND XVIXML ARE PASSED BY NAME 686 ; 687 N XVI,XVTMP,XVT 688 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML 689 . S XVT=@XVIXML@(XVI) 690 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI 691 D H2ARY(XVRTN,"XVTMP") 692 Q 693 ; 694 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE 695 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE 696 ; 697 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED 698 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE 699 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 700 . S DXUSE="DTMP" ; DXUSE IS NAME 701 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE 702 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 703 . S DXUSE="DTMP" ; DXUSE IS NAME 704 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE 705 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE 706 D XVARS("DVARS",DXUSE) ; PULL OUT VARS 707 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM 708 Q 709 ; 710 TEST ; Run all the test cases 711 D TESTALL^C0CUNIT("C0CXPAT0") 712 Q 713 ; 714 ZTEST(WHICH) ; RUN ONE SET OF TESTS 715 N ZTMP 716 S DEBUG=1 717 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 718 D ZTEST^C0CUNIT(.ZTMP,WHICH) 719 Q 720 ; 721 TLIST ; LIST THE TESTS 722 N ZTMP 723 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 724 D TLIST^C0CUNIT(.ZTMP) 725 Q 726 ;
Note:
See TracChangeset
for help on using the changeset viewer.
