VBECHLRT.m

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 ---VBECHLRT   1924     printed  Feb 19, 2025@00:10:48                                                                                                                                                                                                    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