	SUBROUTINE OUTPUT (IBUF,NBYTES)
C
C	NAME: OUTPUT
C
C	LANGUAGE:  VAX-11 FORTRAN-77
C
C	OPERATING SYSTEM:  VAX/VMS
C
C	ORDER NUMBER:  12X-9XV
C
C	PART NUMBER:  000-025809-XXX REV. G  MAY, 1985
C
C	PRODUCT: VAX-11 DIAGNOSTIC,
C	PRODUCT: VAX/VMS DRIVER, SYMBIONT, AND OUTPUT PACKAGE
C
C	VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051
C	A XEROX COMPANY
C
C	Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
C
C	"NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC,
C	INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED
C	LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO
C	PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE
C	REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE
C	THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF
C	VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE
C	AGREEMENT.  THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER
C	THE COPYRIGHT ACT OF 1976."
C
C
C	RELEASE DATE: OCT. 16, 1981
C		FIRST RELEASED WITH REV. B DRIVER
C
C	CHANGE HISTORY:
C
C	REV C - APRIL 30, 1982
C	NO CHANGES TO THIS MODULE
C
C	REV D - JUNE 10, 1983 - P.D.
C	CHANGES MADE FOR COMPATIBILITY OF 122 CONTROLLER
C		(REMOTE FUNCTIONS)
C
C	REV E - JUNE 27,1983 - P.D..
C	NO CHANGES TO THIS MODULE
C
C	REV F - JUNE 15, 1984 - B.L. AND D.W.
C	CHANGES MADE TO SUPPORT REMOTE OUTPUT
C
C	REV G - MAY, 1985 - B.L.
C	SUPPORT 440-10 AND 454 ASYNC DEVICES
C	PRINT STATUS MESSAGE ON DISK OPEN FAILURE
C	OUTPUT REMOTE FUNCTIONS IN PLOT MODE
C	INCREASE BUFFER SIZE TO 32,764.
C	MISC. CHANGES FOR VMS V4 COMPATIBILITY
C
C	OUTPUT - OUTPUT ROUTINE FOR PLOTTER/MAGTAPE/REP/VRC/ASYNC
C
C	SUBROUTINE OUTPUT TAKES THE INPUT BUFFER, NBYTES LONG
C	AND OUTPUTS THE DATA TO THE OUTPUT DEVICE AS FOLLOWS:
C
C	OUTPUT DEVICE		RECORD LENGTH		DC1/DC2/DC3
C
C	MAGTAPE			NBYTES			NO
C	DIRECT PLOTTER		NBYTES			NO
C	SPOOLED PLOTTER		VRECL(DEF=32764)	DC1=DATA STD.
C							DC2=RASTER
C							DC3=REMOTE
C	DISK, VREMOTE NOT
C	  DEFINED (ASSUM SPOOL)	VRECL(DEF=32764)	YES, AS ABOVE
C	DIRECT TERMINAL		NBYTES			NO
C	SPOOLED TERMINAL	VRECL(DEF=32764)	DC1=DATA STD.
C	DISK, VREMOTE DEFINED	VRECL(DEF=80)		NO
C	OTHER (ASSUM REMOTE)	VRECL(DEF=80)		NO
C
C	ENTRY:	CALL ATTACH
C			THIS ROUTINE IS CALLED TO ATTACH THE
C			LOGICAL NAME 'VEROUT' TO THE PHYSICAL
C			DEVICE. THE ROUTINE WILL ALSO DETERMINE
C			WHAT TYPE OF OUTPUT IS NEEDED, AND SET
C			UP BUFFER LENGTHS, ETC. ACCORDINGLY.
C
C	EXIT:	OUTPUT DEVICE ASSIGNED.
C
C	ENTRY:	CALL DETACH
C			THIS ROUTINE IS CALLED TO RELEASE THE DEVICE
C			ASSIGNED FOR OUTPUT.  IF AN OUTPUT BUFFER IS
C			BEING USED IT WILL BE FLUSHED AND WRITTEN TO
C			THE OUTPUT FILE.
C
C	ENTRY:	CALL OUTPUT(IBUF,NBYTES)
C
C			IBUF  - DATA BUFFER
C			NBYTES - NUMBER OF BYTES TO OUTPUT
C			   = 0   IBUF(1) CONTAINS REM. FUNCTION INDEX
C				 FOR ONLINE DATA, OR EOF FOR MAGTAPE
C				 IBUF(1) = 1 - REMOTE LINE TERMINATE
C					 = 2 - REMOTE BUFFER CLEAR
C					 = 3 - REMOTE RESET
C					 = 4 - REMOTE FORM FEED
C					 = 5 - REM. END OF TRANSMISSION
C
C			THIS ROUTINE IS CALLED TO TRANSFER DATA
C			TO THE OUTPUT DEVICE. IF THE OUTPUT IS FOR
C			MAGTAPE, THE CALL WITH A ZERO BYTE COUNT WILL
C			CAUSE AN END-OF-FILE MARK TO BE WRITTEN ON THE
C			TAPE.  FOR BUFFERED OUTPUT, THE OUTPUT BUFFER
C			WILL BE FLUSHED.  IF SPOOLING IS BEING USED,
C			A SPECIAL CONTROL CHARACTER PLUS THE REMOTE
C			FUNCTION REQUESTED, WILL BE SENT TO THE SPOOLED
C			FILE.  REMOTE FUNCTIONS ARE IGNORED FOR REMOTE
C			OUTPUT.
C
C	EXIT: DATA WRITE FUNCTION QUEUED TO THE OUTPUT DEVICE
C
C	ENTRY:  CALL OWAIT
C			THIS ROUTINE IS CALLED TO WAIT FOR LAST OUTPUT
C			OPERATION TO COMPLETE. IF THE OUTPUT DEVICE IS
C			BUFFERED, OWAIT JUST RETURNS WITHOUT WAITING.
C
C	ENTRY:  CALL OEOF
C			THIS ROUTINE IS CALLED TO OUTPUT A END-OF-FILE
C			MARK TO A MAGNETIC TAPE. IF OUTPUT DEVICE IS NOT
C			MAGTAPE ROUTINE JUST RETURNS WITHOUT PERFORMING
C			ANY OPERATION.
C
C	CALLS: VERBUFF ASSEMBLER MODULE, SYSTEM ROUTINES
C
C	CALLED BY:  APPLICATION SOFTWARE
C
	IMPLICIT INTEGER*4 (A-Z)
	EXTERNAL VERFAB_GET
