c
c--------------------- Virtual Terminal Initialization ----------------------
c

	subroutine SetUpVirtualTerminal(remChannel, remRFunc, remWFunc,
     1					locChannel, locRFunc, locWFunc,
     1					status, setType, echo, parity, speed)

	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'
	include 'UTCS$INCLUDE:ttdef.for/nolist'

	parameter	(oON = 0)
	parameter	(oOFF = 1)
	parameter	(oEVEN = 2)
	parameter	(oODD =  3)
	parameter	(oNONE = 4)
	parameter	(o300BAUD = 300)
	parameter	(o600BAUD = 600)
	parameter	(o1200BAUD = 1200)
	parameter	(o2400BAUD = 2400)
	parameter	(o4800BAUD = 4800)
	parameter	(o9600BAUD = 9600)
	parameter	(PRV$V_SYSPRV = '0000001C'X)

	character*63 	localDevice
	character*10 	remoteBaud
	integer*4 	status, byteCount, exitBlock(4), paritySet
	integer*4 	remoteChar(2), setRemote(2), setChar, lineSpeed
	integer*4 	localChar(2), setLocal(2), echo, parity, speed

	
	remRFunc = (io$_ttyreadall + io$m_noecho)
	remWFunc = (io$_writelblk + io$m_noformat)

	if (echo .eq. oOFF) then
		locRFunc = (io$_ttyreadall + io$m_noecho)
	else
		locRFunc = io$_ttyreadall
	endif

	locWFunc = (io$_writelblk + io$m_noformat)

	!
	!  Set up the local channel.
	!

	if (setType .eq. LOCALONLY) then
		status = sys$trnlog(%descr(localLogName),
     1				    %ref(byteCount),
     1				    %descr(localDevice),,,)
		if (status .ne. SS$_NORMAL) then
			return
		endif

		status = sys$assign(%descr(localDevice(1:byteCount)),
     1				    %ref(localChannel),,)
		if (status .ne. SS$_NORMAL) then
			return
		endif

		! Get local terminal characteristics.
		status = sys$qiow(,%val(localChannel),
     1				   %val(io$_sensemode),
     1				   %ref(localReadIosb),,,
     1				   %ref(localChar),,,,,)
		if (status .ne. SS$_NORMAL) then
			return
		endif

		setLocal(1) = localChar(1)
		setLocal(2) = localChar(2)

		! Set local terminal to full duplex.
		call lib$insv(0,tt$v_halfdup,1,setLocal(2))
		status = sys$qiow(,%val(localChannel),
     1				   %val(io$_setmode),
     1				   %ref(localReadIosb),,,
     1				   %ref(setLocal),,,,,)
		if (status .ne. SS$_NORMAL) then
			return
		endif

		locChannel = localChannel

	else
		! 
		!  Set up the remote channel
		!

		call GetRemoteChannel(status)

		! Get remote system characteristics.
		status = sys$qiow(,%val(remoteChannel),
     1				   %val(io$_sensemode),
     1				   %ref(remoteReadIosb),,,
     1				   %ref(remoteChar),,,,,)
		if (status .ne. SS$_NORMAL) then
			return
		endif

		setRemote(1) = remoteChar(1)
		setRemote(2) = remoteChar(2)

		! set term/unknown/width=511/modem/hangup-
		!      /fulldup/hostsync/ttsync/passall/nobroadcast/noecho
		!      other parameters are left untouched
		call lib$insv(dt$_ttyunkn,8,8,setRemote(1))
		call lib$insv(511,16,16,setRemote(1))
		call lib$insv(1,tt$v_hostsync,1,setRemote(2))
		call lib$insv(1,tt$v_ttsync,1,setRemote(2))
		call lib$insv(1,tt$v_passall,1,setRemote(2))
		call lib$insv(1,tt$v_nobrdcst,1,setRemote(2))
		call lib$insv(1,tt$v_noecho,1,setRemote(2))
		call lib$insv(1,tt$v_modem,1,setRemote(2))
		call lib$insv(0,tt$v_halfdup,1,setRemote(2))

		! Set parity parameter.
		if (parity .eq. oEVEN) then
			paritySet = tt$m_altrpar+tt$m_parity
		else if (parity .eq. oNONE) then
			paritySet = tt$m_altrpar
		else
			paritySet = tt$m_altrpar+tt$m_odd
		endif

		! Set speed parameter.
		if (speed .eq. o300BAUD) then
			lineSpeed = tt$c_baud_300
		else if (speed .eq. o600BAUD) then
			lineSpeed = tt$c_baud_600
		else if (speed .eq. o1200BAUD) then
			lineSpeed = tt$c_baud_1200
		else if (speed .eq. o2400BAUD) then
			lineSpeed = tt$c_baud_2400
		else if (speed .eq. o4800BAUD) then
			lineSpeed = tt$c_baud_4800
		else if (speed .eq. o9600BAUD) then
			lineSpeed = tt$c_baud_9600
		endif

		status = sys$qiow(,%val(remoteChannel),
     1			   %val(io$_setmode),
     1			   %ref(remoteReadIosb),,,
     1			   %ref(setRemote),,
     1			   %val(lineSpeed),,
     1			   %val(paritySet),)

		if (status .ne. SS$_NORMAL) then
			return
		endif

		setremote(1) = 0
		setremote(2) = 0
		call lib$insv(1,prv$v_sysprv,1,setremote(1))
		status = sys$setprv(%val(0), %ref(setremote(1)),
     1				    %val(0), %val(0))

		remChannel = remoteChannel
	endif

	return
	end

	subroutine GetRemoteChannel(status)
