DGRRPSKN ; ALB/SGG,JAM - rtnDGRR PatientServices Contact Information ;09/30/03 ; Compiled October 21, 2003 14:54:28
;;5.3;Registration;**557,1067**;Aug 13, 1993;Build 23
;
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]
;.224 K-RELATIONSHIP TYPE [.21;15]
;
;=======================================================
;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]
;.2104 K2-RELATIONSHIP TYPE [.211;15]
;
;=======================================================
; 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]
;.34015 D-RELATIONSHIP TYPE [.34;15]
;
;=======================================================
; 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]
;.3309 E-RELATIONSHIP TYPE [.33;15]
;
;=======================================================
; 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]
;.331015 E2-RELATIONSHIP TYPE [.331;15]
;
;=======================================================
;
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)
; Patch DG*5.3*1067; Add RELATIONSHIP TYPE field - Return NAME (#.02) field from the PATIENT CONTACT RELATION file #12.11
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RelationshipType^"_$$GET1^DIQ(12.11,$P(ADGLOB,"^",15),.02)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRPSKN 5771 printed Apr 09, 2024@21:43:15 Page 2
DGRRPSKN ; ALB/SGG,JAM - rtnDGRR PatientServices Contact Information ;09/30/03 ; Compiled October 21, 2003 14:54:28
+1 ;;5.3;Registration;**557,1067**;Aug 13, 1993;Build 23
+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 ;.224 K-RELATIONSHIP TYPE [.21;15]
+17 ;
+18 ;=======================================================
+19 ;SECONDARY NEXT OF KIN
+20 ;.2191 K2-NAME OF SECONDARY NOK (FX), [.211;1]
+21 ;.2192 K2-RELATIONSHIP TO PATIENT (FX), [.211;2]
+22 ;.2193 K2-STREET ADDRESS [LINE 1] (FX), [.211;3]
+23 ;.2194 K2-STREET ADDRESS [LINE 2] (FX), [.211;4]
+24 ;.2195 K2-STREET ADDRESS [LINE 3] (FX), [.211;5]
+25 ;.2196 K2-CITY (FX), [.211;6]
+26 ;.2197 K2-STATE (P5'X), [.211;7]
+27 ;.2198 K2-ZIP CODE (FX), [.211;8]
+28 ; .2203 K2-ZIP+4 (FOX), [.22;3]
+29 ;.2199 K2-PHONE NUMBER (FX), [.211;9]
+30 ;.211011 K2-WORK PHONE NUMBER (F), [.211;11]
+31 ;.2104 K2-RELATIONSHIP TYPE [.211;15]
+32 ;
+33 ;=======================================================
+34 ; DESIGNEE
+35 ;.341 D-NAME OF DESIGNEE (FX), [.34;1]
+36 ;.342 D-RELATIONSHIP TO PATIENT (FX), [.34;2]
+37 ;.343 D-STREET ADDRESS [LINE 1] (FX), [.34;3]
+38 ;.344 D-STREET ADDRESS [LINE 2] (FX), [.34;4]
+39 ;.345 D-STREET ADDRESS [LINE 3] (FX), [.34;5]
+40 ;.346 D-CITY (FX), [.34;6]
+41 ;.347 D-STATE (P5'X), [.34;7]
+42 ;.348 D-ZIP CODE (FX), [.34;8]
+43 ; .2202 D-ZIP+4 (FOX), [.22;2]
+44 ;.349 D-PHONE NUMBER (FX), [.34;9]
+45 ;.34011 D-WORK PHONE NUMBER (F), [.34;11]
+46 ;.34015 D-RELATIONSHIP TYPE [.34;15]
+47 ;
+48 ;=======================================================
+49 ; EMERGENCY CONTACT
+50 ;.331 E-NAME (FX), [.33;1]
+51 ;.332 E-RELATIONSHIP TO PATIENT (FX), [.33;2]
+52 ;.333 E-STREET ADDRESS [LINE 1] (FX), [.33;3]
+53 ;.334 E-STREET ADDRESS [LINE 2] (FX), [.33;4]
+54 ;.335 E-STREET ADDRESS [LINE 3] (FX), [.33;5]
+55 ;.336 E-CITY (FX), [.33;6]
+56 ;.337 E-STATE (P5'X), [.33;7]
+57 ;.338 E-ZIP CODE (FX), [.33;8]
+58 ; .2201 E-ZIP+4 (FOX), [.22;1]
+59 ;.339 E-PHONE NUMBER (FX), [.33;9]
+60 ;.33011 E-WORK PHONE NUMBER (F), [.33;11]
+61 ;.3309 E-RELATIONSHIP TYPE [.33;15]
+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 ;.331015 E2-RELATIONSHIP TYPE [.331;15]
+77 ;
+78 ;=======================================================
+79 ;
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 ; Patch DG*5.3*1067; Add RELATIONSHIP TYPE field - Return NAME (#.02) field from the PATIENT CONTACT RELATION file #12.11
+13 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RelationshipType^"_$$GET1^DIQ(12.11,$PIECE(ADGLOB,"^",15),.02)
+14 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></DataSet>"_"^^^1"
+15 QUIT
+16 ;
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
