FTN4 PROGRAM QY17(5,90),92069-16060 REV.1912 790125 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-18080 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 INTEGER ITEMS(128) INTEGER ERR1(9) INTEGER ISTAT(10) 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 EQUIVALENCE COMMENT C 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 NUMBER 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 BAD SEGMENT C DATA BLANK/2H / C SELECT-FILE ERROR DATA ERR1/2H S,2HEL,2HEC,2HT-,2HFI,2HLE,2H E,2HRR,2HOR/ C C C C C C C C C C C C C C C C C BEGIN C C C PICK UP THE SELECTED RECORD NUMBER C IF(IPTR .LT. 65) GOTO 50 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) RSEC = DIN(RSEC) IPTR = 1 IF(ISTAT .GE. 0) GOTO 50 C C FMP ERROR C CALL QRIO(2,ITTY,ERR1,9) GOTO 140 C C GET THE DATA FROM THE DATA SET C 50 CONTINUE CALL DBGET(DBNAM,DSNUM,4,ISTAT,ITEMS,IBUFF,SELT(IPTR) ) IF(ISTAT .NE. 0) GOTO 140 IPTR = IPTR+1 C C LOAD AND EXECUTE THE SEGEMENT THAT FORMAT THE PRINT RECORD C SNAM(2) = 2H18 CALL LOAD(SNAM) C C LOAD THE COMMAND INTERPETER SEGMENT C 130 CONTINUE SNAM(2) = 2H GOTO 150 C C C DBMS ERROR C 140 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 C C LOAD AND EXECUTE SEGMENT C 150 CONTINUE CALL LOAD(SNAM) END $