INTSUT ;JPD; 1 Feb 96 09:26; Generic receiver, enhanced functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
INIT1(INDA,INBPN,INIP,CLISRV,INXDST,INDEST,INPOP) ;Init
;Input:
; INDA - ien of Criteria
; INBPN = Background processor
;Output:
; INIP - Parameters
; CLISRV - 0 Client, 1 - Server
; INXDST - Destination Determination xeq
; INDEST - destinations
; INPOP - 0 stop processing, 1 continue processing
;
N ING,INERR,INUIF,X,ER,INMEM,INQP,INQT,I,Y
S X="ERR^INTSAPR",@^%ZOSF("TRAP"),INPOP=1
; initialize variables from background process file
D INIT(INDA,.INIP)
I INIP("PORT")="" D DISPLAY^INTSUT1("Port is not defined") S INPOP=0 Q
;Determine if process will be client (default, with 0) or server (1)
S CLISRV=$$VAL^DWRA(4001.1,13.03,2,DIE,INDA)
;server only lock if server
I CLISRV D Q:'INPOP
.L +^INRHB("RUN","SRVR",INBPN,INIP("PORT")):0 I '$T D
..S INPOP=0
..D DISPLAY^INTSUT1("Port locked by another user")
I CLISRV S ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))=$H
;Set destination determination code
S INXDST=$$VAL^DWRA(4001.1,23.01,2,DIE,INDA)
;Set array of valid destinations
D DISPLAY^INTSUT1("Setting valid destination(s)")
F I=1:1 S X=$T(DEST+I^INHVTAPR) Q:X'[";;" D
.S Y=$TR($P(X,";;")," ",""),INDEST(Y)=$P(X,";;",2)
D DISPLAY^INTSUT1("Initialized variables from background process file")
Q
OPEN(CLISRV,INIP,INMEM,INCHNL,INPOP,INNM) ;Open connection
; Input:
; CLISRV - 0 Client, 1 Server
; INIP - Process parameters
; INNM - Name of what is being opened
; Output:
; INMEM - memory location
; INCHNL - chanel of tcp/ip socket
; INPOP - 0 stop 1 continue
N INLOOP,OPENED,MSG,INX
K INCHNL
S INNM=$G(INNM) S:INNM="" INNM="Test Utility"
S INX=$S(CLISRV:"server",1:"client"),(INDEBUG,INDONE)=0
D DISPLAY^INTSUT1("Opening connection for "_INX_" process ") Q:'INPOP
;Open %INET
F INLOOP=1:1:INIP("OTRY") D Q:INCHNL!'INPOP H INIP("OHNG")
.S MSG="Attempt "_INLOOP_" to open socket"
.D DISPLAY^INTSUT1(MSG)
.;If background process is server open Test Utility as SERVER
.I CLISRV D SRVOPN(.INIP,.INCHNL,.INMEM)
.;If background process is client open Test Utility as CLIENT
.I 'CLISRV D CLIOPN(.INIP,.INCHNL,.INMEM)
.Q:+INCHNL
.I $L(INCHNL) D DISPLAY^INTSUT1(INCHNL) S INCHNL=""
.;Hang and retry
.D DISPLAY^INTSUT1("Waiting "_INIP("OHNG")_" seconds for retry")
;
I 'INCHNL D Q
.D DISPLAY^INTSUT1("Unable to connect to "_INNM_" at "_INIP("ADDR")_" / "_INIP("PORT"))
.S INPOP=0
D DISPLAY^INTSUT1("Channel "_+INCHNL_" opened.")
Q
SRVOPN(INIP,INCHNL,INMEM) ;Open Server
; Input:
; INIP - Parameters
; INCHNL - Port channel
; INMEM - Memory location
D DISPLAY^INTSUT1("Opening Server at port "_INIP("PORT"))
D OPEN^%INET(.INCHNL,.INMEM,"",INIP("PORT"),1)
Q
CLIOPN(INIP,INCHNL,INMEM) ;open client
; Input:
; INIP - Parameters
; INCHNL - Port channel
; INMEM - Memory location
D DISPLAY^INTSUT1("Opening Client at address "_INIP("ADDR")_" port "_INIP("PORT"))
D OPEN^%INET(.INCHNL,.INMEM,INIP("ADDR"),INIP("PORT"),1)
I 'INCHNL,INCHNL'="" D DISPLAY^INTSUT1(INCHNL_" "_INIP("ADDR")_" "_INIP("PORT"))
Q
EXIT(INCHNL,INBPN,INIP,CLISRV) ;Main exit module
;Input:
; INCHNL - Port channel
; INBPN - background process pointer
; INIP - Array of tcp parameters
; CLISRV - 1 Server 0 client
;server
I CLISRV D
.L -^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
.D CLOSE(.INCHNL,"Server")
.K ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
;client
I 'CLISRV D
.D CLOSE(.INCHNL,"Client")
.L -^INRHB("RUN",INBPN,INIP("PORT"))
.K ^INRHB("RUN",INBPN,INIP("PORT"))
D DISPLAY^INTSUT1("Exiting TCP socket transmitter for the Test Utility")
Q
;
CLOSE(INCHNL,INTP) ;Close channel
; Input:
; INCHNL - Cannel of Socket
; INTP - Client or Server
D DISPLAY^INTSUT1("Closing "_INTP_" channel "_(+INCHNL)),CLOSE^%INET(.INCHNL)
Q
CLINIT(INIP,INCHNL,INMEM,INPOP) ;Init as a client send init string
; Input:
; INIP - Input paramters
; INCHNL - TCP/IP socket channel
; INMEM - MEMORY LOCATION FOR TCP/IP
; INPOP - 0 Stop processing, 1 continue
N J,MS,INMS,I,ER,ING,INDATA,APREC,INSMIN,INSND,INOUT
D DISPLAY^INTSUT1("Opened as client")
S INOUT=0
I $L(INIP("INIT")) F INSND=1:1:INIP("STRY") D Q:'INPOP!INOUT
.D SENDSTR^INHUVUT(INIP("INIT"),INCHNL)
.D DISPLAY^INTSUT1("Sent initilization string")
.;Receive initialization response, if specified
.I '$L(INIP("ACK")) S INOUT=1 Q
.D DISPLAY^INTSUT1("waiting to receive initialization response.")
.S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
.S ING="INDATA"
.F I=1:1:INIP("RTRY") D Q:$D(ING) H:I<INIP("RTRY") INIP("RHNG")
..D RECSTR^INTSREC(.ING,.INCHNL,.INIP)
.I '$D(@ING) D Q
..D DISPLAY^INTSUT1("No response received to intialization string ")
.S INOUT=1
I '$D(@ING) S INPOP=0
Q:'INPOP
;Diplay ack message
D PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
S J=0 F S J=$O(INMS(J)) Q:'J S MS=INMS(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
K INMS,MS
;response not same as what's in ACK
I @ING@(1)'[INIP("ACK") D
.S INPOP=0
.D DISPLAY^INTSUT1("Incorrect response "_@ING@(1)_" received to intialization string ")
Q
SRVINIT(INIP,INCHNL,INMEM,INPOP) ;--If opening as server, receive initialization string
; Input:
; INIP - Input paramters
; INCHNL - TCP/IP socket channel
; INMEM - MEMORY LOCATION FOR TCP/IP
; INPOP - 0 Stop processing, 1 continue
;Receive initialization
N INLOOP
Q:'$L(INIP("INIT"))
D DISPLAY^INTSUT1("Waiting to receive initialization string")
S ING="INDATA" K @ING
F INLOOP=1:1:INIP("RTRY") D Q:$D(@ING) H:INLOOP<INIP("RTRY") INIP("RHNG")
.D DISPLAY^INTSUT1("Waiting to receive initialization string")
.D RECSTR^INTSREC(.ING,.INCHNL,.INIP)
I '$D(@ING) D Q
.S INPOP=0
.D DISPLAY^INTSUT1("No initialization string received")
I @ING@(1)'[INIP("INIT") D Q
.S INPOP=0
.D DISPLAY^INTSUT1("Incorrect intialization received: "_@ING@(1))
;received something while waiting for Init string
D DISPLAY^INTSUT1("Received Initialization String")
;Diplay ack message
D PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
S J=0 F S J=$O(INMS(J)) Q:'J S MS=INMS(J) D:$L(MS) DISPLAY^INTSUT1(MS,INEXPAND)
K INMS,MS
;Send initialization response if specified
I $L(INIP("ACK")) D
.D SENDSTR^INHUVUT(INIP("ACK"),INCHNL)
.D DISPLAY^INTSUT1("Sent initialization response")
Q
ERROR(ER,INERR,INRCVE,INPOP) ;receive error check
; Input:
; ER - error
; INERR - Error description
; Input/Output:
; INRCVE - Receive count
; INPOP - 0 stop 1 continue
N RUN
;If ER, some error or timeout has occurred
;Log transceiver error if fatal, don't update message status
I ER,$L($G(INERR)) D DISPLAY^INTSUT1(INERR)
S INRCVE=+$G(INRCVE)+1 I INRCVE>INIP("RTRY") S INPOP=0 H INIP("RHNG")
;--Blank and/or error conditions from receive
;If ER=3, the other side has dropped the connection.
I ER=3 D DISPLAY^INTSUT1("Remote end disconnect") S INPOP=0 Q 0
Q 1
EVAL(INIP,ING,INDEST,ACKUIF,INERR,INXDST,ER,INMSG,INRONLY) ;Evaluate incoming msg
;Input:
; INIP - Parameters
; ING - variable set = to variable that holds message
; INDEST - destinations
; INRONLY - 1 Receive only send no ack, 0 receive then send ack
;Output:
; ACKUIF - ien of Ack message in UIF
; INERR - Error description
; INXDST - Destination Determination xeq
; ER - true or false
N INACKID,ER
;get ack
S ER=$$IN^INTSUSN(.INIP,ING,.INDEST,.ACKUIF,.INERR,.INXDST,.INMSG,.INMSASTA,INRONLY)
;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
;ER=2 is fatal error
;ER=1 is non-fatal error. Log it, but move on to next transmission
;ER=0 is no error
;Log error message
I 'ER,'$D(INERR)
I ER,$D(INERR) D K INERR
.S ERNO=0 F S ERNO=$O(INERR(ERNO)) Q:'ERNO D DISPLAY^INTSUT1(INERR(ERNO),+$G(ACKUIF))
K @ING
Q
INIT(INDA,INIP) ;Initialize IP variables
; Input: INDA - ien of test case
; Output: INIP - IP variables
N STR,STR13,STR17
S STR=$G(^DIZ(4001.1,INDA,16)),STR13=$G(^DIZ(4001.1,INDA,13)),STR17=$G(^DIZ(4001.1,INDA,17)),INIP("PRE")=$G(^DIZ(4001.1,INDA,21)),INIP("POST")=$G(^DIZ(4001.1,INDA,22))
S INIP("AATT")=$P(STR13,U)
S INIP("AAC")=$P(STR13,U,4)
S INIP("OTRY")=$S($L($P(STR,U,4)):$P(STR,U,4),1:10)
S INIP("OHNG")=$S($L($P(STR,U,3)):$P(STR,U,3),1:15)
S INIP("RTO")=$S($L($P(STR,U,11)):$P(STR,U,11),1:15)
S INIP("STO")=$S($L($P(STR,U,8)):$P(STR,U,8),1:60)
S INIP("RTRY")=$S($L($P(STR,U,10)):$P(STR,U,10),1:5)
S INIP("RHNG")=$S($L($P(STR,U,9)):$P(STR,U,9),1:10)
S INIP("EOL")=$$ASCII^INHUVUT($S($L($P(STR,U,12)):$P(STR,U,12),1:13))
S INIP("INIT")=$$ASCII^INHUVUT($P(STR17,U))
S INIP("ACK")=$$ASCII^INHUVUT($P(STR17,U,2))
S INIP("THNG")=$S($L($P(STR,U,5)):$P(STR,U,5),1:10)
S INIP("STRY")=$S($L($P(STR,U,7)):$P(STR,U,7),1:10)
S INIP("SHNG")=$S($L($P(STR,U,6)):$P(STR,U,6),1:10)
S INIP("NOSOM")=1
I $G(DUZ)>1 S INIP("TMAX")=$$DTIME^INHULOG(DUZ)
S INIP("ADDR")=$P(STR,U)
S INIP("PORT")=$P(STR,U,2)
Q
INTSUT ;JPD; 1 Feb 96 09:26; Generic receiver, enhanced functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
INIT1(INDA,INBPN,INIP,CLISRV,INXDST,INDEST,INPOP) ;Init
+1 ;Input:
+2 ; INDA - ien of Criteria
+3 ; INBPN = Background processor
+4 ;Output:
+5 ; INIP - Parameters
+6 ; CLISRV - 0 Client, 1 - Server
+7 ; INXDST - Destination Determination xeq
+8 ; INDEST - destinations
+9 ; INPOP - 0 stop processing, 1 continue processing
+10 ;
+11 NEW ING,INERR,INUIF,X,ER,INMEM,INQP,INQT,I,Y
+12 SET X="ERR^INTSAPR"
SET @^%ZOSF("TRAP")
SET INPOP=1
+13 ; initialize variables from background process file
+14 DO INIT(INDA,.INIP)
+15 IF INIP("PORT")=""
DO DISPLAY^INTSUT1("Port is not defined")
SET INPOP=0
QUIT
+16 ;Determine if process will be client (default, with 0) or server (1)
+17 SET CLISRV=$$VAL^DWRA(4001.1,13.03,2,DIE,INDA)
+18 ;server only lock if server
+19 IF CLISRV
Begin DoDot:1
+20 LOCK +^INRHB("RUN","SRVR",INBPN,INIP("PORT")):0
IF '$TEST
Begin DoDot:2
+21 SET INPOP=0
+22 DO DISPLAY^INTSUT1("Port locked by another user")
End DoDot:2
End DoDot:1
IF 'INPOP
QUIT
+23 IF CLISRV
SET ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))=$HOROLOG
+24 ;Set destination determination code
+25 SET INXDST=$$VAL^DWRA(4001.1,23.01,2,DIE,INDA)
+26 ;Set array of valid destinations
+27 DO DISPLAY^INTSUT1("Setting valid destination(s)")
+28 FOR I=1:1
SET X=$TEXT(DEST+I^INHVTAPR)
IF X'[";;"
QUIT
Begin DoDot:1
+29 SET Y=$TRANSLATE($PIECE(X,";;")," ","")
SET INDEST(Y)=$PIECE(X,";;",2)
End DoDot:1
+30 DO DISPLAY^INTSUT1("Initialized variables from background process file")
+31 QUIT
OPEN(CLISRV,INIP,INMEM,INCHNL,INPOP,INNM) ;Open connection
+1 ; Input:
+2 ; CLISRV - 0 Client, 1 Server
+3 ; INIP - Process parameters
+4 ; INNM - Name of what is being opened
+5 ; Output:
+6 ; INMEM - memory location
+7 ; INCHNL - chanel of tcp/ip socket
+8 ; INPOP - 0 stop 1 continue
+9 NEW INLOOP,OPENED,MSG,INX
+10 KILL INCHNL
+11 SET INNM=$GET(INNM)
IF INNM=""
SET INNM="Test Utility"
+12 SET INX=$SELECT(CLISRV:"server",1:"client")
SET (INDEBUG,INDONE)=0
+13 DO DISPLAY^INTSUT1("Opening connection for "_INX_" process ")
IF 'INPOP
QUIT
+14 ;Open %INET
+15 FOR INLOOP=1:1:INIP("OTRY")
Begin DoDot:1
+16 SET MSG="Attempt "_INLOOP_" to open socket"
+17 DO DISPLAY^INTSUT1(MSG)
+18 ;If background process is server open Test Utility as SERVER
+19 IF CLISRV
DO SRVOPN(.INIP,.INCHNL,.INMEM)
+20 ;If background process is client open Test Utility as CLIENT
+21 IF 'CLISRV
DO CLIOPN(.INIP,.INCHNL,.INMEM)
+22 IF +INCHNL
QUIT
+23 IF $LENGTH(INCHNL)
DO DISPLAY^INTSUT1(INCHNL)
SET INCHNL=""
+24 ;Hang and retry
+25 DO DISPLAY^INTSUT1("Waiting "_INIP("OHNG")_" seconds for retry")
End DoDot:1
IF INCHNL!'INPOP
QUIT
HANG INIP("OHNG")
+26 ;
+27 IF 'INCHNL
Begin DoDot:1
+28 DO DISPLAY^INTSUT1("Unable to connect to "_INNM_" at "_INIP("ADDR")_" / "_INIP("PORT"))
+29 SET INPOP=0
End DoDot:1
QUIT
+30 DO DISPLAY^INTSUT1("Channel "_+INCHNL_" opened.")
+31 QUIT
SRVOPN(INIP,INCHNL,INMEM) ;Open Server
+1 ; Input:
+2 ; INIP - Parameters
+3 ; INCHNL - Port channel
+4 ; INMEM - Memory location
+5 DO DISPLAY^INTSUT1("Opening Server at port "_INIP("PORT"))
+6 DO OPEN^%INET(.INCHNL,.INMEM,"",INIP("PORT"),1)
+7 QUIT
CLIOPN(INIP,INCHNL,INMEM) ;open client
+1 ; Input:
+2 ; INIP - Parameters
+3 ; INCHNL - Port channel
+4 ; INMEM - Memory location
+5 DO DISPLAY^INTSUT1("Opening Client at address "_INIP("ADDR")_" port "_INIP("PORT"))
+6 DO OPEN^%INET(.INCHNL,.INMEM,INIP("ADDR"),INIP("PORT"),1)
+7 IF 'INCHNL
IF INCHNL'=""
DO DISPLAY^INTSUT1(INCHNL_" "_INIP("ADDR")_" "_INIP("PORT"))
+8 QUIT
EXIT(INCHNL,INBPN,INIP,CLISRV) ;Main exit module
+1 ;Input:
+2 ; INCHNL - Port channel
+3 ; INBPN - background process pointer
+4 ; INIP - Array of tcp parameters
+5 ; CLISRV - 1 Server 0 client
+6 ;server
+7 IF CLISRV
Begin DoDot:1
+8 LOCK -^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
+9 DO CLOSE(.INCHNL,"Server")
+10 KILL ^INRHB("RUN","SRVR",INBPN,INIP("PORT"))
End DoDot:1
+11 ;client
+12 IF 'CLISRV
Begin DoDot:1
+13 DO CLOSE(.INCHNL,"Client")
+14 LOCK -^INRHB("RUN",INBPN,INIP("PORT"))
+15 KILL ^INRHB("RUN",INBPN,INIP("PORT"))
End DoDot:1
+16 DO DISPLAY^INTSUT1("Exiting TCP socket transmitter for the Test Utility")
+17 QUIT
+18 ;
CLOSE(INCHNL,INTP) ;Close channel
+1 ; Input:
+2 ; INCHNL - Cannel of Socket
+3 ; INTP - Client or Server
+4 DO DISPLAY^INTSUT1("Closing "_INTP_" channel "_(+INCHNL))
DO CLOSE^%INET(.INCHNL)
+5 QUIT
CLINIT(INIP,INCHNL,INMEM,INPOP) ;Init as a client send init string
+1 ; Input:
+2 ; INIP - Input paramters
+3 ; INCHNL - TCP/IP socket channel
+4 ; INMEM - MEMORY LOCATION FOR TCP/IP
+5 ; INPOP - 0 Stop processing, 1 continue
+6 NEW J,MS,INMS,I,ER,ING,INDATA,APREC,INSMIN,INSND,INOUT
+7 DO DISPLAY^INTSUT1("Opened as client")
+8 SET INOUT=0
+9 IF $LENGTH(INIP("INIT"))
FOR INSND=1:1:INIP("STRY")
Begin DoDot:1
+10 DO SENDSTR^INHUVUT(INIP("INIT"),INCHNL)
+11 DO DISPLAY^INTSUT1("Sent initilization string")
+12 ;Receive initialization response, if specified
+13 IF '$LENGTH(INIP("ACK"))
SET INOUT=1
QUIT
+14 DO DISPLAY^INTSUT1("waiting to receive initialization response.")
+15 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+16 SET ING="INDATA"
+17 FOR I=1:1:INIP("RTRY")
Begin DoDot:2
+18 DO RECSTR^INTSREC(.ING,.INCHNL,.INIP)
End DoDot:2
IF $DATA(ING)
QUIT
IF I<INIP("RTRY")
HANG INIP("RHNG")
+19 IF '$DATA(@ING)
Begin DoDot:2
+20 DO DISPLAY^INTSUT1("No response received to intialization string ")
End DoDot:2
QUIT
+21 SET INOUT=1
End DoDot:1
IF 'INPOP!INOUT
QUIT
+22 IF '$DATA(@ING)
SET INPOP=0
+23 IF 'INPOP
QUIT
+24 ;Diplay ack message
+25 DO PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
+26 SET J=0
FOR
SET J=$ORDER(INMS(J))
IF 'J
QUIT
SET MS=INMS(J)
IF $LENGTH(MS)
DO DISPLAY^INTSUT1(MS,INEXPAND)
+27 KILL INMS,MS
+28 ;response not same as what's in ACK
+29 IF @ING@(1)'[INIP("ACK")
Begin DoDot:1
+30 SET INPOP=0
+31 DO DISPLAY^INTSUT1("Incorrect response "_@ING@(1)_" received to intialization string ")
End DoDot:1
+32 QUIT
SRVINIT(INIP,INCHNL,INMEM,INPOP) ;--If opening as server, receive initialization string
+1 ; Input:
+2 ; INIP - Input paramters
+3 ; INCHNL - TCP/IP socket channel
+4 ; INMEM - MEMORY LOCATION FOR TCP/IP
+5 ; INPOP - 0 Stop processing, 1 continue
+6 ;Receive initialization
+7 NEW INLOOP
+8 IF '$LENGTH(INIP("INIT"))
QUIT
+9 DO DISPLAY^INTSUT1("Waiting to receive initialization string")
+10 SET ING="INDATA"
KILL @ING
+11 FOR INLOOP=1:1:INIP("RTRY")
Begin DoDot:1
+12 DO DISPLAY^INTSUT1("Waiting to receive initialization string")
+13 DO RECSTR^INTSREC(.ING,.INCHNL,.INIP)
End DoDot:1
IF $DATA(@ING)
QUIT
IF INLOOP<INIP("RTRY")
HANG INIP("RHNG")
+14 IF '$DATA(@ING)
Begin DoDot:1
+15 SET INPOP=0
+16 DO DISPLAY^INTSUT1("No initialization string received")
End DoDot:1
QUIT
+17 IF @ING@(1)'[INIP("INIT")
Begin DoDot:1
+18 SET INPOP=0
+19 DO DISPLAY^INTSUT1("Incorrect intialization received: "_@ING@(1))
End DoDot:1
QUIT
+20 ;received something while waiting for Init string
+21 DO DISPLAY^INTSUT1("Received Initialization String")
+22 ;Diplay ack message
+23 DO PARSEDCT^INHUT9(ING,"INMS",IOM,3,"",1)
+24 SET J=0
FOR
SET J=$ORDER(INMS(J))
IF 'J
QUIT
SET MS=INMS(J)
IF $LENGTH(MS)
DO DISPLAY^INTSUT1(MS,INEXPAND)
+25 KILL INMS,MS
+26 ;Send initialization response if specified
+27 IF $LENGTH(INIP("ACK"))
Begin DoDot:1
+28 DO SENDSTR^INHUVUT(INIP("ACK"),INCHNL)
+29 DO DISPLAY^INTSUT1("Sent initialization response")
End DoDot:1
+30 QUIT
ERROR(ER,INERR,INRCVE,INPOP) ;receive error check
+1 ; Input:
+2 ; ER - error
+3 ; INERR - Error description
+4 ; Input/Output:
+5 ; INRCVE - Receive count
+6 ; INPOP - 0 stop 1 continue
+7 NEW RUN
+8 ;If ER, some error or timeout has occurred
+9 ;Log transceiver error if fatal, don't update message status
+10 IF ER
IF $LENGTH($GET(INERR))
DO DISPLAY^INTSUT1(INERR)
+11 SET INRCVE=+$GET(INRCVE)+1
IF INRCVE>INIP("RTRY")
SET INPOP=0
HANG INIP("RHNG")
+12 ;--Blank and/or error conditions from receive
+13 ;If ER=3, the other side has dropped the connection.
+14 IF ER=3
DO DISPLAY^INTSUT1("Remote end disconnect")
SET INPOP=0
QUIT 0
+15 QUIT 1
EVAL(INIP,ING,INDEST,ACKUIF,INERR,INXDST,ER,INMSG,INRONLY) ;Evaluate incoming msg
+1 ;Input:
+2 ; INIP - Parameters
+3 ; ING - variable set = to variable that holds message
+4 ; INDEST - destinations
+5 ; INRONLY - 1 Receive only send no ack, 0 receive then send ack
+6 ;Output:
+7 ; ACKUIF - ien of Ack message in UIF
+8 ; INERR - Error description
+9 ; INXDST - Destination Determination xeq
+10 ; ER - true or false
+11 NEW INACKID,ER
+12 ;get ack
+13 SET ER=$$IN^INTSUSN(.INIP,ING,.INDEST,.ACKUIF,.INERR,.INXDST,.INMSG,.INMSASTA,INRONLY)
+14 ;ER=3 means out of synch, stop tranceiver (NOT checking for this tcvr)
+15 ;ER=2 is fatal error
+16 ;ER=1 is non-fatal error. Log it, but move on to next transmission
+17 ;ER=0 is no error
+18 ;Log error message
+19 IF 'ER
IF '$DATA(INERR)
+20 IF ER
IF $DATA(INERR)
Begin DoDot:1
+21 SET ERNO=0
FOR
SET ERNO=$ORDER(INERR(ERNO))
IF 'ERNO
QUIT
DO DISPLAY^INTSUT1(INERR(ERNO),+$GET(ACKUIF))
End DoDot:1
KILL INERR
+22 KILL @ING
+23 QUIT
INIT(INDA,INIP) ;Initialize IP variables
+1 ; Input: INDA - ien of test case
+2 ; Output: INIP - IP variables
+3 NEW STR,STR13,STR17
+4 SET STR=$GET(^DIZ(4001.1,INDA,16))
SET STR13=$GET(^DIZ(4001.1,INDA,13))
SET STR17=$GET(^DIZ(4001.1,INDA,17))
SET INIP("PRE")=$GET(^DIZ(4001.1,INDA,21))
SET INIP("POST")=$GET(^DIZ(4001.1,INDA,22))
+5 SET INIP("AATT")=$PIECE(STR13,U)
+6 SET INIP("AAC")=$PIECE(STR13,U,4)
+7 SET INIP("OTRY")=$SELECT($LENGTH($PIECE(STR,U,4)):$PIECE(STR,U,4),1:10)
+8 SET INIP("OHNG")=$SELECT($LENGTH($PIECE(STR,U,3)):$PIECE(STR,U,3),1:15)
+9 SET INIP("RTO")=$SELECT($LENGTH($PIECE(STR,U,11)):$PIECE(STR,U,11),1:15)
+10 SET INIP("STO")=$SELECT($LENGTH($PIECE(STR,U,8)):$PIECE(STR,U,8),1:60)
+11 SET INIP("RTRY")=$SELECT($LENGTH($PIECE(STR,U,10)):$PIECE(STR,U,10),1:5)
+12 SET INIP("RHNG")=$SELECT($LENGTH($PIECE(STR,U,9)):$PIECE(STR,U,9),1:10)
+13 SET INIP("EOL")=$$ASCII^INHUVUT($SELECT($LENGTH($PIECE(STR,U,12)):$PIECE(STR,U,12),1:13))
+14 SET INIP("INIT")=$$ASCII^INHUVUT($PIECE(STR17,U))
+15 SET INIP("ACK")=$$ASCII^INHUVUT($PIECE(STR17,U,2))
+16 SET INIP("THNG")=$SELECT($LENGTH($PIECE(STR,U,5)):$PIECE(STR,U,5),1:10)
+17 SET INIP("STRY")=$SELECT($LENGTH($PIECE(STR,U,7)):$PIECE(STR,U,7),1:10)
+18 SET INIP("SHNG")=$SELECT($LENGTH($PIECE(STR,U,6)):$PIECE(STR,U,6),1:10)
+19 SET INIP("NOSOM")=1
+20 IF $GET(DUZ)>1
SET INIP("TMAX")=$$DTIME^INHULOG(DUZ)
+21 SET INIP("ADDR")=$PIECE(STR,U)
+22 SET INIP("PORT")=$PIECE(STR,U,2)
+23 QUIT
