FTN4
      PROGRAM QY24(5,90),92069-16060 REV.2001 791008
C REV.2001 - DOCUMENTATION CHANGE 
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-18087
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  QUERY SUBSYSTEM MAIN MODULE
C  COMMAND INTERPRETER
C 
C 
      LOGICAL IFTTY 
      INTEGER EDITOR(3) 
      INTEGER IERR5(7)
      INTEGER ISTAT(10) 
      INTEGER IERR2(9)
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   $$$$$$$$$$$$$$$$$$$$$
C 
C 
      DATA IERR2/2H I,2HNV,2HAL,2HID,2H R,2HEQ,2HUE,2HST,2H  /
      DATA IERR5/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR /
      DATA EDITOR/2HED,2HIT,2HR / 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C 
C EXECUTE 
C 
C SEE IF DEFAULT OF "EDITR" IS REQUESTED
C 
C     PARAMETER 1 - INPUT LU
C     PARAMETER 2 - MAXIMUM LINE
C     PARAMETER 3 - NODE LOCAL TO THE EDITR 
C     PARAMETER 4 - NODE REMOTE TO THE EDITR, LOCAL TO USER 
C     PARAMETER 5 - LU NUMBER TO APPEND TO THE EDITRTO USER 
C 
      CALL SFILL(IMA,1,6,40B) 
      IF(S.NE. 5) GOTO 560
      CALL SMOVE(EDITOR,1,6,IMA,1)
      ISTAT(1) = INLU 
      ISTAT(2) = 0
      ISTAT(3) = NODE(IDMY) 
      ISTAT(4) = RMOTE
      ISTAT(5) = INLU 
      GOTO 570
C 
C GET NAME OF PROGRAM 
C 
560   CONTINUE
      CALL LSCAN(IB,I,J,K)
      IF(K .NE. 2) GOTO 7010
      CALL SMOVE(IB,I,J,IMA,1)
C 
C PASS THE ORIGINAL PRAMETERS 
C 
      ISTAT(1) = INLU 
      ISTAT(2) = ILP
      ISTAT(3) = ITTY 
      ISTAT(4) = ECHO 
      ISTAT (5) = 0 
C 
C XQPRG RENAMES, LOADS AND EXECUTES A PROGRAM 
C 
C      PARAMETERS:
C 
C            DCB THAT XQPRG USES TO FIND THE PROGRAM
C            EXEC CALL (DO NOT SET THE NO ABORT BIT)
C            NAME OF PROGRAM
C            ARRAY CONTAINING THE 5 RMPAR PARAMETERS
C            ARRAY CONTAINING THE PARAMETER STRING
C            LENGTH OF STRING( MINUS FOR BYTES, PLUS FOR WORDS) 
C            RETURN PARAMETER LIST (MUST NOT BE SAME ARRAY AS INPUT 
C                    PARAMETER LIST)
C            ERROR WORD  SCHEDULING ERROR CODE) 
C 
570   CALL XQPRG(IDCB(2),23,IMA,ISTAT,PARM,-LPARM,ISTAT(6),IERR)
      IF(IERR .NE. 0) GOTO 7030 
20    CONTINUE
      SNAM(2) = 2H
      CALL LOAD(SNAM) 
C 
C SYNTAX ERROR
C 
7010  CONTINUE
      CALL SFILL(IMA,1,72,40B)
      CALL QRIO(2,ITTY,IB,-IEND)
      IF(I .GT. 72) I = I - I/72*72 
      CALL SPUT(IMA,I,136B) 
      CALL QRIO(2,ITTY,IMA,-I)
      CALL ERIO(2,ITTY,IERR5,7 )
      GOTO 20 
C 
C IVALID REQUEST
C 
7030  CONTINUE
      CALL ERIO(2,ITTY,IERR2,9) 
      GOTO 20 
      END 
                                                                                                                                                                                                                                                      