| [613] | 1 | VAFCMSG2 ;ALB/JRP - ADT/R MESSAGE BUILDING;12-SEP-1996
|
|---|
| 2 | ;;5.3;Registration;**91**;Jun 06, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | SNDMSG(EVNTHL7,XMITARRY) ;Entry point to send ADT HL7 messages
|
|---|
| 5 | ;
|
|---|
| 6 | ;Input : EVNTHL7 - HL7 ADT event to build message for (Defaults to A08)
|
|---|
| 7 | ; Currently support event types:
|
|---|
| 8 | ; A04, A08, A28
|
|---|
| 9 | ; XMITARRY - Array containing HL7 message to transmit
|
|---|
| 10 | ; (full global reference)
|
|---|
| 11 | ; - Defaults to ^TMP("HLS",$J)
|
|---|
| 12 | ; - Must be in format required for interaction
|
|---|
| 13 | ; with the HL7 package
|
|---|
| 14 | ;Output : Message ID = Success
|
|---|
| 15 | ; ErrorCode^ErrorText = Error
|
|---|
| 16 | ;Notes : The global array ^TMP("HLS",$J) will be KILLed if XMITARRY
|
|---|
| 17 | ; does not use this global location
|
|---|
| 18 | ;
|
|---|
| 19 | ;Check input
|
|---|
| 20 | S EVNTHL7=$G(EVNTHL7)
|
|---|
| 21 | S:(EVNTHL7="") EVNTHL7="A08"
|
|---|
| 22 | S XMITARRY=$G(XMITARRY)
|
|---|
| 23 | S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
|
|---|
| 24 | Q:($O(@XMITARRY@(""))="") "-1^Can not send empty message"
|
|---|
| 25 | ;Declare variables
|
|---|
| 26 | N HLEID,HL,HLFS,HLECH,HLQ,HLMTIEN,HLRESLT,HLP,ARRY4HL7,KILLARRY,OK,TMP
|
|---|
| 27 | S ARRY4HL7="^TMP(""HLS"","_$J_")"
|
|---|
| 28 | ;Check for supported event
|
|---|
| 29 | S OK=0
|
|---|
| 30 | F TMP="A04","A08","A28" I TMP=EVNTHL7 S OK=1 Q
|
|---|
| 31 | Q:('OK) "-1^Event type not supported"
|
|---|
| 32 | ;Get pointer to HL7 Server Protocol
|
|---|
| 33 | ;S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)
|
|---|
| 34 | ;Q:('HLEID) "-1^Server protocol not found"
|
|---|
| 35 | ;Initialize HL7 variables
|
|---|
| 36 | ;D INIT^HLFNC2(HLEID,.HL)
|
|---|
| 37 | ;Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
|
|---|
| 38 | K HL
|
|---|
| 39 | I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" DO
|
|---|
| 40 | . D INIT^HLFNC2(@EVNTINFO@("SERVER PROTOCOL"),.HL)
|
|---|
| 41 | ;or Get pointer to HL7 Server Protocol
|
|---|
| 42 | E DO Q:'HLEID "-1^Server Protocol not found"
|
|---|
| 43 | .S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)
|
|---|
| 44 | .Q:('HLEID)
|
|---|
| 45 | .;Initialize HL7 variables
|
|---|
| 46 | .D INIT^HLFNC2(HLEID,.HL)
|
|---|
| 47 | Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
|
|---|
| 48 | ;
|
|---|
| 49 | ;See if XMITARRY is ^TMP("HLS",$J)
|
|---|
| 50 | S KILLARRY=0
|
|---|
| 51 | I (XMITARRY'=ARRY4HL7) D
|
|---|
| 52 | .;Make sure '$J' wasn't used
|
|---|
| 53 | .Q:(XMITARRY="^TMP(""HLS"",$J)")
|
|---|
| 54 | .;Initialize ^TMP("HLS",$J) and merge XMITARRY into it
|
|---|
| 55 | .K @ARRY4HL7
|
|---|
| 56 | .M @ARRY4HL7=@XMITARRY
|
|---|
| 57 | .S KILLARRY=1
|
|---|
| 58 | ;Broadcast message
|
|---|
| 59 | ;D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
|
|---|
| 60 | ;S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
|
|---|
| 61 | ;
|
|---|
| 62 | I $G(@EVNTINFO@("SERVER PROTOCOL"))]"" DO
|
|---|
| 63 | . D GENERATE^HLMA(@EVNTINFO@("SERVER PROTOCOL"),"GM",1,.HLRESLT,"",.HLP)
|
|---|
| 64 | E DO
|
|---|
| 65 | . D GENERATE^HLMA(HLEID,"GM",1,.HLRESLT,"",.HLP)
|
|---|
| 66 | ;
|
|---|
| 67 | S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
|
|---|
| 68 | ;
|
|---|
| 69 | ;Delete ^TMP("HLS",$J) if XMITARRY was different
|
|---|
| 70 | K:(KILLARRY) @ARRY4HL7
|
|---|
| 71 | ;Done
|
|---|
| 72 | Q HLRESLT
|
|---|
