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

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1VAFHLZGD ;ALB/KCL/CPM - Create generic HL7 ZGD segment ; 17 Febuary 1993
2 ;;5.3;Registration;**33,68**;Aug 13, 1993
3 ;
4 ;
5EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was
6 ; designed to return the HL7 ZGD
7 ; segment. This segment contains
8 ; generic information pertaining to
9 ; a patient's legal guardian.
10 ;
11 ; Input - DFN as internal entry number of the PATIENT file.
12 ; VAFSTR as string of fields requested separated by commas
13 ; VAFREQ is 1 if VA guardian data is requested, 2 if Civil
14 ; guardian data is requested.
15 ; VAFNUM as sequential number to add to SET ID.
16 ;
17 ; *****Also assumes all HL7 variables returned from*****
18 ; INIT^HLTRANS are defined.
19 ;
20 ; Output - String of data forming the HL7 ZGD segment.
21 ;
22 N VAFNODE,VAFY,X,X1
23 I '$G(DFN)!($G(VAFSTR)']"") G QUIT
24 I $G(VAFREQ)'=2 S VAFREQ=1 ; Default to VA guardian
25 S $P(VAFY,HLFS,8)="",VAFSTR=","_VAFSTR_","
26 S X=$P($T(GUAR+VAFREQ),";;",2),VAFNODE=$G(^DPT(DFN,X))
27 S $P(VAFY,HLFS,1)=$G(VAFNUM)+1 ; Sequential number (Required field)
28 S $P(VAFY,HLFS,2)=VAFREQ ; Guardian type (Required field)
29 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(VAFNODE,"^",4)]"":$P(VAFNODE,"^",4),1:HLQ) ; Guardian
30 I VAFSTR[",4," S X=$P(VAFNODE,"^",3),X1=$S(VAFREQ=1:$P($G(^DIC(4,+X,0)),"^",1),1:X),$P(VAFY,HLFS,4)=$S(X1]"":X1,1:HLQ) ; Guardian Institution
31 I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(VAFNODE,"^",5)]"":$P(VAFNODE,"^",5),1:HLQ) ; Relationship
32 I VAFSTR[",6," S X1=$$ADDR^VAFHLFNC($P(VAFNODE,"^",6,7)_"^^"_$P(VAFNODE,"^",8,9)_"^"_$P(VAFNODE,"^",$P($T(GUAR+VAFREQ),";;",3))),$P(VAFY,HLFS,6)=$S(X1]"":X1,1:HLQ) ; Address
33 I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(VAFNODE,"^",11)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Phone
34 I VAFSTR[",8," S X1=$$HLDATE^HLFNC($P($G(^DPT(DFN,.29)),"^",VAFREQ)),$P(VAFY,HLFS,8)=$S(X1]"":X1,1:HLQ) ; Date Ruled Incomp
35 ;
36QUIT ;
37 Q "ZGD"_HLFS_$G(VAFY)
38 ;
39GUAR ; Corresponding nodes for guarantor type and ZIPZ+4 field piece.
40 ;;.29;;13
41 ;;.291;;12
Note: See TracBrowser for help on using the repository browser.