C
	LOGICAL*4 NOTIFY,BUFFERED,DCX
	INTEGER*2 STATS(4)
C
	INTEGER*4 QDELAY(2),CHAN
C
	BYTE IOBUF,IBUF(1)
	BYTE DC1,DC2
C
	PARAMETER	(IO$M_PLOT	= '00000040'X)
	PARAMETER	(IO$M_REMOTE	= '00000080'X)
	PARAMETER	(IOTYPE$M_SWAP	= '00000100'X)
	PARAMETER	(IO$M_SWAPBYTES	= '00000400'X)
	PARAMETER	(IOTYPE$M_PLOT	= '00000001'X)
C
C
C... INCLUDE SYSTEM DEFINITIONS FOR DEVICE CLASS, I/O, MAGTAPE, STATUS
C    THESE DEFINITIONS COME FROM THE FILE SYS$LIBRARY:FORSYSDEF.TLB,
C    WHICH IS DISTRIBUTED WITH THE DEC FORTRAN COMPILER.
	INCLUDE '($DCDEF)/LIST'
	INCLUDE '($DVIDEF)/LIST'
	INCLUDE '($FABDEF)/LIST'
	INCLUDE '($FSCNDEF)/LIST'
	INCLUDE '($IODEF)/LIST'
	INCLUDE '($LNMDEF)/LIST'
	INCLUDE '($NAMDEF)/LIST'
	INCLUDE '($RMSDEF)/LIST'
	INCLUDE '($SJCDEF)/LIST'
	INCLUDE '($SSDEF)/LIST'
	INCLUDE '($SYSSRVNAM)/LIST'
C
	CHARACTER*10 RECDES
	CHARACTER*(NAM$C_MAXRSS) FIL_NAM
	CHARACTER*1 ANSWER
