source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRPSKN.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1DGRRPSKN ; ALB/SGG - rtnDGRR PatientServices Contact Information ;09/30/03 ; Compiled October 21, 2003 14:54:28
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;<DataSet Name='NextOfKinAddress'
5 ;
6 ;
7 ;=======================================================
8 ; PRIMARY NEXT OF KIN
9 ;.211 K-NAME OF PRIMARY NOK (FaX), [.21;1]
10 ;.212 K-RELATIONSHIP TO PATIENT (FX), [.21;2]
11 ;.213 K-STREET ADDRESS [LINE 1] (FX), [.21;3]
12 ;.214 K-STREET ADDRESS [LINE 2] (FX), [.21;4]
13 ;.215 K-STREET ADDRESS [LINE 3] (FX), [.21;5]
14 ;.216 K-CITY (FX), [.21;6]
15 ;.217 K-STATE (P5'X), [.21;7]
16 ; .2207 K-ZIP+4 (FOX), [.22;7]
17 ;.218 K-ZIP CODE (FX), [.21;8]
18 ;.219 K-PHONE NUMBER (FXa), [.21;9]
19 ;.21011 K-WORK PHONE NUMBER (F), [.21;11]
20 ;
21 ;=======================================================
22 ;SECONDARY NEXT OF KIN
23 ;.2191 K2-NAME OF SECONDARY NOK (FX), [.211;1]
24 ;.2192 K2-RELATIONSHIP TO PATIENT (FX), [.211;2]
25 ;.2193 K2-STREET ADDRESS [LINE 1] (FX), [.211;3]
26 ;.2194 K2-STREET ADDRESS [LINE 2] (FX), [.211;4]
27 ;.2195 K2-STREET ADDRESS [LINE 3] (FX), [.211;5]
28 ;.2196 K2-CITY (FX), [.211;6]
29 ;.2197 K2-STATE (P5'X), [.211;7]
30 ;.2198 K2-ZIP CODE (FX), [.211;8]
31 ; .2203 K2-ZIP+4 (FOX), [.22;3]
32 ;.2199 K2-PHONE NUMBER (FX), [.211;9]
33 ;.211011 K2-WORK PHONE NUMBER (F), [.211;11]
34 ;
35 ;=======================================================
36 ; DESIGNEE
37 ;.341 D-NAME OF DESIGNEE (FX), [.34;1]
38 ;.342 D-RELATIONSHIP TO PATIENT (FX), [.34;2]
39 ;.343 D-STREET ADDRESS [LINE 1] (FX), [.34;3]
40 ;.344 D-STREET ADDRESS [LINE 2] (FX), [.34;4]
41 ;.345 D-STREET ADDRESS [LINE 3] (FX), [.34;5]
42 ;.346 D-CITY (FX), [.34;6]
43 ;.347 D-STATE (P5'X), [.34;7]
44 ;.348 D-ZIP CODE (FX), [.34;8]
45 ; .2202 D-ZIP+4 (FOX), [.22;2]
46 ;.349 D-PHONE NUMBER (FX), [.34;9]
47 ;.34011 D-WORK PHONE NUMBER (F), [.34;11]
48 ;
49 ;=======================================================
50 ; EMERGENCY CONTACT
51 ;.331 E-NAME (FX), [.33;1]
52 ;.332 E-RELATIONSHIP TO PATIENT (FX), [.33;2]
53 ;.333 E-STREET ADDRESS [LINE 1] (FX), [.33;3]
54 ;.334 E-STREET ADDRESS [LINE 2] (FX), [.33;4]
55 ;.335 E-STREET ADDRESS [LINE 3] (FX), [.33;5]
56 ;.336 E-CITY (FX), [.33;6]
57 ;.337 E-STATE (P5'X), [.33;7]
58 ;.338 E-ZIP CODE (FX), [.33;8]
59 ; .2201 E-ZIP+4 (FOX), [.22;1]
60 ;.339 E-PHONE NUMBER (FX), [.33;9]
61 ;.33011 E-WORK PHONE NUMBER (F), [.33;11]
62 ;
63 ;=======================================================
64 ; SECONDARY EMERGENCY CONTACT
65 ;.3311 E2-NAME OF SECONDARY CONTACT (FX), [.331;1]
66 ;.3312 E2-RELATIONSHIP TO PATIENT (FX), [.331;2]
67 ;.3313 E2-STREET ADDRESS [LINE 1] (FX), [.331;3]
68 ;.3314 E2-STREET ADDRESS [LINE 2] (FX), [.331;4]
69 ;.3315 E2-STREET ADDRESS [LINE 3] (FX), [.331;5]
70 ;.3316 E2-CITY (FX), [.331;6]
71 ;.3317 E2-STATE (P5'X), [.331;7]
72 ;.3318 E2-ZIP CODE (FX), [.331;8]
73 ; .2204 E2-ZIP+4 (FOX), [.22;4]
74 ;.3319 E2-PHONE NUMBER (FX), [.331;9]
75 ;.331011 E2-WORK PHONE NUMBER (F), [.331;11]
76 ;
77 ;=======================================================
78 ;
79GETPSARY(PSARRAY) ;
80 NEW CNT
81 DO ADDRESS("NextOfKinAddress",$G(^DPT(PTID,.21)),7)
82 DO ADDRESS("AltNextOfKinAddress",$G(^DPT(PTID,.211)),3)
83 DO ADDRESS("DesigneeAddress",$G(^DPT(PTID,.34)),2)
84 DO ADDRESS("EmergencyContactAddress",$G(^DPT(PTID,.33)),1)
85 DO ADDRESS("AltEmergencyContactAddress",$G(^DPT(PTID,.331)),4)
86 QUIT
87 ;
88ADDRESS(DATASET,ADGLOB,ZIP4) ;
89 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='"_DATASET_"'"
90 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1^"_$P(ADGLOB,"^",3)
91 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2^"_$P(ADGLOB,"^",4)
92 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street3^"_$P(ADGLOB,"^",5)
93 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City^"_$P(ADGLOB,"^",6)
94 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State^"_$$ADSTATE()
95 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip^"_$$ADZIP()
96 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber^"_$P(ADGLOB,"^",9)
97 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^NameOfContact^"_$P(ADGLOB,"^",1)
98 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RelationshipToPatient^"_$P(ADGLOB,"^",2)
99 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WorkPhoneNumber^"_$P(ADGLOB,"^",11)
100 SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
101 QUIT
102 ;
103ADSTATE() ;
104 NEW DATA
105 SET DATA=$P(ADGLOB,"^",7)
106 IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)
107 QUIT DATA
108 ;
109 Q
110ADZIP() ;
111 NEW DATA
112 SET DATA=$P(GLOB(.22),"^",ZIP4)
113 IF DATA="" SET DATA=$P(ADGLOB,"^",8)
114 QUIT DATA
115 Q
Note: See TracBrowser for help on using the repository browser.