C unexpected error condition handler
	INTEGER*4 FUNCTION ERRHAND(SIG,MECH)
	IMPLICIT INTEGER*4 (A-Z)
	INTEGER*4 SIG(*),MECH(*)
!	include '($ssdef)/list'
	PARAMETER (ss$_continue = '00000001'X)
	PARAMETER (ss$_resignal = '00000918'X)
	PARAMETER (ss$_UNWIND = '00000920'X)
	CHARACTER*50 filename

	LOGICAL PREV_ERROR/.false./
C Should this error be ignored?
	i = LIB$MATCH_COND(sig(2),ss$_unwind)
	if (i .eq. 1) return ! unwinding, do nothing
C What facility is the error from?
	i = ibits(sig(2),16,27)
C if this is the CLI facility then display the error and return
	IF (i .eq. 3) then 
	  SIG(1) = sig(1) - 2
	  CALL SYS$PUTMSG(SIG,,,)
	  SIG(1) = sig(1) + 2
	  ERRHAND = ss$_continue
	  return
	ENDIF
	write (*,'(1x,70(''-''),/,a,z8.8,a)',err=999) 
	1	' VMS ERROR ENCOUNTERED (#',sig(2),')'
C is this a second non-recovered error?
	IF (PREV_ERROR) THEN
	  write (*,'(a)',err=999) ' This is a second error, exiting!)'
	  CALL SYS$EXIT(%val(sig(2)))
	endif
C set non-reenterance flag
	PREV_ERROR = .true.
C now display the error message on SYS$OUTPUT:
	SIG(1) = sig(1) - 2
	CALL SYS$PUTMSG(SIG,,,)
	SIG(1) = sig(1) + 2
C ask for option:
1	write (*,'(1x,70(''-''),/,a)',err=999) ' You have five options:'
	write (*,'(a)',err=999) ' 	(1) Save file and exit'
	write (*,'(a)',err=999) ' 	(2) Try to continue, ignoring error'
	write (*,'(a)',err=999) ' 	(3) Call VMS error handler'
	write (*,'(a)',err=999) 
	1	' 	(4) Return to main menu (not always successful)'
	write (*,'(a)',err=999) ' 	(5) Stop'
	write (*,'(a)',err=999) '$Enter your choice (default=1): '
	read (*,'(i)',err=999) i
C----------------------------------------------------------------------
	if (i .le. 1) then
	  write(*,832)
832	  format('$Enter the file name root (default type = .USRPDF): ')
	  read (*,fmt='(q,a)',end=999) len,filename
	  CALL TBLWRITE(filename,len,*999)
	  call exit
C----------------------------------------------------------------------
	elseif (i .eq. 2) then
C reset non-reenterance flag
	  PREV_ERROR = .false.
	  ERRHAND = ss$_continue
C reset "fatal error" bit
	  SIG(2) = IBCLR(SIG(2),2)
	  return
C----------------------------------------------------------------------
	elseif (i .eq. 3) then
C reset non-reenterance flag
	  PREV_ERROR = .false.
	  ERRHAND = ss$_resignal
C reset "fatal error" bit
	  SIG(2) = IBCLR(SIG(2),2)
	  return
C----------------------------------------------------------------------
	elseif (i .eq. 4) then
C reset non-reenterance flag
	  PREV_ERROR = .false.
C unwind stack to return to the main program where LIB$ESTABLISH was called
	  CALL SYS$UNWIND(mech(3),)
	  return
C----------------------------------------------------------------------
	elseif (i .eq. 5) then
999	  stop
C----------------------------------------------------------------------
	else
	  goto 1
	Endif

	end