C
C... DEFINE THE STRUCTURE OF AN ITEM LIST ELEMENT
	STRUCTURE /ITMLST_STR/
	  INTEGER*2 BUFLEN/4/,ITMCOD/0/
	  INTEGER*4 BUFADR,RETLEN/0/
	END STRUCTURE
	RECORD /ITMLST_STR/ GETDVI_ITMLST(3)
	RECORD /ITMLST_STR/ SNDJBC_ITMLST(6)
	RECORD /ITMLST_STR/ TRNLNM_ITMLST(2)
C
	RECORD /FABDEF/ VRS_FAB
	RECORD /NAMDEF/ VRS_NAM
C
C	COMMON USED:
C	/IOCOM/
C		I LUNIT     - LOGICAL UNIT NUMBER OF LISTING DEVICE
C		I IOTYPE    - INDICATES TYPE OF OUTPUT (PRINT OR PLOT)
C
C	/VERBUF/
C		I VRECL     - NUMBER OF BYTES PER BUFFERED RECORD
C		I FSTBYT    - OFFSET FROM IOBUF(1) TO FIRST DATA LOCATION.
C				=2 IF DATA TO BE SENT THROUGH VERSATEC
C					DEVICE DRIVER OR SPOOLER
C				=0 IF DATA TO BE TRANSMITTED TO REMOTE DEVICE
C		I IOBUF     - OUTPUT BUFFER FOR BUFFERING
C
C... COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
	COMMON /IOCOM/ IUNIT,LUNIT,LREC,IOTYPE
C
C... COMMON /VERBUF/ - IO BUFFER FOR BUFFERED OUTPUT
	PARAMETER (MAX_VRECL	=  32764)
	COMMON /VERBUF/ FIL_NAM,VRECL,FSTBYT,IOBUF(MAX_VRECL)
C
C... SET SPOOLING CHARACTERS; TEN SECOND DELAY
	DATA DC1/17/,DC2/18/
	DATA QDELAY/-100000000,-1/
	DATA IOTYPE_LAST/-1/
	DATA KUNIT/5/
C
C... FORMAT STATMENTS
9401	FORMAT(/' OUTPUT - Error writing to output device: 'A)
9500	FORMAT(/' ATTACH - Error translating logical name VEROUT')
9502	FORMAT(/' ATTACH - Error parsing logical name VEROUT',/,
	1	'   file name: 'A)
9505	FORMAT(/' ATTACH - Error getting information for device: 'A)
9510	FORMAT(/' ATTACH - Error translating logical name VREMOTE')
9512	FORMAT(/' ATTACH - Error translating logical name VRECL')
9513	FORMAT(/' ATTACH - Error---logical name VRECL is assigned to: '
	1	,A,',',/,'      it must be an integer')
9514	FORMAT(/' ATTACH - Error---VRECL is',I8,
	1	', it must be even and between 4 and',I8)
9515	FORMAT(/' ATTACH - Error getting logical unit number')
9518	FORMAT(/' ATTACH - Error opening buffered file: ',A)
9520	FORMAT(/' ATTACH - Error allocating device: 'A)
9525	FORMAT(/' ATTACH - Device: ',A,' not available - waiting')
9530	FORMAT(/' ATTACH - Error scheduling process wakeup')
9535	FORMAT(/' ATTACH - Device: ',A,' available - proceeding')
9540	FORMAT(/' ATTACH - Error assigning I/O channel for device: 'A)
9543	FORMAT(/' ATTACH - Error getting event flag')
9545	FORMAT
	1 (/'$Do you want tape positioned to logical EOT? (Y or N): ')
9550	FORMAT(A)
9555	FORMAT(/' ATTACH - Error rewinding tape to load point')
9560	FORMAT(/' ATTACH - Error positioning tape to last tape mark')
9562	FORMAT(/' ATTACH - Error spaced 32767 blocks with no EOF')
9564	FORMAT(/' ATTACH - Error backspacing tape to append file')
9565	FORMAT(/' ATTACH - Error---backspaced tape to append file',
	1	', but no tape mark')
9600	FORMAT(/' OEOF - Error writing tape mark')
9700	FORMAT(/' DETACH - Error translating logical name VQUEUE')
9705	FORMAT(/' DETACH - Error sending print command to job controller')
9710	FORMAT(/' DETACH - Print job number',I6,' sent to queue ',A)
C
C... CHECK IF BUFFER NEEDS TO BE SWAPPED
	IF (((IOTYPE .AND. IOTYPE$M_SWAP) .NE. 0) .AND.
	1  ((ICLASS_PRI .EQ. DC$_TAPE) .OR.
	2  (ICLASS_PRI .EQ. DC$_TERM) .OR.
	3  ((BUFFERED) .AND. (.NOT. DCX)))) CALL SWAP_BYTES(IBUF,NBYTES)
