- 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
