INTST ;FRW, DGH, CHEM, DP ; 27 Sep 96 11:06; INTERACTIVE TESTING II
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;mod from VFA
;This is the transmitter part of the interactive testing
;This routine is based on ^INHVTAPT
;
APLOOP ;Send application messages to App Server
;INPUT:
; INBPN - background process - ien
; INBPNM - background process name
; INIP - array of control parameter
; INCHNL - TCP channel for communications
; INMEM - memory location for TCP
; INDEST - array of destinations
; INDSTR - destiantion pointer for background process
; TESTNUM - session to run
; INIPPO - server (port) number
;
;OUTPUT:
; INPROK - OK to proceed ( 1 - yes ; 0 - no )
;
;Set the error trap
S X="ERR^INTST",@^%ZOSF("TRAP")
N INL
S INL=0,INPROK=1
;
F S INL=$O(^UTILITY("INTHU",DUZ,TESTNUM,INL)) Q:'INL!'INPROK D
. S INT=0
. F S INT=$O(^UTILITY("INTHU",DUZ,TESTNUM,INL,INT)) Q:'INT!'INPROK D
.. D ONE(INT)
.. I '$D(^INRHB("RUN","SRVR",INBPN,INIPPO)) S INPROK=0
;
Q
;
ONE(INUIF) ;Send a message and receive ack
;INPUT:
; INUIF - Message to send (ien in INTHU)
;OUTPUT:
; INPROK - exit simulation
;
S MS="" D DEBUG
Q:'$G(INUIF)
N INL,INT,MS,INNORSP,INSND,MSG,OUT,ER,RCVE,ING,INDATA,RUN,INERR
N INACKID,INMSASTA,INSEND,ERNO
;
;Check for presence of message
I '$O(^INTHU(INUIF,3,0)) S MS="Missing message "_INUIF D DEBUG Q
;
S (INNORSP,INSND)=0
;
S MS="Sending outgoing message: "_$P(^INTHU(INUIF,0),U,5)_" ("_INUIF_")" D DEBUG
S MSG=0 F S MSG=$O(^INTHU(INUIF,3,MSG)) Q:'MSG D
. S MS=$G(^INTHU(INUIF,3,MSG,0)) D:$L(MS) DEBUG
;
SEND ;Send outgoing message. Retry until
;1-Message is NAKed too many times - INSND>INIP("STRY")
;2-No response. Then close socket and exit - INNORSP>20
;
I INNORSP>20 D Q
. S INPROK=0
. S MS="No response after 20 retries, shutting down"
. D DEBUG,CLOSE
;
;If send retries exceeded then send next msg
S INSND=INSND+1 I INSND>INIP("STRY") D Q
. S MS="Send retries ("_$G(INIP("STRY"))_") exceeded." D DEBUG
. S ER=2
;
I INNORSP>1 S MS="Retransmitting: failure "_INNORSP D DEBUG
;
S OUT=0 F S ER=$$SEND^INHUVUT(INUIF,INCHNL,.INIP) S:'ER OUT=1 Q:OUT
;Currently ER will always be returned as 0, but INHUVUT may get smarter
;
RECEIVE ;Receive incoming response. If no response, go back and SEND again
;
;Attempt to receive ack INIP("RTRY") times
S (RCVE,OUT)=0 F D Q:OUT
. K ING S ING="INDATA" K @ING
. S MSG="Receiving acknowldgment"
. S:INNORSP>1 MSG=MSG_", attempt "_INNORSP
. S MS=MSG D DEBUG
. ;Read ack message
. S ER=$$RECEIVE^INHUVUT(.ING,.INCHNL,.INIP,.INERR,.INMEM)
. ;Diplay ack message
. W ! S O=""
. F S O=$O(@ING@(O)) Q:O="" S MS=@ING@(O) D DEBUG
. W !
. S OUT=$S('ER:1,ER=3:1,1:OUT) Q:OUT
. ;If ER, some error or timeout has occurred
. S RCVE=RCVE+1,OUT=$S(RCVE>INIP("RTRY"):1,1:OUT) Q:OUT
. H INIP("RHNG")
;
;Error conditions from receive
;If ER=3 then the other side has dropped the connection
I ER=3 S INPROK=0 Q
;Check for no response
I ER=1!'$D(@ING) S INNORSP=INNORSP+1 G SEND
;Check for unexpected conditions
I ER>1 S INNORSP=INNORSP+1 G SEND ; SHOULD NOT HAPPEN
;If max RCVE retries exceeded go back to send
I RCVE>INIP("RTRY") D G SEND
. S MS="Max Receive retries exceeded." D DEBUG
;
EVAL ;Evaluate incoming response (ie ack status=CA).
;If error, increment LOOP to STRY, go back and send again
K INACKID,INMSASTA,INERR
;Load ack message into file
S ER=$$IN^INHUSEN(ING,.INDEST,INDSTR,0,.INSEND,.INERR,"",.INACKID,1,.INMSASTA)
;
;Check for errors
;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
;ER=2 is fatal error -> shut it down
;ER=1 is non-fatal error -> move on to next transaction
;ER=0 is no error
S MS=$S('ER:"Acknowledgment accepted: ",1:"Error evaluating acknowledgment.")
I $G(INACKID) S MS=MS_$P(^INTHU(INACKID,0),U,5)_" ("_INACKID_")"
D DEBUG
;Display error array
I ER,$D(INERR) D K INERR
. S ERNO=0 F S ERNO=$O(INERR(ERNO)) Q:'ERNO D
.. S MS=INERR(ERNO) D DEBUG
;
K @ING
Q
;
;If non-fatal, send again. Also kill incoming array/gbl
;Resend for CE or AE (or ?E). If rejected, (CR or AR) NEVER resend.
K @ING I ER<2,$E($G(INMSASTA),2)'="E" D Q
. S RUN=$$INRHB^INHUVUT1(INBPN,"Transmission complete",1)
. S MS="Transmission complete for "_INBPNM
;Otherwise, if fatal, hang and try again
S MS="Waiting to re-transmit" D DEBUG
H INIP("SHNG") G SEND
;
ERR ;Error module
N INREERR S INREERR=$$GETERR^%ZTOS
;close port and quit
I $D(INCHNL) D CLOSE^%INET(INCHNL)
S MS="Fatal error encountered by - "_INREERR
D DEBUG
Q
;
CLOSE ;Close channel
S MS="Closing connection for "_INBPNM D DEBUG
D:+$G(INCHNL) CLOSE^%INET(.INCHNL)
Q
;
DEBUG ;Write interactive messages to the screen
;INPUT:
; MS - message to display
;OUTPUT:
; INPROK - exit simulator
;
W !,$G(MS)
Q:'$G(INIPPO)!'$G(INBPN)
I '$D(^INRHB("RUN","SRVR",INBPN,INIPPO)) D Q
. S INPROK=0
. W !,"Process signalled to terminate",!
S ^INRHB("RUN","SRVR",INBPN,INIPPO)=$H_U_MS
S %="" I '$G(INAUTO) R %#1:0
I $L(%) S INPROK=0
Q
;
INTST ;FRW, DGH, CHEM, DP ; 27 Sep 96 11:06; INTERACTIVE TESTING II
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;mod from VFA
+5 ;This is the transmitter part of the interactive testing
+6 ;This routine is based on ^INHVTAPT
+7 ;
APLOOP ;Send application messages to App Server
+1 ;INPUT:
+2 ; INBPN - background process - ien
+3 ; INBPNM - background process name
+4 ; INIP - array of control parameter
+5 ; INCHNL - TCP channel for communications
+6 ; INMEM - memory location for TCP
+7 ; INDEST - array of destinations
+8 ; INDSTR - destiantion pointer for background process
+9 ; TESTNUM - session to run
+10 ; INIPPO - server (port) number
+11 ;
+12 ;OUTPUT:
+13 ; INPROK - OK to proceed ( 1 - yes ; 0 - no )
+14 ;
+15 ;Set the error trap
+16 SET X="ERR^INTST"
SET @^%ZOSF("TRAP")
+17 NEW INL
+18 SET INL=0
SET INPROK=1
+19 ;
+20 FOR
SET INL=$ORDER(^UTILITY("INTHU",DUZ,TESTNUM,INL))
IF 'INL!'INPROK
QUIT
Begin DoDot:1
+21 SET INT=0
+22 FOR
SET INT=$ORDER(^UTILITY("INTHU",DUZ,TESTNUM,INL,INT))
IF 'INT!'INPROK
QUIT
Begin DoDot:2
+23 DO ONE(INT)
+24 IF '$DATA(^INRHB("RUN","SRVR",INBPN,INIPPO))
SET INPROK=0
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
+27 ;
ONE(INUIF) ;Send a message and receive ack
+1 ;INPUT:
+2 ; INUIF - Message to send (ien in INTHU)
+3 ;OUTPUT:
+4 ; INPROK - exit simulation
+5 ;
+6 SET MS=""
DO DEBUG
+7 IF '$GET(INUIF)
QUIT
+8 NEW INL,INT,MS,INNORSP,INSND,MSG,OUT,ER,RCVE,ING,INDATA,RUN,INERR
+9 NEW INACKID,INMSASTA,INSEND,ERNO
+10 ;
+11 ;Check for presence of message
+12 IF '$ORDER(^INTHU(INUIF,3,0))
SET MS="Missing message "_INUIF
DO DEBUG
QUIT
+13 ;
+14 SET (INNORSP,INSND)=0
+15 ;
+16 SET MS="Sending outgoing message: "_$PIECE(^INTHU(INUIF,0),U,5)_" ("_INUIF_")"
DO DEBUG
+17 SET MSG=0
FOR
SET MSG=$ORDER(^INTHU(INUIF,3,MSG))
IF 'MSG
QUIT
Begin DoDot:1
+18 SET MS=$GET(^INTHU(INUIF,3,MSG,0))
IF $LENGTH(MS)
DO DEBUG
End DoDot:1
+19 ;
SEND ;Send outgoing message. Retry until
+1 ;1-Message is NAKed too many times - INSND>INIP("STRY")
+2 ;2-No response. Then close socket and exit - INNORSP>20
+3 ;
+4 IF INNORSP>20
Begin DoDot:1
+5 SET INPROK=0
+6 SET MS="No response after 20 retries, shutting down"
+7 DO DEBUG
DO CLOSE
End DoDot:1
QUIT
+8 ;
+9 ;If send retries exceeded then send next msg
+10 SET INSND=INSND+1
IF INSND>INIP("STRY")
Begin DoDot:1
+11 SET MS="Send retries ("_$GET(INIP("STRY"))_") exceeded."
DO DEBUG
+12 SET ER=2
End DoDot:1
QUIT
+13 ;
+14 IF INNORSP>1
SET MS="Retransmitting: failure "_INNORSP
DO DEBUG
+15 ;
+16 SET OUT=0
FOR
SET ER=$$SEND^INHUVUT(INUIF,INCHNL,.INIP)
IF 'ER
SET OUT=1
IF OUT
QUIT
+17 ;Currently ER will always be returned as 0, but INHUVUT may get smarter
+18 ;
RECEIVE ;Receive incoming response. If no response, go back and SEND again
+1 ;
+2 ;Attempt to receive ack INIP("RTRY") times
+3 SET (RCVE,OUT)=0
FOR
Begin DoDot:1
+4 KILL ING
SET ING="INDATA"
KILL @ING
+5 SET MSG="Receiving acknowldgment"
+6 IF INNORSP>1
SET MSG=MSG_", attempt "_INNORSP
+7 SET MS=MSG
DO DEBUG
+8 ;Read ack message
+9 SET ER=$$RECEIVE^INHUVUT(.ING,.INCHNL,.INIP,.INERR,.INMEM)
+10 ;Diplay ack message
+11 WRITE !
SET O=""
+12 FOR
SET O=$ORDER(@ING@(O))
IF O=""
QUIT
SET MS=@ING@(O)
DO DEBUG
+13 WRITE !
+14 SET OUT=$SELECT('ER:1,ER=3:1,1:OUT)
IF OUT
QUIT
+15 ;If ER, some error or timeout has occurred
+16 SET RCVE=RCVE+1
SET OUT=$SELECT(RCVE>INIP("RTRY"):1,1:OUT)
IF OUT
QUIT
+17 HANG INIP("RHNG")
End DoDot:1
IF OUT
QUIT
+18 ;
+19 ;Error conditions from receive
+20 ;If ER=3 then the other side has dropped the connection
+21 IF ER=3
SET INPROK=0
QUIT
+22 ;Check for no response
+23 IF ER=1!'$DATA(@ING)
SET INNORSP=INNORSP+1
GOTO SEND
+24 ;Check for unexpected conditions
+25 ; SHOULD NOT HAPPEN
IF ER>1
SET INNORSP=INNORSP+1
GOTO SEND
+26 ;If max RCVE retries exceeded go back to send
+27 IF RCVE>INIP("RTRY")
Begin DoDot:1
+28 SET MS="Max Receive retries exceeded."
DO DEBUG
End DoDot:1
GOTO SEND
+29 ;
EVAL ;Evaluate incoming response (ie ack status=CA).
+1 ;If error, increment LOOP to STRY, go back and send again
+2 KILL INACKID,INMSASTA,INERR
+3 ;Load ack message into file
+4 SET ER=$$IN^INHUSEN(ING,.INDEST,INDSTR,0,.INSEND,.INERR,"",.INACKID,1,.INMSASTA)
+5 ;
+6 ;Check for errors
+7 ;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
+8 ;ER=2 is fatal error -> shut it down
+9 ;ER=1 is non-fatal error -> move on to next transaction
+10 ;ER=0 is no error
+11 SET MS=$SELECT('ER:"Acknowledgment accepted: ",1:"Error evaluating acknowledgment.")
+12 IF $GET(INACKID)
SET MS=MS_$PIECE(^INTHU(INACKID,0),U,5)_" ("_INACKID_")"
+13 DO DEBUG
+14 ;Display error array
+15 IF ER
IF $DATA(INERR)
Begin DoDot:1
+16 SET ERNO=0
FOR
SET ERNO=$ORDER(INERR(ERNO))
IF 'ERNO
QUIT
Begin DoDot:2
+17 SET MS=INERR(ERNO)
DO DEBUG
End DoDot:2
End DoDot:1
KILL INERR
+18 ;
+19 KILL @ING
+20 QUIT
+21 ;
+22 ;If non-fatal, send again. Also kill incoming array/gbl
+23 ;Resend for CE or AE (or ?E). If rejected, (CR or AR) NEVER resend.
+24 KILL @ING
IF ER<2
IF $EXTRACT($GET(INMSASTA),2)'="E"
Begin DoDot:1
+25 SET RUN=$$INRHB^INHUVUT1(INBPN,"Transmission complete",1)
+26 SET MS="Transmission complete for "_INBPNM
End DoDot:1
QUIT
+27 ;Otherwise, if fatal, hang and try again
+28 SET MS="Waiting to re-transmit"
DO DEBUG
+29 HANG INIP("SHNG")
GOTO SEND
+30 ;
ERR ;Error module
+1 NEW INREERR
SET INREERR=$$GETERR^%ZTOS
+2 ;close port and quit
+3 IF $DATA(INCHNL)
DO CLOSE^%INET(INCHNL)
+4 SET MS="Fatal error encountered by - "_INREERR
+5 DO DEBUG
+6 QUIT
+7 ;
CLOSE ;Close channel
+1 SET MS="Closing connection for "_INBPNM
DO DEBUG
+2 IF +$GET(INCHNL)
DO CLOSE^%INET(.INCHNL)
+3 QUIT
+4 ;
DEBUG ;Write interactive messages to the screen
+1 ;INPUT:
+2 ; MS - message to display
+3 ;OUTPUT:
+4 ; INPROK - exit simulator
+5 ;
+6 WRITE !,$GET(MS)
+7 IF '$GET(INIPPO)!'$GET(INBPN)
QUIT
+8 IF '$DATA(^INRHB("RUN","SRVR",INBPN,INIPPO))
Begin DoDot:1
+9 SET INPROK=0
+10 WRITE !,"Process signalled to terminate",!
End DoDot:1
QUIT
+11 SET ^INRHB("RUN","SRVR",INBPN,INIPPO)=$HOROLOG_U_MS
+12 SET %=""
IF '$GET(INAUTO)
READ %#1:0
+13 IF $LENGTH(%)
SET INPROK=0
+14 QUIT
+15 ;
