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

INTST.m

Go to the documentation of this file. 
  1. INTST ;FRW, DGH, CHEM, DP ; 27 Sep 96 11:06; INTERACTIVE TESTING II 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;mod from VFA
  1.  ;This is the transmitter part of the interactive testing
  1.  ;This routine is based on ^INHVTAPT
  1.  ;
  1. APLOOP ;Send application messages to App Server
  1.  ;INPUT:
  1.  ;  INBPN - background process - ien
  1.  ;  INBPNM - background process name
  1.  ;  INIP - array of control parameter
  1.  ;  INCHNL - TCP channel for communications
  1.  ;  INMEM - memory location for TCP
  1.  ;  INDEST - array of destinations
  1.  ;  INDSTR - destiantion pointer for background process
  1.  ;  TESTNUM - session to run
  1.  ;  INIPPO - server (port) number
  1.  ;
  1.  ;OUTPUT:
  1.  ;  INPROK - OK to proceed ( 1 - yes ; 0 - no )
  1.  ;
  1.  ;Set the error trap
  1.  S X="ERR^INTST",@^%ZOSF("TRAP")
  1.  N INL
  1.  S INL=0,INPROK=1
  1.  ;
  1.  F  S INL=$O(^UTILITY("INTHU",DUZ,TESTNUM,INL)) Q:'INL!'INPROK  D
  1.  .  S INT=0
  1.  .  F  S INT=$O(^UTILITY("INTHU",DUZ,TESTNUM,INL,INT)) Q:'INT!'INPROK  D
  1.  ..    D ONE(INT)
  1.  ..    I '$D(^INRHB("RUN","SRVR",INBPN,INIPPO)) S INPROK=0
  1.  ;
  1.  Q
  1.  ;
  1. ONE(INUIF) ;Send a message and receive ack
  1.  ;INPUT:
  1.  ;  INUIF - Message to send (ien in INTHU)
  1.  ;OUTPUT:
  1.  ;  INPROK - exit simulation
  1.  ;
  1.  S MS="" D DEBUG
  1.  Q:'$G(INUIF)
  1.  N INL,INT,MS,INNORSP,INSND,MSG,OUT,ER,RCVE,ING,INDATA,RUN,INERR
  1.  N INACKID,INMSASTA,INSEND,ERNO
  1.  ;
  1.  ;Check for presence of message
  1.  I '$O(^INTHU(INUIF,3,0)) S MS="Missing message "_INUIF D DEBUG Q
  1.  ;
  1.  S (INNORSP,INSND)=0
  1.  ;
  1.  S MS="Sending outgoing message: "_$P(^INTHU(INUIF,0),U,5)_"   ("_INUIF_")" D DEBUG
  1.  S MSG=0  F  S MSG=$O(^INTHU(INUIF,3,MSG)) Q:'MSG  D
  1.  .  S MS=$G(^INTHU(INUIF,3,MSG,0)) D:$L(MS) DEBUG
  1.  ;
  1. SEND ;Send outgoing message. Retry until
  1.  ;1-Message is NAKed too many times - INSND>INIP("STRY")
  1.  ;2-No response. Then close socket and exit  - INNORSP>20
  1.  ;
  1.  I INNORSP>20 D  Q
  1.  .  S INPROK=0
  1.  .  S MS="No response after 20 retries, shutting down"
  1.  .  D DEBUG,CLOSE
  1.  ;
  1.  ;If send retries exceeded then send next msg
  1.  S INSND=INSND+1 I INSND>INIP("STRY") D  Q
  1.  .  S MS="Send retries ("_$G(INIP("STRY"))_") exceeded." D DEBUG
  1.  .  S ER=2
  1.  ;
  1.  I INNORSP>1 S MS="Retransmitting: failure "_INNORSP D DEBUG
  1.  ;
  1.  S OUT=0 F  S ER=$$SEND^INHUVUT(INUIF,INCHNL,.INIP) S:'ER OUT=1 Q: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.  ;
  1.  ;Attempt to receive ack INIP("RTRY") times
  1.  S (RCVE,OUT)=0 F  D  Q:OUT
  1.  .  K ING S ING="INDATA" K @ING
  1.  .  S MSG="Receiving acknowldgment"
  1.  .  S:INNORSP>1 MSG=MSG_", attempt "_INNORSP
  1.  .  S MS=MSG D DEBUG
  1.  .  ;Read ack message
  1.  .  S ER=$$RECEIVE^INHUVUT(.ING,.INCHNL,.INIP,.INERR,.INMEM)
  1.  .  ;Diplay ack message
  1.  .  W ! S O=""
  1.  .  F  S O=$O(@ING@(O)) Q:O=""  S MS=@ING@(O) D DEBUG
  1.  .  W !
  1.  .  S OUT=$S('ER:1,ER=3:1,1:OUT) Q:OUT
  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.  .  H INIP("RHNG")
  1.  ;
  1.  ;Error conditions from receive
  1.  ;If ER=3 then the other side has dropped the connection
  1.  I ER=3 S INPROK=0 Q
  1.  ;Check for no response
  1.  I ER=1!'$D(@ING) S INNORSP=INNORSP+1 G SEND
  1.  ;Check for unexpected conditions
  1.  I ER>1 S INNORSP=INNORSP+1 G SEND ; SHOULD NOT HAPPEN
  1.  ;If max RCVE retries exceeded go back to send
  1.  I RCVE>INIP("RTRY") D  G SEND
  1.  .  S MS="Max Receive retries exceeded." D DEBUG
  1.  ;
  1. EVAL ;Evaluate incoming response (ie ack status=CA).
  1.  ;If error, increment LOOP to STRY, go back and send again
  1.  K INACKID,INMSASTA,INERR
  1.  ;Load ack message into file
  1.  S ER=$$IN^INHUSEN(ING,.INDEST,INDSTR,0,.INSEND,.INERR,"",.INACKID,1,.INMSASTA)
  1.  ;
  1.  ;Check for errors
  1.  ;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
  1.  ;ER=2 is fatal error -> shut it down
  1.  ;ER=1 is non-fatal error -> move on to next transaction
  1.  ;ER=0 is no error
  1.  S MS=$S('ER:"Acknowledgment accepted: ",1:"Error evaluating acknowledgment.")
  1.  I $G(INACKID) S MS=MS_$P(^INTHU(INACKID,0),U,5)_"   ("_INACKID_")"
  1.  D DEBUG
  1.  ;Display error array
  1.  I ER,$D(INERR) D  K INERR
  1.  .  S ERNO=0 F  S ERNO=$O(INERR(ERNO)) Q:'ERNO  D
  1.  ..    S MS=INERR(ERNO) D DEBUG
  1.  ;
  1.  K @ING
  1.  Q
  1.  ;
  1.  ;If non-fatal, send again. 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" D  Q
  1.  .  S RUN=$$INRHB^INHUVUT1(INBPN,"Transmission complete",1)
  1.  .  S MS="Transmission complete for "_INBPNM
  1.  ;Otherwise, if fatal, hang and try again
  1.  S MS="Waiting to re-transmit" D DEBUG
  1.  H INIP("SHNG") G SEND
  1.  ;
  1. ERR ;Error module
  1.  N INREERR S INREERR=$$GETERR^%ZTOS
  1.  ;close port and quit
  1.  I $D(INCHNL) D CLOSE^%INET(INCHNL)
  1.  S MS="Fatal error encountered by - "_INREERR
  1.  D DEBUG
  1.  Q
  1.  ;
  1. CLOSE ;Close channel
  1.  S MS="Closing connection for "_INBPNM D DEBUG
  1.  D:+$G(INCHNL) CLOSE^%INET(.INCHNL)
  1.  Q
  1.  ;
  1. DEBUG ;Write interactive messages to the screen
  1.  ;INPUT:
  1.  ;  MS - message to display
  1.  ;OUTPUT:
  1.  ;  INPROK - exit simulator
  1.  ;
  1.  W !,$G(MS)
  1.  Q:'$G(INIPPO)!'$G(INBPN)
  1.  I '$D(^INRHB("RUN","SRVR",INBPN,INIPPO)) D  Q
  1.  .  S INPROK=0
  1.  .  W !,"Process signalled to terminate",!
  1.  S ^INRHB("RUN","SRVR",INBPN,INIPPO)=$H_U_MS
  1.  S %="" I '$G(INAUTO) R %#1:0
  1.  I $L(%) S INPROK=0
  1.  Q
  1.  ;