INHVTAPU ;DGH ; 06 Oct 1999 19:32 ; "Generic" socket transmitter utils
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;This contains the overflow from INHVTAPT, the socket transmitter.
;As of 1/26/96, the initialization logic is moved from INHVTAPT to
;INHVTAPU. Ultimately, we may want to call this to from both
;INHVTAPT and INHVTAPR.
;Also, some logic from the ERR and EN tags has been moved.
;
OPEN(INBPN,CLISRV,INIP,INDEBUG,INCHNL,INMEM) ;Try OTRY times to open connection.
; Hang OHNG seconds between tries.
;
; Returns: 0 - failed open or process signalled to quit
; 1 - good open and process NOT signalled to quit
N INLOOP,INOPENOK,INSTOP
S (INOPENOK,INSTOP)=0,INBPNM=$P($G(^INTHPC(INBPN,0)),U)
D:$G(INDEBUG) LOG^INHVCRA1("Attempting to open "_$S(CLISRV:"server",1:"client")_" process "_INBPNM,7)
F INLOOP=1:1:INIP("OTRY") D Q:INOPENOK!INSTOP
.S MSG="Attempt "_INLOOP_" to open socket"
.D:$G(INDEBUG) LOG^INHVCRA1(MSG_" for "_INBPNM,7)
.S INSTOP='$$INRHB^INHUVUT1(INBPN,MSG,2) Q:INSTOP
.S INOPENOK=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM) Q:INOPENOK
.D:$G(INDEBUG) LOG^INHVCRA1("Waiting "_INIP("OHNG")_" seconds for open retry on "_INBPNM,7)
.D WAIT^INHUVUT2(INBPN,INIP("OHNG"),MSG,.INSTOP)
I INSTOP D:$G(INDEBUG) LOG^INHVCRA1("Run node not present for "_INBPNM,7) Q 0
I 'INOPENOK D Q 0
.N MSG S MSG="Unable to open socket for background process "_INBPNM_" "_$G(INERR)
.D:$G(INDEBUG) LOG^INHVCRA1(MSG,7)
.D ENR^INHE(INBPN,MSG)
D:$G(INDEBUG) LOG^INHVCRA1("Socket opened for "_INBPNM,7)
Q $$INRHB^INHUVUT1(INBPN,"Socket opened")
;
INIT() ;initialization/handshaking between two systems
;INPUT -- all values must be initialized in calling routine
;--INBPN background process number
;--INBPNM background process name
;--INDEBUG debug flag
;--INIP array of socket parameters
;--CLISRV client/server flag
;--INCHNL channel opened by calling routine
;OUTPUT
;--Value of 0 = unsuccessful initialization
;--Value of 1 = successful initialization
;
;--If open as a client, send initialization string
S OK=1 D:'CLISRV G:'OK EXIT
.D:$L(INIP("INIT"))
..D SENDSTR^INHUVUT(INIP("INIT"),INCHNL)
..D:$G(INDEBUG) LOG^INHVCRA1("Opened as client; sent initilization string",7)
.;Receive initialization response, if specified
.Q:'$L(INIP("ACK"))
.D:$G(INDEBUG) LOG^INHVCRA1("Receive initialization response.",7)
.S ING="INDATA" K @ING
.F I=1:1:INIP("RTRY") D:$G(INDEBUG) S ER=$$RCVSTR^INHUVUT1(.ING,INCHNL,.INIP,.INERR,.INMEM) Q:$D(@ING) H:I<INIP("RTRY") INIP("RHNG")
..D LOG^INHVCRA1("Receiving initialization string on "_INCHNL,6)
.I '$D(@ING) D S OK=0 Q
..N MSG S MSG="No response received to intialization string "
..D ENR^INHE(INBPN,MSG_INBPN) D:$G(INDEBUG) LOG^INHVCRA1(MSG_INBPNM,6)
.I INIP("ACK")'[@ING@(1) D S OK=0 Q
..N MSG S MSG="Incorrect response "_@ING@(1)_" received to intialization string "
..D ENR^INHE(INBPN,MSG_INBPN) D:$G(INDEBUG) LOG^INHVCRA1(MSG_INBPNM,6)
;
;--If opening as server, receive initialization string
S OK=1 D:CLISRV G:'OK EXIT
.;Receive initialization
.Q:'$L(INIP("INIT"))
.D:$G(INDEBUG) LOG^INHVCRA1("Opening as server, receive initialization string",7)
.S ING="INDATA" K @ING
.F I=1:1:INIP("RTRY") S ER=$$RCVSTR^INHUVUT1(.ING,INCHNL,.INIP,.INERR,.INMEM) Q:$D(@ING) H:I<INIP("RTRY") INIP("RHNG")
.I ER!'$D(@ING) D S OK=0 Q
..D ENR^INHE(INBPN,"No initialization string received"_INBPN)
..D:$G(INDEBUG) LOG^INHVCRA1("No initialization string received"_INBPNM,6)
.I INIP("INIT")'[@ING@(1) D S OK=0 Q
..N MSG S MSG="Incorrect initialization string "_@ING@(1)_" received "
..D ENR^INHE(INBPN,MSG_INBPN) D:$G(INDEBUG) LOG^INHVCRA1(MSG_INBPNM,6)
.;Send initialization response if specified
.I $L(INIP("ACK")) D SENDSTR^INHUVUT(INIP("ACK"),INCHNL) D:$G(INDEBUG)
..D LOG^INHVCRA1("Sent initialization response",7)
EXIT Q OK
;
PARM ;Get parameters for INHVTAPT, INHVTAPR
D DEBUG^INHVCRA1()
S INBPNM=$P($G(^INTHPC(INBPN,0)),U)
S SYSTEM="SC",INDSTR=+$P(^INTHPC(INBPN,0),U,7),INXDST=$G(^(8)) I 'INDSTR D S INSTOP=1 Q
.D ENR^INHE(INBPN,"No destination designated for background process "_INBPNM)
.D:$G(INDEBUG) LOG^INHVCRA1("No destination designated for background process "_INBPNM,9)
I '$D(^INRHB("RUN",INBPN)) D:$G(INDEBUG) LOG^INHVCRA1("Run node not present for "_INBPNM,9) S INSTOP=1 Q
; intialize variables from background process file
D:$G(INDEBUG) LOG^INHVCRA1("Initializing variables for background process file "_INBPNM,9)
D INIT^INHUVUT(INBPN,.INIP)
I $G(INIP("CRYPT")),'$L(INIP("DESKEY")) D S INSTOP=1 Q
.D ENR^INHE(INBPN,"Encrypt is set but no DES Key specified "_INBPNM)
.D:$G(INDEBUG) LOG^INHVCRA1("Encrypt is set but no DES Key specified "_INBPNM,5)
;Start GIS Background process audit if flag is set in Site Parms File
D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INBPNM)
;Determine if process will be client (default, with 0) or server (1)
S CLISRV=+$P(^INTHPC(INBPN,0),U,8),INTRNSNT=+$P(^(0),U,9)
;If encryption is on, start C process
I $G(INIP("CRYPT")) S RC=$$CRYPON^INCRYPT(INIP("DESKEY"))
Q
;
CLOSE ;Close channel
D:+$G(INCHNL) CLOSE^%INET(+INCHNL)
D:$G(INDEBUG) LOG^INHVCRA1("Closing connection for "_INBPNM,6)
Q
;
EXIT1 ;Exit module called by INHVTAPT, INHVTAPR
D CLOSE
I $G(INIP("CRYPT")) S RC=$$CRYPOFF^INCRYPT()
K ^INRHB("RUN",INBPN)
D DEBUG^INHVCRA1(0)
;Stop background process audit
D:$D(XUAUDIT) AUDSTP^XUSAUD
Q
;
ERR ;Error module
D ENR^INHE(INBPN,"Fatal error encountered by TRANSCEIVER - "_$$GETERR^%ZTOS_" in background process "_INBPN)
D:$G(INDEBUG) LOG^INHVCRA1("Fatal error encountered by TRANSCEIVER - "_$$GETERR^%ZTOS_" in background process "_INBPNM,5)
X $G(^INTHOS(1,3))
D EXIT1
Q
;
CKDISCNT ;Check times of remote end disconnect
N MSG
S INDISCNT=INDISCNT+1
Q:INDISCNT'>INIP("DTRY")
S MSG="Disconnect retries exceeded for background process "_INBPNM
D:$G(INDEBUG) LOG^INHVCRA1(MSG,7)
D ENR^INHE(INBPN,MSG)
S INSTOP=1
Q
INHVTAPU ;DGH ; 06 Oct 1999 19:32 ; "Generic" socket transmitter utils
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;This contains the overflow from INHVTAPT, the socket transmitter.
+5 ;As of 1/26/96, the initialization logic is moved from INHVTAPT to
+6 ;INHVTAPU. Ultimately, we may want to call this to from both
+7 ;INHVTAPT and INHVTAPR.
+8 ;Also, some logic from the ERR and EN tags has been moved.
+9 ;
OPEN(INBPN,CLISRV,INIP,INDEBUG,INCHNL,INMEM) ;Try OTRY times to open connection.
+1 ; Hang OHNG seconds between tries.
+2 ;
+3 ; Returns: 0 - failed open or process signalled to quit
+4 ; 1 - good open and process NOT signalled to quit
+5 NEW INLOOP,INOPENOK,INSTOP
+6 SET (INOPENOK,INSTOP)=0
SET INBPNM=$PIECE($GET(^INTHPC(INBPN,0)),U)
+7 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Attempting to open "_$SELECT(CLISRV:"server",1:"client")_" process "_INBPNM,7)
+8 FOR INLOOP=1:1:INIP("OTRY")
Begin DoDot:1
+9 SET MSG="Attempt "_INLOOP_" to open socket"
+10 IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG_" for "_INBPNM,7)
+11 SET INSTOP='$$INRHB^INHUVUT1(INBPN,MSG,2)
IF INSTOP
QUIT
+12 SET INOPENOK=$$OPEN^INHUVUT(INBPN,.INCHNL,.INERR,.INMEM)
IF INOPENOK
QUIT
+13 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Waiting "_INIP("OHNG")_" seconds for open retry on "_INBPNM,7)
+14 DO WAIT^INHUVUT2(INBPN,INIP("OHNG"),MSG,.INSTOP)
End DoDot:1
IF INOPENOK!INSTOP
QUIT
+15 IF INSTOP
IF $GET(INDEBUG)
DO LOG^INHVCRA1("Run node not present for "_INBPNM,7)
QUIT 0
+16 IF 'INOPENOK
Begin DoDot:1
+17 NEW MSG
SET MSG="Unable to open socket for background process "_INBPNM_" "_$GET(INERR)
+18 IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG,7)
+19 DO ENR^INHE(INBPN,MSG)
End DoDot:1
QUIT 0
+20 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Socket opened for "_INBPNM,7)
+21 QUIT $$INRHB^INHUVUT1(INBPN,"Socket opened")
+22 ;
INIT() ;initialization/handshaking between two systems
+1 ;INPUT -- all values must be initialized in calling routine
+2 ;--INBPN background process number
+3 ;--INBPNM background process name
+4 ;--INDEBUG debug flag
+5 ;--INIP array of socket parameters
+6 ;--CLISRV client/server flag
+7 ;--INCHNL channel opened by calling routine
+8 ;OUTPUT
+9 ;--Value of 0 = unsuccessful initialization
+10 ;--Value of 1 = successful initialization
+11 ;
+12 ;--If open as a client, send initialization string
+13 SET OK=1
IF 'CLISRV
Begin DoDot:1
+14 IF $LENGTH(INIP("INIT"))
Begin DoDot:2
+15 DO SENDSTR^INHUVUT(INIP("INIT"),INCHNL)
+16 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Opened as client; sent initilization string",7)
End DoDot:2
+17 ;Receive initialization response, if specified
+18 IF '$LENGTH(INIP("ACK"))
QUIT
+19 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Receive initialization response.",7)
+20 SET ING="INDATA"
KILL @ING
+21 FOR I=1:1:INIP("RTRY")
IF $GET(INDEBUG)
Begin DoDot:2
+22 DO LOG^INHVCRA1("Receiving initialization string on "_INCHNL,6)
End DoDot:2
SET ER=$$RCVSTR^INHUVUT1(.ING,INCHNL,.INIP,.INERR,.INMEM)
IF $DATA(@ING)
QUIT
IF I<INIP("RTRY")
HANG INIP("RHNG")
+23 IF '$DATA(@ING)
Begin DoDot:2
+24 NEW MSG
SET MSG="No response received to intialization string "
+25 DO ENR^INHE(INBPN,MSG_INBPN)
IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG_INBPNM,6)
End DoDot:2
SET OK=0
QUIT
+26 IF INIP("ACK")'[@ING@(1)
Begin DoDot:2
+27 NEW MSG
SET MSG="Incorrect response "_@ING@(1)_" received to intialization string "
+28 DO ENR^INHE(INBPN,MSG_INBPN)
IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG_INBPNM,6)
End DoDot:2
SET OK=0
QUIT
End DoDot:1
IF 'OK
GOTO EXIT
+29 ;
+30 ;--If opening as server, receive initialization string
+31 SET OK=1
IF CLISRV
Begin DoDot:1
+32 ;Receive initialization
+33 IF '$LENGTH(INIP("INIT"))
QUIT
+34 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Opening as server, receive initialization string",7)
+35 SET ING="INDATA"
KILL @ING
+36 FOR I=1:1:INIP("RTRY")
SET ER=$$RCVSTR^INHUVUT1(.ING,INCHNL,.INIP,.INERR,.INMEM)
IF $DATA(@ING)
QUIT
IF I<INIP("RTRY")
HANG INIP("RHNG")
+37 IF ER!'$DATA(@ING)
Begin DoDot:2
+38 DO ENR^INHE(INBPN,"No initialization string received"_INBPN)
+39 IF $GET(INDEBUG)
DO LOG^INHVCRA1("No initialization string received"_INBPNM,6)
End DoDot:2
SET OK=0
QUIT
+40 IF INIP("INIT")'[@ING@(1)
Begin DoDot:2
+41 NEW MSG
SET MSG="Incorrect initialization string "_@ING@(1)_" received "
+42 DO ENR^INHE(INBPN,MSG_INBPN)
IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG_INBPNM,6)
End DoDot:2
SET OK=0
QUIT
+43 ;Send initialization response if specified
+44 IF $LENGTH(INIP("ACK"))
DO SENDSTR^INHUVUT(INIP("ACK"),INCHNL)
IF $GET(INDEBUG)
Begin DoDot:2
+45 DO LOG^INHVCRA1("Sent initialization response",7)
End DoDot:2
End DoDot:1
IF 'OK
GOTO EXIT
EXIT QUIT OK
+1 ;
PARM ;Get parameters for INHVTAPT, INHVTAPR
+1 DO DEBUG^INHVCRA1()
+2 SET INBPNM=$PIECE($GET(^INTHPC(INBPN,0)),U)
+3 SET SYSTEM="SC"
SET INDSTR=+$PIECE(^INTHPC(INBPN,0),U,7)
SET INXDST=$GET(^(8))
IF 'INDSTR
Begin DoDot:1
+4 DO ENR^INHE(INBPN,"No destination designated for background process "_INBPNM)
+5 IF $GET(INDEBUG)
DO LOG^INHVCRA1("No destination designated for background process "_INBPNM,9)
End DoDot:1
SET INSTOP=1
QUIT
+6 IF '$DATA(^INRHB("RUN",INBPN))
IF $GET(INDEBUG)
DO LOG^INHVCRA1("Run node not present for "_INBPNM,9)
SET INSTOP=1
QUIT
+7 ; intialize variables from background process file
+8 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Initializing variables for background process file "_INBPNM,9)
+9 DO INIT^INHUVUT(INBPN,.INIP)
+10 IF $GET(INIP("CRYPT"))
IF '$LENGTH(INIP("DESKEY"))
Begin DoDot:1
+11 DO ENR^INHE(INBPN,"Encrypt is set but no DES Key specified "_INBPNM)
+12 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Encrypt is set but no DES Key specified "_INBPNM,5)
End DoDot:1
SET INSTOP=1
QUIT
+13 ;Start GIS Background process audit if flag is set in Site Parms File
+14 DO AUDCHK^XUSAUD
IF $DATA(XUAUDIT)
DO ITIME^XUSAUD(INBPNM)
+15 ;Determine if process will be client (default, with 0) or server (1)
+16 SET CLISRV=+$PIECE(^INTHPC(INBPN,0),U,8)
SET INTRNSNT=+$PIECE(^(0),U,9)
+17 ;If encryption is on, start C process
+18 IF $GET(INIP("CRYPT"))
SET RC=$$CRYPON^INCRYPT(INIP("DESKEY"))
+19 QUIT
+20 ;
CLOSE ;Close channel
+1 IF +$GET(INCHNL)
DO CLOSE^%INET(+INCHNL)
+2 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Closing connection for "_INBPNM,6)
+3 QUIT
+4 ;
EXIT1 ;Exit module called by INHVTAPT, INHVTAPR
+1 DO CLOSE
+2 IF $GET(INIP("CRYPT"))
SET RC=$$CRYPOFF^INCRYPT()
+3 KILL ^INRHB("RUN",INBPN)
+4 DO DEBUG^INHVCRA1(0)
+5 ;Stop background process audit
+6 IF $DATA(XUAUDIT)
DO AUDSTP^XUSAUD
+7 QUIT
+8 ;
ERR ;Error module
+1 DO ENR^INHE(INBPN,"Fatal error encountered by TRANSCEIVER - "_$$GETERR^%ZTOS_" in background process "_INBPN)
+2 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Fatal error encountered by TRANSCEIVER - "_$$GETERR^%ZTOS_" in background process "_INBPNM,5)
+3 XECUTE $GET(^INTHOS(1,3))
+4 DO EXIT1
+5 QUIT
+6 ;
CKDISCNT ;Check times of remote end disconnect
+1 NEW MSG
+2 SET INDISCNT=INDISCNT+1
+3 IF INDISCNT'>INIP("DTRY")
QUIT
+4 SET MSG="Disconnect retries exceeded for background process "_INBPNM
+5 IF $GET(INDEBUG)
DO LOG^INHVCRA1(MSG,7)
+6 DO ENR^INHE(INBPN,MSG)
+7 SET INSTOP=1
+8 QUIT