c
c	get the name of an unassigned remote system port
c 	and assign a channel to it.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'
	include 'UTCS$INCLUDE:ttdef.for/nolist'

	character*63 	remoteDevice, currentDevice, remLogNam, logCnt
	integer*4 	status, byteCount, indexBlank, logDescriptor(2), i
	logical*4	found, procLogical


	!  Determine if first logical name translates into
	!  a device.  If it does'nt then abort program.
	call str$concat(remLogNam, defaultLogNam, '0 ')

	!  Kluge string descriptor of remote logical name.
	indexBlank = index(remLogNam, ' ')
	logDescriptor(1) = indexblank - 1
	logDescriptor(2) = %loc(remLogNam)

	status = sys$trnlog(%ref(logDescriptor(1)),
     1			    %ref(byteCount),
     1			    %descr(remoteDevice),,,)
	if (status .ne. SS$_NORMAL) then
		return
	endif

	found = FALSE
	i = 1
	!
	!  Process each device defined by the logical name translation
	!  testing to see if it is available.  If it is'nt then
	!  attempt a new logical name translation until all defined 
	!  logical names have been translated.
	!
	do while ((.not.(found)) .and. (i .le. maxLogNames))
		
		procLogical = FALSE
		do while ((.not.(procLogical)) .and. (.not.(found)))

		     indexBlank = index(remoteDevice, ' ')
		     if (indexBlank .gt. 1) then
			 currentDevice = remoteDevice(1:indexBlank-1)
			 remoteDevice = remoteDevice(indexBlank+1:)
		     else
			 currentDevice = remoteDevice
			 procLogical = TRUE
		     endif
		     status = sys$assign(%descr(currentDevice),
     1		     	 	         %ref(remoteChannel),,)
	     	     if (mod(status,2) .eq. 1) found = TRUE
		enddo
		
		! If not found then translate next logical name.
		if (.not.(found)) then
			call IntToString(i, logCnt)
			call str$concat(remLogNam, defaultLogNam, logCnt(1:))

			!  Kluge string descriptor of remote logical name.
			indexBlank = index(remLogNam, ' ')
			logDescriptor(1) = indexBlank - 1
			status = sys$trnlog(%ref(logDescriptor(1)),
     1					    %ref(byteCount),
     1					    %descr(remoteDevice),,,)
			call CheckLogicalTranslate(status)
			i = i + 1
		endif
	enddo

	return
	end

	subroutine IntToString(int,strng)
