INHVTMT ; DGH, CHEM, KAC ; 02 Nov 1999 17:52 ; Multi-threaded socket transceiver
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
EN N INA,INDA,INDEST,INDSTR,INUSEQ,INSEND,INSND,INERR,INUIF,INLOOP,OUT,RCVE,OK,UIF,X,ER,INCHNL,INIP,INMEM,INQPRI,INQTIME,INNORSP,SYSTEM,RUN,MSG,CLISRV,INBPNM,INMSASTA,INSTOP
N H,INDISCNT,INDISCON,INDONE,INDT,INERRMT,INHBSENT,INHBTRY,INHBWAIT,INITROU,INIVLEN,INLIN,INLOGMSG,INMLTHRD,INMSG,INNORESP,INPEND,INRECV,INRECVD,INRUNMT,INSENT,INSEQNUM,INSTATE,INSTD,INSYNC,INTM,INTMDUE,INTMSENT,INXDST,RC
S INSTD="PDTS" ; set via FFCR in future - flags project-specific coding
S X="ERR^INHVTMT5",@^%ZOSF("TRAP")
S SYSTEM="SC",INBPNM=$P($G(^INTHPC(INBPN,0)),U),INSTATE="OPEN",INMLTHRD=1,INHBTRY=20,(INHBSENT,INDISCNT)=0,INIVLEN=12
D DEBUG^INHVCRA1() ; turn on debug
;Start GIS Background process audit if flag is set in Site Parms File
D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INBPNM)
D:'$$RUN^INHOTM ; ck shutdown status
. D:$G(INDEBUG) LOG^INHVCRA1("Shutdown transceiver "_INBPNM,"E")
. D SHUTDWN^INHVTMT5(INBPN)
L +^INRHB("RUN",INBPN):5 E D Q
. D:$G(INDEBUG) LOG^INHVCRA1("Cannot get exclusive lock for: ^INRHB(""RUN"","_INBPN_")","E")
. D SHUTDWN^INHVTMT5(INBPN)
; Get INTERFACE DESTINATION IEN & Destination Determination Code
S INDSTR=+$P(^INTHPC(INBPN,0),U,7),INXDST=$G(^(8))
I 'INDSTR D Q
. D:$G(INDEBUG) LOG^INHVCRA1("No destination designated for background process "_INBPNM,"E")
. D SHUTDWN^INHVTMT5(INBPN)
I '$L($G(INXDST)) D Q
. D:$G(INDEBUG) LOG^INHVCRA1("Missing code to determine inbound message destination for background process "_INBPNM,"E")
. D SHUTDWN^INHVTMT5(INBPN)
; Initialize variables from background process file
D:$G(INDEBUG) LOG^INHVCRA1("Initializing variables for background process file "_INBPNM,9)
D INIT^INHUVUT(INBPN,.INIP) ; get parms from BPC file
I $L($G(INSTD)) D ; project-specific init
. F X=1:1:9 S INITROU="INIT"_INSTD_"^INHVTMT"_X D:$L($T(@INITROU)) @INITROU
; if Encryption is flagged on, start C process
I $G(INIP("CRYPT")),'$L(INIP("DESKEY")) D Q
. D:$G(INDEBUG) LOG^INHVCRA1("Encrypt is set but no DES Key specified "_INBPNM,5)
. D SHUTDWN^INHVTMT5(INBPN)
I $G(INIP("CRYPT")) S X=$$CRYPON^INCRYPT(INIP("DESKEY"))
;Determine if process will be client (default,0) or server (1)
S CLISRV=+$P(^INTHPC(INBPN,0),U,8)
; sync up INPEND with current state of pend que
S INSYNC=$$PENDSYNC^INHVTMT4(.INPEND)
;
; Main program loop
F D Q:'$G(INRUNMT)
.; Update background process audit
. D:$D(XUAUDIT) ITIME^XUSAUD(INBPNM)
.;
.; Select port & open TCP/IP connection
. I INSTATE="OPEN" D Q:'INRUNMT
.. D CLOSE^INHVTMT5
.. D:$G(INDEBUG) LOG^INHVCRA1("OPEN: Transceiver "_INBPNM,1)
.. S INRUNMT=$$OPEN^INHVTAPU(INBPN,CLISRV,.INIP,INDEBUG,.INCHNL,.INMEM)
.. S:INRUNMT INSTATE="HB",INHBWAIT=0
.;
.; Heartbeat/dummy msg sent to target system for known, pervasive
.; problems til target sends msg indicating that msgs can flow again
. I INSTATE="HB" D Q:'INRUNMT
.. Q:'$L($G(INIP("INIT"))) ; hb not used (e.g. receipt ack precludes)
.. D:$G(INDEBUG) LOG^INHVCRA1("HB: Transceiver "_INBPNM,1)
.. I (INHBTRY'>INHBSENT) S INSTATE="OPEN",INHBSENT=0 Q ; close/reopen
.. S INRUNMT=$$HB^INHVTMT5(.INHBSENT,INHBWAIT) ; send heartbeat msg
.. S:INRUNMT INHBWAIT=1
.;
. I INSTATE="SEND" D Q:'INRUNMT S:INSTATE="SEND" INSTATE="RECV"
.. D:$G(INDEBUG) LOG^INHVCRA1("SEND: Transceiver "_INBPNM,1)
.. S INSEND=INIP("SMAX")-INPEND ; # msgs to send
.. S INSENT=0 ; # msgs sent
..; Send up to max transactions
.. F Q:(INSEND'>INSENT) D Q:(INSTATE'="SEND")!'INRUNMT
...; Get next transaction from destination queue
... S INUIF=""
... F D Q:INUIF!(INSTATE'="SEND")!'INRUNMT
.... D:$G(INDEBUG) LOG^INHVCRA1("Socket ready to start send/receive.",7)
.... S INRUNMT=$$INRHB^INHUVUT1(INBPN,"Idle") Q:'INRUNMT
.... D:$G(INDEBUG) LOG^INHVCRA1("Getting next transaction on "_INDSTR_" destination queue.",7)
.... S INUIF=$$NEXT^INHUVUT3(INDSTR,.INQPRI,.INQTIME,.INPEND)
.... I 'INUIF D Q
..... S INSTATE="RECV" ; nothing to send
..... D:$G(INDEBUG) LOG^INHVCRA1("No transactions on destination queue.",5)
...;
... Q:(INSTATE'="SEND")!'INRUNMT
...;
...; Ck for presence of msg content
... D:$G(INDEBUG) LOG^INHVCRA1("Checking for presence of message",7)
... I '$O(^INTHU(INUIF,3,0)) D Q
.... D ENR^INHE(INBPN,"Missing message "_INUIF_" for destination "_$P($G(^INRHD(INDSTR,0)),U))
.... D PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
...;
...; Selective Routing (send/no send)
... S UIF=$G(^INTHU(INUIF,0)),INA="^INTHU("_INUIF_",7)",INDA="^INTHU("_INUIF_",6)"
... I $$SUPPRESS^INHUT6("XMT",$P(UIF,U,11),$P(UIF,U,2),INBPN,.INA,.INDA,INUIF) D Q
.... D PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
...;
...; Send msg
...; Start transaction audit
... D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",INBPNM,"","TRANSMIT")
... D:$G(INDEBUG) LOG^INHVCRA1("Sending outgoing message on "_INBPNM,7)
... S INRUNMT=$$INRHB^INHUVUT1(INBPN,"Sending UIF= "_INUIF) Q:'INRUNMT
... F S INERRMT=$$SEND^INHVTMT1(INUIF,INCHNL,.INIP) Q:'INERRMT!'INRUNMT
...; Post-send activities
... D ULOG^INHU(INUIF,"S") ; log activity in UIF - sent
... S INSENT=INSENT+1
... S $P(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U)=$H_U_1
... D:$D(XUAUDIT) TTSTP^XUSAUD(0) ;stop transaction audit
.;
. I "^RECV^HB^"[(U_INSTATE_U) D Q:'INRUNMT S:INSTATE="RECV" INSTATE="TIMEOUT"
.. D:$G(INDEBUG) LOG^INHVCRA1("RECV: Transceiver "_INBPNM,1)
.. S (INRECV,INDONE,INDISCON,INNORESP)=0
..; Receive til disconnect, no response after retries, stop transceiver
..; or done reading (e.g. INPEND=0)
.. F D Q:INDONE!INDISCON!INNORESP!'INRUNMT
... S INMSG="Waiting for response"
... D:$G(INDEBUG) LOG^INHVCRA1(INMSG_" on "_INBPNM,7)
... S INRUNMT=$$INRHB^INHUVUT1(INBPN,INMSG) Q:'INRUNMT
... S INERRMT=$$RECEIVE^INHVTMT2(.INCHNL,.INIP,.INERR,.INMEM)
... Q:'INRUNMT
... S INDISCON=(INERRMT=3),INDONE=(INERRMT=0)
...;
... I INDISCON D Q ; disconnect
.... D REROUTE^INHVTMT4(INDSTR,.INPEND)
.... S INSTATE="OPEN"
.... D ENR^INHE(INBPN,INERR)
.... D:$G(INDEBUG) LOG^INHVCRA1(INERR,5) K INERR
.... D:'CLISRV
.....; clients pause before close/reopen; srvrs expect disconnects
..... S INLOGMSG="Waiting "_INIP("DHNG")_" seconds for open retry following disconnect on "_INBPNM_". Attempt "_INDISCNT
..... D:$G(INDEBUG) LOG^INHVCRA1(INLOGMSG,7)
..... D WAIT^INHUVUT2(INBPN,INIP("DHNG"),INLOGMSG,.INRUNMT)
..... S INRUNMT='INRUNMT ; wait rtns opposite
...;
... Q:INDONE ; finished reading available data
...;
...; No response (1) or error (2), try reading up to read-try max
... D:$G(INDEBUG) LOG^INHVCRA1(INERR,5) K INERR
... S INRECV=INRECV+1,INNORESP=$S(INIP("RTRY")'>INRECV:1,1:0)
...; If read retries exceeded
... I INNORESP D Q ; max read tries exceeded - no response (1) or error (2)
.... D:$G(INDEBUG) LOG^INHVCRA1("Maximum receive retries,"_INIP("RTRY")_" exceeded.",7)
...; Read retry - max retries NOT exceeded
... D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("RHNG")_" seconds for read retry.",7)
... H INIP("RHNG")
.;
.; Ck all entries on "pending response" que for no-response timeout
. I "^TIMEOUT^HB^"[(U_INSTATE_U) D Q:'INRUNMT S:INSTATE="TIMEOUT" INSTATE="SEND"
.. D:$G(INDEBUG) LOG^INHVCRA1("TIMEOUT: Transceiver "_INBPNM,1)
.. S:INSYNC INSYNC=0 ; ensured FIFO on startup (TIMEOUT before SEND state)
..; Quit if no items in pending queue
.. I '$D(^INLHDEST(INDSTR,"PEND",INBPN)) S INPEND=0 Q
.. S INRUNMT=$$INRHB^INHUVUT1(INBPN,"Cking for no-response timeout") Q:'INRUNMT
.. S INSEQNUM=""
.. F S INSEQNUM=$O(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM)) Q:(INSEQNUM="") D Q:'INRUNMT
... S INUIF=""
... F S INUIF=$O(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF)) Q:'INUIF D Q:'INRUNMT
.... S INTMSENT=$P(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U)
.... S X=$P(INTMSENT,",",2)+INIP("STO")
....; ck for crossing day boundary
.... S INTMDUE=$S(86400'>X:($P(INTMSENT,",")+1)_","_$TR($J(X-86400,5)," ",0),1:$P(INTMSENT,",")_","_X)
.... S H=$H,INDT=$P(H,","),INTM=$P(H,",",2)
....; If past due date or today's date, but past due time
.... I ($P(INTMDUE,",")<INDT)!(($P(INTMDUE,",")=INDT)&($P(INTMDUE,",",2)'>INTM)) D
.....; If no-response timeout
..... I INIP("STRY")'>$P(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U,2) D Q
......; send tries exceeded, reroute msg to another xceiver
...... S INERR="No-response timeout: Rerouting UIF="_INUIF_" for background process "_INBPNM_$S(INSTATE="TIMEOUT":". Close/reopen socket. Transceiver entering heartbeat state.",1:"")
...... D:$G(INDEBUG) LOG^INHVCRA1(INERR,9)
...... D ENR^INHE(INBPN,INERR) K INERR
...... S INERRMT=$$GETPEND^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
...... S INSTATE="OPEN"
.....; else, send retries NOT exceeded
..... D:$G(INDEBUG) LOG^INHVCRA1("No-response timeout: Resending UIF="_INUIF,9)
..... D RESEND^INHVTMT4(INDSTR,INUIF,INSEQNUM)
;
;
; Shutdown transceiver (close socket, cleanup)
D SHUTDWN^INHVTMT5(INBPN,$G(INCHNL))
Q
;
;
INHVTMT ; DGH, CHEM, KAC ; 02 Nov 1999 17:52 ; Multi-threaded socket transceiver
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
EN NEW INA,INDA,INDEST,INDSTR,INUSEQ,INSEND,INSND,INERR,INUIF,INLOOP,OUT,RCVE,OK,UIF,X,ER,INCHNL,INIP,INMEM,INQPRI,INQTIME,INNORSP,SYSTEM,RUN,MSG,CLISRV,INBPNM,INMSASTA,INSTOP
+1 NEW H,INDISCNT,INDISCON,INDONE,INDT,INERRMT,INHBSENT,INHBTRY,INHBWAIT,INITROU,INIVLEN,INLIN,INLOGMSG,INMLTHRD,INMSG,INNORESP,INPEND,INRECV,INRECVD,INRUNMT,INSENT,INSEQNUM,INSTATE,INSTD,INSYNC,INTM,INTMDUE,INTMSENT,INXDST,RC
+2 ; set via FFCR in future - flags project-specific coding
SET INSTD="PDTS"
+3 SET X="ERR^INHVTMT5"
SET @^%ZOSF("TRAP")
+4 SET SYSTEM="SC"
SET INBPNM=$PIECE($GET(^INTHPC(INBPN,0)),U)
SET INSTATE="OPEN"
SET INMLTHRD=1
SET INHBTRY=20
SET (INHBSENT,INDISCNT)=0
SET INIVLEN=12
+5 ; turn on debug
DO DEBUG^INHVCRA1()
+6 ;Start GIS Background process audit if flag is set in Site Parms File
+7 DO AUDCHK^XUSAUD
IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INBPNM)
+8 ; ck shutdown status
IF '$$RUN^INHOTM
Begin DoDot:1
+9 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Shutdown transceiver "_INBPNM,"E")
+10 DO SHUTDWN^INHVTMT5(INBPN)
End DoDot:1
+11 LOCK +^INRHB("RUN",INBPN):5
IF '$TEST
Begin DoDot:1
+12 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Cannot get exclusive lock for: ^INRHB(""RUN"","_INBPN_")","E")
+13 DO SHUTDWN^INHVTMT5(INBPN)
End DoDot:1
QUIT
+14 ; Get INTERFACE DESTINATION IEN & Destination Determination Code
+15 SET INDSTR=+$PIECE(^INTHPC(INBPN,0),U,7)
SET INXDST=$GET(^(8))
+16 IF 'INDSTR
Begin DoDot:1
+17 IF $GET(INDEBUG)
DO LOG^INHVCRA1("No destination designated for background process "_INBPNM,"E")
+18 DO SHUTDWN^INHVTMT5(INBPN)
End DoDot:1
QUIT
+19 IF '$LENGTH($GET(INXDST))
Begin DoDot:1
+20 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Missing code to determine inbound message destination for background process "_INBPNM,"E")
+21 DO SHUTDWN^INHVTMT5(INBPN)
End DoDot:1
QUIT
+22 ; Initialize variables from background process file
+23 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Initializing variables for background process file "_INBPNM,9)
+24 ; get parms from BPC file
DO INIT^INHUVUT(INBPN,.INIP)
+25 ; project-specific init
IF $LENGTH($GET(INSTD))
Begin DoDot:1
+26 FOR X=1:1:9
SET INITROU="INIT"_INSTD_"^INHVTMT"_X
IF $LENGTH($TEXT(@INITROU))
DO @INITROU
End DoDot:1
+27 ; if Encryption is flagged on, start C process
+28 IF $GET(INIP("CRYPT"))
IF '$LENGTH(INIP("DESKEY"))
Begin DoDot:1
+29 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Encrypt is set but no DES Key specified "_INBPNM,5)
+30 DO SHUTDWN^INHVTMT5(INBPN)
End DoDot:1
QUIT
+31 IF $GET(INIP("CRYPT"))
SET X=$$CRYPON^INCRYPT(INIP("DESKEY"))
+32 ;Determine if process will be client (default,0) or server (1)
+33 SET CLISRV=+$PIECE(^INTHPC(INBPN,0),U,8)
+34 ; sync up INPEND with current state of pend que
+35 SET INSYNC=$$PENDSYNC^INHVTMT4(.INPEND)
+36 ;
+37 ; Main program loop
+38 FOR
Begin DoDot:1
+39 ; Update background process audit
+40 IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INBPNM)
+41 ;
+42 ; Select port & open TCP/IP connection
+43 IF INSTATE="OPEN"
Begin DoDot:2
+44 DO CLOSE^INHVTMT5
+45 IF $GET(INDEBUG)
DO LOG^INHVCRA1("OPEN: Transceiver "_INBPNM,1)
+46 SET INRUNMT=$$OPEN^INHVTAPU(INBPN,CLISRV,.INIP,INDEBUG,.INCHNL,.INMEM)
+47 IF INRUNMT
SET INSTATE="HB"
SET INHBWAIT=0
End DoDot:2
IF 'INRUNMT
QUIT
+48 ;
+49 ; Heartbeat/dummy msg sent to target system for known, pervasive
+50 ; problems til target sends msg indicating that msgs can flow again
+51 IF INSTATE="HB"
Begin DoDot:2
+52 ; hb not used (e.g. receipt ack precludes)
IF '$LENGTH($GET(INIP("INIT")))
QUIT
+53 IF $GET(INDEBUG)
DO LOG^INHVCRA1("HB: Transceiver "_INBPNM,1)
+54 ; close/reopen
IF (INHBTRY'>INHBSENT)
SET INSTATE="OPEN"
SET INHBSENT=0
QUIT
+55 ; send heartbeat msg
SET INRUNMT=$$HB^INHVTMT5(.INHBSENT,INHBWAIT)
+56 IF INRUNMT
SET INHBWAIT=1
End DoDot:2
IF 'INRUNMT
QUIT
+57 ;
+58 IF INSTATE="SEND"
Begin DoDot:2
+59 IF $GET(INDEBUG)
DO LOG^INHVCRA1("SEND: Transceiver "_INBPNM,1)
+60 ; # msgs to send
SET INSEND=INIP("SMAX")-INPEND
+61 ; # msgs sent
SET INSENT=0
+62 ; Send up to max transactions
+63 FOR
IF (INSEND'>INSENT)
QUIT
Begin DoDot:3
+64 ; Get next transaction from destination queue
+65 SET INUIF=""
+66 FOR
Begin DoDot:4
+67 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Socket ready to start send/receive.",7)
+68 SET INRUNMT=$$INRHB^INHUVUT1(INBPN,"Idle")
IF 'INRUNMT
QUIT
+69 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Getting next transaction on "_INDSTR_" destination queue.",7)
+70 SET INUIF=$$NEXT^INHUVUT3(INDSTR,.INQPRI,.INQTIME,.INPEND)
+71 IF 'INUIF
Begin DoDot:5
+72 ; nothing to send
SET INSTATE="RECV"
+73 IF $GET(INDEBUG)
DO LOG^INHVCRA1("No transactions on destination queue.",5)
End DoDot:5
QUIT
End DoDot:4
IF INUIF!(INSTATE'="SEND")!'INRUNMT
QUIT
+74 ;
+75 IF (INSTATE'="SEND")!'INRUNMT
QUIT
+76 ;
+77 ; Ck for presence of msg content
+78 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Checking for presence of message",7)
+79 IF '$ORDER(^INTHU(INUIF,3,0))
Begin DoDot:4
+80 DO ENR^INHE(INBPN,"Missing message "_INUIF_" for destination "_$PIECE($GET(^INRHD(INDSTR,0)),U))
+81 DO PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
End DoDot:4
QUIT
+82 ;
+83 ; Selective Routing (send/no send)
+84 SET UIF=$GET(^INTHU(INUIF,0))
SET INA="^INTHU("_INUIF_",7)"
SET INDA="^INTHU("_INUIF_",6)"
+85 IF $$SUPPRESS^INHUT6("XMT",$PIECE(UIF,U,11),$PIECE(UIF,U,2),INBPN,.INA,.INDA,INUIF)
Begin DoDot:4
+86 DO PQKILL^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
End DoDot:4
QUIT
+87 ;
+88 ; Send msg
+89 ; Start transaction audit
+90 IF $DATA(XUAUDIT)
DO TTSTRT^XUSAUD(INUIF,"",INBPNM,"","TRANSMIT")
+91 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Sending outgoing message on "_INBPNM,7)
+92 SET INRUNMT=$$INRHB^INHUVUT1(INBPN,"Sending UIF= "_INUIF)
IF 'INRUNMT
QUIT
+93 FOR
SET INERRMT=$$SEND^INHVTMT1(INUIF,INCHNL,.INIP)
IF 'INERRMT!'INRUNMT
QUIT
+94 ; Post-send activities
+95 ; log activity in UIF - sent
DO ULOG^INHU(INUIF,"S")
+96 SET INSENT=INSENT+1
+97 SET $PIECE(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U)=$HOROLOG_U_1
+98 ;stop transaction audit
IF $DATA(XUAUDIT)
DO TTSTP^XUSAUD(0)
End DoDot:3
IF (INSTATE'="SEND")!'INRUNMT
QUIT
End DoDot:2
IF 'INRUNMT
QUIT
IF INSTATE="SEND"
SET INSTATE="RECV"
+99 ;
+100 IF "^RECV^HB^"[(U_INSTATE_U)
Begin DoDot:2
+101 IF $GET(INDEBUG)
DO LOG^INHVCRA1("RECV: Transceiver "_INBPNM,1)
+102 SET (INRECV,INDONE,INDISCON,INNORESP)=0
+103 ; Receive til disconnect, no response after retries, stop transceiver
+104 ; or done reading (e.g. INPEND=0)
+105 FOR
Begin DoDot:3
+106 SET INMSG="Waiting for response"
+107 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INMSG_" on "_INBPNM,7)
+108 SET INRUNMT=$$INRHB^INHUVUT1(INBPN,INMSG)
IF 'INRUNMT
QUIT
+109 SET INERRMT=$$RECEIVE^INHVTMT2(.INCHNL,.INIP,.INERR,.INMEM)
+110 IF 'INRUNMT
QUIT
+111 SET INDISCON=(INERRMT=3)
SET INDONE=(INERRMT=0)
+112 ;
+113 ; disconnect
IF INDISCON
Begin DoDot:4
+114 DO REROUTE^INHVTMT4(INDSTR,.INPEND)
+115 SET INSTATE="OPEN"
+116 DO ENR^INHE(INBPN,INERR)
+117 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INERR,5)
KILL INERR
+118 IF 'CLISRV
Begin DoDot:5
+119 ; clients pause before close/reopen; srvrs expect disconnects
+120 SET INLOGMSG="Waiting "_INIP("DHNG")_" seconds for open retry following disconnect on "_INBPNM_". Attempt "_INDISCNT
+121 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INLOGMSG,7)
+122 DO WAIT^INHUVUT2(INBPN,INIP("DHNG"),INLOGMSG,.INRUNMT)
+123 ; wait rtns opposite
SET INRUNMT='INRUNMT
End DoDot:5
End DoDot:4
QUIT
+124 ;
+125 ; finished reading available data
IF INDONE
QUIT
+126 ;
+127 ; No response (1) or error (2), try reading up to read-try max
+128 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INERR,5)
KILL INERR
+129 SET INRECV=INRECV+1
SET INNORESP=$SELECT(INIP("RTRY")'>INRECV:1,1:0)
+130 ; If read retries exceeded
+131 ; max read tries exceeded - no response (1) or error (2)
IF INNORESP
Begin DoDot:4
+132 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Maximum receive retries,"_INIP("RTRY")_" exceeded.",7)
End DoDot:4
QUIT
+133 ; Read retry - max retries NOT exceeded
+134 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Waiting "_INIP("RHNG")_" seconds for read retry.",7)
+135 HANG INIP("RHNG")
End DoDot:3
IF INDONE!INDISCON!INNORESP!'INRUNMT
QUIT
End DoDot:2
IF 'INRUNMT
QUIT
IF INSTATE="RECV"
SET INSTATE="TIMEOUT"
+136 ;
+137 ; Ck all entries on "pending response" que for no-response timeout
+138 IF "^TIMEOUT^HB^"[(U_INSTATE_U)
Begin DoDot:2
+139 IF $GET(INDEBUG)
DO LOG^INHVCRA1("TIMEOUT: Transceiver "_INBPNM,1)
+140 ; ensured FIFO on startup (TIMEOUT before SEND state)
IF INSYNC
SET INSYNC=0
+141 ; Quit if no items in pending queue
+142 IF '$DATA(^INLHDEST(INDSTR,"PEND",INBPN))
SET INPEND=0
QUIT
+143 SET INRUNMT=$$INRHB^INHUVUT1(INBPN,"Cking for no-response timeout")
IF 'INRUNMT
QUIT
+144 SET INSEQNUM=""
+145 FOR
SET INSEQNUM=$ORDER(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM))
IF (INSEQNUM="")
QUIT
Begin DoDot:3
+146 SET INUIF=""
+147 FOR
SET INUIF=$ORDER(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF))
IF 'INUIF
QUIT
Begin DoDot:4
+148 SET INTMSENT=$PIECE(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U)
+149 SET X=$PIECE(INTMSENT,",",2)+INIP("STO")
+150 ; ck for crossing day boundary
+151 SET INTMDUE=$SELECT(86400'>X:($PIECE(INTMSENT,",")+1)_","_$TRANSLATE($JUSTIFY(X-86400,5)," ",0),1:$PIECE(INTMSENT,",")_","_X)
+152 SET H=$HOROLOG
SET INDT=$PIECE(H,",")
SET INTM=$PIECE(H,",",2)
+153 ; If past due date or today's date, but past due time
+154 IF ($PIECE(INTMDUE,",")<INDT)!(($PIECE(INTMDUE,",")=INDT)&($PIECE(INTMDUE,",",2)'>INTM))
Begin DoDot:5
+155 ; If no-response timeout
+156 IF INIP("STRY")'>$PIECE(^INLHDEST(INDSTR,"PEND",INBPN,INSEQNUM,INUIF),U,2)
Begin DoDot:6
+157 ; send tries exceeded, reroute msg to another xceiver
+158 SET INERR="No-response timeout: Rerouting UIF="_INUIF_" for background process "_INBPNM_$SELECT(INSTATE="TIMEOUT":". Close/reopen socket. Transceiver entering heartbeat state.",1:"")
+159 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INERR,9)
+160 DO ENR^INHE(INBPN,INERR)
KILL INERR
+161 SET INERRMT=$$GETPEND^INHVTMT4(INDSTR,INSEQNUM,INUIF,.INPEND)
+162 SET INSTATE="OPEN"
End DoDot:6
QUIT
+163 ; else, send retries NOT exceeded
+164 IF $GET(INDEBUG)
DO LOG^INHVCRA1("No-response timeout: Resending UIF="_INUIF,9)
+165 DO RESEND^INHVTMT4(INDSTR,INUIF,INSEQNUM)
End DoDot:5
End DoDot:4
IF 'INRUNMT
QUIT
End DoDot:3
IF 'INRUNMT
QUIT
End DoDot:2
IF 'INRUNMT
QUIT
IF INSTATE="TIMEOUT"
SET INSTATE="SEND"
End DoDot:1
IF '$GET(INRUNMT)
QUIT
+166 ;
+167 ;
+168 ; Shutdown transceiver (close socket, cleanup)
+169 DO SHUTDWN^INHVTMT5(INBPN,$GET(INCHNL))
+170 QUIT
+171 ;
+172 ;
