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

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1VAFHLZEM ;ALB/KCL - Create generic HL7 ZEM segment ; 22 Febuary 1993
2 ;;5.3;Registration;**68**;Aug 13, 1993
3 ;
4 ;
5EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was
6 ; designed to return the HL7 ZEM segment. This
7 ; segment contains VA-specific information
8 ; pertaining to the employment of a patient or
9 ; his/her spouse.
10 ;
11 ; Input - DFN as internal entry number of the PATIENT file.
12 ; VAFSTR as the string of fields requested seperated by commas.
13 ; VAFREQ is 1 for PATIENT request, is 2 for SPOUSAL request.
14 ; If nothing is passed default to PATIENT request.
15 ; VAFNUM as sequential number to add to SETID.
16 ;
17 ; *****Also assumes all HL7 variables returned from*****
18 ; INIT^HLTRANS are defined.
19 ;
20 ; Output - String of data forming the HL7 ZEM segment.
21 ;
22 N X,X1,VAFY
23 I '$G(DFN)!($G(VAFSTR)']"") G QUIT
24 S $P(VAFY,HLFS,8)="",VAFSTR=","_VAFSTR_",",VAFREQ=$G(VAFREQ)
25 S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) ; Sequential number (required field)
26 I VAFREQ'=2 S $P(VAFY,HLFS,2)=1 D PATZEM
27 I VAFREQ=2 S $P(VAFY,HLFS,2)=2 D SPOUZEM
28QUIT ;
29 Q "ZEM"_HLFS_$G(VAFY)
30 ;
31PATZEM ; Patient data requested.
32 S X=$G(^DPT(DFN,.311))
33 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
34 I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
35 I VAFSTR[",5," S X1=$P($G(^DPT(DFN,0)),"^",7),$P(VAFY,HLFS,5)=$S(X1]"":X1,1:HLQ) ; Occupation.
36 I VAFSTR[",6," S X1=$$ADDR^VAFHLFNC($P(X,"^",3,7)_"^"_$P($G(^DPT(DFN,.22)),"^",5)),$P(VAFY,HLFS,6)=$S(X1]"":X1,1:HLQ) ; Employer Address.
37 I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",9)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
38 I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P(X,"^",2)),$P(VAFY,HLFS,8)=$S(X1]"":X1,1:HLQ) ; Government Agency.
39 ;I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(X,"^",2)]"":$P(X,"^",2),1:HLQ) ; Government Agency.
40 Q
41 ;
42SPOUZEM ; Spousal data requested.
43 S X=$G(^DPT(DFN,.25))
44 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
45 I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
46 I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(X,"^",14)]"":$P(X,"^",14),1:HLQ) ; Occupation.
47 I VAFSTR[",6," S X1=$$ADDR^VAFHLFNC($P(X,"^",2,6)_"^"_$P($G(^DPT(DFN,.22)),"^",6)),$P(VAFY,HLFS,6)=$S(X1]"":X1,1:HLQ) ; Employer Address.
48 I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",8)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
49 I VAFSTR[",8," S $P(VAFY,HLFS,8)=HLQ
50 Q
Note: See TracBrowser for help on using the repository browser.