FTN4
      PROGRAM QY21(5,90),92069-16060 REV.1912 790205
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C*************************************************************
C 
C 
C     SOURCE:    92069-18084
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C ABSTRACT: 
C 
C THIS SEGMENT PARSES THE RUN STRING AND SETS THE FLAG INDICATING 
C REMOTE OR LOCAL (RMOTE).
C 
C THE RUN STRING IS AS FOLLOWS
C 
C     RU,QUERY,INPUT,LIST,LOG,OPTION,NODE 
C 
C     WHERE:
C 
C     INPUT 
C     IS AN FMP NAMR OR LU.  WHEN THE INPUT IS A NON-INTERACTIVE DEVICE 
C     OR WHEN IT IS A FILE , QUERY ASSUMES BATCH COMMANDS, AND
C     DOES NOT PROMPT THE USER FOR INPUT.  WHEN NO INPUT PARAMETER IS 
C     GIVEN LU 1 IS ASSUMED.
C 
C     LIST
C     IS AN FMP NAMR OR LU.  IT IS THE UNIT TO WHICH ALL OUTPUT FROM
C     THE COMMANDS ARE DIRECTED.  ERRORS ARE NOT LISTED TO THE LIST 
C     UNIT, INSTEAD THEY AR LISTED TO THE LOG DEVICE.  WHEN NO LIST 
C     PARAMETER, THEN THE LIST UNIT DEFAULTS TO THE INTERACTIVE INPUT 
C     UNIT.  IF THE INPUT UNIT IS NOT INTERACTIVE THEN IT DEFAULTS TO 
C     LU 1. 
C 
C     LOG 
C     IS AN FMP NAMR OF  LU.  IT IS THE UNIT TO WHICH ALL ERROR MESSAGES
C     ARE LISTED.  IT ALSO IS THE UNIT TO WHICH THE ECHO OF THE COMMANDS
C     IS LISTED.  WHEN NO LOG PARAMETER IS ENTERED, THE LOG UNIT IS 
C     DEFAULTED TO THE INTERACTIVE INPUT UNIT.  WHEN THE INPUT UNIT 
C     IS NOT INTERACTIVE, THE LOG UNIT DEFAULTS TO LU 1.
C 
C     OPTION
C     IS THE WORD "ECHO".  THIS INDICATES THAT QUERY SHOULD ECHO
C     EVERY COMMAND TO THE LOG UNIT.
C 
C     NODE
C     IS THE NODE NUMBER AT WHICH THE REMOTE INTERACTIVE USER IS SITTING. 
C     (QUERY DOES NOT RECOGNIZE NON-INTERACTIVE REMOTE DEVICES, BECAUSE 
C     THERE IS NOT A REMOTE EQUIVALENCE TO THE SUBROUTINE "IFTTY".) 
C 
C 
C 
      LOGICAL LUREQ 
      INTEGER IMSG(15)
      INTEGER BLANK 
      INTEGER XECW(3) 
      INTEGER ERR1(12),ERR2(12),ERR3(11)
      INTEGER ERR4(8) 
      INTEGER ERR5(12)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ 
      INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM 
      INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR 
      INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN
      LOGICAL BREAK 
      INTEGER IPFLAG,IOFLAG,RMOTE 
      LOGICAL BATCH,XQBCH 
      INTEGER PAGCNT,LNCNT
      INTEGER PAGLEN,COLLIM 
      REAL    RRCNT 
      REAL    SELT,RSEC 
      INTEGER IPTR
      REAL    RCOUNT
      INTEGER S,R3,TRKNM,IDILU
      INTEGER R6
      REAL    ATOTAL
      INTEGER LIST,L,T,U
      INTEGER LEVSTR,LEVLEN 
      INTEGER IBUFF 
      INTEGER SS(7,100) 
