VAFHLZCT ;ALB/ESD,TDM,JAM,KUM - Creation of ZCT segment ;12/9/09 2:10pm
;;5.3;Registration;**68,653,754,997,1067**;Aug 13, 1993;Build 23
;
; This generic extrinsic function transfers information pertaining to
; a patient's next of kin through the Emergency Contact (ZCT) segment.
;
;
EN(DFN,VAFSTR,VAFNUM,VAFTYPE,VAFNAMFT) ;function returns ZCT segment containing emergency contact info.
;
; Input:
; DFN -- Internal entry number of the PATIENT file.
; VAFSTR -- String of fields requested separated by commas
; VAFNUM -- Set Id (sequential number-if not passed, set to 1).
; VAFTYPE -- Contact type to determine type of data returned
; (1=NOK, 2=2nd NOK, 3=Emer Cont, 4=2nd Emer Cont,
; 5=Designee).
; VAFNAMFT -- Flag indicating to format the name field (SEQ-3)
; to HL7 XPN data type.(1=Format, 0=Do Not Format)
;
; Output: String of components forming ZCT segment.
;
; ****Also assumes all HL7 variables returned from****
; INIT^HLTRANS are defined.
;
N VAFNODE,VAFCNODE,X,X1,VAFY
I '$G(DFN)!($G(VAFSTR)']"") G QUIT
S $P(VAFY,HLFS,9)="",VAFSTR=","_VAFSTR_","
I "^1^2^3^4^5^"'[("^"_$G(VAFTYPE)_"^") S VAFTYPE=1
I $G(VAFNAMFT)<1 S VAFNAMFT=0
S VAFNODE=$P($T(TYPE+VAFTYPE),";;",2),VAFCNODE=$G(^DPT(DFN,VAFNODE))
S $P(VAFY,HLFS,1)=$S($G(VAFNUM):+VAFNUM\1,1:1) ; If Set Id not passed in, set to 1
S $P(VAFY,HLFS,2)=VAFTYPE ; Contact Type
I VAFSTR[",3," D ;Name of Next of Kin
. S X=$P(VAFCNODE,"^",1)
. I VAFNAMFT D
. . S X=$$HLNAME^XLFNAME(X,"",$E(HL("ECH"),1))
. . I X'="",$P(X,$E(HL("ECH"),1),7)'="L" S $P(X,$E(HL("ECH"),1),7)="L"
. S $P(VAFY,HLFS,3)=$S(X]"":X,1:HLQ)
I VAFSTR[",4," S X=$P(VAFCNODE,"^",2),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; Relationship to Patient
I VAFSTR[",5," D
. S X1=$G(^DPT(DFN,.22))
. ; DG*5.3*997; JAM; Add Country, Province and Postal Code to address build (pieces 12-14)
. S X=$$ADDR^VAFHLFNC($P(VAFCNODE,"^",3,7)_"^"_$P(X1,"^",$P($T(TYPE+VAFTYPE),";;",3))_"^"_$P(VAFCNODE,"^",12,14))
. S $P(VAFY,HLFS,5)=$S(X]"":$P(X,HLFS,1),1:HLQ) ; Next of Kin address
;
I VAFSTR[",6," S X=$$HLPHONE^HLFNC($P(VAFCNODE,"^",9)),$P(VAFY,HLFS,6)=$S(X]"":X,1:HLQ) ; Home Phone
I VAFSTR[",7," S X=$$HLPHONE^HLFNC($P(VAFCNODE,"^",11)),$P(VAFY,HLFS,7)=$S(X]"":X,1:HLQ) ; Work Phone
S X=$P(VAFCNODE,"^",10) ;Get this piece for next two fields
I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S(VAFTYPE=1!(VAFTYPE=2):$$YN^VAFHLFNC(X),1:HLQ) ; Contact Address Same as NOK?
I VAFSTR[",9," S $P(VAFY,HLFS,9)=$S(VAFTYPE=3!(VAFTYPE=5):$$YN^VAFHLFNC(X),1:HLQ) ; Contact Person Same as NOK?
I VAFSTR[",10," D ; Last Date/Time Updated
. ;Q:((VAFTYPE'=1)&(VAFTYPE'=2)) ; Currently only available for type 1 & 2
. I (VAFTYPE=1)!(VAFTYPE=2) S X=$P($G(^DPT(DFN,.212)),"^",VAFTYPE)
. I (VAFTYPE=3)!(VAFTYPE=4)!(VAFTYPE=5) S X=$P($G(^DPT(DFN,.332)),"^",(VAFTYPE-2))
. S $P(VAFY,HLFS,10)=$S(X'="":$$HLDATE^HLFNC(X),1:HLQ)
; DG*5.3*1067 - Add Relationship
I VAFSTR[",11," D
. N VAFFLD
. S VAFFLD=$S(VAFTYPE=1:".224",VAFTYPE=2:".2104",VAFTYPE=3:".3309",VAFTYPE=4:".331015",VAFTYPE=5:".34015",1:"")
. S X=$$GET1^DIQ(12.11,$$GET1^DIQ(2,DFN,VAFFLD,"I"),.01,"E")
. S $P(VAFY,HLFS,11)=$S(X]"":X,1:HLQ)
QUIT Q "ZCT"_HLFS_$G(VAFY)
TYPE ; Corresponding nodes for emergency contact type and ZIP+4 field piece.
;;.21;;7
;;.211;;3
;;.33;;1
;;.331;;4
;;.34;;2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZCT 3480 printed Nov 22, 2024@18:13:20 Page 2
VAFHLZCT ;ALB/ESD,TDM,JAM,KUM - Creation of ZCT segment ;12/9/09 2:10pm
+1 ;;5.3;Registration;**68,653,754,997,1067**;Aug 13, 1993;Build 23
+2 ;
+3 ; This generic extrinsic function transfers information pertaining to
+4 ; a patient's next of kin through the Emergency Contact (ZCT) segment.
+5 ;
+6 ;
EN(DFN,VAFSTR,VAFNUM,VAFTYPE,VAFNAMFT) ;function returns ZCT segment containing emergency contact info.
+1 ;
+2 ; Input:
+3 ; DFN -- Internal entry number of the PATIENT file.
+4 ; VAFSTR -- String of fields requested separated by commas
+5 ; VAFNUM -- Set Id (sequential number-if not passed, set to 1).
+6 ; VAFTYPE -- Contact type to determine type of data returned
+7 ; (1=NOK, 2=2nd NOK, 3=Emer Cont, 4=2nd Emer Cont,
+8 ; 5=Designee).
+9 ; VAFNAMFT -- Flag indicating to format the name field (SEQ-3)
+10 ; to HL7 XPN data type.(1=Format, 0=Do Not Format)
+11 ;
+12 ; Output: String of components forming ZCT segment.
+13 ;
+14 ; ****Also assumes all HL7 variables returned from****
+15 ; INIT^HLTRANS are defined.
+16 ;
+17 NEW VAFNODE,VAFCNODE,X,X1,VAFY
+18 IF '$GET(DFN)!($GET(VAFSTR)']"")
GOTO QUIT
+19 SET $PIECE(VAFY,HLFS,9)=""
SET VAFSTR=","_VAFSTR_","
+20 IF "^1^2^3^4^5^"'[("^"_$GET(VAFTYPE)_"^")
SET VAFTYPE=1
+21 IF $GET(VAFNAMFT)<1
SET VAFNAMFT=0
+22 SET VAFNODE=$PIECE($TEXT(TYPE+VAFTYPE),";;",2)
SET VAFCNODE=$GET(^DPT(DFN,VAFNODE))
+23 ; If Set Id not passed in, set to 1
SET $PIECE(VAFY,HLFS,1)=$SELECT($GET(VAFNUM):+VAFNUM\1,1:1)
+24 ; Contact Type
SET $PIECE(VAFY,HLFS,2)=VAFTYPE
+25 ;Name of Next of Kin
IF VAFSTR[",3,"
Begin DoDot:1
+26 SET X=$PIECE(VAFCNODE,"^",1)
+27 IF VAFNAMFT
Begin DoDot:2
+28 SET X=$$HLNAME^XLFNAME(X,"",$EXTRACT(HL("ECH"),1))
+29 IF X'=""
IF $PIECE(X,$EXTRACT(HL("ECH"),1),7)'="L"
SET $PIECE(X,$EXTRACT(HL("ECH"),1),7)="L"
End DoDot:2
+30 SET $PIECE(VAFY,HLFS,3)=$SELECT(X]"":X,1:HLQ)
End DoDot:1
+31 ; Relationship to Patient
IF VAFSTR[",4,"
SET X=$PIECE(VAFCNODE,"^",2)
SET $PIECE(VAFY,HLFS,4)=$SELECT(X]"":X,1:HLQ)
+32 IF VAFSTR[",5,"
Begin DoDot:1
+33 SET X1=$GET(^DPT(DFN,.22))
+34 ; DG*5.3*997; JAM; Add Country, Province and Postal Code to address build (pieces 12-14)
+35 SET X=$$ADDR^VAFHLFNC($PIECE(VAFCNODE,"^",3,7)_"^"_$PIECE(X1,"^",$PIECE($TEXT(TYPE+VAFTYPE),";;",3))_"^"_$PIECE(VAFCNODE,"^",12,14))
+36 ; Next of Kin address
SET $PIECE(VAFY,HLFS,5)=$SELECT(X]"":$PIECE(X,HLFS,1),1:HLQ)
End DoDot:1
+37 ;
+38 ; Home Phone
IF VAFSTR[",6,"
SET X=$$HLPHONE^HLFNC($PIECE(VAFCNODE,"^",9))
SET $PIECE(VAFY,HLFS,6)=$SELECT(X]"":X,1:HLQ)
+39 ; Work Phone
IF VAFSTR[",7,"
SET X=$$HLPHONE^HLFNC($PIECE(VAFCNODE,"^",11))
SET $PIECE(VAFY,HLFS,7)=$SELECT(X]"":X,1:HLQ)
+40 ;Get this piece for next two fields
SET X=$PIECE(VAFCNODE,"^",10)
+41 ; Contact Address Same as NOK?
IF VAFSTR[",8,"
SET $PIECE(VAFY,HLFS,8)=$SELECT(VAFTYPE=1!(VAFTYPE=2):$$YN^VAFHLFNC(X),1:HLQ)
+42 ; Contact Person Same as NOK?
IF VAFSTR[",9,"
SET $PIECE(VAFY,HLFS,9)=$SELECT(VAFTYPE=3!(VAFTYPE=5):$$YN^VAFHLFNC(X),1:HLQ)
+43 ; Last Date/Time Updated
IF VAFSTR[",10,"
Begin DoDot:1
+44 ;Q:((VAFTYPE'=1)&(VAFTYPE'=2)) ; Currently only available for type 1 & 2
+45 IF (VAFTYPE=1)!(VAFTYPE=2)
SET X=$PIECE($GET(^DPT(DFN,.212)),"^",VAFTYPE)
+46 IF (VAFTYPE=3)!(VAFTYPE=4)!(VAFTYPE=5)
SET X=$PIECE($GET(^DPT(DFN,.332)),"^",(VAFTYPE-2))
+47 SET $PIECE(VAFY,HLFS,10)=$SELECT(X'="":$$HLDATE^HLFNC(X),1:HLQ)
End DoDot:1
+48 ; DG*5.3*1067 - Add Relationship
+49 IF VAFSTR[",11,"
Begin DoDot:1
+50 NEW VAFFLD
+51 SET VAFFLD=$SELECT(VAFTYPE=1:".224",VAFTYPE=2:".2104",VAFTYPE=3:".3309",VAFTYPE=4:".331015",VAFTYPE=5:".34015",1:"")
+52 SET X=$$GET1^DIQ(12.11,$$GET1^DIQ(2,DFN,VAFFLD,"I"),.01,"E")
+53 SET $PIECE(VAFY,HLFS,11)=$SELECT(X]"":X,1:HLQ)
End DoDot:1
QUIT QUIT "ZCT"_HLFS_$GET(VAFY)
TYPE ; Corresponding nodes for emergency contact type and ZIP+4 field piece.
+1 ;;.21;;7
+2 ;;.211;;3
+3 ;;.33;;1
+4 ;;.331;;4
+5 ;;.34;;2
