10	! ----- PRINTABLE.FUN -----
	!
	! ----- FUNCTION TO SEE IF A PASSED FILESPEC IS A "PRINTABLE" FILE -----
	! ----- (I.E.  FILE IS A SEQUENTIAL FILE WHOSE MAXIMUM RECORD SIZE -----
	! -----  IS LESS THAN 150 CHARS) -----
	!
	! ----- PASSED: -----
	!
	! -----		FILESPEC = FILE SPECIFICATION TO BE PROCESSED -----
	!
	! ----- RETURNED: -----
	!
	! -----		PRINTABLE = 1 IF FILE IS "PRINTABLE", -----
	! -----			    0 IF FILE IS NOT "PRINTABLE", -----
	! -----			    OR VMS EXIT STATUS IF ANY ERROR -----
	! -----			       HAS OCCURRED.  -----
	!
	!
	! ----- THIS FUNCTION USES THE ACP QIO SYSTEM SERVICE TO -----
	! ----- READ THE MAXIMUM RECORD SIZE OF A FILE. -----
	! ----- REFER TO THE I/O USER'S REFERENCE MANUAL, PART I, -----
	! ----- SECTION I, FOR DETAILS ON THE ACP QIO INTERFACE. -----
	!
	! ----- NOTE: -----
	! ----- IF THE PASSED FILESPEC MATCHES AN EXISTING LOGICAL NAME, -----
	! ----- YOU MUST INCLUDE AN EXPLICIT PERIOD (.), OTHERWISE GETFID -----
	! ----- GETS THE FILE-ID OF THE LOGICAL NAME TRANSLATION RATHER -----
	! ----- THAN THE ACTUAL FILE -----
	!
	! ----- Last Change 05/01/89 by Brian Lomasky -----
	!
	! ----- Teradyne, Inc., 179 Lincoln Street, Boston, MA  02111 -----
	! ----- (617) 482-2706, x3259 -----
	!
	! ----- Neither Brian Lomasky nor Teradyne, Inc. implicitly or -----
	! ----- explicitly implies this program is usable in any way. -----
	! ----- This program is released to the public domain in an -----
	! ----- "AS-IS" condition. -----
	!
	! ----- Restrictions: -----
	! -----   1) Requires VAX BASIC V2.4 or later. -----
	! -----   2) GETFID and F$PARSE must be linked with this function -----
	!
	FUNCTION LONG PRINTABLE(STRING FILESPEC)

	OPTION TYPE = EXPLICIT

	%LET %DEBUG = 0%			! SET TO 1 FOR DEBUG, 0 IF NOT

	EXTERNAL LONG CONSTANT ATR$C_RECATTR	! RECORD ATTRIBUTE AREA
	EXTERNAL LONG CONSTANT ATR$S_RECATTR	! SIZE OF ATR$C_RECATTR
	EXTERNAL LONG CONSTANT FAT$C_SEQUENTIAL	! SEQUENTIAL FILE ORGANIZATION
	EXTERNAL LONG CONSTANT IO$_ACCESS	! ACP QIO ACCESS FUNCTION CODE

	DECLARE LONG CONSTANT UPPERCASE = 32%	! FOR EDIT$ FUNCTION

	! ----- CREATE THE TEMPLATE FOR THE ATTRIBUTE LIST -----
	! ----- SEE I/O USER'S MANUAL PART I, PAGE 1-17 FOR DETAILS. -----
	RECORD ATTR_CONTROL_BLOCK
		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

	! ----- CREATE THE TEMPLATE FOR THE DESIRED ATTRIBUTE -----
	RECORD ATTR_RECORD
		BYTE FAT$B_RTYPE		! RECORD TYPE
		BYTE FAT$B_RATTRIB		! RECORD ATTRIBUTES
		WORD FAT$W_RSIZE		! RECORD SIZE IN BYTES
		LONG FAT$L_HIBLK		! HIGHEST ALLOCATED VBN
		LONG FAT$L_EFBLK		! END-OF-FILE VBN
		WORD FAT$W_FFBYTE		! FIRST FREE BLOCK IN EFBLK
		BYTE FAT$B_BKTSIZE		! BUCKET SIZE IN BLOCKS
		BYTE FAT$B_VFCSIZE		! FIXED-LENGTH VFC CONTROL SIZE
		WORD FAT$W_MAXREC		! MAXIMUM RECORD SIZE IN BYTES
		WORD FAT$W_DEFEXT		! DEFAULT EXTEND QUANTITY
		WORD FAT$W_GBC			! GLOBAL BUFFER COUNT
		STRING FILL = 6%		! <RESERVED>
		WORD FILL			! <UNUSED>
		WORD FAT$W_VERSIONS		! DEFAULT VERSION LIMIT
	END RECORD ATTR_RECORD

	! ----- CREATE THE TEMPLATE FOR THE FILE INFORMATION BLOCK (FIB) -----
	! ----- HERE WE USE THE "SHORT" FIB.  SEE I/O USER'S MANUAL -----
	! ----- PART I, PAGE 1-3 FOR FURTHER DETAILS. -----
	RECORD FIB
		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

	DECLARE ATTR_RECORD ATTR_BUFFER		! BUFFER TO BE WRITTEN
	DECLARE ATTR_CONTROL_BLOCK ATTR		! ATTRIBUTE LIST
	DECLARE WORD CHAN			! I/O CHANNEL NUMBER
	DECLARE LONG COLON_POS			! COLON POSITION IN PARAMETER
	DECLARE STRING DEVICE_NAME		! DEVICE NAME WHERE FILE RESIDES
	DECLARE WORD EXTRACTED_BITS		! VALUE OF EXTRACTED ATTRIB BITS
	DECLARE STRING FILE_DIR_NAME_EXT	! FILE TO BE ACCESSED
	DECLARE LONG FUNC			! FUNCTION CODE
	DIM WORD IOSB(3%)			! I/O STATUS BLOCK
	DECLARE STRING PARSED_FILE_SPEC		! FULLY-PARSED FILE SPEC
	DECLARE LONG SYS_STATUS			! FUNCTION STATUS
	DECLARE STRING THE_FILESPEC		! THE FILESPEC TO BE PARSED

	EXTERNAL STRING FUNCTION F$PARSE(STRING BY			&
		DESC)				! PARSE A FILE SPECIFICATION
	EXTERNAL LONG FUNCTION GETFID(STRING BY DESC,			&
		WORD DIM() BY REF)		! GET FILE-ID SUBPROGRAM
	EXTERNAL LONG FUNCTION SYS$ASSIGN	! ASSIGN I/O CHANNEL
	EXTERNAL LONG FUNCTION SYS$DASSGN	! DEASSIGN I/O CHANNEL
	EXTERNAL LONG FUNCTION SYS$QIOW		! QUEUE I/O REQUEST AND WAIT

	! ----- MAP THE FIB STRUCTURE -----
	MAP (FIB_BUFFER) FIB	USER_FIB	! SPECIFIES FORMAT OF FIB
	MAP (FIB_BUFFER) STRING	FIB_BUFF = 22%	! USED IN QIOW CALL

	! ----- INITIALIZE THE ATTRIBUTES LIST -----
	ATTR::ATTRIBUTE_SIZE  = ATR$S_RECATTR	! SIZE OF ATR$C_RECATTR
	ATTR::ATTRIBUTE_TYPE  = ATR$C_RECATTR	! RETURNS RECORD ATTRIBUTES
	ATTR::BUFFER_ADDRESS  = LOC(ATTR_BUFFER)! BUFFER TO BE WRITTEN
	ATTR::LIST_TERMINATOR = 0%		! ATTRIBUTE LIST TERMINATOR

	IF LEN(FILESPEC) = 0% THEN
		PRINTABLE = 0%			! FILE IS NOT "PRINTABLE"
		EXIT FUNCTION
	END IF
	THE_FILESPEC = EDIT$(FILESPEC, UPPERCASE)

	%IF %DEBUG = 1% %THEN
		PRINT "DEBUG>THE_FILESPEC="; THE_FILESPEC; "<"
	%END %IF

	! ----- FULLY PARSE THE PASSED FILE SPEC -----
	PARSED_FILE_SPEC = F$PARSE(THE_FILESPEC)

	%IF %DEBUG = 1% %THEN
		PRINT "DEBUG>PARSED_FILE_SPEC="; PARSED_FILE_SPEC; "<"
	%END %IF

	IF PARSED_FILE_SPEC = "" THEN		! NULL STRING IF ERROR
		PRINTABLE = 0%			! FILE IS NOT "PRINTABLE"
		EXIT FUNCTION
	END IF

	! ----- ERROR IF A NODE WAS SPECIFIED -----
	IF POS(PARSED_FILE_SPEC, "::", 1%) > 0% THEN
		PRINTABLE = 0%			! FILE IS NOT "PRINTABLE"
		EXIT FUNCTION
	END IF

	! ----- EXTRACT THE DEVICE SPECIFIER FROM THE FULLY-PARSED SPEC -----
	COLON_POS = POS(PARSED_FILE_SPEC, ":", 1%)
	DEVICE_NAME = LEFT(PARSED_FILE_SPEC, COLON_POS)
	%IF %DEBUG = 1% %THEN
		PRINT "DEBUG>DEVICE_NAME="; DEVICE_NAME; "<"
	%END %IF

	! ----- EXTRACT THE DIRECTORY, FILENAME, EXTENSION, AND (IF -----
	! ----- PRESENT) AN EXPLICIT VERSION NUMBER FROM THE FULLY-PARSED -----
	! ----- SPEC -----
	FILE_DIR_NAME_EXT = RIGHT(PARSED_FILE_SPEC, COLON_POS + 1%)
	IF RIGHT(FILE_DIR_NAME_EXT, LEN(FILE_DIR_NAME_EXT)) = ";" THEN
		FILE_DIR_NAME_EXT = LEFT(FILE_DIR_NAME_EXT,		&
			LEN(FILE_DIR_NAME_EXT) - 1%)
	END IF
	%IF %DEBUG = 1% %THEN
		PRINT "DEBUG>FILE_DIR_NAME_EXT="; FILE_DIR_NAME_EXT; "<"
	%END %IF

	! ----- ASSIGN A CHANNEL TO THE DISK FOR THE $QIO CALL -----
	SYS_STATUS = SYS$ASSIGN(DEVICE_NAME, CHAN, , )
	IF (SYS_STATUS AND 1%) = 0% THEN
		PRINTABLE = SYS_STATUS		! RETURN VMS ERROR STATUS
		EXIT FUNCTION
	END IF

	! ----- GET THE FILE-ID FOR THE FILE TO BE ACCESSED -----
	FILE_DIR_NAME_EXT = DEVICE_NAME + FILE_DIR_NAME_EXT
	%IF %DEBUG = 1% %THEN
		PRINT "DEBUG>FILE_DIR_NAME_EXT="; FILE_DIR_NAME_EXT; "<"
	%END %IF
	! ----- NOTE: GETFID RETURNS "RMS-F-FNF, file not found" ERROR -----
	! ----- STATUS IF FILE DOESN'T EXIST -----
	SYS_STATUS = GETFID(FILE_DIR_NAME_EXT, USER_FIB::FIB$W_FID())
	IF (SYS_STATUS AND 1%) = 0% THEN
		PRINTABLE = SYS_STATUS		! RETURN VMS ERROR STATUS
		EXIT FUNCTION
	END IF

	! ----- TO INITIATE A READ ATTRIBUTES OPERATION, CALL THE -----
	! ----- ACP QIO SERVICE WITH A FUNCTION CODE OF IO$_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_BUFF BY DESC,		! ADDRESS OF FIB DESC	&
		,				! FILENAME STRING DESC	&
		,				! FILENAME STRING LENGTH&
		,				! FILENAME STRING DESC	&
		ATTR BY REF,			! ATTR CONTROL BLK ADDR	&
		)				! N/A

	IF (SYS_STATUS AND 1%) = 0% THEN
		PRINTABLE = SYS_STATUS		! RETURN VMS ERROR STATUS
		EXIT FUNCTION
	END IF
	IF (IOSB(0%) AND 1%) = 0% THEN
		PRINTABLE = IOSB(0%)		! RETURN VMS ERROR STATUS
		EXIT FUNCTION
	END IF

	! ----- EXTRACT THE FILE ORGANIZATION SUBFIELD FROM FAT$B_RTYPE -----
	EXTRACTED_BITS = (ATTR_BUFFER::FAT$B_RTYPE AND NOT 15%)
	IF EXTRACTED_BITS = FAT$C_SEQUENTIAL	! MUST BE A SEQUENTIAL FILE
	THEN
		! ----- SEE IF FILE WILL PRINT IN 149 COLS OR LESS -----
		IF ATTR_BUFFER::FAT$W_RSIZE < 150% THEN
			! ----- IS A VALID FILE TO BE PRINTED -----
			PRINTABLE = 1%		! FILE IS "PRINTABLE"
		END IF
	END IF

	! ----- DEASSIGN THE I/O CHANNEL -----
	SYS_STATUS = SYS$DASSGN(CHAN BY VALUE)
	IF (SYS_STATUS AND 1%) = 0% THEN
		PRINTABLE = SYS_STATUS		! RETURN VMS ERROR STATUS
		EXIT FUNCTION
	END IF

	END FUNCTION