- 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 ;
