VAFHLZE2 ;ALB/TDM - Create HL7 ZE2 segment ; 5/17/12 11:22am
;;5.3;Registration;**842**;Aug 13, 1993;Build 33
;
;
; This generic extrinsic function is designed to return the
; HL7 ZE2 segment. This segment is a continuation of the ZEL
; segment.
;
EN(DFN,VAFSTR,VAFHLQ,VAFHLFS) ; --
; Entry point for creating HL7 ZE2 segment.
;
;Variables Required to use this routine:
; HL - array that contains the necessary HL variables (init^hlsub)
;
; Input(s):
; DFN - internal entry number of Patient (#2) file
; VAFSTR - (optional) string of fields requested, separated by
; commas. If not passed, return all data fields.
; VAFHLQ - (optional) HL7 null variable.
; VAFHLFS - (optional) HL7 field separator.
;
; Output(s):
; String containing the desired components of the HL7 ZE2 segment
;
N VAFY,VAF385,VAL,VAFHLSC
;
; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
S VAFHLFS=$G(VAFHLS) I VAFHLFS="" S VAFHLFS="^"
S:($L(VAFHLFS)'=1) VAFHLFS="^"
S VAFHLC=$G(VAFHLC) I VAFHLC="" S VAFHLC="~|\&"
S:($L(VAFHLC)'=4) VAFHLC="~|\&"
S:('$D(VAFHLQ)) VAFHLQ=$C(34,34)
S VAFHLSC=$E(VAFHLC,1)
;
; if DFN not passed, exit
I '$G(DFN) S VAFY=1 G ENQ
;
; if VAFSTR not passed, return all data fields
I $G(VAFSTR)']"" S VAFSTR="1,2"
;
; initialize output string and requested data fields
S $P(VAFY,VAFHLFS,2)="",VAFSTR=","_VAFSTR_","
;
; get pension data node of Patient (#2) file
S VAF385=$G(^DPT(DFN,.385))
;
I VAFSTR[",1," S $P(VAFY,VAFHLFS,1)=$S($P(VAF385,"^",1)]"":$$HLDATE^HLFNC($P(VAF385,"^",1)),1:VAFHLQ) ; Pension Award Effective Date (#.3851)
I VAFSTR[",2," D ; Pension Award Reason Code (#.3852)
.I $P(VAF385,"^",2)']"" S $P(VAFY,VAFHLFS,2)=VAFHLQ Q
.S VAL=$P(VAF385,"^",2)_","
.S $P(VAFY,VAFHLFS,2)=$$GET1^DIQ(27.18,VAL,1)
.S $P(VAFY,VAFHLFS,2)=$P(VAFY,VAFHLFS,2)_VAFHLSC_VAFHLSC_"VistA27.18"
;
ENQ Q "ZE2"_VAFHLFS_$G(VAFY)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZE2 1970 printed Apr 09, 2024@21:44:53 Page 2
VAFHLZE2 ;ALB/TDM - Create HL7 ZE2 segment ; 5/17/12 11:22am
+1 ;;5.3;Registration;**842**;Aug 13, 1993;Build 33
+2 ;
+3 ;
+4 ; This generic extrinsic function is designed to return the
+5 ; HL7 ZE2 segment. This segment is a continuation of the ZEL
+6 ; segment.
+7 ;
EN(DFN,VAFSTR,VAFHLQ,VAFHLFS) ; --
+1 ; Entry point for creating HL7 ZE2 segment.
+2 ;
+3 ;Variables Required to use this routine:
+4 ; HL - array that contains the necessary HL variables (init^hlsub)
+5 ;
+6 ; Input(s):
+7 ; DFN - internal entry number of Patient (#2) file
+8 ; VAFSTR - (optional) string of fields requested, separated by
+9 ; commas. If not passed, return all data fields.
+10 ; VAFHLQ - (optional) HL7 null variable.
+11 ; VAFHLFS - (optional) HL7 field separator.
+12 ;
+13 ; Output(s):
+14 ; String containing the desired components of the HL7 ZE2 segment
+15 ;
+16 NEW VAFY,VAF385,VAL,VAFHLSC
+17 ;
+18 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
+19 SET VAFHLFS=$GET(VAFHLS)
IF VAFHLFS=""
SET VAFHLFS="^"
+20 if ($LENGTH(VAFHLFS)'=1)
SET VAFHLFS="^"
+21 SET VAFHLC=$GET(VAFHLC)
IF VAFHLC=""
SET VAFHLC="~|\&"
+22 if ($LENGTH(VAFHLC)'=4)
SET VAFHLC="~|\&"
+23 if ('$DATA(VAFHLQ))
SET VAFHLQ=$CHAR(34,34)
+24 SET VAFHLSC=$EXTRACT(VAFHLC,1)
+25 ;
+26 ; if DFN not passed, exit
+27 IF '$GET(DFN)
SET VAFY=1
GOTO ENQ
+28 ;
+29 ; if VAFSTR not passed, return all data fields
+30 IF $GET(VAFSTR)']""
SET VAFSTR="1,2"
+31 ;
+32 ; initialize output string and requested data fields
+33 SET $PIECE(VAFY,VAFHLFS,2)=""
SET VAFSTR=","_VAFSTR_","
+34 ;
+35 ; get pension data node of Patient (#2) file
+36 SET VAF385=$GET(^DPT(DFN,.385))
+37 ;
+38 ; Pension Award Effective Date (#.3851)
IF VAFSTR[",1,"
SET $PIECE(VAFY,VAFHLFS,1)=$SELECT($PIECE(VAF385,"^",1)]"":$$HLDATE^HLFNC($PIECE(VAF385,"^",1)),1:VAFHLQ)
+39 ; Pension Award Reason Code (#.3852)
IF VAFSTR[",2,"
Begin DoDot:1
+40 IF $PIECE(VAF385,"^",2)']""
SET $PIECE(VAFY,VAFHLFS,2)=VAFHLQ
QUIT
+41 SET VAL=$PIECE(VAF385,"^",2)_","
+42 SET $PIECE(VAFY,VAFHLFS,2)=$$GET1^DIQ(27.18,VAL,1)
+43 SET $PIECE(VAFY,VAFHLFS,2)=$PIECE(VAFY,VAFHLFS,2)_VAFHLSC_VAFHLSC_"VistA27.18"
End DoDot:1
+44 ;
ENQ QUIT "ZE2"_VAFHLFS_$GET(VAFY)