C 
      COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)
      COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) 
      COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR
      COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN
      COMMON BREAK
      COMMON IPFLAG,IOFLAG,RMOTE
      COMMON BATCH,XQBCH
      COMMON PAGCNT,LNCNT 
      COMMON PAGLEN,COLLIM
      COMMON RRCNT
      COMMON SELT(64),RSEC
      COMMON IPTR 
      COMMON RCOUNT 
      COMMON S(15,50),R3,TRKNM,IDILU
      COMMON R6 
      COMMON ATOTAL(6,5)
      COMMON LIST(101,6),L(7),T(5),U(7,5) 
      COMMON LEVSTR(66,5),LEVLEN(5) 
      COMMON IBUFF(2048)
C 
      EQUIVALENCE (S,SS)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      DATA  ERR1/2H I,2HLL,2HEG,2HAL,2H I,2HNP,2HUT,2H P,2HAR,2HAM, 
     &   2HET,2HER/ 
      DATA ERR2/2H I,2HLL,2HEG,2HAL,2H L,2HIS,2HT ,2HPA,2HRA,2HME,
     &   2HTE,2HR / 
      DATA ERR3/2H I,2HLL,2HEG,2HAL,2H L,2HOG,2H P,2HAR,2HAM,2HET,
     &   2HER/
      DATA ERR4/2H I,2HLL,2HEG,2HAL,2H O,2HPT,2HIO,2HN /
      DATA ERR5/2H I,2HLL,2HEG,2HAL,2H L,2HOC,2HK ,2HON,    
     &  2HIN,2HPU,2HT ,2HLU/
C 
C 
C     CR/LF/LF/LF IMAGE 1000 QUERY       CR/LF/LF/LF
      DATA IMSG/2H  ,2H  ,2HIM,2HAG,2HE/,2H10,2H00, 
     &2H Q,2HUE,2HRY,2H  ,2H  ,2H  ,2H  ,2H  /
      DATA XECW/2HEX,2HEC,2HW / 
      DATA BLANK/2H  /
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C 
C 
C TURN THE STRING LENGTH INTO CHARACTERS
C 
      ICNT = 2 * LPARM
      IPTR = 1
C 
C GET THE REMOTE STRING LENGTH INTO CHARACTERS
C 
      RMOTE = -1
      DO 10 I=1,5 
      CALL NAMR(IMA,PARM,ICNT,IPTR) 
10    CONTINUE
C 
C IF 5TH PARAMETER IS AN INTEGER ASSUME IT TO BE GOOD 
C 
      IF((IAND(IMA(4),3) .EQ. 1).AND.(IMA .NE. NODE(IDMY)))RMOTE = IMA
      IPTR = 1
C 
C GTPRM CALLS NAMR WITH THE FIRST FOUR PARAMETERS 
C RETURNING THE LU IN THE FIFTH OR THE OPENED DCB IN THE SIXTH
C THE FLAG IS SET TO INDICATE THAT THE FILE SHOULD NOT
C BE CREATED, AND THE LAST PARAMETER INDICATES ERRORS.
C 
      CALL GTPRM(IMA,PARM,ICNT,IPTR,INLU,INLU(2),.FALSE.,IERR)
      IF(IERR .LT. 0) GOTO 7010 
C 
C DEFAULT INPUT TO LOG
C 
      IF(INLU .EQ. 0) INLU = 1
C 
C LUREQ IS TRUE ONLY IF THE LU IS A LOCAL DEVICE, OR IS A LOCAL FILE
C WHEN THE INPUT UNIT IS A LOCAL DEVICE OR FILE BATCH IS ASSUMED
C 
C 
      BATCH = LUREQ(RMOTE,1,INLU,IERR)
      IF(IERR .LT. 0) GOTO 7005 
C 
C GET THE LIST DEVICE 
C 
      CALL GTPRM(IMA,PARM,ICNT,IPTR,ILP,ILP(2),.TRUE.,IERR) 
      IF(IERR .LT. 0) GOTO 7020 
C 
C DEFAULT TO THE LINE PRINTER 
C 
      IF(ILP .NE. 0) GOTO 17
      ILP = 6 
      IF(.NOT. BATCH) ILP = INLU
C 
C SET THE ECHO BIT IF THIS IS A FILE
C 
17    CONTINUE
      IF(ILP .GT. 0) ILP = ILP + 600B 
