source: smart/trunk/kids/C0S_1_0_0_T2.KID@ 1536

Last change on this file since 1536 was 1534, checked in by George Lilly, 12 years ago

fixes for snomed lookup

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