- 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 Mar 13, 2025@22:08:05 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)