HLCS ;ALB/RJS,MTC,JRP - COMMUNICATIONS SERVER - ;05/09/2000 11:21
;;1.6;HEALTH LEVEL SEVEN;**2,9,14,19,43,57,109**;Oct 13, 1995
;
;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
.;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
HLCS ;ALB/RJS,MTC,JRP - COMMUNICATIONS SERVER - ;05/09/2000 11:21
+1 ;;1.6;HEALTH LEVEL SEVEN;**2,9,14,19,43,57,109**;Oct 13, 1995
+2 ;
+3 ;The SEND function is invoked by the transaction processor.
+4 ;It's function is to $O through the ITEM multiple of the Event Driver
+5 ;Protocol and create child entries in the Message Text file (#772)
+6 ;for the message at HLMTIEN. These child messages point back
+7 ;to the parent message so that message text does not need to
+8 ;be duplicated when a message is sent to multiple applications.
+9 ;
+10 ;The SENDACK function is also invoked by the transaction processor.
+11 ;It's function is to create a child entry in the Message Text file
+12 ;for the message at HLMTIENA and deliver the message to the
+13 ;application the requested/sent information.
+14 ;
+15 ;For DHCP to DHCP messaging (i.e. internal to internal), an incoming
+16 ;message is created in the Message Text file which is a duplication
+17 ;of the outgoing message. The incoming message is then processed by
+18 ;calling the transaction processor.
+19 ;
+20 ;For DHCP to COTS messaging (i.e. internal to external), the message
+21 ;is filed in the Message Text file with the Logical Link defined and
+22 ;a status of PENDING TRANSMISSION. These entries are picked up by
+23 ;the background filer and transmitted to the appropriate COTS system.
+24 ;
SEND(HLMTIEN,HLEID,HLRESULT) ;Send an HL7 message
+1 ;HLMTIEN=The IEN of the parent message in file # 772
+2 ;HLEID=The IEN of the Event Driver protocol in file #101
+3 ;HLRESULT=Variable for any error text (pass by reference)
+4 ;
+5 ;Declare variables
+6 NEW HLARY,HLERROR,HLEIDS,HLCLIENT,HLOGLINK,HLMTIENS,HLMSGPTR
+7 SET HLERROR=""
+8 ;Direct connect
+9 IF HLPRIO="I"
Begin DoDot:1
+10 DO DC^HLMA2
+11 SET HLRESULT=HLERROR
End DoDot:1
QUIT
+12 ;Get all subscribers to the message
+13 DO ITEM^HLUTIL2(HLEID,"PTR")
+14 ;Quit if no subscribers (considered successful delivery)
+15 IF ($GET(HLARY(0))'>0)
GOTO EXIT
+16 ;Deliver message to each subscriber
+17 SET HLEIDS=0
+18 FOR
SET HLEIDS=$ORDER(HLARY(HLEIDS))
IF (HLEIDS'>0)
QUIT
Begin DoDot:1
+19 ;Get pointer to receiving application
+20 SET HLCLIENT=+HLARY(HLEIDS)
SET HL("EIDS")=HLEIDS
SET HLERROR=""
+21 IF (HLCLIENT'>0)
QUIT
+22 ;Check and execute ROUTING LOGIC **CIRN**
+23 SET HLX=$GET(^ORD(101,HLEIDS,774))
+24 IF HLX]""
Begin DoDot:2
+25 NEW HLQUIT,HLNODE,HLNEXT
+26 SET HLQUIT=0
SET HLNODE=""
SET HLNEXT="D HLNEXT^HLCSUTL"
+27 ;**CIRN**
XECUTE HLX
IF $DATA(HLL("LINKS"))
DO FWD^HLCS2
KILL HLL
End DoDot:2
QUIT
+28 ;Get pointer to logical link
+29 SET HLOGLINK=$PIECE(HLARY(HLEIDS),"^",2)
+30 ;Determine if receiving application is internal or external
+31 ; Logical link has a value for external applications
+32 ; Logical link is NULL for internal applications
+33 IF (HLOGLINK)
DO COTS
QUIT
+34 ;Create 'incoming' message based on 'outgoing' message (internal)
+35 DO DHCP(HLMTIEN,HLEIDS,HLCLIENT)
+36 IF (HLERROR)
QUIT
+37 ;Process the 'incoming' message
+38 SET HLERROR=""
+39 DO PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
+40 ;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
+41 ; or ERROR DURING TRANSMISSION
+42 DO STATUS^HLTF0(HLMSGPTR,$SELECT(HLERROR:4,1:3),$SELECT(HLERROR:+HLERROR,1:""),$SELECT(HLERROR:$PIECE(HLERROR,"^",2),1:""),,$SELECT($GET(HLERR("SKIP_EVENT"))=1:1,1:0))
+43 ;**CIRN**
IF $DATA(HLL("LINKS"))
DO FWD^HLCS2
KILL HLL
End DoDot:1
+44 ;**CIRN**
DO ADD^HLCS2
EXIT SET HLRESULT=HLERROR
+1 QUIT
COTS ;Internal to external communication
+1 ;Create child entry in Message Text file
+2 NEW HLTCP,HLTCPI,HLTCPO
+3 DO SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
+4 IF ((+HLMTIENS)'>0)
SET HLERROR=HLMTIENS
QUIT
+5 ;'Pass' message to background filer by setting status of child
+6 ; to PENDING TRANSMISSION
+7 DO STATUS^HLTF0(HLMTIENS,1)
+8 QUIT
DHCP(HLMTIEN,HLEIDS,HLCLIENT) ;Internal to internal communication
+1 ;
+2 ;Input : HLMTIEN - Pointer to parent outgoing message (file #772)
+3 ; HLEIDS - Pointer to subscribing protocol (file #101)
+4 ; HLCLIENT - Pointer to receiving application (file # 771)
+5 ;
+6 ;Output : HLMTIENS - Pointer to child outgoing message (file #772)
+7 ; HLMSGPTR - Pointer to [parent] incoming message (file #772)
+8 ; HLERROR - ErrorCode ^ ErrorText
+9 ;
+10 ;Notes : This module only copies the outgoing message into an incoming
+11 ; message. Delivery of the message (i.e. processing of it)
+12 ; must be done by the calling application.
+13 ; : Message/batch header (MSH/BSH) is built and placed in the
+14 ; incoming message
+15 ; : HLMTIENS, HLMSGPTR, and HLERROR will be initialized
+16 ; : Existance and validity of input is assumed
+17 ;
+18 ;Declare variables
+19 NEW MSGID,MSGDT,MSGDTH,HDR2BLD,TMP,HLHDR,BHSHDR
+20 SET HLERROR=""
+21 SET HLMTIENS=0
+22 SET HLMSGPTR=0
+23 ;Create child entry in Message Text file
+24 DO SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS)
+25 IF ((+HLMTIENS)'>0)
SET HLERROR=HLMTIENS
QUIT
+26 ;'Receive' message by making an incoming message
+27 ;Determine type of header to build
+28 SET TMP=$GET(^HL(772,HLMTIEN,0))
+29 SET HDR2BLD=$PIECE(TMP,"^",14)
+30 ;Build message header (MSH)
+31 IF (HDR2BLD="M")
Begin DoDot:1
+32 SET TMP=""
+33 DO HEADER^HLCSHDR(HLMTIENS,.TMP)
+34 IF (TMP="")
QUIT
+35 ;Error building header
+36 SET HLERROR="4^Unable to build message header => "_TMP
+37 DO STATUS^HLTF0(HLMTIENS,4,0,$PIECE(HLERROR,"^",2))
End DoDot:1
IF (HLERROR)
QUIT
+38 ;Build batch header (BHS or FHS)
+39 IF (HDR2BLD'="M")
Begin DoDot:1
+40 SET TMP=""
+41 DO BHSHDR^HLCSHDR(HLMTIENS)
+42 IF ($EXTRACT(HLHDR(1),1)="-")
SET TMP=$PIECE(HLHDR(1),"^",2)
+43 IF (TMP="")
QUIT
+44 ;Error building header
+45 SET HLERROR="4^Unable to build batch header => "_TMP
+46 DO STATUS^HLTF0(HLMTIENS,4,0,$PIECE(HLERROR,"^",2))
End DoDot:1
IF (HLERROR)
QUIT
+47 ;Create entry for 'incoming' message
+48 DO CREATE^HLTF(.MSGID,.HLMSGPTR,.MSGDT,.MSGDTH)
+49 ;Move header and rest of message into 'incoming' message
+50 IF (HDR2BLD="M")
Begin DoDot:1
+51 ;Use MSH as header
+52 DO MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"HLHDR")
End DoDot:1
+53 IF (HDR2BLD'="M")
Begin DoDot:1
+54 ;Use BHS or FHS as header
+55 DO MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"BHSHDR")
End DoDot:1
+56 ;Set status of outgoing message to AWAITING ACKNOWLEDGEMENT
+57 DO STATUS^HLTF0(HLMTIENS,$SELECT($PIECE(^HL(772,HLMTIEN,0),U,7):3,1:2))
+58 ;Set status of 'incoming' message to AWAITING PROCESSING
+59 DO STATUS^HLTF0(HLMSGPTR,9)
+60 QUIT
SENDACK(HLMTIENA,HLEID,HLEIDS,HLRESULT) ;Send an HL7 acknowledgement/response
+1 ;HLMTIENA=The IEN of the parent acknowledgment/response message in
+2 ; file # 772
+3 ;HLEIDS=The IEN of the Subscribing protocol in file # 101
+4 ;HLEID=The IEN of the Event Driver protocol in file #101
+5 ;HLRESULT=Variable for any error text (pass by reference)
+6 ;
+7 NEW HLERROR,HLOGLINK,HLCLIENT,HLMTIENS,HLMSGPTR,HLCLNODE
+8 IF $GET(HLMTIENA)=""!($GET(HLEID)="")!($GET(HLEIDS)="")
SET HLERROR="0^7^"_$GET(^HL(771.7,7,0))_"at SENDACK^HLCS entry point"
GOTO EXIT2
+9 SET HLCLNODE=$GET(^ORD(101,HLEID,770))
+10 ;Get pointers to Logical Link & receiving application
+11 SET HLOGLINK=$PIECE($GET(^ORD(101,HLEIDS,770)),U,7)
+12 ;Application needed to dynamically address the ACK (tcp/ip)
+13 ;(set HLL("LINKS") array before calling GENACK)
+14 IF $DATA(HLL("LINKS"))
Begin DoDot:1
+15 SET HLOGLINK=$PIECE(HLL("LINKS",1),"^",2)
IF HLOGLINK=""
QUIT
+16 KILL HLL("LINKS")
+17 IF +HLOGLINK'=HLOGLINK
SET HLOGLINK=$ORDER(^HLCS(870,"B",HLOGLINK,0))
End DoDot:1
IF 'HLOGLINK
QUIT
+18 SET HLCLIENT=$PIECE(HLCLNODE,U,1)
+19 IF ('HLCLIENT)
QUIT
+20 ;Determine if receiving application is internal or external
+21 ; Logical link has a value for external applications
+22 ; Logical link is NULL for internal applications
+23 IF (HLOGLINK)
DO COTSACK
QUIT
+24 ;Create 'incoming' message based on 'outgoing' message (internal)
+25 DO DHCP(HLMTIENA,HLEID,HLCLIENT)
+26 ;Process the 'incoming' message
+27 IF (HLMSGPTR)
Begin DoDot:1
+28 SET HLERROR=""
+29 DO PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
End DoDot:1
+30 ;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
+31 ; or ERROR DURING TRANSMISSION
+32 DO STATUS^HLTF0(HLMSGPTR,$SELECT(HLERROR:4,1:3),$SELECT(HLERROR:+HLERROR,1:""),$SELECT(HLERROR:$PIECE(HLERROR,"^",2),1:""))
EXIT2 ;
+1 SET HLRESULT=$GET(HLERROR)
+2 QUIT
COTSACK ;Internal to external communication of acknowledgements/responses
+1 ;Create child entry in Message Text file
+2 DO SEND^HLMA2(HLEID,HLMTIENA,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
+3 ;'Pass' message to background filer by setting status of child
+4 ; to PENDING TRANSMISSION
+5 DO STATUS^HLTF0(HLMTIENS,1)
+6 QUIT
