INTSEND ;JD; 13 May 96 12:19; "Generic" socket transceiver
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;This is an interactive transmitter routine. It first sends a message,
;then waits for an ack, then sends another msg, etc.
;The counterpart routine is INTSREC, which receives first, then
;sends an ack, etc.
;
;This runs similar to INHVTAPT
EN(INEXPAND,INDA,DIE) ;Entry point
; Input:
; INEXPAND - 0 display to screen, 1 don't display to screen
; INDA - ien of criteria
; DIE - Criteria File
N INPOP,INBPN,INIP,CLISRV,INXDST,INDEST,INCHNL,INMEM,ING,INDATA
K ^UTILITY("INTHU",DUZ)
;update messages
D UPDTSND^INTSUT3(INDA)
;clear channel, set background process ien
S INCHNL="",INBPN=+$$VAL^DWRA(4001.1,20,2,DIE,INDA)
S INPOP=1
;initialize parameters
D INIT1^INTSUT(INDA,.INBPN,.INIP,.CLISRV,.INXDST,.INDEST,.INPOP)
Q:'INPOP
I CLISRV,INIP("ADDR")'="" S INIP("ADDR")="" D DISPLAY^INTSUT1("IP Address not needed for a Server")
I 'CLISRV,INIP("ADDR")="" D DISPLAY^INTSUT1("No IP Address designated for client") Q
;open socket
D OPEN^INTSUT(CLISRV,.INIP,.INMEM,.INCHNL,.INPOP)
I INPOP D
.;client init string
.I $L(INIP("INIT"))+$L(INIP("ACK")) D
..;if client initialize as client
..I 'CLISRV D CLINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP) Q:'INPOP
..;if server initialize as server
..I CLISRV D SRVINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP) Q:'INPOP
.I INPOP D DISPLAY^INTSUT1("Socket ready to start send/receive.")
.;Loop until a transaction exists on the destination queue
.I INPOP D LOOP(.INCHNL,.INIP,.INDEST,.INXDST,INEXPAND,.INPOP,INDA)
D EXIT^INTSUT(.INCHNL,INBPN,.INIP,CLISRV)
Q
LOOP(INCHNL,INIP,INDEST,INXDST,INEXPAND,INPOP,INDA) ;Loop /send and receive messages
; Input:
; INCHNL - port channel
; INIP - TCP/IP paramters
; INDEST - array of destinations
; INPOP - 0 stop, 1 continue
; INDA - ien of Criteria
N INSND,OUT,RCVE,INARY,INEXTN,INEXTUIF,INLASTN,INUPDAT,INOPT
S (INSND,OUT,RCVE,INLASTN,INUPDAT)=0
F D Q:OUT!'INPOP
.K INARY,INEXTUIF
.S (INEXTN,INLASTN)=$O(^UTILITY("INTHU",DUZ,$J,INLASTN))
.I INEXTN S INEXTUIF=$O(^UTILITY("INTHU",DUZ,$J,INEXTN,""))
.;Pre process
.I $G(INIP("PRE"))'="" D PRE^INTSUT2(INDA,INIP("PRE"),.INEXTUIF,.INARY)
.Q:'$$POSTPRE^INTSUT2(INDA,.INARY,.INEXTUIF,.INLASTN,.INPOP,.INUPDAT)
.;last entry in utility and nothing updated in post process so QUIT
.I 'INLASTN S OUT=1 Q
.I '$D(^INTHU(+$G(INEXTUIF),0)) D DISPLAY^INTSUT1("Invalid or missing Universal Interface entry "_$G(INEXTUIF)) S INPOP=0 Q
.N INERR,INDATA,ING,ER,INOUT
.S INOUT=0
.D DISPLAY^INTSUT1("Ready to send")
.;loop until done
.F INSND=1:1:INIP("STRY") D Q:'INPOP!INOUT
..D DISPLAY^INTSUT1("Sending message "_$P($G(^INTHU(INEXTUIF,0)),U),0,INEXTUIF)
..;Expanded display
..I 'INEXPAND D EXPNDIS^INTSUT1(INEXTUIF)
..F S ER=$$SEND^INHUVUT(INEXTUIF,INCHNL,.INIP) Q:'ER
..D RECEIVE^INTSREC(.INIP,.INCHNL,.INXDST,.INDEST,INEXPAND,.INPOP,INDA,1,.INOUT)
.I INSND>INIP("STRY") D DISPLAY^INTSUT1("Send retries ("_$G(INIP("STRY"))_") exceeded.")
.;set message to complete
.D ULOG^INHU(INEXTUIF,"C")
;save criteria tests if they were updated in the pre or post
I INUPDAT D
.N INOPT
.S INOPT("TYPE")="TEST",INOPT("NONINTER")=1
.S X=$$SAVE^INHUTC1(.INOPT,INDA,"U")
Q
INTSEND ;JD; 13 May 96 12:19; "Generic" socket transceiver
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;This is an interactive transmitter routine. It first sends a message,
+5 ;then waits for an ack, then sends another msg, etc.
+6 ;The counterpart routine is INTSREC, which receives first, then
+7 ;sends an ack, etc.
+8 ;
+9 ;This runs similar to INHVTAPT
EN(INEXPAND,INDA,DIE) ;Entry point
+1 ; Input:
+2 ; INEXPAND - 0 display to screen, 1 don't display to screen
+3 ; INDA - ien of criteria
+4 ; DIE - Criteria File
+5 NEW INPOP,INBPN,INIP,CLISRV,INXDST,INDEST,INCHNL,INMEM,ING,INDATA
+6 KILL ^UTILITY("INTHU",DUZ)
+7 ;update messages
+8 DO UPDTSND^INTSUT3(INDA)
+9 ;clear channel, set background process ien
+10 SET INCHNL=""
SET INBPN=+$$VAL^DWRA(4001.1,20,2,DIE,INDA)
+11 SET INPOP=1
+12 ;initialize parameters
+13 DO INIT1^INTSUT(INDA,.INBPN,.INIP,.CLISRV,.INXDST,.INDEST,.INPOP)
+14 IF 'INPOP
QUIT
+15 IF CLISRV
IF INIP("ADDR")'=""
SET INIP("ADDR")=""
DO DISPLAY^INTSUT1("IP Address not needed for a Server")
+16 IF 'CLISRV
IF INIP("ADDR")=""
DO DISPLAY^INTSUT1("No IP Address designated for client")
QUIT
+17 ;open socket
+18 DO OPEN^INTSUT(CLISRV,.INIP,.INMEM,.INCHNL,.INPOP)
+19 IF INPOP
Begin DoDot:1
+20 ;client init string
+21 IF $LENGTH(INIP("INIT"))+$LENGTH(INIP("ACK"))
Begin DoDot:2
+22 ;if client initialize as client
+23 IF 'CLISRV
DO CLINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
IF 'INPOP
QUIT
+24 ;if server initialize as server
+25 IF CLISRV
DO SRVINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
IF 'INPOP
QUIT
End DoDot:2
+26 IF INPOP
DO DISPLAY^INTSUT1("Socket ready to start send/receive.")
+27 ;Loop until a transaction exists on the destination queue
+28 IF INPOP
DO LOOP(.INCHNL,.INIP,.INDEST,.INXDST,INEXPAND,.INPOP,INDA)
End DoDot:1
+29 DO EXIT^INTSUT(.INCHNL,INBPN,.INIP,CLISRV)
+30 QUIT
LOOP(INCHNL,INIP,INDEST,INXDST,INEXPAND,INPOP,INDA) ;Loop /send and receive messages
+1 ; Input:
+2 ; INCHNL - port channel
+3 ; INIP - TCP/IP paramters
+4 ; INDEST - array of destinations
+5 ; INPOP - 0 stop, 1 continue
+6 ; INDA - ien of Criteria
+7 NEW INSND,OUT,RCVE,INARY,INEXTN,INEXTUIF,INLASTN,INUPDAT,INOPT
+8 SET (INSND,OUT,RCVE,INLASTN,INUPDAT)=0
+9 FOR
Begin DoDot:1
+10 KILL INARY,INEXTUIF
+11 SET (INEXTN,INLASTN)=$ORDER(^UTILITY("INTHU",DUZ,$JOB,INLASTN))
+12 IF INEXTN
SET INEXTUIF=$ORDER(^UTILITY("INTHU",DUZ,$JOB,INEXTN,""))
+13 ;Pre process
+14 IF $GET(INIP("PRE"))'=""
DO PRE^INTSUT2(INDA,INIP("PRE"),.INEXTUIF,.INARY)
+15 IF '$$POSTPRE^INTSUT2(INDA,.INARY,.INEXTUIF,.INLASTN,.INPOP,.INUPDAT)
QUIT
+16 ;last entry in utility and nothing updated in post process so QUIT
+17 IF 'INLASTN
SET OUT=1
QUIT
+18 IF '$DATA(^INTHU(+$GET(INEXTUIF),0))
DO DISPLAY^INTSUT1("Invalid or missing Universal Interface entry "_$GET(INEXTUIF))
SET INPOP=0
QUIT
+19 NEW INERR,INDATA,ING,ER,INOUT
+20 SET INOUT=0
+21 DO DISPLAY^INTSUT1("Ready to send")
+22 ;loop until done
+23 FOR INSND=1:1:INIP("STRY")
Begin DoDot:2
+24 DO DISPLAY^INTSUT1("Sending message "_$PIECE($GET(^INTHU(INEXTUIF,0)),U),0,INEXTUIF)
+25 ;Expanded display
+26 IF 'INEXPAND
DO EXPNDIS^INTSUT1(INEXTUIF)
+27 FOR
SET ER=$$SEND^INHUVUT(INEXTUIF,INCHNL,.INIP)
IF 'ER
QUIT
+28 DO RECEIVE^INTSREC(.INIP,.INCHNL,.INXDST,.INDEST,INEXPAND,.INPOP,INDA,1,.INOUT)
End DoDot:2
IF 'INPOP!INOUT
QUIT
+29 IF INSND>INIP("STRY")
DO DISPLAY^INTSUT1("Send retries ("_$GET(INIP("STRY"))_") exceeded.")
+30 ;set message to complete
+31 DO ULOG^INHU(INEXTUIF,"C")
End DoDot:1
IF OUT!'INPOP
QUIT
+32 ;save criteria tests if they were updated in the pre or post
+33 IF INUPDAT
Begin DoDot:1
+34 NEW INOPT
+35 SET INOPT("TYPE")="TEST"
SET INOPT("NONINTER")=1
+36 SET X=$$SAVE^INHUTC1(.INOPT,INDA,"U")
End DoDot:1
+37 QUIT
