	PROGRAM REMINDERS

**
*	PROGRAM REMINDERS
*
*
*	12 Jan 1984	Correct second line of LOGIN message when first
*			appointment > 5 days from now.
*
*	15 May 1984	Also save time of next-to-last login if login
*			recording is used.
*
*	7 Aug 1984	Correct problem of USERX getting USERXX's login
*			messages (keyed reads in LOGIN were doing partial
*			key comparison).
*
*	22 Aug 1984	Use 99999 days in LOGIN_2 to signify infinity, not
*			999 days (reminders for n years hence were incor-
*			rectly processed).
*
*	23 Aug 1984	Display far-off reminders in months, not days.
*
*	23 Aug 1984	Support years past 1999.
*
*	27 Aug 1984	Establish a condition handler to recover from
*			DEVOFFLINE error by BRDCST when user has his term-
*			inal set /NOBROADCAST.
*
*	 2 Jul 1986	Correct coding for processing message at the time
*			of the appointment; problem showed up on clusters.
*
*
*	Alan L. Zirkle     Naval Surface Weapons Center
*			   Code K53
*	5 December 1983    Dahlgren, Virginia  22448
*

	IMPLICIT INTEGER (A-Z)

	CALL INITIALIZE

10	CALL SYS$SETAST()					 ! Disable ASTs

	CALL INTERRUPT

	CALL SYS$SETAST(%VAL(1))				  ! Enable ASTs

	CALL GO_TO_SLEEP

	GO TO 10

	END
	SUBROUTINE INITIALIZE

	IMPLICIT INTEGER (A-Z)

	CHARACTER*128 FILE

	INTEGER*4 MB_DATA(4)

	EXTERNAL LOGIN

	LOGICAL LOGIN_RECORD

	COMMON /LOGIN_/ LOGIN_RECORD

	COMMON /TICKLE/ TICKLE_TIMES,TICKLE_TIME(10)

!	PARAMETER ( SYI$_NODENAME = '10D9'X )		!NODENAME

!	CHARACTER*8 NODE				!NODENAME

!	COMMON /NODE_/ NODE				!NODENAME

	DATA TICKLE_TIMES,TICKLE_TIME / 7 , 0,1,5,10,15,30,60,0,0,0 /

	DATA LOGIN_RECORD / .FALSE. /	! Keep record of everyone's last login?

!	CALL LIB$GETSYI(SYI$_NODENAME,,NODE,NLEN)	!NODENAME

!	IF (NLEN.EQ.0) NODE = ' '			!NODENAME

	READ *, TICKLE_TIMES,(TICKLE_TIME(I),I=1,MIN(10,TICKLE_TIMES))

	READ 1000,FILE

	OPEN (1,FILE=FILE,STATUS='OLD',SHARED,ACCESS='KEYED',
	1					       FORM='FORMATTED')

	CALL MAILBOX('REMINDERS_',MB_DATA,LOGIN,,PERM)

	READ (*,1000,END=100) FILE

	IF (FILE.NE.' ') THEN

	    LOGIN_RECORD = .TRUE.

	    CALL LAST_LOGIN_INITIALIZE(FILE)

	ENDIF

100	RETURN

1000	FORMAT (A)

	END
	SUBROUTINE INTERRUPT

	IMPLICIT INTEGER (A-Z)

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	INTEGER*4    WAKE_TIME(2)
	CHARACTER*20 WAKE_TIME_

	COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_

	COMMON /TICKLE/ TICKLE_TIMES,TICKLE_TIME(10)

	WAKE_TIME_ = ' '

	ASSIGN 10 TO LOCK	   ! Where to return to after record lock error

10	READ (1,1000,KEY=' ',ERR=110,IOSTAT=ERR) LEV,EVENT    ! Simulate rewind

	ASSIGN 20 TO LOCK