C 
C GET THE LOG DEVICE
C 
      CALL GTPRM(IMA,PARM,ICNT,IPTR,ITTY,ITTY(2),.TRUE.,IERR) 
      IF(IERR .LT. 0) GOTO 7030 
C 
C DEFAULT THE LOG TO THE INPUT DEVICE 
C 
      IF(ITTY .NE. 0) GOTO 20 
      ITTY = 1
      IF(.NOT. BATCH) ITTY = INLU 
C 
C SET THE ECHO BIT
C 
20    CONTINUE
      IF(ITTY .GT. 0) ITTY = ITTY + 600B
C 
C SET THE ECHO BIT ON THE INPUT 
C 
      IF(.NOT. BATCH) INLU = INLU + 400B
C 
C GET THE ECHO OPTION 
C 
      CALL NAMR(IMA,PARM,ICNT,IPTR) 
      ECHO = 0
      IF(IAND(IMA(4),3) .NE. 3) GOTO 30 
      IF(IMA .NE. 2HEC)  GOTO 7050
      ECHO = 1
C 
C 
C INITIALIZE THE GLOBALS
C 
C 
C PAGLEN = MAXIMUM LINES PER PAGE 
C COLLIM = MAXIMUM CHARACTERS PER LINE
C 
30    CONTINUE
      PAGLEN = 54 
      COLLIM = 132
C 
C DINUM = DATA ITEM NUMBER
C DSNUM = DATA SET NUMBER 
C DBNAM  = DATA BASE NAME 
C DSNAM = DATA SET NAME 
C DINAM = DATA ITEM NAME
C 
      DINUM = 0 
      DSNUM = 0 
      DBNAM = 2H
      DBNAM(2) = 2H 
      DINAM = 2H
      DSNAM = 2H
C 
C 
C RRCNT = NUMBER OF ENTRIES IN SELECT FILE
C SELECT = SELECT FILE NAME 
C 
      RRCNT = 0 
      SELECT = 2H 
C 
C IBSZ = SIZE OF THE INPUT BUFFER "IB"
C 
      IBSZ = 893
C 
C PRINT THE HEADING 
C 
      CALL QRIO(2,ILP,BLANK,1)
      CALL QRIO(2,ILP,BLANK,1)
      CALL QRIO(2,ILP,BLANK,1)
      CALL QRIO(2,ILP,IMSG,15)
      CALL QRIO(2,ILP,BLANK,1)
      CALL QRIO(2,ILP,BLANK,1)
      CALL QRIO(2,ILP,BLANK,1)
C 
C LOAD AND EXECUTE COMMAND INTERPRETER
C 
      SNAM(2) = 2H
      CALL LOAD(SNAM) 
C 
C 
C 
C 
C 
C ERROR PROCESSORS
C 
C OUTPUT "ILLEGAL LOCK ON INPUT LU" 
C 
7005  CONTINUE
      CALL QRIO(2,ITTY,ERR5,12) 
      GOTO 7045 
C 
C OUTPUT "ILLEGAL INPUT PARAMETER"
C 
7010  CONTINUE
      CALL QRIO(2,ITTY,ERR1,12) 
      IF(IERR .EQ. -200)7045,7040 
C 
C ILLEGAL LIST PARAMETER
C 
7020  CONTINUE
      CALL QRIO(2,ITTY,ERR2,12) 
      IF(IERR .EQ. -200)7045,7040 
C 
C ILLEGAL LOG DEVICE
C 
7030  CONTINUE
      ITTY = 401B 
      CALL QRIO(2,ITTY,ERR3,11) 
      IF(IERR .EQ. -200) 7045,7040
C 
C STOP EXECUTION
C 
7040  CONTINUE
      CALL FMERR(IERR,ITTY) 
7045  SNAM(2) = 2H16
      CALL LOAD(SNAM) 
C 
C OUTPUT "ILLEGAL OPTION" 
C 
7050  CONTINUE
      CALL QRIO(2,ITTY,ERR4,8)
      GOTO 7040 
      END