| 1 | HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm ;08/15/2007
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134,137**;Oct 13, 1995;Build 21
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;GET WORK function for the process running under the Process Manager
|
|---|
| 6 | GETWORK(QUE) ;
|
|---|
| 7 | ;Input:
|
|---|
| 8 | ; QUE - (pass by reference) These subscripts are used:
|
|---|
| 9 | ; ("LINK") - <link name>_":"_<port> last obtained
|
|---|
| 10 | ; ("QUEUE") - name of the queue last obtained
|
|---|
| 11 | ;Output:
|
|---|
| 12 | ; Function returns 1 if success, 0 if no more work
|
|---|
| 13 | ; QUE - updated to identify next queue of messages to process.
|
|---|
| 14 | ; ("LINK") - <link name>_":"_<port>
|
|---|
| 15 | ; ("QUEUE") - the named queue on the link
|
|---|
| 16 | ; ("DOWN") - =1 means that the last OPEN attempt failed
|
|---|
| 17 | ;
|
|---|
| 18 | N LINK,QUEUE
|
|---|
| 19 | S LINK=$G(QUE("LINK")),QUEUE=$G(QUE("QUEUE"))
|
|---|
| 20 | I (LINK]""),(QUEUE]"") D
|
|---|
| 21 | .L -^HLB("QUEUE","OUT",LINK,QUEUE)
|
|---|
| 22 | .I '$$CNNCTD(LINK),$$FAILING(.LINK) S QUEUE="" Q
|
|---|
| 23 | .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
|
|---|
| 24 | I (LINK]""),(QUEUE="") D
|
|---|
| 25 | .F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D Q:$L(QUEUE)
|
|---|
| 26 | ..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q
|
|---|
| 27 | ..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
|
|---|
| 28 | I LINK="" D
|
|---|
| 29 | .F S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK="" D Q:$L(QUEUE)
|
|---|
| 30 | ..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q
|
|---|
| 31 | ..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
|
|---|
| 32 | S QUE("LINK")=LINK,QUE("QUEUE")=QUEUE,QUE("DOWN")=$G(LINK("DOWN"))
|
|---|
| 33 | Q:$L(QUEUE) 1
|
|---|
| 34 | D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)
|
|---|
| 35 | Q 0
|
|---|
| 36 | ;
|
|---|
| 37 | FAILING(LINK) ;
|
|---|
| 38 | ;Returns 1 if the link has failed in the last 30 seconds, 0 otherwise
|
|---|
| 39 | ;Also returns LINK("DOWN")=1 if the link was failing > 30 seconds ago, not yet known if its up
|
|---|
| 40 | ;
|
|---|
| 41 | N LASTTIME,SET
|
|---|
| 42 | S LINK("DOWN")=0
|
|---|
| 43 | S LASTTIME=$G(^HLB("QUEUE","OUT",LINK))
|
|---|
| 44 | S SET=$S(LASTTIME]"":1,1:0)
|
|---|
| 45 | I SET D
|
|---|
| 46 | .I $$HDIFF^XLFDT($H,LASTTIME,2)>30 S ^HLB("QUEUE","OUT",LINK)="",SET=0,LINK("DOWN")=1
|
|---|
| 47 | I $D(^HLTMP("FAILING LINKS",LINK)) S LINK("DOWN")=1
|
|---|
| 48 | Q SET
|
|---|
| 49 | ;
|
|---|
| 50 | LINKDOWN(HLCSTATE) ;
|
|---|
| 51 | D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)
|
|---|
| 52 | I $D(HLCSTATE("LINK","NAME")),$D(HLCSTATE("LINK","PORT")) D
|
|---|
| 53 | .S TO=HLCSTATE("LINK","NAME")_":"_HLCSTATE("LINK","PORT")
|
|---|
| 54 | .S ^HLB("QUEUE","OUT",TO)=$H
|
|---|
| 55 | .S:'$D(^HLTMP("FAILING LINKS",TO)) ^HLTMP("FAILING LINKS",TO)=$H
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ERROR ;error trap
|
|---|
| 59 | S $ETRAP="Q:$QUIT """" Q"
|
|---|
| 60 | N HOUR
|
|---|
| 61 | S HOUR=$E($$NOW^XLFDT,1,10)
|
|---|
| 62 | S ^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2))=$G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))+1
|
|---|
| 63 | D END
|
|---|
| 64 | D LINKDOWN(.HLCSTATE)
|
|---|
| 65 | ;
|
|---|
| 66 | I ($ECODE["TOOMANYFILES")!($ECODE["EDITED") Q:$QUIT "" Q
|
|---|
| 67 | ;while debugging quit on all errors - this will return the process to the Process Manager error trap
|
|---|
| 68 | I $G(^HLTMP("LOG ALL ERRORS")) Q:$QUIT "" Q
|
|---|
| 69 | ;
|
|---|
| 70 | ;don't log some common errors
|
|---|
| 71 | I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
|
|---|
| 72 | .;
|
|---|
| 73 | E D
|
|---|
| 74 | .;but do log all the others
|
|---|
| 75 | .D ^%ZTER
|
|---|
| 76 | ;
|
|---|
| 77 | ;a lot of errors of the same type may indicate an endless loop
|
|---|
| 78 | ;return to the Process Manager error trap
|
|---|
| 79 | I ($G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))>30) Q:$QUIT "" Q
|
|---|
| 80 | ;
|
|---|
| 81 | ;resume execution of the process manager executing the client
|
|---|
| 82 | D UNWIND^%ZTER
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | DOWORK(QUEUE) ;sends the messages on the queue
|
|---|
| 86 | N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOCLNT"
|
|---|
| 87 | N MSGIEN,DEQUE,SUCCESS,MSGCOUNT
|
|---|
| 88 | S DEQUE=0
|
|---|
| 89 | S SUCCESS=1
|
|---|
| 90 | ;
|
|---|
| 91 | I '$$CNNCTD(QUEUE("LINK")),'$$CONNECT^HLOCLNT1($P(QUEUE("LINK"),":"),$P(QUEUE("LINK"),":",2),30,.HLCSTATE) Q
|
|---|
| 92 | ;
|
|---|
| 93 | S (MSGCOUNT,MSGIEN)=0
|
|---|
| 94 | F S MSGIEN=$O(^HLB("QUEUE","OUT",QUEUE("LINK"),QUEUE("QUEUE"),MSGIEN)) Q:'MSGIEN D Q:'SUCCESS Q:MSGCOUNT>1000
|
|---|
| 95 | .N UPDATE
|
|---|
| 96 | .S ^HLB(MSGIEN,"TRIES")=$G(^HLB(MSGIEN,"TRIES"))+1
|
|---|
| 97 | .S SUCCESS=0
|
|---|
| 98 | .S:$$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE) SUCCESS=1
|
|---|
| 99 | .Q:('SUCCESS)!('$D(UPDATE))
|
|---|
| 100 | .D DEQUE(.UPDATE)
|
|---|
| 101 | .S MSGCOUNT=MSGCOUNT+1
|
|---|
| 102 | .D:HLCSTATE("COUNTS")>4 SAVECNTS^HLOSTAT(.HLCSTATE)
|
|---|
| 103 | .;
|
|---|
| 104 | .;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
|
|---|
| 105 | .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"))
|
|---|
| 106 | ;
|
|---|
| 107 | END D DEQUE()
|
|---|
| 108 | D SAVECNTS^HLOSTAT(.HLCSTATE)
|
|---|
| 109 | Q
|
|---|
| 110 | CNNCTD(LINK) ;
|
|---|
| 111 | ;Connected to LINK? HLCSTATE must be defined, LINK=<link name>:<port>
|
|---|
| 112 | ;
|
|---|
| 113 | I ($G(HLCSTATE("LINK","NAME"))=$P(LINK,":")),($G(HLCSTATE("LINK","PORT"))=$P(LINK,":",2)),$G(HLCSTATE("CONNECTED")) Q 1
|
|---|
| 114 | Q 0
|
|---|
| 115 | ;
|
|---|
| 116 | DEQUE(UPDATE) ;
|
|---|
| 117 | 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")
|
|---|
| 118 | I '$D(UPDATE)!(DEQUE>15) D
|
|---|
| 119 | .N MSGIEN S MSGIEN=0
|
|---|
| 120 | .F S MSGIEN=$O(DEQUE(MSGIEN)) Q:'MSGIEN D
|
|---|
| 121 | ..N NODE,TIME
|
|---|
| 122 | ..D DEQUE^HLOQUE(QUEUE("LINK"),QUEUE("QUEUE"),"OUT",MSGIEN)
|
|---|
| 123 | ..S TIME=$P(DEQUE(MSGIEN),"^")
|
|---|
| 124 | ..Q:'TIME
|
|---|
| 125 | ..S NODE=QUEUE("LINK")_"^"_QUEUE("QUEUE")_"^"_$P(DEQUE(MSGIEN),"^",2,99)
|
|---|
| 126 | ..S ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN)=NODE
|
|---|
| 127 | ..S:$G(DEQUE(MSGIEN,"MSA"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"MSA")=DEQUE(MSGIEN,"MSA")
|
|---|
| 128 | ..S:$G(DEQUE(MSGIEN,"ACTION"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"ACTION")=DEQUE(MSGIEN,"ACTION")
|
|---|
| 129 | .K DEQUE S DEQUE=0
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | TRANSMIT(HLCSTATE,MSGIEN,UPDATE) ;
|
|---|
| 133 | ;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.
|
|---|
| 134 | ;Input:
|
|---|
| 135 | ; HLCSTATE (pass by reference)
|
|---|
| 136 | ; MSGIEN - ien, file 778, of message to be transmitted
|
|---|
| 137 | ;Output:
|
|---|
| 138 | ; Function returns 1 on success, 0 on failure
|
|---|
| 139 | ; UPDATE - (pass by reference) to contain updates needed for message
|
|---|
| 140 | ;
|
|---|
| 141 | N HLMSTATE,MSA,HDR,SUCCESS
|
|---|
| 142 | ;
|
|---|
| 143 | S SUCCESS=0
|
|---|
| 144 | S HLCSTATE("ATTEMPT")=0
|
|---|
| 145 | ;
|
|---|
| 146 | ;start saving updates needed after the message is transmitted
|
|---|
| 147 | S UPDATE=MSGIEN
|
|---|
| 148 | Q:'$$GETMSG^HLOCLNT2(MSGIEN,.HLMSTATE) 1 ;returns 1 so the message will be removed from the queue
|
|---|
| 149 | I HLMSTATE("DT/TM"),HLMSTATE("STATUS","ACCEPTED")!(HLMSTATE("HDR","ACCEPT ACK TYPE")="NE") Q 1 ;the message was already transmitted
|
|---|
| 150 | ;
|
|---|
| 151 | S UPDATE=UPDATE_"^"_$$NOW^XLFDT
|
|---|
| 152 | RETRY D
|
|---|
| 153 | .S HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1
|
|---|
| 154 | .I 'HLCSTATE("CONNECTED") D OPEN^HLOT(.HLCSTATE) Q:'HLCSTATE("CONNECTED")
|
|---|
| 155 | .;
|
|---|
| 156 | .;try to send the message
|
|---|
| 157 | .;
|
|---|
| 158 | .;
|
|---|
| 159 | .Q:'$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE)
|
|---|
| 160 | .;does the message need an accept ack?
|
|---|
| 161 | .I HLMSTATE("HDR","ACCEPT ACK TYPE")="AL" D
|
|---|
| 162 | ..N FS
|
|---|
| 163 | ..Q:'$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA)
|
|---|
| 164 | ..;does the MSA refer to the correct control id?
|
|---|
| 165 | ..S FS=$E(HDR(1),4)
|
|---|
| 166 | ..Q:$P(MSA,FS,3)'=HLMSTATE("ID")
|
|---|
| 167 | ..N ACKID,ACKCODE
|
|---|
| 168 | ..S ACKCODE=$P(MSA,FS,2)
|
|---|
| 169 | ..S ACKID=$S($E(HDR(1),1,3)="MSH":$P(HDR(2),FS,5),1:$P(HDR(2),FS,6))
|
|---|
| 170 | ..S $P(UPDATE,"^",5)=1
|
|---|
| 171 | ..S UPDATE("MSA")=ACKID_"^"_MSA
|
|---|
| 172 | ..I '(ACKCODE="CA") S $P(UPDATE,"^",3)="ER",$P(UPDATE,"^",4)=2
|
|---|
| 173 | ..I ACKCODE="CA",HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):"2",1:1)
|
|---|
| 174 | ..I ($P(UPDATE,"^",3)="ER") S $P(UPDATE,"^",6)=$P(HLMSTATE("HDR",1),FS,5) ;errors need the application for xref
|
|---|
| 175 | ..;
|
|---|
| 176 | ..;if it's from a sequence queue, timestamp the queue
|
|---|
| 177 | ..I $L($G(HLMSTATE("STATUS","SEQUENCE QUEUE"))) D
|
|---|
| 178 | ...L +^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE")):200
|
|---|
| 179 | ...I $P($G(^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE"))),"^")'=MSGIEN L -^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE")) Q
|
|---|
| 180 | ...I ACKCODE="CA" S $P(^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE")),"^",2)=$$FMADD^XLFDT($P(UPDATE,"^",2),,,$$TIMEOUT^HLOAPP($$GETSAP^HLOCLNT2(MSGIEN))) L -^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE")) Q
|
|---|
| 181 | ...;if the message wasn't accepted, need to notify without waiting
|
|---|
| 182 | ...S $P(^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE")),"^",2)=$P(UPDATE,"^",2)
|
|---|
| 183 | ...L -^HLB("QUEUE","SEQUENCE",HLMSTATE("STATUS","SEQUENCE QUEUE"))
|
|---|
| 184 | ..;
|
|---|
| 185 | ..;does the app need notification of accept ack?
|
|---|
| 186 | ..S UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE")
|
|---|
| 187 | ..;
|
|---|
| 188 | ..S SUCCESS=1
|
|---|
| 189 | .E D ;accept ack wasn't requested
|
|---|
| 190 | ..S SUCCESS=1
|
|---|
| 191 | ..I HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):2,1:1)
|
|---|
| 192 | ;
|
|---|
| 193 | I 'SUCCESS,'HLCSTATE("CONNECTED"),(HLCSTATE("ATTEMPT")<2) G RETRY
|
|---|
| 194 | I SUCCESS D
|
|---|
| 195 | .D COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$S(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT")))
|
|---|
| 196 | .;if this is an ack to a message need to purge the original message, so store its ien with the purge date
|
|---|
| 197 | .S:$G(HLMSTATE("ACK TO IEN")) $P(UPDATE,"^",4)=$P(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN")
|
|---|
| 198 | I ('HLCSTATE("CONNECTED"))!('SUCCESS) D LINKDOWN(.HLCSTATE)
|
|---|
| 199 | Q SUCCESS
|
|---|
