PROGRAM GETUAF
C   ---------------------------------------------------------------------------
C   GETUAF.FOR - The function of this program is to fetch information from the
C	System User Authorization File.  The access key may be either a
C	username or a UIC (if multiple defined UIC's only first is returned).
C
C   Calling Procedure:
C
C	$ GETUAF := "$disk:[directory]GETUAF"
C	$ GETUAF access_key
C		[/UAF=file_spec]
C		[/UIC=symbol]
C		[/USERNAME=symbol]
C		[/[NO]EXACT]
C		[/DEVICE=symbol]
C		[/DIRECTORY=symbol]
C		[/ACCOUNT=symbol]
C		[/OWNER=symbol]
C		[/NEXT_UIC_MEMBER=symbol]
C		[/CTRLY=symbol]
C		[/CAPTIVE=symbol]
C		[/DISUSER=symbol]
C		[/NEWMAIL=symbol]
C		[/WELCOME=symbol]
C		[/CONTINUE_UIC=username]
C
C   Parameter:
C
C	access_key - This is the 'username' or the '[uic]' of the UAF record
C		that is desired.  If it is the '[uic]' it must be enclosed in
C		[] to distinguesh it from a 'username'.
C
C		If the '[uic]' specified has more that one record associated
C		with it only the information on the first found is returned.
C
C   Qualifiers:
C
C	/UAF=file_spec - will specify to the program the name of an alternate
C		User Authorization File to access.
C
C	/UIC=symbol - will return the UIC from the record, selected by the
C		access_key, in the local 'symbol' supplied.
C
C	/USERNAME=symbol - will return the username from the record, selected
C		by the access_key, in the local 'symbol' supplied.
C
C	/[NO]EXACT - will specify that the access_key is to be an exact match
C		with the record key in the UAF.  This is meaningfull only
C		if the access_key is a username.  The /NOEXACT is useful
C		for determining if a possible directory name will be in
C		conflict with an existing directory name.
C
C	/DEVICE=symbol - will return the default disk device from the record,
C		selected by the access_key, in the local 'symbol' supplied.
C
C	/DIRECTORY=symbol - will return the default directory from the record,
C		selected by the access_key, in the local 'symbol' supplied.
C
C	/ACCOUNT=symbol - will return the account number from the record,
C		selected by the access_key, in the local 'symbol' supplied.
C
C	/OWNER=symbol - will return the owner name from the record,
C		selected by the access_key, in the local 'symbol' supplied.
C
C	/NEXT_UIC_MEMBER=symbol - will return the next available (un-used)
C		member number (in octal).  The group and the lower limit for
C		the search are specified by the access_key which must be a
C		UIC specification when this qualifier is specified.
C
C	/CTRLY=symbol - will return "NO" if Control-Y is disabled for the
C		account (DISCTLY flag is set).  Else will return "YES".
C
C	/CAPTIVE=symbol - will return "YES" if this is a captive (turnkey)
C		account (CAPTIVE flag is set).  Else will return "NO".
C
C	/DISUSER=symbol - will return "YES" if this account is disabled from
C		interactive logins (DISUSER flag is set).  Else returns "NO".
C
C	/NEWMAIL=symbol - will return "YES" if "New Mail" messages are to be
C		displayed for the account at login.  Otherwise, (if DISNEWMAIL
C		flag is set) returns "NO".
C
C	/WELCOME=symbol - will return "YES" if welcoming messages are to be
C		displayed for the account at login.  Otherwise, (if DISWELCOM
C		flag is set) returns "NO".
C
C	/CONTINUE_UIC=username - will, if the access key is "uic" return the
C		information for the UAF entry for the next username with the
C		same uic as that given as the parameter for this qualifier.
C		If no more usernames are found, then the /USERNAME qualifier
C		will return a null string in the specified symbol.
C
C   Exit Conditions:
C
C	The exit status codes returned are:
C
C   ---------------------------------------------------------------------------
C
C V2.0	04-Apr-83	FJN	Added mods to return /FLAGS values and other
C				Fermilab compatible changes.
C V3.0	26-Nov-83	FJN	Modifications to support "wildcard" accesses by
C				UIC
C
	IMPLICIT INTEGER*4 (A-Z)
C
	PARAMETER	RECORDZ=1024*2
	PARAMETER	USERNAME_KEY=0
	PARAMETER	UIC_KEY=1
	PARAMETER	UAF_UNIT=1
	PARAMETER	USERNAMEZ=12
	PARAMETER	ACCOUNTZ=8
	PARAMETER	UICZ=6
	PARAMETER	DEVICEZ=16
	PARAMETER	DIRECTORYZ=31
	PARAMETER	OWNERZ=32
C
	CHARACTER	PARAM*(256)
	CHARACTER	DUMMY_C*(1)
C
	CHARACTER	UIC_SYM*(32)
	CHARACTER	UIC_GROUP_C*(UICZ)
	CHARACTER	UIC_MEMBER_C*(UICZ)
	CHARACTER	USERNAME_SYM*(32)
	CHARACTER	USERNAME_C*(USERNAMEZ)
	CHARACTER	username_last*(USERNAMEZ)
	CHARACTER	DEVICE_SYM*(32)
	CHARACTER	DEVICE_C*(DEVICEZ)
	CHARACTER	DIRECTORY_SYM*(32)
	CHARACTER	DIRECTORY_C*(DIRECTORYZ)
	CHARACTER	ACCOUNT_SYM*(32)
	CHARACTER	ACCOUNT_C*(ACCOUNTZ)
	CHARACTER	OWNER_SYM*(32)
	CHARACTER	OWNER_C*(OWNERZ)
	CHARACTER	NEXT_UIC_MEMBER_SYM*(32)
	CHARACTER	NEXT_UIC_MEMBER_C*(UICZ)
	CHARACTER	ctrly_sym*(32)
	CHARACTER	captive_sym*(32)
	CHARACTER	disuser_sym*(32)
	CHARACTER	newmail_sym*(32)
	CHARACTER	welcome_sym*(32)
C
	CHARACTER	LOGTRANS*(64)
	CHARACTER	UAF_NAME*(128)
C
	CHARACTER	RECORD*(RECORDZ)
	BYTE		RECORD_1(RECORDZ)
	EQUIVALENCE	( RECORD, RECORD_1 )
C
	INTEGER*4	ACCESS_UIC
	INTEGER*2	ACCESS_UIC_2(2)
	INTEGER*2	ACCESS_GROUP, ACCESS_MEMBER
	EQUIVALENCE	( ACCESS_UIC, ACCESS_UIC_2(1) )
	EQUIVALENCE	( ACCESS_UIC_2(1), ACCESS_MEMBER )
	EQUIVALENCE	( ACCESS_UIC_2(2), ACCESS_GROUP )
C
	INTEGER*2	UIC_GROUP, UIC_MEMBER
	BYTE		UIC_GROUP_1(2), UIC_MEMBER_1(2)
	EQUIVALENCE	( UIC_GROUP, UIC_GROUP_1(1) )
	EQUIVALENCE	( UIC_MEMBER, UIC_MEMBER_1(1) )
C
	EXTERNAL	SS$_NORMAL
	EXTERNAL	SS$_INSFARG
	EXTERNAL	SS$_BADPARAM
C
	EXTERNAL	UAF$T_USERNAME
	EXTERNAL	UAF$T_ACCOUNT
	EXTERNAL	UAF$T_DEFDIR
	EXTERNAL	UAF$T_DEFDEV
	EXTERNAL	UAF$T_OWNER
	EXTERNAL	UAF$W_MEM
	EXTERNAL	UAF$W_GRP
C
	EXTERNAL	UAF$B_FLAGS
	EXTERNAL	UAF$V_DISCTLY
	EXTERNAL	UAF$V_CAPTIVE
	EXTERNAL	UAF$V_DISACNT
	EXTERNAL	UAF$V_DISWELCOM
	EXTERNAL	UAF$V_DISMAIL
C
C   ---------------------------------------------------------------------------
C
C     Fetch the foreign command line from DCL.
C
	CALL LIB$GET_FOREIGN( PARAM, ,PARAM_S )
	CALL STR$UPCASE( PARAM, PARAM(1:PARAM_S) )
C
C     Fetch the qualifiers if any.
C
	UAF_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/UAF', 3, UAF_NAME, UAF_NAME_S )
	IF ( UAF_STATUS .NE. 1 .AND. UAF_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	UIC_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/UIC', 3, UIC_SYM, UIC_SYM_S )
	IF ( UIC_STATUS .NE. 1 .AND. UIC_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	USERNAME_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/USERNAME', 4,
	1		USERNAME_SYM, USERNAME_SYM_S )
	IF ( USERNAME_STATUS .NE. 1 .AND. USERNAME_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	continue_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/CONTINUE_UIC', 4,
	1		username_last, username_last_s )
	IF ( continue_STATUS .NE. 1 .AND. continue_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	EXACT_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/EXACT', 4, DUMMY_C, DUMMY_S )
	IF ( EXACT_STATUS .NE. 3 .AND. EXACT_STATUS .NE. 0 .AND.
	1    EXACT_STATUS .NE. 13 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	DEVICE_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/DEVICE', 4,
	1		DEVICE_SYM, DEVICE_SYM_S )
	IF ( DEVICE_STATUS .NE. 1 .AND. DEVICE_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	DIRECTORY_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/DIRECTORY', 4,
	1		DIRECTORY_SYM, DIRECTORY_SYM_S )
	IF ( DIRECTORY_STATUS .NE. 1 .AND. DIRECTORY_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	ACCOUNT_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/ACCOUNT', 4,
	1		ACCOUNT_SYM, ACCOUNT_SYM_S )
	IF ( ACCOUNT_STATUS .NE. 1 .AND. ACCOUNT_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	OWNER_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/OWNER', 4,
	1		OWNER_SYM, OWNER_SYM_S )
	IF ( OWNER_STATUS .NE. 1 .AND. OWNER_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	ctrly_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/CTRLY', 4,
	1		ctrly_SYM, ctrly_SYM_S )
	IF ( ctrly_STATUS .NE. 1 .AND. ctrly_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	captive_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/CAPTIVE', 4,
	1		captive_SYM, captive_SYM_S )
	IF ( captive_STATUS .NE. 1 .AND. captive_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	disuser_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/DISUSER', 4,
	1		disuser_SYM, disuser_SYM_S )
	IF ( disuser_STATUS .NE. 1 .AND. disuser_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	newmail_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/NEWMAIL', 4,
	1		newmail_SYM, newmail_SYM_S )
	IF ( newmail_STATUS .NE. 1 .AND. newmail_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	welcome_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/WELCOME', 4,
	1		welcome_SYM, welcome_SYM_S )
	IF ( welcome_STATUS .NE. 1 .AND. welcome_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
C     Fetch /NEXT_UIC_MEMBER qualifier.
C	SPECIAL NOTE:  This should be the last qualifier fetched because
C		       it is not compatable with the other qualifiers.
C		       A test will be made at this point and if this qualifier
C		       exists along with the previously tested for qualifiers
C		       an error will be issued.
C
	NEXT_UIC_MEMBER_STATUS = Q_STRING
	1	( PARAM(1:PARAM_S), '/NEXT_UIC_MEMBER', 4,
	1		NEXT_UIC_MEMBER_SYM, NEXT_UIC_MEMBER_SYM_S )
	IF ( NEXT_UIC_MEMBER_STATUS .NE. 1 .AND.
	1    NEXT_UIC_MEMBER_STATUS .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	IF ( ( USERNAME_STATUS + UIC_STATUS + continue_status +
	1      ACCOUNT_STATUS + DEVICE_STATUS +
	1      DIRECTORY_STATUS + OWNER_STATUS + ctrly_status +
	2      captive_status + disuser_status +
	3      newmail_status + welcome_status ) .GT. 0 .AND.
	1    NEXT_UIC_MEMBER_STATUS .EQ. 1 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
	IF ( INDEX( PARAM(1:PARAM_S), '/' ) .NE. 0 ) THEN
	    CALL LIB$STOP(SS$_BADPARAM)
	    ENDIF
C
C   ---------------------------------------------------------------------------
C
C     Fetch the access_key.
C
	P3 = 0
	STATUS = GET_STRING( PARAM(1:PARAM_S), P1, P3 )
	IF ( .NOT. STATUS ) THEN
	    CALL LIB$STOP(SS$_INSFARG)
	    ENDIF
C
C     See if access key is a username or a UIC
C
	IF ( PARAM(P1:P1) .EQ. '[' .AND. PARAM(P3:P3) .EQ. ']' ) THEN
C
C	  Access key is a UIC; convert to binary group and member.
C
	    ACCESS_KEY = UIC_KEY
	    P2 = INDEX( PARAM(P1+1:P3), ',' ) + P1
	    IF ( P2 .EQ. P1 ) THEN
		CALL LIB$STOP(SS$_BADPARAM)
		ENDIF
C
	    STATUS = OTS$CVT_TO_L( PARAM(P1+1:P2-1), ACCESS_GROUP,
	1		%val(2), %val(0) )
	    IF ( .NOT. STATUS ) THEN
		CALL LIB$STOP(%VAL(STATUS))
		ENDIF
	    STATUS = OTS$CVT_TO_L( PARAM(P2+1:P3-1), ACCESS_MEMBER,
	1		%val(2), %val(0) )
	    IF ( .NOT. STATUS ) THEN
		CALL LIB$STOP(%VAL(STATUS))
		ENDIF
C
	ELSE
C
C	  Access key is a username.
C
	    ACCESS_KEY = USERNAME_KEY
C
C	  See if an exact match is desired.
C
	    IF ( EXACT_STATUS .NE. 13 ) THEN
C
C	      Pad the username out with blanks to max key length.
C
	        P2 = P1 + (USERNAMEZ-1)
	        PARAM(P3+1:P2) = ' '
		ELSE
C
C	      Use the access_key as is and take what ever matches.
C
		P2 = P3
		ENDIF
C
C	  See if next UIC member is requested, if so error.
C
	    IF ( NEXT_UIC_MEMBER_STATUS .EQ. 1 ) THEN
		CALL LIB$STOP(SS$_BADPARAM)
		ENDIF
C
C	  Don't allow /CONTINUE_UIC qualifier with username access key.
C
	    IF ( continue_last .EQ. 1) THEN
		CALL LIB$STOP( SS$_BADPARAM)
		ENDIF
C
	ENDIF
C
C   ---------------------------------------------------------------------------
C
C     Open the User Authorization File.
C
	IF ( UAF_STATUS .NE. 1 ) THEN
	    UAF_NAME = LOGTRANS( 'SYSUAF', UAF_NAME_S )
	    UAF_NAME = 'SYS$SYSTEM:' // UAF_NAME(1:UAF_NAME_S)
	    UAF_NAME_S = UAF_NAME_S + 11
	    ENDIF
C
	OPEN( UNIT=UAF_UNIT, FILE=UAF_NAME(1:UAF_NAME_S), STATUS='OLD',
	1	ACCESS='KEYED', ORGANIZATION='INDEXED',
	1	FORM='FORMATTED', CARRIAGECONTROL='NONE',
	1	SHARED, ERR=199 )
	GOTO 200
C
C     Open error.
C
199	CONTINUE
	    CALL ERRSNS( FOR_ERR, RMS_CC, RMS_STATUS, ERR_UNIT, VAX_CC )
	    CALL LIB$STOP(%VAL(RMS_CC))
200	CONTINUE
C
C   ---------------------------------------------------------------------------
C
C     See if an explicit user is requested or if the next UIC is desired.
C
	IF ( NEXT_UIC_MEMBER_STATUS .EQ. 1 ) THEN
C
C	  Fetch the next UIC member available.
C
	    DO WHILE (.TRUE.)
		READ( UAF_UNIT, 300, ERR=299,
	1	    KEYID=ACCESS_KEY, KEYEQ=ACCESS_UIC )
	1		RECORD_S, RECORD(1:RECORD_S)
		ACCESS_MEMBER = ACCESS_MEMBER + 1
		ENDDO
299	    CONTINUE
C
C	  Determine if the error was because record not found.
C
	    CALL ERRSNS( FOR_ERR, RMS_CC, RMS_STATUS, ERR_UNIT, VAX_CC )
	    IF ( FOR_ERR .NE. 36 ) THEN
		CLOSE( UNIT=uaf_unit )
		CALL LIB$STOP(%VAL(RMS_CC))
		ENDIF
	    ELSE
C
C	  Fetch the desired record from the UAF.
C
	    IF ( ACCESS_KEY .EQ. USERNAME_KEY ) THEN
		READ( UAF_UNIT, 300, ERR=399,
	1	    KEYID=ACCESS_KEY, KEYEQ=PARAM(P1:P2) )
	1		RECORD_S, RECORD(1:RECORD_S)
		ELSE
		READ( UAF_UNIT, 300, ERR=399,
	1	    KEYID=ACCESS_KEY, KEYEQ=ACCESS_UIC )
	1		RECORD_S, RECORD(1:RECORD_S)
C
		IF ( continue_status .EQ. 1) THEN
C
C	  Fetch the next record after the specified previous username.
C
		    DO WHILE (.TRUE.)
			UIC_MEMBER_1(1) = RECORD_1(%loc(UAF$W_MEM)+1)
			UIC_MEMBER_1(2) = RECORD_1(%loc(UAF$W_MEM)+2)
			UIC_GROUP_1(1) = RECORD_1(%loc(UAF$W_GRP)+1)
			UIC_GROUP_1(2) = RECORD_1(%loc(UAF$W_GRP)+2)
			IF ( uic_group .NE. access_group .OR.
	1		     uic_member .NE. access_member) GOTO 311
			U1 = %loc(UAF$T_USERNAME)+1
			U2 = U1 + (USERNAMEZ-1)
			STATUS = STR$TRIM( USERNAME_C,
	1				   RECORD(U1:U2), USERNAME_S )
			IF ( username_c(1:username_s) .EQ.
	1		     username_last(1:username_last_s)) GOTO 311
C
			READ( UAF_UNIT, 300, ERR=399, END=310)
	1			RECORD_S, RECORD(1:RECORD_S)
			ENDDO
C
310		    CONTINUE
		    access_group = 0
		    access_member = 0
311		    CONTINUE
		    IF ( uic_group .NE. access_group .OR.
	1		 uic_member .NE. access_member) THEN
			record = ' '
			record_s = LEN( record)
			RECORD_1(%loc(UAF$W_MEM)+1) = 0
			RECORD_1(%loc(UAF$W_MEM)+2) = 0
			RECORD_1(%loc(UAF$W_GRP)+1) = 0
			RECORD_1(%loc(UAF$W_GRP)+2) = 0
			ELSE
C
C	  Read next user record (same UIC).
C
			READ( UAF_UNIT, 300, ERR=399, END=310)
	1			RECORD_S, RECORD(1:RECORD_S)
			UIC_MEMBER_1(1) = RECORD_1(%loc(UAF$W_MEM)+1)
			UIC_MEMBER_1(2) = RECORD_1(%loc(UAF$W_MEM)+2)
			UIC_GROUP_1(1) = RECORD_1(%loc(UAF$W_GRP)+1)
			UIC_GROUP_1(2) = RECORD_1(%loc(UAF$W_GRP)+2)
			IF ( uic_group .NE. access_group .OR.
	1		     uic_member .NE. access_member) THEN
			    record = ' '
			    RECORD_1(%loc(UAF$W_MEM)+1) = 0
			    RECORD_1(%loc(UAF$W_MEM)+2) = 0
			    RECORD_1(%loc(UAF$W_GRP)+1) = 0
			    RECORD_1(%loc(UAF$W_GRP)+2) = 0
			    record_s = LEN( record)
			    ENDIF
			ENDIF
C
		    ENDIF	!continue_status ? 1
C
300	    FORMAT( Q, A )
C
		ENDIF
C
C	  Unlock the record so other user's may get to it.
C
	    UNLOCK( UAF_UNIT )
	    GOTO 400
399	    CONTINUE
C
C	      I/O error.
C
		CALL ERRSNS( FOR_ERR, RMS_CC, RMS_STATUS, ERR_UNIT, VAX_CC )
		CLOSE( UNIT=uaf_unit )
		CALL LIB$STOP(%VAL(RMS_CC))
400	    CONTINUE
	    ENDIF
C
C   ---------------------------------------------------------------------------
C
C     Store the requested values in the local symbols passed.
C
	IF ( UIC_STATUS .EQ. 1 ) THEN
C
C	  Fetch the member value from the record and convert to octal text.
C
	    UIC_MEMBER_1(1) = RECORD_1(%loc(UAF$W_MEM)+1)
	    UIC_MEMBER_1(2) = RECORD_1(%loc(UAF$W_MEM)+2)
	    STATUS = OTS$CVT_L_TO( UIC_MEMBER, UIC_MEMBER_C, %val(1), %val(2) )
	    M1 = LIB$SKPC( ' ', UIC_MEMBER_C )
C
C	  Fetch the group UIC from the record and convert to octal text.
C
	    UIC_GROUP_1(1) = RECORD_1(%loc(UAF$W_GRP)+1)
	    UIC_GROUP_1(2) = RECORD_1(%loc(UAF$W_GRP)+2)
	    STATUS = OTS$CVT_L_TO( UIC_GROUP, UIC_GROUP_C, %val(1), %val(2) )
	    G1 = LIB$SKPC( ' ', UIC_GROUP_C )
C
C	  Create the local symbol.
C
	    STATUS = LIB$SET_SYMBOL( UIC_SYM(1:UIC_SYM_S),
	1	'[' // UIC_GROUP_C(G1:) // ',' // UIC_MEMBER_C(M1:) // ']' )
	ENDIF
C
	IF ( USERNAME_STATUS .EQ. 1 ) THEN
	    U1 = %loc(UAF$T_USERNAME)+1
	    U2 = U1 + (USERNAMEZ-1)
	    STATUS = STR$TRIM( USERNAME_C, RECORD(U1:U2), USERNAME_S )
	    STATUS = LIB$SET_SYMBOL
	1	( USERNAME_SYM(1:USERNAME_SYM_S), USERNAME_C(1:USERNAME_S) )
	    IF ( username_s .EQ. 0) GOTO 88888
	ENDIF
C
	IF ( DEVICE_STATUS .EQ. 1 ) THEN
	    D1 = %loc(UAF$T_DEFDEV)+1
	    D2 = D1 + RECORD_1(D1)
	    STATUS = STR$TRIM( DEVICE_C, RECORD(D1+1:D2), DEVICE_S )
	    STATUS = LIB$SET_SYMBOL
	1	( DEVICE_SYM(1:DEVICE_SYM_S), DEVICE_C(1:DEVICE_S) )
	ENDIF
C
	IF ( DIRECTORY_STATUS .EQ. 1 ) THEN
	    D1 = %loc(UAF$T_DEFDIR)+1
	    D2 = D1 + RECORD_1(D1)
	    STATUS = STR$TRIM( DIRECTORY_C, RECORD(D1+1:D2), DIRECTORY_S )
	    STATUS = LIB$SET_SYMBOL
	1	( DIRECTORY_SYM(1:DIRECTORY_SYM_S),
	1		DIRECTORY_C(1:DIRECTORY_S) )
	ENDIF
C
	IF ( ACCOUNT_STATUS .EQ. 1 ) THEN
	    A1 = %loc(UAF$T_ACCOUNT)+1
	    A2 = A1 + (ACCOUNTZ-1)
	    STATUS = STR$TRIM( ACCOUNT_C, RECORD(A1:A2), ACCOUNT_S )
	    STATUS = LIB$SET_SYMBOL
	1	( ACCOUNT_SYM(1:ACCOUNT_SYM_S), ACCOUNT_C(1:ACCOUNT_S) )
	ENDIF
C
	IF ( OWNER_STATUS .EQ. 1 ) THEN
	    O1 = %loc(UAF$T_OWNER)+1
	    O2 = O1 + (OWNERZ-1)
	    STATUS = STR$TRIM( OWNER_C, RECORD(O1:O2), OWNER_S )
	    STATUS = LIB$SET_SYMBOL
	1	( OWNER_SYM(1:OWNER_SYM_S), OWNER_C(1:OWNER_S) )
	ENDIF
C
	IF ( ctrly_STATUS .EQ. 1 ) THEN
	    b1 = %loc(UAF$B_FLAGS)+1
	    b1 = ZEXT(record_1(b1))
	    b2 = %loc(UAF$V_DISCTLY)
	    IF (BTEST(b1,b2)) THEN
		CALL LIB$SET_SYMBOL( ctrly_SYM(1:ctrly_SYM_S), 'NO' )
		ELSE
		CALL LIB$SET_SYMBOL( ctrly_SYM(1:ctrly_SYM_S), 'YES' )
		ENDIF
	ENDIF
C
	IF ( captive_STATUS .EQ. 1 ) THEN
	    b1 = %loc(UAF$B_FLAGS)+1
	    b1 = ZEXT(record_1(b1))
	    b2 = %loc(UAF$V_CAPTIVE)
	    IF (BTEST(b1,b2)) THEN
		CALL LIB$SET_SYMBOL( captive_SYM(1:captive_SYM_S), 'YES' )
		ELSE
		CALL LIB$SET_SYMBOL( captive_SYM(1:captive_SYM_S), 'NO' )
		ENDIF
	ENDIF
C
	IF ( disuser_STATUS .EQ. 1 ) THEN
	    b1 = %loc(UAF$B_FLAGS)+1
	    b1 = ZEXT(record_1(b1))
	    b2 = %loc(UAF$V_DISACNT)
	    IF (BTEST(b1,b2)) THEN
		CALL LIB$SET_SYMBOL( disuser_SYM(1:disuser_SYM_S), 'YES' )
		ELSE
		CALL LIB$SET_SYMBOL( disuser_SYM(1:disuser_SYM_S), 'NO' )
		ENDIF
	ENDIF
C
	IF ( newmail_STATUS .EQ. 1 ) THEN
	    b1 = %loc(UAF$B_FLAGS)+1
	    b1 = ZEXT(record_1(b1))
	    b2 = %loc(UAF$V_DISMAIL)
	    IF (BTEST(b1,b2)) THEN
		CALL LIB$SET_SYMBOL( newmail_SYM(1:newmail_SYM_S), 'NO' )
		ELSE
		CALL LIB$SET_SYMBOL( newmail_SYM(1:newmail_SYM_S), 'YES' )
		ENDIF
	ENDIF
C
	IF ( welcome_STATUS .EQ. 1 ) THEN
	    b1 = %loc(UAF$B_FLAGS)+1
	    b1 = ZEXT(record_1(b1))
	    b2 = %loc(UAF$V_DISWELCOM)
	    IF (BTEST(b1,b2)) THEN
		CALL LIB$SET_SYMBOL( welcome_SYM(1:welcome_SYM_S), 'NO' )
		ELSE
		CALL LIB$SET_SYMBOL( welcome_SYM(1:welcome_SYM_S), 'YES' )
		ENDIF
	ENDIF
C
	IF ( NEXT_UIC_MEMBER_STATUS .EQ. 1 ) THEN
	    STATUS = OTS$CVT_L_TO( ACCESS_MEMBER, NEXT_UIC_MEMBER_C,
	1				%val(1), %val(2) )
	    N1 = LIB$SKPC( ' ', NEXT_UIC_MEMBER_C )
	    STATUS = LIB$SET_SYMBOL
	1	( NEXT_UIC_MEMBER_SYM(1:NEXT_UIC_MEMBER_SYM_S),
	1		NEXT_UIC_MEMBER_C(N1:) )
	ENDIF
C
C   ---------------------------------------------------------------------------
C
C     Close the User Authorization File.
C
88888	CONTINUE
	CLOSE( UNIT=UAF_UNIT )
C
C   ---------------------------------------------------------------------------
C
C     Exit.
C
	END