Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCS

HLCS.m

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