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

INHUVUT2.m

Go to the documentation of this file. 
  1. INHUVUT2 ; CHEM ; 20 May 99 17:11; Generic TCP/IP socket utilities
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  Q
  1. WAIT(INBPN,HNG,STAT,STOP)       ;Hang function which periodically checks ^INRHB
  1.  ;INPUT:
  1.  ; INBPN=backgound process
  1.  ; HNG=requested hang time
  1.  ; STAT (OPT) = Status message display in second piece of ^INHRB("RUN")
  1.  ;              Default status is "Idle"
  1.  ; STOP = PBR variable will return 0 if time expires
  1.  ;                                 1 if signalled to quit
  1.  ;This function will quit after the requested hang time, or if
  1.  ;the background process is signalled to quit, whichever comes first.
  1.  N BEGIN,DAY,TIME,END,OUT,INHNGCNT
  1.  S BEGIN=$H,DAY=$P(BEGIN,","),TIME=$P(BEGIN,",",2),END=TIME+HNG,OUT=0,INHNGCNT=HNG
  1.  ;If end time falls into tomorrow
  1.  I END'<86400 S DAY=DAY+(END\86400),END=END#86400
  1.  F  D  Q:OUT
  1.  .;Check background process status - lock to flush local bfr
  1.  .L +^INRHB("RUN",INBPN):0
  1.  .I '$D(^INRHB("RUN",INBPN)) L -^INRHB("RUN",INBPN) S OUT=2 Q
  1.  .S $P(^INRHB("RUN",INBPN),U,1,2)=$H_U_$S($D(STAT):STAT,1:"Idle")
  1.  .L -^INRHB("RUN",INBPN)
  1.  .H $S(INHNGCNT<5:INHNGCNT,1:5)  ; 5 sec interval before cking process status
  1.  .;Quit at day's end
  1.  .I $H>DAY S OUT=1 Q
  1.  .;Otherwise quit when time is later than end
  1.  .I $P($H,",",2)'<END S OUT=1 Q
  1.  .; Check if hang counter has expired - avoid 0/negative hang time
  1.  .S INHNGCNT=INHNGCNT-5 I INHNGCNT<1 S OUT=1 Q
  1.  S STOP=OUT=2
  1.  Q
  1. ADDR(INBPN,INIPADIE,INERR) ;Get next IP address from Background Proc file
  1.  ;INPUT:
  1.  ;  INBPN=background procese ien
  1.  ;  INIPADIE - last ien in IP Address multiple checked (pass by ref.)
  1.  ;OUTPUT
  1.  ;  INIPADIE - last ien checked in IP ADDRESS multiple
  1.  ;  function value - IP address or 0 if not found
  1.  ;
  1.  N %
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Getting next IP address",5)
  1.  I '$O(^INTHPC(INBPN,6,0)) S INERR="No ports designated" Q ""
  1.  S INIPADIE=$O(^INTHPC(INBPN,6,INIPADIE)) Q:'INIPADIE ""
  1.  S %=$P($G(^INTHPC(INBPN,6,INIPADIE,0)),U,1) Q:$L(%) %
  1.  Q 0
  1.  ;
  1. CPORT(INBPN,INIPADIE,INIPPOIE) ;Get next client port from Background Proc. file
  1.  ;INPUT:
  1.  ;  INBPN - background process
  1.  ;  INIPADIE - last ien in IP Address multiple checked
  1.  ;  INIPPOIE - last port tried at address (pass by ref.)
  1.  ;OUTPUT:
  1.  ;  INIPPOIE - last ient checked in IP PORT multiple
  1.  ;  function value = Port Number or null if not found
  1.  ;
  1.  N %
  1.  ;Check for next port
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Checking for next port",5)
  1.  S INIPPOIE=$O(^INTHPC(INBPN,6,INIPADIE,1,INIPPOIE)) Q:'INIPPOIE ""
  1.  S %=$P($G(^INTHPC(INBPN,6,INIPADIE,1,INIPPOIE,0)),U,1) Q:$L(%) %
  1.  Q ""
  1.  ;
  1. SPORT(INBPN,INIPADIE,INERR) ;Get next server port from Background Prc. file
  1.  ;INPUT:
  1.  ;  INBPN - background process
  1.  ;  INIPADIE - last ien in port multiple checked (Pass by ref)
  1.  ;  INERR - error variable (PBR)
  1.  ;OUTPUT:
  1.  ;  function value - Port Number
  1.  ;
  1.  N INIPORT
  1.  ;Check for next port
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Checking for next server port",5)
  1.  I '$O(^INTHPC(INBPN,5,0)) S INERR="No ports designated" Q ""
  1.  S INIPADIE=$O(^INTHPC(INBPN,5,INIPADIE)) Q:'INIPADIE ""
  1.  S INIPORT=$P(^INTHPC(INBPN,5,INIPADIE,0),U) Q:'INIPORT ""
  1.  Q INIPORT
  1.  ;
  1. OPEN(INBPN,INCHNL,INERR,INMEM) ;Open socket for destination
  1.  ;INPUT:
  1.  ; INBPN = background process file
  1.  ; INCHNL=channel opened (1st param)
  1.  ; INMEM=memory location (2nd)
  1.  ; INERR=error array
  1.  ;
  1.  ;OUTPUT:
  1.  ; 1 if successful, 0 if not
  1.  ;Initialize variables
  1.  N INIPADIE,INIPAD,INIPPOIE,CLISRV,DOMN,INIPORT,INDONE
  1.  S (INIPADIE,INIPAD,INDONE,INCHNL)=0
  1.  ;Determine if socket is to be opened as client (0=default) or as server
  1.  S CLISRV=+$P(^INTHPC(INBPN,0),U,8)
  1.  ;If server
  1.  I CLISRV D  Q $S(INCHNL:1,1:0)
  1.  .;Get port
  1.  .F  D  Q:INDONE!'$D(^INRHB("RUN",INBPN))
  1.  ..S INIPORT=$$SPORT(INBPN,.INIPADIE,.INERR) I 'INIPORT S INDONE=1 Q
  1.  ..;Attempt to create an internet socket
  1.  ..D:$G(INDEBUG) LOG^INHVCRA1("Attempt to create an internet socket for "_INBPN,3)
  1.  ..D OPEN^%INET(.INCHNL,.INMEM,"",INIPORT,1)
  1.  ..;Check for success
  1.  ..S:INCHNL INDONE=1 Q
  1.  .I 'INCHNL,$L(INCHNL),'$L($G(INERR)) S INERR=INCHNL
  1.  .D:$G(INDEBUG) LOG^INHVCRA1($S(INCHNL:"Socket created on port "_INIPORT,1:INERR),3)
  1.  ;If client
  1.  F  D  Q:INDONE!'$D(^INRHB("RUN",INBPN))
  1.  .  ;Get domain name/internet address until no more entries in multiple
  1.  .  S DOMN=$$ADDR(INBPN,.INIPADIE,.INERR) I 'INIPADIE S INDONE=1 Q
  1.  .  ;look through port multiple until port is opened or no more ports
  1.  .  S INIPPOIE=0 F  D  Q:INDONE!'$D(^INRHB("RUN",INBPN))
  1.  ..   ;Get next port for address - quit if none left
  1.  ..   S INIPORT=$$CPORT(INBPN,INIPADIE,.INIPPOIE) I 'INIPORT S INDONE=1 Q
  1.  ..   ;Attempt to create an internet socket
  1.  ..   D:$G(INDEBUG) LOG^INHVCRA1("Attempting to create a socket for "_DOMN_" on "_INIPORT,4)
  1.  ..   D OPEN^%INET(.INCHNL,.INMEM,.DOMN,INIPORT,1)
  1.  ..   ;Check for success
  1.  ..   S:INCHNL INDONE=1
  1.  I 'INCHNL,$L(INCHNL),'$L($G(INERR)) S INERR=INCHNL
  1.  D:$G(INDEBUG) LOG^INHVCRA1($S(INCHNL:"Socket created for "_DOMN_" on "_INIPORT,1:INERR),3)
  1.  Q $S(INCHNL:1,1:0)