c
c	convert a integer to a string with ascii character set.
c
	include	'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	parameter	(maxStringSize=63)
	character*63    strng, tstrng
	character*10	digits, char
	integer*4	int, intval, remDig, j, i, strngSize
	logical*4	moreDigits
	
	digits = '0123456789'
	!  Make sign of number positive.
	intval = abs(int)
	moreDigits = .true.
	tStrng(1:1) = ' '
	strngSize = 1
	
	!  Generate digits.
	do while (moreDigits)
		strngSize = strngSize + 1
		remDig = jmod(intval, 10)
		tstrng(strngSize:strngSize) = digits(remDig+1:remDig+1)
 		intval = intval/10
		if ((intval .eq. 0) .or. (strngSize .gt. maxStringSize))
     1			 moreDigits = .false.
	enddo

	!  Place sign in string.
	if (int .lt. 0) then
		strngSize = strngSize + 1
		tStrng(strngSize:strngSize) = '-'
	endif

	!  Reverse string and then assign to output string.
	j = 1
	i = strngSize
	do while (j .lt. i)
		char = tStrng(i:i)
		tStrng(i:i) = tStrng(j:j)
		tStrng(j:j) = char
		j = j + 1
		i = i - 1
	enddo
	strng = tStrng(1:)	

	return
	end

	subroutine CheckLogicalTranslate(statusCode)
c
c	Subroutine to check the status of the remote logical
c	assign to determine if it is in error.  If it is
c	then print a message to user and die cleanly.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'
	integer*4 statusCode

	!  All tranlation status' greater than one if error. 
	if (statusCode .ne. SS$_NORMAL) then
	    !  Print warning message and exit.
	    call WriteUser(' ? all lines to remote system are in use')
	    call sys$exit(%val(SS$_NORMAL))
	endif
	
	return
	end

c
c------------------------ Virtual Terminal Program ------------------------
c

	subroutine VirtualTerminal(remChanl, remRFunc, remWFunc,
     1				   locChanl, locRFunc, locWFunc, conStatus)
c
c	Initialize the program and commence execution.
c
	include 'VTERMDIR:vglobal.for'
	include 'UTCS$INCLUDE:booleans.for'

	integer*4	remChanl, remRFunc, remWFunc
	integer*4	locChanl, locRFunc, locWFunc
	logical*4	conStatus

	shuttingDown = FALSE

	call InitializeProgram

	localReadFunc = locRFunc
	localWriteFunc = locWFunc
	localChannel = locChanl
	remoteReadFunc = remRFunc 
	remoteWriteFunc = remWFunc 
	remoteChannel = remChanl
	connected = conStatus
	
	!  Start up each process
	call ReadRemo
	call ReadLoco

	!  And wait forever
	status = sys$hiber()

	!  Set return values
	remChanl = remoteChannel
	remRFunc = remoteReadFunc
	remWFunc = remoteWriteFunc
	locRFunc = localReadFunc
	locWFunc = localWriteFunc
	locChanl = localChannel
	conStatus = connected

	return
	end

	subroutine InitializeProgram
c
c	initialization routine
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	character*10	selectedSystem
	integer*4 	exitBlock(4),status,indxBlank


	!  Get users remote system and initialize for it.
	call GetUsersRemoteSystem(selectedSystem)

	! set status flags
	localReadSize = 1
	localWriteChars = 0	
	remoteReadStart = 1	
	localWrtIosbAvail = 0	
	localWrtIosbUsed  = 0	
	waitingToReadRemote = FALSE
	tablePointer = 0	
	tableWrapped = 0	
	firstTimeRun = TRUE
	firstTurn = TRUE
	remoteReadCnt = 0
	remoteTypeAhdFunc = io$sensemode+io$m_typeahdcnt

	call WriteUser('Proceed...')
	call WriteUser(' ')

	return
	end

	subroutine GetUsersRemoteSystem(charSysType)
c
c	Get type of remote system and configure QIO options accordingly
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'

	character*10 systemType, charSysType

	localReadFunc = localReadFunc + io$m_noecho
	charSysType = systemType

	return
	end

	subroutine ReadRemo