20	READ (1,1000,END=100,ERR=110,IOSTAT=ERR) LEV,EVENT

	IF (EVENT(1:1).EQ.'\') THEN
	    UNLOCK (1)
	    GO TO 100
	ENDIF

	CALL CV_TIME(DAYS,MINUTES,*30)

	IF (DAYS.LE.0) THEN			      ! This event is for today

	    DO T=1,TICKLE_TIMES

		IF (MINUTES.LE.TICKLE_TIME(T)) THEN

		    CALL NOTIFY(T,DAYS,MINUTES)

		    IF (T.NE.1) CALL COMPUTE_WAKE_TIME(TICKLE_TIME(T-1))

		    GO TO 20

		ENDIF

	    ENDDO

	ENDIF

	CALL COMPUTE_WAKE_TIME(60)

	GO TO 20

30	DELETE (1)				  ! Remove ill-formatted record

	GO TO 20

100	RETURN

110	IF (ERR.EQ.52) THEN				    ! Is record locked?
	    CALL GO_WAIT(1)
	    GO TO LOCK,(10,20)
	ELSE
	    PRINT 1001,ERR
	    CALL EXIT
	ENDIF

1000	FORMAT (Q,A)
1001	FORMAT ('0Error',I3,' on the Reminder Event File.'/)

	END
	SUBROUTINE NOTIFY(T,DAYS,MINUTES)

*
*	Defaults, changable by initialization input data:
*
*		T=1 means event is NOW.
*		T=2 means event is in one minute.
*		T=3 means event is in five minutes.
*		T=4 means event is in ten minutes.
*		T=5 means event is in fifteen minutes.
*		T=6 means event is in a half hour.
*		T=7 means event is in one hour.
*
*	DAYS is number of days until the event (should be 0).
*
*	MINUTES is exact number of minutes until the event.
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	CHARACTER*80 MSG

	IF (T.EQ.1.OR.MINUTES.LE.1) THEN      ! Event is NOW or is already past

	    IF (EVENT(42:42).EQ.CHAR(T+48)) GO TO 10		 ! Already sent

	    EVENT(42:42) = CHAR(T+48)		   ! Set flag that msg was sent

	    LEV = MAX(LEV,42)		    ! Make sure updated flag is written

	    IF (DAYS.EQ.0.AND.MINUTES.GE.-30) THEN	! If 30+ min. late,
							!             forget it
		NREC = SEND('You have an appointment RIGHT NOW')

	    ENDIF

*	    Remove event from event file if event time reached and user got
*	    the message, or if message is too old.

10	    IF (T.EQ.1.AND.(NREC.GT.0.OR.MINUTES.LT.-30)) THEN
		DELETE (1)
	    ELSE
		REWRITE (1,1000) EVENT(1:LEV)	   ! Update event on event file
	    ENDIF

	ELSE			! Event is soon, send N-minute msg if necessary

	    IF (EVENT(42:42).EQ.CHAR(T+48)) RETURN		 ! Already sent

	    EVENT(42:42) = CHAR(T+48)		   ! Set flag that msg was sent

	    LEV = MAX(LEV,42)		    ! Make sure updated flag is written

	    REWRITE (1,1000) EVENT(1:LEV)	   ! Update event on event file

	    CALL SYS$FAO('You have an appointment'//
	1		' in !SL minutes, at !AS',LEN,MSG,
	2				%VAL(MINUTES),EVENT(37:41))

	    NREC = SEND(MSG(:LEN))

	ENDIF

1000	FORMAT (A)

	END
	INTEGER FUNCTION SEND(TEXT)

*
*	The function result is the number of terminals recieving the
*	message; this may be zero.
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) TEXT

!	CHARACTER*8 NODE				!NODENAME

