VAFCMSG2.m

VAFCMSG2 ;ALB/JRP - ADT/R MESSAGE BUILDING;12-SEP-1996

 ;;5.3;Registration;**91**;Jun 06, 1996

 ;

SNDMSG(EVNTHL7,XMITARRY) ;Entry point to send ADT HL7 messages

 ;

 ;Input  : EVNTHL7 - HL7 ADT event to build message for (Defaults to A08)

 ;                   Currently support event types:

 ;                     A04, A08, A28

 ;         XMITARRY - Array containing HL7 message to transmit

 ;                    (full global reference)

 ;                  - Defaults to ^TMP("HLS",$J)

 ;                  - Must be in format required for interaction

 ;                    with the HL7 package

 ;Output :   Message ID = Success

 ;           ErrorCode^ErrorText = Error

 ;Notes  : The global array ^TMP("HLS",$J) will be KILLed if XMITARRY

 ;         does not use this global location

 ;

 ;Check input

 S EVNTHL7=$G(EVNTHL7)

 S:(EVNTHL7="") EVNTHL7="A08"

 S XMITARRY=$G(XMITARRY)

 S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"

 Q:($O(@XMITARRY@(""))="") "-1^Can not send empty message"

 ;Declare variables

 N HLEID,HL,HLFS,HLECH,HLQ,HLMTIEN,HLRESLT,HLP,ARRY4HL7,KILLARRY,OK,TMP

 S ARRY4HL7="^TMP(""HLS"","_$J_")"

 ;Check for supported event

 S OK=0

 F TMP="A04","A08","A28" I TMP=EVNTHL7 S OK=1 Q

 Q:('OK) "-1^Event type not supported"

 ;Get pointer to HL7 Server Protocol

 ;S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)

 ;Q:('HLEID) "-1^Server protocol not found"

 ;Initialize HL7 variables

 ;D INIT^HLFNC2(HLEID,.HL)

 ;Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"

 K HL

 I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" DO

 . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)

 ;or Get pointer to HL7 Server Protocol

 E  DO  Q:'HLEID "-1^Server Protocol not found"

 .S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)

 .Q:('HLEID)

 .;Initialize HL7 variables

 .D INIT^HLFNC2(HLEID,.HL)

 Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"

 ;

 ;See if XMITARRY is ^TMP("HLS",$J)

 S KILLARRY=0

 I (XMITARRY'=ARRY4HL7) D

 .;Make sure '$J' wasn't used

 .Q:(XMITARRY="^TMP(""HLS"",$J)")

 .;Initialize ^TMP("HLS",$J) and merge XMITARRY into it

 .K @ARRY4HL7

 .M @ARRY4HL7=@XMITARRY

 .S KILLARRY=1

 ;Broadcast message

 ;D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)

 ;S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)

 ;

 I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" DO

 . D GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)

 E  DO

 . D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)

 ;

 S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)

 ;

 ;Delete ^TMP("HLS",$J) if XMITARRY was different

 K:(KILLARRY) @ARRY4HL7

 ;Done

 Q HLRESLT

VAFCMSG2  ;ALB/JRP - ADT/R MESSAGE BUILDING;12-SEP-1996

 +1       ;;5.3;Registration;**91**;Jun 06, 1996

 +2       ;

SNDMSG(EVNTHL7,XMITARRY) ;Entry point to send ADT HL7 messages

 +1       ;

 +2       ;Input  : EVNTHL7 - HL7 ADT event to build message for (Defaults to A08)

 +3       ;                   Currently support event types:

 +4       ;                     A04, A08, A28

 +5       ;         XMITARRY - Array containing HL7 message to transmit

 +6       ;                    (full global reference)

 +7       ;                  - Defaults to ^TMP("HLS",$J)

 +8       ;                  - Must be in format required for interaction

 +9       ;                    with the HL7 package

 +10      ;Output :   Message ID = Success

 +11      ;           ErrorCode^ErrorText = Error

 +12      ;Notes  : The global array ^TMP("HLS",$J) will be KILLed if XMITARRY

 +13      ;         does not use this global location

 +14      ;

 +15      ;Check input

 +16       SET EVNTHL7=$GET(EVNTHL7)

 +17       IF (EVNTHL7="")

               SET EVNTHL7="A08"

 +18       SET XMITARRY=$GET(XMITARRY)

 +19       IF (XMITARRY="")

               SET XMITARRY="^TMP(""HLS"","_$JOB_")"

 +20       IF ($ORDER(@XMITARRY@(""))="")

               QUIT "-1^Can not send empty message"

 +21      ;Declare variables

 +22       NEW HLEID,HL,HLFS,HLECH,HLQ,HLMTIEN,HLRESLT,HLP,ARRY4HL7,KILLARRY,OK,TMP

 +23       SET ARRY4HL7="^TMP(""HLS"","_$JOB_")"

 +24      ;Check for supported event

 +25       SET OK=0

 +26       FOR TMP="A04","A08","A28"

               IF TMP=EVNTHL7

                   SET OK=1

                   QUIT 

 +27       IF ('OK)

               QUIT "-1^Event type not supported"

 +28      ;Get pointer to HL7 Server Protocol

 +29      ;S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)

 +30      ;Q:('HLEID) "-1^Server protocol not found"

 +31      ;Initialize HL7 variables

 +32      ;D INIT^HLFNC2(HLEID,.HL)

 +33      ;Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"

 +34       KILL HL

 +35       IF $GET(@EVNTINFO@("SERVER PROTOCOL"))]""

               Begin DoDot:1

 +36               DO INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)

               End DoDot:1

 +37      ;or Get pointer to HL7 Server Protocol

 +38      IF '$TEST

               Begin DoDot:1

 +39               SET HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)

 +40               IF ('HLEID)

                       QUIT 

 +41      ;Initialize HL7 variables

 +42               DO INIT^HLFNC2(HLEID,.HL)

               End DoDot:1

               IF 'HLEID

                   QUIT "-1^Server Protocol not found"

 +43       IF ($ORDER(HL(""))="")

               QUIT "-1^Unable to initialize HL7 variables"

 +44      ;

 +45      ;See if XMITARRY is ^TMP("HLS",$J)

 +46       SET KILLARRY=0

 +47       IF (XMITARRY'=ARRY4HL7)

               Begin DoDot:1

 +48      ;Make sure '$J' wasn't used

 +49               IF (XMITARRY="^TMP(""HLS"",$J)")

                       QUIT 

 +50      ;Initialize ^TMP("HLS",$J) and merge XMITARRY into it

 +51               KILL @ARRY4HL7

 +52               MERGE @ARRY4HL7=@XMITARRY

 +53               SET KILLARRY=1

               End DoDot:1

 +54      ;Broadcast message

 +55      ;D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)

 +56      ;S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)

 +57      ;

 +58       IF $GET(@EVNTINFO@("SERVER PROTOCOL"))]""

               Begin DoDot:1

 +59               DO GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)

               End DoDot:1

 +60      IF '$TEST

               Begin DoDot:1

 +61               DO GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)

               End DoDot:1

 +62      ;

 +63       IF ('HLRESLT)

               SET HLRESLT=$PIECE(HLRESLT,"^",2,3)

 +64      ;

 +65      ;Delete ^TMP("HLS",$J) if XMITARRY was different

 +66       IF (KILLARRY)

               KILL @ARRY4HL7

 +67      ;Done

 +68       QUIT HLRESLT