188 lines
7.8 KiB
Mathematica
188 lines
7.8 KiB
Mathematica
HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm ;03/22/2007
|
|
;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134**;Oct 13, 1995;Build 30
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;
|
|
;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="Q:$QUIT """" Q"
|
|
N HOUR
|
|
S HOUR=$E($$NOW^XLFDT,1,10)
|
|
S ^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2))=$G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))+1
|
|
D END
|
|
D LINKDOWN(.HLCSTATE)
|
|
;
|
|
I ($ECODE["TOOMANYFILES")!($ECODE["EDITED") Q:$QUIT "" Q
|
|
;while debugging quit on all errors - this will return the process to the Process Manager error trap
|
|
I $G(^HLTMP("LOG ALL ERRORS")) Q:$QUIT "" Q
|
|
;
|
|
;don't log some common errors
|
|
I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
|
|
.;
|
|
E D
|
|
.;but do log all the others
|
|
.D ^%ZTER
|
|
;
|
|
;a lot of errors of the same type may indicate an endless loop
|
|
;return to the Process Manager error trap
|
|
I ($G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))>30) Q:$QUIT "" Q
|
|
;
|
|
;resume execution of the process manager executing the client
|
|
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
|
|
.S ^HLB(MSGIEN,"TRIES")=$G(^HLB(MSGIEN,"TRIES"))+1
|
|
.S SUCCESS=0
|
|
.S:$$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE) SUCCESS=1
|
|
.Q:('SUCCESS)!('$D(UPDATE))
|
|
.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),"^")
|
|
..Q:'TIME
|
|
..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
|
|
;
|
|
;start saving updates needed after the message is transmitted
|
|
S UPDATE=MSGIEN
|
|
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
|
|
;
|
|
S UPDATE=UPDATE_"^"_$$NOW^XLFDT
|
|
RETRY D
|
|
.S HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1
|
|
.I 'HLCSTATE("CONNECTED") D OPEN^HLOT(.HLCSTATE) Q:'HLCSTATE("CONNECTED")
|
|
.;
|
|
.;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
|