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

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

This update contains the completion of attempt 1 at extracting patient data from the patient file. It also contains a unit tester routine.

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