INHB ; cmi/flag/maw - JSH,KAC 18 Apr 97 11:03 Background Process Control ; [ 05/14/2002 1:31 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
;COPYRIGHT 1991-2000 SAIC
;
STARTUP ;Full interface startup
D START
Q
;
STOPALL ;Stop all processes
N INDA,X
I '$D(IOF) S (%ZIS,IOP)="" D ^%ZIS
W @IOF,!
S X=$$YN^UTSRD("Do you really want to shut down all Interface processes? ;1","") Q:'X
; Signal all background processes to quit
F X=1:1:100 K ^INRHB("RUN")
; If process opened as server & is active, shut down "hung" active servers
S INDA=0
F S INDA=$O(^INTHPC("ACT",1,INDA)) Q:'INDA I +$P(^INTHPC(INDA,0),U,8),$$VER(INDA) S X=$$SRVRHNG(INDA)
W !!,"All processes have been signalled to quit."
Q
;
START ;Start all background processes
N AVJ,DA,I,VER,CT S AVJ=^%ZOSF("AVJ"),U="^"
S (CT,DA)=0
F S DA=$O(^INTHPC("ACT",1,DA)) Q:'DA D
.S DA(0)=$P(^INTHPC(DA,0),U) X AVJ W:Y<1&'$D(ZTSK) !,DA(0)_"NOT Started - not enough available jobs." I Y>0 S VER=1 D I VER S X=$$A(DA) W:'$D(ZTSK) !,DA(0)_$S(X:"",1:" NOT")_" Started." S:X CT=CT+1
..Q:$D(ZTSK) I $$VER(DA) W !,*7 S X=$$YN^UTSRD("NOTE: "_DA(0)_" appears to be running - continue? ;0","") S:'X VER=0
Q:$D(ZTSK)
W !,CT_" processes were started."
Q
;
A(DA) ;Startup a process
;DA = entry # in file 4004
;Returns 1 if started, 0 otherwise
;
N INERR
S INERR=$$OKTR(DA) I 'INERR W:'$D(ZTSK) !,?10,*7,INERR Q 0
N JOB S JOB=$$REPLACE^UTIL(^INTHOS(1,1),"*","^INHB1("_DA_")")
K ^INRHB("RUN",DA) X JOB F I=1:1:15 L +^INRHB("RUN",DA):0,-^INRHB("RUN",DA) Q:$D(^INRHB("RUN",DA)) H 2 W:'$D(ZTSK) "."
H 1 Q ''$D(^INRHB("RUN",DA))
;
OKTR(X) ;See if OK to run process #X
;Returns 1 if OK, 0 otherwise
Q:'$G(^INRHSITE(1,"ACT")) "Interface system not active - NO ACTION TAKEN."
Q:'$P($G(^INTHPC(X,0)),"^",2) "Process not active - NO ACTION TAKEN."
Q:+$G(^INTHPC(X,7)) "Process cannot be started manually - NO ACTION TAKEN."
Q 1
;
START1 ;Restart individual processes
N DIC,INDA,X,Y
S DIC="^INTHPC(",DIC(0)="QAE",DIC("S")="I $P(^(0),U,2)",DIC("A")="Select PROCESS to Start: " D ^DIC Q:Y<0
S INDA=+Y I $$VER(INDA) W !,*7 S X=$$YN^UTSRD("This process appears to be running already - continue? ;0","") G:'X START1
X ^%ZOSF("AVJ") I Y<1 W !,*7,"No available partitions." Q
W !?5 S X=$$A(INDA)
W:X " Started" W:'X !,*7," PROCESS DID NOT START!"
G START1
;
VER(DA) ;Verify entry DA is running
;Return 1 if running, 0 if not running, -1 if running but signaled to quit
G:$G(^INTHOS(1,4))]"" VER1
L +^INRHB("RUN",DA):1 I L -^INRHB("RUN",DA) Q 0
Q:'$D(^INRHB("RUN",DA)) -1
Q 1
;
VER1 ;Come here when OS file has code to do the checking
N X S X=$P(^INTHPC(DA,0),"^",4) Q:'X 0
X "N DA "_^INTHOS(1,4) Q:'X 0
Q:'$D(^INRHB("RUN",DA)) -1
Q 1
;
VERIFY ;Verify if all active processes are running
D EN^INHOV Q
;
;Deactivated 2/23/95 by jmb
N I,OK,S,H S U="^"
S I=0,OK=1 F S I=$O(^INTHPC("ACT",1,I)) Q:'I S S=$$VER(I) W !?5,$P(^INTHPC(I,0),"^")," ",$S('S:"appears to be *NOT* running!",S=-1:"has been signaled to quit.",1:"appears to be running.") S H=$$LAST(I) W:H]"" !?10,"Last run update: "_H
W !,$$CR^INHU1
Q
;
LAST(I) ;Returns last run update date/time for process #I
N H S H=$G(^INRHB("RUN",I)) Q:H="" "" Q $$DATEFMT^UTDT(H,"DD MMM YY@HH:II:SS")
;
STOP ;Stop a process
N DIC,INDA,INRUN,INSRVR,X,Y
S DIC="^INTHPC(",DIC(0)="QAE",DIC("S")="I $P(^(0),U,2)",DIC("A")="Select PROCESS to Stop: " D ^DIC Q:Y<0
S INDA=+Y
S INRUN=$$VER(INDA)
S INSRVR=+$P(^INTHPC(INDA,0),U,8) ; opened as client=0 or server=1
I 'INRUN!((INRUN=-1)&('INSRVR)) W !,*7 S X=$$YN^UTSRD("This process does not appear to be running - continue? ;0","") Q:'X
F X=1:1:100 K ^INRHB("RUN",INDA)
S:$$VER(INDA)&INSRVR X=$$SRVRHNG(INDA) ; shut down "hung" active server
U 0 W !,"Process has been signaled to terminate."
Q
;
SRVRHNG(INBPN) ; $$function - If a receiver opens a TCP/IP socket, but no
; transmitter makes a connection, the receiver will hang on the
; OPEN^%INET command. As a result, signalling such a receiver
; background process to shutdown will fail since %INET retains
; control until a connection is received. The purpose of this
; routine is to supply the awaited connection, at which time the
; background process will receive control, detect the flag to
; shutdown and quit.
;
; Input:
; INBPN - BACKGROUND PROCESS CONTROL IEN for process to shut down
;
; Variables:
; INCHNL - TCP channel assigned to this server when connection is opened
; INMEM - memory variable used by %INET
; INPADIE - IEN of "well-known" IP port multiple for this server
; INPORT - "well-known" IP port(s) for this server background process
;
; Output:
; 0 = successful attempt to connect to potentially "hung" server
; 1 = attempt to connect to potentially "hung" server was NOT successful
;
N INCHNL,INMEM,INPADIE,INPORT
;
Q:'+$P(^INTHPC(INBPN,0),U,8) 1 ; quit if process opened as client
Q:'$D(^INTHPC(INBPN,5)) 1 ; quit if no port data for this server
K ^INRHB("RUN",INBPN) ; signal process to shutdown
;
; Find/connect to any port(s) associated with this background process
; on which a "hung" server may be listening
S INPADIE=0
F S INPADIE=$O(^INTHPC(INBPN,5,INPADIE)) Q:'INPADIE D
. S INPORT=$P(^INTHPC(INBPN,5,INPADIE,0),U) Q:'INPORT
.; Attempt to open as a client to this server on this port
. D OPEN^%INET(.INCHNL,.INMEM,"0.0.0.0",INPORT,1)
. ;D OPEN^%INET(.INCHNL,.INMEM,"0.0.0.0",INPORT,1,$G(INBPN)) ;maw cache
. D:INCHNL CLOSE^%INET(INCHNL)
. ;D:INCHNL CLOSE^%INET(INCHNL,$G(INBPN)) ;maw cache
Q 0
;
INHB ; cmi/flag/maw - JSH,KAC 18 Apr 97 11:03 Background Process Control ; [ 05/14/2002 1:31 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
STARTUP ;Full interface startup
+1 DO START
+2 QUIT
+3 ;
STOPALL ;Stop all processes
+1 NEW INDA,X
+2 IF '$DATA(IOF)
SET (%ZIS,IOP)=""
DO ^%ZIS
+3 WRITE @IOF,!
+4 SET X=$$YN^UTSRD("Do you really want to shut down all Interface processes? ;1","")
IF 'X
QUIT
+5 ; Signal all background processes to quit
+6 FOR X=1:1:100
KILL ^INRHB("RUN")
+7 ; If process opened as server & is active, shut down "hung" active servers
+8 SET INDA=0
+9 FOR
SET INDA=$ORDER(^INTHPC("ACT",1,INDA))
IF 'INDA
QUIT
IF +$PIECE(^INTHPC(INDA,0),U,8)
IF $$VER(INDA)
SET X=$$SRVRHNG(INDA)
+10 WRITE !!,"All processes have been signalled to quit."
+11 QUIT
+12 ;
START ;Start all background processes
+1 NEW AVJ,DA,I,VER,CT
SET AVJ=^%ZOSF("AVJ")
SET U="^"
+2 SET (CT,DA)=0
+3 FOR
SET DA=$ORDER(^INTHPC("ACT",1,DA))
IF 'DA
QUIT
Begin DoDot:1
+4 SET DA(0)=$PIECE(^INTHPC(DA,0),U)
XECUTE AVJ
IF Y<1&'$DATA(ZTSK)
WRITE !,DA(0)_"NOT Started - not enough available jobs."
IF Y>0
SET VER=1
Begin DoDot:2
+5 IF $DATA(ZTSK)
QUIT
IF $$VER(DA)
WRITE !,*7
SET X=$$YN^UTSRD("NOTE: "_DA(0)_" appears to be running - continue? ;0","")
IF 'X
SET VER=0
End DoDot:2
IF VER
SET X=$$A(DA)
IF '$DATA(ZTSK)
WRITE !,DA(0)_$SELECT(X:"",1:" NOT")_" Started."
IF X
SET CT=CT+1
End DoDot:1
+6 IF $DATA(ZTSK)
QUIT
+7 WRITE !,CT_" processes were started."
+8 QUIT
+9 ;
A(DA) ;Startup a process
+1 ;DA = entry # in file 4004
+2 ;Returns 1 if started, 0 otherwise
+3 ;
+4 NEW INERR
+5 SET INERR=$$OKTR(DA)
IF 'INERR
IF '$DATA(ZTSK)
WRITE !,?10,*7,INERR
QUIT 0
+6 NEW JOB
SET JOB=$$REPLACE^UTIL(^INTHOS(1,1),"*","^INHB1("_DA_")")
+7 KILL ^INRHB("RUN",DA)
XECUTE JOB
FOR I=1:1:15
LOCK +^INRHB("RUN",DA):0,-^INRHB("RUN",DA)
IF $DATA(^INRHB("RUN",DA))
QUIT
HANG 2
IF '$DATA(ZTSK)
WRITE "."
+8 HANG 1
QUIT ''$DATA(^INRHB("RUN",DA))
+9 ;
OKTR(X) ;See if OK to run process #X
+1 ;Returns 1 if OK, 0 otherwise
+2 IF '$GET(^INRHSITE(1,"ACT"))
QUIT "Interface system not active - NO ACTION TAKEN."
+3 IF '$PIECE($GET(^INTHPC(X,0)),"^",2)
QUIT "Process not active - NO ACTION TAKEN."
+4 IF +$GET(^INTHPC(X,7))
QUIT "Process cannot be started manually - NO ACTION TAKEN."
+5 QUIT 1
+6 ;
START1 ;Restart individual processes
+1 NEW DIC,INDA,X,Y
+2 SET DIC="^INTHPC("
SET DIC(0)="QAE"
SET DIC("S")="I $P(^(0),U,2)"
SET DIC("A")="Select PROCESS to Start: "
DO ^DIC
IF Y<0
QUIT
+3 SET INDA=+Y
IF $$VER(INDA)
WRITE !,*7
SET X=$$YN^UTSRD("This process appears to be running already - continue? ;0","")
IF 'X
GOTO START1
+4 XECUTE ^%ZOSF("AVJ")
IF Y<1
WRITE !,*7,"No available partitions."
QUIT
+5 WRITE !?5
SET X=$$A(INDA)
+6 IF X
WRITE " Started"
IF 'X
WRITE !,*7," PROCESS DID NOT START!"
+7 GOTO START1
+8 ;
VER(DA) ;Verify entry DA is running
+1 ;Return 1 if running, 0 if not running, -1 if running but signaled to quit
+2 IF $GET(^INTHOS(1,4))]""
GOTO VER1
+3 LOCK +^INRHB("RUN",DA):1
IF $TEST
LOCK -^INRHB("RUN",DA)
QUIT 0
+4 IF '$DATA(^INRHB("RUN",DA))
QUIT -1
+5 QUIT 1
+6 ;
VER1 ;Come here when OS file has code to do the checking
+1 NEW X
SET X=$PIECE(^INTHPC(DA,0),"^",4)
IF 'X
QUIT 0
+2 XECUTE "N DA "_^INTHOS(1,4)
IF 'X
QUIT 0
+3 IF '$DATA(^INRHB("RUN",DA))
QUIT -1
+4 QUIT 1
+5 ;
VERIFY ;Verify if all active processes are running
+1 DO EN^INHOV
QUIT
+2 ;
+3 ;Deactivated 2/23/95 by jmb
+4 NEW I,OK,S,H
SET U="^"
+5 SET I=0
SET OK=1
FOR
SET I=$ORDER(^INTHPC("ACT",1,I))
IF 'I
QUIT
SET S=$$VER(I)
WRITE !?5,$PIECE(^INTHPC(I,0),"^")," ",$SELECT('S:"appears to be *NOT* running!",S=-1:"has been signaled to quit.",1:"appears to be running.")
SET H=$$LAST(I)
IF H]""
WRITE !?10,"Last run update: "_H
+6 WRITE !,$$CR^INHU1
+7 QUIT
+8 ;
LAST(I) ;Returns last run update date/time for process #I
+1 NEW H
SET H=$GET(^INRHB("RUN",I))
IF H=""
QUIT ""
QUIT $$DATEFMT^UTDT(H,"DD MMM YY@HH:II:SS")
+2 ;
STOP ;Stop a process
+1 NEW DIC,INDA,INRUN,INSRVR,X,Y
+2 SET DIC="^INTHPC("
SET DIC(0)="QAE"
SET DIC("S")="I $P(^(0),U,2)"
SET DIC("A")="Select PROCESS to Stop: "
DO ^DIC
IF Y<0
QUIT
+3 SET INDA=+Y
+4 SET INRUN=$$VER(INDA)
+5 ; opened as client=0 or server=1
SET INSRVR=+$PIECE(^INTHPC(INDA,0),U,8)
+6 IF 'INRUN!((INRUN=-1)&('INSRVR))
WRITE !,*7
SET X=$$YN^UTSRD("This process does not appear to be running - continue? ;0","")
IF 'X
QUIT
+7 FOR X=1:1:100
KILL ^INRHB("RUN",INDA)
+8 ; shut down "hung" active server
IF $$VER(INDA)&INSRVR
SET X=$$SRVRHNG(INDA)
+9 USE 0
WRITE !,"Process has been signaled to terminate."
+10 QUIT
+11 ;
SRVRHNG(INBPN) ; $$function - If a receiver opens a TCP/IP socket, but no
+1 ; transmitter makes a connection, the receiver will hang on the
+2 ; OPEN^%INET command. As a result, signalling such a receiver
+3 ; background process to shutdown will fail since %INET retains
+4 ; control until a connection is received. The purpose of this
+5 ; routine is to supply the awaited connection, at which time the
+6 ; background process will receive control, detect the flag to
+7 ; shutdown and quit.
+8 ;
+9 ; Input:
+10 ; INBPN - BACKGROUND PROCESS CONTROL IEN for process to shut down
+11 ;
+12 ; Variables:
+13 ; INCHNL - TCP channel assigned to this server when connection is opened
+14 ; INMEM - memory variable used by %INET
+15 ; INPADIE - IEN of "well-known" IP port multiple for this server
+16 ; INPORT - "well-known" IP port(s) for this server background process
+17 ;
+18 ; Output:
+19 ; 0 = successful attempt to connect to potentially "hung" server
+20 ; 1 = attempt to connect to potentially "hung" server was NOT successful
+21 ;
+22 NEW INCHNL,INMEM,INPADIE,INPORT
+23 ;
+24 ; quit if process opened as client
IF '+$PIECE(^INTHPC(INBPN,0),U,8)
QUIT 1
+25 ; quit if no port data for this server
IF '$DATA(^INTHPC(INBPN,5))
QUIT 1
+26 ; signal process to shutdown
KILL ^INRHB("RUN",INBPN)
+27 ;
+28 ; Find/connect to any port(s) associated with this background process
+29 ; on which a "hung" server may be listening
+30 SET INPADIE=0
+31 FOR
SET INPADIE=$ORDER(^INTHPC(INBPN,5,INPADIE))
IF 'INPADIE
QUIT
Begin DoDot:1
+32 SET INPORT=$PIECE(^INTHPC(INBPN,5,INPADIE,0),U)
IF 'INPORT
QUIT
+33 ; Attempt to open as a client to this server on this port
+34 DO OPEN^%INET(.INCHNL,.INMEM,"0.0.0.0",INPORT,1)
+35 ;D OPEN^%INET(.INCHNL,.INMEM,"0.0.0.0",INPORT,1,$G(INBPN)) ;maw cache
+36 IF INCHNL
DO CLOSE^%INET(INCHNL)
+37 ;D:INCHNL CLOSE^%INET(INCHNL,$G(INBPN)) ;maw cache
End DoDot:1
+38 QUIT 0
+39 ;
