source: ccr/trunk/p/C0CDPT.m@ 1806

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

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CDPT.m1290
    /ccr/branches/ohum/p/C0CDPT.m1291-1543
    /ccr/branches/ohum/p/p/C0CDPT.m1287-1289
File size: 8.9 KB
Line 
1C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ;
4 ; Copyright 2008 WorldVistA.
5 ;
6 ; This program is free software: you can redistribute it and/or modify
7 ; it under the terms of the GNU Affero General Public License as
8 ; published by the Free Software Foundation, either version 3 of the
9 ; License, or (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU Affero General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU Affero General Public License
17 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
18 ;
19 ;
20 ; FAMILY Family Name
21 ; GIVEN Given Name
22 ; MIDDLE Middle Name
23 ; SUFFIX Suffix Name
24 ; DISPNAME Display Name
25 ; DOB Date of Birth
26 ; GENDER Get Gender
27 ; SSN Get SSN for ID
28 ; ADDRTYPE Get Home Address
29 ; ADDR1 Get Home Address line 1
30 ; ADDR2 Get Home Address line 2
31 ; CITY Get City for Home Address
32 ; STATE Get State for Home Address
33 ; ZIP Get Zip code for Home Address
34 ; COUNTY Get County for our Address
35 ; COUNTRY Get Country for our Address
36 ; RESTEL Residential Telephone
37 ; WORKTEL Work Telephone
38 ; EMAIL Email Adddress
39 ; CELLTEL Cell Phone
40 ; NOK1FAM Next of Kin 1 (NOK1) Family Name
41 ; NOK1GIV NOK1 Given Name
42 ; NOK1MID NOK1 Middle Name
43 ; NOK1SUF NOK1 Suffi Name
44 ; NOK1DISP NOK1 Display Name
45 ; NOK1REL NOK1 Relationship to the patient
46 ; NOK1ADD1 NOK1 Address 1
47 ; NOK1ADD2 NOK1 Address 2
48 ; NOK1CITY NOK1 City
49 ; NOK1STAT NOK1 State
50 ; NOK1ZIP NOK1 Zip Code
51 ; NOK1HTEL NOK1 Home Telephone
52 ; NOK1WTEL NOK1 Work Telephone
53 ; NOK1SAME Is NOK1's Address the same the patient?
54 ; NOK2FAM NOK2 Family Name
55 ; NOK2GIV NOK2 Given Name
56 ; NOK2MID NOK2 Middle Name
57 ; NOK2SUF NOK2 Suffi Name
58 ; NOK2DISP NOK2 Display Name
59 ; NOK2REL NOK2 Relationship to the patient
60 ; NOK2ADD1 NOK2 Address 1
61 ; NOK2ADD2 NOK2 Address 2
62 ; NOK2CITY NOK2 City
63 ; NOK2STAT NOK2 State
64 ; NOK2ZIP NOK2 Zip Code
65 ; NOK2HTEL NOK2 Home Telephone
66 ; NOK2WTEL NOK2 Work Telephone
67 ; NOK2SAME Is NOK2's Address the same the patient?
68 ; EMERFAM Emergency Contact (EMER) Family Name
69 ; EMERGIV EMER Given Name
70 ; EMERMID EMER Middle Name
71 ; EMERSUF EMER Suffi Name
72 ; EMERDISP EMER Display Name
73 ; EMERREL EMER Relationship to the patient
74 ; EMERADD1 EMER Address 1
75 ; EMERADD2 EMER Address 2
76 ; EMERCITY EMER City
77 ; EMERSTAT EMER State
78 ; EMERZIP EMER Zip Code
79 ; EMERHTEL EMER Home Telephone
80 ; EMERWTEL EMER Work Telephone
81 ; EMERSAME Is EMER's Address the same the NOK?
82 ;
83 W "No Entry at top!" Q
84 ;
85 ;**Revision History**
86 ; - June 15, 08: v0.1 using merged global
87 ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
88 ;
89 ; All methods are Public and Extrinsic
90 ; All calls use Fileman file 2 (Patient).
91 ; You can obtain field numbers using the data dictionary
92 ;
93FAMILY(DFN) ; Family Name
94 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
95 D NAMECOMP^XLFNAME(.NAME)
96 Q NAME("FAMILY")
97GIVEN(DFN) ; Given Name
98 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
99 D NAMECOMP^XLFNAME(.NAME)
100 Q NAME("GIVEN")
101MIDDLE(DFN) ; Middle Name
102 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
103 D NAMECOMP^XLFNAME(.NAME)
104 Q NAME("MIDDLE")
105SUFFIX(DFN) ; Suffi Name
106 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
107 D NAMECOMP^XLFNAME(.NAME)
108 Q NAME("SUFFIX")
109DISPNAME(DFN) ; Display Name
110 N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
111 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
112 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
113DOB(DFN) ; Date of Birth
114 N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
115 ; Date in FM Date Format. Convert to UTC/ISO 8601.
116 Q $$FMDTOUTC^C0CUTIL(DOB,"D")
117GENDER(DFN) ; Gender/Sex
118 Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
119SSN(DFN) ; SSN
120 Q $$GET1^DIQ(2,DFN,.09)
121ADDRTYPE(DFN) ; Address Type
122 ; Vista only stores a home address for the patient.
123 Q "Home"
124ADDR1(DFN) ; Get Home Address line 1
125 Q $$GET1^DIQ(2,DFN,.111)
126ADDR2(DFN) ; Get Home Address line 2
127 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
128 N ADDLN2,ADDLN3
129 S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
130 Q:ADDLN3="" ADDLN2
131 Q ADDLN2_", "_ADDLN3
132CITY(DFN) ; Get City for Home Address
133 Q $$GET1^DIQ(2,DFN,.114)
134STATE(DFN) ; Get State for Home Address
135 Q $$GET1^DIQ(2,DFN,.115)
136ZIP(DFN) ; Get Zip code for Home Address
137 Q $$GET1^DIQ(2,DFN,.116)
138COUNTY(DFN) ; Get County for our Address
139 Q $$GET1^DIQ(2,DFN,.117)
140COUNTRY(DFN) ; Get Country for our Address
141 ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
142 Q "USA"
143RESTEL(DFN) ; Residential Telephone
144 Q $$GET1^DIQ(2,DFN,.131)
145WORKTEL(DFN) ; Work Telephone
146 Q $$GET1^DIQ(2,DFN,.132)
147EMAIL(DFN) ; Email Adddress
148 Q $$GET1^DIQ(2,DFN,.133)
149CELLTEL(DFN) ; Cell Phone
150 Q $$GET1^DIQ(2,DFN,.134)
151NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
152 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
153 D NAMECOMP^XLFNAME(.NAME)
154 Q NAME("FAMILY")
155NOK1GIV(DFN) ; NOK1 Given Name
156 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
157 D NAMECOMP^XLFNAME(.NAME)
158 Q NAME("GIVEN")
159NOK1MID(DFN) ; NOK1 Middle Name
160 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
161 D NAMECOMP^XLFNAME(.NAME)
162 Q NAME("MIDDLE")
163NOK1SUF(DFN) ; NOK1 Suffi Name
164 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
165 D NAMECOMP^XLFNAME(.NAME)
166 Q NAME("SUFFIX")
167NOK1DISP(DFN) ; NOK1 Display Name
168 N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
169 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
170 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
171NOK1REL(DFN) ; NOK1 Relationship to the patient
172 Q $$GET1^DIQ(2,DFN,.212)
173NOK1ADD1(DFN) ; NOK1 Address 1
174 Q $$GET1^DIQ(2,DFN,.213)
175NOK1ADD2(DFN) ; NOK1 Address 2
176 N ADDLN2,ADDLN3
177 S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
178 Q:ADDLN3="" ADDLN2
179 Q ADDLN2_", "_ADDLN3
180NOK1CITY(DFN) ; NOK1 City
181 Q $$GET1^DIQ(2,DFN,.216)
182NOK1STAT(DFN) ; NOK1 State
183 Q $$GET1^DIQ(2,DFN,.217)
184NOK1ZIP(DFN) ; NOK1 Zip Code
185 Q $$GET1^DIQ(2,DFN,.218)
186NOK1HTEL(DFN) ; NOK1 Home Telephone
187 Q $$GET1^DIQ(2,DFN,.219)
188NOK1WTEL(DFN) ; NOK1 Work Telephone
189 Q $$GET1^DIQ(2,DFN,.21011)
190NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
191 Q $$GET1^DIQ(2,DFN,.2125)
192NOK2FAM(DFN) ; NOK2 Family Name
193 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
194 D NAMECOMP^XLFNAME(.NAME)
195 Q NAME("FAMILY")
196NOK2GIV(DFN) ; NOK2 Given Name
197 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
198 D NAMECOMP^XLFNAME(.NAME)
199 Q NAME("GIVEN")
200NOK2MID(DFN) ; NOK2 Middle Name
201 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
202 D NAMECOMP^XLFNAME(.NAME)
203 Q NAME("MIDDLE")
204NOK2SUF(DFN) ; NOK2 Suffi Name
205 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
206 D NAMECOMP^XLFNAME(.NAME)
207 Q NAME("SUFFIX")
208NOK2DISP(DFN) ; NOK2 Display Name
209 N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
210 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
211 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
212NOK2REL(DFN) ; NOK2 Relationship to the patient
213 Q $$GET1^DIQ(2,DFN,.2192)
214NOK2ADD1(DFN) ; NOK2 Address 1
215 Q $$GET1^DIQ(2,DFN,.2193)
216NOK2ADD2(DFN) ; NOK2 Address 2
217 N ADDLN2,ADDLN3
218 S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
219 Q:ADDLN3="" ADDLN2
220 Q ADDLN2_", "_ADDLN3
221NOK2CITY(DFN) ; NOK2 City
222 Q $$GET1^DIQ(2,DFN,.2196)
223NOK2STAT(DFN) ; NOK2 State
224 Q $$GET1^DIQ(2,DFN,.2197)
225NOK2ZIP(DFN) ; NOK2 Zip Code
226 Q $$GET1^DIQ(2,DFN,.2198)
227NOK2HTEL(DFN) ; NOK2 Home Telephone
228 Q $$GET1^DIQ(2,DFN,.2199)
229NOK2WTEL(DFN) ; NOK2 Work Telephone
230 Q $$GET1^DIQ(2,DFN,.211011)
231NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
232 Q $$GET1^DIQ(2,DFN,.21925)
233EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
234 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
235 D NAMECOMP^XLFNAME(.NAME)
236 Q NAME("FAMILY")
237EMERGIV(DFN) ; EMER Given Name
238 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
239 D NAMECOMP^XLFNAME(.NAME)
240 Q NAME("GIVEN")
241EMERMID(DFN) ; EMER Middle Name
242 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
243 D NAMECOMP^XLFNAME(.NAME)
244 Q NAME("MIDDLE")
245EMERSUF(DFN) ; EMER Suffi Name
246 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
247 D NAMECOMP^XLFNAME(.NAME)
248 Q NAME("SUFFIX")
249EMERDISP(DFN) ; EMER Display Name
250 N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
251 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
252 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
253EMERREL(DFN) ; EMER Relationship to the patient
254 Q $$GET1^DIQ(2,DFN,.331)
255EMERADD1(DFN) ; EMER Address 1
256 Q $$GET1^DIQ(2,DFN,.333)
257EMERADD2(DFN) ; EMER Address 2
258 N ADDLN2,ADDLN3
259 S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
260 Q:ADDLN3="" ADDLN2
261 Q ADDLN2_", "_ADDLN3
262EMERCITY(DFN) ; EMER City
263 Q $$GET1^DIQ(2,DFN,.336)
264EMERSTAT(DFN) ; EMER State
265 Q $$GET1^DIQ(2,DFN,.337)
266EMERZIP(DFN) ; EMER Zip Code
267 Q $$GET1^DIQ(2,DFN,.338)
268EMERHTEL(DFN) ; EMER Home Telephone
269 Q $$GET1^DIQ(2,DFN,.339)
270EMERWTEL(DFN) ; EMER Work Telephone
271 Q $$GET1^DIQ(2,DFN,.33011)
272EMERSAME(DFN) ; Is EMER's Address the same the NOK?
273 Q $$GET1^DIQ(2,DFN,.3305)
Note: See TracBrowser for help on using the repository browser.