PROGRAM		WATCH_DOG
	IMPLICIT NONE
C
C   Program:	WATCHDOG
C
C   Original:	unknown (program came from Decus Tape)
C
C   Modifier's Address:
C		George H. Walrod III   Phone: (301) 251-8485
C		MS-34
C		1801 Research Boulevard
C		Rockville, MD 20850
C
C   Purpose:	This Program Monitors Interactive Processes and Logs Off
C		Processes Set There Idle.
C
C   Compilation:	<WATCHDOG.BLD>
C		FORTRAN /CONTINUATION=99/LIST/CROSS WATCHDOG
C		MACRO WATCHSYM
C		LINK WATCHDOG,WATCHSYM/SELECTIVE/NOTRACEBACK/MAP
C
C   Other Modules:
C		WATCHSYM.MAR	- System Symbols for Watch Dog
C
C   Corrected Modification:
C		Restructured Program adding comments and Fixing a Bug
C		if you login into another System using Decnet
C		you idle on Host but still working on other system.
C					04/06/85	George H. Walrod III
C
C		Correct Bug if User Spawns a Subprocess the Subprocess
C		Does not Have a Terminal when you do a GETJPI, so we
C		Search for the Parent Process to Get the Terminal.  If
C		Parent has No Terminal They are probley a Detach Process
C		and We Do Not Tough thoses Process.
C					04/22/85	George H. Walrod III
C
C		Security/Bug, If user Spawn a Subprocess and then
C		Suspends his Parent Process, Then we can't find his
C		Terminal.  The User seems to be trying to avoid Watchdog
C		So we warning him but send no Messages, and eventually
C		log him off, Knowing That it will probley hang him in
C		Suspended Process.  But we try to resume the Parent
C		Process first knowing that this will probably no work.
C					04/22/85	George H. Walrod III
C
C		Watch Dog get hits by Car! When Watchdog tells the user
C		that they are being logged off and the User logs out on
C		their own, When Watch goes to bite(Delete) the user 
C		process for the final Kill, and user is gone.  Watchdog
C		dies when a car(Error) come from no where. The license
C		plate of the car is "SS$_NONEXPR" (nonexistent process).
C					04/26/85	George H. Walrod III
C
C		Dec Goes Against Own Standard, Version 4.X changes the 
C		Extented Pid to Normal Pid.  Added Routine to Change
C		Pid (GETPID).  THIS CALL MUST BE COMMENTED FOR VMS
C		VERSION LESS THAN 4.X.
C					12/06/85	George H. Walrod III
C							Alan Cutler

