	PROGRAM INQUIRE
C
C o _INQUIRE:
C   ---------
C   This program is a substitute for the DCL INQUIRE command.  It has
C   more functionality. (See INQ$QUAL comments or INQUIRE.OUT for
C   full documentation.)  INQUIRE.CLD is required to define the command
C   to DCL.
C
C   Note that /CHECK=BOUNDS should NOT be used in compiling this program,
C   as null strings are generated at various points.
C
C   Steve Duff 5-Jan-1983  VAX/VMS V3.1
C
C   This program may be freely used, modified or copied.  The author requests
C   that this preamble be retained.  No liability is assumed and no
C   warranty is implied regarding this program.
C
C Revision History:
C -----------------
C o Revised 04-Dec-1985 [SGD]:
C   o Fix IO$M_NOFILTR on TRMCHAR qualifiers.  Add /NOFILTER qualifier
C
C o Revised 26-Sep-1985 [SGD]:
C   o Add /DEVICE=name and /PROMPT=name.  Make P2 optional.
C
C o Revised 23-Sep-1985 [SGD]:
C   o Add /TERMINATOR.  Build separate CLD for program and CLI interface.
C     Add /BUFLEN=n.
C
C o Revised 14-Dec-1983 [SGD]:
C   o Map SS$_BADESCAPE to success status
C
C o Revised 23-MAY-1983 [SGD]:
C   o Added /LOWER,/NOLOWER
C   o Revised architecture to permit INQ$PROGRAM program call interface
C   o Got rid of a lot of useless RMS error handling stuff
C   o Added INQ$CALL... interface.
C
C o Revised 27-JAN-1983 [SGD]:
C   o Revised /HELPLIB to /HLPLIB without (...).
C     Function of (...) on /HELPLIB taken over by /HLPPFX.
C   o /HLPSFX added.
C
C o Revised 20-JAN-1983 [SGD]:
C   o Changed default for help to PAGE and NOPROMPT
C   o Changed help to issue reset scrolling region to VT100 terminals.
C
C o Revised 11-JAN-1983 [SGD]:
C   o Added /ERASE=(LINE|SCREEN)
C   o Added /HELPLIB=file(text)
C   o Added /[NO]REPROMPT
C   o Added /TERMINATOR=symbol option
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/LIST'
C
C	Functions
C
	INTEGER LIB$SET_SYMBOL
	INTEGER INQ$INIT, INQ$ASSIGN, INQ$QUAL
	INTEGER INQ$DO_INQUIRE
C
C	Local store
C
	INTEGER ISTAT
C
C	Initialize
C
	ISTAT=INQ$INIT(.FALSE.)
	INQ_DEVICE='SYS$COMMAND'
	IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
C
C	Process the qualifiers
C
	ISTAT=INQ$QUAL()
	IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
C
C	Assign a channel to the command input stream
C
	ISTAT=INQ$DO_INQUIRE(INQ_DEVICE)
	IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
C
C	Set the symbol name to the input string
C
	ISTAT=LIB$SET_SYMBOL(INQ_SYMBOL(1:INQ_SYMBOLLEN),
     $		INQ_RESPONSE(1:INQ_RESPONSELEN),INQ_CLITABLE)
	IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
