	PROGRAM CHKEXPR3

C This program warns the user if his or her account
C will expire in the near future.
C
C This version for VMS 4.4+
C
C This version uses the system service routine SYS$GETUAI
C (Get User Authorization Information) which is new as of VMS 4.4
C
C David Deley  September, 1986
C---------------------------------------------------------------------
C FLOW-CHART
C
C    GET USERNAME
C    GET EXPIRATION DATE OF USERNAME
C       call sys$getuai (vms 4.4)
C    GET CURRENT DATE
C    DETERMINE REMAINING TIME UNTIL ACCOUNT EXPIRES
C       remaining_time = expiration_date - current_date
C       do i=1,number_of_warning_days
C         remaining_time = remaining_time - one_day
C       enddo
C    IF REMAINING TIME LESS THAN ZERO THEN
C       compute day of week account will expire
C       format warning message
C       send warning message
C    ENDIF
C    END
C----------------------------------------------------------------------
C
C COMPILING:
C  $ FORTRAN CHKEXPR3
C  $ LINK/NOTRACEBACK CHKEXPR3
C
C----------------------------------------------------------------------

	INCLUDE '($DSCDEF)'
	INCLUDE '($JPIDEF)'
C	INCLUDE '($UAIDEF)'
	parameter UAI$Q_EXPIRATION=25

	INTEGER	SYS$FAO, SYS$GETJPIW,  SYS$GETUAI, SYS$GETTIM, STATUS

	parameter NUM_WAR_DAYS=10						!Number of warning days before expiration
	parameter MAX_USRNAM_LEN=12						!Maximum username length

	! Define item list structure
	STRUCTURE	/ITMLST/
	  UNION
	    MAP
	      INTEGER*2 BUFLEN,ITMCOD
	      INTEGER*4 BUFADR, RETADR
	    END MAP
	    MAP
	      INTEGER*4 END_LIST
	    END MAP
	  END UNION
	END STRUCTURE

	! Declare $GETJPIW and $GETAUI item lists
	RECORD  /ITMLST/  JPILST(2)
	RECORD  /ITMLST/  UAILST(2)

	! Declare variables
	INTEGER*4	ONE_DAY(2)						!One binary day
	INTEGER*4	EXP_TIM(2)						!Expiration time
	INTEGER*4	CUR_TIM(2)						!Current time
	INTEGER*4	REMAINING_TIME(2)					!Remaining time
	INTEGER*4	TEMP(2)							!Temporary storage of remaining time
	INTEGER*4	DAY_NUM							!Day number account expires.  1=Monday,7=Sunday
	INTEGER*4	WEEKDAY_LEN(7)						!Length of weekday names array
	INTEGER*4	USRNAM_LEN						!Length of username

	CHARACTER*68	OUT_MSG_BUFD						!Formatted output message buffer
	CHARACTER*55	WAR_MSGD						!Warning message control string
	CHARACTER*12	USRNAM							!Username
	CHARACTER*9	WEEKDAY(7)						!Weekday array (Monday-Sunday)

	DATA	ONE_DAY  /'2A69C000'X,'000000C9'X/				!One binary day
	DATA	WAR_MSGD
	1	/' WARNING - Your account expires on !AD, !11%D '/		!Warning message control string
	DATA	WEEKDAY
	1	/'Monday','Tuesday','Wednesday','Thursday',			!Weekday array (Monday-Sunday)
	2	'Friday','Saturday','Sunday'/
	DATA	WEEKDAY_LEN  /6,7,9,8,6,8,6/					!Length of weekday names array

C-----------------------------------------------------------------------
C	.ENTRY

	! Initialize item list for call to sys$getjpiw				!GET USERNAME
	JPILST(1).BUFLEN =  MAX_USRNAM_LEN
	JPILST(1).ITMCOD =  JPI$_USERNAME
	JPILST(1).BUFADR =  %LOC(USRNAM)
	JPILST(1).RETADR =  %LOC(USRNAM_LEN)
	JPILST(2).END_LIST = 0

	STATUS = SYS$GETJPIW (,,,JPILST,,,)
	IF (.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))

	! Initialize item list for call to sys$getuai				!GET EXPIRATION
	UAILST(1).BUFLEN = 8
	UAILST(1).ITMCOD = UAI$Q_EXPIRATION
	UAILST(1).BUFADR = %LOC(EXP_TIM)
	UAILST(1).RETADR = 0
	UAILST(2).END_LIST = 0

	STATUS = SYS$GETUAI (,,USRNAM,UAILST,,,)
	IF (.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))

	TEMP(2) = EXP_TIM(2)
	TEMP(1) = EXP_TIM(1)
	IF (TEMP(2) .EQ. 0 .AND. TEMP(1) .EQ. 0) CALL SYS$EXIT(%VAL(1))		!IF NO EXPIRATION THEN EXIT

	STATUS = SYS$GETTIM (CUR_TIM)						!GET CURRENT TIME
	IF (.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
	CALL LIB$SUBX(EXP_TIM,CUR_TIM,REMAINING_TIME,2)				!SUBTRACT CURRENT TIME FROM EXPIRATION TIME

	DO I=1,NUM_WAR_DAYS							!SUBTRACT WARNING DAYS FROM REMAINING TIME
		TEMP(2) = REMAINING_TIME(2)
		TEMP(1) = REMAINING_TIME(1)
		CALL LIB$SUBX(TEMP,ONE_DAY,REMAINING_TIME,2)
	ENDDO	

	IF (REMAINING_TIME(2) .GT. 0) CALL SYS$EXIT(%VAL(1))			!IF REMAINING TIME < 0 THEN WARN USER OF EXPIRATION

	CALL LIB$DAY_OF_WEEK(EXP_TIM,DAY_NUM)					!GET DAY OF WEEK ACCOUNT EXPIRES
	WAR_MSGD(1:1)=CHAR(7)							!PLACE BELL CHARACTER IN WARNING MESSAGE
	STATUS=SYS$FAO(WAR_MSGD,L,OUT_MSG_BUFD,					!FORMAT WARNING MESSAGE
	1	%VAL(WEEKDAY_LEN(DAY_NUM)),%REF(WEEKDAY(DAY_NUM)),
	2	EXP_TIM)
	IF (.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
	CALL LIB$PUT_OUTPUT(OUT_MSG_BUFD(1:L))					!PRINT WARNING MESSAGE
	CALL SYS$EXIT(%VAL(1))							!EXIT

	END
