FTN4
      PROGRAM QY03(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-18066
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  THIS MODULE WILL REPORT "ALL" DATA RECORDS 
C  WITHOUT REPORT FORMATING OR EDITING
C 
C THE "REPORT ALL" PROCESSOR IS BROKEN INTO THREE MODULES:
C 
C     QS03 - BUILDS THE SCOOP TABLE WHICH CONTAINS INFORMATION
C            ABOUT EACHITEM IN THE DATA SET.
C     QS17 - READS THE DATA RECORD FROM THE DATA SET
C     QS18 - FORMATS AND PRINTS EACH DATA ITEM'S VALUE
C 
C 
C          NULL ASCII DATA-ITEMS WILL BE FILLED 
C  WITH " "S; INTEGER AND REAL DATA-ITEMS WILL
C  PRINT AS ZEROS(0). 
C 
C  RRCNT IS A COUNT OF RETRIEVED RECORDS
C  WITHIN SELECT-FILE.
C 
      LOGICAL IFTTY 
      INTEGER ITEMS(128)
      INTEGER INFO(13)
      INTEGER DZERO(2)
      INTEGER ISTAT(10) 
      INTEGER ERR1(13)
      INTEGER ERR2(12)
      INTEGER ERR3(9) 
      INTEGER BLANK 
      INTEGER SCOOP(128,6)
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 SCOOP IS A 128 BY 6 ARRAY, WHICH CONTAINS AN ENTRY FOR
C       EACH ITEM IN THE DATA SET.  THE FIRST ENTRY CONTAINS
C       THE RCOUNT OF CURRENT ENTRIES.  THE OTHERS CONTAIN THE
C       FOLLOWING INFORMATION:
C 
C       WORD 1-3  CONTAINS THE ITEM NAME
C       WORD 4    CONTAINS THE ITEM TYPE
C       WORD 5    CONTAINS THE ITEM LENGTH
C       WORD 6    CONTAINS THE ELEMENT COUNT
C 
C ITEMS IS A 128 WORD ARRAY WHICH CONTAINS THE INFORMATION RETURNED 
C       FROM A DBINF MODE 104.
C 
C SELT CONATINS A RECORD FROM THE SELECT FILE.
C 
C RCOUNT IS THE NUMBER OF DBMS RECORDS SELECTED IN THE SELECT FILE. 
C 
C RSEC IS THE CURRENT RECORD NUMBER OF THE SELECT FILE
C 
C IPTR IS THE OFFSET INTO THE SELECT FILE RECORD IN SELT
C 
C LIST IS A FLAG
C       0 INDICATES PRINT ITEM NAME 
C       1 SUPPRESSES THE PRINTING OF THE ITEM NAME
C 
C 
C 
      EQUIVALENCE(SCOOP,IB) 
      EQUIVALENCE(ITEMS,IB(769))
      EQUIVALENCE(LLIST,S(1,1) )
C 
C RECORD NOT YET BEEN FOUND 
      DATA ERR1/2H R,2HEC,2HOR,2HD ,2HNO,2HT ,2HYE,2HT ,2HBE,2HEN,
     &  2H F,2HOU,2HND/ 
C ULLEGAL LOCK REQUEST
      DATA ERR2/2H I,2HLL,2HEG,2HAL,2H L,2HU ,2HLO,2HCK,2H R,2HEQ,
     &  2HUE,2HST/
C SELECT-FILE ERROR 
      DATA ERR3/2H S,2HEL,2HEC,2HT-,2HFI,2HLE,2H E,2HRR,2HOR/ 
C BAD SEGMENT 
C 
      DATA DZERO/0,0/ 
      DATA BLANK/2H  /
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
      LLIST = 0 
      CALL LSCAN(IB,I,J,K)
      IF(K .NE. 5) LLIST = 1
C 
C INTIALIZE SECTOR NUMBER, AND OFFSET INTO SECTOR FOR SELECT FILE 
C 
      RSEC = DBLEI(1) 
C 
C READ THE FIRST RECORD OF THE SELECT FILE
C 
      CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) 
      IF(ISTAT .LT. 0) GOTO 135 
      RCOUNT = SELT(6)
      RRCNT = SELT(6) 
      CALL SMOVE(SELT,19,20,DSNUM,1)
      IPTR = 9
      RSEC = DIN(RSEC)
C 
C VERIFY THAT RECORDS ARE SELECTED
C 
      IF(DCO(RRCNT,DZERO) )5,5,10 
5     CALL ERIO(2,ITTY,ERR1,13) 
      GOTO 130
C 
C GET ALL ITEMS IN THIS DATA SET
C 
10    CONTINUE
      CALL DBINF(DBNAM,DSNUM,104,ISTAT,ITEMS) 
      IF(ISTAT .NE. 0) GOTO 140 
      IF(ITEMS .LE. 0) GOTO 130 
C 
C PUT THE INFORMATION NECESSARY FOR PRINTING OUT THE ITEM VALUES
C IN THE ARRAY "SCOOP". SCOOP IS 128 BY 6. THERE IS A ROW FOR 
C EACH POSSIBLE ITEM IN A DATA ENTRY. 
C 
C WORD 1-3  CONTAINS THE ITEM NAME
C WORD 4 CONTAINS THE ITEM TYPE 
C WORD 5 CONTAINS THE ITEM LENGTH 
C WORD 6 CONTAINS THE ITEM ELEMENT COUNT
C 
      SCOOP(1,1) = ITEMS
      DO 20 ITM = 2,ITEMS+1 
C 
C GET THE ITEM NUMBER IGNORING THE TYPE OF ACCESS 
C MODIFY THE "ITEMS" TO CONTAIN ONLY POSITIVE ENTRIES SO IT 
C CAN BE USED BY DBGET
C 
      DINUM = IABS(ITEMS(ITM))
      ITEMS(ITM) = DINUM
C 
C GET THE ITEM CHARACTERISTICS
C 
      CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO)
      IF(ISTAT .NE. 0) GOTO 140 
      SCOOP(ITM,1) = INFO(1)
      SCOOP(ITM,2) = INFO(2)
      SCOOP(ITM,3) = INFO(3)
      CALL SGET(INFO,17,SCOOP(ITM,4)) 
      SCOOP(ITM,5) = INFO(10) 
      SCOOP(ITM,6) = INFO(11) 
20    CONTINUE
C 
C LOCK THE PRINT DEVICE 
C 
      CALL LUREQ(RMOTE,1,ILP,IERR)
      IF(IERR .NE. 0) GOTO 150
      CALL TOPAG(RMOTE,ILP,IERR)
C 
C LOAD AND EXECUTE SEGEMENT TO GET DATA ITEM
C 
30    CONTINUE
      SNAM(2) = 2H17
      CALL LOAD(SNAM) 
C 
C LOAD THE COMMAND INTERPETER SEGMENT 
C 
130   CONTINUE
      SNAM(2) = 2H
      CALL LOAD(SNAM) 
C 
C SELECT-FILE ERROR 
C 
135   CONTINUE
      CALL QRIO(2,ITTY,ERR3,9)
C 
C 
C DBMS ERROR AND FMP ERRORS 
C 
140   CONTINUE
      QSERR = ISTAT 
      SNAM(2) = 2H23
      CALL LOAD(SNAM) 
C 
C ILLEGAL LU LOCK REQUEST 
C 
150   CONTINUE
      CALL ERIO(2,ITTY,ERR2,12) 
      GOTO 130
      END 
$ 
                            