C   Notes:
C
C	Variables of Some Importants :
C		Maxuser		: Maximum Number of Users Program can Support
C		Send_Stamp	: What Interval Time Stamp Should be Send
C		Start_Message	: What Interval Cycle Should Warning Message
C				  Starts.
C		Stop_Message	: What Interval Cycle Should Process be Deleted
C		ASCTIM		: Single Interval Cycle
C
C	Debugging Tools Build-in :
C		D-Lines are used for Debug, note when you compile Watchdog
C		with D_LINES only Processes with Group Number matching the
C		System Group(variable name SYSGRP) will be monitored.
C

	PARAMETER
     +		MAXUSER		= 256,		! Maximum Number Users
     +		SEND_STAMP	= 12,		! Time Stamp(send_stamp*asctim)
     +		START_MESSAGE	= 2,		! Start Sending Warning Msg
     +		STOP_MESSAGE	= 3,		! Stop Process Msg
     +		JPI_WILDCARD	= -1,		! Get Job Process Info Wildcard
     +		EFN		= 1,		! Event Flag
     +		CPU_50MS	= 5,		! 50 MS Resolution
     +		SYSGRP		= 7,		! System Group Number
     +		UNKNOWN_TERM	= 'UNKN',	! Unknown Terminal Name
     +		PROCESS_NAME	= 'WATCHDOG',	! Process Name
     +		BELL		= char(7),	! Ascii Bell
     +		FAO_IN_STR	= 
     +			'!AS !AS on !AS has been inactive for !SL min.!/!AS',
     +		HEADER_MSG	= 		! Header Message
     +			BELL//'MESSAGE FROM WATCH_DOG'//BELL,
     +		STAMP_MSG	=		! Time Stamp Message
     +			'WATCH DOG TIME STAMP',
     +		LOGOFF_DEF	=		! DEFAULT LOGOFF
     +			' and is being Logged Off',
     +		INIT_MSG	=		! Initial Message
     +			'WATCH DOG HAS BEEN INITIALIZED AND IS RUNNING'

	LOGICAL*1
     +		MS_TYPE,			! Operator Request Type
     +		OPER_MSG_BUF(8),		! Operator Message Buffer
     +		STOPABLE(MAXUSER),		! Process Stopable
     +		NO_WARNING			! Send No Warning Message

	CHARACTER
     +		ACCNAM*8,			! Account Name
     +		TIMBF*8,			! Current Time Buffer
     +		TTYNUM*7,			! Terminal Name
     +		USRNAM*12,			! User Name
     +		LOGOFF_MSG*24,			! Logoff Message
     +		MESSAGE*85,			! Message Buffer
     +		ASCTIM*13 /'0 00:05:00.00'/,	! Time Delay
     +		OPER_MESS*95			! Operator Message

	INTEGER*2
     +		JPIBUF2(14),			! Job Process Info Buffer
     +		JPIBUF(62),			! Job Process Info Buffer
     +		SEQ_NUMBER(2),			! Sequence Number PID
     +		SEQ(MAXUSER)			! Sequence Part Of Pid

	INTEGER*4
     +		MS_TARGET,			! Operator Terminal Type
     +		TIME_STAMP,			! Time Stamp Counter
     +		SEEDPID,			! Seed Pid for GETJPI
     +		CUR_PID,			! Current Pid
     +		BINTIM(2),			! Binary Time
     +		RANGE(2)	/0,'7FFFFFFF'X/,! Working Set Purge
     +		CPUTIM(MAXUSER),		! Cpu Time Used
     +		BUFIOC(MAXUSER),		! Number Of Buffer I/O
     +		WARNING(MAXUSER),		! Number Of Warning So Far
     +		SS_STATUS,			! Sys Service Status
     +		LIB$MATCHC,			! RTL Index for Colon
     +		OTS$CVT_TI_L,			! RTL Convert Decimal->Binary
     +		SYS$SETPRN,			! SS Set Process Name
     +		SYS$FAO,			! SS Format Ascii Output
     +		SYS$SCHDWK,			! SS Schedule Wake
     +		SYS$PURGWS,			! SS Purge Working set
     +		SYS$BINTIM,			! SS Binary Time
     +		SYS$DELPRC,			! SS Delete Process
     +		SYS$BRDCST,			! SS Broadcast
     +		SYS$SNDOPR,			! SS Send Operator
     +		SYS$GETJPI,			! SS Get Job Process Info
     +		SYS$WAITFR,			! SS Wait For Efn
     +		SYS$RESUME,			! SS Resume
     +		SYS$HIBER,			! SS Hiberate
     +		START_IDX,			! Index Pointer of TIME
     +		TIME_MINUTES,			! Time in Minutes
     +		MESSAGE_LEN,			! Message Length
     +		PID,				! Process Identifacation No.
     +		OWNER,				! Process Owner Pid
     +		NEWCPU,				! New Cpu Time
     +		NEWIOC,				! New Buffer I/O Count
     +		STATE,				! Process State
     +		GRPNUM,				! Group Number
     +		SUBCOUNT,			! Sub-Process Count
     +		PIDADDR,			! Addr of Pid
     +		PIDLEN,				! Length of Pid
     +		CPUTADDR,			! Addr of Cpu Time
     +		CPULEN,				! Length of Cpu Time
     +		BIOADDR,			! Addr Buffer I/O
     +		BIOLEN,				! Length Buffer I/O
     +		STATEADDR,			! Addr of Process State
     +		STATELEN,			! Length of Process State
     +		USRNAM_L,			! User Name Length
     +		USERADDR,			! Addr of User Name
     +		USERLEN,			! Length of User Name
     +		ACCNAM_L,			! Account Name Length
     +		ACCADDR,			! Addr of Account Name
     +		ACCLEN,				! Length of Account Name
     +		TTYNUM_L,			! Terminal Name Length
     +		TERMADDR,			! Addr of Terminal Name
     +		TERMLEN,			! Length of Terminal Name
     +		GRPADDR,			! Addr of Group Number
     +		GRPLEN,				! Length Group Number
     +		PRCCADDR,			! Addr of Process Count
     +		PRCCLEN,			! Length of Process Count
     +		OWNERADDR,			! Addr of Owner Pid
     +		OWNERLEN,			! Length of Owner Pid
     +		TERMADDR2,			! Addr of Terminal Name
     +		TERMLEN2,			! Length of Terminal Name
     +		OWNERADDR2,			! Addr of Owner Pid
     +		OWNERLEN2			! Length of Owner Pid

	EXTERNAL
     +		SS$_DEVOFFLINE,			! Device Offline Line
     +		SS$_NOMOREPROC,			! No More Processes
     +		SS$_NONEXPR,			! Non Existent Process
     +		SS$_NORMAL,			! Normal Completion
     +		SS$_SUSPENDED,			! Process Suspended
     +		JPI$_PID,			! Pid
     +		JPI$_CPUTIM,			! Cpu Time
     +		JPI$_BUFIO,			! Buffer I/O
     +		JPI$_STATE,			! Process State
     +		JPI$_USERNAME,			! User Name
     +		JPI$_ACCOUNT,			! Account Name
     +		JPI$_TERMINAL,			! Terminal Name
     +		JPI$_GRP,			! Group Number
     +		JPI$_PRCCNT,			! Process Count
     +		JPI$_OWNER,			! Process Owner
     +		JPI$C_LISTEND,			! End List
     +		SCH$C_HIB,			! Schedule Hiberation
     +		SCH$C_HIBO,			! Schedule Hiberation Out Swap
     +		OPC$M_NM_CENTRL,		! Operator Central
     +		OPC$_RQ_RQST			! Operator Request

