- VAFHLZCT ;ALB/ESD,TDM - Creation of ZCT segment ; 12/9/09 2:10pm
- ;;5.3;PIMS;**68,653,1015,1016**;JUN 30, 2012;Build 20
- ;
- ; 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))
- . S X=$$ADDR^VAFHLFNC($P(VAFCNODE,"^",3,7)_"^"_$P(X1,"^",$P($T(TYPE+VAFTYPE),";;",3)))
- . 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)
- 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
- VAFHLZCT ;ALB/ESD,TDM - Creation of ZCT segment ; 12/9/09 2:10pm
- +1 ;;5.3;PIMS;**68,653,1015,1016**;JUN 30, 2012;Build 20
- +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 SET X=$$ADDR^VAFHLFNC($PIECE(VAFCNODE,"^",3,7)_"^"_$PIECE(X1,"^",$PIECE($TEXT(TYPE+VAFTYPE),";;",3)))
- +35 ; Next of Kin address
- SET $PIECE(VAFY,HLFS,5)=$SELECT(X]"":$PIECE(X,HLFS,1),1:HLQ)
- End DoDot:1
- +36 ;
- +37 ; Home Phone
- IF VAFSTR[",6,"
- SET X=$$HLPHONE^HLFNC($PIECE(VAFCNODE,"^",9))
- SET $PIECE(VAFY,HLFS,6)=$SELECT(X]"":X,1:HLQ)
- +38 ; Work Phone
- IF VAFSTR[",7,"
- SET X=$$HLPHONE^HLFNC($PIECE(VAFCNODE,"^",11))
- SET $PIECE(VAFY,HLFS,7)=$SELECT(X]"":X,1:HLQ)
- +39 ;Get this piece for next two fields
- SET X=$PIECE(VAFCNODE,"^",10)
- +40 ; Contact Address Same as NOK?
- IF VAFSTR[",8,"
- SET $PIECE(VAFY,HLFS,8)=$SELECT(VAFTYPE=1!(VAFTYPE=2):$$YN^VAFHLFNC(X),1:HLQ)
- +41 ; Contact Person Same as NOK?
- IF VAFSTR[",9,"
- SET $PIECE(VAFY,HLFS,9)=$SELECT(VAFTYPE=3!(VAFTYPE=5):$$YN^VAFHLFNC(X),1:HLQ)
- +42 ; Last Date/Time Updated
- IF VAFSTR[",10,"
- Begin DoDot:1
- +43 ;Q:((VAFTYPE'=1)&(VAFTYPE'=2)) ; Currently only available for type 1 & 2
- +44 IF (VAFTYPE=1)!(VAFTYPE=2)
- SET X=$PIECE($GET(^DPT(DFN,.212)),"^",VAFTYPE)
- +45 IF (VAFTYPE=3)!(VAFTYPE=4)!(VAFTYPE=5)
- SET X=$PIECE($GET(^DPT(DFN,.332)),"^",(VAFTYPE-2))
- +46 SET $PIECE(VAFY,HLFS,10)=$SELECT(X'="":$$HLDATE^HLFNC(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
