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

VAFHLZE2.m

Go to the documentation of this file.
  1. VAFHLZE2 ;ALB/TDM - Create HL7 ZE2 segment ; 5/17/12 11:22am
  1. ;;5.3;Registration;**842**;Aug 13, 1993;Build 33
  1. ;
  1. ;
  1. ; This generic extrinsic function is designed to return the
  1. ; HL7 ZE2 segment. This segment is a continuation of the ZEL
  1. ; segment.
  1. ;
  1. EN(DFN,VAFSTR,VAFHLQ,VAFHLFS) ; --
  1. ; Entry point for creating HL7 ZE2 segment.
  1. ;
  1. ;Variables Required to use this routine:
  1. ; HL - array that contains the necessary HL variables (init^hlsub)
  1. ;
  1. ; Input(s):
  1. ; DFN - internal entry number of Patient (#2) file
  1. ; VAFSTR - (optional) string of fields requested, separated by
  1. ; commas. If not passed, return all data fields.
  1. ; VAFHLQ - (optional) HL7 null variable.
  1. ; VAFHLFS - (optional) HL7 field separator.
  1. ;
  1. ; Output(s):
  1. ; String containing the desired components of the HL7 ZE2 segment
  1. ;
  1. N VAFY,VAF385,VAL,VAFHLSC
  1. ;
  1. ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
  1. S VAFHLFS=$G(VAFHLS) I VAFHLFS="" S VAFHLFS="^"
  1. S:($L(VAFHLFS)'=1) VAFHLFS="^"
  1. S VAFHLC=$G(VAFHLC) I VAFHLC="" S VAFHLC="~|\&"
  1. S:($L(VAFHLC)'=4) VAFHLC="~|\&"
  1. S:('$D(VAFHLQ)) VAFHLQ=$C(34,34)
  1. S VAFHLSC=$E(VAFHLC,1)
  1. ;
  1. ; if DFN not passed, exit
  1. I '$G(DFN) S VAFY=1 G ENQ
  1. ;
  1. ; if VAFSTR not passed, return all data fields
  1. I $G(VAFSTR)']"" S VAFSTR="1,2"
  1. ;
  1. ; initialize output string and requested data fields
  1. S $P(VAFY,VAFHLFS,2)="",VAFSTR=","_VAFSTR_","
  1. ;
  1. ; get pension data node of Patient (#2) file
  1. S VAF385=$G(^DPT(DFN,.385))
  1. ;
  1. I VAFSTR[",1," S $P(VAFY,VAFHLFS,1)=$S($P(VAF385,"^",1)]"":$$HLDATE^HLFNC($P(VAF385,"^",1)),1:VAFHLQ) ; Pension Award Effective Date (#.3851)
  1. I VAFSTR[",2," D ; Pension Award Reason Code (#.3852)
  1. .I $P(VAF385,"^",2)']"" S $P(VAFY,VAFHLFS,2)=VAFHLQ Q
  1. .S VAL=$P(VAF385,"^",2)_","
  1. .S $P(VAFY,VAFHLFS,2)=$$GET1^DIQ(27.18,VAL,1)
  1. .S $P(VAFY,VAFHLFS,2)=$P(VAFY,VAFHLFS,2)_VAFHLSC_VAFHLSC_"VistA27.18"
  1. ;
  1. ENQ Q "ZE2"_VAFHLFS_$G(VAFY)