C
C... CHECK IF BUFFERED OUTPUT
	IF (.NOT. BUFFERED) GOTO 20
C
C... CHECK FOR BYTE COUNT = 0
	IF (NBYTES .NE. 0) GO TO 10
C
C... BYTE COUNT ZERO, IBUF(1) CONTAINS INDEX FOR REMOTE FUNCTION
	IF ((IBUF(1) .LT. 1) .OR. (IBUF(1) .GT. 5)) RETURN
	IF ((.NOT. DCX) .OR. (ICLASS_SEC .EQ. DC$_TERM)) RETURN
	CALL FLUSH_BUF
	IOTYPE_LAST = -1
	CALL REMOTE(IBUF(1))
	RETURN
C
C... SEE IF PUTTING DCX CODES IN FILE
10	IF (.NOT. DCX) GOTO 18
C
C... IF STILL OUTPUTING SAME TYPE DATA DON'T FLUSH BUFFER
	IF (IOTYPE .EQ. IOTYPE_LAST) GO TO 15
C
C... FLUSH OUTPUT BUFFER
	CALL FLUSH_BUF
C
C... SAVE NEW DATA TYPE (RASTER=1 OR TRANSPARENT DATA=0)
	IOTYPE_LAST = IOTYPE
C
C... ASSUME TRANSPARENT PRINT DATA
	IOBUF(1) = DC1
C
C... SEE IF RASTER OUTPUT
	IF ((IOTYPE .AND. IOTYPE$M_PLOT) .NE. 0) IOBUF(1) = DC2
C
C... CHECK FOR BYTE SWAPPING
15	IF ((IOTYPE .AND. IOTYPE$M_SWAP) .NE. 0)
	1		IOBUF(1) = IOBUF(1) .OR. '80'X
C
C... BREAK INPUT BUFFER INTO RECORDS AND RETURN
18	CALL FILL_BUF(IBUF,NBYTES)
	RETURN
C
C... NOT BUFFERED, WAIT FOR PREVIOUS CALL AND CHECK STATUS
20	CALL SYS$WAITFR(%VAL(EVENFLG))
	IF (STATS(1)) GOTO 25
	WRITE (LUNIT,9401) FIL_NAM(1:VRS_NAM.NAM$B_ESL)
	GOTO 9000
C
C... CHECK IF BYTE COUNT ZERO
25	IF (NBYTES .NE. 0) GOTO 30
C
C... IF TERMINAL CAN'T DO REMOTE FUNCTION SO JUST RETURN
	IF (ICLASS_PRI .EQ. DC$_TERM) RETURN
C
C... IF MAGTAPE GO WRITE END-OF-FILE MARK ON TAPE
	IF (ICLASS_PRI .EQ. DC$_TAPE) GOTO 8500
C
C... ISSUE REMOTE FUNCTION, THEN GO CHECK FOR ERROR
	REM_CODE = IBUF(1)
	IF ((REM_CODE .LT. 1) .OR. (REM_CODE .GT. 5)) RETURN
	ISTAT = SYS$QIO(%VAL(EVENFLG),%VAL(CHAN),
	1	%VAL(IO$_WRITEVBLK .OR. IO$M_REMOTE .OR. IO$M_PLOT),
	2	STATS,,,,,%VAL(REM_CODE),,,)
	GOTO 45
C
C... DATA TRANSFER, ASSUME MAGTAPE
30	IOFUNC = IO$_WRITEVBLK
	IF (ICLASS_PRI .EQ. DC$_TAPE) GOTO 40
C
C... ASSUME PRINT TRANSPARENT TRANSFERS
	IOFUNC = IOFUNC .OR. IO$M_NOFORMAT
	IF (ICLASS_PRI .EQ. DC$_TERM) GOTO 40
