Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHVTAPU

INHVTAPU.m

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