FTN 
      FUNCTION QRIO(ICODE,IFILE,IBUF,IL),92069-16061 REV.1912 781128
      INTEGER IFILE(145)
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED 
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR 
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18112
C     RELOC:     92069-16060
C 
C 
C****************************************************************:
C 
C 
C 
C 
C 
C ABSTRACT: 
C 
C QRIO IS A ROUTINE WRITTEN TO REPLACE "REIO". IT ALLOWS QUERY TO 
C USE LOCAL AND REMOTE FILES WITHOUT DISTRUBING THE QUERY CODE
C 
C QRIO WILL PAD AN ODD BYTE  COUNT  TO  A FILE WITH A BLANK.
C 
C 
C CALLING SEQUENCE: 
C 
C     CALL QRIO(ICODE,IFILE,IBUF,IL)
C 
C        WHERE: 
C 
C        ICODE
C        IS THE OPERAND CODE
C             1 INDICATES READ
C             2 INDICATES WRITE 
C 
C        IFILE
C        IS THE FILE DCB OR LU OF THE DEVICE
C            WORD 1 = POSITIVE LU AND LU CONTROL
C                     OR, IS NEGETIVE WHICH INDICATES 
C                     THAT A DCB IS IN WORDS 2 - 145
C            WORD 2-145 = DCB 
C 
C 
C        IBUF 
C        IS THE READ/WRITE BUFFER 
C 
C        IL 
C        IS THE LENGTH
C           NEGETIVE INDICATES BYTE COUNT 
C           POSITIVE INDICATES WORD COUNT 
C 
C 
C 
C 
C 
C 
C 
      INTEGER IQRA,IQRB 
      INTEGER IRIO(2) 
      REAL    RIO 
      INTEGER ERR1(13),ERR2(18),ERR4(12)
      INTEGER ERR5(13)
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   $$$$$$$$$$$$$$$$$$$$$
      EQUIVALENCE ( RIO,IRIO) 
      EQUIVALENCE (IRIO,IQRA) 
      EQUIVALENCE (IRIO(2),IQRB)
      DATA ERR1/2H Q,2HUE,2HRY,2H D,2HEV,2HIC,2HE ,2HI/,2HO ,2HAB,
     &   2HOR,2HTE,2HD /
      DATA ERR2/2H Q,2HUE,2HRY,2H- ,2HIL,2HLE,2HGA,2HL ,2HI/
     &   ,2HO ,2HCO,2HNT,2HRO,2HL ,2HOP,2HER,2HAN,2HD / 
      DATA ERR4/2H Q,2HUE,2HRY,2H- ,2HIN,2HPU,2HT ,2HFI,2HLE,2H E,
     &    2HRR,2HOR/
      DATA ERR5/2H Q,2HUE,2HRY,2H- ,2HOU,2HTP,2HUT,2H F,2HIL,2HE ,
     &    2HER,2HRO,2HR / 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C CHECK TO SEE IF THE INPUT IS A FILE 
C 
      IF(IFILE .LT. 0) GOTO 10
C 
C SEE IF THIS IS A REMOTE CALL
C 
      IF(RMOTE .EQ. -1) GOTO 2
      CALL DEXEC(RMOTE,ICODE+100000B,IFILE,IBUF,IL) 
      GOTO 40 
1     GOTO 5
C 
C MAKE LOCAL DEVICE CALL
C 
2     CONTINUE
      CALL REIO(ICODE+100000B,IFILE,IBUF,IL)
      GOTO 40 
5     CALL ABREG(IQRA,IQRB) 
      GOTO 30 
C 
C GET INPUT FROM A FILE 
C 
10    CONTINUE
      IF(ICODE .NE. 1)GOTO 20 
      LEN = IL
      IF(IL .LT. 0)LEN = -(IL+1/2)
      CALL EREAD(IFILE(2),IQRA,IBUF,LEN,IQRB,DUMY)
      IF(IQRA .LT. 0) GOTO 70 
      IF(IL .LT. 0) IQRB = IQRB*2 
      GOTO 30 
C 
C WRITE TO A FILE 
C 
20    CONTINUE
      IF(ICODE .NE. 2) GOTO 50
      LEN = IL
C 
C PAD ODD WRITE COUNTS WITH A BLANK 
C 
      IF(IL .GT. 0) GOTO 25 
      LEN = - LEN/2 
      IL = -IL
      IF(IL-LEN*2  .EQ. 0) GOTO 25
      LEN = LEN + 1 
      CALL SPUT(IBUF,IL+1,40B)
C 
C WRITE THE RECORD
C 
25    CONTINUE
      CALL EWRIT(IFILE(2),IQRA,IBUF,LEN,DUMY) 
      IF(IQRA .LT. 0) GOTO 70 
      IQRB= IL
C 
C EXIT
C 
30    CONTINUE
      QRIO = RIO
      RETURN
C 
C 
C 
C ERROR PROCESSOR 
C 
C 
40    CONTINUE
      IQRA = -1 
      CALL REIO(2,1,ERR1,13)
      GOTO 100
C 
C OUTPUT "ILLEGAL I/O CONTROL OPERAND"
C 
50    CONTINUE
      CALL REIO(2,1,ERR2,18)
      GOTO 100
C 
C OUTPUT "INPUT FILE ERROR" 
C 
70    CALL REIO(2,1,ERR4,12)
      GOTO 90 
C 
C OUTPUT "OUTPUT FILE ERROR"
C 
80    CALL REIO(2,1,ERR5,13)
C 
C OUTPUT FMP ERROR
C 
90    CALL FMERR(IQRA,1)
C 
C END QUERY 
C 
100   CONTINUE
      SNAM(2) = 2H16
      CALL LOAD(SNAM) 
      END 
                  