C
C... IF RASTER OUTPUT, SET PROPER QIO FUNCTION
	IF ((IOTYPE .AND. IOTYPE$M_PLOT) .NE. 0)
	1		IOFUNC = IOFUNC .OR. IO$M_PLOT
C
C... CHECK FOR BYTE SWAPPING, IF SO, SET SWAP BIT FOR DRIVER
	IF ((IOTYPE .AND. IOTYPE$M_SWAP) .NE. 0)
	1		IOFUNC = IOFUNC .OR. IO$M_SWAPBYTES
C
C... OUTPUT TO DEVICE
40	ISTAT = SYS$QIO (%VAL(EVENFLG),%VAL(CHAN),%VAL(IOFUNC),
	1			STATS,,,IBUF,%VAL(NBYTES),,,,)
C
C... CHECK FOR ERROR
45	IF (ISTAT) RETURN
	WRITE (LUNIT,9401) FIL_NAM(1:VRS_NAM.NAM$B_ESL)
	GOTO 9010
C
C*******************************************************
C... ATTACH OUTPUT DEVICE
	ENTRY ATTACH
C
C... TRANSLATE LOGICAL NAME JUST TO MAKE SURE IT IS ASSIGNED
C    DO NOT BOTHER TO GET TRANSLATED TEXT
	ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV','VEROUT',,)
	IF (ISTAT) GOTO 100
	WRITE (LUNIT,9500)
	GOTO 9010
C
C... PARSE FILE NAME
100	VRS_FAB.FAB$B_BID = FAB$C_BID
	VRS_FAB.FAB$B_BLN = FAB$C_BLN
	VRS_FAB.FAB$L_DNA = %LOC('VRSTEC.VDS')
	VRS_FAB.FAB$B_DNS = 10
	VRS_FAB.FAB$L_FNA = %LOC('VEROUT')
	VRS_FAB.FAB$B_FNS = 6
	VRS_FAB.FAB$L_NAM = %LOC(VRS_NAM)
	VRS_NAM.NAM$B_BID = NAM$C_BID
	VRS_NAM.NAM$B_BLN = NAM$C_BLN
	VRS_NAM.NAM$L_ESA = %LOC(FIL_NAM)
	VRS_NAM.NAM$B_ESS = NAM$C_MAXRSS
	VRS_NAM.NAM$B_NOP = NAM$M_SYNCHK
	ISTAT = SYS$PARSE(VRS_FAB)
	IF (ISTAT) GOTO 110
	WRITE (LUNIT,9502) FIL_NAM(1:VRS_NAM.NAM$B_ESL)
	CALL LIB$STOP(%VAL(ISTAT),%VAL(VRS_FAB.FAB$L_STV))
C
C... GET DEVICE CLASS, AND CHECK FOR ERROR
110	GETDVI_ITMLST(1).ITMCOD = DVI$_DEVCLASS
	GETDVI_ITMLST(1).BUFADR = %LOC(ICLASS_PRI)
	GETDVI_ITMLST(2).ITMCOD = DVI$_DEVCLASS .OR. DVI$C_SECONDARY
	GETDVI_ITMLST(2).BUFADR = %LOC(ICLASS_SEC)
	DEV_END = VRS_NAM.NAM$B_NODE+VRS_NAM.NAM$B_DEV
	ISTAT = SYS$GETDVIW(,,FIL_NAM(1:DEV_END),GETDVI_ITMLST,STATS,,,)
	IF (ISTAT) GOTO 120
	IF (ISTAT .EQ. SS$_NONLOCAL) GOTO 200
	WRITE(LUNIT,9505) FIL_NAM(1:DEV_END)
	GOTO 9010
120	IF (STATS(1)) GOTO 130
	WRITE(LUNIT,9505) FIL_NAM(1:DEV_END)
	GOTO 9000
C
C... DETERMINE DEVICE CLASS
130	IF ((ICLASS_PRI .EQ. DC$_LP) .OR.
	1	(ICLASS_PRI .EQ. DC$_TERM)) GOTO 300
	IF (ICLASS_PRI .EQ. DC$_TAPE) GOTO 1000
	IF ((ICLASS_PRI .EQ. DC$_DISK) .AND. (ICLASS_SEC .EQ. DC$_LP))
	1						GOTO 210
	IF ((ICLASS_PRI .EQ. DC$_DISK) .AND. (ICLASS_SEC .EQ. DC$_TERM))
	1						GOTO 205
	IF (ICLASS_PRI .NE. DC$_DISK) GOTO 220