!	COMMON /NODE_/ NODE				!NODENAME

	CHARACTER*80 BLANKS / ' ' /
	CHARACTER*5 NOW
	CHARACTER*2 CRLF

	PARAMETER ( CRLF = CHAR(13) // CHAR(10) )

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	EXTERNAL CONDITION_HANDLER

	CALL TIME(NOW)

	L = 90 - 33 - LEN(TEXT)

!	L = L - 2					!NODENAME

	CALL LIB$ESTABLISH(CONDITION_HANDLER)

	COL = STR_LEN(EVENT(1:15))

	IF (LEV.LE.42) THEN

	    SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//'  Reminder -- '//
	1			NOW//' -- '//TEXT//BLANKS(:L)//CRLF)
!	    SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//'  Reminder -- '//	!NODENAME
!	1		NOW//' -- '//TEXT//BLANKS(:L)//NODE(1:2)//CRLF)	!NODENAME

	ELSE

	    L2 = 90 - 33 - (LEV-42)

	    SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//'  Reminder -- '//
	1			NOW//' -- '//TEXT//BLANKS(:L)//CRLF
	2			//'                       '//
	3			EVENT(43:LEV)//BLANKS(:L2)//CRLF)
!	    SEND = SEND_MESSAGE(EVENT(1:COL),CRLF//'  Reminder -- '//	!NODENAME
!	1		NOW//' -- '//TEXT//BLANKS(:L)//NODE(1:2)//CRLF	!NODENAME
!	2			//'                       '//		!NODENAME
!	3			EVENT(43:LEV)//BLANKS(:L2)//CRLF)	!NODENAME

	ENDIF

	END
	SUBROUTINE CV_TIME(DAYS,MINUTES,*)

*
*	STRING -- AN ASCII TIME, FORMAT '18-NOV-83 12:00'  (note 83, not 1983)
*
*	DAYS -- DIFFERENCE BETWEEN TODAY AND TIME STRING IN EVENT RECORD
*
*	MINUTES -- IF DAYS=0, DIFFERENCE BETWEEN CURRENT TIME AND STRING TIME
*		   IF DAYS>0, MINUTES FROM THAT DAY'S MIDNIGHT AND STRING TIME
*		   IF DAYS<0, MINUTES = -999
*
*	THE ALTERNATE RETURN IS TAKEN IF THE TIME IS BADLY FORMATTED.
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	INTEGER*4 WORK(2),EVENT_TIME(2)

	COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY

	CALL SYS$GETTIM(WORK)

	IF (EVENT(34:34).GE.'8') THEN		! 1980's, or 1990's

	    STATUS = SYS$BINTIM(EVENT(27:33)//'19'//EVENT(34:41),
	1						     EVENT_TIME)
	ELSE				! 2000 or beyond

	    STATUS = SYS$BINTIM(EVENT(27:33)//'20'//EVENT(34:41),
	1						     EVENT_TIME)
	ENDIF

	IF (.NOT.STATUS) RETURN 1

	CALL LIB$DAY(TODAY_DAY,WORK)

	CALL LIB$DAY(EVENT_DAY,EVENT_TIME,SECS)

	DAYS = EVENT_DAY - TODAY_DAY

	IF (DAYS.EQ.0) THEN

	    CALL LIB$SUBX(EVENT_TIME,WORK,WORK)

	    CALL LIB$EDIV(600000000,WORK,MINUTES,REM)

	ELSE IF (DAYS.GT.0) THEN

	    MINUTES = SECS / (60*100)

	ELSE

	    MINUTES = -999

	ENDIF

	END
	SUBROUTINE COMPUTE_WAKE_TIME(BIAS)

	IMPLICIT INTEGER (A-Z)

	INTEGER*4 QWORK(4)

	INTEGER*4    WAKE_TIME(2)
	CHARACTER*20 WAKE_TIME_

	COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_

	INTEGER*4 EVENT_TIME(2)

	COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY

	CALL LIB$EMUL(BIAS*60,10000000,0,QWORK)     ! Convert bias to VAX units

	CALL LIB$SUBX(EVENT_TIME,QWORK,EVENT_TIME)    ! Subtract bias from time

	CALL LIB$DAY(WORK,EVENT_TIME,CENTISEC)	    ! Round down to even minute

	CENTISEC = MOD(CENTISEC,100*60)

	CALL LIB$EMUL(CENTISEC,100000,0,QWORK)

	CALL LIB$SUBX(EVENT_TIME,QWORK,EVENT_TIME)

	IF (WAKE_TIME_.NE.' ') THEN

	    CALL LIB$SUBX(WAKE_TIME,EVENT_TIME,QWORK)

	    IF (QWORK(2).LT.0) RETURN

	ENDIF

 	WAKE_TIME(1) = EVENT_TIME(1)
	WAKE_TIME(2) = EVENT_TIME(2)

	CALL SYS$ASCTIM(,WAKE_TIME_,WAKE_TIME,)	! ASCII wake time, for debugs

	END
	SUBROUTINE GO_TO_SLEEP

	IMPLICIT INTEGER (A-Z)

	INTEGER*4    WAKE_TIME(2)
	CHARACTER*20 WAKE_TIME_

	COMMON /WAKE_UP/ WAKE_TIME,WAKE_TIME_

	IF (WAKE_TIME_.NE.' ') THEN

	    STATUS = SYS$SCHDWK(,,WAKE_TIME,)

	    IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

	ENDIF

	CALL GO_HIBERNATE

	END
	SUBROUTINE LOGIN(MB_DATA)

	IMPLICIT INTEGER (A-Z)

	INTEGER*4 MB_DATA(4)

	CHARACTER*80 BUFFER

	COMMON /BUF/ BLEN,BUFFER

	LOGICAL HIBERNATING

	COMMON /HIBER_/ HIBERNATING

	LOGICAL LOGIN_RECORD

	COMMON /LOGIN_/ LOGIN_RECORD

	CHARACTER*15 USERNAME

	CALL MAILBOX_READ(MB_DATA,BUFFER,LENGTH)

	IF (LENGTH.LE.5) RETURN

	IF (HIBERNATING) THEN

	    CALL SYS$CANWAK(,)

	    CALL GO_WAKE_UP

	ENDIF

	IF (BUFFER(1:5).NE.'I am ') RETURN

	COL = INDEX(BUFFER(1:LENGTH),' on ')

	IF (COL.EQ.0) RETURN

	USERNAME = BUFFER(6:COL-1)

	IF (LOGIN_RECORD) CALL LAST_LOGIN(USERNAME)

	CALL LOGIN_2(USERNAME,BUFFER(COL+4:LENGTH))

	END
	SUBROUTINE LOGIN_2(USERNAME,TERMINAL)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) USERNAME,TERMINAL

	CHARACTER*15 EARLIEST

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	CHARACTER*80 BUFFER

	COMMON /BUF/ BLEN,BUFFER

	APPTS = 0

	ASSIGN 10 TO LOCK	   ! Where to return to after record lock error

10	READ (1,1000,KEY=USERNAME,ERR=110,IOSTAT=ERR) LEV,EVENT

	UNLOCK (1)

	ASSIGN 30 TO LOCK

	NEXT  = 99999*10000

20	APPTS = APPTS + 1
	CALL CV_TIME(DAYS,MINUTES,*30)
	THIS = DAYS*10000 + MINUTES
	IF (THIS.LT.NEXT) THEN
	    NEXT  = THIS
	    EARLIEST = EVENT(27:41)
	ENDIF

30	READ (1,1000,END=100,ERR=110,IOSTAT=ERR) LEV,EVENT

	UNLOCK (1)

	IF (EVENT(1:25).EQ.USERNAME) GO TO 20

100	IF (APPTS.EQ.0) RETURN

	EVENT(1:25) = TERMINAL		! Temporarily put terminal name of
					!  logging-in user in the username
					!  area of the event record, so
					!  if user is logged in elsewhere,
					!  only this terminal gets the mes-
					!  sage.  Since this is not written
					!  to the event file, it is temporary.
	EVENT(27:41) = EARLIEST

	IF (APPTS.EQ.1) THEN

	    BUFFER = 'You have one appointment,'
	    BLEN = 25
	    CALL LOGIN_3(' ')

	ELSE

	    CALL SYS$FAO('You have !SL appointments;',
	1					BLEN,BUFFER,%VAL(APPTS))
	    CALL LOGIN_3(' The next one is ')

	ENDIF

	RETURN

110	IF (ERR.EQ.52) THEN				    ! Is record locked?
	    CALL GO_WAIT(1)
	    GO TO LOCK,(10,20)
	ELSE
	    IF (ERR.EQ.36) GO TO 100
	    PRINT 1001,ERR
	    CALL EXIT
	ENDIF

1000	FORMAT (Q,A)
1001	FORMAT ('0Error',I3,' on the Reminder Event File.'/)

	END
	SUBROUTINE LOGIN_3(TEXT)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) TEXT

	CHARACTER*90 EVENT

	COMMON /EVENT_/ LEV,EVENT

	CHARACTER*5  TIME

	EQUIVALENCE (TIME,EVENT(37:41))

	CHARACTER*70 BUFFER
	CHARACTER*10 DAY

	COMMON /BUF/ BLEN,BUFFER,DAY

	INTEGER*4 EVENT_TIME(2)

	COMMON /EVENT_DAY_/ EVENT_TIME,EVENT_DAY

	CHARACTER*10 WEEK(0:6)

	DATA WEEK / 'Wednesday','Thursday','Friday','Saturday',
	1				'Sunday','Monday','Tuesday' /

	EVENT(43:) = TEXT

	LEV = 42 + LEN(TEXT)

	CALL CV_TIME(DAYS,MINUTES,*10)

