- 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