C
C... SAVE GETDVIW STATUS
200	DVISTAT = ISTAT
C
C... SEE IF LOGICAL VREMOTE IS DEFINED, IF SO, SET-UP FOR REMOTE
	ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV','VREMOTE',,)
	IF (ISTAT) GOTO 220
	IF (ISTAT .EQ. SS$_NOLOGNAM) GOTO 202
	WRITE (LUNIT,9510)
	GOTO 9010
C
C... IF DECNET IS INVOLVED USE LOWER RECORD SIZE
202	IF (DVISTAT .NE. SS$_NONLOCAL) GOTO 210
	VRECL = 4096
	GOTO 215
C
C... SETUP FOR BUFFERED FILE FOR OUTPUT THROUGH SPOOLED TERMINAL
C... ASSUME MAXBUF IS AT LEAST 1584
205	VRECL = 1484
	GOTO 215
C
C... SETUP FOR BUFFERED FILE FOR OUTPUT THROUGH VERSATEC DRIVER
210	VRECL = 32764
215	DCX = .TRUE.
	FSTBYT = 2
	GOTO 230
C
C... SETUP FOR BUFFERED FILE FOR TRANSMISSION TO REMOTE DEVICE
220	DCX = .FALSE.
	VRECL = 80
	FSTBYT = 0
	IF ((VRS_NAM.NAM$L_FNB .AND. NAM$M_EXP_TYPE) .EQ. 0) THEN
	  TYPSTRT = DEV_END + VRS_NAM.NAM$B_DIR + VRS_NAM.NAM$B_NAME + 1
	  TYPEND = TYPSTRT + VRS_NAM.NAM$B_TYPE - 1
	  FIL_NAM(TYPSTRT:TYPEND) = '.RMT'
	ENDIF
C
C... SETUP LOGICAL FOR BUFFERED
230	BUFFERED = .TRUE.
C
C... SEE IF USER PASSED RECORD LENGTH IN VRECL
	TRNLNM_ITMLST(1).ITMCOD = LNM$_STRING
	TRNLNM_ITMLST(1).BUFLEN = 10
	TRNLNM_ITMLST(1).BUFADR = %LOC(RECDES)
	TRNLNM_ITMLST(1).RETLEN = %LOC(RECDES_LEN)
	ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV',
	1				'VRECL',,TRNLNM_ITMLST)
	IF(ISTAT .EQ. SS$_NOLOGNAM) GOTO 260
	IF(ISTAT) GOTO 240
	WRITE (LUNIT,9512)
	GOTO 9010
240	READ (UNIT=RECDES(1:RECDES_LEN),FMT='(I10)',ERR=250) VRECL
	IF ((VRECL .LE. MAX_VRECL) .AND. (VRECL .GE. 4)
	1			.AND. ((VRECL .AND. 1) .EQ. 0)) GOTO 260
	WRITE (LUNIT,9514) VRECL,MAX_VRECL
	CALL EXIT
250	WRITE (LUNIT,9513) RECDES
	CALL EXIT
C
C... GET LUN NUMBER AND OPEN FILE
260	ISTAT = LIB$GET_LUN(OUNIT)
	IF (ISTAT) GOTO 270
	WRITE (LUNIT,9515)
	GOTO 9010
270	OPEN (UNIT=OUNIT,FILE=FIL_NAM,CARRIAGECONTROL='NONE',
	1	RECL=VRECL,FORM='FORMATTED',STATUS='NEW',
	2	RECORDTYPE='VARIABLE',USEROPEN=VERFAB_GET,
	3	ERR=280,IOSTAT=IOS)
	RETURN
C
C... OPEN ERROR
280	WRITE (LUNIT,9518) FIL_NAM(1:VRS_NAM.NAM$B_ESL)
	CALL ERRSNS(IOS,IRMS_STS,IRMS_STV,,ISTAT)
	CALL LIB$STOP(%VAL(ISTAT),%VAL(2),%VAL(OUNIT),%DESCR(FIL_NAM),
	1				%VAL(IRMS_STS),%VAL(IRMS_STV))
