HLCS	;ALB/RJS,MTC,JRP - COMMUNICATIONS SERVER - ;10/04/2007  14:34
	;;1.6;HEALTH LEVEL SEVEN;**2,9,14,19,43,57,109,132,122**;Oct 13, 1995;Build 14
	;Per VHA Directive 2004-038, this routine should not be modified.
	;
	;The SEND function is invoked by the transaction processor.
	;It's function is to $O through the ITEM multiple of the Event Driver
	;Protocol and create child entries in the Message Text file (#772)
	;for the message at HLMTIEN.  These child messages point back
	;to the parent message so that message text does not need to
	;be duplicated when a message is sent to multiple applications.
	;
	;The SENDACK function is also invoked by the transaction processor.
	;It's function is to create a child entry in the Message Text file
	;for the message at HLMTIENA and deliver the message to the
	;application the requested/sent information.
	;
	;For DHCP to DHCP messaging (i.e. internal to internal), an incoming
	;message is created in the Message Text file which is a duplication
	;of the outgoing message.  The incoming message is then processed by
	;calling the transaction processor.
	;
	;For DHCP to COTS messaging (i.e. internal to external), the message
	;is filed in the Message Text file with the Logical Link defined and
	;a status of PENDING TRANSMISSION.  These entries are picked up by
	;the background filer and transmitted to the appropriate COTS system.
	;
SEND(HLMTIEN,HLEID,HLRESULT)	;Send an HL7 message
	;HLMTIEN=The IEN of the parent message in file # 772
	;HLEID=The IEN of the Event Driver protocol in file #101
	;HLRESULT=Variable for any error text (pass by reference)
	;
	;Declare variables
	N HLARY,HLERROR,HLEIDS,HLCLIENT,HLOGLINK,HLMTIENS,HLMSGPTR
	S HLERROR=""
	;Direct connect
	I HLPRIO="I" D  Q
	. D DC^HLMA2
	. S HLRESULT=HLERROR
	;Get all subscribers to the message
	D ITEM^HLUTIL2(HLEID,"PTR")
	;Quit if no subscribers (considered successful delivery)
	G:($G(HLARY(0))'>0) EXIT
	;Deliver message to each subscriber
	S HLEIDS=0
	F  S HLEIDS=$O(HLARY(HLEIDS)) Q:(HLEIDS'>0)  D
	.;
	.;**132 excluded subscribers **
	.N I,EXCLUDE
	.S (EXCLUDE,I)=0
	. ;
	. ; patch HL*1.6*122
	. ; F  S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I  I $G(HLP("EXCLUDE SUBSCRIBER",I))=HLEIDS S EXCLUDE=1 Q
	. F  S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I  D  Q:EXCLUDE
	.. N TEMP
	.. S TEMP=HLP("EXCLUDE SUBSCRIBER",I)
	.. I 'TEMP,TEMP]"" S TEMP=$O(^ORD(101,"B",TEMP,0))
	.. I TEMP=HLEIDS S EXCLUDE=1
	. ; patch HL*1.6*122
	. ;
	.Q:EXCLUDE
	.;** 132 end **
	.;
	.;Get pointer to receiving application
	.S HLCLIENT=+HLARY(HLEIDS),HL("EIDS")=HLEIDS,HLERROR=""
	.Q:(HLCLIENT'>0)
	.;Check and execute ROUTING LOGIC **CIRN**
	.S HLX=$G(^ORD(101,HLEIDS,774))
	.I HLX]"" D  Q
	..N HLQUIT,HLNODE,HLNEXT
	..S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
	..X HLX I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
	.;Get pointer to logical link
	.S HLOGLINK=$P(HLARY(HLEIDS),"^",2)
	.;Determine if receiving application is internal or external
	.;  Logical link has a value for external applications
	.;  Logical link is NULL for internal applications
	.I (HLOGLINK) D COTS Q
	.;Create 'incoming' message based on 'outgoing' message (internal)
	.D DHCP(HLMTIEN,HLEIDS,HLCLIENT)
	.Q:(HLERROR)
	.;Process the 'incoming' message
	.S HLERROR=""
	.D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
	.;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
	.; or ERROR DURING TRANSMISSION
	.D STATUS^HLTF0(HLMSGPTR,$S(HLERROR:4,1:3),$S(HLERROR:+HLERROR,1:""),$S(HLERROR:$P(HLERROR,"^",2),1:""),,$S($G(HLERR("SKIP_EVENT"))=1:1,1:0))
	.I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
	D ADD^HLCS2 ;**CIRN**
EXIT	S HLRESULT=HLERROR
	Q
COTS	;Internal to external communication
	;Create child entry in Message Text file
	N HLTCP,HLTCPI,HLTCPO
	D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
	I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
	;'Pass' message to background filer by setting status of child
	;  to PENDING TRANSMISSION
	D STATUS^HLTF0(HLMTIENS,1)
	Q
DHCP(HLMTIEN,HLEIDS,HLCLIENT)	;Internal to internal communication
	;
	;Input  : HLMTIEN - Pointer to parent outgoing message (file #772)
	;         HLEIDS - Pointer to subscribing protocol (file #101)
	;         HLCLIENT - Pointer to receiving application (file # 771)
	;
	;Output : HLMTIENS - Pointer to child outgoing message (file #772)
	;         HLMSGPTR - Pointer to [parent] incoming message (file #772)
	;         HLERROR - ErrorCode ^ ErrorText
	;
	;Notes  : This module only copies the outgoing message into an incoming
	;         message.  Delivery of the message (i.e. processing of it)
	;         must be done by the calling application.
	;       : Message/batch header (MSH/BSH) is built and placed in the
	;         incoming message
	;       : HLMTIENS, HLMSGPTR, and HLERROR will be initialized
	;       : Existance and validity of input is assumed
	;
	;Declare variables
	N MSGID,MSGDT,MSGDTH,HDR2BLD,TMP,HLHDR,BHSHDR
	S HLERROR=""
	S HLMTIENS=0
	S HLMSGPTR=0
	;Create child entry in Message Text file
	D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS)
	I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
	;'Receive' message by making an incoming message
	;Determine type of header to build
	S TMP=$G(^HL(772,HLMTIEN,0))
	S HDR2BLD=$P(TMP,"^",14)
	;Build message header (MSH)
	I (HDR2BLD="M") D  Q:(HLERROR)
	.S TMP=""
	.D HEADER^HLCSHDR(HLMTIENS,.TMP)
	.Q:(TMP="")
	.;Error building header
	.S HLERROR="4^Unable to build message header => "_TMP
	.D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
	;Build batch header (BHS or FHS)
	I (HDR2BLD'="M") D  Q:(HLERROR)
	.S TMP=""
	.D BHSHDR^HLCSHDR(HLMTIENS)
	.S:($E(HLHDR(1),1)="-") TMP=$P(HLHDR(1),"^",2)
	.Q:(TMP="")
	.;Error building header
	.S HLERROR="4^Unable to build batch header => "_TMP
	.D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
	;Create entry for 'incoming' message
	D CREATE^HLTF(.MSGID,.HLMSGPTR,.MSGDT,.MSGDTH)
	;Move header and rest of message into 'incoming' message
	I (HDR2BLD="M") D
	.;Use MSH as header
	.D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"HLHDR")
	I (HDR2BLD'="M") D
	.;Use BHS or FHS as header
	.D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"BHSHDR")
	;Set status of outgoing message to AWAITING ACKNOWLEDGEMENT
	D STATUS^HLTF0(HLMTIENS,$S($P(^HL(772,HLMTIEN,0),U,7):3,1:2))
	;Set status of 'incoming' message to AWAITING PROCESSING
	D STATUS^HLTF0(HLMSGPTR,9)
	Q
SENDACK(HLMTIENA,HLEID,HLEIDS,HLRESULT)	;Send an HL7 acknowledgement/response
	;HLMTIENA=The IEN of the parent acknowledgment/response message in
	;         file # 772
	;HLEIDS=The IEN of the Subscribing protocol in file # 101
	;HLEID=The IEN of the Event Driver protocol in file #101
	;HLRESULT=Variable for any error text (pass by reference)
	;
	N HLERROR,HLOGLINK,HLCLIENT,HLMTIENS,HLMSGPTR,HLCLNODE
	I $G(HLMTIENA)=""!($G(HLEID)="")!($G(HLEIDS)="") S HLERROR="0^7^"_$G(^HL(771.7,7,0))_"at SENDACK^HLCS entry point" G EXIT2
	S HLCLNODE=$G(^ORD(101,HLEID,770))
	;Get pointers to Logical Link & receiving application
	S HLOGLINK=$P($G(^ORD(101,HLEIDS,770)),U,7)
	;Application needed to dynamically address the ACK (tcp/ip)
	;(set HLL("LINKS") array before calling GENACK)
	I $D(HLL("LINKS")) D  Q:'HLOGLINK
	.S HLOGLINK=$P(HLL("LINKS",1),"^",2) Q:HLOGLINK=""
	.K HLL("LINKS")
	.I +HLOGLINK'=HLOGLINK S HLOGLINK=$O(^HLCS(870,"B",HLOGLINK,0))
	S HLCLIENT=$P(HLCLNODE,U,1)
	Q:('HLCLIENT)
	;Determine if receiving application is internal or external
	;  Logical link has a value for external applications
	;  Logical link is NULL for internal applications
	I (HLOGLINK) D COTSACK Q
	;Create 'incoming' message based on 'outgoing' message (internal)
	D DHCP(HLMTIENA,HLEID,HLCLIENT)
	;Process the 'incoming' message
	I (HLMSGPTR) D
	.S HLERROR=""
	.D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
	;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
	; or ERROR DURING TRANSMISSION
	D STATUS^HLTF0(HLMSGPTR,$S(HLERROR:4,1:3),$S(HLERROR:+HLERROR,1:""),$S(HLERROR:$P(HLERROR,"^",2),1:""))
EXIT2	;
	S HLRESULT=$G(HLERROR)
	Q
COTSACK	;Internal to external communication of acknowledgements/responses
	;Create child entry in Message Text file
	D SEND^HLMA2(HLEID,HLMTIENA,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
	;'Pass' message to background filer by setting status of child
	;  to PENDING TRANSMISSION
	D STATUS^HLTF0(HLMTIENS,1)
	Q
