source: smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID@ 1672

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

Updated License on all files

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