C
C	Exit with branch to label if such a condition occurred
C
	IF (INQ_EXITLABELLEN .GT. 0) THEN
	  CALL LIB$DO_COMMAND('$GOTO '//INQ_EXITLABEL(1:INQ_EXITLABELLEN))
C
C	Otherwise, just exit
C
	ELSE
	  CALL EXIT
	ENDIF
	END
	INTEGER FUNCTION INQ$CALL
C
C o This is the fast call interface to INQUIRE
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
	INCLUDE 'INQCALFOR.DEF'
	INCLUDE '($IODEF)/NOLIST'
C
C	Entry points
C
	INTEGER INQ$CALL_DEVICE, INQ$CALL_INIT, INQ$CALL_POSITION
	INTEGER INQ$CALL_HELP, INQ$CALL_TIMEOUT, INQ$CALL_TRMCHARS
	INTEGER INQ$CALL_READPROMPT, INQ$CALL_ERASE, INQ$CALL_GETTERM
C
C	Functions
C
	INTEGER INQ$DO_INQUIRE
C
C	Parameters
C
	BYTE MASK(8)
	INTEGER FLAGS, SECONDS, ROW, COL, ERASE, RLEN, TLEN, IMASK
	CHARACTER*(*) DEVICE
	CHARACTER*(*) HELPLIB, PREFIX, SUFFIX, PROMPT, RESPONSE, TERMINATOR
C
C	Always fails
C
	INQ$CALL=0
	RETURN
C
C o Enter here to init the call interface
C
	ENTRY INQ$CALL_INIT
C
	INQ_QIOFUNC=IO$_READPROMPT .OR. IO$M_ESCAPE
	INQ_BUFLEN=-1
	INQ_DEVICE='SYS$COMMAND'
	INQ_ERASE_EOL=.FALSE.
	INQ_ERASE_EOS=.FALSE.
	INQ_ERASE_LINE=.FALSE.
	INQ_ERASE_SCREEN=.FALSE.
	INQ_HELPLIB=.FALSE.
	INQ_HELPPFXLEN=0
	INQ_HELPSFXLEN=0
	INQ_LOWER=.TRUE.
	INQ_POSITION=.FALSE.
	INQ_REPOSITION=.FALSE.
	INQ_RESPONSELEN=0
	INQ_TERMLEN=0
	INQ_TIMEOUTSECS=0
	INQ_TERMINATOR=.FALSE.
	INQ_TERMVAL=.FALSE.
	INQ_TRMCHARS=.FALSE.
	INQ$CALL_INIT=1
	RETURN
C
C o Here to set pre-prompt row and column
C
	ENTRY INQ$CALL_POSITION(ROW,COL)
	INQ$CALL_POSITION=1
	IF ((ROW .GT. 0) .AND. (COL .GT. 0)) THEN
	  INQ_POSITION=.TRUE.
	  INQ_ROW=ROW
	  INQ_COL=COL
	ENDIF
	RETURN
C
C o Here to set device
C
	ENTRY INQ$CALL_DEVICE(DEVICE)
	INQ$CALL_DEVICE=1
	INQ_DEVICE=DEVICE
	RETURN
C
C o Here to set pre-prompt erase attribute
C
	ENTRY INQ$CALL_ERASE(ERASE)
	INQ$CALL_ERASE=1
	IF (ERASE .EQ. INQ$C_ERASE_EOL) THEN
	  INQ_ERASE_EOL=.TRUE.
	ELSE IF (ERASE .EQ. INQ$C_ERASE_EOS) THEN
	  INQ_ERASE_EOS=.TRUE.
	ELSE IF (ERASE .EQ. INQ$C_ERASE_LINE) THEN
	  INQ_ERASE_LINE=.TRUE.
	ELSE IF (ERASE .EQ. INQ$C_ERASE_SCREEN) THEN
	  INQ_ERASE_SCREEN=.TRUE.
	ENDIF
	RETURN
C
C o Here to set help library, prefix and suffix
C
	ENTRY INQ$CALL_HELP(HELPLIB,PREFIX,SUFFIX)
	INQ$CALL_HELP=1
	INQ_HELPLIB=.TRUE.
	INQ_HELPFILE=HELPLIB
	INQ_HELPFILELEN=LEN(HELPLIB)
	INQ_HELPPFX=PREFIX
	INQ_HELPPFXLEN=LEN(PREFIX)
	INQ_HELPSFX=SUFFIX
	INQ_HELPSFXLEN=LEN(SUFFIX)
	RETURN
C
C o Here to set timeout value
C
	ENTRY INQ$CALL_TIMEOUT(SECONDS)
	INQ$CALL_TIMEOUT=1
	INQ_TIMEOUTSECS=SECONDS
	INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_TIMED
	RETURN
C
C o Here to set terminator characters mask
C
	ENTRY INQ$CALL_TRMCHARS(MASK)
	INQ$CALL_TRMCHARS = 1
	INQ_TRMCHARS = .TRUE.
	DO IMASK = 1,8
	  INQ_TRM(IMASK) = MASK(IMASK)
	ENDDO
	RETURN
C
C o Here to perform the actual I/O operation
C
	ENTRY INQ$CALL_READPROMPT(FLAGS,PROMPT,RESPONSE,RLEN)
C
C	Process the flags
C
	IF ((FLAGS .AND. INQ$M_FLAG_NOECHO) .NE. 0)
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_NOECHO
	IF ((FLAGS .AND. INQ$M_FLAG_NOESCAPE) .NE. 0)
     $		INQ_QIOFUNC=INQ_QIOFUNC .AND. (.NOT. IO$M_NOECHO)
	IF ((FLAGS .AND. INQ$M_FLAG_NOET) .NE. 0)
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_TRMNOECHO
	IF ((FLAGS .AND. INQ$M_FLAG_PURGE) .NE. 0)
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_PURGE
	IF ((FLAGS .AND. INQ$M_FLAG_REPOSITION) .NE. 0)
     $		INQ_REPOSITION=.TRUE.
	IF ((FLAGS .AND. INQ$M_FLAG_NOREPROMPT) .NE. 0)
     $		INQ_REPROMPT=.FALSE.
	IF ((FLAGS .AND. INQ$M_FLAG_NOLOWER) .NE. 0)
     $		INQ_LOWER=.FALSE.
C
C	Set the prompt
C
	INQ_PROMPT=PROMPT
	INQ_PROMPTLEN=LEN(PROMPT)
C
C	Do the operation
C
	INQ_BUFLEN=MIN(LEN(RESPONSE),LEN(INQ_RESPONSE))
	INQ$CALL_READPROMPT=INQ$DO_INQUIRE(INQ_DEVICE)
	IF (.NOT. INQ$CALL_READPROMPT) RETURN
C
C	Set the response and string and length
C
	RESPONSE=INQ_RESPONSE(1:INQ_RESPONSELEN)
	RLEN=INQ_RESPONSELEN
	RETURN
C
C o Here to get last response terminator and length
C
	ENTRY INQ$CALL_GETTERM(TERMINATOR,TLEN)
	INQ$CALL_GETTERM=1
	TERMINATOR=INQ_RESPONSE(INQ_TERMPOS:INQ_TERMPOS+INQ_TERMLEN-1)
	TLEN=INQ_TERMLEN
	RETURN
	END
	INTEGER FUNCTION INQ$DO_INQUIRE(LOGNAME)
C
C o Assign a channel to the given name, and find out about it.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
	INCLUDE '($DCDEF)/NOLIST'
C
C	Codes
C
	EXTERNAL DVI$_DEVCLASS, DVI$_DEVDEPEND2
C
C	Functions
C
	INTEGER SYS$ASSIGN, SYS$GETDVI, LIB$SET_SYMBOL
	INTEGER INQ$INQUIRE_TERM, INQ$INQUIRE_MISC, INQ$RETURN_R0
C
C	Parameters
C
	CHARACTER*(*) LOGNAME
C
C	Local store
C
	INTEGER JUNK, DVIRQST(7) /7*0/, BLANK_POS, TAB_POS
C
C	Do the assign if we haven't already done it
C
	IF (INQ_CHAN .EQ. 0) THEN
	  BLANK_POS = INDEX(LOGNAME//' ',' ')
	  TAB_POS = INDEX(LOGNAME//'	',' ')
	  INQ$DO_INQUIRE=SYS$ASSIGN(LOGNAME(1:MIN(BLANK_POS,TAB_POS)-1),
     $		      INQ_CHAN,,)
	  IF (.NOT. INQ$DO_INQUIRE) RETURN
	ENDIF
C
C	Find out what sort of device we are dealing with and
C	get secondary characteristics (used by INQ$INQUIRE_TERM)
C
	DVIRQST(1)=ISHFT(%LOC(DVI$_DEVCLASS),16) .OR. 4
	DVIRQST(2)=%LOC(INQ_DEVCLASS)
	DVIRQST(4)=ISHFT(%LOC(DVI$_DEVDEPEND2),16) .OR. 4
	DVIRQST(5)=%LOC(INQ_DEVDEPEND2)
	INQ$DO_INQUIRE=SYS$GETDVI(,%VAL(INQ_CHAN),,DVIRQST,,,,)
	IF (.NOT. INQ$DO_INQUIRE) RETURN
	CALL SYS$WAITFR()
C
C	Case depending on whether or not we have a terminal device.
C
	IF (INQ_DEVCLASS .EQ. DC$_TERM) THEN
	  INQ$DO_INQUIRE=INQ$INQUIRE_TERM()
	ELSE
C
C	  Open input unit
C
	  OPEN(UNIT=INQ$K_INUNIT,FILE=LOGNAME,STATUS='OLD',READONLY,SHARED,
     $		FORM='FORMATTED',ERR=1000)
C
C	  Open SYS$OUTPUT
C
	  OPEN(UNIT=INQ$K_OUTUNIT,FILE='SYS$OUTPUT',STATUS='UNKNOWN',
     $		FORM='FORMATTED',ERR=1000)
C
C	  Do the inquire
C
	  INQ$DO_INQUIRE=INQ$INQUIRE_MISC()
C
C	  Close the units
C
	  CLOSE(UNIT=INQ$K_INUNIT,ERR=100)
100	  CONTINUE
	  CLOSE(UNIT=INQ$K_OUTUNIT,ERR=200)
200	  CONTINUE
	ENDIF
C
C	If /NOLOWER then do an upcase on it
C
	IF (.NOT. INQ_LOWER) CALL STR$UPCASE(INQ_RESPONSE,INQ_RESPONSE,JUNK)
C
C	Set the /TERMINATOR symbol if specified in command line.
C
	IF (INQ_TERMVAL) THEN
	  INQ$DO_INQUIRE=LIB$SET_SYMBOL(INQ_TERMSYM(1:INQ_TERMSYMLEN),
     $		INQ_RESPONSE(INQ_RESPONSELEN+1:INQ_RESPONSELEN+INQ_TERMLEN),
     $		INQ_CLITABLE)
	  IF (.NOT. INQ$DO_INQUIRE) RETURN
	ENDIF
C
C	Add terminator length to transfer length if /TERMINATOR given
C
	INQ_TERMPOS=INQ_RESPONSELEN+1
	IF (INQ_TERMINATOR) THEN
	  INQ_RESPONSELEN=INQ_RESPONSELEN+INQ_TERMLEN
	ENDIF
	RETURN
C
C	Here on open error
C
1000	CONTINUE
	INQ$DO_INQUIRE=INQ$RETURN_R0()
	END
	INTEGER FUNCTION INQ$GET_VALUE(NAME,STR,STRLEN)
C
C o This routine calls CLI$GET_VALUE with a varying string descriptor so
C   that the length of the value can be retrieved.
C
C   NAME is the name of the qualifier/parameter being retrieved
C   STR is the descriptor for the string to be returned in
C   STRLEN is the defined length of the string
C
C   The returned status is that of the call to CLI$GET_VALUE
C
	IMPLICIT NONE
C
C	Functions
C
	INTEGER CLI$GET_VALUE
	EXTERNAL CLI$GET_VALUE
C
C	Parameters
C
	CHARACTER*(*) NAME,STR
	INTEGER STRLEN
C
C	Varying string descriptor
C
	INTEGER VARY$L(0:1), I
	BYTE VARY$B(0:7)
	EQUIVALENCE (VARY$L(0),VARY$B(0))
	DATA (VARY$B(I),I=0,3)/255,0,14,11/
C
C	Heap for varying string
C
	BYTE HEAP$B(255)
	CHARACTER*255 HEAP$C
	INTEGER*2 CURLEN(2) /0,0/
	EQUIVALENCE (CURLEN(2),HEAP$B(1))
	EQUIVALENCE (HEAP$B(1),HEAP$C(1:1))
C
C	Set location of heap
C
	VARY$L(1)=%LOC(CURLEN)
C
C	Get string value
C
	INQ$GET_VALUE=CLI$GET_VALUE(NAME,VARY$L)
C
C	Set into caller's area if it worked
C
	IF (INQ$GET_VALUE) THEN
	  STRLEN=CURLEN(1)
	  STR=HEAP$C(1:STRLEN)
	ENDIF
	END
	INTEGER FUNCTION INQ$HANDLE_HELP(SIGARGS,MECHARGS)
C
C o Condition handler that is invoked if we have a problem accessing
C   help library (/HLPLIB).  We print a message and unwind to the
C   establisher.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
	INCLUDE '($SSDEF)/NOLIST'
C
C	Parameters
C
	INTEGER SIGARGS(*), MECHARGS(*)
C
C	Set resignal
C
	INQ$HANDLE_HELP=SS$_RESIGNAL
C
C	Ignore unwinds and informational
C
	IF (SIGARGS(2) .EQ. SS$_UNWIND) RETURN
	IF (SIGARGS(2)) RETURN
C
C	Print the error
C
	SIGARGS(1)=SIGARGS(1)-2
	CALL SYS$PUTMSG(SIGARGS,,,)
	SIGARGS(1)=SIGARGS(1)+2
C
C	Be apologetic
C
	CALL LIB$PUT_OUTPUT('Sorry, can''t provide any help')
C
C	Unwind
C
	CALL SYS$UNWIND(MECHARGS(3),)
	END
	INTEGER FUNCTION INQ$INIT(PROGFLAG)
C
C o Initialize the INQUIRE program state.
C
C   PROGFLAG is true iff this execution is through the program interface.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
	INCLUDE '($IODEF)/NOLIST'
C
C	Functions
C
	INTEGER INQ$GET_VALUE
C
C	Parameters
C
	LOGICAL PROGFLAG
C
C	Set variables
C
	INQ_PROGRAM=PROGFLAG
	INQ_CLITABLE=1
	INQ_EXITLABELLEN=0
	INQ_QIOFUNC=IO$_READPROMPT
	INQ_TERMINATOR=.FALSE.
C
C	Get the symbol name into common
C
	INQ$INIT=INQ$GET_VALUE('SYMBOL',INQ_SYMBOL,INQ_SYMBOLLEN)
	IF (.NOT. INQ$INIT) RETURN
C
C	Get the prompt into common.  If not specified then set the prompt to be
C	the symbol.
C
	INQ$INIT=CLI$PRESENT('PROMPT')
	IF (INQ$INIT .EQ. %LOC(CLI$_ABSENT)) THEN
	  INQ_PROMPT=INQ_SYMBOL
	  INQ_PROMPTLEN=INQ_SYMBOLLEN
	  INQ$INIT=1
	ELSE IF (.NOT. INQ$INIT) THEN
	  RETURN
	ELSE
	  INQ$INIT=INQ$GET_VALUE('PROMPT',INQ_PROMPT,INQ_PROMPTLEN)
	ENDIF
	END
	INTEGER FUNCTION INQ$INQUIRE_TERM
C
C o This routine is called after command parsing is complete, only
C   if the command input device is a terminal.  Terminals can support
C   all of the command qualifiers, and so the logic is more
C   involved than if we just write the prompt and read the response.
C
C   This routine sets the values of INQ_RESPONSE and INQ_RESPONSELEN,
C   but does not actually define the DCL symbol.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
C
C	Codes
C
	EXTERNAL SS$_TIMEOUT, TT2$M_DECCRT, TT2$M_ANSICRT, IO$_WRITEVBLK
	EXTERNAL SS$_BADESCAPE
C
C	Local constants
C
	PARAMETER ESCAPE=27
C
C	Functions
C
	INTEGER SYS$QIOW
	EXTERNAL LIB$GET_INPUT, LIB$PUT_OUTPUT, INQ$HANDLE_HELP
	EXTERNAL HLP$M_PROMPT, HLP$M_PROCESS, HLP$M_GROUP, HLP$M_SYSTEM
	EXTERNAL HLP$M_LIBLIST, HLP$M_HELP
C
C	Structures
C
	STRUCTURE /TERMBLK_STRUC/
	  INTEGER*2 SIZE,FILLER
	  INTEGER PTR
	END STRUCTURE
C
C	Local store
C
	CHARACTER*3 PF2
	CHARACTER*2 RESTORE_CURSOR, SAVE_CURSOR
	CHARACTER*7 RESET_SCROLLING
	INTEGER IOSB(2), ISTAT, HELP_FLAGS, TERMPTR, BUFLEN
	LOGICAL DECCRT, ANSICRT, REPROMPT
	RECORD /TERMBLK_STRUC/ TERMBLK
C
	DATA PF2(1:1)/ESCAPE/, PF2(2:3)/'OQ'/
	DATA RESTORE_CURSOR(1:1)/ESCAPE/, RESTORE_CURSOR(2:)/'8'/
	DATA SAVE_CURSOR(1:1)/ESCAPE/, SAVE_CURSOR(2:)/'7'/
	DATA RESET_SCROLLING(1:1)/ESCAPE/, RESET_SCROLLING(2:3)/'[r'/
     $		RESET_SCROLLING(4:4)/ESCAPE/, RESET_SCROLLING(5:)/'[2J'/
C
C	Statement function to get the character corresponding to
C	a particular digit of an integer.  (Place is the power of 10
C	that identifies the digit, i.e. {1,10,100...})
C
	CHARACTER*1 DIGIT
	INTEGER IVAL,IPLACE
	DIGIT(IVAL,IPLACE)=CHAR(ICHAR('0')+MOD(IVAL/IPLACE,10))
C
C	Assume success
C
	INQ$INQUIRE_TERM=1
	TERMPTR=0
C
C	Set terminal types
C
	DECCRT=(INQ_DEVDEPEND2 .AND. %LOC(TT2$M_DECCRT)) .NE. 0
	ANSICRT=(INQ_DEVDEPEND2 .AND. %LOC(TT2$M_ANSICRT)) .NE. 0
C
C	IF /CLEAR=LINE or /CLEAR=SCREEN set then set prefix to clear
C
	IF (ANSICRT .AND. (INQ_ERASE_LINE .OR. INQ_ERASE_SCREEN)) THEN
	    INQ_PROMPT=CHAR(ESCAPE)//'[2K'//INQ_PROMPT
	    INQ_PROMPTLEN=INQ_PROMPTLEN+4
	    IF (INQ_ERASE_SCREEN) INQ_PROMPT(4:4)='J'
	ENDIF
C
C	If /POSITION specified set prefix to move cursor (ANSI only)
C
	IF (INQ_POSITION .AND. ANSICRT) THEN
	  INQ_PROMPT=CHAR(ESCAPE)//'['//
     $		DIGIT(INQ_ROW,100)//DIGIT(INQ_ROW,10)//DIGIT(INQ_ROW,1)//';'//
     $		DIGIT(INQ_COL,100)//DIGIT(INQ_COL,10)//DIGIT(INQ_COL,1)//'H'//
     $		INQ_PROMPT
	  INQ_PROMPTLEN=INQ_PROMPTLEN+10
	ENDIF
C
C	IF /CLEAR=EOx has been set then set prefix to clear to EOL/EOS
C
	IF (ANSICRT .AND. (INQ_ERASE_EOL .OR. INQ_ERASE_EOS)) THEN
	    INQ_PROMPT=INQ_PROMPT(1:INQ_PROMPTLEN)//CHAR(ESCAPE)//'[0K'
	    INQ_PROMPTLEN=INQ_PROMPTLEN+4
	    IF (INQ_ERASE_EOS) INQ_PROMPT(INQ_PROMPTLEN:INQ_PROMPTLEN)='J'
	ENDIF
C
C	If /REPOSITION specified then issue QIO to save cursor pos
C
	IF (INQ_REPOSITION .AND. DECCRT) THEN
	  INQ$INQUIRE_TERM=
     $		SYS$QIOW(,%VAL(INQ_CHAN),%VAL(%LOC(IO$_WRITEVBLK)),,,,
     $		%REF(SAVE_CURSOR), %VAL(LEN(SAVE_CURSOR)),
     $		,%VAL(0),,)
	  IF (.NOT. INQ$INQUIRE_TERM) RETURN
	ENDIF
C
C	Check for terminator mask
C
	IF (INQ_TRMCHARS) THEN
	  TERMBLK.SIZE = 32
	  TERMBLK.PTR = %LOC(INQ_TRM)
	  TERMPTR = %LOC(TERMBLK)
	ENDIF
C
C	Set response buffer length
C
	BUFLEN = LEN(INQ_RESPONSE)
	IF (INQ_BUFLEN .GE. 0) BUFLEN = INQ_BUFLEN
C
C	Loop here until we have a response
C
	REPROMPT=.TRUE.
100	DO WHILE (REPROMPT)
C
C	  Assume no reprompting will be needed
C
	  REPROMPT=.FALSE.
C
C	  Issue the read-prompt QIO
C
	  INQ$INQUIRE_TERM=SYS$QIOW(,%VAL(INQ_CHAN),%VAL(INQ_QIOFUNC),IOSB,,,
     $		%REF(INQ_RESPONSE), %VAL(BUFLEN),
     $		%VAL(INQ_TIMEOUTSECS),
     $		%VAL(TERMPTR),
     $		%REF(INQ_PROMPT), %VAL(INQ_PROMPTLEN))
	  IF (.NOT. INQ$INQUIRE_TERM) RETURN
C
C	  Get final status and transfer length
C
	  ISTAT=IOSB(1) .AND. 'FFFF'X
	  INQ_RESPONSELEN=ISHFT(IOSB(1),-16)
C
C	  Map BADESCAPE to informational
C
	  IF (ISTAT .EQ. %LOC(SS$_BADESCAPE)) THEN
	    ISTAT=(ISTAT .AND. 'FFFFFFF8'X) .OR. 3
	  ENDIF
C
C	  Get terminator length
C
	  INQ_TERMLEN=ISHFT(IOSB(2),-16)
C
C	  Check for timeout
C
	  IF (ISTAT .EQ. %LOC(SS$_TIMEOUT)) THEN
	    IF (INQ_TIMEOUT) THEN
	      INQ_EXITLABEL=INQ_TIMEOUTLABEL
	      INQ_EXITLABELLEN=INQ_TIMEOUTLABELLEN
	    ENDIF
C
C	  Otherwise fatal error if bad status
C
	  ELSE IF (.NOT. ISTAT) THEN
	    INQ$INQUIRE_TERM=ISTAT
	    RETURN
C
C	  Check for EOF (control-Z terminator).
C
	  ELSE IF ((IOSB(2) .EQ. '1001A'X) .AND. INQ_EOF) THEN
	    IF (INQ_RESPONSE(INQ_RESPONSELEN+1:
     $			INQ_RESPONSELEN+1) .EQ. CHAR(26)) THEN
	      INQ_EXITLABEL=INQ_EOFLABEL
	      INQ_EXITLABELLEN=INQ_EOFLABELLEN
	    ENDIF
	  ENDIF
C
C	  If /HLPLIB and response terminated with <ESC>OQ then do help
C	  prompting.
C
	  IF (INQ_HELPLIB .AND. (INQ_TERMLEN .EQ. 3) .AND.
     $		(INQ_RESPONSE(INQ_RESPONSELEN+1:INQ_RESPONSELEN+3) .EQ. PF2))
     $		THEN
C
C	    Set for reprompting on next pass through loop if reprompting
C	    permitted.
C
	    REPROMPT=INQ_REPROMPT
C
C	    Issue reset scrolling region on ANSI-CRT terminals
C
	    IF (ANSICRT) THEN
	      CALL SYS$QIOW(,%VAL(INQ_CHAN),%VAL(%LOC(IO$_WRITEVBLK)),,,,
     $		%REF(RESET_SCROLLING), %VAL(LEN(RESET_SCROLLING)),
     $		,%VAL(0),,)
	    ENDIF
C
C	    Call to get help.
C
	    CALL LIB$ESTABLISH(INQ$HANDLE_HELP)
	    HELP_FLAGS=0
	    CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,
     $		INQ_HELPPFX(1:INQ_HELPPFXLEN)//
     $			INQ_RESPONSE(1:INQ_RESPONSELEN)//
     $			INQ_HELPSFX(1:INQ_HELPSFXLEN),
     $		INQ_HELPFILE(1:INQ_HELPFILELEN),HELP_FLAGS,LIB$GET_INPUT)
	    CALL LIB$REVERT
	  ENDIF
	ENDDO
C
C	If /REPOSITION specified then issue QIO to restore cursor
C
	IF (INQ_REPOSITION .AND. DECCRT) THEN
	  INQ$INQUIRE_TERM=
     $		SYS$QIOW(,%VAL(INQ_CHAN),%VAL(%LOC(IO$_WRITEVBLK)),,,,
     $		%REF(RESTORE_CURSOR), %VAL(LEN(RESTORE_CURSOR)),
     $		,%VAL(0),,)
	  IF (.NOT. INQ$INQUIRE_TERM) RETURN
	ENDIF
	END
	INTEGER FUNCTION INQ$INQUIRE_MISC
C
C o This routine is called after command parsing is complete with
C   a non-terminal command device.  There is little that we can do
C   except write out the prompt and read the response.
C
C   This routine sets the values of INQ_RESPONSE and INQ_RESPONSELEN.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
C
C	Functions
C
	INTEGER INQ$RETURN_R0
C
C	Write the prompt string
C
	WRITE(INQ$K_OUTUNIT,'(1H$,A)',ERR=1000) INQ_PROMPT(1:INQ_PROMPTLEN)
C
C	Read the response string
C
	INQ_TERMLEN=0
	READ(INQ$K_INUNIT,'(Q,A)',ERR=1000,END=100) INQ_RESPONSELEN,
     $		INQ_RESPONSE
	GOTO 200
C
C	  Here if EOF on read
C
100	  CONTINUE
	  INQ_RESPONSE=' '
	  INQ_RESPONSELEN=0
C
C	Merge when response set
C
200	CONTINUE
C
C	Here if I/O error
C
1000	CONTINUE
	INQ$INQUIRE_MISC=INQ$RETURN_R0()
	END
	INTEGER FUNCTION INQ$PROGRAM(CMDSTR,RESULTSTR,RESULTLEN)
C
C o This is the program call interface for the INQUIRE command.
C   The format of the call is:
C
C   Status = INQ$PROGRAM(command-line.rt.ds, result-str.wt.ds,
C				result-len.wl.r)
C
C o The command line should be the same as the corresponding DCL
C   command line that would be given (less the "_INQUIRE").
C   The DCL symbol name should be replaced with the logical name
C   from which input/output should be done.  Normally this will
C   be SYS$COMMAND.
C
C o The resulting string is returned in result-str, blank padded
C   on the right.  The actual length of the response is returned in
C   result-len.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF'
	INCLUDE '($DCDEF)/NOLIST'
C
C	Codes
C
	EXTERNAL INQUIRE$PARSE_TABLE
C
C	Functions
C
	INTEGER CLI$DCL_PARSE
	INTEGER INQ$DO_INQUIRE, INQ$QUAL, INQ$GET_VALUE, INQ$INIT, INQ$ASSIGN
C
C	Parameters
C
	CHARACTER*(*) CMDSTR, RESULTSTR
	INTEGER RESULTLEN
C
C	Parse the given command line
C
	INQ$PROGRAM=CLI$DCL_PARSE('_INQUIRE '//CMDSTR,INQUIRE$PARSE_TABLE)
	IF (.NOT. INQ$PROGRAM) RETURN
C
C	Initialize
C
	INQ$PROGRAM=INQ$INIT(.TRUE.)
	INQ_DEVICE=INQ_SYMBOL(1:INQ_SYMBOLLEN)
	IF (.NOT. INQ$PROGRAM) RETURN
C
C	Process the qualifiers
C
	INQ$PROGRAM=INQ$QUAL()
	IF (.NOT. INQ$PROGRAM) RETURN
C
C	Assign a channel to the command input stream
C
	INQ$PROGRAM=INQ$DO_INQUIRE(INQ_DEVICE)
	IF (.NOT. INQ$PROGRAM) RETURN
C
C	Set the returned string
C
	RESULTSTR=INQ_RESPONSE(1:INQ_RESPONSELEN)
	RESULTLEN=INQ_RESPONSELEN
	END
	INTEGER FUNCTION INQ$QUAL
C
C o This routine is called to process the various qualifiers that
C   can appear in the command string.  The processing is done
C   essentially in alphabetical order, except where it is expeditious
C   to observe a particular order of processing due to qualifier
C   interdependencies.
C
	IMPLICIT NONE
	INCLUDE 'INQUIRE.DEF/NOLIST'
	INCLUDE '($IODEF)/NOLIST'
C
C	Functions
C
	INTEGER OTS$CVT_TI_L, INQ$GET_VALUE
	EXTERNAL OTS$CVT_TI_L, INQ$GET_VALUE
C
C	Local store
C
	CHARACTER*255 VALUESTR
	INTEGER ISTAT, VALUELEN, ICH, CHARVAL
C
C	Assume success
C
	INQ$QUAL=1
C
C o /BUFLEN=n
C
C   Controls max buffer length of response
C
	INQ_BUFLEN=-1
	ISTAT=CLI$PRESENT('BUFLEN')
C
C	Get value if qualifier given
C
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	  ISTAT=INQ$GET_VALUE('BUFLEN',VALUESTR,VALUELEN)
C
C	  Convert to integer and check range
C
	  ISTAT=OTS$CVT_TI_L(VALUESTR,INQ_BUFLEN,%VAL(4),%VAL('9'X))
	  IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
	  IF ((INQ_BUFLEN .GT. LEN(INQ_RESPONSE)) .OR. (INQ_BUFLEN .LT. 0))
     $		  CALL LIB$STOP(%LOC(CLI$_VALCNVERR))
	ENDIF
C
C o /DEVICE=name
C
C   Override the default device of "SYS$COMMAND:"
C   (Not valid for program interface).
C
	IF (.NOT. INQ_PROGRAM) THEN
	  ISTAT=CLI$PRESENT('DEVICE')
	  IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	    ISTAT=INQ$GET_VALUE('DEVICE',INQ_DEVICE,VALUELEN)
	  ENDIF
	ENDIF
C
C o /ECHO (D)
C   /NOECHO
C
C   Controls echoing of received characters
C
	ISTAT=CLI$PRESENT('ECHO')
	IF (ISTAT .EQ. %LOC(CLI$_NEGATED))
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_NOECHO
C
C o /EOF=label
C
C   Defines a branch label on exit if read results in an EOF status.
C   (Not valid for program interface).
C
	INQ_EOF=.FALSE.
	IF (.NOT. INQ_PROGRAM) THEN
	  ISTAT=CLI$PRESENT('EOF')
	  IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	    ISTAT=INQ$GET_VALUE('EOF',INQ_EOFLABEL,INQ_EOFLABELLEN)
	    INQ_EOF=.TRUE.
	  ENDIF
	ENDIF
C
C o /ERASE=EOL|EOS|LINE|SCREEN
C
C   Clear according to respective function.  LINE and SCREEN clear the entity
C   prior to the prompt.  EOL and EOS clear to end-of-line or screen
C   respectively, after prompting.
C
	INQ_ERASE_EOL=.FALSE.
	INQ_ERASE_EOS=.FALSE.
	INQ_ERASE_LINE=.FALSE.
	INQ_ERASE_SCREEN=.FALSE.
	IF (CLI$PRESENT('ERASE') .EQ. %LOC(CLI$_PRESENT)) THEN
	  CALL INQ$GET_VALUE('ERASE',VALUESTR,VALUELEN)
	  IF (VALUESTR .EQ. 'EOL') THEN
	    INQ_ERASE_EOL=.TRUE.
	  ELSE IF (VALUESTR .EQ. 'EOS') THEN
	    INQ_ERASE_EOS=.TRUE.
	  ELSE IF (VALUESTR(1:1) .EQ. 'L') THEN
	    INQ_ERASE_LINE=.TRUE.
	  ELSE
	    INQ_ERASE_SCREEN=.TRUE.
	  ENDIF
	ENDIF
C
C o /ESCAPE
C   /NOESCAPE (D)
C
C   Controls whether escape sequences are recognized as read terminators.
C   Note that /ESCAPE implies /TERMINATOR unless /NOTERMINATOR specified.
C
	ISTAT=CLI$PRESENT('ESCAPE')
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	  INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_ESCAPE
C
C	  Default the setting of /TERMINATOR.
C
	  ISTAT=CLI$PRESENT('TERMINATOR')
	  IF (ISTAT .NE. %LOC(CLI$_NEGATED)) INQ_TERMINATOR=.TRUE.
	ENDIF
C
C o /ET (D)
C   /NOET
C
C   Controls echoing of terminator character.
C
	ISTAT=CLI$PRESENT('ET')
	IF (ISTAT .EQ. %LOC(CLI$_NEGATED))
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_TRMNOECHO
C
C o /FILTER (D)
C   /NOFILTER
C
C   Controls IO$M_NOFILTR qualifier (DEL, Ctrl-R, Ctrl-U)
C
	ISTAT=CLI$PRESENT('FILTER')
	IF (ISTAT .EQ. %LOC(CLI$_NEGATED))
     $	        INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_NOFILTR
C
C o /GLOBAL
C
C   If specified, symbol is defined as global DCL symbol
C   (Not valid for program interface)
C
	IF (.NOT. INQ_PROGRAM) THEN
	  ISTAT=CLI$PRESENT('GLOBAL')
	  IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	    INQ_CLITABLE=2
	  ENDIF
	ENDIF
C
C o /HLPLIB=file
C
C   If specified, and PF2 (ESC-O-Q) terminates the input to the response,
C   then LIB$DO_HELP is invoked with the response string (sans terminator)
C   prefixed with /HLPPFX text (if any), and suffixed with /HLPSFX text
C   (if any).
C
C   This qualifier implies /ESCAPE by default.  /NOESCAPE with /HLPLIB is
C   to be considered quite pointless.  /TERMINATOR is not required for /HLPLIB
C   to function properly.
C
	INQ_HELPLIB=.FALSE.
	ISTAT=CLI$PRESENT('HLPLIB')
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	  CALL INQ$GET_VALUE('HLPLIB',INQ_HELPFILE,INQ_HELPFILELEN)
	  INQ_HELPLIB=.TRUE.
C
C	  Presume /ESCAPE unless overridden (caveat emptor).
C
	  IF (CLI$PRESENT('ESCAPE') .NE. %LOC(CLI$_NEGATED))
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_ESCAPE
	ENDIF
C
C o /HLPPFX=text
C
C   Specifies prefix text for help.
C
	INQ_HELPPFXLEN=0
	IF (CLI$PRESENT('HLPPFX') .EQ. %LOC(CLI$_PRESENT)) THEN
	  CALL INQ$GET_VALUE('HLPPFX',INQ_HELPPFX,INQ_HELPPFXLEN)
	ENDIF
C
C o /HLPSFX=text
C
C   Specifies suffix text for help.
C
	INQ_HELPSFXLEN=0
	IF (CLI$PRESENT('HLPSFX') .EQ. %LOC(CLI$_PRESENT)) THEN
	  CALL INQ$GET_VALUE('HLPSFX',INQ_HELPSFX,INQ_HELPSFXLEN)
	ENDIF
C
C o /LOCAL (D)
C
C   If specified, symbol is defined as local DCL symbol.  This is the default,
C   so we do nothing (go ahead and process the qualifier).
C   (Not valid for program interface).
C
	IF (.NOT. INQ_PROGRAM) THEN
	  ISTAT=CLI$PRESENT('LOCAL')
	  IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	    INQ$QUAL=%LOC(CLI$_INVQUAL)
	    RETURN
	  ENDIF
	ENDIF
C
C o /LOWER (D)
C   /NOLOWER
C
C   Just set the flag for later
C
	INQ_LOWER=.NOT. (CLI$PRESENT('LOWER') .EQ. %LOC(CLI$_NEGATED))
C
C o /POSITION=(row,col)
C
C   Causes prompt to appear at (row,col) on ANSI crt terminals
C
	INQ_POSITION=.FALSE.
	ISTAT=CLI$PRESENT('POSITION')
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
C
C	  Get row value
C
	  ISTAT=INQ$GET_VALUE('POSITION',VALUESTR,VALUELEN)
	  ISTAT=OTS$CVT_TI_L(VALUESTR(1:VALUELEN),INQ_ROW,%VAL(4),%VAL('9'X))
	  IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
	  IF ((INQ_ROW .LT. 0) .OR. (INQ_ROW .GT. 999))
     $			CALL LIB$STOP(%LOC(CLI$_VALCNVERR))
C
C	  Get column value (make sure it is there)
C
	  ISTAT=INQ$GET_VALUE('POSITION',VALUESTR,VALUELEN)
	  IF (.NOT. ISTAT) CALL LIB$STOP(%LOC(CLI$_INVQUAL))
	  ISTAT=OTS$CVT_TI_L(VALUESTR,INQ_COL,%VAL(4),%VAL('9'X))
	  IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
	  IF ((INQ_COL .LT. 0) .OR. (INQ_COL .GT. 999))
     $			CALL LIB$STOP(%LOC(CLI$_VALCNVERR))
	  INQ_POSITION=.TRUE.
	ENDIF
C
C o /PROMPT=string
C   /NOPROMPT
C
C   Override (or specify) the prompt string in P2
C
	ISTAT=CLI$PRESENT('PROMPTQUAL')
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	  ISTAT=INQ$GET_VALUE('PROMPTQUAL',INQ_PROMPT,INQ_PROMPTLEN)
	ELSE IF (ISTAT .EQ. %LOC(CLI$_NEGATED)) THEN
	  INQ_PROMPT = ' '
	  INQ_PROMPTLEN = 0
	ENDIF
C
C o /PUNCTUATION (D)
C   /NOPUNCTUATION
C
C   Controls whether ": " is appended to prompt string.  If /NOPROMPT
C   is specified, then /NOPUNCTUATION is the default.
C
	ISTAT=CLI$PRESENT('PUNCTUATION')
C
C	If /PUNCTUATION requested then add ": " onto prompt string
C
	IF ((ISTAT .EQ. %LOC(CLI$_PRESENT)) .OR.
     $		((ISTAT .EQ. %LOC(CLI$_DEFAULTED)) .AND.
     $		(CLI$PRESENT('PROMPTQUAL') .NE. %LOC(CLI$_NEGATED)))) THEN
	  IF (INQ_PROMPTLEN+2 .LE. LEN(INQ_PROMPT)) THEN
	    INQ_PROMPT(INQ_PROMPTLEN+1:INQ_PROMPTLEN+2)=': '
	    INQ_PROMPTLEN=INQ_PROMPTLEN+2
	  ENDIF
	ENDIF
C
C o /PURGE
C   /NOPURGE (D)
C
C   Controls whether type-ahead buffer is purged before the read
C
	ISTAT=CLI$PRESENT('PURGE')
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT))
     $		INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_PURGE
C
C o /REPOSITION
C   /NOREPOSITION (D)
C
C   Controls whether cursor position is saved/restored on DEC crt terminals
C
	INQ_REPOSITION=.FALSE.
	IF (CLI$PRESENT('REPOSITION') .EQ. %LOC(CLI$_PRESENT))
     $		INQ_REPOSITION=.TRUE.
C
C o /REPROMPT (D)
C   /NOREPROMPT
C
C   Controls whether reprompting is permitted after help operation
C
	INQ_REPROMPT=.TRUE.
	IF (CLI$PRESENT('REPROMPT') .EQ. %LOC(CLI$_NEGATED))
     $		INQ_REPROMPT=.FALSE.
C
C o /SECONDS=nnn
C
C   Timeout constant in seconds
C
	INQ_TIMEOUTSECS=0
	ISTAT=CLI$PRESENT('SECONDS')
C
C	Get value if qualifier given
C
	IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	  ISTAT=INQ$GET_VALUE('SECONDS',VALUESTR,VALUELEN)
C
C	  Convert to integer and check range
C
	  ISTAT=OTS$CVT_TI_L(VALUESTR,INQ_TIMEOUTSECS,%VAL(4),%VAL('9'X))
	  IF (.NOT. ISTAT) CALL LIB$STOP(%VAL(ISTAT))
	  IF (INQ_TIMEOUTSECS .LT. 0) CALL LIB$STOP(%LOC(CLI$_VALCNVERR))
	  INQ_QIOFUNC=INQ_QIOFUNC .OR. IO$M_TIMED
	ENDIF
C
C o /TERMINATOR (D for /ESCAPE)
C   /NOTERMINATOR (D otherwise)
C   /TERMINATOR=symbol
C
C o Controls whether terminator is included in the symbol definition.
C   (/TERMINATOR=symbol not legal for program call).
C
	INQ_TERMVAL=.FALSE.
	IF (.NOT. INQ_PROGRAM) THEN
	  IF (CLI$PRESENT('TERMINATOR') .EQ. %LOC(CLI$_PRESENT)) THEN
C
C	    If value present, then set symbol name
C
	    IF (INQ$GET_VALUE('TERMINATOR',INQ_TERMSYM,INQ_TERMSYMLEN)) THEN
	      INQ_TERMINATOR=.FALSE.
	      INQ_TERMVAL=.TRUE.
C
C	    Otherwise indicate terminator to be stuffed in symbol
C
	    ELSE
	      INQ_TERMINATOR=.TRUE.
	    ENDIF
	  ENDIF
	ENDIF
C
C o /TIMEOUT=label
C
C   Read timeout for terminals.  "Label" is DCL transfer label if timeout
C   occurs.
C   (Not valid for program interface).
C
	INQ_TIMEOUTLABEL=' '
	INQ_TIMEOUTLABELLEN=0
	INQ_TIMEOUT=.FALSE.
C
C	Check to see if qualifier specified on the given command
C
	IF (.NOT. INQ_PROGRAM) THEN
	  ISTAT=CLI$PRESENT('TIMEOUT')
C
C	  If present then get the label
C
	  IF (ISTAT .EQ. %LOC(CLI$_PRESENT)) THEN
	    ISTAT=INQ$GET_VALUE('TIMEOUT',INQ_TIMEOUTLABEL,INQ_TIMEOUTLABELLEN)
	    INQ_TIMEOUT=.TRUE.
	  ENDIF
	ENDIF
C
C	/TRMCHARS=(CHARACTERS=string,CONTROL=string)
C	Set terminator characters for read.
C
	ISTAT = CLI$PRESENT('TRMCHARS')
	INQ_TRMCHARS = ISTAT
	IF (ISTAT) THEN
	  CALL LIB$MOVC5(0,0,0,8,INQ_TRM)
C
C	  Process normal characters.
C
	  ISTAT = INQ$GET_VALUE('TRMCHARS.CHARACTERS',VALUESTR,VALUELEN)
	  IF (ISTAT) THEN
	    DO ICH = 1,VALUELEN
	      CALL LIB$INSV(1,ICHAR(VALUESTR(ICH:ICH)),1,INQ_TRM)
	    ENDDO
	  ENDIF
C
C	  Process control characters.
C
	  ISTAT = INQ$GET_VALUE('TRMCHARS.CONTROL',VALUESTR,VALUELEN)
	  IF (ISTAT) THEN
	    DO ICH = 1,VALUELEN
	      CHARVAL = ICHAR(VALUESTR(ICH:ICH)) - 64
	      IF (CHARVAL .GT. 0) THEN
	        CALL LIB$INSV(1,CHARVAL,1,INQ_TRM)
	      ELSE
	        INQ$QUAL = %LOC(CLI$_VALCNVERR)
	        RETURN
	      ENDIF
	    ENDDO
	  ENDIF
	ENDIF
	END
	SUBROUTINE INQ$RETURN_R0
C
C o This is a fake-out routine that simply returns whatever is in R0 as the
C   status.  Callers can declare this as an integer function to get the
C   last status of a Fortran I/O subroutine call.
C
	IMPLICIT NONE
	END