c
c	start the process of reading an entire write-block from the 
c	remote system.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	integer*4 nBytes

	if (shuttingDown)
     1		return

	! Get typeahead count.
	call CheckRemo(nBytes)

	if (nbytes .eq. 0) then
	    ! remote hasnt sent anything; 
	    ! read one byte to find out when it does
	    call Read$remo(1,keepReading)
	else
	    ! some data from remote already;
	    ! watch the typeahead buffer to get everything in one read
	    call WatchRemo(nBytes)
	endif

	return
	end

	subroutine WatchRemo(firstBytes)
c
c	watch the typeahead buffer for the remote system
c	issue a read when it gets full or the sender stops
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'

	integer*4 firstBytes,nBytes,oBytes
	logical  sending

	if (shuttingDown)
     1		return

	! loop while the remote appears to be sending to us

	obytes = firstBytes
	sending = TRUE
	do while (sending)

	    if (shuttingDown)
     1		return

	    ! wait a bit before checking again
	    call WaitRemo(remoteWaitTime)

	    ! check typeahead buffer
	    call CheckRemo(nBytes)

	    ! if typeahead buffer is almost full - do a read
	    if (nbytes .gt. typeAheadlimit) then
		call Read$remo(nBytes,keepReading)
		sending = FALSE

	    ! if nothing arrived since last time - do a read
	    elseif (obytes .eq. nbytes) then
		call Read$remo(nBytes,stopReading)
		sending = FALSE

	    ! otherwise remember how many bytes we have now for next time round
	    else
		oBytes = nBytes
	    endif

	enddo

	return
	end

	subroutine CheckRemo(nBytes)
c
c	Get typeahead count for remote system
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'

	integer*4 nBytes
	integer*2 typeAheadBuf(4)

	if (shuttingDown)
     1		return

	if (firstTimeRun) then
		remoteTypeAhdFunc = remoteTypeAhdFunc +io$m_purge
		firstTimeRun = FALSE
	endif

	status = sys$qiow(,%val(remoteChannel),
     1			   %val(io$_sensemode+io$m_typeahdcnt),
     1			   %ref(remoteReadIosb)
     1			   ,,,
     1			   %ref(typeaheadBuf),,,,,)

	call CheckStatus('CheckRemo(senseRemoteTypeAhead)',status)

	nBytes = typeaheadBuf(1)

	return
	end

	subroutine WaitRemo(timeToWait)
c
c	subroutine to perform an in-line wait
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	character*(*) timeToWait
	integer*4 status
	real*8 delta	

	if (shuttingDown)
     1		return

	status = sys$bintim(%descr(timeToWait),
     1			    %ref(delta))
	call CheckStatus('WaitRemo(bintim)',status)

	status = sys$setimr(%val(WaitRemoEfn),
     1			    %ref(delta),,)
	call CheckStatus('WaitRemo(setimr)',status)

	status = sys$waitfr(%val(WaitRemoEfn))
	call CheckStatus('WaitRemo(waitfr)',status)

	return
	end

	subroutine Read$remo(nBytes,astFlag)
c
c	issues a QIO read to the remote system
c	fires AST gotRemo on read completion
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	integer*4 nBytes,astFlag,bufAddr, status
	external gotRemo

	if (shuttingDown)
     1		return

	bufAddr = %loc(remoteToLocalBuf(remoteReadStart))
	status = sys$qio(,%val(remoteChannel),
     1			  %val(remoteReadFunc),
     1			  %ref(remoteReadIosb),
     1			  gotRemo,astFlag,
     1			  %val(bufAddr),
     1			  %val(nbytes),,
     1			  %ref(remoteTerminator),,)

	return
	end

	subroutine GotRemo(readerSays)