C
C... DIRECT (NON-BUFFERED) PLOTTER OR TERMINAL, ALLOCATE
300	NOTIFY = .TRUE.
310	ISTAT = SYS$ALLOC (FIL_NAM(1:DEV_END),,,)
	IF (ISTAT) GOTO 330
C
C... CHECK IF DEVICE ALLOCATED TO ANOTHER USER
	IF (ISTAT .EQ. SS$_DEVALLOC) GOTO 320
C
C... UNABLE TO ALLOCATE DEVICE
	WRITE (LUNIT,9520) FIL_NAM(1:DEV_END)
	GOTO 9010
C
C... IF NOTIFY TRUE SEND MESSAGE TO USER
320	IF( NOTIFY) WRITE (LUNIT,9525) FIL_NAM(1:DEV_END)
C
C... DISABLE SENDING MESSAGE AGAIN
	NOTIFY = .FALSE.
	ISTAT = SYS$SCHDWK (,,QDELAY,)
	IF (ISTAT) GOTO 325
	WRITE (LUNIT,9530)
	GOTO 9010
325	CALL SYS$HIBER ()
	GOTO 310
C
C... IF NOTIFY FALSE THEN MESSAGE NEEDS TO BE SENT
330	IF (.NOT. NOTIFY) WRITE (LUNIT,9535) FIL_NAM(1:DEV_END)
C
C... SET AS NON-BUFFERED DEVICE, THEN ASSIGN DEVICE
1000	BUFFERED = .FALSE.
	ISTAT = SYS$ASSIGN (FIL_NAM(1:DEV_END),CHAN,,)
	IF (ISTAT) GOTO 1005
	WRITE (LUNIT,9540) FIL_NAM(1:DEV_END)
	GOTO 9010
C
C... GET EVENT FLAG
1005	ISTAT = LIB$GET_EF(EVENFLG)
	IF (ISTAT) GOTO 1010
	WRITE (LUNIT,9543)
	GOTO 9010
C
C... IF NOT MAGTAPE GO SET EVENT FLAG
1010	IF (ICLASS_PRI .NE. DC$_TAPE) GOTO 1045
C
C...	PROMPT FOR TAPE POSITIONING INPUT
1025	WRITE (LUNIT,9545)
	READ  (KUNIT,9550) ANSWER
	IF ((ANSWER .EQ. 'N') .OR. (ANSWER .EQ. 'n')) GO TO 1035
	IF ((ANSWER .NE. 'Y') .AND. (ANSWER .NE. 'y')) GO TO 1025
C
C... REWIND TO LOAD POINT
	ISTAT = SYS$QIOW(%VAL(EVENFLG),%VAL(CHAN),%VAL(IO$_REWIND),
	1			STATS,,,,,,,,)
	IF (ISTAT) GOTO 1028
	WRITE (LUNIT,9555)
	GOTO 9010
1028	IF (STATS(1)) GO TO 1030
	WRITE (LUNIT,9555)
	GOTO 9000
C
C... POSITION TAPE TO LAST END-OF-FILE MARK
1030	ISTAT = SYS$QIOW(%VAL(EVENFLG),%VAL(CHAN),%VAL(IO$_SKIPFILE),
	1			STATS,,,%VAL(32767),,,,,)
	IF (ISTAT) GOTO 1032
	WRITE (LUNIT,9560)
	GOTO 9010
1032	IF (STATS(1) .EQ. SS$_ENDOFVOLUME) GOTO 1045
	WRITE (LUNIT,9562)
	GOTO 9000
C
C...  BACKSPACE ONE BLOCK TO APPEND FILE
1035	ISTAT = SYS$QIOW(%VAL(EVENFLG),%VAL(CHAN),%VAL(IO$_SKIPRECORD),
	1			STATS,,,%VAL(-1),,,,,)
	IF (ISTAT) GOTO 1040
	WRITE (LUNIT,9564)
	GOTO 9010
1040	IF (STATS(1) .EQ. SS$_ENDOFFILE) GO TO 1045
	WRITE (LUNIT,9565)
	IF (.NOT.(STATS(1))) GOTO 9000
	STOP
C
C... SET EVENT FLAG
1045	CALL SYS$SETEF(%VAL(EVENFLG))
C
C... MAKE SURE STATS SET TO NORMAL RETURN
	STATS(1) = SS$_NORMAL
	RETURN