C
C   Define Equivalence Fields for Data Buffers
C
	EQUIVALENCE
     +		(PIDADDR,	JPIBUF(03)),
     +		(PIDLEN,	JPIBUF(05)),
     +		(CPUTADDR,	JPIBUF(09)),
     +		(CPULEN,	JPIBUF(11)),
     +		(BIOADDR,	JPIBUF(15)),
     +		(BIOLEN,	JPIBUF(17)),
     +		(STATEADDR,	JPIBUF(21)),
     +		(STATELEN,	JPIBUF(23)),
     +		(USERADDR,	JPIBUF(27)),
     +		(USERLEN,	JPIBUF(29)),
     +		(ACCADDR,	JPIBUF(33)),
     +		(ACCLEN,	JPIBUF(35)),
     +		(TERMADDR,	JPIBUF(39)),
     +		(TERMLEN,	JPIBUF(41)),
     +		(GRPADDR,	JPIBUF(45)),
     +		(GRPLEN,	JPIBUF(47)),
     +		(PRCCADDR,	JPIBUF(51)),
     +		(PRCCLEN,	JPIBUF(53)),
     +		(OWNERADDR,	JPIBUF(57)),
     +		(OWNERLEN,	JPIBUF(59)),
     +		(TERMADDR2,	JPIBUF2(03)),
     +		(TERMLEN2,	JPIBUF2(05)),
     +		(OWNERADDR2,	JPIBUF2(09)),
     +		(OWNERLEN2,	JPIBUF2(11)),
     +		(MS_TYPE,	OPER_MSG_BUF(1)),
     +		(MS_TARGET,	OPER_MSG_BUF(2)),
     +		(OPER_MSG_BUF,	OPER_MESS),
     +		(MESSAGE,	OPER_MESS(11:)),
     +		(SEQ_NUMBER(1),	PID)

