HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm
;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
;
;GET WORK function for the process running under the Process Manager
GETWORK(QUE) ;
;Input:
; QUE - (pass by reference) These subscripts are used:
; ("LINK") - <link name>_":"_<port> last obtained
; ("QUEUE") - name of the queue last obtained
;Output:
; Function returns 1 if success, 0 if no more work
; QUE - updated to identify next queue of messages to process.
; ("LINK") - <link name>_":"_<port>
; ("QUEUE") - the named queue on the link
; ("DOWN") - =1 means that the last OPEN attempt failed
;
N LINK,QUEUE
S LINK=$G(QUE("LINK")),QUEUE=$G(QUE("QUEUE"))
I (LINK]""),(QUEUE]"") D
.L -^HLB("QUEUE","OUT",LINK,QUEUE)
.I '$$CNNCTD(LINK),$$FAILING(.LINK) S QUEUE="" Q
.F S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="") I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0 Q:$T
I (LINK]""),(QUEUE="") D
.F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D Q:$L(QUEUE)
..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q
..S QUEUE="" F S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="") I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0 Q:$T
I LINK="" D
.F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D Q:$L(QUEUE)
..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q
..S QUEUE="" F S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="") I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0 Q:$T
S QUE("LINK")=LINK,QUE("QUEUE")=QUEUE,QUE("DOWN")=$G(LINK("DOWN"))
Q:$L(QUEUE) 1
D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)
Q 0
;
FAILING(LINK) ;
;Returns 1 if the link has failed in the last 30 seconds, 0 otherwise
;Also returns LINK("DOWN")=1 if the link was failing > 30 seconds ago, not yet known if its up
;
N LASTTIME,SET
S LINK("DOWN")=0
S LASTTIME=$G(^HLB("QUEUE","OUT",LINK))
S SET=$S(LASTTIME]"":1,1:0)
I SET D
.I $$HDIFF^XLFDT($H,LASTTIME,2)>30 S ^HLB("QUEUE","OUT",LINK)="",SET=0,LINK("DOWN")=1
I $D(^HLTMP("FAILING LINKS",LINK)) S LINK("DOWN")=1
Q SET
;
LINKDOWN(HLCSTATE) ;
D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)
I $D(HLCSTATE("LINK","NAME")),$D(HLCSTATE("LINK","PORT")) D
.S TO=HLCSTATE("LINK","NAME")_":"_HLCSTATE("LINK","PORT")
.S ^HLB("QUEUE","OUT",TO)=$H
.S:'$D(^HLTMP("FAILING LINKS",TO)) ^HLTMP("FAILING LINKS",TO)=$H
Q
;
ERROR ;error trap
S $ETRAP="D UNWIND^%ZTER"
D END
D LINKDOWN(.HLCSTATE)
;
;while debugging quit on all errors - this will return the process to the Process Manager error trap
I $G(^HLTMP("LOG ALL ERRORS")) QUIT
;
;don't log some common errors
I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
.;
E D
.D ^%ZTER
;
;a lot of errors of the same type may indicate an endless loop, so keep a count
S ^TMP("HL7 ERRORS",$J,$ECODE)=$G(^TMP("HL7 ERRORS",$J,$ECODE))+1
;
QUIT:($G(^TMP("HL7 ERRORS",$J,$ECODE))>100) ;return to the Process Manager error trap
D UNWIND^%ZTER
Q
;
DOWORK(QUEUE) ;sends the messages on the queue
N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOCLNT"
N MSGIEN,DEQUE,SUCCESS,MSGCOUNT
S DEQUE=0
S SUCCESS=1
I '$$CNNCTD(QUEUE("LINK")),'$$CONNECT^HLOCLNT1($P(QUEUE("LINK"),":"),$P(QUEUE("LINK"),":",2),30,.HLCSTATE) Q
;
S (MSGCOUNT,MSGIEN)=0
F S MSGIEN=$O(^HLB("QUEUE","OUT",QUEUE("LINK"),QUEUE("QUEUE"),MSGIEN)) Q:'MSGIEN D Q:'SUCCESS Q:MSGCOUNT>1000
.N UPDATE
.I $$INC^HLOSITE($NA(^HLB(MSGIEN,"TRIES"))) S SUCCESS=0
.S:$$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE) SUCCESS=1
.Q:('SUCCESS)!('$D(UPDATE)) ;'$D(UPDATE) with SUCCESS=1 means that the message is to be removed from the queue without actually being transmitted
.D DEQUE(.UPDATE)
.S MSGCOUNT=MSGCOUNT+1
.D:HLCSTATE("COUNTS")>4 SAVECNTS^HLOSTAT(.HLCSTATE)
.;
.;if the queue was on the down list, and not since shutdown, mark it as up, since a message has been successfully transmitted across it
.I $G(QUEUE("DOWN"))!$$FAILING(QUEUE("LINK")),'$$IFSHUT^HLOTLNK(QUEUE("LINK")) S QUEUE("DOWN")=0,^HLB("QUEUE","OUT",QUEUE("LINK"))="" K ^HLTMP("FAILING LINKS",QUEUE("LINK"))
;
END D DEQUE()
D SAVECNTS^HLOSTAT(.HLCSTATE)
Q
CNNCTD(LINK) ;
;Connected to LINK? HLCSTATE must be defined, LINK=<link name>:<port>
;
I ($G(HLCSTATE("LINK","NAME"))=$P(LINK,":")),($G(HLCSTATE("LINK","PORT"))=$P(LINK,":",2)),$G(HLCSTATE("CONNECTED")) Q 1
Q 0
;
DEQUE(UPDATE) ;
I $D(UPDATE) S DEQUE=DEQUE+1,DEQUE(+UPDATE)=$P(UPDATE,"^",2,99) S:$G(UPDATE("MSA"))]"" DEQUE(+UPDATE,"MSA")=UPDATE("MSA") S:$G(UPDATE("ACTION"))]"" DEQUE(+UPDATE,"ACTION")=UPDATE("ACTION")
I '$D(UPDATE)!(DEQUE>15) D
.N MSGIEN S MSGIEN=0
.F S MSGIEN=$O(DEQUE(MSGIEN)) Q:'MSGIEN D
..N NODE,TIME
..D DEQUE^HLOQUE(QUEUE("LINK"),QUEUE("QUEUE"),"OUT",MSGIEN)
..S TIME=$P(DEQUE(MSGIEN),"^")
..S NODE=QUEUE("LINK")_"^"_QUEUE("QUEUE")_"^"_$P(DEQUE(MSGIEN),"^",2,99)
..S ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN)=NODE
..S:$G(DEQUE(MSGIEN,"MSA"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"MSA")=DEQUE(MSGIEN,"MSA")
..S:$G(DEQUE(MSGIEN,"ACTION"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"ACTION")=DEQUE(MSGIEN,"ACTION")
.K DEQUE S DEQUE=0
Q
;
TRANSMIT(HLCSTATE,MSGIEN,UPDATE) ;
;Transmits a single message and if a commit ack was requested reads it. Updates file 778 with the result. Queues for the infiler the application accept action if one was requested.
;Input:
; HLCSTATE (pass by reference)
; MSGIEN - ien, file 778, of message to be transmitted
;Output:
; Function returns 1 on success, 0 on failure
; UPDATE - (pass by reference) to contain updates needed for message
;
N HLMSTATE,MSA,HDR,SUCCESS
;
S SUCCESS=0
S HLCSTATE("ATTEMPT")=0
;
Q:'$$GETMSG^HLOCLNT2(MSGIEN,.HLMSTATE) 1 ;returns 1 so the message will be removed from the queue
I HLMSTATE("DT/TM"),HLMSTATE("STATUS","ACCEPTED")!(HLMSTATE("HDR","ACCEPT ACK TYPE")="NE") Q 1 ;the message was already transmitted
;
;start saving updates needed after the message is transmitted
S UPDATE=MSGIEN_"^"_$$NOW^XLFDT
RETRY D
.S HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1
.I 'HLCSTATE("CONNECTED") D OPEN^HLOT(.HLCSTATE)
.;
.;try to send the message
.Q:'$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE)
.;does the message need an accept ack?
.I HLMSTATE("HDR","ACCEPT ACK TYPE")="AL" D
..N FS
..Q:'$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA)
..;does the MSA refer to the correct control id?
..S FS=$E(HDR(1),4)
..Q:$P(MSA,FS,3)'=HLMSTATE("ID")
..N ACKID,ACKCODE
..S ACKCODE=$P(MSA,FS,2)
..S ACKID=$S($E(HDR(1),1,3)="MSH":$P(HDR(2),FS,5),1:$P(HDR(2),FS,6))
..S $P(UPDATE,"^",5)=1
..S UPDATE("MSA")=ACKID_"^"_MSA
..I '(ACKCODE="CA") S $P(UPDATE,"^",3)="SE",$P(UPDATE,"^",4)=2
..I ACKCODE="CA",HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):"2",1:1)
..I ($P(UPDATE,"^",3)="SE") S $P(UPDATE,"^",6)=$P(HLMSTATE("HDR",1),FS,5) ;errors need the application for xref
..;
..;did the app request notification of accept ack?
..S UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE")
..S SUCCESS=1
.E D ;accept ack wasn't requested
..S SUCCESS=1
..I HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):2,1:1)
;
I 'SUCCESS,'HLCSTATE("CONNECTED"),(HLCSTATE("ATTEMPT")<2) G RETRY
I SUCCESS D
.D COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$S(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT")))
.;if this is an ack to a message need to purge the original message, so store its ien with the purge date
.S:$G(HLMSTATE("ACK TO IEN")) $P(UPDATE,"^",4)=$P(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN")
I ('HLCSTATE("CONNECTED"))!('SUCCESS) D LINKDOWN(.HLCSTATE)
Q SUCCESS
HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10
+2 ;
+3 ;GET WORK function for the process running under the Process Manager
GETWORK(QUE) ;
+1 ;Input:
+2 ; QUE - (pass by reference) These subscripts are used:
+3 ; ("LINK") - <link name>_":"_<port> last obtained
+4 ; ("QUEUE") - name of the queue last obtained
+5 ;Output:
+6 ; Function returns 1 if success, 0 if no more work
+7 ; QUE - updated to identify next queue of messages to process.
+8 ; ("LINK") - <link name>_":"_<port>
+9 ; ("QUEUE") - the named queue on the link
+10 ; ("DOWN") - =1 means that the last OPEN attempt failed
+11 ;
+12 NEW LINK,QUEUE
+13 SET LINK=$GET(QUE("LINK"))
SET QUEUE=$GET(QUE("QUEUE"))
+14 IF (LINK]"")
IF (QUEUE]"")
Begin DoDot:1
+15 LOCK -^HLB("QUEUE","OUT",LINK,QUEUE)
+16 IF '$$CNNCTD(LINK)
IF $$FAILING(.LINK)
SET QUEUE=""
QUIT
+17 FOR
SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))
IF (QUEUE="")
QUIT
IF '$$STOPPED^HLOQUE("OUT",QUEUE)
LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0
IF $TEST
QUIT
End DoDot:1
+18 IF (LINK]"")
IF (QUEUE="")
Begin DoDot:1
+19 FOR
SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))
IF LINK=""
QUIT
Begin DoDot:2
+20 IF '$$CNNCTD(LINK)
IF $$FAILING(.LINK)
QUIT
+21 SET QUEUE=""
FOR
SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))
IF (QUEUE="")
QUIT
IF '$$STOPPED^HLOQUE("OUT",QUEUE)
LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0
IF $TEST
QUIT
End DoDot:2
IF $LENGTH(QUEUE)
QUIT
End DoDot:1
+22 IF LINK=""
Begin DoDot:1
+23 FOR
SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))
IF LINK=""
QUIT
Begin DoDot:2
+24 IF '$$CNNCTD(LINK)
IF $$FAILING(.LINK)
QUIT
+25 SET QUEUE=""
FOR
SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))
IF (QUEUE="")
QUIT
IF '$$STOPPED^HLOQUE("OUT",QUEUE)
LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0
IF $TEST
QUIT
End DoDot:2
IF $LENGTH(QUEUE)
QUIT
End DoDot:1
+26 SET QUE("LINK")=LINK
SET QUE("QUEUE")=QUEUE
SET QUE("DOWN")=$GET(LINK("DOWN"))
+27 IF $LENGTH(QUEUE)
QUIT 1
+28 IF $GET(HLCSTATE("CONNECTED"))
DO CLOSE^HLOT(.HLCSTATE)
+29 QUIT 0
+30 ;
FAILING(LINK) ;
+1 ;Returns 1 if the link has failed in the last 30 seconds, 0 otherwise
+2 ;Also returns LINK("DOWN")=1 if the link was failing > 30 seconds ago, not yet known if its up
+3 ;
+4 NEW LASTTIME,SET
+5 SET LINK("DOWN")=0
+6 SET LASTTIME=$GET(^HLB("QUEUE","OUT",LINK))
+7 SET SET=$SELECT(LASTTIME]"":1,1:0)
+8 IF SET
Begin DoDot:1
+9 IF $$HDIFF^XLFDT($HOROLOG,LASTTIME,2)>30
SET ^HLB("QUEUE","OUT",LINK)=""
SET SET=0
SET LINK("DOWN")=1
End DoDot:1
+10 IF $DATA(^HLTMP("FAILING LINKS",LINK))
SET LINK("DOWN")=1
+11 QUIT SET
+12 ;
LINKDOWN(HLCSTATE) ;
+1 IF $GET(HLCSTATE("CONNECTED"))
DO CLOSE^HLOT(.HLCSTATE)
+2 IF $DATA(HLCSTATE("LINK","NAME"))
IF $DATA(HLCSTATE("LINK","PORT"))
Begin DoDot:1
+3 SET TO=HLCSTATE("LINK","NAME")_":"_HLCSTATE("LINK","PORT")
+4 SET ^HLB("QUEUE","OUT",TO)=$HOROLOG
+5 IF '$DATA(^HLTMP("FAILING LINKS",TO))
SET ^HLTMP("FAILING LINKS",TO)=$HOROLOG
End DoDot:1
+6 QUIT
+7 ;
ERROR ;error trap
+1 SET $ETRAP="D UNWIND^%ZTER"
+2 DO END
+3 DO LINKDOWN(.HLCSTATE)
+4 ;
+5 ;while debugging quit on all errors - this will return the process to the Process Manager error trap
+6 IF $GET(^HLTMP("LOG ALL ERRORS"))
QUIT
+7 ;
+8 ;don't log some common errors
+9 IF ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR")
Begin DoDot:1
+10 ;
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO ^%ZTER
End DoDot:1
+13 ;
+14 ;a lot of errors of the same type may indicate an endless loop, so keep a count
+15 SET ^TMP("HL7 ERRORS",$JOB,$ECODE)=$GET(^TMP("HL7 ERRORS",$JOB,$ECODE))+1
+16 ;
+17 ;return to the Process Manager error trap
IF ($GET(^TMP("HL7 ERRORS",$JOB,$ECODE))>100)
QUIT
+18 DO UNWIND^%ZTER
+19 QUIT
+20 ;
DOWORK(QUEUE) ;sends the messages on the queue
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="G ERROR^HLOCLNT"
+2 NEW MSGIEN,DEQUE,SUCCESS,MSGCOUNT
+3 SET DEQUE=0
+4 SET SUCCESS=1
+5 IF '$$CNNCTD(QUEUE("LINK"))
IF '$$CONNECT^HLOCLNT1($PIECE(QUEUE("LINK"),":"),$PIECE(QUEUE("LINK"),":",2),30,.HLCSTATE)
QUIT
+6 ;
+7 SET (MSGCOUNT,MSGIEN)=0
+8 FOR
SET MSGIEN=$ORDER(^HLB("QUEUE","OUT",QUEUE("LINK"),QUEUE("QUEUE"),MSGIEN))
IF 'MSGIEN
QUIT
Begin DoDot:1
+9 NEW UPDATE
+10 IF $$INC^HLOSITE($NAME(^HLB(MSGIEN,"TRIES")))
SET SUCCESS=0
+11 IF $$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE)
SET SUCCESS=1
+12 ;'$D(UPDATE) with SUCCESS=1 means that the message is to be removed from the queue without actually being transmitted
IF ('SUCCESS)!('$DATA(UPDATE))
QUIT
+13 DO DEQUE(.UPDATE)
+14 SET MSGCOUNT=MSGCOUNT+1
+15 IF HLCSTATE("COUNTS")>4
DO SAVECNTS^HLOSTAT(.HLCSTATE)
+16 ;
+17 ;if the queue was on the down list, and not since shutdown, mark it as up, since a message has been successfully transmitted across it
+18 IF $GET(QUEUE("DOWN"))!$$FAILING(QUEUE("LINK"))
IF '$$IFSHUT^HLOTLNK(QUEUE("LINK"))
SET QUEUE("DOWN")=0
SET ^HLB("QUEUE","OUT",QUEUE("LINK"))=""
KILL ^HLTMP("FAILING LINKS",QUEUE("LINK"))
End DoDot:1
IF 'SUCCESS
QUIT
IF MSGCOUNT>1000
QUIT
+19 ;
END DO DEQUE()
+1 DO SAVECNTS^HLOSTAT(.HLCSTATE)
+2 QUIT
CNNCTD(LINK) ;
+1 ;Connected to LINK? HLCSTATE must be defined, LINK=<link name>:<port>
+2 ;
+3 IF ($GET(HLCSTATE("LINK","NAME"))=$PIECE(LINK,":"))
IF ($GET(HLCSTATE("LINK","PORT"))=$PIECE(LINK,":",2))
IF $GET(HLCSTATE("CONNECTED"))
QUIT 1
+4 QUIT 0
+5 ;
DEQUE(UPDATE) ;
+1 IF $DATA(UPDATE)
SET DEQUE=DEQUE+1
SET DEQUE(+UPDATE)=$PIECE(UPDATE,"^",2,99)
IF $GET(UPDATE("MSA"))]""
SET DEQUE(+UPDATE,"MSA")=UPDATE("MSA")
IF $GET(UPDATE("ACTION"))]""
SET DEQUE(+UPDATE,"ACTION")=UPDATE("ACTION")
+2 IF '$DATA(UPDATE)!(DEQUE>15)
Begin DoDot:1
+3 NEW MSGIEN
SET MSGIEN=0
+4 FOR
SET MSGIEN=$ORDER(DEQUE(MSGIEN))
IF 'MSGIEN
QUIT
Begin DoDot:2
+5 NEW NODE,TIME
+6 DO DEQUE^HLOQUE(QUEUE("LINK"),QUEUE("QUEUE"),"OUT",MSGIEN)
+7 SET TIME=$PIECE(DEQUE(MSGIEN),"^")
+8 SET NODE=QUEUE("LINK")_"^"_QUEUE("QUEUE")_"^"_$PIECE(DEQUE(MSGIEN),"^",2,99)
+9 SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN)=NODE
+10 IF $GET(DEQUE(MSGIEN,"MSA"))]""
SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN,"MSA")=DEQUE(MSGIEN,"MSA")
+11 IF $GET(DEQUE(MSGIEN,"ACTION"))]""
SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN,"ACTION")=DEQUE(MSGIEN,"ACTION")
End DoDot:2
+12 KILL DEQUE
SET DEQUE=0
End DoDot:1
+13 QUIT
+14 ;
TRANSMIT(HLCSTATE,MSGIEN,UPDATE) ;
+1 ;Transmits a single message and if a commit ack was requested reads it. Updates file 778 with the result. Queues for the infiler the application accept action if one was requested.
+2 ;Input:
+3 ; HLCSTATE (pass by reference)
+4 ; MSGIEN - ien, file 778, of message to be transmitted
+5 ;Output:
+6 ; Function returns 1 on success, 0 on failure
+7 ; UPDATE - (pass by reference) to contain updates needed for message
+8 ;
+9 NEW HLMSTATE,MSA,HDR,SUCCESS
+10 ;
+11 SET SUCCESS=0
+12 SET HLCSTATE("ATTEMPT")=0
+13 ;
+14 ;returns 1 so the message will be removed from the queue
IF '$$GETMSG^HLOCLNT2(MSGIEN,.HLMSTATE)
QUIT 1
+15 ;the message was already transmitted
IF HLMSTATE("DT/TM")
IF HLMSTATE("STATUS","ACCEPTED")!(HLMSTATE("HDR","ACCEPT ACK TYPE")="NE")
QUIT 1
+16 ;
+17 ;start saving updates needed after the message is transmitted
+18 SET UPDATE=MSGIEN_"^"_$$NOW^XLFDT
RETRY Begin DoDot:1
+1 SET HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1
+2 IF 'HLCSTATE("CONNECTED")
DO OPEN^HLOT(.HLCSTATE)
+3 ;
+4 ;try to send the message
+5 IF '$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE)
QUIT
+6 ;does the message need an accept ack?
+7 IF HLMSTATE("HDR","ACCEPT ACK TYPE")="AL"
Begin DoDot:2
+8 NEW FS
+9 IF '$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA)
QUIT
+10 ;does the MSA refer to the correct control id?
+11 SET FS=$EXTRACT(HDR(1),4)
+12 IF $PIECE(MSA,FS,3)'=HLMSTATE("ID")
QUIT
+13 NEW ACKID,ACKCODE
+14 SET ACKCODE=$PIECE(MSA,FS,2)
+15 SET ACKID=$SELECT($EXTRACT(HDR(1),1,3)="MSH":$PIECE(HDR(2),FS,5),1:$PIECE(HDR(2),FS,6))
+16 SET $PIECE(UPDATE,"^",5)=1
+17 SET UPDATE("MSA")=ACKID_"^"_MSA
+18 IF '(ACKCODE="CA")
SET $PIECE(UPDATE,"^",3)="SE"
SET $PIECE(UPDATE,"^",4)=2
+19 IF ACKCODE="CA"
IF HLMSTATE("HDR","APP ACK TYPE")="NE"
SET $PIECE(UPDATE,"^",3)="SU"
SET $PIECE(UPDATE,"^",4)=$SELECT(HLMSTATE("BATCH"):"2",1:1)
+20 ;errors need the application for xref
IF ($PIECE(UPDATE,"^",3)="SE")
SET $PIECE(UPDATE,"^",6)=$PIECE(HLMSTATE("HDR",1),FS,5)
+21 ;
+22 ;did the app request notification of accept ack?
+23 SET UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE")
+24 SET SUCCESS=1
End DoDot:2
+25 ;accept ack wasn't requested
IF '$TEST
Begin DoDot:2
+26 SET SUCCESS=1
+27 IF HLMSTATE("HDR","APP ACK TYPE")="NE"
SET $PIECE(UPDATE,"^",3)="SU"
SET $PIECE(UPDATE,"^",4)=$SELECT(HLMSTATE("BATCH"):2,1:1)
End DoDot:2
End DoDot:1
+28 ;
+29 IF 'SUCCESS
IF 'HLCSTATE("CONNECTED")
IF (HLCSTATE("ATTEMPT")<2)
GOTO RETRY
+30 IF SUCCESS
Begin DoDot:1
+31 DO COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$SELECT(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT")))
+32 ;if this is an ack to a message need to purge the original message, so store its ien with the purge date
+33 IF $GET(HLMSTATE("ACK TO IEN"))
SET $PIECE(UPDATE,"^",4)=$PIECE(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN")
End DoDot:1
+34 IF ('HLCSTATE("CONNECTED"))!('SUCCESS)
DO LINKDOWN(.HLCSTATE)
+35 QUIT SUCCESS
