Changeset 1592 for smart/trunk
- Timestamp:
- Oct 30, 2012, 1:54:46 PM (12 years ago)
- Location:
- smart/trunk/kids
- Files:
-
- 1 deleted
- 1 edited
-
VISTA_SMART_CONTAINER_1T4.KID (deleted)
-
VISTA_SMART_CONTAINER_1T5.KID (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID
r1571 r1592 1 KIDS Distribution saved on Oct 13, 2012@13:00:562 fix for lab units not found and analysis routines 1 KIDS Distribution saved on Oct 30, 2012@11:06:18 2 VISTA SMART CONTAINER V1.0 3 3 **KIDS**:VISTA SMART CONTAINER 1.0^ 4 4 5 5 **INSTALL NAME** 6 6 VISTA SMART CONTAINER 1.0 7 "BLD",8180,0) 8 VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3121013^n 9 "BLD",8180,1,0) 10 ^^1^1^3120926^ 11 "BLD",8180,1,1,0) 7 "BLD",7885,0) 8 VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3121030^n 9 "BLD",7885,1,0) 10 ^^5^5^3121030^ 11 "BLD",7885,1,1,0) 12 Licensed under the AGPL v3. 13 "BLD",7885,1,2,0) 14 15 "BLD",7885,1,3,0) 16 http://www.gnu.org/licenses/agpl-3.0.html 17 "BLD",7885,1,4,0) 18 19 "BLD",7885,1,5,0) 12 20 Version 1.0 13 "BLD", 8180,4,0)21 "BLD",7885,4,0) 14 22 ^9.64PA^^ 15 "BLD", 8180,6.3)16 5 17 "BLD", 8180,"ABPKG")23 "BLD",7885,6.3) 24 6 25 "BLD",7885,"ABPKG") 18 26 n 19 "BLD", 8180,"KRN",0)27 "BLD",7885,"KRN",0) 20 28 ^9.67PA^779.2^20 21 "BLD", 8180,"KRN",.4,0)29 "BLD",7885,"KRN",.4,0) 22 30 .4 23 "BLD", 8180,"KRN",.401,0)31 "BLD",7885,"KRN",.401,0) 24 32 .401 25 "BLD", 8180,"KRN",.402,0)33 "BLD",7885,"KRN",.402,0) 26 34 .402 27 "BLD", 8180,"KRN",.403,0)35 "BLD",7885,"KRN",.403,0) 28 36 .403 29 "BLD", 8180,"KRN",.5,0)37 "BLD",7885,"KRN",.5,0) 30 38 .5 31 "BLD", 8180,"KRN",.84,0)39 "BLD",7885,"KRN",.84,0) 32 40 .84 33 "BLD", 8180,"KRN",3.6,0)41 "BLD",7885,"KRN",3.6,0) 34 42 3.6 35 "BLD", 8180,"KRN",3.8,0)43 "BLD",7885,"KRN",3.8,0) 36 44 3.8 37 "BLD", 8180,"KRN",9.2,0)45 "BLD",7885,"KRN",9.2,0) 38 46 9.2 39 "BLD", 8180,"KRN",9.8,0)47 "BLD",7885,"KRN",9.8,0) 40 48 9.8 41 "BLD", 8180,"KRN",9.8,"NM",0)49 "BLD",7885,"KRN",9.8,"NM",0) 42 50 ^9.68A^13^13 43 "BLD", 8180,"KRN",9.8,"NM",1,0)44 C0SDEM^^0^B5 902236245 "BLD", 8180,"KRN",9.8,"NM",2,0)46 C0SDOM^^0^B8 736716247 "BLD", 8180,"KRN",9.8,"NM",3,0)48 C0SLAB^^0^B79 85625249 "BLD", 8180,"KRN",9.8,"NM",4,0)50 C0SMART^^0^B2 90740151 "BLD", 8180,"KRN",9.8,"NM",5,0)52 C0SMED^^0^B40 71908353 "BLD", 8180,"KRN",9.8,"NM",6,0)54 C0SMXMLB^^0^B12 18964455 "BLD", 8180,"KRN",9.8,"NM",7,0)56 C0SNHIN^^0^B8 860064457 "BLD", 8180,"KRN",9.8,"NM",8,0)51 "BLD",7885,"KRN",9.8,"NM",1,0) 52 C0SDEM^^0^B58572381 53 "BLD",7885,"KRN",9.8,"NM",2,0) 54 C0SDOM^^0^B86029417 55 "BLD",7885,"KRN",9.8,"NM",3,0) 56 C0SLAB^^0^B79123674 57 "BLD",7885,"KRN",9.8,"NM",4,0) 58 C0SMART^^0^B2814519 59 "BLD",7885,"KRN",9.8,"NM",5,0) 60 C0SMED^^0^B40022947 61 "BLD",7885,"KRN",9.8,"NM",6,0) 62 C0SMXMLB^^0^B12331075 63 "BLD",7885,"KRN",9.8,"NM",7,0) 64 C0SNHIN^^0^B87708170 65 "BLD",7885,"KRN",9.8,"NM",8,0) 58 66 C0SNHINV^^0^B15736572 59 "BLD", 8180,"KRN",9.8,"NM",9,0)60 C0SPROB^^0^B49 66940061 "BLD", 8180,"KRN",9.8,"NM",10,0)62 C0SPROB2^^0^B67 59487463 "BLD", 8180,"KRN",9.8,"NM",11,0)64 C0STBL^^0^B23 98976165 "BLD", 8180,"KRN",9.8,"NM",12,0)66 C0SUTIL^^0^B 100550267 "BLD", 8180,"KRN",9.8,"NM",13,0)68 C0SXPATH^^0^B5 2128314369 "BLD", 8180,"KRN",9.8,"NM","B","C0SDEM",1)67 "BLD",7885,"KRN",9.8,"NM",9,0) 68 C0SPROB^^0^B49349956 69 "BLD",7885,"KRN",9.8,"NM",10,0) 70 C0SPROB2^^0^B67175408 71 "BLD",7885,"KRN",9.8,"NM",11,0) 72 C0STBL^^0^B23538791 73 "BLD",7885,"KRN",9.8,"NM",12,0) 74 C0SUTIL^^0^B968662 75 "BLD",7885,"KRN",9.8,"NM",13,0) 76 C0SXPATH^^0^B518728149 77 "BLD",7885,"KRN",9.8,"NM","B","C0SDEM",1) 70 78 71 "BLD", 8180,"KRN",9.8,"NM","B","C0SDOM",2)79 "BLD",7885,"KRN",9.8,"NM","B","C0SDOM",2) 72 80 73 "BLD", 8180,"KRN",9.8,"NM","B","C0SLAB",3)81 "BLD",7885,"KRN",9.8,"NM","B","C0SLAB",3) 74 82 75 "BLD", 8180,"KRN",9.8,"NM","B","C0SMART",4)83 "BLD",7885,"KRN",9.8,"NM","B","C0SMART",4) 76 84 77 "BLD", 8180,"KRN",9.8,"NM","B","C0SMED",5)85 "BLD",7885,"KRN",9.8,"NM","B","C0SMED",5) 78 86 79 "BLD", 8180,"KRN",9.8,"NM","B","C0SMXMLB",6)87 "BLD",7885,"KRN",9.8,"NM","B","C0SMXMLB",6) 80 88 81 "BLD", 8180,"KRN",9.8,"NM","B","C0SNHIN",7)89 "BLD",7885,"KRN",9.8,"NM","B","C0SNHIN",7) 82 90 83 "BLD", 8180,"KRN",9.8,"NM","B","C0SNHINV",8)91 "BLD",7885,"KRN",9.8,"NM","B","C0SNHINV",8) 84 92 85 "BLD", 8180,"KRN",9.8,"NM","B","C0SPROB",9)93 "BLD",7885,"KRN",9.8,"NM","B","C0SPROB",9) 86 94 87 "BLD", 8180,"KRN",9.8,"NM","B","C0SPROB2",10)95 "BLD",7885,"KRN",9.8,"NM","B","C0SPROB2",10) 88 96 89 "BLD", 8180,"KRN",9.8,"NM","B","C0STBL",11)97 "BLD",7885,"KRN",9.8,"NM","B","C0STBL",11) 90 98 91 "BLD", 8180,"KRN",9.8,"NM","B","C0SUTIL",12)99 "BLD",7885,"KRN",9.8,"NM","B","C0SUTIL",12) 92 100 93 "BLD", 8180,"KRN",9.8,"NM","B","C0SXPATH",13)101 "BLD",7885,"KRN",9.8,"NM","B","C0SXPATH",13) 94 102 95 "BLD", 8180,"KRN",19,0)103 "BLD",7885,"KRN",19,0) 96 104 19 97 "BLD", 8180,"KRN",19.1,0)105 "BLD",7885,"KRN",19.1,0) 98 106 19.1 99 "BLD", 8180,"KRN",101,0)107 "BLD",7885,"KRN",101,0) 100 108 101 101 "BLD", 8180,"KRN",409.61,0)109 "BLD",7885,"KRN",409.61,0) 102 110 409.61 103 "BLD", 8180,"KRN",771,0)111 "BLD",7885,"KRN",771,0) 104 112 771 105 "BLD", 8180,"KRN",779.2,0)113 "BLD",7885,"KRN",779.2,0) 106 114 779.2 107 "BLD", 8180,"KRN",870,0)115 "BLD",7885,"KRN",870,0) 108 116 870 109 "BLD", 8180,"KRN",8989.51,0)117 "BLD",7885,"KRN",8989.51,0) 110 118 8989.51 111 "BLD", 8180,"KRN",8989.52,0)119 "BLD",7885,"KRN",8989.52,0) 112 120 8989.52 113 "BLD", 8180,"KRN",8994,0)121 "BLD",7885,"KRN",8994,0) 114 122 8994 115 "BLD", 8180,"KRN","B",.4,.4)123 "BLD",7885,"KRN","B",.4,.4) 116 124 117 "BLD", 8180,"KRN","B",.401,.401)125 "BLD",7885,"KRN","B",.401,.401) 118 126 119 "BLD", 8180,"KRN","B",.402,.402)127 "BLD",7885,"KRN","B",.402,.402) 120 128 121 "BLD", 8180,"KRN","B",.403,.403)129 "BLD",7885,"KRN","B",.403,.403) 122 130 123 "BLD", 8180,"KRN","B",.5,.5)131 "BLD",7885,"KRN","B",.5,.5) 124 132 125 "BLD", 8180,"KRN","B",.84,.84)133 "BLD",7885,"KRN","B",.84,.84) 126 134 127 "BLD", 8180,"KRN","B",3.6,3.6)135 "BLD",7885,"KRN","B",3.6,3.6) 128 136 129 "BLD", 8180,"KRN","B",3.8,3.8)137 "BLD",7885,"KRN","B",3.8,3.8) 130 138 131 "BLD", 8180,"KRN","B",9.2,9.2)139 "BLD",7885,"KRN","B",9.2,9.2) 132 140 133 "BLD", 8180,"KRN","B",9.8,9.8)141 "BLD",7885,"KRN","B",9.8,9.8) 134 142 135 "BLD", 8180,"KRN","B",19,19)143 "BLD",7885,"KRN","B",19,19) 136 144 137 "BLD", 8180,"KRN","B",19.1,19.1)145 "BLD",7885,"KRN","B",19.1,19.1) 138 146 139 "BLD", 8180,"KRN","B",101,101)147 "BLD",7885,"KRN","B",101,101) 140 148 141 "BLD", 8180,"KRN","B",409.61,409.61)149 "BLD",7885,"KRN","B",409.61,409.61) 142 150 143 "BLD", 8180,"KRN","B",771,771)151 "BLD",7885,"KRN","B",771,771) 144 152 145 "BLD", 8180,"KRN","B",779.2,779.2)153 "BLD",7885,"KRN","B",779.2,779.2) 146 154 147 "BLD", 8180,"KRN","B",870,870)155 "BLD",7885,"KRN","B",870,870) 148 156 149 "BLD", 8180,"KRN","B",8989.51,8989.51)157 "BLD",7885,"KRN","B",8989.51,8989.51) 150 158 151 "BLD", 8180,"KRN","B",8989.52,8989.52)159 "BLD",7885,"KRN","B",8989.52,8989.52) 152 160 153 "BLD", 8180,"KRN","B",8994,8994)161 "BLD",7885,"KRN","B",8994,8994) 154 162 155 "BLD", 8180,"QUES",0)163 "BLD",7885,"QUES",0) 156 164 ^9.62^^ 157 "BLD", 8180,"REQB",0)165 "BLD",7885,"REQB",0) 158 166 ^9.611^^ 159 167 "MBREQ") 160 168 0 161 "PKG",21 6,-1)169 "PKG",211,-1) 162 170 1^1 163 "PKG",21 6,0)171 "PKG",211,0) 164 172 VISTA SMART CONTAINER^C0S^RDF Server for Harvard's Smart Data Model 165 "PKG",21 6,20,0)173 "PKG",211,20,0) 166 174 ^9.402P^^ 167 "PKG",21 6,22,0)175 "PKG",211,22,0) 168 176 ^9.49I^1^1 169 "PKG",216,22,1,0) 170 1.0^3121013^3121011^77 171 "PKG",216,22,1,1,0) 172 ^^1^1^3121013 173 "PKG",216,22,1,1,1,0) 177 "PKG",211,22,1,0) 178 1.0^3121030^3121030^8 179 "PKG",211,22,1,1,0) 180 ^^5^5^3121030 181 "PKG",211,22,1,1,1,0) 182 Licensed under the AGPL v3. 183 "PKG",211,22,1,1,2,0) 184 185 "PKG",211,22,1,1,3,0) 186 http://www.gnu.org/licenses/agpl-3.0.html 187 "PKG",211,22,1,1,4,0) 188 189 "PKG",211,22,1,1,5,0) 174 190 Version 1.0 175 "PKG",21 6,"DEV")191 "PKG",211,"DEV") 176 192 GPL/WV 177 "PKG",21 6,"VERSION")193 "PKG",211,"VERSION") 178 194 1.0 179 195 "QUES","XPF1",0) … … 250 266 13 251 267 "RTN","C0SDEM") 252 0^1^B5 9022362268 0^1^B58572381 253 269 "RTN","C0SDEM",1,0) 254 C0SDEM ; GPL - Smart Demographics Processing ; 2/22/12 17:05270 C0SDEM ; GPL - Smart Demographics Processing ; 10/30/12 10:59am 255 271 "RTN","C0SDEM",2,0) 256 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5272 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 257 273 "RTN","C0SDEM",3,0) 258 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU274 ;Copyright 2012 George Lilly. 259 275 "RTN","C0SDEM",4,0) 260 ; General Public License See attached copy of the License.276 ; 261 277 "RTN","C0SDEM",5,0) 262 ; 278 ; This program is free software: you can redistribute it and/or modify 263 279 "RTN","C0SDEM",6,0) 264 ; This program is free software; you can redistribute it and/or modify280 ; it under the terms of the GNU Affero General Public License as 265 281 "RTN","C0SDEM",7,0) 266 ; it under the terms of the GNU General Public License as published by282 ; published by the Free Software Foundation, either version 3 of the 267 283 "RTN","C0SDEM",8,0) 268 ; the Free Software Foundation; either version 2 of the License, or284 ; License, or (at your option) any later version. 269 285 "RTN","C0SDEM",9,0) 270 ; (at your option) any later version.286 ; 271 287 "RTN","C0SDEM",10,0) 272 ; 288 ; This program is distributed in the hope that it will be useful, 273 289 "RTN","C0SDEM",11,0) 274 ; This program is distributed in the hope that it will be useful,290 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 275 291 "RTN","C0SDEM",12,0) 276 ; but WITHOUT ANY WARRANTY; without even the implied warranty of292 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 277 293 "RTN","C0SDEM",13,0) 278 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the294 ; GNU Affero General Public License for more details. 279 295 "RTN","C0SDEM",14,0) 280 ; GNU General Public License for more details.296 ; 281 297 "RTN","C0SDEM",15,0) 282 ; 298 ; You should have received a copy of the GNU Affero General Public License 283 299 "RTN","C0SDEM",16,0) 284 ; You should have received a copy of the GNU General Public License along300 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 285 301 "RTN","C0SDEM",17,0) 286 ; with this program; if not, write to the Free Software Foundation, Inc.,302 ; 287 303 "RTN","C0SDEM",18,0) 288 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.304 Q 289 305 "RTN","C0SDEM",19,0) 290 306 ; 291 307 "RTN","C0SDEM",20,0) 292 Q308 ;<?xml version="1.0" encoding="utf-8"?> 293 309 "RTN","C0SDEM",21,0) 294 ; 310 ;<rdf:RDF 295 311 "RTN","C0SDEM",22,0) 296 ; <?xml version="1.0" encoding="utf-8"?>312 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" 297 313 "RTN","C0SDEM",23,0) 314 ; xmlns:sp="http://smartplatforms.org/terms#" 315 "RTN","C0SDEM",24,0) 316 ; xmlns:dcterms="http://purl.org/dc/terms/" 317 "RTN","C0SDEM",25,0) 318 ; xmlns:v="http://www.w3.org/2006/vcard/ns#" 319 "RTN","C0SDEM",26,0) 320 ; xmlns:foaf="http://xmlns.com/foaf/0.1/"> 321 "RTN","C0SDEM",27,0) 322 ; <sp:Demographics> 323 "RTN","C0SDEM",28,0) 324 ; 325 "RTN","C0SDEM",29,0) 326 ; <v:n> 327 "RTN","C0SDEM",30,0) 328 ; <v:Name> 329 "RTN","C0SDEM",31,0) 330 ; <v:given-name>Bob</v:given-name> 331 "RTN","C0SDEM",32,0) 332 ; <v:additional-name>J</v:additional-name> 333 "RTN","C0SDEM",33,0) 334 ; <v:family-name>Odenkirk</v:family-name> 335 "RTN","C0SDEM",34,0) 336 ; </v:Name> 337 "RTN","C0SDEM",35,0) 338 ; </v:n> 339 "RTN","C0SDEM",36,0) 340 ; 341 "RTN","C0SDEM",37,0) 342 ; <v:adr> 343 "RTN","C0SDEM",38,0) 344 ; <v:Address> 345 "RTN","C0SDEM",39,0) 346 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 347 "RTN","C0SDEM",40,0) 348 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 349 "RTN","C0SDEM",41,0) 350 ; 351 "RTN","C0SDEM",42,0) 352 ; <v:street-address>15 Main St</v:street-address> 353 "RTN","C0SDEM",43,0) 354 ; <v:extended-address>Apt 2</v:extended-address> 355 "RTN","C0SDEM",44,0) 356 ; <v:locality>Wonderland</v:locality> 357 "RTN","C0SDEM",45,0) 358 ; <v:region>OZ</v:region> 359 "RTN","C0SDEM",46,0) 360 ; <v:postal-code>54321</v:postal-code> 361 "RTN","C0SDEM",47,0) 362 ; <v:country>USA</v:country> 363 "RTN","C0SDEM",48,0) 364 ; </v:Address> 365 "RTN","C0SDEM",49,0) 366 ; </v:adr> 367 "RTN","C0SDEM",50,0) 368 ; 369 "RTN","C0SDEM",51,0) 370 ; <v:tel> 371 "RTN","C0SDEM",52,0) 372 ; <v:Tel> 373 "RTN","C0SDEM",53,0) 374 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 375 "RTN","C0SDEM",54,0) 376 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 377 "RTN","C0SDEM",55,0) 378 ; <rdf:value>800-555-1212</rdf:value> 379 "RTN","C0SDEM",56,0) 380 ; </v:Tel> 381 "RTN","C0SDEM",57,0) 382 ; </v:tel> 383 "RTN","C0SDEM",58,0) 384 ; 385 "RTN","C0SDEM",59,0) 386 ; <v:tel> 387 "RTN","C0SDEM",60,0) 388 ; <v:Tel> 389 "RTN","C0SDEM",61,0) 390 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" /> 391 "RTN","C0SDEM",62,0) 392 ; <rdf:value>800-555-1515</rdf:value> 393 "RTN","C0SDEM",63,0) 394 ; </v:Tel> 395 "RTN","C0SDEM",64,0) 396 ; </v:tel> 397 "RTN","C0SDEM",65,0) 398 ; 399 "RTN","C0SDEM",66,0) 400 ; <foaf:gender>male</foaf:gender> 401 "RTN","C0SDEM",67,0) 402 ; <v:bday>1959-12-25</v:bday> 403 "RTN","C0SDEM",68,0) 404 ; <v:email>bob.odenkirk@example.com</v:email> 405 "RTN","C0SDEM",69,0) 406 ; 407 "RTN","C0SDEM",70,0) 408 ; <sp:medicalRecordNumber> 409 "RTN","C0SDEM",71,0) 410 ; <sp:Code> 411 "RTN","C0SDEM",72,0) 412 ; <dcterms:title>My Hospital Record 2304575</dcterms:title> 413 "RTN","C0SDEM",73,0) 414 ; <dcterms:identifier>2304575</dcterms:identifier> 415 "RTN","C0SDEM",74,0) 416 ; <sp:system>My Hospital Record</sp:system> 417 "RTN","C0SDEM",75,0) 418 ; </sp:Code> 419 "RTN","C0SDEM",76,0) 420 ; </sp:medicalRecordNumber> 421 "RTN","C0SDEM",77,0) 422 ; 423 "RTN","C0SDEM",78,0) 424 ; </sp:Demographics> 425 "RTN","C0SDEM",79,0) 426 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?> 427 "RTN","C0SDEM",80,0) 298 428 ;<rdf:RDF 299 "RTN","C0SDEM", 24,0)429 "RTN","C0SDEM",81,0) 300 430 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" 301 "RTN","C0SDEM", 25,0)431 "RTN","C0SDEM",82,0) 302 432 ; xmlns:sp="http://smartplatforms.org/terms#" 303 "RTN","C0SDEM", 26,0)433 "RTN","C0SDEM",83,0) 304 434 ; xmlns:dcterms="http://purl.org/dc/terms/" 305 "RTN","C0SDEM", 27,0)435 "RTN","C0SDEM",84,0) 306 436 ; xmlns:v="http://www.w3.org/2006/vcard/ns#" 307 "RTN","C0SDEM", 28,0)437 "RTN","C0SDEM",85,0) 308 438 ; xmlns:foaf="http://xmlns.com/foaf/0.1/"> 309 "RTN","C0SDEM", 29,0)439 "RTN","C0SDEM",86,0) 310 440 ; <sp:Demographics> 311 "RTN","C0SDEM", 30,0)312 ; 313 "RTN","C0SDEM", 31,0)441 "RTN","C0SDEM",87,0) 442 ; 443 "RTN","C0SDEM",88,0) 314 444 ; <v:n> 315 "RTN","C0SDEM", 32,0)445 "RTN","C0SDEM",89,0) 316 446 ; <v:Name> 317 "RTN","C0SDEM", 33,0)447 "RTN","C0SDEM",90,0) 318 448 ; <v:given-name>Bob</v:given-name> 319 "RTN","C0SDEM", 34,0)449 "RTN","C0SDEM",91,0) 320 450 ; <v:additional-name>J</v:additional-name> 321 "RTN","C0SDEM", 35,0)451 "RTN","C0SDEM",92,0) 322 452 ; <v:family-name>Odenkirk</v:family-name> 323 "RTN","C0SDEM", 36,0)453 "RTN","C0SDEM",93,0) 324 454 ; </v:Name> 325 "RTN","C0SDEM", 37,0)455 "RTN","C0SDEM",94,0) 326 456 ; </v:n> 327 "RTN","C0SDEM", 38,0)328 ; 329 "RTN","C0SDEM", 39,0)457 "RTN","C0SDEM",95,0) 458 ; 459 "RTN","C0SDEM",96,0) 330 460 ; <v:adr> 331 "RTN","C0SDEM", 40,0)461 "RTN","C0SDEM",97,0) 332 462 ; <v:Address> 333 "RTN","C0SDEM", 41,0)463 "RTN","C0SDEM",98,0) 334 464 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 335 "RTN","C0SDEM", 42,0)465 "RTN","C0SDEM",99,0) 336 466 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 337 "RTN","C0SDEM", 43,0)338 ; 339 "RTN","C0SDEM", 44,0)467 "RTN","C0SDEM",100,0) 468 ; 469 "RTN","C0SDEM",101,0) 340 470 ; <v:street-address>15 Main St</v:street-address> 341 "RTN","C0SDEM", 45,0)471 "RTN","C0SDEM",102,0) 342 472 ; <v:extended-address>Apt 2</v:extended-address> 343 "RTN","C0SDEM", 46,0)473 "RTN","C0SDEM",103,0) 344 474 ; <v:locality>Wonderland</v:locality> 345 "RTN","C0SDEM", 47,0)475 "RTN","C0SDEM",104,0) 346 476 ; <v:region>OZ</v:region> 347 "RTN","C0SDEM", 48,0)477 "RTN","C0SDEM",105,0) 348 478 ; <v:postal-code>54321</v:postal-code> 349 "RTN","C0SDEM", 49,0)479 "RTN","C0SDEM",106,0) 350 480 ; <v:country>USA</v:country> 351 "RTN","C0SDEM", 50,0)481 "RTN","C0SDEM",107,0) 352 482 ; </v:Address> 353 "RTN","C0SDEM", 51,0)483 "RTN","C0SDEM",108,0) 354 484 ; </v:adr> 355 "RTN","C0SDEM", 52,0)356 ; 357 "RTN","C0SDEM", 53,0)485 "RTN","C0SDEM",109,0) 486 ; 487 "RTN","C0SDEM",110,0) 358 488 ; <v:tel> 359 "RTN","C0SDEM", 54,0)489 "RTN","C0SDEM",111,0) 360 490 ; <v:Tel> 361 "RTN","C0SDEM", 55,0)491 "RTN","C0SDEM",112,0) 362 492 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" /> 363 "RTN","C0SDEM", 56,0)493 "RTN","C0SDEM",113,0) 364 494 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" /> 365 "RTN","C0SDEM", 57,0)495 "RTN","C0SDEM",114,0) 366 496 ; <rdf:value>800-555-1212</rdf:value> 367 "RTN","C0SDEM", 58,0)497 "RTN","C0SDEM",115,0) 368 498 ; </v:Tel> 369 "RTN","C0SDEM", 59,0)499 "RTN","C0SDEM",116,0) 370 500 ; </v:tel> 371 "RTN","C0SDEM", 60,0)372 ; 373 "RTN","C0SDEM", 61,0)501 "RTN","C0SDEM",117,0) 502 ; 503 "RTN","C0SDEM",118,0) 374 504 ; <v:tel> 375 "RTN","C0SDEM", 62,0)505 "RTN","C0SDEM",119,0) 376 506 ; <v:Tel> 377 "RTN","C0SDEM", 63,0)507 "RTN","C0SDEM",120,0) 378 508 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" /> 379 "RTN","C0SDEM", 64,0)509 "RTN","C0SDEM",121,0) 380 510 ; <rdf:value>800-555-1515</rdf:value> 381 "RTN","C0SDEM", 65,0)511 "RTN","C0SDEM",122,0) 382 512 ; </v:Tel> 383 "RTN","C0SDEM", 66,0)513 "RTN","C0SDEM",123,0) 384 514 ; </v:tel> 385 "RTN","C0SDEM", 67,0)386 ; 387 "RTN","C0SDEM", 68,0)515 "RTN","C0SDEM",124,0) 516 ; 517 "RTN","C0SDEM",125,0) 388 518 ; <foaf:gender>male</foaf:gender> 389 "RTN","C0SDEM", 69,0)519 "RTN","C0SDEM",126,0) 390 520 ; <v:bday>1959-12-25</v:bday> 391 "RTN","C0SDEM", 70,0)521 "RTN","C0SDEM",127,0) 392 522 ; <v:email>bob.odenkirk@example.com</v:email> 393 "RTN","C0SDEM", 71,0)394 ; 395 "RTN","C0SDEM", 72,0)523 "RTN","C0SDEM",128,0) 524 ; 525 "RTN","C0SDEM",129,0) 396 526 ; <sp:medicalRecordNumber> 397 "RTN","C0SDEM", 73,0)527 "RTN","C0SDEM",130,0) 398 528 ; <sp:Code> 399 "RTN","C0SDEM", 74,0)529 "RTN","C0SDEM",131,0) 400 530 ; <dcterms:title>My Hospital Record 2304575</dcterms:title> 401 "RTN","C0SDEM", 75,0)531 "RTN","C0SDEM",132,0) 402 532 ; <dcterms:identifier>2304575</dcterms:identifier> 403 "RTN","C0SDEM", 76,0)533 "RTN","C0SDEM",133,0) 404 534 ; <sp:system>My Hospital Record</sp:system> 405 "RTN","C0SDEM", 77,0)535 "RTN","C0SDEM",134,0) 406 536 ; </sp:Code> 407 "RTN","C0SDEM", 78,0)537 "RTN","C0SDEM",135,0) 408 538 ; </sp:medicalRecordNumber> 409 "RTN","C0SDEM", 79,0)410 ; 411 "RTN","C0SDEM", 80,0)539 "RTN","C0SDEM",136,0) 540 ; 541 "RTN","C0SDEM",137,0) 412 542 ; </sp:Demographics> 413 "RTN","C0SDEM",81,0)414 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?>415 "RTN","C0SDEM",82,0)416 ;<rdf:RDF417 "RTN","C0SDEM",83,0)418 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"419 "RTN","C0SDEM",84,0)420 ; xmlns:sp="http://smartplatforms.org/terms#"421 "RTN","C0SDEM",85,0)422 ; xmlns:dcterms="http://purl.org/dc/terms/"423 "RTN","C0SDEM",86,0)424 ; xmlns:v="http://www.w3.org/2006/vcard/ns#"425 "RTN","C0SDEM",87,0)426 ; xmlns:foaf="http://xmlns.com/foaf/0.1/">427 "RTN","C0SDEM",88,0)428 ; <sp:Demographics>429 "RTN","C0SDEM",89,0)430 ;431 "RTN","C0SDEM",90,0)432 ; <v:n>433 "RTN","C0SDEM",91,0)434 ; <v:Name>435 "RTN","C0SDEM",92,0)436 ; <v:given-name>Bob</v:given-name>437 "RTN","C0SDEM",93,0)438 ; <v:additional-name>J</v:additional-name>439 "RTN","C0SDEM",94,0)440 ; <v:family-name>Odenkirk</v:family-name>441 "RTN","C0SDEM",95,0)442 ; </v:Name>443 "RTN","C0SDEM",96,0)444 ; </v:n>445 "RTN","C0SDEM",97,0)446 ;447 "RTN","C0SDEM",98,0)448 ; <v:adr>449 "RTN","C0SDEM",99,0)450 ; <v:Address>451 "RTN","C0SDEM",100,0)452 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />453 "RTN","C0SDEM",101,0)454 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />455 "RTN","C0SDEM",102,0)456 ;457 "RTN","C0SDEM",103,0)458 ; <v:street-address>15 Main St</v:street-address>459 "RTN","C0SDEM",104,0)460 ; <v:extended-address>Apt 2</v:extended-address>461 "RTN","C0SDEM",105,0)462 ; <v:locality>Wonderland</v:locality>463 "RTN","C0SDEM",106,0)464 ; <v:region>OZ</v:region>465 "RTN","C0SDEM",107,0)466 ; <v:postal-code>54321</v:postal-code>467 "RTN","C0SDEM",108,0)468 ; <v:country>USA</v:country>469 "RTN","C0SDEM",109,0)470 ; </v:Address>471 "RTN","C0SDEM",110,0)472 ; </v:adr>473 "RTN","C0SDEM",111,0)474 ;475 "RTN","C0SDEM",112,0)476 ; <v:tel>477 "RTN","C0SDEM",113,0)478 ; <v:Tel>479 "RTN","C0SDEM",114,0)480 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />481 "RTN","C0SDEM",115,0)482 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />483 "RTN","C0SDEM",116,0)484 ; <rdf:value>800-555-1212</rdf:value>485 "RTN","C0SDEM",117,0)486 ; </v:Tel>487 "RTN","C0SDEM",118,0)488 ; </v:tel>489 "RTN","C0SDEM",119,0)490 ;491 "RTN","C0SDEM",120,0)492 ; <v:tel>493 "RTN","C0SDEM",121,0)494 ; <v:Tel>495 "RTN","C0SDEM",122,0)496 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />497 "RTN","C0SDEM",123,0)498 ; <rdf:value>800-555-1515</rdf:value>499 "RTN","C0SDEM",124,0)500 ; </v:Tel>501 "RTN","C0SDEM",125,0)502 ; </v:tel>503 "RTN","C0SDEM",126,0)504 ;505 "RTN","C0SDEM",127,0)506 ; <foaf:gender>male</foaf:gender>507 "RTN","C0SDEM",128,0)508 ; <v:bday>1959-12-25</v:bday>509 "RTN","C0SDEM",129,0)510 ; <v:email>bob.odenkirk@example.com</v:email>511 "RTN","C0SDEM",130,0)512 ;513 "RTN","C0SDEM",131,0)514 ; <sp:medicalRecordNumber>515 "RTN","C0SDEM",132,0)516 ; <sp:Code>517 "RTN","C0SDEM",133,0)518 ; <dcterms:title>My Hospital Record 2304575</dcterms:title>519 "RTN","C0SDEM",134,0)520 ; <dcterms:identifier>2304575</dcterms:identifier>521 "RTN","C0SDEM",135,0)522 ; <sp:system>My Hospital Record</sp:system>523 "RTN","C0SDEM",136,0)524 ; </sp:Code>525 "RTN","C0SDEM",137,0)526 ; </sp:medicalRecordNumber>527 543 "RTN","C0SDEM",138,0) 528 ; 544 ;</rdf:RDF> 529 545 "RTN","C0SDEM",139,0) 530 ; </sp:Demographics>546 ;G(1)="nodeID:25591^rdf:type^v:Home" 531 547 "RTN","C0SDEM",140,0) 532 ; </rdf:RDF>548 ;G(2)="nodeID:25591^rdf:type^v:Pref" 533 549 "RTN","C0SDEM",141,0) 534 ;G( 1)="nodeID:25591^rdf:type^v:Home"550 ;G(3)="nodeID:25591^rdf:type^v:Tel" 535 551 "RTN","C0SDEM",142,0) 536 ;G( 2)="nodeID:25591^rdf:type^v:Pref"552 ;G(4)="nodeID:25591^rdf:value^800-369-6403" 537 553 "RTN","C0SDEM",143,0) 538 ;G( 3)="nodeID:25591^rdf:type^v:Tel"554 ;G(5)="nodeID:25611^rdf:type^v:Name" 539 555 "RTN","C0SDEM",144,0) 540 ;G( 4)="nodeID:25591^rdf:value^800-369-6403"556 ;G(6)="nodeID:25611^v:additional-name^N" 541 557 "RTN","C0SDEM",145,0) 542 ;G( 5)="nodeID:25611^rdf:type^v:Name"558 ;G(7)="nodeID:25611^v:family-name^Brooks" 543 559 "RTN","C0SDEM",146,0) 544 ;G( 6)="nodeID:25611^v:additional-name^N"560 ;G(8)="nodeID:25611^v:given-name^Brian" 545 561 "RTN","C0SDEM",147,0) 546 ;G( 7)="nodeID:25611^v:family-name^Brooks"562 ;G(9)="nodeID:25622^dcterms:identifier^981968" 547 563 "RTN","C0SDEM",148,0) 548 ;G( 8)="nodeID:25611^v:given-name^Brian"564 ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" 549 565 "RTN","C0SDEM",149,0) 550 ;G( 9)="nodeID:25622^dcterms:identifier^981968"566 ;G(11)="nodeID:25622^rdf:type^sp:Code" 551 567 "RTN","C0SDEM",150,0) 552 ;G(1 0)="nodeID:25622^dcterms:title^My Hospital Record 981968"568 ;G(12)="nodeID:25622^sp:system^My Hospital Record" 553 569 "RTN","C0SDEM",151,0) 554 ;G(1 1)="nodeID:25622^rdf:type^sp:Code"570 ;G(13)="nodeID:25623^rdf:type^v:Address" 555 571 "RTN","C0SDEM",152,0) 556 ;G(1 2)="nodeID:25622^sp:system^My Hospital Record"572 ;G(14)="nodeID:25623^rdf:type^v:Home" 557 573 "RTN","C0SDEM",153,0) 558 ;G(1 3)="nodeID:25623^rdf:type^v:Address"574 ;G(15)="nodeID:25623^rdf:type^v:Pref" 559 575 "RTN","C0SDEM",154,0) 560 ;G(1 4)="nodeID:25623^rdf:type^v:Home"576 ;G(16)="nodeID:25623^v:locality^Bixby" 561 577 "RTN","C0SDEM",155,0) 562 ;G(1 5)="nodeID:25623^rdf:type^v:Pref"578 ;G(17)="nodeID:25623^v:postal-code^74008" 563 579 "RTN","C0SDEM",156,0) 564 ;G(1 6)="nodeID:25623^v:locality^Bixby"580 ;G(18)="nodeID:25623^v:region^OK" 565 581 "RTN","C0SDEM",157,0) 566 ;G(1 7)="nodeID:25623^v:postal-code^74008"582 ;G(19)="nodeID:25623^v:street-address^82 Lake St" 567 583 "RTN","C0SDEM",158,0) 568 ;G( 18)="nodeID:25623^v:region^OK"584 ;G(20)="smart:981968/demographics^foaf:gender^male" 569 585 "RTN","C0SDEM",159,0) 570 ;G( 19)="nodeID:25623^v:street-address^82 Lake St"586 ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" 571 587 "RTN","C0SDEM",160,0) 572 ;G(2 0)="smart:981968/demographics^foaf:gender^male"588 ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" 573 589 "RTN","C0SDEM",161,0) 574 ;G(2 1)="smart:981968/demographics^rdf:type^sp:Demographics"590 ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" 575 591 "RTN","C0SDEM",162,0) 576 ;G(2 2)="smart:981968/demographics^sp:belongsTo^smart:981968"592 ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" 577 593 "RTN","C0SDEM",163,0) 578 ;G(2 3)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622"594 ;G(25)="smart:981968/demographics^v:bday^1956-03-23" 579 595 "RTN","C0SDEM",164,0) 580 ;G(2 4)="smart:981968/demographics^v:adr^nodeID:25623"596 ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" 581 597 "RTN","C0SDEM",165,0) 582 ;G(2 5)="smart:981968/demographics^v:bday^1956-03-23"598 ;G(27)="smart:981968/demographics^v:n^nodeID:25611" 583 599 "RTN","C0SDEM",166,0) 584 ;G(2 6)="smart:981968/demographics^v:email^brian.brooks@example.com"600 ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" 585 601 "RTN","C0SDEM",167,0) 586 ;G(27)="smart:981968/demographics^v:n^nodeID:25611"602 Q 587 603 "RTN","C0SDEM",168,0) 588 ; G(28)="smart:981968/demographics^v:tel^nodeID:25591"604 ; 589 605 "RTN","C0SDEM",169,0) 590 Q 606 PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, 591 607 "RTN","C0SDEM",170,0) 592 ; 608 ; is the return name of the graph created. "" if none 593 609 "RTN","C0SDEM",171,0) 594 PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, 610 ; C0SARY is passed in by reference and is the NHIN array of patient 595 611 "RTN","C0SDEM",172,0) 596 ; is the return name of the graph created. "" if none612 ; 597 613 "RTN","C0SDEM",173,0) 598 ; C0SARY is passed in by reference and is the NHIN array of patient614 I $O(C0SARY("patient",""))="" D Q ; 599 615 "RTN","C0SDEM",174,0) 600 ;616 . I $D(DEBUG) W !,"No Patient array" 601 617 "RTN","C0SDEM",175,0) 602 I $O(C0SARY("patient",""))="" D Q ;618 . S GRTN="" 603 619 "RTN","C0SDEM",176,0) 604 . I $D(DEBUG) W !,"No Patient array"620 S GRTN="" ; default to no patient 605 621 "RTN","C0SDEM",177,0) 606 . S GRTN=""622 N C0SGRF 607 623 "RTN","C0SDEM",178,0) 608 S GRTN="" ; default to no patient624 S C0SGRF="vistaSmart:"_ZPATID_"/patient" 609 625 "RTN","C0SDEM",179,0) 610 N C0SGRF626 S ZPAT=C0SGRF ; subject is the same as the graph name 611 627 "RTN","C0SDEM",180,0) 612 S C0SGRF="vistaSmart:"_ZPATID_"/patient"628 I $D(DEBUG) W !,"Processing ",C0SGRF 613 629 "RTN","C0SDEM",181,0) 614 S ZPAT=C0SGRF ; subject is the same as the graph name630 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 615 631 "RTN","C0SDEM",182,0) 616 I $D(DEBUG) W !,"Processing ",C0SGRF632 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 617 633 "RTN","C0SDEM",183,0) 618 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph634 N FARY S FARY="C0XFARY" 619 635 "RTN","C0SDEM",184,0) 620 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use636 D USEFARY^C0XF2N(FARY) 621 637 "RTN","C0SDEM",185,0) 622 N FARY S FARY="C0XFARY"638 D VOCINIT^C0XUTIL 623 639 "RTN","C0SDEM",186,0) 624 D USEFARY^C0XF2N(FARY)640 ; 625 641 "RTN","C0SDEM",187,0) 626 D VOCINIT^C0XUTIL642 N ZPN,ZR 627 643 "RTN","C0SDEM",188,0) 628 ;644 D STARTADD^C0XF2N 629 645 "RTN","C0SDEM",189,0) 630 N ZPN,ZR646 ; 631 647 "RTN","C0SDEM",190,0) 632 D STARTADD^C0XF2N648 ; First do the base demographic graph 633 649 "RTN","C0SDEM",191,0) 634 650 ; 635 651 "RTN","C0SDEM",192,0) 636 ; First do the base demographic graph652 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient 637 653 "RTN","C0SDEM",193,0) 638 ;654 N SEX S SEX=$G(@ZPN@("gender@value")) 639 655 "RTN","C0SDEM",194,0) 640 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient656 I SEX="M" S SEX="male" 641 657 "RTN","C0SDEM",195,0) 642 N SEX S SEX=$G(@ZPN@("gender@value"))658 I SEX="F" S SEX="female" 643 659 "RTN","C0SDEM",196,0) 644 I SEX="M" S SEX="male"660 S ZR("foaf:gender")=SEX 645 661 "RTN","C0SDEM",197,0) 646 I SEX="F" S SEX="female"662 S ZR("rdf:type")="sp:Demographics" 647 663 "RTN","C0SDEM",198,0) 648 S ZR(" foaf:gender")=SEX664 S ZR("sp:belongsTo")=ZPAT 649 665 "RTN","C0SDEM",199,0) 650 S ZR("rdf:type")="sp:Demographics"666 N PATIENT 651 667 "RTN","C0SDEM",200,0) 652 S ZR("sp:belongsTo")=ZPAT668 S PATIENT=$P(ZPAT,"#",2) 653 669 "RTN","C0SDEM",201,0) 654 NPATIENT670 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT 655 671 "RTN","C0SDEM",202,0) 656 S PATIENT=$P(ZPAT,"#",2)672 N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph 657 673 "RTN","C0SDEM",203,0) 658 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT674 S ZR("sp:medicalRecordNumber")=NMREC 659 675 "RTN","C0SDEM",204,0) 660 N N MREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph676 N NVADR S NVADR=$$ANONS^C0XF2N ; for address 661 677 "RTN","C0SDEM",205,0) 662 S ZR(" sp:medicalRecordNumber")=NMREC678 S ZR("v:adr")=NVADR 663 679 "RTN","C0SDEM",206,0) 664 N N VADR S NVADR=$$ANONS^C0XF2N ; for address680 N NNAME S NNAME=$$ANONS^C0XF2N ; for name 665 681 "RTN","C0SDEM",207,0) 666 S ZR("v: adr")=NVADR682 S ZR("v:n")=NNAME 667 683 "RTN","C0SDEM",208,0) 668 N N NAME S NNAME=$$ANONS^C0XF2N ; for name684 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone 669 685 "RTN","C0SDEM",209,0) 670 S ZR("v:n")=NNAME686 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists 671 687 "RTN","C0SDEM",210,0) 672 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone688 N BDATE 673 689 "RTN","C0SDEM",211,0) 674 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists690 S ZX="" 675 691 "RTN","C0SDEM",212,0) 676 N BDATE692 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format 677 693 "RTN","C0SDEM",213,0) 678 S ZX=""694 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date 679 695 "RTN","C0SDEM",214,0) 680 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format696 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens 681 697 "RTN","C0SDEM",215,0) 682 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date698 I BDATE="" S BDATE="UNKNOWN" 683 699 "RTN","C0SDEM",216,0) 684 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens700 N Z2,Z3 685 701 "RTN","C0SDEM",217,0) 686 I BDATE="" S BDATE="UNKNOWN"702 S Z2=$P(BDATE,"-",2) 687 703 "RTN","C0SDEM",218,0) 688 N Z2,Z3704 S Z3=$P(BDATE,"-",3) 689 705 "RTN","C0SDEM",219,0) 690 S Z2=$P(BDATE,"-",2)706 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 691 707 "RTN","C0SDEM",220,0) 692 S Z3=$P(BDATE,"-",3)708 I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 693 709 "RTN","C0SDEM",221,0) 694 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2710 S ZR("v:bday")=BDATE 695 711 "RTN","C0SDEM",222,0) 696 I $ L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3712 I $D(C0SVISTA) D ; 697 713 "RTN","C0SDEM",223,0) 698 S ZR("v:bday")=BDATE714 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN 699 715 "RTN","C0SDEM",224,0) 700 I $D(C0SVISTA) D ;716 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN 701 717 "RTN","C0SDEM",225,0) 702 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN718 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph 703 719 "RTN","C0SDEM",226,0) 704 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN720 K ZR 705 721 "RTN","C0SDEM",227,0) 706 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph722 ; 707 723 "RTN","C0SDEM",228,0) 724 ; create address sub-graph 725 "RTN","C0SDEM",229,0) 726 ; 727 "RTN","C0SDEM",230,0) 728 S ZR("rdf:type")="v:Address" 729 "RTN","C0SDEM",231,0) 730 S ZR("rdf:type")="v:Home" 731 "RTN","C0SDEM",232,0) 732 S ZR("v:locality")=$G(@ZPN@("address@city")) 733 "RTN","C0SDEM",233,0) 734 S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) 735 "RTN","C0SDEM",234,0) 736 S ZR("v:region")=$G(@ZPN@("address@stateProvince")) 737 "RTN","C0SDEM",235,0) 738 S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) 739 "RTN","C0SDEM",236,0) 740 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address 741 "RTN","C0SDEM",237,0) 708 742 K ZR 709 "RTN","C0SDEM",229,0)710 ;711 "RTN","C0SDEM",230,0)712 ; create address sub-graph713 "RTN","C0SDEM",231,0)714 ;715 "RTN","C0SDEM",232,0)716 S ZR("rdf:type")="v:Address"717 "RTN","C0SDEM",233,0)718 S ZR("rdf:type")="v:Home"719 "RTN","C0SDEM",234,0)720 S ZR("v:locality")=$G(@ZPN@("address@city"))721 "RTN","C0SDEM",235,0)722 S ZR("v:postal-code")=$G(@ZPN@("address@postalCode"))723 "RTN","C0SDEM",236,0)724 S ZR("v:region")=$G(@ZPN@("address@stateProvince"))725 "RTN","C0SDEM",237,0)726 S ZR("v:street-address")=$G(@ZPN@("address@streetLine1"))727 743 "RTN","C0SDEM",238,0) 728 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address744 ; 729 745 "RTN","C0SDEM",239,0) 746 ; create medical record subgraph 747 "RTN","C0SDEM",240,0) 748 ; 749 "RTN","C0SDEM",241,0) 750 S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) 751 "RTN","C0SDEM",242,0) 752 S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") 753 "RTN","C0SDEM",243,0) 754 S ZR("rdf:type")="sp:Code" 755 "RTN","C0SDEM",244,0) 756 S ZR("sp:system")="VistA Patient Record" 757 "RTN","C0SDEM",245,0) 758 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph 759 "RTN","C0SDEM",246,0) 730 760 K ZR 731 "RTN","C0SDEM",240,0)732 ;733 "RTN","C0SDEM",241,0)734 ; create medical record subgraph735 "RTN","C0SDEM",242,0)736 ;737 "RTN","C0SDEM",243,0)738 S ZR("dcterms:identifier")=$G(@ZPN@("id@value"))739 "RTN","C0SDEM",244,0)740 S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier")741 "RTN","C0SDEM",245,0)742 S ZR("rdf:type")="sp:Code"743 "RTN","C0SDEM",246,0)744 S ZR("sp:system")="VistA Patient Record"745 761 "RTN","C0SDEM",247,0) 746 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph762 ; 747 763 "RTN","C0SDEM",248,0) 764 ; create name subgraph 765 "RTN","C0SDEM",249,0) 766 ; 767 "RTN","C0SDEM",250,0) 768 N ZNF,ZNL,ZNM,ZNAM 769 "RTN","C0SDEM",251,0) 770 S ZR("rdf:type")="v:Name" 771 "RTN","C0SDEM",252,0) 772 S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names 773 "RTN","C0SDEM",253,0) 774 S ZNF=$P(ZX," ",1) ; first name is first piece 775 "RTN","C0SDEM",254,0) 776 S ZNM=$P(ZX," ",2) ; middle names are the rest 777 "RTN","C0SDEM",255,0) 778 S ZR("v:additional-name")=ZNM 779 "RTN","C0SDEM",256,0) 780 S ZR("v:family-name")=$G(@ZPN@("familyName@value")) 781 "RTN","C0SDEM",257,0) 782 S ZR("v:given-name")=ZNF 783 "RTN","C0SDEM",258,0) 784 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph 785 "RTN","C0SDEM",259,0) 748 786 K ZR 749 "RTN","C0SDEM",249,0)750 ;751 "RTN","C0SDEM",250,0)752 ; create name subgraph753 "RTN","C0SDEM",251,0)754 ;755 "RTN","C0SDEM",252,0)756 N ZNF,ZNL,ZNM,ZNAM757 "RTN","C0SDEM",253,0)758 S ZR("rdf:type")="v:Name"759 "RTN","C0SDEM",254,0)760 S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names761 "RTN","C0SDEM",255,0)762 S ZNF=$P(ZX," ",1) ; first name is first piece763 "RTN","C0SDEM",256,0)764 S ZNM=$P(ZX," ",2) ; middle names are the rest765 "RTN","C0SDEM",257,0)766 S ZR("v:additional-name")=ZNM767 "RTN","C0SDEM",258,0)768 S ZR("v:family-name")=$G(@ZPN@("familyName@value"))769 "RTN","C0SDEM",259,0)770 S ZR("v:given-name")=ZNF771 787 "RTN","C0SDEM",260,0) 772 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph788 ; 773 789 "RTN","C0SDEM",261,0) 790 ; create telephone subgraph 791 "RTN","C0SDEM",262,0) 792 ; 793 "RTN","C0SDEM",263,0) 794 D ; 795 "RTN","C0SDEM",264,0) 796 . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) 797 "RTN","C0SDEM",265,0) 798 . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph 799 "RTN","C0SDEM",266,0) 800 . S ZR("rdf:type")="v:Tel" 801 "RTN","C0SDEM",267,0) 802 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) 803 "RTN","C0SDEM",268,0) 774 804 K ZR 775 "RTN","C0SDEM",262,0)776 ;777 "RTN","C0SDEM",263,0)778 ; create telephone subgraph779 "RTN","C0SDEM",264,0)780 ;781 "RTN","C0SDEM",265,0)782 D ;783 "RTN","C0SDEM",266,0)784 . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value"))785 "RTN","C0SDEM",267,0)786 . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph787 "RTN","C0SDEM",268,0)788 . S ZR("rdf:type")="v:Tel"789 805 "RTN","C0SDEM",269,0) 790 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR)806 ; 791 807 "RTN","C0SDEM",270,0) 792 K ZR808 ; load the demographics graph and all sub graphs to the triple store 793 809 "RTN","C0SDEM",271,0) 794 810 ; 795 811 "RTN","C0SDEM",272,0) 796 ; load the demographics graph and all sub graphs to the triple store812 D BULKLOAD^C0XF2N(.C0XFDA) 797 813 "RTN","C0SDEM",273,0) 798 ;814 S GRTN=C0SGRF 799 815 "RTN","C0SDEM",274,0) 800 D BULKLOAD^C0XF2N(.C0XFDA)816 Q 801 817 "RTN","C0SDEM",275,0) 802 S GRTN=C0SGRF818 ; 803 819 "RTN","C0SDEM",276,0) 804 Q 820 AGES ; LIST ALL PATIENTS AND THEIR AGES 805 821 "RTN","C0SDEM",277,0) 806 ;822 N ZI S ZI=0 807 823 "RTN","C0SDEM",278,0) 808 AGES ; LIST ALL PATIENTS AND THEIR AGES 824 F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT 809 825 "RTN","C0SDEM",279,0) 810 N ZI S ZI=0826 . N ZDOB 811 827 "RTN","C0SDEM",280,0) 812 F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT828 . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB 813 829 "RTN","C0SDEM",281,0) 814 . N Z DOB830 . N ZNAME 815 831 "RTN","C0SDEM",282,0) 816 . S Z DOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB832 . S ZNAME=$P(^DPT(ZI,0),U) 817 833 "RTN","C0SDEM",283,0) 818 . N Z NAME834 . N ZSEX 819 835 "RTN","C0SDEM",284,0) 820 . S Z NAME=$P(^DPT(ZI,0),U)836 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") 821 837 "RTN","C0SDEM",285,0) 822 . NZSEX838 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX 823 839 "RTN","C0SDEM",286,0) 824 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX")840 Q 825 841 "RTN","C0SDEM",287,0) 826 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX827 "RTN","C0SDEM",288,0)828 Q829 "RTN","C0SDEM",289,0)830 842 ; 831 843 "RTN","C0SDOM") 832 0^2^B8 7367162844 0^2^B86029417 833 845 "RTN","C0SDOM",1,0) 834 846 C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 835 847 "RTN","C0SDOM",2,0) 836 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5848 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 837 849 "RTN","C0SDOM",3,0) 838 ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU850 ;Copyright 2011,2012 George Lilly. 839 851 "RTN","C0SDOM",4,0) 840 ; General Public License See attached copy of the License.852 ; 841 853 "RTN","C0SDOM",5,0) 842 ; 854 ; This program is free software: you can redistribute it and/or modify 843 855 "RTN","C0SDOM",6,0) 844 ; This program is free software; you can redistribute it and/or modify856 ; it under the terms of the GNU Affero General Public License as 845 857 "RTN","C0SDOM",7,0) 846 ; it under the terms of the GNU General Public License as published by858 ; published by the Free Software Foundation, either version 3 of the 847 859 "RTN","C0SDOM",8,0) 848 ; the Free Software Foundation; either version 2 of the License, or860 ; License, or (at your option) any later version. 849 861 "RTN","C0SDOM",9,0) 850 ; (at your option) any later version.862 ; 851 863 "RTN","C0SDOM",10,0) 852 ; 864 ; This program is distributed in the hope that it will be useful, 853 865 "RTN","C0SDOM",11,0) 854 866 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 855 867 "RTN","C0SDOM",12,0) 856 ; This program is distributed in the hope that it will be useful,868 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 857 869 "RTN","C0SDOM",13,0) 858 ; but WITHOUT ANY WARRANTY; without even the implied warranty of870 ; GNU Affero General Public License for more details. 859 871 "RTN","C0SDOM",14,0) 860 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the872 ; 861 873 "RTN","C0SDOM",15,0) 862 ; GNU General Public License for more details.874 ; You should have received a copy of the GNU Affero General Public License 863 875 "RTN","C0SDOM",16,0) 864 ; 876 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 865 877 "RTN","C0SDOM",17,0) 866 ; You should have received a copy of the GNU General Public License along878 ; 867 879 "RTN","C0SDOM",18,0) 868 ;with this program; if not, write to the Free Software Foundation, Inc.,880 Q 869 881 "RTN","C0SDOM",19,0) 870 ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.882 ; 871 883 "RTN","C0SDOM",20,0) 872 ; 884 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 873 885 "RTN","C0SDOM",21,0) 874 Q886 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 875 887 "RTN","C0SDOM",22,0) 876 ; 888 ; THE XPATH ARRAY XPARY, PASSED BY NAME 877 889 "RTN","C0SDOM",23,0) 878 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 890 ; ZOID IS THE STARTING OID 879 891 "RTN","C0SDOM",24,0) 880 ; THE XPATH INDEX ZXIDX, PASSED BY NAME892 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 881 893 "RTN","C0SDOM",25,0) 882 ; THE XPATH ARRAY XPARY, PASSED BY NAME894 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 883 895 "RTN","C0SDOM",26,0) 884 ; Z OID IS THE STARTING OID896 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 885 897 "RTN","C0SDOM",27,0) 886 ; ZPATH IS THE STARTING XPATH, USUALLY "/"898 I $G(ZREDUX)="" S ZREDUX="" 887 899 "RTN","C0SDOM",28,0) 888 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE900 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 889 901 "RTN","C0SDOM",29,0) 890 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT902 N NEWNUM S NEWNUM="" 891 903 "RTN","C0SDOM",30,0) 892 I $G(Z REDUX)="" S ZREDUX=""904 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 893 905 "RTN","C0SDOM",31,0) 894 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY906 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 895 907 "RTN","C0SDOM",32,0) 896 N NEWNUM S NEWNUM=""908 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 897 909 "RTN","C0SDOM",33,0) 898 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"910 . N GT S GT=$P(NEWPATH,ZREDUX,2) 899 911 "RTN","C0SDOM",34,0) 900 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE912 . I GT'="" S NEWPATH=GT 901 913 "RTN","C0SDOM",35,0) 902 I $G(ZREDUX)'="" D ; REDUX PROVIDED?914 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 903 915 "RTN","C0SDOM",36,0) 904 . N GT S GT=$P(NEWPATH,ZREDUX,2)916 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 905 917 "RTN","C0SDOM",37,0) 906 . I GT'="" S NEWPATH=GT918 I $D(GA) D ; PROCESS THE ATTRIBUTES 907 919 "RTN","C0SDOM",38,0) 908 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX920 . N ZI S ZI="" 909 921 "RTN","C0SDOM",39,0) 910 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE922 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 911 923 "RTN","C0SDOM",40,0) 912 I $D(GA) D ; PROCESS THE ATTRIBUTES924 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE 913 925 "RTN","C0SDOM",41,0) 914 . N ZI S ZI=""926 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 915 927 "RTN","C0SDOM",42,0) 916 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE928 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 917 929 "RTN","C0SDOM",43,0) 918 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE930 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 919 931 "RTN","C0SDOM",44,0) 920 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY932 I $D(GD(2)) D ; 921 933 "RTN","C0SDOM",45,0) 922 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE934 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 923 935 "RTN","C0SDOM",46,0) 924 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE936 E I $D(GD(1)) D ; 925 937 "RTN","C0SDOM",47,0) 926 I $D(GD(2)) D ;938 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 927 939 "RTN","C0SDOM",48,0) 928 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THEARRAY940 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 929 941 "RTN","C0SDOM",49,0) 930 E I $D(GD(1)) D ;942 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 931 943 "RTN","C0SDOM",50,0) 932 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY944 I ZFRST'=0 D ; THERE IS A CHILD 933 945 "RTN","C0SDOM",51,0) 934 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY946 . N ZNUM 935 947 "RTN","C0SDOM",52,0) 936 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD948 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 937 949 "RTN","C0SDOM",53,0) 938 I ZFRST'=0 D ; THERE IS ACHILD950 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 939 951 "RTN","C0SDOM",54,0) 940 . N ZNUM952 N GNXT S GNXT=$$NXTSIB(ZOID) 941 953 "RTN","C0SDOM",55,0) 942 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE954 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 943 955 "RTN","C0SDOM",56,0) 944 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD956 I GNXT'=0 D ; 945 957 "RTN","C0SDOM",57,0) 946 N GNXT S GNXT=$$NXTSIB(ZOID)958 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 947 959 "RTN","C0SDOM",58,0) 948 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTERMULTIPLES960 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 949 961 "RTN","C0SDOM",59,0) 950 I GNXT'=0 D;962 . . N ZNUM S ZNUM=1 ; 951 963 "RTN","C0SDOM",60,0) 952 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?964 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 953 965 "RTN","C0SDOM",61,0) 954 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES966 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 955 967 "RTN","C0SDOM",62,0) 956 . . N ZNUM S ZNUM=1 ;968 Q 957 969 "RTN","C0SDOM",63,0) 958 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB970 ; 959 971 "RTN","C0SDOM",64,0) 960 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 972 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 961 973 "RTN","C0SDOM",65,0) 962 Q974 ; 963 975 "RTN","C0SDOM",66,0) 964 ; 976 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES 965 977 "RTN","C0SDOM",67,0) 966 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 978 ; 967 979 "RTN","C0SDOM",68,0) 968 ;980 N ZZI,ZZJ,ZZN 969 981 "RTN","C0SDOM",69,0) 970 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES982 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 971 983 "RTN","C0SDOM",70,0) 972 ;984 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 973 985 "RTN","C0SDOM",71,0) 974 N ZZI,ZZJ,ZZN986 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 975 987 "RTN","C0SDOM",72,0) 976 S ZZ I=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY988 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 977 989 "RTN","C0SDOM",73,0) 978 I ZZI ="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE990 I ZZI'["]" D ; A SINGLETON 979 991 "RTN","C0SDOM",74,0) 980 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY992 . S ZZN=1 981 993 "RTN","C0SDOM",75,0) 982 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .994 E D ; THERE IS AN [x] OCCURANCE 983 995 "RTN","C0SDOM",76,0) 984 I ZZI'["]" D ; A SINGLETON996 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 985 997 "RTN","C0SDOM",77,0) 986 . S ZZ N=1998 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 987 999 "RTN","C0SDOM",78,0) 988 E D ; THERE IS AN [x] OCCURANCE1000 I ZZJ'="" D ; TIME TO ADD THE VALUE 989 1001 "RTN","C0SDOM",79,0) 990 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE1002 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 991 1003 "RTN","C0SDOM",80,0) 992 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]1004 Q 993 1005 "RTN","C0SDOM",81,0) 994 I ZZJ'="" D ; TIME TO ADD THE VALUE1006 ; 995 1007 "RTN","C0SDOM",82,0) 996 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE1008 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 997 1009 "RTN","C0SDOM",83,0) 998 Q1010 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 999 1011 "RTN","C0SDOM",84,0) 1000 ; 1012 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 1001 1013 "RTN","C0SDOM",85,0) 1002 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 1014 ;Q $$EN^MXMLDOM(INXML) 1003 1015 "RTN","C0SDOM",86,0) 1004 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW1016 Q $$EN^MXMLDOM(INXML,"W") 1005 1017 "RTN","C0SDOM",87,0) 1006 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML1018 ; 1007 1019 "RTN","C0SDOM",88,0) 1008 ;Q $$EN^MXMLDOM(INXML) 1020 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 1009 1021 "RTN","C0SDOM",89,0) 1010 Q $$EN^MXMLDOM(INXML,"W")1022 N ZN 1011 1023 "RTN","C0SDOM",90,0) 1012 ; 1024 ;I $$TAG(ZOID)["entry" B 1013 1025 "RTN","C0SDOM",91,0) 1014 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 1026 S ZN=$$NXTSIB(ZOID) 1015 1027 "RTN","C0SDOM",92,0) 1016 N ZN1028 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 1017 1029 "RTN","C0SDOM",93,0) 1018 ;I $$TAG(ZOID)["entry" B1030 Q 0 1019 1031 "RTN","C0SDOM",94,0) 1020 S ZN=$$NXTSIB(ZOID)1032 ; 1021 1033 "RTN","C0SDOM",95,0) 1022 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 1034 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 1023 1035 "RTN","C0SDOM",96,0) 1024 Q 01036 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) 1025 1037 "RTN","C0SDOM",97,0) 1026 1038 ; 1027 1039 "RTN","C0SDOM",98,0) 1028 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILDOF ZOID1040 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 1029 1041 "RTN","C0SDOM",99,0) 1030 Q $$ CHILD^MXMLDOM(C0SDOCID,ZOID)1042 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) 1031 1043 "RTN","C0SDOM",100,0) 1032 1044 ; 1033 1045 "RTN","C0SDOM",101,0) 1034 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OFZOID1046 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 1035 1047 "RTN","C0SDOM",102,0) 1036 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)1048 S HANDLE=C0SDOCID 1037 1049 "RTN","C0SDOM",103,0) 1038 ;1050 K @RTN 1039 1051 "RTN","C0SDOM",104,0) 1040 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 1052 D GETTXT^MXMLDOM("A") 1041 1053 "RTN","C0SDOM",105,0) 1042 S HANDLE=C0SDOCID1054 Q 1043 1055 "RTN","C0SDOM",106,0) 1044 K @RTN1056 ; 1045 1057 "RTN","C0SDOM",107,0) 1046 D GETTXT^MXMLDOM("A") 1058 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 1047 1059 "RTN","C0SDOM",108,0) 1048 Q1060 ;I ZOID=149 B ;GPLTEST 1049 1061 "RTN","C0SDOM",109,0) 1050 ;1062 N X,Y 1051 1063 "RTN","C0SDOM",110,0) 1052 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 1064 S Y="" 1053 1065 "RTN","C0SDOM",111,0) 1054 ;I ZOID=149 B ;GPLTEST1066 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 1055 1067 "RTN","C0SDOM",112,0) 1056 N X,Y1068 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 1057 1069 "RTN","C0SDOM",113,0) 1058 S Y=""1070 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) 1059 1071 "RTN","C0SDOM",114,0) 1060 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE1072 Q Y 1061 1073 "RTN","C0SDOM",115,0) 1062 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y1074 ; 1063 1075 "RTN","C0SDOM",116,0) 1064 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) 1076 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 1065 1077 "RTN","C0SDOM",117,0) 1066 Q Y1078 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) 1067 1079 "RTN","C0SDOM",118,0) 1068 1080 ; 1069 1081 "RTN","C0SDOM",119,0) 1070 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 1082 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 1071 1083 "RTN","C0SDOM",120,0) 1072 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)1084 ;N ZT,ZN S ZT="" 1073 1085 "RTN","C0SDOM",121,0) 1074 ; 1086 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) 1075 1087 "RTN","C0SDOM",122,0) 1076 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 1088 ;Q $G(@C0SDOM@(ZOID,"T",1)) 1077 1089 "RTN","C0SDOM",123,0) 1078 ;N ZT,ZN S ZT=""1090 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) 1079 1091 "RTN","C0SDOM",124,0) 1080 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))1092 Q 1081 1093 "RTN","C0SDOM",125,0) 1082 ; Q $G(@C0SDOM@(ZOID,"T",1))1094 ; 1083 1095 "RTN","C0SDOM",126,0) 1084 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) 1096 OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 1085 1097 "RTN","C0SDOM",127,0) 1086 Q1098 ; 1087 1099 "RTN","C0SDOM",128,0) 1088 ;1100 S C0SDOCID=INID 1089 1101 "RTN","C0SDOM",129,0) 1090 OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 1102 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation 1091 1103 "RTN","C0SDOM",130,0) 1092 ;1104 D START^C0SMXMLB($$TAG(1),,"G",NO1ST) 1093 1105 "RTN","C0SDOM",131,0) 1094 S C0SDOCID=INID1106 D NDOUT($$FIRST(1)) 1095 1107 "RTN","C0SDOM",132,0) 1096 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation1108 D END^C0SMXMLB ;END THE DOCUMENT 1097 1109 "RTN","C0SDOM",133,0) 1098 D START^C0SMXMLB($$TAG(1),,"G",NO1ST)1110 M @ZRTN=^TMP("MXMLBLD",$J) 1099 1111 "RTN","C0SDOM",134,0) 1100 D NDOUT($$FIRST(1))1112 K ^TMP("MXMLBLD",$J) 1101 1113 "RTN","C0SDOM",135,0) 1102 D END^C0SMXMLB ;END THE DOCUMENT1114 Q 1103 1115 "RTN","C0SDOM",136,0) 1104 M @ZRTN=^TMP("MXMLBLD",$J)1116 ; 1105 1117 "RTN","C0SDOM",137,0) 1106 K ^TMP("MXMLBLD",$J) 1118 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 1107 1119 "RTN","C0SDOM",138,0) 1108 Q1120 N ZI S ZI=$$FIRST(ZOID) 1109 1121 "RTN","C0SDOM",139,0) 1110 ;1122 I ZI'=0 D ; THERE IS A CHILD 1111 1123 "RTN","C0SDOM",140,0) 1112 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 1124 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 1113 1125 "RTN","C0SDOM",141,0) 1114 N ZI S ZI=$$FIRST(ZOID)1126 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN 1115 1127 "RTN","C0SDOM",142,0) 1116 I ZI'=0 D ; THERE IS A CHILD1128 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 1117 1129 "RTN","C0SDOM",143,0) 1118 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT1130 . ;W "DOING",ZOID,! 1119 1131 "RTN","C0SDOM",144,0) 1120 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN1132 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 1121 1133 "RTN","C0SDOM",145,0) 1122 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT1134 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 1123 1135 "RTN","C0SDOM",146,0) 1124 . ;W "DOING",ZOID,!1136 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 1125 1137 "RTN","C0SDOM",147,0) 1126 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA1138 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 1127 1139 "RTN","C0SDOM",148,0) 1128 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES1140 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 1129 1141 "RTN","C0SDOM",149,0) 1130 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN1142 Q 1131 1143 "RTN","C0SDOM",150,0) 1132 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING1144 ; 1133 1145 "RTN","C0SDOM",151,0) 1134 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 1146 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 1135 1147 "RTN","C0SDOM",152,0) 1136 Q1148 ; 1137 1149 "RTN","C0SDOM",153,0) 1138 ;1150 N GN,GN2 1139 1151 "RTN","C0SDOM",154,0) 1140 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 1152 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 1141 1153 "RTN","C0SDOM",155,0) 1142 ;1154 S GN2=$NA(@GN@(1)) 1143 1155 "RTN","C0SDOM",156,0) 1144 N GN,GN21156 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 1145 1157 "RTN","C0SDOM",157,0) 1146 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML1158 Q 1147 1159 "RTN","C0SDOM",158,0) 1148 S GN2=$NA(@GN@(1))1160 ; 1149 1161 "RTN","C0SDOM",159,0) 1150 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 1162 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 1151 1163 "RTN","C0SDOM",160,0) 1152 Q1164 ; ZGOUT AND ZGIN ARE PASSED BY NAME 1153 1165 "RTN","C0SDOM",161,0) 1154 ;1166 N C0SDOCID 1155 1167 "RTN","C0SDOM",162,0) 1156 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY 1168 W !,ZGOUT," ",ZGIN 1157 1169 "RTN","C0SDOM",163,0) 1158 ; ZGOUT AND ZGIN ARE PASSED BY NAME1170 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM 1159 1171 "RTN","C0SDOM",164,0) 1160 N C0SDOCID1172 D OUTXML(ZGOUT,C0SDOCID) 1161 1173 "RTN","C0SDOM",165,0) 1162 W !,ZGOUT," ",ZGIN1174 Q 1163 1175 "RTN","C0SDOM",166,0) 1164 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM1176 ; 1165 1177 "RTN","C0SDOM",167,0) 1166 D OUTXML(ZGOUT,C0SDOCID)1178 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN 1167 1179 "RTN","C0SDOM",168,0) 1168 Q1180 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA) 1169 1181 "RTN","C0SDOM",169,0) 1170 1182 ; 1171 1183 "RTN","C0SDOM",170,0) 1172 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN1184 ;GNARY("med",1,"doses.dose@dose")=10 1173 1185 "RTN","C0SDOM",171,0) 1174 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)1186 ;GNARY("med",1,"doses.dose@noun")="TABLET" 1175 1187 "RTN","C0SDOM",172,0) 1176 ; 1188 ;GNARY("med",1,"doses.dose@route")="PO" 1177 1189 "RTN","C0SDOM",173,0) 1178 ;GNARY("med",1,"doses.dose@ dose")=101190 ;GNARY("med",1,"doses.dose@schedule")="QD" 1179 1191 "RTN","C0SDOM",174,0) 1180 ;GNARY("med",1,"doses.dose@ noun")="TABLET"1192 ;GNARY("med",1,"doses.dose@units")="MG" 1181 1193 "RTN","C0SDOM",175,0) 1182 ;GNARY("med",1,"doses.dose@ route")="PO"1194 ;GNARY("med",1,"doses.dose@unitsPerDose")=1 1183 1195 "RTN","C0SDOM",176,0) 1184 ;GNARY("med",1," doses.dose@schedule")="QD"1196 ;GNARY("med",1,"facility@code")=100 1185 1197 "RTN","C0SDOM",177,0) 1186 ;GNARY("med",1," doses.dose@units")="MG"1198 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION" 1187 1199 "RTN","C0SDOM",178,0) 1188 ;GNARY("med",1," doses.dose@unitsPerDose")=11200 ;GNARY("med",1,"form@value")="TAB" 1189 1201 "RTN","C0SDOM",179,0) 1190 ;GNARY("med",1," facility@code")=1001202 ;GNARY("med",1,"id@value")="1N;O" 1191 1203 "RTN","C0SDOM",180,0) 1192 ;GNARY("med",1," facility@name")="VOE OFFICE INSTITUTION"1204 ;GNARY("med",1,"location@code")=5 1193 1205 "RTN","C0SDOM",181,0) 1194 ;GNARY("med",1," form@value")="TAB"1206 ;GNARY("med",1,"location@name")="3 WEST" 1195 1207 "RTN","C0SDOM",182,0) 1196 ;GNARY("med",1," id@value")="1N;O"1208 ;GNARY("med",1,"name@value")="LISINOPRIL TAB" 1197 1209 "RTN","C0SDOM",183,0) 1198 ;GNARY("med",1," location@code")=51210 ;GNARY("med",1,"orderID@value")=294 1199 1211 "RTN","C0SDOM",184,0) 1200 ;GNARY("med",1," location@name")="3 WEST"1212 ;GNARY("med",1,"ordered@value")=3110531.001233 1201 1213 "RTN","C0SDOM",185,0) 1202 ;GNARY("med",1," name@value")="LISINOPRIL TAB"1214 ;GNARY("med",1,"orderingProvider@code")=63 1203 1215 "RTN","C0SDOM",186,0) 1204 ;GNARY("med",1,"order ID@value")=2941216 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL" 1205 1217 "RTN","C0SDOM",187,0) 1206 ;GNARY("med",1," ordered@value")=3110531.0012331218 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS" 1207 1219 "RTN","C0SDOM",188,0) 1208 ;GNARY("med",1," orderingProvider@code")=631220 ;GNARY("med",1,"products.product.vaGeneric@code")=1990 1209 1221 "RTN","C0SDOM",189,0) 1210 ;GNARY("med",1," orderingProvider@name")="KING,MATTHEW MICHAEL"1222 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL" 1211 1223 "RTN","C0SDOM",190,0) 1212 ;GNARY("med",1,"products.product. class@code")="ACE INHIBITORS"1224 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380 1213 1225 "RTN","C0SDOM",191,0) 1214 ;GNARY("med",1,"products.product.va Generic@code")=19901226 ;GNARY("med",1,"products.product.vaProduct@code")=8118 1215 1227 "RTN","C0SDOM",192,0) 1216 ;GNARY("med",1,"products.product.va Generic@name")="LISINOPRIL"1228 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB" 1217 1229 "RTN","C0SDOM",193,0) 1218 ;GNARY("med",1,"products.product.va Generic@vuid")=40193801230 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593 1219 1231 "RTN","C0SDOM",194,0) 1220 ;GNARY("med",1,"products.product .vaProduct@code")=81181232 ;GNARY("med",1,"products.product@code")=6174 1221 1233 "RTN","C0SDOM",195,0) 1222 ;GNARY("med",1,"products.product .vaProduct@name")="LISINOPRIL 10MG TAB"1234 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D" 1223 1235 "RTN","C0SDOM",196,0) 1224 ;GNARY("med",1,"products.product .vaProduct@vuid")=40085931236 ;GNARY("med",1,"products.product@role")="D" 1225 1237 "RTN","C0SDOM",197,0) 1226 ;GNARY("med",1," products.product@code")=61741238 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY" 1227 1239 "RTN","C0SDOM",198,0) 1228 ;GNARY("med",1," products.product@name")="LISINOPRIL 10MG U/D"1240 ;GNARY("med",1,"sig@xml:space")="preserve" 1229 1241 "RTN","C0SDOM",199,0) 1230 ;GNARY("med",1," products.product@role")="D"1242 ;GNARY("med",1,"status@value")="active" 1231 1243 "RTN","C0SDOM",200,0) 1232 ;GNARY("med",1," sig")="10MG BY MOUTH EVERY DAY"1244 ;GNARY("med",1,"type@value")="OTC" 1233 1245 "RTN","C0SDOM",201,0) 1234 ;GNARY("med",1," sig@xml:space")="preserve"1246 ;GNARY("med",1,"vaType@value")="N" 1235 1247 "RTN","C0SDOM",202,0) 1236 ; GNARY("med",1,"status@value")="active"1248 ; 1237 1249 "RTN","C0SDOM",203,0) 1238 ; GNARY("med",1,"type@value")="OTC"1250 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM 1239 1251 "RTN","C0SDOM",204,0) 1240 ; GNARY("med",1,"vaType@value")="N"1252 ; it returns 0 or 1 based on success. 1241 1253 "RTN","C0SDOM",205,0) 1242 1254 ; 1243 1255 "RTN","C0SDOM",206,0) 1244 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM1256 ; INARY is passed by name and has the format shown above 1245 1257 "RTN","C0SDOM",207,0) 1246 ; it returns 0 or 1 based on success.1258 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will 1247 1259 "RTN","C0SDOM",208,0) 1248 ; 1260 ; be supported eventually - initial implementation is for MXML 1249 1261 "RTN","C0SDOM",209,0) 1250 ; INARY is passed by name and has the format shown above1262 ; 1251 1263 "RTN","C0SDOM",210,0) 1252 ; HANDLE is the document number in the DOM (both MXML and EWD DOMswill1264 ; PARENT is the node id or tag of the parent under which the DOM will 1253 1265 "RTN","C0SDOM",211,0) 1254 ; be supported eventually - initial implementation is for MXML1266 ; be populated. If it is numeric, it is a node. If it is a string, the DOM 1255 1267 "RTN","C0SDOM",212,0) 1256 ; 1268 ; will be searched to find the tag. If not found and there is no root, 1257 1269 "RTN","C0SDOM",213,0) 1258 ; PARENT is the node id or tag of the parent under which the DOM will1270 ; it will be inserted as the root. If not found and there is a root, it 1259 1271 "RTN","C0SDOM",214,0) 1260 ; be populated. If it is numeric, it is a node. If it is a string, the DOM1272 ; will be inserted under the root. 1261 1273 "RTN","C0SDOM",215,0) 1262 ; will be searched to find the tag. If not found and there is no root,1274 ; 1263 1275 "RTN","C0SDOM",216,0) 1264 ; it will be inserted as the root. If not found and there is a root, it1276 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results") 1265 1277 "RTN","C0SDOM",217,0) 1266 ; will be inserted under the root.1278 ; because "results" is the root tag. Use OUTXML to render the xml from 1267 1279 "RTN","C0SDOM",218,0) 1268 ; 1280 ; the DOM. 1269 1281 "RTN","C0SDOM",219,0) 1270 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")1282 ; 1271 1283 "RTN","C0SDOM",220,0) 1272 ; because "results" is the root tag. Use OUTXML to render the xml from 1284 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM 1273 1285 "RTN","C0SDOM",221,0) 1274 ; the DOM.1286 ; 1275 1287 "RTN","C0SDOM",222,0) 1276 ;1288 N ZPARNODE 1277 1289 "RTN","C0SDOM",223,0) 1278 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM 1290 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0 1279 1291 "RTN","C0SDOM",224,0) 1280 ;1292 I '$D(INARY) Q 0 ; NO ARRAY PASSED 1281 1293 "RTN","C0SDOM",225,0) 1282 N ZPARNODE1294 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM 1283 1295 "RTN","C0SDOM",226,0) 1284 S (SUCCESS,LEVEL,LEVEL(0),NODE)=01296 ;I PARENT="" S PARENT="root" 1285 1297 "RTN","C0SDOM",227,0) 1286 I '$D(INARY) Q 0 ; NO ARRAY PASSED1298 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID 1287 1299 "RTN","C0SDOM",228,0) 1288 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM1300 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL 1289 1301 "RTN","C0SDOM",229,0) 1290 ;I PARENT="" S PARENT="root"1302 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE 1291 1303 "RTN","C0SDOM",230,0) 1292 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID1304 . S ZPARNODE=1 ; 1293 1305 "RTN","C0SDOM",231,0) 1294 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL1306 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET 1295 1307 "RTN","C0SDOM",232,0) 1296 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE1308 N ZEXARY 1297 1309 "RTN","C0SDOM",233,0) 1298 . S ZPARNODE=1 ;1310 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY 1299 1311 "RTN","C0SDOM",234,0) 1300 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET1312 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED 1301 1313 "RTN","C0SDOM",235,0) 1302 N ZEXARY1314 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 1303 1315 "RTN","C0SDOM",236,0) 1304 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY1316 Q HANDLE ; SUCCESS 1305 1317 "RTN","C0SDOM",237,0) 1306 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED1318 ; 1307 1319 "RTN","C0SDOM",238,0) 1308 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE 1320 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 1309 1321 "RTN","C0SDOM",239,0) 1310 Q HANDLE ; SUCCESS1322 N ZI S ZI="" 1311 1323 "RTN","C0SDOM",240,0) 1312 ;1324 N ZTAG 1313 1325 "RTN","C0SDOM",241,0) 1314 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES 1326 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION 1315 1327 "RTN","C0SDOM",242,0) 1316 N ZI S ZI=""1328 . N ZELEADD S ZELEADD=0 1317 1329 "RTN","C0SDOM",243,0) 1318 N ZTAG1330 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES 1319 1331 "RTN","C0SDOM",244,0) 1320 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION1332 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG 1321 1333 "RTN","C0SDOM",245,0) 1322 . N ZELEADD S ZELEADD=01334 . . K ZATT ; CLEAR OUT LAST ONE 1323 1335 "RTN","C0SDOM",246,0) 1324 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES1336 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY 1325 1337 "RTN","C0SDOM",247,0) 1326 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG1338 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE 1327 1339 "RTN","C0SDOM",248,0) 1328 . . K ZATT ; CLEAR OUT LAST ONE1340 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE 1329 1341 "RTN","C0SDOM",249,0) 1330 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY1342 . I $O(@ZARY@(ZI,""))="" D ;END NODE 1331 1343 "RTN","C0SDOM",250,0) 1332 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE1344 . . S ZTAG=ZI ; USE ZI FOR THE TAG 1333 1345 "RTN","C0SDOM",251,0) 1334 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE1346 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE 1335 1347 "RTN","C0SDOM",252,0) 1336 . I $O(@ZARY@(ZI,""))="" D ;END NODE1348 . . S ZELEADD=1 ; ADDED AN ELEMENT 1337 1349 "RTN","C0SDOM",253,0) 1338 . . S ZTAG=ZI ; USE ZI FOR THE TAG1350 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE 1339 1351 "RTN","C0SDOM",254,0) 1340 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE1352 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL 1341 1353 "RTN","C0SDOM",255,0) 1342 . . S ZELEADD=1 ; ADDED AN ELEMENT1354 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING 1343 1355 "RTN","C0SDOM",256,0) 1344 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE1356 . N NEWARY ; INDENTED ARRAY 1345 1357 "RTN","C0SDOM",257,0) 1346 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL1358 . N ZN S ZN=0 1347 1359 "RTN","C0SDOM",258,0) 1348 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING1360 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE 1349 1361 "RTN","C0SDOM",259,0) 1350 . N NEWARY ; INDENTED ARRAY1362 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG 1351 1363 "RTN","C0SDOM",260,0) 1352 . N ZN S ZN=01364 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY 1353 1365 "RTN","C0SDOM",261,0) 1354 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE1366 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY 1355 1367 "RTN","C0SDOM",262,0) 1356 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG1368 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 1357 1369 "RTN","C0SDOM",263,0) 1358 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY1370 Q 1359 1371 "RTN","C0SDOM",264,0) 1360 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY1372 ; 1361 1373 "RTN","C0SDOM",265,0) 1362 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG 1374 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 1363 1375 "RTN","C0SDOM",266,0) 1364 Q1376 ; CONSISTENT FORMAT 1365 1377 "RTN","C0SDOM",267,0) 1366 ; 1378 ; GNARY("patient",1,"facilities[2].facility@code")="050" 1367 1379 "RTN","C0SDOM",268,0) 1368 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED 1380 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" 1369 1381 "RTN","C0SDOM",269,0) 1370 ; CONSISTENT FORMAT1382 ; for easier processing (this is fileman format genius) 1371 1383 "RTN","C0SDOM",270,0) 1372 ; GNARY("patient",1,"facilities[2].facility@code")="050"1384 ; basically removes the dot notation from the strings 1373 1385 "RTN","C0SDOM",271,0) 1374 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"1386 ; 1375 1387 "RTN","C0SDOM",272,0) 1376 ; for easier processing (this is fileman format genius)1388 N ZZI 1377 1389 "RTN","C0SDOM",273,0) 1378 ; basically removes the dot notation from the strings1390 S ZZI="" 1379 1391 "RTN","C0SDOM",274,0) 1380 ;1392 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; 1381 1393 "RTN","C0SDOM",275,0) 1382 N ZZI1394 . N ZZN S ZZN=0 1383 1395 "RTN","C0SDOM",276,0) 1384 S ZZI=""1396 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; 1385 1397 "RTN","C0SDOM",277,0) 1386 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;1398 . . N ZZS S ZZS="" 1387 1399 "RTN","C0SDOM",278,0) 1388 . N ZZN S ZZN=01400 . . N GA ;PUSH STACK 1389 1401 "RTN","C0SDOM",279,0) 1390 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;1402 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; 1391 1403 "RTN","C0SDOM",280,0) 1392 . . N ZZS S ZZS=""1404 . . . K GA ; NEW STACK 1393 1405 "RTN","C0SDOM",281,0) 1394 . . N GA ;PUSH STACK1406 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT 1395 1407 "RTN","C0SDOM",282,0) 1396 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;1408 . . . N ZZV ; PLACE TO STASH THE VALUE 1397 1409 "RTN","C0SDOM",283,0) 1398 . . . K GA ; NEW STACK1410 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE 1399 1411 "RTN","C0SDOM",284,0) 1400 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT1412 . . . W !,"VALUE:",ZZV 1401 1413 "RTN","C0SDOM",285,0) 1402 . . . N ZZV ; PLACE TO STASH THE VALUE1414 . . . N GK ; COUNTER 1403 1415 "RTN","C0SDOM",286,0) 1404 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE1416 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE 1405 1417 "RTN","C0SDOM",287,0) 1406 . . . W !,"VALUE:",ZZV1418 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] 1407 1419 "RTN","C0SDOM",288,0) 1408 . . . N GK ; COUNTER1420 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG 1409 1421 "RTN","C0SDOM",289,0) 1410 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE1422 . . . . I GM["[" D ; IT'S A MULTIPLE 1411 1423 "RTN","C0SDOM",290,0) 1412 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]1424 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER 1413 1425 "RTN","C0SDOM",291,0) 1414 . . . . N GM S GM=$P(ZZS,".",GK) ;TAG1426 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG 1415 1427 "RTN","C0SDOM",292,0) 1416 . . . . I GM[" [" D ; IT'S A MULTIPLE1428 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES 1417 1429 "RTN","C0SDOM",293,0) 1418 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER1430 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME 1419 1431 "RTN","C0SDOM",294,0) 1420 . . . . . S GM=$P(GM,"[",1) ; PULL OUTTHE TAG1432 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG 1421 1433 "RTN","C0SDOM",295,0) 1422 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES1434 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) 1423 1435 "RTN","C0SDOM",296,0) 1424 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME1436 . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; 1425 1437 "RTN","C0SDOM",297,0) 1426 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG1438 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" 1427 1439 "RTN","C0SDOM",298,0) 1428 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2)1440 . . . N GZI S GZI="" ; STRING FOR THE INDEX 1429 1441 "RTN","C0SDOM",299,0) 1430 . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ;1442 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS 1431 1443 "RTN","C0SDOM",300,0) 1432 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"1444 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG 1433 1445 "RTN","C0SDOM",301,0) 1434 . . . N GZI S GZI="" ; STRING FOR THE INDEX1446 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY 1435 1447 "RTN","C0SDOM",302,0) 1436 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS1448 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE 1437 1449 "RTN","C0SDOM",303,0) 1438 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG1450 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST 1439 1451 "RTN","C0SDOM",304,0) 1440 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY1452 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME 1441 1453 "RTN","C0SDOM",305,0) 1442 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE1454 . . . W !,GZI 1443 1455 "RTN","C0SDOM",306,0) 1444 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST1456 . . . S @GZI2=ZZV ; REMEMBER THE VALUE? 1445 1457 "RTN","C0SDOM",307,0) 1446 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME1458 Q 1447 1459 "RTN","C0SDOM",308,0) 1448 . . . W !,GZI1460 ; 1449 1461 "RTN","C0SDOM",309,0) 1450 . . . S @GZI2=ZZV ; REMEMBER THE VALUE? 1462 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 1451 1463 "RTN","C0SDOM",310,0) 1452 Q1464 N CBK,SUCCESS,LEVEL,NODE,HANDLE 1453 1465 "RTN","C0SDOM",311,0) 1454 ;1466 K ^TMP("MXMLERR",$J) 1455 1467 "RTN","C0SDOM",312,0) 1456 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE 1468 L +^TMP("MXMLDOM",$J):5 1457 1469 "RTN","C0SDOM",313,0) 1458 N CBK,SUCCESS,LEVEL,NODE,HANDLE1470 E Q 0 1459 1471 "RTN","C0SDOM",314,0) 1460 K ^TMP("MXMLERR",$J)1472 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" 1461 1473 "RTN","C0SDOM",315,0) 1462 L +^TMP("MXMLDOM",$J):51474 L -^TMP("MXMLDOM",$J) 1463 1475 "RTN","C0SDOM",316,0) 1464 E Q 01476 Q HANDLE 1465 1477 "RTN","C0SDOM",317,0) 1466 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""1467 "RTN","C0SDOM",318,0)1468 L -^TMP("MXMLDOM",$J)1469 "RTN","C0SDOM",319,0)1470 Q HANDLE1471 "RTN","C0SDOM",320,0)1472 1478 ; 1473 1479 "RTN","C0SLAB") 1474 0^3^B79 8562521480 0^3^B79123674 1475 1481 "RTN","C0SLAB",1,0) 1476 1482 C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 1477 1483 "RTN","C0SLAB",2,0) 1478 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 51484 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 1479 1485 "RTN","C0SLAB",3,0) 1480 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU1486 ;Copyright 2012 George Lilly. 1481 1487 "RTN","C0SLAB",4,0) 1482 ; General Public License See attached copy of the License.1488 ; 1483 1489 "RTN","C0SLAB",5,0) 1484 ; 1490 ; This program is free software: you can redistribute it and/or modify 1485 1491 "RTN","C0SLAB",6,0) 1486 ; This program is free software; you can redistribute it and/or modify1492 ; it under the terms of the GNU Affero General Public License as 1487 1493 "RTN","C0SLAB",7,0) 1488 ; it under the terms of the GNU General Public License as published by1494 ; published by the Free Software Foundation, either version 3 of the 1489 1495 "RTN","C0SLAB",8,0) 1490 ; the Free Software Foundation; either version 2 of the License, or1496 ; License, or (at your option) any later version. 1491 1497 "RTN","C0SLAB",9,0) 1492 ; (at your option) any later version.1498 ; 1493 1499 "RTN","C0SLAB",10,0) 1494 ; 1500 ; This program is distributed in the hope that it will be useful, 1495 1501 "RTN","C0SLAB",11,0) 1496 ; This program is distributed in the hope that it will be useful,1502 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 1497 1503 "RTN","C0SLAB",12,0) 1498 ; but WITHOUT ANY WARRANTY; without even the implied warranty of1504 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 1499 1505 "RTN","C0SLAB",13,0) 1500 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the1506 ; GNU Affero General Public License for more details. 1501 1507 "RTN","C0SLAB",14,0) 1502 ; GNU General Public License for more details.1508 ; 1503 1509 "RTN","C0SLAB",15,0) 1504 ; 1510 ; You should have received a copy of the GNU Affero General Public License 1505 1511 "RTN","C0SLAB",16,0) 1506 ; You should have received a copy of the GNU General Public License along1512 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 1507 1513 "RTN","C0SLAB",17,0) 1508 ; with this program; if not, write to the Free Software Foundation, Inc.,1514 ; 1509 1515 "RTN","C0SLAB",18,0) 1510 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.1516 Q 1511 1517 "RTN","C0SLAB",19,0) 1512 1518 ; 1513 1519 "RTN","C0SLAB",20,0) 1514 Q1520 ; sample VistA NHIN lab result 1515 1521 "RTN","C0SLAB",21,0) 1516 1522 ; 1517 1523 "RTN","C0SLAB",22,0) 1518 ; sample VistA NHIN lab result1524 ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 1519 1525 "RTN","C0SLAB",23,0) 1520 ; 1526 ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" 1521 1527 "RTN","C0SLAB",24,0) 1522 ;^TMP("C0STBL",32,"lab",8,"co llected@value")=3110626.161528 ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" 1523 1529 "RTN","C0SLAB",25,0) 1524 ;^TMP("C0STBL",32,"lab",8," comment")="Report Released Date/Time: Jun 26, 2011@19:00"1530 ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 1525 1531 "RTN","C0SLAB",26,0) 1526 ;^TMP("C0STBL",32,"lab",8," comment@xml:space")="preserve"1532 ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" 1527 1533 "RTN","C0SLAB",27,0) 1528 ;^TMP("C0STBL",32,"lab",8," facility@code")=1001534 ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" 1529 1535 "RTN","C0SLAB",28,0) 1530 ;^TMP("C0STBL",32,"lab",8," facility@name")="VOE OFFICE INSTITUTION"1536 ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" 1531 1537 "RTN","C0SLAB",29,0) 1532 ;^TMP("C0STBL",32,"lab",8," groupName@value")="CH 0626 47"1538 ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" 1533 1539 "RTN","C0SLAB",30,0) 1534 ;^TMP("C0STBL",32,"lab",8," high@value")=" 101"1540 ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" 1535 1541 "RTN","C0SLAB",31,0) 1536 ;^TMP("C0STBL",32,"lab",8," id@value")="CH;6889372.84;67003"1542 ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 1537 1543 "RTN","C0SLAB",32,0) 1538 ;^TMP("C0STBL",32,"lab",8," interpretation@value")="H"1544 ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" 1539 1545 "RTN","C0SLAB",33,0) 1540 ;^TMP("C0STBL",32,"lab",8,"l abOrderID@value")=3361546 ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" 1541 1547 "RTN","C0SLAB",34,0) 1542 ;^TMP("C0STBL",32,"lab",8,"lo calName@value")="FBLDGLU"1548 ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " 1543 1549 "RTN","C0SLAB",35,0) 1544 ;^TMP("C0STBL",32,"lab",8," loinc@value")="14771-0"1550 ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 1545 1551 "RTN","C0SLAB",36,0) 1546 ;^TMP("C0STBL",32,"lab",8," low@value")="69 "1552 ;^TMP("C0STBL",32,"lab",8,"result@value")=178 1547 1553 "RTN","C0SLAB",37,0) 1548 ;^TMP("C0STBL",32,"lab",8," orderID@value")=8071554 ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 1549 1555 "RTN","C0SLAB",38,0) 1550 ;^TMP("C0STBL",32,"lab",8," result@value")=1781556 ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" 1551 1557 "RTN","C0SLAB",39,0) 1552 ;^TMP("C0STBL",32,"lab",8," resulted@value")=3110626.1900061558 ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" 1553 1559 "RTN","C0SLAB",40,0) 1554 ;^TMP("C0STBL",32,"lab",8,"s ample@value")="SERUM"1560 ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" 1555 1561 "RTN","C0SLAB",41,0) 1556 ;^TMP("C0STBL",32,"lab",8,"s pecimen@code")="0X500"1562 ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" 1557 1563 "RTN","C0SLAB",42,0) 1558 ;^TMP("C0STBL",32,"lab",8," specimen@name")="SERUM"1564 ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" 1559 1565 "RTN","C0SLAB",43,0) 1560 ;^TMP("C0STBL",32,"lab",8," status@value")="completed"1566 ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" 1561 1567 "RTN","C0SLAB",44,0) 1562 ;^TMP("C0STBL",32,"lab",8," test@value")="FASTING BLOOD GLUCOSE"1568 ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" 1563 1569 "RTN","C0SLAB",45,0) 1564 ;^TMP("C0STBL",32,"lab",8," type@value")="CH"1570 ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 1565 1571 "RTN","C0SLAB",46,0) 1566 ; ^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL"1572 ; 1567 1573 "RTN","C0SLAB",47,0) 1568 ; ^TMP("C0STBL",32,"lab",8,"vuid@value")=46563421574 ; sample Smart lab result triples 1569 1575 "RTN","C0SLAB",48,0) 1570 1576 ; 1571 1577 "RTN","C0SLAB",49,0) 1572 ; sample Smart lab result triples1578 ;G("loinc:29571-7","dcterms:identifier")="29571-7" 1573 1579 "RTN","C0SLAB",50,0) 1574 ; 1580 ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" 1575 1581 "RTN","C0SLAB",51,0) 1576 ;G("loinc:29571-7"," dcterms:identifier")="29571-7"1582 ;G("loinc:29571-7","rdf:type")="sp:Code" 1577 1583 "RTN","C0SLAB",52,0) 1578 ;G("loinc:29571-7"," dcterms:title")="Phe DBS Ql"1584 ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" 1579 1585 "RTN","C0SLAB",53,0) 1580 ;G("loinc: 29571-7","rdf:type")="sp:Code"1586 ;G("loinc:38478-4","dcterms:identifier")="38478-4" 1581 1587 "RTN","C0SLAB",54,0) 1582 ;G("loinc: 29571-7","sp:system")="http://loinc.org/codes/"1588 ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" 1583 1589 "RTN","C0SLAB",55,0) 1584 ;G("loinc:38478-4"," dcterms:identifier")="38478-4"1590 ;G("loinc:38478-4","rdf:type")="sp:Code" 1585 1591 "RTN","C0SLAB",56,0) 1586 ;G("loinc:38478-4"," dcterms:title")="Biotinidase DBS Ql"1592 ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" 1587 1593 "RTN","C0SLAB",57,0) 1588 ;G(" loinc:38478-4","rdf:type")="sp:Code"1594 ;G("qqWZZIew993","rdf:type")="sp:Attribution" 1589 1595 "RTN","C0SLAB",58,0) 1590 ;G(" loinc:38478-4","sp:system")="http://loinc.org/codes/"1596 ;G("qqWZZIew993","sp:startDate")="2007-04-21" 1591 1597 "RTN","C0SLAB",59,0) 1592 ;G("qqWZZIew99 3","rdf:type")="sp:Attribution"1598 ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" 1593 1599 "RTN","C0SLAB",60,0) 1594 ;G("qqWZZIew99 3","sp:startDate")="2007-04-21"1600 ;G("qqWZZIew994","sp:value")="Normal" 1595 1601 "RTN","C0SLAB",61,0) 1596 ;G("qqWZZIew99 4","rdf:type")="sp:NarrativeResult"1602 ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" 1597 1603 "RTN","C0SLAB",62,0) 1598 ;G("qqWZZIew99 4","sp:value")="Normal"1604 ;G("qqWZZIew995","rdf:type")="sp:CodedValue" 1599 1605 "RTN","C0SLAB",63,0) 1600 ;G("qqWZZIew995"," dcterms:title")="Biotinidase DBS Ql"1606 ;G("qqWZZIew995","sp:code")="loinc:38478-4" 1601 1607 "RTN","C0SLAB",64,0) 1602 ;G("qqWZZIew99 5","rdf:type")="sp:CodedValue"1608 ;G("qqWZZIew997","rdf:type")="sp:Attribution" 1603 1609 "RTN","C0SLAB",65,0) 1604 ;G("qqWZZIew99 5","sp:code")="loinc:38478-4"1610 ;G("qqWZZIew997","sp:startDate")="2007-09-08" 1605 1611 "RTN","C0SLAB",66,0) 1606 ;G("qqWZZIew99 7","rdf:type")="sp:Attribution"1612 ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" 1607 1613 "RTN","C0SLAB",67,0) 1608 ;G("qqWZZIew99 7","sp:startDate")="2007-09-08"1614 ;G("qqWZZIew998","sp:value")="Normal" 1609 1615 "RTN","C0SLAB",68,0) 1610 ;G("qqWZZIew99 8","rdf:type")="sp:NarrativeResult"1616 ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" 1611 1617 "RTN","C0SLAB",69,0) 1612 ;G("qqWZZIew99 8","sp:value")="Normal"1618 ;G("qqWZZIew999","rdf:type")="sp:CodedValue" 1613 1619 "RTN","C0SLAB",70,0) 1614 ;G("qqWZZIew999"," dcterms:title")="Phe DBS Ql"1620 ;G("qqWZZIew999","sp:code")="loinc:29571-7" 1615 1621 "RTN","C0SLAB",71,0) 1616 ;G(" qqWZZIew999","rdf:type")="sp:CodedValue"1622 ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" 1617 1623 "RTN","C0SLAB",72,0) 1618 ;G(" qqWZZIew999","sp:code")="loinc:29571-7"1624 ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" 1619 1625 "RTN","C0SLAB",73,0) 1620 ;G("smart:99912345/lab_results/3d9b39249193"," rdf:type")="sp:LabResult"1626 ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" 1621 1627 "RTN","C0SLAB",74,0) 1622 ;G("smart:99912345/lab_results/3d9b39249193","sp: belongsTo")="smart:99912345"1628 ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" 1623 1629 "RTN","C0SLAB",75,0) 1624 ;G("smart:99912345/lab_results/3d9b39249193","sp: labName")="qqWZZIew995"1630 ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" 1625 1631 "RTN","C0SLAB",76,0) 1626 ;G("smart:99912345/lab_results/ 3d9b39249193","sp:narrativeResult")="qqWZZIew994"1632 ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" 1627 1633 "RTN","C0SLAB",77,0) 1628 ;G("smart:99912345/lab_results/ 3d9b39249193","sp:specimenCollected")="qqWZZIew993"1634 ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" 1629 1635 "RTN","C0SLAB",78,0) 1630 ;G("smart:99912345/lab_results/426c7adc4f54"," rdf:type")="sp:LabResult"1636 ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" 1631 1637 "RTN","C0SLAB",79,0) 1632 ;G("smart:99912345/lab_results/426c7adc4f54","sp: belongsTo")="smart:99912345"1638 ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" 1633 1639 "RTN","C0SLAB",80,0) 1634 ;G("smart:99912345/lab_results/426c7adc4f54","sp: labName")="qqWZZIew999"1640 ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" 1635 1641 "RTN","C0SLAB",81,0) 1636 ; G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998"1642 ; 1637 1643 "RTN","C0SLAB",82,0) 1638 ; G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997"1644 ; 1639 1645 "RTN","C0SLAB",83,0) 1640 ; 1646 ; another Smart example, this one with sp:quantitativeResult 1641 1647 "RTN","C0SLAB",84,0) 1642 1648 ; 1643 1649 "RTN","C0SLAB",85,0) 1644 ; another Smart example, this one with sp:quantitativeResult1650 ;G("loinc:786-4","dcterms:identifier")="786-4" 1645 1651 "RTN","C0SLAB",86,0) 1646 ; 1652 ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" 1647 1653 "RTN","C0SLAB",87,0) 1648 ;G("loinc:786-4"," dcterms:identifier")="786-4"1654 ;G("loinc:786-4","rdf:type")="sp:Code" 1649 1655 "RTN","C0SLAB",88,0) 1650 ;G("loinc:786-4"," dcterms:title")="MCHC RBC Auto-mCnc"1656 ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" 1651 1657 "RTN","C0SLAB",89,0) 1652 ;G(" loinc:786-4","rdf:type")="sp:Code"1658 ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" 1653 1659 "RTN","C0SLAB",90,0) 1654 ;G(" loinc:786-4","sp:system")="http://loinc.org/codes/"1660 ;G("nodeID:4439","sp:unit")="g/dL" 1655 1661 "RTN","C0SLAB",91,0) 1656 ;G("nodeID:4439"," rdf:type")="sp:ValueAndUnit"1662 ;G("nodeID:4439","sp:value")=36.6 1657 1663 "RTN","C0SLAB",92,0) 1658 ;G("nodeID:4 439","sp:unit")="g/dL"1664 ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" 1659 1665 "RTN","C0SLAB",93,0) 1660 ;G("nodeID:4 439","sp:value")=36.61666 ;G("nodeID:4613","sp:unit")="g/dL" 1661 1667 "RTN","C0SLAB",94,0) 1662 ;G("nodeID:4613"," rdf:type")="sp:ValueAndUnit"1668 ;G("nodeID:4613","sp:value")=32 1663 1669 "RTN","C0SLAB",95,0) 1664 ;G("nodeID:46 13","sp:unit")="g/dL"1670 ;G("nodeID:4672","rdf:type")="sp:Attribution" 1665 1671 "RTN","C0SLAB",96,0) 1666 ;G("nodeID:46 13","sp:value")=321672 ;G("nodeID:4672","sp:startDate")="2005-03-10" 1667 1673 "RTN","C0SLAB",97,0) 1668 ;G("nodeID:4 672","rdf:type")="sp:Attribution"1674 ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" 1669 1675 "RTN","C0SLAB",98,0) 1670 ;G("nodeID:4 672","sp:startDate")="2005-03-10"1676 ;G("nodeID:4866","sp:unit")="g/dL" 1671 1677 "RTN","C0SLAB",99,0) 1672 ;G("nodeID:4866"," rdf:type")="sp:ValueAndUnit"1678 ;G("nodeID:4866","sp:value")=36 1673 1679 "RTN","C0SLAB",100,0) 1674 ;G("nodeID:48 66","sp:unit")="g/dL"1680 ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" 1675 1681 "RTN","C0SLAB",101,0) 1676 ;G("nodeID:48 66","sp:value")=361682 ;G("nodeID:4871","rdf:type")="sp:CodedValue" 1677 1683 "RTN","C0SLAB",102,0) 1678 ;G("nodeID:4871"," dcterms:title")="MCHC RBC Auto-mCnc"1684 ;G("nodeID:4871","sp:code")="loinc:786-4" 1679 1685 "RTN","C0SLAB",103,0) 1680 ;G("nodeID: 4871","rdf:type")="sp:CodedValue"1686 ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" 1681 1687 "RTN","C0SLAB",104,0) 1682 ;G("nodeID: 4871","sp:code")="loinc:786-4"1688 ;G("nodeID:5221","sp:normalRange")="nodeID:5282" 1683 1689 "RTN","C0SLAB",105,0) 1684 ;G("nodeID:5221"," rdf:type")="sp:QuantitativeResult"1690 ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" 1685 1691 "RTN","C0SLAB",106,0) 1686 ;G("nodeID:52 21","sp:normalRange")="nodeID:5282"1692 ;G("nodeID:5282","rdf:type")="sp:ValueRange" 1687 1693 "RTN","C0SLAB",107,0) 1688 ;G("nodeID:52 21","sp:valueAndUnit")="nodeID:4439"1694 ;G("nodeID:5282","sp:maximum")="nodeID:4866" 1689 1695 "RTN","C0SLAB",108,0) 1690 ;G("nodeID:5282"," rdf:type")="sp:ValueRange"1696 ;G("nodeID:5282","sp:minimum")="nodeID:4613" 1691 1697 "RTN","C0SLAB",109,0) 1692 ;G(" nodeID:5282","sp:maximum")="nodeID:4866"1698 ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" 1693 1699 "RTN","C0SLAB",110,0) 1694 ;G(" nodeID:5282","sp:minimum")="nodeID:4613"1700 ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" 1695 1701 "RTN","C0SLAB",111,0) 1696 ;G("smart:1540505/lab_results/2fc100850766"," rdf:type")="sp:LabResult"1702 ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" 1697 1703 "RTN","C0SLAB",112,0) 1698 ;G("smart:1540505/lab_results/2fc100850766","sp: belongsTo")="smart:1540505"1704 ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" 1699 1705 "RTN","C0SLAB",113,0) 1700 ;G("smart:1540505/lab_results/2fc100850766","sp: labName")="nodeID:4871"1706 ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" 1701 1707 "RTN","C0SLAB",114,0) 1702 ; G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221"1708 ; 1703 1709 "RTN","C0SLAB",115,0) 1704 ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" 1710 LAB(GRTN,C0SARY) ; GRTN, passed by reference, 1705 1711 "RTN","C0SLAB",116,0) 1706 ; 1712 ; is the return name of the graph created. "" if none 1707 1713 "RTN","C0SLAB",117,0) 1708 LAB(GRTN,C0SARY) ; GRTN, passed by reference, 1714 ; C0SARY is passed in by reference and is the NHIN array of lab 1709 1715 "RTN","C0SLAB",118,0) 1710 ; is the return name of the graph created. "" if none1716 ; 1711 1717 "RTN","C0SLAB",119,0) 1712 ; C0SARY is passed in by reference and is the NHIN array of lab1718 I $O(C0SARY("lab",""))="" D Q ; 1713 1719 "RTN","C0SLAB",120,0) 1714 ;1720 . I $D(DEBUG) W !,"No Labs" 1715 1721 "RTN","C0SLAB",121,0) 1716 I $O(C0SARY("lab",""))="" D Q ;1722 S GRTN="" ; default to no labs 1717 1723 "RTN","C0SLAB",122,0) 1718 . I $D(DEBUG) W !,"No Labs"1724 N C0SGRF 1719 1725 "RTN","C0SLAB",123,0) 1720 S GRTN="" ; default to no labs1726 S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" 1721 1727 "RTN","C0SLAB",124,0) 1722 NC0SGRF1728 I $D(DEBUG) W !,"Processing ",C0SGRF 1723 1729 "RTN","C0SLAB",125,0) 1724 S C0SGRF="vistaSmart:"_ZPATID_"/lab_results"1730 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 1725 1731 "RTN","C0SLAB",126,0) 1726 I $D(DEBUG) W !,"Processing ",C0SGRF1732 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 1727 1733 "RTN","C0SLAB",127,0) 1728 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph1734 N FARY S FARY="C0XFARY" 1729 1735 "RTN","C0SLAB",128,0) 1730 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use1736 D USEFARY^C0XF2N(FARY) 1731 1737 "RTN","C0SLAB",129,0) 1732 N FARY S FARY="C0XFARY"1738 D VOCINIT^C0XUTIL 1733 1739 "RTN","C0SLAB",130,0) 1734 D USEFARY^C0XF2N(FARY)1740 ; 1735 1741 "RTN","C0SLAB",131,0) 1736 D VOCINIT^C0XUTIL1742 D STARTADD^C0XF2N ; initialize to create triples 1737 1743 "RTN","C0SLAB",132,0) 1738 1744 ; 1739 1745 "RTN","C0SLAB",133,0) 1740 D STARTADD^C0XF2N ; initialize to create triples1746 N ZI S ZI="" 1741 1747 "RTN","C0SLAB",134,0) 1742 ;1748 F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; 1743 1749 "RTN","C0SLAB",135,0) 1744 N ZI S ZI=""1750 . N LRN,ZR ; ZR is the local array for building the new triples 1745 1751 "RTN","C0SLAB",136,0) 1746 F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ;1752 . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result 1747 1753 "RTN","C0SLAB",137,0) 1748 . N LRN,ZR ; ZR is the local array for building the new triples1754 . ; 1749 1755 "RTN","C0SLAB",138,0) 1750 . S LRN=$NA(C0SARY("lab",ZI)) ; base for values inthis lab result1756 . N RSLTID ; unique Id for this lab result 1751 1757 "RTN","C0SLAB",139,0) 1758 . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 1759 "RTN","C0SLAB",140,0) 1752 1760 . ; 1753 "RTN","C0SLAB",140,0)1754 . N RSLTID ; unique Id for this lab result1755 1761 "RTN","C0SLAB",141,0) 1756 . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number1762 . ; i don't like this because the same labs result gets a 1757 1763 "RTN","C0SLAB",142,0) 1764 . ; different ID every time it's reported. Can't trace it back to VistA 1765 "RTN","C0SLAB",143,0) 1766 . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" 1767 "RTN","C0SLAB",144,0) 1768 . ; .. either that or store an OID with the lab result - but that 1769 "RTN","C0SLAB",145,0) 1770 . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 1771 "RTN","C0SLAB",146,0) 1758 1772 . ; 1759 "RTN","C0SLAB",143,0)1760 . ; i don't like this because the same labs result gets a1761 "RTN","C0SLAB",144,0)1762 . ; different ID every time it's reported. Can't trace it back to VistA1763 "RTN","C0SLAB",145,0)1764 . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003"1765 "RTN","C0SLAB",146,0)1766 . ; .. either that or store an OID with the lab result - but that1767 1773 "RTN","C0SLAB",147,0) 1768 . ; will have to wait for the redesign of file 60.. - gpl 4/16/20121774 . N LOINC S LOINC=$G(@LRN@("loinc@value")) 1769 1775 "RTN","C0SLAB",148,0) 1776 . I LOINC="" D Q ; 1777 "RTN","C0SLAB",149,0) 1778 . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" 1779 "RTN","C0SLAB",150,0) 1780 . N LABTST S LABTST=$G(@LRN@("test@value")) 1781 "RTN","C0SLAB",151,0) 1782 . I $D(DEBUG) D ; 1783 "RTN","C0SLAB",152,0) 1784 . . W !,"Processing Lab Result ",RSLTID 1785 "RTN","C0SLAB",153,0) 1786 . . W !,"test: ",LABTST 1787 "RTN","C0SLAB",154,0) 1788 . . W !,"loinc: ",LOINC 1789 "RTN","C0SLAB",155,0) 1770 1790 . ; 1771 "RTN","C0SLAB",149,0)1772 . N LOINC S LOINC=$G(@LRN@("loinc@value"))1773 "RTN","C0SLAB",150,0)1774 . I LOINC="" D Q ;1775 "RTN","C0SLAB",151,0)1776 . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING"1777 "RTN","C0SLAB",152,0)1778 . N LABTST S LABTST=$G(@LRN@("test@value"))1779 "RTN","C0SLAB",153,0)1780 . I $D(DEBUG) D ;1781 "RTN","C0SLAB",154,0)1782 . . W !,"Processing Lab Result ",RSLTID1783 "RTN","C0SLAB",155,0)1784 . . W !,"test: ",LABTST1785 1791 "RTN","C0SLAB",156,0) 1786 . . W !,"loinc: ",LOINC1792 . ; first do the base result graph 1787 1793 "RTN","C0SLAB",157,0) 1788 1794 . ; 1789 1795 "RTN","C0SLAB",158,0) 1790 . ; first do the base result graph1796 . S ZR("rdf:type")="sp:LabResult" 1791 1797 "RTN","C0SLAB",159,0) 1798 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results 1799 "RTN","C0SLAB",160,0) 1800 . ; ie /vista/smart/99912345/lab_results 1801 "RTN","C0SLAB",161,0) 1792 1802 . ; 1793 "RTN","C0SLAB",160,0)1794 . S ZR("rdf:type")="sp:LabResult"1795 "RTN","C0SLAB",161,0)1796 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results1797 1803 "RTN","C0SLAB",162,0) 1798 . ; ie /vista/smart/99912345/lab_results1804 . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name 1799 1805 "RTN","C0SLAB",163,0) 1806 . S ZR("sp:labName")=LABNAME 1807 "RTN","C0SLAB",164,0) 1800 1808 . ; 1801 "RTN","C0SLAB",164,0)1802 . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name1803 1809 "RTN","C0SLAB",165,0) 1804 . S ZR("sp:labName")=LABNAME1810 . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result 1805 1811 "RTN","C0SLAB",166,0) 1812 . S ZR("sp:narrativeResult")=NARRSLT 1813 "RTN","C0SLAB",167,0) 1806 1814 . ; 1807 "RTN","C0SLAB",167,0)1808 . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result1809 1815 "RTN","C0SLAB",168,0) 1810 . S ZR("sp:narrativeResult")=NARRSLT1816 . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result 1811 1817 "RTN","C0SLAB",169,0) 1818 . S ZR("sp:quantitativeResult")=QNTRSLT 1819 "RTN","C0SLAB",170,0) 1812 1820 . ; 1813 "RTN","C0SLAB",170,0)1814 . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result1815 1821 "RTN","C0SLAB",171,0) 1816 . S ZR("sp:quantitativeResult")=QNTRSLT1822 . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected 1817 1823 "RTN","C0SLAB",172,0) 1824 . S ZR("sp:specimenCollected")=SPECCOLL 1825 "RTN","C0SLAB",173,0) 1818 1826 . ; 1819 "RTN","C0SLAB",173,0)1820 . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected1821 1827 "RTN","C0SLAB",174,0) 1822 . S ZR("sp:specimenCollected")=SPECCOLL1828 . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples 1823 1829 "RTN","C0SLAB",175,0) 1830 . K ZR ; clean up 1831 "RTN","C0SLAB",176,0) 1824 1832 . ; 1825 "RTN","C0SLAB",176,0)1826 . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples1827 1833 "RTN","C0SLAB",177,0) 1828 . K ZR ; clean up1834 . ; create the narrative result graph 1829 1835 "RTN","C0SLAB",178,0) 1830 1836 . ; 1831 1837 "RTN","C0SLAB",179,0) 1832 . ; create the narrative result graph1838 . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L 1833 1839 "RTN","C0SLAB",180,0) 1840 . I IVAL'="" 1841 "RTN","C0SLAB",181,0) 1842 . . S ZR("rdf:type")="sp:NarrativeResult" 1843 "RTN","C0SLAB",182,0) 1844 . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L 1845 "RTN","C0SLAB",183,0) 1846 . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" 1847 "RTN","C0SLAB",184,0) 1848 . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" 1849 "RTN","C0SLAB",185,0) 1850 . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" 1851 "RTN","C0SLAB",186,0) 1852 . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" 1853 "RTN","C0SLAB",187,0) 1854 . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) 1855 "RTN","C0SLAB",188,0) 1856 . . K ZR 1857 "RTN","C0SLAB",189,0) 1834 1858 . ; 1835 "RTN","C0SLAB",181,0)1836 . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L1837 "RTN","C0SLAB",182,0)1838 . I IVAL'=""1839 "RTN","C0SLAB",183,0)1840 . . S ZR("rdf:type")="sp:NarrativeResult"1841 "RTN","C0SLAB",184,0)1842 . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L1843 "RTN","C0SLAB",185,0)1844 . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal"1845 "RTN","C0SLAB",186,0)1846 . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal"1847 "RTN","C0SLAB",187,0)1848 . . I ZR("sp:value")="HH" S ZR("sp:value")="critical"1849 "RTN","C0SLAB",188,0)1850 . . I ZR("sp:value")="LL" S ZR("sp:value")="critical"1851 "RTN","C0SLAB",189,0)1852 . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR)1853 1859 "RTN","C0SLAB",190,0) 1854 . . K ZR1860 . ; create the quantitative result graph 1855 1861 "RTN","C0SLAB",191,0) 1862 . ; 1863 "RTN","C0SLAB",192,0) 1864 . S ZR("rdf:type")="sp:QuantitativeResult" 1865 "RTN","C0SLAB",193,0) 1866 . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph 1867 "RTN","C0SLAB",194,0) 1868 . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph 1869 "RTN","C0SLAB",195,0) 1870 . N HASNORMAL S HASNORMAL=0 1871 "RTN","C0SLAB",196,0) 1872 . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 1873 "RTN","C0SLAB",197,0) 1874 . I HASNORMAL S ZR("sp:normalRange")=NORMNM 1875 "RTN","C0SLAB",198,0) 1876 . S ZR("sp:valueAndUnit")=VUNM 1877 "RTN","C0SLAB",199,0) 1878 . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) 1879 "RTN","C0SLAB",200,0) 1880 . K ZR 1881 "RTN","C0SLAB",201,0) 1856 1882 . ; 1857 "RTN","C0SLAB",192,0)1858 . ; create the quantitative result graph1859 "RTN","C0SLAB",193,0)1860 . ;1861 "RTN","C0SLAB",194,0)1862 . S ZR("rdf:type")="sp:QuantitativeResult"1863 "RTN","C0SLAB",195,0)1864 . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph1865 "RTN","C0SLAB",196,0)1866 . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph1867 "RTN","C0SLAB",197,0)1868 . N HASNORMAL S HASNORMAL=01869 "RTN","C0SLAB",198,0)1870 . I $G(@LRN@("high@value"))'="" S HASNORMAL=11871 "RTN","C0SLAB",199,0)1872 . I HASNORMAL S ZR("sp:normalRange")=NORMNM1873 "RTN","C0SLAB",200,0)1874 . S ZR("sp:valueAndUnit")=VUNM1875 "RTN","C0SLAB",201,0)1876 . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR)1877 1883 "RTN","C0SLAB",202,0) 1878 . K ZR1884 . ; create the normal range graph 1879 1885 "RTN","C0SLAB",203,0) 1880 1886 . ; 1881 1887 "RTN","C0SLAB",204,0) 1882 . ; create the normal range graph1888 . I HASNORMAL D ; 1883 1889 "RTN","C0SLAB",205,0) 1890 . . S ZR("rdf:type")="sp:ValueRange" 1891 "RTN","C0SLAB",206,0) 1892 . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph 1893 "RTN","C0SLAB",207,0) 1894 . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph 1895 "RTN","C0SLAB",208,0) 1896 . . S ZR("sp:maximum")=MAXNM 1897 "RTN","C0SLAB",209,0) 1898 . . S ZR("sp:minimum")=MINNM 1899 "RTN","C0SLAB",210,0) 1900 . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) 1901 "RTN","C0SLAB",211,0) 1902 . . K ZR 1903 "RTN","C0SLAB",212,0) 1904 . . ; 1905 "RTN","C0SLAB",213,0) 1906 . . ; create the maximum graph 1907 "RTN","C0SLAB",214,0) 1908 . . ; 1909 "RTN","C0SLAB",215,0) 1910 . . S ZR("rdf:type")="sp:ValueAndUnit" 1911 "RTN","C0SLAB",216,0) 1912 . . S ZR("sp:unit")=$G(@LRN@("units@value")) 1913 "RTN","C0SLAB",217,0) 1914 . . S ZR("sp:value")=$G(@LRN@("high@value")) 1915 "RTN","C0SLAB",218,0) 1916 . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) 1917 "RTN","C0SLAB",219,0) 1918 . . K ZR 1919 "RTN","C0SLAB",220,0) 1920 . . ; 1921 "RTN","C0SLAB",221,0) 1922 . . ; create the minimum graph 1923 "RTN","C0SLAB",222,0) 1924 . . ; 1925 "RTN","C0SLAB",223,0) 1926 . . S ZR("rdf:type")="sp:ValueAndUnit" 1927 "RTN","C0SLAB",224,0) 1928 . . S ZR("sp:unit")=$G(@LRN@("units@value")) 1929 "RTN","C0SLAB",225,0) 1930 . . S ZR("sp:value")=$G(@LRN@("low@value")) 1931 "RTN","C0SLAB",226,0) 1932 . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) 1933 "RTN","C0SLAB",227,0) 1934 . . K ZR 1935 "RTN","C0SLAB",228,0) 1884 1936 . ; 1885 "RTN","C0SLAB",206,0)1886 . I HASNORMAL D ;1887 "RTN","C0SLAB",207,0)1888 . . S ZR("rdf:type")="sp:ValueRange"1889 "RTN","C0SLAB",208,0)1890 . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph1891 "RTN","C0SLAB",209,0)1892 . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph1893 "RTN","C0SLAB",210,0)1894 . . S ZR("sp:maximum")=MAXNM1895 "RTN","C0SLAB",211,0)1896 . . S ZR("sp:minimum")=MINNM1897 "RTN","C0SLAB",212,0)1898 . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR)1899 "RTN","C0SLAB",213,0)1900 . . K ZR1901 "RTN","C0SLAB",214,0)1902 . . ;1903 "RTN","C0SLAB",215,0)1904 . . ; create the maximum graph1905 "RTN","C0SLAB",216,0)1906 . . ;1907 "RTN","C0SLAB",217,0)1908 . . S ZR("rdf:type")="sp:ValueAndUnit"1909 "RTN","C0SLAB",218,0)1910 . . S ZR("sp:unit")=$G(@LRN@("units@value"))1911 "RTN","C0SLAB",219,0)1912 . . S ZR("sp:value")=$G(@LRN@("high@value"))1913 "RTN","C0SLAB",220,0)1914 . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR)1915 "RTN","C0SLAB",221,0)1916 . . K ZR1917 "RTN","C0SLAB",222,0)1918 . . ;1919 "RTN","C0SLAB",223,0)1920 . . ; create the minimum graph1921 "RTN","C0SLAB",224,0)1922 . . ;1923 "RTN","C0SLAB",225,0)1924 . . S ZR("rdf:type")="sp:ValueAndUnit"1925 "RTN","C0SLAB",226,0)1926 . . S ZR("sp:unit")=$G(@LRN@("units@value"))1927 "RTN","C0SLAB",227,0)1928 . . S ZR("sp:value")=$G(@LRN@("low@value"))1929 "RTN","C0SLAB",228,0)1930 . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR)1931 1937 "RTN","C0SLAB",229,0) 1932 . . K ZR1938 . ; create the value and unit graph 1933 1939 "RTN","C0SLAB",230,0) 1934 1940 . ; 1935 1941 "RTN","C0SLAB",231,0) 1936 . ; create the value and unit graph1942 . S ZR("rdf:type")="sp:ValueAndUnit" 1937 1943 "RTN","C0SLAB",232,0) 1944 . S ZR("sp:unit")=$G(@LRN@("units@value")) 1945 "RTN","C0SLAB",233,0) 1946 . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl 1947 "RTN","C0SLAB",234,0) 1948 . S ZR("sp:value")=$G(@LRN@("result@value")) 1949 "RTN","C0SLAB",235,0) 1950 . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) 1951 "RTN","C0SLAB",236,0) 1952 . K ZR 1953 "RTN","C0SLAB",237,0) 1938 1954 . ; 1939 "RTN","C0SLAB",233,0)1940 . S ZR("rdf:type")="sp:ValueAndUnit"1941 "RTN","C0SLAB",234,0)1942 . S ZR("sp:unit")=$G(@LRN@("units@value"))1943 "RTN","C0SLAB",235,0)1944 . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl1945 "RTN","C0SLAB",236,0)1946 . S ZR("sp:value")=$G(@LRN@("result@value"))1947 "RTN","C0SLAB",237,0)1948 . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR)1949 1955 "RTN","C0SLAB",238,0) 1956 . ; create specimen collected graph 1957 "RTN","C0SLAB",239,0) 1958 . ; 1959 "RTN","C0SLAB",240,0) 1960 . S ZR("rdf:type")="sp:Attribution" 1961 "RTN","C0SLAB",241,0) 1962 . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) 1963 "RTN","C0SLAB",242,0) 1964 . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) 1965 "RTN","C0SLAB",243,0) 1950 1966 . K ZR 1951 "RTN","C0SLAB",2 39,0)1967 "RTN","C0SLAB",244,0) 1952 1968 . ; 1953 "RTN","C0SLAB",240,0)1954 . ; create specimen collected graph1955 "RTN","C0SLAB",241,0)1956 . ;1957 "RTN","C0SLAB",242,0)1958 . S ZR("rdf:type")="sp:Attribution"1959 "RTN","C0SLAB",243,0)1960 . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value")))1961 "RTN","C0SLAB",244,0)1962 . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR)1963 1969 "RTN","C0SLAB",245,0) 1964 . K ZR1970 . ; create lab name graph - this contains the test name and code 1965 1971 "RTN","C0SLAB",246,0) 1966 1972 . ; 1967 1973 "RTN","C0SLAB",247,0) 1968 . ; create lab name graph - this contains the test name and code1974 . I LOINC'="" D ; 1969 1975 "RTN","C0SLAB",248,0) 1976 . . S ZR("rdf:type")="sp:CodedValue" 1977 "RTN","C0SLAB",249,0) 1978 . . S ZR("dcterms:title")=LABTST 1979 "RTN","C0SLAB",250,0) 1980 . . N LOINCNM S LOINCNM="loinc:"_LOINC 1981 "RTN","C0SLAB",251,0) 1982 . . S ZR("sp:code")="loinc:"_LOINC 1983 "RTN","C0SLAB",252,0) 1984 . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) 1985 "RTN","C0SLAB",253,0) 1986 . . K ZR 1987 "RTN","C0SLAB",254,0) 1988 . . S ZR("dcterms:identifier")=LOINC 1989 "RTN","C0SLAB",255,0) 1990 . . S ZR("dcterms:title")=LABTST 1991 "RTN","C0SLAB",256,0) 1992 . . S ZR("rdf:type")="sp:Code" 1993 "RTN","C0SLAB",257,0) 1994 . . S ZR("sp:system")="http://loinc.org/codes/" 1995 "RTN","C0SLAB",258,0) 1996 . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) 1997 "RTN","C0SLAB",259,0) 1998 . . K ZR 1999 "RTN","C0SLAB",260,0) 1970 2000 . ; 1971 "RTN","C0SLAB",249,0)1972 . I LOINC'="" D ;1973 "RTN","C0SLAB",250,0)1974 . . S ZR("rdf:type")="sp:CodedValue"1975 "RTN","C0SLAB",251,0)1976 . . S ZR("dcterms:title")=LABTST1977 "RTN","C0SLAB",252,0)1978 . . N LOINCNM S LOINCNM="loinc:"_LOINC1979 "RTN","C0SLAB",253,0)1980 . . S ZR("sp:code")="loinc:"_LOINC1981 "RTN","C0SLAB",254,0)1982 . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR)1983 "RTN","C0SLAB",255,0)1984 . . K ZR1985 "RTN","C0SLAB",256,0)1986 . . S ZR("dcterms:identifier")=LOINC1987 "RTN","C0SLAB",257,0)1988 . . S ZR("dcterms:title")=LABTST1989 "RTN","C0SLAB",258,0)1990 . . S ZR("rdf:type")="sp:Code"1991 "RTN","C0SLAB",259,0)1992 . . S ZR("sp:system")="http://loinc.org/codes/"1993 "RTN","C0SLAB",260,0)1994 . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR)1995 2001 "RTN","C0SLAB",261,0) 1996 . . K ZR2002 . ; that's all for now folks (there is more to do like reference ranges 1997 2003 "RTN","C0SLAB",262,0) 2004 . ; and result values) 2005 "RTN","C0SLAB",263,0) 1998 2006 . ; 1999 "RTN","C0SLAB",263,0)2000 . ; that's all for now folks (there is more to do like reference ranges2001 2007 "RTN","C0SLAB",264,0) 2002 . ; and result values)2008 D BULKLOAD^C0XF2N(.C0XFDA) 2003 2009 "RTN","C0SLAB",265,0) 2004 . ;2010 S GRTN=C0SGRF 2005 2011 "RTN","C0SLAB",266,0) 2006 D BULKLOAD^C0XF2N(.C0XFDA)2012 Q 2007 2013 "RTN","C0SLAB",267,0) 2008 S GRTN=C0SGRF2014 ; 2009 2015 "RTN","C0SLAB",268,0) 2010 Q 2016 SAMPLE ; import sample lab tests to the triplestore 2011 2017 "RTN","C0SLAB",269,0) 2012 ;2018 N GN 2013 2019 "RTN","C0SLAB",270,0) 2014 SAMPLE ; import sample lab tests to the triplestore 2020 S GN=$NA(^rdf("lab_results")) 2015 2021 "RTN","C0SLAB",271,0) 2016 N GN2022 D INSRDF^C0XF2N(GN,"/smart/lab/samples") 2017 2023 "RTN","C0SLAB",272,0) 2018 S GN=$NA(^rdf("lab_results"))2024 Q 2019 2025 "RTN","C0SLAB",273,0) 2020 D INSRDF^C0XF2N(GN,"/smart/lab/samples")2021 "RTN","C0SLAB",274,0)2022 Q2023 "RTN","C0SLAB",275,0)2024 2026 ; 2025 2027 "RTN","C0SMART") 2026 0^4^B2 9074012028 0^4^B2814519 2027 2029 "RTN","C0SMART",1,0) 2028 2030 C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 2029 2031 "RTN","C0SMART",2,0) 2030 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 52032 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 2031 2033 "RTN","C0SMART",3,0) 2032 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU2034 ;Copyright 2012 George Lilly. 2033 2035 "RTN","C0SMART",4,0) 2034 ; General Public License See attached copy of the License.2036 ; 2035 2037 "RTN","C0SMART",5,0) 2036 ; 2038 ; This program is free software: you can redistribute it and/or modify 2037 2039 "RTN","C0SMART",6,0) 2038 ; This program is free software; you can redistribute it and/or modify2040 ; it under the terms of the GNU Affero General Public License as 2039 2041 "RTN","C0SMART",7,0) 2040 ; it under the terms of the GNU General Public License as published by2042 ; published by the Free Software Foundation, either version 3 of the 2041 2043 "RTN","C0SMART",8,0) 2042 ; the Free Software Foundation; either version 2 of the License, or2044 ; License, or (at your option) any later version. 2043 2045 "RTN","C0SMART",9,0) 2044 ; (at your option) any later version.2046 ; 2045 2047 "RTN","C0SMART",10,0) 2046 ; 2048 ; This program is distributed in the hope that it will be useful, 2047 2049 "RTN","C0SMART",11,0) 2048 ; This program is distributed in the hope that it will be useful,2050 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 2049 2051 "RTN","C0SMART",12,0) 2050 ; but WITHOUT ANY WARRANTY; without even the implied warranty of2052 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 2051 2053 "RTN","C0SMART",13,0) 2052 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the2054 ; GNU Affero General Public License for more details. 2053 2055 "RTN","C0SMART",14,0) 2054 ; GNU General Public License for more details.2056 ; 2055 2057 "RTN","C0SMART",15,0) 2056 ; 2058 ; You should have received a copy of the GNU Affero General Public License 2057 2059 "RTN","C0SMART",16,0) 2058 ; You should have received a copy of the GNU General Public License along2060 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 2059 2061 "RTN","C0SMART",17,0) 2060 ; with this program; if not, write to the Free Software Foundation, Inc.,2062 ; 2061 2063 "RTN","C0SMART",18,0) 2062 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.2064 Q 2063 2065 "RTN","C0SMART",19,0) 2064 ; 2066 EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP 2065 2067 "RTN","C0SMART",20,0) 2066 Q2068 ; for patient ZPATID; ZFORM defaults to rdf 2067 2069 "RTN","C0SMART",21,0) 2068 EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP 2070 ; ZRTN is passed by reference 2069 2071 "RTN","C0SMART",22,0) 2070 ; for patient ZPATID; ZFORM defaults to rdf2072 ; For now, ZPATID is the DFN 2071 2073 "RTN","C0SMART",23,0) 2072 ; ZRTN is passed by reference2074 ; 2073 2075 "RTN","C0SMART",24,0) 2074 ; For now, ZPATID is the DFN2076 I '$D(ZFORM) S ZFORM="rdf" 2075 2077 "RTN","C0SMART",25,0) 2076 ;2078 K ZRTN ; CLEAN RETURN 2077 2079 "RTN","C0SMART",26,0) 2078 I '$D(ZFORM) S ZFORM="rdf"2080 N C0SARY 2079 2081 "RTN","C0SMART",27,0) 2080 K ZRTN ; CLEAN RETURN2082 I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") 2081 2083 "RTN","C0SMART",28,0) 2082 N C0SARY2084 E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) 2083 2085 "RTN","C0SMART",29,0) 2084 I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient")2086 I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; 2085 2087 "RTN","C0SMART",30,0) 2086 E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP)2088 . W !,"Error Retreiving Patient Record" 2087 2089 "RTN","C0SMART",31,0) 2088 I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q;2090 ; 2089 2091 "RTN","C0SMART",32,0) 2090 . W !,"Error Retreiving Patient Record"2092 K C0XFDA 2091 2093 "RTN","C0SMART",33,0) 2092 2094 ; 2093 2095 "RTN","C0SMART",34,0) 2094 K C0XFDA2096 N C0SGR ; graph 2095 2097 "RTN","C0SMART",35,0) 2096 2098 ; 2097 2099 "RTN","C0SMART",36,0) 2098 N C0SGR ; graph2100 ; processing table 2099 2101 "RTN","C0SMART",37,0) 2100 2102 ; 2101 2103 "RTN","C0SMART",38,0) 2102 ; processing table2104 N C0SCTRL 2103 2105 "RTN","C0SMART",39,0) 2104 ;2106 S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" 2105 2107 "RTN","C0SMART",40,0) 2106 N C0SCTRL2108 S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" 2107 2109 "RTN","C0SMART",41,0) 2108 S C0SCTRL(" med")="D MED^C0SMED(.C0SGR,.C0SARY)"2110 S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" 2109 2111 "RTN","C0SMART",42,0) 2110 S C0SCTRL("p atient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)"2112 S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" 2111 2113 "RTN","C0SMART",43,0) 2112 S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)"2114 ; 2113 2115 "RTN","C0SMART",44,0) 2114 S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)"2116 I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; 2115 2117 "RTN","C0SMART",45,0) 2116 ;2118 N ZX 2117 2119 "RTN","C0SMART",46,0) 2118 I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ;2120 S ZX=C0SCTRL(ZTYP) 2119 2121 "RTN","C0SMART",47,0) 2120 N ZX2122 X ZX ; 2121 2123 "RTN","C0SMART",48,0) 2122 S ZX=C0SCTRL(ZTYP)2124 ; 2123 2125 "RTN","C0SMART",49,0) 2124 X ZX ;2126 I '$D(C0SGR) Q ; 2125 2127 "RTN","C0SMART",50,0) 2126 2128 ; 2127 2129 "RTN","C0SMART",51,0) 2128 I '$D(C0SGR) Q ;2130 D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) 2129 2131 "RTN","C0SMART",52,0) 2130 2132 ; 2131 2133 "RTN","C0SMART",53,0) 2132 D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM)2134 Q 2133 2135 "RTN","C0SMART",54,0) 2134 2136 ; 2135 "RTN","C0SMART",55,0)2136 Q2137 "RTN","C0SMART",56,0)2138 ;2139 2137 "RTN","C0SMED") 2140 0^5^B40 7190832138 0^5^B40022947 2141 2139 "RTN","C0SMED",1,0) 2142 2140 C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 2143 2141 "RTN","C0SMED",2,0) 2144 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 52142 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 2145 2143 "RTN","C0SMED",3,0) 2146 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU2144 ;Copyright 2012 George Lilly. 2147 2145 "RTN","C0SMED",4,0) 2148 ; General Public License See attached copy of the License.2146 ; 2149 2147 "RTN","C0SMED",5,0) 2150 ; 2148 ; This program is free software: you can redistribute it and/or modify 2151 2149 "RTN","C0SMED",6,0) 2152 ; This program is free software; you can redistribute it and/or modify2150 ; it under the terms of the GNU Affero General Public License as 2153 2151 "RTN","C0SMED",7,0) 2154 ; it under the terms of the GNU General Public License as published by2152 ; published by the Free Software Foundation, either version 3 of the 2155 2153 "RTN","C0SMED",8,0) 2156 ; the Free Software Foundation; either version 2 of the License, or2154 ; License, or (at your option) any later version. 2157 2155 "RTN","C0SMED",9,0) 2158 ; (at your option) any later version.2156 ; 2159 2157 "RTN","C0SMED",10,0) 2160 ; 2158 ; This program is distributed in the hope that it will be useful, 2161 2159 "RTN","C0SMED",11,0) 2162 ; This program is distributed in the hope that it will be useful,2160 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 2163 2161 "RTN","C0SMED",12,0) 2164 ; but WITHOUT ANY WARRANTY; without even the implied warranty of2162 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 2165 2163 "RTN","C0SMED",13,0) 2166 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the2164 ; GNU Affero General Public License for more details. 2167 2165 "RTN","C0SMED",14,0) 2168 ; GNU General Public License for more details.2166 ; 2169 2167 "RTN","C0SMED",15,0) 2170 ; 2168 ; You should have received a copy of the GNU Affero General Public License 2171 2169 "RTN","C0SMED",16,0) 2172 ; You should have received a copy of the GNU General Public License along2170 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 2173 2171 "RTN","C0SMED",17,0) 2174 ; with this program; if not, write to the Free Software Foundation, Inc.,2172 ; 2175 2173 "RTN","C0SMED",18,0) 2176 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.2174 Q 2177 2175 "RTN","C0SMED",19,0) 2178 2176 ; 2179 2177 "RTN","C0SMED",20,0) 2180 Q 2178 MED(GRTN,C0SARY) ; GRTN, passed by reference, 2181 2179 "RTN","C0SMED",21,0) 2182 ; 2180 ; is the return name of the graph created. "" if none 2183 2181 "RTN","C0SMED",22,0) 2184 MED(GRTN,C0SARY) ; GRTN, passed by reference, 2182 ; C0SARY is passed in by reference and is the NHIN array of meds 2185 2183 "RTN","C0SMED",23,0) 2186 ; is the return name of the graph created. "" if none2184 ; 2187 2185 "RTN","C0SMED",24,0) 2188 ; C0SARY is passed in by reference and is the NHIN array of meds2186 I $O(C0SARY("med",""))="" D Q ; 2189 2187 "RTN","C0SMED",25,0) 2190 ;2188 . I $D(DEBUG) W !,"No Meds" 2191 2189 "RTN","C0SMED",26,0) 2192 I $O(C0SARY("med",""))="" D Q ;2190 S GRTN="" ; default to no meds 2193 2191 "RTN","C0SMED",27,0) 2194 . I $D(DEBUG) W !,"No Meds"2192 N C0SGRF 2195 2193 "RTN","C0SMED",28,0) 2196 S GRTN="" ; default to no meds2194 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP 2197 2195 "RTN","C0SMED",29,0) 2198 NC0SGRF2196 I $D(DEBUG) W !,"Processing ",C0SGRF 2199 2197 "RTN","C0SMED",30,0) 2200 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP2198 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 2201 2199 "RTN","C0SMED",31,0) 2202 I $D(DEBUG) W !,"Processing ",C0SGRF2200 N MEDTRP ; MEDS TRIPLES 2203 2201 "RTN","C0SMED",32,0) 2204 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph2202 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 2205 2203 "RTN","C0SMED",33,0) 2206 N MEDTRP ; MEDS TRIPLES2204 N FARY S FARY="C0XFARY" 2207 2205 "RTN","C0SMED",34,0) 2208 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use2206 D USEFARY^C0XF2N(FARY) 2209 2207 "RTN","C0SMED",35,0) 2210 N FARY S FARY="C0XFARY"2208 D VOCINIT^C0XUTIL 2211 2209 "RTN","C0SMED",36,0) 2212 D USEFARY^C0XF2N(FARY)2210 ; 2213 2211 "RTN","C0SMED",37,0) 2214 D VOCINIT^C0XUTIL2212 N DUPCHK S DUPCHK="" ; check for no duplicates 2215 2213 "RTN","C0SMED",38,0) 2216 ;2214 N ZI S ZI="" 2217 2215 "RTN","C0SMED",39,0) 2218 N DUPCHK S DUPCHK="" ; check for no duplicates2216 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; 2219 2217 "RTN","C0SMED",40,0) 2220 N ZI S ZI=""2218 . N SDATE,SDTMP 2221 2219 "RTN","C0SMED",41,0) 2222 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D;2220 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; 2223 2221 "RTN","C0SMED",42,0) 2224 . N SDATE,SDTMP2222 . . I $D(DEBUG) W !,"Expired Mediation, Skipping" 2225 2223 "RTN","C0SMED",43,0) 2226 . I $G(C 0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ;2224 . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; 2227 2225 "RTN","C0SMED",44,0) 2228 . . I $D(DEBUG) W !," Expired Mediation, Skipping"2226 . . I $D(DEBUG) W !,"Inpatient Med, skipping" 2229 2227 "RTN","C0SMED",45,0) 2230 . I $G(COSARY("med",ZI,"vaType@value"))=" I" D Q ;2228 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; 2231 2229 "RTN","C0SMED",46,0) 2232 . . I $D(DEBUG) W !,"I npatient Med, skipping"2230 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" 2233 2231 "RTN","C0SMED",47,0) 2234 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q;2232 . ; 2235 2233 "RTN","C0SMED",48,0) 2236 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"2234 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) 2237 2235 "RTN","C0SMED",49,0) 2238 . ;2236 . I SDTMP="" D ; 2239 2237 "RTN","C0SMED",50,0) 2240 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))2238 . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) 2241 2239 "RTN","C0SMED",51,0) 2242 . I SDTMP="" D ;2240 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date 2243 2241 "RTN","C0SMED",52,0) 2244 . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))2242 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens 2245 2243 "RTN","C0SMED",53,0) 2246 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date2244 . I SDATE="" S SDATE="UNKNOWN" 2247 2245 "RTN","C0SMED",54,0) 2248 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens2246 . N DNAME,VUID,DCODE,RXNORM,SIG 2249 2247 "RTN","C0SMED",55,0) 2250 . I SDATE="" S SDATE="UNKNOWN"2248 . S DNAME=$G(C0SARY("med",ZI,"name@value")) 2251 2249 "RTN","C0SMED",56,0) 2252 . N DNAME,VUID,DCODE,RXNORM,SIG2250 . I DNAME="" D ; 2253 2251 "RTN","C0SMED",57,0) 2254 . S DNAME=$G(C0SARY("med",ZI,"name@value"))2252 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) 2255 2253 "RTN","C0SMED",58,0) 2256 . I DNAME="" D ;2254 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) 2257 2255 "RTN","C0SMED",59,0) 2258 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))2256 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) 2259 2257 "RTN","C0SMED",60,0) 2260 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))2258 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) 2261 2259 "RTN","C0SMED",61,0) 2262 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))2260 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code 2263 2261 "RTN","C0SMED",62,0) 2264 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))2262 . I $P(RXNORM,"^",2)="RXNORM" D ; 2265 2263 "RTN","C0SMED",63,0) 2266 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code2264 . . S RXVER=$P(RXNORM,"^",3) 2267 2265 "RTN","C0SMED",64,0) 2268 . I $P(RXNORM,"^",2)="RXNORM" D ;2266 . . S RXNORM=$P(RXNORM,"^",1) 2269 2267 "RTN","C0SMED",65,0) 2270 . . S RXVER=$P(RXNORM,"^",3)2268 . E D Q ; 2271 2269 "RTN","C0SMED",66,0) 2272 . . S RXNORM=$P(RXNORM,"^",1)2270 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" 2273 2271 "RTN","C0SMED",67,0) 2274 . E D Q ;2272 . . I $D(DEBUG) W !,RXNORM 2275 2273 "RTN","C0SMED",68,0) 2276 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"2274 . I DNAME="" D Q ; 2277 2275 "RTN","C0SMED",69,0) 2278 . . I $D(DEBUG) W !, RXNORM2276 . . I $D(DEBUG) W !,"Error No Drug Name" 2279 2277 "RTN","C0SMED",70,0) 2280 . I DNAME="" D Q ;2278 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) 2281 2279 "RTN","C0SMED",71,0) 2282 . . I $D(DEBUG) W !,"Error No Drug Name"2280 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED 2283 2281 "RTN","C0SMED",72,0) 2284 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)2282 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF 2285 2283 "RTN","C0SMED",73,0) 2286 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED2284 . S DUPCHK(MEDGRF)="" 2287 2285 "RTN","C0SMED",74,0) 2288 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF2286 . I $D(DEBUG) D ; 2289 2287 "RTN","C0SMED",75,0) 2290 . S DUPCHK(MEDGRF)=""2288 . . W !,"Processing Medication ",MEDGRF 2291 2289 "RTN","C0SMED",76,0) 2292 . I $D(DEBUG) D ;2290 . . W !,DNAME 2293 2291 "RTN","C0SMED",77,0) 2294 . . W !, "Processing Medication ",MEDGRF2292 . . W !,RXNORM 2295 2293 "RTN","C0SMED",78,0) 2296 . . W !,DNAME2294 . S SIG=$G(C0SARY("med",ZI,"sig")) 2297 2295 "RTN","C0SMED",79,0) 2298 . . W !,RXNORM2296 . I SIG["|" D ; 2299 2297 "RTN","C0SMED",80,0) 2300 . S SIG=$G(C0SARY("med",ZI,"sig"))2298 . . N SIGTMP 2301 2299 "RTN","C0SMED",81,0) 2302 . I SIG["|" D ;2300 . . S SIGTMP=SIG 2303 2301 "RTN","C0SMED",82,0) 2304 . . N SIGTMP2302 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig 2305 2303 "RTN","C0SMED",83,0) 2306 . . S SIGTMP=SIG2304 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig 2307 2305 "RTN","C0SMED",84,0) 2308 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name fromthe sig2306 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig 2309 2307 "RTN","C0SMED",85,0) 2310 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig2308 . K C0XFARY 2311 2309 "RTN","C0SMED",86,0) 2312 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig2310 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) 2313 2311 "RTN","C0SMED",87,0) 2314 . K C0XFARY2312 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) 2315 2313 "RTN","C0SMED",88,0) 2316 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)2314 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject 2317 2315 "RTN","C0SMED",89,0) 2318 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp: belongsTo",C0SGRF,FARY)2316 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) 2319 2317 "RTN","C0SMED",90,0) 2320 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject2318 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) 2321 2319 "RTN","C0SMED",91,0) 2322 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)2320 . N NQTY,NQTY2,NFREQ,NFREQ2 2323 2321 "RTN","C0SMED",92,0) 2324 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)2322 . S NQTY=$$ANONS^C0XF2N ; anonomous subject 2325 2323 "RTN","C0SMED",93,0) 2326 . N NQTY,NQTY2,NFREQ,NFREQ22324 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) 2327 2325 "RTN","C0SMED",94,0) 2328 . S NQTY =$$ANONS^C0XF2N ; anonomous subject2326 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject 2329 2327 "RTN","C0SMED",95,0) 2330 . D ADD^C0XF2N(C0SGRF, MEDGRF,"sp:quantity",NQTY,FARY)2328 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) 2331 2329 "RTN","C0SMED",96,0) 2332 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject2330 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) 2333 2331 "RTN","C0SMED",97,0) 2334 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)2332 . I DOSE="" S DOSE="UNKNOWN" 2335 2333 "RTN","C0SMED",98,0) 2336 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))2334 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) 2337 2335 "RTN","C0SMED",99,0) 2338 . I DOSE="" S DOSE="UNKNOWN"2336 . I UNIT="" S UNIT="UNKNOWN" 2339 2337 "RTN","C0SMED",100,0) 2340 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))2338 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) 2341 2339 "RTN","C0SMED",101,0) 2342 . I UNIT="" S UNIT="UNKNOWN"2340 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) 2343 2341 "RTN","C0SMED",102,0) 2344 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)2342 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject 2345 2343 "RTN","C0SMED",103,0) 2346 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)2344 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject 2347 2345 "RTN","C0SMED",104,0) 2348 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject2346 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) 2349 2347 "RTN","C0SMED",105,0) 2350 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject2348 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) 2351 2349 "RTN","C0SMED",106,0) 2352 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)2350 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) 2353 2351 "RTN","C0SMED",107,0) 2354 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)2352 . I SCHED="" S SCHED="UNKNOWN" 2355 2353 "RTN","C0SMED",108,0) 2356 . N SCH ED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))2354 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) 2357 2355 "RTN","C0SMED",109,0) 2358 . I SCH ED="" S SCHED="UNKNOWN"2356 . I SCHUNIT="" S SCHUNIT="UNKNOWN" 2359 2357 "RTN","C0SMED",110,0) 2360 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))2358 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) 2361 2359 "RTN","C0SMED",111,0) 2362 . I SCHUNIT="" S SCHUNIT="UNKNOWN"2360 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) 2363 2361 "RTN","C0SMED",112,0) 2364 . D ADD^C0XF2N(C0SGRF, NFREQ2,"sp:value",SCHED,FARY)2362 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) 2365 2363 "RTN","C0SMED",113,0) 2366 . D ADD^C0XF2N(C0SGRF, NFREQ2,"sp:unit",SCHUNIT,FARY)2364 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) 2367 2365 "RTN","C0SMED",114,0) 2368 . D ADD^C0XF2N(C0SGRF, DSUBJ,"rdf:type","sp:CodedValue",FARY)2366 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) 2369 2367 "RTN","C0SMED",115,0) 2370 . D ADD^C0XF2N(C0SGRF, DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)2368 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) 2371 2369 "RTN","C0SMED",116,0) 2372 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM," rdf:type","sp:Code",FARY)2370 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) 2373 2371 "RTN","C0SMED",117,0) 2374 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms: title",DNAME,FARY)2372 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) 2375 2373 "RTN","C0SMED",118,0) 2376 . D ADD^C0XF2N(C0SGRF, "rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)2374 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) 2377 2375 "RTN","C0SMED",119,0) 2378 . D ADD^C0XF2N(C0SGRF, "rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)2376 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) 2379 2377 "RTN","C0SMED",120,0) 2380 . D ADD^C0XF2N(C0SGRF, DSUBJ,"dcterms:title",DNAME,FARY)2378 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) 2381 2379 "RTN","C0SMED",121,0) 2382 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)2380 . D BULKLOAD^C0XF2N(.C0XFDA) 2383 2381 "RTN","C0SMED",122,0) 2384 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)2382 . K C0XFDA 2385 2383 "RTN","C0SMED",123,0) 2386 . D BULKLOAD^C0XF2N(.C0XFDA)2384 S GRTN=C0SGRF 2387 2385 "RTN","C0SMED",124,0) 2388 . K C0XFDA2386 q 2389 2387 "RTN","C0SMED",125,0) 2390 S GRTN=C0SGRF2388 ; 2391 2389 "RTN","C0SMED",126,0) 2392 q 2390 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number 2393 2391 "RTN","C0SMED",127,0) 2394 2392 ; 2395 2393 "RTN","C0SMED",128,0) 2396 RX NFN() Q 1130590011.001 ; RxNorm Concepts file number2394 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 2397 2395 "RTN","C0SMED",129,0) 2398 ; 2396 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR 2399 2397 "RTN","C0SMED",130,0) 2400 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF 2398 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT 2401 2399 "RTN","C0SMED",131,0) 2402 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR2400 I $G(ZVUID)="" Q "" 2403 2401 "RTN","C0SMED",132,0) 2404 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT2402 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED 2405 2403 "RTN","C0SMED",133,0) 2406 I $G(ZVUID)="" Q ""2404 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") 2407 2405 "RTN","C0SMED",134,0) 2408 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED2406 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES 2409 2407 "RTN","C0SMED",135,0) 2410 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")2408 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) 2411 2409 "RTN","C0SMED",136,0) 2412 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES2410 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED 2413 2411 "RTN","C0SMED",137,0) 2414 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)2412 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" 2415 2413 "RTN","C0SMED",138,0) 2416 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED2414 Q ZRSLT 2417 2415 "RTN","C0SMED",139,0) 2418 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"2416 ; 2419 2417 "RTN","C0SMED",140,0) 2420 Q ZRSLT 2418 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 2421 2419 "RTN","C0SMED",141,0) 2422 ; 2420 ; CONFORM TO NIST REQUIREMENTS 2423 2421 "RTN","C0SMED",142,0) 2424 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 2422 ;INPATIENT CERTIFICATION 2425 2423 "RTN","C0SMED",143,0) 2426 ; CONFORM TO NIST REQUIREMENTS2424 I ZRXN=309362 S ZRXN=213169 2427 2425 "RTN","C0SMED",144,0) 2428 ;INPATIENT CERTIFICATION2426 I ZRXN=855318 S ZRXN=855320 2429 2427 "RTN","C0SMED",145,0) 2430 I ZRXN= 309362 S ZRXN=2131692428 I ZRXN=197361 S ZRXN=212549 2431 2429 "RTN","C0SMED",146,0) 2432 I ZRXN=855318 S ZRXN=8553202430 ;OUTPATIENT CERTIFICATION 2433 2431 "RTN","C0SMED",147,0) 2434 I ZRXN= 197361 S ZRXN=2125492432 I ZRXN=310534 S ZRXN=205875 2435 2433 "RTN","C0SMED",148,0) 2436 ;OUTPATIENT CERTIFICATION2434 I ZRXN=617312 S ZRXN=617314 2437 2435 "RTN","C0SMED",149,0) 2438 I ZRXN=310 534 S ZRXN=2058752436 I ZRXN=310429 S ZRXN=200801 2439 2437 "RTN","C0SMED",150,0) 2440 I ZRXN=6 17312 S ZRXN=6173142438 I ZRXN=628953 S ZRXN=628958 2441 2439 "RTN","C0SMED",151,0) 2442 I ZRXN= 310429 S ZRXN=2008012440 I ZRXN=745679 S ZRXN=630208 2443 2441 "RTN","C0SMED",152,0) 2444 I ZRXN= 628953 S ZRXN=6289582442 I ZRXN=311564 S ZRXN=979334 2445 2443 "RTN","C0SMED",153,0) 2446 I ZRXN= 745679 S ZRXN=6302082444 I ZRXN=836343 S ZRXN=836370 2447 2445 "RTN","C0SMED",154,0) 2448 I ZRXN=311564 S ZRXN=9793342446 Q ZRXN 2449 2447 "RTN","C0SMED",155,0) 2450 I ZRXN=836343 S ZRXN=8363702451 "RTN","C0SMED",156,0)2452 Q ZRXN2453 "RTN","C0SMED",157,0)2454 2448 ; 2455 2449 "RTN","C0SMXMLB") 2456 0^6^B12 1896442450 0^6^B12331075 2457 2451 "RTN","C0SMXMLB",1,0) 2458 2452 MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. 2459 2453 "RTN","C0SMXMLB",2,0) 2460 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 52454 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 2461 2455 "RTN","C0SMXMLB",3,0) 2456 ; Public Domain 2457 "RTN","C0SMXMLB",4,0) 2462 2458 QUIT 2463 "RTN","C0SMXMLB",4,0)2464 ;2465 2459 "RTN","C0SMXMLB",5,0) 2460 ; 2461 "RTN","C0SMXMLB",6,0) 2466 2462 ;DOC - The top level tag 2467 "RTN","C0SMXMLB", 6,0)2463 "RTN","C0SMXMLB",7,0) 2468 2464 ;DOCTYPE - Want to include a DOCTYPE node 2469 "RTN","C0SMXMLB", 7,0)2465 "RTN","C0SMXMLB",8,0) 2470 2466 ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, 2471 "RTN","C0SMXMLB", 8,0)2467 "RTN","C0SMXMLB",9,0) 2472 2468 START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. 2473 "RTN","C0SMXMLB", 9,0)2469 "RTN","C0SMXMLB",10,0) 2474 2470 K ^TMP("MXMLBLD",$J) 2475 "RTN","C0SMXMLB",1 0,0)2471 "RTN","C0SMXMLB",11,0) 2476 2472 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 2477 "RTN","C0SMXMLB",1 1,0)2473 "RTN","C0SMXMLB",12,0) 2478 2474 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 2479 "RTN","C0SMXMLB",1 2,0)2475 "RTN","C0SMXMLB",13,0) 2480 2476 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 2481 "RTN","C0SMXMLB",1 3,0)2477 "RTN","C0SMXMLB",14,0) 2482 2478 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">") 2483 "RTN","C0SMXMLB",14,0)2484 Q2485 2479 "RTN","C0SMXMLB",15,0) 2486 ;2480 Q 2487 2481 "RTN","C0SMXMLB",16,0) 2482 ; 2483 "RTN","C0SMXMLB",17,0) 2488 2484 END ;Call this once to close out the document 2489 "RTN","C0SMXMLB",1 7,0)2485 "RTN","C0SMXMLB",18,0) 2490 2486 D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">") 2491 "RTN","C0SMXMLB",1 8,0)2487 "RTN","C0SMXMLB",19,0) 2492 2488 I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) 2493 "RTN","C0SMXMLB", 19,0)2489 "RTN","C0SMXMLB",20,0) 2494 2490 K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") 2495 "RTN","C0SMXMLB",20,0)2496 Q2497 2491 "RTN","C0SMXMLB",21,0) 2498 ;2492 Q 2499 2493 "RTN","C0SMXMLB",22,0) 2494 ; 2495 "RTN","C0SMXMLB",23,0) 2500 2496 ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item 2501 "RTN","C0SMXMLB",2 3,0)2497 "RTN","C0SMXMLB",24,0) 2502 2498 N I,X 2503 "RTN","C0SMXMLB",2 4,0)2499 "RTN","C0SMXMLB",25,0) 2504 2500 S ATT=$G(ATT) 2505 "RTN","C0SMXMLB",2 5,0)2501 "RTN","C0SMXMLB",26,0) 2506 2502 I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q 2507 "RTN","C0SMXMLB",2 6,0)2503 "RTN","C0SMXMLB",27,0) 2508 2504 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">") 2509 "RTN","C0SMXMLB",27,0)2510 Q2511 2505 "RTN","C0SMXMLB",28,0) 2506 Q 2507 "RTN","C0SMXMLB",29,0) 2512 2508 ;DOITEM is a callback to output the lower level. 2513 "RTN","C0SMXMLB", 29,0)2509 "RTN","C0SMXMLB",30,0) 2514 2510 MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule 2515 "RTN","C0SMXMLB",3 0,0)2511 "RTN","C0SMXMLB",31,0) 2516 2512 N I,X,S 2517 "RTN","C0SMXMLB",3 1,0)2513 "RTN","C0SMXMLB",32,0) 2518 2514 S ATT=$G(ATT) 2519 "RTN","C0SMXMLB",3 2,0)2515 "RTN","C0SMXMLB",33,0) 2520 2516 D PUSH($G(INDENT),TAG,.ATT) 2521 "RTN","C0SMXMLB",3 3,0)2517 "RTN","C0SMXMLB",34,0) 2522 2518 D @DOITEM 2523 "RTN","C0SMXMLB",3 4,0)2519 "RTN","C0SMXMLB",35,0) 2524 2520 D POP 2525 "RTN","C0SMXMLB",35,0)2526 Q2527 2521 "RTN","C0SMXMLB",36,0) 2528 ;2522 Q 2529 2523 "RTN","C0SMXMLB",37,0) 2524 ; 2525 "RTN","C0SMXMLB",38,0) 2530 2526 ATT(ATT) ;Output a string of attributes 2531 "RTN","C0SMXMLB",3 8,0)2527 "RTN","C0SMXMLB",39,0) 2532 2528 I $D(ATT)<9 Q "" 2533 "RTN","C0SMXMLB", 39,0)2529 "RTN","C0SMXMLB",40,0) 2534 2530 N I,S,V 2535 "RTN","C0SMXMLB",4 0,0)2531 "RTN","C0SMXMLB",41,0) 2536 2532 S S="",I="" 2537 "RTN","C0SMXMLB",4 1,0)2533 "RTN","C0SMXMLB",42,0) 2538 2534 F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) 2539 "RTN","C0SMXMLB",4 2,0)2535 "RTN","C0SMXMLB",43,0) 2540 2536 Q S 2541 "RTN","C0SMXMLB",43,0)2542 ;2543 2537 "RTN","C0SMXMLB",44,0) 2538 ; 2539 "RTN","C0SMXMLB",45,0) 2544 2540 Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 2545 "RTN","C0SMXMLB",4 5,0)2541 "RTN","C0SMXMLB",46,0) 2546 2542 ;I X'[$C(34) Q $C(34)_X_$C(34) 2547 "RTN","C0SMXMLB",4 6,0)2543 "RTN","C0SMXMLB",47,0) 2548 2544 I X'[$C(39) Q $C(39)_X_$C(39) 2549 "RTN","C0SMXMLB",4 7,0)2545 "RTN","C0SMXMLB",48,0) 2550 2546 ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" 2551 "RTN","C0SMXMLB",4 8,0)2547 "RTN","C0SMXMLB",49,0) 2552 2548 N Q,Y,I,Z S Q=$C(39),(Y,Z)="" 2553 "RTN","C0SMXMLB", 49,0)2549 "RTN","C0SMXMLB",50,0) 2554 2550 F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q 2555 "RTN","C0SMXMLB",5 0,0)2551 "RTN","C0SMXMLB",51,0) 2556 2552 S Y=Y_$P(X,Q,$L(X,Q)) 2557 "RTN","C0SMXMLB",5 1,0)2553 "RTN","C0SMXMLB",52,0) 2558 2554 ;Q $C(34)_Y_$C(34) 2559 "RTN","C0SMXMLB",5 2,0)2555 "RTN","C0SMXMLB",53,0) 2560 2556 Q $C(39)_Y_$C(39) 2561 "RTN","C0SMXMLB",53,0)2562 ;2563 2557 "RTN","C0SMXMLB",54,0) 2558 ; 2559 "RTN","C0SMXMLB",55,0) 2564 2560 XMLHDR() ; -- provides current XML standard header 2565 "RTN","C0SMXMLB",5 5,0)2561 "RTN","C0SMXMLB",56,0) 2566 2562 Q "<?xml version=""1.0"" encoding=""utf-8"" ?>" 2567 "RTN","C0SMXMLB",56,0)2568 ;2569 2563 "RTN","C0SMXMLB",57,0) 2564 ; 2565 "RTN","C0SMXMLB",58,0) 2570 2566 OUTPUT(S) ;Output 2571 "RTN","C0SMXMLB",5 8,0)2567 "RTN","C0SMXMLB",59,0) 2572 2568 N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) 2573 "RTN","C0SMXMLB", 59,0)2569 "RTN","C0SMXMLB",60,0) 2574 2570 I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q 2575 "RTN","C0SMXMLB",6 0,0)2571 "RTN","C0SMXMLB",61,0) 2576 2572 W S,! 2577 "RTN","C0SMXMLB",61,0)2578 Q2579 2573 "RTN","C0SMXMLB",62,0) 2580 ;2574 Q 2581 2575 "RTN","C0SMXMLB",63,0) 2576 ; 2577 "RTN","C0SMXMLB",64,0) 2582 2578 CHARCHK(STR) ; -- replace xml character limits with entities 2583 "RTN","C0SMXMLB",6 4,0)2579 "RTN","C0SMXMLB",65,0) 2584 2580 N A,I,X,Y,Z,NEWSTR 2585 "RTN","C0SMXMLB",6 5,0)2581 "RTN","C0SMXMLB",66,0) 2586 2582 S (Y,Z)="" 2587 "RTN","C0SMXMLB",6 6,0)2583 "RTN","C0SMXMLB",67,0) 2588 2584 ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z 2589 "RTN","C0SMXMLB",6 7,0)2585 "RTN","C0SMXMLB",68,0) 2590 2586 ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" 2591 "RTN","C0SMXMLB",6 8,0)2587 "RTN","C0SMXMLB",69,0) 2592 2588 I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) 2593 "RTN","C0SMXMLB", 69,0)2589 "RTN","C0SMXMLB",70,0) 2594 2590 I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" 2595 "RTN","C0SMXMLB",7 0,0)2591 "RTN","C0SMXMLB",71,0) 2596 2592 I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" 2597 "RTN","C0SMXMLB",7 1,0)2593 "RTN","C0SMXMLB",72,0) 2598 2594 I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" 2599 "RTN","C0SMXMLB",7 2,0)2595 "RTN","C0SMXMLB",73,0) 2600 2596 I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" 2601 "RTN","C0SMXMLB",73,0)2602 ;2603 2597 "RTN","C0SMXMLB",74,0) 2598 ; 2599 "RTN","C0SMXMLB",75,0) 2604 2600 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)) 2605 "RTN","C0SMXMLB",7 5,0)2601 "RTN","C0SMXMLB",76,0) 2606 2602 QUIT STR 2607 "RTN","C0SMXMLB",76,0)2608 ;2609 2603 "RTN","C0SMXMLB",77,0) 2604 ; 2605 "RTN","C0SMXMLB",78,0) 2610 2606 COMMENT(VAL) ;Add Comments 2611 "RTN","C0SMXMLB",7 8,0)2607 "RTN","C0SMXMLB",79,0) 2612 2608 N I,L 2613 "RTN","C0SMXMLB", 79,0)2609 "RTN","C0SMXMLB",80,0) 2614 2610 ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q 2615 "RTN","C0SMXMLB",8 0,0)2611 "RTN","C0SMXMLB",81,0) 2616 2612 I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q ;CHANGED BY GPL FOR GTM 2617 "RTN","C0SMXMLB",8 1,0)2613 "RTN","C0SMXMLB",82,0) 2618 2614 S I="",L="<!--" 2619 "RTN","C0SMXMLB",8 2,0)2615 "RTN","C0SMXMLB",83,0) 2620 2616 F S I=$O(ATT(I)) Q:I="" D OUTPUT(L_ATT(I)) S L="" 2621 "RTN","C0SMXMLB",8 3,0)2617 "RTN","C0SMXMLB",84,0) 2622 2618 D OUTPUT("-->") 2623 "RTN","C0SMXMLB",84,0)2624 Q2625 2619 "RTN","C0SMXMLB",85,0) 2626 ;2620 Q 2627 2621 "RTN","C0SMXMLB",86,0) 2622 ; 2623 "RTN","C0SMXMLB",87,0) 2628 2624 PUSH(INDENT,TAG,ATT) ;Write a TAG and save. 2629 "RTN","C0SMXMLB",8 7,0)2625 "RTN","C0SMXMLB",88,0) 2630 2626 N CNT 2631 "RTN","C0SMXMLB",8 8,0)2627 "RTN","C0SMXMLB",89,0) 2632 2628 S ATT=$G(ATT) 2633 "RTN","C0SMXMLB", 89,0)2629 "RTN","C0SMXMLB",90,0) 2634 2630 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") 2635 "RTN","C0SMXMLB",9 0,0)2631 "RTN","C0SMXMLB",91,0) 2636 2632 S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG 2637 "RTN","C0SMXMLB",91,0)2638 Q2639 2633 "RTN","C0SMXMLB",92,0) 2640 ;2634 Q 2641 2635 "RTN","C0SMXMLB",93,0) 2636 ; 2637 "RTN","C0SMXMLB",94,0) 2642 2638 POP ;Write last pushed tag and pop 2643 "RTN","C0SMXMLB",9 4,0)2639 "RTN","C0SMXMLB",95,0) 2644 2640 N CNT,TAG,INDENT,X 2645 "RTN","C0SMXMLB",9 5,0)2641 "RTN","C0SMXMLB",96,0) 2646 2642 S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 2647 "RTN","C0SMXMLB",9 6,0)2643 "RTN","C0SMXMLB",97,0) 2648 2644 S INDENT=+X,TAG=$P(X,"^",2) 2649 "RTN","C0SMXMLB",9 7,0)2645 "RTN","C0SMXMLB",98,0) 2650 2646 D OUTPUT($$BLS(INDENT)_"</"_TAG_">") 2651 "RTN","C0SMXMLB",98,0)2652 Q2653 2647 "RTN","C0SMXMLB",99,0) 2654 ;2648 Q 2655 2649 "RTN","C0SMXMLB",100,0) 2650 ; 2651 "RTN","C0SMXMLB",101,0) 2656 2652 BLS(I) ;Return INDENT string 2657 "RTN","C0SMXMLB",10 1,0)2653 "RTN","C0SMXMLB",102,0) 2658 2654 N S 2659 "RTN","C0SMXMLB",10 2,0)2655 "RTN","C0SMXMLB",103,0) 2660 2656 S S="",I=$G(I) S:I>0 $P(S," ",I)=" " 2661 "RTN","C0SMXMLB",10 3,0)2657 "RTN","C0SMXMLB",104,0) 2662 2658 Q S 2663 "RTN","C0SMXMLB",104,0)2664 ;2665 2659 "RTN","C0SMXMLB",105,0) 2660 ; 2661 "RTN","C0SMXMLB",106,0) 2666 2662 INDENT() ;Renturn indent level 2667 "RTN","C0SMXMLB",10 6,0)2663 "RTN","C0SMXMLB",107,0) 2668 2664 Q +$G(^TMP("MXMLBLD",$J,"STK")) 2669 2665 "RTN","C0SNHIN") 2670 0^7^B8 86006442666 0^7^B87708170 2671 2667 "RTN","C0SNHIN",1,0) 2672 2668 C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 2673 2669 "RTN","C0SNHIN",2,0) 2674 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 52670 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 2675 2671 "RTN","C0SNHIN",3,0) 2676 ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU2672 ;Copyright 2011-2012 George Lilly. 2677 2673 "RTN","C0SNHIN",4,0) 2678 ; General Public License See attached copy of the License.2674 ; 2679 2675 "RTN","C0SNHIN",5,0) 2680 ; 2676 ; This program is free software: you can redistribute it and/or modify 2681 2677 "RTN","C0SNHIN",6,0) 2682 ; This program is free software; you can redistribute it and/or modify2678 ; it under the terms of the GNU Affero General Public License as 2683 2679 "RTN","C0SNHIN",7,0) 2684 ; it under the terms of the GNU General Public License as published by2680 ; published by the Free Software Foundation, either version 3 of the 2685 2681 "RTN","C0SNHIN",8,0) 2686 ; the Free Software Foundation; either version 2 of the License, or2682 ; License, or (at your option) any later version. 2687 2683 "RTN","C0SNHIN",9,0) 2688 ; (at your option) any later version.2684 ; 2689 2685 "RTN","C0SNHIN",10,0) 2690 ; 2686 ; This program is distributed in the hope that it will be useful, 2691 2687 "RTN","C0SNHIN",11,0) 2692 ; This program is distributed in the hope that it will be useful,2688 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 2693 2689 "RTN","C0SNHIN",12,0) 2694 ; but WITHOUT ANY WARRANTY; without even the implied warranty of2690 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 2695 2691 "RTN","C0SNHIN",13,0) 2696 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the2692 ; GNU Affero General Public License for more details. 2697 2693 "RTN","C0SNHIN",14,0) 2698 ; GNU General Public License for more details.2694 ; 2699 2695 "RTN","C0SNHIN",15,0) 2700 ; 2696 ; You should have received a copy of the GNU Affero General Public License 2701 2697 "RTN","C0SNHIN",16,0) 2702 ; You should have received a copy of the GNU General Public License along2698 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 2703 2699 "RTN","C0SNHIN",17,0) 2704 ; with this program; if not, write to the Free Software Foundation, Inc.,2700 ; 2705 2701 "RTN","C0SNHIN",18,0) 2706 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.2702 Q 2707 2703 "RTN","C0SNHIN",19,0) 2708 ; 2704 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT 2709 2705 "RTN","C0SNHIN",20,0) 2710 Q2706 ; 2711 2707 "RTN","C0SNHIN",21,0) 2712 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT 2708 K GARY,GNARY,GIDX,C0SDOCID 2713 2709 "RTN","C0SNHIN",22,0) 2714 ;2710 K ZRTN 2715 2711 "RTN","C0SNHIN",23,0) 2716 K GARY,GNARY,GIDX,C0SDOCID2712 N GN 2717 2713 "RTN","C0SNHIN",24,0) 2718 K ZRTN2714 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL 2719 2715 "RTN","C0SNHIN",25,0) 2716 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM 2717 "RTN","C0SNHIN",26,0) 2718 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS 2719 "RTN","C0SNHIN",27,0) 2720 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML 2721 "RTN","C0SNHIN",28,0) 2722 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL 2723 "RTN","C0SNHIN",29,0) 2724 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 2725 "RTN","C0SNHIN",30,0) 2726 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS 2727 "RTN","C0SNHIN",31,0) 2728 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 2729 "RTN","C0SNHIN",32,0) 2730 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) 2731 "RTN","C0SNHIN",33,0) 2732 Q 2733 "RTN","C0SNHIN",34,0) 2734 ; 2735 "RTN","C0SNHIN",35,0) 2736 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE 2737 "RTN","C0SNHIN",36,0) 2738 ; 2739 "RTN","C0SNHIN",37,0) 2740 N ZG 2741 "RTN","C0SNHIN",38,0) 2742 S ZG=$NA(^TMP("PQRIXML",$J)) 2743 "RTN","C0SNHIN",39,0) 2744 K @ZG 2745 "RTN","C0SNHIN",40,0) 2746 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML 2747 "RTN","C0SNHIN",41,0) 2748 N C0SDOCID 2749 "RTN","C0SNHIN",42,0) 2750 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML 2751 "RTN","C0SNHIN",43,0) 2752 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS 2753 "RTN","C0SNHIN",44,0) 2754 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 2755 "RTN","C0SNHIN",45,0) 2756 Q 2757 "RTN","C0SNHIN",46,0) 2758 ; 2759 "RTN","C0SNHIN",47,0) 2760 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE 2761 "RTN","C0SNHIN",48,0) 2762 ; 2763 "RTN","C0SNHIN",49,0) 2764 ;N GG 2765 "RTN","C0SNHIN",50,0) 2766 D GETXML^C0SMXP("GG","PQRI ONE MEASURE") 2767 "RTN","C0SNHIN",51,0) 2768 D PROCESS(ZRTN,"GG","root",1) 2769 "RTN","C0SNHIN",52,0) 2770 Q 2771 "RTN","C0SNHIN",53,0) 2772 ; 2773 "RTN","C0SNHIN",54,0) 2774 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML 2775 "RTN","C0SNHIN",55,0) 2776 ; ZRTN IS PASSED BY REFERENCE 2777 "RTN","C0SNHIN",56,0) 2778 ; ZXML IS PASSED BY NAME 2779 "RTN","C0SNHIN",57,0) 2780 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED 2781 "RTN","C0SNHIN",58,0) 2782 ; 2783 "RTN","C0SNHIN",59,0) 2720 2784 N GN 2721 "RTN","C0SNHIN",26,0) 2722 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL 2723 "RTN","C0SNHIN",27,0) 2724 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM 2725 "RTN","C0SNHIN",28,0) 2726 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS 2727 "RTN","C0SNHIN",29,0) 2728 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML 2729 "RTN","C0SNHIN",30,0) 2730 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL 2731 "RTN","C0SNHIN",31,0) 2785 "RTN","C0SNHIN",60,0) 2786 S GN=$NA(^TMP("C0SPROCESS",$J)) 2787 "RTN","C0SNHIN",61,0) 2788 K @GN 2789 "RTN","C0SNHIN",62,0) 2790 M @GN=@ZXML 2791 "RTN","C0SNHIN",63,0) 2732 2792 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML 2733 "RTN","C0SNHIN",32,0) 2734 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS 2735 "RTN","C0SNHIN",33,0) 2793 "RTN","C0SNHIN",64,0) 2794 K @GN 2795 "RTN","C0SNHIN",65,0) 2796 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS 2797 "RTN","C0SNHIN",66,0) 2736 2798 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 2737 "RTN","C0SNHIN",34,0)2738 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))2739 "RTN","C0SNHIN",35,0)2740 Q2741 "RTN","C0SNHIN",36,0)2742 ;2743 "RTN","C0SNHIN",37,0)2744 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE2745 "RTN","C0SNHIN",38,0)2746 ;2747 "RTN","C0SNHIN",39,0)2748 N ZG2749 "RTN","C0SNHIN",40,0)2750 S ZG=$NA(^TMP("PQRIXML",$J))2751 "RTN","C0SNHIN",41,0)2752 K @ZG2753 "RTN","C0SNHIN",42,0)2754 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML2755 "RTN","C0SNHIN",43,0)2756 N C0SDOCID2757 "RTN","C0SNHIN",44,0)2758 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML2759 "RTN","C0SNHIN",45,0)2760 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS2761 "RTN","C0SNHIN",46,0)2762 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=12763 "RTN","C0SNHIN",47,0)2764 Q2765 "RTN","C0SNHIN",48,0)2766 ;2767 "RTN","C0SNHIN",49,0)2768 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE2769 "RTN","C0SNHIN",50,0)2770 ;2771 "RTN","C0SNHIN",51,0)2772 ;N GG2773 "RTN","C0SNHIN",52,0)2774 D GETXML^C0SMXP("GG","PQRI ONE MEASURE")2775 "RTN","C0SNHIN",53,0)2776 D PROCESS(ZRTN,"GG","root",1)2777 "RTN","C0SNHIN",54,0)2778 Q2779 "RTN","C0SNHIN",55,0)2780 ;2781 "RTN","C0SNHIN",56,0)2782 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML2783 "RTN","C0SNHIN",57,0)2784 ; ZRTN IS PASSED BY REFERENCE2785 "RTN","C0SNHIN",58,0)2786 ; ZXML IS PASSED BY NAME2787 "RTN","C0SNHIN",59,0)2788 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED2789 "RTN","C0SNHIN",60,0)2790 ;2791 "RTN","C0SNHIN",61,0)2792 N GN2793 "RTN","C0SNHIN",62,0)2794 S GN=$NA(^TMP("C0SPROCESS",$J))2795 "RTN","C0SNHIN",63,0)2796 K @GN2797 "RTN","C0SNHIN",64,0)2798 M @GN=@ZXML2799 "RTN","C0SNHIN",65,0)2800 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML2801 "RTN","C0SNHIN",66,0)2802 K @GN2803 2799 "RTN","C0SNHIN",67,0) 2804 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS2800 Q 2805 2801 "RTN","C0SNHIN",68,0) 2806 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=12802 ; 2807 2803 "RTN","C0SNHIN",69,0) 2808 Q 2804 LOADSMRT ; 2809 2805 "RTN","C0SNHIN",70,0) 2810 2806 ; 2811 2807 "RTN","C0SNHIN",71,0) 2812 LOADSMRT ; 2808 K ^GPL("SMART") 2813 2809 "RTN","C0SNHIN",72,0) 2814 ;2810 S GN=$NA(^GPL("SMART",1)) 2815 2811 "RTN","C0SNHIN",73,0) 2816 K ^GPL("SMART")2812 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" 2817 2813 "RTN","C0SNHIN",74,0) 2818 S GN=$NA(^GPL("SMART",1))2814 Q 2819 2815 "RTN","C0SNHIN",75,0) 2820 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"2816 ; 2821 2817 "RTN","C0SNHIN",76,0) 2822 Q 2818 SMART ; TRY IT WITH SMART 2823 2819 "RTN","C0SNHIN",77,0) 2824 2820 ; 2825 2821 "RTN","C0SNHIN",78,0) 2826 SMART ; TRY IT WITH SMART 2822 S GN=$NA(^GPL("SMART")) 2827 2823 "RTN","C0SNHIN",79,0) 2828 ; 2824 ;K ^TMP("MXMLDOM",$J) 2829 2825 "RTN","C0SNHIN",80,0) 2830 S GN=$NA(^GPL("SMART"))2826 K ^TMP("MXMLERR",$J) 2831 2827 "RTN","C0SNHIN",81,0) 2828 S C0SDOCID=$$PARSE(GN,"SMART") 2829 "RTN","C0SNHIN",82,0) 2830 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") 2831 "RTN","C0SNHIN",83,0) 2832 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 2833 "RTN","C0SNHIN",84,0) 2834 Q 2835 "RTN","C0SNHIN",85,0) 2836 ; 2837 "RTN","C0SNHIN",86,0) 2838 CCR ; TRY IT WITH A CCR 2839 "RTN","C0SNHIN",87,0) 2840 ; 2841 "RTN","C0SNHIN",88,0) 2842 S GN=$NA(^GPL("CCR")) 2843 "RTN","C0SNHIN",89,0) 2832 2844 ;K ^TMP("MXMLDOM",$J) 2833 "RTN","C0SNHIN", 82,0)2845 "RTN","C0SNHIN",90,0) 2834 2846 K ^TMP("MXMLERR",$J) 2835 "RTN","C0SNHIN", 83,0)2836 S C0SDOCID=$$PARSE(GN," SMART")2837 "RTN","C0SNHIN", 84,0)2838 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"// rdf:RDF/")2839 "RTN","C0SNHIN", 85,0)2847 "RTN","C0SNHIN",91,0) 2848 S C0SDOCID=$$PARSE(GN,"CCR") 2849 "RTN","C0SNHIN",92,0) 2850 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") 2851 "RTN","C0SNHIN",93,0) 2840 2852 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 2841 "RTN","C0SNHIN",86,0) 2842 Q 2843 "RTN","C0SNHIN",87,0) 2844 ; 2845 "RTN","C0SNHIN",88,0) 2846 CCR ; TRY IT WITH A CCR 2847 "RTN","C0SNHIN",89,0) 2848 ; 2849 "RTN","C0SNHIN",90,0) 2850 S GN=$NA(^GPL("CCR")) 2851 "RTN","C0SNHIN",91,0) 2853 "RTN","C0SNHIN",94,0) 2854 Q 2855 "RTN","C0SNHIN",95,0) 2856 ; 2857 "RTN","C0SNHIN",96,0) 2858 MED ; TRY IT WITH A CCR MED SECTION 2859 "RTN","C0SNHIN",97,0) 2860 ; 2861 "RTN","C0SNHIN",98,0) 2862 S GN=$NA(^GPL("MED")) 2863 "RTN","C0SNHIN",99,0) 2864 K ^TMP("MXMLDOM",$J) 2865 "RTN","C0SNHIN",100,0) 2866 K ^TMP("MXMLERR",$J) 2867 "RTN","C0SNHIN",101,0) 2868 S C0SDOCID=$$PARSE(GN,"MED") 2869 "RTN","C0SNHIN",102,0) 2870 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") 2871 "RTN","C0SNHIN",103,0) 2872 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 2873 "RTN","C0SNHIN",104,0) 2874 Q 2875 "RTN","C0SNHIN",105,0) 2876 ; 2877 "RTN","C0SNHIN",106,0) 2878 CCD ; TRY IT WITH A CCD 2879 "RTN","C0SNHIN",107,0) 2880 ; 2881 "RTN","C0SNHIN",108,0) 2882 S GN=$NA(^GPL("CCD")) 2883 "RTN","C0SNHIN",109,0) 2852 2884 ;K ^TMP("MXMLDOM",$J) 2853 "RTN","C0SNHIN", 92,0)2885 "RTN","C0SNHIN",110,0) 2854 2886 K ^TMP("MXMLERR",$J) 2855 "RTN","C0SNHIN", 93,0)2856 S C0SDOCID=$$PARSE(GN,"CC R")2857 "RTN","C0SNHIN", 94,0)2858 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//C ontinuityOfCareRecord/Body/")2859 "RTN","C0SNHIN", 95,0)2887 "RTN","C0SNHIN",111,0) 2888 S C0SDOCID=$$PARSE(GN,"CCD") 2889 "RTN","C0SNHIN",112,0) 2890 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") 2891 "RTN","C0SNHIN",113,0) 2860 2892 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG 2861 "RTN","C0SNHIN",96,0)2862 Q2863 "RTN","C0SNHIN",97,0)2864 ;2865 "RTN","C0SNHIN",98,0)2866 MED ; TRY IT WITH A CCR MED SECTION2867 "RTN","C0SNHIN",99,0)2868 ;2869 "RTN","C0SNHIN",100,0)2870 S GN=$NA(^GPL("MED"))2871 "RTN","C0SNHIN",101,0)2872 K ^TMP("MXMLDOM",$J)2873 "RTN","C0SNHIN",102,0)2874 K ^TMP("MXMLERR",$J)2875 "RTN","C0SNHIN",103,0)2876 S C0SDOCID=$$PARSE(GN,"MED")2877 "RTN","C0SNHIN",104,0)2878 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")2879 "RTN","C0SNHIN",105,0)2880 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG2881 "RTN","C0SNHIN",106,0)2882 Q2883 "RTN","C0SNHIN",107,0)2884 ;2885 "RTN","C0SNHIN",108,0)2886 CCD ; TRY IT WITH A CCD2887 "RTN","C0SNHIN",109,0)2888 ;2889 "RTN","C0SNHIN",110,0)2890 S GN=$NA(^GPL("CCD"))2891 "RTN","C0SNHIN",111,0)2892 ;K ^TMP("MXMLDOM",$J)2893 "RTN","C0SNHIN",112,0)2894 K ^TMP("MXMLERR",$J)2895 "RTN","C0SNHIN",113,0)2896 S C0SDOCID=$$PARSE(GN,"CCD")2897 2893 "RTN","C0SNHIN",114,0) 2898 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")2894 Q 2899 2895 "RTN","C0SNHIN",115,0) 2900 ; K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG2896 ; 2901 2897 "RTN","C0SNHIN",116,0) 2902 Q 2898 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 2903 2899 "RTN","C0SNHIN",117,0) 2904 ; 2900 ; PARSED WITH MXML 2905 2901 "RTN","C0SNHIN",118,0) 2906 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 2902 ; RUN THROUGH XPATH 2907 2903 "RTN","C0SNHIN",119,0) 2904 K GARY,GIDX,C0SDOCID 2905 "RTN","C0SNHIN",120,0) 2906 S GN=$NA(^GPL("NHIN")) 2907 "RTN","C0SNHIN",121,0) 2908 ;S GN=$NA(^GPL("DOMI")) 2909 "RTN","C0SNHIN",122,0) 2910 S C0SDOCID=$$PARSE(GN,"GPLTEST") 2911 "RTN","C0SNHIN",123,0) 2912 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") 2913 "RTN","C0SNHIN",124,0) 2914 K ^GPL("GNARY") 2915 "RTN","C0SNHIN",125,0) 2916 M ^GPL("GNARY")=GNARY 2917 "RTN","C0SNHIN",126,0) 2918 Q 2919 "RTN","C0SNHIN",127,0) 2920 ; 2921 "RTN","C0SNHIN",128,0) 2922 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") 2923 "RTN","C0SNHIN",129,0) 2924 ; 2925 "RTN","C0SNHIN",130,0) 2926 S GN=$NA(^GPL("GNARY")) 2927 "RTN","C0SNHIN",131,0) 2928 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") 2929 "RTN","C0SNHIN",132,0) 2930 D OUTXML^C0SDOM("G",C0SDOCID) 2931 "RTN","C0SNHIN",133,0) 2932 K ^GPL("DOMI") 2933 "RTN","C0SNHIN",134,0) 2934 M ^GPL("DOMI")=G 2935 "RTN","C0SNHIN",135,0) 2936 Q 2937 "RTN","C0SNHIN",136,0) 2938 ; 2939 "RTN","C0SNHIN",137,0) 2940 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") 2941 "RTN","C0SNHIN",138,0) 2908 2942 ; PARSED WITH MXML 2909 "RTN","C0SNHIN",1 20,0)2943 "RTN","C0SNHIN",139,0) 2910 2944 ; RUN THROUGH XPATH 2911 "RTN","C0SNHIN",1 21,0)2945 "RTN","C0SNHIN",140,0) 2912 2946 K GARY,GIDX,C0SDOCID 2913 "RTN","C0SNHIN",1 22,0)2914 S GN=$NA(^GPL("NHIN"))2915 "RTN","C0SNHIN",1 23,0)2916 ;S GN=$NA(^GPL("DOMI"))2917 "RTN","C0SNHIN",1 24,0)2947 "RTN","C0SNHIN",141,0) 2948 ;S GN=$NA(^GPL("NHIN")) 2949 "RTN","C0SNHIN",142,0) 2950 S GN=$NA(^GPL("DOMI")) 2951 "RTN","C0SNHIN",143,0) 2918 2952 S C0SDOCID=$$PARSE(GN,"GPLTEST") 2919 "RTN","C0SNHIN",1 25,0)2953 "RTN","C0SNHIN",144,0) 2920 2954 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") 2921 "RTN","C0SNHIN",126,0)2922 K ^GPL("GNARY")2923 "RTN","C0SNHIN",127,0)2924 M ^GPL("GNARY")=GNARY2925 "RTN","C0SNHIN",128,0)2926 Q2927 "RTN","C0SNHIN",129,0)2928 ;2929 "RTN","C0SNHIN",130,0)2930 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")2931 "RTN","C0SNHIN",131,0)2932 ;2933 "RTN","C0SNHIN",132,0)2934 S GN=$NA(^GPL("GNARY"))2935 "RTN","C0SNHIN",133,0)2936 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")2937 "RTN","C0SNHIN",134,0)2938 D OUTXML^C0SDOM("G",C0SDOCID)2939 "RTN","C0SNHIN",135,0)2940 K ^GPL("DOMI")2941 "RTN","C0SNHIN",136,0)2942 M ^GPL("DOMI")=G2943 "RTN","C0SNHIN",137,0)2944 Q2945 "RTN","C0SNHIN",138,0)2946 ;2947 "RTN","C0SNHIN",139,0)2948 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")2949 "RTN","C0SNHIN",140,0)2950 ; PARSED WITH MXML2951 "RTN","C0SNHIN",141,0)2952 ; RUN THROUGH XPATH2953 "RTN","C0SNHIN",142,0)2954 K GARY,GIDX,C0SDOCID2955 "RTN","C0SNHIN",143,0)2956 ;S GN=$NA(^GPL("NHIN"))2957 "RTN","C0SNHIN",144,0)2958 S GN=$NA(^GPL("DOMI"))2959 2955 "RTN","C0SNHIN",145,0) 2960 S C0SDOCID=$$PARSE(GN,"GPLTEST")2956 Q 2961 2957 "RTN","C0SNHIN",146,0) 2962 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")2958 ; 2963 2959 "RTN","C0SNHIN",147,0) 2964 Q 2960 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE 2965 2961 "RTN","C0SNHIN",148,0) 2966 ; 2962 ; THE XPATH INDEX ZXIDX, PASSED BY NAME 2967 2963 "RTN","C0SNHIN",149,0) 2968 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE2964 ; THE XPATH ARRAY XPARY, PASSED BY NAME 2969 2965 "RTN","C0SNHIN",150,0) 2970 ; THE XPATH INDEX ZXIDX, PASSED BY NAME2966 ; ZOID IS THE STARTING OID 2971 2967 "RTN","C0SNHIN",151,0) 2972 ; THE XPATH ARRAY XPARY, PASSED BY NAME2968 ; ZPATH IS THE STARTING XPATH, USUALLY "/" 2973 2969 "RTN","C0SNHIN",152,0) 2974 ; Z OID IS THE STARTING OID2970 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE 2975 2971 "RTN","C0SNHIN",153,0) 2976 ; Z PATH IS THE STARTING XPATH, USUALLY "/"2972 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT 2977 2973 "RTN","C0SNHIN",154,0) 2978 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE2974 I $G(ZREDUX)="" S ZREDUX="" 2979 2975 "RTN","C0SNHIN",155,0) 2980 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT2976 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY 2981 2977 "RTN","C0SNHIN",156,0) 2982 I $G(ZREDUX)="" S ZREDUX=""2978 N NEWNUM S NEWNUM="" 2983 2979 "RTN","C0SNHIN",157,0) 2984 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY2980 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" 2985 2981 "RTN","C0SNHIN",158,0) 2986 N NEWNUM S NEWNUM=""2982 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE 2987 2983 "RTN","C0SNHIN",159,0) 2988 I $G(Z NUM)>0 S NEWNUM="["_ZNUM_"]"2984 I $G(ZREDUX)'="" D ; REDUX PROVIDED? 2989 2985 "RTN","C0SNHIN",160,0) 2990 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE2986 . N GT S GT=$P(NEWPATH,ZREDUX,2) 2991 2987 "RTN","C0SNHIN",161,0) 2992 I $G(ZREDUX)'="" D ; REDUX PROVIDED?2988 . I GT'="" S NEWPATH=GT 2993 2989 "RTN","C0SNHIN",162,0) 2994 . N GT S GT=$P(NEWPATH,ZREDUX,2)2990 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX 2995 2991 "RTN","C0SNHIN",163,0) 2996 . I GT'="" S NEWPATH=GT2992 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE 2997 2993 "RTN","C0SNHIN",164,0) 2998 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX2994 I $D(GA) D ; PROCESS THE ATTRIBUTES 2999 2995 "RTN","C0SNHIN",165,0) 3000 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE2996 . N ZI S ZI="" 3001 2997 "RTN","C0SNHIN",166,0) 3002 I $D(GA) D ; PROCESS THE ATTRIBUTES2998 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE 3003 2999 "RTN","C0SNHIN",167,0) 3004 . N ZI S ZI=""3000 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE 3005 3001 "RTN","C0SNHIN",168,0) 3006 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE3002 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY 3007 3003 "RTN","C0SNHIN",169,0) 3008 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE3004 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE 3009 3005 "RTN","C0SNHIN",170,0) 3010 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY3006 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE 3011 3007 "RTN","C0SNHIN",171,0) 3012 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE3008 I $D(GD(2)) D ; 3013 3009 "RTN","C0SNHIN",172,0) 3014 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE3010 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY 3015 3011 "RTN","C0SNHIN",173,0) 3016 I $D(GD(2)) D ;3012 E I $D(GD(1)) D ; 3017 3013 "RTN","C0SNHIN",174,0) 3018 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THEARRAY3014 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY 3019 3015 "RTN","C0SNHIN",175,0) 3020 E I $D(GD(1)) D ;3016 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY 3021 3017 "RTN","C0SNHIN",176,0) 3022 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY3018 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD 3023 3019 "RTN","C0SNHIN",177,0) 3024 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY3020 I ZFRST'=0 D ; THERE IS A CHILD 3025 3021 "RTN","C0SNHIN",178,0) 3026 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD3022 . N ZNUM 3027 3023 "RTN","C0SNHIN",179,0) 3028 I ZFRST'=0 D ; THERE IS A CHILD3024 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE 3029 3025 "RTN","C0SNHIN",180,0) 3030 . N ZNUM3026 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD 3031 3027 "RTN","C0SNHIN",181,0) 3032 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE3028 N GNXT S GNXT=$$NXTSIB(ZOID) 3033 3029 "RTN","C0SNHIN",182,0) 3034 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD3030 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES 3035 3031 "RTN","C0SNHIN",183,0) 3036 N GNXT S GNXT=$$NXTSIB(ZOID)3032 I GNXT'=0 D ; 3037 3033 "RTN","C0SNHIN",184,0) 3038 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES3034 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? 3039 3035 "RTN","C0SNHIN",185,0) 3040 I GNXT'=0 D ;3036 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES 3041 3037 "RTN","C0SNHIN",186,0) 3042 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?3038 . . N ZNUM S ZNUM=1 ; 3043 3039 "RTN","C0SNHIN",187,0) 3044 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES3040 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB 3045 3041 "RTN","C0SNHIN",188,0) 3046 . . N ZNUM S ZNUM=1 ;3042 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB 3047 3043 "RTN","C0SNHIN",189,0) 3048 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB3044 Q 3049 3045 "RTN","C0SNHIN",190,0) 3050 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB3046 ; 3051 3047 "RTN","C0SNHIN",191,0) 3052 Q 3048 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 3053 3049 "RTN","C0SNHIN",192,0) 3054 3050 ; 3055 3051 "RTN","C0SNHIN",193,0) 3056 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY 3052 N ZZI,ZZJ,ZZN 3057 3053 "RTN","C0SNHIN",194,0) 3058 ;3054 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY 3059 3055 "RTN","C0SNHIN",195,0) 3060 N ZZI,ZZJ,ZZN3056 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE 3061 3057 "RTN","C0SNHIN",196,0) 3062 S ZZ I=$P(ZXP,"/",1) ; FIRST PIECEOF XPATH ARRAY3058 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY 3063 3059 "RTN","C0SNHIN",197,0) 3064 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE3060 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . 3065 3061 "RTN","C0SNHIN",198,0) 3066 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY3062 I ZZI'["]" D ; A SINGLETON 3067 3063 "RTN","C0SNHIN",199,0) 3068 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .3064 . S ZZN=1 3069 3065 "RTN","C0SNHIN",200,0) 3070 I ZZI'["]" D ; A SINGLETON3066 E D ; THERE IS AN [x] OCCURANCE 3071 3067 "RTN","C0SNHIN",201,0) 3072 . S ZZN= 13068 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE 3073 3069 "RTN","C0SNHIN",202,0) 3074 E D ; THERE IS AN [x] OCCURANCE3070 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] 3075 3071 "RTN","C0SNHIN",203,0) 3076 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE3072 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE 3077 3073 "RTN","C0SNHIN",204,0) 3078 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]3074 Q 3079 3075 "RTN","C0SNHIN",205,0) 3080 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE3076 ; 3081 3077 "RTN","C0SNHIN",206,0) 3082 Q 3078 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 3083 3079 "RTN","C0SNHIN",207,0) 3084 ; 3080 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW 3085 3081 "RTN","C0SNHIN",208,0) 3086 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME 3082 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML 3087 3083 "RTN","C0SNHIN",209,0) 3088 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW3084 ;Q $$EN^MXMLDOM(INXML) 3089 3085 "RTN","C0SNHIN",210,0) 3090 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML3086 Q $$EN^MXMLDOM(INXML,"W") 3091 3087 "RTN","C0SNHIN",211,0) 3092 ; Q $$EN^MXMLDOM(INXML)3088 ; 3093 3089 "RTN","C0SNHIN",212,0) 3094 Q $$EN^MXMLDOM(INXML,"W") 3090 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 3095 3091 "RTN","C0SNHIN",213,0) 3096 ;3092 N ZN 3097 3093 "RTN","C0SNHIN",214,0) 3098 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE 3094 ;I $$TAG(ZOID)["entry" B 3099 3095 "RTN","C0SNHIN",215,0) 3100 N ZN3096 S ZN=$$NXTSIB(ZOID) 3101 3097 "RTN","C0SNHIN",216,0) 3102 ;I $$TAG(ZOID)["entry" B3098 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG 3103 3099 "RTN","C0SNHIN",217,0) 3104 S ZN=$$NXTSIB(ZOID)3100 Q 0 3105 3101 "RTN","C0SNHIN",218,0) 3106 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG3102 ; 3107 3103 "RTN","C0SNHIN",219,0) 3108 Q 0 3104 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 3109 3105 "RTN","C0SNHIN",220,0) 3110 ;3106 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) 3111 3107 "RTN","C0SNHIN",221,0) 3112 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID 3108 ; 3113 3109 "RTN","C0SNHIN",222,0) 3114 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) 3110 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 3115 3111 "RTN","C0SNHIN",223,0) 3116 ;3112 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) 3117 3113 "RTN","C0SNHIN",224,0) 3118 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID 3114 ; 3119 3115 "RTN","C0SNHIN",225,0) 3120 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) 3116 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 3121 3117 "RTN","C0SNHIN",226,0) 3122 ;3118 S HANDLE=C0SDOCID 3123 3119 "RTN","C0SNHIN",227,0) 3124 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID 3120 K @RTN 3125 3121 "RTN","C0SNHIN",228,0) 3126 S HANDLE=C0SDOCID3122 D GETTXT^MXMLDOM("A") 3127 3123 "RTN","C0SNHIN",229,0) 3128 K @RTN3124 Q 3129 3125 "RTN","C0SNHIN",230,0) 3130 D GETTXT^MXMLDOM("A")3126 ; 3131 3127 "RTN","C0SNHIN",231,0) 3132 Q 3128 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 3133 3129 "RTN","C0SNHIN",232,0) 3134 ; 3130 ;I ZOID=149 B ;GPLTEST 3135 3131 "RTN","C0SNHIN",233,0) 3136 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE 3132 N X,Y 3137 3133 "RTN","C0SNHIN",234,0) 3138 ;I ZOID=149 B ;GPLTEST3134 S Y="" 3139 3135 "RTN","C0SNHIN",235,0) 3140 N X,Y3136 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE 3141 3137 "RTN","C0SNHIN",236,0) 3142 S Y=""3138 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y 3143 3139 "RTN","C0SNHIN",237,0) 3144 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE3140 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) 3145 3141 "RTN","C0SNHIN",238,0) 3146 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SETY3142 Q Y 3147 3143 "RTN","C0SNHIN",239,0) 3148 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)3144 ; 3149 3145 "RTN","C0SNHIN",240,0) 3150 Q Y 3146 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 3151 3147 "RTN","C0SNHIN",241,0) 3152 ;3148 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) 3153 3149 "RTN","C0SNHIN",242,0) 3154 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING 3150 ; 3155 3151 "RTN","C0SNHIN",243,0) 3156 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) 3152 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 3157 3153 "RTN","C0SNHIN",244,0) 3158 ; 3154 ;N ZT,ZN S ZT="" 3159 3155 "RTN","C0SNHIN",245,0) 3160 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE 3156 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) 3161 3157 "RTN","C0SNHIN",246,0) 3162 ; N ZT,ZN S ZT=""3158 ;Q $G(@C0SDOM@(ZOID,"T",1)) 3163 3159 "RTN","C0SNHIN",247,0) 3164 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))3160 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) 3165 3161 "RTN","C0SNHIN",248,0) 3166 ;Q $G(@C0SDOM@(ZOID,"T",1))3162 Q 3167 3163 "RTN","C0SNHIN",249,0) 3168 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)3164 ; 3169 3165 "RTN","C0SNHIN",250,0) 3170 Q 3166 OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 3171 3167 "RTN","C0SNHIN",251,0) 3172 3168 ; 3173 3169 "RTN","C0SNHIN",252,0) 3174 OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM 3170 S C0SDOCID=INID 3175 3171 "RTN","C0SNHIN",253,0) 3176 ;3172 D START^C0SMXMLB($$TAG(1),,"G") 3177 3173 "RTN","C0SNHIN",254,0) 3178 S C0SDOCID=INID3174 D NDOUT($$FIRST(1)) 3179 3175 "RTN","C0SNHIN",255,0) 3180 D START^C0SMXMLB($$TAG(1),,"G")3176 D END^C0SMXMLB ;END THE DOCUMENT 3181 3177 "RTN","C0SNHIN",256,0) 3182 D NDOUT($$FIRST(1))3178 M @ZRTN=^TMP("MXMLBLD",$J) 3183 3179 "RTN","C0SNHIN",257,0) 3184 D END^C0SMXMLB ;END THE DOCUMENT3180 K ^TMP("MXMLBLD",$J) 3185 3181 "RTN","C0SNHIN",258,0) 3186 M @ZRTN=^TMP("MXMLBLD",$J)3182 Q 3187 3183 "RTN","C0SNHIN",259,0) 3188 K ^TMP("MXMLBLD",$J)3184 ; 3189 3185 "RTN","C0SNHIN",260,0) 3190 Q 3186 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 3191 3187 "RTN","C0SNHIN",261,0) 3192 ;3188 N ZI S ZI=$$FIRST(ZOID) 3193 3189 "RTN","C0SNHIN",262,0) 3194 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE 3190 I ZI'=0 D ; THERE IS A CHILD 3195 3191 "RTN","C0SNHIN",263,0) 3196 N ZI S ZI=$$FIRST(ZOID)3192 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT 3197 3193 "RTN","C0SNHIN",264,0) 3198 I ZI'=0 D ; THERE IS A CHILD3194 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN 3199 3195 "RTN","C0SNHIN",265,0) 3200 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT3196 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT 3201 3197 "RTN","C0SNHIN",266,0) 3202 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN3198 . ;W "DOING",ZOID,! 3203 3199 "RTN","C0SNHIN",267,0) 3204 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT3200 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA 3205 3201 "RTN","C0SNHIN",268,0) 3206 . ;W "DOING",ZOID,!3202 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES 3207 3203 "RTN","C0SNHIN",269,0) 3208 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA3204 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN 3209 3205 "RTN","C0SNHIN",270,0) 3210 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES3206 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING 3211 3207 "RTN","C0SNHIN",271,0) 3212 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN3208 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS 3213 3209 "RTN","C0SNHIN",272,0) 3214 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING3210 Q 3215 3211 "RTN","C0SNHIN",273,0) 3216 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS3212 ; 3217 3213 "RTN","C0SNHIN",274,0) 3218 Q 3214 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 3219 3215 "RTN","C0SNHIN",275,0) 3220 3216 ; 3221 3217 "RTN","C0SNHIN",276,0) 3222 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE 3218 N GN,GN2 3223 3219 "RTN","C0SNHIN",277,0) 3224 ;3220 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML 3225 3221 "RTN","C0SNHIN",278,0) 3226 N GN,GN23222 S GN2=$NA(@GN@(1)) 3227 3223 "RTN","C0SNHIN",279,0) 3228 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML3224 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") 3229 3225 "RTN","C0SNHIN",280,0) 3230 S GN2=$NA(@GN@(1))3226 Q 3231 3227 "RTN","C0SNHIN",281,0) 3232 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")3228 ; 3233 3229 "RTN","C0SNHIN",282,0) 3234 Q 3230 TESTNARY ; TEST MAKING A NHIN ARRAY 3235 3231 "RTN","C0SNHIN",283,0) 3236 ;3232 N ZI S ZI="" 3237 3233 "RTN","C0SNHIN",284,0) 3238 TESTNARY ; TEST MAKING A NHIN ARRAY 3234 N ZH ; DOM HANDLE 3239 3235 "RTN","C0SNHIN",285,0) 3240 N ZI S ZI=""3236 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM 3241 3237 "RTN","C0SNHIN",286,0) 3242 N ZH ; DOMHANDLE3238 S ZH=C0SDOCID ; SET THE HANDLE 3243 3239 "RTN","C0SNHIN",287,0) 3244 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM3240 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) 3245 3241 "RTN","C0SNHIN",288,0) 3246 S ZH=C0SDOCID ; SET THE HANDLE3242 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE 3247 3243 "RTN","C0SNHIN",289,0) 3248 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))3244 . N ZATT 3249 3245 "RTN","C0SNHIN",290,0) 3250 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE3246 . D MNARY(.ZATT,ZH,ZI) 3251 3247 "RTN","C0SNHIN",291,0) 3252 . N Z ATT3248 . N ZPRE,ZN 3253 3249 "RTN","C0SNHIN",292,0) 3254 . D MNARY(.ZATT,ZH,ZI)3250 . S ZPRE=$$PRE(ZI) 3255 3251 "RTN","C0SNHIN",293,0) 3256 . N ZPRE,ZN3252 . S ZN=$P(ZPRE,",",2) 3257 3253 "RTN","C0SNHIN",294,0) 3258 . S ZPRE=$ $PRE(ZI)3254 . S ZPRE=$P(ZPRE,",",1) 3259 3255 "RTN","C0SNHIN",295,0) 3260 . S ZN=$P(ZPRE,",",2)3256 . ;I $D(ZATT) ZWR ZATT 3261 3257 "RTN","C0SNHIN",296,0) 3262 . S ZPRE=$P(ZPRE,",",1)3258 . N ZJ S ZJ="" 3263 3259 "RTN","C0SNHIN",297,0) 3264 . ;I $D(ZATT) ZWR ZATT3260 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE 3265 3261 "RTN","C0SNHIN",298,0) 3266 . N ZJ S ZJ=""3262 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! 3267 3263 "RTN","C0SNHIN",299,0) 3268 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE3264 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) 3269 3265 "RTN","C0SNHIN",300,0) 3270 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!3266 Q 3271 3267 "RTN","C0SNHIN",301,0) 3272 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)3268 ; 3273 3269 "RTN","C0SNHIN",302,0) 3274 Q 3270 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE 3275 3271 "RTN","C0SNHIN",303,0) 3276 3272 ; 3277 3273 "RTN","C0SNHIN",304,0) 3278 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE 3274 N GI,GI2,GPT,GJ,GN 3279 3275 "RTN","C0SNHIN",305,0) 3280 ;3276 S GI=$$PARENT(ZNODE) ; PARENT NODE 3281 3277 "RTN","C0SNHIN",306,0) 3282 N GI,GI2,GPT,GJ,GN3278 I GI=0 Q "" ; NO PARENT 3283 3279 "RTN","C0SNHIN",307,0) 3284 S G I=$$PARENT(ZNODE) ; PARENT NODE3280 S GPT=$$TAG(GI) ; TAG OF PARENT 3285 3281 "RTN","C0SNHIN",308,0) 3286 I GI=0 Q "" ; NOPARENT3282 S GI2=$$PARENT(GI) ; PARENT OF PARENT 3287 3283 "RTN","C0SNHIN",309,0) 3288 S GPT=$$TAG(GI) ; TAG OF PARENT3284 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT 3289 3285 "RTN","C0SNHIN",310,0) 3290 S G I2=$$PARENT(GI) ; PARENT OF PARENT3286 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB 3291 3287 "RTN","C0SNHIN",311,0) 3292 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT3288 I GJ=ZNODE Q:$$TAG(GI)_",1" 3293 3289 "RTN","C0SNHIN",312,0) 3294 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB3290 F GN=2:1 Q:GJ=ZNODE D ; 3295 3291 "RTN","C0SNHIN",313,0) 3296 I GJ=ZNODE Q:$$TAG(GI)_",1"3292 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING 3297 3293 "RTN","C0SNHIN",314,0) 3298 F GN=2:1 Q:GJ=ZNODE D ;3294 Q GPT_","_GN 3299 3295 "RTN","C0SNHIN",315,0) 3300 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING3296 ; 3301 3297 "RTN","C0SNHIN",316,0) 3302 Q GPT_","_GN 3298 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE 3303 3299 "RTN","C0SNHIN",317,0) 3304 ; 3300 ; RETURNED IN ZRTN, PASSED BY REFERENCE 3305 3301 "RTN","C0SNHIN",318,0) 3306 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE 3302 ; ZHANDLE IS THE DOM DOCUMENT ID 3307 3303 "RTN","C0SNHIN",319,0) 3308 ; RETURNED IN ZRTN, PASSED BY REFERENCE3304 ; ZOID IS THE DOM NODE 3309 3305 "RTN","C0SNHIN",320,0) 3310 ; ZHANDLE IS THE DOM DOCUMENT ID3306 D ATT("ZRTN",ZOID) 3311 3307 "RTN","C0SNHIN",321,0) 3312 ; ZOID IS THE DOM NODE3308 Q 3313 3309 "RTN","C0SNHIN",322,0) 3314 D ATT("ZRTN",ZOID)3315 "RTN","C0SNHIN",323,0)3316 Q3317 "RTN","C0SNHIN",324,0)3318 3310 ; 3319 3311 "RTN","C0SNHINV") … … 3322 3314 C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version 3323 3315 "RTN","C0SNHINV",2,0) 3324 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 53316 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 3325 3317 "RTN","C0SNHINV",3,0) 3326 3318 ; … … 3556 3548 Q $$GET1^DIQ(FILE,IEN_",",99.99) 3557 3549 "RTN","C0SPROB") 3558 0^9^B49 6694003550 0^9^B49349956 3559 3551 "RTN","C0SPROB",1,0) 3560 3552 C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 3561 3553 "RTN","C0SPROB",2,0) 3562 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 53554 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 3563 3555 "RTN","C0SPROB",3,0) 3564 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU3556 ;Copyright 2012 George Lilly. 3565 3557 "RTN","C0SPROB",4,0) 3566 ; General Public License See attached copy of the License.3558 ; 3567 3559 "RTN","C0SPROB",5,0) 3568 ; 3560 ; This program is free software: you can redistribute it and/or modify 3569 3561 "RTN","C0SPROB",6,0) 3570 ; This program is free software; you can redistribute it and/or modify3562 ; it under the terms of the GNU Affero General Public License as 3571 3563 "RTN","C0SPROB",7,0) 3572 ; it under the terms of the GNU General Public License as published by3564 ; published by the Free Software Foundation, either version 3 of the 3573 3565 "RTN","C0SPROB",8,0) 3574 ; the Free Software Foundation; either version 2 of the License, or3566 ; License, or (at your option) any later version. 3575 3567 "RTN","C0SPROB",9,0) 3576 ; (at your option) any later version.3568 ; 3577 3569 "RTN","C0SPROB",10,0) 3578 ; 3570 ; This program is distributed in the hope that it will be useful, 3579 3571 "RTN","C0SPROB",11,0) 3580 ; This program is distributed in the hope that it will be useful,3572 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 3581 3573 "RTN","C0SPROB",12,0) 3582 ; but WITHOUT ANY WARRANTY; without even the implied warranty of3574 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 3583 3575 "RTN","C0SPROB",13,0) 3584 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the3576 ; GNU Affero General Public License for more details. 3585 3577 "RTN","C0SPROB",14,0) 3586 ; GNU General Public License for more details.3578 ; 3587 3579 "RTN","C0SPROB",15,0) 3588 ; 3580 ; You should have received a copy of the GNU Affero General Public License 3589 3581 "RTN","C0SPROB",16,0) 3590 ; You should have received a copy of the GNU General Public License along3582 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 3591 3583 "RTN","C0SPROB",17,0) 3592 ; with this program; if not, write to the Free Software Foundation, Inc.,3584 ; 3593 3585 "RTN","C0SPROB",18,0) 3594 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.3586 Q 3595 3587 "RTN","C0SPROB",19,0) 3596 3588 ; 3597 3589 "RTN","C0SPROB",20,0) 3598 Q3590 ; sample VistA NHIN problem list 3599 3591 "RTN","C0SPROB",21,0) 3600 3592 ; 3601 3593 "RTN","C0SPROB",22,0) 3602 ; sample VistA NHIN problem list3594 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" 3603 3595 "RTN","C0SPROB",23,0) 3604 ; 3596 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 3605 3597 "RTN","C0SPROB",24,0) 3606 ;^TMP("C0STBL",91,"problem",1," acuity@value")="C"3598 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 3607 3599 "RTN","C0SPROB",25,0) 3608 ;^TMP("C0STBL",91,"problem",1," entered@value")=31105313600 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" 3609 3601 "RTN","C0SPROB",26,0) 3610 ;^TMP("C0STBL",91,"problem",1," facility@code")=1003602 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 3611 3603 "RTN","C0SPROB",27,0) 3612 ;^TMP("C0STBL",91,"problem",1," facility@name")="VOE OFFICE INSTITUTION"3604 ;^TMP("C0STBL",91,"problem",1,"id@value")=100 3613 3605 "RTN","C0SPROB",28,0) 3614 ;^TMP("C0STBL",91,"problem",1," icd@value")=414.93606 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" 3615 3607 "RTN","C0SPROB",29,0) 3616 ;^TMP("C0STBL",91,"problem",1," id@value")=1003608 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" 3617 3609 "RTN","C0SPROB",30,0) 3618 ;^TMP("C0STBL",91,"problem",1," location@value")="DR OFFICE"3610 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 3619 3611 "RTN","C0SPROB",31,0) 3620 ;^TMP("C0STBL",91,"problem",1," name@value")="Coronary Artery Disease"3612 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 3621 3613 "RTN","C0SPROB",32,0) 3622 ;^TMP("C0STBL",91,"problem",1," onset@value")=31002013614 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" 3623 3615 "RTN","C0SPROB",33,0) 3624 ;^TMP("C0STBL",91,"problem",1," provider@code")=633616 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 3625 3617 "RTN","C0SPROB",34,0) 3626 ;^TMP("C0STBL",91,"problem",1," provider@name")="KING,MATTHEW MICHAEL"3618 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 3627 3619 "RTN","C0SPROB",35,0) 3628 ;^TMP("C0STBL",91,"problem",1," removed@value")=03620 ;^TMP("C0STBL",91,"problem",1,"status@value")="A" 3629 3621 "RTN","C0SPROB",36,0) 3630 ;^TMP("C0STBL",91,"problem",1," sc@value")=03622 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 3631 3623 "RTN","C0SPROB",37,0) 3632 ;^TMP("C0STBL",91,"problem",1," status@value")="A"3624 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 3633 3625 "RTN","C0SPROB",38,0) 3634 ;^TMP("C0STBL",91,"problem", 1,"unverified@value")=03626 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" 3635 3627 "RTN","C0SPROB",39,0) 3636 ;^TMP("C0STBL",91,"problem", 1,"updated@value")=31105313628 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 3637 3629 "RTN","C0SPROB",40,0) 3638 ;^TMP("C0STBL",91,"problem",2," acuity@value")="C"3630 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 3639 3631 "RTN","C0SPROB",41,0) 3640 ;^TMP("C0STBL",91,"problem",2," entered@value")=31106023632 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" 3641 3633 "RTN","C0SPROB",42,0) 3642 ;^TMP("C0STBL",91,"problem",2," facility@code")=1003634 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 3643 3635 "RTN","C0SPROB",43,0) 3644 ;^TMP("C0STBL",91,"problem",2," facility@name")="VOE OFFICE INSTITUTION"3636 ;^TMP("C0STBL",91,"problem",2,"id@value")=108 3645 3637 "RTN","C0SPROB",44,0) 3646 ;^TMP("C0STBL",91,"problem",2," icd@value")=780.23638 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" 3647 3639 "RTN","C0SPROB",45,0) 3648 ;^TMP("C0STBL",91,"problem",2," id@value")=1083640 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 3649 3641 "RTN","C0SPROB",46,0) 3650 ;^TMP("C0STBL",91,"problem",2," name@value")="Syncope and collapse"3642 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 3651 3643 "RTN","C0SPROB",47,0) 3652 ;^TMP("C0STBL",91,"problem",2," onset@value")=31101023644 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" 3653 3645 "RTN","C0SPROB",48,0) 3654 ;^TMP("C0STBL",91,"problem",2," provider@code")=633646 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 3655 3647 "RTN","C0SPROB",49,0) 3656 ;^TMP("C0STBL",91,"problem",2," provider@name")="KING,MATTHEW MICHAEL"3648 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 3657 3649 "RTN","C0SPROB",50,0) 3658 ;^TMP("C0STBL",91,"problem",2," removed@value")=03650 ;^TMP("C0STBL",91,"problem",2,"status@value")="A" 3659 3651 "RTN","C0SPROB",51,0) 3660 ;^TMP("C0STBL",91,"problem",2," sc@value")=03652 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 3661 3653 "RTN","C0SPROB",52,0) 3662 ;^TMP("C0STBL",91,"problem",2," status@value")="A"3654 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 3663 3655 "RTN","C0SPROB",53,0) 3664 ;^TMP("C0STBL",91,"problem", 2,"unverified@value")=03656 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" 3665 3657 "RTN","C0SPROB",54,0) 3666 ;^TMP("C0STBL",91,"problem", 2,"updated@value")=31106023658 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 3667 3659 "RTN","C0SPROB",55,0) 3668 ;^TMP("C0STBL",91,"problem",3," acuity@value")="C"3660 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 3669 3661 "RTN","C0SPROB",56,0) 3670 ;^TMP("C0STBL",91,"problem",3," entered@value")=31106023662 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" 3671 3663 "RTN","C0SPROB",57,0) 3672 ;^TMP("C0STBL",91,"problem",3," facility@code")=1003664 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 3673 3665 "RTN","C0SPROB",58,0) 3674 ;^TMP("C0STBL",91,"problem",3," facility@name")="VOE OFFICE INSTITUTION"3666 ;^TMP("C0STBL",91,"problem",3,"id@value")=109 3675 3667 "RTN","C0SPROB",59,0) 3676 ;^TMP("C0STBL",91,"problem",3," icd@value")=433.913668 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" 3677 3669 "RTN","C0SPROB",60,0) 3678 ;^TMP("C0STBL",91,"problem",3," id@value")=1093670 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 3679 3671 "RTN","C0SPROB",61,0) 3680 ;^TMP("C0STBL",91,"problem",3," name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"3672 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 3681 3673 "RTN","C0SPROB",62,0) 3682 ;^TMP("C0STBL",91,"problem",3," onset@value")=31001013674 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" 3683 3675 "RTN","C0SPROB",63,0) 3684 ;^TMP("C0STBL",91,"problem",3," provider@code")=633676 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 3685 3677 "RTN","C0SPROB",64,0) 3686 ;^TMP("C0STBL",91,"problem",3," provider@name")="KING,MATTHEW MICHAEL"3678 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 3687 3679 "RTN","C0SPROB",65,0) 3688 ;^TMP("C0STBL",91,"problem",3," removed@value")=03680 ;^TMP("C0STBL",91,"problem",3,"status@value")="A" 3689 3681 "RTN","C0SPROB",66,0) 3690 ;^TMP("C0STBL",91,"problem",3," sc@value")=03682 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 3691 3683 "RTN","C0SPROB",67,0) 3692 ;^TMP("C0STBL",91,"problem",3," status@value")="A"3684 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 3693 3685 "RTN","C0SPROB",68,0) 3694 ;^TMP("C0STBL",91,"problem", 3,"unverified@value")=03686 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 3695 3687 "RTN","C0SPROB",69,0) 3696 ;^TMP("C0STBL",91,"problem", 3,"updated@value")=31106023688 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 3697 3689 "RTN","C0SPROB",70,0) 3698 ;^TMP("C0STBL",91,"problem",4," entered@value")=31106033690 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" 3699 3691 "RTN","C0SPROB",71,0) 3700 ;^TMP("C0STBL",91,"problem",4," facility@code")=1003692 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" 3701 3693 "RTN","C0SPROB",72,0) 3702 ;^TMP("C0STBL",91,"problem",4," facility@name")="VOE OFFICE INSTITUTION"3694 ;^TMP("C0STBL",91,"problem",4,"id@value")=115 3703 3695 "RTN","C0SPROB",73,0) 3704 ;^TMP("C0STBL",91,"problem",4," icd@value")="00.66"3696 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" 3705 3697 "RTN","C0SPROB",74,0) 3706 ;^TMP("C0STBL",91,"problem",4," id@value")=1153698 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" 3707 3699 "RTN","C0SPROB",75,0) 3708 ;^TMP("C0STBL",91,"problem",4," location@value")="DR OFFICE"3700 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 3709 3701 "RTN","C0SPROB",76,0) 3710 ;^TMP("C0STBL",91,"problem",4," name@value")="00.66"3702 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" 3711 3703 "RTN","C0SPROB",77,0) 3712 ;^TMP("C0STBL",91,"problem",4," provider@code")=633704 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 3713 3705 "RTN","C0SPROB",78,0) 3714 ;^TMP("C0STBL",91,"problem",4," provider@name")="KING,MATTHEW MICHAEL"3706 ;^TMP("C0STBL",91,"problem",4,"status@value")="A" 3715 3707 "RTN","C0SPROB",79,0) 3716 ;^TMP("C0STBL",91,"problem",4," removed@value")=03708 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 3717 3709 "RTN","C0SPROB",80,0) 3718 ;^TMP("C0STBL",91,"problem",4," status@value")="A"3710 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 3719 3711 "RTN","C0SPROB",81,0) 3720 ;^TMP("C0STBL",91,"problem", 4,"unverified@value")=03712 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 3721 3713 "RTN","C0SPROB",82,0) 3722 ;^TMP("C0STBL",91,"problem", 4,"updated@value")=31106033714 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 3723 3715 "RTN","C0SPROB",83,0) 3724 ;^TMP("C0STBL",91,"problem",5," entered@value")=31106033716 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" 3725 3717 "RTN","C0SPROB",84,0) 3726 ;^TMP("C0STBL",91,"problem",5," facility@code")=1003718 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 3727 3719 "RTN","C0SPROB",85,0) 3728 ;^TMP("C0STBL",91,"problem",5," facility@name")="VOE OFFICE INSTITUTION"3720 ;^TMP("C0STBL",91,"problem",5,"id@value")=116 3729 3721 "RTN","C0SPROB",86,0) 3730 ;^TMP("C0STBL",91,"problem",5," icd@value")=37.213722 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" 3731 3723 "RTN","C0SPROB",87,0) 3732 ;^TMP("C0STBL",91,"problem",5," id@value")=1163724 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 3733 3725 "RTN","C0SPROB",88,0) 3734 ;^TMP("C0STBL",91,"problem",5," location@value")="DR OFFICE"3726 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 3735 3727 "RTN","C0SPROB",89,0) 3736 ;^TMP("C0STBL",91,"problem",5," name@value")=37.213728 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" 3737 3729 "RTN","C0SPROB",90,0) 3738 ;^TMP("C0STBL",91,"problem",5," provider@code")=633730 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 3739 3731 "RTN","C0SPROB",91,0) 3740 ;^TMP("C0STBL",91,"problem",5," provider@name")="KING,MATTHEW MICHAEL"3732 ;^TMP("C0STBL",91,"problem",5,"status@value")="A" 3741 3733 "RTN","C0SPROB",92,0) 3742 ;^TMP("C0STBL",91,"problem",5," removed@value")=03734 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 3743 3735 "RTN","C0SPROB",93,0) 3744 ;^TMP("C0STBL",91,"problem",5," status@value")="A"3736 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 3745 3737 "RTN","C0SPROB",94,0) 3746 ;^TMP("C0STBL",91,"problem", 5,"unverified@value")=03738 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 3747 3739 "RTN","C0SPROB",95,0) 3748 ;^TMP("C0STBL",91,"problem", 5,"updated@value")=31106033740 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 3749 3741 "RTN","C0SPROB",96,0) 3750 ;^TMP("C0STBL",91,"problem",6," entered@value")=31106033742 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" 3751 3743 "RTN","C0SPROB",97,0) 3752 ;^TMP("C0STBL",91,"problem",6," facility@code")=1003744 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 3753 3745 "RTN","C0SPROB",98,0) 3754 ;^TMP("C0STBL",91,"problem",6," facility@name")="VOE OFFICE INSTITUTION"3746 ;^TMP("C0STBL",91,"problem",6,"id@value")=117 3755 3747 "RTN","C0SPROB",99,0) 3756 ;^TMP("C0STBL",91,"problem",6," icd@value")=81.513748 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" 3757 3749 "RTN","C0SPROB",100,0) 3758 ;^TMP("C0STBL",91,"problem",6," id@value")=1173750 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 3759 3751 "RTN","C0SPROB",101,0) 3760 ;^TMP("C0STBL",91,"problem",6," location@value")="DR OFFICE"3752 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 3761 3753 "RTN","C0SPROB",102,0) 3762 ;^TMP("C0STBL",91,"problem",6," name@value")=81.513754 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" 3763 3755 "RTN","C0SPROB",103,0) 3764 ;^TMP("C0STBL",91,"problem",6," provider@code")=633756 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 3765 3757 "RTN","C0SPROB",104,0) 3766 ;^TMP("C0STBL",91,"problem",6," provider@name")="KING,MATTHEW MICHAEL"3758 ;^TMP("C0STBL",91,"problem",6,"status@value")="A" 3767 3759 "RTN","C0SPROB",105,0) 3768 ;^TMP("C0STBL",91,"problem",6," removed@value")=03760 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 3769 3761 "RTN","C0SPROB",106,0) 3770 ;^TMP("C0STBL",91,"problem",6," status@value")="A"3762 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 3771 3763 "RTN","C0SPROB",107,0) 3772 ;^TMP("C0STBL",91,"problem", 6,"unverified@value")=03764 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 3773 3765 "RTN","C0SPROB",108,0) 3774 ;^TMP("C0STBL",91,"problem", 6,"updated@value")=31106033766 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 3775 3767 "RTN","C0SPROB",109,0) 3776 ;^TMP("C0STBL",91,"problem",7," entered@value")=31106033768 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" 3777 3769 "RTN","C0SPROB",110,0) 3778 ;^TMP("C0STBL",91,"problem",7," facility@code")=1003770 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 3779 3771 "RTN","C0SPROB",111,0) 3780 ;^TMP("C0STBL",91,"problem",7," facility@name")="VOE OFFICE INSTITUTION"3772 ;^TMP("C0STBL",91,"problem",7,"id@value")=118 3781 3773 "RTN","C0SPROB",112,0) 3782 ;^TMP("C0STBL",91,"problem",7," icd@value")=47.093774 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" 3783 3775 "RTN","C0SPROB",113,0) 3784 ;^TMP("C0STBL",91,"problem",7," id@value")=1183776 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 3785 3777 "RTN","C0SPROB",114,0) 3786 ;^TMP("C0STBL",91,"problem",7," location@value")="DR OFFICE"3778 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 3787 3779 "RTN","C0SPROB",115,0) 3788 ;^TMP("C0STBL",91,"problem",7," name@value")=47.093780 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" 3789 3781 "RTN","C0SPROB",116,0) 3790 ;^TMP("C0STBL",91,"problem",7," provider@code")=633782 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 3791 3783 "RTN","C0SPROB",117,0) 3792 ;^TMP("C0STBL",91,"problem",7," provider@name")="KING,MATTHEW MICHAEL"3784 ;^TMP("C0STBL",91,"problem",7,"status@value")="A" 3793 3785 "RTN","C0SPROB",118,0) 3794 ;^TMP("C0STBL",91,"problem",7," removed@value")=03786 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 3795 3787 "RTN","C0SPROB",119,0) 3796 ;^TMP("C0STBL",91,"problem",7," status@value")="A"3788 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 3797 3789 "RTN","C0SPROB",120,0) 3798 ;^TMP("C0STBL",91,"problem", 7,"unverified@value")=03790 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 3799 3791 "RTN","C0SPROB",121,0) 3800 ;^TMP("C0STBL",91,"problem", 7,"updated@value")=31106033792 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 3801 3793 "RTN","C0SPROB",122,0) 3802 ;^TMP("C0STBL",91,"problem",8," entered@value")=31106033794 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" 3803 3795 "RTN","C0SPROB",123,0) 3804 ;^TMP("C0STBL",91,"problem",8," facility@code")=1003796 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" 3805 3797 "RTN","C0SPROB",124,0) 3806 ;^TMP("C0STBL",91,"problem",8," facility@name")="VOE OFFICE INSTITUTION"3798 ;^TMP("C0STBL",91,"problem",8,"id@value")=119 3807 3799 "RTN","C0SPROB",125,0) 3808 ;^TMP("C0STBL",91,"problem",8," icd@value")="250.00"3800 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" 3809 3801 "RTN","C0SPROB",126,0) 3810 ;^TMP("C0STBL",91,"problem",8," id@value")=1193802 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," 3811 3803 "RTN","C0SPROB",127,0) 3812 ;^TMP("C0STBL",91,"problem",8," location@value")="DR OFFICE"3804 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 3813 3805 "RTN","C0SPROB",128,0) 3814 ;^TMP("C0STBL",91,"problem",8," name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"3806 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" 3815 3807 "RTN","C0SPROB",129,0) 3816 ;^TMP("C0STBL",91,"problem",8," provider@code")=633808 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 3817 3809 "RTN","C0SPROB",130,0) 3818 ;^TMP("C0STBL",91,"problem",8," provider@name")="KING,MATTHEW MICHAEL"3810 ;^TMP("C0STBL",91,"problem",8,"status@value")="A" 3819 3811 "RTN","C0SPROB",131,0) 3820 ;^TMP("C0STBL",91,"problem",8," removed@value")=03812 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 3821 3813 "RTN","C0SPROB",132,0) 3822 ;^TMP("C0STBL",91,"problem",8," status@value")="A"3814 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 3823 3815 "RTN","C0SPROB",133,0) 3824 ; ^TMP("C0STBL",91,"problem",8,"unverified@value")=03816 ; 3825 3817 "RTN","C0SPROB",134,0) 3826 ; ^TMP("C0STBL",91,"problem",8,"updated@value")=31106033818 ; sample Smart lab result triples 3827 3819 "RTN","C0SPROB",135,0) 3828 3820 ; 3829 3821 "RTN","C0SPROB",136,0) 3830 ; sample Smart lab result triples3822 ;G("node16rk1fgdvx10882","code")="snomed:40930008" 3831 3823 "RTN","C0SPROB",137,0) 3832 ; 3824 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" 3833 3825 "RTN","C0SPROB",138,0) 3834 ;G("node16rk1fgdvx10882"," code")="snomed:40930008"3826 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" 3835 3827 "RTN","C0SPROB",139,0) 3836 ;G("node16rk1fgdvx1 0882","dcterms:title")="Hypothyroidism"3828 ;G("node16rk1fgdvx11051","code")="snomed:188155002" 3837 3829 "RTN","C0SPROB",140,0) 3838 ;G("node16rk1fgdvx1 0882","rdf:type")="sp:CodedValue"3830 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 3839 3831 "RTN","C0SPROB",141,0) 3840 ;G("node16rk1fgdvx11051"," code")="snomed:188155002"3832 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" 3841 3833 "RTN","C0SPROB",142,0) 3842 ;G("node16rk1fgdvx110 51","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"3834 ;G("node16rk1fgdvx11073","code")="snomed:353295004" 3843 3835 "RTN","C0SPROB",143,0) 3844 ;G("node16rk1fgdvx110 51","rdf:type")="sp:CodedValue"3836 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" 3845 3837 "RTN","C0SPROB",144,0) 3846 ;G("node16rk1fgdvx11073"," code")="snomed:353295004"3838 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" 3847 3839 "RTN","C0SPROB",145,0) 3848 ;G("node16rk1fgdvx110 73","dcterms:title")="Toxic diffuse goiter"3840 ;G("node16rk1fgdvx11089","code")="snomed:54302000" 3849 3841 "RTN","C0SPROB",146,0) 3850 ;G("node16rk1fgdvx110 73","rdf:type")="sp:CodedValue"3842 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" 3851 3843 "RTN","C0SPROB",147,0) 3852 ;G("node16rk1fgdvx11089"," code")="snomed:54302000"3844 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" 3853 3845 "RTN","C0SPROB",148,0) 3854 ;G("node16rk1fgdvx11 089","dcterms:title")="Disorder of breast"3846 ;G("node16rk1fgdvx11351","code")="snomed:38341003" 3855 3847 "RTN","C0SPROB",149,0) 3856 ;G("node16rk1fgdvx11 089","rdf:type")="sp:CodedValue"3848 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" 3857 3849 "RTN","C0SPROB",150,0) 3858 ;G("node16rk1fgdvx11351"," code")="snomed:38341003"3850 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" 3859 3851 "RTN","C0SPROB",151,0) 3860 ;G("node16rk1fgdvx113 51","dcterms:title")="Essential hypertension"3852 ;G("node16rk1fgdvx11390","code")="snomed:44054006" 3861 3853 "RTN","C0SPROB",152,0) 3862 ;G("node16rk1fgdvx113 51","rdf:type")="sp:CodedValue"3854 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" 3863 3855 "RTN","C0SPROB",153,0) 3864 ;G("node16rk1fgdvx11390"," code")="snomed:44054006"3856 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" 3865 3857 "RTN","C0SPROB",154,0) 3866 ;G("node16rk1fgdvx11 390","dcterms:title")="Diabetes mellitus type 2"3858 ;G("node16rk1fgdvx11558","code")="snomed:195967001" 3867 3859 "RTN","C0SPROB",155,0) 3868 ;G("node16rk1fgdvx11 390","rdf:type")="sp:CodedValue"3860 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" 3869 3861 "RTN","C0SPROB",156,0) 3870 ;G("node16rk1fgdvx11558"," code")="snomed:195967001"3862 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" 3871 3863 "RTN","C0SPROB",157,0) 3872 ;G("node16rk1fgdvx115 58","dcterms:title")="Asthma"3864 ;G("node16rk1fgdvx11578","code")="snomed:254837009" 3873 3865 "RTN","C0SPROB",158,0) 3874 ;G("node16rk1fgdvx115 58","rdf:type")="sp:CodedValue"3866 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" 3875 3867 "RTN","C0SPROB",159,0) 3876 ;G("node16rk1fgdvx11578"," code")="snomed:254837009"3868 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" 3877 3869 "RTN","C0SPROB",160,0) 3878 ;G("node16rk1fgdvx11 578","dcterms:title")="Primary malignant neoplasm of female breast"3870 ;G("node16rk1fgdvx11687","code")="snomed:8517006" 3879 3871 "RTN","C0SPROB",161,0) 3880 ;G("node16rk1fgdvx11 578","rdf:type")="sp:CodedValue"3872 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" 3881 3873 "RTN","C0SPROB",162,0) 3882 ;G("node16rk1fgdvx11687"," code")="snomed:8517006"3874 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" 3883 3875 "RTN","C0SPROB",163,0) 3884 ;G("node16rk1fgdvx11 687","dcterms:title")="History of tobacco use"3876 ;G("node16rk1fgdvx11716","code")="snomed:55822004" 3885 3877 "RTN","C0SPROB",164,0) 3886 ;G("node16rk1fgdvx11 687","rdf:type")="sp:CodedValue"3878 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" 3887 3879 "RTN","C0SPROB",165,0) 3888 ;G("node16rk1fgdvx11716"," code")="snomed:55822004"3880 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" 3889 3881 "RTN","C0SPROB",166,0) 3890 ;G(" node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"3882 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" 3891 3883 "RTN","C0SPROB",167,0) 3892 ;G(" node16rk1fgdvx11716","rdf:type")="sp:CodedValue"3884 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" 3893 3885 "RTN","C0SPROB",168,0) 3894 ;G("smart:1577780/problems/69560e4721e1"," belongsTo")="smart:1577780"3886 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" 3895 3887 "RTN","C0SPROB",169,0) 3896 ;G("smart:1577780/problems/69560e4721e1"," problemName")="node16rk1fgdvx11089"3888 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" 3897 3889 "RTN","C0SPROB",170,0) 3898 ;G("smart:1577780/problems/ 69560e4721e1","rdf:type")="sp:Problem"3890 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" 3899 3891 "RTN","C0SPROB",171,0) 3900 ;G("smart:1577780/problems/ 69560e4721e1","startDate")="2005-08-02"3892 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" 3901 3893 "RTN","C0SPROB",172,0) 3902 ;G("smart:1577780/problems/06ef10c4e92c"," belongsTo")="smart:1577780"3894 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" 3903 3895 "RTN","C0SPROB",173,0) 3904 ;G("smart:1577780/problems/06ef10c4e92c"," problemName")="node16rk1fgdvx11051"3896 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" 3905 3897 "RTN","C0SPROB",174,0) 3906 ;G("smart:1577780/problems/ 06ef10c4e92c","rdf:type")="sp:Problem"3898 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" 3907 3899 "RTN","C0SPROB",175,0) 3908 ;G("smart:1577780/problems/ 06ef10c4e92c","startDate")="2006-02-20"3900 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" 3909 3901 "RTN","C0SPROB",176,0) 3910 ;G("smart:1577780/problems/9894ba9dfe5a"," belongsTo")="smart:1577780"3902 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" 3911 3903 "RTN","C0SPROB",177,0) 3912 ;G("smart:1577780/problems/9894ba9dfe5a"," problemName")="node16rk1fgdvx11578"3904 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" 3913 3905 "RTN","C0SPROB",178,0) 3914 ;G("smart:1577780/problems/ 9894ba9dfe5a","rdf:type")="sp:Problem"3906 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" 3915 3907 "RTN","C0SPROB",179,0) 3916 ;G("smart:1577780/problems/ 9894ba9dfe5a","startDate")="2005-08-22"3908 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" 3917 3909 "RTN","C0SPROB",180,0) 3918 ;G("smart:1577780/problems/c109aa7a0675"," belongsTo")="smart:1577780"3910 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" 3919 3911 "RTN","C0SPROB",181,0) 3920 ;G("smart:1577780/problems/c109aa7a0675"," problemName")="node16rk1fgdvx11558"3912 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" 3921 3913 "RTN","C0SPROB",182,0) 3922 ;G("smart:1577780/problems/ c109aa7a0675","rdf:type")="sp:Problem"3914 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" 3923 3915 "RTN","C0SPROB",183,0) 3924 ;G("smart:1577780/problems/ c109aa7a0675","startDate")="2005-09-22"3916 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" 3925 3917 "RTN","C0SPROB",184,0) 3926 ;G("smart:1577780/problems/1c50100614a2"," belongsTo")="smart:1577780"3918 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" 3927 3919 "RTN","C0SPROB",185,0) 3928 ;G("smart:1577780/problems/1c50100614a2"," problemName")="node16rk1fgdvx11073"3920 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" 3929 3921 "RTN","C0SPROB",186,0) 3930 ;G("smart:1577780/problems/ 1c50100614a2","rdf:type")="sp:Problem"3922 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" 3931 3923 "RTN","C0SPROB",187,0) 3932 ;G("smart:1577780/problems/ 1c50100614a2","startDate")="2007-02-21"3924 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" 3933 3925 "RTN","C0SPROB",188,0) 3934 ;G("smart:1577780/problems/083dffb2c4a0"," belongsTo")="smart:1577780"3926 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" 3935 3927 "RTN","C0SPROB",189,0) 3936 ;G("smart:1577780/problems/083dffb2c4a0"," problemName")="node16rk1fgdvx11390"3928 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" 3937 3929 "RTN","C0SPROB",190,0) 3938 ;G("smart:1577780/problems/ 083dffb2c4a0","rdf:type")="sp:Problem"3930 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" 3939 3931 "RTN","C0SPROB",191,0) 3940 ;G("smart:1577780/problems/ 083dffb2c4a0","startDate")="2007-01-07"3932 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" 3941 3933 "RTN","C0SPROB",192,0) 3942 ;G("smart:1577780/problems/762b5639a2d1"," belongsTo")="smart:1577780"3934 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" 3943 3935 "RTN","C0SPROB",193,0) 3944 ;G("smart:1577780/problems/762b5639a2d1"," problemName")="node16rk1fgdvx11687"3936 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" 3945 3937 "RTN","C0SPROB",194,0) 3946 ;G("smart:1577780/problems/ 762b5639a2d1","rdf:type")="sp:Problem"3938 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" 3947 3939 "RTN","C0SPROB",195,0) 3948 ;G("smart:1577780/problems/ 762b5639a2d1","startDate")="2006-02-20"3940 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" 3949 3941 "RTN","C0SPROB",196,0) 3950 ;G("smart:1577780/problems/9dc9053dd6f4"," belongsTo")="smart:1577780"3942 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" 3951 3943 "RTN","C0SPROB",197,0) 3952 ;G("smart:1577780/problems/9dc9053dd6f4"," problemName")="node16rk1fgdvx11716"3944 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" 3953 3945 "RTN","C0SPROB",198,0) 3954 ;G("smart:1577780/problems/ 9dc9053dd6f4","rdf:type")="sp:Problem"3946 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" 3955 3947 "RTN","C0SPROB",199,0) 3956 ;G("smart:1577780/problems/ 9dc9053dd6f4","startDate")="2008-04-08"3948 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" 3957 3949 "RTN","C0SPROB",200,0) 3958 ;G("smart:1577780/problems/e3fe9b7ee552"," belongsTo")="smart:1577780"3950 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" 3959 3951 "RTN","C0SPROB",201,0) 3960 ;G("smart:1577780/problems/e3fe9b7ee552"," problemName")="node16rk1fgdvx10882"3952 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" 3961 3953 "RTN","C0SPROB",202,0) 3962 ;G("smart:1577780/problems/ e3fe9b7ee552","rdf:type")="sp:Problem"3954 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" 3963 3955 "RTN","C0SPROB",203,0) 3964 ;G("smart:1577780/problems/ e3fe9b7ee552","startDate")="2005-10-27"3956 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" 3965 3957 "RTN","C0SPROB",204,0) 3966 ;G("smart:1577780/problems/9933307e8f95"," belongsTo")="smart:1577780"3958 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" 3967 3959 "RTN","C0SPROB",205,0) 3968 ;G("smart:1577780/problems/9933307e8f95"," problemName")="node16rk1fgdvx11351"3960 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" 3969 3961 "RTN","C0SPROB",206,0) 3970 ;G("s mart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"3962 ;G("snomed:188155002","dcterms:identifier")=188155002 3971 3963 "RTN","C0SPROB",207,0) 3972 ;G("s mart:1577780/problems/9933307e8f95","startDate")="2005-08-22"3964 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 3973 3965 "RTN","C0SPROB",208,0) 3974 ;G("snomed:188155002"," dcterms:identifier")=1881550023966 ;G("snomed:188155002","rdf:type")="sp:Code" 3975 3967 "RTN","C0SPROB",209,0) 3976 ;G("snomed:188155002"," dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"3968 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 3977 3969 "RTN","C0SPROB",210,0) 3978 ;G("snomed:1 88155002","rdf:type")="sp:Code"3970 ;G("snomed:195967001","dcterms:identifier")=195967001 3979 3971 "RTN","C0SPROB",211,0) 3980 ;G("snomed:1 88155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"3972 ;G("snomed:195967001","dcterms:title")="Asthma" 3981 3973 "RTN","C0SPROB",212,0) 3982 ;G("snomed:195967001"," dcterms:identifier")=1959670013974 ;G("snomed:195967001","rdf:type")="sp:Code" 3983 3975 "RTN","C0SPROB",213,0) 3984 ;G("snomed:195967001"," dcterms:title")="Asthma"3976 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 3985 3977 "RTN","C0SPROB",214,0) 3986 ;G("snomed: 195967001","rdf:type")="sp:Code"3978 ;G("snomed:254837009","dcterms:identifier")=254837009 3987 3979 "RTN","C0SPROB",215,0) 3988 ;G("snomed: 195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"3980 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" 3989 3981 "RTN","C0SPROB",216,0) 3990 ;G("snomed:254837009"," dcterms:identifier")=2548370093982 ;G("snomed:254837009","rdf:type")="sp:Code" 3991 3983 "RTN","C0SPROB",217,0) 3992 ;G("snomed:254837009"," dcterms:title")="Primary malignant neoplasm of female breast"3984 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 3993 3985 "RTN","C0SPROB",218,0) 3994 ;G("snomed: 254837009","rdf:type")="sp:Code"3986 ;G("snomed:353295004","dcterms:identifier")=353295004 3995 3987 "RTN","C0SPROB",219,0) 3996 ;G("snomed: 254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"3988 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" 3997 3989 "RTN","C0SPROB",220,0) 3998 ;G("snomed:353295004"," dcterms:identifier")=3532950043990 ;G("snomed:353295004","rdf:type")="sp:Code" 3999 3991 "RTN","C0SPROB",221,0) 4000 ;G("snomed:353295004"," dcterms:title")="Toxic diffuse goiter"3992 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4001 3993 "RTN","C0SPROB",222,0) 4002 ;G("snomed:3 53295004","rdf:type")="sp:Code"3994 ;G("snomed:38341003","dcterms:identifier")=38341003 4003 3995 "RTN","C0SPROB",223,0) 4004 ;G("snomed:3 53295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"3996 ;G("snomed:38341003","dcterms:title")="Essential hypertension" 4005 3997 "RTN","C0SPROB",224,0) 4006 ;G("snomed:38341003"," dcterms:identifier")=383410033998 ;G("snomed:38341003","rdf:type")="sp:Code" 4007 3999 "RTN","C0SPROB",225,0) 4008 ;G("snomed:38341003"," dcterms:title")="Essential hypertension"4000 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4009 4001 "RTN","C0SPROB",226,0) 4010 ;G("snomed: 38341003","rdf:type")="sp:Code"4002 ;G("snomed:40930008","dcterms:identifier")=40930008 4011 4003 "RTN","C0SPROB",227,0) 4012 ;G("snomed: 38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4004 ;G("snomed:40930008","dcterms:title")="Hypothyroidism" 4013 4005 "RTN","C0SPROB",228,0) 4014 ;G("snomed:40930008"," dcterms:identifier")=409300084006 ;G("snomed:40930008","rdf:type")="sp:Code" 4015 4007 "RTN","C0SPROB",229,0) 4016 ;G("snomed:40930008"," dcterms:title")="Hypothyroidism"4008 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4017 4009 "RTN","C0SPROB",230,0) 4018 ;G("snomed:4 0930008","rdf:type")="sp:Code"4010 ;G("snomed:44054006","dcterms:identifier")=44054006 4019 4011 "RTN","C0SPROB",231,0) 4020 ;G("snomed:4 0930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4012 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" 4021 4013 "RTN","C0SPROB",232,0) 4022 ;G("snomed:44054006"," dcterms:identifier")=440540064014 ;G("snomed:44054006","rdf:type")="sp:Code" 4023 4015 "RTN","C0SPROB",233,0) 4024 ;G("snomed:44054006"," dcterms:title")="Diabetes mellitus type 2"4016 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4025 4017 "RTN","C0SPROB",234,0) 4026 ;G("snomed: 44054006","rdf:type")="sp:Code"4018 ;G("snomed:54302000","dcterms:identifier")=54302000 4027 4019 "RTN","C0SPROB",235,0) 4028 ;G("snomed: 44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4020 ;G("snomed:54302000","dcterms:title")="Disorder of breast" 4029 4021 "RTN","C0SPROB",236,0) 4030 ;G("snomed:54302000"," dcterms:identifier")=543020004022 ;G("snomed:54302000","rdf:type")="sp:Code" 4031 4023 "RTN","C0SPROB",237,0) 4032 ;G("snomed:54302000"," dcterms:title")="Disorder of breast"4024 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4033 4025 "RTN","C0SPROB",238,0) 4034 ;G("snomed:5 4302000","rdf:type")="sp:Code"4026 ;G("snomed:55822004","dcterms:identifier")=55822004 4035 4027 "RTN","C0SPROB",239,0) 4036 ;G("snomed:5 4302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4028 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" 4037 4029 "RTN","C0SPROB",240,0) 4038 ;G("snomed:55822004"," dcterms:identifier")=558220044030 ;G("snomed:55822004","rdf:type")="sp:Code" 4039 4031 "RTN","C0SPROB",241,0) 4040 ;G("snomed:55822004"," dcterms:title")="Hyperlipidemia"4032 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4041 4033 "RTN","C0SPROB",242,0) 4042 ;G("snomed: 55822004","rdf:type")="sp:Code"4034 ;G("snomed:8517006","dcterms:identifier")=8517006 4043 4035 "RTN","C0SPROB",243,0) 4044 ;G("snomed: 55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4036 ;G("snomed:8517006","dcterms:title")="History of tobacco use" 4045 4037 "RTN","C0SPROB",244,0) 4046 ;G("snomed:8517006"," dcterms:identifier")=85170064038 ;G("snomed:8517006","rdf:type")="sp:Code" 4047 4039 "RTN","C0SPROB",245,0) 4048 ;G("snomed:8517006"," dcterms:title")="History of tobacco use"4040 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" 4049 4041 "RTN","C0SPROB",246,0) 4050 ;G("snomed:8517006","rdf:type")="sp:Code"4042 4051 4043 "RTN","C0SPROB",247,0) 4052 ; G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"4044 ; 4053 4045 "RTN","C0SPROB",248,0) 4054 4046 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 4055 4047 "RTN","C0SPROB",249,0) 4056 ; 4048 ; is the return name of the graph created. "" if none 4057 4049 "RTN","C0SPROB",250,0) 4058 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 4050 ; C0SARY is passed in by reference and is the NHIN array of problems 4059 4051 "RTN","C0SPROB",251,0) 4060 ; is the return name of the graph created. "" if none4052 ; 4061 4053 "RTN","C0SPROB",252,0) 4062 ; C0SARY is passed in by reference and is the NHIN array of problems4054 I $O(C0SARY("problem",""))="" D Q ; 4063 4055 "RTN","C0SPROB",253,0) 4064 ;4056 . I $D(DEBUG) W !,"No Problems" 4065 4057 "RTN","C0SPROB",254,0) 4066 I $O(C0SARY("problem",""))="" D Q ;4058 S GRTN="" ; default to no problems 4067 4059 "RTN","C0SPROB",255,0) 4068 . I $D(DEBUG) W !,"No Problems"4060 N C0SGRF 4069 4061 "RTN","C0SPROB",256,0) 4070 S GRTN="" ; default to no problems4062 S C0SGRF="vistaSmart:"_ZPATID_"/problems" 4071 4063 "RTN","C0SPROB",257,0) 4072 NC0SGRF4064 I $D(DEBUG) W !,"Processing ",C0SGRF 4073 4065 "RTN","C0SPROB",258,0) 4074 S C0SGRF="vistaSmart:"_ZPATID_"/problems"4066 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 4075 4067 "RTN","C0SPROB",259,0) 4076 I $D(DEBUG) W !,"Processing ",C0SGRF4068 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 4077 4069 "RTN","C0SPROB",260,0) 4078 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph4070 N FARY S FARY="C0XFARY" 4079 4071 "RTN","C0SPROB",261,0) 4080 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use4072 D USEFARY^C0XF2N(FARY) 4081 4073 "RTN","C0SPROB",262,0) 4082 N FARY S FARY="C0XFARY"4074 D VOCINIT^C0XUTIL 4083 4075 "RTN","C0SPROB",263,0) 4084 D USEFARY^C0XF2N(FARY)4076 ; 4085 4077 "RTN","C0SPROB",264,0) 4086 D VOCINIT^C0XUTIL4078 D STARTADD^C0XF2N ; initialize to create triples 4087 4079 "RTN","C0SPROB",265,0) 4088 4080 ; 4089 4081 "RTN","C0SPROB",266,0) 4090 D STARTADD^C0XF2N ; initialize to create triples4082 N ZI S ZI="" 4091 4083 "RTN","C0SPROB",267,0) 4092 ;4084 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; 4093 4085 "RTN","C0SPROB",268,0) 4094 N ZI S ZI=""4086 . N LRN,ZR ; ZR is the local array for building the new triples 4095 4087 "RTN","C0SPROB",269,0) 4096 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ;4088 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result 4097 4089 "RTN","C0SPROB",270,0) 4098 . N LRN,ZR ; ZR is the local array for building the new triples4090 . ; 4099 4091 "RTN","C0SPROB",271,0) 4100 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result4092 . N PROBID ; unique Id for this problem 4101 4093 "RTN","C0SPROB",272,0) 4094 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 4095 "RTN","C0SPROB",273,0) 4102 4096 . ; 4103 "RTN","C0SPROB",273,0)4104 . N PROBID ; unique Id for this problem4105 4097 "RTN","C0SPROB",274,0) 4106 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number4098 . ; i don't like this because the same problems gets a 4107 4099 "RTN","C0SPROB",275,0) 4100 . ; different ID every time it's reported. Can't trace it back to VistA 4101 "RTN","C0SPROB",276,0) 4102 . ; I'd rather be using id@value ie "id@value")="118" 4103 "RTN","C0SPROB",277,0) 4108 4104 . ; 4109 "RTN","C0SPROB",276,0)4110 . ; i don't like this because the same problems gets a4111 "RTN","C0SPROB",277,0)4112 . ; different ID every time it's reported. Can't trace it back to VistA4113 4105 "RTN","C0SPROB",278,0) 4114 . ; I'd rather be using id@value ie "id@value")="118"4106 . N SNOMED S SNOMED=$G(@LRN@("icd@value")) 4115 4107 "RTN","C0SPROB",279,0) 4108 . N SNOGRF S SNOGRF="snomed:"_SNOMED 4109 "RTN","C0SPROB",280,0) 4110 . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) 4111 "RTN","C0SPROB",281,0) 4112 . I $D(DEBUG) D ; 4113 "RTN","C0SPROB",282,0) 4114 . . W !,"Processing Problem List ",PROBID 4115 "RTN","C0SPROB",283,0) 4116 . . W !,"problem: ",SNOTIT 4117 "RTN","C0SPROB",284,0) 4118 . . W !,"code: ",SNOMED 4119 "RTN","C0SPROB",285,0) 4116 4120 . ; 4117 "RTN","C0SPROB",280,0)4118 . N SNOMED S SNOMED=$G(@LRN@("icd@value"))4119 "RTN","C0SPROB",281,0)4120 . N SNOGRF S SNOGRF="snomed:"_SNOMED4121 "RTN","C0SPROB",282,0)4122 . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))4123 "RTN","C0SPROB",283,0)4124 . I $D(DEBUG) D ;4125 "RTN","C0SPROB",284,0)4126 . . W !,"Processing Problem List ",PROBID4127 "RTN","C0SPROB",285,0)4128 . . W !,"problem: ",SNOTIT4129 4121 "RTN","C0SPROB",286,0) 4130 . . W !,"code: ",SNOMED4122 . ; first do the base result graph 4131 4123 "RTN","C0SPROB",287,0) 4132 4124 . ; 4133 4125 "RTN","C0SPROB",288,0) 4134 . ; first do the base result graph4126 . S ZR("rdf:type")="sp:Problem" 4135 4127 "RTN","C0SPROB",289,0) 4128 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems 4129 "RTN","C0SPROB",290,0) 4130 . ; ie /vista/smart/99912345/problems 4131 "RTN","C0SPROB",291,0) 4136 4132 . ; 4137 "RTN","C0SPROB",290,0)4138 . S ZR("rdf:type")="sp:Problem"4139 "RTN","C0SPROB",291,0)4140 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems4141 4133 "RTN","C0SPROB",292,0) 4142 . ; ie /vista/smart/99912345/problems4134 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name 4143 4135 "RTN","C0SPROB",293,0) 4136 . S ZR("sp:problemName")=PROBNAME 4137 "RTN","C0SPROB",294,0) 4144 4138 . ; 4145 "RTN","C0SPROB",294,0)4146 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name4147 4139 "RTN","C0SPROB",295,0) 4148 . S ZR("sp:problemName")=PROBNAME4140 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) 4149 4141 "RTN","C0SPROB",296,0) 4142 . S ZR("sp:startDate")=STARTDT 4143 "RTN","C0SPROB",297,0) 4150 4144 . ; 4151 "RTN","C0SPROB",297,0)4152 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))4153 4145 "RTN","C0SPROB",298,0) 4154 . S ZR("sp:startDate")=STARTDT4146 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples 4155 4147 "RTN","C0SPROB",299,0) 4148 . K ZR ; clean up 4149 "RTN","C0SPROB",300,0) 4156 4150 . ; 4157 "RTN","C0SPROB",300,0)4158 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples4159 4151 "RTN","C0SPROB",301,0) 4160 . K ZR ; clean up4152 . ; create the problemName graph 4161 4153 "RTN","C0SPROB",302,0) 4162 4154 . ; 4163 4155 "RTN","C0SPROB",303,0) 4164 . ; create the problemName graph4156 . S ZR("rdf:type")="sp:CodedValue" 4165 4157 "RTN","C0SPROB",304,0) 4158 . S ZR("sp:code")="snomed:"_SNOMED 4159 "RTN","C0SPROB",305,0) 4160 . S ZR("dcterms:title")=$G(@LRN@("name@value")) 4161 "RTN","C0SPROB",306,0) 4162 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) 4163 "RTN","C0SPROB",307,0) 4164 . K ZR 4165 "RTN","C0SPROB",308,0) 4166 4166 . ; 4167 "RTN","C0SPROB",305,0)4168 . S ZR("rdf:type")="sp:CodedValue"4169 "RTN","C0SPROB",306,0)4170 . S ZR("sp:code")="snomed:"_SNOMED4171 "RTN","C0SPROB",307,0)4172 . S ZR("dcterms:title")=$G(@LRN@("name@value"))4173 "RTN","C0SPROB",308,0)4174 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)4175 4167 "RTN","C0SPROB",309,0) 4168 . ; create snomed graph 4169 "RTN","C0SPROB",310,0) 4170 . ; 4171 "RTN","C0SPROB",311,0) 4172 . S ZR("rdf:type")="sp:Code" 4173 "RTN","C0SPROB",312,0) 4174 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4175 "RTN","C0SPROB",313,0) 4176 . S ZR("dcterms:identifier")=SNOMED 4177 "RTN","C0SPROB",314,0) 4178 . S ZR("dcterms:title")=SNOTIT 4179 "RTN","C0SPROB",315,0) 4180 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) 4181 "RTN","C0SPROB",316,0) 4176 4182 . K ZR 4177 "RTN","C0SPROB",31 0,0)4183 "RTN","C0SPROB",317,0) 4178 4184 . ; 4179 "RTN","C0SPROB",311,0)4180 . ; create snomed graph4181 "RTN","C0SPROB",312,0)4182 . ;4183 "RTN","C0SPROB",313,0)4184 . S ZR("rdf:type")="sp:Code"4185 "RTN","C0SPROB",314,0)4186 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"4187 "RTN","C0SPROB",315,0)4188 . S ZR("dcterms:identifier")=SNOMED4189 "RTN","C0SPROB",316,0)4190 . S ZR("dcterms:title")=SNOTIT4191 "RTN","C0SPROB",317,0)4192 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)4193 4185 "RTN","C0SPROB",318,0) 4194 . K ZR4186 D BULKLOAD^C0XF2N(.C0XFDA) 4195 4187 "RTN","C0SPROB",319,0) 4196 . ;4188 S GRTN=C0SGRF 4197 4189 "RTN","C0SPROB",320,0) 4198 D BULKLOAD^C0XF2N(.C0XFDA)4190 Q 4199 4191 "RTN","C0SPROB",321,0) 4200 S GRTN=C0SGRF4201 "RTN","C0SPROB",322,0)4202 Q4203 "RTN","C0SPROB",323,0)4204 4192 ; 4205 4193 "RTN","C0SPROB2") 4206 0^10^B67 5948744194 0^10^B67175408 4207 4195 "RTN","C0SPROB2",1,0) 4208 4196 C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 4209 4197 "RTN","C0SPROB2",2,0) 4210 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 54198 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 4211 4199 "RTN","C0SPROB2",3,0) 4212 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU4200 ;Copyright 2012 George Lilly. 4213 4201 "RTN","C0SPROB2",4,0) 4214 ; General Public License See attached copy of the License.4202 ; 4215 4203 "RTN","C0SPROB2",5,0) 4216 ; 4204 ; This program is free software: you can redistribute it and/or modify 4217 4205 "RTN","C0SPROB2",6,0) 4218 ; This program is free software; you can redistribute it and/or modify4206 ; it under the terms of the GNU Affero General Public License as 4219 4207 "RTN","C0SPROB2",7,0) 4220 ; it under the terms of the GNU General Public License as published by4208 ; published by the Free Software Foundation, either version 3 of the 4221 4209 "RTN","C0SPROB2",8,0) 4222 ; the Free Software Foundation; either version 2 of the License, or4210 ; License, or (at your option) any later version. 4223 4211 "RTN","C0SPROB2",9,0) 4224 ; (at your option) any later version.4212 ; 4225 4213 "RTN","C0SPROB2",10,0) 4226 ; 4214 ; This program is distributed in the hope that it will be useful, 4227 4215 "RTN","C0SPROB2",11,0) 4228 ; This program is distributed in the hope that it will be useful,4216 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 4229 4217 "RTN","C0SPROB2",12,0) 4230 ; but WITHOUT ANY WARRANTY; without even the implied warranty of4218 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 4231 4219 "RTN","C0SPROB2",13,0) 4232 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the4220 ; GNU Affero General Public License for more details. 4233 4221 "RTN","C0SPROB2",14,0) 4234 ; GNU General Public License for more details.4222 ; 4235 4223 "RTN","C0SPROB2",15,0) 4236 ; 4224 ; You should have received a copy of the GNU Affero General Public License 4237 4225 "RTN","C0SPROB2",16,0) 4238 ; You should have received a copy of the GNU General Public License along4226 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 4239 4227 "RTN","C0SPROB2",17,0) 4240 ; with this program; if not, write to the Free Software Foundation, Inc.,4228 ; 4241 4229 "RTN","C0SPROB2",18,0) 4242 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.4230 Q 4243 4231 "RTN","C0SPROB2",19,0) 4244 4232 ; 4245 4233 "RTN","C0SPROB2",20,0) 4246 Q4234 ; sample VistA NHIN problem list 4247 4235 "RTN","C0SPROB2",21,0) 4248 4236 ; 4249 4237 "RTN","C0SPROB2",22,0) 4250 ; sample VistA NHIN problem list4238 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" 4251 4239 "RTN","C0SPROB2",23,0) 4252 ; 4240 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 4253 4241 "RTN","C0SPROB2",24,0) 4254 ;^TMP("C0STBL",91,"problem",1," acuity@value")="C"4242 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 4255 4243 "RTN","C0SPROB2",25,0) 4256 ;^TMP("C0STBL",91,"problem",1," entered@value")=31105314244 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" 4257 4245 "RTN","C0SPROB2",26,0) 4258 ;^TMP("C0STBL",91,"problem",1," facility@code")=1004246 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 4259 4247 "RTN","C0SPROB2",27,0) 4260 ;^TMP("C0STBL",91,"problem",1," facility@name")="VOE OFFICE INSTITUTION"4248 ;^TMP("C0STBL",91,"problem",1,"id@value")=100 4261 4249 "RTN","C0SPROB2",28,0) 4262 ;^TMP("C0STBL",91,"problem",1," icd@value")=414.94250 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" 4263 4251 "RTN","C0SPROB2",29,0) 4264 ;^TMP("C0STBL",91,"problem",1," id@value")=1004252 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" 4265 4253 "RTN","C0SPROB2",30,0) 4266 ;^TMP("C0STBL",91,"problem",1," location@value")="DR OFFICE"4254 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 4267 4255 "RTN","C0SPROB2",31,0) 4268 ;^TMP("C0STBL",91,"problem",1," name@value")="Coronary Artery Disease"4256 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 4269 4257 "RTN","C0SPROB2",32,0) 4270 ;^TMP("C0STBL",91,"problem",1," onset@value")=31002014258 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" 4271 4259 "RTN","C0SPROB2",33,0) 4272 ;^TMP("C0STBL",91,"problem",1," provider@code")=634260 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 4273 4261 "RTN","C0SPROB2",34,0) 4274 ;^TMP("C0STBL",91,"problem",1," provider@name")="KING,MATTHEW MICHAEL"4262 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 4275 4263 "RTN","C0SPROB2",35,0) 4276 ;^TMP("C0STBL",91,"problem",1," removed@value")=04264 ;^TMP("C0STBL",91,"problem",1,"status@value")="A" 4277 4265 "RTN","C0SPROB2",36,0) 4278 ;^TMP("C0STBL",91,"problem",1," sc@value")=04266 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 4279 4267 "RTN","C0SPROB2",37,0) 4280 ;^TMP("C0STBL",91,"problem",1," status@value")="A"4268 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 4281 4269 "RTN","C0SPROB2",38,0) 4282 ;^TMP("C0STBL",91,"problem", 1,"unverified@value")=04270 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" 4283 4271 "RTN","C0SPROB2",39,0) 4284 ;^TMP("C0STBL",91,"problem", 1,"updated@value")=31105314272 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 4285 4273 "RTN","C0SPROB2",40,0) 4286 ;^TMP("C0STBL",91,"problem",2," acuity@value")="C"4274 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 4287 4275 "RTN","C0SPROB2",41,0) 4288 ;^TMP("C0STBL",91,"problem",2," entered@value")=31106024276 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" 4289 4277 "RTN","C0SPROB2",42,0) 4290 ;^TMP("C0STBL",91,"problem",2," facility@code")=1004278 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 4291 4279 "RTN","C0SPROB2",43,0) 4292 ;^TMP("C0STBL",91,"problem",2," facility@name")="VOE OFFICE INSTITUTION"4280 ;^TMP("C0STBL",91,"problem",2,"id@value")=108 4293 4281 "RTN","C0SPROB2",44,0) 4294 ;^TMP("C0STBL",91,"problem",2," icd@value")=780.24282 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" 4295 4283 "RTN","C0SPROB2",45,0) 4296 ;^TMP("C0STBL",91,"problem",2," id@value")=1084284 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 4297 4285 "RTN","C0SPROB2",46,0) 4298 ;^TMP("C0STBL",91,"problem",2," name@value")="Syncope and collapse"4286 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 4299 4287 "RTN","C0SPROB2",47,0) 4300 ;^TMP("C0STBL",91,"problem",2," onset@value")=31101024288 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" 4301 4289 "RTN","C0SPROB2",48,0) 4302 ;^TMP("C0STBL",91,"problem",2," provider@code")=634290 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 4303 4291 "RTN","C0SPROB2",49,0) 4304 ;^TMP("C0STBL",91,"problem",2," provider@name")="KING,MATTHEW MICHAEL"4292 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 4305 4293 "RTN","C0SPROB2",50,0) 4306 ;^TMP("C0STBL",91,"problem",2," removed@value")=04294 ;^TMP("C0STBL",91,"problem",2,"status@value")="A" 4307 4295 "RTN","C0SPROB2",51,0) 4308 ;^TMP("C0STBL",91,"problem",2," sc@value")=04296 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 4309 4297 "RTN","C0SPROB2",52,0) 4310 ;^TMP("C0STBL",91,"problem",2," status@value")="A"4298 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 4311 4299 "RTN","C0SPROB2",53,0) 4312 ;^TMP("C0STBL",91,"problem", 2,"unverified@value")=04300 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" 4313 4301 "RTN","C0SPROB2",54,0) 4314 ;^TMP("C0STBL",91,"problem", 2,"updated@value")=31106024302 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 4315 4303 "RTN","C0SPROB2",55,0) 4316 ;^TMP("C0STBL",91,"problem",3," acuity@value")="C"4304 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 4317 4305 "RTN","C0SPROB2",56,0) 4318 ;^TMP("C0STBL",91,"problem",3," entered@value")=31106024306 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" 4319 4307 "RTN","C0SPROB2",57,0) 4320 ;^TMP("C0STBL",91,"problem",3," facility@code")=1004308 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 4321 4309 "RTN","C0SPROB2",58,0) 4322 ;^TMP("C0STBL",91,"problem",3," facility@name")="VOE OFFICE INSTITUTION"4310 ;^TMP("C0STBL",91,"problem",3,"id@value")=109 4323 4311 "RTN","C0SPROB2",59,0) 4324 ;^TMP("C0STBL",91,"problem",3," icd@value")=433.914312 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" 4325 4313 "RTN","C0SPROB2",60,0) 4326 ;^TMP("C0STBL",91,"problem",3," id@value")=1094314 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 4327 4315 "RTN","C0SPROB2",61,0) 4328 ;^TMP("C0STBL",91,"problem",3," name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"4316 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 4329 4317 "RTN","C0SPROB2",62,0) 4330 ;^TMP("C0STBL",91,"problem",3," onset@value")=31001014318 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" 4331 4319 "RTN","C0SPROB2",63,0) 4332 ;^TMP("C0STBL",91,"problem",3," provider@code")=634320 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 4333 4321 "RTN","C0SPROB2",64,0) 4334 ;^TMP("C0STBL",91,"problem",3," provider@name")="KING,MATTHEW MICHAEL"4322 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 4335 4323 "RTN","C0SPROB2",65,0) 4336 ;^TMP("C0STBL",91,"problem",3," removed@value")=04324 ;^TMP("C0STBL",91,"problem",3,"status@value")="A" 4337 4325 "RTN","C0SPROB2",66,0) 4338 ;^TMP("C0STBL",91,"problem",3," sc@value")=04326 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 4339 4327 "RTN","C0SPROB2",67,0) 4340 ;^TMP("C0STBL",91,"problem",3," status@value")="A"4328 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 4341 4329 "RTN","C0SPROB2",68,0) 4342 ;^TMP("C0STBL",91,"problem", 3,"unverified@value")=04330 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 4343 4331 "RTN","C0SPROB2",69,0) 4344 ;^TMP("C0STBL",91,"problem", 3,"updated@value")=31106024332 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 4345 4333 "RTN","C0SPROB2",70,0) 4346 ;^TMP("C0STBL",91,"problem",4," entered@value")=31106034334 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" 4347 4335 "RTN","C0SPROB2",71,0) 4348 ;^TMP("C0STBL",91,"problem",4," facility@code")=1004336 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" 4349 4337 "RTN","C0SPROB2",72,0) 4350 ;^TMP("C0STBL",91,"problem",4," facility@name")="VOE OFFICE INSTITUTION"4338 ;^TMP("C0STBL",91,"problem",4,"id@value")=115 4351 4339 "RTN","C0SPROB2",73,0) 4352 ;^TMP("C0STBL",91,"problem",4," icd@value")="00.66"4340 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" 4353 4341 "RTN","C0SPROB2",74,0) 4354 ;^TMP("C0STBL",91,"problem",4," id@value")=1154342 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" 4355 4343 "RTN","C0SPROB2",75,0) 4356 ;^TMP("C0STBL",91,"problem",4," location@value")="DR OFFICE"4344 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 4357 4345 "RTN","C0SPROB2",76,0) 4358 ;^TMP("C0STBL",91,"problem",4," name@value")="00.66"4346 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" 4359 4347 "RTN","C0SPROB2",77,0) 4360 ;^TMP("C0STBL",91,"problem",4," provider@code")=634348 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 4361 4349 "RTN","C0SPROB2",78,0) 4362 ;^TMP("C0STBL",91,"problem",4," provider@name")="KING,MATTHEW MICHAEL"4350 ;^TMP("C0STBL",91,"problem",4,"status@value")="A" 4363 4351 "RTN","C0SPROB2",79,0) 4364 ;^TMP("C0STBL",91,"problem",4," removed@value")=04352 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 4365 4353 "RTN","C0SPROB2",80,0) 4366 ;^TMP("C0STBL",91,"problem",4," status@value")="A"4354 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 4367 4355 "RTN","C0SPROB2",81,0) 4368 ;^TMP("C0STBL",91,"problem", 4,"unverified@value")=04356 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 4369 4357 "RTN","C0SPROB2",82,0) 4370 ;^TMP("C0STBL",91,"problem", 4,"updated@value")=31106034358 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 4371 4359 "RTN","C0SPROB2",83,0) 4372 ;^TMP("C0STBL",91,"problem",5," entered@value")=31106034360 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" 4373 4361 "RTN","C0SPROB2",84,0) 4374 ;^TMP("C0STBL",91,"problem",5," facility@code")=1004362 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 4375 4363 "RTN","C0SPROB2",85,0) 4376 ;^TMP("C0STBL",91,"problem",5," facility@name")="VOE OFFICE INSTITUTION"4364 ;^TMP("C0STBL",91,"problem",5,"id@value")=116 4377 4365 "RTN","C0SPROB2",86,0) 4378 ;^TMP("C0STBL",91,"problem",5," icd@value")=37.214366 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" 4379 4367 "RTN","C0SPROB2",87,0) 4380 ;^TMP("C0STBL",91,"problem",5," id@value")=1164368 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 4381 4369 "RTN","C0SPROB2",88,0) 4382 ;^TMP("C0STBL",91,"problem",5," location@value")="DR OFFICE"4370 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 4383 4371 "RTN","C0SPROB2",89,0) 4384 ;^TMP("C0STBL",91,"problem",5," name@value")=37.214372 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" 4385 4373 "RTN","C0SPROB2",90,0) 4386 ;^TMP("C0STBL",91,"problem",5," provider@code")=634374 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 4387 4375 "RTN","C0SPROB2",91,0) 4388 ;^TMP("C0STBL",91,"problem",5," provider@name")="KING,MATTHEW MICHAEL"4376 ;^TMP("C0STBL",91,"problem",5,"status@value")="A" 4389 4377 "RTN","C0SPROB2",92,0) 4390 ;^TMP("C0STBL",91,"problem",5," removed@value")=04378 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 4391 4379 "RTN","C0SPROB2",93,0) 4392 ;^TMP("C0STBL",91,"problem",5," status@value")="A"4380 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 4393 4381 "RTN","C0SPROB2",94,0) 4394 ;^TMP("C0STBL",91,"problem", 5,"unverified@value")=04382 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 4395 4383 "RTN","C0SPROB2",95,0) 4396 ;^TMP("C0STBL",91,"problem", 5,"updated@value")=31106034384 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 4397 4385 "RTN","C0SPROB2",96,0) 4398 ;^TMP("C0STBL",91,"problem",6," entered@value")=31106034386 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" 4399 4387 "RTN","C0SPROB2",97,0) 4400 ;^TMP("C0STBL",91,"problem",6," facility@code")=1004388 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 4401 4389 "RTN","C0SPROB2",98,0) 4402 ;^TMP("C0STBL",91,"problem",6," facility@name")="VOE OFFICE INSTITUTION"4390 ;^TMP("C0STBL",91,"problem",6,"id@value")=117 4403 4391 "RTN","C0SPROB2",99,0) 4404 ;^TMP("C0STBL",91,"problem",6," icd@value")=81.514392 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" 4405 4393 "RTN","C0SPROB2",100,0) 4406 ;^TMP("C0STBL",91,"problem",6," id@value")=1174394 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 4407 4395 "RTN","C0SPROB2",101,0) 4408 ;^TMP("C0STBL",91,"problem",6," location@value")="DR OFFICE"4396 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 4409 4397 "RTN","C0SPROB2",102,0) 4410 ;^TMP("C0STBL",91,"problem",6," name@value")=81.514398 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" 4411 4399 "RTN","C0SPROB2",103,0) 4412 ;^TMP("C0STBL",91,"problem",6," provider@code")=634400 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 4413 4401 "RTN","C0SPROB2",104,0) 4414 ;^TMP("C0STBL",91,"problem",6," provider@name")="KING,MATTHEW MICHAEL"4402 ;^TMP("C0STBL",91,"problem",6,"status@value")="A" 4415 4403 "RTN","C0SPROB2",105,0) 4416 ;^TMP("C0STBL",91,"problem",6," removed@value")=04404 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 4417 4405 "RTN","C0SPROB2",106,0) 4418 ;^TMP("C0STBL",91,"problem",6," status@value")="A"4406 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 4419 4407 "RTN","C0SPROB2",107,0) 4420 ;^TMP("C0STBL",91,"problem", 6,"unverified@value")=04408 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 4421 4409 "RTN","C0SPROB2",108,0) 4422 ;^TMP("C0STBL",91,"problem", 6,"updated@value")=31106034410 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 4423 4411 "RTN","C0SPROB2",109,0) 4424 ;^TMP("C0STBL",91,"problem",7," entered@value")=31106034412 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" 4425 4413 "RTN","C0SPROB2",110,0) 4426 ;^TMP("C0STBL",91,"problem",7," facility@code")=1004414 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 4427 4415 "RTN","C0SPROB2",111,0) 4428 ;^TMP("C0STBL",91,"problem",7," facility@name")="VOE OFFICE INSTITUTION"4416 ;^TMP("C0STBL",91,"problem",7,"id@value")=118 4429 4417 "RTN","C0SPROB2",112,0) 4430 ;^TMP("C0STBL",91,"problem",7," icd@value")=47.094418 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" 4431 4419 "RTN","C0SPROB2",113,0) 4432 ;^TMP("C0STBL",91,"problem",7," id@value")=1184420 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 4433 4421 "RTN","C0SPROB2",114,0) 4434 ;^TMP("C0STBL",91,"problem",7," location@value")="DR OFFICE"4422 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 4435 4423 "RTN","C0SPROB2",115,0) 4436 ;^TMP("C0STBL",91,"problem",7," name@value")=47.094424 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" 4437 4425 "RTN","C0SPROB2",116,0) 4438 ;^TMP("C0STBL",91,"problem",7," provider@code")=634426 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 4439 4427 "RTN","C0SPROB2",117,0) 4440 ;^TMP("C0STBL",91,"problem",7," provider@name")="KING,MATTHEW MICHAEL"4428 ;^TMP("C0STBL",91,"problem",7,"status@value")="A" 4441 4429 "RTN","C0SPROB2",118,0) 4442 ;^TMP("C0STBL",91,"problem",7," removed@value")=04430 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 4443 4431 "RTN","C0SPROB2",119,0) 4444 ;^TMP("C0STBL",91,"problem",7," status@value")="A"4432 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 4445 4433 "RTN","C0SPROB2",120,0) 4446 ;^TMP("C0STBL",91,"problem", 7,"unverified@value")=04434 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 4447 4435 "RTN","C0SPROB2",121,0) 4448 ;^TMP("C0STBL",91,"problem", 7,"updated@value")=31106034436 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 4449 4437 "RTN","C0SPROB2",122,0) 4450 ;^TMP("C0STBL",91,"problem",8," entered@value")=31106034438 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" 4451 4439 "RTN","C0SPROB2",123,0) 4452 ;^TMP("C0STBL",91,"problem",8," facility@code")=1004440 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" 4453 4441 "RTN","C0SPROB2",124,0) 4454 ;^TMP("C0STBL",91,"problem",8," facility@name")="VOE OFFICE INSTITUTION"4442 ;^TMP("C0STBL",91,"problem",8,"id@value")=119 4455 4443 "RTN","C0SPROB2",125,0) 4456 ;^TMP("C0STBL",91,"problem",8," icd@value")="250.00"4444 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" 4457 4445 "RTN","C0SPROB2",126,0) 4458 ;^TMP("C0STBL",91,"problem",8," id@value")=1194446 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," 4459 4447 "RTN","C0SPROB2",127,0) 4460 ;^TMP("C0STBL",91,"problem",8," location@value")="DR OFFICE"4448 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 4461 4449 "RTN","C0SPROB2",128,0) 4462 ;^TMP("C0STBL",91,"problem",8," name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"4450 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" 4463 4451 "RTN","C0SPROB2",129,0) 4464 ;^TMP("C0STBL",91,"problem",8," provider@code")=634452 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 4465 4453 "RTN","C0SPROB2",130,0) 4466 ;^TMP("C0STBL",91,"problem",8," provider@name")="KING,MATTHEW MICHAEL"4454 ;^TMP("C0STBL",91,"problem",8,"status@value")="A" 4467 4455 "RTN","C0SPROB2",131,0) 4468 ;^TMP("C0STBL",91,"problem",8," removed@value")=04456 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 4469 4457 "RTN","C0SPROB2",132,0) 4470 ;^TMP("C0STBL",91,"problem",8," status@value")="A"4458 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 4471 4459 "RTN","C0SPROB2",133,0) 4472 ; ^TMP("C0STBL",91,"problem",8,"unverified@value")=04460 ; 4473 4461 "RTN","C0SPROB2",134,0) 4474 ; ^TMP("C0STBL",91,"problem",8,"updated@value")=31106034462 ; sample Smart lab result triples 4475 4463 "RTN","C0SPROB2",135,0) 4476 4464 ; 4477 4465 "RTN","C0SPROB2",136,0) 4478 ; sample Smart lab result triples4466 ;G("node16rk1fgdvx10882","code")="snomed:40930008" 4479 4467 "RTN","C0SPROB2",137,0) 4480 ; 4468 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" 4481 4469 "RTN","C0SPROB2",138,0) 4482 ;G("node16rk1fgdvx10882"," code")="snomed:40930008"4470 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" 4483 4471 "RTN","C0SPROB2",139,0) 4484 ;G("node16rk1fgdvx1 0882","dcterms:title")="Hypothyroidism"4472 ;G("node16rk1fgdvx11051","code")="snomed:188155002" 4485 4473 "RTN","C0SPROB2",140,0) 4486 ;G("node16rk1fgdvx1 0882","rdf:type")="sp:CodedValue"4474 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 4487 4475 "RTN","C0SPROB2",141,0) 4488 ;G("node16rk1fgdvx11051"," code")="snomed:188155002"4476 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" 4489 4477 "RTN","C0SPROB2",142,0) 4490 ;G("node16rk1fgdvx110 51","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"4478 ;G("node16rk1fgdvx11073","code")="snomed:353295004" 4491 4479 "RTN","C0SPROB2",143,0) 4492 ;G("node16rk1fgdvx110 51","rdf:type")="sp:CodedValue"4480 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" 4493 4481 "RTN","C0SPROB2",144,0) 4494 ;G("node16rk1fgdvx11073"," code")="snomed:353295004"4482 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" 4495 4483 "RTN","C0SPROB2",145,0) 4496 ;G("node16rk1fgdvx110 73","dcterms:title")="Toxic diffuse goiter"4484 ;G("node16rk1fgdvx11089","code")="snomed:54302000" 4497 4485 "RTN","C0SPROB2",146,0) 4498 ;G("node16rk1fgdvx110 73","rdf:type")="sp:CodedValue"4486 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" 4499 4487 "RTN","C0SPROB2",147,0) 4500 ;G("node16rk1fgdvx11089"," code")="snomed:54302000"4488 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" 4501 4489 "RTN","C0SPROB2",148,0) 4502 ;G("node16rk1fgdvx11 089","dcterms:title")="Disorder of breast"4490 ;G("node16rk1fgdvx11351","code")="snomed:38341003" 4503 4491 "RTN","C0SPROB2",149,0) 4504 ;G("node16rk1fgdvx11 089","rdf:type")="sp:CodedValue"4492 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" 4505 4493 "RTN","C0SPROB2",150,0) 4506 ;G("node16rk1fgdvx11351"," code")="snomed:38341003"4494 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" 4507 4495 "RTN","C0SPROB2",151,0) 4508 ;G("node16rk1fgdvx113 51","dcterms:title")="Essential hypertension"4496 ;G("node16rk1fgdvx11390","code")="snomed:44054006" 4509 4497 "RTN","C0SPROB2",152,0) 4510 ;G("node16rk1fgdvx113 51","rdf:type")="sp:CodedValue"4498 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" 4511 4499 "RTN","C0SPROB2",153,0) 4512 ;G("node16rk1fgdvx11390"," code")="snomed:44054006"4500 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" 4513 4501 "RTN","C0SPROB2",154,0) 4514 ;G("node16rk1fgdvx11 390","dcterms:title")="Diabetes mellitus type 2"4502 ;G("node16rk1fgdvx11558","code")="snomed:195967001" 4515 4503 "RTN","C0SPROB2",155,0) 4516 ;G("node16rk1fgdvx11 390","rdf:type")="sp:CodedValue"4504 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" 4517 4505 "RTN","C0SPROB2",156,0) 4518 ;G("node16rk1fgdvx11558"," code")="snomed:195967001"4506 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" 4519 4507 "RTN","C0SPROB2",157,0) 4520 ;G("node16rk1fgdvx115 58","dcterms:title")="Asthma"4508 ;G("node16rk1fgdvx11578","code")="snomed:254837009" 4521 4509 "RTN","C0SPROB2",158,0) 4522 ;G("node16rk1fgdvx115 58","rdf:type")="sp:CodedValue"4510 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" 4523 4511 "RTN","C0SPROB2",159,0) 4524 ;G("node16rk1fgdvx11578"," code")="snomed:254837009"4512 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" 4525 4513 "RTN","C0SPROB2",160,0) 4526 ;G("node16rk1fgdvx11 578","dcterms:title")="Primary malignant neoplasm of female breast"4514 ;G("node16rk1fgdvx11687","code")="snomed:8517006" 4527 4515 "RTN","C0SPROB2",161,0) 4528 ;G("node16rk1fgdvx11 578","rdf:type")="sp:CodedValue"4516 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" 4529 4517 "RTN","C0SPROB2",162,0) 4530 ;G("node16rk1fgdvx11687"," code")="snomed:8517006"4518 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" 4531 4519 "RTN","C0SPROB2",163,0) 4532 ;G("node16rk1fgdvx11 687","dcterms:title")="History of tobacco use"4520 ;G("node16rk1fgdvx11716","code")="snomed:55822004" 4533 4521 "RTN","C0SPROB2",164,0) 4534 ;G("node16rk1fgdvx11 687","rdf:type")="sp:CodedValue"4522 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" 4535 4523 "RTN","C0SPROB2",165,0) 4536 ;G("node16rk1fgdvx11716"," code")="snomed:55822004"4524 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" 4537 4525 "RTN","C0SPROB2",166,0) 4538 ;G(" node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"4526 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" 4539 4527 "RTN","C0SPROB2",167,0) 4540 ;G(" node16rk1fgdvx11716","rdf:type")="sp:CodedValue"4528 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" 4541 4529 "RTN","C0SPROB2",168,0) 4542 ;G("smart:1577780/problems/69560e4721e1"," belongsTo")="smart:1577780"4530 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" 4543 4531 "RTN","C0SPROB2",169,0) 4544 ;G("smart:1577780/problems/69560e4721e1"," problemName")="node16rk1fgdvx11089"4532 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" 4545 4533 "RTN","C0SPROB2",170,0) 4546 ;G("smart:1577780/problems/ 69560e4721e1","rdf:type")="sp:Problem"4534 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" 4547 4535 "RTN","C0SPROB2",171,0) 4548 ;G("smart:1577780/problems/ 69560e4721e1","startDate")="2005-08-02"4536 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" 4549 4537 "RTN","C0SPROB2",172,0) 4550 ;G("smart:1577780/problems/06ef10c4e92c"," belongsTo")="smart:1577780"4538 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" 4551 4539 "RTN","C0SPROB2",173,0) 4552 ;G("smart:1577780/problems/06ef10c4e92c"," problemName")="node16rk1fgdvx11051"4540 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" 4553 4541 "RTN","C0SPROB2",174,0) 4554 ;G("smart:1577780/problems/ 06ef10c4e92c","rdf:type")="sp:Problem"4542 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" 4555 4543 "RTN","C0SPROB2",175,0) 4556 ;G("smart:1577780/problems/ 06ef10c4e92c","startDate")="2006-02-20"4544 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" 4557 4545 "RTN","C0SPROB2",176,0) 4558 ;G("smart:1577780/problems/9894ba9dfe5a"," belongsTo")="smart:1577780"4546 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" 4559 4547 "RTN","C0SPROB2",177,0) 4560 ;G("smart:1577780/problems/9894ba9dfe5a"," problemName")="node16rk1fgdvx11578"4548 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" 4561 4549 "RTN","C0SPROB2",178,0) 4562 ;G("smart:1577780/problems/ 9894ba9dfe5a","rdf:type")="sp:Problem"4550 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" 4563 4551 "RTN","C0SPROB2",179,0) 4564 ;G("smart:1577780/problems/ 9894ba9dfe5a","startDate")="2005-08-22"4552 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" 4565 4553 "RTN","C0SPROB2",180,0) 4566 ;G("smart:1577780/problems/c109aa7a0675"," belongsTo")="smart:1577780"4554 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" 4567 4555 "RTN","C0SPROB2",181,0) 4568 ;G("smart:1577780/problems/c109aa7a0675"," problemName")="node16rk1fgdvx11558"4556 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" 4569 4557 "RTN","C0SPROB2",182,0) 4570 ;G("smart:1577780/problems/ c109aa7a0675","rdf:type")="sp:Problem"4558 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" 4571 4559 "RTN","C0SPROB2",183,0) 4572 ;G("smart:1577780/problems/ c109aa7a0675","startDate")="2005-09-22"4560 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" 4573 4561 "RTN","C0SPROB2",184,0) 4574 ;G("smart:1577780/problems/1c50100614a2"," belongsTo")="smart:1577780"4562 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" 4575 4563 "RTN","C0SPROB2",185,0) 4576 ;G("smart:1577780/problems/1c50100614a2"," problemName")="node16rk1fgdvx11073"4564 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" 4577 4565 "RTN","C0SPROB2",186,0) 4578 ;G("smart:1577780/problems/ 1c50100614a2","rdf:type")="sp:Problem"4566 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" 4579 4567 "RTN","C0SPROB2",187,0) 4580 ;G("smart:1577780/problems/ 1c50100614a2","startDate")="2007-02-21"4568 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" 4581 4569 "RTN","C0SPROB2",188,0) 4582 ;G("smart:1577780/problems/083dffb2c4a0"," belongsTo")="smart:1577780"4570 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" 4583 4571 "RTN","C0SPROB2",189,0) 4584 ;G("smart:1577780/problems/083dffb2c4a0"," problemName")="node16rk1fgdvx11390"4572 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" 4585 4573 "RTN","C0SPROB2",190,0) 4586 ;G("smart:1577780/problems/ 083dffb2c4a0","rdf:type")="sp:Problem"4574 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" 4587 4575 "RTN","C0SPROB2",191,0) 4588 ;G("smart:1577780/problems/ 083dffb2c4a0","startDate")="2007-01-07"4576 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" 4589 4577 "RTN","C0SPROB2",192,0) 4590 ;G("smart:1577780/problems/762b5639a2d1"," belongsTo")="smart:1577780"4578 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" 4591 4579 "RTN","C0SPROB2",193,0) 4592 ;G("smart:1577780/problems/762b5639a2d1"," problemName")="node16rk1fgdvx11687"4580 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" 4593 4581 "RTN","C0SPROB2",194,0) 4594 ;G("smart:1577780/problems/ 762b5639a2d1","rdf:type")="sp:Problem"4582 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" 4595 4583 "RTN","C0SPROB2",195,0) 4596 ;G("smart:1577780/problems/ 762b5639a2d1","startDate")="2006-02-20"4584 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" 4597 4585 "RTN","C0SPROB2",196,0) 4598 ;G("smart:1577780/problems/9dc9053dd6f4"," belongsTo")="smart:1577780"4586 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" 4599 4587 "RTN","C0SPROB2",197,0) 4600 ;G("smart:1577780/problems/9dc9053dd6f4"," problemName")="node16rk1fgdvx11716"4588 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" 4601 4589 "RTN","C0SPROB2",198,0) 4602 ;G("smart:1577780/problems/ 9dc9053dd6f4","rdf:type")="sp:Problem"4590 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" 4603 4591 "RTN","C0SPROB2",199,0) 4604 ;G("smart:1577780/problems/ 9dc9053dd6f4","startDate")="2008-04-08"4592 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" 4605 4593 "RTN","C0SPROB2",200,0) 4606 ;G("smart:1577780/problems/e3fe9b7ee552"," belongsTo")="smart:1577780"4594 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" 4607 4595 "RTN","C0SPROB2",201,0) 4608 ;G("smart:1577780/problems/e3fe9b7ee552"," problemName")="node16rk1fgdvx10882"4596 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" 4609 4597 "RTN","C0SPROB2",202,0) 4610 ;G("smart:1577780/problems/ e3fe9b7ee552","rdf:type")="sp:Problem"4598 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" 4611 4599 "RTN","C0SPROB2",203,0) 4612 ;G("smart:1577780/problems/ e3fe9b7ee552","startDate")="2005-10-27"4600 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" 4613 4601 "RTN","C0SPROB2",204,0) 4614 ;G("smart:1577780/problems/9933307e8f95"," belongsTo")="smart:1577780"4602 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" 4615 4603 "RTN","C0SPROB2",205,0) 4616 ;G("smart:1577780/problems/9933307e8f95"," problemName")="node16rk1fgdvx11351"4604 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" 4617 4605 "RTN","C0SPROB2",206,0) 4618 ;G("s mart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"4606 ;G("snomed:188155002","dcterms:identifier")=188155002 4619 4607 "RTN","C0SPROB2",207,0) 4620 ;G("s mart:1577780/problems/9933307e8f95","startDate")="2005-08-22"4608 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" 4621 4609 "RTN","C0SPROB2",208,0) 4622 ;G("snomed:188155002"," dcterms:identifier")=1881550024610 ;G("snomed:188155002","rdf:type")="sp:Code" 4623 4611 "RTN","C0SPROB2",209,0) 4624 ;G("snomed:188155002"," dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"4612 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4625 4613 "RTN","C0SPROB2",210,0) 4626 ;G("snomed:1 88155002","rdf:type")="sp:Code"4614 ;G("snomed:195967001","dcterms:identifier")=195967001 4627 4615 "RTN","C0SPROB2",211,0) 4628 ;G("snomed:1 88155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4616 ;G("snomed:195967001","dcterms:title")="Asthma" 4629 4617 "RTN","C0SPROB2",212,0) 4630 ;G("snomed:195967001"," dcterms:identifier")=1959670014618 ;G("snomed:195967001","rdf:type")="sp:Code" 4631 4619 "RTN","C0SPROB2",213,0) 4632 ;G("snomed:195967001"," dcterms:title")="Asthma"4620 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4633 4621 "RTN","C0SPROB2",214,0) 4634 ;G("snomed: 195967001","rdf:type")="sp:Code"4622 ;G("snomed:254837009","dcterms:identifier")=254837009 4635 4623 "RTN","C0SPROB2",215,0) 4636 ;G("snomed: 195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4624 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" 4637 4625 "RTN","C0SPROB2",216,0) 4638 ;G("snomed:254837009"," dcterms:identifier")=2548370094626 ;G("snomed:254837009","rdf:type")="sp:Code" 4639 4627 "RTN","C0SPROB2",217,0) 4640 ;G("snomed:254837009"," dcterms:title")="Primary malignant neoplasm of female breast"4628 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4641 4629 "RTN","C0SPROB2",218,0) 4642 ;G("snomed: 254837009","rdf:type")="sp:Code"4630 ;G("snomed:353295004","dcterms:identifier")=353295004 4643 4631 "RTN","C0SPROB2",219,0) 4644 ;G("snomed: 254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4632 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" 4645 4633 "RTN","C0SPROB2",220,0) 4646 ;G("snomed:353295004"," dcterms:identifier")=3532950044634 ;G("snomed:353295004","rdf:type")="sp:Code" 4647 4635 "RTN","C0SPROB2",221,0) 4648 ;G("snomed:353295004"," dcterms:title")="Toxic diffuse goiter"4636 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4649 4637 "RTN","C0SPROB2",222,0) 4650 ;G("snomed:3 53295004","rdf:type")="sp:Code"4638 ;G("snomed:38341003","dcterms:identifier")=38341003 4651 4639 "RTN","C0SPROB2",223,0) 4652 ;G("snomed:3 53295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4640 ;G("snomed:38341003","dcterms:title")="Essential hypertension" 4653 4641 "RTN","C0SPROB2",224,0) 4654 ;G("snomed:38341003"," dcterms:identifier")=383410034642 ;G("snomed:38341003","rdf:type")="sp:Code" 4655 4643 "RTN","C0SPROB2",225,0) 4656 ;G("snomed:38341003"," dcterms:title")="Essential hypertension"4644 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4657 4645 "RTN","C0SPROB2",226,0) 4658 ;G("snomed: 38341003","rdf:type")="sp:Code"4646 ;G("snomed:40930008","dcterms:identifier")=40930008 4659 4647 "RTN","C0SPROB2",227,0) 4660 ;G("snomed: 38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4648 ;G("snomed:40930008","dcterms:title")="Hypothyroidism" 4661 4649 "RTN","C0SPROB2",228,0) 4662 ;G("snomed:40930008"," dcterms:identifier")=409300084650 ;G("snomed:40930008","rdf:type")="sp:Code" 4663 4651 "RTN","C0SPROB2",229,0) 4664 ;G("snomed:40930008"," dcterms:title")="Hypothyroidism"4652 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4665 4653 "RTN","C0SPROB2",230,0) 4666 ;G("snomed:4 0930008","rdf:type")="sp:Code"4654 ;G("snomed:44054006","dcterms:identifier")=44054006 4667 4655 "RTN","C0SPROB2",231,0) 4668 ;G("snomed:4 0930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4656 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" 4669 4657 "RTN","C0SPROB2",232,0) 4670 ;G("snomed:44054006"," dcterms:identifier")=440540064658 ;G("snomed:44054006","rdf:type")="sp:Code" 4671 4659 "RTN","C0SPROB2",233,0) 4672 ;G("snomed:44054006"," dcterms:title")="Diabetes mellitus type 2"4660 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4673 4661 "RTN","C0SPROB2",234,0) 4674 ;G("snomed: 44054006","rdf:type")="sp:Code"4662 ;G("snomed:54302000","dcterms:identifier")=54302000 4675 4663 "RTN","C0SPROB2",235,0) 4676 ;G("snomed: 44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4664 ;G("snomed:54302000","dcterms:title")="Disorder of breast" 4677 4665 "RTN","C0SPROB2",236,0) 4678 ;G("snomed:54302000"," dcterms:identifier")=543020004666 ;G("snomed:54302000","rdf:type")="sp:Code" 4679 4667 "RTN","C0SPROB2",237,0) 4680 ;G("snomed:54302000"," dcterms:title")="Disorder of breast"4668 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4681 4669 "RTN","C0SPROB2",238,0) 4682 ;G("snomed:5 4302000","rdf:type")="sp:Code"4670 ;G("snomed:55822004","dcterms:identifier")=55822004 4683 4671 "RTN","C0SPROB2",239,0) 4684 ;G("snomed:5 4302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4672 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" 4685 4673 "RTN","C0SPROB2",240,0) 4686 ;G("snomed:55822004"," dcterms:identifier")=558220044674 ;G("snomed:55822004","rdf:type")="sp:Code" 4687 4675 "RTN","C0SPROB2",241,0) 4688 ;G("snomed:55822004"," dcterms:title")="Hyperlipidemia"4676 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4689 4677 "RTN","C0SPROB2",242,0) 4690 ;G("snomed: 55822004","rdf:type")="sp:Code"4678 ;G("snomed:8517006","dcterms:identifier")=8517006 4691 4679 "RTN","C0SPROB2",243,0) 4692 ;G("snomed: 55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"4680 ;G("snomed:8517006","dcterms:title")="History of tobacco use" 4693 4681 "RTN","C0SPROB2",244,0) 4694 ;G("snomed:8517006"," dcterms:identifier")=85170064682 ;G("snomed:8517006","rdf:type")="sp:Code" 4695 4683 "RTN","C0SPROB2",245,0) 4696 ;G("snomed:8517006"," dcterms:title")="History of tobacco use"4684 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" 4697 4685 "RTN","C0SPROB2",246,0) 4698 ;G("snomed:8517006","rdf:type")="sp:Code"4686 4699 4687 "RTN","C0SPROB2",247,0) 4700 ; G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"4688 ; 4701 4689 "RTN","C0SPROB2",248,0) 4702 4690 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 4703 4691 "RTN","C0SPROB2",249,0) 4704 ; 4692 ; is the return name of the graph created. "" if none 4705 4693 "RTN","C0SPROB2",250,0) 4706 PROB(GRTN,C0SARY) ; GRTN, passed by reference, 4694 ; C0SARY is passed in by reference and is the NHIN array of problems 4707 4695 "RTN","C0SPROB2",251,0) 4708 ; is the return name of the graph created. "" if none4696 ; 4709 4697 "RTN","C0SPROB2",252,0) 4710 ; C0SARY is passed in by reference and is the NHIN array of problems4698 I $O(C0SARY("problem",""))="" D Q ; 4711 4699 "RTN","C0SPROB2",253,0) 4712 ;4700 . I $D(DEBUG) W !,"No Problems" 4713 4701 "RTN","C0SPROB2",254,0) 4714 I $O(C0SARY("problem",""))="" D Q ;4702 S GRTN="" ; default to no problems 4715 4703 "RTN","C0SPROB2",255,0) 4716 . I $D(DEBUG) W !,"No Problems"4704 N C0SGRF 4717 4705 "RTN","C0SPROB2",256,0) 4718 S GRTN="" ; default to no problems4706 S C0SGRF="vistaSmart:"_ZPATID_"/problems" 4719 4707 "RTN","C0SPROB2",257,0) 4720 NC0SGRF4708 I $D(DEBUG) W !,"Processing ",C0SGRF 4721 4709 "RTN","C0SPROB2",258,0) 4722 S C0SGRF="vistaSmart:"_ZPATID_"/problems"4710 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph 4723 4711 "RTN","C0SPROB2",259,0) 4724 I $D(DEBUG) W !,"Processing ",C0SGRF4712 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use 4725 4713 "RTN","C0SPROB2",260,0) 4726 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph4714 N FARY S FARY="C0XFARY" 4727 4715 "RTN","C0SPROB2",261,0) 4728 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use4716 D USEFARY^C0XF2N(FARY) 4729 4717 "RTN","C0SPROB2",262,0) 4730 N FARY S FARY="C0XFARY"4718 D VOCINIT^C0XUTIL 4731 4719 "RTN","C0SPROB2",263,0) 4732 D USEFARY^C0XF2N(FARY)4720 ; 4733 4721 "RTN","C0SPROB2",264,0) 4734 D VOCINIT^C0XUTIL4722 D STARTADD^C0XF2N ; initialize to create triples 4735 4723 "RTN","C0SPROB2",265,0) 4736 4724 ; 4737 4725 "RTN","C0SPROB2",266,0) 4738 D STARTADD^C0XF2N ; initialize to create triples4726 N ZI S ZI="" 4739 4727 "RTN","C0SPROB2",267,0) 4740 ;4728 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; 4741 4729 "RTN","C0SPROB2",268,0) 4742 N ZI S ZI=""4730 . N LRN,ZR ; ZR is the local array for building the new triples 4743 4731 "RTN","C0SPROB2",269,0) 4744 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ;4732 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result 4745 4733 "RTN","C0SPROB2",270,0) 4746 . N LRN,ZR ; ZR is the local array for building the new triples4734 . ; 4747 4735 "RTN","C0SPROB2",271,0) 4748 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result4736 . N PROBID ; unique Id for this problem 4749 4737 "RTN","C0SPROB2",272,0) 4738 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number 4739 "RTN","C0SPROB2",273,0) 4750 4740 . ; 4751 "RTN","C0SPROB2",273,0)4752 . N PROBID ; unique Id for this problem4753 4741 "RTN","C0SPROB2",274,0) 4754 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number4742 . ; i don't like this because the same problems gets a 4755 4743 "RTN","C0SPROB2",275,0) 4744 . ; different ID every time it's reported. Can't trace it back to VistA 4745 "RTN","C0SPROB2",276,0) 4746 . ; I'd rather be using id@value ie "id@value")="118" 4747 "RTN","C0SPROB2",277,0) 4756 4748 . ; 4757 "RTN","C0SPROB2",276,0)4758 . ; i don't like this because the same problems gets a4759 "RTN","C0SPROB2",277,0)4760 . ; different ID every time it's reported. Can't trace it back to VistA4761 4749 "RTN","C0SPROB2",278,0) 4762 . ; I'd rather be using id@value ie "id@value")="118"4750 . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) 4763 4751 "RTN","C0SPROB2",279,0) 4752 . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map 4753 "RTN","C0SPROB2",280,0) 4754 . N SNOGRF ; graph for SNOMED code 4755 "RTN","C0SPROB2",281,0) 4756 . I SNOMED="" D ; 4757 "RTN","C0SPROB2",282,0) 4758 . . S SNOMED=ICD ; if not found, return the ICD code 4759 "RTN","C0SPROB2",283,0) 4760 . . S SNOGRF="icd9:"_SNOMED 4761 "RTN","C0SPROB2",284,0) 4762 . E S SNOGRF="snomed:"_SNOMED 4763 "RTN","C0SPROB2",285,0) 4764 . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) 4765 "RTN","C0SPROB2",286,0) 4766 . I $D(DEBUG) D ; 4767 "RTN","C0SPROB2",287,0) 4768 . . W !,"Processing Problem List ",PROBID 4769 "RTN","C0SPROB2",288,0) 4770 . . W !,"problem: ",SNOTIT 4771 "RTN","C0SPROB2",289,0) 4772 . . W !,"code: ",SNOMED 4773 "RTN","C0SPROB2",290,0) 4764 4774 . ; 4765 "RTN","C0SPROB2",280,0)4766 . N SNOMED,ICD S ICD=$G(@LRN@("icd@value"))4767 "RTN","C0SPROB2",281,0)4768 . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map4769 "RTN","C0SPROB2",282,0)4770 . N SNOGRF ; graph for SNOMED code4771 "RTN","C0SPROB2",283,0)4772 . I SNOMED="" D ;4773 "RTN","C0SPROB2",284,0)4774 . . S SNOMED=ICD ; if not found, return the ICD code4775 "RTN","C0SPROB2",285,0)4776 . . S SNOGRF="icd9:"_SNOMED4777 "RTN","C0SPROB2",286,0)4778 . E S SNOGRF="snomed:"_SNOMED4779 "RTN","C0SPROB2",287,0)4780 . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))4781 "RTN","C0SPROB2",288,0)4782 . I $D(DEBUG) D ;4783 "RTN","C0SPROB2",289,0)4784 . . W !,"Processing Problem List ",PROBID4785 "RTN","C0SPROB2",290,0)4786 . . W !,"problem: ",SNOTIT4787 4775 "RTN","C0SPROB2",291,0) 4788 . . W !,"code: ",SNOMED4776 . ; first do the base result graph 4789 4777 "RTN","C0SPROB2",292,0) 4790 4778 . ; 4791 4779 "RTN","C0SPROB2",293,0) 4792 . ; first do the base result graph4780 . S ZR("rdf:type")="sp:Problem" 4793 4781 "RTN","C0SPROB2",294,0) 4782 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems 4783 "RTN","C0SPROB2",295,0) 4784 . ; ie /vista/smart/99912345/problems 4785 "RTN","C0SPROB2",296,0) 4794 4786 . ; 4795 "RTN","C0SPROB2",295,0)4796 . S ZR("rdf:type")="sp:Problem"4797 "RTN","C0SPROB2",296,0)4798 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems4799 4787 "RTN","C0SPROB2",297,0) 4800 . ; ie /vista/smart/99912345/problems4788 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name 4801 4789 "RTN","C0SPROB2",298,0) 4790 . S ZR("sp:problemName")=PROBNAME 4791 "RTN","C0SPROB2",299,0) 4802 4792 . ; 4803 "RTN","C0SPROB2",299,0)4804 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name4805 4793 "RTN","C0SPROB2",300,0) 4806 . S ZR("sp:problemName")=PROBNAME4794 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) 4807 4795 "RTN","C0SPROB2",301,0) 4796 . S ZR("sp:startDate")=STARTDT 4797 "RTN","C0SPROB2",302,0) 4808 4798 . ; 4809 "RTN","C0SPROB2",302,0)4810 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))4811 4799 "RTN","C0SPROB2",303,0) 4812 . S ZR("sp:startDate")=STARTDT4800 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples 4813 4801 "RTN","C0SPROB2",304,0) 4802 . K ZR ; clean up 4803 "RTN","C0SPROB2",305,0) 4814 4804 . ; 4815 "RTN","C0SPROB2",305,0)4816 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples4817 4805 "RTN","C0SPROB2",306,0) 4818 . K ZR ; clean up4806 . ; create the problemName graph 4819 4807 "RTN","C0SPROB2",307,0) 4820 4808 . ; 4821 4809 "RTN","C0SPROB2",308,0) 4822 . ; create the problemName graph4810 . S ZR("rdf:type")="sp:CodedValue" 4823 4811 "RTN","C0SPROB2",309,0) 4812 . ;S ZR("sp:code")="snomed:"_SNOMED 4813 "RTN","C0SPROB2",310,0) 4814 . S ZR("sp:code")=SNOGRF 4815 "RTN","C0SPROB2",311,0) 4816 . S ZR("dcterms:title")=$G(@LRN@("name@value")) 4817 "RTN","C0SPROB2",312,0) 4818 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) 4819 "RTN","C0SPROB2",313,0) 4820 . K ZR 4821 "RTN","C0SPROB2",314,0) 4824 4822 . ; 4825 "RTN","C0SPROB2",310,0)4826 . S ZR("rdf:type")="sp:CodedValue"4827 "RTN","C0SPROB2",311,0)4828 . ;S ZR("sp:code")="snomed:"_SNOMED4829 "RTN","C0SPROB2",312,0)4830 . S ZR("sp:code")=SNOGRF4831 "RTN","C0SPROB2",313,0)4832 . S ZR("dcterms:title")=$G(@LRN@("name@value"))4833 "RTN","C0SPROB2",314,0)4834 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)4835 4823 "RTN","C0SPROB2",315,0) 4824 . ; create snomed graph 4825 "RTN","C0SPROB2",316,0) 4826 . ; 4827 "RTN","C0SPROB2",317,0) 4828 . S ZR("rdf:type")="sp:Code" 4829 "RTN","C0SPROB2",318,0) 4830 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" 4831 "RTN","C0SPROB2",319,0) 4832 . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" 4833 "RTN","C0SPROB2",320,0) 4834 . S ZR("dcterms:identifier")=SNOMED 4835 "RTN","C0SPROB2",321,0) 4836 . S ZR("dcterms:title")=SNOTIT 4837 "RTN","C0SPROB2",322,0) 4838 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) 4839 "RTN","C0SPROB2",323,0) 4836 4840 . K ZR 4837 "RTN","C0SPROB2",3 16,0)4841 "RTN","C0SPROB2",324,0) 4838 4842 . ; 4839 "RTN","C0SPROB2",317,0)4840 . ; create snomed graph4841 "RTN","C0SPROB2",318,0)4842 . ;4843 "RTN","C0SPROB2",319,0)4844 . S ZR("rdf:type")="sp:Code"4845 "RTN","C0SPROB2",320,0)4846 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"4847 "RTN","C0SPROB2",321,0)4848 . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9"4849 "RTN","C0SPROB2",322,0)4850 . S ZR("dcterms:identifier")=SNOMED4851 "RTN","C0SPROB2",323,0)4852 . S ZR("dcterms:title")=SNOTIT4853 "RTN","C0SPROB2",324,0)4854 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)4855 4843 "RTN","C0SPROB2",325,0) 4856 . K ZR4844 D BULKLOAD^C0XF2N(.C0XFDA) 4857 4845 "RTN","C0SPROB2",326,0) 4858 . ;4846 S GRTN=C0SGRF 4859 4847 "RTN","C0SPROB2",327,0) 4860 D BULKLOAD^C0XF2N(.C0XFDA)4848 Q 4861 4849 "RTN","C0SPROB2",328,0) 4862 S GRTN=C0SGRF4850 ; 4863 4851 "RTN","C0SPROB2",329,0) 4864 Q 4852 SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code 4865 4853 "RTN","C0SPROB2",330,0) 4866 ; 4854 ; requires the mapping table installed in the triplestore 4867 4855 "RTN","C0SPROB2",331,0) 4868 SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code 4856 ; 4869 4857 "RTN","C0SPROB2",332,0) 4870 ; requires the mapping table installed in the triplestore4858 N ZSN,ZARY,ZSUB,ZSUBS 4871 4859 "RTN","C0SPROB2",333,0) 4872 ;4860 I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots 4873 4861 "RTN","C0SPROB2",334,0) 4874 N ZSN,ZARY,ZSUB,ZSUBS4862 D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code 4875 4863 "RTN","C0SPROB2",335,0) 4876 I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots4864 S ZSUB=$O(ZSUBS("")) ; pick the first one 4877 4865 "RTN","C0SPROB2",336,0) 4878 D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code4866 I ZSUB="" Q "" 4879 4867 "RTN","C0SPROB2",337,0) 4880 S ZSUB=$O(ZSUBS("")) ; pick the first one4868 D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") 4881 4869 "RTN","C0SPROB2",338,0) 4882 I ZSUB="" Q ""4870 S ZSN=$O(ZARY("")) 4883 4871 "RTN","C0SPROB2",339,0) 4884 D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode")4872 I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") 4885 4873 "RTN","C0SPROB2",340,0) 4886 S ZSN=$O(ZARY(""))4874 Q ZSN 4887 4875 "RTN","C0SPROB2",341,0) 4888 I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label")4889 "RTN","C0SPROB2",342,0)4890 Q ZSN4891 "RTN","C0SPROB2",343,0)4892 4876 ; 4893 4877 "RTN","C0STBL") 4894 0^11^B23 9897614878 0^11^B23538791 4895 4879 "RTN","C0STBL",1,0) 4896 4880 C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 4897 4881 "RTN","C0STBL",2,0) 4898 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 54882 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 4899 4883 "RTN","C0STBL",3,0) 4900 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU4884 ;Copyright 2012 George Lilly. 4901 4885 "RTN","C0STBL",4,0) 4902 ; General Public License See attached copy of the License.4886 ; 4903 4887 "RTN","C0STBL",5,0) 4904 ; 4888 ; This program is free software: you can redistribute it and/or modify 4905 4889 "RTN","C0STBL",6,0) 4906 ; This program is free software; you can redistribute it and/or modify4890 ; it under the terms of the GNU Affero General Public License as 4907 4891 "RTN","C0STBL",7,0) 4908 ; it under the terms of the GNU General Public License as published by4892 ; published by the Free Software Foundation, either version 3 of the 4909 4893 "RTN","C0STBL",8,0) 4910 ; the Free Software Foundation; either version 2 of the License, or4894 ; License, or (at your option) any later version. 4911 4895 "RTN","C0STBL",9,0) 4912 ; (at your option) any later version.4896 ; 4913 4897 "RTN","C0STBL",10,0) 4914 ; 4898 ; This program is distributed in the hope that it will be useful, 4915 4899 "RTN","C0STBL",11,0) 4916 ; This program is distributed in the hope that it will be useful,4900 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 4917 4901 "RTN","C0STBL",12,0) 4918 ; but WITHOUT ANY WARRANTY; without even the implied warranty of4902 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 4919 4903 "RTN","C0STBL",13,0) 4920 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the4904 ; GNU Affero General Public License for more details. 4921 4905 "RTN","C0STBL",14,0) 4922 ; GNU General Public License for more details.4906 ; 4923 4907 "RTN","C0STBL",15,0) 4924 ; 4908 ; You should have received a copy of the GNU Affero General Public License 4925 4909 "RTN","C0STBL",16,0) 4926 ; You should have received a copy of the GNU General Public License along4910 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 4927 4911 "RTN","C0STBL",17,0) 4928 ; with this program; if not, write to the Free Software Foundation, Inc.,4912 ; 4929 4913 "RTN","C0STBL",18,0) 4930 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.4914 Q 4931 4915 "RTN","C0STBL",19,0) 4932 ; 4916 EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN 4933 4917 "RTN","C0STBL",20,0) 4934 Q4918 I '$D(BEGDFN) S BDGDFN="" 4935 4919 "RTN","C0STBL",21,0) 4936 EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN 4920 I '$D(DFNCNT) S DFNCNT=150 4937 4921 "RTN","C0STBL",22,0) 4938 I '$D( BEGDFN) S BDGDFN=""4922 I '$D(ZPART) S ZPART="" 4939 4923 "RTN","C0STBL",23,0) 4940 I '$D(DFNCNT) S DFNCNT=1504924 N ZTBL S ZTBL=$NA(^TMP("C0STBL")) 4941 4925 "RTN","C0STBL",24,0) 4942 I '$D(ZPART) S ZPART=""4926 N ZI,ZCNT,ZG 4943 4927 "RTN","C0STBL",25,0) 4944 N ZTBL S ZTBL=$NA(^TMP("C0STBL"))4928 S ZI=$O(^DPT(BEGDFN),-1) 4945 4929 "RTN","C0STBL",26,0) 4946 N ZI,ZCNT,ZG4930 S ZCNT=1 4947 4931 "RTN","C0STBL",27,0) 4948 S ZI=$O(^DPT(BEGDFN),-1)4932 F S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT)) D ; 4949 4933 "RTN","C0STBL",28,0) 4950 S ZCNT=14934 . S ZCNT=ZCNT+1 4951 4935 "RTN","C0STBL",29,0) 4952 F S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT)) D ;4936 . W ZI," " 4953 4937 "RTN","C0STBL",30,0) 4954 . S ZCNT=ZCNT+14938 . K ZG 4955 4939 "RTN","C0STBL",31,0) 4956 . W ZI," "4940 . D EN^C0SNHIN(.ZG,ZI,ZPART) 4957 4941 "RTN","C0STBL",32,0) 4958 . KZG4942 . M @ZTBL@(ZI)=ZG 4959 4943 "RTN","C0STBL",33,0) 4960 . D EN^C0SNHIN(.ZG,ZI,ZPART)4944 . K G 4961 4945 "RTN","C0STBL",34,0) 4962 . M @ZTBL@(ZI)=ZG4946 . N GDIR S GDIR="/home/vista/p/" 4963 4947 "RTN","C0STBL",35,0) 4948 . D EN^C0SMART(.G,ZI,"med") 4949 "RTN","C0STBL",36,0) 4950 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR) 4951 "RTN","C0STBL",37,0) 4952 . k G 4953 "RTN","C0STBL",38,0) 4954 . D EN^C0SMART(.G,ZI,"patient") 4955 "RTN","C0STBL",39,0) 4956 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR) 4957 "RTN","C0STBL",40,0) 4964 4958 . K G 4965 "RTN","C0STBL",36,0)4966 . N GDIR S GDIR="/home/vista/p/"4967 "RTN","C0STBL",37,0)4968 . D EN^C0SMART(.G,ZI,"med")4969 "RTN","C0STBL",38,0)4970 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR)4971 "RTN","C0STBL",39,0)4972 . k G4973 "RTN","C0STBL",40,0)4974 . D EN^C0SMART(.G,ZI,"patient")4975 4959 "RTN","C0STBL",41,0) 4976 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR)4960 . D EN^C0SMART(.G,ZI,"lab") 4977 4961 "RTN","C0STBL",42,0) 4962 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR) 4963 "RTN","C0STBL",43,0) 4978 4964 . K G 4979 "RTN","C0STBL",43,0)4980 . D EN^C0SMART(.G,ZI,"lab")4981 4965 "RTN","C0STBL",44,0) 4982 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR)4966 . D EN^C0SMART(.G,ZI,"problem") 4983 4967 "RTN","C0STBL",45,0) 4984 . K G4968 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR) 4985 4969 "RTN","C0STBL",46,0) 4986 . D EN^C0SMART(.G,ZI,"problem")4970 Q 4987 4971 "RTN","C0STBL",47,0) 4988 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR)4972 ; 4989 4973 "RTN","C0STBL",48,0) 4990 Q 4974 LOADHACK ; 4991 4975 "RTN","C0STBL",49,0) 4992 ;4976 N ZI 4993 4977 "RTN","C0STBL",50,0) 4994 LOADHACK;4978 F ZI=2:1:374 D ; 4995 4979 "RTN","C0STBL",51,0) 4996 N ZI4980 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") 4997 4981 "RTN","C0STBL",52,0) 4998 F ZI=2:1:374 D ;4982 Q 4999 4983 "RTN","C0STBL",53,0) 5000 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/")4984 ; 5001 4985 "RTN","C0STBL",54,0) 5002 Q 4986 LABCNT ; COUNT LAB TESTS AND LOINC CODES 5003 4987 "RTN","C0STBL",55,0) 5004 ;4988 K LABCNT,GLOINC,PATCNT 5005 4989 "RTN","C0STBL",56,0) 5006 LABCNT ; COUNT LAB TESTS AND LOINC CODES 4990 S (LABCNT,GLOINC,PATCNT)=0 5007 4991 "RTN","C0STBL",57,0) 5008 K LABCNT,GLOINC,PATCNT4992 N ZI S ZI="" 5009 4993 "RTN","C0STBL",58,0) 5010 S (LABCNT,GLOINC,PATCNT)=04994 N GN S GN=$NA(^TMP("C0STBL")) 5011 4995 "RTN","C0STBL",59,0) 4996 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 4997 "RTN","C0STBL",60,0) 4998 . S PATCNT=PATCNT+1 4999 "RTN","C0STBL",61,0) 5000 . I '$D(@GN@(ZI,"lab")) Q ; 5001 "RTN","C0STBL",62,0) 5002 . N ZJ S ZJ="" 5003 "RTN","C0STBL",63,0) 5004 . F S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ="" D ; 5005 "RTN","C0STBL",64,0) 5006 . . S LABCNT=LABCNT+1 5007 "RTN","C0STBL",65,0) 5008 . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value")) 5009 "RTN","C0STBL",66,0) 5010 . . I X'="" S GLOINC=GLOINC+1 5011 "RTN","C0STBL",67,0) 5012 W !,"Total number of patients: ",PATCNT 5013 "RTN","C0STBL",68,0) 5014 W !,"Total number of lab results: ",LABCNT 5015 "RTN","C0STBL",69,0) 5016 W !,"Total number of lab results with loinc codes: ",GLOINC 5017 "RTN","C0STBL",70,0) 5018 W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%" 5019 "RTN","C0STBL",71,0) 5020 Q 5021 "RTN","C0STBL",72,0) 5022 ; 5023 "RTN","C0STBL",73,0) 5024 PROBCNT ; COUNT PROBLEMS AND SNOMED CODES 5025 "RTN","C0STBL",74,0) 5026 K PROBCNT,GSNO,PATCNT 5027 "RTN","C0STBL",75,0) 5028 S (PROBCNT,GSNO,PATCNT)=0 5029 "RTN","C0STBL",76,0) 5012 5030 N ZI S ZI="" 5013 "RTN","C0STBL", 60,0)5031 "RTN","C0STBL",77,0) 5014 5032 N GN S GN=$NA(^TMP("C0STBL")) 5015 "RTN","C0STBL", 61,0)5033 "RTN","C0STBL",78,0) 5016 5034 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 5017 "RTN","C0STBL", 62,0)5035 "RTN","C0STBL",79,0) 5018 5036 . S PATCNT=PATCNT+1 5019 "RTN","C0STBL", 63,0)5020 . I '$D(@GN@(ZI," lab")) Q ;5021 "RTN","C0STBL", 64,0)5037 "RTN","C0STBL",80,0) 5038 . I '$D(@GN@(ZI,"problem")) Q ; 5039 "RTN","C0STBL",81,0) 5022 5040 . N ZJ S ZJ="" 5023 "RTN","C0STBL",65,0) 5024 . F S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ="" D ; 5025 "RTN","C0STBL",66,0) 5026 . . S LABCNT=LABCNT+1 5027 "RTN","C0STBL",67,0) 5028 . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value")) 5029 "RTN","C0STBL",68,0) 5030 . . I X'="" S GLOINC=GLOINC+1 5031 "RTN","C0STBL",69,0) 5041 "RTN","C0STBL",82,0) 5042 . F S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ="" D ; 5043 "RTN","C0STBL",83,0) 5044 . . S PROBCNT=PROBCNT+1 5045 "RTN","C0STBL",84,0) 5046 . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value")) 5047 "RTN","C0STBL",85,0) 5048 . . S Y=$$SNOMED^C0SPROB2(X) 5049 "RTN","C0STBL",86,0) 5050 . . I Y'="" S GSNO=GSNO+1 5051 "RTN","C0STBL",87,0) 5032 5052 W !,"Total number of patients: ",PATCNT 5033 "RTN","C0STBL", 70,0)5034 W !,"Total number of lab results: ",LABCNT5035 "RTN","C0STBL", 71,0)5036 W !,"Total number of lab results with loinc codes: ",GLOINC5037 "RTN","C0STBL", 72,0)5038 W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%"5039 "RTN","C0STBL", 73,0)5040 Q 5041 "RTN","C0STBL", 74,0)5042 ; 5043 "RTN","C0STBL", 75,0)5044 PROBCNT ; COUNT PROBLEMS AND SNOMED CODES5045 "RTN","C0STBL", 76,0)5046 K PROBCNT,GSNO,PATCNT5047 "RTN","C0STBL", 77,0)5048 S ( PROBCNT,GSNO,PATCNT)=05049 "RTN","C0STBL", 78,0)5053 "RTN","C0STBL",88,0) 5054 W !,"Total number of problems: ",PROBCNT 5055 "RTN","C0STBL",89,0) 5056 W !,"Total number of problems with snomed codes: ",GSNO 5057 "RTN","C0STBL",90,0) 5058 W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%" 5059 "RTN","C0STBL",91,0) 5060 Q 5061 "RTN","C0STBL",92,0) 5062 ; 5063 "RTN","C0STBL",93,0) 5064 MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS 5065 "RTN","C0STBL",94,0) 5066 K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE 5067 "RTN","C0STBL",95,0) 5068 S (MEDCNT,OMED,GSNO,PATCNT)=0 5069 "RTN","C0STBL",96,0) 5050 5070 N ZI S ZI="" 5051 "RTN","C0STBL", 79,0)5071 "RTN","C0STBL",97,0) 5052 5072 N GN S GN=$NA(^TMP("C0STBL")) 5053 "RTN","C0STBL", 80,0)5073 "RTN","C0STBL",98,0) 5054 5074 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; 5055 "RTN","C0STBL", 81,0)5075 "RTN","C0STBL",99,0) 5056 5076 . S PATCNT=PATCNT+1 5057 "RTN","C0STBL", 82,0)5058 . I '$D(@GN@(ZI," problem")) Q ;5059 "RTN","C0STBL", 83,0)5077 "RTN","C0STBL",100,0) 5078 . I '$D(@GN@(ZI,"med")) Q ; 5079 "RTN","C0STBL",101,0) 5060 5080 . N ZJ S ZJ="" 5061 "RTN","C0STBL",84,0) 5062 . F S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ="" D ; 5063 "RTN","C0STBL",85,0) 5064 . . S PROBCNT=PROBCNT+1 5065 "RTN","C0STBL",86,0) 5066 . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value")) 5067 "RTN","C0STBL",87,0) 5068 . . S Y=$$SNOMED^C0SPROB2(X) 5069 "RTN","C0STBL",88,0) 5070 . . I Y'="" S GSNO=GSNO+1 5071 "RTN","C0STBL",89,0) 5081 "RTN","C0STBL",102,0) 5082 . F S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ="" D ; 5083 "RTN","C0STBL",103,0) 5084 . . S MEDCNT=MEDCNT+1 5085 "RTN","C0STBL",104,0) 5086 . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D Q ; 5087 "RTN","C0STBL",105,0) 5088 . . . I $D(DEBUG) W !,"Expired Mediation, Skipping" 5089 "RTN","C0STBL",106,0) 5090 . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D Q ; 5091 "RTN","C0STBL",107,0) 5092 . . . I $D(DEBUG) W !,"Inpatient Med, skipping" 5093 "RTN","C0STBL",108,0) 5094 . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D Q ; 5095 "RTN","C0STBL",109,0) 5096 . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" 5097 "RTN","C0STBL",110,0) 5098 . . S OMED=OMED+1 5099 "RTN","C0STBL",111,0) 5100 . . S X=$G(@GN@(ZI,"med",ZJ,"form@value")) 5101 "RTN","C0STBL",112,0) 5102 . . S FORM(X)=$G(FORM(X))+1 5103 "RTN","C0STBL",113,0) 5104 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose")) 5105 "RTN","C0STBL",114,0) 5106 . . I X="" S X="UNKNOWN" 5107 "RTN","C0STBL",115,0) 5108 . . S DOSE(X)=$G(DOSE(X))+1 5109 "RTN","C0STBL",116,0) 5110 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units")) 5111 "RTN","C0STBL",117,0) 5112 . . I X="" S X="UNKNOWN" 5113 "RTN","C0STBL",118,0) 5114 . . S UNITS(X)=$G(UNITS(X))+1 5115 "RTN","C0STBL",119,0) 5116 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule")) 5117 "RTN","C0STBL",120,0) 5118 . . I X="" S X="UNKNOWN" 5119 "RTN","C0STBL",121,0) 5120 . . S SCHED(X)=$G(SCHED(X))+1 5121 "RTN","C0STBL",122,0) 5122 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route")) 5123 "RTN","C0STBL",123,0) 5124 . . I X="" S X="UNKNOWN" 5125 "RTN","C0STBL",124,0) 5126 . . S ROUTE(X)=$G(ROUTE(X))+1 5127 "RTN","C0STBL",125,0) 5072 5128 W !,"Total number of patients: ",PATCNT 5073 "RTN","C0STBL",90,0)5074 W !,"Total number of problems: ",PROBCNT5075 "RTN","C0STBL",91,0)5076 W !,"Total number of problems with snomed codes: ",GSNO5077 "RTN","C0STBL",92,0)5078 W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%"5079 "RTN","C0STBL",93,0)5080 Q5081 "RTN","C0STBL",94,0)5082 ;5083 "RTN","C0STBL",95,0)5084 MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS5085 "RTN","C0STBL",96,0)5086 K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE5087 "RTN","C0STBL",97,0)5088 S (MEDCNT,OMED,GSNO,PATCNT)=05089 "RTN","C0STBL",98,0)5090 N ZI S ZI=""5091 "RTN","C0STBL",99,0)5092 N GN S GN=$NA(^TMP("C0STBL"))5093 "RTN","C0STBL",100,0)5094 F S ZI=$O(@GN@(ZI)) Q:ZI="" D ;5095 "RTN","C0STBL",101,0)5096 . S PATCNT=PATCNT+15097 "RTN","C0STBL",102,0)5098 . I '$D(@GN@(ZI,"med")) Q ;5099 "RTN","C0STBL",103,0)5100 . N ZJ S ZJ=""5101 "RTN","C0STBL",104,0)5102 . F S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ="" D ;5103 "RTN","C0STBL",105,0)5104 . . S MEDCNT=MEDCNT+15105 "RTN","C0STBL",106,0)5106 . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D Q ;5107 "RTN","C0STBL",107,0)5108 . . . I $D(DEBUG) W !,"Expired Mediation, Skipping"5109 "RTN","C0STBL",108,0)5110 . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D Q ;5111 "RTN","C0STBL",109,0)5112 . . . I $D(DEBUG) W !,"Inpatient Med, skipping"5113 "RTN","C0STBL",110,0)5114 . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D Q ;5115 "RTN","C0STBL",111,0)5116 . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"5117 "RTN","C0STBL",112,0)5118 . . S OMED=OMED+15119 "RTN","C0STBL",113,0)5120 . . S X=$G(@GN@(ZI,"med",ZJ,"form@value"))5121 "RTN","C0STBL",114,0)5122 . . S FORM(X)=$G(FORM(X))+15123 "RTN","C0STBL",115,0)5124 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose"))5125 "RTN","C0STBL",116,0)5126 . . I X="" S X="UNKNOWN"5127 "RTN","C0STBL",117,0)5128 . . S DOSE(X)=$G(DOSE(X))+15129 "RTN","C0STBL",118,0)5130 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units"))5131 "RTN","C0STBL",119,0)5132 . . I X="" S X="UNKNOWN"5133 "RTN","C0STBL",120,0)5134 . . S UNITS(X)=$G(UNITS(X))+15135 "RTN","C0STBL",121,0)5136 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule"))5137 "RTN","C0STBL",122,0)5138 . . I X="" S X="UNKNOWN"5139 "RTN","C0STBL",123,0)5140 . . S SCHED(X)=$G(SCHED(X))+15141 "RTN","C0STBL",124,0)5142 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route"))5143 "RTN","C0STBL",125,0)5144 . . I X="" S X="UNKNOWN"5145 5129 "RTN","C0STBL",126,0) 5146 . . S ROUTE(X)=$G(ROUTE(X))+15130 W !,"Total number of medications: ",MEDCNT 5147 5131 "RTN","C0STBL",127,0) 5148 W !,"Total number of patients: ",PATCNT5132 W !,"Total number of outpatient medications: ",OMED 5149 5133 "RTN","C0STBL",128,0) 5150 W !," Total number of medications: ",MEDCNT5134 W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",! 5151 5135 "RTN","C0STBL",129,0) 5152 W !,"Total number of outpatient medications: ",OMED5136 ZWR FORM 5153 5137 "RTN","C0STBL",130,0) 5154 W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",!5138 ZWR DOSE 5155 5139 "RTN","C0STBL",131,0) 5156 ZWR FORM5140 ZWR UNITS 5157 5141 "RTN","C0STBL",132,0) 5158 ZWR DOSE5142 ZWR SCHED 5159 5143 "RTN","C0STBL",133,0) 5160 ZWR UNITS5144 ZWR ROUTE 5161 5145 "RTN","C0STBL",134,0) 5162 ZWR SCHED5146 Q 5163 5147 "RTN","C0STBL",135,0) 5164 ZWR ROUTE5165 "RTN","C0STBL",136,0)5166 Q5167 "RTN","C0STBL",137,0)5168 5148 ; 5169 5149 "RTN","C0SUTIL") 5170 0^12^B 10055025150 0^12^B968662 5171 5151 "RTN","C0SUTIL",1,0) 5172 5152 C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 5173 5153 "RTN","C0SUTIL",2,0) 5174 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 55154 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 5175 5155 "RTN","C0SUTIL",3,0) 5176 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU5156 ;Copyright 2012 George Lilly. 5177 5157 "RTN","C0SUTIL",4,0) 5178 ; General Public License See attached copy of the License.5158 ; 5179 5159 "RTN","C0SUTIL",5,0) 5180 ; 5160 ; This program is free software: you can redistribute it and/or modify 5181 5161 "RTN","C0SUTIL",6,0) 5182 ; This program is free software; you can redistribute it and/or modify5162 ; it under the terms of the GNU Affero General Public License as 5183 5163 "RTN","C0SUTIL",7,0) 5184 ; it under the terms of the GNU General Public License as published by5164 ; published by the Free Software Foundation, either version 3 of the 5185 5165 "RTN","C0SUTIL",8,0) 5186 ; the Free Software Foundation; either version 2 of the License, or5166 ; License, or (at your option) any later version. 5187 5167 "RTN","C0SUTIL",9,0) 5188 ; (at your option) any later version.5168 ; 5189 5169 "RTN","C0SUTIL",10,0) 5190 ; 5170 ; This program is distributed in the hope that it will be useful, 5191 5171 "RTN","C0SUTIL",11,0) 5192 ; This program is distributed in the hope that it will be useful,5172 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 5193 5173 "RTN","C0SUTIL",12,0) 5194 ; but WITHOUT ANY WARRANTY; without even the implied warranty of5174 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 5195 5175 "RTN","C0SUTIL",13,0) 5196 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the5176 ; GNU Affero General Public License for more details. 5197 5177 "RTN","C0SUTIL",14,0) 5198 ; GNU General Public License for more details.5178 ; 5199 5179 "RTN","C0SUTIL",15,0) 5200 ; 5180 ; You should have received a copy of the GNU Affero General Public License 5201 5181 "RTN","C0SUTIL",16,0) 5202 ; You should have received a copy of the GNU General Public License along5182 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 5203 5183 "RTN","C0SUTIL",17,0) 5204 ; with this program; if not, write to the Free Software Foundation, Inc.,5184 ; 5205 5185 "RTN","C0SUTIL",18,0) 5206 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.5186 Q 5207 5187 "RTN","C0SUTIL",19,0) 5208 5188 ; 5209 5189 "RTN","C0SUTIL",20,0) 5210 Q 5190 SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd 5211 5191 "RTN","C0SUTIL",21,0) 5212 ; 5192 ; ZDATE is a fileman format date 5213 5193 "RTN","C0SUTIL",22,0) 5214 SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd 5194 N TMPDT 5215 5195 "RTN","C0SUTIL",23,0) 5216 ; ZDATE is a fileman formatdate5196 S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date 5217 5197 "RTN","C0SUTIL",24,0) 5218 N TMPDT5198 S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens 5219 5199 "RTN","C0SUTIL",25,0) 5220 S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date5200 I TMPDT="" S TMPDT="UNKNOWN" 5221 5201 "RTN","C0SUTIL",26,0) 5222 S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens5202 N Z2,Z3 5223 5203 "RTN","C0SUTIL",27,0) 5224 I TMPDT="" S TMPDT="UNKNOWN"5204 S Z2=$P(TMPDT,"-",2) 5225 5205 "RTN","C0SUTIL",28,0) 5226 N Z2,Z35206 S Z3=$P(TMPDT,"-",3) 5227 5207 "RTN","C0SUTIL",29,0) 5228 S Z2=$P(TMPDT,"-",2)5208 I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 5229 5209 "RTN","C0SUTIL",30,0) 5230 S Z3=$P(TMPDT,"-",3)5210 I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 5231 5211 "RTN","C0SUTIL",31,0) 5232 I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z25212 Q TMPDT 5233 5213 "RTN","C0SUTIL",32,0) 5234 I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z35235 "RTN","C0SUTIL",33,0)5236 Q TMPDT5237 "RTN","C0SUTIL",34,0)5238 5214 ; 5239 5215 "RTN","C0SXPATH") 5240 0^13^B5 212831435216 0^13^B518728149 5241 5217 "RTN","C0SXPATH",1,0) 5242 5218 C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am 5243 5219 "RTN","C0SXPATH",2,0) 5244 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 55220 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6 5245 5221 "RTN","C0SXPATH",3,0) 5246 ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU5222 ;Copyright 2008-2012 George Lilly. 5247 5223 "RTN","C0SXPATH",4,0) 5248 ; General Public License See attached copy of the License.5224 ; 5249 5225 "RTN","C0SXPATH",5,0) 5250 ; 5226 ; This program is free software: you can redistribute it and/or modify 5251 5227 "RTN","C0SXPATH",6,0) 5252 ; This program is free software; you can redistribute it and/or modify5228 ; it under the terms of the GNU Affero General Public License as 5253 5229 "RTN","C0SXPATH",7,0) 5254 ; it under the terms of the GNU General Public License as published by5230 ; published by the Free Software Foundation, either version 3 of the 5255 5231 "RTN","C0SXPATH",8,0) 5256 ; the Free Software Foundation; either version 2 of the License, or5232 ; License, or (at your option) any later version. 5257 5233 "RTN","C0SXPATH",9,0) 5258 ; (at your option) any later version.5234 ; 5259 5235 "RTN","C0SXPATH",10,0) 5260 ; 5236 ; This program is distributed in the hope that it will be useful, 5261 5237 "RTN","C0SXPATH",11,0) 5262 ; This program is distributed in the hope that it will be useful,5238 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 5263 5239 "RTN","C0SXPATH",12,0) 5264 ; but WITHOUT ANY WARRANTY; without even the implied warranty of5240 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 5265 5241 "RTN","C0SXPATH",13,0) 5266 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the5242 ; GNU Affero General Public License for more details. 5267 5243 "RTN","C0SXPATH",14,0) 5268 ; GNU General Public License for more details.5244 ; 5269 5245 "RTN","C0SXPATH",15,0) 5270 ; 5246 ; You should have received a copy of the GNU Affero General Public License 5271 5247 "RTN","C0SXPATH",16,0) 5272 ; You should have received a copy of the GNU General Public License along5248 ; along with this program. If not, see <http://www.gnu.org/licenses/>. 5273 5249 "RTN","C0SXPATH",17,0) 5274 ; with this program; if not, write to the Free Software Foundation, Inc.,5250 ; 5275 5251 "RTN","C0SXPATH",18,0) 5276 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.5252 W "This is an XML XPATH utility library",! 5277 5253 "RTN","C0SXPATH",19,0) 5278 ;5254 W ! 5279 5255 "RTN","C0SXPATH",20,0) 5280 W "This is an XML XPATH utility library",!5256 Q 5281 5257 "RTN","C0SXPATH",21,0) 5282 W !5258 ; 5283 5259 "RTN","C0SXPATH",22,0) 5284 Q 5260 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 5285 5261 "RTN","C0SXPATH",23,0) 5286 5262 ; 5287 5263 "RTN","C0SXPATH",24,0) 5288 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE 5264 N Y 5289 5265 "RTN","C0SXPATH",25,0) 5290 ;5266 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) 5291 5267 "RTN","C0SXPATH",26,0) 5292 N Y5268 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR 5293 5269 "RTN","C0SXPATH",27,0) 5294 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)5270 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR 5295 5271 "RTN","C0SXPATH",28,0) 5296 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR5272 Q 5297 5273 "RTN","C0SXPATH",29,0) 5298 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR5274 ; 5299 5275 "RTN","C0SXPATH",30,0) 5300 Q 5276 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 5301 5277 "RTN","C0SXPATH",31,0) 5302 ; 5278 ; VAL IS A STRING AND STK IS PASSED BY NAME 5303 5279 "RTN","C0SXPATH",32,0) 5304 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) 5280 ; 5305 5281 "RTN","C0SXPATH",33,0) 5306 ; VAL IS A STRING AND STK IS PASSED BY NAME5282 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE 5307 5283 "RTN","C0SXPATH",34,0) 5308 ;5284 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH 5309 5285 "RTN","C0SXPATH",35,0) 5310 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE5286 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY 5311 5287 "RTN","C0SXPATH",36,0) 5312 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH5288 Q 5313 5289 "RTN","C0SXPATH",37,0) 5314 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY5290 ; 5315 5291 "RTN","C0SXPATH",38,0) 5316 Q 5292 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 5317 5293 "RTN","C0SXPATH",39,0) 5318 ; 5294 ; VAL AND STK ARE PASSED BY REFERENCE 5319 5295 "RTN","C0SXPATH",40,0) 5320 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL 5296 ; 5321 5297 "RTN","C0SXPATH",41,0) 5322 ; VAL AND STK ARE PASSED BY REFERENCE5298 I @STK@(0)<1 D ; IF ARRAY IS EMPTY 5323 5299 "RTN","C0SXPATH",42,0) 5324 ;5300 . S VAL="" 5325 5301 "RTN","C0SXPATH",43,0) 5326 I @STK@(0)<1 D ; IF ARRAY IS EMPTY5302 . S @STK@(0)=0 5327 5303 "RTN","C0SXPATH",44,0) 5328 . S VAL=""5304 I @STK@(0)>0 D ; 5329 5305 "RTN","C0SXPATH",45,0) 5330 . S @STK@(0)=05306 . S VAL=@STK@(@STK@(0)) 5331 5307 "RTN","C0SXPATH",46,0) 5332 I @STK@(0)>0 D ;5308 . K @STK@(@STK@(0)) 5333 5309 "RTN","C0SXPATH",47,0) 5334 . S VAL=@STK@(@STK@(0))5310 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY 5335 5311 "RTN","C0SXPATH",48,0) 5336 . K @STK@(@STK@(0))5312 Q 5337 5313 "RTN","C0SXPATH",49,0) 5338 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY5314 ; 5339 5315 "RTN","C0SXPATH",50,0) 5340 Q 5316 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME 5341 5317 "RTN","C0SXPATH",51,0) 5342 5318 ; 5343 5319 "RTN","C0SXPATH",52,0) 5344 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME 5320 N ZGI 5345 5321 "RTN","C0SXPATH",53,0) 5346 ;5322 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY 5347 5323 "RTN","C0SXPATH",54,0) 5348 N ZGI5324 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT 5349 5325 "RTN","C0SXPATH",55,0) 5350 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY5326 Q 5351 5327 "RTN","C0SXPATH",56,0) 5352 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT5328 ; 5353 5329 "RTN","C0SXPATH",57,0) 5354 Q 5330 MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 5355 5331 "RTN","C0SXPATH",58,0) 5356 ; 5332 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS 5357 5333 "RTN","C0SXPATH",59,0) 5358 MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK 5334 ; REDUX IS A STRING TO REMOVE FROM THE RESULT 5359 5335 "RTN","C0SXPATH",60,0) 5360 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS5336 S RTN="" 5361 5337 "RTN","C0SXPATH",61,0) 5362 ; REDUX IS A STRING TO REMOVE FROM THE RESULT5338 N I 5363 5339 "RTN","C0SXPATH",62,0) 5364 S RTN=""5340 ; W "STK= ",STK,! 5365 5341 "RTN","C0SXPATH",63,0) 5342 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY 5343 "RTN","C0SXPATH",64,0) 5344 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON 5345 "RTN","C0SXPATH",65,0) 5346 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON 5347 "RTN","C0SXPATH",66,0) 5348 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) 5349 "RTN","C0SXPATH",67,0) 5350 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) 5351 "RTN","C0SXPATH",68,0) 5352 Q 5353 "RTN","C0SXPATH",69,0) 5354 ; 5355 "RTN","C0SXPATH",70,0) 5356 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG 5357 "RTN","C0SXPATH",71,0) 5358 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME 5359 "RTN","C0SXPATH",72,0) 5360 ; ISTR IS PASSED BY VALUE 5361 "RTN","C0SXPATH",73,0) 5362 N CUR,TMP 5363 "RTN","C0SXPATH",74,0) 5364 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET 5365 "RTN","C0SXPATH",75,0) 5366 . S TMP=$P(ISTR,"<",2) 5367 "RTN","C0SXPATH",76,0) 5368 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME> 5369 "RTN","C0SXPATH",77,0) 5370 . S TMP=$P(TMP,"/",2) 5371 "RTN","C0SXPATH",78,0) 5372 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME 5373 "RTN","C0SXPATH",79,0) 5374 ; W "CUR= ",CUR,! 5375 "RTN","C0SXPATH",80,0) 5376 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> 5377 "RTN","C0SXPATH",81,0) 5378 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER 5379 "RTN","C0SXPATH",82,0) 5380 ; W "CUR2= ",CUR,! 5381 "RTN","C0SXPATH",83,0) 5382 Q CUR 5383 "RTN","C0SXPATH",84,0) 5384 ; 5385 "RTN","C0SXPATH",85,0) 5386 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML 5387 "RTN","C0SXPATH",86,0) 5388 ; <NAME>VALUE</NAME> WILL RETURN VALUE 5389 "RTN","C0SXPATH",87,0) 5390 N G 5391 "RTN","C0SXPATH",88,0) 5392 S G=$P(ISTR,">",2) ;STRIP OFF <NAME> 5393 "RTN","C0SXPATH",89,0) 5394 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE 5395 "RTN","C0SXPATH",90,0) 5396 ; 5397 "RTN","C0SXPATH",91,0) 5398 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV 5399 "RTN","C0SXPATH",92,0) 5400 ; VDX: @INVDX@(XPATH)=VALUE 5401 "RTN","C0SXPATH",93,0) 5402 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE 5403 "RTN","C0SXPATH",94,0) 5404 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE 5405 "RTN","C0SXPATH",95,0) 5406 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS 5407 "RTN","C0SXPATH",96,0) 5408 ; @VDV@("XPATH",X1X2X3X4)="XPATH" 5409 "RTN","C0SXPATH",97,0) 5410 N ZA,ZI,ZW 5411 "RTN","C0SXPATH",98,0) 5412 S ZI="" 5413 "RTN","C0SXPATH",99,0) 5414 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 5415 "RTN","C0SXPATH",100,0) 5416 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME 5417 "RTN","C0SXPATH",101,0) 5418 . W ZW,! 5419 "RTN","C0SXPATH",102,0) 5420 . S @OUTVDV@(ZW)=@INVDX@(ZI) 5421 "RTN","C0SXPATH",103,0) 5422 . S @OUTVDV@("XPATH",ZW)=ZI 5423 "RTN","C0SXPATH",104,0) 5424 Q 5425 "RTN","C0SXPATH",105,0) 5426 ; 5427 "RTN","C0SXPATH",106,0) 5428 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG 5429 "RTN","C0SXPATH",107,0) 5430 ; VDX: @VDX@(XPATH)=VALUE 5431 "RTN","C0SXPATH",108,0) 5432 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE 5433 "RTN","C0SXPATH",109,0) 5434 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX 5435 "RTN","C0SXPATH",110,0) 5436 N ZA,ZI,ZW 5437 "RTN","C0SXPATH",111,0) 5438 S ZI="" 5439 "RTN","C0SXPATH",112,0) 5440 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; 5441 "RTN","C0SXPATH",113,0) 5442 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // 5443 "RTN","C0SXPATH",114,0) 5444 . S ZW2=$P(ZW,"/",1) 5445 "RTN","C0SXPATH",115,0) 5446 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) 5447 "RTN","C0SXPATH",116,0) 5448 . ;ZWR ZA 5449 "RTN","C0SXPATH",117,0) 5450 . S ZW2=ZA(1) 5451 "RTN","C0SXPATH",118,0) 5452 . F ZK=2:1:ZA(0) D ; 5453 "RTN","C0SXPATH",119,0) 5454 . . S ZW2=ZW2_""","""_ZA(ZK) 5455 "RTN","C0SXPATH",120,0) 5456 . K ZA 5457 "RTN","C0SXPATH",121,0) 5458 . S ZW2=""""_ZW2_"""" 5459 "RTN","C0SXPATH",122,0) 5460 . W ZW2,! 5461 "RTN","C0SXPATH",123,0) 5462 . S ZN=OUTXPG_"("_ZW2_")" 5463 "RTN","C0SXPATH",124,0) 5464 . S @ZN=@INVDX@(ZI) 5465 "RTN","C0SXPATH",125,0) 5466 Q 5467 "RTN","C0SXPATH",126,0) 5468 ; 5469 "RTN","C0SXPATH",127,0) 5470 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY 5471 "RTN","C0SXPATH",128,0) 5472 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE 5473 "RTN","C0SXPATH",129,0) 5474 ; 5475 "RTN","C0SXPATH",130,0) 5476 ;N G1 5477 "RTN","C0SXPATH",131,0) 5478 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED 5479 "RTN","C0SXPATH",132,0) 5480 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM 5481 "RTN","C0SXPATH",133,0) 5482 Q 5483 "RTN","C0SXPATH",134,0) 5484 ; 5485 "RTN","C0SXPATH",135,0) 5486 DO 5487 "RTN","C0SXPATH",136,0) 5488 D XPG2XML("^GPL2B","^GPL2A") 5489 "RTN","C0SXPATH",137,0) 5490 Q 5491 "RTN","C0SXPATH",138,0) 5492 ; 5493 "RTN","C0SXPATH",139,0) 5494 T1 ; TEST OUT THESE ROUTINES 5495 "RTN","C0SXPATH",140,0) 5496 D XML2XPG("G2","^GPL") 5497 "RTN","C0SXPATH",141,0) 5498 D XPG2XML("G3","G2") 5499 "RTN","C0SXPATH",142,0) 5500 K ^GPLOUT 5501 "RTN","C0SXPATH",143,0) 5502 M ^GPLOUT=G3 5503 "RTN","C0SXPATH",144,0) 5504 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") 5505 "RTN","C0SXPATH",145,0) 5506 Q 5507 "RTN","C0SXPATH",146,0) 5508 ; 5509 "RTN","C0SXPATH",147,0) 5510 XPG2XML(OUTXML,INXPG) ; 5511 "RTN","C0SXPATH",148,0) 5512 N C0CN,FWD,ZA,G,GA,ZQ 5513 "RTN","C0SXPATH",149,0) 5514 S ZQ=0 ; QUIT FLAG 5515 "RTN","C0SXPATH",150,0) 5516 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING 5517 "RTN","C0SXPATH",151,0) 5518 . I '$D(C0CN) D ; FIRST TIME THROUGH 5519 "RTN","C0SXPATH",152,0) 5520 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR 5521 "RTN","C0SXPATH",153,0) 5522 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS 5523 "RTN","C0SXPATH",154,0) 5524 . . S G=$Q(@INXPG) ; THIS ONE 5525 "RTN","C0SXPATH",155,0) 5526 . . S GN=$Q(@G) ; NEXT ONE 5527 "RTN","C0SXPATH",156,0) 5528 . . S C0CN=1 ; SUBSCRIPT COUNT 5529 "RTN","C0SXPATH",157,0) 5530 . . S ZQ=0 ; QUIT FLAG 5531 "RTN","C0SXPATH",158,0) 5532 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML 5533 "RTN","C0SXPATH",159,0) 5534 . . I $QS(G,1)="ContinuityOfCareRecord" D ; 5535 "RTN","C0SXPATH",160,0) 5536 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK 5537 "RTN","C0SXPATH",161,0) 5538 . I FWD D ; GOING FORWARDS 5539 "RTN","C0SXPATH",162,0) 5540 . . I C0CN<$QL(G) D ; NOT A DATA NODE 5541 "RTN","C0SXPATH",163,0) 5542 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 5543 "RTN","C0SXPATH",164,0) 5544 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT 5545 "RTN","C0SXPATH",165,0) 5546 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ; 5547 "RTN","C0SXPATH",166,0) 5548 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">" 5549 "RTN","C0SXPATH",167,0) 5550 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE 5551 "RTN","C0SXPATH",168,0) 5552 . . E D ; AT THE DATA NODE 5553 "RTN","C0SXPATH",169,0) 5554 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT 5555 "RTN","C0SXPATH",170,0) 5556 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE 5557 "RTN","C0SXPATH",171,0) 5558 . . . S FWD=0 ; GO BACKWARDS 5559 "RTN","C0SXPATH",172,0) 5560 . I 'FWD D ;GOING BACKWARDS 5561 "RTN","C0SXPATH",173,0) 5562 . . S GN=$Q(@G) ;NEXT XPATH 5563 "RTN","C0SXPATH",174,0) 5564 . . ;W "NEXT!",GN,! 5565 "RTN","C0SXPATH",175,0) 5566 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT 5567 "RTN","C0SXPATH",176,0) 5568 . . I GN'="" D ; 5569 "RTN","C0SXPATH",177,0) 5570 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT 5571 "RTN","C0SXPATH",178,0) 5572 . . . . D ZXC($QS(G,C0CN)) ; 5573 "RTN","C0SXPATH",179,0) 5574 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL 5575 "RTN","C0SXPATH",180,0) 5576 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH 5577 "RTN","C0SXPATH",181,0) 5578 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT 5579 "RTN","C0SXPATH",182,0) 5580 . . . . S FWD=1 ; GOING FORWARD NOW 5581 "RTN","C0SXPATH",183,0) 5582 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE 5583 "RTN","C0SXPATH",184,0) 5584 . . D ZXC($QS(G,C0CN)) ; LAST ONE 5585 "RTN","C0SXPATH",185,0) 5586 . . S ZQ=1 ; QUIT NOW 5587 "RTN","C0SXPATH",186,0) 5588 Q 5589 "RTN","C0SXPATH",187,0) 5590 ; 5591 "RTN","C0SXPATH",188,0) 5592 ZXO(WHAT) 5593 "RTN","C0SXPATH",189,0) 5594 D PUSH("GA",WHAT) 5595 "RTN","C0SXPATH",190,0) 5596 D PUSH(OUTXML,"<"_WHAT_">") 5597 "RTN","C0SXPATH",191,0) 5598 Q 5599 "RTN","C0SXPATH",192,0) 5600 ; 5601 "RTN","C0SXPATH",193,0) 5602 ZXC(WHAT) 5603 "RTN","C0SXPATH",194,0) 5604 D POP("GA",.TMP) 5605 "RTN","C0SXPATH",195,0) 5606 D PUSH(OUTXML,"</"_WHAT_">") 5607 "RTN","C0SXPATH",196,0) 5608 Q 5609 "RTN","C0SXPATH",197,0) 5610 ; 5611 "RTN","C0SXPATH",198,0) 5612 ZXVAL(WHAT,VAL) 5613 "RTN","C0SXPATH",199,0) 5614 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">") 5615 "RTN","C0SXPATH",200,0) 5616 Q 5617 "RTN","C0SXPATH",201,0) 5618 ; 5619 "RTN","C0SXPATH",202,0) 5620 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce 5621 "RTN","C0SXPATH",203,0) 5622 ; an XPATH index; REDUX is a string to be removed from each xpath 5623 "RTN","C0SXPATH",204,0) 5624 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME 5625 "RTN","C0SXPATH",205,0) 5626 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE 5627 "RTN","C0SXPATH",206,0) 5628 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG 5629 "RTN","C0SXPATH",207,0) 5630 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME 5631 "RTN","C0SXPATH",208,0) 5632 ; @VDX@("XPATH")=VALUE 5633 "RTN","C0SXPATH",209,0) 5634 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE 5635 "RTN","C0SXPATH",210,0) 5636 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE 5637 "RTN","C0SXPATH",211,0) 5638 ; XML SECTION 5639 "RTN","C0SXPATH",212,0) 5640 ; IZXML IS PASSED BY NAME 5641 "RTN","C0SXPATH",213,0) 5642 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE 5643 "RTN","C0SXPATH",214,0) 5644 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT 5645 "RTN","C0SXPATH",215,0) 5646 N C0CSTK ; LEAVE OUT FOR DEBUGGING 5647 "RTN","C0SXPATH",216,0) 5648 I '$D(REDUX) S REDUX="" 5649 "RTN","C0SXPATH",217,0) 5650 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX 5651 "RTN","C0SXPATH",218,0) 5652 N ZXML 5653 "RTN","C0SXPATH",219,0) 5654 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD 5655 "RTN","C0SXPATH",220,0) 5656 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP 5657 "RTN","C0SXPATH",221,0) 5658 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM 5659 "RTN","C0SXPATH",222,0) 5660 . S I="",LCNT=0 5661 "RTN","C0SXPATH",223,0) 5662 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 5663 "RTN","C0SXPATH",224,0) 5664 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY 5665 "RTN","C0SXPATH",225,0) 5666 I LCNT=0 D Q ; NO XML PASSED 5667 "RTN","C0SXPATH",226,0) 5668 . W "ERROR IN XML FILE",! 5669 "RTN","C0SXPATH",227,0) 5670 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX 5671 "RTN","C0SXPATH",228,0) 5672 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX 5673 "RTN","C0SXPATH",229,0) 5674 S C0CSTK(0)=0 ; INITIALIZE STACK 5675 "RTN","C0SXPATH",230,0) 5676 K LKASD ; KILL LOOKASIDE ARRAY 5677 "RTN","C0SXPATH",231,0) 5678 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES 5679 "RTN","C0SXPATH",232,0) 5680 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY 5681 "RTN","C0SXPATH",233,0) 5682 . S LINE=@IZXML@(I) 5683 "RTN","C0SXPATH",234,0) 5684 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED 5685 "RTN","C0SXPATH",235,0) 5686 . . S @TEMPLATE@(I)=$$CLEAN(LINE) 5687 "RTN","C0SXPATH",236,0) 5688 . ;W LINE,! 5689 "RTN","C0SXPATH",237,0) 5690 . S FOUND=0 ; INTIALIZED FOUND FLAG 5691 "RTN","C0SXPATH",238,0) 5692 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS 5693 "RTN","C0SXPATH",239,0) 5694 . I FOUND'=1 D 5695 "RTN","C0SXPATH",240,0) 5696 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D 5697 "RTN","C0SXPATH",241,0) 5698 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS 5699 "RTN","C0SXPATH",242,0) 5700 . . . ; ON THE SAME LINE 5701 "RTN","C0SXPATH",243,0) 5702 . . . ; W "FOUND ",LINE,! 5703 "RTN","C0SXPATH",244,0) 5704 . . . S FOUND=1 ; SET FOUND FLAG 5705 "RTN","C0SXPATH",245,0) 5706 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 5707 "RTN","C0SXPATH",246,0) 5708 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 5709 "RTN","C0SXPATH",247,0) 5710 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 5711 "RTN","C0SXPATH",248,0) 5712 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX 5713 "RTN","C0SXPATH",249,0) 5714 . . . ; W "MDX=",MDX,! 5715 "RTN","C0SXPATH",250,0) 5716 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 5717 "RTN","C0SXPATH",251,0) 5718 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 5719 "RTN","C0SXPATH",252,0) 5720 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 5721 "RTN","C0SXPATH",253,0) 5722 . . . . ;W "DUP:",MDX,! 5723 "RTN","C0SXPATH",254,0) 5724 . . . . ;I '$D(CURVAL) S CURVAL="" 5725 "RTN","C0SXPATH",255,0) 5726 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL 5727 "RTN","C0SXPATH",256,0) 5728 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 5729 "RTN","C0SXPATH",257,0) 5730 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 5731 "RTN","C0SXPATH",258,0) 5732 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST 5733 "RTN","C0SXPATH",259,0) 5734 . . . . S CURVAL=$$XVAL(LINE) ; VALUE 5735 "RTN","C0SXPATH",260,0) 5736 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE 5737 "RTN","C0SXPATH",261,0) 5738 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED 5739 "RTN","C0SXPATH",262,0) 5740 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED 5741 "RTN","C0SXPATH",263,0) 5742 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS 5743 "RTN","C0SXPATH",264,0) 5744 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2) 5745 "RTN","C0SXPATH",265,0) 5746 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 5747 "RTN","C0SXPATH",266,0) 5748 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END 5749 "RTN","C0SXPATH",267,0) 5750 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION 5751 "RTN","C0SXPATH",268,0) 5752 . . . ; W "FOUND ",LINE,! 5753 "RTN","C0SXPATH",269,0) 5754 . . . S FOUND=1 ; SET FOUND FLAG 5755 "RTN","C0SXPATH",270,0) 5756 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 5757 "RTN","C0SXPATH",271,0) 5758 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 5759 "RTN","C0SXPATH",272,0) 5760 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 5761 "RTN","C0SXPATH",273,0) 5762 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK 5763 "RTN","C0SXPATH",274,0) 5764 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE 5765 "RTN","C0SXPATH",275,0) 5766 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START 5767 "RTN","C0SXPATH",276,0) 5768 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,! 5769 "RTN","C0SXPATH",277,0) 5770 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING 5771 "RTN","C0SXPATH",278,0) 5772 . . . . Q 5773 "RTN","C0SXPATH",279,0) 5774 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING 5775 "RTN","C0SXPATH",280,0) 5776 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION 5777 "RTN","C0SXPATH",281,0) 5778 . . . ; W "FOUND ",LINE,! 5779 "RTN","C0SXPATH",282,0) 5780 . . . S FOUND=1 ; SET FOUND FLAG 5781 "RTN","C0SXPATH",283,0) 5782 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME 5783 "RTN","C0SXPATH",284,0) 5784 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES 5785 "RTN","C0SXPATH",285,0) 5786 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK 5787 "RTN","C0SXPATH",286,0) 5788 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX 5789 "RTN","C0SXPATH",287,0) 5790 . . . ; W "MDX=",MDX,! 5791 "RTN","C0SXPATH",288,0) 5792 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE 5793 "RTN","C0SXPATH",289,0) 5794 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER 5795 "RTN","C0SXPATH",290,0) 5796 . . . . ;B 5797 "RTN","C0SXPATH",291,0) 5798 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE 5799 "RTN","C0SXPATH",292,0) 5800 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX 5801 "RTN","C0SXPATH",293,0) 5802 S @ZXML@("INDEXED")="" 5803 "RTN","C0SXPATH",294,0) 5804 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH 5805 "RTN","C0SXPATH",295,0) 5806 I NOINX K @ZXML ; DELETE UNWANTED INDEX 5807 "RTN","C0SXPATH",296,0) 5808 Q 5809 "RTN","C0SXPATH",297,0) 5810 ; 5811 "RTN","C0SXPATH",298,0) 5812 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES 5813 "RTN","C0SXPATH",299,0) 5814 ; 5815 "RTN","C0SXPATH",300,0) 5816 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 5817 "RTN","C0SXPATH",301,0) 5818 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY 5819 "RTN","C0SXPATH",302,0) 5820 . S ZLINE=@IZXML@(ZI) 5821 "RTN","C0SXPATH",303,0) 5822 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1) 5823 "RTN","C0SXPATH",304,0) 5824 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION 5825 "RTN","C0SXPATH",305,0) 5826 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME 5827 "RTN","C0SXPATH",306,0) 5828 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION 5829 "RTN","C0SXPATH",307,0) 5830 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME 5831 "RTN","C0SXPATH",308,0) 5832 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE 5833 "RTN","C0SXPATH",309,0) 5834 . . . . S OUTBUF(CUR,ZI+1)="" 5835 "RTN","C0SXPATH",310,0) 5836 ;ZWR OUTBUF 5837 "RTN","C0SXPATH",311,0) 5838 S ZI="" 5839 "RTN","C0SXPATH",312,0) 5840 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE 5841 "RTN","C0SXPATH",313,0) 5842 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE 5843 "RTN","C0SXPATH",314,0) 5844 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; 5845 "RTN","C0SXPATH",315,0) 5846 . S OUTBUF(ZI,ZN)="" 5847 "RTN","C0SXPATH",316,0) 5848 S ZA=1,ZI="",ZN="" 5849 "RTN","C0SXPATH",317,0) 5850 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] 5851 "RTN","C0SXPATH",318,0) 5852 . S ZN="",ZA=1 5853 "RTN","C0SXPATH",319,0) 5854 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; 5855 "RTN","C0SXPATH",320,0) 5856 . . S OUTBUF(ZI,ZN)="["_ZA_"]" 5857 "RTN","C0SXPATH",321,0) 5858 . . S ZA=ZA+1 5859 "RTN","C0SXPATH",322,0) 5860 Q 5861 "RTN","C0SXPATH",323,0) 5862 ; 5863 "RTN","C0SXPATH",324,0) 5864 CLEAN(STR,TR) ; extrinsic function; returns string 5865 "RTN","C0SXPATH",325,0) 5866 ;; Removes all non printable characters from a string. 5867 "RTN","C0SXPATH",326,0) 5868 ;; STR by Value 5869 "RTN","C0SXPATH",327,0) 5870 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE 5871 "RTN","C0SXPATH",328,0) 5872 N TR,I 5873 "RTN","C0SXPATH",329,0) 5874 I '$D(TR) D ; 5875 "RTN","C0SXPATH",330,0) 5876 . F I=0:1:31 S TR=$G(TR)_$C(I) 5877 "RTN","C0SXPATH",331,0) 5878 . S TR=TR_$C(127) 5879 "RTN","C0SXPATH",332,0) 5880 QUIT $TR(STR,TR) 5881 "RTN","C0SXPATH",333,0) 5882 ; 5883 "RTN","C0SXPATH",334,0) 5884 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION 5885 "RTN","C0SXPATH",335,0) 5886 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" 5887 "RTN","C0SXPATH",336,0) 5888 ; IARY AND OARY ARE PASSED BY NAME 5889 "RTN","C0SXPATH",337,0) 5890 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY 5891 "RTN","C0SXPATH",338,0) 5892 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML 5893 "RTN","C0SXPATH",339,0) 5894 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN 5895 "RTN","C0SXPATH",340,0) 5896 N TMP,I,J,QXPATH 5897 "RTN","C0SXPATH",341,0) 5898 S FIRST=1 5899 "RTN","C0SXPATH",342,0) 5900 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE 5901 "RTN","C0SXPATH",343,0) 5902 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK 5903 "RTN","C0SXPATH",344,0) 5904 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT 5905 "RTN","C0SXPATH",345,0) 5906 I XPATH'="//" D ; NOT A ROOT QUERY 5907 "RTN","C0SXPATH",346,0) 5908 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES 5909 "RTN","C0SXPATH",347,0) 5910 . S FIRST=$P(TMP,"^",1) 5911 "RTN","C0SXPATH",348,0) 5912 . S LAST=$P(TMP,"^",2) 5913 "RTN","C0SXPATH",349,0) 5914 K @OARY 5915 "RTN","C0SXPATH",350,0) 5916 S @OARY@(0)=+LAST-FIRST+1 5917 "RTN","C0SXPATH",351,0) 5918 S J=1 5919 "RTN","C0SXPATH",352,0) 5920 FOR I=FIRST:1:LAST D 5921 "RTN","C0SXPATH",353,0) 5922 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY 5923 "RTN","C0SXPATH",354,0) 5924 . S J=J+1 5925 "RTN","C0SXPATH",355,0) 5926 ; ZWR OARY 5927 "RTN","C0SXPATH",356,0) 5928 Q 5929 "RTN","C0SXPATH",357,0) 5930 ; 5931 "RTN","C0SXPATH",358,0) 5932 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH 5933 "RTN","C0SXPATH",359,0) 5934 ; INDEX WITH TWO PIECES START^FINISH 5935 "RTN","C0SXPATH",360,0) 5936 ; IDX IS PASSED BY NAME 5937 "RTN","C0SXPATH",361,0) 5938 Q $P(@IDX@(XPATH),"^",1) 5939 "RTN","C0SXPATH",362,0) 5940 ; 5941 "RTN","C0SXPATH",363,0) 5942 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH 5943 "RTN","C0SXPATH",364,0) 5944 ; INDEX WITH TWO PIECES START^FINISH 5945 "RTN","C0SXPATH",365,0) 5946 ; IDX IS PASSED BY NAME 5947 "RTN","C0SXPATH",366,0) 5948 Q $P(@IDX@(XPATH),"^",2) 5949 "RTN","C0SXPATH",367,0) 5950 ; 5951 "RTN","C0SXPATH",368,0) 5952 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX 5953 "RTN","C0SXPATH",369,0) 5954 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 5955 "RTN","C0SXPATH",370,0) 5956 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME 5957 "RTN","C0SXPATH",371,0) 5958 Q $P(ISTR,";",2) 5959 "RTN","C0SXPATH",372,0) 5960 ; 5961 "RTN","C0SXPATH",373,0) 5962 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX 5963 "RTN","C0SXPATH",374,0) 5964 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 5965 "RTN","C0SXPATH",375,0) 5966 Q $P(ISTR,";",3) 5967 "RTN","C0SXPATH",376,0) 5968 ; 5969 "RTN","C0SXPATH",377,0) 5970 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX 5971 "RTN","C0SXPATH",378,0) 5972 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH 5973 "RTN","C0SXPATH",379,0) 5974 Q $P(ISTR,";",1) 5975 "RTN","C0SXPATH",380,0) 5976 ; 5977 "RTN","C0SXPATH",381,0) 5978 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST 5979 "RTN","C0SXPATH",382,0) 5980 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST 5981 "RTN","C0SXPATH",383,0) 5982 ; DEST IS CLEARED TO START 5983 "RTN","C0SXPATH",384,0) 5984 ; USES PUSH TO DO THE COPY 5985 "RTN","C0SXPATH",385,0) 5366 5986 N I 5367 "RTN","C0SXPATH",64,0)5368 ; W "STK= ",STK,!5369 "RTN","C0SXPATH",65,0)5370 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY5371 "RTN","C0SXPATH",66,0)5372 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON5373 "RTN","C0SXPATH",67,0)5374 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON5375 "RTN","C0SXPATH",68,0)5376 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)5377 "RTN","C0SXPATH",69,0)5378 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)5379 "RTN","C0SXPATH",70,0)5380 Q5381 "RTN","C0SXPATH",71,0)5382 ;5383 "RTN","C0SXPATH",72,0)5384 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG5385 "RTN","C0SXPATH",73,0)5386 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME5387 "RTN","C0SXPATH",74,0)5388 ; ISTR IS PASSED BY VALUE5389 "RTN","C0SXPATH",75,0)5390 N CUR,TMP5391 "RTN","C0SXPATH",76,0)5392 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET5393 "RTN","C0SXPATH",77,0)5394 . S TMP=$P(ISTR,"<",2)5395 "RTN","C0SXPATH",78,0)5396 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>5397 "RTN","C0SXPATH",79,0)5398 . S TMP=$P(TMP,"/",2)5399 "RTN","C0SXPATH",80,0)5400 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME5401 "RTN","C0SXPATH",81,0)5402 ; W "CUR= ",CUR,!5403 "RTN","C0SXPATH",82,0)5404 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>5405 "RTN","C0SXPATH",83,0)5406 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER5407 "RTN","C0SXPATH",84,0)5408 ; W "CUR2= ",CUR,!5409 "RTN","C0SXPATH",85,0)5410 Q CUR5411 "RTN","C0SXPATH",86,0)5412 ;5413 "RTN","C0SXPATH",87,0)5414 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML5415 "RTN","C0SXPATH",88,0)5416 ; <NAME>VALUE</NAME> WILL RETURN VALUE5417 "RTN","C0SXPATH",89,0)5418 N G5419 "RTN","C0SXPATH",90,0)5420 S G=$P(ISTR,">",2) ;STRIP OFF <NAME>5421 "RTN","C0SXPATH",91,0)5422 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE5423 "RTN","C0SXPATH",92,0)5424 ;5425 "RTN","C0SXPATH",93,0)5426 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV5427 "RTN","C0SXPATH",94,0)5428 ; VDX: @INVDX@(XPATH)=VALUE5429 "RTN","C0SXPATH",95,0)5430 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE5431 "RTN","C0SXPATH",96,0)5432 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE5433 "RTN","C0SXPATH",97,0)5434 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS5435 "RTN","C0SXPATH",98,0)5436 ; @VDV@("XPATH",X1X2X3X4)="XPATH"5437 "RTN","C0SXPATH",99,0)5438 N ZA,ZI,ZW5439 "RTN","C0SXPATH",100,0)5440 S ZI=""5441 "RTN","C0SXPATH",101,0)5442 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;5443 "RTN","C0SXPATH",102,0)5444 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME5445 "RTN","C0SXPATH",103,0)5446 . W ZW,!5447 "RTN","C0SXPATH",104,0)5448 . S @OUTVDV@(ZW)=@INVDX@(ZI)5449 "RTN","C0SXPATH",105,0)5450 . S @OUTVDV@("XPATH",ZW)=ZI5451 "RTN","C0SXPATH",106,0)5452 Q5453 "RTN","C0SXPATH",107,0)5454 ;5455 "RTN","C0SXPATH",108,0)5456 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG5457 "RTN","C0SXPATH",109,0)5458 ; VDX: @VDX@(XPATH)=VALUE5459 "RTN","C0SXPATH",110,0)5460 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE5461 "RTN","C0SXPATH",111,0)5462 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX5463 "RTN","C0SXPATH",112,0)5464 N ZA,ZI,ZW5465 "RTN","C0SXPATH",113,0)5466 S ZI=""5467 "RTN","C0SXPATH",114,0)5468 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;5469 "RTN","C0SXPATH",115,0)5470 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //5471 "RTN","C0SXPATH",116,0)5472 . S ZW2=$P(ZW,"/",1)5473 "RTN","C0SXPATH",117,0)5474 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))5475 "RTN","C0SXPATH",118,0)5476 . ;ZWR ZA5477 "RTN","C0SXPATH",119,0)5478 . S ZW2=ZA(1)5479 "RTN","C0SXPATH",120,0)5480 . F ZK=2:1:ZA(0) D ;5481 "RTN","C0SXPATH",121,0)5482 . . S ZW2=ZW2_""","""_ZA(ZK)5483 "RTN","C0SXPATH",122,0)5484 . K ZA5485 "RTN","C0SXPATH",123,0)5486 . S ZW2=""""_ZW2_""""5487 "RTN","C0SXPATH",124,0)5488 . W ZW2,!5489 "RTN","C0SXPATH",125,0)5490 . S ZN=OUTXPG_"("_ZW2_")"5491 "RTN","C0SXPATH",126,0)5492 . S @ZN=@INVDX@(ZI)5493 "RTN","C0SXPATH",127,0)5494 Q5495 "RTN","C0SXPATH",128,0)5496 ;5497 "RTN","C0SXPATH",129,0)5498 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY5499 "RTN","C0SXPATH",130,0)5500 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE5501 "RTN","C0SXPATH",131,0)5502 ;5503 "RTN","C0SXPATH",132,0)5504 ;N G15505 "RTN","C0SXPATH",133,0)5506 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED5507 "RTN","C0SXPATH",134,0)5508 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM5509 "RTN","C0SXPATH",135,0)5510 Q5511 "RTN","C0SXPATH",136,0)5512 ;5513 "RTN","C0SXPATH",137,0)5514 DO5515 "RTN","C0SXPATH",138,0)5516 D XPG2XML("^GPL2B","^GPL2A")5517 "RTN","C0SXPATH",139,0)5518 Q5519 "RTN","C0SXPATH",140,0)5520 ;5521 "RTN","C0SXPATH",141,0)5522 T1 ; TEST OUT THESE ROUTINES5523 "RTN","C0SXPATH",142,0)5524 D XML2XPG("G2","^GPL")5525 "RTN","C0SXPATH",143,0)5526 D XPG2XML("G3","G2")5527 "RTN","C0SXPATH",144,0)5528 K ^GPLOUT5529 "RTN","C0SXPATH",145,0)5530 M ^GPLOUT=G35531 "RTN","C0SXPATH",146,0)5532 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")5533 "RTN","C0SXPATH",147,0)5534 Q5535 "RTN","C0SXPATH",148,0)5536 ;5537 "RTN","C0SXPATH",149,0)5538 XPG2XML(OUTXML,INXPG) ;5539 "RTN","C0SXPATH",150,0)5540 N C0CN,FWD,ZA,G,GA,ZQ5541 "RTN","C0SXPATH",151,0)5542 S ZQ=0 ; QUIT FLAG5543 "RTN","C0SXPATH",152,0)5544 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING5545 "RTN","C0SXPATH",153,0)5546 . I '$D(C0CN) D ; FIRST TIME THROUGH5547 "RTN","C0SXPATH",154,0)5548 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR5549 "RTN","C0SXPATH",155,0)5550 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS5551 "RTN","C0SXPATH",156,0)5552 . . S G=$Q(@INXPG) ; THIS ONE5553 "RTN","C0SXPATH",157,0)5554 . . S GN=$Q(@G) ; NEXT ONE5555 "RTN","C0SXPATH",158,0)5556 . . S C0CN=1 ; SUBSCRIPT COUNT5557 "RTN","C0SXPATH",159,0)5558 . . S ZQ=0 ; QUIT FLAG5559 "RTN","C0SXPATH",160,0)5560 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML5561 "RTN","C0SXPATH",161,0)5562 . . I $QS(G,1)="ContinuityOfCareRecord" D ;5563 "RTN","C0SXPATH",162,0)5564 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK5565 "RTN","C0SXPATH",163,0)5566 . I FWD D ; GOING FORWARDS5567 "RTN","C0SXPATH",164,0)5568 . . I C0CN<$QL(G) D ; NOT A DATA NODE5569 "RTN","C0SXPATH",165,0)5570 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT5571 "RTN","C0SXPATH",166,0)5572 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT5573 "RTN","C0SXPATH",167,0)5574 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ;5575 "RTN","C0SXPATH",168,0)5576 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"5577 "RTN","C0SXPATH",169,0)5578 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE5579 "RTN","C0SXPATH",170,0)5580 . . E D ; AT THE DATA NODE5581 "RTN","C0SXPATH",171,0)5582 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT5583 "RTN","C0SXPATH",172,0)5584 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE5585 "RTN","C0SXPATH",173,0)5586 . . . S FWD=0 ; GO BACKWARDS5587 "RTN","C0SXPATH",174,0)5588 . I 'FWD D ;GOING BACKWARDS5589 "RTN","C0SXPATH",175,0)5590 . . S GN=$Q(@G) ;NEXT XPATH5591 "RTN","C0SXPATH",176,0)5592 . . ;W "NEXT!",GN,!5593 "RTN","C0SXPATH",177,0)5594 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT5595 "RTN","C0SXPATH",178,0)5596 . . I GN'="" D ;5597 "RTN","C0SXPATH",179,0)5598 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT5599 "RTN","C0SXPATH",180,0)5600 . . . . D ZXC($QS(G,C0CN)) ;5601 "RTN","C0SXPATH",181,0)5602 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL5603 "RTN","C0SXPATH",182,0)5604 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH5605 "RTN","C0SXPATH",183,0)5606 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT5607 "RTN","C0SXPATH",184,0)5608 . . . . S FWD=1 ; GOING FORWARD NOW5609 "RTN","C0SXPATH",185,0)5610 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE5611 "RTN","C0SXPATH",186,0)5612 . . D ZXC($QS(G,C0CN)) ; LAST ONE5613 "RTN","C0SXPATH",187,0)5614 . . S ZQ=1 ; QUIT NOW5615 "RTN","C0SXPATH",188,0)5616 Q5617 "RTN","C0SXPATH",189,0)5618 ;5619 "RTN","C0SXPATH",190,0)5620 ZXO(WHAT)5621 "RTN","C0SXPATH",191,0)5622 D PUSH("GA",WHAT)5623 "RTN","C0SXPATH",192,0)5624 D PUSH(OUTXML,"<"_WHAT_">")5625 "RTN","C0SXPATH",193,0)5626 Q5627 "RTN","C0SXPATH",194,0)5628 ;5629 "RTN","C0SXPATH",195,0)5630 ZXC(WHAT)5631 "RTN","C0SXPATH",196,0)5632 D POP("GA",.TMP)5633 "RTN","C0SXPATH",197,0)5634 D PUSH(OUTXML,"</"_WHAT_">")5635 "RTN","C0SXPATH",198,0)5636 Q5637 "RTN","C0SXPATH",199,0)5638 ;5639 "RTN","C0SXPATH",200,0)5640 ZXVAL(WHAT,VAL)5641 "RTN","C0SXPATH",201,0)5642 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")5643 "RTN","C0SXPATH",202,0)5644 Q5645 "RTN","C0SXPATH",203,0)5646 ;5647 "RTN","C0SXPATH",204,0)5648 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce5649 "RTN","C0SXPATH",205,0)5650 ; an XPATH index; REDUX is a string to be removed from each xpath5651 "RTN","C0SXPATH",206,0)5652 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME5653 "RTN","C0SXPATH",207,0)5654 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE5655 "RTN","C0SXPATH",208,0)5656 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG5657 "RTN","C0SXPATH",209,0)5658 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME5659 "RTN","C0SXPATH",210,0)5660 ; @VDX@("XPATH")=VALUE5661 "RTN","C0SXPATH",211,0)5662 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE5663 "RTN","C0SXPATH",212,0)5664 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE5665 "RTN","C0SXPATH",213,0)5666 ; XML SECTION5667 "RTN","C0SXPATH",214,0)5668 ; IZXML IS PASSED BY NAME5669 "RTN","C0SXPATH",215,0)5670 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE5671 "RTN","C0SXPATH",216,0)5672 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT5673 "RTN","C0SXPATH",217,0)5674 N C0CSTK ; LEAVE OUT FOR DEBUGGING5675 "RTN","C0SXPATH",218,0)5676 I '$D(REDUX) S REDUX=""5677 "RTN","C0SXPATH",219,0)5678 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX5679 "RTN","C0SXPATH",220,0)5680 N ZXML5681 "RTN","C0SXPATH",221,0)5682 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD5683 "RTN","C0SXPATH",222,0)5684 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP5685 "RTN","C0SXPATH",223,0)5686 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM5687 "RTN","C0SXPATH",224,0)5688 . S I="",LCNT=05689 "RTN","C0SXPATH",225,0)5690 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+15691 "RTN","C0SXPATH",226,0)5692 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY5693 "RTN","C0SXPATH",227,0)5694 I LCNT=0 D Q ; NO XML PASSED5695 "RTN","C0SXPATH",228,0)5696 . W "ERROR IN XML FILE",!5697 "RTN","C0SXPATH",229,0)5698 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX5699 "RTN","C0SXPATH",230,0)5700 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX5701 "RTN","C0SXPATH",231,0)5702 S C0CSTK(0)=0 ; INITIALIZE STACK5703 "RTN","C0SXPATH",232,0)5704 K LKASD ; KILL LOOKASIDE ARRAY5705 "RTN","C0SXPATH",233,0)5706 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES5707 "RTN","C0SXPATH",234,0)5708 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY5709 "RTN","C0SXPATH",235,0)5710 . S LINE=@IZXML@(I)5711 "RTN","C0SXPATH",236,0)5712 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED5713 "RTN","C0SXPATH",237,0)5714 . . S @TEMPLATE@(I)=$$CLEAN(LINE)5715 "RTN","C0SXPATH",238,0)5716 . ;W LINE,!5717 "RTN","C0SXPATH",239,0)5718 . S FOUND=0 ; INTIALIZED FOUND FLAG5719 "RTN","C0SXPATH",240,0)5720 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS5721 "RTN","C0SXPATH",241,0)5722 . I FOUND'=1 D5723 "RTN","C0SXPATH",242,0)5724 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D5725 "RTN","C0SXPATH",243,0)5726 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS5727 "RTN","C0SXPATH",244,0)5728 . . . ; ON THE SAME LINE5729 "RTN","C0SXPATH",245,0)5730 . . . ; W "FOUND ",LINE,!5731 "RTN","C0SXPATH",246,0)5732 . . . S FOUND=1 ; SET FOUND FLAG5733 "RTN","C0SXPATH",247,0)5734 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME5735 "RTN","C0SXPATH",248,0)5736 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES5737 "RTN","C0SXPATH",249,0)5738 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK5739 "RTN","C0SXPATH",250,0)5740 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX5741 "RTN","C0SXPATH",251,0)5742 . . . ; W "MDX=",MDX,!5743 "RTN","C0SXPATH",252,0)5744 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE5745 "RTN","C0SXPATH",253,0)5746 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=25747 "RTN","C0SXPATH",254,0)5748 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+15749 "RTN","C0SXPATH",255,0)5750 . . . . ;W "DUP:",MDX,!5751 "RTN","C0SXPATH",256,0)5752 . . . . ;I '$D(CURVAL) S CURVAL=""5753 "RTN","C0SXPATH",257,0)5754 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL5755 "RTN","C0SXPATH",258,0)5756 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER5757 "RTN","C0SXPATH",259,0)5758 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE5759 "RTN","C0SXPATH",260,0)5760 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST5761 "RTN","C0SXPATH",261,0)5762 . . . . S CURVAL=$$XVAL(LINE) ; VALUE5763 "RTN","C0SXPATH",262,0)5764 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE5765 "RTN","C0SXPATH",263,0)5766 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED5767 "RTN","C0SXPATH",264,0)5768 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED5769 "RTN","C0SXPATH",265,0)5770 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS5771 "RTN","C0SXPATH",266,0)5772 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)5773 "RTN","C0SXPATH",267,0)5774 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK5775 "RTN","C0SXPATH",268,0)5776 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END5777 "RTN","C0SXPATH",269,0)5778 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION5779 "RTN","C0SXPATH",270,0)5780 . . . ; W "FOUND ",LINE,!5781 "RTN","C0SXPATH",271,0)5782 . . . S FOUND=1 ; SET FOUND FLAG5783 "RTN","C0SXPATH",272,0)5784 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME5785 "RTN","C0SXPATH",273,0)5786 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX5787 "RTN","C0SXPATH",274,0)5788 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER5789 "RTN","C0SXPATH",275,0)5790 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK5791 "RTN","C0SXPATH",276,0)5792 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE5793 "RTN","C0SXPATH",277,0)5794 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START5795 "RTN","C0SXPATH",278,0)5796 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!5797 "RTN","C0SXPATH",279,0)5798 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING5799 "RTN","C0SXPATH",280,0)5800 . . . . Q5801 "RTN","C0SXPATH",281,0)5802 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING5803 "RTN","C0SXPATH",282,0)5804 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION5805 "RTN","C0SXPATH",283,0)5806 . . . ; W "FOUND ",LINE,!5807 "RTN","C0SXPATH",284,0)5808 . . . S FOUND=1 ; SET FOUND FLAG5809 "RTN","C0SXPATH",285,0)5810 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME5811 "RTN","C0SXPATH",286,0)5812 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES5813 "RTN","C0SXPATH",287,0)5814 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK5815 "RTN","C0SXPATH",288,0)5816 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX5817 "RTN","C0SXPATH",289,0)5818 . . . ; W "MDX=",MDX,!5819 "RTN","C0SXPATH",290,0)5820 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE5821 "RTN","C0SXPATH",291,0)5822 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER5823 "RTN","C0SXPATH",292,0)5824 . . . . ;B5825 "RTN","C0SXPATH",293,0)5826 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE5827 "RTN","C0SXPATH",294,0)5828 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX5829 "RTN","C0SXPATH",295,0)5830 S @ZXML@("INDEXED")=""5831 "RTN","C0SXPATH",296,0)5832 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH5833 "RTN","C0SXPATH",297,0)5834 I NOINX K @ZXML ; DELETE UNWANTED INDEX5835 "RTN","C0SXPATH",298,0)5836 Q5837 "RTN","C0SXPATH",299,0)5838 ;5839 "RTN","C0SXPATH",300,0)5840 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES5841 "RTN","C0SXPATH",301,0)5842 ;5843 "RTN","C0SXPATH",302,0)5844 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR25845 "RTN","C0SXPATH",303,0)5846 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY5847 "RTN","C0SXPATH",304,0)5848 . S ZLINE=@IZXML@(ZI)5849 "RTN","C0SXPATH",305,0)5850 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)5851 "RTN","C0SXPATH",306,0)5852 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION5853 "RTN","C0SXPATH",307,0)5854 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME5855 "RTN","C0SXPATH",308,0)5856 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION5857 "RTN","C0SXPATH",309,0)5858 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME5859 "RTN","C0SXPATH",310,0)5860 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE5861 "RTN","C0SXPATH",311,0)5862 . . . . S OUTBUF(CUR,ZI+1)=""5863 "RTN","C0SXPATH",312,0)5864 ;ZWR OUTBUF5865 "RTN","C0SXPATH",313,0)5866 S ZI=""5867 "RTN","C0SXPATH",314,0)5868 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE5869 "RTN","C0SXPATH",315,0)5870 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE5871 "RTN","C0SXPATH",316,0)5872 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ;5873 "RTN","C0SXPATH",317,0)5874 . S OUTBUF(ZI,ZN)=""5875 "RTN","C0SXPATH",318,0)5876 S ZA=1,ZI="",ZN=""5877 "RTN","C0SXPATH",319,0)5878 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x]5879 "RTN","C0SXPATH",320,0)5880 . S ZN="",ZA=15881 "RTN","C0SXPATH",321,0)5882 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ;5883 "RTN","C0SXPATH",322,0)5884 . . S OUTBUF(ZI,ZN)="["_ZA_"]"5885 "RTN","C0SXPATH",323,0)5886 . . S ZA=ZA+15887 "RTN","C0SXPATH",324,0)5888 Q5889 "RTN","C0SXPATH",325,0)5890 ;5891 "RTN","C0SXPATH",326,0)5892 CLEAN(STR,TR) ; extrinsic function; returns string5893 "RTN","C0SXPATH",327,0)5894 ;; Removes all non printable characters from a string.5895 "RTN","C0SXPATH",328,0)5896 ;; STR by Value5897 "RTN","C0SXPATH",329,0)5898 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE5899 "RTN","C0SXPATH",330,0)5900 N TR,I5901 "RTN","C0SXPATH",331,0)5902 I '$D(TR) D ;5903 "RTN","C0SXPATH",332,0)5904 . F I=0:1:31 S TR=$G(TR)_$C(I)5905 "RTN","C0SXPATH",333,0)5906 . S TR=TR_$C(127)5907 "RTN","C0SXPATH",334,0)5908 QUIT $TR(STR,TR)5909 "RTN","C0SXPATH",335,0)5910 ;5911 "RTN","C0SXPATH",336,0)5912 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION5913 "RTN","C0SXPATH",337,0)5914 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"5915 "RTN","C0SXPATH",338,0)5916 ; IARY AND OARY ARE PASSED BY NAME5917 "RTN","C0SXPATH",339,0)5918 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY5919 "RTN","C0SXPATH",340,0)5920 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML5921 "RTN","C0SXPATH",341,0)5922 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN5923 "RTN","C0SXPATH",342,0)5924 N TMP,I,J,QXPATH5925 "RTN","C0SXPATH",343,0)5926 S FIRST=15927 "RTN","C0SXPATH",344,0)5928 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE5929 "RTN","C0SXPATH",345,0)5930 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK5931 "RTN","C0SXPATH",346,0)5932 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT5933 "RTN","C0SXPATH",347,0)5934 I XPATH'="//" D ; NOT A ROOT QUERY5935 "RTN","C0SXPATH",348,0)5936 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES5937 "RTN","C0SXPATH",349,0)5938 . S FIRST=$P(TMP,"^",1)5939 "RTN","C0SXPATH",350,0)5940 . S LAST=$P(TMP,"^",2)5941 "RTN","C0SXPATH",351,0)5942 K @OARY5943 "RTN","C0SXPATH",352,0)5944 S @OARY@(0)=+LAST-FIRST+15945 "RTN","C0SXPATH",353,0)5946 S J=15947 "RTN","C0SXPATH",354,0)5948 FOR I=FIRST:1:LAST D5949 "RTN","C0SXPATH",355,0)5950 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY5951 "RTN","C0SXPATH",356,0)5952 . S J=J+15953 "RTN","C0SXPATH",357,0)5954 ; ZWR OARY5955 "RTN","C0SXPATH",358,0)5956 Q5957 "RTN","C0SXPATH",359,0)5958 ;5959 "RTN","C0SXPATH",360,0)5960 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH5961 "RTN","C0SXPATH",361,0)5962 ; INDEX WITH TWO PIECES START^FINISH5963 "RTN","C0SXPATH",362,0)5964 ; IDX IS PASSED BY NAME5965 "RTN","C0SXPATH",363,0)5966 Q $P(@IDX@(XPATH),"^",1)5967 "RTN","C0SXPATH",364,0)5968 ;5969 "RTN","C0SXPATH",365,0)5970 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH5971 "RTN","C0SXPATH",366,0)5972 ; INDEX WITH TWO PIECES START^FINISH5973 "RTN","C0SXPATH",367,0)5974 ; IDX IS PASSED BY NAME5975 "RTN","C0SXPATH",368,0)5976 Q $P(@IDX@(XPATH),"^",2)5977 "RTN","C0SXPATH",369,0)5978 ;5979 "RTN","C0SXPATH",370,0)5980 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX5981 "RTN","C0SXPATH",371,0)5982 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH5983 "RTN","C0SXPATH",372,0)5984 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME5985 "RTN","C0SXPATH",373,0)5986 Q $P(ISTR,";",2)5987 "RTN","C0SXPATH",374,0)5988 ;5989 "RTN","C0SXPATH",375,0)5990 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX5991 "RTN","C0SXPATH",376,0)5992 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH5993 "RTN","C0SXPATH",377,0)5994 Q $P(ISTR,";",3)5995 "RTN","C0SXPATH",378,0)5996 ;5997 "RTN","C0SXPATH",379,0)5998 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX5999 "RTN","C0SXPATH",380,0)6000 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH6001 "RTN","C0SXPATH",381,0)6002 Q $P(ISTR,";",1)6003 "RTN","C0SXPATH",382,0)6004 ;6005 "RTN","C0SXPATH",383,0)6006 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST6007 "RTN","C0SXPATH",384,0)6008 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST6009 "RTN","C0SXPATH",385,0)6010 ; DEST IS CLEARED TO START6011 5987 "RTN","C0SXPATH",386,0) 6012 ; USES PUSH TO DO THE COPY5988 K @BDEST 6013 5989 "RTN","C0SXPATH",387,0) 5990 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 5991 "RTN","C0SXPATH",388,0) 5992 . N J,ATMP 5993 "RTN","C0SXPATH",389,0) 5994 . S ATMP=$$ARRAY(@BLIST@(I)) 5995 "RTN","C0SXPATH",390,0) 5996 . I $G(DEBUG) W "ATMP=",ATMP,! 5997 "RTN","C0SXPATH",391,0) 5998 . I $G(DEBUG) W @BLIST@(I),! 5999 "RTN","C0SXPATH",392,0) 6000 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 6001 "RTN","C0SXPATH",393,0) 6002 . . ; FOR EACH LINE IN THIS INSTR 6003 "RTN","C0SXPATH",394,0) 6004 . . I $G(DEBUG) W "BDEST= ",BDEST,! 6005 "RTN","C0SXPATH",395,0) 6006 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 6007 "RTN","C0SXPATH",396,0) 6008 . . D PUSH(BDEST,@ATMP@(J)) 6009 "RTN","C0SXPATH",397,0) 6010 Q 6011 "RTN","C0SXPATH",398,0) 6012 ; 6013 "RTN","C0SXPATH",399,0) 6014 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 6015 "RTN","C0SXPATH",400,0) 6016 ; 6017 "RTN","C0SXPATH",401,0) 6018 I $G(DEBUG) W "QUEUEING ",BLST,! 6019 "RTN","C0SXPATH",402,0) 6020 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 6021 "RTN","C0SXPATH",403,0) 6022 Q 6023 "RTN","C0SXPATH",404,0) 6024 ; 6025 "RTN","C0SXPATH",405,0) 6026 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 6027 "RTN","C0SXPATH",406,0) 6028 ; KILLS CPDEST FIRST 6029 "RTN","C0SXPATH",407,0) 6030 N CPINSTR 6031 "RTN","C0SXPATH",408,0) 6032 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! 6033 "RTN","C0SXPATH",409,0) 6034 I @CPSRC@(0)<1 D ; BAD LENGTH 6035 "RTN","C0SXPATH",410,0) 6036 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 6037 "RTN","C0SXPATH",411,0) 6038 . Q 6039 "RTN","C0SXPATH",412,0) 6040 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 6041 "RTN","C0SXPATH",413,0) 6042 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 6043 "RTN","C0SXPATH",414,0) 6044 D BUILD("CPINSTR",CPDEST) 6045 "RTN","C0SXPATH",415,0) 6046 Q 6047 "RTN","C0SXPATH",416,0) 6048 ; 6049 "RTN","C0SXPATH",417,0) 6050 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 6051 "RTN","C0SXPATH",418,0) 6052 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 6053 "RTN","C0SXPATH",419,0) 6054 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 6055 "RTN","C0SXPATH",420,0) 6056 ; USED TO INSERT CHILDREN NODES 6057 "RTN","C0SXPATH",421,0) 6058 I @QOXML@(0)<1 D ; MALFORMED XML 6059 "RTN","C0SXPATH",422,0) 6060 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 6061 "RTN","C0SXPATH",423,0) 6062 . Q 6063 "RTN","C0SXPATH",424,0) 6064 I $G(DEBUG) W "DOING QOPEN",! 6065 "RTN","C0SXPATH",425,0) 6066 N S1,E1,QOT,QOTMP 6067 "RTN","C0SXPATH",426,0) 6068 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 6069 "RTN","C0SXPATH",427,0) 6070 I $D(QOXPATH) D ; XPATH PROVIDED 6071 "RTN","C0SXPATH",428,0) 6072 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 6073 "RTN","C0SXPATH",429,0) 6074 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 6075 "RTN","C0SXPATH",430,0) 6076 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 6077 "RTN","C0SXPATH",431,0) 6078 . S E1=@QOXML@(0)-1 6079 "RTN","C0SXPATH",432,0) 6080 D QUEUE(QOBLIST,QOXML,S1,E1) 6081 "RTN","C0SXPATH",433,0) 6082 ; S QOTMP=QOXML_"^"_S1_"^"_E1 6083 "RTN","C0SXPATH",434,0) 6084 ; D PUSH(QOBLIST,QOTMP) 6085 "RTN","C0SXPATH",435,0) 6086 Q 6087 "RTN","C0SXPATH",436,0) 6088 ; 6089 "RTN","C0SXPATH",437,0) 6090 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 6091 "RTN","C0SXPATH",438,0) 6092 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 6093 "RTN","C0SXPATH",439,0) 6094 ; USED TO FINISH INSERTING CHILDERN NODES 6095 "RTN","C0SXPATH",440,0) 6096 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 6097 "RTN","C0SXPATH",441,0) 6098 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 6099 "RTN","C0SXPATH",442,0) 6100 I @QCXML@(0)<1 D ; MALFORMED XML 6101 "RTN","C0SXPATH",443,0) 6102 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 6103 "RTN","C0SXPATH",444,0) 6104 I $G(DEBUG) W "GOING TO CLOSE",! 6105 "RTN","C0SXPATH",445,0) 6106 N S1,E1,QCT,QCTMP 6107 "RTN","C0SXPATH",446,0) 6108 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 6109 "RTN","C0SXPATH",447,0) 6110 I $D(QCXPATH) D ; XPATH PROVIDED 6111 "RTN","C0SXPATH",448,0) 6112 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 6113 "RTN","C0SXPATH",449,0) 6114 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 6115 "RTN","C0SXPATH",450,0) 6116 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 6117 "RTN","C0SXPATH",451,0) 6118 . S S1=@QCXML@(0) 6119 "RTN","C0SXPATH",452,0) 6120 D QUEUE(QCBLIST,QCXML,S1,E1) 6121 "RTN","C0SXPATH",453,0) 6122 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 6123 "RTN","C0SXPATH",454,0) 6124 Q 6125 "RTN","C0SXPATH",455,0) 6126 ; 6127 "RTN","C0SXPATH",456,0) 6128 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 6129 "RTN","C0SXPATH",457,0) 6130 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 6131 "RTN","C0SXPATH",458,0) 6132 ; OMITTED, INSERTION WILL BE AT THE ROOT 6133 "RTN","C0SXPATH",459,0) 6134 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 6135 "RTN","C0SXPATH",460,0) 6136 ; XML AT THE END OF THE XPATH POINT 6137 "RTN","C0SXPATH",461,0) 6138 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 6139 "RTN","C0SXPATH",462,0) 6140 N INSBLD,INSTMP 6141 "RTN","C0SXPATH",463,0) 6142 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 6143 "RTN","C0SXPATH",464,0) 6144 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 6145 "RTN","C0SXPATH",465,0) 6146 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY 6147 "RTN","C0SXPATH",466,0) 6148 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 6149 "RTN","C0SXPATH",467,0) 6150 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 6151 "RTN","C0SXPATH",468,0) 6152 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH 6153 "RTN","C0SXPATH",469,0) 6154 . I $D(INSXPATH) D ; XPATH PROVIDED 6155 "RTN","C0SXPATH",470,0) 6156 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 6157 "RTN","C0SXPATH",471,0) 6158 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") 6159 "RTN","C0SXPATH",472,0) 6160 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 6161 "RTN","C0SXPATH",473,0) 6162 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 6163 "RTN","C0SXPATH",474,0) 6164 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML 6165 "RTN","C0SXPATH",475,0) 6166 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 6167 "RTN","C0SXPATH",476,0) 6168 . I $D(INSXPATH) D ; XPATH PROVIDED 6169 "RTN","C0SXPATH",477,0) 6170 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 6171 "RTN","C0SXPATH",478,0) 6172 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 6173 "RTN","C0SXPATH",479,0) 6174 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 6175 "RTN","C0SXPATH",480,0) 6176 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 6177 "RTN","C0SXPATH",481,0) 6178 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 6179 "RTN","C0SXPATH",482,0) 6180 Q 6181 "RTN","C0SXPATH",483,0) 6182 ; 6183 "RTN","C0SXPATH",484,0) 6184 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 6185 "RTN","C0SXPATH",485,0) 6186 ; INTO INNXML AT THE INNXPATH XPATH POINT 6187 "RTN","C0SXPATH",486,0) 6188 ; 6189 "RTN","C0SXPATH",487,0) 6190 N INNBLD,UXPATH 6191 "RTN","C0SXPATH",488,0) 6192 N INNTBUF 6193 "RTN","C0SXPATH",489,0) 6194 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 6195 "RTN","C0SXPATH",490,0) 6196 I '$D(INNXPATH) D ; XPATH NOT PASSED 6197 "RTN","C0SXPATH",491,0) 6198 . S UXPATH="//" ; USE ROOT XPATH 6199 "RTN","C0SXPATH",492,0) 6200 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 6201 "RTN","C0SXPATH",493,0) 6202 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 6203 "RTN","C0SXPATH",494,0) 6204 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 6205 "RTN","C0SXPATH",495,0) 6206 . D BUILD("INNBLD",INNXML) 6207 "RTN","C0SXPATH",496,0) 6208 I @INNXML@(0)>0 D ; NOT EMPTY 6209 "RTN","C0SXPATH",497,0) 6210 . D QOPEN("INNBLD",INNXML,UXPATH) ; 6211 "RTN","C0SXPATH",498,0) 6212 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 6213 "RTN","C0SXPATH",499,0) 6214 . D QCLOSE("INNBLD",INNXML,UXPATH) 6215 "RTN","C0SXPATH",500,0) 6216 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 6217 "RTN","C0SXPATH",501,0) 6218 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 6219 "RTN","C0SXPATH",502,0) 6220 Q 6221 "RTN","C0SXPATH",503,0) 6222 ; 6223 "RTN","C0SXPATH",504,0) 6224 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST 6225 "RTN","C0SXPATH",505,0) 6226 ; BUT XDEST AN XNEW ARE PASSED BY NAME 6227 "RTN","C0SXPATH",506,0) 6228 N XBLD,XTMP 6229 "RTN","C0SXPATH",507,0) 6230 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT 6231 "RTN","C0SXPATH",508,0) 6232 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST 6233 "RTN","C0SXPATH",509,0) 6234 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION 6235 "RTN","C0SXPATH",510,0) 6236 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 6237 "RTN","C0SXPATH",511,0) 6238 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION 6239 "RTN","C0SXPATH",512,0) 6240 I $G(DEBUG) D PARY("XDEST") 6241 "RTN","C0SXPATH",513,0) 6242 Q 6243 "RTN","C0SXPATH",514,0) 6244 ; 6245 "RTN","C0SXPATH",515,0) 6246 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 6247 "RTN","C0SXPATH",516,0) 6248 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 6249 "RTN","C0SXPATH",517,0) 6250 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 6251 "RTN","C0SXPATH",518,0) 6252 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 6253 "RTN","C0SXPATH",519,0) 6254 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 6255 "RTN","C0SXPATH",520,0) 6256 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 6257 "RTN","C0SXPATH",521,0) 6258 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 6259 "RTN","C0SXPATH",522,0) 6260 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 6261 "RTN","C0SXPATH",523,0) 6262 S XFIRST=$P(XNODE,"^",1) 6263 "RTN","C0SXPATH",524,0) 6264 S XLAST=$P(XNODE,"^",2) 6265 "RTN","C0SXPATH",525,0) 6266 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG 6267 "RTN","C0SXPATH",526,0) 6268 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 6269 "RTN","C0SXPATH",527,0) 6270 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 6271 "RTN","C0SXPATH",528,0) 6272 I RENEW'="" D ; NEW XML IS NOT NULL 6273 "RTN","C0SXPATH",529,0) 6274 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 6275 "RTN","C0SXPATH",530,0) 6276 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 6277 "RTN","C0SXPATH",531,0) 6278 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 6279 "RTN","C0SXPATH",532,0) 6280 I $G(DEBUG) W "REPLACE PREBUILD",! 6281 "RTN","C0SXPATH",533,0) 6282 I $G(DEBUG) D PARY("REBLD") 6283 "RTN","C0SXPATH",534,0) 6284 D BUILD("REBLD","RTMP") 6285 "RTN","C0SXPATH",535,0) 6286 K @REXML ; KILL WHAT WAS THERE 6287 "RTN","C0SXPATH",536,0) 6288 D CP("RTMP",REXML) ; COPY IN THE RESULT 6289 "RTN","C0SXPATH",537,0) 6290 Q 6291 "RTN","C0SXPATH",538,0) 6292 ; 6293 "RTN","C0SXPATH",539,0) 6294 DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT 6295 "RTN","C0SXPATH",540,0) 6296 ; REXML IS PASSED BY NAME XPATH IS A VALUE 6297 "RTN","C0SXPATH",541,0) 6298 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 6299 "RTN","C0SXPATH",542,0) 6300 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 6301 "RTN","C0SXPATH",543,0) 6302 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 6303 "RTN","C0SXPATH",544,0) 6304 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 6305 "RTN","C0SXPATH",545,0) 6306 S XFIRST=$P(XNODE,"^",1) 6307 "RTN","C0SXPATH",546,0) 6308 S XLAST=$P(XNODE,"^",2) 6309 "RTN","C0SXPATH",547,0) 6310 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 6311 "RTN","C0SXPATH",548,0) 6312 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 6313 "RTN","C0SXPATH",549,0) 6314 I $G(DEBUG) D PARY("REBLD") 6315 "RTN","C0SXPATH",550,0) 6316 D BUILD("REBLD","RTMP") 6317 "RTN","C0SXPATH",551,0) 6318 K @REXML ; KILL WHAT WAS THERE 6319 "RTN","C0SXPATH",552,0) 6320 D CP("RTMP",REXML) ; COPY IN THE RESULT 6321 "RTN","C0SXPATH",553,0) 6322 Q 6323 "RTN","C0SXPATH",554,0) 6324 ; 6325 "RTN","C0SXPATH",555,0) 6326 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 6327 "RTN","C0SXPATH",556,0) 6328 ; W "Reporting on the missing",! 6329 "RTN","C0SXPATH",557,0) 6330 ; W OARY 6331 "RTN","C0SXPATH",558,0) 6332 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 6333 "RTN","C0SXPATH",559,0) 6014 6334 N I 6015 "RTN","C0SXPATH",388,0) 6016 K @BDEST 6017 "RTN","C0SXPATH",389,0) 6018 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST 6019 "RTN","C0SXPATH",390,0) 6020 . N J,ATMP 6021 "RTN","C0SXPATH",391,0) 6022 . S ATMP=$$ARRAY(@BLIST@(I)) 6023 "RTN","C0SXPATH",392,0) 6024 . I $G(DEBUG) W "ATMP=",ATMP,! 6025 "RTN","C0SXPATH",393,0) 6026 . I $G(DEBUG) W @BLIST@(I),! 6027 "RTN","C0SXPATH",394,0) 6028 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; 6029 "RTN","C0SXPATH",395,0) 6030 . . ; FOR EACH LINE IN THIS INSTR 6031 "RTN","C0SXPATH",396,0) 6032 . . I $G(DEBUG) W "BDEST= ",BDEST,! 6033 "RTN","C0SXPATH",397,0) 6034 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! 6035 "RTN","C0SXPATH",398,0) 6036 . . D PUSH(BDEST,@ATMP@(J)) 6037 "RTN","C0SXPATH",399,0) 6038 Q 6039 "RTN","C0SXPATH",400,0) 6040 ; 6041 "RTN","C0SXPATH",401,0) 6042 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST 6043 "RTN","C0SXPATH",402,0) 6044 ; 6045 "RTN","C0SXPATH",403,0) 6046 I $G(DEBUG) W "QUEUEING ",BLST,! 6047 "RTN","C0SXPATH",404,0) 6048 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) 6049 "RTN","C0SXPATH",405,0) 6050 Q 6051 "RTN","C0SXPATH",406,0) 6052 ; 6053 "RTN","C0SXPATH",407,0) 6054 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME 6055 "RTN","C0SXPATH",408,0) 6056 ; KILLS CPDEST FIRST 6057 "RTN","C0SXPATH",409,0) 6058 N CPINSTR 6059 "RTN","C0SXPATH",410,0) 6060 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! 6061 "RTN","C0SXPATH",411,0) 6062 I @CPSRC@(0)<1 D ; BAD LENGTH 6063 "RTN","C0SXPATH",412,0) 6064 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! 6065 "RTN","C0SXPATH",413,0) 6066 . Q 6067 "RTN","C0SXPATH",414,0) 6068 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT 6069 "RTN","C0SXPATH",415,0) 6070 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY 6071 "RTN","C0SXPATH",416,0) 6072 D BUILD("CPINSTR",CPDEST) 6073 "RTN","C0SXPATH",417,0) 6074 Q 6075 "RTN","C0SXPATH",418,0) 6076 ; 6077 "RTN","C0SXPATH",419,0) 6078 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST 6079 "RTN","C0SXPATH",420,0) 6080 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD 6081 "RTN","C0SXPATH",421,0) 6082 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT 6083 "RTN","C0SXPATH",422,0) 6084 ; USED TO INSERT CHILDREN NODES 6085 "RTN","C0SXPATH",423,0) 6086 I @QOXML@(0)<1 D ; MALFORMED XML 6087 "RTN","C0SXPATH",424,0) 6088 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! 6089 "RTN","C0SXPATH",425,0) 6090 . Q 6091 "RTN","C0SXPATH",426,0) 6092 I $G(DEBUG) W "DOING QOPEN",! 6093 "RTN","C0SXPATH",427,0) 6094 N S1,E1,QOT,QOTMP 6095 "RTN","C0SXPATH",428,0) 6096 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML 6097 "RTN","C0SXPATH",429,0) 6098 I $D(QOXPATH) D ; XPATH PROVIDED 6099 "RTN","C0SXPATH",430,0) 6100 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX 6101 "RTN","C0SXPATH",431,0) 6102 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 6103 "RTN","C0SXPATH",432,0) 6104 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 6105 "RTN","C0SXPATH",433,0) 6106 . S E1=@QOXML@(0)-1 6107 "RTN","C0SXPATH",434,0) 6108 D QUEUE(QOBLIST,QOXML,S1,E1) 6109 "RTN","C0SXPATH",435,0) 6110 ; S QOTMP=QOXML_"^"_S1_"^"_E1 6111 "RTN","C0SXPATH",436,0) 6112 ; D PUSH(QOBLIST,QOTMP) 6113 "RTN","C0SXPATH",437,0) 6114 Q 6115 "RTN","C0SXPATH",438,0) 6116 ; 6117 "RTN","C0SXPATH",439,0) 6118 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN 6119 "RTN","C0SXPATH",440,0) 6120 ; ADDS THE LIST LINE OF QCXML TO QCBLIST 6121 "RTN","C0SXPATH",441,0) 6122 ; USED TO FINISH INSERTING CHILDERN NODES 6123 "RTN","C0SXPATH",442,0) 6124 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END 6125 "RTN","C0SXPATH",443,0) 6126 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO 6127 "RTN","C0SXPATH",444,0) 6128 I @QCXML@(0)<1 D ; MALFORMED XML 6129 "RTN","C0SXPATH",445,0) 6130 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! 6131 "RTN","C0SXPATH",446,0) 6132 I $G(DEBUG) W "GOING TO CLOSE",! 6133 "RTN","C0SXPATH",447,0) 6134 N S1,E1,QCT,QCTMP 6135 "RTN","C0SXPATH",448,0) 6136 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML 6137 "RTN","C0SXPATH",449,0) 6138 I $D(QCXPATH) D ; XPATH PROVIDED 6139 "RTN","C0SXPATH",450,0) 6140 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX 6141 "RTN","C0SXPATH",451,0) 6142 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML 6143 "RTN","C0SXPATH",452,0) 6144 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 6145 "RTN","C0SXPATH",453,0) 6146 . S S1=@QCXML@(0) 6147 "RTN","C0SXPATH",454,0) 6148 D QUEUE(QCBLIST,QCXML,S1,E1) 6149 "RTN","C0SXPATH",455,0) 6150 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) 6151 "RTN","C0SXPATH",456,0) 6152 Q 6153 "RTN","C0SXPATH",457,0) 6154 ; 6155 "RTN","C0SXPATH",458,0) 6156 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE 6157 "RTN","C0SXPATH",459,0) 6158 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS 6159 "RTN","C0SXPATH",460,0) 6160 ; OMITTED, INSERTION WILL BE AT THE ROOT 6161 "RTN","C0SXPATH",461,0) 6162 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW 6163 "RTN","C0SXPATH",462,0) 6164 ; XML AT THE END OF THE XPATH POINT 6165 "RTN","C0SXPATH",463,0) 6166 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE 6167 "RTN","C0SXPATH",464,0) 6168 N INSBLD,INSTMP 6169 "RTN","C0SXPATH",465,0) 6170 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! 6171 "RTN","C0SXPATH",466,0) 6172 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! 6173 "RTN","C0SXPATH",467,0) 6174 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY 6175 "RTN","C0SXPATH",468,0) 6176 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT 6177 "RTN","C0SXPATH",469,0) 6178 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY 6179 "RTN","C0SXPATH",470,0) 6180 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH 6181 "RTN","C0SXPATH",471,0) 6182 . I $D(INSXPATH) D ; XPATH PROVIDED 6183 "RTN","C0SXPATH",472,0) 6184 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE 6185 "RTN","C0SXPATH",473,0) 6186 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") 6187 "RTN","C0SXPATH",474,0) 6188 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT 6189 "RTN","C0SXPATH",475,0) 6190 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH 6191 "RTN","C0SXPATH",476,0) 6192 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML 6193 "RTN","C0SXPATH",477,0) 6194 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML 6195 "RTN","C0SXPATH",478,0) 6196 . I $D(INSXPATH) D ; XPATH PROVIDED 6197 "RTN","C0SXPATH",479,0) 6198 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH 6199 "RTN","C0SXPATH",480,0) 6200 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT 6201 "RTN","C0SXPATH",481,0) 6202 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH 6203 "RTN","C0SXPATH",482,0) 6204 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST 6205 "RTN","C0SXPATH",483,0) 6206 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE 6207 "RTN","C0SXPATH",484,0) 6208 Q 6209 "RTN","C0SXPATH",485,0) 6210 ; 6211 "RTN","C0SXPATH",486,0) 6212 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW 6213 "RTN","C0SXPATH",487,0) 6214 ; INTO INNXML AT THE INNXPATH XPATH POINT 6215 "RTN","C0SXPATH",488,0) 6216 ; 6217 "RTN","C0SXPATH",489,0) 6218 N INNBLD,UXPATH 6219 "RTN","C0SXPATH",490,0) 6220 N INNTBUF 6221 "RTN","C0SXPATH",491,0) 6222 S INNTBUF=$NA(^TMP($J,"INNTBUF")) 6223 "RTN","C0SXPATH",492,0) 6224 I '$D(INNXPATH) D ; XPATH NOT PASSED 6225 "RTN","C0SXPATH",493,0) 6226 . S UXPATH="//" ; USE ROOT XPATH 6227 "RTN","C0SXPATH",494,0) 6228 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED 6229 "RTN","C0SXPATH",495,0) 6230 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY 6231 "RTN","C0SXPATH",496,0) 6232 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER 6233 "RTN","C0SXPATH",497,0) 6234 . D BUILD("INNBLD",INNXML) 6235 "RTN","C0SXPATH",498,0) 6236 I @INNXML@(0)>0 D ; NOT EMPTY 6237 "RTN","C0SXPATH",499,0) 6238 . D QOPEN("INNBLD",INNXML,UXPATH) ; 6239 "RTN","C0SXPATH",500,0) 6240 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML 6241 "RTN","C0SXPATH",501,0) 6242 . D QCLOSE("INNBLD",INNXML,UXPATH) 6243 "RTN","C0SXPATH",502,0) 6244 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER 6245 "RTN","C0SXPATH",503,0) 6246 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST 6247 "RTN","C0SXPATH",504,0) 6248 Q 6249 "RTN","C0SXPATH",505,0) 6250 ; 6251 "RTN","C0SXPATH",506,0) 6252 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST 6253 "RTN","C0SXPATH",507,0) 6254 ; BUT XDEST AN XNEW ARE PASSED BY NAME 6255 "RTN","C0SXPATH",508,0) 6335 "RTN","C0SXPATH",560,0) 6336 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT 6337 "RTN","C0SXPATH",561,0) 6338 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY 6339 "RTN","C0SXPATH",562,0) 6340 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE 6341 "RTN","C0SXPATH",563,0) 6342 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY 6343 "RTN","C0SXPATH",564,0) 6344 . . Q 6345 "RTN","C0SXPATH",565,0) 6346 Q 6347 "RTN","C0SXPATH",566,0) 6348 ; 6349 "RTN","C0SXPATH",567,0) 6350 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY 6351 "RTN","C0SXPATH",568,0) 6352 ; AND PUT THE RESULTS IN OXML 6353 "RTN","C0SXPATH",569,0) 6354 N XCNT 6355 "RTN","C0SXPATH",570,0) 6356 I '$D(DEBUG) S DEBUG=0 6357 "RTN","C0SXPATH",571,0) 6358 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q 6359 "RTN","C0SXPATH",572,0) 6360 I '$D(@IXML@(0)) D ; INITIALIZE COUNT 6361 "RTN","C0SXPATH",573,0) 6362 . S XCNT=$O(@IXML@(""),-1) 6363 "RTN","C0SXPATH",574,0) 6364 E S XCNT=@IXML@(0) ;COUNT 6365 "RTN","C0SXPATH",575,0) 6366 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q 6367 "RTN","C0SXPATH",576,0) 6368 N I,J,TNAM,TVAL,TSTR 6369 "RTN","C0SXPATH",577,0) 6370 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT 6371 "RTN","C0SXPATH",578,0) 6372 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY 6373 "RTN","C0SXPATH",579,0) 6374 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT 6375 "RTN","C0SXPATH",580,0) 6376 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? 6377 "RTN","C0SXPATH",581,0) 6378 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS 6379 "RTN","C0SXPATH",582,0) 6380 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS 6381 "RTN","C0SXPATH",583,0) 6382 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! 6383 "RTN","C0SXPATH",584,0) 6384 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME 6385 "RTN","C0SXPATH",585,0) 6386 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED 6387 "RTN","C0SXPATH",586,0) 6388 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? 6389 "RTN","C0SXPATH",587,0) 6390 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD 6391 "RTN","C0SXPATH",588,0) 6392 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE 6393 "RTN","C0SXPATH",589,0) 6394 . . . . E D DOFLD ; PROCESS A FIELD 6395 "RTN","C0SXPATH",590,0) 6396 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE 6397 "RTN","C0SXPATH",591,0) 6398 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER 6399 "RTN","C0SXPATH",592,0) 6400 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES 6401 "RTN","C0SXPATH",593,0) 6402 . . I DEBUG W TSTR 6403 "RTN","C0SXPATH",594,0) 6404 I DEBUG W "MAPPED",! 6405 "RTN","C0SXPATH",595,0) 6406 Q 6407 "RTN","C0SXPATH",596,0) 6408 ; 6409 "RTN","C0SXPATH",597,0) 6410 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE 6411 "RTN","C0SXPATH",598,0) 6412 ; 6413 "RTN","C0SXPATH",599,0) 6414 Q 6415 "RTN","C0SXPATH",600,0) 6416 ; 6417 "RTN","C0SXPATH",601,0) 6418 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS 6419 "RTN","C0SXPATH",602,0) 6420 ; THEXML IS PASSED BY NAME 6421 "RTN","C0SXPATH",603,0) 6422 N I,J,TMPXML,DEL,FOUND,INTXT 6423 "RTN","C0SXPATH",604,0) 6424 S FOUND=0 6425 "RTN","C0SXPATH",605,0) 6426 S INTXT=0 6427 "RTN","C0SXPATH",606,0) 6428 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! 6429 "RTN","C0SXPATH",607,0) 6430 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY 6431 "RTN","C0SXPATH",608,0) 6432 . S J=@THEXML@(I) 6433 "RTN","C0SXPATH",609,0) 6434 . I J["<text>" D 6435 "RTN","C0SXPATH",610,0) 6436 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM 6437 "RTN","C0SXPATH",611,0) 6438 . . I $G(DEBUG) W "IN HTML SECTION",! 6439 "RTN","C0SXPATH",612,0) 6440 . N JM,JP,JPX ; JMINUS AND JPLUS 6441 "RTN","C0SXPATH",613,0) 6442 . S JM=@THEXML@(I-1) ; LINE BEFORE 6443 "RTN","C0SXPATH",614,0) 6444 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM 6445 "RTN","C0SXPATH",615,0) 6446 . S JP=@THEXML@(I+1) ; LINE AFTER 6447 "RTN","C0SXPATH",616,0) 6448 . I INTXT=0 D ; IF NOT IN AN HTML SECTION 6449 "RTN","C0SXPATH",617,0) 6450 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH 6451 "RTN","C0SXPATH",618,0) 6452 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES 6453 "RTN","C0SXPATH",619,0) 6454 . . . I $G(DEBUG) W I,J,JP,! 6455 "RTN","C0SXPATH",620,0) 6456 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 6457 "RTN","C0SXPATH",621,0) 6458 . . . S DEL(I)="" ; SET LINE TO DELETE 6459 "RTN","C0SXPATH",622,0) 6460 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE 6461 "RTN","C0SXPATH",623,0) 6462 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE 6463 "RTN","C0SXPATH",624,0) 6464 . . . I $G(DEBUG) W I,J,! 6465 "RTN","C0SXPATH",625,0) 6466 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED 6467 "RTN","C0SXPATH",626,0) 6468 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED 6469 "RTN","C0SXPATH",627,0) 6470 . . . I JM=JPX D ; 6471 "RTN","C0SXPATH",628,0) 6472 . . . . I $G(DEBUG) W I,JM_J_JPX,! 6473 "RTN","C0SXPATH",629,0) 6474 . . . . S DEL(I-1)="" 6475 "RTN","C0SXPATH",630,0) 6476 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL 6477 "RTN","C0SXPATH",631,0) 6478 ; . I J'["><" D PUSH("TMPXML",J) 6479 "RTN","C0SXPATH",632,0) 6480 I FOUND D ; NEED TO DELETE THINGS 6481 "RTN","C0SXPATH",633,0) 6482 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES 6483 "RTN","C0SXPATH",634,0) 6484 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED 6485 "RTN","C0SXPATH",635,0) 6486 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY 6487 "RTN","C0SXPATH",636,0) 6488 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY 6489 "RTN","C0SXPATH",637,0) 6490 Q FOUND 6491 "RTN","C0SXPATH",638,0) 6492 ; 6493 "RTN","C0SXPATH",639,0) 6494 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML 6495 "RTN","C0SXPATH",640,0) 6496 ; XSEC IS A SECTION PASSED BY NAME 6497 "RTN","C0SXPATH",641,0) 6256 6498 N XBLD,XTMP 6257 "RTN","C0SXPATH",509,0) 6258 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT 6259 "RTN","C0SXPATH",510,0) 6260 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST 6261 "RTN","C0SXPATH",511,0) 6262 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION 6263 "RTN","C0SXPATH",512,0) 6499 "RTN","C0SXPATH",642,0) 6500 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML 6501 "RTN","C0SXPATH",643,0) 6264 6502 D BUILD("XBLD","XTMP") ; BUILD THE RESULT 6265 "RTN","C0SXPATH",513,0) 6266 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION 6267 "RTN","C0SXPATH",514,0) 6268 I $G(DEBUG) D PARY("XDEST") 6269 "RTN","C0SXPATH",515,0) 6270 Q 6271 "RTN","C0SXPATH",516,0) 6272 ; 6273 "RTN","C0SXPATH",517,0) 6274 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT 6275 "RTN","C0SXPATH",518,0) 6276 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE 6277 "RTN","C0SXPATH",519,0) 6278 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE 6279 "RTN","C0SXPATH",520,0) 6280 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") 6281 "RTN","C0SXPATH",521,0) 6282 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 6283 "RTN","C0SXPATH",522,0) 6284 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 6285 "RTN","C0SXPATH",523,0) 6286 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 6287 "RTN","C0SXPATH",524,0) 6288 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 6289 "RTN","C0SXPATH",525,0) 6290 S XFIRST=$P(XNODE,"^",1) 6291 "RTN","C0SXPATH",526,0) 6292 S XLAST=$P(XNODE,"^",2) 6293 "RTN","C0SXPATH",527,0) 6294 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG 6295 "RTN","C0SXPATH",528,0) 6296 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE 6297 "RTN","C0SXPATH",529,0) 6298 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST 6299 "RTN","C0SXPATH",530,0) 6300 I RENEW'="" D ; NEW XML IS NOT NULL 6301 "RTN","C0SXPATH",531,0) 6302 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 6303 "RTN","C0SXPATH",532,0) 6304 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW 6305 "RTN","C0SXPATH",533,0) 6306 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 6307 "RTN","C0SXPATH",534,0) 6308 I $G(DEBUG) W "REPLACE PREBUILD",! 6309 "RTN","C0SXPATH",535,0) 6310 I $G(DEBUG) D PARY("REBLD") 6311 "RTN","C0SXPATH",536,0) 6312 D BUILD("REBLD","RTMP") 6313 "RTN","C0SXPATH",537,0) 6314 K @REXML ; KILL WHAT WAS THERE 6315 "RTN","C0SXPATH",538,0) 6316 D CP("RTMP",REXML) ; COPY IN THE RESULT 6317 "RTN","C0SXPATH",539,0) 6318 Q 6319 "RTN","C0SXPATH",540,0) 6320 ; 6321 "RTN","C0SXPATH",541,0) 6322 DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT 6323 "RTN","C0SXPATH",542,0) 6324 ; REXML IS PASSED BY NAME XPATH IS A VALUE 6325 "RTN","C0SXPATH",543,0) 6326 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP 6327 "RTN","C0SXPATH",544,0) 6328 S OLD=$NA(^TMP($J,"REPLACE_OLD")) 6329 "RTN","C0SXPATH",545,0) 6330 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD 6331 "RTN","C0SXPATH",546,0) 6332 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS 6333 "RTN","C0SXPATH",547,0) 6334 S XFIRST=$P(XNODE,"^",1) 6335 "RTN","C0SXPATH",548,0) 6336 S XLAST=$P(XNODE,"^",2) 6337 "RTN","C0SXPATH",549,0) 6338 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE 6339 "RTN","C0SXPATH",550,0) 6340 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST 6341 "RTN","C0SXPATH",551,0) 6342 I $G(DEBUG) D PARY("REBLD") 6343 "RTN","C0SXPATH",552,0) 6344 D BUILD("REBLD","RTMP") 6345 "RTN","C0SXPATH",553,0) 6346 K @REXML ; KILL WHAT WAS THERE 6347 "RTN","C0SXPATH",554,0) 6348 D CP("RTMP",REXML) ; COPY IN THE RESULT 6349 "RTN","C0SXPATH",555,0) 6350 Q 6351 "RTN","C0SXPATH",556,0) 6352 ; 6353 "RTN","C0SXPATH",557,0) 6354 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY 6355 "RTN","C0SXPATH",558,0) 6356 ; W "Reporting on the missing",! 6357 "RTN","C0SXPATH",559,0) 6358 ; W OARY 6359 "RTN","C0SXPATH",560,0) 6360 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q 6361 "RTN","C0SXPATH",561,0) 6503 "RTN","C0SXPATH",644,0) 6504 D CP("XTMP",XSEC) ; REPLACE PASSED XML 6505 "RTN","C0SXPATH",645,0) 6506 Q 6507 "RTN","C0SXPATH",646,0) 6508 ; 6509 "RTN","C0SXPATH",647,0) 6510 PARY(GLO,ZN) ;PRINT AN ARRAY 6511 "RTN","C0SXPATH",648,0) 6512 ; IF ZN=-1 NO LINE NUMBERS 6513 "RTN","C0SXPATH",649,0) 6362 6514 N I 6363 "RTN","C0SXPATH",562,0)6364 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT6365 "RTN","C0SXPATH",563,0)6366 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY6367 "RTN","C0SXPATH",564,0)6368 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE6369 "RTN","C0SXPATH",565,0)6370 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY6371 "RTN","C0SXPATH",566,0)6372 . . Q6373 "RTN","C0SXPATH",567,0)6374 Q6375 "RTN","C0SXPATH",568,0)6376 ;6377 "RTN","C0SXPATH",569,0)6378 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY6379 "RTN","C0SXPATH",570,0)6380 ; AND PUT THE RESULTS IN OXML6381 "RTN","C0SXPATH",571,0)6382 N XCNT6383 "RTN","C0SXPATH",572,0)6384 I '$D(DEBUG) S DEBUG=06385 "RTN","C0SXPATH",573,0)6386 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q6387 "RTN","C0SXPATH",574,0)6388 I '$D(@IXML@(0)) D ; INITIALIZE COUNT6389 "RTN","C0SXPATH",575,0)6390 . S XCNT=$O(@IXML@(""),-1)6391 "RTN","C0SXPATH",576,0)6392 E S XCNT=@IXML@(0) ;COUNT6393 "RTN","C0SXPATH",577,0)6394 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q6395 "RTN","C0SXPATH",578,0)6396 N I,J,TNAM,TVAL,TSTR6397 "RTN","C0SXPATH",579,0)6398 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT6399 "RTN","C0SXPATH",580,0)6400 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY6401 "RTN","C0SXPATH",581,0)6402 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT6403 "RTN","C0SXPATH",582,0)6404 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?6405 "RTN","C0SXPATH",583,0)6406 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS6407 "RTN","C0SXPATH",584,0)6408 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS6409 "RTN","C0SXPATH",585,0)6410 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!6411 "RTN","C0SXPATH",586,0)6412 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME6413 "RTN","C0SXPATH",587,0)6414 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED6415 "RTN","C0SXPATH",588,0)6416 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?6417 "RTN","C0SXPATH",589,0)6418 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD6419 "RTN","C0SXPATH",590,0)6420 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE6421 "RTN","C0SXPATH",591,0)6422 . . . . E D DOFLD ; PROCESS A FIELD6423 "RTN","C0SXPATH",592,0)6424 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE6425 "RTN","C0SXPATH",593,0)6426 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER6427 "RTN","C0SXPATH",594,0)6428 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES6429 "RTN","C0SXPATH",595,0)6430 . . I DEBUG W TSTR6431 "RTN","C0SXPATH",596,0)6432 I DEBUG W "MAPPED",!6433 "RTN","C0SXPATH",597,0)6434 Q6435 "RTN","C0SXPATH",598,0)6436 ;6437 "RTN","C0SXPATH",599,0)6438 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE6439 "RTN","C0SXPATH",600,0)6440 ;6441 "RTN","C0SXPATH",601,0)6442 Q6443 "RTN","C0SXPATH",602,0)6444 ;6445 "RTN","C0SXPATH",603,0)6446 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS6447 "RTN","C0SXPATH",604,0)6448 ; THEXML IS PASSED BY NAME6449 "RTN","C0SXPATH",605,0)6450 N I,J,TMPXML,DEL,FOUND,INTXT6451 "RTN","C0SXPATH",606,0)6452 S FOUND=06453 "RTN","C0SXPATH",607,0)6454 S INTXT=06455 "RTN","C0SXPATH",608,0)6456 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!6457 "RTN","C0SXPATH",609,0)6458 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY6459 "RTN","C0SXPATH",610,0)6460 . S J=@THEXML@(I)6461 "RTN","C0SXPATH",611,0)6462 . I J["<text>" D6463 "RTN","C0SXPATH",612,0)6464 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM6465 "RTN","C0SXPATH",613,0)6466 . . I $G(DEBUG) W "IN HTML SECTION",!6467 "RTN","C0SXPATH",614,0)6468 . N JM,JP,JPX ; JMINUS AND JPLUS6469 "RTN","C0SXPATH",615,0)6470 . S JM=@THEXML@(I-1) ; LINE BEFORE6471 "RTN","C0SXPATH",616,0)6472 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM6473 "RTN","C0SXPATH",617,0)6474 . S JP=@THEXML@(I+1) ; LINE AFTER6475 "RTN","C0SXPATH",618,0)6476 . I INTXT=0 D ; IF NOT IN AN HTML SECTION6477 "RTN","C0SXPATH",619,0)6478 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH6479 "RTN","C0SXPATH",620,0)6480 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES6481 "RTN","C0SXPATH",621,0)6482 . . . I $G(DEBUG) W I,J,JP,!6483 "RTN","C0SXPATH",622,0)6484 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED6485 "RTN","C0SXPATH",623,0)6486 . . . S DEL(I)="" ; SET LINE TO DELETE6487 "RTN","C0SXPATH",624,0)6488 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE6489 "RTN","C0SXPATH",625,0)6490 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE6491 "RTN","C0SXPATH",626,0)6492 . . . I $G(DEBUG) W I,J,!6493 "RTN","C0SXPATH",627,0)6494 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED6495 "RTN","C0SXPATH",628,0)6496 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED6497 "RTN","C0SXPATH",629,0)6498 . . . I JM=JPX D ;6499 "RTN","C0SXPATH",630,0)6500 . . . . I $G(DEBUG) W I,JM_J_JPX,!6501 "RTN","C0SXPATH",631,0)6502 . . . . S DEL(I-1)=""6503 "RTN","C0SXPATH",632,0)6504 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL6505 "RTN","C0SXPATH",633,0)6506 ; . I J'["><" D PUSH("TMPXML",J)6507 "RTN","C0SXPATH",634,0)6508 I FOUND D ; NEED TO DELETE THINGS6509 "RTN","C0SXPATH",635,0)6510 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES6511 "RTN","C0SXPATH",636,0)6512 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED6513 "RTN","C0SXPATH",637,0)6514 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY6515 "RTN","C0SXPATH",638,0)6516 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY6517 "RTN","C0SXPATH",639,0)6518 Q FOUND6519 "RTN","C0SXPATH",640,0)6520 ;6521 "RTN","C0SXPATH",641,0)6522 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML6523 "RTN","C0SXPATH",642,0)6524 ; XSEC IS A SECTION PASSED BY NAME6525 "RTN","C0SXPATH",643,0)6526 N XBLD,XTMP6527 "RTN","C0SXPATH",644,0)6528 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML6529 "RTN","C0SXPATH",645,0)6530 D BUILD("XBLD","XTMP") ; BUILD THE RESULT6531 "RTN","C0SXPATH",646,0)6532 D CP("XTMP",XSEC) ; REPLACE PASSED XML6533 "RTN","C0SXPATH",647,0)6534 Q6535 "RTN","C0SXPATH",648,0)6536 ;6537 "RTN","C0SXPATH",649,0)6538 PARY(GLO,ZN) ;PRINT AN ARRAY6539 6515 "RTN","C0SXPATH",650,0) 6540 ; IF ZN=-1 NO LINE NUMBERS6516 F I=1:1:@GLO@(0) D ; 6541 6517 "RTN","C0SXPATH",651,0) 6542 N I6518 . I $G(ZN)=-1 W @GLO@(I),! 6543 6519 "RTN","C0SXPATH",652,0) 6544 F I=1:1:@GLO@(0) D ;6520 . E W I_" "_@GLO@(I),! 6545 6521 "RTN","C0SXPATH",653,0) 6546 . I $G(ZN)=-1 W @GLO@(I),!6522 Q 6547 6523 "RTN","C0SXPATH",654,0) 6548 . E W I_" "_@GLO@(I),!6524 ; 6549 6525 "RTN","C0SXPATH",655,0) 6550 Q 6526 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY 6551 6527 "RTN","C0SXPATH",656,0) 6552 ; 6528 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE 6553 6529 "RTN","C0SXPATH",657,0) 6554 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY 6530 I '$D(IPRE) S IPRE="" 6555 6531 "RTN","C0SXPATH",658,0) 6556 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE6532 N H2I S H2I="" 6557 6533 "RTN","C0SXPATH",659,0) 6558 I '$D(IPRE) S IPRE=""6534 ; W $O(@IHASH@(H2I)),! 6559 6535 "RTN","C0SXPATH",660,0) 6560 N H2I S H2I=""6536 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH 6561 6537 "RTN","C0SXPATH",661,0) 6562 ; W $O(@IHASH@(H2I)),!6538 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES 6563 6539 "RTN","C0SXPATH",662,0) 6564 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH6540 . . ;W H2I_"^"_@IHASH@(H2I),! 6565 6541 "RTN","C0SXPATH",663,0) 6566 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES6542 . . N IH,IHI 6567 6543 "RTN","C0SXPATH",664,0) 6568 . . ;W H2I_"^"_@IHASH@(H2I),!6544 . . S IH=$NA(@IHASH@(H2I)) ; 6569 6545 "RTN","C0SXPATH",665,0) 6570 . . N IH,IHI6546 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR 6571 6547 "RTN","C0SXPATH",666,0) 6572 . . S IH =$NA(@IHASH@(H2I)) ;6548 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE 6573 6549 "RTN","C0SXPATH",667,0) 6574 . . S IH 2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR6550 . . S IHI="" ; INDEX INTO "M" MULTIPLES 6575 6551 "RTN","C0SXPATH",668,0) 6576 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE6552 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE 6577 6553 "RTN","C0SXPATH",669,0) 6578 . . S IHI="" ; INDEX INTO "M" MULTIPLES6554 . . . ; W @IH@(IHI) 6579 6555 "RTN","C0SXPATH",670,0) 6580 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE6556 . . . S IH3=$NA(@IH2@(IHI)) 6581 6557 "RTN","C0SXPATH",671,0) 6582 . . . ; W @IH@(IHI)6558 . . . ; W "HEY",IH3,! 6583 6559 "RTN","C0SXPATH",672,0) 6584 . . . S IH3=$NA(@IH2@(IHI))6560 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS 6585 6561 "RTN","C0SXPATH",673,0) 6586 . . . ; W "HEY",IH3,!6562 . . ; W IH,! 6587 6563 "RTN","C0SXPATH",674,0) 6588 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS6564 . . ; W "C0CZZ",! 6589 6565 "RTN","C0SXPATH",675,0) 6590 . . ; W IH,!6566 . . ; W $NA(@IHASH@(H2I)),! 6591 6567 "RTN","C0SXPATH",676,0) 6592 . . ; W "C0CZZ",!6568 . . Q ; 6593 6569 "RTN","C0SXPATH",677,0) 6594 . . ; W $NA(@IHASH@(H2I)),!6570 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) 6595 6571 "RTN","C0SXPATH",678,0) 6596 . . Q ;6572 . ; W @IARYRTN@(0),! 6597 6573 "RTN","C0SXPATH",679,0) 6598 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))6574 Q 6599 6575 "RTN","C0SXPATH",680,0) 6600 . ; W @IARYRTN@(0),!6576 ; 6601 6577 "RTN","C0SXPATH",681,0) 6602 Q 6578 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES 6603 6579 "RTN","C0SXPATH",682,0) 6604 ; 6580 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ 6605 6581 "RTN","C0SXPATH",683,0) 6606 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES 6582 ; XVRTN AND XVIXML ARE PASSED BY NAME 6607 6583 "RTN","C0SXPATH",684,0) 6608 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@6584 ; 6609 6585 "RTN","C0SXPATH",685,0) 6610 ; XVRTN AND XVIXML ARE PASSED BY NAME6586 N XVI,XVTMP,XVT 6611 6587 "RTN","C0SXPATH",686,0) 6612 ;6588 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML 6613 6589 "RTN","C0SXPATH",687,0) 6614 N XVI,XVTMP,XVT6590 . S XVT=@XVIXML@(XVI) 6615 6591 "RTN","C0SXPATH",688,0) 6616 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML6592 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI 6617 6593 "RTN","C0SXPATH",689,0) 6618 . S XVT=@XVIXML@(XVI)6594 D H2ARY(XVRTN,"XVTMP") 6619 6595 "RTN","C0SXPATH",690,0) 6620 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI6596 Q 6621 6597 "RTN","C0SXPATH",691,0) 6622 D H2ARY(XVRTN,"XVTMP")6598 ; 6623 6599 "RTN","C0SXPATH",692,0) 6624 Q 6600 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE 6625 6601 "RTN","C0SXPATH",693,0) 6626 ; 6602 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE 6627 6603 "RTN","C0SXPATH",694,0) 6628 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE 6604 ; 6629 6605 "RTN","C0SXPATH",695,0) 6630 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE6606 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED 6631 6607 "RTN","C0SXPATH",696,0) 6632 ;6608 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE 6633 6609 "RTN","C0SXPATH",697,0) 6634 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED6610 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 6635 6611 "RTN","C0SXPATH",698,0) 6636 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE6612 . S DXUSE="DTMP" ; DXUSE IS NAME 6637 6613 "RTN","C0SXPATH",699,0) 6638 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP6614 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE 6639 6615 "RTN","C0SXPATH",700,0) 6616 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP 6617 "RTN","C0SXPATH",701,0) 6640 6618 . S DXUSE="DTMP" ; DXUSE IS NAME 6641 "RTN","C0SXPATH",701,0)6642 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE6643 6619 "RTN","C0SXPATH",702,0) 6644 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP6620 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE 6645 6621 "RTN","C0SXPATH",703,0) 6646 . S DXUSE="DTMP" ; DXUSE IS NAME6622 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE 6647 6623 "RTN","C0SXPATH",704,0) 6648 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE6624 D XVARS("DVARS",DXUSE) ; PULL OUT VARS 6649 6625 "RTN","C0SXPATH",705,0) 6650 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE6626 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM 6651 6627 "RTN","C0SXPATH",706,0) 6652 D XVARS("DVARS",DXUSE) ; PULL OUT VARS6628 Q 6653 6629 "RTN","C0SXPATH",707,0) 6654 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM6630 ; 6655 6631 "RTN","C0SXPATH",708,0) 6656 Q 6632 TEST ; Run all the test cases 6657 6633 "RTN","C0SXPATH",709,0) 6658 ;6634 D TESTALL^C0CUNIT("C0CXPAT0") 6659 6635 "RTN","C0SXPATH",710,0) 6660 TEST ; Run all the test cases 6636 Q 6661 6637 "RTN","C0SXPATH",711,0) 6662 D TESTALL^C0CUNIT("C0CXPAT0")6638 ; 6663 6639 "RTN","C0SXPATH",712,0) 6664 Q 6640 ZTEST(WHICH) ; RUN ONE SET OF TESTS 6665 6641 "RTN","C0SXPATH",713,0) 6666 ;6642 N ZTMP 6667 6643 "RTN","C0SXPATH",714,0) 6668 ZTEST(WHICH) ; RUN ONE SET OF TESTS 6644 S DEBUG=1 6669 6645 "RTN","C0SXPATH",715,0) 6646 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 6647 "RTN","C0SXPATH",716,0) 6648 D ZTEST^C0CUNIT(.ZTMP,WHICH) 6649 "RTN","C0SXPATH",717,0) 6650 Q 6651 "RTN","C0SXPATH",718,0) 6652 ; 6653 "RTN","C0SXPATH",719,0) 6654 TLIST ; LIST THE TESTS 6655 "RTN","C0SXPATH",720,0) 6670 6656 N ZTMP 6671 "RTN","C0SXPATH",716,0) 6672 S DEBUG=1 6673 "RTN","C0SXPATH",717,0) 6657 "RTN","C0SXPATH",721,0) 6674 6658 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") 6675 "RTN","C0SXPATH",718,0)6676 D ZTEST^C0CUNIT(.ZTMP,WHICH)6677 "RTN","C0SXPATH",719,0)6678 Q6679 "RTN","C0SXPATH",720,0)6680 ;6681 "RTN","C0SXPATH",721,0)6682 TLIST ; LIST THE TESTS6683 6659 "RTN","C0SXPATH",722,0) 6684 N ZTMP6660 D TLIST^C0CUNIT(.ZTMP) 6685 6661 "RTN","C0SXPATH",723,0) 6686 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")6662 Q 6687 6663 "RTN","C0SXPATH",724,0) 6688 D TLIST^C0CUNIT(.ZTMP)6689 "RTN","C0SXPATH",725,0)6690 Q6691 "RTN","C0SXPATH",726,0)6692 6664 ; 6693 6665 "VER")
Note:
See TracChangeset
for help on using the changeset viewer.