C
C   Job Process Information Layout
C						! +---------------+
	JPIBUF(01) = 4				! |  Pid Buf Size |
	JPIBUF(02) = %loc(jpi$_pid)		! |      PID      |
	PIDADDR    = %loc(pid)			! |   Pid Addr    |
	PIDLEN     = 0				! |  Pid Ret Len  |
	JPIBUF(7)  = 4				! |  Cpu Time Len |
	JPIBUF(8)  = %loc(jpi$_cputim)		! |    CPUTIM     |
	CPUTADDR   = %loc(newcpu)		! | Cpu Time Addr |
	CPULEN     = 0				! |  Cpu Ret Len  |
	JPIBUF(13) = 4				! |  Buf I/O Size |
	JPIBUF(14) = %loc(jpi$_bufio)		! |   Buffer I/O  |
	BIOADDR    = %loc(newioc)		! | Buf I/O Addr  |
	BIOLEN     = 0				! | BufIO Ret Len |
	JPIBUF(19) = 4				! |Proc State Size|
	JPIBUF(20) = %loc(jpi$_state)		! | Process State !
	STATEADDR  = %loc(state)		! |Proc State Addr|
	STATELEN   = 0				! | State Ret Len |
	JPIBUF(25) = 12				! | User Name Len |
	JPIBUF(26) = %loc(jpi$_username)	! |   User Name   |
	USERADDR   = %loc(usrnam)		! | User Name Addr|
	USERLEN    = %loc(usrnam_l)		! | User Ret Len  |
	JPIBUF(31) = 8				! | Account Sizen |
	JPIBUF(32) = %loc(jpi$_account)		! |    Account    |
	ACCADDR    = %loc(accnam)		! | Account Addr  |
	ACCLEN     = %loc(accnam_l)		! | Account Retlen|
	JPIBUF(37) = 7				! | Terminal Size |
	JPIBUF(38) = %loc(jpi$_terminal)	! |   Terminal    |
	TERMADDR   = %loc(ttynum)		! | Terminal Addr |
	TERMLEN    = %loc(ttynum_l)		! | Terminal Len  |
	JPIBUF(43) = 4				! |  Grpno Size   |
	JPIBUF(44) = %loc(jpi$_grp)		! | Group Number  |
	GRPADDR    = %loc(grpnum)		! |  Grpno Addr   |
	GRPLEN     = 0				! | Grpno Ret Len |
	JPIBUF(49) = 4				! | Process Size  |
	JPIBUF(50) = %loc(jpi$_prccnt)		! | Process Count |
	PRCCADDR   = %loc(subcount)		! |   Proc Addr   |
	PRCCLEN    = 0				! | Proc Ret Len  |
	JPIBUF(55) = 4				! | Owner Size    |
	JPIBUF(56) = %loc(jpi$_owner)		! |  Owner Pid    |
	OWNERADDR  = %loc(owner)		! |  Owner Addr   |
	OWNERLEN   = 0				! | Owner Ret Len |
	JPIBUF(61) = %loc(jpi$c_listend)	! |  END OF LIST  |
	JPIBUF(62) = %loc(jpi$c_listend)	! |  END OF LIST  |
C						  +---------------+
C   End of Job Process Information List
C