C
C
C*******************************************************
C... DETACH PRINTER/PLOTTER
	ENTRY DETACH
C
C... CHECK IF BUFFERED DEVICE
	IF (BUFFERED) GOTO 8000
C
C... WAIT FOR LAST OPERATION
	CALL SYS$WAITFR(%VAL(EVENFLG))
C
C... CHECK FOR ERROR
	IF (.NOT.(STATS(1))) GOTO 9000
C
C... RELEASE CHANNEL, RELEASE DEVICE, AND FREE EVENT FLAG
	CALL SYS$DASSGN (%VAL(CHAN))
	CALL SYS$DALLOC (FIL_NAM(1:DEV_END),)
	CALL LIB$FREE_EF(EVENFLG)
	RETURN
C
C... FLUSH OUT LAST BUFFER TO BUFFERED FILE
8000	CALL FLUSH_BUF
	CLOSE (OUNIT)
	CALL LIB$FREE_LUN(OUNIT)
C
C... DONE UNLESS A DISK FILE
	IF ((ICLASS_PRI .NE. DC$_DISK) .OR. (ICLASS_SEC .NE. DC$_DISK))
	1				RETURN
	ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV',
	1				'VQUEUE',,TRNLNM_ITMLST)
	IF(ISTAT .EQ. SS$_NOLOGNAM) RETURN
	IF(ISTAT) GOTO 8010
	WRITE (LUNIT,9700)
	GOTO 9010
8010	SNDJBC_ITMLST(1).ITMCOD = SJC$_QUEUE
	SNDJBC_ITMLST(1).BUFADR = %LOC(RECDES)
	SNDJBC_ITMLST(2).ITMCOD = SJC$_FILE_SPECIFICATION
	SNDJBC_ITMLST(2).BUFADR = %LOC(FIL_NAM)
	SNDJBC_ITMLST(2).BUFLEN = VRS_NAM.NAM$B_ESL
	SNDJBC_ITMLST(3).ITMCOD = SJC$_PASSALL
	SNDJBC_ITMLST(4).ITMCOD = SJC$_DELETE_FILE
	SNDJBC_ITMLST(5).ITMCOD = SJC$_ENTRY_NUMBER_OUTPUT
	SNDJBC_ITMLST(5).BUFADR = %LOC(ENTRY_NUMBER)
	ISTAT = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,SNDJBC_ITMLST,STATS,,)
	IF (ISTAT) GOTO 8020
	WRITE (LUNIT,9705)
	GOTO 9010
8020	IF (STATS(1)) GOTO 8030
	WRITE (LUNIT,9705)
	GOTO 9000
8030	WRITE (LUNIT,9710) ENTRY_NUMBER,RECDES
	RETURN
C
C***************************************************************
C.. WAIT FOR EVENT ENTRY POINT
	ENTRY OWAIT
C
C... CHECK IF BUFFERED
	IF (BUFFERED) RETURN
	CALL SYS$WAITFR(%VAL(EVENFLG))
C
C... CHECK FOR ERROR
	IF (.NOT.(STATS(1))) GOTO 9000
	RETURN
C
C***************************************************************
C... OUTPUT LOGICAL EOF
	ENTRY OEOF
	IF (ICLASS_PRI .NE. DC$_TAPE) RETURN
C
C... WAIT FOR PREVIOUS I/O AND CHECK FOR ERROR
	CALL SYS$WAITFR (%VAL(EVENFLG))
	IF (.NOT.(STATS(1))) GOTO 9000
C
C... WRITE EOF, THEN CHECK FOR ERROR
8500	ISTAT = SYS$QIOW (%VAL(EVENFLG),%VAL(CHAN),%VAL(IO$_WRITEOF),
	1			STATS,,,,,,,,)
	IF (ISTAT) GOTO 8510
	WRITE (LUNIT,9600)
	GOTO 9010
8510	IF (STATS(1)) RETURN
	WRITE (LUNIT,9600)
C***************************************************************
C
C... ERROR HANDLER, 9000 IF CODE IN STATS(1);
C    9010 IF CODE IN ISTAT
9000	CALL LIB$STOP(%VAL(STATS(1)))
9010	CALL LIB$STOP(%VAL(ISTAT))
	END
