source: ccr/trunk/p/CCRDPT.m@ 102

Last change on this file since 102 was 69, checked in by George Lilly, 16 years ago

added GPL license language

File size: 23.5 KB
Line 
1CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
2 ;;0.1;CCRCCD;;Jun 15, 2008;
3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(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 General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
21 ; DESTROY to clean-up.
22
23 ; The first line of every routine tests if the global exists.
24
25 ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
26 ; INIT 9 lines Copy DFN global to a local variable
27 ; DESTROY 6 lines Kill local variable
28 ; FAMILY 6 lines Family Name
29 ; GIVEN 6 lines Given Name
30 ; MIDDLE 6 lines Middle Name
31 ; SUFFIX 6 lines Suffix Name
32 ; DISPNAME 5 lines Display Name
33 ; DOB 6 lines Date of Birth
34 ; GENDER 4 lines Get Gender
35 ; SSN 4 lines Get SSN for ID
36 ; ADDRTYPE 4 lines Get Home Address
37 ; ADDR1 4 lines Get Home Address line 1
38 ; ADDR2 5 lines Get Home Address line 2
39 ; CITY 4 lines Get City for Home Address
40 ; STATE 11 lines Get State for Home Address
41 ; ZIP 4 lines Get Zip code for Home Address
42 ; COUNTY 4 lines Get County for our Address
43 ; COUNTRY 4 lines Get Country for our Address
44 ; RESTEL 4 lines Residential Telephone
45 ; WORKTEL 4 lines Work Telephone
46 ; EMAIL 4 lines Email Adddress
47 ; CELLTEL 4 lines Cell Phone
48 ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name
49 ; NOK1GIV 6 lines NOK1 Given Name
50 ; NOK1MID 6 lines NOK1 Middle Name
51 ; NOK1SUF 6 lines NOK1 Suffi Name
52 ; NOK1DISP 5 lines NOK1 Display Name
53 ; NOK1REL 4 lines NOK1 Relationship to the patient
54 ; NOK1ADD1 4 lines NOK1 Address 1
55 ; NOK1ADD2 5 lines NOK1 Address 2
56 ; NOK1CITY 4 lines NOK1 City
57 ; NOK1STAT 5 lines NOK1 State
58 ; NOK1ZIP 4 lines NOK1 Zip Code
59 ; NOK1HTEL; 4 lines NOK1 Home Telephone
60 ; NOK1WTEL; 4 lines NOK1 Work Telephone
61 ; NOK1SAME; 4 lines Is NOK1's Address the same the patient?
62 ; NOK2FAM 6 lines NOK2 Family Name
63 ; NOK2GIV 6 lines NOK2 Given Name
64 ; NOK2MID 6 lines NOK2 Middle Name
65 ; NOK2SUF 5 lines NOK2 Suffi Name
66 ; NOK2DISP 5 lines NOK2 Display Name
67 ; NOK2REL 4 lines NOK2 Relationship to the patient
68 ; NOK2ADD1 4 lines NOK2 Address 1
69 ; NOK2ADD2 5 lines NOK2 Address 2
70 ; NOK2CITY 4 lines NOK2 City
71 ; NOK2STAT 5 lines NOK2 State
72 ; NOK2ZIP 4 lines NOK2 Zip Code
73 ; NOK2HTEL; 4 lines NOK2 Home Telephone
74 ; NOK2WTEL; 4 lines NOK2 Work Telephone
75 ; NOK2SAME; 4 lines Is NOK2's Address the same the patient?
76 ; EMERFAM 6 lines Emergency Contact (EMER) Family Name
77 ; EMERGIV 6 lines EMER Given Name
78 ; EMERMID 6 lines EMER Middle Name
79 ; EMERSUF 5 lines EMER Suffi Name
80 ; EMERDISP 5 lines EMER Display Name
81 ; EMERREL 4 lines EMER Relationship to the patient
82 ; EMERADD1 4 lines EMER Address 1
83 ; EMERADD2 5 lines EMER Address 2
84 ; EMERCITY 4 lines EMER City
85 ; EMERSTAT 5 lines EMER State
86 ; EMERZIP 4 lines EMER Zip Code
87 ; EMERHTEL; 4 lines EMER Home Telephone
88 ; EMERWTEL; 4 lines EMER Work Telephone
89 ; EMERSAME; 4 lines Is EMER's Address the same the NOK?
90
91 W "No Entry at top!" Q
92
93 ; The following is a map of the relevant data in the patient global.
94 ;
95 ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
96 ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
97 ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
98 ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
99 ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
100 ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
101 ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
102 ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
103 ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
104 ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
105 ; ==>[21S] ^
106 ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
107 ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
108 ; ==>COMPONENTS [3P:20] ^
109 ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
110 ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
111 ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
112 ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
113 ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
114 ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
115 ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
116 ; ==>^
117 ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
118 ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
119 ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
120 ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
121 ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
122 ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
123 ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
124 ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
125 ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
126 ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
127 ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
128 ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
129 ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
130 ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
131 ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
132 ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
133 ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
134 ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
135 ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
136 ; ==>SITE [14P:4] ^
137 ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
138 ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
139 ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
140 ; ==>3] [5F] ^
141 ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
142 ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
143 ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
144 ; ==>^
145 ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
146 ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
147 ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
148 ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
149 ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
150 ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
151 ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
152 ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
153 ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
154 ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
155 ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
156 ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
157 ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
158 ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
159 ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
160 ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
161 ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
162 ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
163 ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
164 ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
165 ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
166 ; ==>[11F] ^
167
168INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
169 ; INPUT: Patient IEN (DFN)
170 ; OUTPUT: PT in the Symbol Table, representing the patient global
171
172 ; Instead of accessing a global each single read (SLOOOOW)
173 ; read it off a local variable stored in Memory.
174 M PT=^DPT(DFN)
175 Q
176 ;
177DESTROY ; Kill local variable; PUBLIC
178 ; INPUT: None
179 ; OUTPUT: Kill PT from the Symbol Table after you are done
180 K PT
181 Q
182 ;
183FAMILY() ; Family Name; PUBLIC; Extrinsic
184 ; PREREQ: PT Defined
185 Q:$G(PT(0))="" ""
186 N NAME S NAME=$P(PT(0),"^",1)
187 D NAMECOMP^XLFNAME(.NAME)
188 Q NAME("FAMILY")
189 ;
190GIVEN() ; Given Name; PUBLIC; Extrinsic
191 ; PREREQ: PT Defined
192 Q:$G(PT(0))="" ""
193 N NAME S NAME=$P(PT(0),"^",1)
194 D NAMECOMP^XLFNAME(.NAME)
195 Q NAME("GIVEN")
196 ;
197MIDDLE() ; Middle Name; PUBLIC; Extrinsic
198 ; PREREQ: PT Defined
199 Q:$G(PT(0))="" ""
200 N NAME S NAME=$P(PT(0),"^",1)
201 D NAMECOMP^XLFNAME(.NAME)
202 Q NAME("MIDDLE")
203 ;
204SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
205 ; PREREQ: PT Defined
206 Q:$G(PT(0))="" ""
207 N NAME S NAME=$P(PT(0),"^",1)
208 D NAMECOMP^XLFNAME(.NAME)
209 Q NAME("SUFFIX")
210 ;
211DISPNAME() ; Display Name; PUBLIC; Extrinsic
212 ; PREREQ: PT Defined
213 Q:$G(PT(0))="" ""
214 N NAME S NAME=$P(PT(0),"^",1)
215 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
216 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
217DOB() ; Date of Birth; PUBLIC; Extrinsic
218 ; PREREQ: PT Defined
219 Q:$G(PT(0))="" ""
220 N DOB S DOB=$P(PT(0),"^",3)
221 ; Date in FM Date Format. Convert to UTC/ISO 8601.
222 Q $$FMDTOUTC^CCRUTIL(DOB,"D")
223 ;
224GENDER() ; Get Gender; PUBLIC; Extrinsic
225 ; PREREQ: PT Defined
226 Q:$G(PT(0))="" ""
227 Q $P(PT(0),"^",2)
228 ;
229SSN() ; Get SSN for ID; PUBLIC; Extrinsic
230 ; PREREQ: PT Defined
231 Q:$G(PT(0))="" ""
232 Q $P(PT(0),"^",9)
233 ;
234ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
235 ; Vista only stores a home address for the patient.
236 Q:$G(PT(0))="" ""
237 Q "Home"
238 ;
239ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
240 ; PREREQ: PT Defined
241 Q:$G(PT(.11))="" ""
242 Q $P(PT(.11),"^",1)
243 ;
244ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
245 ; PREREQ: PT Defined
246 ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
247 Q:$G(PT(.11))="" ""
248 ; If the thrid address is empty, just return the 2nd.
249 ; If the 2nd is empty, we don't lose, b/c it will return ""
250 ; This is so that we won't produce a comma if there is no 3rd addr.
251 Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
252 Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
253 ;
254CITY() ; Get City for Home Address; PUBLIC; Extrinsic
255 ; PREREQ: PT Defined
256 Q:$G(PT(.11))="" ""
257 Q $P(PT(.11),"^",4)
258 ;
259STATE() ; Get State for Home Address; PUBLIC; Extrinsic
260 ; PREREQ: PT Defined
261 Q:$G(PT(.11))="" ""
262 ; State is stored as a pointer
263 N STATENUM S STATENUM=$P(PT(.11),"^",5)
264 ;
265 ; State File Global is below
266 ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
267 ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
268 ; ==>US STATE OR POSSESSION [6S] ^
269 Q:STATENUM="" "" ; To prevent global undefined below if no state
270 Q $P(^DIC(5,STATENUM,0),"^",1)
271 ;
272ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
273 ; PREREQ: PT Defined
274 Q:$G(PT(.11))="" ""
275 Q $P(PT(.11),"^",6)
276 ;
277COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
278 ; PREREQ: PT Defined
279 Q:$G(PT(.11))="" ""
280 Q $P(PT(.11),"^",7)
281 ;
282COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
283 ; Unfortunately, I can't find where that is stored, so the inevitable...
284 Q:$G(PT(.11))="" ""
285 Q "USA"
286 ;
287RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
288 ; PREREQ: PT Defined
289 Q:$G(PT(.13))="" ""
290 Q $P(PT(.13),"^",1)
291 ;
292WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
293 ; PREREQ: PT Defined
294 Q:$G(PT(.13))="" ""
295 Q $P(PT(.13),"^",2)
296 ;
297EMAIL() ; Email Adddress; PUBLIC; Extrinsic
298 ; PREREQ: PT Defined
299 Q:$G(PT(.13))="" ""
300 Q $P(PT(.13),"^",3)
301 ;
302CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
303 ; PREREQ: PT Defined
304 Q:$G(PT(.13))="" ""
305 Q $P(PT(.13),"^",4)
306 ;
307NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
308 ; PREREQ: PT Defined
309 Q:$G(PT(.21))="" ""
310 N NAME S NAME=$P(PT(.21),"^",1)
311 D NAMECOMP^XLFNAME(.NAME)
312 Q NAME("FAMILY")
313 ;
314NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
315 ; PREREQ: PT Defined
316 Q:$G(PT(.21))="" ""
317 N NAME S NAME=$P(PT(.21),"^",1)
318 D NAMECOMP^XLFNAME(.NAME)
319 Q NAME("GIVEN")
320 ;
321NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
322 ; PREREQ: PT Defined
323 Q:$G(PT(.21))="" ""
324 N NAME S NAME=$P(PT(.21),"^",1)
325 D NAMECOMP^XLFNAME(.NAME)
326 Q NAME("MIDDLE")
327 ;
328NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
329 ; PREREQ: PT Defined
330 Q:$G(PT(.21))="" ""
331 N NAME S NAME=$P(PT(.21),"^",1)
332 D NAMECOMP^XLFNAME(.NAME)
333 Q NAME("SUFFIX")
334 ;
335NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
336 ; PREREQ: PT Defined
337 Q:$G(PT(.21))="" ""
338 N NAME S NAME=$P(PT(.21),"^",1)
339 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
340 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
341NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
342 ; PREREQ: PT Defined
343 Q:$G(PT(.21))="" ""
344 Q $P(PT(.21),"^",2)
345 ;
346NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
347 ; PREREQ: PT Defined
348 Q:$G(PT(.21))="" ""
349 Q $P(PT(.21),"^",3)
350 ;
351NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
352 ; PREREQ: PT Defined
353 ; As before, CCR only allows two fileds for the address, so we have to compromise
354 Q:$G(PT(.21))="" ""
355 ; If the thrid address is empty, just return the 2nd.
356 ; If the 2nd is empty, we don't lose, b/c it will return ""
357 ; This is so that we won't produce a comma if there is no 3rd addr.
358 Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
359 Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
360 ;
361NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
362 ; PREREQ: PT Defined
363 Q:$G(PT(.21))="" ""
364 Q $P(PT(.21),"^",6)
365 ;
366NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
367 ; PREREQ: PT Defined
368 Q:$G(PT(.21))="" ""
369 N STATENUM S STATENUM=$P(PT(.21),"^",7)
370 Q:STATENUM="" ""
371 Q $P(^DIC(5,STATENUM,0),"^",1)
372 ;
373NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
374 ; PREREQ: PT Defined
375 Q:$G(PT(.21))="" ""
376 Q $P(PT(.21),"^",8)
377 ;
378NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
379 ; PREREQ: PT Defined
380 Q:$G(PT(.21))="" ""
381 Q $P(PT(.21),"^",9)
382 ;
383NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
384 ; PREREQ: PT Defined
385 Q:$G(PT(.21))="" ""
386 Q $P(PT(.21),"^",11)
387 ;
388NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
389 ; PREREQ: PT Defined
390 Q:$G(PT(.21))="" ""
391 Q $P(PT(.21),"^",10)
392 ;
393NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
394 ; PREREQ: PT Defined
395 Q:$G(PT(.211))="" ""
396 N NAME S NAME=$P(PT(.211),"^",1)
397 D NAMECOMP^XLFNAME(.NAME)
398 Q NAME("FAMILY")
399 ;
400NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
401 Q:$G(PT(.211))="" ""
402 N NAME S NAME=$P(PT(.211),"^",1)
403 D NAMECOMP^XLFNAME(.NAME)
404 Q NAME("GIVEN")
405 ;
406NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
407 ; PREREQ: PT Defined
408 Q:$G(PT(.211))="" ""
409 N NAME S NAME=$P(PT(.211),"^",1)
410 D NAMECOMP^XLFNAME(.NAME)
411 Q NAME("MIDDLE")
412 ;
413NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
414 ; PREREQ: PT Defined
415 Q:$G(PT(.211))="" ""
416 N NAME S NAME=$P(PT(.211),"^",1)
417 D NAMECOMP^XLFNAME(.NAME)
418 Q NAME("SUFFIX")
419NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
420 ; PREREQ: PT Defined
421 Q:$G(PT(.211))="" ""
422 N NAME S NAME=$P(PT(.211),"^",1)
423 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
424 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
425NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
426 ; PREREQ: PT Defined
427 Q:$G(PT(.211))="" ""
428 Q $P(PT(.211),"^",2)
429 ;
430NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
431 ; PREREQ: PT Defined
432 Q:$G(PT(.211))="" ""
433 Q $P(PT(.211),"^",3)
434 ;
435NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
436 ; PREREQ: PT Defined
437 ; As before, CCR only allows two fileds for the address, so we have to compromise
438 Q:$G(PT(.211))="" ""
439 ; If the thrid address is empty, just return the 2nd.
440 ; If the 2nd is empty, we don't lose, b/c it will return ""
441 ; This is so that we won't produce a comma if there is no 3rd addr.
442 Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
443 Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
444 ;
445NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
446 ; PREREQ: PT Defined
447 Q:$G(PT(.211))="" ""
448 Q $P(PT(.211),"^",6)
449 ;
450NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
451 ; PREREQ: PT Defined
452 Q:$G(PT(.211))="" ""
453 N STATENUM S STATENUM=$P(PT(.211),"^",7)
454 Q:STATENUM="" "" ; To prevent global undefined below if no state
455 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
456 ;
457NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
458 ; PREREQ: PT Defined
459 Q:$G(PT(.211))="" ""
460 Q $P(PT(.211),"^",8)
461 ;
462NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
463 ; PREREQ: PT Defined
464 Q:$G(PT(.211))="" ""
465 Q $P(PT(.211),"^",9)
466 ;
467NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
468 ; PREREQ: PT Defined
469 Q:$G(PT(.211))="" ""
470 Q $P(PT(.211),"^",11)
471 ;
472NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
473 ; PREREQ: PT Defined
474 Q:$G(PT(.211))="" ""
475 Q $P(PT(.211),"^",10)
476 ;
477EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
478 ; PREREQ: PT Defined
479 Q:$G(PT(.33))="" ""
480 N NAME S NAME=$P(PT(.33),"^",1)
481 D NAMECOMP^XLFNAME(.NAME)
482 Q NAME("FAMILY")
483 ;
484EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
485 ; PREREQ: PT Defined
486 Q:$G(PT(.33))="" ""
487 N NAME S NAME=$P(PT(.33),"^",1)
488 D NAMECOMP^XLFNAME(.NAME)
489 Q NAME("GIVEN")
490 ;
491EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
492 ; PREREQ: PT Defined
493 Q:$G(PT(.33))="" ""
494 N NAME S NAME=$P(PT(.33),"^",1)
495 D NAMECOMP^XLFNAME(.NAME)
496 Q NAME("MIDDLE")
497 ;
498EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
499 ; PREREQ: PT Defined
500 Q:$G(PT(.33))="" ""
501 N NAME S NAME=$P(PT(.33),"^",1)
502 D NAMECOMP^XLFNAME(.NAME)
503 Q NAME("SUFFIX")
504EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
505 ; PREREQ: PT Defined
506 Q:$G(PT(.33))="" ""
507 N NAME S NAME=$P(PT(.33),"^",1)
508 Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
509 ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
510EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
511 ; PREREQ: PT Defined
512 Q:$G(PT(.33))="" ""
513 Q $P(PT(.33),"^",2)
514 ;
515EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
516 ; PREREQ: PT Defined
517 Q:$G(PT(.33))="" ""
518 Q $P(PT(.33),"^",3)
519 ;
520EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
521 ; PREREQ: PT Defined
522 ; As before, CCR only allows two fileds for the address, so we have to compromise
523 Q:$G(PT(.33))="" ""
524 ; If the thrid address is empty, just return the 2nd.
525 ; If the 2nd is empty, we don't lose, b/c it will return ""
526 ; This is so that we won't produce a comma if there is no 3rd addr.
527 Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
528 Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
529 ;
530EMERCITY() ; EMER City; PUBLIC; Extrinsic
531 ; PREREQ: PT Defined
532 Q:$G(PT(.33))="" ""
533 Q $P(PT(.33),"^",6)
534 ;
535EMERSTAT() ; EMER State; PUBLIC; Extrinsic
536 ; PREREQ: PT Defined
537 Q:$G(PT(.33))="" ""
538 N STATENUM S STATENUM=$P(PT(.33),"^",7)
539 Q:STATENUM="" "" ; To prevent global undefined below if no state
540 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
541 ;
542EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
543 ; PREREQ: PT Defined
544 Q:$G(PT(.33))="" ""
545 Q $P(PT(.33),"^",8)
546 ;
547EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
548 ; PREREQ: PT Defined
549 Q:$G(PT(.33))="" ""
550 Q $P(PT(.33),"^",9)
551 ;
552EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
553 ; PREREQ: PT Defined
554 Q:$G(PT(.33))="" ""
555 Q $P(PT(.33),"^",11)
556 ;
557EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
558 ; PREREQ: PT Defined
559 Q:$G(PT(.33))="" ""
560 Q $P(PT(.33),"^",10)
561 ;
Note: See TracBrowser for help on using the repository browser.