c
c	AST routine fired when remote system read completes.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'

	integer*4 readerSays
	integer*4 status,nBytes,i,j

	! check read status code.
	status = remoteReadIosb(1)
	if (status .eq. ss$_abort) then
		! read was cancelled; do it again
		call ReadRemo
		return
	elseif ((status .eq. ss$_hangup) .and. (.not.(firstTurn))) then
     		call ShutDown(ss$_hangup)
	elseif (status .ne. ss$_parity) then
		call CheckStatus('remote read completion',status)
	endif

	firstTurn = FALSE

	! Get the byte count from iosb
	nBytes = remoteReadIosb(2) + remoteReadIosb(4)

	! adjust pointer for next read
	remoteReadStart = remoteReadStart + nBytes

	! increment chars-to-write counter
	localWriteChars = localWriteChars + nBytes

	! decide whether to do another read or write what we have now

	if (readerSays .eq. stopReading) then
	    ! the reader said no more
	    call WriteLoco
	elseif (localWriteChars+maxTypeAhead .gt. maxLocalWrite) then
	    ! almost got a full block; read it
	    call WriteLoco
	else
	    ! check the typeahead buffer
	    call CheckRemo(nBytes)
	    if (nBytes .eq. 0) then
		! no more data; do a write
		call WriteLoco
	    else
		! there is more data; do another read
		call WatchRemo(nBytes)
	    endif
	endif
	
	return
	end

	subroutine WriteLoco
c
c	sends a complete write-block to local terminal 
c
c	completion of the write runs AST sentLoco
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	
	integer*4 status
	external sentLoco

	status = sys$qio(,%val(localChannel),
     1			  %val(localWriteFunc),
     1			  ,
     1			  sentLoco,,
     1			  %ref(remoteToLocalBuf),
     1			  %val(localWriteChars),,,,)
	call CheckStatus('writeLoco(immediate)',status)

	localWriteChars = 0
	remoteReadStart = 1
	
	! once again start read of remote terminal

	call Readremo

	return
	end

	subroutine SentLoco
c
c	Routine used to collect statistics for tracing.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	return
	end

	subroutine ReadLoco
c
c	issue a read to the local terminal
c
c	completion of the read runs AST WriteRemo 
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'

	integer*4 status
	external writeremo

	status = sys$qio(,%val(localChannel),
     1			  %val(localReadFunc),
     1			  %ref(localReadIosb),
     1			  writeremo,,
     1			  %ref(localToRemoteBuf),
     1			  %val(localReadSize),,
     1			  %ref(localterminator),,)

	call CheckStatus('ReadLoco(readLocalTerm)',status)
c
	return
	end

	subroutine Writeremo
c
c	AST routine fired when local terminal read completes
c	
c	checks for VTerminal escape character in the received data
c	if found begins termination of the program
c	otherwise copies the data to the remote system
c
c	Completion of the write runs AST ReadLoco
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'

	integer*4 status,nBytes
	logical escapeRequest
	external readLoco

	! check read status
	status = localReadIosb(1)	 ! Get status code.
	if (status .eq. ss$_abort) then
	    ! read was cancelled; do it again
	    call ReadLoco 
	    return
	elseif (status .eq. ss$_parity) then
		call SendBreakChar
		call ReadLoco
		return
	else
	    	call CheckStatus('local read completion',status)
	endif

	! get number of bytes read
	nBytes = localReadIosb(2) + localReadIosb(4)

	! check for escape character
	escapeRequest = FALSE
	do ix=1,nBytes
	    if (localToRemoteBuf(ix) .eq. escapeChar) then
		escapeRequest = TRUE
	    endif
	enddo

	! the escape character means that user wants out of session
	if (escapeRequest) then
		call ShutDown(ss$_normal)
	else

		status = sys$qio(,%val(remoteChannel),
     1				  %val(remoteWriteFunc),
     1				  %ref(remoteWriteIosb),
     1				  readLoco,,
     1				  %ref(localToRemoteBuf),
     1				  %val(nBytes),,,,)
		call CheckStatus('WriteRemo(immediate)',status)

	endif

	return
	end

	subroutine SendBreakChar
