| 1 | VAFHLZCT ;ALB/ESD,TDM - Creation of ZCT segment ; 9/19/05 11:44am
|
|---|
| 2 | ;;5.3;Registration;**68,653**;Aug 13, 1993;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; This generic extrinsic function transfers information pertaining to
|
|---|
| 5 | ; a patient's next of kin through the Emergency Contact (ZCT) segment.
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | EN(DFN,VAFSTR,VAFNUM,VAFTYPE,VAFNAMFT) ;function returns ZCT segment containing emergency contact info.
|
|---|
| 9 | ;
|
|---|
| 10 | ; Input:
|
|---|
| 11 | ; DFN -- Internal entry number of the PATIENT file.
|
|---|
| 12 | ; VAFSTR -- String of fields requested separated by commas
|
|---|
| 13 | ; VAFNUM -- Set Id (sequential number-if not passed, set to 1).
|
|---|
| 14 | ; VAFTYPE -- Contact type to determine type of data returned
|
|---|
| 15 | ; (1=NOK, 2=2nd NOK, 3=Emer Cont, 4=2nd Emer Cont,
|
|---|
| 16 | ; 5=Designee).
|
|---|
| 17 | ; VAFNAMFT -- Flag indicating to format the name field (SEQ-3)
|
|---|
| 18 | ; to HL7 XPN data type.(1=Format, 0=Do Not Format)
|
|---|
| 19 | ;
|
|---|
| 20 | ; Output: String of components forming ZCT segment.
|
|---|
| 21 | ;
|
|---|
| 22 | ; ****Also assumes all HL7 variables returned from****
|
|---|
| 23 | ; INIT^HLTRANS are defined.
|
|---|
| 24 | ;
|
|---|
| 25 | N VAFNODE,VAFCNODE,X,X1,VAFY
|
|---|
| 26 | I '$G(DFN)!($G(VAFSTR)']"") G QUIT
|
|---|
| 27 | S $P(VAFY,HLFS,9)="",VAFSTR=","_VAFSTR_","
|
|---|
| 28 | I "^1^2^3^4^5^"'[("^"_$G(VAFTYPE)_"^") S VAFTYPE=1
|
|---|
| 29 | I $G(VAFNAMFT)<1 S VAFNAMFT=0
|
|---|
| 30 | S VAFNODE=$P($T(TYPE+VAFTYPE),";;",2),VAFCNODE=$G(^DPT(DFN,VAFNODE))
|
|---|
| 31 | S $P(VAFY,HLFS,1)=$S($G(VAFNUM):+VAFNUM\1,1:1) ; If Set Id not passed in, set to 1
|
|---|
| 32 | S $P(VAFY,HLFS,2)=VAFTYPE ; Contact Type
|
|---|
| 33 | I VAFSTR[",3," D ;Name of Next of Kin
|
|---|
| 34 | . S X=$P(VAFCNODE,"^",1)
|
|---|
| 35 | . I VAFNAMFT D
|
|---|
| 36 | . . S X=$$HLNAME^XLFNAME(X,"",$E(HL("ECH"),1))
|
|---|
| 37 | . . I X'="",$P(X,$E(HL("ECH"),1),7)'="L" S $P(X,$E(HL("ECH"),1),7)="L"
|
|---|
| 38 | . S $P(VAFY,HLFS,3)=$S(X]"":X,1:HLQ)
|
|---|
| 39 | I VAFSTR[",4," S X=$P(VAFCNODE,"^",2),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; Relationship to Patient
|
|---|
| 40 | I VAFSTR[",5," D
|
|---|
| 41 | . S X1=$G(^DPT(DFN,.22))
|
|---|
| 42 | . S X=$$ADDR^VAFHLFNC($P(VAFCNODE,"^",3,7)_"^"_$P(X1,"^",$P($T(TYPE+VAFTYPE),";;",3)))
|
|---|
| 43 | . S $P(VAFY,HLFS,5)=$S(X]"":$P(X,HLFS,1),1:HLQ) ; Next of Kin address
|
|---|
| 44 | ;
|
|---|
| 45 | I VAFSTR[",6," S X=$$HLPHONE^HLFNC($P(VAFCNODE,"^",9)),$P(VAFY,HLFS,6)=$S(X]"":X,1:HLQ) ; Home Phone
|
|---|
| 46 | I VAFSTR[",7," S X=$$HLPHONE^HLFNC($P(VAFCNODE,"^",11)),$P(VAFY,HLFS,7)=$S(X]"":X,1:HLQ) ; Work Phone
|
|---|
| 47 | S X=$P(VAFCNODE,"^",10) ;Get this piece for next two fields
|
|---|
| 48 | I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S(VAFTYPE=1!(VAFTYPE=2):$$YN^VAFHLFNC(X),1:HLQ) ; Contact Address Same as NOK?
|
|---|
| 49 | I VAFSTR[",9," S $P(VAFY,HLFS,9)=$S(VAFTYPE=3!(VAFTYPE=5):$$YN^VAFHLFNC(X),1:HLQ) ; Contact Person Same as NOK?
|
|---|
| 50 | I VAFSTR[",10," D ; Last Date/Time Updated
|
|---|
| 51 | . Q:((VAFTYPE'=1)&(VAFTYPE'=2)) ; Currently only available for type 1 & 2
|
|---|
| 52 | . S X=$P($G(^DPT(DFN,.212)),"^",VAFTYPE)
|
|---|
| 53 | . S $P(VAFY,HLFS,10)=$S(X'="":$$HLDATE^HLFNC(X),1:HLQ)
|
|---|
| 54 | QUIT Q "ZCT"_HLFS_$G(VAFY)
|
|---|
| 55 | TYPE ; Corresponding nodes for emergency contact type and ZIP+4 field piece.
|
|---|
| 56 | ;;.21;;7
|
|---|
| 57 | ;;.211;;3
|
|---|
| 58 | ;;.33;;1
|
|---|
| 59 | ;;.331;;4
|
|---|
| 60 | ;;.34;;2
|
|---|