C
C   Job Process Information Layout Subprocess
C						! +---------------+
	JPIBUF2(01) = 7				! | Terminal Size |
	JPIBUF2(02) = %loc(jpi$_terminal)	! |   Terminal    |
	TERMADDR2   = %loc(ttynum)		! | Terminal Addr |
	TERMLEN2    = %loc(ttynum_l)		! | Terminal Len  |
	JPIBUF2(07) = 4				! | Owner Size    |
	JPIBUF2(08) = %loc(jpi$_owner)		! |  Owner Pid    |
	OWNERADDR2  = %loc(owner)		! |  Owner Addr   |
	OWNERLEN2   = 0				! | Owner Ret Len |
	JPIBUF2(13) = %loc(jpi$c_listend)	! |  END OF LIST  |
	JPIBUF2(14) = %loc(jpi$c_listend)	! |  END OF LIST  |
C						  +---------------+
C   End of Job Process Information List for Subprocess
C

C
C   Set-Up Data Buffer for Operator Message
C
	MS_TYPE   = %loc(OPC$_RQ_RQST)
	MS_TARGET = %loc(OPC$M_NM_CENTRL)
	OPER_MESS(9:10) = BELL // BELL

C
C   Convert Ascii Time to Binary Time
C

	SS_STATUS = SYS$BINTIM(ASCTIM,BINTIM)
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))

C
C   Extract Minutes From Asctim for Warning Messages
C

	START_IDX = LIB$MATCHC(':',ASCTIM) + 1
D	TYPE *,'ASCII Time Intervals is ',ASCTIM
D	TYPE *,'Number of Minutes ASCII ',ASCTIM(START_IDX:START_IDX+1)
	SS_STATUS = OTS$CVT_TI_L(ASCTIM(START_IDX:START_IDX+1),
     +							TIME_MINUTES)
D	TYPE *,'Type Return Status from OTS$CVT_TI_L is ',SS_STATUS
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))

C
C   Set Process Name to "WATCH_DOG"
C

	SS_STATUS = SYS$SETPRN(PROCESS_NAME)
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))

C
C   Send Operator Console Message Tell Them That I am Running
C

	MESSAGE   = INIT_MSG
	SS_STATUS = SYS$SNDOPR(OPER_MESS,)
D	TYPE *,'Type Return Status from SYS$SNDOPR is ',SS_STATUS
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))

C
C   Initialize Time Stamp Time So That I Send Time Stamp Message
C   Too When I Start Running
C

	TIME_STAMP = SEND_STAMP - 1

C
C   Main Section of Program, Get Data on Users
C

1	CONTINUE
	TIME_STAMP = TIME_STAMP + 1
C
C   Send Time Stamp Message If It is Time
C
	IF (TIME_STAMP .eq. SEND_STAMP ) then
	  MESSAGE   = STAMP_MSG
	  SS_STATUS = SYS$SNDOPR(OPER_MESS,)
D	  TYPE *,'Type Return Status from SYS$SNDOPR is ',SS_STATUS
	  IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
	  TIME_STAMP=0
	ENDIF
C
C   Loop Until We Have Looked At All Processes using 
C   Get Job Process Information with a Wild Card
C
D900	  FORMAT(' Working With PID ',Z8)

	SEEDPID   = JPI_WILDCARD
	SS_STATUS = 0
	DO WHILE (SS_STATUS .ne. %loc(SS$_NOMOREPROC))
	  SS_STATUS   = SYS$GETJPI(%val(EFN),%ref(SEEDPID),,%ref(JPIBUF),,,)
D	  TYPE *,'Type Return Status from SYS$GETJPI is ',SS_STATUS
D	  TYPE 900,PID
	  IF (SS_STATUS) then
	    SS_STATUS = SYS$WAITFR(%val(EFN))
	   ELSE
	    IF ((SS_STATUS .ne. %loc(SS$_NOMOREPROC)) .and.
     +		 SS_STATUS .ne. %loc(SS$_SUSPENDED)) then
	      CALL LIB$STOP(%val(SS_STATUS))
	     ELSE
	      GOTO 20
	     endif
	   endif

