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 Oct 16, 2024@19:03:57 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
