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

KIDS Distribution saved on Sep 26, 2012@04:21:57
fixes to snomed lookup
**KIDS**:C0S*1.0*0^

**INSTALL NAME**
C0S*1.0*0
"BLD",7929,0)
C0S*1.0*0^^0^3120926^n
"BLD",7929,4,0)
^9.64PA^^
"BLD",7929,6.3)
2
"BLD",7929,"KRN",0)
^9.67PA^779.2^20
"BLD",7929,"KRN",.4,0)
.4
"BLD",7929,"KRN",.401,0)
.401
"BLD",7929,"KRN",.402,0)
.402
"BLD",7929,"KRN",.403,0)
.403
"BLD",7929,"KRN",.5,0)
.5
"BLD",7929,"KRN",.84,0)
.84
"BLD",7929,"KRN",3.6,0)
3.6
"BLD",7929,"KRN",3.8,0)
3.8
"BLD",7929,"KRN",9.2,0)
9.2
"BLD",7929,"KRN",9.8,0)
9.8
"BLD",7929,"KRN",9.8,"NM",0)
^9.68A^13^13
"BLD",7929,"KRN",9.8,"NM",1,0)
C0SDEM^^0^B59022362
"BLD",7929,"KRN",9.8,"NM",2,0)
C0SDOM^^0^B87367162
"BLD",7929,"KRN",9.8,"NM",3,0)
C0SLAB^^0^B79265150
"BLD",7929,"KRN",9.8,"NM",4,0)
C0SMART^^0^B2907401
"BLD",7929,"KRN",9.8,"NM",5,0)
C0SMED^^0^B40719083
"BLD",7929,"KRN",9.8,"NM",6,0)
C0SMXMLB^^0^B12189644
"BLD",7929,"KRN",9.8,"NM",7,0)
C0SNHIN^^0^B88600644
"BLD",7929,"KRN",9.8,"NM",8,0)
C0SNHINV^^0^B15736572
"BLD",7929,"KRN",9.8,"NM",9,0)
C0SPROB^^0^B49669400
"BLD",7929,"KRN",9.8,"NM",10,0)
C0SPROB2^^0^B67594874
"BLD",7929,"KRN",9.8,"NM",11,0)
C0STBL^^0^B2535026
"BLD",7929,"KRN",9.8,"NM",12,0)
C0SUTIL^^0^B1005502
"BLD",7929,"KRN",9.8,"NM",13,0)
C0SXPATH^^0^B521212541
"BLD",7929,"KRN",9.8,"NM","B","C0SDEM",1)

"BLD",7929,"KRN",9.8,"NM","B","C0SDOM",2)

"BLD",7929,"KRN",9.8,"NM","B","C0SLAB",3)

"BLD",7929,"KRN",9.8,"NM","B","C0SMART",4)

"BLD",7929,"KRN",9.8,"NM","B","C0SMED",5)

"BLD",7929,"KRN",9.8,"NM","B","C0SMXMLB",6)

"BLD",7929,"KRN",9.8,"NM","B","C0SNHIN",7)

"BLD",7929,"KRN",9.8,"NM","B","C0SNHINV",8)

"BLD",7929,"KRN",9.8,"NM","B","C0SPROB",9)

"BLD",7929,"KRN",9.8,"NM","B","C0SPROB2",10)

"BLD",7929,"KRN",9.8,"NM","B","C0STBL",11)

"BLD",7929,"KRN",9.8,"NM","B","C0SUTIL",12)

"BLD",7929,"KRN",9.8,"NM","B","C0SXPATH",13)

"BLD",7929,"KRN",19,0)
19
"BLD",7929,"KRN",19.1,0)
19.1
"BLD",7929,"KRN",101,0)
101
"BLD",7929,"KRN",409.61,0)
409.61
"BLD",7929,"KRN",771,0)
771
"BLD",7929,"KRN",779.2,0)
779.2
"BLD",7929,"KRN",870,0)
870
"BLD",7929,"KRN",8989.51,0)
8989.51
"BLD",7929,"KRN",8989.52,0)
8989.52
"BLD",7929,"KRN",8994,0)
8994
"BLD",7929,"KRN","B",.4,.4)

"BLD",7929,"KRN","B",.401,.401)

"BLD",7929,"KRN","B",.402,.402)

"BLD",7929,"KRN","B",.403,.403)

"BLD",7929,"KRN","B",.5,.5)

"BLD",7929,"KRN","B",.84,.84)

"BLD",7929,"KRN","B",3.6,3.6)

"BLD",7929,"KRN","B",3.8,3.8)

"BLD",7929,"KRN","B",9.2,9.2)

"BLD",7929,"KRN","B",9.8,9.8)

"BLD",7929,"KRN","B",19,19)

"BLD",7929,"KRN","B",19.1,19.1)

"BLD",7929,"KRN","B",101,101)

"BLD",7929,"KRN","B",409.61,409.61)

"BLD",7929,"KRN","B",771,771)

"BLD",7929,"KRN","B",779.2,779.2)

"BLD",7929,"KRN","B",870,870)

"BLD",7929,"KRN","B",8989.51,8989.51)

"BLD",7929,"KRN","B",8989.52,8989.52)

"BLD",7929,"KRN","B",8994,8994)

"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

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