Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT.m
r613 r623 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 1 HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm ;03/22/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,134**;Oct 13, 1995;Build 30 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 .Q:'$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE) 158 .;does the message need an accept ack? 159 .I HLMSTATE("HDR","ACCEPT ACK TYPE")="AL" D 160 ..N FS 161 ..Q:'$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA) 162 ..;does the MSA refer to the correct control id? 163 ..S FS=$E(HDR(1),4) 164 ..Q:$P(MSA,FS,3)'=HLMSTATE("ID") 165 ..N ACKID,ACKCODE 166 ..S ACKCODE=$P(MSA,FS,2) 167 ..S ACKID=$S($E(HDR(1),1,3)="MSH":$P(HDR(2),FS,5),1:$P(HDR(2),FS,6)) 168 ..S $P(UPDATE,"^",5)=1 169 ..S UPDATE("MSA")=ACKID_"^"_MSA 170 ..I '(ACKCODE="CA") S $P(UPDATE,"^",3)="SE",$P(UPDATE,"^",4)=2 171 ..I ACKCODE="CA",HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):"2",1:1) 172 ..I ($P(UPDATE,"^",3)="SE") S $P(UPDATE,"^",6)=$P(HLMSTATE("HDR",1),FS,5) ;errors need the application for xref 173 ..; 174 ..;did the app request notification of accept ack? 175 ..S UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE") 176 ..S SUCCESS=1 177 .E D ;accept ack wasn't requested 178 ..S SUCCESS=1 179 ..I HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):2,1:1) 180 ; 181 I 'SUCCESS,'HLCSTATE("CONNECTED"),(HLCSTATE("ATTEMPT")<2) G RETRY 182 I SUCCESS D 183 .D COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$S(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT"))) 184 .;if this is an ack to a message need to purge the original message, so store its ien with the purge date 185 .S:$G(HLMSTATE("ACK TO IEN")) $P(UPDATE,"^",4)=$P(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN") 186 I ('HLCSTATE("CONNECTED"))!('SUCCESS) D LINKDOWN(.HLCSTATE) 187 Q SUCCESS
Note:
See TracChangeset
for help on using the changeset viewer.
