- VAFHLZEM ;ALB/KCL,TDM - Create generic HL7 ZEM segment ; 12/22/08 4:37pm
- ;;5.3;Registration;**68,754**;Aug 13, 1993;Build 46
- ;
- ;
- EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was
- ; designed to return the HL7 ZEM segment. This
- ; segment contains VA-specific information
- ; pertaining to the employment of a patient or
- ; his/her spouse.
- ;
- ; Input - DFN as internal entry number of the PATIENT file.
- ; VAFSTR as the string of fields requested seperated by commas.
- ; VAFREQ is 1 for PATIENT request, is 2 for SPOUSAL request.
- ; If nothing is passed default to PATIENT request.
- ; VAFNUM as sequential number to add to SETID.
- ;
- ; *****Also assumes all HL7 variables returned from*****
- ; INIT^HLTRANS are defined.
- ;
- ; Output - String of data forming the HL7 ZEM segment.
- ;
- N X,X1,VAFY
- I '$G(DFN)!($G(VAFSTR)']"") G QUIT
- S $P(VAFY,HLFS,9)="",VAFSTR=","_VAFSTR_",",VAFREQ=$G(VAFREQ)
- S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) ; Sequential number (required field)
- I VAFREQ'=2 S $P(VAFY,HLFS,2)=1 D PATZEM
- I VAFREQ=2 S $P(VAFY,HLFS,2)=2 D SPOUZEM
- QUIT ;
- Q "ZEM"_HLFS_$G(VAFY)
- ;
- PATZEM ; Patient data requested.
- S X=$G(^DPT(DFN,.311))
- I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
- I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
- I VAFSTR[",5," S X1=$P($G(^DPT(DFN,0)),"^",7),$P(VAFY,HLFS,5)=$S(X1]"":X1,1:HLQ) ; Occupation.
- 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.
- I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",9)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
- I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P(X,"^",2)),$P(VAFY,HLFS,8)=$S(X1]"":X1,1:HLQ) ; Government Agency.
- ;I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(X,"^",2)]"":$P(X,"^",2),1:HLQ) ; Government Agency.
- I VAFSTR[",9," S X1=$$HLDATE^HLFNC($P(X,"^",16)),$P(VAFY,HLFS,9)=$S(X1]"":X1,1:HLQ) ;Retirement Date
- Q
- ;
- SPOUZEM ; Spousal data requested.
- S X=$G(^DPT(DFN,.25))
- I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(X,"^",15)]"":$P(X,"^",15),1:HLQ) ; Employment Status.
- I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(X,"^",1)]"":$P(X,"^",1),1:HLQ) ; Employer Name.
- I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(X,"^",14)]"":$P(X,"^",14),1:HLQ) ; Occupation.
- 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.
- I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(X,"^",8)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Employer Phone.
- I VAFSTR[",8," S $P(VAFY,HLFS,8)=HLQ
- I VAFSTR[",9," S X1=$$HLDATE^HLFNC($P(X,"^",16)),$P(VAFY,HLFS,9)=$S(X1]"":X1,1:HLQ) ;Retirement Date
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZEM 2915 printed Feb 19, 2025@00:29:27 Page 2
- 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
- +2 ;
- +3 ;
- EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was
- +1 ; designed to return the HL7 ZEM segment. This
- +2 ; segment contains VA-specific information
- +3 ; pertaining to the employment of a patient or
- +4 ; his/her spouse.
- +5 ;
- +6 ; Input - DFN as internal entry number of the PATIENT file.
- +7 ; VAFSTR as the string of fields requested seperated by commas.
- +8 ; VAFREQ is 1 for PATIENT request, is 2 for SPOUSAL request.
- +9 ; If nothing is passed default to PATIENT request.
- +10 ; VAFNUM as sequential number to add to SETID.
- +11 ;
- +12 ; *****Also assumes all HL7 variables returned from*****
- +13 ; INIT^HLTRANS are defined.
- +14 ;
- +15 ; Output - String of data forming the HL7 ZEM segment.
- +16 ;
- +17 NEW X,X1,VAFY
- +18 IF '$GET(DFN)!($GET(VAFSTR)']"")
- GOTO QUIT
- +19 SET $PIECE(VAFY,HLFS,9)=""
- SET VAFSTR=","_VAFSTR_","
- SET VAFREQ=$GET(VAFREQ)
- +20 ; Sequential number (required field)
- SET $PIECE(VAFY,HLFS,1)=$SELECT($GET(VAFNUM):VAFNUM,1:1)
- +21 IF VAFREQ'=2
- SET $PIECE(VAFY,HLFS,2)=1
- DO PATZEM
- +22 IF VAFREQ=2
- SET $PIECE(VAFY,HLFS,2)=2
- DO SPOUZEM
- QUIT ;
- +1 QUIT "ZEM"_HLFS_$GET(VAFY)
- +2 ;
- PATZEM ; Patient data requested.
- +1 SET X=$GET(^DPT(DFN,.311))
- +2 ; Employment Status.
- IF VAFSTR[",3,"
- SET $PIECE(VAFY,HLFS,3)=$SELECT($PIECE(X,"^",15)]"":$PIECE(X,"^",15),1:HLQ)
- +3 ; Employer Name.
- IF VAFSTR[",4,"
- SET $PIECE(VAFY,HLFS,4)=$SELECT($PIECE(X,"^",1)]"":$PIECE(X,"^",1),1:HLQ)
- +4 ; Occupation.
- IF VAFSTR[",5,"
- SET X1=$PIECE($GET(^DPT(DFN,0)),"^",7)
- SET $PIECE(VAFY,HLFS,5)=$SELECT(X1]"":X1,1:HLQ)
- +5 ; Employer Address.
- IF VAFSTR[",6,"
- SET X1=$$ADDR^VAFHLFNC($PIECE(X,"^",3,7)_"^"_$PIECE($GET(^DPT(DFN,.22)),"^",5))
- SET $PIECE(VAFY,HLFS,6)=$SELECT(X1]"":X1,1:HLQ)
- +6 ; Employer Phone.
- IF VAFSTR[",7,"
- SET X1=$$HLPHONE^HLFNC($PIECE(X,"^",9))
- SET $PIECE(VAFY,HLFS,7)=$SELECT(X1]"":X1,1:HLQ)
- +7 ; Government Agency.
- IF VAFSTR[",8,"
- SET X1=$$YN^VAFHLFNC($PIECE(X,"^",2))
- SET $PIECE(VAFY,HLFS,8)=$SELECT(X1]"":X1,1:HLQ)
- +8 ;I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(X,"^",2)]"":$P(X,"^",2),1:HLQ) ; Government Agency.
- +9 ;Retirement Date
- IF VAFSTR[",9,"
- SET X1=$$HLDATE^HLFNC($PIECE(X,"^",16))
- SET $PIECE(VAFY,HLFS,9)=$SELECT(X1]"":X1,1:HLQ)
- +10 QUIT
- +11 ;
- SPOUZEM ; Spousal data requested.
- +1 SET X=$GET(^DPT(DFN,.25))
- +2 ; Employment Status.
- IF VAFSTR[",3,"
- SET $PIECE(VAFY,HLFS,3)=$SELECT($PIECE(X,"^",15)]"":$PIECE(X,"^",15),1:HLQ)
- +3 ; Employer Name.
- IF VAFSTR[",4,"
- SET $PIECE(VAFY,HLFS,4)=$SELECT($PIECE(X,"^",1)]"":$PIECE(X,"^",1),1:HLQ)
- +4 ; Occupation.
- IF VAFSTR[",5,"
- SET $PIECE(VAFY,HLFS,5)=$SELECT($PIECE(X,"^",14)]"":$PIECE(X,"^",14),1:HLQ)
- +5 ; Employer Address.
- IF VAFSTR[",6,"
- SET X1=$$ADDR^VAFHLFNC($PIECE(X,"^",2,6)_"^"_$PIECE($GET(^DPT(DFN,.22)),"^",6))
- SET $PIECE(VAFY,HLFS,6)=$SELECT(X1]"":X1,1:HLQ)
- +6 ; Employer Phone.
- IF VAFSTR[",7,"
- SET X1=$$HLPHONE^HLFNC($PIECE(X,"^",8))
- SET $PIECE(VAFY,HLFS,7)=$SELECT(X1]"":X1,1:HLQ)
- +7 IF VAFSTR[",8,"
- SET $PIECE(VAFY,HLFS,8)=HLQ
- +8 ;Retirement Date
- IF VAFSTR[",9,"
- SET X1=$$HLDATE^HLFNC($PIECE(X,"^",16))
- SET $PIECE(VAFY,HLFS,9)=$SELECT(X1]"":X1,1:HLQ)
- +9 QUIT