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