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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMSG2 2576 printed Dec 13, 2024@03:02:02 Page 2
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
