Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHVTAX1

INHVTAX1.m

Go to the documentation of this file. 
  1. INHVTAX1 ; cmi/flag/maw - DGH, CHEM 07 Oct 1999 15:24 "Generic" socket transceiver ; [ 05/22/2002  2:56 PM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 7; 6-OCT-1997
  1.  ;COPYRIGHT 1994 SAIC
  1.  ;cmi/sitka/maw modified for use with X12 
  1.  ;
  1.  ;This is an interactive transmitter routine. It first sends a message,
  1.  ;then waits for an ack, then sends another msg, etc.
  1.  ;The counterpart routine is INHVTAPR, which receives first, then
  1.  ;sends an ack, etc.
  1.  ;
  1. EN ;Entry point
  1.  S INDEBUG=1 ;maw turn debugging on
  1.  N INA,INDA,INDEST,ING,INDSTR,INUSEQ,INSEND,INSND,INERR,INUIF,INLOOP,OUT,RCVE,OK,UIF,X,ER,INCHNL,INIP,INMEM,INQP,INQT,INNORSP,SYSTEM,RUN,MSG,CLISRV,TIMCHK,INBPNM,INMSASTA,INSTOP,RC,INTRNSNT,INDISCNT
  1.  S X="ERR^INHVTAPT",@^%ZOSF("TRAP"),(INSTOP,INDISCNT)=0
  1.  D PARM^INHVTAPU
  1.  G:INSTOP EXIT
  1. OPEN ;Open the TCP/IP connection
  1.  ;Check destination queue when running in client transient mode
  1.  I 'CLISRV&INTRNSNT S RUN=0 F  D  Q:RUN!INSTOP
  1.  .I $D(^INLHDEST(INDSTR)) S RUN=1 Q
  1.  .D WAIT^INHUVUT2(INBPN,INIP("THNG"),"Waiting to check queue",.INSTOP)
  1.  G:INSTOP EXIT
  1.  S OK=$$OPEN^INHVTAPU(INBPN,CLISRV,.INIP,INDEBUG,.INCHNL,.INMEM) G:'OK EXIT
  1.  ;If initialization parameters are specified, run handshaking log
  1.  I $L(INIP("INIT"))+$L(INIP("ACK")) S OK=$$INIT^INHVTAPU G:'OK EXIT
  1.  ;
  1. RUN ;With port open, start send/receive. This is main loop of routine.
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Socket ready to start send/receive.",7)
  1.  S RUN=$$INRHB^INHUVUT1(INBPN,"Idle") G:'RUN EXIT
  1.  ;Update background process audit
  1.  D:$D(XUAUDIT) ITIME^XUSAUD(INBPNM)
  1.  ;Loop until a transaction exists on the destination queue
  1.  ;If re-trying a message, it will still be at top of queue
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Waiting for next transaction on "_INDSTR_" destination queue.",7)
  1.  S INUIF=$$NEXT^INHUVUT3(INDSTR,.INQP,.INQT)
  1.  ;Read socket to determine if other side dropped. $$RECEIVE will return 2
  1.  I 'INUIF D  G:$G(INSTOP) EXIT G:ER<3 RUN G OPEN
  1.  .;Only read 60 sec. from later of 1) last check OR 2) last transmission
  1.  .S ER=0
  1.  .I 'CLISRV&INTRNSNT D WAIT^INHUVUT2(INBPN,INIP("THNG"),"Waiting to check queue",.INSTOP) Q:$D(^INLHDEST(INDSTR))  D CLOSE^INHVTAPU D:$G(INDEBUG) LOG^INHVCRA1("Close socket in transient mode",7) S ER=3 Q
  1.  .I $P($H,",",2)<$G(TIMCHK) D WAIT^INHUVUT2(INBPN,INIP("THNG"),"Waiting to check queue",.INSTOP) Q
  1.  .S TIMCHK=$P($H,",",2)+60 S:TIMCHK'<86400 TIMCHK=0
  1.  .S ING="INDATA" K @ING
  1.  .D:$G(INDEBUG) LOG^INHVCRA1("Reading from socket to determine status",8)
  1.  .S ER=$$RECEIVE^INHUVUTX(.ING,.INCHNL,.INIP,.INERR,.INMEM)
  1.  .Q:ER<3
  1.  .S RUN=$$INRHB^INHUVUT1(INBPN,"Remote disconnect",2)
  1.  .D:$G(INDEBUG) LOG^INHVCRA1("Remote disconnect on "_INBPNM,6)
  1.  .;If client, close--if server, don't. Will re-synch handshake for both
  1.  .;I 'CLISRV D CKDISCNT^INHVTAPU Q:INSTOP  D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("DHNG")_" seconds for open retry following disconnect on "_INBPNM_". Attempt "_INDISCNT,7) H INIP("DHNG") ;maw removed close
  1.  .I 'CLISRV D CKDISCNT^INHVTAPU Q:INSTOP  D CLOSE^INHVTAPU D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("DHNG")_" seconds for open retry following disconnect on "_INBPNM_". Attempt "_INDISCNT,7) H INIP("DHNG")
  1.  ;Check for presence of message
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Checking for presence of message",7)
  1.  I '$O(^INTHU(INUIF,3,0)) D ENR^INHE(INBPN,"Missing message "_INUIF_" for destination "_$P($G(^INRHD(INDSTR,0)),U)),QKILL G RUN
  1.  S TIMCHK=$P($H,",",2)+60 S:TIMCHK'<86400 TIMCHK=0
  1.  ;
  1.  ; Screen msg (send/no send)
  1.  S UIF=$G(^INTHU(INUIF,0)),INA="^INTHU("_INUIF_",7)",INDA="^INTHU("_INUIF_",6)"
  1.  I $$SUPPRESS^INHUT6("XMT",$P(UIF,U,11),$P(UIF,U,2),INBPN,.INA,.INDA,INUIF) D QKILL G RUN
  1.  ;
  1.  S (INNORSP,INSND)=0
  1.  ;Start transaction audit here to include all retries in log
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",INBPNM,"","TRANSMIT")
  1. SEND ;Send outgoing message. Retry until
  1.  ;1-INSND is NAKed STRY times, then delete INUIF from queue, send next
  1.  ;2-NO RESPonce 20 times. Then close socket and go to OPEN
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Sending outgoing message.",7)
  1.  I INNORSP>20 D ENR^INHE(INBPN,"No response after 20 re-tries on "_INBPNM_", shutting down socket"),CLOSE^INHVTAPU H:'CLISRV INIP("OHNG") G OPEN
  1.  ;If send retries exceeded, update logs, kill from queue, send next msg.
  1.  S INSND=INSND+1 I INSND>INIP("STRY") D  G RUN
  1.  .D:$G(INDEBUG) LOG^INHVCRA1("Send retries ("_$G(INSND)_") exceeded.",6)
  1.  .S INERR="MAXIMUM NUMBER OF RETRIES, "_$G(INSND)_" exceeded",ER=2
  1.  .D ENR^INHE(INBPN,INERR),LOG K INERR
  1.  .D QKILL
  1.  S MSG="Transmitting" S:INNORSP>1 MSG=MSG_": Failure "_INNORSP
  1.  D:$G(INDEBUG) LOG^INHVCRA1(MSG_" on "_INBPNM,7)
  1.  S RUN=$$INRHB^INHUVUT1(INBPN,MSG) G:'RUN EXIT
  1.  S OUT=0 F  S ER=$$SEND^INHUVUTX(INUIF,INCHNL,.INIP) S:'ER OUT=1 Q:'$D(^INRHB("RUN",INBPN))!OUT
  1.  ;Currently ER will always be returned as 0, but INHUVUT may get smarter
  1.  ;
  1. RECEIVE ;Receive incoming response. If no response, go back and SEND again
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Receiving incoming response.",7)
  1.  S ING="INDATA" K @ING
  1.  S (RCVE,OUT)=0 F  D  Q:'RUN!OUT
  1.  .S MSG="Waiting for commit ack" S:INNORSP>1 MSG=MSG_", attempt "_INNORSP
  1.  .D:$G(INDEBUG) LOG^INHVCRA1(MSG_" on "_INBPNM,7)
  1.  .S RUN=$$INRHB^INHUVUT1(INBPN,MSG)
  1.  .S ER=$$RECEIVE^INHUVUTX(.ING,.INCHNL,.INIP,.INERR,.INMEM)
  1.  .S ^MAW($H)=$G(ER)
  1.  .S OUT=$S('ER:1,ER=3:1,1:OUT) Q:OUT  ; I 'ER!(ER=3) S OUT=1 Q
  1.  .;If ER, some error or timeout has occurred
  1.  .S RCVE=RCVE+1,OUT=$S(RCVE>INIP("RTRY"):1,1:OUT) Q:OUT
  1.  .D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("RHNG")_" seconds for retry.",7)
  1.  .H INIP("RHNG")
  1.  ;
  1.  ;Error conditions from receive
  1.  ;If ER=3, the other side has dropped the connection. Close and reopen
  1.  I ER=3 D  G:INSTOP EXIT G OPEN
  1.  .D ENR^INHE(INBPN,INERR)
  1.  .D:$G(INDEBUG) LOG^INHVCRA1(INERR,5) K INERR
  1.  .;Stop transaction audit if other side drops.
  1.  .D:$D(XUAUDIT) TTSTP^XUSAUD(1)
  1.  .I 'CLISRV D CKDISCNT^INHVTAPU Q:INSTOP  D CLOSE^INHVTAPU D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("DHNG")_" seconds for open retry following disconnect on "_INBPNM_". Attempt "_INDISCNT,7) H INIP("DHNG")
  1.  I ER=1!'$D(@ING) S INNORSP=INNORSP+1,INSND=0 G SEND
  1.  I ER>1 S INNORSP=INNORSP+1,INSND=0 G SEND ; SHOULD NOT HAPPEN
  1.  ;If max RCVE retries exceeded go back to send
  1.  I RCVE>INIP("RTRY") D:$G(INDEBUG) LOG^INHVCRA1("Max Receive retries exceeded.",7) S INSND=0 G SEND
  1.  ;Stop transaction audit. TRANSMIT is complete when ack is received.
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  ;
  1. EVAL ;Evaluate incoming response (ie ack status=CA).
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Evaluating commit acknowledgement.",8)
  1.  S RUN=$$INRHB^INHUVUT1(INBPN,"Evaluating commit acknowledgement.")
  1.  ;If error, increment LOOP to STRY, go back and send again
  1.  K INACKID,INMSASTA,INERR
  1.  ;Start transaction audit for receipt of ack. T Type not known.
  1.  ;Stop point is in INHUSEN
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD("","",INBPNM,"","RECEIVE")
  1.  S ER=$$IN^INHUSEN(ING,.INDEST,INDSTR,0,.INSEND,.INERR,.INXDST,"","",.INMSASTA,1) D:$G(INDEBUG)
  1.  S ER=0,INMSASTA="CA" ;maw accept incoming message ack
  1.  D LOG^INHVCRA1("Acknowlegement accepted",9)
  1.  ;If all is in synch, kill sent entry from queue and update status
  1.  ;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
  1.  ;ER=2 is fatal error
  1.  ;ER=1 is non-fatal error. Log it, but move on to next transmission
  1.  ;ER=0 is no error
  1.  S:ER<2 INDISCNT=0
  1.  ;Log error array
  1.  I ER,$D(INERR) D ENR^INHE(INBPN,.INERR) K INERR
  1.  ;If non-fatal, kill from queue and loop. Also kill incoming array/gbl
  1.  ;Resend for CE or AE (or ?E).  If rejected, (CR or AR) NEVER resend.
  1.  K @ING I (ER<2&($E($G(INMSASTA),2)'="E"))!($E($G(INMSASTA),2)="R") D  G RUN
  1.  .N INMSG
  1.  .I $E($G(INMSASTA),2)="R" S (INHERR,INMSG)="Transmission rejected",ER=2
  1.  .E  S INMSG="Transmission Complete"
  1.  .D QKILL,LOG
  1.  .S RUN=$$INRHB^INHUVUT1(INBPN,INMSG,1)
  1.  .D:$G(INDEBUG) LOG^INHVCRA1(INMSG_" for "_INBPNM,8)
  1.  ;Otherwise, if fatal, hang and try again
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Waiting to re-transmit",7)
  1.  S RUN=$$INRHB^INHUVUT1(INBPN,"Waiting to re-transmit")
  1.  H INIP("SHNG")
  1.  ;Errored message (AE or CE) should increment INSND counter
  1.  ;Other errors should reset INSND to avoid message deletion from queue
  1.  S INSND=$S($E($G(INMSASTA),2)="E":INSND,1:0) G SEND
  1.  ;
  1. LOG ;Log status of original message
  1.  ;INHOS needs UIF and ER=0,1,or 2
  1.  N UIF S UIF=INUIF
  1.  D DONE^INHOS
  1.  Q
  1.  ;
  1. QKILL K ^INLHDEST(INDSTR,INQP,INQT,INUIF)
  1.  D QULOCK
  1.  Q
  1.  ;
  1. QULOCK L:$G(INUIF) -^INLHDEST(INDSTR,INQP,INQT,INUIF)
  1.  Q
  1.  ;
  1. ERR ;Error module
  1.  D QULOCK
  1.  ;Handle known non-fatal error conditions
  1.  I $$ETYPE^%ZTFE("O") D  G EN
  1.  .S X="ERR^INHVTAPT",@^%ZOSF("TRAP") D:$D(INCHNL) CLOSE^%INET(INCHNL)
  1.  .;S X="ERR^INHVTAPT",@^%ZOSF("TRAP") D:$D(INCHNL) CLOSE^%INET(INCHNL,$G(INBPN))  ;maw cache
  1.  .D:$G(INDEBUG) LOG^INHVCRA1("Non-fatal error encountered in "_INBPNM,6)
  1.  ;If unanticipated error is encounterd close port and quit transmitter
  1.  D ERR^INHVTAPU
  1.  Q
  1.  ;
  1. EXIT ;Main exit module
  1.  D QULOCK
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Exiting TCP socket transmitter for "_INBPNM,5)
  1.  D EXIT1^INHVTAPU
  1.  Q