10	! ----- DISK$PGM:[LOMASKY.COMMON.SD.NEW]SD.BAS -----
	! ----- Last Change 10/18/90 by Brian Lomasky (matches SD_VERSION) -----
	! ----- Program to handle default directory changes -----
	!
	! ----- Requires:  VAX BASIC V3.0+ -----
	!
	! ----- Note:  This program must be installed with CMEXEC -----
	!
	OPTION TYPE = EXPLICIT			! Force Explicit Declarations

	ON ERROR GOTO ERROR_ROUTINE		! Trap Errors

	DECLARE STRING CONSTANT SD_VERSION = "90.10.18"

	%INCLUDE "$ATRDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$DCDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$DVIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$LNMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$PRVDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"

	EXTERNAL LONG CONSTANT IO$_ACCESS	! ACP QIO Access Function Code
	EXTERNAL LONG CONSTANT JPI$_AUTHPRIV	! Authorized Privileges
	EXTERNAL LONG CONSTANT JPI$_CURPRIV	! Current Privileges
	EXTERNAL LONG CONSTANT JPI$_GRP		! GETJPI UIC Group Number
	EXTERNAL LONG CONSTANT JPI$_MEM		! GETJPI UIC Member Number
	EXTERNAL LONG CONSTANT LIB$_NOSUCHSYM	! No Such Symbol
	EXTERNAL LONG CONSTANT RMS$_DIR		! Error in Directory Name
	EXTERNAL LONG CONSTANT RMS$_IAL		! Error in Argument List
	EXTERNAL LONG CONSTANT RMS$_NORMAL	! Success Status
	EXTERNAL LONG CONSTANT SS$_IVDEVNAM	! Invalid Device Name
	EXTERNAL LONG CONSTANT SS$_IVLOGNAM	! Invalid Logical Name
	EXTERNAL LONG CONSTANT SS$_NOLOGNAM	! No Logical Name Translation
	EXTERNAL LONG CONSTANT SS$_NONLOCAL	! Device is on a Remote System
	EXTERNAL LONG CONSTANT SS$_NORMAL	! Normal Return Status
	EXTERNAL LONG CONSTANT SS$_NOSUCHDEV	! No Such Device
	EXTERNAL LONG CONSTANT SS$_NOSUCHFILE	! No Such File

	DECLARE WORD CONSTANT TRUE = (1% = 1%)	! Truth Condition
	DECLARE WORD CONSTANT FALSE = NOT TRUE	! Obviously not the Truth

	! ----- BASIC ERROR CODES RETURNED BY ERR -----
	DECLARE WORD CONSTANT BUCKET_LOCKED	= 154%
	DECLARE WORD CONSTANT END_OF_FILE	= 11%
	DECLARE WORD CONSTANT REC_NOT_FOUND	= 155%

	DECLARE STRING CONSTANT BLINK_VIDEO =				&
		ESC + "[5m"			! Blink Video Attribute
	DECLARE STRING CONSTANT BOLD_VIDEO =				&
		ESC + "[1m"			! Bold Video Attribute
	! ----- TO RETURN ERROR (2) IN $STATUS BUT HAVE NO MESSAGE -----
	! ----- DISPLAYED ON THE SCREEN, ALSO SET BIT 28 (HEX 10000000) IN -----
	! ----- THE VALUE YOU PASS TO SYS$EXIT -----
	DECLARE LONG CONSTANT ERROR_WITH_NO_PUTMSG = X"10000002"L
	DECLARE LONG CONSTANT MAKE_POS = 65536%	! Offset for Positive Longword
	DECLARE STRING CONSTANT NORMAL_VIDEO =				&
		ESC + "[m"			! Normal Video Attribute
	DECLARE WORD CONSTANT NUMBER_OF_RANDOM_PROMPTS = 11%
	DECLARE STRING CONSTANT QUOTE = '"'	! Quote Character
	DECLARE STRING CONSTANT REVERSE_VIDEO =				&
		ESC + "[7m"			! Reverse Video Attribute
	DECLARE LONG CONSTANT STRIP_HIGH_BIT =				&
		268435455%			! Longword to Strip the High Bit
	DECLARE STRING CONSTANT UNDERLINE_VIDEO =			&
		ESC + "[4m"			! Underline Video Attribute
	DECLARE WORD CONSTANT UPPERCASE = 32%	! For EDIT$ Function

	EXTERNAL SUB GETFID(STRING BY DESC,				&
		WORD DIM() BY REF)		! Get File-ID Subprogram
	EXTERNAL SUB LIB$DO_COMMAND		! Execute DCL Command Line
	EXTERNAL LONG FUNCTION LIB$GET_FOREIGN	! Get Foreign Command Line
	EXTERNAL LONG FUNCTION LIB$GET_SYMBOL	! Get a DCL Symbol
	EXTERNAL LONG FUNCTION LIB$SET_SYMBOL	! Store a DCL Symbol
	EXTERNAL LONG FUNCTION LIB$SYS_GETMSG	! Retrieve System Message
	EXTERNAL LONG SETPRIV			! Set/Reset Process Privileges
	EXTERNAL LONG FUNCTION SYS$ASSIGN	! Assign I/O Channel
	EXTERNAL LONG FUNCTION SYS$CMEXEC	! Change Mode to Executive
	EXTERNAL LONG FUNCTION SYS$DASSGN	! Deassign I/O Channel
	EXTERNAL LONG FUNCTION SYS$EXIT		! EXIT PROCESS WITH STATUS
	EXTERNAL LONG FUNCTION SYS$GETDVI	! Get Device Information
	EXTERNAL LONG FUNCTION SYS$GETJPIW	! Get Job/Process Status
	EXTERNAL LONG FUNCTION SYS$QIOW		! Queue I/O Request and Wait
	EXTERNAL LONG FUNCTION SYS$SETDDIR	! Get/Set Default Directory
	EXTERNAL LONG FUNCTION SYS$TRNLNM	! Translate Logical Name

	RECORD ATTR_CONTROL_BLOCK		! ATTRIBUTE LIST TEMPLATE
		WORD	ATTRIBUTE_SIZE		! NUMBER OF BYTES TO TRANSFER
		WORD	ATTRIBUTE_TYPE		! ATTRIBUTE TYPE TO READ/WRITE
		LONG	BUFFER_ADDRESS		! BUFFER ADDRESS OF ATTRIBUTE
		LONG	LIST_TERMINATOR		! ATTRIB CONTROL BLK TERMINATOR
	END RECORD ATTR_CONTROL_BLOCK

	RECORD DVIBUF
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		LONG LIST_TERMINATOR
	END RECORD DVIBUF

	RECORD FIB				! "SHORT" FIB BLOCK
		VARIANT
		CASE
			LONG	FIB$L_ACCTL	! FLAG BITS THAT CONTROL ACCESS
		CASE
			STRING	FIB$$FILL_1 = 3%
			BYTE	FIB$B_WSIZE	! SIZE OF THE FILE WINDOW
		END VARIANT
		WORD	FIB$W_FID(2%)		! SPECIFIES THE FILE ID
		WORD	FIB$W_DID(2%)		! FILE ID OF THE DIRECTORY
		LONG	FIB$L_WCC		! MAINTAINS POSITION CONTEXT
		WORD	FIB$W_NMCTL		! FLAG BITS TO CONTROL NAME STR
	END RECORD FIB

	RECORD JPIBUF
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		WORD BUFFER_LENGTH3
		WORD ITEM_CODE3
		LONG BUFFER_ADDRESS3
		LONG RETURN_LENGTH_ADDRESS3
		WORD BUFFER_LENGTH4
		WORD ITEM_CODE4
		LONG BUFFER_ADDRESS4
		LONG RETURN_LENGTH_ADDRESS4
		LONG LIST_TERMINATOR
	END RECORD JPIBUF

	RECORD OWNER_UIC			! TEMPLATE FOR UIC ATTRIBUTE
		WORD	OWNER_UIC_MEMBER	! DECIMAL MEMBER UIC
		WORD	OWNER_UIC_GROUP		! DECIMAL GROUP UIC
	END RECORD OWNER_UIC

	RECORD TRNBUF
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		LONG LIST_TERMINATOR
	END RECORD TRNBUF

	RECORD TRNBUF2
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		WORD BUFFER_LENGTH3
		WORD ITEM_CODE3
		LONG BUFFER_ADDRESS3
		LONG RETURN_LENGTH_ADDRESS3
		LONG LIST_TERMINATOR
	END RECORD TRNBUF2

	DECLARE DVIBUF DVIITEM			! Equate GETDVI record
	DECLARE JPIBUF JPIITEM			! Equate GETJPI record
	DECLARE TRNBUF TRNITEM			! Equate TRNLNM record
	DECLARE TRNBUF2 TRNITEM2		! Equate TRNLNM record

	MAP (DDIR)	STRING	CURR_DIR = 150%	! Current Directory

	MAP (DVI1)	LONG	MOUNTED,	! Mounted Device?	&
			LONG	DEVICE_CLASS	! Device Class

	MAP (FIB1)	FIB	USER_FIB	! Specifies Format of FIB
	MAP (FIB1)	STRING	FIB_BUF = 22%	! Used in QIOW Call

	MAP (JPI1)	LONG	AUTHPRIV(1%),	! Authorized Privileges	&
			LONG	CURPRIV(1%),	! Current Privileges	&
			LONG	UIC_GROUP,	! UIC Group Number	&
			LONG	UIC_MEMBER	! UIC Member Number

	MAP (PRIV1)	LONG	PRV_ADR(1%)	! Privilege bit settings
	MAP (PRIV2)	LONG	ENABLE_FLAG	! Enable/Disable Priv Flag

	MAP (TRNL1)	STRING	LOG_NAME = 255%,! Logical Name String	&
			LONG	LOG_ATTRIB,	! Logical Name Attribute&
			LONG	LNM_INDEX	! Logical Name Index

	MAP (UAF)	STRING UAF_REC = 1412%

	MAP (UAF)	STRING FILL = 4%,				&
			STRING USER_NAME_NO_TAG = 31%

	MAP (UAF)	STRING FILL = 4%,				&
			! ----- USER_NAME IS THE PRIMARY KEY -----	&
			! ----- (NO DUPLICATES, NO CHANGES) -----	&
			STRING USER_NAME = 32%,		! ALJTB		&
			STRING FILL = 80%,				&
			BYTE DEVICE_LENGTH,				&
			STRING THE_DEVICE = 31%

	DECLARE ATTR_CONTROL_BLOCK ATTR		! Attribute List
	DECLARE WORD AUTHPRIV_LENGTH		! Length of Authorized Privs
	DECLARE WORD BYPASS_ON			! TRUE if BYPASS priv is on
		BYPASS_ON = FALSE		! Assume BYPASS not on
	DECLARE WORD CHAN			! I/O Channel Number
	DECLARE WORD CHECK_FOR_SOMETHING_FLAG	! True if Jumped to CHECK_FOR...
	DECLARE WORD CMKRNL_ON			! TRUE if CMKRNL priv is on
		CMKRNL_ON = FALSE		! Assume CMKRNL not on
	DECLARE STRING COMMAND_FILE		! Command File Name to Execute
		COMMAND_FILE = ""		! Init string in case of error
	DECLARE STRING COMMAND_STRING		! Command Line Parameters
	DECLARE WORD COMMAND_STRING_LENGTH	! Length of Command Line Params
	DECLARE STRING CUR_DEV			! Current User Device
	DECLARE STRING CUR_DEVDIR		! Current User Device/Directory
	DECLARE STRING CUR_DIR			! Current User Directory
	DECLARE WORD CURPRIV_LENGTH		! Length of Current Privs
	DECLARE WORD CURR_DIR_LEN		! Length of Current Directory
	DECLARE WORD DEBUG			! TRUE if SD_DEBUG is defined
		DEBUG = FALSE			! Assume SD_DEBUG not defined
	DECLARE LONG DEC_INPUT			! Decimal Input for DECOCT
	DECLARE LONG DEVICE_CLASS_LENGTH	! Length of DEVICE_CLASS
	DECLARE WORD DOT_COUNTER		! Counter of Subdirectories
	DECLARE WORD ERROR_FLAG			! Error Trapping Flag
	DECLARE STRING ERROR_LINE		! Variable to Hold Label
	DECLARE LONG FUNC			! Function Code
	DECLARE LONG GLOBAL			! LIB$SET_SYMBOL Table
		GLOBAL = 2%			! Store Global Symbols
	DECLARE WORD INDEX			! SD_INDEX Value
	DIM WORD IOSB(3%)			! I/O Status Block
	DECLARE WORD LAST_DOT			! Last Subdirectory Position
	DECLARE WORD LNM_INDEX_LENGTH		! Length of Logical Name Index
	DECLARE WORD LOG_ATTRIB_LENGTH		! Length of Logical Attributes
	DECLARE WORD LOG_NAME_LENGTH		! Length of Logical Name
	DECLARE STRING LOG_PARM			! Logical Parameter
	DECLARE LONG LONG_OWNER_UIC_GROUP	! Longword Decimal Group UIC
	DECLARE LONG LONG_OWNER_UIC_MEMBER	! Longword Decimal Member UIC
	DECLARE WORD LOOP_FLAG			! TRUE to iterate loop
	DECLARE WORD MINUS_COUNTER		! Counter for Minus Signs
	DECLARE LONG MOUNTED_LENGTH		! Mounted Device Buffer Length
	DECLARE STRING NEW_DEV			! New Device Specifier
	DECLARE STRING NEW_DEV_UNCONCEALED	! New Unconcealed Dev Specifier
	DECLARE STRING NEW_DIR			! New Directory Specifier
	DECLARE STRING NEW_DIR_UNCONCEALED	! New Unconcealed Dir Specifier
	DECLARE STRING NEW_UIC			! New UIC Specifier
	DECLARE STRING NODE_NAME		! Name of the current node
	DECLARE WORD NO_LOGICAL_NAME_FOUND	! True if No Logical Name Found
	DECLARE LONG OCT_OUTPUT			! Octal Output
	DECLARE STRING PREV_DIR			! Previous Level Directory
	DECLARE LONG PREV_LNM_INDEX		! Previous LNM Index Value
	DECLARE STRING PREV_PRIV		! Previous Privilege String
	DECLARE WORD PRIVILEGED			! Users Privilege Status
	DECLARE STRING PROMPT_LOGICAL		! Logical pointed by SD_PROMPT
	DIM STRING RANDOM_PROMPTS(NUMBER_OF_RANDOM_PROMPTS)
	DECLARE WORD RESUME_WITH_ERROR_TRAP	! True to go back to error trap
	DECLARE STRING SD_COUNTER		! Last Directory Index Counter
	DECLARE STRING SD_INDEX			! Index for last SD_COUNTER
	DECLARE WORD SETPRV_ALLOWED		! TRUE if SETPRV is authorized
		SETPRV_ALLOWED = FALSE		! Assume SETPRV not allowed
	DECLARE WORD STORE_UNCONCEALED_LOGICAL	! TRUE=Store Unconcealed Logical
	DECLARE	LONG SYS_STATUS			! Longword to Receive Status
	DECLARE STRING SYSTEM_OUTPUT		! Output String for $GETMSG
	DECLARE WORD SYSUAF_ALREADY_TRIED	! True if we searched the SYSUAF
	DECLARE STRING SYSUAF_FILE_SPEC		! SYSUAF Logical Translation
	DECLARE WORD TEMP			! Temporary Word Storage
	DECLARE WORD TEMP2			! Temporary Word Storage
	DECLARE STRING TEMP_STRING		! Temporary String Storage
	DECLARE STRING TEMP_STRING2		! Temporary String Storage
	DECLARE WORD TURNED_BYPASS_ON		! True if BYPASS was turned on
	DECLARE OWNER_UIC UIC			! UIC Attribute for ACP QIO
	DECLARE WORD UIC_GROUP_LENGTH		! Length of the UIC Group
	DECLARE WORD UIC_MEMBER_LENGTH		! Length of the UIC Member
	DECLARE STRING VIDEO_ATTRIBUTE		! Video Attribute for Prompt

	! ----- Initialize the Attributes List for the ACP QIO -----
	ATTR::ATTRIBUTE_SIZE	= ATR$S_UIC_RO	! Size of ATR$C_UIC_RO
	ATTR::ATTRIBUTE_TYPE	= ATR$C_UIC_RO	! Returns 4-byte Owner UIC
	ATTR::BUFFER_ADDRESS	= LOC(UIC)	! Buffer to Store UIC
	ATTR::LIST_TERMINATOR	= 0%		! Attribute List Terminator

	! ----- Get Device Mounted Information and Device Class -----
	DVIITEM::BUFFER_LENGTH1		= 4
	DVIITEM::ITEM_CODE1		= DVI$_MOUNTCNT
	DVIITEM::BUFFER_ADDRESS1	= LOC(MOUNTED)
	DVIITEM::RETURN_LENGTH_ADDRESS1	= LOC(MOUNTED_LENGTH)
	DVIITEM::BUFFER_LENGTH2		= 4
	DVIITEM::ITEM_CODE2		= DVI$_DEVCLASS
	DVIITEM::BUFFER_ADDRESS2	= LOC(DEVICE_CLASS)
	DVIITEM::RETURN_LENGTH_ADDRESS2	= LOC(DEVICE_CLASS_LENGTH)
	DVIITEM::LIST_TERMINATOR	= 0

	! ----- Get This Users Authorized and Current Privileges, -----
	! ----- UIC Group, and UIC Member Numbers -----
	JPIITEM::BUFFER_LENGTH1		= 8%
	JPIITEM::ITEM_CODE1		= JPI$_AUTHPRIV
	JPIITEM::BUFFER_ADDRESS1	= LOC(AUTHPRIV(0%))
	JPIITEM::RETURN_LENGTH_ADDRESS1	= LOC(AUTHPRIV_LENGTH)
	JPIITEM::BUFFER_LENGTH2		= 8%
	JPIITEM::ITEM_CODE2		= JPI$_CURPRIV
	JPIITEM::BUFFER_ADDRESS2	= LOC(CURPRIV(0%))
	JPIITEM::RETURN_LENGTH_ADDRESS2	= LOC(CURPRIV_LENGTH)
	JPIITEM::BUFFER_LENGTH3		= 4
	JPIITEM::ITEM_CODE3		= JPI$_GRP
	JPIITEM::BUFFER_ADDRESS3	= LOC(UIC_GROUP)
	JPIITEM::RETURN_LENGTH_ADDRESS3	= LOC(UIC_GROUP_LENGTH)
	JPIITEM::BUFFER_LENGTH4		= 4
	JPIITEM::ITEM_CODE4		= JPI$_MEM
	JPIITEM::BUFFER_ADDRESS4	= LOC(UIC_MEMBER)
	JPIITEM::RETURN_LENGTH_ADDRESS4	= LOC(UIC_MEMBER_LENGTH)
	JPIITEM::LIST_TERMINATOR	= 0%

	! ----- Translate Logical Name -----
	TRNITEM::BUFFER_LENGTH1		= 255%
	TRNITEM::ITEM_CODE1		= LNM$_STRING
	TRNITEM::BUFFER_ADDRESS1	= LOC(LOG_NAME)
	TRNITEM::RETURN_LENGTH_ADDRESS1	= LOC(LOG_NAME_LENGTH)
	TRNITEM::BUFFER_LENGTH2		= 4%
	TRNITEM::ITEM_CODE2		= LNM$_ATTRIBUTES
	TRNITEM::BUFFER_ADDRESS2	= LOC(LOG_ATTRIB)
	TRNITEM::RETURN_LENGTH_ADDRESS2	= LOC(LOG_ATTRIB_LENGTH)
	TRNITEM::LIST_TERMINATOR	= 0%

	TRNITEM2::BUFFER_LENGTH1	= 4%
	TRNITEM2::ITEM_CODE1		= LNM$_INDEX
	TRNITEM2::BUFFER_ADDRESS1	= LOC(LNM_INDEX)
	TRNITEM2::RETURN_LENGTH_ADDRESS1= LOC(LNM_INDEX_LENGTH)
	TRNITEM2::BUFFER_LENGTH2	= 4%
	TRNITEM2::ITEM_CODE2		= LNM$_ATTRIBUTES
	TRNITEM2::BUFFER_ADDRESS2	= LOC(LOG_ATTRIB)
	TRNITEM2::RETURN_LENGTH_ADDRESS2= LOC(LOG_ATTRIB_LENGTH)
	TRNITEM2::BUFFER_LENGTH3	= 255%
	TRNITEM2::ITEM_CODE3		= LNM$_STRING
	TRNITEM2::BUFFER_ADDRESS3	= LOC(LOG_NAME)
	TRNITEM2::RETURN_LENGTH_ADDRESS3= LOC(LOG_NAME_LENGTH)
	TRNITEM2::LIST_TERMINATOR	= 0%

	! ----- Decimal to Octal Conversion Function -----
	DEF STRING DECOCT(LONG DEC_UIC)
		OCT_OUTPUT = 0%
		DEC_INPUT = DEC_UIC
		FOR TEMP = 5% TO 0% STEP -1%
			TEMP2 = INT(DEC_INPUT / 8% ^ TEMP)
			IF TEMP2 > 0% THEN
				OCT_OUTPUT = OCT_OUTPUT + TEMP2 * 10% ^ TEMP
				DEC_INPUT = DEC_INPUT - 8% ^ TEMP * TEMP2
			END IF
		NEXT TEMP
		DECOCT = NUM1$(OCT_OUTPUT)
	END DEF

	! ----- Function to Remove Trailing Colon, if any -----
	DEF STRING ELIMINATE_COLON(STRING INPUT_STRING)

		IF RIGHT(INPUT_STRING, LEN(INPUT_STRING)) = ":" THEN
			INPUT_STRING = LEFT(INPUT_STRING,		&
				LEN(INPUT_STRING) - 1%)
		END IF
		ELIMINATE_COLON = INPUT_STRING

	END DEF

	! ----- Function to Eliminate any Leading Underscore Characters -----
	DEF STRING ELIMINATE_UNDERSCORES(STRING INPUT_STRING)

		WHILE LEFT(INPUT_STRING, 1%) = "_"
			INPUT_STRING = RIGHT(INPUT_STRING, 2%)
		NEXT
		ELIMINATE_UNDERSCORES = INPUT_STRING

	END DEF

	! ----- Local Function to Check for SDLOGIN.COM -----
	DEF WORD CHECK_SDLOGIN

		CHECK_SDLOGIN = FALSE		! Assume SDLOGIN does not exist

		ON ERROR GOTO CHECK_SDLOGIN_ERROR

		! ----- Try to open SDLOGIN.COM -----
		TEMP_STRING = NEW_DEV + ":" + NEW_DIR + "SDLOGIN.COM"
		ERROR_LINE = "opening SDLOGIN"
		PRINT "SD DEBUG>Searching for "; TEMP_STRING IF DEBUG
		OPEN TEMP_STRING FOR INPUT AS FILE #1%, RECORDSIZE 1%,	&
			ACCESS READ, ALLOW READ
		ERROR_LINE = "done opening SDLOGIN"

		CLOSE #1%
		CHECK_SDLOGIN = TRUE		! Set for existing SDLOGIN.COM
		EXIT DEF

 CHECK_SDLOGIN_ERROR:

		IF ERROR_LINE = "opening SDLOGIN" THEN
			ERROR_LINE = "done opening SDLOGIN"
			RESUME NO_SDLOGIN
		END IF
		ON ERROR GO BACK

 NO_SDLOGIN:

	END DEF

	! ----- Local Function to Check for SDLOGOFF.COM -----
	DEF WORD CHECK_SDLOGOFF

		CHECK_SDLOGOFF = FALSE		! Assume SDLOGOFF does not exist

		ON ERROR GOTO CHECK_SDLOGOFF_ERROR

		! ----- Try to open SDLOGOFF.COM -----
		ERROR_LINE = "opening SDLOGOFF"
		PRINT "SD DEBUG>Searching for SDLOGOFF.COM" IF DEBUG
		OPEN "SDLOGOFF.COM" FOR INPUT AS FILE #1%,		&
			RECORDSIZE 1%, ACCESS READ, ALLOW READ
		ERROR_LINE = "done opening SDLOGOFF"

		CLOSE #1%
		CHECK_SDLOGOFF = TRUE		! Set for existing SDLOGOFF.COM
		EXIT DEF

 CHECK_SDLOGOFF_ERROR:

		IF ERROR_LINE = "opening SDLOGOFF" THEN
			ERROR_LINE = "done opening SDLOGOFF"
			RESUME NO_SDLOGOFF
		END IF
		ON ERROR GO BACK

 NO_SDLOGOFF:

	END DEF

	! ----- Local function to open the SYSUAF file and to read a -----
	! ----- record to get the Default Device for a Username, -----
	! ----- Returns FALSE if Passed Username matches a SYSUAF record -----
	DEF WORD READ_UAF(STRING USERNAME_TO_CHECK)

		TURNED_BYPASS_ON = FALSE	! Init Flag

		READ_UAF = TRUE			! Assume error status

		ON ERROR GOTO READ_UAF_ERROR

		! ----- See if User Name can not be in the SYSUAF file -----
		EXIT DEF IF LEN(TRM$(USERNAME_TO_CHECK)) = 0%
		EXIT DEF IF POS(TRM$(USERNAME_TO_CHECK), " ", 1%) > 0%
		EXIT DEF IF POS(USERNAME_TO_CHECK, ".", 1%) > 0%
		EXIT DEF IF POS(USERNAME_TO_CHECK, "[", 1%) > 0%
		EXIT DEF IF POS(USERNAME_TO_CHECK, "]", 1%) > 0%
		EXIT DEF IF POS(USERNAME_TO_CHECK, ",", 1%) > 0%
		EXIT DEF IF POS(USERNAME_TO_CHECK, ":", 1%) > 0%

		! ----- Translate any SYSUAF Logical Name -----
		SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL",		&
			"SYSUAF", , TRNITEM)
		ERROR_LINE = "TRANSLATE SYSUAF"
		SELECT SYS_STATUS
		CASE SS$_NOLOGNAM	! If no logical equivalent:
			! ----- Clear SYS_STATUS Error Condition -----
			SYS_STATUS = SS$_NORMAL
			SYSUAF_FILE_SPEC = "SYS$SYSTEM:SYSUAF.DAT"
		CASE SS$_NORMAL
			! ----- Extract Logical Name -----
			IF LOG_NAME_LENGTH > 1% THEN
				SYSUAF_FILE_SPEC = LEFT(LOG_NAME,	&
					LOG_NAME_LENGTH)
			ELSE
				SYSUAF_FILE_SPEC = "SYS$SYSTEM:SYSUAF.DAT"
			END IF
		CASE ELSE
			EXIT DEF
		END SELECT

		IF NOT SETPRV_ALLOWED THEN
			! ----- If user does not have the SETPRIV -----
			! ----- privilege, ensure BYPASS privilege is -----
			! ----- turned on (SD is already installed with -----
			! ----- the CMEXEC privilege) -----
			IF NOT BYPASS_ON THEN
				! ----- Set the Privileges to be Enabled -----
				PRV_ADR(0%) = 0%! Clear Privilege Mask
				! ----- Set to turn on BYPASS Priv -----
				PRV_ADR(0%) = PRV_ADR(0%) OR PRV$M_BYPASS
				PRV_ADR(1%) = 0%
				ERROR_LINE = "setting BYPASS on"
				ENABLE_FLAG = 1%! Set Flag to "ENABLE"
				! ----- Call $CMEXEC to change access to -----
				! ----- Executive Mode and Execute the -----
				! ----- SETPRIV Routine.  -----
				! ----- Note: Process Deletion will Occur -----
				! ----- if Errors are Encountered in -----
				! ----- Executive Mode. -----
				SYS_STATUS = SYS$CMEXEC(SETPRIV,)
				EXIT DEF IF SYS_STATUS <> SS$_NORMAL
				TURNED_BYPASS_ON = TRUE
			END IF
		END IF

		! ----- Try to Open the SYSUAF File -----
		ERROR_LINE = "trying to open " + SYSUAF_FILE_SPEC
		ERROR_FLAG = 1%
		OPEN SYSUAF_FILE_SPEC FOR INPUT AS FILE #9%,		&
			RECORDSIZE 1412%,				&
			ACCESS READ,					&
			ALLOW MODIFY,					&
			INDEXED VARIABLE,				&
			MAP UAF,					&
			RECORDTYPE ANY
		ERROR_FLAG = 0%

		USER_NAME = USERNAME_TO_CHECK	! Store Primary Key to search
		GET #9%, KEY #0% GE USER_NAME, REGARDLESS
		CLOSE #9%
		GOTO ENSURE_BYPASS_OFF IF TRM$(USER_NAME_NO_TAG) <>	&
			TRM$(USERNAME_TO_CHECK)
		READ_UAF = FALSE		! Return Success Status

	ENSURE_BYPASS_OFF:

		! ----- Ensure BYPASS privilege is turned on if we turned -----
		! ----- it on -----
		IF TURNED_BYPASS_ON THEN
			! ----- Set the Privileges to be Disabled -----
			PRV_ADR(0%) = 0%	! Clear Privilege Mask
			! ----- Set to turn off BYPASS Priv -----
			PRV_ADR(0%) = PRV_ADR(0%) OR PRV$M_BYPASS
			PRV_ADR(1%) = 0%
			ERROR_LINE = "setting BYPASS off"
			ENABLE_FLAG = 0%	! Set Flag to "DISABLE"
			! ----- Call $CMEXEC to change access to Executive -----
			! ----- Mode and Execute the SETPRIV Routine.  -----
			! ----- Note: Process Deletion will Occur if -----
			! ----- Errors are Encountered in Executive Mode. -----
			SYS_STATUS = SYS$CMEXEC(SETPRIV,)
			EXIT DEF IF SYS_STATUS <> SS$_NORMAL
		END IF
		EXIT DEF			! Exit Function

	 READ_UAF_ERROR:

		IF ERROR_FLAG = 1% THEN
			ERROR_FLAG = 0%
			PRINT "%SD Error Warning:  Error"; ERR;		&
				"while "; ERROR_LINE; BEL
			RESUME ENSURE_BYPASS_OFF
		END IF
		IF ERR = BUCKET_LOCKED THEN	! If bucket is locked?
			SLEEP 1%
			RESUME
		END IF
		RESUME ENSURE_BYPASS_OFF				&
			IF ERR = REC_NOT_FOUND OR ERR = END_OF_FILE
		PRINT "Unexpected error from READ_UAF"; ERR; TIME$(0%)
	END DEF

	! ----- Init flag to indicate we have not searched the SYSUAF ----
	SYSUAF_ALREADY_TRIED = FALSE

	! ----- Turn on debug mode if SD_DEBUG is defined as a logical -----
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", "SD_DEBUG", , TRNITEM)
	ERROR_LINE = "SYS$TRNLNM9"
	IF SYS_STATUS = SS$_NORMAL THEN
		DEBUG = TRUE			! Turn on DEBUG Mode Flag
	ELSE
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NOLOGNAM
	END IF

	! ----- Get any parameters typed after SD -----
	SYS_STATUS = LIB$GET_FOREIGN(COMMAND_STRING, , COMMAND_STRING_LENGTH)
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
	IF COMMAND_STRING_LENGTH = 0% THEN
		COMMAND_STRING = ""
	ELSE
		COMMAND_STRING = EDIT$(LEFT(COMMAND_STRING,		&
			COMMAND_STRING_LENGTH), UPPERCASE)
	END IF

	! ----- Get the info on this process -----
	ERROR_LINE = "GETJPI"
	SYS_STATUS = SYS$GETJPIW(, , , JPIITEM, , , )
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- Check status of user's SETPRIV, BYPASS, and CMKRNL privs -----
	PRIVILEGED = FALSE			! Assume user not privileged
	IF (AUTHPRIV(0%) AND PRV$M_SETPRV) > 0% THEN
		SETPRV_ALLOWED = TRUE
		PRIVILEGED = TRUE		! User is privileged
	ELSE
		SETPRV_ALLOWED = FALSE
	END IF
	IF (CURPRIV(0%) AND PRV$M_BYPASS) > 0% THEN
		BYPASS_ON = TRUE
		PREV_PRIV = "BYPASS"
	ELSE
		BYPASS_ON = FALSE
		PREV_PRIV = "NOBYPASS"
	END IF
	IF (CURPRIV(0%) AND PRV$M_CMKRNL) > 0% THEN
		CMKRNL_ON = TRUE
		PREV_PRIV = PREV_PRIV + ",CMKRNL"
	ELSE
		CMKRNL_ON = FALSE
		PREV_PRIV = PREV_PRIV + ",NOCMKRNL"
	END IF

	! ----- Get SD_COUNTER Parameter -----
	SYS_STATUS = LIB$GET_SYMBOL("SD_COUNTER", SD_COUNTER)
	ERROR_LINE = "LIB$GET_SYMBOL"
	IF SYS_STATUS = LIB$_NOSUCHSYM THEN
		SD_COUNTER = "0"
		SYS_STATUS = SS$_NORMAL
	END IF
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- Get Current Directory -----
	SYS_STATUS = SYS$SETDDIR(, CURR_DIR_LEN, CURR_DIR)
	ERROR_LINE = "SYS$SETDDIR"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> RMS$_NORMAL
	CUR_DIR = LEFT(CURR_DIR, CURR_DIR_LEN)

	! ----- Check for Invalid Characters in Directory Name -----
	IF LEN(COMMAND_STRING) > 1% THEN
		GOTO SYNTAX_ERROR IF LEFT(COMMAND_STRING, 1%) = "*"
		GOTO SYNTAX_ERROR IF LEFT(COMMAND_STRING, 1%) = "<"
	END IF
	IF LEN(COMMAND_STRING) > 0% THEN
		TEMP = POS(COMMAND_STRING, "#", 1%)
		GOTO SYNTAX_ERROR IF TEMP <> 0% AND TEMP <> 1%
		GOTO SYNTAX_ERROR IF POS("!@%^&()+={};'>?/",		&
			MID(COMMAND_STRING, TEMP, 1%), 1%) > 0%		&
				FOR TEMP = 1% TO LEN(COMMAND_STRING)
	END IF

	LNM_INDEX = 0%				! Set to search the first index
	RESUME_WITH_ERROR_TRAP = FALSE		! So as not to go back to trap
	CHECK_FOR_SOMETHING_FLAG = FALSE	! Init CHECK_FOR_SOMETHING Flag

 RESTART_PROGRAM:

	COMMAND_FILE = "@SD_DIR:SD"
	PRINT "SD DEBUG>COMMAND_STRING="; COMMAND_STRING IF DEBUG
	! ----- Process Move to SYS$LOGIN: -----
	IF COMMAND_STRING = "" THEN
		COMMAND_STRING = "SYS$LOGIN:"
		GOTO RESTART_PROGRAM
	END IF
	! ----- Process Move to Previous Directory -----
	IF COMMAND_STRING = "<" THEN
		SYS_STATUS = LIB$GET_SYMBOL("SD_LAST_DIRECTORY", COMMAND_STRING)
		ERROR_LINE = "LIB$GET_SYMBOL3"
		IF SYS_STATUS = LIB$_NOSUCHSYM THEN
			COMMAND_STRING = ""
			SYS_STATUS = SS$_NORMAL
		END IF
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		GOTO RESTART_PROGRAM
	END IF
	! ----- Process List of Previous Directories -----
	IF COMMAND_STRING = "*" THEN
		IF INTEGER(SD_COUNTER, WORD) = 0% THEN
			PRINT "No Previous Directories to Display"
			COMMAND_FILE = ""
			GOTO END_PROGRAM
		END IF

		SYS_STATUS = LIB$GET_SYMBOL("SD_INDEX", SD_INDEX)
		ERROR_LINE = "LIB$GET_SYMBOL9"
		IF SYS_STATUS = LIB$_NOSUCHSYM THEN
			INDEX = 0%
			SYS_STATUS = SS$_NORMAL
		END IF
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		INDEX = INTEGER(SD_INDEX, WORD)

		FOR TEMP = 1% TO INTEGER(SD_COUNTER, WORD)
			TEMP_STRING = "SD_LAST_DIRECTORY" + NUM1$(TEMP)
			SYS_STATUS = LIB$GET_SYMBOL(TEMP_STRING, TEMP_STRING2)
			ERROR_LINE = "LIB$GET_SYMBOL4"
			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

			PRINT USING "###", TEMP;
			IF TEMP = INDEX THEN
				PRINT "    "; TEMP_STRING2; "  <Last Directory>"
			ELSE
				PRINT "    "; TEMP_STRING2
			END IF
		NEXT TEMP
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF
	! ----- Process Move to a Specific Previous Directory -----
	IF LEFT(COMMAND_STRING, 1%) = "#" THEN
		GOTO SYNTAX_ERROR IF LEN(COMMAND_STRING) < 2% OR	&
			LEN(COMMAND_STRING) > 3%
		IF INTEGER(SD_COUNTER, WORD) = 0% THEN
			PRINT "No Previous Directories to Move to"
			COMMAND_FILE = ""
			GOTO END_PROGRAM
		END IF
		TEMP_STRING = RIGHT(COMMAND_STRING, 2%)
		! ----- Ensure Numeric Response -----
		FOR TEMP = 1% TO LEN(TEMP_STRING)
			TEMP2 = ASCII(MID(TEMP_STRING, TEMP, 1%))
			GOTO SYNTAX_ERROR IF TEMP2 < 48% OR TEMP2 > 57%
		NEXT TEMP
		TEMP = INTEGER(TEMP_STRING, WORD)
		! ----- Ensure Proper Range of Numbers -----
		GOTO SYNTAX_ERROR IF TEMP < 1% OR TEMP >		&
			INTEGER(SD_COUNTER, WORD)
		TEMP_STRING = "SD_LAST_DIRECTORY" + NUM1$(TEMP)
		SYS_STATUS = LIB$GET_SYMBOL(TEMP_STRING, COMMAND_STRING)
		ERROR_LINE = "LIB$GET_SYMBOL5"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		GOTO RESTART_PROGRAM
	END IF
	! ----- Process HELP Command -----
	IF COMMAND_STRING = "HELP" THEN
		PRINT
		PRINT
		PRINT "HELP MESSAGE FOR " + QUOTE + "SD" + QUOTE +	&
			" COMMAND"; TAB(62%); "Version " + SD_VERSION
		PRINT
		PRINT "SD [dir]  sets default directory to specified directory"
		PRINT "SD dir    sets default directory to specified directory"
		PRINT "SD        sets default to initial login directory"
		PRINT "SD \      sets default to higher level directory"
		PRINT "SD \\     sets default to 2nd higher level directory"
		PRINT "SD [-]    sets default to higher level directory"
		PRINT "SD [--]   sets default to 2nd higher level directory"
		PRINT "SD <      sets default to previous directory"
		PRINT "SD *      displays last twenty directories"
		PRINT "SD #n     sets default to previous directory number n"
		PRINT "SD HELP   displays this help message"
		PRINT
		PRINT "If present, SD will execute any file called";	&
			" SDLOGOFF.COM before leaving the"
		PRINT "current directory and will execute any file";	&
			" called SDLOGIN.COM existing in"
		PRINT "the new directory."
		PRINT
		PRINT "If the logical SD_PROMPT is defined, your DCL";	&
			" prompt will be changed to indicate"
		PRINT "your current node, device, and directory (max";	&
			"imum of 32 characters)."
		PRINT "(Define SD_PROMPT as BLINK:, BOLD:, REVERSE:,";	&
			" or UNDERLINE: to use the"
		PRINT " corresponding video attribute in the prompt ";	&
			"string; or define it as anything"
		PRINT " else so as to not use any special video attributes)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF
	TEMP = POS(COMMAND_STRING, ":", 1%)	! See if colon in parameter

	! ----- Ensure directory name (if specified) has left/right brackets -
	SELECT TEMP
	CASE 0%					! No Device Specifier
		COMMAND_STRING = "[" + COMMAND_STRING			&
			IF LEFT(COMMAND_STRING, 1%) <> "["
		COMMAND_STRING = COMMAND_STRING + "]"			&
			IF RIGHT(COMMAND_STRING, LEN(COMMAND_STRING)) <> "]"
	CASE < LEN(COMMAND_STRING)		! Colon within Parameter
		IF MID(COMMAND_STRING, TEMP + 1%, 1%) <> "[" THEN
			COMMAND_STRING = LEFT(COMMAND_STRING, TEMP) +	&
				"[" + RIGHT(COMMAND_STRING, TEMP + 1%)
		END IF
		COMMAND_STRING = COMMAND_STRING + "]"			&
			IF RIGHT(COMMAND_STRING, LEN(COMMAND_STRING)) <> "]"
	END SELECT

	PRINT "SD DEBUG>COMMAND_STRING 2="; COMMAND_STRING IF DEBUG
	! ----- Count all leading Minus Signs (or Backslashes) -----
	MINUS_COUNTER = 0%
	! ----- Check for Minus Sign or Backslash (after the left bracket) -----
	TEMP = 2%				! Starting Search Position
	WHILE POS("-\", MID(COMMAND_STRING, TEMP, 1%), 1%) > 0%
		MINUS_COUNTER = MINUS_COUNTER + 1%
		TEMP = TEMP + 1%
	NEXT
	! ----- All Done with counting the Minus Signs or Backslashes -----
	CUR_DEV = "SYS$DISK"			! Store Existing Device

	! ----- Translate Current Disk Device -----
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", "SYS$DISK", , TRNITEM)
	ERROR_LINE = "SYS$TRNLNM2"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL AND		&
		SYS_STATUS <> SS$_NOLOGNAM

	IF SYS_STATUS = SS$_NORMAL THEN
		CUR_DEV = LEFT(LOG_NAME, LOG_NAME_LENGTH)
		CUR_DEV = ELIMINATE_UNDERSCORES(CUR_DEV)
	END IF

	CUR_DEV = ELIMINATE_COLON(CUR_DEV)	! Remove any Trailing Colon

	! ----- If user has the SETPRIV privilege, ensure BYPASS -----
	! ----- and CMKRNL privileges are turned on (SD is already -----
	! ----- installed with the CMEXEC privilege) -----
	IF (NOT (BYPASS_ON AND CMKRNL_ON)) AND SETPRV_ALLOWED THEN
		! ----- Set the Privileges to be Enabled -----
		PRV_ADR(0%) = 0%		! Clear Privilege Mask
		IF NOT BYPASS_ON THEN		! Set to turn on BYPASS Priv
			PRV_ADR(0%) = PRV_ADR(0%) OR PRV$M_BYPASS
		END IF
		IF NOT CMKRNL_ON THEN		! Set to turn on CMKRNL Priv
			PRV_ADR(0%) = PRV_ADR(0%) OR PRV$M_CMKRNL
		END IF
		PRV_ADR(1%) = 0%
		ERROR_LINE = "setting BYPASS and CMKRNL on"
		ENABLE_FLAG = 1%		! Set Flag to "ENABLE"
		! ----- Call $CMEXEC to change access to Executive Mode -----
		! ----- and Execute the SETPRIV Routine.  -----
		! ----- Note: Process Deletion will Occur if Errors are -----
		! ----- Encountered in Executive Mode. -----
		SYS_STATUS = SYS$CMEXEC(SETPRIV,)
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
	END IF

	! ----- Perform further Translations if either a Minus Sign -----
	! ----- and/or backslash is present -----
	IF MINUS_COUNTER > 0% THEN
		! ----- Skip Further Translations if Able to Back Up -----
		! ----- Required Levels -----

		! ----- First Ensure Current Device ends with a Colon -----
		CUR_DEV = CUR_DEV + ":" IF POS(CUR_DEV, ":", 1%) = 0%
		CUR_DEVDIR = CUR_DEV + CUR_DIR
		! ----- Remove any occurence of ][ -----
		TEMP = POS(CUR_DEVDIR, "][", 1%)
		IF TEMP > 0% THEN
			CUR_DEVDIR = LEFT(CUR_DEVDIR, TEMP - 1%) +	&
				RIGHT(CUR_DEVDIR, TEMP + 2%)
		END IF
		! ----- Next see if number of sub-directories <= -----
		! ----- MINUS_COUNTER -----
		TEMP = LEN(CUR_DEVDIR)		! Starting Search Position
		DOT_COUNTER = 0%		! Init Subdirectory Counter
		WHILE DOT_COUNTER < MINUS_COUNTER AND TEMP > 0%
			TEMP = TEMP - 1%	! Decrement Search Position
			ITERATE IF TEMP <= 0%
			! ----- Increment Number of Subdirectories if -----
			! ----- Dot Found -----
			IF MID(CUR_DEVDIR, TEMP + 1%, 1%) = "." THEN
				DOT_COUNTER = DOT_COUNTER + 1%
			END IF
		NEXT
		! ----- Skip Logical Translation if Enough Sub-Directories -----
		IF TEMP <= 0% THEN
			! ----- Check for a Logical Name -----
			! ----- Remove any Trailing Colon -----
			CUR_DEV = ELIMINATE_COLON(CUR_DEV)
			SYS_STATUS = SS$_NORMAL	! Init Loop Parameter
			WHILE SYS_STATUS = SS$_NORMAL
				SYS_STATUS = SYS$TRNLNM(,		&
					"LNM$DCL_LOGICAL", CUR_DEV, , TRNITEM)
				ERROR_LINE = "SYS$TRNLNM2"
				PRINT "SD DEBUG>LOG_NAME=";		&
					LEFT(LOG_NAME, LOG_NAME_LENGTH) IF DEBUG
				IF SYS_STATUS = SS$_NORMAL THEN
					! ----- A Logical Name has been -----
					! ----- found -----
					CUR_DEV = LEFT(LOG_NAME,	&
						LOG_NAME_LENGTH)
				ELSE					
					! ----- Exit Loop if no Logical -----
					! ----- Equivalent -----
					ITERATE IF SYS_STATUS = SS$_NOLOGNAM
					GOTO SYSTEM_ERROR IF SYS_STATUS	&
						<> SS$_NORMAL
				END IF
				! ----- Skip check for further logicals if -----
				! ----- non-privileged -----
				IF NOT PRIVILEGED THEN
					! ----- Set Status to Exit Loop -----
					SYS_STATUS = SS$_NOLOGNAM
					ITERATE
				END IF
				! ----- Remove any Trailing Colon -----
				CUR_DEV = ELIMINATE_COLON(CUR_DEV)
				CUR_DEV = ELIMINATE_UNDERSCORES(CUR_DEV)
			NEXT			! Check for further Logical
		END IF

		! ----- Ensure Current Device ends with a Colon -----
		CUR_DEV = CUR_DEV + ":" IF POS(CUR_DEV, ":", 1%) = 0%
		CUR_DEVDIR = CUR_DEV + CUR_DIR
		! ----- Remove any occurence of ][ -----
		TEMP = POS(CUR_DEVDIR, "][", 1%)
		IF TEMP > 0% THEN
			CUR_DEVDIR = LEFT(CUR_DEVDIR, TEMP - 1%) +	&
				RIGHT(CUR_DEVDIR, TEMP + 2%)
		END IF
		! ----- Locate Number of Subdirectories to Skip Over, -----
		! ----- (Go back as many directories as there are -----
		! ----- minus signs) -----
		TEMP = LEN(CUR_DEVDIR)		! Starting Search Position
		DOT_COUNTER = 0%		! Init Subdirectory Counter
		WHILE DOT_COUNTER < MINUS_COUNTER
			TEMP = TEMP - 1%	! Decrement Search Position
			GOTO SYNTAX_ERROR IF TEMP <= 0%
			! ----- Increment Number of Subdirectories if -----
			! ----- Dot Found -----
			IF MID(CUR_DEVDIR, TEMP + 1%, 1%) = "." THEN
				DOT_COUNTER = DOT_COUNTER + 1%
			END IF
		NEXT
		CUR_DEVDIR = LEFT(CUR_DEVDIR,				&
			TEMP)			! Store Previous Subdirectory
		! ----- Concatenate Directory, If other than just -----
		! ----- Minus Signs -----
		TEMP_STRING = MID(COMMAND_STRING, LEN(COMMAND_STRING) -	&
			1%, 1%)			! Store Next to Last Character
		! ----- Concatenate Parameter (Less Minus Signs) onto -----
		! ----- Current Dir -----
		IF TEMP_STRING <> "-" AND TEMP_STRING <> "\" THEN
			CUR_DEVDIR = CUR_DEVDIR +			&
				RIGHT(COMMAND_STRING, MINUS_COUNTER + 2%)
		END IF
		! ----- Ensure that Directory Specifier has a Trailing -----
		! ----- Bracket -----
		IF RIGHT(CUR_DEVDIR, LEN(CUR_DEVDIR)) <> "]" THEN
			CUR_DEVDIR = CUR_DEVDIR + "]"
		END IF
		COMMAND_STRING = CUR_DEVDIR	! Store Parsed Directory
		GOTO RESTART_PROGRAM
	END IF

	LOG_PARM = COMMAND_STRING
	LOOP_FLAG = TRUE			! Force at least one loop
	STORE_UNCONCEALED_LOGICAL = TRUE	! Store first logical
	NO_LOGICAL_NAME_FOUND = TRUE		! Assume No Logical Name Found
	WHILE LOOP_FLAG
		IF DEBUG THEN
			PRINT "SD DEBUG>**********START OF LOOP**********"
			PRINT "SD DEBUG>LOG_PARM="; LOG_PARM
		END IF
		LOOP_FLAG = FALSE		! Assume exit from loop
		NEW_DEV = "SYS$DISK"		! New Device Specification
		NEW_DIR = LOG_PARM		! New Directory Specification
		TEMP = POS(LOG_PARM, ":", 1%)
		IF TEMP > 0% THEN
			! ----- Extract Device Specifier (Less Colon) -----
			NEW_DEV = LEFT(LOG_PARM, TEMP - 1%)
			! ----- Extract Directory Specifier -----
			! ----- (Including Brackets) -----
			NEW_DIR = RIGHT(LOG_PARM, TEMP + 1%)
		END IF
		! ----- Eliminate any Leading Underscore Characters -----
		NEW_DEV = ELIMINATE_UNDERSCORES(NEW_DEV)

		! ----- See if only a logical name was specified -----
		IF TEMP = LEN(LOG_PARM) THEN
			NEW_DIR = CUR_DIR
		END IF
		! ----- Ensure Leading and Trailing Brackets in New -----
		! ----- Directory -----
		NEW_DIR = "[" + NEW_DIR IF LEFT(NEW_DIR, 1%) <> "["
		NEW_DIR = NEW_DIR + "]" IF RIGHT(NEW_DIR, LEN(NEW_DIR)) <> "]"

		IF STORE_UNCONCEALED_LOGICAL THEN
			NEW_DEV_UNCONCEALED = NEW_DEV + ":"
			NEW_DIR_UNCONCEALED = NEW_DIR
		END IF

		! ----- Loop if the LNM_INDEX value is too high -----
		PREV_LNM_INDEX = LNM_INDEX	! Store Previous Index Value
		LOOP_FLAG = TRUE		! Force at least one loop
		WHILE LOOP_FLAG
			IF DEBUG THEN
				PRINT "DEBUG>Before TRNLNM of NEW_DEV:"
				PRINT "  DEBUG>CUR_DEV="; CUR_DEV
				PRINT "  DEBUG>CUR_DIR="; CUR_DIR
				PRINT "  DEBUG>LNM_INDEX="; LNM_INDEX
				PRINT "  DEBUG>NEW_DEV="; NEW_DEV
				PRINT "  DEBUG>NEW_DIR="; NEW_DIR
				PRINT "  DEBUG>RESUME_WITH_ERROR" +	&
					"_TRAP="; RESUME_WITH_ERROR_TRAP
			END IF

			! ----- Check for a Logical Name (of a specific -----
			! ----- Index) -----
			SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL",	&
				NEW_DEV, , TRNITEM2)
			ERROR_LINE = "SYS$TRNLNM3"

			IF LNM_INDEX = 0% THEN
				! ----- Restore any Previous Index Value -----
				LNM_INDEX = PREV_LNM_INDEX
				! ----- Exit from loop if no search list -----
				LOOP_FLAG = FALSE
				ITERATE
			END IF

			IF SYS_STATUS = SS$_NORMAL THEN
				! ----- See If No Equivalence Name at -----
				! ----- This Index -----
				IF LOG_NAME_LENGTH = 0% THEN
					! ----- Try Lower Index Value -----
					LNM_INDEX = LNM_INDEX - 1%
					ITERATE
				END IF
			END IF
			LOOP_FLAG = FALSE	! Exit from loop
		NEXT
		IF SYS_STATUS = SS$_NOLOGNAM	! If No Logical Equivalent:
		THEN
			IF DEBUG THEN
				PRINT "  DEBUG>No equiv name" +		&
					" found for "; NEW_DEV
			END IF
			! ----- Resume normal error processing if we were -----
			! ----- just checking for a search list logical -----
			GOTO ERROR_TRAP IF RESUME_WITH_ERROR_TRAP
		ELSE
			! ----- Set so as not to go back to error trap -----
			RESUME_WITH_ERROR_TRAP = FALSE

			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

			! ----- A Logical Name has been found -----
			IF DEBUG THEN
				PRINT "  DEBUG>Equiv Name=";		&
					LEFT(LOG_NAME, LOG_NAME_LENGTH)
			END IF
			NO_LOGICAL_NAME_FOUND = FALSE

			! ----- Store device and directory if unconcealed -----
			IF (LOG_ATTRIB AND LNM$M_CONCEALED) = 0% THEN
				STORE_UNCONCEALED_LOGICAL = TRUE
			ELSE
				STORE_UNCONCEALED_LOGICAL = FALSE
			END IF
			! ----- Store New Logical Device -----
			LOG_PARM = LEFT(LOG_NAME, LOG_NAME_LENGTH)
			! ----- Eliminate any Leading Underscore -----
			! ----- Characters -----
			LOG_PARM = ELIMINATE_UNDERSCORES(LOG_PARM)
			! ----- Ensure Equivalence Name Ends with a Colon -----
			! ----- if it is not a directory specifier -----
			IF POS(LOG_PARM, ":", 1%) = 0% THEN
				IF POS(LOG_PARM, "[", 1%) = 0% THEN
					LOG_PARM = LOG_PARM + ":"
				END IF
			END IF
			! ----- Concatenate Previously-Entered Directory -----
			! ----- Name -----
			IF NEW_DIR <> CUR_DIR OR POS(LOG_PARM, ".]", 1%) > 0%
			THEN
				LOG_PARM = LOG_PARM + NEW_DIR
			END IF
			! ----- Check to see if no Root Directory was -----
			! ----- Entered (check for [.) -----
			TEMP = POS(LOG_PARM, "[.", 1%)
			IF TEMP > 0% THEN
				LOG_PARM = LEFT(LOG_PARM, TEMP) +	&
					MID(CUR_DIR, 2%, LEN(CUR_DIR) -	&
					2%) + RIGHT(LOG_PARM, TEMP + 1%)
			END IF
			! ----- Check for ][ -----
			TEMP = POS(LOG_PARM, "][", 1%)
			IF TEMP > 0% THEN
				LOG_PARM = LEFT(LOG_PARM, TEMP - 1%) +	&
					RIGHT(LOG_PARM, TEMP + 2%)
			END IF
			LOOP_FLAG = TRUE	! Iterate loop again
		END IF
	NEXT

	IF DEBUG THEN
		PRINT "DEBUG>Before CMS check:"
		PRINT "  DEBUG>CUR_DEV="; CUR_DEV
		PRINT "  DEBUG>CUR_DIR="; CUR_DIR
		PRINT "  DEBUG>NEW_DEV="; NEW_DEV
		PRINT "  DEBUG>NEW_DIR="; NEW_DIR
	END IF

	! ----- Invalid if .CMS] Directory -----
	IF POS(NEW_DIR, ".CMS]", 1%) > 0% THEN
		PRINT "You can not set your default to a CMS subdirectory!"; BEL
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF

	! ----- Invalid if .CMSREF] Directory -----
	IF POS(NEW_DIR, ".CMSREF]", 1%) > 0% THEN
		PRINT "You can not set your default to a CMS subdirectory!"; BEL
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF

	! ----- Verify that the Directory Exists -----

	PREV_DIR = NEW_DEV + ":" + NEW_DIR
	! ----- See if Whether a UIC-type Directory was specified -----
	IF POS(NEW_DIR, ",", 1%) > 0% THEN
		! ----- Special Operation if a UIC-type Directory -----
		TEMP2 = POS(NEW_DIR, ",", 1%) + LEN(NEW_DEV) + 1%
		GOTO ERROR_TRAP IF LEN(NEW_DEV) >= TEMP2 AND TEMP2 > 0%
		GOSUB SEE_IF_MOUNTED		! Ensure Device is Mounted
	ELSE
		! ----- A Non-UIC-type Directory was Specified -----
		LOG_PARM = NEW_DEV + ":[000000." + RIGHT(NEW_DIR, 2%)
		IF NEW_DIR <> "[000000]" THEN
			! ----- Ensure that no colon follows a comma -----
			TEMP = POS(LOG_PARM, ",", 1%)
			IF TEMP > 0% THEN
				GOTO ERROR_TRAP IF POS(LOG_PARM, ":", 1%) > TEMP
			END IF

			! ----- Ensure that the Search Directory does in -----
			! ----- Fact Exist.  First Locate the Lowest Level -----
			! ----- Subdirectory -----
			LAST_DOT = 0%
			TEMP = 1%		! Starting Search Position
			WHILE POS(LOG_PARM, ".", TEMP) > 0%
				LAST_DOT = POS(LOG_PARM, ".", TEMP)
				TEMP = LAST_DOT + 1%
			NEXT
			! ----- Found Lowest Level Subdirectory -----
			! ----- Create File Spec for Previous Levels -----
			! ----- Directory Name -----
			PREV_DIR = LEFT(LOG_PARM, LAST_DOT - 1%) + "]"	&
				+ RIGHT(LOG_PARM, LAST_DOT + 1%)
			PREV_DIR = LEFT(PREV_DIR, LEN(PREV_DIR) - 1%) + ".DIR"

			GOSUB SEE_IF_MOUNTED	! Ensure Device is Mounted

			! ----- Ensure that Directory File does Indeed -----
			! ----- Exist -----

			! ----- If it exists, get the Owner UIC of the -----
			! ----- Previous Level's Directory File -----

			! ----- Assign a channel to the disk for the -----
			! ----- $QIO call -----
			ERROR_LINE = "assigning an I/O channel to " + NEW_DEV
			SYS_STATUS = SYS$ASSIGN(NEW_DEV, CHAN, , )
			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

			! ----- Get the FILE-ID for the File to be -----
			! ----- Accessed -----
			CALL GETFID(PREV_DIR, USER_FIB::FIB$W_FID())

			! ----- To initiate a Read Attributes operation, -----
			! ----- call the ACP QIO service with a Function -----
			! ----- Code of IO$_ACCESS -----

			ERROR_LINE = "performing QIOW for access"
			FUNC = IO$_ACCESS

			SYS_STATUS = SYS$QIOW( ,! Event Flag		&
				CHAN BY VALUE,	! Device I/O Channel	&
				FUNC BY VALUE,	! Device Function Code	&
				IOSB() BY REF,	! I/O Status Block	&
				,		! AST Address		&
				,		! AST Parameter		&
				FIB_BUF BY DESC,! Address of FIB Desc	&
				,		! Filename String Desc	&
				,		! Filename String Length&
				,		! Filename String Desc	&
				ATTR BY REF,	! Attr Control Blk Addr	&
				)		! N/A

			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
			IF (IOSB(0%) AND 1%) = 0% THEN
				IF IOSB(0%) = SS$_NOSUCHFILE THEN
					! ----- NEW_DEV:PREV_DIR.DIR does -----
					! ----- not exist -----
					SYS_STATUS = SS$_NORMAL
					! ----- Assume that the device is -----
					! ----- a search list or logical -----
					! ----- name -----
					GOTO CHECK_FOR_SOMETHING_ELSE
				END IF
				! ----- Abort program if any unexpected -----
				! ----- error -----
				SYS_STATUS = IOSB(0%)
				GOTO SYSTEM_ERROR
			END IF
			LONG_OWNER_UIC_GROUP = UIC::OWNER_UIC_GROUP
			LONG_OWNER_UIC_MEMBER = UIC::OWNER_UIC_MEMBER
			LONG_OWNER_UIC_GROUP = LONG_OWNER_UIC_GROUP +	&
				MAKE_POS IF LONG_OWNER_UIC_GROUP < 0%
			LONG_OWNER_UIC_MEMBER = LONG_OWNER_UIC_MEMBER +	&
				MAKE_POS IF LONG_OWNER_UIC_MEMBER < 0%

			! ----- Deassign the I/O Channel -----
			ERROR_LINE = "deassigning the I/O channel"
			SYS_STATUS = SYS$DASSGN(CHAN BY VALUE)
			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		ELSE
			GOSUB SEE_IF_MOUNTED	! Ensure Device is Mounted
		END IF
	END IF

	! ----- Check for SDLOGOFF.COM -----
	IF CHECK_SDLOGOFF THEN
		PRINT "SD DEBUG>SDLOGOFF exists" IF DEBUG
		COMMAND_FILE = COMMAND_FILE + "Y"
	ELSE
		PRINT "SD DEBUG>SDLOGOFF does not exist" IF DEBUG
		COMMAND_FILE = COMMAND_FILE + "N"
	END IF

	! ----- Set Symbol to the New Default Directory -----
	TEMP_STRING = NEW_DEV_UNCONCEALED + NEW_DIR_UNCONCEALED
	SYS_STATUS = LIB$SET_SYMBOL("SD_DIRECTORY", TEMP_STRING, GLOBAL BY REF)
	ERROR_LINE = "LIB$SET_SYMBOL"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- Print Directory Change Information for User -----
	PRINT CUR_DEV; ":"; CUR_DIR; " --> ";				&
		NEW_DEV_UNCONCEALED; NEW_DIR_UNCONCEALED

	! ----- Store Old Directory Spec in Global Symbols -----
	SYS_STATUS = LIB$SET_SYMBOL("SD_LAST_DIRECTORY",		&
		CUR_DEV + ":" + CUR_DIR, GLOBAL BY REF)
	ERROR_LINE = "LIB$SET_SYMBOL2"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- See if SD_LAST_DIRECTORY list is already full -----
	IF INTEGER(SD_COUNTER, WORD) < 20% THEN
		! ----- Not Full, Increment Counter of Symbols -----
		SD_COUNTER = NUM1$(INTEGER(SD_COUNTER, WORD) + 1%)
		TEMP_STRING = "SD_LAST_DIRECTORY" + SD_COUNTER

		! ----- Store New Counter -----
		SYS_STATUS = LIB$SET_SYMBOL("SD_COUNTER", SD_COUNTER,	&
			GLOBAL BY REF)
		ERROR_LINE = "LIB$SET_SYMBOL3"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

		! ----- Store Last Counter Index -----
		SYS_STATUS = LIB$SET_SYMBOL("SD_INDEX", SD_COUNTER,	&
			GLOBAL BY REF)
		ERROR_LINE = "LIB$SET_SYMBOL4"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
	ELSE
		! ----- Full, Supercede Next Symbol with Last Directory -----
		! ----- Get SD_INDEX Symbol -----
		SYS_STATUS = LIB$GET_SYMBOL("SD_INDEX", SD_INDEX)
		ERROR_LINE = "LIB$GET_SYMBOL8"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

		SD_INDEX = NUM1$(INTEGER(SD_INDEX, WORD) + 1%)
		SD_INDEX = "1" IF SD_INDEX = "21"	! Start Loop at begin?

		! ----- Store Last Counter Index -----
		SYS_STATUS = LIB$SET_SYMBOL("SD_INDEX", SD_INDEX,	&
			GLOBAL BY REF)
		ERROR_LINE = "LIB$SET_SYMBOL5"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

		TEMP_STRING = "SD_LAST_DIRECTORY" + SD_INDEX
	END IF
	! ----- Store Last Directory in Proper Global Symbol -----
	SYS_STATUS = LIB$SET_SYMBOL(TEMP_STRING, CUR_DEV + ":" +	&
		CUR_DIR, GLOBAL BY REF)
	ERROR_LINE = "LIB$SET_SYMBOL6"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- Check for SDLOGIN.COM -----
	IF CHECK_SDLOGIN THEN
		PRINT "SD DEBUG>SDLOGIN exists" IF DEBUG
		COMMAND_FILE = COMMAND_FILE + "Y"
	ELSE
		PRINT "SD DEBUG>SDLOGIN does not exist" IF DEBUG
		COMMAND_FILE = COMMAND_FILE + "N"
	END IF

	! ----- Store names of privileged to be turned off -----
	SYS_STATUS = LIB$SET_SYMBOL("SD_PRIV", PREV_PRIV, GLOBAL BY REF)
	ERROR_LINE = "LIB$SET_SYMBOL7"
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	! ----- Check for UIC change only if privileged user -----
	IF PRIVILEGED THEN

		NEW_UIC = ""			! Assume no UIC change

		! ----- Skip UIC change if group or member number out of -----
		! ----- normal UIC range -----
		IF LONG_OWNER_UIC_GROUP > 0% AND LONG_OWNER_UIC_GROUP <	&
			16383% AND LONG_OWNER_UIC_MEMBER >= 0% AND	&
			LONG_OWNER_UIC_MEMBER < 65535%
		THEN
			! ----- If neither Disk MFD nor a comma within -----
			! ----- Directory -----
			IF NEW_DIR <> "[000000]" AND POS(NEW_DIR, ",", 1%) = 0%
			THEN
				! ----- Do UIC change if destination UIC -----
				! ----- is not the same as the current UIC -----
				IF UIC_GROUP <> LONG_OWNER_UIC_GROUP OR	&
					UIC_MEMBER <> LONG_OWNER_UIC_MEMBER
				THEN
					NEW_UIC = "[" + DECOCT(		&
						LONG_OWNER_UIC_GROUP) +	&
						"," + DECOCT(		&
						LONG_OWNER_UIC_MEMBER) + "]"
				END IF
			ELSE
				! ----- This is a Disk MFD or a comma is -----
				! ----- within the Dir -----
				IF POS(NEW_DIR, ",", 1%) > 0% THEN
					! ----- Store UIC if [ggg,mmm] -----
					NEW_UIC = NEW_DIR
				ELSE
					! ----- Store UIC if [000000] -----
					NEW_UIC = "[1,4]"
				END IF
			END IF
		ELSE
			PRINT "%Warning - UIC not changed since" +	&
				" owner directory has invalid UIC value"
		END IF
		IF NEW_UIC <> "" THEN
			! ----- Set command file name and symbol to -----
			! ----- change the user's UIC -----
			COMMAND_FILE = COMMAND_FILE + "Y"
			SYS_STATUS = LIB$SET_SYMBOL("SD_UIC", NEW_UIC,	&
				GLOBAL BY REF)
			ERROR_LINE = "LIB$SET_SYMBOL8"
			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		ELSE
			COMMAND_FILE = COMMAND_FILE + "N"
		END IF
	ELSE
		COMMAND_FILE = COMMAND_FILE + "N"
	END IF

	! ----- If SD_PROMPT is defined as a logical pointing to -----
	! ----- NL:, then change the user's prompt to -----
	! ----- node::disk:[directory]> -----
	! ----- Translate Current Disk Device -----
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", "SD_PROMPT", , TRNITEM)
	ERROR_LINE = "SYS$TRNLNM2"
	IF SYS_STATUS = SS$_NOLOGNAM THEN
		COMMAND_FILE = COMMAND_FILE + "N"
	ELSE
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		PROMPT_LOGICAL = LEFT(LOG_NAME, LOG_NAME_LENGTH)

		! ----- Translate SYS$NODE -----
		SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL",		&
			"SYS$NODE", , TRNITEM)
		IF SYS_STATUS = SS$_NOLOGNAM	! If no Logical Equivalent:
		THEN
			! ----- No Node Name -----
			NODE_NAME = ""
		ELSE
			GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
			! ----- Extract Node Name -----
			NODE_NAME = LEFT(LOG_NAME, LOG_NAME_LENGTH)
		END IF

		SELECT PROMPT_LOGICAL
		CASE "BLINK:"
			VIDEO_ATTRIBUTE = BLINK_VIDEO
		CASE "BOLD:"
			VIDEO_ATTRIBUTE = BOLD_VIDEO
		CASE "REVERSE:"
			VIDEO_ATTRIBUTE = REVERSE_VIDEO
		CASE "UNDERLINE:"
			VIDEO_ATTRIBUTE = UNDERLINE_VIDEO
		CASE ELSE
			VIDEO_ATTRIBUTE = ""
		END SELECT
		IF VIDEO_ATTRIBUTE <> "" THEN
			! ----- Create string of NODE::DEVICE:[DIRECTORY] -----
			! ----- with the desired video attribute -----
			TEMP_STRING = VIDEO_ATTRIBUTE +			&
				NODE_NAME + NEW_DEV_UNCONCEALED +	&
				NEW_DIR_UNCONCEALED + ">" + NORMAL_VIDEO
			IF LEN(TEMP_STRING) > 32% THEN
				TEMP_STRING = VIDEO_ATTRIBUTE +		&
					NODE_NAME + NEW_DIR_UNCONCEALED	&
					+ ">" + NORMAL_VIDEO
				IF LEN(TEMP_STRING) > 32% THEN
					TEMP_STRING =			&
						VIDEO_ATTRIBUTE +	&
						RIGHT(TEMP_STRING,	&
						LEN(TEMP_STRING) - 27%)
				END IF
			END IF
		ELSE
			SELECT PROMPT_LOGICAL
			CASE "AUTO:"
				RANDOMIZE	! Randomize RND Seed Value
				READ RANDOM_PROMPTS(TEMP) FOR TEMP = 0%	&
					TO NUMBER_OF_RANDOM_PROMPTS

				TEMP = RND * NUMBER_OF_RANDOM_PROMPTS
				TEMP_STRING = RANDOM_PROMPTS(TEMP) + " "
			CASE "SCREENR:"
				! ----- Get SDSCREEN Symbol -----
				SYS_STATUS = LIB$GET_SYMBOL("SDSCREEN",	&
					TEMP_STRING)
				ERROR_LINE = "LIB$GET_SYMBOL8"
				IF SYS_STATUS = LIB$_NOSUCHSYM THEN
					TEMP_STRING = "A"
				ELSE
					GOTO SYSTEM_ERROR IF		&
						SYS_STATUS <> SS$_NORMAL
				END IF

				IF TEMP_STRING = "A" THEN
					TEMP_STRING = "B"
				ELSE
					TEMP_STRING = "A"
				END IF

				SYS_STATUS = LIB$SET_SYMBOL("SDSCREEN",	&
					TEMP_STRING, GLOBAL BY REF)
				ERROR_LINE = "LIB$SET_SYMBOL8"
				GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

				IF TEMP_STRING = "B" THEN
					TEMP_STRING = ESC + "[?5h$ "
				ELSE
					TEMP_STRING = ESC + "[?5l$ "
				END IF
			CASE ELSE
				! ----- Create string of -----
				! ----- NODE::DEVICE:[DIRECTORY] -----
				! ----- with no video attributes -----
				TEMP_STRING = NODE_NAME +		&
					NEW_DEV_UNCONCEALED +		&
					NEW_DIR_UNCONCEALED + ">"
				IF LEN(TEMP_STRING) > 32% THEN
					TEMP_STRING = NODE_NAME +	&
						NEW_DIR_UNCONCEALED + ">"
					IF LEN(TEMP_STRING) > 32% THEN
						TEMP_STRING = RIGHT(	&
							TEMP_STRING,	&
							LEN(TEMP_STRING) - 31%)
					END IF
				END IF
			END SELECT
		END IF

		! ----- Set a symbol to change the DCL prompt string -----
		SYS_STATUS = LIB$SET_SYMBOL("SD_NEW_PROMPT",		&
			TEMP_STRING, GLOBAL BY REF)
		ERROR_LINE = "LIB$SET_SYMBOL9"
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
		COMMAND_FILE = COMMAND_FILE + "Y"
	END IF
	GOTO END_PROGRAM

 SEE_IF_MOUNTED:

	! ----- Subroutine to Check to see if Disk Device is Mounted -----
	SYS_STATUS = SYS$GETDVI(, , NEW_DEV, DVIITEM, , , , )
	ERROR_LINE = "SYS$GETDVI"
	IF SYS_STATUS = SS$_NOSUCHDEV THEN
		PRINT "ERROR -- Device "; NEW_DEV; " does not exist"
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF
	IF SYS_STATUS = SS$_NONLOCAL THEN
		PRINT "ERROR -- Device "; NEW_DEV; " is on a remote system"
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF
	IF SYS_STATUS = SS$_IVDEVNAM OR SYS_STATUS = SS$_IVLOGNAM THEN
		PRINT "ERROR -- Invalid Device: "; NEW_DEV
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF
	GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL

	IF DEVICE_CLASS <> DC$_DISK THEN	! Ensure a Disk Device
		PRINT "ERROR -- Device "; NEW_DEV; " is not a disk"
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF

	IF MOUNTED = 0% THEN
		PRINT "ERROR -- Device "; NEW_DEV; " is not mounted"
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	END IF

	RETURN

 CHECK_FOR_SOMETHING_ELSE:

	! ----- Before Reporting any Error, -----
	! ----- First Check for a Search List for the Device -----
	IF DEBUG THEN
		PRINT "  DEBUG>Check for Something Else"
	END IF
	IF NOT CHECK_FOR_SOMETHING_FLAG THEN	! See if first time here
		CHECK_FOR_SOMETHING_FLAG = TRUE	! Set CHECK_FOR_SOMETHING Flag
		IF NOT NO_LOGICAL_NAME_FOUND	! If a Logical Name was Found:
		THEN
			! ----- Set to search the next index -----
			LNM_INDEX = LNM_INDEX + 1%
			! ----- Set Flag to come back here -----
			RESUME_WITH_ERROR_TRAP = TRUE
			GOTO RESTART_PROGRAM	! Start Program Over
		END IF
	END IF

 ERROR_TRAP:

	IF DEBUG THEN
		PRINT "  DEBUG>Enter Error Trap"
	END IF
	LNM_INDEX = 0%				! Set to search the first index
	RESUME_WITH_ERROR_TRAP = FALSE		! Set Flag to not come back here

	! ----- Before Reporting any Error, -----
	! ----- See if There is a Matching Logical -----
	TEMP_STRING = MID(COMMAND_STRING, 2%, LEN(COMMAND_STRING) - 2%)

	! ----- Check for a Logical Name -----
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", TEMP_STRING, , TRNITEM)
	ERROR_LINE = "SYS$TRNLNM6"
	SELECT SYS_STATUS
	CASE SS$_NORMAL				! Is a Logical Name?
		PRINT "Assuming that "; TEMP_STRING; " is a logical name"
		! ----- Append Colon to Logical Name -----
		COMMAND_STRING = TEMP_STRING + ":"
		GOTO RESTART_PROGRAM		! Start Program Over
	CASE SS$_NOLOGNAM			! Not a Logical?
		! ----- Before Reporting any Error, -----
		! ----- See if the destination is a valid username -----
		TEMP = LEN(TEMP_STRING)
		! ----- See if Valid length for username and we did not -----
		! ----- already search the SYSUAF -----
		IF TEMP > 0% AND TEMP < 13% AND NOT SYSUAF_ALREADY_TRIED THEN
			! ----- Set flag to indicate we searched the SYSUAF ----
			SYSUAF_ALREADY_TRIED = TRUE
			! ----- Open and Read the SYSUAF file -----
			IF NOT READ_UAF(TEMP_STRING) THEN
				! ----- Directory is a username -----
				PRINT "Assuming "; TEMP_STRING;		&
					" is a username on ";		&
					LEFT(THE_DEVICE, DEVICE_LENGTH)
				! ----- Prefix the Directory with the -----
				! ----- Extracted Device from the SYSUAF -----
				COMMAND_STRING = LEFT(THE_DEVICE,	&
					DEVICE_LENGTH) + TEMP_STRING
				! ----- Start Program Over -----
				GOTO RESTART_PROGRAM
			END IF
		END IF
		PRINT "Directory "; COMMAND_STRING; " does not exist!"
		PRINT "(Type:    SD HELP    for help)"
		COMMAND_FILE = ""
		GOTO END_PROGRAM
	CASE ELSE
		GOTO SYSTEM_ERROR IF SYS_STATUS <> SS$_NORMAL
	END SELECT

 SYNTAX_ERROR:

	PRINT "Invalid syntax: "; COMMAND_STRING
	PRINT "(Type:    SD HELP    for help)"
	COMMAND_FILE = ""
	GOTO END_PROGRAM

 SYSTEM_ERROR:

	PRINT
	PRINT "Error during "; ERROR_LINE
	PRINT "SYS_STATUS ="; SYS_STATUS
	COMMAND_FILE = ""
	! ----- Display System Error Message from Return Status -----
	IF LIB$SYS_GETMSG(SYS_STATUS, , SYSTEM_OUTPUT, 1%) <> 0% THEN
		PRINT SYSTEM_OUTPUT
	ELSE
		PRINT "LIB$SYS_GETMSG ERROR"
	END IF
	GOTO END_PROGRAM

 ERROR_ROUTINE:

	COMMAND_FILE = ""
	PRINT "Unexpected error"; ERR; " after ERROR_LINE ";		&
		ERROR_LINE; " in SD.BAS"
	PRINT ERT$(ERR)
	CLOSE #1%
	RESUME END_PROGRAM

 END_PROGRAM:

	IF COMMAND_FILE <> "" THEN
		PRINT "SD DEBUG>Chaining to "; COMMAND_FILE IF DEBUG
		! ----- Chain to the correct file -----
		CALL LIB$DO_COMMAND(COMMAND_FILE)
	ELSE
		! ----- Return Error Status (%X10000002) to Caller -----
		CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
	END IF

	DATA Your What Hurts?,By your command:,"Yes, Kimosahbee:"
	DATA May the force be with you:,"Yes, Master:",You Rang??
	DATA "",What the hell do YOU want??,"Speak!"
	DATA "W
h
a
t
 
N
o
w
?
"
	DATA VAXs forever...,""
	END