[613] | 1 | VAFHLZEM ;ALB/KCL - Create generic HL7 ZEM segment ; 22 Febuary 1993
|
---|
| 2 | ;;5.3;Registration;**68**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | EN(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
|
---|
| 28 | QUIT ;
|
---|
| 29 | Q "ZEM"_HLFS_$G(VAFY)
|
---|
| 30 | ;
|
---|
| 31 | PATZEM ; 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 | ;
|
---|
| 42 | SPOUZEM ; 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
|
---|