source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLZCT.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1VAFHLZCT ;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 ;
8EN(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)
54QUIT Q "ZCT"_HLFS_$G(VAFY)
55TYPE ; 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
Note: See TracBrowser for help on using the repository browser.