C
C   We Have A User, Get The Low 16 Bits Of His Pid (the index) 
C   the High Order Bits Are the Sequence number
C

          CALL GETPID (PID)		! Change for Version 4.X
	  CUR_PID = SEQ_NUMBER(1)

C
C   If The Sequence Number Has Changed Since We Last Logged In,
C   We Have A New Sucker. Reset All The Use Counts, And Dont Bother Him
C

	  IF (SEQ(CUR_PID) .ne. SEQ_NUMBER(2)) then
D	    TYPE *,'Never Seen This Person Before'
	    SEQ(CUR_PID)      = SEQ_NUMBER(2)
	    WARNING(CUR_PID)  = 0
	    STOPABLE(CUR_PID) = .TRUE.
	    GOTO 10
	   endif

C
C   Is The Process Subject to Watchdog Monitoring
C	(am I wasteing my time)
C

	  IF (.not. STOPABLE(CUR_PID)) GOTO 10

C
C   Leave The Processes Alone, Which are Hiberating
C

	  IF ((STATE .eq. %loc(SCH$C_HIB)) .or.
     +	      (STATE .eq. %loc(SCH$C_HIBO))) GOTO 10

C
C   Leave The System Processes Alone, Things Break If I Don't
C

C	  IF (ACCNAM(1:ACCNAM_L) .eq. 'SYSTEM') then
C	    STOPABLE(CUR_PID) = .false.
C	    GOTO 20
C	   end if

C
C   I leave The Systems Staff Alone, Otherwise I Would Be Considered
C   Anti-Social.
C

C	  IF (GRPNUM .le. SYSGRP) then
C	    STOPABLE(CUR_PID) = .false.
C	    GOTO 20
C	   end if

C
C   Debuging to only look at SYSGRP Uic's
C

D	  IF (GRPNUM .ne. SYSGRP) then
D	    STOPABLE(CUR_PID) = .false.
D	    GOTO 20
D	   end if


C
C   If He Has No Tty Associated, He Is A Batch Job, Or An Acp
C   Or Something Like That. If He Is A Batch Job During Primetime
C   It Is Likely That He Is Not Running Enough To Notice. But
C   If He a Subprocess Find His Parent terminal and send a message
C   to him.
C
D901	FORMAT(' Working With Owner PID ',Z8)

	  NO_WARNING = .FALSE.
	  IF (TTYNUM_L .eq. 0) then
	    DO WHILE (OWNER .ne. 0)
	      SS_STATUS = SYS$GETJPI(%val(EFN),%ref(Owner),,
     +						%ref(JPIBUF2),,,)
D	      TYPE *,'Type Return Status from SYS$GETJPI for Subprocess is ',
D    +						SS_STATUS
D	      TYPE 901,Owner
	      IF (SS_STATUS) then
	        SS_STATUS = SYS$WAITFR(%val(EFN))
	       ELSE
	        IF (SS_STATUS .ne. %loc(SS$_SUSPENDED)) then
	          CALL LIB$STOP(%val(SS_STATUS))
	         ELSE
		  NO_WARNING = .TRUE.
	         endif
	       endif
             end do
	   IF ((TTYNUM_L .eq. 0) .and.
     +	       (.not. NO_WARNING)) GOTO 20
	  else
	   IF (SUBCOUNT .GT. 0) then
	     WARNING(CUR_PID) = 0
	     GOTO 10
	    endif
	   end if

C
C   Normal User, He Can Be Saved By Doing An I/O, Or Using 50ms Of Cpu
C   If He Has Some Subprocess' Running Then He May Be Waiting
C   So Don't Blow Him Away
C

	  IF ((BUFIOC(CUR_PID) .lt. NEWIOC) .or.
     +	      (CPUTIM(CUR_PID)+CPU_50MS .le. NEWCPU)) then
	    WARNING(CUR_PID) = 0
	    GOTO 10
	   endif

C
C   We Have Them Now, Check To See if We Can Start Sending Messages Yet
C   to User and/or Central Operator
C

