source: smart/trunk/p/C0SDEM.m@ 1666

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

Updated license for routines
File size: 9.7 KB
RevLine 
[1591]1C0SDEM ; GPL - Smart Demographics Processing ; 10/30/12 10:59am
2 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
3 ;Copyright 2012 George Lilly.
[1571]4 ;
[1591]5 ; This program is free software: you can redistribute it and/or modify
6 ; it under the terms of the GNU Affero General Public License as
7 ; published by the Free Software Foundation, either version 3 of the
8 ; License, or (at your option) any later version.
[1571]9 ;
[1591]10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU Affero General Public License for more details.
[1571]14 ;
[1591]15 ; You should have received a copy of the GNU Affero General Public License
16 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
[1571]17 ;
18 Q
19 ;
20 ;<?xml version="1.0" encoding="utf-8"?>
21 ;<rdf:RDF
22 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
23 ; xmlns:sp="http://smartplatforms.org/terms#"
24 ; xmlns:dcterms="http://purl.org/dc/terms/"
25 ; xmlns:v="http://www.w3.org/2006/vcard/ns#"
26 ; xmlns:foaf="http://xmlns.com/foaf/0.1/">
27 ; <sp:Demographics>
28 ;
29 ; <v:n>
30 ; <v:Name>
31 ; <v:given-name>Bob</v:given-name>
32 ; <v:additional-name>J</v:additional-name>
33 ; <v:family-name>Odenkirk</v:family-name>
34 ; </v:Name>
35 ; </v:n>
36 ;
37 ; <v:adr>
38 ; <v:Address>
39 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
40 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
41 ;
42 ; <v:street-address>15 Main St</v:street-address>
43 ; <v:extended-address>Apt 2</v:extended-address>
44 ; <v:locality>Wonderland</v:locality>
45 ; <v:region>OZ</v:region>
46 ; <v:postal-code>54321</v:postal-code>
47 ; <v:country>USA</v:country>
48 ; </v:Address>
49 ; </v:adr>
50 ;
51 ; <v:tel>
52 ; <v:Tel>
53 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
54 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
55 ; <rdf:value>800-555-1212</rdf:value>
56 ; </v:Tel>
57 ; </v:tel>
58 ;
59 ; <v:tel>
60 ; <v:Tel>
61 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
62 ; <rdf:value>800-555-1515</rdf:value>
63 ; </v:Tel>
64 ; </v:tel>
65 ;
66 ; <foaf:gender>male</foaf:gender>
67 ; <v:bday>1959-12-25</v:bday>
68 ; <v:email>bob.odenkirk@example.com</v:email>
69 ;
70 ; <sp:medicalRecordNumber>
71 ; <sp:Code>
72 ; <dcterms:title>My Hospital Record 2304575</dcterms:title>
73 ; <dcterms:identifier>2304575</dcterms:identifier>
74 ; <sp:system>My Hospital Record</sp:system>
75 ; </sp:Code>
76 ; </sp:medicalRecordNumber>
77 ;
78 ; </sp:Demographics>
79 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?>
80 ;<rdf:RDF
81 ; xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
82 ; xmlns:sp="http://smartplatforms.org/terms#"
83 ; xmlns:dcterms="http://purl.org/dc/terms/"
84 ; xmlns:v="http://www.w3.org/2006/vcard/ns#"
85 ; xmlns:foaf="http://xmlns.com/foaf/0.1/">
86 ; <sp:Demographics>
87 ;
88 ; <v:n>
89 ; <v:Name>
90 ; <v:given-name>Bob</v:given-name>
91 ; <v:additional-name>J</v:additional-name>
92 ; <v:family-name>Odenkirk</v:family-name>
93 ; </v:Name>
94 ; </v:n>
95 ;
96 ; <v:adr>
97 ; <v:Address>
98 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
99 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
100 ;
101 ; <v:street-address>15 Main St</v:street-address>
102 ; <v:extended-address>Apt 2</v:extended-address>
103 ; <v:locality>Wonderland</v:locality>
104 ; <v:region>OZ</v:region>
105 ; <v:postal-code>54321</v:postal-code>
106 ; <v:country>USA</v:country>
107 ; </v:Address>
108 ; </v:adr>
109 ;
110 ; <v:tel>
111 ; <v:Tel>
112 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
113 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
114 ; <rdf:value>800-555-1212</rdf:value>
115 ; </v:Tel>
116 ; </v:tel>
117 ;
118 ; <v:tel>
119 ; <v:Tel>
120 ; <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
121 ; <rdf:value>800-555-1515</rdf:value>
122 ; </v:Tel>
123 ; </v:tel>
124 ;
125 ; <foaf:gender>male</foaf:gender>
126 ; <v:bday>1959-12-25</v:bday>
127 ; <v:email>bob.odenkirk@example.com</v:email>
128 ;
129 ; <sp:medicalRecordNumber>
130 ; <sp:Code>
131 ; <dcterms:title>My Hospital Record 2304575</dcterms:title>
132 ; <dcterms:identifier>2304575</dcterms:identifier>
133 ; <sp:system>My Hospital Record</sp:system>
134 ; </sp:Code>
135 ; </sp:medicalRecordNumber>
136 ;
137 ; </sp:Demographics>
138 ;</rdf:RDF>
139 ;G(1)="nodeID:25591^rdf:type^v:Home"
140 ;G(2)="nodeID:25591^rdf:type^v:Pref"
141 ;G(3)="nodeID:25591^rdf:type^v:Tel"
142 ;G(4)="nodeID:25591^rdf:value^800-369-6403"
143 ;G(5)="nodeID:25611^rdf:type^v:Name"
144 ;G(6)="nodeID:25611^v:additional-name^N"
145 ;G(7)="nodeID:25611^v:family-name^Brooks"
146 ;G(8)="nodeID:25611^v:given-name^Brian"
147 ;G(9)="nodeID:25622^dcterms:identifier^981968"
148 ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968"
149 ;G(11)="nodeID:25622^rdf:type^sp:Code"
150 ;G(12)="nodeID:25622^sp:system^My Hospital Record"
151 ;G(13)="nodeID:25623^rdf:type^v:Address"
152 ;G(14)="nodeID:25623^rdf:type^v:Home"
153 ;G(15)="nodeID:25623^rdf:type^v:Pref"
154 ;G(16)="nodeID:25623^v:locality^Bixby"
155 ;G(17)="nodeID:25623^v:postal-code^74008"
156 ;G(18)="nodeID:25623^v:region^OK"
157 ;G(19)="nodeID:25623^v:street-address^82 Lake St"
158 ;G(20)="smart:981968/demographics^foaf:gender^male"
159 ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics"
160 ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968"
161 ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622"
162 ;G(24)="smart:981968/demographics^v:adr^nodeID:25623"
163 ;G(25)="smart:981968/demographics^v:bday^1956-03-23"
164 ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com"
165 ;G(27)="smart:981968/demographics^v:n^nodeID:25611"
166 ;G(28)="smart:981968/demographics^v:tel^nodeID:25591"
167 Q
168 ;
169PATIENT(GRTN,C0SARY) ; GRTN, passed by reference,
170 ; is the return name of the graph created. "" if none
171 ; C0SARY is passed in by reference and is the NHIN array of patient
172 ;
173 I $O(C0SARY("patient",""))="" D Q ;
174 . I $D(DEBUG) W !,"No Patient array"
175 . S GRTN=""
176 S GRTN="" ; default to no patient
177 N C0SGRF
178 S C0SGRF="vistaSmart:"_ZPATID_"/patient"
179 S ZPAT=C0SGRF ; subject is the same as the graph name
180 I $D(DEBUG) W !,"Processing ",C0SGRF
181 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
182 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
183 N FARY S FARY="C0XFARY"
184 D USEFARY^C0XF2N(FARY)
185 D VOCINIT^C0XUTIL
186 ;
187 N ZPN,ZR
188 D STARTADD^C0XF2N
189 ;
190 ; First do the base demographic graph
191 ;
192 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient
193 N SEX S SEX=$G(@ZPN@("gender@value"))
194 I SEX="M" S SEX="male"
195 I SEX="F" S SEX="female"
196 S ZR("foaf:gender")=SEX
197 S ZR("rdf:type")="sp:Demographics"
198 S ZR("sp:belongsTo")=ZPAT
199 N PATIENT
200 S PATIENT=$P(ZPAT,"#",2)
201 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT
202 N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph
203 S ZR("sp:medicalRecordNumber")=NMREC
204 N NVADR S NVADR=$$ANONS^C0XF2N ; for address
205 S ZR("v:adr")=NVADR
206 N NNAME S NNAME=$$ANONS^C0XF2N ; for name
207 S ZR("v:n")=NNAME
208 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone
209 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists
210 N BDATE
211 S ZX=""
212 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format
213 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date
214 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens
215 I BDATE="" S BDATE="UNKNOWN"
216 N Z2,Z3
217 S Z2=$P(BDATE,"-",2)
218 S Z3=$P(BDATE,"-",3)
219 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2
220 I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3
221 S ZR("v:bday")=BDATE
222 I $D(C0SVISTA) D ;
223 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN
224 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN
225 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph
226 K ZR
227 ;
228 ; create address sub-graph
229 ;
230 S ZR("rdf:type")="v:Address"
231 S ZR("rdf:type")="v:Home"
232 S ZR("v:locality")=$G(@ZPN@("address@city"))
233 S ZR("v:postal-code")=$G(@ZPN@("address@postalCode"))
234 S ZR("v:region")=$G(@ZPN@("address@stateProvince"))
235 S ZR("v:street-address")=$G(@ZPN@("address@streetLine1"))
236 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address
237 K ZR
238 ;
239 ; create medical record subgraph
240 ;
241 S ZR("dcterms:identifier")=$G(@ZPN@("id@value"))
242 S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier")
243 S ZR("rdf:type")="sp:Code"
244 S ZR("sp:system")="VistA Patient Record"
245 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph
246 K ZR
247 ;
248 ; create name subgraph
249 ;
250 N ZNF,ZNL,ZNM,ZNAM
251 S ZR("rdf:type")="v:Name"
252 S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names
253 S ZNF=$P(ZX," ",1) ; first name is first piece
254 S ZNM=$P(ZX," ",2) ; middle names are the rest
255 S ZR("v:additional-name")=ZNM
256 S ZR("v:family-name")=$G(@ZPN@("familyName@value"))
257 S ZR("v:given-name")=ZNF
258 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph
259 K ZR
260 ;
261 ; create telephone subgraph
262 ;
263 D ;
264 . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value"))
265 . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph
266 . S ZR("rdf:type")="v:Tel"
267 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR)
268 K ZR
269 ;
270 ; load the demographics graph and all sub graphs to the triple store
271 ;
272 D BULKLOAD^C0XF2N(.C0XFDA)
273 S GRTN=C0SGRF
274 Q
275 ;
276AGES ; LIST ALL PATIENTS AND THEIR AGES
277 N ZI S ZI=0
278 F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT
279 . N ZDOB
280 . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB
281 . N ZNAME
282 . S ZNAME=$P(^DPT(ZI,0),U)
283 . N ZSEX
284 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX")
285 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX
286 Q
287 ;
Note: See TracBrowser for help on using the repository browser.