c
c	Subroutine to send a break character to the remote
c	by   1. dropping remote line speed to 50 baud.
c	     2. sending two FF's.
c	     3. restoring line speed to original speed.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'
	include 'UTCS$INCLUDE:ttdef.for/nolist'

	integer*4	remoteChar(2),lineSpeed,nBytes,status
	integer*2	tempReadIosb(4), tempWriteIosb(4)
	character*1	syncBytes(10)

	!  Set local write pointer to null
	localWriteChars = 0

	!  Cancel all I/O on the remote channel.
	status = sys$cancel(%val(remoteChannel))

	! Get remote characteristics.
	status = sys$qiow(,%val(remoteChannel),
     1			   %val(io$_sensemode),
     1			   %ref(tempReadIosb),,,
     1			   %ref(remoteChar),,,,,)
	call CheckStatus('sendBreakChar(sensemode)', status)

	! Save line speed from IOSB
	lineSpeed = tempReadIosb(2)

	! Set remote with 50 baud rate.
	status = sys$qiow(,%val(remoteChannel),
     1			   %val(io$_setmode),
     1			   %ref(tempReadIosb),,,
     1			   %ref(remoteChar),,
     1			   %val(tt$c_baud_50),,,)
	call CheckStatus('sendBreakChar(setmode50)', status)

	! Write a three hex FF's to remote.
	syncBytes(1) = char(0)
	syncBytes(2) = char(0)
	nBytes = 2
	status = sys$qiow(,%val(remoteChannel),
     1			   %val(remoteWriteFunc),
     1			   %ref(tempWriteIosb),,,
     1			   %ref(syncBytes),
     1			   %val(nBytes),,,,)
	call CheckStatus('sendBreakChar(writeBuf)',status)

	! Set remote back to old line speed.
	status = sys$qiow(,%val(remoteChannel),
     1			   %val(io$_setmode),
     1			   %ref(tempReadIosb),,,
     1			   %ref(remoteChar),,
     1			   %val(lineSpeed),,,)
	call CheckStatus('sendBreakChar(setmode100)', status)

	return
	end

	subroutine CheckStatus(facilityName,statusCode)
c
c	Subroutine to check status from a System Service.
c
c	Inputs:
c		facilityName - Subroutine name.
c		statusCode - Status code.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'

	character*(*) facilityName
	integer*4 statusCode

	character*(*) errorMessage
	parameter (errorMessage = 'VTerminal Terminated with ERROR')

	character*80 message
	integer*4 flags,msglen

	if (shuttingdown)
     1		return

	if (mod(statusCode,2) .ne. 1) then

	    ! obtain error message from the system
	    flags = "7	! get text,id and severity, but not facility
	    call sys$getmsg(%val(statusCode),
     1			    %ref(msglen),
     1			    %descr(message),
     1			    %val(flags),)

	    ! send it to the user
	    call WriteUser('%'//facilityName//'-'//message(2:msglen))

	    ! and terminate
	    call ShutDown(statusCode)
	endif

	return
	end

	subroutine ShutDown(statusCode)
c
c	Subroutine to terminate VTerminal processing
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'
	include 'UTCS$INCLUDE:ssdef.for/nolist'

	integer*4 statusCode

	shuttingDown = TRUE

	status = sys$cancel(%val(remoteChannel))

	if (statusCode .eq. SS$_HANGUP) then
		status = sys$dassgn(%val(remoteChannel))
		connected = TRUE
	endif

	! Schedule a wake up for the hibernating process.
	status = sys$wake(,)

	return
	end

	subroutine WriteUser(message)
c
c	Write a message to the local terminal surrounded by CRLFs
c
c	Dont check completion status - called from termination 
c	code so terminal may be gone.
c
	include 'VTERMDIR:vglobal.for/nolist'
	include 'UTCS$INCLUDE:booleans.for/nolist'
	include 'UTCS$INCLUDE:iodef.for/nolist'

	character*(*) message
	integer*4 length,status

	print *,message

	return
	end
c
c----------------------- Image and exit handler -------------------------
c
	subroutine SetUpExitHandlerVMS(swapm, priority)
c
c	Place the image into no swap mode, higher priority, and set up
c	the exit handler.
c
	integer*4	status, exitBlock(4), swapm, priority

	call sys$setswm(%VAL(swapm)) 	
	call sys$setpri(,,%VAL(priority),) 	

	return
	end