10	IF (DAYS.EQ.0) THEN

	    EVENT(LEV+1:) = 'at ' // TIME // ' Today.'

	    LEV = LEV + 3 + 5 + 7

	ELSE IF (DAYS.EQ.1) THEN

	    EVENT(LEV+1:) = 'at ' // time // ' Tomorrow.'

	    LEV = LEV + 3 + 5 + 10

	ELSE IF (DAYS.LE.5) THEN

	    DAY = WEEK(MOD(EVENT_DAY,7))

	    D = INDEX(DAY,' ') - 1

	    EVENT(LEV+1:) = DAY(:D) // ' at ' // TIME

	    LEV = LEV + D + 4 + 5

	ELSE IF (DAYS.LE.120) THEN

	    CALL SYS$FAO('in !SL days.  ',D,EVENT(LEV+1:),%VAL(DAYS))

	    LEV = LEV + D

	ELSE

	    CALL SYS$FAO('in !SL months.  ',D,EVENT(LEV+1:),
	1						  %VAL(DAYS/30))
	    LEV = LEV + D

	ENDIF

	CALL SEND(BUFFER(1:BLEN))

	END
	SUBROUTINE LAST_LOGIN_INITIALIZE(FILE)

**
*	SUBROUTINE LAST_LOGIN_INITIALIZE ( file )
*
*	Opens (creates if necessary) the indexed sequential file
*	which is used to record the date and time of each user's
*	last login.  See routine LAST_LOGIN for more information.
*
*	The character string FILE is the name of the file.
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) FILE

	LOGICAL EXISTS

	INQUIRE (FILE=FILE,EXIST=EXISTS)

	IF (EXISTS) THEN

	    OPEN (2,FILE=FILE,STATUS='OLD',ACCESS='KEYED',
	1		FORM='FORMATTED',SHARED)

	ELSE

	    OPEN (2,FILE=FILE,STATUS='NEW',ORGANIZATION='INDEXED',
	1		ACCESS='KEYED',RECL=54,RECORDTYPE='VARIABLE',
	2		KEY=(1:15:CHARACTER),FORM='FORMATTED',
	3		CARRIAGECONTROL='LIST',SHARED)

	ENDIF

	END
	SUBROUTINE LAST_LOGIN(USERNAME)

