VBECHLRT ;HOIFO/BNT - VBECS HL7 ADT Messaging Routing routine;July 13, 2004
;;2.0;VBEC;**3**;Jun 05, 2015;Build 3
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to ^%ZTLOAD supported by IA #10063
; Reference to INIT^HLFNC2 supported by IA #2161
; Reference to GENERATE^HLMA supported by IA #2164
; Reference to GETDFN^MPIF001 supported by IA #2701
;
QUIT
;
EN ; Get Message and queue TaskMan to send it on.
Q ;Remove ADT-08 messages for BCE. RLM 12/10/18
; Only send ADT A08 Message Types
N VBECEVNT,HLA,MSG,VBI,VBJ,SG,VBECSEND
D INIT^HLFNC2("VAFC ADT-A08 SERVER",.HL) ;Initialize HL7 variables
S VBECEVNT=HL("ETN")
S VBECSEND=0
Q:VBECEVNT'[$E("A08")
F VBI=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE,SG=$E(HLNODE,1,3) D
. S HLA("HLS",VBI)=MSG
. S VBJ=0 F S VBJ=$O(HLNODE(VBJ)) Q:'VBJ S MSG(VBJ)=HLNODE(VBJ),HLA("HLS",VBI,VBJ)=HLNODE(VBJ)
. I $T(@SG)]"" D @SG
Q:'VBECSEND
;
S ZTIO=""
S ZTRTN="SNDMSG^VBECHLRT"
S ZTSAVE("HLA(""HLS"",")=""
S ZTSAVE("VBECEVNT")=""
S ZTDESC="VBECS HL7 Message Router"
S ZTDTH=$H
D ^%ZTLOAD
D EXIT
Q
;
ZFF ; This segment contains the edited fields
N X,VBECFLDS
S VBECFLDS=$P(MSG,HL("FS"),3)
F I=1:1 S X=$P(VBECFLDS,";",I) Q:X']"" D Q:VBECSEND
. S VBECSEND=$S(X=".01":1,X=".02":1,X=".03":1,X=".09":1,X=".351":1,X="991.01":1,1:0)
Q
;
SNDMSG ; Create the ^TMP("HLS",$J global array and send the message
S:$D(ZTQUEUED) ZTREQ="@"
N EID
S EID=$O(^ORD(101,"B","VBECS ADT-"_VBECEVNT_" SERVER",0))
N HL,INT,HLRESLT,HLP
S HL="HL",INT=0
D INIT^HLFNC2(EID,.HL,INT)
D GENERATE^HLMA(EID,"LM",1,.HLRESLT,"",.HLP)
K HLA,VBECEVNT
Q
;
EXIT ; Kill variables and quit
K SG,ZTIO,ZTSAVE,ZTDESC,ZTRTN,ZTDTH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECHLRT 1924 printed Sep 23, 2025@20:20:27 Page 2
VBECHLRT ;HOIFO/BNT - VBECS HL7 ADT Messaging Routing routine;July 13, 2004
+1 ;;2.0;VBEC;**3**;Jun 05, 2015;Build 3
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to ^%ZTLOAD supported by IA #10063
+9 ; Reference to INIT^HLFNC2 supported by IA #2161
+10 ; Reference to GENERATE^HLMA supported by IA #2164
+11 ; Reference to GETDFN^MPIF001 supported by IA #2701
+12 ;
+13 QUIT
+14 ;
EN ; Get Message and queue TaskMan to send it on.
+1 ;Remove ADT-08 messages for BCE. RLM 12/10/18
QUIT
+2 ; Only send ADT A08 Message Types
+3 NEW VBECEVNT,HLA,MSG,VBI,VBJ,SG,VBECSEND
+4 ;Initialize HL7 variables
DO INIT^HLFNC2("VAFC ADT-A08 SERVER",.HL)
+5 SET VBECEVNT=HL("ETN")
+6 SET VBECSEND=0
+7 if VBECEVNT'[$EXTRACT("A08")
QUIT
+8 FOR VBI=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
SET MSG=HLNODE
SET SG=$EXTRACT(HLNODE,1,3)
Begin DoDot:1
+9 SET HLA("HLS",VBI)=MSG
+10 SET VBJ=0
FOR
SET VBJ=$ORDER(HLNODE(VBJ))
if 'VBJ
QUIT
SET MSG(VBJ)=HLNODE(VBJ)
SET HLA("HLS",VBI,VBJ)=HLNODE(VBJ)
+11 IF $TEXT(@SG)]""
DO @SG
End DoDot:1
+12 if 'VBECSEND
QUIT
+13 ;
+14 SET ZTIO=""
+15 SET ZTRTN="SNDMSG^VBECHLRT"
+16 SET ZTSAVE("HLA(""HLS"",")=""
+17 SET ZTSAVE("VBECEVNT")=""
+18 SET ZTDESC="VBECS HL7 Message Router"
+19 SET ZTDTH=$HOROLOG
+20 DO ^%ZTLOAD
+21 DO EXIT
+22 QUIT
+23 ;
ZFF ; This segment contains the edited fields
+1 NEW X,VBECFLDS
+2 SET VBECFLDS=$PIECE(MSG,HL("FS"),3)
+3 FOR I=1:1
SET X=$PIECE(VBECFLDS,";",I)
if X']""
QUIT
Begin DoDot:1
+4 SET VBECSEND=$SELECT(X=".01":1,X=".02":1,X=".03":1,X=".09":1,X=".351":1,X="991.01":1,1:0)
End DoDot:1
if VBECSEND
QUIT
+5 QUIT
+6 ;
SNDMSG ; Create the ^TMP("HLS",$J global array and send the message
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW EID
+3 SET EID=$ORDER(^ORD(101,"B","VBECS ADT-"_VBECEVNT_" SERVER",0))
+4 NEW HL,INT,HLRESLT,HLP
+5 SET HL="HL"
SET INT=0
+6 DO INIT^HLFNC2(EID,.HL,INT)
+7 DO GENERATE^HLMA(EID,"LM",1,.HLRESLT,"",.HLP)
+8 KILL HLA,VBECEVNT
+9 QUIT
+10 ;
EXIT ; Kill variables and quit
+1 KILL SG,ZTIO,ZTSAVE,ZTDESC,ZTRTN,ZTDTH
+2 QUIT
