INTSREC ;JPD ; 13 May 98 12:09; Generic receiver, enhanced functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;This is an interactive transmitter/receiver routine supporting
;enhanced functionality.
;It receives a message, sends an ack, receives a message, etc.
;The process can function as either a server or a client, depending
;on the parameters. See notes below.
;
;This runs similar to INHVTAPR
Q
EN(INEXPAND,INDA,DIE) ;
;Input:
; INEXPAND - 0 - don't expand, 1 - expand
; INDA - ien of 4001.1 file
; DIE - 4001.1
N INBPN,INIP,CLISRV,INXDST,INDEST,INPOP,INDEBUG,J,INTT,MS
;Background process
S INBPN=+$$VAL^DWRA(4001.1,20,2,DIE,INDA)
;Initialize variables
D INIT1^INTSUT(INDA,.INBPN,.INIP,.CLISRV,.INXDST,.INDEST,.INPOP)
Q:'INPOP
I INIP("PORT")="" D DISPLAY^INTSUT1("No port Designated") Q
;open socket
D OPEN^INTSUT(CLISRV,.INIP,.INMEM,.INCHNL,.INPOP)
I INPOP,$L(INIP("INIT")) D
.;If opening as a Client Send Init String
.I 'CLISRV D CLINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
.;If opening as server
.I CLISRV D SRVINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
;receiver data
I INPOP D RECEIVE(.INIP,.INCHNL,.INXDST,.INDEST,INEXPAND,.INPOP,INDA)
;close socket
D EXIT^INTSUT(.INCHNL,INBPN,.INIP,CLISRV)
Q
RECEIVE(INIP,INCHNL,INXDST,INDEST,INEXPAND,INPOP,INDA,INRONLY,INOUT) ;
;Input:
; INIP - Parameters
; INCHNL - port channel
; INXDST - Destination Determination xeq
; INDEST - destinations
; INEXPAND - 0 - don't expand, 1 - expand
; INPOP - 0 stop 1 continue
; INDA - ien of Criteria
; INRONLY - 1 Receive only and send no ack, 0 receive then send ack
;Output:
; (opt) INOUT - out of loop
;
N INERR,ER,INMEM,ING,INDATA,INLP,RUN,X,Y,Z,ACKUIF,INUPDAT,INRCVE
S INRONLY=+$G(INRONLY),INOUT=$G(INOUT),(INUPDAT,INRCVE)=0
F X=1:1 S Y=$T(DEST+X) Q:Y'[";;" S Z=$TR($P(Y,";;")," ",""),INDEST(Z)=$P(Y,";;",2)
F INLP=1:1:INIP("RTRY") D Q:'INPOP!INOUT D DSPHNG Q:'INPOP
.I 'INRONLY,$G(INIP("PRE"))'="" D PRE^INTSUT2(INDA,INIP("PRE"),"",.INARY) Q:'$$POSTPRE^INTSUT2(INDA,.INARY,.INEXTUIF,.INLASTN,.INPOP,.INUPDAT)
.S ING="INDATA" K @ING,INERR
.S ER=$$RECEIVE^INHUVUT(.ING,.INCHNL,.INIP,.INERR,.INMEM)
.K INMS,MS
.I ER,$$ERROR^INTSUT(ER,.INERR,.INRCVE,.INPOP) Q
.Q:'INPOP
.;evaluate data
.D EVAL^INTSUT(.INIP,.ING,.INDEST,.ACKUIF,.INERR,.INXDST,ER,.INMSG,INRONLY) Q:'INPOP
.D DISPLAY^INTSUT1("Received Successfully "_$P($G(^INTHU(+$G(INMSG),0)),U),0,+$G(INMSG))
.;if we saved incoming message/UIF ien exists
.I $G(INMSG)>0 D
..;mark the message complete
..D ULOG^INHU(INMSG,"C")
..;expand message
..I 'INEXPAND D EXPNDIS^INTSUT1(INMSG)
.;receive only
.I INRONLY S INOUT=1
.;if not receive only evaluate and send ack
.I 'INRONLY D
..I $G(INIP("POST"))'="" D POST^INTSUT2(INDA,.ACKUIF,.INARY)
..Q:'$$POSTPRE^INTSUT2(INDA,.INARY,.ACKUIF,.INLASTN,.INPOP,.INUPDAT)
..D SEND(ACKUIF,INCHNL,.INIP,.INLOOP,INEXPAND)
..S INLP=1
;not recieve only and updated tests in prepost
I 'INRONLY,INUPDAT D
.N INOPT
.S INOPT("TYPE")="TEST",INOPT("NONINTER")=1
.D SAVE^INHUTC1(.INOPT,INDA,"U")
Q
DSPHNG ;hang then display
D DISPLAY^INTSUT1("Waiting to receive. Hanging "_INIP("RHNG")_" seconds")
H INIP("RHNG")
Q
SEND(ACKUIF,INCHNL,INIP,INLOOP,INEXPAND) ;Send outgoing ack.
; Input:
; ACKUIF - Universal Interface file ien for ack
; INCHNL - tcp/ip channel
; INIP - Parameters
; INLOOP - Receive retry count
; INEXPAND - 0 expand 1 don't expand
I 'ACKUIF D DISPLAY^INTSUT1("ACK not sent")
I ACKUIF D
.D DISPLAY^INTSUT1("Transmitting commit acknowledgement")
.I 'INEXPAND D EXPNDIS^INTSUT1(ACKUIF)
.S ER=$$SEND^INHUVUT(.ACKUIF,INCHNL,.INIP)
.I 'ER D DISPLAY^INTSUT1("Ack sent - Successful transmission")
.S INLOOP=0
Q
RECSTR(INV,INCHNL,INIP) ;
; Input:
; INV - gets set in PARSE^INHUVUT1
; INV(1) if line terminated by $c(13), or is first line of many in seg
; INV(1,1), INV(1,2)... for overflow nodes until terminated
; INCHNL - tcp/ip channel
; INIP - Parameters
N APDONE,APREC,AP,NULLREAD,NORESP,INSMIN
S (APDONE,APREC,AP)="",(NULLREAD,NORESP)=0,INREC="REC"
S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
F D Q:APDONE!NORESP
.D RECV^%INET(.APREC,.INCHNL,INIP("RTO"),1)
.I $G(APREC(0))["Remote end disconnect" D Q
..D DISPLAY^INTSUT1(APREC(0))
..S INPOP=0,APDONE=1
.I APREC=""!(APREC[$C(28)) S APDONE=1
.S APREC=$TR(APREC,$C(11))
.I '$L(APREC) D Q
..S NULLREAD=NULLREAD+1 S:NULLREAD>INIP("RTRY") NORESP=1
.I $S<INSMIN,INREC'["^" D
..K ^UTILITY("INREC",$J)
..M ^UTILITY("INREC",$J)=@INREC K @INREC S INREC="^UTILITY(""INREC"","_$J_")"
.S AP=AP+1,@INREC@(AP)=APREC
Q:'$D(APREC)
D PARSE^INHUVUT1
K @INREC
Q
DEST ; get valid destinations
ORMO01 ;;TEST INTERACTIVE
;
INTSREC ;JPD ; 13 May 98 12:09; Generic receiver, enhanced functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;This is an interactive transmitter/receiver routine supporting
+5 ;enhanced functionality.
+6 ;It receives a message, sends an ack, receives a message, etc.
+7 ;The process can function as either a server or a client, depending
+8 ;on the parameters. See notes below.
+9 ;
+10 ;This runs similar to INHVTAPR
+11 QUIT
EN(INEXPAND,INDA,DIE) ;
+1 ;Input:
+2 ; INEXPAND - 0 - don't expand, 1 - expand
+3 ; INDA - ien of 4001.1 file
+4 ; DIE - 4001.1
+5 NEW INBPN,INIP,CLISRV,INXDST,INDEST,INPOP,INDEBUG,J,INTT,MS
+6 ;Background process
+7 SET INBPN=+$$VAL^DWRA(4001.1,20,2,DIE,INDA)
+8 ;Initialize variables
+9 DO INIT1^INTSUT(INDA,.INBPN,.INIP,.CLISRV,.INXDST,.INDEST,.INPOP)
+10 IF 'INPOP
QUIT
+11 IF INIP("PORT")=""
DO DISPLAY^INTSUT1("No port Designated")
QUIT
+12 ;open socket
+13 DO OPEN^INTSUT(CLISRV,.INIP,.INMEM,.INCHNL,.INPOP)
+14 IF INPOP
IF $LENGTH(INIP("INIT"))
Begin DoDot:1
+15 ;If opening as a Client Send Init String
+16 IF 'CLISRV
DO CLINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
+17 ;If opening as server
+18 IF CLISRV
DO SRVINIT^INTSUT(.INIP,.INCHNL,.INMEM,.INPOP)
End DoDot:1
+19 ;receiver data
+20 IF INPOP
DO RECEIVE(.INIP,.INCHNL,.INXDST,.INDEST,INEXPAND,.INPOP,INDA)
+21 ;close socket
+22 DO EXIT^INTSUT(.INCHNL,INBPN,.INIP,CLISRV)
+23 QUIT
RECEIVE(INIP,INCHNL,INXDST,INDEST,INEXPAND,INPOP,INDA,INRONLY,INOUT) ;
+1 ;Input:
+2 ; INIP - Parameters
+3 ; INCHNL - port channel
+4 ; INXDST - Destination Determination xeq
+5 ; INDEST - destinations
+6 ; INEXPAND - 0 - don't expand, 1 - expand
+7 ; INPOP - 0 stop 1 continue
+8 ; INDA - ien of Criteria
+9 ; INRONLY - 1 Receive only and send no ack, 0 receive then send ack
+10 ;Output:
+11 ; (opt) INOUT - out of loop
+12 ;
+13 NEW INERR,ER,INMEM,ING,INDATA,INLP,RUN,X,Y,Z,ACKUIF,INUPDAT,INRCVE
+14 SET INRONLY=+$GET(INRONLY)
SET INOUT=$GET(INOUT)
SET (INUPDAT,INRCVE)=0
+15 FOR X=1:1
SET Y=$TEXT(DEST+X)
IF Y'[";;"
QUIT
SET Z=$TRANSLATE($PIECE(Y,";;")," ","")
SET INDEST(Z)=$PIECE(Y,";;",2)
+16 FOR INLP=1:1:INIP("RTRY")
Begin DoDot:1
+17 IF 'INRONLY
IF $GET(INIP("PRE"))'=""
DO PRE^INTSUT2(INDA,INIP("PRE"),"",.INARY)
IF '$$POSTPRE^INTSUT2(INDA,.INARY,.INEXTUIF,.INLASTN,.INPOP,.INUPDAT)
QUIT
+18 SET ING="INDATA"
KILL @ING,INERR
+19 SET ER=$$RECEIVE^INHUVUT(.ING,.INCHNL,.INIP,.INERR,.INMEM)
+20 KILL INMS,MS
+21 IF ER
IF $$ERROR^INTSUT(ER,.INERR,.INRCVE,.INPOP)
QUIT
+22 IF 'INPOP
QUIT
+23 ;evaluate data
+24 DO EVAL^INTSUT(.INIP,.ING,.INDEST,.ACKUIF,.INERR,.INXDST,ER,.INMSG,INRONLY)
IF 'INPOP
QUIT
+25 DO DISPLAY^INTSUT1("Received Successfully "_$PIECE($GET(^INTHU(+$GET(INMSG),0)),U),0,+$GET(INMSG))
+26 ;if we saved incoming message/UIF ien exists
+27 IF $GET(INMSG)>0
Begin DoDot:2
+28 ;mark the message complete
+29 DO ULOG^INHU(INMSG,"C")
+30 ;expand message
+31 IF 'INEXPAND
DO EXPNDIS^INTSUT1(INMSG)
End DoDot:2
+32 ;receive only
+33 IF INRONLY
SET INOUT=1
+34 ;if not receive only evaluate and send ack
+35 IF 'INRONLY
Begin DoDot:2
+36 IF $GET(INIP("POST"))'=""
DO POST^INTSUT2(INDA,.ACKUIF,.INARY)
+37 IF '$$POSTPRE^INTSUT2(INDA,.INARY,.ACKUIF,.INLASTN,.INPOP,.INUPDAT)
QUIT
+38 DO SEND(ACKUIF,INCHNL,.INIP,.INLOOP,INEXPAND)
+39 SET INLP=1
End DoDot:2
End DoDot:1
IF 'INPOP!INOUT
QUIT
DO DSPHNG
IF 'INPOP
QUIT
+40 ;not recieve only and updated tests in prepost
+41 IF 'INRONLY
IF INUPDAT
Begin DoDot:1
+42 NEW INOPT
+43 SET INOPT("TYPE")="TEST"
SET INOPT("NONINTER")=1
+44 DO SAVE^INHUTC1(.INOPT,INDA,"U")
End DoDot:1
+45 QUIT
DSPHNG ;hang then display
+1 DO DISPLAY^INTSUT1("Waiting to receive. Hanging "_INIP("RHNG")_" seconds")
+2 HANG INIP("RHNG")
+3 QUIT
SEND(ACKUIF,INCHNL,INIP,INLOOP,INEXPAND) ;Send outgoing ack.
+1 ; Input:
+2 ; ACKUIF - Universal Interface file ien for ack
+3 ; INCHNL - tcp/ip channel
+4 ; INIP - Parameters
+5 ; INLOOP - Receive retry count
+6 ; INEXPAND - 0 expand 1 don't expand
+7 IF 'ACKUIF
DO DISPLAY^INTSUT1("ACK not sent")
+8 IF ACKUIF
Begin DoDot:1
+9 DO DISPLAY^INTSUT1("Transmitting commit acknowledgement")
+10 IF 'INEXPAND
DO EXPNDIS^INTSUT1(ACKUIF)
+11 SET ER=$$SEND^INHUVUT(.ACKUIF,INCHNL,.INIP)
+12 IF 'ER
DO DISPLAY^INTSUT1("Ack sent - Successful transmission")
+13 SET INLOOP=0
End DoDot:1
+14 QUIT
RECSTR(INV,INCHNL,INIP) ;
+1 ; Input:
+2 ; INV - gets set in PARSE^INHUVUT1
+3 ; INV(1) if line terminated by $c(13), or is first line of many in seg
+4 ; INV(1,1), INV(1,2)... for overflow nodes until terminated
+5 ; INCHNL - tcp/ip channel
+6 ; INIP - Parameters
+7 NEW APDONE,APREC,AP,NULLREAD,NORESP,INSMIN
+8 SET (APDONE,APREC,AP)=""
SET (NULLREAD,NORESP)=0
SET INREC="REC"
+9 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+10 FOR
Begin DoDot:1
+11 DO RECV^%INET(.APREC,.INCHNL,INIP("RTO"),1)
+12 IF $GET(APREC(0))["Remote end disconnect"
Begin DoDot:2
+13 DO DISPLAY^INTSUT1(APREC(0))
+14 SET INPOP=0
SET APDONE=1
End DoDot:2
QUIT
+15 IF APREC=""!(APREC[$CHAR(28))
SET APDONE=1
+16 SET APREC=$TRANSLATE(APREC,$CHAR(11))
+17 IF '$LENGTH(APREC)
Begin DoDot:2
+18 SET NULLREAD=NULLREAD+1
IF NULLREAD>INIP("RTRY")
SET NORESP=1
End DoDot:2
QUIT
+19 IF $STORAGE<INSMIN
IF INREC'["^"
Begin DoDot:2
+20 KILL ^UTILITY("INREC",$JOB)
+21 MERGE ^UTILITY("INREC",$JOB)=@INREC
KILL @INREC
SET INREC="^UTILITY(""INREC"","_$JOB_")"
End DoDot:2
+22 SET AP=AP+1
SET @INREC@(AP)=APREC
End DoDot:1
IF APDONE!NORESP
QUIT
+23 IF '$DATA(APREC)
QUIT
+24 DO PARSE^INHUVUT1
+25 KILL @INREC
+26 QUIT
DEST ; get valid destinations
ORMO01 ;;TEST INTERACTIVE
+1 ;