**
*	SUBROUTINE LAST_LOGIN( username )
*
*	Records, if the feature is enabled (see routine INITIALIZE),
*	the date and time of last login for the user USERNAME.
*
*	This data is recorded on an indexed sequential file, indexed
*	by username.  The format of each 36-character record is:
*
*		Col 1-15  --  Username
*
*		Col 17-33 --  Date/Time 'dd-mmm-yyyy hh:mm' of last login
*
*		Col 38-54 --  Date/Time 'dd-mmm-yyyy hh:mm' of next-to-
*								last login
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) USERNAME

	CHARACTER*17 TIME
	CHARACTER*54 RECORD

	CALL SYS$ASCTIM(,TIME,,)

10	READ (2,1001,KEY=USERNAME,ERR=30,IOSTAT=ERR) RECORD

	REWRITE (2,1001) USERNAME,TIME,RECORD(17:33)

20	UNLOCK (2)

	RETURN

30	IF (ERR.EQ.52) THEN
	    CALL GO_WAIT(1)
	    GO TO 10
	ELSE IF (ERR.NE.36) THEN
	    GO TO 100
	ENDIF

	WRITE (2,1001) USERNAME,TIME,' 1-JAN-1900 00:00'

	GO TO 20

100	PRINT 1000,ERR

1000	FORMAT ('0 Error',I3,' on LASTLOGIN.DAT file.'/)
1001	FORMAT (A,T17,A,T38,A)

	END
	INTEGER*4 FUNCTION CONDITION_HANDLER(SIGARGS,MECHARGS)

	IMPLICIT INTEGER*4 (A-Z)

	INTEGER*4 SIGARGS(*),MECHARGS(*)

	CHARACTER PROC*16,TERM*8,USER*12
	INTEGER*2 PNLEN,TNLEN,UNLEN

	COMMON /GETJPI_1/ PID,STAT,UIC,PROC,TERM,USER,PNLEN,TNLEN,UNLEN

	EXTERNAL SS$_RESIGNAL,SS$_DEVOFFLINE,SS$_NOSUCHDEV,SS$_BADPARAM

	CONDITION_HANDLER = %LOC(SS$_RESIGNAL)

	N = LIB$MATCH_COND(SIGARGS(2),%LOC(SS$_DEVOFFLINE),
	1			      %LOC(SS$_NOSUCHDEV),
	2			      %LOC(SS$_BADPARAM))

	IF (N.GT.0) THEN

	    PRINT 1000,SIGARGS(2),USER(1:UNLEN),TERM(1:TNLEN)

	    CALL SYS$UNWIND(MECHARGS(3),)

	ENDIF

1000	FORMAT (' ERROR ',Z8.8,2X,A,2X,A)

	END
