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

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

XINDEX fixes. almost clean except for long var names and big files

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