source: smart/trunk/kids/VISTA_SMART_CONTAINER_1T4.KID@ 1572

Last change on this file since 1572 was 1538, checked in by Sam Habiel, 12 years ago

Proper Package File

File size: 194.8 KB
RevLine 
[1538]1KIDS Distribution saved on Sep 26, 2012@11:14:54
2VistA Smart Container
3**KIDS**:VISTA SMART CONTAINER 1.0^
4
5**INSTALL NAME**
6VISTA SMART CONTAINER 1.0
7"BLD",8489,0)
8VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3120926^n
9"BLD",8489,1,0)
10^^1^1^3120926^
11"BLD",8489,1,1,0)
12Version 1.0
13"BLD",8489,4,0)
14^9.64PA^^
15"BLD",8489,6.3)
164
17"BLD",8489,"ABPKG")
18n
19"BLD",8489,"KRN",0)
20^9.67PA^779.2^20
21"BLD",8489,"KRN",.4,0)
22.4
23"BLD",8489,"KRN",.401,0)
24.401
25"BLD",8489,"KRN",.402,0)
26.402
27"BLD",8489,"KRN",.403,0)
28.403
29"BLD",8489,"KRN",.5,0)
30.5
31"BLD",8489,"KRN",.84,0)
32.84
33"BLD",8489,"KRN",3.6,0)
343.6
35"BLD",8489,"KRN",3.8,0)
363.8
37"BLD",8489,"KRN",9.2,0)
389.2
39"BLD",8489,"KRN",9.8,0)
409.8
41"BLD",8489,"KRN",9.8,"NM",0)
42^9.68A^13^13
43"BLD",8489,"KRN",9.8,"NM",1,0)
44C0SDEM^^0^B59022362
45"BLD",8489,"KRN",9.8,"NM",2,0)
46C0SDOM^^0^B87367162
47"BLD",8489,"KRN",9.8,"NM",3,0)
48C0SLAB^^0^B79265150
49"BLD",8489,"KRN",9.8,"NM",4,0)
50C0SMART^^0^B2907401
51"BLD",8489,"KRN",9.8,"NM",5,0)
52C0SMED^^0^B40719083
53"BLD",8489,"KRN",9.8,"NM",6,0)
54C0SMXMLB^^0^B12189644
55"BLD",8489,"KRN",9.8,"NM",7,0)
56C0SNHIN^^0^B88600644
57"BLD",8489,"KRN",9.8,"NM",8,0)
58C0SNHINV^^0^B15736572
59"BLD",8489,"KRN",9.8,"NM",9,0)
60C0SPROB^^0^B49669400
61"BLD",8489,"KRN",9.8,"NM",10,0)
62C0SPROB2^^0^B67594874
63"BLD",8489,"KRN",9.8,"NM",11,0)
64C0STBL^^0^B2535026
65"BLD",8489,"KRN",9.8,"NM",12,0)
66C0SUTIL^^0^B1005502
67"BLD",8489,"KRN",9.8,"NM",13,0)
68C0SXPATH^^0^B521283143
69"BLD",8489,"KRN",9.8,"NM","B","C0SDEM",1)
70
71"BLD",8489,"KRN",9.8,"NM","B","C0SDOM",2)
72
73"BLD",8489,"KRN",9.8,"NM","B","C0SLAB",3)
74
75"BLD",8489,"KRN",9.8,"NM","B","C0SMART",4)
76
77"BLD",8489,"KRN",9.8,"NM","B","C0SMED",5)
78
79"BLD",8489,"KRN",9.8,"NM","B","C0SMXMLB",6)
80
81"BLD",8489,"KRN",9.8,"NM","B","C0SNHIN",7)
82
83"BLD",8489,"KRN",9.8,"NM","B","C0SNHINV",8)
84
85"BLD",8489,"KRN",9.8,"NM","B","C0SPROB",9)
86
87"BLD",8489,"KRN",9.8,"NM","B","C0SPROB2",10)
88
89"BLD",8489,"KRN",9.8,"NM","B","C0STBL",11)
90
91"BLD",8489,"KRN",9.8,"NM","B","C0SUTIL",12)
92
93"BLD",8489,"KRN",9.8,"NM","B","C0SXPATH",13)
94
95"BLD",8489,"KRN",19,0)
9619
97"BLD",8489,"KRN",19.1,0)
9819.1
99"BLD",8489,"KRN",101,0)
100101
101"BLD",8489,"KRN",409.61,0)
102409.61
103"BLD",8489,"KRN",771,0)
104771
105"BLD",8489,"KRN",779.2,0)
106779.2
107"BLD",8489,"KRN",870,0)
108870
109"BLD",8489,"KRN",8989.51,0)
1108989.51
111"BLD",8489,"KRN",8989.52,0)
1128989.52
113"BLD",8489,"KRN",8994,0)
1148994
115"BLD",8489,"KRN","B",.4,.4)
116
117"BLD",8489,"KRN","B",.401,.401)
118
119"BLD",8489,"KRN","B",.402,.402)
120
121"BLD",8489,"KRN","B",.403,.403)
122
123"BLD",8489,"KRN","B",.5,.5)
124
125"BLD",8489,"KRN","B",.84,.84)
126
127"BLD",8489,"KRN","B",3.6,3.6)
128
129"BLD",8489,"KRN","B",3.8,3.8)
130
131"BLD",8489,"KRN","B",9.2,9.2)
132
133"BLD",8489,"KRN","B",9.8,9.8)
134
135"BLD",8489,"KRN","B",19,19)
136
137"BLD",8489,"KRN","B",19.1,19.1)
138
139"BLD",8489,"KRN","B",101,101)
140
141"BLD",8489,"KRN","B",409.61,409.61)
142
143"BLD",8489,"KRN","B",771,771)
144
145"BLD",8489,"KRN","B",779.2,779.2)
146
147"BLD",8489,"KRN","B",870,870)
148
149"BLD",8489,"KRN","B",8989.51,8989.51)
150
151"BLD",8489,"KRN","B",8989.52,8989.52)
152
153"BLD",8489,"KRN","B",8994,8994)
154
155"BLD",8489,"QUES",0)
156^9.62^^
157"BLD",8489,"REQB",0)
158^9.611^^
159"MBREQ")
1600
161"PKG",218,-1)
1621^1
163"PKG",218,0)
164VISTA SMART CONTAINER^C0S^RDF Server for Harvard's Smart Data Model
165"PKG",218,20,0)
166^9.402P^^
167"PKG",218,22,0)
168^9.49I^1^1
169"PKG",218,22,1,0)
1701.0^3120926
171"PKG",218,22,1,1,0)
172^^1^1^3120926
173"PKG",218,22,1,1,1,0)
174Version 1.0
175"PKG",218,"DEV")
176GPL/WV
177"PKG",218,"VERSION")
1781.0
179"QUES","XPF1",0)
180Y
181"QUES","XPF1","??")
182^D REP^XPDH
183"QUES","XPF1","A")
184Shall I write over your |FLAG| File
185"QUES","XPF1","B")
186YES
187"QUES","XPF1","M")
188D XPF1^XPDIQ
189"QUES","XPF2",0)
190Y
191"QUES","XPF2","??")
192^D DTA^XPDH
193"QUES","XPF2","A")
194Want my data |FLAG| yours
195"QUES","XPF2","B")
196YES
197"QUES","XPF2","M")
198D XPF2^XPDIQ
199"QUES","XPI1",0)
200YO
201"QUES","XPI1","??")
202^D INHIBIT^XPDH
203"QUES","XPI1","A")
204Want KIDS to INHIBIT LOGONs during the install
205"QUES","XPI1","B")
206NO
207"QUES","XPI1","M")
208D XPI1^XPDIQ
209"QUES","XPM1",0)
210PO^VA(200,:EM
211"QUES","XPM1","??")
212^D MG^XPDH
213"QUES","XPM1","A")
214Enter the Coordinator for Mail Group '|FLAG|'
215"QUES","XPM1","B")
216
217"QUES","XPM1","M")
218D XPM1^XPDIQ
219"QUES","XPO1",0)
220Y
221"QUES","XPO1","??")
222^D MENU^XPDH
223"QUES","XPO1","A")
224Want KIDS to Rebuild Menu Trees Upon Completion of Install
225"QUES","XPO1","B")
226NO
227"QUES","XPO1","M")
228D XPO1^XPDIQ
229"QUES","XPZ1",0)
230Y
231"QUES","XPZ1","??")
232^D OPT^XPDH
233"QUES","XPZ1","A")
234Want to DISABLE Scheduled Options, Menu Options, and Protocols
235"QUES","XPZ1","B")
236NO
237"QUES","XPZ1","M")
238D XPZ1^XPDIQ
239"QUES","XPZ2",0)
240Y
241"QUES","XPZ2","??")
242^D RTN^XPDH
243"QUES","XPZ2","A")
244Want to MOVE routines to other CPUs
245"QUES","XPZ2","B")
246NO
247"QUES","XPZ2","M")
248D XPZ2^XPDIQ
249"RTN")
25013
251"RTN","C0SDEM")
2520^1^B59022362
253"RTN","C0SDEM",1,0)
254C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05
255"RTN","C0SDEM",2,0)
256 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
257"RTN","C0SDEM",3,0)
258 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
259"RTN","C0SDEM",4,0)
260 ;General Public License See attached copy of the License.
261"RTN","C0SDEM",5,0)
262 ;
263"RTN","C0SDEM",6,0)
264 ;This program is free software; you can redistribute it and/or modify
265"RTN","C0SDEM",7,0)
266 ;it under the terms of the GNU General Public License as published by
267"RTN","C0SDEM",8,0)
268 ;the Free Software Foundation; either version 2 of the License, or
269"RTN","C0SDEM",9,0)
270 ;(at your option) any later version.
271"RTN","C0SDEM",10,0)
272 ;
273"RTN","C0SDEM",11,0)
274 ;This program is distributed in the hope that it will be useful,
275"RTN","C0SDEM",12,0)
276 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
277"RTN","C0SDEM",13,0)
278 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
279"RTN","C0SDEM",14,0)
280 ;GNU General Public License for more details.
281"RTN","C0SDEM",15,0)
282 ;
283"RTN","C0SDEM",16,0)
284 ;You should have received a copy of the GNU General Public License along
285"RTN","C0SDEM",17,0)
286 ;with this program; if not, write to the Free Software Foundation, Inc.,
287"RTN","C0SDEM",18,0)
288 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
289"RTN","C0SDEM",19,0)
290 ;
291"RTN","C0SDEM",20,0)
292 Q
293"RTN","C0SDEM",21,0)
294 ;
295"RTN","C0SDEM",22,0)
296 ;<?xml version="1.0" encoding="utf-8"?>
297"RTN","C0SDEM",23,0)
298 ;<rdf:RDF
299"RTN","C0SDEM",24,0)
300 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
301"RTN","C0SDEM",25,0)
302 ; xmlns:sp="http://smartplatforms.org/terms#"
303"RTN","C0SDEM",26,0)
304 ; xmlns:dcterms="http://purl.org/dc/terms/"
305"RTN","C0SDEM",27,0)
306 ; xmlns:v="http://www.w3.org/2006/vcard/ns#"
307"RTN","C0SDEM",28,0)
308 ; xmlns:foaf="http://xmlns.com/foaf/0.1/">
309"RTN","C0SDEM",29,0)
310 ; <sp:Demographics>
311"RTN","C0SDEM",30,0)
312 ;
313"RTN","C0SDEM",31,0)
314 ; <v:n>
315"RTN","C0SDEM",32,0)
316 ; <v:Name>
317"RTN","C0SDEM",33,0)
318 ; <v:given-name>Bob</v:given-name>
319"RTN","C0SDEM",34,0)
320 ; <v:additional-name>J</v:additional-name>
321"RTN","C0SDEM",35,0)
322 ; <v:family-name>Odenkirk</v:family-name>
323"RTN","C0SDEM",36,0)
324 ; </v:Name>
325"RTN","C0SDEM",37,0)
326 ; </v:n>
327"RTN","C0SDEM",38,0)
328 ;
329"RTN","C0SDEM",39,0)
330 ; <v:adr>
331"RTN","C0SDEM",40,0)
332 ; <v:Address>
333"RTN","C0SDEM",41,0)
334 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
335"RTN","C0SDEM",42,0)
336 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
337"RTN","C0SDEM",43,0)
338 ;
339"RTN","C0SDEM",44,0)
340 ; <v:street-address>15 Main St</v:street-address>
341"RTN","C0SDEM",45,0)
342 ; <v:extended-address>Apt 2</v:extended-address>
343"RTN","C0SDEM",46,0)
344 ; <v:locality>Wonderland</v:locality>
345"RTN","C0SDEM",47,0)
346 ; <v:region>OZ</v:region>
347"RTN","C0SDEM",48,0)
348 ; <v:postal-code>54321</v:postal-code>
349"RTN","C0SDEM",49,0)
350 ; <v:country>USA</v:country>
351"RTN","C0SDEM",50,0)
352 ; </v:Address>
353"RTN","C0SDEM",51,0)
354 ; </v:adr>
355"RTN","C0SDEM",52,0)
356 ;
357"RTN","C0SDEM",53,0)
358 ; <v:tel>
359"RTN","C0SDEM",54,0)
360 ; <v:Tel>
361"RTN","C0SDEM",55,0)
362 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
363"RTN","C0SDEM",56,0)
364 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
365"RTN","C0SDEM",57,0)
366 ; <rdf:value>800-555-1212</rdf:value>
367"RTN","C0SDEM",58,0)
368 ; </v:Tel>
369"RTN","C0SDEM",59,0)
370 ; </v:tel>
371"RTN","C0SDEM",60,0)
372 ;
373"RTN","C0SDEM",61,0)
374 ; <v:tel>
375"RTN","C0SDEM",62,0)
376 ; <v:Tel>
377"RTN","C0SDEM",63,0)
378 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
379"RTN","C0SDEM",64,0)
380 ; <rdf:value>800-555-1515</rdf:value>
381"RTN","C0SDEM",65,0)
382 ; </v:Tel>
383"RTN","C0SDEM",66,0)
384 ; </v:tel>
385"RTN","C0SDEM",67,0)
386 ;
387"RTN","C0SDEM",68,0)
388 ; <foaf:gender>male</foaf:gender>
389"RTN","C0SDEM",69,0)
390 ; <v:bday>1959-12-25</v:bday>
391"RTN","C0SDEM",70,0)
392 ; <v:email>bob.odenkirk@example.com</v:email>
393"RTN","C0SDEM",71,0)
394 ;
395"RTN","C0SDEM",72,0)
396 ; <sp:medicalRecordNumber>
397"RTN","C0SDEM",73,0)
398 ; <sp:Code>
399"RTN","C0SDEM",74,0)
400 ; <dcterms:title>My Hospital Record 2304575</dcterms:title>
401"RTN","C0SDEM",75,0)
402 ; <dcterms:identifier>2304575</dcterms:identifier>
403"RTN","C0SDEM",76,0)
404 ; <sp:system>My Hospital Record</sp:system>
405"RTN","C0SDEM",77,0)
406 ; </sp:Code>
407"RTN","C0SDEM",78,0)
408 ; </sp:medicalRecordNumber>
409"RTN","C0SDEM",79,0)
410 ;
411"RTN","C0SDEM",80,0)
412 ; </sp:Demographics>
413"RTN","C0SDEM",81,0)
414 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?>
415"RTN","C0SDEM",82,0)
416 ;<rdf:RDF
417"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"RTN","C0SDEM",138,0)
528 ;
529"RTN","C0SDEM",139,0)
530 ; </sp:Demographics>
531"RTN","C0SDEM",140,0)
532 ;</rdf:RDF>
533"RTN","C0SDEM",141,0)
534 ;G(1)="nodeID:25591^rdf:type^v:Home"
535"RTN","C0SDEM",142,0)
536 ;G(2)="nodeID:25591^rdf:type^v:Pref"
537"RTN","C0SDEM",143,0)
538 ;G(3)="nodeID:25591^rdf:type^v:Tel"
539"RTN","C0SDEM",144,0)
540 ;G(4)="nodeID:25591^rdf:value^800-369-6403"
541"RTN","C0SDEM",145,0)
542 ;G(5)="nodeID:25611^rdf:type^v:Name"
543"RTN","C0SDEM",146,0)
544 ;G(6)="nodeID:25611^v:additional-name^N"
545"RTN","C0SDEM",147,0)
546 ;G(7)="nodeID:25611^v:family-name^Brooks"
547"RTN","C0SDEM",148,0)
548 ;G(8)="nodeID:25611^v:given-name^Brian"
549"RTN","C0SDEM",149,0)
550 ;G(9)="nodeID:25622^dcterms:identifier^981968"
551"RTN","C0SDEM",150,0)
552 ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968"
553"RTN","C0SDEM",151,0)
554 ;G(11)="nodeID:25622^rdf:type^sp:Code"
555"RTN","C0SDEM",152,0)
556 ;G(12)="nodeID:25622^sp:system^My Hospital Record"
557"RTN","C0SDEM",153,0)
558 ;G(13)="nodeID:25623^rdf:type^v:Address"
559"RTN","C0SDEM",154,0)
560 ;G(14)="nodeID:25623^rdf:type^v:Home"
561"RTN","C0SDEM",155,0)
562 ;G(15)="nodeID:25623^rdf:type^v:Pref"
563"RTN","C0SDEM",156,0)
564 ;G(16)="nodeID:25623^v:locality^Bixby"
565"RTN","C0SDEM",157,0)
566 ;G(17)="nodeID:25623^v:postal-code^74008"
567"RTN","C0SDEM",158,0)
568 ;G(18)="nodeID:25623^v:region^OK"
569"RTN","C0SDEM",159,0)
570 ;G(19)="nodeID:25623^v:street-address^82 Lake St"
571"RTN","C0SDEM",160,0)
572 ;G(20)="smart:981968/demographics^foaf:gender^male"
573"RTN","C0SDEM",161,0)
574 ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics"
575"RTN","C0SDEM",162,0)
576 ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968"
577"RTN","C0SDEM",163,0)
578 ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622"
579"RTN","C0SDEM",164,0)
580 ;G(24)="smart:981968/demographics^v:adr^nodeID:25623"
581"RTN","C0SDEM",165,0)
582 ;G(25)="smart:981968/demographics^v:bday^1956-03-23"
583"RTN","C0SDEM",166,0)
584 ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com"
585"RTN","C0SDEM",167,0)
586 ;G(27)="smart:981968/demographics^v:n^nodeID:25611"
587"RTN","C0SDEM",168,0)
588 ;G(28)="smart:981968/demographics^v:tel^nodeID:25591"
589"RTN","C0SDEM",169,0)
590 Q
591"RTN","C0SDEM",170,0)
592 ;
593"RTN","C0SDEM",171,0)
594PATIENT(GRTN,C0SARY) ; GRTN, passed by reference,
595"RTN","C0SDEM",172,0)
596 ; is the return name of the graph created. "" if none
597"RTN","C0SDEM",173,0)
598 ; C0SARY is passed in by reference and is the NHIN array of patient
599"RTN","C0SDEM",174,0)
600 ;
601"RTN","C0SDEM",175,0)
602 I $O(C0SARY("patient",""))="" D Q ;
603"RTN","C0SDEM",176,0)
604 . I $D(DEBUG) W !,"No Patient array"
605"RTN","C0SDEM",177,0)
606 . S GRTN=""
607"RTN","C0SDEM",178,0)
608 S GRTN="" ; default to no patient
609"RTN","C0SDEM",179,0)
610 N C0SGRF
611"RTN","C0SDEM",180,0)
612 S C0SGRF="vistaSmart:"_ZPATID_"/patient"
613"RTN","C0SDEM",181,0)
614 S ZPAT=C0SGRF ; subject is the same as the graph name
615"RTN","C0SDEM",182,0)
616 I $D(DEBUG) W !,"Processing ",C0SGRF
617"RTN","C0SDEM",183,0)
618 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
619"RTN","C0SDEM",184,0)
620 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
621"RTN","C0SDEM",185,0)
622 N FARY S FARY="C0XFARY"
623"RTN","C0SDEM",186,0)
624 D USEFARY^C0XF2N(FARY)
625"RTN","C0SDEM",187,0)
626 D VOCINIT^C0XUTIL
627"RTN","C0SDEM",188,0)
628 ;
629"RTN","C0SDEM",189,0)
630 N ZPN,ZR
631"RTN","C0SDEM",190,0)
632 D STARTADD^C0XF2N
633"RTN","C0SDEM",191,0)
634 ;
635"RTN","C0SDEM",192,0)
636 ; First do the base demographic graph
637"RTN","C0SDEM",193,0)
638 ;
639"RTN","C0SDEM",194,0)
640 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient
641"RTN","C0SDEM",195,0)
642 N SEX S SEX=$G(@ZPN@("gender@value"))
643"RTN","C0SDEM",196,0)
644 I SEX="M" S SEX="male"
645"RTN","C0SDEM",197,0)
646 I SEX="F" S SEX="female"
647"RTN","C0SDEM",198,0)
648 S ZR("foaf:gender")=SEX
649"RTN","C0SDEM",199,0)
650 S ZR("rdf:type")="sp:Demographics"
651"RTN","C0SDEM",200,0)
652 S ZR("sp:belongsTo")=ZPAT
653"RTN","C0SDEM",201,0)
654 N PATIENT
655"RTN","C0SDEM",202,0)
656 S PATIENT=$P(ZPAT,"#",2)
657"RTN","C0SDEM",203,0)
658 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT
659"RTN","C0SDEM",204,0)
660 N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph
661"RTN","C0SDEM",205,0)
662 S ZR("sp:medicalRecordNumber")=NMREC
663"RTN","C0SDEM",206,0)
664 N NVADR S NVADR=$$ANONS^C0XF2N ; for address
665"RTN","C0SDEM",207,0)
666 S ZR("v:adr")=NVADR
667"RTN","C0SDEM",208,0)
668 N NNAME S NNAME=$$ANONS^C0XF2N ; for name
669"RTN","C0SDEM",209,0)
670 S ZR("v:n")=NNAME
671"RTN","C0SDEM",210,0)
672 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone
673"RTN","C0SDEM",211,0)
674 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists
675"RTN","C0SDEM",212,0)
676 N BDATE
677"RTN","C0SDEM",213,0)
678 S ZX=""
679"RTN","C0SDEM",214,0)
680 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format
681"RTN","C0SDEM",215,0)
682 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date
683"RTN","C0SDEM",216,0)
684 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens
685"RTN","C0SDEM",217,0)
686 I BDATE="" S BDATE="UNKNOWN"
687"RTN","C0SDEM",218,0)
688 N Z2,Z3
689"RTN","C0SDEM",219,0)
690 S Z2=$P(BDATE,"-",2)
691"RTN","C0SDEM",220,0)
692 S Z3=$P(BDATE,"-",3)
693"RTN","C0SDEM",221,0)
694 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2
695"RTN","C0SDEM",222,0)
696 I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3
697"RTN","C0SDEM",223,0)
698 S ZR("v:bday")=BDATE
699"RTN","C0SDEM",224,0)
700 I $D(C0SVISTA) D ;
701"RTN","C0SDEM",225,0)
702 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN
703"RTN","C0SDEM",226,0)
704 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN
705"RTN","C0SDEM",227,0)
706 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph
707"RTN","C0SDEM",228,0)
708 K ZR
709"RTN","C0SDEM",229,0)
710 ;
711"RTN","C0SDEM",230,0)
712 ; create address sub-graph
713"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"RTN","C0SDEM",238,0)
728 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address
729"RTN","C0SDEM",239,0)
730 K ZR
731"RTN","C0SDEM",240,0)
732 ;
733"RTN","C0SDEM",241,0)
734 ; create medical record subgraph
735"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"RTN","C0SDEM",247,0)
746 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph
747"RTN","C0SDEM",248,0)
748 K ZR
749"RTN","C0SDEM",249,0)
750 ;
751"RTN","C0SDEM",250,0)
752 ; create name subgraph
753"RTN","C0SDEM",251,0)
754 ;
755"RTN","C0SDEM",252,0)
756 N ZNF,ZNL,ZNM,ZNAM
757"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 names
761"RTN","C0SDEM",255,0)
762 S ZNF=$P(ZX," ",1) ; first name is first piece
763"RTN","C0SDEM",256,0)
764 S ZNM=$P(ZX," ",2) ; middle names are the rest
765"RTN","C0SDEM",257,0)
766 S ZR("v:additional-name")=ZNM
767"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")=ZNF
771"RTN","C0SDEM",260,0)
772 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph
773"RTN","C0SDEM",261,0)
774 K ZR
775"RTN","C0SDEM",262,0)
776 ;
777"RTN","C0SDEM",263,0)
778 ; create telephone subgraph
779"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 subgraph
787"RTN","C0SDEM",268,0)
788 . S ZR("rdf:type")="v:Tel"
789"RTN","C0SDEM",269,0)
790 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR)
791"RTN","C0SDEM",270,0)
792 K ZR
793"RTN","C0SDEM",271,0)
794 ;
795"RTN","C0SDEM",272,0)
796 ; load the demographics graph and all sub graphs to the triple store
797"RTN","C0SDEM",273,0)
798 ;
799"RTN","C0SDEM",274,0)
800 D BULKLOAD^C0XF2N(.C0XFDA)
801"RTN","C0SDEM",275,0)
802 S GRTN=C0SGRF
803"RTN","C0SDEM",276,0)
804 Q
805"RTN","C0SDEM",277,0)
806 ;
807"RTN","C0SDEM",278,0)
808AGES ; LIST ALL PATIENTS AND THEIR AGES
809"RTN","C0SDEM",279,0)
810 N ZI S ZI=0
811"RTN","C0SDEM",280,0)
812 F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT
813"RTN","C0SDEM",281,0)
814 . N ZDOB
815"RTN","C0SDEM",282,0)
816 . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB
817"RTN","C0SDEM",283,0)
818 . N ZNAME
819"RTN","C0SDEM",284,0)
820 . S ZNAME=$P(^DPT(ZI,0),U)
821"RTN","C0SDEM",285,0)
822 . N ZSEX
823"RTN","C0SDEM",286,0)
824 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX")
825"RTN","C0SDEM",287,0)
826 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX
827"RTN","C0SDEM",288,0)
828 Q
829"RTN","C0SDEM",289,0)
830 ;
831"RTN","C0SDOM")
8320^2^B87367162
833"RTN","C0SDOM",1,0)
834C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05
835"RTN","C0SDOM",2,0)
836 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
837"RTN","C0SDOM",3,0)
838 ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU
839"RTN","C0SDOM",4,0)
840 ;General Public License See attached copy of the License.
841"RTN","C0SDOM",5,0)
842 ;
843"RTN","C0SDOM",6,0)
844 ;This program is free software; you can redistribute it and/or modify
845"RTN","C0SDOM",7,0)
846 ;it under the terms of the GNU General Public License as published by
847"RTN","C0SDOM",8,0)
848 ;the Free Software Foundation; either version 2 of the License, or
849"RTN","C0SDOM",9,0)
850 ;(at your option) any later version.
851"RTN","C0SDOM",10,0)
852 ;
853"RTN","C0SDOM",11,0)
854
855"RTN","C0SDOM",12,0)
856 ;This program is distributed in the hope that it will be useful,
857"RTN","C0SDOM",13,0)
858 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
859"RTN","C0SDOM",14,0)
860 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
861"RTN","C0SDOM",15,0)
862 ;GNU General Public License for more details.
863"RTN","C0SDOM",16,0)
864 ;
865"RTN","C0SDOM",17,0)
866 ;You should have received a copy of the GNU General Public License along
867"RTN","C0SDOM",18,0)
868 ;with this program; if not, write to the Free Software Foundation, Inc.,
869"RTN","C0SDOM",19,0)
870 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
871"RTN","C0SDOM",20,0)
872 ;
873"RTN","C0SDOM",21,0)
874 Q
875"RTN","C0SDOM",22,0)
876 ;
877"RTN","C0SDOM",23,0)
878DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
879"RTN","C0SDOM",24,0)
880 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
881"RTN","C0SDOM",25,0)
882 ; THE XPATH ARRAY XPARY, PASSED BY NAME
883"RTN","C0SDOM",26,0)
884 ; ZOID IS THE STARTING OID
885"RTN","C0SDOM",27,0)
886 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
887"RTN","C0SDOM",28,0)
888 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
889"RTN","C0SDOM",29,0)
890 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
891"RTN","C0SDOM",30,0)
892 I $G(ZREDUX)="" S ZREDUX=""
893"RTN","C0SDOM",31,0)
894 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
895"RTN","C0SDOM",32,0)
896 N NEWNUM S NEWNUM=""
897"RTN","C0SDOM",33,0)
898 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
899"RTN","C0SDOM",34,0)
900 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
901"RTN","C0SDOM",35,0)
902 I $G(ZREDUX)'="" D ; REDUX PROVIDED?
903"RTN","C0SDOM",36,0)
904 . N GT S GT=$P(NEWPATH,ZREDUX,2)
905"RTN","C0SDOM",37,0)
906 . I GT'="" S NEWPATH=GT
907"RTN","C0SDOM",38,0)
908 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
909"RTN","C0SDOM",39,0)
910 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
911"RTN","C0SDOM",40,0)
912 I $D(GA) D ; PROCESS THE ATTRIBUTES
913"RTN","C0SDOM",41,0)
914 . N ZI S ZI=""
915"RTN","C0SDOM",42,0)
916 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
917"RTN","C0SDOM",43,0)
918 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
919"RTN","C0SDOM",44,0)
920 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
921"RTN","C0SDOM",45,0)
922 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
923"RTN","C0SDOM",46,0)
924 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
925"RTN","C0SDOM",47,0)
926 I $D(GD(2)) D ;
927"RTN","C0SDOM",48,0)
928 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
929"RTN","C0SDOM",49,0)
930 E I $D(GD(1)) D ;
931"RTN","C0SDOM",50,0)
932 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
933"RTN","C0SDOM",51,0)
934 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
935"RTN","C0SDOM",52,0)
936 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
937"RTN","C0SDOM",53,0)
938 I ZFRST'=0 D ; THERE IS A CHILD
939"RTN","C0SDOM",54,0)
940 . N ZNUM
941"RTN","C0SDOM",55,0)
942 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
943"RTN","C0SDOM",56,0)
944 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
945"RTN","C0SDOM",57,0)
946 N GNXT S GNXT=$$NXTSIB(ZOID)
947"RTN","C0SDOM",58,0)
948 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
949"RTN","C0SDOM",59,0)
950 I GNXT'=0 D ;
951"RTN","C0SDOM",60,0)
952 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
953"RTN","C0SDOM",61,0)
954 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
955"RTN","C0SDOM",62,0)
956 . . N ZNUM S ZNUM=1 ;
957"RTN","C0SDOM",63,0)
958 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
959"RTN","C0SDOM",64,0)
960 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
961"RTN","C0SDOM",65,0)
962 Q
963"RTN","C0SDOM",66,0)
964 ;
965"RTN","C0SDOM",67,0)
966ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
967"RTN","C0SDOM",68,0)
968 ;
969"RTN","C0SDOM",69,0)
970 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
971"RTN","C0SDOM",70,0)
972 ;
973"RTN","C0SDOM",71,0)
974 N ZZI,ZZJ,ZZN
975"RTN","C0SDOM",72,0)
976 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
977"RTN","C0SDOM",73,0)
978 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
979"RTN","C0SDOM",74,0)
980 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
981"RTN","C0SDOM",75,0)
982 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
983"RTN","C0SDOM",76,0)
984 I ZZI'["]" D ; A SINGLETON
985"RTN","C0SDOM",77,0)
986 . S ZZN=1
987"RTN","C0SDOM",78,0)
988 E D ; THERE IS AN [x] OCCURANCE
989"RTN","C0SDOM",79,0)
990 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
991"RTN","C0SDOM",80,0)
992 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
993"RTN","C0SDOM",81,0)
994 I ZZJ'="" D ; TIME TO ADD THE VALUE
995"RTN","C0SDOM",82,0)
996 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
997"RTN","C0SDOM",83,0)
998 Q
999"RTN","C0SDOM",84,0)
1000 ;
1001"RTN","C0SDOM",85,0)
1002PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
1003"RTN","C0SDOM",86,0)
1004 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
1005"RTN","C0SDOM",87,0)
1006 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
1007"RTN","C0SDOM",88,0)
1008 ;Q $$EN^MXMLDOM(INXML)
1009"RTN","C0SDOM",89,0)
1010 Q $$EN^MXMLDOM(INXML,"W")
1011"RTN","C0SDOM",90,0)
1012 ;
1013"RTN","C0SDOM",91,0)
1014ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
1015"RTN","C0SDOM",92,0)
1016 N ZN
1017"RTN","C0SDOM",93,0)
1018 ;I $$TAG(ZOID)["entry" B
1019"RTN","C0SDOM",94,0)
1020 S ZN=$$NXTSIB(ZOID)
1021"RTN","C0SDOM",95,0)
1022 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
1023"RTN","C0SDOM",96,0)
1024 Q 0
1025"RTN","C0SDOM",97,0)
1026 ;
1027"RTN","C0SDOM",98,0)
1028FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
1029"RTN","C0SDOM",99,0)
1030 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
1031"RTN","C0SDOM",100,0)
1032 ;
1033"RTN","C0SDOM",101,0)
1034PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
1035"RTN","C0SDOM",102,0)
1036 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
1037"RTN","C0SDOM",103,0)
1038 ;
1039"RTN","C0SDOM",104,0)
1040ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
1041"RTN","C0SDOM",105,0)
1042 S HANDLE=C0SDOCID
1043"RTN","C0SDOM",106,0)
1044 K @RTN
1045"RTN","C0SDOM",107,0)
1046 D GETTXT^MXMLDOM("A")
1047"RTN","C0SDOM",108,0)
1048 Q
1049"RTN","C0SDOM",109,0)
1050 ;
1051"RTN","C0SDOM",110,0)
1052TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
1053"RTN","C0SDOM",111,0)
1054 ;I ZOID=149 B ;GPLTEST
1055"RTN","C0SDOM",112,0)
1056 N X,Y
1057"RTN","C0SDOM",113,0)
1058 S Y=""
1059"RTN","C0SDOM",114,0)
1060 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
1061"RTN","C0SDOM",115,0)
1062 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
1063"RTN","C0SDOM",116,0)
1064 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
1065"RTN","C0SDOM",117,0)
1066 Q Y
1067"RTN","C0SDOM",118,0)
1068 ;
1069"RTN","C0SDOM",119,0)
1070NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
1071"RTN","C0SDOM",120,0)
1072 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
1073"RTN","C0SDOM",121,0)
1074 ;
1075"RTN","C0SDOM",122,0)
1076DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
1077"RTN","C0SDOM",123,0)
1078 ;N ZT,ZN S ZT=""
1079"RTN","C0SDOM",124,0)
1080 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
1081"RTN","C0SDOM",125,0)
1082 ;Q $G(@C0SDOM@(ZOID,"T",1))
1083"RTN","C0SDOM",126,0)
1084 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
1085"RTN","C0SDOM",127,0)
1086 Q
1087"RTN","C0SDOM",128,0)
1088 ;
1089"RTN","C0SDOM",129,0)
1090OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
1091"RTN","C0SDOM",130,0)
1092 ;
1093"RTN","C0SDOM",131,0)
1094 S C0SDOCID=INID
1095"RTN","C0SDOM",132,0)
1096 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
1097"RTN","C0SDOM",133,0)
1098 D START^C0SMXMLB($$TAG(1),,"G",NO1ST)
1099"RTN","C0SDOM",134,0)
1100 D NDOUT($$FIRST(1))
1101"RTN","C0SDOM",135,0)
1102 D END^C0SMXMLB ;END THE DOCUMENT
1103"RTN","C0SDOM",136,0)
1104 M @ZRTN=^TMP("MXMLBLD",$J)
1105"RTN","C0SDOM",137,0)
1106 K ^TMP("MXMLBLD",$J)
1107"RTN","C0SDOM",138,0)
1108 Q
1109"RTN","C0SDOM",139,0)
1110 ;
1111"RTN","C0SDOM",140,0)
1112NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
1113"RTN","C0SDOM",141,0)
1114 N ZI S ZI=$$FIRST(ZOID)
1115"RTN","C0SDOM",142,0)
1116 I ZI'=0 D ; THERE IS A CHILD
1117"RTN","C0SDOM",143,0)
1118 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
1119"RTN","C0SDOM",144,0)
1120 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
1121"RTN","C0SDOM",145,0)
1122 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
1123"RTN","C0SDOM",146,0)
1124 . ;W "DOING",ZOID,!
1125"RTN","C0SDOM",147,0)
1126 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
1127"RTN","C0SDOM",148,0)
1128 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
1129"RTN","C0SDOM",149,0)
1130 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
1131"RTN","C0SDOM",150,0)
1132 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
1133"RTN","C0SDOM",151,0)
1134 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
1135"RTN","C0SDOM",152,0)
1136 Q
1137"RTN","C0SDOM",153,0)
1138 ;
1139"RTN","C0SDOM",154,0)
1140WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
1141"RTN","C0SDOM",155,0)
1142 ;
1143"RTN","C0SDOM",156,0)
1144 N GN,GN2
1145"RTN","C0SDOM",157,0)
1146 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
1147"RTN","C0SDOM",158,0)
1148 S GN2=$NA(@GN@(1))
1149"RTN","C0SDOM",159,0)
1150 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
1151"RTN","C0SDOM",160,0)
1152 Q
1153"RTN","C0SDOM",161,0)
1154 ;
1155"RTN","C0SDOM",162,0)
1156NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
1157"RTN","C0SDOM",163,0)
1158 ; ZGOUT AND ZGIN ARE PASSED BY NAME
1159"RTN","C0SDOM",164,0)
1160 N C0SDOCID
1161"RTN","C0SDOM",165,0)
1162 W !,ZGOUT," ",ZGIN
1163"RTN","C0SDOM",166,0)
1164 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
1165"RTN","C0SDOM",167,0)
1166 D OUTXML(ZGOUT,C0SDOCID)
1167"RTN","C0SDOM",168,0)
1168 Q
1169"RTN","C0SDOM",169,0)
1170 ;
1171"RTN","C0SDOM",170,0)
1172 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
1173"RTN","C0SDOM",171,0)
1174 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
1175"RTN","C0SDOM",172,0)
1176 ;
1177"RTN","C0SDOM",173,0)
1178 ;GNARY("med",1,"doses.dose@dose")=10
1179"RTN","C0SDOM",174,0)
1180 ;GNARY("med",1,"doses.dose@noun")="TABLET"
1181"RTN","C0SDOM",175,0)
1182 ;GNARY("med",1,"doses.dose@route")="PO"
1183"RTN","C0SDOM",176,0)
1184 ;GNARY("med",1,"doses.dose@schedule")="QD"
1185"RTN","C0SDOM",177,0)
1186 ;GNARY("med",1,"doses.dose@units")="MG"
1187"RTN","C0SDOM",178,0)
1188 ;GNARY("med",1,"doses.dose@unitsPerDose")=1
1189"RTN","C0SDOM",179,0)
1190 ;GNARY("med",1,"facility@code")=100
1191"RTN","C0SDOM",180,0)
1192 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
1193"RTN","C0SDOM",181,0)
1194 ;GNARY("med",1,"form@value")="TAB"
1195"RTN","C0SDOM",182,0)
1196 ;GNARY("med",1,"id@value")="1N;O"
1197"RTN","C0SDOM",183,0)
1198 ;GNARY("med",1,"location@code")=5
1199"RTN","C0SDOM",184,0)
1200 ;GNARY("med",1,"location@name")="3 WEST"
1201"RTN","C0SDOM",185,0)
1202 ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
1203"RTN","C0SDOM",186,0)
1204 ;GNARY("med",1,"orderID@value")=294
1205"RTN","C0SDOM",187,0)
1206 ;GNARY("med",1,"ordered@value")=3110531.001233
1207"RTN","C0SDOM",188,0)
1208 ;GNARY("med",1,"orderingProvider@code")=63
1209"RTN","C0SDOM",189,0)
1210 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
1211"RTN","C0SDOM",190,0)
1212 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
1213"RTN","C0SDOM",191,0)
1214 ;GNARY("med",1,"products.product.vaGeneric@code")=1990
1215"RTN","C0SDOM",192,0)
1216 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
1217"RTN","C0SDOM",193,0)
1218 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
1219"RTN","C0SDOM",194,0)
1220 ;GNARY("med",1,"products.product.vaProduct@code")=8118
1221"RTN","C0SDOM",195,0)
1222 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
1223"RTN","C0SDOM",196,0)
1224 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
1225"RTN","C0SDOM",197,0)
1226 ;GNARY("med",1,"products.product@code")=6174
1227"RTN","C0SDOM",198,0)
1228 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
1229"RTN","C0SDOM",199,0)
1230 ;GNARY("med",1,"products.product@role")="D"
1231"RTN","C0SDOM",200,0)
1232 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
1233"RTN","C0SDOM",201,0)
1234 ;GNARY("med",1,"sig@xml:space")="preserve"
1235"RTN","C0SDOM",202,0)
1236 ;GNARY("med",1,"status@value")="active"
1237"RTN","C0SDOM",203,0)
1238 ;GNARY("med",1,"type@value")="OTC"
1239"RTN","C0SDOM",204,0)
1240 ;GNARY("med",1,"vaType@value")="N"
1241"RTN","C0SDOM",205,0)
1242 ;
1243"RTN","C0SDOM",206,0)
1244 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
1245"RTN","C0SDOM",207,0)
1246 ; it returns 0 or 1 based on success.
1247"RTN","C0SDOM",208,0)
1248 ;
1249"RTN","C0SDOM",209,0)
1250 ; INARY is passed by name and has the format shown above
1251"RTN","C0SDOM",210,0)
1252 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
1253"RTN","C0SDOM",211,0)
1254 ; be supported eventually - initial implementation is for MXML
1255"RTN","C0SDOM",212,0)
1256 ;
1257"RTN","C0SDOM",213,0)
1258 ; PARENT is the node id or tag of the parent under which the DOM will
1259"RTN","C0SDOM",214,0)
1260 ; be populated. If it is numeric, it is a node. If it is a string, the DOM
1261"RTN","C0SDOM",215,0)
1262 ; will be searched to find the tag. If not found and there is no root,
1263"RTN","C0SDOM",216,0)
1264 ; it will be inserted as the root. If not found and there is a root, it
1265"RTN","C0SDOM",217,0)
1266 ; will be inserted under the root.
1267"RTN","C0SDOM",218,0)
1268 ;
1269"RTN","C0SDOM",219,0)
1270 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
1271"RTN","C0SDOM",220,0)
1272 ; because "results" is the root tag. Use OUTXML to render the xml from
1273"RTN","C0SDOM",221,0)
1274 ; the DOM.
1275"RTN","C0SDOM",222,0)
1276 ;
1277"RTN","C0SDOM",223,0)
1278DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
1279"RTN","C0SDOM",224,0)
1280 ;
1281"RTN","C0SDOM",225,0)
1282 N ZPARNODE
1283"RTN","C0SDOM",226,0)
1284 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
1285"RTN","C0SDOM",227,0)
1286 I '$D(INARY) Q 0 ; NO ARRAY PASSED
1287"RTN","C0SDOM",228,0)
1288 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
1289"RTN","C0SDOM",229,0)
1290 ;I PARENT="" S PARENT="root"
1291"RTN","C0SDOM",230,0)
1292 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
1293"RTN","C0SDOM",231,0)
1294 E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
1295"RTN","C0SDOM",232,0)
1296 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
1297"RTN","C0SDOM",233,0)
1298 . S ZPARNODE=1 ;
1299"RTN","C0SDOM",234,0)
1300 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
1301"RTN","C0SDOM",235,0)
1302 N ZEXARY
1303"RTN","C0SDOM",236,0)
1304 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
1305"RTN","C0SDOM",237,0)
1306 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
1307"RTN","C0SDOM",238,0)
1308 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
1309"RTN","C0SDOM",239,0)
1310 Q HANDLE ; SUCCESS
1311"RTN","C0SDOM",240,0)
1312 ;
1313"RTN","C0SDOM",241,0)
1314MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
1315"RTN","C0SDOM",242,0)
1316 N ZI S ZI=""
1317"RTN","C0SDOM",243,0)
1318 N ZTAG
1319"RTN","C0SDOM",244,0)
1320 F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION
1321"RTN","C0SDOM",245,0)
1322 . N ZELEADD S ZELEADD=0
1323"RTN","C0SDOM",246,0)
1324 . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
1325"RTN","C0SDOM",247,0)
1326 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
1327"RTN","C0SDOM",248,0)
1328 . . K ZATT ; CLEAR OUT LAST ONE
1329"RTN","C0SDOM",249,0)
1330 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
1331"RTN","C0SDOM",250,0)
1332 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
1333"RTN","C0SDOM",251,0)
1334 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
1335"RTN","C0SDOM",252,0)
1336 . I $O(@ZARY@(ZI,""))="" D ;END NODE
1337"RTN","C0SDOM",253,0)
1338 . . S ZTAG=ZI ; USE ZI FOR THE TAG
1339"RTN","C0SDOM",254,0)
1340 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
1341"RTN","C0SDOM",255,0)
1342 . . S ZELEADD=1 ; ADDED AN ELEMENT
1343"RTN","C0SDOM",256,0)
1344 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
1345"RTN","C0SDOM",257,0)
1346 . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL
1347"RTN","C0SDOM",258,0)
1348 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
1349"RTN","C0SDOM",259,0)
1350 . N NEWARY ; INDENTED ARRAY
1351"RTN","C0SDOM",260,0)
1352 . N ZN S ZN=0
1353"RTN","C0SDOM",261,0)
1354 . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE
1355"RTN","C0SDOM",262,0)
1356 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
1357"RTN","C0SDOM",263,0)
1358 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
1359"RTN","C0SDOM",264,0)
1360 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
1361"RTN","C0SDOM",265,0)
1362 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
1363"RTN","C0SDOM",266,0)
1364 Q
1365"RTN","C0SDOM",267,0)
1366 ;
1367"RTN","C0SDOM",268,0)
1368EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
1369"RTN","C0SDOM",269,0)
1370 ; CONSISTENT FORMAT
1371"RTN","C0SDOM",270,0)
1372 ; GNARY("patient",1,"facilities[2].facility@code")="050"
1373"RTN","C0SDOM",271,0)
1374 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
1375"RTN","C0SDOM",272,0)
1376 ; for easier processing (this is fileman format genius)
1377"RTN","C0SDOM",273,0)
1378 ; basically removes the dot notation from the strings
1379"RTN","C0SDOM",274,0)
1380 ;
1381"RTN","C0SDOM",275,0)
1382 N ZZI
1383"RTN","C0SDOM",276,0)
1384 S ZZI=""
1385"RTN","C0SDOM",277,0)
1386 F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ;
1387"RTN","C0SDOM",278,0)
1388 . N ZZN S ZZN=0
1389"RTN","C0SDOM",279,0)
1390 . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ;
1391"RTN","C0SDOM",280,0)
1392 . . N ZZS S ZZS=""
1393"RTN","C0SDOM",281,0)
1394 . . N GA ;PUSH STACK
1395"RTN","C0SDOM",282,0)
1396 . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ;
1397"RTN","C0SDOM",283,0)
1398 . . . K GA ; NEW STACK
1399"RTN","C0SDOM",284,0)
1400 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
1401"RTN","C0SDOM",285,0)
1402 . . . N ZZV ; PLACE TO STASH THE VALUE
1403"RTN","C0SDOM",286,0)
1404 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
1405"RTN","C0SDOM",287,0)
1406 . . . W !,"VALUE:",ZZV
1407"RTN","C0SDOM",288,0)
1408 . . . N GK ; COUNTER
1409"RTN","C0SDOM",289,0)
1410 . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE
1411"RTN","C0SDOM",290,0)
1412 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
1413"RTN","C0SDOM",291,0)
1414 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
1415"RTN","C0SDOM",292,0)
1416 . . . . I GM["[" D ; IT'S A MULTIPLE
1417"RTN","C0SDOM",293,0)
1418 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
1419"RTN","C0SDOM",294,0)
1420 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
1421"RTN","C0SDOM",295,0)
1422 . . . . I GM["@" D ; IT'S GOT ATTRIBUTES
1423"RTN","C0SDOM",296,0)
1424 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
1425"RTN","C0SDOM",297,0)
1426 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
1427"RTN","C0SDOM",298,0)
1428 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2)
1429"RTN","C0SDOM",299,0)
1430 . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ;
1431"RTN","C0SDOM",300,0)
1432 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"
1433"RTN","C0SDOM",301,0)
1434 . . . N GZI S GZI="" ; STRING FOR THE INDEX
1435"RTN","C0SDOM",302,0)
1436 . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS
1437"RTN","C0SDOM",303,0)
1438 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
1439"RTN","C0SDOM",304,0)
1440 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
1441"RTN","C0SDOM",305,0)
1442 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
1443"RTN","C0SDOM",306,0)
1444 . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
1445"RTN","C0SDOM",307,0)
1446 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
1447"RTN","C0SDOM",308,0)
1448 . . . W !,GZI
1449"RTN","C0SDOM",309,0)
1450 . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
1451"RTN","C0SDOM",310,0)
1452 Q
1453"RTN","C0SDOM",311,0)
1454 ;
1455"RTN","C0SDOM",312,0)
1456NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
1457"RTN","C0SDOM",313,0)
1458 N CBK,SUCCESS,LEVEL,NODE,HANDLE
1459"RTN","C0SDOM",314,0)
1460 K ^TMP("MXMLERR",$J)
1461"RTN","C0SDOM",315,0)
1462 L +^TMP("MXMLDOM",$J):5
1463"RTN","C0SDOM",316,0)
1464 E Q 0
1465"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 HANDLE
1471"RTN","C0SDOM",320,0)
1472 ;
1473"RTN","C0SLAB")
14740^3^B79265150
1475"RTN","C0SLAB",1,0)
1476C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05
1477"RTN","C0SLAB",2,0)
1478 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
1479"RTN","C0SLAB",3,0)
1480 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
1481"RTN","C0SLAB",4,0)
1482 ;General Public License See attached copy of the License.
1483"RTN","C0SLAB",5,0)
1484 ;
1485"RTN","C0SLAB",6,0)
1486 ;This program is free software; you can redistribute it and/or modify
1487"RTN","C0SLAB",7,0)
1488 ;it under the terms of the GNU General Public License as published by
1489"RTN","C0SLAB",8,0)
1490 ;the Free Software Foundation; either version 2 of the License, or
1491"RTN","C0SLAB",9,0)
1492 ;(at your option) any later version.
1493"RTN","C0SLAB",10,0)
1494 ;
1495"RTN","C0SLAB",11,0)
1496 ;This program is distributed in the hope that it will be useful,
1497"RTN","C0SLAB",12,0)
1498 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
1499"RTN","C0SLAB",13,0)
1500 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1501"RTN","C0SLAB",14,0)
1502 ;GNU General Public License for more details.
1503"RTN","C0SLAB",15,0)
1504 ;
1505"RTN","C0SLAB",16,0)
1506 ;You should have received a copy of the GNU General Public License along
1507"RTN","C0SLAB",17,0)
1508 ;with this program; if not, write to the Free Software Foundation, Inc.,
1509"RTN","C0SLAB",18,0)
1510 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
1511"RTN","C0SLAB",19,0)
1512 ;
1513"RTN","C0SLAB",20,0)
1514 Q
1515"RTN","C0SLAB",21,0)
1516 ;
1517"RTN","C0SLAB",22,0)
1518 ; sample VistA NHIN lab result
1519"RTN","C0SLAB",23,0)
1520 ;
1521"RTN","C0SLAB",24,0)
1522 ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16
1523"RTN","C0SLAB",25,0)
1524 ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00"
1525"RTN","C0SLAB",26,0)
1526 ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve"
1527"RTN","C0SLAB",27,0)
1528 ;^TMP("C0STBL",32,"lab",8,"facility@code")=100
1529"RTN","C0SLAB",28,0)
1530 ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION"
1531"RTN","C0SLAB",29,0)
1532 ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47"
1533"RTN","C0SLAB",30,0)
1534 ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101"
1535"RTN","C0SLAB",31,0)
1536 ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003"
1537"RTN","C0SLAB",32,0)
1538 ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H"
1539"RTN","C0SLAB",33,0)
1540 ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336
1541"RTN","C0SLAB",34,0)
1542 ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU"
1543"RTN","C0SLAB",35,0)
1544 ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0"
1545"RTN","C0SLAB",36,0)
1546 ;^TMP("C0STBL",32,"lab",8,"low@value")="69 "
1547"RTN","C0SLAB",37,0)
1548 ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807
1549"RTN","C0SLAB",38,0)
1550 ;^TMP("C0STBL",32,"lab",8,"result@value")=178
1551"RTN","C0SLAB",39,0)
1552 ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006
1553"RTN","C0SLAB",40,0)
1554 ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM"
1555"RTN","C0SLAB",41,0)
1556 ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500"
1557"RTN","C0SLAB",42,0)
1558 ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM"
1559"RTN","C0SLAB",43,0)
1560 ;^TMP("C0STBL",32,"lab",8,"status@value")="completed"
1561"RTN","C0SLAB",44,0)
1562 ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE"
1563"RTN","C0SLAB",45,0)
1564 ;^TMP("C0STBL",32,"lab",8,"type@value")="CH"
1565"RTN","C0SLAB",46,0)
1566 ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL"
1567"RTN","C0SLAB",47,0)
1568 ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342
1569"RTN","C0SLAB",48,0)
1570 ;
1571"RTN","C0SLAB",49,0)
1572 ; sample Smart lab result triples
1573"RTN","C0SLAB",50,0)
1574 ;
1575"RTN","C0SLAB",51,0)
1576 ;G("loinc:29571-7","dcterms:identifier")="29571-7"
1577"RTN","C0SLAB",52,0)
1578 ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql"
1579"RTN","C0SLAB",53,0)
1580 ;G("loinc:29571-7","rdf:type")="sp:Code"
1581"RTN","C0SLAB",54,0)
1582 ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/"
1583"RTN","C0SLAB",55,0)
1584 ;G("loinc:38478-4","dcterms:identifier")="38478-4"
1585"RTN","C0SLAB",56,0)
1586 ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql"
1587"RTN","C0SLAB",57,0)
1588 ;G("loinc:38478-4","rdf:type")="sp:Code"
1589"RTN","C0SLAB",58,0)
1590 ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/"
1591"RTN","C0SLAB",59,0)
1592 ;G("qqWZZIew993","rdf:type")="sp:Attribution"
1593"RTN","C0SLAB",60,0)
1594 ;G("qqWZZIew993","sp:startDate")="2007-04-21"
1595"RTN","C0SLAB",61,0)
1596 ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult"
1597"RTN","C0SLAB",62,0)
1598 ;G("qqWZZIew994","sp:value")="Normal"
1599"RTN","C0SLAB",63,0)
1600 ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql"
1601"RTN","C0SLAB",64,0)
1602 ;G("qqWZZIew995","rdf:type")="sp:CodedValue"
1603"RTN","C0SLAB",65,0)
1604 ;G("qqWZZIew995","sp:code")="loinc:38478-4"
1605"RTN","C0SLAB",66,0)
1606 ;G("qqWZZIew997","rdf:type")="sp:Attribution"
1607"RTN","C0SLAB",67,0)
1608 ;G("qqWZZIew997","sp:startDate")="2007-09-08"
1609"RTN","C0SLAB",68,0)
1610 ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult"
1611"RTN","C0SLAB",69,0)
1612 ;G("qqWZZIew998","sp:value")="Normal"
1613"RTN","C0SLAB",70,0)
1614 ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql"
1615"RTN","C0SLAB",71,0)
1616 ;G("qqWZZIew999","rdf:type")="sp:CodedValue"
1617"RTN","C0SLAB",72,0)
1618 ;G("qqWZZIew999","sp:code")="loinc:29571-7"
1619"RTN","C0SLAB",73,0)
1620 ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult"
1621"RTN","C0SLAB",74,0)
1622 ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345"
1623"RTN","C0SLAB",75,0)
1624 ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995"
1625"RTN","C0SLAB",76,0)
1626 ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994"
1627"RTN","C0SLAB",77,0)
1628 ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993"
1629"RTN","C0SLAB",78,0)
1630 ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult"
1631"RTN","C0SLAB",79,0)
1632 ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345"
1633"RTN","C0SLAB",80,0)
1634 ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999"
1635"RTN","C0SLAB",81,0)
1636 ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998"
1637"RTN","C0SLAB",82,0)
1638 ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997"
1639"RTN","C0SLAB",83,0)
1640 ;
1641"RTN","C0SLAB",84,0)
1642 ;
1643"RTN","C0SLAB",85,0)
1644 ; another Smart example, this one with sp:quantitativeResult
1645"RTN","C0SLAB",86,0)
1646 ;
1647"RTN","C0SLAB",87,0)
1648 ;G("loinc:786-4","dcterms:identifier")="786-4"
1649"RTN","C0SLAB",88,0)
1650 ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc"
1651"RTN","C0SLAB",89,0)
1652 ;G("loinc:786-4","rdf:type")="sp:Code"
1653"RTN","C0SLAB",90,0)
1654 ;G("loinc:786-4","sp:system")="http://loinc.org/codes/"
1655"RTN","C0SLAB",91,0)
1656 ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit"
1657"RTN","C0SLAB",92,0)
1658 ;G("nodeID:4439","sp:unit")="g/dL"
1659"RTN","C0SLAB",93,0)
1660 ;G("nodeID:4439","sp:value")=36.6
1661"RTN","C0SLAB",94,0)
1662 ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit"
1663"RTN","C0SLAB",95,0)
1664 ;G("nodeID:4613","sp:unit")="g/dL"
1665"RTN","C0SLAB",96,0)
1666 ;G("nodeID:4613","sp:value")=32
1667"RTN","C0SLAB",97,0)
1668 ;G("nodeID:4672","rdf:type")="sp:Attribution"
1669"RTN","C0SLAB",98,0)
1670 ;G("nodeID:4672","sp:startDate")="2005-03-10"
1671"RTN","C0SLAB",99,0)
1672 ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit"
1673"RTN","C0SLAB",100,0)
1674 ;G("nodeID:4866","sp:unit")="g/dL"
1675"RTN","C0SLAB",101,0)
1676 ;G("nodeID:4866","sp:value")=36
1677"RTN","C0SLAB",102,0)
1678 ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc"
1679"RTN","C0SLAB",103,0)
1680 ;G("nodeID:4871","rdf:type")="sp:CodedValue"
1681"RTN","C0SLAB",104,0)
1682 ;G("nodeID:4871","sp:code")="loinc:786-4"
1683"RTN","C0SLAB",105,0)
1684 ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult"
1685"RTN","C0SLAB",106,0)
1686 ;G("nodeID:5221","sp:normalRange")="nodeID:5282"
1687"RTN","C0SLAB",107,0)
1688 ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439"
1689"RTN","C0SLAB",108,0)
1690 ;G("nodeID:5282","rdf:type")="sp:ValueRange"
1691"RTN","C0SLAB",109,0)
1692 ;G("nodeID:5282","sp:maximum")="nodeID:4866"
1693"RTN","C0SLAB",110,0)
1694 ;G("nodeID:5282","sp:minimum")="nodeID:4613"
1695"RTN","C0SLAB",111,0)
1696 ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult"
1697"RTN","C0SLAB",112,0)
1698 ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505"
1699"RTN","C0SLAB",113,0)
1700 ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871"
1701"RTN","C0SLAB",114,0)
1702 ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221"
1703"RTN","C0SLAB",115,0)
1704 ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672"
1705"RTN","C0SLAB",116,0)
1706 ;
1707"RTN","C0SLAB",117,0)
1708LAB(GRTN,C0SARY) ; GRTN, passed by reference,
1709"RTN","C0SLAB",118,0)
1710 ; is the return name of the graph created. "" if none
1711"RTN","C0SLAB",119,0)
1712 ; C0SARY is passed in by reference and is the NHIN array of lab
1713"RTN","C0SLAB",120,0)
1714 ;
1715"RTN","C0SLAB",121,0)
1716 I $O(C0SARY("lab",""))="" D Q ;
1717"RTN","C0SLAB",122,0)
1718 . I $D(DEBUG) W !,"No Labs"
1719"RTN","C0SLAB",123,0)
1720 S GRTN="" ; default to no labs
1721"RTN","C0SLAB",124,0)
1722 N C0SGRF
1723"RTN","C0SLAB",125,0)
1724 S C0SGRF="vistaSmart:"_ZPATID_"/lab_results"
1725"RTN","C0SLAB",126,0)
1726 I $D(DEBUG) W !,"Processing ",C0SGRF
1727"RTN","C0SLAB",127,0)
1728 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
1729"RTN","C0SLAB",128,0)
1730 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
1731"RTN","C0SLAB",129,0)
1732 N FARY S FARY="C0XFARY"
1733"RTN","C0SLAB",130,0)
1734 D USEFARY^C0XF2N(FARY)
1735"RTN","C0SLAB",131,0)
1736 D VOCINIT^C0XUTIL
1737"RTN","C0SLAB",132,0)
1738 ;
1739"RTN","C0SLAB",133,0)
1740 D STARTADD^C0XF2N ; initialize to create triples
1741"RTN","C0SLAB",134,0)
1742 ;
1743"RTN","C0SLAB",135,0)
1744 N ZI S ZI=""
1745"RTN","C0SLAB",136,0)
1746 F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ;
1747"RTN","C0SLAB",137,0)
1748 . N LRN,ZR ; ZR is the local array for building the new triples
1749"RTN","C0SLAB",138,0)
1750 . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result
1751"RTN","C0SLAB",139,0)
1752 . ;
1753"RTN","C0SLAB",140,0)
1754 . N RSLTID ; unique Id for this lab result
1755"RTN","C0SLAB",141,0)
1756 . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
1757"RTN","C0SLAB",142,0)
1758 . ;
1759"RTN","C0SLAB",143,0)
1760 . ; i don't like this because the same labs result gets a
1761"RTN","C0SLAB",144,0)
1762 . ; different ID every time it's reported. Can't trace it back to VistA
1763"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 that
1767"RTN","C0SLAB",147,0)
1768 . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012
1769"RTN","C0SLAB",148,0)
1770 . ;
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 ",RSLTID
1783"RTN","C0SLAB",155,0)
1784 . . W !,"test: ",LABTST
1785"RTN","C0SLAB",156,0)
1786 . . W !,"loinc: ",LOINC
1787"RTN","C0SLAB",157,0)
1788 . ;
1789"RTN","C0SLAB",158,0)
1790 . ; first do the base result graph
1791"RTN","C0SLAB",159,0)
1792 . ;
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 results
1797"RTN","C0SLAB",162,0)
1798 . ; ie /vista/smart/99912345/lab_results
1799"RTN","C0SLAB",163,0)
1800 . ;
1801"RTN","C0SLAB",164,0)
1802 . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name
1803"RTN","C0SLAB",165,0)
1804 . S ZR("sp:labName")=LABNAME
1805"RTN","C0SLAB",166,0)
1806 . ;
1807"RTN","C0SLAB",167,0)
1808 . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result
1809"RTN","C0SLAB",168,0)
1810 . S ZR("sp:narrativeResult")=NARRSLT
1811"RTN","C0SLAB",169,0)
1812 . ;
1813"RTN","C0SLAB",170,0)
1814 . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result
1815"RTN","C0SLAB",171,0)
1816 . S ZR("sp:quantitativeResult")=QNTRSLT
1817"RTN","C0SLAB",172,0)
1818 . ;
1819"RTN","C0SLAB",173,0)
1820 . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected
1821"RTN","C0SLAB",174,0)
1822 . S ZR("sp:specimenCollected")=SPECCOLL
1823"RTN","C0SLAB",175,0)
1824 . ;
1825"RTN","C0SLAB",176,0)
1826 . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples
1827"RTN","C0SLAB",177,0)
1828 . K ZR ; clean up
1829"RTN","C0SLAB",178,0)
1830 . ;
1831"RTN","C0SLAB",179,0)
1832 . ; create the narrative result graph
1833"RTN","C0SLAB",180,0)
1834 . ;
1835"RTN","C0SLAB",181,0)
1836 . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L
1837"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 L
1843"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"RTN","C0SLAB",190,0)
1854 . . K ZR
1855"RTN","C0SLAB",191,0)
1856 . ;
1857"RTN","C0SLAB",192,0)
1858 . ; create the quantitative result graph
1859"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 graph
1865"RTN","C0SLAB",196,0)
1866 . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph
1867"RTN","C0SLAB",197,0)
1868 . N HASNORMAL S HASNORMAL=0
1869"RTN","C0SLAB",198,0)
1870 . I $G(@LRN@("high@value"))'="" S HASNORMAL=1
1871"RTN","C0SLAB",199,0)
1872 . I HASNORMAL S ZR("sp:normalRange")=NORMNM
1873"RTN","C0SLAB",200,0)
1874 . S ZR("sp:valueAndUnit")=VUNM
1875"RTN","C0SLAB",201,0)
1876 . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR)
1877"RTN","C0SLAB",202,0)
1878 . K ZR
1879"RTN","C0SLAB",203,0)
1880 . ;
1881"RTN","C0SLAB",204,0)
1882 . ; create the normal range graph
1883"RTN","C0SLAB",205,0)
1884 . ;
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 graph
1891"RTN","C0SLAB",209,0)
1892 . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph
1893"RTN","C0SLAB",210,0)
1894 . . S ZR("sp:maximum")=MAXNM
1895"RTN","C0SLAB",211,0)
1896 . . S ZR("sp:minimum")=MINNM
1897"RTN","C0SLAB",212,0)
1898 . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR)
1899"RTN","C0SLAB",213,0)
1900 . . K ZR
1901"RTN","C0SLAB",214,0)
1902 . . ;
1903"RTN","C0SLAB",215,0)
1904 . . ; create the maximum graph
1905"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 ZR
1917"RTN","C0SLAB",222,0)
1918 . . ;
1919"RTN","C0SLAB",223,0)
1920 . . ; create the minimum graph
1921"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"RTN","C0SLAB",229,0)
1932 . . K ZR
1933"RTN","C0SLAB",230,0)
1934 . ;
1935"RTN","C0SLAB",231,0)
1936 . ; create the value and unit graph
1937"RTN","C0SLAB",232,0)
1938 . ;
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")=$G(@LRN@("test@value"))
1945"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"RTN","C0SLAB",238,0)
1950 . K ZR
1951"RTN","C0SLAB",239,0)
1952 . ;
1953"RTN","C0SLAB",240,0)
1954 . ; create specimen collected graph
1955"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"RTN","C0SLAB",245,0)
1964 . K ZR
1965"RTN","C0SLAB",246,0)
1966 . ;
1967"RTN","C0SLAB",247,0)
1968 . ; create lab name graph - this contains the test name and code
1969"RTN","C0SLAB",248,0)
1970 . ;
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")=LABTST
1977"RTN","C0SLAB",252,0)
1978 . . N LOINCNM S LOINCNM="loinc:"_LOINC
1979"RTN","C0SLAB",253,0)
1980 . . S ZR("sp:code")="loinc:"_LOINC
1981"RTN","C0SLAB",254,0)
1982 . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR)
1983"RTN","C0SLAB",255,0)
1984 . . K ZR
1985"RTN","C0SLAB",256,0)
1986 . . S ZR("dcterms:identifier")=LOINC
1987"RTN","C0SLAB",257,0)
1988 . . S ZR("dcterms:title")=LABTST
1989"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"RTN","C0SLAB",261,0)
1996 . . K ZR
1997"RTN","C0SLAB",262,0)
1998 . ;
1999"RTN","C0SLAB",263,0)
2000 . ; that's all for now folks (there is more to do like reference ranges
2001"RTN","C0SLAB",264,0)
2002 . ; and result values)
2003"RTN","C0SLAB",265,0)
2004 . ;
2005"RTN","C0SLAB",266,0)
2006 D BULKLOAD^C0XF2N(.C0XFDA)
2007"RTN","C0SLAB",267,0)
2008 S GRTN=C0SGRF
2009"RTN","C0SLAB",268,0)
2010 Q
2011"RTN","C0SLAB",269,0)
2012 ;
2013"RTN","C0SLAB",270,0)
2014SAMPLE ; import sample lab tests to the triplestore
2015"RTN","C0SLAB",271,0)
2016 N GN
2017"RTN","C0SLAB",272,0)
2018 S GN=$NA(^rdf("lab_results"))
2019"RTN","C0SLAB",273,0)
2020 D INSRDF^C0XF2N(GN,"/smart/lab/samples")
2021"RTN","C0SLAB",274,0)
2022 Q
2023"RTN","C0SLAB",275,0)
2024 ;
2025"RTN","C0SMART")
20260^4^B2907401
2027"RTN","C0SMART",1,0)
2028C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05
2029"RTN","C0SMART",2,0)
2030 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
2031"RTN","C0SMART",3,0)
2032 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
2033"RTN","C0SMART",4,0)
2034 ;General Public License See attached copy of the License.
2035"RTN","C0SMART",5,0)
2036 ;
2037"RTN","C0SMART",6,0)
2038 ;This program is free software; you can redistribute it and/or modify
2039"RTN","C0SMART",7,0)
2040 ;it under the terms of the GNU General Public License as published by
2041"RTN","C0SMART",8,0)
2042 ;the Free Software Foundation; either version 2 of the License, or
2043"RTN","C0SMART",9,0)
2044 ;(at your option) any later version.
2045"RTN","C0SMART",10,0)
2046 ;
2047"RTN","C0SMART",11,0)
2048 ;This program is distributed in the hope that it will be useful,
2049"RTN","C0SMART",12,0)
2050 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
2051"RTN","C0SMART",13,0)
2052 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2053"RTN","C0SMART",14,0)
2054 ;GNU General Public License for more details.
2055"RTN","C0SMART",15,0)
2056 ;
2057"RTN","C0SMART",16,0)
2058 ;You should have received a copy of the GNU General Public License along
2059"RTN","C0SMART",17,0)
2060 ;with this program; if not, write to the Free Software Foundation, Inc.,
2061"RTN","C0SMART",18,0)
2062 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
2063"RTN","C0SMART",19,0)
2064 ;
2065"RTN","C0SMART",20,0)
2066 Q
2067"RTN","C0SMART",21,0)
2068EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP
2069"RTN","C0SMART",22,0)
2070 ; for patient ZPATID; ZFORM defaults to rdf
2071"RTN","C0SMART",23,0)
2072 ; ZRTN is passed by reference
2073"RTN","C0SMART",24,0)
2074 ; For now, ZPATID is the DFN
2075"RTN","C0SMART",25,0)
2076 ;
2077"RTN","C0SMART",26,0)
2078 I '$D(ZFORM) S ZFORM="rdf"
2079"RTN","C0SMART",27,0)
2080 K ZRTN ; CLEAN RETURN
2081"RTN","C0SMART",28,0)
2082 N C0SARY
2083"RTN","C0SMART",29,0)
2084 I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient")
2085"RTN","C0SMART",30,0)
2086 E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP)
2087"RTN","C0SMART",31,0)
2088 I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ;
2089"RTN","C0SMART",32,0)
2090 . W !,"Error Retreiving Patient Record"
2091"RTN","C0SMART",33,0)
2092 ;
2093"RTN","C0SMART",34,0)
2094 K C0XFDA
2095"RTN","C0SMART",35,0)
2096 ;
2097"RTN","C0SMART",36,0)
2098 N C0SGR ; graph
2099"RTN","C0SMART",37,0)
2100 ;
2101"RTN","C0SMART",38,0)
2102 ; processing table
2103"RTN","C0SMART",39,0)
2104 ;
2105"RTN","C0SMART",40,0)
2106 N C0SCTRL
2107"RTN","C0SMART",41,0)
2108 S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)"
2109"RTN","C0SMART",42,0)
2110 S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)"
2111"RTN","C0SMART",43,0)
2112 S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)"
2113"RTN","C0SMART",44,0)
2114 S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)"
2115"RTN","C0SMART",45,0)
2116 ;
2117"RTN","C0SMART",46,0)
2118 I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ;
2119"RTN","C0SMART",47,0)
2120 N ZX
2121"RTN","C0SMART",48,0)
2122 S ZX=C0SCTRL(ZTYP)
2123"RTN","C0SMART",49,0)
2124 X ZX ;
2125"RTN","C0SMART",50,0)
2126 ;
2127"RTN","C0SMART",51,0)
2128 I '$D(C0SGR) Q ;
2129"RTN","C0SMART",52,0)
2130 ;
2131"RTN","C0SMART",53,0)
2132 D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM)
2133"RTN","C0SMART",54,0)
2134 ;
2135"RTN","C0SMART",55,0)
2136 Q
2137"RTN","C0SMART",56,0)
2138 ;
2139"RTN","C0SMED")
21400^5^B40719083
2141"RTN","C0SMED",1,0)
2142C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05
2143"RTN","C0SMED",2,0)
2144 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
2145"RTN","C0SMED",3,0)
2146 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
2147"RTN","C0SMED",4,0)
2148 ;General Public License See attached copy of the License.
2149"RTN","C0SMED",5,0)
2150 ;
2151"RTN","C0SMED",6,0)
2152 ;This program is free software; you can redistribute it and/or modify
2153"RTN","C0SMED",7,0)
2154 ;it under the terms of the GNU General Public License as published by
2155"RTN","C0SMED",8,0)
2156 ;the Free Software Foundation; either version 2 of the License, or
2157"RTN","C0SMED",9,0)
2158 ;(at your option) any later version.
2159"RTN","C0SMED",10,0)
2160 ;
2161"RTN","C0SMED",11,0)
2162 ;This program is distributed in the hope that it will be useful,
2163"RTN","C0SMED",12,0)
2164 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
2165"RTN","C0SMED",13,0)
2166 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2167"RTN","C0SMED",14,0)
2168 ;GNU General Public License for more details.
2169"RTN","C0SMED",15,0)
2170 ;
2171"RTN","C0SMED",16,0)
2172 ;You should have received a copy of the GNU General Public License along
2173"RTN","C0SMED",17,0)
2174 ;with this program; if not, write to the Free Software Foundation, Inc.,
2175"RTN","C0SMED",18,0)
2176 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
2177"RTN","C0SMED",19,0)
2178 ;
2179"RTN","C0SMED",20,0)
2180 Q
2181"RTN","C0SMED",21,0)
2182 ;
2183"RTN","C0SMED",22,0)
2184MED(GRTN,C0SARY) ; GRTN, passed by reference,
2185"RTN","C0SMED",23,0)
2186 ; is the return name of the graph created. "" if none
2187"RTN","C0SMED",24,0)
2188 ; C0SARY is passed in by reference and is the NHIN array of meds
2189"RTN","C0SMED",25,0)
2190 ;
2191"RTN","C0SMED",26,0)
2192 I $O(C0SARY("med",""))="" D Q ;
2193"RTN","C0SMED",27,0)
2194 . I $D(DEBUG) W !,"No Meds"
2195"RTN","C0SMED",28,0)
2196 S GRTN="" ; default to no meds
2197"RTN","C0SMED",29,0)
2198 N C0SGRF
2199"RTN","C0SMED",30,0)
2200 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
2201"RTN","C0SMED",31,0)
2202 I $D(DEBUG) W !,"Processing ",C0SGRF
2203"RTN","C0SMED",32,0)
2204 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
2205"RTN","C0SMED",33,0)
2206 N MEDTRP ; MEDS TRIPLES
2207"RTN","C0SMED",34,0)
2208 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
2209"RTN","C0SMED",35,0)
2210 N FARY S FARY="C0XFARY"
2211"RTN","C0SMED",36,0)
2212 D USEFARY^C0XF2N(FARY)
2213"RTN","C0SMED",37,0)
2214 D VOCINIT^C0XUTIL
2215"RTN","C0SMED",38,0)
2216 ;
2217"RTN","C0SMED",39,0)
2218 N DUPCHK S DUPCHK="" ; check for no duplicates
2219"RTN","C0SMED",40,0)
2220 N ZI S ZI=""
2221"RTN","C0SMED",41,0)
2222 F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ;
2223"RTN","C0SMED",42,0)
2224 . N SDATE,SDTMP
2225"RTN","C0SMED",43,0)
2226 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ;
2227"RTN","C0SMED",44,0)
2228 . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
2229"RTN","C0SMED",45,0)
2230 . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ;
2231"RTN","C0SMED",46,0)
2232 . . I $D(DEBUG) W !,"Inpatient Med, skipping"
2233"RTN","C0SMED",47,0)
2234 . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ;
2235"RTN","C0SMED",48,0)
2236 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
2237"RTN","C0SMED",49,0)
2238 . ;
2239"RTN","C0SMED",50,0)
2240 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
2241"RTN","C0SMED",51,0)
2242 . I SDTMP="" D ;
2243"RTN","C0SMED",52,0)
2244 . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
2245"RTN","C0SMED",53,0)
2246 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
2247"RTN","C0SMED",54,0)
2248 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
2249"RTN","C0SMED",55,0)
2250 . I SDATE="" S SDATE="UNKNOWN"
2251"RTN","C0SMED",56,0)
2252 . N DNAME,VUID,DCODE,RXNORM,SIG
2253"RTN","C0SMED",57,0)
2254 . S DNAME=$G(C0SARY("med",ZI,"name@value"))
2255"RTN","C0SMED",58,0)
2256 . I DNAME="" D ;
2257"RTN","C0SMED",59,0)
2258 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
2259"RTN","C0SMED",60,0)
2260 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
2261"RTN","C0SMED",61,0)
2262 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
2263"RTN","C0SMED",62,0)
2264 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
2265"RTN","C0SMED",63,0)
2266 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
2267"RTN","C0SMED",64,0)
2268 . I $P(RXNORM,"^",2)="RXNORM" D ;
2269"RTN","C0SMED",65,0)
2270 . . S RXVER=$P(RXNORM,"^",3)
2271"RTN","C0SMED",66,0)
2272 . . S RXNORM=$P(RXNORM,"^",1)
2273"RTN","C0SMED",67,0)
2274 . E D Q ;
2275"RTN","C0SMED",68,0)
2276 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
2277"RTN","C0SMED",69,0)
2278 . . I $D(DEBUG) W !,RXNORM
2279"RTN","C0SMED",70,0)
2280 . I DNAME="" D Q ;
2281"RTN","C0SMED",71,0)
2282 . . I $D(DEBUG) W !,"Error No Drug Name"
2283"RTN","C0SMED",72,0)
2284 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
2285"RTN","C0SMED",73,0)
2286 . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED
2287"RTN","C0SMED",74,0)
2288 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
2289"RTN","C0SMED",75,0)
2290 . S DUPCHK(MEDGRF)=""
2291"RTN","C0SMED",76,0)
2292 . I $D(DEBUG) D ;
2293"RTN","C0SMED",77,0)
2294 . . W !,"Processing Medication ",MEDGRF
2295"RTN","C0SMED",78,0)
2296 . . W !,DNAME
2297"RTN","C0SMED",79,0)
2298 . . W !,RXNORM
2299"RTN","C0SMED",80,0)
2300 . S SIG=$G(C0SARY("med",ZI,"sig"))
2301"RTN","C0SMED",81,0)
2302 . I SIG["|" D ;
2303"RTN","C0SMED",82,0)
2304 . . N SIGTMP
2305"RTN","C0SMED",83,0)
2306 . . S SIGTMP=SIG
2307"RTN","C0SMED",84,0)
2308 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
2309"RTN","C0SMED",85,0)
2310 . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig
2311"RTN","C0SMED",86,0)
2312 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
2313"RTN","C0SMED",87,0)
2314 . K C0XFARY
2315"RTN","C0SMED",88,0)
2316 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
2317"RTN","C0SMED",89,0)
2318 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
2319"RTN","C0SMED",90,0)
2320 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
2321"RTN","C0SMED",91,0)
2322 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
2323"RTN","C0SMED",92,0)
2324 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
2325"RTN","C0SMED",93,0)
2326 . N NQTY,NQTY2,NFREQ,NFREQ2
2327"RTN","C0SMED",94,0)
2328 . S NQTY=$$ANONS^C0XF2N ; anonomous subject
2329"RTN","C0SMED",95,0)
2330 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
2331"RTN","C0SMED",96,0)
2332 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
2333"RTN","C0SMED",97,0)
2334 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
2335"RTN","C0SMED",98,0)
2336 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
2337"RTN","C0SMED",99,0)
2338 . I DOSE="" S DOSE="UNKNOWN"
2339"RTN","C0SMED",100,0)
2340 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
2341"RTN","C0SMED",101,0)
2342 . I UNIT="" S UNIT="UNKNOWN"
2343"RTN","C0SMED",102,0)
2344 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
2345"RTN","C0SMED",103,0)
2346 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
2347"RTN","C0SMED",104,0)
2348 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
2349"RTN","C0SMED",105,0)
2350 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
2351"RTN","C0SMED",106,0)
2352 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
2353"RTN","C0SMED",107,0)
2354 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
2355"RTN","C0SMED",108,0)
2356 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
2357"RTN","C0SMED",109,0)
2358 . I SCHED="" S SCHED="UNKNOWN"
2359"RTN","C0SMED",110,0)
2360 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
2361"RTN","C0SMED",111,0)
2362 . I SCHUNIT="" S SCHUNIT="UNKNOWN"
2363"RTN","C0SMED",112,0)
2364 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
2365"RTN","C0SMED",113,0)
2366 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
2367"RTN","C0SMED",114,0)
2368 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
2369"RTN","C0SMED",115,0)
2370 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
2371"RTN","C0SMED",116,0)
2372 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
2373"RTN","C0SMED",117,0)
2374 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
2375"RTN","C0SMED",118,0)
2376 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
2377"RTN","C0SMED",119,0)
2378 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
2379"RTN","C0SMED",120,0)
2380 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
2381"RTN","C0SMED",121,0)
2382 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
2383"RTN","C0SMED",122,0)
2384 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
2385"RTN","C0SMED",123,0)
2386 . D BULKLOAD^C0XF2N(.C0XFDA)
2387"RTN","C0SMED",124,0)
2388 . K C0XFDA
2389"RTN","C0SMED",125,0)
2390 S GRTN=C0SGRF
2391"RTN","C0SMED",126,0)
2392 q
2393"RTN","C0SMED",127,0)
2394 ;
2395"RTN","C0SMED",128,0)
2396RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
2397"RTN","C0SMED",129,0)
2398 ;
2399"RTN","C0SMED",130,0)
2400RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
2401"RTN","C0SMED",131,0)
2402 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
2403"RTN","C0SMED",132,0)
2404 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
2405"RTN","C0SMED",133,0)
2406 I $G(ZVUID)="" Q ""
2407"RTN","C0SMED",134,0)
2408 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
2409"RTN","C0SMED",135,0)
2410 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
2411"RTN","C0SMED",136,0)
2412 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
2413"RTN","C0SMED",137,0)
2414 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
2415"RTN","C0SMED",138,0)
2416 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
2417"RTN","C0SMED",139,0)
2418 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
2419"RTN","C0SMED",140,0)
2420 Q ZRSLT
2421"RTN","C0SMED",141,0)
2422 ;
2423"RTN","C0SMED",142,0)
2424NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
2425"RTN","C0SMED",143,0)
2426 ; CONFORM TO NIST REQUIREMENTS
2427"RTN","C0SMED",144,0)
2428 ;INPATIENT CERTIFICATION
2429"RTN","C0SMED",145,0)
2430 I ZRXN=309362 S ZRXN=213169
2431"RTN","C0SMED",146,0)
2432 I ZRXN=855318 S ZRXN=855320
2433"RTN","C0SMED",147,0)
2434 I ZRXN=197361 S ZRXN=212549
2435"RTN","C0SMED",148,0)
2436 ;OUTPATIENT CERTIFICATION
2437"RTN","C0SMED",149,0)
2438 I ZRXN=310534 S ZRXN=205875
2439"RTN","C0SMED",150,0)
2440 I ZRXN=617312 S ZRXN=617314
2441"RTN","C0SMED",151,0)
2442 I ZRXN=310429 S ZRXN=200801
2443"RTN","C0SMED",152,0)
2444 I ZRXN=628953 S ZRXN=628958
2445"RTN","C0SMED",153,0)
2446 I ZRXN=745679 S ZRXN=630208
2447"RTN","C0SMED",154,0)
2448 I ZRXN=311564 S ZRXN=979334
2449"RTN","C0SMED",155,0)
2450 I ZRXN=836343 S ZRXN=836370
2451"RTN","C0SMED",156,0)
2452 Q ZRXN
2453"RTN","C0SMED",157,0)
2454 ;
2455"RTN","C0SMXMLB")
24560^6^B12189644
2457"RTN","C0SMXMLB",1,0)
2458MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver.
2459"RTN","C0SMXMLB",2,0)
2460 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
2461"RTN","C0SMXMLB",3,0)
2462 QUIT
2463"RTN","C0SMXMLB",4,0)
2464 ;
2465"RTN","C0SMXMLB",5,0)
2466 ;DOC - The top level tag
2467"RTN","C0SMXMLB",6,0)
2468 ;DOCTYPE - Want to include a DOCTYPE node
2469"RTN","C0SMXMLB",7,0)
2470 ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
2471"RTN","C0SMXMLB",8,0)
2472START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
2473"RTN","C0SMXMLB",9,0)
2474 K ^TMP("MXMLBLD",$J)
2475"RTN","C0SMXMLB",10,0)
2476 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
2477"RTN","C0SMXMLB",11,0)
2478 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
2479"RTN","C0SMXMLB",12,0)
2480 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
2481"RTN","C0SMXMLB",13,0)
2482 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
2483"RTN","C0SMXMLB",14,0)
2484 Q
2485"RTN","C0SMXMLB",15,0)
2486 ;
2487"RTN","C0SMXMLB",16,0)
2488END ;Call this once to close out the document
2489"RTN","C0SMXMLB",17,0)
2490 D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
2491"RTN","C0SMXMLB",18,0)
2492 I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
2493"RTN","C0SMXMLB",19,0)
2494 K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
2495"RTN","C0SMXMLB",20,0)
2496 Q
2497"RTN","C0SMXMLB",21,0)
2498 ;
2499"RTN","C0SMXMLB",22,0)
2500ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
2501"RTN","C0SMXMLB",23,0)
2502 N I,X
2503"RTN","C0SMXMLB",24,0)
2504 S ATT=$G(ATT)
2505"RTN","C0SMXMLB",25,0)
2506 I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
2507"RTN","C0SMXMLB",26,0)
2508 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">")
2509"RTN","C0SMXMLB",27,0)
2510 Q
2511"RTN","C0SMXMLB",28,0)
2512 ;DOITEM is a callback to output the lower level.
2513"RTN","C0SMXMLB",29,0)
2514MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
2515"RTN","C0SMXMLB",30,0)
2516 N I,X,S
2517"RTN","C0SMXMLB",31,0)
2518 S ATT=$G(ATT)
2519"RTN","C0SMXMLB",32,0)
2520 D PUSH($G(INDENT),TAG,.ATT)
2521"RTN","C0SMXMLB",33,0)
2522 D @DOITEM
2523"RTN","C0SMXMLB",34,0)
2524 D POP
2525"RTN","C0SMXMLB",35,0)
2526 Q
2527"RTN","C0SMXMLB",36,0)
2528 ;
2529"RTN","C0SMXMLB",37,0)
2530ATT(ATT) ;Output a string of attributes
2531"RTN","C0SMXMLB",38,0)
2532 I $D(ATT)<9 Q ""
2533"RTN","C0SMXMLB",39,0)
2534 N I,S,V
2535"RTN","C0SMXMLB",40,0)
2536 S S="",I=""
2537"RTN","C0SMXMLB",41,0)
2538 F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I))
2539"RTN","C0SMXMLB",42,0)
2540 Q S
2541"RTN","C0SMXMLB",43,0)
2542 ;
2543"RTN","C0SMXMLB",44,0)
2544Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
2545"RTN","C0SMXMLB",45,0)
2546 ;I X'[$C(34) Q $C(34)_X_$C(34)
2547"RTN","C0SMXMLB",46,0)
2548 I X'[$C(39) Q $C(39)_X_$C(39)
2549"RTN","C0SMXMLB",47,0)
2550 ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
2551"RTN","C0SMXMLB",48,0)
2552 N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
2553"RTN","C0SMXMLB",49,0)
2554 F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
2555"RTN","C0SMXMLB",50,0)
2556 S Y=Y_$P(X,Q,$L(X,Q))
2557"RTN","C0SMXMLB",51,0)
2558 ;Q $C(34)_Y_$C(34)
2559"RTN","C0SMXMLB",52,0)
2560 Q $C(39)_Y_$C(39)
2561"RTN","C0SMXMLB",53,0)
2562 ;
2563"RTN","C0SMXMLB",54,0)
2564XMLHDR() ; -- provides current XML standard header
2565"RTN","C0SMXMLB",55,0)
2566 Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
2567"RTN","C0SMXMLB",56,0)
2568 ;
2569"RTN","C0SMXMLB",57,0)
2570OUTPUT(S) ;Output
2571"RTN","C0SMXMLB",58,0)
2572 N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
2573"RTN","C0SMXMLB",59,0)
2574 I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
2575"RTN","C0SMXMLB",60,0)
2576 W S,!
2577"RTN","C0SMXMLB",61,0)
2578 Q
2579"RTN","C0SMXMLB",62,0)
2580 ;
2581"RTN","C0SMXMLB",63,0)
2582CHARCHK(STR) ; -- replace xml character limits with entities
2583"RTN","C0SMXMLB",64,0)
2584 N A,I,X,Y,Z,NEWSTR
2585"RTN","C0SMXMLB",65,0)
2586 S (Y,Z)=""
2587"RTN","C0SMXMLB",66,0)
2588 ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z
2589"RTN","C0SMXMLB",67,0)
2590 ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&amp;",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
2591"RTN","C0SMXMLB",68,0)
2592 I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&amp;"_$P(STR,"&",I+1,999)
2593"RTN","C0SMXMLB",69,0)
2594 I STR["<" F S STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
2595"RTN","C0SMXMLB",70,0)
2596 I STR[">" F S STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
2597"RTN","C0SMXMLB",71,0)
2598 I STR["'" F S STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
2599"RTN","C0SMXMLB",72,0)
2600 I STR["""" F S STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) Q:STR'[""""
2601"RTN","C0SMXMLB",73,0)
2602 ;
2603"RTN","C0SMXMLB",74,0)
2604 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",75,0)
2606 QUIT STR
2607"RTN","C0SMXMLB",76,0)
2608 ;
2609"RTN","C0SMXMLB",77,0)
2610COMMENT(VAL) ;Add Comments
2611"RTN","C0SMXMLB",78,0)
2612 N I,L
2613"RTN","C0SMXMLB",79,0)
2614 ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q
2615"RTN","C0SMXMLB",80,0)
2616 I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q ;CHANGED BY GPL FOR GTM
2617"RTN","C0SMXMLB",81,0)
2618 S I="",L="<!--"
2619"RTN","C0SMXMLB",82,0)
2620 F S I=$O(ATT(I)) Q:I="" D OUTPUT(L_ATT(I)) S L=""
2621"RTN","C0SMXMLB",83,0)
2622 D OUTPUT("-->")
2623"RTN","C0SMXMLB",84,0)
2624 Q
2625"RTN","C0SMXMLB",85,0)
2626 ;
2627"RTN","C0SMXMLB",86,0)
2628PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
2629"RTN","C0SMXMLB",87,0)
2630 N CNT
2631"RTN","C0SMXMLB",88,0)
2632 S ATT=$G(ATT)
2633"RTN","C0SMXMLB",89,0)
2634 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
2635"RTN","C0SMXMLB",90,0)
2636 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 Q
2639"RTN","C0SMXMLB",92,0)
2640 ;
2641"RTN","C0SMXMLB",93,0)
2642POP ;Write last pushed tag and pop
2643"RTN","C0SMXMLB",94,0)
2644 N CNT,TAG,INDENT,X
2645"RTN","C0SMXMLB",95,0)
2646 S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
2647"RTN","C0SMXMLB",96,0)
2648 S INDENT=+X,TAG=$P(X,"^",2)
2649"RTN","C0SMXMLB",97,0)
2650 D OUTPUT($$BLS(INDENT)_"</"_TAG_">")
2651"RTN","C0SMXMLB",98,0)
2652 Q
2653"RTN","C0SMXMLB",99,0)
2654 ;
2655"RTN","C0SMXMLB",100,0)
2656BLS(I) ;Return INDENT string
2657"RTN","C0SMXMLB",101,0)
2658 N S
2659"RTN","C0SMXMLB",102,0)
2660 S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
2661"RTN","C0SMXMLB",103,0)
2662 Q S
2663"RTN","C0SMXMLB",104,0)
2664 ;
2665"RTN","C0SMXMLB",105,0)
2666INDENT() ;Renturn indent level
2667"RTN","C0SMXMLB",106,0)
2668 Q +$G(^TMP("MXMLBLD",$J,"STK"))
2669"RTN","C0SNHIN")
26700^7^B88600644
2671"RTN","C0SNHIN",1,0)
2672C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05
2673"RTN","C0SNHIN",2,0)
2674 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
2675"RTN","C0SNHIN",3,0)
2676 ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU
2677"RTN","C0SNHIN",4,0)
2678 ;General Public License See attached copy of the License.
2679"RTN","C0SNHIN",5,0)
2680 ;
2681"RTN","C0SNHIN",6,0)
2682 ;This program is free software; you can redistribute it and/or modify
2683"RTN","C0SNHIN",7,0)
2684 ;it under the terms of the GNU General Public License as published by
2685"RTN","C0SNHIN",8,0)
2686 ;the Free Software Foundation; either version 2 of the License, or
2687"RTN","C0SNHIN",9,0)
2688 ;(at your option) any later version.
2689"RTN","C0SNHIN",10,0)
2690 ;
2691"RTN","C0SNHIN",11,0)
2692 ;This program is distributed in the hope that it will be useful,
2693"RTN","C0SNHIN",12,0)
2694 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
2695"RTN","C0SNHIN",13,0)
2696 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2697"RTN","C0SNHIN",14,0)
2698 ;GNU General Public License for more details.
2699"RTN","C0SNHIN",15,0)
2700 ;
2701"RTN","C0SNHIN",16,0)
2702 ;You should have received a copy of the GNU General Public License along
2703"RTN","C0SNHIN",17,0)
2704 ;with this program; if not, write to the Free Software Foundation, Inc.,
2705"RTN","C0SNHIN",18,0)
2706 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
2707"RTN","C0SNHIN",19,0)
2708 ;
2709"RTN","C0SNHIN",20,0)
2710 Q
2711"RTN","C0SNHIN",21,0)
2712EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
2713"RTN","C0SNHIN",22,0)
2714 ;
2715"RTN","C0SNHIN",23,0)
2716 K GARY,GNARY,GIDX,C0SDOCID
2717"RTN","C0SNHIN",24,0)
2718 K ZRTN
2719"RTN","C0SNHIN",25,0)
2720 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)
2732 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)
2736 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 Q
2741"RTN","C0SNHIN",36,0)
2742 ;
2743"RTN","C0SNHIN",37,0)
2744PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
2745"RTN","C0SNHIN",38,0)
2746 ;
2747"RTN","C0SNHIN",39,0)
2748 N ZG
2749"RTN","C0SNHIN",40,0)
2750 S ZG=$NA(^TMP("PQRIXML",$J))
2751"RTN","C0SNHIN",41,0)
2752 K @ZG
2753"RTN","C0SNHIN",42,0)
2754 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
2755"RTN","C0SNHIN",43,0)
2756 N C0SDOCID
2757"RTN","C0SNHIN",44,0)
2758 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
2759"RTN","C0SNHIN",45,0)
2760 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
2761"RTN","C0SNHIN",46,0)
2762 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
2763"RTN","C0SNHIN",47,0)
2764 Q
2765"RTN","C0SNHIN",48,0)
2766 ;
2767"RTN","C0SNHIN",49,0)
2768PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
2769"RTN","C0SNHIN",50,0)
2770 ;
2771"RTN","C0SNHIN",51,0)
2772 ;N GG
2773"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 Q
2779"RTN","C0SNHIN",55,0)
2780 ;
2781"RTN","C0SNHIN",56,0)
2782PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
2783"RTN","C0SNHIN",57,0)
2784 ; ZRTN IS PASSED BY REFERENCE
2785"RTN","C0SNHIN",58,0)
2786 ; ZXML IS PASSED BY NAME
2787"RTN","C0SNHIN",59,0)
2788 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
2789"RTN","C0SNHIN",60,0)
2790 ;
2791"RTN","C0SNHIN",61,0)
2792 N GN
2793"RTN","C0SNHIN",62,0)
2794 S GN=$NA(^TMP("C0SPROCESS",$J))
2795"RTN","C0SNHIN",63,0)
2796 K @GN
2797"RTN","C0SNHIN",64,0)
2798 M @GN=@ZXML
2799"RTN","C0SNHIN",65,0)
2800 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
2801"RTN","C0SNHIN",66,0)
2802 K @GN
2803"RTN","C0SNHIN",67,0)
2804 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
2805"RTN","C0SNHIN",68,0)
2806 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
2807"RTN","C0SNHIN",69,0)
2808 Q
2809"RTN","C0SNHIN",70,0)
2810 ;
2811"RTN","C0SNHIN",71,0)
2812LOADSMRT ;
2813"RTN","C0SNHIN",72,0)
2814 ;
2815"RTN","C0SNHIN",73,0)
2816 K ^GPL("SMART")
2817"RTN","C0SNHIN",74,0)
2818 S GN=$NA(^GPL("SMART",1))
2819"RTN","C0SNHIN",75,0)
2820 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
2821"RTN","C0SNHIN",76,0)
2822 Q
2823"RTN","C0SNHIN",77,0)
2824 ;
2825"RTN","C0SNHIN",78,0)
2826SMART ; TRY IT WITH SMART
2827"RTN","C0SNHIN",79,0)
2828 ;
2829"RTN","C0SNHIN",80,0)
2830 S GN=$NA(^GPL("SMART"))
2831"RTN","C0SNHIN",81,0)
2832 ;K ^TMP("MXMLDOM",$J)
2833"RTN","C0SNHIN",82,0)
2834 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)
2840 ;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)
2846CCR ; 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)
2852 ;K ^TMP("MXMLDOM",$J)
2853"RTN","C0SNHIN",92,0)
2854 K ^TMP("MXMLERR",$J)
2855"RTN","C0SNHIN",93,0)
2856 S C0SDOCID=$$PARSE(GN,"CCR")
2857"RTN","C0SNHIN",94,0)
2858 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
2859"RTN","C0SNHIN",95,0)
2860 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
2861"RTN","C0SNHIN",96,0)
2862 Q
2863"RTN","C0SNHIN",97,0)
2864 ;
2865"RTN","C0SNHIN",98,0)
2866MED ; TRY IT WITH A CCR MED SECTION
2867"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 BIG
2881"RTN","C0SNHIN",106,0)
2882 Q
2883"RTN","C0SNHIN",107,0)
2884 ;
2885"RTN","C0SNHIN",108,0)
2886CCD ; TRY IT WITH A CCD
2887"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"RTN","C0SNHIN",114,0)
2898 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
2899"RTN","C0SNHIN",115,0)
2900 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
2901"RTN","C0SNHIN",116,0)
2902 Q
2903"RTN","C0SNHIN",117,0)
2904 ;
2905"RTN","C0SNHIN",118,0)
2906TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
2907"RTN","C0SNHIN",119,0)
2908 ; PARSED WITH MXML
2909"RTN","C0SNHIN",120,0)
2910 ; RUN THROUGH XPATH
2911"RTN","C0SNHIN",121,0)
2912 K GARY,GIDX,C0SDOCID
2913"RTN","C0SNHIN",122,0)
2914 S GN=$NA(^GPL("NHIN"))
2915"RTN","C0SNHIN",123,0)
2916 ;S GN=$NA(^GPL("DOMI"))
2917"RTN","C0SNHIN",124,0)
2918 S C0SDOCID=$$PARSE(GN,"GPLTEST")
2919"RTN","C0SNHIN",125,0)
2920 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")=GNARY
2925"RTN","C0SNHIN",128,0)
2926 Q
2927"RTN","C0SNHIN",129,0)
2928 ;
2929"RTN","C0SNHIN",130,0)
2930TEST2 ; 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")=G
2943"RTN","C0SNHIN",137,0)
2944 Q
2945"RTN","C0SNHIN",138,0)
2946 ;
2947"RTN","C0SNHIN",139,0)
2948TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
2949"RTN","C0SNHIN",140,0)
2950 ; PARSED WITH MXML
2951"RTN","C0SNHIN",141,0)
2952 ; RUN THROUGH XPATH
2953"RTN","C0SNHIN",142,0)
2954 K GARY,GIDX,C0SDOCID
2955"RTN","C0SNHIN",143,0)
2956 ;S GN=$NA(^GPL("NHIN"))
2957"RTN","C0SNHIN",144,0)
2958 S GN=$NA(^GPL("DOMI"))
2959"RTN","C0SNHIN",145,0)
2960 S C0SDOCID=$$PARSE(GN,"GPLTEST")
2961"RTN","C0SNHIN",146,0)
2962 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
2963"RTN","C0SNHIN",147,0)
2964 Q
2965"RTN","C0SNHIN",148,0)
2966 ;
2967"RTN","C0SNHIN",149,0)
2968DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
2969"RTN","C0SNHIN",150,0)
2970 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
2971"RTN","C0SNHIN",151,0)
2972 ; THE XPATH ARRAY XPARY, PASSED BY NAME
2973"RTN","C0SNHIN",152,0)
2974 ; ZOID IS THE STARTING OID
2975"RTN","C0SNHIN",153,0)
2976 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
2977"RTN","C0SNHIN",154,0)
2978 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
2979"RTN","C0SNHIN",155,0)
2980 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
2981"RTN","C0SNHIN",156,0)
2982 I $G(ZREDUX)="" S ZREDUX=""
2983"RTN","C0SNHIN",157,0)
2984 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
2985"RTN","C0SNHIN",158,0)
2986 N NEWNUM S NEWNUM=""
2987"RTN","C0SNHIN",159,0)
2988 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
2989"RTN","C0SNHIN",160,0)
2990 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
2991"RTN","C0SNHIN",161,0)
2992 I $G(ZREDUX)'="" D ; REDUX PROVIDED?
2993"RTN","C0SNHIN",162,0)
2994 . N GT S GT=$P(NEWPATH,ZREDUX,2)
2995"RTN","C0SNHIN",163,0)
2996 . I GT'="" S NEWPATH=GT
2997"RTN","C0SNHIN",164,0)
2998 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
2999"RTN","C0SNHIN",165,0)
3000 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
3001"RTN","C0SNHIN",166,0)
3002 I $D(GA) D ; PROCESS THE ATTRIBUTES
3003"RTN","C0SNHIN",167,0)
3004 . N ZI S ZI=""
3005"RTN","C0SNHIN",168,0)
3006 . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE
3007"RTN","C0SNHIN",169,0)
3008 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
3009"RTN","C0SNHIN",170,0)
3010 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
3011"RTN","C0SNHIN",171,0)
3012 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
3013"RTN","C0SNHIN",172,0)
3014 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
3015"RTN","C0SNHIN",173,0)
3016 I $D(GD(2)) D ;
3017"RTN","C0SNHIN",174,0)
3018 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
3019"RTN","C0SNHIN",175,0)
3020 E I $D(GD(1)) D ;
3021"RTN","C0SNHIN",176,0)
3022 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
3023"RTN","C0SNHIN",177,0)
3024 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
3025"RTN","C0SNHIN",178,0)
3026 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
3027"RTN","C0SNHIN",179,0)
3028 I ZFRST'=0 D ; THERE IS A CHILD
3029"RTN","C0SNHIN",180,0)
3030 . N ZNUM
3031"RTN","C0SNHIN",181,0)
3032 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
3033"RTN","C0SNHIN",182,0)
3034 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
3035"RTN","C0SNHIN",183,0)
3036 N GNXT S GNXT=$$NXTSIB(ZOID)
3037"RTN","C0SNHIN",184,0)
3038 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
3039"RTN","C0SNHIN",185,0)
3040 I GNXT'=0 D ;
3041"RTN","C0SNHIN",186,0)
3042 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
3043"RTN","C0SNHIN",187,0)
3044 . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
3045"RTN","C0SNHIN",188,0)
3046 . . N ZNUM S ZNUM=1 ;
3047"RTN","C0SNHIN",189,0)
3048 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
3049"RTN","C0SNHIN",190,0)
3050 . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
3051"RTN","C0SNHIN",191,0)
3052 Q
3053"RTN","C0SNHIN",192,0)
3054 ;
3055"RTN","C0SNHIN",193,0)
3056ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
3057"RTN","C0SNHIN",194,0)
3058 ;
3059"RTN","C0SNHIN",195,0)
3060 N ZZI,ZZJ,ZZN
3061"RTN","C0SNHIN",196,0)
3062 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
3063"RTN","C0SNHIN",197,0)
3064 I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
3065"RTN","C0SNHIN",198,0)
3066 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
3067"RTN","C0SNHIN",199,0)
3068 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
3069"RTN","C0SNHIN",200,0)
3070 I ZZI'["]" D ; A SINGLETON
3071"RTN","C0SNHIN",201,0)
3072 . S ZZN=1
3073"RTN","C0SNHIN",202,0)
3074 E D ; THERE IS AN [x] OCCURANCE
3075"RTN","C0SNHIN",203,0)
3076 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
3077"RTN","C0SNHIN",204,0)
3078 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
3079"RTN","C0SNHIN",205,0)
3080 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
3081"RTN","C0SNHIN",206,0)
3082 Q
3083"RTN","C0SNHIN",207,0)
3084 ;
3085"RTN","C0SNHIN",208,0)
3086PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
3087"RTN","C0SNHIN",209,0)
3088 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
3089"RTN","C0SNHIN",210,0)
3090 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
3091"RTN","C0SNHIN",211,0)
3092 ;Q $$EN^MXMLDOM(INXML)
3093"RTN","C0SNHIN",212,0)
3094 Q $$EN^MXMLDOM(INXML,"W")
3095"RTN","C0SNHIN",213,0)
3096 ;
3097"RTN","C0SNHIN",214,0)
3098ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
3099"RTN","C0SNHIN",215,0)
3100 N ZN
3101"RTN","C0SNHIN",216,0)
3102 ;I $$TAG(ZOID)["entry" B
3103"RTN","C0SNHIN",217,0)
3104 S ZN=$$NXTSIB(ZOID)
3105"RTN","C0SNHIN",218,0)
3106 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
3107"RTN","C0SNHIN",219,0)
3108 Q 0
3109"RTN","C0SNHIN",220,0)
3110 ;
3111"RTN","C0SNHIN",221,0)
3112FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
3113"RTN","C0SNHIN",222,0)
3114 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
3115"RTN","C0SNHIN",223,0)
3116 ;
3117"RTN","C0SNHIN",224,0)
3118PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
3119"RTN","C0SNHIN",225,0)
3120 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
3121"RTN","C0SNHIN",226,0)
3122 ;
3123"RTN","C0SNHIN",227,0)
3124ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
3125"RTN","C0SNHIN",228,0)
3126 S HANDLE=C0SDOCID
3127"RTN","C0SNHIN",229,0)
3128 K @RTN
3129"RTN","C0SNHIN",230,0)
3130 D GETTXT^MXMLDOM("A")
3131"RTN","C0SNHIN",231,0)
3132 Q
3133"RTN","C0SNHIN",232,0)
3134 ;
3135"RTN","C0SNHIN",233,0)
3136TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
3137"RTN","C0SNHIN",234,0)
3138 ;I ZOID=149 B ;GPLTEST
3139"RTN","C0SNHIN",235,0)
3140 N X,Y
3141"RTN","C0SNHIN",236,0)
3142 S Y=""
3143"RTN","C0SNHIN",237,0)
3144 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
3145"RTN","C0SNHIN",238,0)
3146 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
3147"RTN","C0SNHIN",239,0)
3148 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
3149"RTN","C0SNHIN",240,0)
3150 Q Y
3151"RTN","C0SNHIN",241,0)
3152 ;
3153"RTN","C0SNHIN",242,0)
3154NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
3155"RTN","C0SNHIN",243,0)
3156 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
3157"RTN","C0SNHIN",244,0)
3158 ;
3159"RTN","C0SNHIN",245,0)
3160DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
3161"RTN","C0SNHIN",246,0)
3162 ;N ZT,ZN S ZT=""
3163"RTN","C0SNHIN",247,0)
3164 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
3165"RTN","C0SNHIN",248,0)
3166 ;Q $G(@C0SDOM@(ZOID,"T",1))
3167"RTN","C0SNHIN",249,0)
3168 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
3169"RTN","C0SNHIN",250,0)
3170 Q
3171"RTN","C0SNHIN",251,0)
3172 ;
3173"RTN","C0SNHIN",252,0)
3174OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
3175"RTN","C0SNHIN",253,0)
3176 ;
3177"RTN","C0SNHIN",254,0)
3178 S C0SDOCID=INID
3179"RTN","C0SNHIN",255,0)
3180 D START^C0SMXMLB($$TAG(1),,"G")
3181"RTN","C0SNHIN",256,0)
3182 D NDOUT($$FIRST(1))
3183"RTN","C0SNHIN",257,0)
3184 D END^C0SMXMLB ;END THE DOCUMENT
3185"RTN","C0SNHIN",258,0)
3186 M @ZRTN=^TMP("MXMLBLD",$J)
3187"RTN","C0SNHIN",259,0)
3188 K ^TMP("MXMLBLD",$J)
3189"RTN","C0SNHIN",260,0)
3190 Q
3191"RTN","C0SNHIN",261,0)
3192 ;
3193"RTN","C0SNHIN",262,0)
3194NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
3195"RTN","C0SNHIN",263,0)
3196 N ZI S ZI=$$FIRST(ZOID)
3197"RTN","C0SNHIN",264,0)
3198 I ZI'=0 D ; THERE IS A CHILD
3199"RTN","C0SNHIN",265,0)
3200 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
3201"RTN","C0SNHIN",266,0)
3202 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
3203"RTN","C0SNHIN",267,0)
3204 E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
3205"RTN","C0SNHIN",268,0)
3206 . ;W "DOING",ZOID,!
3207"RTN","C0SNHIN",269,0)
3208 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
3209"RTN","C0SNHIN",270,0)
3210 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
3211"RTN","C0SNHIN",271,0)
3212 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
3213"RTN","C0SNHIN",272,0)
3214 I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
3215"RTN","C0SNHIN",273,0)
3216 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
3217"RTN","C0SNHIN",274,0)
3218 Q
3219"RTN","C0SNHIN",275,0)
3220 ;
3221"RTN","C0SNHIN",276,0)
3222WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
3223"RTN","C0SNHIN",277,0)
3224 ;
3225"RTN","C0SNHIN",278,0)
3226 N GN,GN2
3227"RTN","C0SNHIN",279,0)
3228 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
3229"RTN","C0SNHIN",280,0)
3230 S GN2=$NA(@GN@(1))
3231"RTN","C0SNHIN",281,0)
3232 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
3233"RTN","C0SNHIN",282,0)
3234 Q
3235"RTN","C0SNHIN",283,0)
3236 ;
3237"RTN","C0SNHIN",284,0)
3238TESTNARY ; TEST MAKING A NHIN ARRAY
3239"RTN","C0SNHIN",285,0)
3240 N ZI S ZI=""
3241"RTN","C0SNHIN",286,0)
3242 N ZH ; DOM HANDLE
3243"RTN","C0SNHIN",287,0)
3244 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
3245"RTN","C0SNHIN",288,0)
3246 S ZH=C0SDOCID ; SET THE HANDLE
3247"RTN","C0SNHIN",289,0)
3248 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
3249"RTN","C0SNHIN",290,0)
3250 F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE
3251"RTN","C0SNHIN",291,0)
3252 . N ZATT
3253"RTN","C0SNHIN",292,0)
3254 . D MNARY(.ZATT,ZH,ZI)
3255"RTN","C0SNHIN",293,0)
3256 . N ZPRE,ZN
3257"RTN","C0SNHIN",294,0)
3258 . S ZPRE=$$PRE(ZI)
3259"RTN","C0SNHIN",295,0)
3260 . S ZN=$P(ZPRE,",",2)
3261"RTN","C0SNHIN",296,0)
3262 . S ZPRE=$P(ZPRE,",",1)
3263"RTN","C0SNHIN",297,0)
3264 . ;I $D(ZATT) ZWR ZATT
3265"RTN","C0SNHIN",298,0)
3266 . N ZJ S ZJ=""
3267"RTN","C0SNHIN",299,0)
3268 . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE
3269"RTN","C0SNHIN",300,0)
3270 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
3271"RTN","C0SNHIN",301,0)
3272 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
3273"RTN","C0SNHIN",302,0)
3274 Q
3275"RTN","C0SNHIN",303,0)
3276 ;
3277"RTN","C0SNHIN",304,0)
3278PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
3279"RTN","C0SNHIN",305,0)
3280 ;
3281"RTN","C0SNHIN",306,0)
3282 N GI,GI2,GPT,GJ,GN
3283"RTN","C0SNHIN",307,0)
3284 S GI=$$PARENT(ZNODE) ; PARENT NODE
3285"RTN","C0SNHIN",308,0)
3286 I GI=0 Q "" ; NO PARENT
3287"RTN","C0SNHIN",309,0)
3288 S GPT=$$TAG(GI) ; TAG OF PARENT
3289"RTN","C0SNHIN",310,0)
3290 S GI2=$$PARENT(GI) ; PARENT OF PARENT
3291"RTN","C0SNHIN",311,0)
3292 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
3293"RTN","C0SNHIN",312,0)
3294 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
3295"RTN","C0SNHIN",313,0)
3296 I GJ=ZNODE Q:$$TAG(GI)_",1"
3297"RTN","C0SNHIN",314,0)
3298 F GN=2:1 Q:GJ=ZNODE D ;
3299"RTN","C0SNHIN",315,0)
3300 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
3301"RTN","C0SNHIN",316,0)
3302 Q GPT_","_GN
3303"RTN","C0SNHIN",317,0)
3304 ;
3305"RTN","C0SNHIN",318,0)
3306MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
3307"RTN","C0SNHIN",319,0)
3308 ; RETURNED IN ZRTN, PASSED BY REFERENCE
3309"RTN","C0SNHIN",320,0)
3310 ; ZHANDLE IS THE DOM DOCUMENT ID
3311"RTN","C0SNHIN",321,0)
3312 ; ZOID IS THE DOM NODE
3313"RTN","C0SNHIN",322,0)
3314 D ATT("ZRTN",ZOID)
3315"RTN","C0SNHIN",323,0)
3316 Q
3317"RTN","C0SNHIN",324,0)
3318 ;
3319"RTN","C0SNHINV")
33200^8^B15736572
3321"RTN","C0SNHINV",1,0)
3322C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version
3323"RTN","C0SNHINV",2,0)
3324 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
3325"RTN","C0SNHINV",3,0)
3326 ;
3327"RTN","C0SNHINV",4,0)
3328 ; External References DBIA#
3329"RTN","C0SNHINV",5,0)
3330 ; ------------------- -----
3331"RTN","C0SNHINV",6,0)
3332 ; ^DPT 10035
3333"RTN","C0SNHINV",7,0)
3334 ; ^SC 10040
3335"RTN","C0SNHINV",8,0)
3336 ; DIQ 2056
3337"RTN","C0SNHINV",9,0)
3338 ; MPIF001 2701
3339"RTN","C0SNHINV",10,0)
3340 ; VASITE 10112
3341"RTN","C0SNHINV",11,0)
3342 ; XLFDT 10103
3343"RTN","C0SNHINV",12,0)
3344 ; XLFSTR 10104
3345"RTN","C0SNHINV",13,0)
3346 ; XUAF4 2171
3347"RTN","C0SNHINV",14,0)
3348 ;
3349"RTN","C0SNHINV",15,0)
3350GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n)
3351"RTN","C0SNHINV",16,0)
3352 ; RPC = NHIN GET VISTA DATA
3353"RTN","C0SNHINV",17,0)
3354 N ICN,NHINI,NHINTOTL
3355"RTN","C0SNHINV",18,0)
3356 S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN
3357"RTN","C0SNHINV",19,0)
3358 ;
3359"RTN","C0SNHINV",20,0)
3360 ; parse & validate input parameters
3361"RTN","C0SNHINV",21,0)
3362 S ICN=+$P(DFN,";",2),DFN=+$G(DFN)
3363"RTN","C0SNHINV",22,0)
3364 I 'DFN S DFN=+$$GETDFN^MPIF001(ICN)
3365"RTN","C0SNHINV",23,0)
3366 I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ
3367"RTN","C0SNHINV",24,0)
3368 S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL
3369"RTN","C0SNHINV",25,0)
3370 S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999
3371"RTN","C0SNHINV",26,0)
3372 I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch
3373"RTN","C0SNHINV",27,0)
3374 I STOP,$L(STOP,".")<2 S STOP=STOP_".24"
3375"RTN","C0SNHINV",28,0)
3376 S ID=$G(ID)
3377"RTN","C0SNHINV",29,0)
3378 ;
3379"RTN","C0SNHINV",30,0)
3380 ; extract data
3381"RTN","C0SNHINV",31,0)
3382 N NHINTYPE,NHINP,RTN
3383"RTN","C0SNHINV",32,0)
3384 S NHINTYPE=TYPE D ADD("<results>")
3385"RTN","C0SNHINV",33,0)
3386 F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D
3387"RTN","C0SNHINV",34,0)
3388 . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q
3389"RTN","C0SNHINV",35,0)
3390 . D @(RTN_"(DFN,START,STOP,MAX,ID)")
3391"RTN","C0SNHINV",36,0)
3392 D ADD("</results>")
3393"RTN","C0SNHINV",37,0)
3394 ;
3395"RTN","C0SNHINV",38,0)
3396 I $G(NHINTOTL),$G(@NHIN@(1))="<results>" S @NHIN@(1)="<results total='"_NHINTOTL_"' >"
3397"RTN","C0SNHINV",39,0)
3398 ;
3399"RTN","C0SNHINV",40,0)
3400GTQ ; end
3401"RTN","C0SNHINV",41,0)
3402 Q
3403"RTN","C0SNHINV",42,0)
3404 ;
3405"RTN","C0SNHINV",43,0)
3406RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X
3407"RTN","C0SNHINV",44,0)
3408 S X=$$UP^XLFSTR(X),Y="NHINV"
3409"RTN","C0SNHINV",45,0)
3410 I X="ACCESSION" S Y="NHINVLRA"
3411"RTN","C0SNHINV",46,0)
3412 I X="ALLERGY" S Y="NHINVART"
3413"RTN","C0SNHINV",47,0)
3414 I X="APPOINTMENT" S Y="NHINVAPT"
3415"RTN","C0SNHINV",48,0)
3416 ; X="CONSULT" S Y="NHINVCON"
3417"RTN","C0SNHINV",49,0)
3418 I X="DOCUMENT" S Y="NHINVTIU"
3419"RTN","C0SNHINV",50,0)
3420 I X="IMMUNIZATION" S Y="NHINVIMM"
3421"RTN","C0SNHINV",51,0)
3422 I X="LAB" S Y="NHINVLR"
3423"RTN","C0SNHINV",52,0)
3424 I X="PANEL" S Y="NHINVLRO"
3425"RTN","C0SNHINV",53,0)
3426 I X="MED" S Y="NHINVPS"
3427"RTN","C0SNHINV",54,0)
3428 I X="RX" S Y="NHINVPSO"
3429"RTN","C0SNHINV",55,0)
3430 ; X="ORDER" S Y="NHINVOR"
3431"RTN","C0SNHINV",56,0)
3432 I X="PATIENT" S Y="NHINVPT"
3433"RTN","C0SNHINV",57,0)
3434 I X="PROBLEM" S Y="NHINVPL"
3435"RTN","C0SNHINV",58,0)
3436 I X="PROCEDURE" S Y="NHINVPRC"
3437"RTN","C0SNHINV",59,0)
3438 I X="SURGERY" S Y="NHINVSR"
3439"RTN","C0SNHINV",60,0)
3440 I X="VISIT" S Y="NHINVSIT"
3441"RTN","C0SNHINV",61,0)
3442 I X="VITAL" S Y="NHINVIT"
3443"RTN","C0SNHINV",62,0)
3444 I X="RADIOLOGY" S Y="NHINVRA"
3445"RTN","C0SNHINV",63,0)
3446 I X="NEW" S Y="NHINVPR"
3447"RTN","C0SNHINV",64,0)
3448 Q Y
3449"RTN","C0SNHINV",65,0)
3450 ;
3451"RTN","C0SNHINV",66,0)
3452ALL() ; -- return string for all types of data
3453"RTN","C0SNHINV",67,0)
3454 ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure"
3455"RTN","C0SNHINV",68,0)
3456 Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure"
3457"RTN","C0SNHINV",69,0)
3458 ;
3459"RTN","C0SNHINV",70,0)
3460ERR(X,VAL) ; -- return error message
3461"RTN","C0SNHINV",71,0)
3462 N MSG S MSG="Error"
3463"RTN","C0SNHINV",72,0)
3464 I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found"
3465"RTN","C0SNHINV",73,0)
3466 I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized"
3467"RTN","C0SNHINV",74,0)
3468 I X=99 S MSG="Unknown request"
3469"RTN","C0SNHINV",75,0)
3470 ;
3471"RTN","C0SNHINV",76,0)
3472 D ADD("<error>")
3473"RTN","C0SNHINV",77,0)
3474 D ADD("<message>"_MSG_"</message>")
3475"RTN","C0SNHINV",78,0)
3476 D ADD("</error>")
3477"RTN","C0SNHINV",79,0)
3478 Q
3479"RTN","C0SNHINV",80,0)
3480 ;
3481"RTN","C0SNHINV",81,0)
3482ESC(X) ; -- escape outgoing XML
3483"RTN","C0SNHINV",82,0)
3484 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
3485"RTN","C0SNHINV",83,0)
3486 ;
3487"RTN","C0SNHINV",84,0)
3488 N I,Y,QOT S QOT=""""
3489"RTN","C0SNHINV",85,0)
3490 S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&amp;"_$P(X,"&",I)
3491"RTN","C0SNHINV",86,0)
3492 S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"&lt;"_$P(X,"<",I)
3493"RTN","C0SNHINV",87,0)
3494 S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_"&gt;"_$P(X,">",I)
3495"RTN","C0SNHINV",88,0)
3496 S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"&apos;"_$P(X,"'",I)
3497"RTN","C0SNHINV",89,0)
3498 S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"&quot;"_$P(X,QOT,I)
3499"RTN","C0SNHINV",90,0)
3500 Q Y
3501"RTN","C0SNHINV",91,0)
3502 ;
3503"RTN","C0SNHINV",92,0)
3504ADD(X) ; Add a line @NHIN@(n)=X
3505"RTN","C0SNHINV",93,0)
3506 S NHINI=$G(NHINI)+1
3507"RTN","C0SNHINV",94,0)
3508 S @NHIN@(NHINI)=X
3509"RTN","C0SNHINV",95,0)
3510 Q
3511"RTN","C0SNHINV",96,0)
3512 ;
3513"RTN","C0SNHINV",97,0)
3514STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
3515"RTN","C0SNHINV",98,0)
3516 N I,X,Y S Y=""
3517"RTN","C0SNHINV",99,0)
3518 S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0))
3519"RTN","C0SNHINV",100,0)
3520 S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I)))
3521"RTN","C0SNHINV",101,0)
3522 F S I=$O(ARRAY(I)) Q:I<1 D
3523"RTN","C0SNHINV",102,0)
3524 . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
3525"RTN","C0SNHINV",103,0)
3526 . I $E(X)=" " S Y=Y_$C(13,10)_X Q
3527"RTN","C0SNHINV",104,0)
3528 . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
3529"RTN","C0SNHINV",105,0)
3530 Q Y
3531"RTN","C0SNHINV",106,0)
3532 ;
3533"RTN","C0SNHINV",107,0)
3534FAC(X) ; -- return Institution file station# for location X
3535"RTN","C0SNHINV",108,0)
3536 N HLOC,FAC,Y0,Y S Y=""
3537"RTN","C0SNHINV",109,0)
3538 S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien
3539"RTN","C0SNHINV",110,0)
3540 ; Get P:4 via Med Ctr Div, if not directly linked
3541"RTN","C0SNHINV",111,0)
3542 I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I")
3543"RTN","C0SNHINV",112,0)
3544 S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
3545"RTN","C0SNHINV",113,0)
3546 S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name
3547"RTN","C0SNHINV",114,0)
3548 I $L(Y),'Y S $P(Y,U)=FAC
3549"RTN","C0SNHINV",115,0)
3550 Q Y
3551"RTN","C0SNHINV",116,0)
3552 ;
3553"RTN","C0SNHINV",117,0)
3554VUID(IEN,FILE) ; -- Return VUID for item
3555"RTN","C0SNHINV",118,0)
3556 Q $$GET1^DIQ(FILE,IEN_",",99.99)
3557"RTN","C0SPROB")
35580^9^B49669400
3559"RTN","C0SPROB",1,0)
3560C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05
3561"RTN","C0SPROB",2,0)
3562 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
3563"RTN","C0SPROB",3,0)
3564 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
3565"RTN","C0SPROB",4,0)
3566 ;General Public License See attached copy of the License.
3567"RTN","C0SPROB",5,0)
3568 ;
3569"RTN","C0SPROB",6,0)
3570 ;This program is free software; you can redistribute it and/or modify
3571"RTN","C0SPROB",7,0)
3572 ;it under the terms of the GNU General Public License as published by
3573"RTN","C0SPROB",8,0)
3574 ;the Free Software Foundation; either version 2 of the License, or
3575"RTN","C0SPROB",9,0)
3576 ;(at your option) any later version.
3577"RTN","C0SPROB",10,0)
3578 ;
3579"RTN","C0SPROB",11,0)
3580 ;This program is distributed in the hope that it will be useful,
3581"RTN","C0SPROB",12,0)
3582 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
3583"RTN","C0SPROB",13,0)
3584 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3585"RTN","C0SPROB",14,0)
3586 ;GNU General Public License for more details.
3587"RTN","C0SPROB",15,0)
3588 ;
3589"RTN","C0SPROB",16,0)
3590 ;You should have received a copy of the GNU General Public License along
3591"RTN","C0SPROB",17,0)
3592 ;with this program; if not, write to the Free Software Foundation, Inc.,
3593"RTN","C0SPROB",18,0)
3594 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
3595"RTN","C0SPROB",19,0)
3596 ;
3597"RTN","C0SPROB",20,0)
3598 Q
3599"RTN","C0SPROB",21,0)
3600 ;
3601"RTN","C0SPROB",22,0)
3602 ; sample VistA NHIN problem list
3603"RTN","C0SPROB",23,0)
3604 ;
3605"RTN","C0SPROB",24,0)
3606 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
3607"RTN","C0SPROB",25,0)
3608 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
3609"RTN","C0SPROB",26,0)
3610 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
3611"RTN","C0SPROB",27,0)
3612 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
3613"RTN","C0SPROB",28,0)
3614 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
3615"RTN","C0SPROB",29,0)
3616 ;^TMP("C0STBL",91,"problem",1,"id@value")=100
3617"RTN","C0SPROB",30,0)
3618 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
3619"RTN","C0SPROB",31,0)
3620 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
3621"RTN","C0SPROB",32,0)
3622 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
3623"RTN","C0SPROB",33,0)
3624 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
3625"RTN","C0SPROB",34,0)
3626 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
3627"RTN","C0SPROB",35,0)
3628 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
3629"RTN","C0SPROB",36,0)
3630 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
3631"RTN","C0SPROB",37,0)
3632 ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
3633"RTN","C0SPROB",38,0)
3634 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
3635"RTN","C0SPROB",39,0)
3636 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
3637"RTN","C0SPROB",40,0)
3638 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
3639"RTN","C0SPROB",41,0)
3640 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
3641"RTN","C0SPROB",42,0)
3642 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
3643"RTN","C0SPROB",43,0)
3644 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
3645"RTN","C0SPROB",44,0)
3646 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
3647"RTN","C0SPROB",45,0)
3648 ;^TMP("C0STBL",91,"problem",2,"id@value")=108
3649"RTN","C0SPROB",46,0)
3650 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
3651"RTN","C0SPROB",47,0)
3652 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
3653"RTN","C0SPROB",48,0)
3654 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
3655"RTN","C0SPROB",49,0)
3656 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
3657"RTN","C0SPROB",50,0)
3658 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
3659"RTN","C0SPROB",51,0)
3660 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
3661"RTN","C0SPROB",52,0)
3662 ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
3663"RTN","C0SPROB",53,0)
3664 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
3665"RTN","C0SPROB",54,0)
3666 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
3667"RTN","C0SPROB",55,0)
3668 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
3669"RTN","C0SPROB",56,0)
3670 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
3671"RTN","C0SPROB",57,0)
3672 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
3673"RTN","C0SPROB",58,0)
3674 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
3675"RTN","C0SPROB",59,0)
3676 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
3677"RTN","C0SPROB",60,0)
3678 ;^TMP("C0STBL",91,"problem",3,"id@value")=109
3679"RTN","C0SPROB",61,0)
3680 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
3681"RTN","C0SPROB",62,0)
3682 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
3683"RTN","C0SPROB",63,0)
3684 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
3685"RTN","C0SPROB",64,0)
3686 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
3687"RTN","C0SPROB",65,0)
3688 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
3689"RTN","C0SPROB",66,0)
3690 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
3691"RTN","C0SPROB",67,0)
3692 ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
3693"RTN","C0SPROB",68,0)
3694 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
3695"RTN","C0SPROB",69,0)
3696 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
3697"RTN","C0SPROB",70,0)
3698 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
3699"RTN","C0SPROB",71,0)
3700 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
3701"RTN","C0SPROB",72,0)
3702 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
3703"RTN","C0SPROB",73,0)
3704 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
3705"RTN","C0SPROB",74,0)
3706 ;^TMP("C0STBL",91,"problem",4,"id@value")=115
3707"RTN","C0SPROB",75,0)
3708 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
3709"RTN","C0SPROB",76,0)
3710 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
3711"RTN","C0SPROB",77,0)
3712 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
3713"RTN","C0SPROB",78,0)
3714 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
3715"RTN","C0SPROB",79,0)
3716 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
3717"RTN","C0SPROB",80,0)
3718 ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
3719"RTN","C0SPROB",81,0)
3720 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
3721"RTN","C0SPROB",82,0)
3722 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
3723"RTN","C0SPROB",83,0)
3724 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
3725"RTN","C0SPROB",84,0)
3726 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
3727"RTN","C0SPROB",85,0)
3728 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
3729"RTN","C0SPROB",86,0)
3730 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
3731"RTN","C0SPROB",87,0)
3732 ;^TMP("C0STBL",91,"problem",5,"id@value")=116
3733"RTN","C0SPROB",88,0)
3734 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
3735"RTN","C0SPROB",89,0)
3736 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
3737"RTN","C0SPROB",90,0)
3738 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
3739"RTN","C0SPROB",91,0)
3740 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
3741"RTN","C0SPROB",92,0)
3742 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
3743"RTN","C0SPROB",93,0)
3744 ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
3745"RTN","C0SPROB",94,0)
3746 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
3747"RTN","C0SPROB",95,0)
3748 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
3749"RTN","C0SPROB",96,0)
3750 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
3751"RTN","C0SPROB",97,0)
3752 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
3753"RTN","C0SPROB",98,0)
3754 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
3755"RTN","C0SPROB",99,0)
3756 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
3757"RTN","C0SPROB",100,0)
3758 ;^TMP("C0STBL",91,"problem",6,"id@value")=117
3759"RTN","C0SPROB",101,0)
3760 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
3761"RTN","C0SPROB",102,0)
3762 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
3763"RTN","C0SPROB",103,0)
3764 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
3765"RTN","C0SPROB",104,0)
3766 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
3767"RTN","C0SPROB",105,0)
3768 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
3769"RTN","C0SPROB",106,0)
3770 ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
3771"RTN","C0SPROB",107,0)
3772 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
3773"RTN","C0SPROB",108,0)
3774 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
3775"RTN","C0SPROB",109,0)
3776 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
3777"RTN","C0SPROB",110,0)
3778 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
3779"RTN","C0SPROB",111,0)
3780 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
3781"RTN","C0SPROB",112,0)
3782 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
3783"RTN","C0SPROB",113,0)
3784 ;^TMP("C0STBL",91,"problem",7,"id@value")=118
3785"RTN","C0SPROB",114,0)
3786 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
3787"RTN","C0SPROB",115,0)
3788 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
3789"RTN","C0SPROB",116,0)
3790 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
3791"RTN","C0SPROB",117,0)
3792 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
3793"RTN","C0SPROB",118,0)
3794 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
3795"RTN","C0SPROB",119,0)
3796 ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
3797"RTN","C0SPROB",120,0)
3798 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
3799"RTN","C0SPROB",121,0)
3800 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
3801"RTN","C0SPROB",122,0)
3802 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
3803"RTN","C0SPROB",123,0)
3804 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
3805"RTN","C0SPROB",124,0)
3806 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
3807"RTN","C0SPROB",125,0)
3808 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
3809"RTN","C0SPROB",126,0)
3810 ;^TMP("C0STBL",91,"problem",8,"id@value")=119
3811"RTN","C0SPROB",127,0)
3812 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
3813"RTN","C0SPROB",128,0)
3814 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
3815"RTN","C0SPROB",129,0)
3816 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
3817"RTN","C0SPROB",130,0)
3818 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
3819"RTN","C0SPROB",131,0)
3820 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
3821"RTN","C0SPROB",132,0)
3822 ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
3823"RTN","C0SPROB",133,0)
3824 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
3825"RTN","C0SPROB",134,0)
3826 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
3827"RTN","C0SPROB",135,0)
3828 ;
3829"RTN","C0SPROB",136,0)
3830 ; sample Smart lab result triples
3831"RTN","C0SPROB",137,0)
3832 ;
3833"RTN","C0SPROB",138,0)
3834 ;G("node16rk1fgdvx10882","code")="snomed:40930008"
3835"RTN","C0SPROB",139,0)
3836 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
3837"RTN","C0SPROB",140,0)
3838 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
3839"RTN","C0SPROB",141,0)
3840 ;G("node16rk1fgdvx11051","code")="snomed:188155002"
3841"RTN","C0SPROB",142,0)
3842 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
3843"RTN","C0SPROB",143,0)
3844 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
3845"RTN","C0SPROB",144,0)
3846 ;G("node16rk1fgdvx11073","code")="snomed:353295004"
3847"RTN","C0SPROB",145,0)
3848 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
3849"RTN","C0SPROB",146,0)
3850 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
3851"RTN","C0SPROB",147,0)
3852 ;G("node16rk1fgdvx11089","code")="snomed:54302000"
3853"RTN","C0SPROB",148,0)
3854 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
3855"RTN","C0SPROB",149,0)
3856 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
3857"RTN","C0SPROB",150,0)
3858 ;G("node16rk1fgdvx11351","code")="snomed:38341003"
3859"RTN","C0SPROB",151,0)
3860 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
3861"RTN","C0SPROB",152,0)
3862 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
3863"RTN","C0SPROB",153,0)
3864 ;G("node16rk1fgdvx11390","code")="snomed:44054006"
3865"RTN","C0SPROB",154,0)
3866 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
3867"RTN","C0SPROB",155,0)
3868 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
3869"RTN","C0SPROB",156,0)
3870 ;G("node16rk1fgdvx11558","code")="snomed:195967001"
3871"RTN","C0SPROB",157,0)
3872 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
3873"RTN","C0SPROB",158,0)
3874 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
3875"RTN","C0SPROB",159,0)
3876 ;G("node16rk1fgdvx11578","code")="snomed:254837009"
3877"RTN","C0SPROB",160,0)
3878 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
3879"RTN","C0SPROB",161,0)
3880 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
3881"RTN","C0SPROB",162,0)
3882 ;G("node16rk1fgdvx11687","code")="snomed:8517006"
3883"RTN","C0SPROB",163,0)
3884 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
3885"RTN","C0SPROB",164,0)
3886 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
3887"RTN","C0SPROB",165,0)
3888 ;G("node16rk1fgdvx11716","code")="snomed:55822004"
3889"RTN","C0SPROB",166,0)
3890 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
3891"RTN","C0SPROB",167,0)
3892 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
3893"RTN","C0SPROB",168,0)
3894 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
3895"RTN","C0SPROB",169,0)
3896 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
3897"RTN","C0SPROB",170,0)
3898 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
3899"RTN","C0SPROB",171,0)
3900 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
3901"RTN","C0SPROB",172,0)
3902 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
3903"RTN","C0SPROB",173,0)
3904 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
3905"RTN","C0SPROB",174,0)
3906 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
3907"RTN","C0SPROB",175,0)
3908 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
3909"RTN","C0SPROB",176,0)
3910 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
3911"RTN","C0SPROB",177,0)
3912 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
3913"RTN","C0SPROB",178,0)
3914 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
3915"RTN","C0SPROB",179,0)
3916 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
3917"RTN","C0SPROB",180,0)
3918 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
3919"RTN","C0SPROB",181,0)
3920 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
3921"RTN","C0SPROB",182,0)
3922 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
3923"RTN","C0SPROB",183,0)
3924 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
3925"RTN","C0SPROB",184,0)
3926 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
3927"RTN","C0SPROB",185,0)
3928 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
3929"RTN","C0SPROB",186,0)
3930 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
3931"RTN","C0SPROB",187,0)
3932 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
3933"RTN","C0SPROB",188,0)
3934 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
3935"RTN","C0SPROB",189,0)
3936 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
3937"RTN","C0SPROB",190,0)
3938 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
3939"RTN","C0SPROB",191,0)
3940 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
3941"RTN","C0SPROB",192,0)
3942 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
3943"RTN","C0SPROB",193,0)
3944 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
3945"RTN","C0SPROB",194,0)
3946 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
3947"RTN","C0SPROB",195,0)
3948 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
3949"RTN","C0SPROB",196,0)
3950 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
3951"RTN","C0SPROB",197,0)
3952 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
3953"RTN","C0SPROB",198,0)
3954 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
3955"RTN","C0SPROB",199,0)
3956 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
3957"RTN","C0SPROB",200,0)
3958 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
3959"RTN","C0SPROB",201,0)
3960 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
3961"RTN","C0SPROB",202,0)
3962 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
3963"RTN","C0SPROB",203,0)
3964 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
3965"RTN","C0SPROB",204,0)
3966 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
3967"RTN","C0SPROB",205,0)
3968 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
3969"RTN","C0SPROB",206,0)
3970 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
3971"RTN","C0SPROB",207,0)
3972 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
3973"RTN","C0SPROB",208,0)
3974 ;G("snomed:188155002","dcterms:identifier")=188155002
3975"RTN","C0SPROB",209,0)
3976 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
3977"RTN","C0SPROB",210,0)
3978 ;G("snomed:188155002","rdf:type")="sp:Code"
3979"RTN","C0SPROB",211,0)
3980 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
3981"RTN","C0SPROB",212,0)
3982 ;G("snomed:195967001","dcterms:identifier")=195967001
3983"RTN","C0SPROB",213,0)
3984 ;G("snomed:195967001","dcterms:title")="Asthma"
3985"RTN","C0SPROB",214,0)
3986 ;G("snomed:195967001","rdf:type")="sp:Code"
3987"RTN","C0SPROB",215,0)
3988 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
3989"RTN","C0SPROB",216,0)
3990 ;G("snomed:254837009","dcterms:identifier")=254837009
3991"RTN","C0SPROB",217,0)
3992 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
3993"RTN","C0SPROB",218,0)
3994 ;G("snomed:254837009","rdf:type")="sp:Code"
3995"RTN","C0SPROB",219,0)
3996 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
3997"RTN","C0SPROB",220,0)
3998 ;G("snomed:353295004","dcterms:identifier")=353295004
3999"RTN","C0SPROB",221,0)
4000 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
4001"RTN","C0SPROB",222,0)
4002 ;G("snomed:353295004","rdf:type")="sp:Code"
4003"RTN","C0SPROB",223,0)
4004 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4005"RTN","C0SPROB",224,0)
4006 ;G("snomed:38341003","dcterms:identifier")=38341003
4007"RTN","C0SPROB",225,0)
4008 ;G("snomed:38341003","dcterms:title")="Essential hypertension"
4009"RTN","C0SPROB",226,0)
4010 ;G("snomed:38341003","rdf:type")="sp:Code"
4011"RTN","C0SPROB",227,0)
4012 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4013"RTN","C0SPROB",228,0)
4014 ;G("snomed:40930008","dcterms:identifier")=40930008
4015"RTN","C0SPROB",229,0)
4016 ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
4017"RTN","C0SPROB",230,0)
4018 ;G("snomed:40930008","rdf:type")="sp:Code"
4019"RTN","C0SPROB",231,0)
4020 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4021"RTN","C0SPROB",232,0)
4022 ;G("snomed:44054006","dcterms:identifier")=44054006
4023"RTN","C0SPROB",233,0)
4024 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
4025"RTN","C0SPROB",234,0)
4026 ;G("snomed:44054006","rdf:type")="sp:Code"
4027"RTN","C0SPROB",235,0)
4028 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4029"RTN","C0SPROB",236,0)
4030 ;G("snomed:54302000","dcterms:identifier")=54302000
4031"RTN","C0SPROB",237,0)
4032 ;G("snomed:54302000","dcterms:title")="Disorder of breast"
4033"RTN","C0SPROB",238,0)
4034 ;G("snomed:54302000","rdf:type")="sp:Code"
4035"RTN","C0SPROB",239,0)
4036 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4037"RTN","C0SPROB",240,0)
4038 ;G("snomed:55822004","dcterms:identifier")=55822004
4039"RTN","C0SPROB",241,0)
4040 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
4041"RTN","C0SPROB",242,0)
4042 ;G("snomed:55822004","rdf:type")="sp:Code"
4043"RTN","C0SPROB",243,0)
4044 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4045"RTN","C0SPROB",244,0)
4046 ;G("snomed:8517006","dcterms:identifier")=8517006
4047"RTN","C0SPROB",245,0)
4048 ;G("snomed:8517006","dcterms:title")="History of tobacco use"
4049"RTN","C0SPROB",246,0)
4050 ;G("snomed:8517006","rdf:type")="sp:Code"
4051"RTN","C0SPROB",247,0)
4052 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
4053"RTN","C0SPROB",248,0)
4054
4055"RTN","C0SPROB",249,0)
4056 ;
4057"RTN","C0SPROB",250,0)
4058PROB(GRTN,C0SARY) ; GRTN, passed by reference,
4059"RTN","C0SPROB",251,0)
4060 ; is the return name of the graph created. "" if none
4061"RTN","C0SPROB",252,0)
4062 ; C0SARY is passed in by reference and is the NHIN array of problems
4063"RTN","C0SPROB",253,0)
4064 ;
4065"RTN","C0SPROB",254,0)
4066 I $O(C0SARY("problem",""))="" D Q ;
4067"RTN","C0SPROB",255,0)
4068 . I $D(DEBUG) W !,"No Problems"
4069"RTN","C0SPROB",256,0)
4070 S GRTN="" ; default to no problems
4071"RTN","C0SPROB",257,0)
4072 N C0SGRF
4073"RTN","C0SPROB",258,0)
4074 S C0SGRF="vistaSmart:"_ZPATID_"/problems"
4075"RTN","C0SPROB",259,0)
4076 I $D(DEBUG) W !,"Processing ",C0SGRF
4077"RTN","C0SPROB",260,0)
4078 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
4079"RTN","C0SPROB",261,0)
4080 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
4081"RTN","C0SPROB",262,0)
4082 N FARY S FARY="C0XFARY"
4083"RTN","C0SPROB",263,0)
4084 D USEFARY^C0XF2N(FARY)
4085"RTN","C0SPROB",264,0)
4086 D VOCINIT^C0XUTIL
4087"RTN","C0SPROB",265,0)
4088 ;
4089"RTN","C0SPROB",266,0)
4090 D STARTADD^C0XF2N ; initialize to create triples
4091"RTN","C0SPROB",267,0)
4092 ;
4093"RTN","C0SPROB",268,0)
4094 N ZI S ZI=""
4095"RTN","C0SPROB",269,0)
4096 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ;
4097"RTN","C0SPROB",270,0)
4098 . N LRN,ZR ; ZR is the local array for building the new triples
4099"RTN","C0SPROB",271,0)
4100 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
4101"RTN","C0SPROB",272,0)
4102 . ;
4103"RTN","C0SPROB",273,0)
4104 . N PROBID ; unique Id for this problem
4105"RTN","C0SPROB",274,0)
4106 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
4107"RTN","C0SPROB",275,0)
4108 . ;
4109"RTN","C0SPROB",276,0)
4110 . ; i don't like this because the same problems gets a
4111"RTN","C0SPROB",277,0)
4112 . ; different ID every time it's reported. Can't trace it back to VistA
4113"RTN","C0SPROB",278,0)
4114 . ; I'd rather be using id@value ie "id@value")="118"
4115"RTN","C0SPROB",279,0)
4116 . ;
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:"_SNOMED
4121"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 ",PROBID
4127"RTN","C0SPROB",285,0)
4128 . . W !,"problem: ",SNOTIT
4129"RTN","C0SPROB",286,0)
4130 . . W !,"code: ",SNOMED
4131"RTN","C0SPROB",287,0)
4132 . ;
4133"RTN","C0SPROB",288,0)
4134 . ; first do the base result graph
4135"RTN","C0SPROB",289,0)
4136 . ;
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 problems
4141"RTN","C0SPROB",292,0)
4142 . ; ie /vista/smart/99912345/problems
4143"RTN","C0SPROB",293,0)
4144 . ;
4145"RTN","C0SPROB",294,0)
4146 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
4147"RTN","C0SPROB",295,0)
4148 . S ZR("sp:problemName")=PROBNAME
4149"RTN","C0SPROB",296,0)
4150 . ;
4151"RTN","C0SPROB",297,0)
4152 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
4153"RTN","C0SPROB",298,0)
4154 . S ZR("sp:startDate")=STARTDT
4155"RTN","C0SPROB",299,0)
4156 . ;
4157"RTN","C0SPROB",300,0)
4158 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
4159"RTN","C0SPROB",301,0)
4160 . K ZR ; clean up
4161"RTN","C0SPROB",302,0)
4162 . ;
4163"RTN","C0SPROB",303,0)
4164 . ; create the problemName graph
4165"RTN","C0SPROB",304,0)
4166 . ;
4167"RTN","C0SPROB",305,0)
4168 . S ZR("rdf:type")="sp:CodedValue"
4169"RTN","C0SPROB",306,0)
4170 . S ZR("sp:code")="snomed:"_SNOMED
4171"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"RTN","C0SPROB",309,0)
4176 . K ZR
4177"RTN","C0SPROB",310,0)
4178 . ;
4179"RTN","C0SPROB",311,0)
4180 . ; create snomed graph
4181"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")=SNOMED
4189"RTN","C0SPROB",316,0)
4190 . S ZR("dcterms:title")=SNOTIT
4191"RTN","C0SPROB",317,0)
4192 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
4193"RTN","C0SPROB",318,0)
4194 . K ZR
4195"RTN","C0SPROB",319,0)
4196 . ;
4197"RTN","C0SPROB",320,0)
4198 D BULKLOAD^C0XF2N(.C0XFDA)
4199"RTN","C0SPROB",321,0)
4200 S GRTN=C0SGRF
4201"RTN","C0SPROB",322,0)
4202 Q
4203"RTN","C0SPROB",323,0)
4204 ;
4205"RTN","C0SPROB2")
42060^10^B67594874
4207"RTN","C0SPROB2",1,0)
4208C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05
4209"RTN","C0SPROB2",2,0)
4210 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
4211"RTN","C0SPROB2",3,0)
4212 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
4213"RTN","C0SPROB2",4,0)
4214 ;General Public License See attached copy of the License.
4215"RTN","C0SPROB2",5,0)
4216 ;
4217"RTN","C0SPROB2",6,0)
4218 ;This program is free software; you can redistribute it and/or modify
4219"RTN","C0SPROB2",7,0)
4220 ;it under the terms of the GNU General Public License as published by
4221"RTN","C0SPROB2",8,0)
4222 ;the Free Software Foundation; either version 2 of the License, or
4223"RTN","C0SPROB2",9,0)
4224 ;(at your option) any later version.
4225"RTN","C0SPROB2",10,0)
4226 ;
4227"RTN","C0SPROB2",11,0)
4228 ;This program is distributed in the hope that it will be useful,
4229"RTN","C0SPROB2",12,0)
4230 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
4231"RTN","C0SPROB2",13,0)
4232 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4233"RTN","C0SPROB2",14,0)
4234 ;GNU General Public License for more details.
4235"RTN","C0SPROB2",15,0)
4236 ;
4237"RTN","C0SPROB2",16,0)
4238 ;You should have received a copy of the GNU General Public License along
4239"RTN","C0SPROB2",17,0)
4240 ;with this program; if not, write to the Free Software Foundation, Inc.,
4241"RTN","C0SPROB2",18,0)
4242 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
4243"RTN","C0SPROB2",19,0)
4244 ;
4245"RTN","C0SPROB2",20,0)
4246 Q
4247"RTN","C0SPROB2",21,0)
4248 ;
4249"RTN","C0SPROB2",22,0)
4250 ; sample VistA NHIN problem list
4251"RTN","C0SPROB2",23,0)
4252 ;
4253"RTN","C0SPROB2",24,0)
4254 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
4255"RTN","C0SPROB2",25,0)
4256 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
4257"RTN","C0SPROB2",26,0)
4258 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
4259"RTN","C0SPROB2",27,0)
4260 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
4261"RTN","C0SPROB2",28,0)
4262 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
4263"RTN","C0SPROB2",29,0)
4264 ;^TMP("C0STBL",91,"problem",1,"id@value")=100
4265"RTN","C0SPROB2",30,0)
4266 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
4267"RTN","C0SPROB2",31,0)
4268 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
4269"RTN","C0SPROB2",32,0)
4270 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
4271"RTN","C0SPROB2",33,0)
4272 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
4273"RTN","C0SPROB2",34,0)
4274 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
4275"RTN","C0SPROB2",35,0)
4276 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
4277"RTN","C0SPROB2",36,0)
4278 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
4279"RTN","C0SPROB2",37,0)
4280 ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
4281"RTN","C0SPROB2",38,0)
4282 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
4283"RTN","C0SPROB2",39,0)
4284 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
4285"RTN","C0SPROB2",40,0)
4286 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
4287"RTN","C0SPROB2",41,0)
4288 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
4289"RTN","C0SPROB2",42,0)
4290 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
4291"RTN","C0SPROB2",43,0)
4292 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
4293"RTN","C0SPROB2",44,0)
4294 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
4295"RTN","C0SPROB2",45,0)
4296 ;^TMP("C0STBL",91,"problem",2,"id@value")=108
4297"RTN","C0SPROB2",46,0)
4298 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
4299"RTN","C0SPROB2",47,0)
4300 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
4301"RTN","C0SPROB2",48,0)
4302 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
4303"RTN","C0SPROB2",49,0)
4304 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
4305"RTN","C0SPROB2",50,0)
4306 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
4307"RTN","C0SPROB2",51,0)
4308 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
4309"RTN","C0SPROB2",52,0)
4310 ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
4311"RTN","C0SPROB2",53,0)
4312 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
4313"RTN","C0SPROB2",54,0)
4314 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
4315"RTN","C0SPROB2",55,0)
4316 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
4317"RTN","C0SPROB2",56,0)
4318 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
4319"RTN","C0SPROB2",57,0)
4320 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
4321"RTN","C0SPROB2",58,0)
4322 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
4323"RTN","C0SPROB2",59,0)
4324 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
4325"RTN","C0SPROB2",60,0)
4326 ;^TMP("C0STBL",91,"problem",3,"id@value")=109
4327"RTN","C0SPROB2",61,0)
4328 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
4329"RTN","C0SPROB2",62,0)
4330 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
4331"RTN","C0SPROB2",63,0)
4332 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
4333"RTN","C0SPROB2",64,0)
4334 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
4335"RTN","C0SPROB2",65,0)
4336 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
4337"RTN","C0SPROB2",66,0)
4338 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
4339"RTN","C0SPROB2",67,0)
4340 ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
4341"RTN","C0SPROB2",68,0)
4342 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
4343"RTN","C0SPROB2",69,0)
4344 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
4345"RTN","C0SPROB2",70,0)
4346 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
4347"RTN","C0SPROB2",71,0)
4348 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
4349"RTN","C0SPROB2",72,0)
4350 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
4351"RTN","C0SPROB2",73,0)
4352 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
4353"RTN","C0SPROB2",74,0)
4354 ;^TMP("C0STBL",91,"problem",4,"id@value")=115
4355"RTN","C0SPROB2",75,0)
4356 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
4357"RTN","C0SPROB2",76,0)
4358 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
4359"RTN","C0SPROB2",77,0)
4360 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
4361"RTN","C0SPROB2",78,0)
4362 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
4363"RTN","C0SPROB2",79,0)
4364 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
4365"RTN","C0SPROB2",80,0)
4366 ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
4367"RTN","C0SPROB2",81,0)
4368 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
4369"RTN","C0SPROB2",82,0)
4370 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
4371"RTN","C0SPROB2",83,0)
4372 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
4373"RTN","C0SPROB2",84,0)
4374 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
4375"RTN","C0SPROB2",85,0)
4376 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
4377"RTN","C0SPROB2",86,0)
4378 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
4379"RTN","C0SPROB2",87,0)
4380 ;^TMP("C0STBL",91,"problem",5,"id@value")=116
4381"RTN","C0SPROB2",88,0)
4382 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
4383"RTN","C0SPROB2",89,0)
4384 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
4385"RTN","C0SPROB2",90,0)
4386 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
4387"RTN","C0SPROB2",91,0)
4388 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
4389"RTN","C0SPROB2",92,0)
4390 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
4391"RTN","C0SPROB2",93,0)
4392 ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
4393"RTN","C0SPROB2",94,0)
4394 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
4395"RTN","C0SPROB2",95,0)
4396 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
4397"RTN","C0SPROB2",96,0)
4398 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
4399"RTN","C0SPROB2",97,0)
4400 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
4401"RTN","C0SPROB2",98,0)
4402 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
4403"RTN","C0SPROB2",99,0)
4404 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
4405"RTN","C0SPROB2",100,0)
4406 ;^TMP("C0STBL",91,"problem",6,"id@value")=117
4407"RTN","C0SPROB2",101,0)
4408 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
4409"RTN","C0SPROB2",102,0)
4410 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
4411"RTN","C0SPROB2",103,0)
4412 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
4413"RTN","C0SPROB2",104,0)
4414 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
4415"RTN","C0SPROB2",105,0)
4416 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
4417"RTN","C0SPROB2",106,0)
4418 ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
4419"RTN","C0SPROB2",107,0)
4420 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
4421"RTN","C0SPROB2",108,0)
4422 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
4423"RTN","C0SPROB2",109,0)
4424 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
4425"RTN","C0SPROB2",110,0)
4426 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
4427"RTN","C0SPROB2",111,0)
4428 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
4429"RTN","C0SPROB2",112,0)
4430 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
4431"RTN","C0SPROB2",113,0)
4432 ;^TMP("C0STBL",91,"problem",7,"id@value")=118
4433"RTN","C0SPROB2",114,0)
4434 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
4435"RTN","C0SPROB2",115,0)
4436 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
4437"RTN","C0SPROB2",116,0)
4438 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
4439"RTN","C0SPROB2",117,0)
4440 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
4441"RTN","C0SPROB2",118,0)
4442 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
4443"RTN","C0SPROB2",119,0)
4444 ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
4445"RTN","C0SPROB2",120,0)
4446 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
4447"RTN","C0SPROB2",121,0)
4448 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
4449"RTN","C0SPROB2",122,0)
4450 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
4451"RTN","C0SPROB2",123,0)
4452 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
4453"RTN","C0SPROB2",124,0)
4454 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
4455"RTN","C0SPROB2",125,0)
4456 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
4457"RTN","C0SPROB2",126,0)
4458 ;^TMP("C0STBL",91,"problem",8,"id@value")=119
4459"RTN","C0SPROB2",127,0)
4460 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
4461"RTN","C0SPROB2",128,0)
4462 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
4463"RTN","C0SPROB2",129,0)
4464 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
4465"RTN","C0SPROB2",130,0)
4466 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
4467"RTN","C0SPROB2",131,0)
4468 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
4469"RTN","C0SPROB2",132,0)
4470 ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
4471"RTN","C0SPROB2",133,0)
4472 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
4473"RTN","C0SPROB2",134,0)
4474 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
4475"RTN","C0SPROB2",135,0)
4476 ;
4477"RTN","C0SPROB2",136,0)
4478 ; sample Smart lab result triples
4479"RTN","C0SPROB2",137,0)
4480 ;
4481"RTN","C0SPROB2",138,0)
4482 ;G("node16rk1fgdvx10882","code")="snomed:40930008"
4483"RTN","C0SPROB2",139,0)
4484 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
4485"RTN","C0SPROB2",140,0)
4486 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
4487"RTN","C0SPROB2",141,0)
4488 ;G("node16rk1fgdvx11051","code")="snomed:188155002"
4489"RTN","C0SPROB2",142,0)
4490 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
4491"RTN","C0SPROB2",143,0)
4492 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
4493"RTN","C0SPROB2",144,0)
4494 ;G("node16rk1fgdvx11073","code")="snomed:353295004"
4495"RTN","C0SPROB2",145,0)
4496 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
4497"RTN","C0SPROB2",146,0)
4498 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
4499"RTN","C0SPROB2",147,0)
4500 ;G("node16rk1fgdvx11089","code")="snomed:54302000"
4501"RTN","C0SPROB2",148,0)
4502 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
4503"RTN","C0SPROB2",149,0)
4504 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
4505"RTN","C0SPROB2",150,0)
4506 ;G("node16rk1fgdvx11351","code")="snomed:38341003"
4507"RTN","C0SPROB2",151,0)
4508 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
4509"RTN","C0SPROB2",152,0)
4510 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
4511"RTN","C0SPROB2",153,0)
4512 ;G("node16rk1fgdvx11390","code")="snomed:44054006"
4513"RTN","C0SPROB2",154,0)
4514 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
4515"RTN","C0SPROB2",155,0)
4516 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
4517"RTN","C0SPROB2",156,0)
4518 ;G("node16rk1fgdvx11558","code")="snomed:195967001"
4519"RTN","C0SPROB2",157,0)
4520 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
4521"RTN","C0SPROB2",158,0)
4522 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
4523"RTN","C0SPROB2",159,0)
4524 ;G("node16rk1fgdvx11578","code")="snomed:254837009"
4525"RTN","C0SPROB2",160,0)
4526 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
4527"RTN","C0SPROB2",161,0)
4528 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
4529"RTN","C0SPROB2",162,0)
4530 ;G("node16rk1fgdvx11687","code")="snomed:8517006"
4531"RTN","C0SPROB2",163,0)
4532 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
4533"RTN","C0SPROB2",164,0)
4534 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
4535"RTN","C0SPROB2",165,0)
4536 ;G("node16rk1fgdvx11716","code")="snomed:55822004"
4537"RTN","C0SPROB2",166,0)
4538 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
4539"RTN","C0SPROB2",167,0)
4540 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
4541"RTN","C0SPROB2",168,0)
4542 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
4543"RTN","C0SPROB2",169,0)
4544 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
4545"RTN","C0SPROB2",170,0)
4546 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
4547"RTN","C0SPROB2",171,0)
4548 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
4549"RTN","C0SPROB2",172,0)
4550 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
4551"RTN","C0SPROB2",173,0)
4552 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
4553"RTN","C0SPROB2",174,0)
4554 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
4555"RTN","C0SPROB2",175,0)
4556 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
4557"RTN","C0SPROB2",176,0)
4558 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
4559"RTN","C0SPROB2",177,0)
4560 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
4561"RTN","C0SPROB2",178,0)
4562 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
4563"RTN","C0SPROB2",179,0)
4564 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
4565"RTN","C0SPROB2",180,0)
4566 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
4567"RTN","C0SPROB2",181,0)
4568 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
4569"RTN","C0SPROB2",182,0)
4570 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
4571"RTN","C0SPROB2",183,0)
4572 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
4573"RTN","C0SPROB2",184,0)
4574 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
4575"RTN","C0SPROB2",185,0)
4576 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
4577"RTN","C0SPROB2",186,0)
4578 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
4579"RTN","C0SPROB2",187,0)
4580 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
4581"RTN","C0SPROB2",188,0)
4582 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
4583"RTN","C0SPROB2",189,0)
4584 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
4585"RTN","C0SPROB2",190,0)
4586 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
4587"RTN","C0SPROB2",191,0)
4588 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
4589"RTN","C0SPROB2",192,0)
4590 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
4591"RTN","C0SPROB2",193,0)
4592 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
4593"RTN","C0SPROB2",194,0)
4594 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
4595"RTN","C0SPROB2",195,0)
4596 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
4597"RTN","C0SPROB2",196,0)
4598 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
4599"RTN","C0SPROB2",197,0)
4600 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
4601"RTN","C0SPROB2",198,0)
4602 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
4603"RTN","C0SPROB2",199,0)
4604 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
4605"RTN","C0SPROB2",200,0)
4606 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
4607"RTN","C0SPROB2",201,0)
4608 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
4609"RTN","C0SPROB2",202,0)
4610 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
4611"RTN","C0SPROB2",203,0)
4612 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
4613"RTN","C0SPROB2",204,0)
4614 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
4615"RTN","C0SPROB2",205,0)
4616 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
4617"RTN","C0SPROB2",206,0)
4618 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
4619"RTN","C0SPROB2",207,0)
4620 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
4621"RTN","C0SPROB2",208,0)
4622 ;G("snomed:188155002","dcterms:identifier")=188155002
4623"RTN","C0SPROB2",209,0)
4624 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
4625"RTN","C0SPROB2",210,0)
4626 ;G("snomed:188155002","rdf:type")="sp:Code"
4627"RTN","C0SPROB2",211,0)
4628 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4629"RTN","C0SPROB2",212,0)
4630 ;G("snomed:195967001","dcterms:identifier")=195967001
4631"RTN","C0SPROB2",213,0)
4632 ;G("snomed:195967001","dcterms:title")="Asthma"
4633"RTN","C0SPROB2",214,0)
4634 ;G("snomed:195967001","rdf:type")="sp:Code"
4635"RTN","C0SPROB2",215,0)
4636 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4637"RTN","C0SPROB2",216,0)
4638 ;G("snomed:254837009","dcterms:identifier")=254837009
4639"RTN","C0SPROB2",217,0)
4640 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
4641"RTN","C0SPROB2",218,0)
4642 ;G("snomed:254837009","rdf:type")="sp:Code"
4643"RTN","C0SPROB2",219,0)
4644 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4645"RTN","C0SPROB2",220,0)
4646 ;G("snomed:353295004","dcterms:identifier")=353295004
4647"RTN","C0SPROB2",221,0)
4648 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
4649"RTN","C0SPROB2",222,0)
4650 ;G("snomed:353295004","rdf:type")="sp:Code"
4651"RTN","C0SPROB2",223,0)
4652 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4653"RTN","C0SPROB2",224,0)
4654 ;G("snomed:38341003","dcterms:identifier")=38341003
4655"RTN","C0SPROB2",225,0)
4656 ;G("snomed:38341003","dcterms:title")="Essential hypertension"
4657"RTN","C0SPROB2",226,0)
4658 ;G("snomed:38341003","rdf:type")="sp:Code"
4659"RTN","C0SPROB2",227,0)
4660 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4661"RTN","C0SPROB2",228,0)
4662 ;G("snomed:40930008","dcterms:identifier")=40930008
4663"RTN","C0SPROB2",229,0)
4664 ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
4665"RTN","C0SPROB2",230,0)
4666 ;G("snomed:40930008","rdf:type")="sp:Code"
4667"RTN","C0SPROB2",231,0)
4668 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4669"RTN","C0SPROB2",232,0)
4670 ;G("snomed:44054006","dcterms:identifier")=44054006
4671"RTN","C0SPROB2",233,0)
4672 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
4673"RTN","C0SPROB2",234,0)
4674 ;G("snomed:44054006","rdf:type")="sp:Code"
4675"RTN","C0SPROB2",235,0)
4676 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4677"RTN","C0SPROB2",236,0)
4678 ;G("snomed:54302000","dcterms:identifier")=54302000
4679"RTN","C0SPROB2",237,0)
4680 ;G("snomed:54302000","dcterms:title")="Disorder of breast"
4681"RTN","C0SPROB2",238,0)
4682 ;G("snomed:54302000","rdf:type")="sp:Code"
4683"RTN","C0SPROB2",239,0)
4684 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4685"RTN","C0SPROB2",240,0)
4686 ;G("snomed:55822004","dcterms:identifier")=55822004
4687"RTN","C0SPROB2",241,0)
4688 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
4689"RTN","C0SPROB2",242,0)
4690 ;G("snomed:55822004","rdf:type")="sp:Code"
4691"RTN","C0SPROB2",243,0)
4692 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
4693"RTN","C0SPROB2",244,0)
4694 ;G("snomed:8517006","dcterms:identifier")=8517006
4695"RTN","C0SPROB2",245,0)
4696 ;G("snomed:8517006","dcterms:title")="History of tobacco use"
4697"RTN","C0SPROB2",246,0)
4698 ;G("snomed:8517006","rdf:type")="sp:Code"
4699"RTN","C0SPROB2",247,0)
4700 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
4701"RTN","C0SPROB2",248,0)
4702
4703"RTN","C0SPROB2",249,0)
4704 ;
4705"RTN","C0SPROB2",250,0)
4706PROB(GRTN,C0SARY) ; GRTN, passed by reference,
4707"RTN","C0SPROB2",251,0)
4708 ; is the return name of the graph created. "" if none
4709"RTN","C0SPROB2",252,0)
4710 ; C0SARY is passed in by reference and is the NHIN array of problems
4711"RTN","C0SPROB2",253,0)
4712 ;
4713"RTN","C0SPROB2",254,0)
4714 I $O(C0SARY("problem",""))="" D Q ;
4715"RTN","C0SPROB2",255,0)
4716 . I $D(DEBUG) W !,"No Problems"
4717"RTN","C0SPROB2",256,0)
4718 S GRTN="" ; default to no problems
4719"RTN","C0SPROB2",257,0)
4720 N C0SGRF
4721"RTN","C0SPROB2",258,0)
4722 S C0SGRF="vistaSmart:"_ZPATID_"/problems"
4723"RTN","C0SPROB2",259,0)
4724 I $D(DEBUG) W !,"Processing ",C0SGRF
4725"RTN","C0SPROB2",260,0)
4726 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
4727"RTN","C0SPROB2",261,0)
4728 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
4729"RTN","C0SPROB2",262,0)
4730 N FARY S FARY="C0XFARY"
4731"RTN","C0SPROB2",263,0)
4732 D USEFARY^C0XF2N(FARY)
4733"RTN","C0SPROB2",264,0)
4734 D VOCINIT^C0XUTIL
4735"RTN","C0SPROB2",265,0)
4736 ;
4737"RTN","C0SPROB2",266,0)
4738 D STARTADD^C0XF2N ; initialize to create triples
4739"RTN","C0SPROB2",267,0)
4740 ;
4741"RTN","C0SPROB2",268,0)
4742 N ZI S ZI=""
4743"RTN","C0SPROB2",269,0)
4744 F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ;
4745"RTN","C0SPROB2",270,0)
4746 . N LRN,ZR ; ZR is the local array for building the new triples
4747"RTN","C0SPROB2",271,0)
4748 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
4749"RTN","C0SPROB2",272,0)
4750 . ;
4751"RTN","C0SPROB2",273,0)
4752 . N PROBID ; unique Id for this problem
4753"RTN","C0SPROB2",274,0)
4754 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
4755"RTN","C0SPROB2",275,0)
4756 . ;
4757"RTN","C0SPROB2",276,0)
4758 . ; i don't like this because the same problems gets a
4759"RTN","C0SPROB2",277,0)
4760 . ; different ID every time it's reported. Can't trace it back to VistA
4761"RTN","C0SPROB2",278,0)
4762 . ; I'd rather be using id@value ie "id@value")="118"
4763"RTN","C0SPROB2",279,0)
4764 . ;
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 map
4769"RTN","C0SPROB2",282,0)
4770 . N SNOGRF ; graph for SNOMED code
4771"RTN","C0SPROB2",283,0)
4772 . I SNOMED="" D ;
4773"RTN","C0SPROB2",284,0)
4774 . . S SNOMED=ICD ; if not found, return the ICD code
4775"RTN","C0SPROB2",285,0)
4776 . . S SNOGRF="icd9:"_SNOMED
4777"RTN","C0SPROB2",286,0)
4778 . E S SNOGRF="snomed:"_SNOMED
4779"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 ",PROBID
4785"RTN","C0SPROB2",290,0)
4786 . . W !,"problem: ",SNOTIT
4787"RTN","C0SPROB2",291,0)
4788 . . W !,"code: ",SNOMED
4789"RTN","C0SPROB2",292,0)
4790 . ;
4791"RTN","C0SPROB2",293,0)
4792 . ; first do the base result graph
4793"RTN","C0SPROB2",294,0)
4794 . ;
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 problems
4799"RTN","C0SPROB2",297,0)
4800 . ; ie /vista/smart/99912345/problems
4801"RTN","C0SPROB2",298,0)
4802 . ;
4803"RTN","C0SPROB2",299,0)
4804 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
4805"RTN","C0SPROB2",300,0)
4806 . S ZR("sp:problemName")=PROBNAME
4807"RTN","C0SPROB2",301,0)
4808 . ;
4809"RTN","C0SPROB2",302,0)
4810 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
4811"RTN","C0SPROB2",303,0)
4812 . S ZR("sp:startDate")=STARTDT
4813"RTN","C0SPROB2",304,0)
4814 . ;
4815"RTN","C0SPROB2",305,0)
4816 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
4817"RTN","C0SPROB2",306,0)
4818 . K ZR ; clean up
4819"RTN","C0SPROB2",307,0)
4820 . ;
4821"RTN","C0SPROB2",308,0)
4822 . ; create the problemName graph
4823"RTN","C0SPROB2",309,0)
4824 . ;
4825"RTN","C0SPROB2",310,0)
4826 . S ZR("rdf:type")="sp:CodedValue"
4827"RTN","C0SPROB2",311,0)
4828 . ;S ZR("sp:code")="snomed:"_SNOMED
4829"RTN","C0SPROB2",312,0)
4830 . S ZR("sp:code")=SNOGRF
4831"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"RTN","C0SPROB2",315,0)
4836 . K ZR
4837"RTN","C0SPROB2",316,0)
4838 . ;
4839"RTN","C0SPROB2",317,0)
4840 . ; create snomed graph
4841"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")=SNOMED
4851"RTN","C0SPROB2",323,0)
4852 . S ZR("dcterms:title")=SNOTIT
4853"RTN","C0SPROB2",324,0)
4854 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
4855"RTN","C0SPROB2",325,0)
4856 . K ZR
4857"RTN","C0SPROB2",326,0)
4858 . ;
4859"RTN","C0SPROB2",327,0)
4860 D BULKLOAD^C0XF2N(.C0XFDA)
4861"RTN","C0SPROB2",328,0)
4862 S GRTN=C0SGRF
4863"RTN","C0SPROB2",329,0)
4864 Q
4865"RTN","C0SPROB2",330,0)
4866 ;
4867"RTN","C0SPROB2",331,0)
4868SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code
4869"RTN","C0SPROB2",332,0)
4870 ; requires the mapping table installed in the triplestore
4871"RTN","C0SPROB2",333,0)
4872 ;
4873"RTN","C0SPROB2",334,0)
4874 N ZSN,ZARY,ZSUB,ZSUBS
4875"RTN","C0SPROB2",335,0)
4876 I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots
4877"RTN","C0SPROB2",336,0)
4878 D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code
4879"RTN","C0SPROB2",337,0)
4880 S ZSUB=$O(ZSUBS("")) ; pick the first one
4881"RTN","C0SPROB2",338,0)
4882 I ZSUB="" Q ""
4883"RTN","C0SPROB2",339,0)
4884 D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode")
4885"RTN","C0SPROB2",340,0)
4886 S ZSN=$O(ZARY(""))
4887"RTN","C0SPROB2",341,0)
4888 I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label")
4889"RTN","C0SPROB2",342,0)
4890 Q ZSN
4891"RTN","C0SPROB2",343,0)
4892 ;
4893"RTN","C0STBL")
48940^11^B2535026
4895"RTN","C0STBL",1,0)
4896C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05
4897"RTN","C0STBL",2,0)
4898 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
4899"RTN","C0STBL",3,0)
4900 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
4901"RTN","C0STBL",4,0)
4902 ;General Public License See attached copy of the License.
4903"RTN","C0STBL",5,0)
4904 ;
4905"RTN","C0STBL",6,0)
4906 ;This program is free software; you can redistribute it and/or modify
4907"RTN","C0STBL",7,0)
4908 ;it under the terms of the GNU General Public License as published by
4909"RTN","C0STBL",8,0)
4910 ;the Free Software Foundation; either version 2 of the License, or
4911"RTN","C0STBL",9,0)
4912 ;(at your option) any later version.
4913"RTN","C0STBL",10,0)
4914 ;
4915"RTN","C0STBL",11,0)
4916 ;This program is distributed in the hope that it will be useful,
4917"RTN","C0STBL",12,0)
4918 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
4919"RTN","C0STBL",13,0)
4920 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4921"RTN","C0STBL",14,0)
4922 ;GNU General Public License for more details.
4923"RTN","C0STBL",15,0)
4924 ;
4925"RTN","C0STBL",16,0)
4926 ;You should have received a copy of the GNU General Public License along
4927"RTN","C0STBL",17,0)
4928 ;with this program; if not, write to the Free Software Foundation, Inc.,
4929"RTN","C0STBL",18,0)
4930 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
4931"RTN","C0STBL",19,0)
4932 ;
4933"RTN","C0STBL",20,0)
4934 Q
4935"RTN","C0STBL",21,0)
4936EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN
4937"RTN","C0STBL",22,0)
4938 I '$D(BEGDFN) S BDGDFN=""
4939"RTN","C0STBL",23,0)
4940 I '$D(DFNCNT) S DFNCNT=150
4941"RTN","C0STBL",24,0)
4942 I '$D(ZPART) S ZPART=""
4943"RTN","C0STBL",25,0)
4944 N ZTBL S ZTBL=$NA(^TMP("C0STBL"))
4945"RTN","C0STBL",26,0)
4946 N ZI,ZCNT,ZG
4947"RTN","C0STBL",27,0)
4948 S ZI=BEGDFN
4949"RTN","C0STBL",28,0)
4950 S ZCNT=0
4951"RTN","C0STBL",29,0)
4952 F S ZI=$O(^DPT(ZI)) Q:(+ZI=0)!(ZCNT>DFNCNT) D ;
4953"RTN","C0STBL",30,0)
4954 . S ZCNT=ZCNT+1
4955"RTN","C0STBL",31,0)
4956 . W ZI," "
4957"RTN","C0STBL",32,0)
4958 . K ZG
4959"RTN","C0STBL",33,0)
4960 . D EN^C0SNHIN(.ZG,ZI,ZPART)
4961"RTN","C0STBL",34,0)
4962 . M @ZTBL@(ZI)=ZG
4963"RTN","C0STBL",35,0)
4964 . K G
4965"RTN","C0STBL",36,0)
4966 . ;D EN^C0SMART(.G,ZI,"med")
4967"RTN","C0STBL",37,0)
4968 . ;I $D(G) W !,$$output^C0XGET1("G")
4969"RTN","C0STBL",38,0)
4970 . ;k G
4971"RTN","C0STBL",39,0)
4972 . ;D EN^C0SMART(.G,ZI,"patient")
4973"RTN","C0STBL",40,0)
4974 . ;I $D(G) W !,$$output^C0XGET1("G")
4975"RTN","C0STBL",41,0)
4976 . ;K G
4977"RTN","C0STBL",42,0)
4978 . ;D EN^C0SMART(.G,ZI,"lab")
4979"RTN","C0STBL",43,0)
4980 . ;I $D(G) W !,$$output^C0XGET1("G")
4981"RTN","C0STBL",44,0)
4982 . ;K G
4983"RTN","C0STBL",45,0)
4984 . D EN^C0SMART(.G,ZI,"problem")
4985"RTN","C0STBL",46,0)
4986 . ;I $D(G) W !,$$output^C0XGET1("G")
4987"RTN","C0STBL",47,0)
4988 Q
4989"RTN","C0STBL",48,0)
4990 ;
4991"RTN","C0STBL",49,0)
4992LOADHACK ;
4993"RTN","C0STBL",50,0)
4994 N ZI
4995"RTN","C0STBL",51,0)
4996 F ZI=2:1:374 D ;
4997"RTN","C0STBL",52,0)
4998 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/")
4999"RTN","C0STBL",53,0)
5000 Q
5001"RTN","C0STBL",54,0)
5002 ;
5003"RTN","C0SUTIL")
50040^12^B1005502
5005"RTN","C0SUTIL",1,0)
5006C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05
5007"RTN","C0SUTIL",2,0)
5008 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
5009"RTN","C0SUTIL",3,0)
5010 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU
5011"RTN","C0SUTIL",4,0)
5012 ;General Public License See attached copy of the License.
5013"RTN","C0SUTIL",5,0)
5014 ;
5015"RTN","C0SUTIL",6,0)
5016 ;This program is free software; you can redistribute it and/or modify
5017"RTN","C0SUTIL",7,0)
5018 ;it under the terms of the GNU General Public License as published by
5019"RTN","C0SUTIL",8,0)
5020 ;the Free Software Foundation; either version 2 of the License, or
5021"RTN","C0SUTIL",9,0)
5022 ;(at your option) any later version.
5023"RTN","C0SUTIL",10,0)
5024 ;
5025"RTN","C0SUTIL",11,0)
5026 ;This program is distributed in the hope that it will be useful,
5027"RTN","C0SUTIL",12,0)
5028 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
5029"RTN","C0SUTIL",13,0)
5030 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5031"RTN","C0SUTIL",14,0)
5032 ;GNU General Public License for more details.
5033"RTN","C0SUTIL",15,0)
5034 ;
5035"RTN","C0SUTIL",16,0)
5036 ;You should have received a copy of the GNU General Public License along
5037"RTN","C0SUTIL",17,0)
5038 ;with this program; if not, write to the Free Software Foundation, Inc.,
5039"RTN","C0SUTIL",18,0)
5040 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
5041"RTN","C0SUTIL",19,0)
5042 ;
5043"RTN","C0SUTIL",20,0)
5044 Q
5045"RTN","C0SUTIL",21,0)
5046 ;
5047"RTN","C0SUTIL",22,0)
5048SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd
5049"RTN","C0SUTIL",23,0)
5050 ; ZDATE is a fileman format date
5051"RTN","C0SUTIL",24,0)
5052 N TMPDT
5053"RTN","C0SUTIL",25,0)
5054 S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date
5055"RTN","C0SUTIL",26,0)
5056 S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens
5057"RTN","C0SUTIL",27,0)
5058 I TMPDT="" S TMPDT="UNKNOWN"
5059"RTN","C0SUTIL",28,0)
5060 N Z2,Z3
5061"RTN","C0SUTIL",29,0)
5062 S Z2=$P(TMPDT,"-",2)
5063"RTN","C0SUTIL",30,0)
5064 S Z3=$P(TMPDT,"-",3)
5065"RTN","C0SUTIL",31,0)
5066 I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2
5067"RTN","C0SUTIL",32,0)
5068 I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3
5069"RTN","C0SUTIL",33,0)
5070 Q TMPDT
5071"RTN","C0SUTIL",34,0)
5072 ;
5073"RTN","C0SXPATH")
50740^13^B521283143
5075"RTN","C0SXPATH",1,0)
5076C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am
5077"RTN","C0SXPATH",2,0)
5078 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4
5079"RTN","C0SXPATH",3,0)
5080 ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU
5081"RTN","C0SXPATH",4,0)
5082 ;General Public License See attached copy of the License.
5083"RTN","C0SXPATH",5,0)
5084 ;
5085"RTN","C0SXPATH",6,0)
5086 ;This program is free software; you can redistribute it and/or modify
5087"RTN","C0SXPATH",7,0)
5088 ;it under the terms of the GNU General Public License as published by
5089"RTN","C0SXPATH",8,0)
5090 ;the Free Software Foundation; either version 2 of the License, or
5091"RTN","C0SXPATH",9,0)
5092 ;(at your option) any later version.
5093"RTN","C0SXPATH",10,0)
5094 ;
5095"RTN","C0SXPATH",11,0)
5096 ;This program is distributed in the hope that it will be useful,
5097"RTN","C0SXPATH",12,0)
5098 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
5099"RTN","C0SXPATH",13,0)
5100 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5101"RTN","C0SXPATH",14,0)
5102 ;GNU General Public License for more details.
5103"RTN","C0SXPATH",15,0)
5104 ;
5105"RTN","C0SXPATH",16,0)
5106 ;You should have received a copy of the GNU General Public License along
5107"RTN","C0SXPATH",17,0)
5108 ;with this program; if not, write to the Free Software Foundation, Inc.,
5109"RTN","C0SXPATH",18,0)
5110 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
5111"RTN","C0SXPATH",19,0)
5112 ;
5113"RTN","C0SXPATH",20,0)
5114 W "This is an XML XPATH utility library",!
5115"RTN","C0SXPATH",21,0)
5116 W !
5117"RTN","C0SXPATH",22,0)
5118 Q
5119"RTN","C0SXPATH",23,0)
5120 ;
5121"RTN","C0SXPATH",24,0)
5122OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
5123"RTN","C0SXPATH",25,0)
5124 ;
5125"RTN","C0SXPATH",26,0)
5126 N Y
5127"RTN","C0SXPATH",27,0)
5128 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
5129"RTN","C0SXPATH",28,0)
5130 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
5131"RTN","C0SXPATH",29,0)
5132 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
5133"RTN","C0SXPATH",30,0)
5134 Q
5135"RTN","C0SXPATH",31,0)
5136 ;
5137"RTN","C0SXPATH",32,0)
5138PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
5139"RTN","C0SXPATH",33,0)
5140 ; VAL IS A STRING AND STK IS PASSED BY NAME
5141"RTN","C0SXPATH",34,0)
5142 ;
5143"RTN","C0SXPATH",35,0)
5144 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
5145"RTN","C0SXPATH",36,0)
5146 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
5147"RTN","C0SXPATH",37,0)
5148 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
5149"RTN","C0SXPATH",38,0)
5150 Q
5151"RTN","C0SXPATH",39,0)
5152 ;
5153"RTN","C0SXPATH",40,0)
5154POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
5155"RTN","C0SXPATH",41,0)
5156 ; VAL AND STK ARE PASSED BY REFERENCE
5157"RTN","C0SXPATH",42,0)
5158 ;
5159"RTN","C0SXPATH",43,0)
5160 I @STK@(0)<1 D ; IF ARRAY IS EMPTY
5161"RTN","C0SXPATH",44,0)
5162 . S VAL=""
5163"RTN","C0SXPATH",45,0)
5164 . S @STK@(0)=0
5165"RTN","C0SXPATH",46,0)
5166 I @STK@(0)>0 D ;
5167"RTN","C0SXPATH",47,0)
5168 . S VAL=@STK@(@STK@(0))
5169"RTN","C0SXPATH",48,0)
5170 . K @STK@(@STK@(0))
5171"RTN","C0SXPATH",49,0)
5172 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
5173"RTN","C0SXPATH",50,0)
5174 Q
5175"RTN","C0SXPATH",51,0)
5176 ;
5177"RTN","C0SXPATH",52,0)
5178PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
5179"RTN","C0SXPATH",53,0)
5180 ;
5181"RTN","C0SXPATH",54,0)
5182 N ZGI
5183"RTN","C0SXPATH",55,0)
5184 F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY
5185"RTN","C0SXPATH",56,0)
5186 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
5187"RTN","C0SXPATH",57,0)
5188 Q
5189"RTN","C0SXPATH",58,0)
5190 ;
5191"RTN","C0SXPATH",59,0)
5192MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
5193"RTN","C0SXPATH",60,0)
5194 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
5195"RTN","C0SXPATH",61,0)
5196 ; REDUX IS A STRING TO REMOVE FROM THE RESULT
5197"RTN","C0SXPATH",62,0)
5198 S RTN=""
5199"RTN","C0SXPATH",63,0)
5200 N I
5201"RTN","C0SXPATH",64,0)
5202 ; W "STK= ",STK,!
5203"RTN","C0SXPATH",65,0)
5204 I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY
5205"RTN","C0SXPATH",66,0)
5206 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
5207"RTN","C0SXPATH",67,0)
5208 . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
5209"RTN","C0SXPATH",68,0)
5210 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
5211"RTN","C0SXPATH",69,0)
5212 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
5213"RTN","C0SXPATH",70,0)
5214 Q
5215"RTN","C0SXPATH",71,0)
5216 ;
5217"RTN","C0SXPATH",72,0)
5218XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
5219"RTN","C0SXPATH",73,0)
5220 ; </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
5221"RTN","C0SXPATH",74,0)
5222 ; ISTR IS PASSED BY VALUE
5223"RTN","C0SXPATH",75,0)
5224 N CUR,TMP
5225"RTN","C0SXPATH",76,0)
5226 I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET
5227"RTN","C0SXPATH",77,0)
5228 . S TMP=$P(ISTR,"<",2)
5229"RTN","C0SXPATH",78,0)
5230 I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
5231"RTN","C0SXPATH",79,0)
5232 . S TMP=$P(TMP,"/",2)
5233"RTN","C0SXPATH",80,0)
5234 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
5235"RTN","C0SXPATH",81,0)
5236 ; W "CUR= ",CUR,!
5237"RTN","C0SXPATH",82,0)
5238 I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST>
5239"RTN","C0SXPATH",83,0)
5240 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
5241"RTN","C0SXPATH",84,0)
5242 ; W "CUR2= ",CUR,!
5243"RTN","C0SXPATH",85,0)
5244 Q CUR
5245"RTN","C0SXPATH",86,0)
5246 ;
5247"RTN","C0SXPATH",87,0)
5248XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
5249"RTN","C0SXPATH",88,0)
5250 ; <NAME>VALUE</NAME> WILL RETURN VALUE
5251"RTN","C0SXPATH",89,0)
5252 N G
5253"RTN","C0SXPATH",90,0)
5254 S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
5255"RTN","C0SXPATH",91,0)
5256 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
5257"RTN","C0SXPATH",92,0)
5258 ;
5259"RTN","C0SXPATH",93,0)
5260VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
5261"RTN","C0SXPATH",94,0)
5262 ; VDX: @INVDX@(XPATH)=VALUE
5263"RTN","C0SXPATH",95,0)
5264 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
5265"RTN","C0SXPATH",96,0)
5266 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
5267"RTN","C0SXPATH",97,0)
5268 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
5269"RTN","C0SXPATH",98,0)
5270 ; @VDV@("XPATH",X1X2X3X4)="XPATH"
5271"RTN","C0SXPATH",99,0)
5272 N ZA,ZI,ZW
5273"RTN","C0SXPATH",100,0)
5274 S ZI=""
5275"RTN","C0SXPATH",101,0)
5276 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
5277"RTN","C0SXPATH",102,0)
5278 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
5279"RTN","C0SXPATH",103,0)
5280 . W ZW,!
5281"RTN","C0SXPATH",104,0)
5282 . S @OUTVDV@(ZW)=@INVDX@(ZI)
5283"RTN","C0SXPATH",105,0)
5284 . S @OUTVDV@("XPATH",ZW)=ZI
5285"RTN","C0SXPATH",106,0)
5286 Q
5287"RTN","C0SXPATH",107,0)
5288 ;
5289"RTN","C0SXPATH",108,0)
5290VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
5291"RTN","C0SXPATH",109,0)
5292 ; VDX: @VDX@(XPATH)=VALUE
5293"RTN","C0SXPATH",110,0)
5294 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
5295"RTN","C0SXPATH",111,0)
5296 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
5297"RTN","C0SXPATH",112,0)
5298 N ZA,ZI,ZW
5299"RTN","C0SXPATH",113,0)
5300 S ZI=""
5301"RTN","C0SXPATH",114,0)
5302 F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ;
5303"RTN","C0SXPATH",115,0)
5304 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
5305"RTN","C0SXPATH",116,0)
5306 . S ZW2=$P(ZW,"/",1)
5307"RTN","C0SXPATH",117,0)
5308 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
5309"RTN","C0SXPATH",118,0)
5310 . ;ZWR ZA
5311"RTN","C0SXPATH",119,0)
5312 . S ZW2=ZA(1)
5313"RTN","C0SXPATH",120,0)
5314 . F ZK=2:1:ZA(0) D ;
5315"RTN","C0SXPATH",121,0)
5316 . . S ZW2=ZW2_""","""_ZA(ZK)
5317"RTN","C0SXPATH",122,0)
5318 . K ZA
5319"RTN","C0SXPATH",123,0)
5320 . S ZW2=""""_ZW2_""""
5321"RTN","C0SXPATH",124,0)
5322 . W ZW2,!
5323"RTN","C0SXPATH",125,0)
5324 . S ZN=OUTXPG_"("_ZW2_")"
5325"RTN","C0SXPATH",126,0)
5326 . S @ZN=@INVDX@(ZI)
5327"RTN","C0SXPATH",127,0)
5328 Q
5329"RTN","C0SXPATH",128,0)
5330 ;
5331"RTN","C0SXPATH",129,0)
5332XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
5333"RTN","C0SXPATH",130,0)
5334 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
5335"RTN","C0SXPATH",131,0)
5336 ;
5337"RTN","C0SXPATH",132,0)
5338 ;N G1
5339"RTN","C0SXPATH",133,0)
5340 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
5341"RTN","C0SXPATH",134,0)
5342 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
5343"RTN","C0SXPATH",135,0)
5344 Q
5345"RTN","C0SXPATH",136,0)
5346 ;
5347"RTN","C0SXPATH",137,0)
5348DO
5349"RTN","C0SXPATH",138,0)
5350 D XPG2XML("^GPL2B","^GPL2A")
5351"RTN","C0SXPATH",139,0)
5352 Q
5353"RTN","C0SXPATH",140,0)
5354 ;
5355"RTN","C0SXPATH",141,0)
5356T1 ; TEST OUT THESE ROUTINES
5357"RTN","C0SXPATH",142,0)
5358 D XML2XPG("G2","^GPL")
5359"RTN","C0SXPATH",143,0)
5360 D XPG2XML("G3","G2")
5361"RTN","C0SXPATH",144,0)
5362 K ^GPLOUT
5363"RTN","C0SXPATH",145,0)
5364 M ^GPLOUT=G3
5365"RTN","C0SXPATH",146,0)
5366 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
5367"RTN","C0SXPATH",147,0)
5368 Q
5369"RTN","C0SXPATH",148,0)
5370 ;
5371"RTN","C0SXPATH",149,0)
5372XPG2XML(OUTXML,INXPG) ;
5373"RTN","C0SXPATH",150,0)
5374 N C0CN,FWD,ZA,G,GA,ZQ
5375"RTN","C0SXPATH",151,0)
5376 S ZQ=0 ; QUIT FLAG
5377"RTN","C0SXPATH",152,0)
5378 F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING
5379"RTN","C0SXPATH",153,0)
5380 . I '$D(C0CN) D ; FIRST TIME THROUGH
5381"RTN","C0SXPATH",154,0)
5382 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
5383"RTN","C0SXPATH",155,0)
5384 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
5385"RTN","C0SXPATH",156,0)
5386 . . S G=$Q(@INXPG) ; THIS ONE
5387"RTN","C0SXPATH",157,0)
5388 . . S GN=$Q(@G) ; NEXT ONE
5389"RTN","C0SXPATH",158,0)
5390 . . S C0CN=1 ; SUBSCRIPT COUNT
5391"RTN","C0SXPATH",159,0)
5392 . . S ZQ=0 ; QUIT FLAG
5393"RTN","C0SXPATH",160,0)
5394 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
5395"RTN","C0SXPATH",161,0)
5396 . . I $QS(G,1)="ContinuityOfCareRecord" D ;
5397"RTN","C0SXPATH",162,0)
5398 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
5399"RTN","C0SXPATH",163,0)
5400 . I FWD D ; GOING FORWARDS
5401"RTN","C0SXPATH",164,0)
5402 . . I C0CN<$QL(G) D ; NOT A DATA NODE
5403"RTN","C0SXPATH",165,0)
5404 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
5405"RTN","C0SXPATH",166,0)
5406 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
5407"RTN","C0SXPATH",167,0)
5408 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D ;
5409"RTN","C0SXPATH",168,0)
5410 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
5411"RTN","C0SXPATH",169,0)
5412 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
5413"RTN","C0SXPATH",170,0)
5414 . . E D ; AT THE DATA NODE
5415"RTN","C0SXPATH",171,0)
5416 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
5417"RTN","C0SXPATH",172,0)
5418 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
5419"RTN","C0SXPATH",173,0)
5420 . . . S FWD=0 ; GO BACKWARDS
5421"RTN","C0SXPATH",174,0)
5422 . I 'FWD D ;GOING BACKWARDS
5423"RTN","C0SXPATH",175,0)
5424 . . S GN=$Q(@G) ;NEXT XPATH
5425"RTN","C0SXPATH",176,0)
5426 . . ;W "NEXT!",GN,!
5427"RTN","C0SXPATH",177,0)
5428 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
5429"RTN","C0SXPATH",178,0)
5430 . . I GN'="" D ;
5431"RTN","C0SXPATH",179,0)
5432 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT
5433"RTN","C0SXPATH",180,0)
5434 . . . . D ZXC($QS(G,C0CN)) ;
5435"RTN","C0SXPATH",181,0)
5436 . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL
5437"RTN","C0SXPATH",182,0)
5438 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
5439"RTN","C0SXPATH",183,0)
5440 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
5441"RTN","C0SXPATH",184,0)
5442 . . . . S FWD=1 ; GOING FORWARD NOW
5443"RTN","C0SXPATH",185,0)
5444 . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE
5445"RTN","C0SXPATH",186,0)
5446 . . D ZXC($QS(G,C0CN)) ; LAST ONE
5447"RTN","C0SXPATH",187,0)
5448 . . S ZQ=1 ; QUIT NOW
5449"RTN","C0SXPATH",188,0)
5450 Q
5451"RTN","C0SXPATH",189,0)
5452 ;
5453"RTN","C0SXPATH",190,0)
5454ZXO(WHAT)
5455"RTN","C0SXPATH",191,0)
5456 D PUSH("GA",WHAT)
5457"RTN","C0SXPATH",192,0)
5458 D PUSH(OUTXML,"<"_WHAT_">")
5459"RTN","C0SXPATH",193,0)
5460 Q
5461"RTN","C0SXPATH",194,0)
5462 ;
5463"RTN","C0SXPATH",195,0)
5464ZXC(WHAT)
5465"RTN","C0SXPATH",196,0)
5466 D POP("GA",.TMP)
5467"RTN","C0SXPATH",197,0)
5468 D PUSH(OUTXML,"</"_WHAT_">")
5469"RTN","C0SXPATH",198,0)
5470 Q
5471"RTN","C0SXPATH",199,0)
5472 ;
5473"RTN","C0SXPATH",200,0)
5474ZXVAL(WHAT,VAL)
5475"RTN","C0SXPATH",201,0)
5476 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
5477"RTN","C0SXPATH",202,0)
5478 Q
5479"RTN","C0SXPATH",203,0)
5480 ;
5481"RTN","C0SXPATH",204,0)
5482INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
5483"RTN","C0SXPATH",205,0)
5484 ; an XPATH index; REDUX is a string to be removed from each xpath
5485"RTN","C0SXPATH",206,0)
5486 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
5487"RTN","C0SXPATH",207,0)
5488 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
5489"RTN","C0SXPATH",208,0)
5490 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
5491"RTN","C0SXPATH",209,0)
5492 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
5493"RTN","C0SXPATH",210,0)
5494 ; @VDX@("XPATH")=VALUE
5495"RTN","C0SXPATH",211,0)
5496 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
5497"RTN","C0SXPATH",212,0)
5498 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
5499"RTN","C0SXPATH",213,0)
5500 ; XML SECTION
5501"RTN","C0SXPATH",214,0)
5502 ; IZXML IS PASSED BY NAME
5503"RTN","C0SXPATH",215,0)
5504 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
5505"RTN","C0SXPATH",216,0)
5506 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
5507"RTN","C0SXPATH",217,0)
5508 N C0CSTK ; LEAVE OUT FOR DEBUGGING
5509"RTN","C0SXPATH",218,0)
5510 I '$D(REDUX) S REDUX=""
5511"RTN","C0SXPATH",219,0)
5512 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
5513"RTN","C0SXPATH",220,0)
5514 N ZXML
5515"RTN","C0SXPATH",221,0)
5516 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
5517"RTN","C0SXPATH",222,0)
5518 E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
5519"RTN","C0SXPATH",223,0)
5520 I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM
5521"RTN","C0SXPATH",224,0)
5522 . S I="",LCNT=0
5523"RTN","C0SXPATH",225,0)
5524 . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1
5525"RTN","C0SXPATH",226,0)
5526 E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
5527"RTN","C0SXPATH",227,0)
5528 I LCNT=0 D Q ; NO XML PASSED
5529"RTN","C0SXPATH",228,0)
5530 . W "ERROR IN XML FILE",!
5531"RTN","C0SXPATH",229,0)
5532 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
5533"RTN","C0SXPATH",230,0)
5534 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
5535"RTN","C0SXPATH",231,0)
5536 S C0CSTK(0)=0 ; INITIALIZE STACK
5537"RTN","C0SXPATH",232,0)
5538 K LKASD ; KILL LOOKASIDE ARRAY
5539"RTN","C0SXPATH",233,0)
5540 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
5541"RTN","C0SXPATH",234,0)
5542 F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
5543"RTN","C0SXPATH",235,0)
5544 . S LINE=@IZXML@(I)
5545"RTN","C0SXPATH",236,0)
5546 . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED
5547"RTN","C0SXPATH",237,0)
5548 . . S @TEMPLATE@(I)=$$CLEAN(LINE)
5549"RTN","C0SXPATH",238,0)
5550 . ;W LINE,!
5551"RTN","C0SXPATH",239,0)
5552 . S FOUND=0 ; INTIALIZED FOUND FLAG
5553"RTN","C0SXPATH",240,0)
5554 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
5555"RTN","C0SXPATH",241,0)
5556 . I FOUND'=1 D
5557"RTN","C0SXPATH",242,0)
5558 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E) D
5559"RTN","C0SXPATH",243,0)
5560 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
5561"RTN","C0SXPATH",244,0)
5562 . . . ; ON THE SAME LINE
5563"RTN","C0SXPATH",245,0)
5564 . . . ; W "FOUND ",LINE,!
5565"RTN","C0SXPATH",246,0)
5566 . . . S FOUND=1 ; SET FOUND FLAG
5567"RTN","C0SXPATH",247,0)
5568 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
5569"RTN","C0SXPATH",248,0)
5570 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
5571"RTN","C0SXPATH",249,0)
5572 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
5573"RTN","C0SXPATH",250,0)
5574 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
5575"RTN","C0SXPATH",251,0)
5576 . . . ; W "MDX=",MDX,!
5577"RTN","C0SXPATH",252,0)
5578 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
5579"RTN","C0SXPATH",253,0)
5580 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
5581"RTN","C0SXPATH",254,0)
5582 . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1
5583"RTN","C0SXPATH",255,0)
5584 . . . . ;W "DUP:",MDX,!
5585"RTN","C0SXPATH",256,0)
5586 . . . . ;I '$D(CURVAL) S CURVAL=""
5587"RTN","C0SXPATH",257,0)
5588 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
5589"RTN","C0SXPATH",258,0)
5590 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
5591"RTN","C0SXPATH",259,0)
5592 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
5593"RTN","C0SXPATH",260,0)
5594 . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST
5595"RTN","C0SXPATH",261,0)
5596 . . . . S CURVAL=$$XVAL(LINE) ; VALUE
5597"RTN","C0SXPATH",262,0)
5598 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
5599"RTN","C0SXPATH",263,0)
5600 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
5601"RTN","C0SXPATH",264,0)
5602 . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED
5603"RTN","C0SXPATH",265,0)
5604 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
5605"RTN","C0SXPATH",266,0)
5606 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
5607"RTN","C0SXPATH",267,0)
5608 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
5609"RTN","C0SXPATH",268,0)
5610 . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END
5611"RTN","C0SXPATH",269,0)
5612 . . I LINE?.E1"</"1.E D ; LINE CONTAINS END OF A SECTION
5613"RTN","C0SXPATH",270,0)
5614 . . . ; W "FOUND ",LINE,!
5615"RTN","C0SXPATH",271,0)
5616 . . . S FOUND=1 ; SET FOUND FLAG
5617"RTN","C0SXPATH",272,0)
5618 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
5619"RTN","C0SXPATH",273,0)
5620 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
5621"RTN","C0SXPATH",274,0)
5622 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
5623"RTN","C0SXPATH",275,0)
5624 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
5625"RTN","C0SXPATH",276,0)
5626 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
5627"RTN","C0SXPATH",277,0)
5628 . . . I TMP'=CUR D ; MALFORMED XML, END MUST MATCH START
5629"RTN","C0SXPATH",278,0)
5630 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
5631"RTN","C0SXPATH",279,0)
5632 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
5633"RTN","C0SXPATH",280,0)
5634 . . . . Q
5635"RTN","C0SXPATH",281,0)
5636 . I FOUND'=1 D ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
5637"RTN","C0SXPATH",282,0)
5638 . . I (LINE?.E1"<"1.E)&(LINE'["?>") D ; BEGINNING OF A SECTION
5639"RTN","C0SXPATH",283,0)
5640 . . . ; W "FOUND ",LINE,!
5641"RTN","C0SXPATH",284,0)
5642 . . . S FOUND=1 ; SET FOUND FLAG
5643"RTN","C0SXPATH",285,0)
5644 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
5645"RTN","C0SXPATH",286,0)
5646 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
5647"RTN","C0SXPATH",287,0)
5648 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
5649"RTN","C0SXPATH",288,0)
5650 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
5651"RTN","C0SXPATH",289,0)
5652 . . . ; W "MDX=",MDX,!
5653"RTN","C0SXPATH",290,0)
5654 . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE
5655"RTN","C0SXPATH",291,0)
5656 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
5657"RTN","C0SXPATH",292,0)
5658 . . . . ;B
5659"RTN","C0SXPATH",293,0)
5660 . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE
5661"RTN","C0SXPATH",294,0)
5662 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
5663"RTN","C0SXPATH",295,0)
5664 S @ZXML@("INDEXED")=""
5665"RTN","C0SXPATH",296,0)
5666 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
5667"RTN","C0SXPATH",297,0)
5668 I NOINX K @ZXML ; DELETE UNWANTED INDEX
5669"RTN","C0SXPATH",298,0)
5670 Q
5671"RTN","C0SXPATH",299,0)
5672 ;
5673"RTN","C0SXPATH",300,0)
5674MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
5675"RTN","C0SXPATH",301,0)
5676 ;
5677"RTN","C0SXPATH",302,0)
5678 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
5679"RTN","C0SXPATH",303,0)
5680 F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY
5681"RTN","C0SXPATH",304,0)
5682 . S ZLINE=@IZXML@(ZI)
5683"RTN","C0SXPATH",305,0)
5684 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
5685"RTN","C0SXPATH",306,0)
5686 . I ZLINE?.E1"</"1.E D ; NEXT LINE CONTAINS END OF A SECTION
5687"RTN","C0SXPATH",307,0)
5688 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
5689"RTN","C0SXPATH",308,0)
5690 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>") D ; BEGINNING OF A SECTION
5691"RTN","C0SXPATH",309,0)
5692 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME
5693"RTN","C0SXPATH",310,0)
5694 . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE
5695"RTN","C0SXPATH",311,0)
5696 . . . . S OUTBUF(CUR,ZI+1)=""
5697"RTN","C0SXPATH",312,0)
5698 ;ZWR OUTBUF
5699"RTN","C0SXPATH",313,0)
5700 S ZI=""
5701"RTN","C0SXPATH",314,0)
5702 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE
5703"RTN","C0SXPATH",315,0)
5704 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
5705"RTN","C0SXPATH",316,0)
5706 . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ;
5707"RTN","C0SXPATH",317,0)
5708 . S OUTBUF(ZI,ZN)=""
5709"RTN","C0SXPATH",318,0)
5710 S ZA=1,ZI="",ZN=""
5711"RTN","C0SXPATH",319,0)
5712 F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x]
5713"RTN","C0SXPATH",320,0)
5714 . S ZN="",ZA=1
5715"RTN","C0SXPATH",321,0)
5716 . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ;
5717"RTN","C0SXPATH",322,0)
5718 . . S OUTBUF(ZI,ZN)="["_ZA_"]"
5719"RTN","C0SXPATH",323,0)
5720 . . S ZA=ZA+1
5721"RTN","C0SXPATH",324,0)
5722 Q
5723"RTN","C0SXPATH",325,0)
5724 ;
5725"RTN","C0SXPATH",326,0)
5726CLEAN(STR,TR) ; extrinsic function; returns string
5727"RTN","C0SXPATH",327,0)
5728 ;; Removes all non printable characters from a string.
5729"RTN","C0SXPATH",328,0)
5730 ;; STR by Value
5731"RTN","C0SXPATH",329,0)
5732 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
5733"RTN","C0SXPATH",330,0)
5734 N TR,I
5735"RTN","C0SXPATH",331,0)
5736 I '$D(TR) D ;
5737"RTN","C0SXPATH",332,0)
5738 . F I=0:1:31 S TR=$G(TR)_$C(I)
5739"RTN","C0SXPATH",333,0)
5740 . S TR=TR_$C(127)
5741"RTN","C0SXPATH",334,0)
5742 QUIT $TR(STR,TR)
5743"RTN","C0SXPATH",335,0)
5744 ;
5745"RTN","C0SXPATH",336,0)
5746QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
5747"RTN","C0SXPATH",337,0)
5748 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
5749"RTN","C0SXPATH",338,0)
5750 ; IARY AND OARY ARE PASSED BY NAME
5751"RTN","C0SXPATH",339,0)
5752 I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY
5753"RTN","C0SXPATH",340,0)
5754 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
5755"RTN","C0SXPATH",341,0)
5756 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
5757"RTN","C0SXPATH",342,0)
5758 N TMP,I,J,QXPATH
5759"RTN","C0SXPATH",343,0)
5760 S FIRST=1
5761"RTN","C0SXPATH",344,0)
5762 I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE
5763"RTN","C0SXPATH",345,0)
5764 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
5765"RTN","C0SXPATH",346,0)
5766 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
5767"RTN","C0SXPATH",347,0)
5768 I XPATH'="//" D ; NOT A ROOT QUERY
5769"RTN","C0SXPATH",348,0)
5770 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
5771"RTN","C0SXPATH",349,0)
5772 . S FIRST=$P(TMP,"^",1)
5773"RTN","C0SXPATH",350,0)
5774 . S LAST=$P(TMP,"^",2)
5775"RTN","C0SXPATH",351,0)
5776 K @OARY
5777"RTN","C0SXPATH",352,0)
5778 S @OARY@(0)=+LAST-FIRST+1
5779"RTN","C0SXPATH",353,0)
5780 S J=1
5781"RTN","C0SXPATH",354,0)
5782 FOR I=FIRST:1:LAST D
5783"RTN","C0SXPATH",355,0)
5784 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
5785"RTN","C0SXPATH",356,0)
5786 . S J=J+1
5787"RTN","C0SXPATH",357,0)
5788 ; ZWR OARY
5789"RTN","C0SXPATH",358,0)
5790 Q
5791"RTN","C0SXPATH",359,0)
5792 ;
5793"RTN","C0SXPATH",360,0)
5794XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
5795"RTN","C0SXPATH",361,0)
5796 ; INDEX WITH TWO PIECES START^FINISH
5797"RTN","C0SXPATH",362,0)
5798 ; IDX IS PASSED BY NAME
5799"RTN","C0SXPATH",363,0)
5800 Q $P(@IDX@(XPATH),"^",1)
5801"RTN","C0SXPATH",364,0)
5802 ;
5803"RTN","C0SXPATH",365,0)
5804XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
5805"RTN","C0SXPATH",366,0)
5806 ; INDEX WITH TWO PIECES START^FINISH
5807"RTN","C0SXPATH",367,0)
5808 ; IDX IS PASSED BY NAME
5809"RTN","C0SXPATH",368,0)
5810 Q $P(@IDX@(XPATH),"^",2)
5811"RTN","C0SXPATH",369,0)
5812 ;
5813"RTN","C0SXPATH",370,0)
5814START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
5815"RTN","C0SXPATH",371,0)
5816 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
5817"RTN","C0SXPATH",372,0)
5818 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
5819"RTN","C0SXPATH",373,0)
5820 Q $P(ISTR,";",2)
5821"RTN","C0SXPATH",374,0)
5822 ;
5823"RTN","C0SXPATH",375,0)
5824FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
5825"RTN","C0SXPATH",376,0)
5826 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
5827"RTN","C0SXPATH",377,0)
5828 Q $P(ISTR,";",3)
5829"RTN","C0SXPATH",378,0)
5830 ;
5831"RTN","C0SXPATH",379,0)
5832ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
5833"RTN","C0SXPATH",380,0)
5834 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
5835"RTN","C0SXPATH",381,0)
5836 Q $P(ISTR,";",1)
5837"RTN","C0SXPATH",382,0)
5838 ;
5839"RTN","C0SXPATH",383,0)
5840BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
5841"RTN","C0SXPATH",384,0)
5842 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
5843"RTN","C0SXPATH",385,0)
5844 ; DEST IS CLEARED TO START
5845"RTN","C0SXPATH",386,0)
5846 ; USES PUSH TO DO THE COPY
5847"RTN","C0SXPATH",387,0)
5848 N I
5849"RTN","C0SXPATH",388,0)
5850 K @BDEST
5851"RTN","C0SXPATH",389,0)
5852 F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST
5853"RTN","C0SXPATH",390,0)
5854 . N J,ATMP
5855"RTN","C0SXPATH",391,0)
5856 . S ATMP=$$ARRAY(@BLIST@(I))
5857"RTN","C0SXPATH",392,0)
5858 . I $G(DEBUG) W "ATMP=",ATMP,!
5859"RTN","C0SXPATH",393,0)
5860 . I $G(DEBUG) W @BLIST@(I),!
5861"RTN","C0SXPATH",394,0)
5862 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ;
5863"RTN","C0SXPATH",395,0)
5864 . . ; FOR EACH LINE IN THIS INSTR
5865"RTN","C0SXPATH",396,0)
5866 . . I $G(DEBUG) W "BDEST= ",BDEST,!
5867"RTN","C0SXPATH",397,0)
5868 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
5869"RTN","C0SXPATH",398,0)
5870 . . D PUSH(BDEST,@ATMP@(J))
5871"RTN","C0SXPATH",399,0)
5872 Q
5873"RTN","C0SXPATH",400,0)
5874 ;
5875"RTN","C0SXPATH",401,0)
5876QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
5877"RTN","C0SXPATH",402,0)
5878 ;
5879"RTN","C0SXPATH",403,0)
5880 I $G(DEBUG) W "QUEUEING ",BLST,!
5881"RTN","C0SXPATH",404,0)
5882 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
5883"RTN","C0SXPATH",405,0)
5884 Q
5885"RTN","C0SXPATH",406,0)
5886 ;
5887"RTN","C0SXPATH",407,0)
5888CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
5889"RTN","C0SXPATH",408,0)
5890 ; KILLS CPDEST FIRST
5891"RTN","C0SXPATH",409,0)
5892 N CPINSTR
5893"RTN","C0SXPATH",410,0)
5894 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
5895"RTN","C0SXPATH",411,0)
5896 I @CPSRC@(0)<1 D ; BAD LENGTH
5897"RTN","C0SXPATH",412,0)
5898 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
5899"RTN","C0SXPATH",413,0)
5900 . Q
5901"RTN","C0SXPATH",414,0)
5902 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
5903"RTN","C0SXPATH",415,0)
5904 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
5905"RTN","C0SXPATH",416,0)
5906 D BUILD("CPINSTR",CPDEST)
5907"RTN","C0SXPATH",417,0)
5908 Q
5909"RTN","C0SXPATH",418,0)
5910 ;
5911"RTN","C0SXPATH",419,0)
5912QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
5913"RTN","C0SXPATH",420,0)
5914 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
5915"RTN","C0SXPATH",421,0)
5916 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
5917"RTN","C0SXPATH",422,0)
5918 ; USED TO INSERT CHILDREN NODES
5919"RTN","C0SXPATH",423,0)
5920 I @QOXML@(0)<1 D ; MALFORMED XML
5921"RTN","C0SXPATH",424,0)
5922 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
5923"RTN","C0SXPATH",425,0)
5924 . Q
5925"RTN","C0SXPATH",426,0)
5926 I $G(DEBUG) W "DOING QOPEN",!
5927"RTN","C0SXPATH",427,0)
5928 N S1,E1,QOT,QOTMP
5929"RTN","C0SXPATH",428,0)
5930 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
5931"RTN","C0SXPATH",429,0)
5932 I $D(QOXPATH) D ; XPATH PROVIDED
5933"RTN","C0SXPATH",430,0)
5934 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
5935"RTN","C0SXPATH",431,0)
5936 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
5937"RTN","C0SXPATH",432,0)
5938 I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
5939"RTN","C0SXPATH",433,0)
5940 . S E1=@QOXML@(0)-1
5941"RTN","C0SXPATH",434,0)
5942 D QUEUE(QOBLIST,QOXML,S1,E1)
5943"RTN","C0SXPATH",435,0)
5944 ; S QOTMP=QOXML_"^"_S1_"^"_E1
5945"RTN","C0SXPATH",436,0)
5946 ; D PUSH(QOBLIST,QOTMP)
5947"RTN","C0SXPATH",437,0)
5948 Q
5949"RTN","C0SXPATH",438,0)
5950 ;
5951"RTN","C0SXPATH",439,0)
5952QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
5953"RTN","C0SXPATH",440,0)
5954 ; ADDS THE LIST LINE OF QCXML TO QCBLIST
5955"RTN","C0SXPATH",441,0)
5956 ; USED TO FINISH INSERTING CHILDERN NODES
5957"RTN","C0SXPATH",442,0)
5958 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
5959"RTN","C0SXPATH",443,0)
5960 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
5961"RTN","C0SXPATH",444,0)
5962 I @QCXML@(0)<1 D ; MALFORMED XML
5963"RTN","C0SXPATH",445,0)
5964 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
5965"RTN","C0SXPATH",446,0)
5966 I $G(DEBUG) W "GOING TO CLOSE",!
5967"RTN","C0SXPATH",447,0)
5968 N S1,E1,QCT,QCTMP
5969"RTN","C0SXPATH",448,0)
5970 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
5971"RTN","C0SXPATH",449,0)
5972 I $D(QCXPATH) D ; XPATH PROVIDED
5973"RTN","C0SXPATH",450,0)
5974 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
5975"RTN","C0SXPATH",451,0)
5976 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
5977"RTN","C0SXPATH",452,0)
5978 I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
5979"RTN","C0SXPATH",453,0)
5980 . S S1=@QCXML@(0)
5981"RTN","C0SXPATH",454,0)
5982 D QUEUE(QCBLIST,QCXML,S1,E1)
5983"RTN","C0SXPATH",455,0)
5984 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
5985"RTN","C0SXPATH",456,0)
5986 Q
5987"RTN","C0SXPATH",457,0)
5988 ;
5989"RTN","C0SXPATH",458,0)
5990INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
5991"RTN","C0SXPATH",459,0)
5992 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
5993"RTN","C0SXPATH",460,0)
5994 ; OMITTED, INSERTION WILL BE AT THE ROOT
5995"RTN","C0SXPATH",461,0)
5996 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
5997"RTN","C0SXPATH",462,0)
5998 ; XML AT THE END OF THE XPATH POINT
5999"RTN","C0SXPATH",463,0)
6000 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
6001"RTN","C0SXPATH",464,0)
6002 N INSBLD,INSTMP
6003"RTN","C0SXPATH",465,0)
6004 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
6005"RTN","C0SXPATH",466,0)
6006 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
6007"RTN","C0SXPATH",467,0)
6008 I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY
6009"RTN","C0SXPATH",468,0)
6010 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
6011"RTN","C0SXPATH",469,0)
6012 I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY
6013"RTN","C0SXPATH",470,0)
6014 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
6015"RTN","C0SXPATH",471,0)
6016 . I $D(INSXPATH) D ; XPATH PROVIDED
6017"RTN","C0SXPATH",472,0)
6018 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
6019"RTN","C0SXPATH",473,0)
6020 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
6021"RTN","C0SXPATH",474,0)
6022 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT
6023"RTN","C0SXPATH",475,0)
6024 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
6025"RTN","C0SXPATH",476,0)
6026 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
6027"RTN","C0SXPATH",477,0)
6028 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
6029"RTN","C0SXPATH",478,0)
6030 . I $D(INSXPATH) D ; XPATH PROVIDED
6031"RTN","C0SXPATH",479,0)
6032 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
6033"RTN","C0SXPATH",480,0)
6034 . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT
6035"RTN","C0SXPATH",481,0)
6036 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
6037"RTN","C0SXPATH",482,0)
6038 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
6039"RTN","C0SXPATH",483,0)
6040 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
6041"RTN","C0SXPATH",484,0)
6042 Q
6043"RTN","C0SXPATH",485,0)
6044 ;
6045"RTN","C0SXPATH",486,0)
6046INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
6047"RTN","C0SXPATH",487,0)
6048 ; INTO INNXML AT THE INNXPATH XPATH POINT
6049"RTN","C0SXPATH",488,0)
6050 ;
6051"RTN","C0SXPATH",489,0)
6052 N INNBLD,UXPATH
6053"RTN","C0SXPATH",490,0)
6054 N INNTBUF
6055"RTN","C0SXPATH",491,0)
6056 S INNTBUF=$NA(^TMP($J,"INNTBUF"))
6057"RTN","C0SXPATH",492,0)
6058 I '$D(INNXPATH) D ; XPATH NOT PASSED
6059"RTN","C0SXPATH",493,0)
6060 . S UXPATH="//" ; USE ROOT XPATH
6061"RTN","C0SXPATH",494,0)
6062 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
6063"RTN","C0SXPATH",495,0)
6064 I '$D(@INNXML@(0)) D ; INNXML IS EMPTY
6065"RTN","C0SXPATH",496,0)
6066 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
6067"RTN","C0SXPATH",497,0)
6068 . D BUILD("INNBLD",INNXML)
6069"RTN","C0SXPATH",498,0)
6070 I @INNXML@(0)>0 D ; NOT EMPTY
6071"RTN","C0SXPATH",499,0)
6072 . D QOPEN("INNBLD",INNXML,UXPATH) ;
6073"RTN","C0SXPATH",500,0)
6074 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
6075"RTN","C0SXPATH",501,0)
6076 . D QCLOSE("INNBLD",INNXML,UXPATH)
6077"RTN","C0SXPATH",502,0)
6078 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
6079"RTN","C0SXPATH",503,0)
6080 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
6081"RTN","C0SXPATH",504,0)
6082 Q
6083"RTN","C0SXPATH",505,0)
6084 ;
6085"RTN","C0SXPATH",506,0)
6086INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
6087"RTN","C0SXPATH",507,0)
6088 ; BUT XDEST AN XNEW ARE PASSED BY NAME
6089"RTN","C0SXPATH",508,0)
6090 N XBLD,XTMP
6091"RTN","C0SXPATH",509,0)
6092 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
6093"RTN","C0SXPATH",510,0)
6094 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
6095"RTN","C0SXPATH",511,0)
6096 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
6097"RTN","C0SXPATH",512,0)
6098 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
6099"RTN","C0SXPATH",513,0)
6100 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
6101"RTN","C0SXPATH",514,0)
6102 I $G(DEBUG) D PARY("XDEST")
6103"RTN","C0SXPATH",515,0)
6104 Q
6105"RTN","C0SXPATH",516,0)
6106 ;
6107"RTN","C0SXPATH",517,0)
6108REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
6109"RTN","C0SXPATH",518,0)
6110 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
6111"RTN","C0SXPATH",519,0)
6112 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
6113"RTN","C0SXPATH",520,0)
6114 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
6115"RTN","C0SXPATH",521,0)
6116 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
6117"RTN","C0SXPATH",522,0)
6118 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
6119"RTN","C0SXPATH",523,0)
6120 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
6121"RTN","C0SXPATH",524,0)
6122 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
6123"RTN","C0SXPATH",525,0)
6124 S XFIRST=$P(XNODE,"^",1)
6125"RTN","C0SXPATH",526,0)
6126 S XLAST=$P(XNODE,"^",2)
6127"RTN","C0SXPATH",527,0)
6128 I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
6129"RTN","C0SXPATH",528,0)
6130 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
6131"RTN","C0SXPATH",529,0)
6132 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
6133"RTN","C0SXPATH",530,0)
6134 I RENEW'="" D ; NEW XML IS NOT NULL
6135"RTN","C0SXPATH",531,0)
6136 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
6137"RTN","C0SXPATH",532,0)
6138 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
6139"RTN","C0SXPATH",533,0)
6140 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
6141"RTN","C0SXPATH",534,0)
6142 I $G(DEBUG) W "REPLACE PREBUILD",!
6143"RTN","C0SXPATH",535,0)
6144 I $G(DEBUG) D PARY("REBLD")
6145"RTN","C0SXPATH",536,0)
6146 D BUILD("REBLD","RTMP")
6147"RTN","C0SXPATH",537,0)
6148 K @REXML ; KILL WHAT WAS THERE
6149"RTN","C0SXPATH",538,0)
6150 D CP("RTMP",REXML) ; COPY IN THE RESULT
6151"RTN","C0SXPATH",539,0)
6152 Q
6153"RTN","C0SXPATH",540,0)
6154 ;
6155"RTN","C0SXPATH",541,0)
6156DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT
6157"RTN","C0SXPATH",542,0)
6158 ; REXML IS PASSED BY NAME XPATH IS A VALUE
6159"RTN","C0SXPATH",543,0)
6160 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
6161"RTN","C0SXPATH",544,0)
6162 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
6163"RTN","C0SXPATH",545,0)
6164 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
6165"RTN","C0SXPATH",546,0)
6166 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
6167"RTN","C0SXPATH",547,0)
6168 S XFIRST=$P(XNODE,"^",1)
6169"RTN","C0SXPATH",548,0)
6170 S XLAST=$P(XNODE,"^",2)
6171"RTN","C0SXPATH",549,0)
6172 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
6173"RTN","C0SXPATH",550,0)
6174 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
6175"RTN","C0SXPATH",551,0)
6176 I $G(DEBUG) D PARY("REBLD")
6177"RTN","C0SXPATH",552,0)
6178 D BUILD("REBLD","RTMP")
6179"RTN","C0SXPATH",553,0)
6180 K @REXML ; KILL WHAT WAS THERE
6181"RTN","C0SXPATH",554,0)
6182 D CP("RTMP",REXML) ; COPY IN THE RESULT
6183"RTN","C0SXPATH",555,0)
6184 Q
6185"RTN","C0SXPATH",556,0)
6186 ;
6187"RTN","C0SXPATH",557,0)
6188MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
6189"RTN","C0SXPATH",558,0)
6190 ; W "Reporting on the missing",!
6191"RTN","C0SXPATH",559,0)
6192 ; W OARY
6193"RTN","C0SXPATH",560,0)
6194 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
6195"RTN","C0SXPATH",561,0)
6196 N I
6197"RTN","C0SXPATH",562,0)
6198 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
6199"RTN","C0SXPATH",563,0)
6200 F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY
6201"RTN","C0SXPATH",564,0)
6202 . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE
6203"RTN","C0SXPATH",565,0)
6204 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
6205"RTN","C0SXPATH",566,0)
6206 . . Q
6207"RTN","C0SXPATH",567,0)
6208 Q
6209"RTN","C0SXPATH",568,0)
6210 ;
6211"RTN","C0SXPATH",569,0)
6212MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
6213"RTN","C0SXPATH",570,0)
6214 ; AND PUT THE RESULTS IN OXML
6215"RTN","C0SXPATH",571,0)
6216 N XCNT
6217"RTN","C0SXPATH",572,0)
6218 I '$D(DEBUG) S DEBUG=0
6219"RTN","C0SXPATH",573,0)
6220 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
6221"RTN","C0SXPATH",574,0)
6222 I '$D(@IXML@(0)) D ; INITIALIZE COUNT
6223"RTN","C0SXPATH",575,0)
6224 . S XCNT=$O(@IXML@(""),-1)
6225"RTN","C0SXPATH",576,0)
6226 E S XCNT=@IXML@(0) ;COUNT
6227"RTN","C0SXPATH",577,0)
6228 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
6229"RTN","C0SXPATH",578,0)
6230 N I,J,TNAM,TVAL,TSTR
6231"RTN","C0SXPATH",579,0)
6232 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
6233"RTN","C0SXPATH",580,0)
6234 F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY
6235"RTN","C0SXPATH",581,0)
6236 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
6237"RTN","C0SXPATH",582,0)
6238 . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE?
6239"RTN","C0SXPATH",583,0)
6240 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
6241"RTN","C0SXPATH",584,0)
6242 . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
6243"RTN","C0SXPATH",585,0)
6244 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
6245"RTN","C0SXPATH",586,0)
6246 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
6247"RTN","C0SXPATH",587,0)
6248 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
6249"RTN","C0SXPATH",588,0)
6250 . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP?
6251"RTN","C0SXPATH",589,0)
6252 . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
6253"RTN","C0SXPATH",590,0)
6254 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
6255"RTN","C0SXPATH",591,0)
6256 . . . . E D DOFLD ; PROCESS A FIELD
6257"RTN","C0SXPATH",592,0)
6258 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
6259"RTN","C0SXPATH",593,0)
6260 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
6261"RTN","C0SXPATH",594,0)
6262 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
6263"RTN","C0SXPATH",595,0)
6264 . . I DEBUG W TSTR
6265"RTN","C0SXPATH",596,0)
6266 I DEBUG W "MAPPED",!
6267"RTN","C0SXPATH",597,0)
6268 Q
6269"RTN","C0SXPATH",598,0)
6270 ;
6271"RTN","C0SXPATH",599,0)
6272DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
6273"RTN","C0SXPATH",600,0)
6274 ;
6275"RTN","C0SXPATH",601,0)
6276 Q
6277"RTN","C0SXPATH",602,0)
6278 ;
6279"RTN","C0SXPATH",603,0)
6280TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
6281"RTN","C0SXPATH",604,0)
6282 ; THEXML IS PASSED BY NAME
6283"RTN","C0SXPATH",605,0)
6284 N I,J,TMPXML,DEL,FOUND,INTXT
6285"RTN","C0SXPATH",606,0)
6286 S FOUND=0
6287"RTN","C0SXPATH",607,0)
6288 S INTXT=0
6289"RTN","C0SXPATH",608,0)
6290 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
6291"RTN","C0SXPATH",609,0)
6292 F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY
6293"RTN","C0SXPATH",610,0)
6294 . S J=@THEXML@(I)
6295"RTN","C0SXPATH",611,0)
6296 . I J["<text>" D
6297"RTN","C0SXPATH",612,0)
6298 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
6299"RTN","C0SXPATH",613,0)
6300 . . I $G(DEBUG) W "IN HTML SECTION",!
6301"RTN","C0SXPATH",614,0)
6302 . N JM,JP,JPX ; JMINUS AND JPLUS
6303"RTN","C0SXPATH",615,0)
6304 . S JM=@THEXML@(I-1) ; LINE BEFORE
6305"RTN","C0SXPATH",616,0)
6306 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
6307"RTN","C0SXPATH",617,0)
6308 . S JP=@THEXML@(I+1) ; LINE AFTER
6309"RTN","C0SXPATH",618,0)
6310 . I INTXT=0 D ; IF NOT IN AN HTML SECTION
6311"RTN","C0SXPATH",619,0)
6312 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
6313"RTN","C0SXPATH",620,0)
6314 . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES
6315"RTN","C0SXPATH",621,0)
6316 . . . I $G(DEBUG) W I,J,JP,!
6317"RTN","C0SXPATH",622,0)
6318 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
6319"RTN","C0SXPATH",623,0)
6320 . . . S DEL(I)="" ; SET LINE TO DELETE
6321"RTN","C0SXPATH",624,0)
6322 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
6323"RTN","C0SXPATH",625,0)
6324 . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE
6325"RTN","C0SXPATH",626,0)
6326 . . . I $G(DEBUG) W I,J,!
6327"RTN","C0SXPATH",627,0)
6328 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
6329"RTN","C0SXPATH",628,0)
6330 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
6331"RTN","C0SXPATH",629,0)
6332 . . . I JM=JPX D ;
6333"RTN","C0SXPATH",630,0)
6334 . . . . I $G(DEBUG) W I,JM_J_JPX,!
6335"RTN","C0SXPATH",631,0)
6336 . . . . S DEL(I-1)=""
6337"RTN","C0SXPATH",632,0)
6338 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
6339"RTN","C0SXPATH",633,0)
6340 ; . I J'["><" D PUSH("TMPXML",J)
6341"RTN","C0SXPATH",634,0)
6342 I FOUND D ; NEED TO DELETE THINGS
6343"RTN","C0SXPATH",635,0)
6344 . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES
6345"RTN","C0SXPATH",636,0)
6346 . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED
6347"RTN","C0SXPATH",637,0)
6348 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
6349"RTN","C0SXPATH",638,0)
6350 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
6351"RTN","C0SXPATH",639,0)
6352 Q FOUND
6353"RTN","C0SXPATH",640,0)
6354 ;
6355"RTN","C0SXPATH",641,0)
6356UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
6357"RTN","C0SXPATH",642,0)
6358 ; XSEC IS A SECTION PASSED BY NAME
6359"RTN","C0SXPATH",643,0)
6360 N XBLD,XTMP
6361"RTN","C0SXPATH",644,0)
6362 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
6363"RTN","C0SXPATH",645,0)
6364 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
6365"RTN","C0SXPATH",646,0)
6366 D CP("XTMP",XSEC) ; REPLACE PASSED XML
6367"RTN","C0SXPATH",647,0)
6368 Q
6369"RTN","C0SXPATH",648,0)
6370 ;
6371"RTN","C0SXPATH",649,0)
6372PARY(GLO,ZN) ;PRINT AN ARRAY
6373"RTN","C0SXPATH",650,0)
6374 ; IF ZN=-1 NO LINE NUMBERS
6375"RTN","C0SXPATH",651,0)
6376 N I
6377"RTN","C0SXPATH",652,0)
6378 F I=1:1:@GLO@(0) D ;
6379"RTN","C0SXPATH",653,0)
6380 . I $G(ZN)=-1 W @GLO@(I),!
6381"RTN","C0SXPATH",654,0)
6382 . E W I_" "_@GLO@(I),!
6383"RTN","C0SXPATH",655,0)
6384 Q
6385"RTN","C0SXPATH",656,0)
6386 ;
6387"RTN","C0SXPATH",657,0)
6388H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
6389"RTN","C0SXPATH",658,0)
6390 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
6391"RTN","C0SXPATH",659,0)
6392 I '$D(IPRE) S IPRE=""
6393"RTN","C0SXPATH",660,0)
6394 N H2I S H2I=""
6395"RTN","C0SXPATH",661,0)
6396 ; W $O(@IHASH@(H2I)),!
6397"RTN","C0SXPATH",662,0)
6398 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH
6399"RTN","C0SXPATH",663,0)
6400 . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES
6401"RTN","C0SXPATH",664,0)
6402 . . ;W H2I_"^"_@IHASH@(H2I),!
6403"RTN","C0SXPATH",665,0)
6404 . . N IH,IHI
6405"RTN","C0SXPATH",666,0)
6406 . . S IH=$NA(@IHASH@(H2I)) ;
6407"RTN","C0SXPATH",667,0)
6408 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
6409"RTN","C0SXPATH",668,0)
6410 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
6411"RTN","C0SXPATH",669,0)
6412 . . S IHI="" ; INDEX INTO "M" MULTIPLES
6413"RTN","C0SXPATH",670,0)
6414 . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE
6415"RTN","C0SXPATH",671,0)
6416 . . . ; W @IH@(IHI)
6417"RTN","C0SXPATH",672,0)
6418 . . . S IH3=$NA(@IH2@(IHI))
6419"RTN","C0SXPATH",673,0)
6420 . . . ; W "HEY",IH3,!
6421"RTN","C0SXPATH",674,0)
6422 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
6423"RTN","C0SXPATH",675,0)
6424 . . ; W IH,!
6425"RTN","C0SXPATH",676,0)
6426 . . ; W "C0CZZ",!
6427"RTN","C0SXPATH",677,0)
6428 . . ; W $NA(@IHASH@(H2I)),!
6429"RTN","C0SXPATH",678,0)
6430 . . Q ;
6431"RTN","C0SXPATH",679,0)
6432 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
6433"RTN","C0SXPATH",680,0)
6434 . ; W @IARYRTN@(0),!
6435"RTN","C0SXPATH",681,0)
6436 Q
6437"RTN","C0SXPATH",682,0)
6438 ;
6439"RTN","C0SXPATH",683,0)
6440XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
6441"RTN","C0SXPATH",684,0)
6442 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
6443"RTN","C0SXPATH",685,0)
6444 ; XVRTN AND XVIXML ARE PASSED BY NAME
6445"RTN","C0SXPATH",686,0)
6446 ;
6447"RTN","C0SXPATH",687,0)
6448 N XVI,XVTMP,XVT
6449"RTN","C0SXPATH",688,0)
6450 F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML
6451"RTN","C0SXPATH",689,0)
6452 . S XVT=@XVIXML@(XVI)
6453"RTN","C0SXPATH",690,0)
6454 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
6455"RTN","C0SXPATH",691,0)
6456 D H2ARY(XVRTN,"XVTMP")
6457"RTN","C0SXPATH",692,0)
6458 Q
6459"RTN","C0SXPATH",693,0)
6460 ;
6461"RTN","C0SXPATH",694,0)
6462DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
6463"RTN","C0SXPATH",695,0)
6464 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
6465"RTN","C0SXPATH",696,0)
6466 ;
6467"RTN","C0SXPATH",697,0)
6468 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
6469"RTN","C0SXPATH",698,0)
6470 I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE
6471"RTN","C0SXPATH",699,0)
6472 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
6473"RTN","C0SXPATH",700,0)
6474 . S DXUSE="DTMP" ; DXUSE IS NAME
6475"RTN","C0SXPATH",701,0)
6476 E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE
6477"RTN","C0SXPATH",702,0)
6478 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
6479"RTN","C0SXPATH",703,0)
6480 . S DXUSE="DTMP" ; DXUSE IS NAME
6481"RTN","C0SXPATH",704,0)
6482 E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
6483"RTN","C0SXPATH",705,0)
6484 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
6485"RTN","C0SXPATH",706,0)
6486 D XVARS("DVARS",DXUSE) ; PULL OUT VARS
6487"RTN","C0SXPATH",707,0)
6488 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
6489"RTN","C0SXPATH",708,0)
6490 Q
6491"RTN","C0SXPATH",709,0)
6492 ;
6493"RTN","C0SXPATH",710,0)
6494TEST ; Run all the test cases
6495"RTN","C0SXPATH",711,0)
6496 D TESTALL^C0CUNIT("C0CXPAT0")
6497"RTN","C0SXPATH",712,0)
6498 Q
6499"RTN","C0SXPATH",713,0)
6500 ;
6501"RTN","C0SXPATH",714,0)
6502ZTEST(WHICH) ; RUN ONE SET OF TESTS
6503"RTN","C0SXPATH",715,0)
6504 N ZTMP
6505"RTN","C0SXPATH",716,0)
6506 S DEBUG=1
6507"RTN","C0SXPATH",717,0)
6508 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
6509"RTN","C0SXPATH",718,0)
6510 D ZTEST^C0CUNIT(.ZTMP,WHICH)
6511"RTN","C0SXPATH",719,0)
6512 Q
6513"RTN","C0SXPATH",720,0)
6514 ;
6515"RTN","C0SXPATH",721,0)
6516TLIST ; LIST THE TESTS
6517"RTN","C0SXPATH",722,0)
6518 N ZTMP
6519"RTN","C0SXPATH",723,0)
6520 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
6521"RTN","C0SXPATH",724,0)
6522 D TLIST^C0CUNIT(.ZTMP)
6523"RTN","C0SXPATH",725,0)
6524 Q
6525"RTN","C0SXPATH",726,0)
6526 ;
6527"VER")
65288.0^22.0
6529**END**
6530**END**
Note: See TracBrowser for help on using the repository browser.