D	  TYPE *,'Number of Warning ',WARNING(CUR_PID)
	  WARNING(CUR_PID) = WARNING(CUR_PID) + 1

	  IF (WARNING(CUR_PID) .ge. START_MESSAGE) then
	    MESSAGE = ' '
D	    TYPE *,'Warn User ',USRNAM(1:USRNAM_L)

C
C   Determine If We Are Going to Make Them History for the Message
C   Get Time of Day and Assemble The Message
C
	    LOGOFF_MSG = LOGOFF_DEF
	    IF (WARNING(CUR_PID) .ne. STOP_MESSAGE) LOGOFF_MSG = ' '
	    CALL TIME(TIMBF)
	    Usrnam_l = LIB$MATCHC(' ',usrnam) - 1
	    If (No_Warning) then
	      TTYNUM   = UNKNOWN_TERM
	      TTYNUM_L = len(UNKNOWN_TERM)
	     end if
	    SS_STATUS = SYS$FAO(FAO_IN_STR, MESSAGE_LEN, MESSAGE,
     +				TIMBF,
     +				USRNAM(1:usrnam_l),
     +				TTYNUM(1:ttynum_l),
     +				%val(TIME_MINUTES*WARNING(CUR_PID)),
     +				LOGOFF_MSG)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
D	    TYPE *,'STATUS RETURN FROM FAO IS ',SS_STATUS
D	    TYPE *,'IDLE TIME ',TIME_MINUTES*WARNING(CUR_PID)
C	    SS_STATUS = SYS$SNDOPR(OPER_MESS(1:Message_len+10),)
C	    IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
	    IF (.not. NO_WARNING) then
	      SS_STATUS = SYS$BRDCST(HEADER_MSG,TTYNUM)
	      IF ((.not. SS_STATUS) .and. 
     +		  (SS_STATUS .ne. %loc(SS$_DEVOFFLINE))) 
     +			CALL LIB$STOP(%val(SS_STATUS))
	      SS_STATUS = SYS$BRDCST(OPER_MESS(9:Message_len+10),TTYNUM)
	      IF ((.not. SS_STATUS) .and. 
     +		  (SS_STATUS .ne. %loc(SS$_DEVOFFLINE)))
     +			CALL LIB$STOP(%val(SS_STATUS))
	     endif
	   endif

C
C   Can We Delete Process, Check
C

	  IF (WARNING(CUR_PID) .eq. STOP_MESSAGE) then
D	    TYPE *,'Deleting User ',USRNAM(1:USRNAM_L)
	    SS_STATUS = SYS$SNDOPR(OPER_MESS(1:Message_len+10),)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
	    IF (NO_WARNING) then
	      SS_STATUS = SYS$RESUME(%ref(OWNER),)
	      IF ((SS_STATUS .ne. %loc(SS$_NORMAL)) .and.
     +		   SS_STATUS .ne. %loc(SS$_NONEXPR)) 
     +		CALL LIB$STOP(%val(SS_STATUS))
	     endif
	    SS_STATUS = SYS$DELPRC(%ref(PID),)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
	   endif

C
C   Go Get Another Process, Also Assign the CPUTIM and BUFIOC
C

10	  CONTINUE
	  CPUTIM(CUR_PID)=NEWCPU
	  BUFIOC(CUR_PID)=NEWIOC
20	  CONTINUE
	END DO
C
C   Set Up a Scheduled Wake Up to Occur
C
	SS_STATUS = SYS$SCHDWK(,,BINTIM,)
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
C
C  Dont Waste Memory While Waiting
C
	SS_STATUS = SYS$PURGWS(%ref(RANGE))
	IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS))
C
C  Hibernate Till the Scheduled Wake-up
C

D	TYPE *,'Going To Hiberate'
	SS_STATUS = SYS$HIBER()
D	TYPE *,'WATCH DOG Awake And Feeling Refreshed'
 	GOTO 1
	end						! Call It a Day