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

Last change on this file since 60 was 48, checked in by Sam Habiel, 16 years ago

Added entry points to GPLACTORS to get the patient information; changes in Template in GPLCCR0

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