DGRRPSKN ; ALB/SGG - rtnDGRR PatientServices Contact Information ;09/30/03 ; Compiled October 21, 2003 14:54:28
;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21
;
DOC ;<DataSet Name='NextOfKinAddress'
;
;
;=======================================================
; PRIMARY NEXT OF KIN
;.211 K-NAME OF PRIMARY NOK (FaX), [.21;1]
;.212 K-RELATIONSHIP TO PATIENT (FX), [.21;2]
;.213 K-STREET ADDRESS [LINE 1] (FX), [.21;3]
;.214 K-STREET ADDRESS [LINE 2] (FX), [.21;4]
;.215 K-STREET ADDRESS [LINE 3] (FX), [.21;5]
;.216 K-CITY (FX), [.21;6]
;.217 K-STATE (P5'X), [.21;7]
; .2207 K-ZIP+4 (FOX), [.22;7]
;.218 K-ZIP CODE (FX), [.21;8]
;.219 K-PHONE NUMBER (FXa), [.21;9]
;.21011 K-WORK PHONE NUMBER (F), [.21;11]
;
;=======================================================
;SECONDARY NEXT OF KIN
;.2191 K2-NAME OF SECONDARY NOK (FX), [.211;1]
;.2192 K2-RELATIONSHIP TO PATIENT (FX), [.211;2]
;.2193 K2-STREET ADDRESS [LINE 1] (FX), [.211;3]
;.2194 K2-STREET ADDRESS [LINE 2] (FX), [.211;4]
;.2195 K2-STREET ADDRESS [LINE 3] (FX), [.211;5]
;.2196 K2-CITY (FX), [.211;6]
;.2197 K2-STATE (P5'X), [.211;7]
;.2198 K2-ZIP CODE (FX), [.211;8]
; .2203 K2-ZIP+4 (FOX), [.22;3]
;.2199 K2-PHONE NUMBER (FX), [.211;9]
;.211011 K2-WORK PHONE NUMBER (F), [.211;11]
;
;=======================================================
; DESIGNEE
;.341 D-NAME OF DESIGNEE (FX), [.34;1]
;.342 D-RELATIONSHIP TO PATIENT (FX), [.34;2]
;.343 D-STREET ADDRESS [LINE 1] (FX), [.34;3]
;.344 D-STREET ADDRESS [LINE 2] (FX), [.34;4]
;.345 D-STREET ADDRESS [LINE 3] (FX), [.34;5]
;.346 D-CITY (FX), [.34;6]
;.347 D-STATE (P5'X), [.34;7]
;.348 D-ZIP CODE (FX), [.34;8]
; .2202 D-ZIP+4 (FOX), [.22;2]
;.349 D-PHONE NUMBER (FX), [.34;9]
;.34011 D-WORK PHONE NUMBER (F), [.34;11]
;
;=======================================================
; EMERGENCY CONTACT
;.331 E-NAME (FX), [.33;1]
;.332 E-RELATIONSHIP TO PATIENT (FX), [.33;2]
;.333 E-STREET ADDRESS [LINE 1] (FX), [.33;3]
;.334 E-STREET ADDRESS [LINE 2] (FX), [.33;4]
;.335 E-STREET ADDRESS [LINE 3] (FX), [.33;5]
;.336 E-CITY (FX), [.33;6]
;.337 E-STATE (P5'X), [.33;7]
;.338 E-ZIP CODE (FX), [.33;8]
; .2201 E-ZIP+4 (FOX), [.22;1]
;.339 E-PHONE NUMBER (FX), [.33;9]
;.33011 E-WORK PHONE NUMBER (F), [.33;11]
;
;=======================================================
; SECONDARY EMERGENCY CONTACT
;.3311 E2-NAME OF SECONDARY CONTACT (FX), [.331;1]
;.3312 E2-RELATIONSHIP TO PATIENT (FX), [.331;2]
;.3313 E2-STREET ADDRESS [LINE 1] (FX), [.331;3]
;.3314 E2-STREET ADDRESS [LINE 2] (FX), [.331;4]
;.3315 E2-STREET ADDRESS [LINE 3] (FX), [.331;5]
;.3316 E2-CITY (FX), [.331;6]
;.3317 E2-STATE (P5'X), [.331;7]
;.3318 E2-ZIP CODE (FX), [.331;8]
; .2204 E2-ZIP+4 (FOX), [.22;4]
;.3319 E2-PHONE NUMBER (FX), [.331;9]
;.331011 E2-WORK PHONE NUMBER (F), [.331;11]
;
;=======================================================
;
GETPSARY(PSARRAY) ;
NEW CNT
DO ADDRESS("NextOfKinAddress",$G(^DPT(PTID,.21)),7)
DO ADDRESS("AltNextOfKinAddress",$G(^DPT(PTID,.211)),3)
DO ADDRESS("DesigneeAddress",$G(^DPT(PTID,.34)),2)
DO ADDRESS("EmergencyContactAddress",$G(^DPT(PTID,.33)),1)
DO ADDRESS("AltEmergencyContactAddress",$G(^DPT(PTID,.331)),4)
QUIT
;
ADDRESS(DATASET,ADGLOB,ZIP4) ;
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='"_DATASET_"'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1^"_$P(ADGLOB,"^",3)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2^"_$P(ADGLOB,"^",4)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street3^"_$P(ADGLOB,"^",5)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City^"_$P(ADGLOB,"^",6)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State^"_$$ADSTATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip^"_$$ADZIP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber^"_$P(ADGLOB,"^",9)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^NameOfContact^"_$P(ADGLOB,"^",1)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RelationshipToPatient^"_$P(ADGLOB,"^",2)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WorkPhoneNumber^"_$P(ADGLOB,"^",11)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
QUIT
;
ADSTATE() ;
NEW DATA
SET DATA=$P(ADGLOB,"^",7)
IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)
QUIT DATA
;
Q
ADZIP() ;
NEW DATA
SET DATA=$P(GLOB(.22),"^",ZIP4)
IF DATA="" SET DATA=$P(ADGLOB,"^",8)
QUIT DATA
Q
DGRRPSKN ; ALB/SGG - rtnDGRR PatientServices Contact Information ;09/30/03 ; Compiled October 21, 2003 14:54:28
+1 ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21
+2 ;
DOC ;<DataSet Name='NextOfKinAddress'
+1 ;
+2 ;
+3 ;=======================================================
+4 ; PRIMARY NEXT OF KIN
+5 ;.211 K-NAME OF PRIMARY NOK (FaX), [.21;1]
+6 ;.212 K-RELATIONSHIP TO PATIENT (FX), [.21;2]
+7 ;.213 K-STREET ADDRESS [LINE 1] (FX), [.21;3]
+8 ;.214 K-STREET ADDRESS [LINE 2] (FX), [.21;4]
+9 ;.215 K-STREET ADDRESS [LINE 3] (FX), [.21;5]
+10 ;.216 K-CITY (FX), [.21;6]
+11 ;.217 K-STATE (P5'X), [.21;7]
+12 ; .2207 K-ZIP+4 (FOX), [.22;7]
+13 ;.218 K-ZIP CODE (FX), [.21;8]
+14 ;.219 K-PHONE NUMBER (FXa), [.21;9]
+15 ;.21011 K-WORK PHONE NUMBER (F), [.21;11]
+16 ;
+17 ;=======================================================
+18 ;SECONDARY NEXT OF KIN
+19 ;.2191 K2-NAME OF SECONDARY NOK (FX), [.211;1]
+20 ;.2192 K2-RELATIONSHIP TO PATIENT (FX), [.211;2]
+21 ;.2193 K2-STREET ADDRESS [LINE 1] (FX), [.211;3]
+22 ;.2194 K2-STREET ADDRESS [LINE 2] (FX), [.211;4]
+23 ;.2195 K2-STREET ADDRESS [LINE 3] (FX), [.211;5]
+24 ;.2196 K2-CITY (FX), [.211;6]
+25 ;.2197 K2-STATE (P5'X), [.211;7]
+26 ;.2198 K2-ZIP CODE (FX), [.211;8]
+27 ; .2203 K2-ZIP+4 (FOX), [.22;3]
+28 ;.2199 K2-PHONE NUMBER (FX), [.211;9]
+29 ;.211011 K2-WORK PHONE NUMBER (F), [.211;11]
+30 ;
+31 ;=======================================================
+32 ; DESIGNEE
+33 ;.341 D-NAME OF DESIGNEE (FX), [.34;1]
+34 ;.342 D-RELATIONSHIP TO PATIENT (FX), [.34;2]
+35 ;.343 D-STREET ADDRESS [LINE 1] (FX), [.34;3]
+36 ;.344 D-STREET ADDRESS [LINE 2] (FX), [.34;4]
+37 ;.345 D-STREET ADDRESS [LINE 3] (FX), [.34;5]
+38 ;.346 D-CITY (FX), [.34;6]
+39 ;.347 D-STATE (P5'X), [.34;7]
+40 ;.348 D-ZIP CODE (FX), [.34;8]
+41 ; .2202 D-ZIP+4 (FOX), [.22;2]
+42 ;.349 D-PHONE NUMBER (FX), [.34;9]
+43 ;.34011 D-WORK PHONE NUMBER (F), [.34;11]
+44 ;
+45 ;=======================================================
+46 ; EMERGENCY CONTACT
+47 ;.331 E-NAME (FX), [.33;1]
+48 ;.332 E-RELATIONSHIP TO PATIENT (FX), [.33;2]
+49 ;.333 E-STREET ADDRESS [LINE 1] (FX), [.33;3]
+50 ;.334 E-STREET ADDRESS [LINE 2] (FX), [.33;4]
+51 ;.335 E-STREET ADDRESS [LINE 3] (FX), [.33;5]
+52 ;.336 E-CITY (FX), [.33;6]
+53 ;.337 E-STATE (P5'X), [.33;7]
+54 ;.338 E-ZIP CODE (FX), [.33;8]
+55 ; .2201 E-ZIP+4 (FOX), [.22;1]
+56 ;.339 E-PHONE NUMBER (FX), [.33;9]
+57 ;.33011 E-WORK PHONE NUMBER (F), [.33;11]
+58 ;
+59 ;=======================================================
+60 ; SECONDARY EMERGENCY CONTACT
+61 ;.3311 E2-NAME OF SECONDARY CONTACT (FX), [.331;1]
+62 ;.3312 E2-RELATIONSHIP TO PATIENT (FX), [.331;2]
+63 ;.3313 E2-STREET ADDRESS [LINE 1] (FX), [.331;3]
+64 ;.3314 E2-STREET ADDRESS [LINE 2] (FX), [.331;4]
+65 ;.3315 E2-STREET ADDRESS [LINE 3] (FX), [.331;5]
+66 ;.3316 E2-CITY (FX), [.331;6]
+67 ;.3317 E2-STATE (P5'X), [.331;7]
+68 ;.3318 E2-ZIP CODE (FX), [.331;8]
+69 ; .2204 E2-ZIP+4 (FOX), [.22;4]
+70 ;.3319 E2-PHONE NUMBER (FX), [.331;9]
+71 ;.331011 E2-WORK PHONE NUMBER (F), [.331;11]
+72 ;
+73 ;=======================================================
+74 ;
GETPSARY(PSARRAY) ;
+1 NEW CNT
+2 DO ADDRESS("NextOfKinAddress",$GET(^DPT(PTID,.21)),7)
+3 DO ADDRESS("AltNextOfKinAddress",$GET(^DPT(PTID,.211)),3)
+4 DO ADDRESS("DesigneeAddress",$GET(^DPT(PTID,.34)),2)
+5 DO ADDRESS("EmergencyContactAddress",$GET(^DPT(PTID,.33)),1)
+6 DO ADDRESS("AltEmergencyContactAddress",$GET(^DPT(PTID,.331)),4)
+7 QUIT
+8 ;
ADDRESS(DATASET,ADGLOB,ZIP4) ;
+1 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<DataSet Name='"_DATASET_"'"
+2 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street1^"_$PIECE(ADGLOB,"^",3)
+3 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street2^"_$PIECE(ADGLOB,"^",4)
+4 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street3^"_$PIECE(ADGLOB,"^",5)
+5 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^City^"_$PIECE(ADGLOB,"^",6)
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^State^"_$$ADSTATE()
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Zip^"_$$ADZIP()
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^PhoneNumber^"_$PIECE(ADGLOB,"^",9)
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^NameOfContact^"_$PIECE(ADGLOB,"^",1)
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RelationshipToPatient^"_$PIECE(ADGLOB,"^",2)
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^WorkPhoneNumber^"_$PIECE(ADGLOB,"^",11)
+12 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></DataSet>"_"^^^1"
+13 QUIT
+14 ;
ADSTATE() ;
+1 NEW DATA
+2 SET DATA=$PIECE(ADGLOB,"^",7)
+3 IF DATA'=""
SET DATA=$PIECE($GET(^DIC(5,DATA,0)),"^",2)
+4 QUIT DATA
+5 ;
+6 QUIT
ADZIP() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(.22),"^",ZIP4)
+3 IF DATA=""
SET DATA=$PIECE(ADGLOB,"^",8)
+4 QUIT DATA
+5 QUIT
