Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZEM

VAFHLZEM.m

Go to the documentation of this file.
  1. VAFHLZEM ;ALB/KCL,TDM - Create generic HL7 ZEM segment ; 12/22/08 4:37pm
  1. ;;5.3;Registration;**68,754**;Aug 13, 1993;Build 46
  1. ;
  1. ;
  1. EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was
  1. ; designed to return the HL7 ZEM segment. This
  1. ; segment contains VA-specific information
  1. ; pertaining to the employment of a patient or
  1. ; his/her spouse.
  1. ;
  1. ; Input - DFN as internal entry number of the PATIENT file.
  1. ; VAFSTR as the string of fields requested seperated by commas.
  1. ; VAFREQ is 1 for PATIENT request, is 2 for SPOUSAL request.
  1. ; If nothing is passed default to PATIENT request.
  1. ; VAFNUM as sequential number to add to SETID.
  1. ;
  1. ; *****Also assumes all HL7 variables returned from*****
  1. ; INIT^HLTRANS are defined.
  1. ;
  1. ; Output - String of data forming the HL7 ZEM segment.
  1. ;
  1. N X,X1,VAFY
  1. I '$G(DFN)!($G(VAFSTR)']"") G QUIT
  1. S $P(VAFY,HLFS,9)="",VAFSTR=","_VAFSTR_",",VAFREQ=$G(VAFREQ)
  1. S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) ; Sequential number (required field)
  1. I VAFREQ'=2 S $P(VAFY,HLFS,2)=1 D PATZEM
  1. I VAFREQ=2 S $P(VAFY,HLFS,2)=2 D SPOUZEM
  1. QUIT ;
  1. Q "ZEM"_HLFS_$G(VAFY)
  1. ;
  1. PATZEM ; Patient data requested.
  1. S X=$G(^DPT(DFN,.311))
  1. I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
  1. I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
  1. I VAFSTR[",5," S X1=$P($G(^DPT(DFN,0)),"^",7),$P(VAFY,HLFS,5)=$S(X1]"":X1,1:HLQ) ; Occupation.
  1. 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.
  1. I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",9)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
  1. I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P(X,"^",2)),$P(VAFY,HLFS,8)=$S(X1]"":X1,1:HLQ) ; Government Agency.
  1. ;I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(X,"^",2)]"":$P(X,"^",2),1:HLQ) ; Government Agency.
  1. I VAFSTR[",9," S X1=$$HLDATE^HLFNC($P(X,"^",16)),$P(VAFY,HLFS,9)=$S(X1]"":X1,1:HLQ) ;Retirement Date
  1. Q
  1. ;
  1. SPOUZEM ; Spousal data requested.
  1. S X=$G(^DPT(DFN,.25))
  1. I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
  1. I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
  1. I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(X,"^",14)]"":$P(X,"^",14),1:HLQ) ; Occupation.
  1. 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.
  1. I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",8)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
  1. I VAFSTR[",8," S $P(VAFY,HLFS,8)=HLQ
  1. I VAFSTR[",9," S X1=$$HLDATE^HLFNC($P(X,"^",16)),$P(VAFY,HLFS,9)=$S(X1]"":X1,1:HLQ) ;Retirement Date
  1. Q