FTN4
      PROGRAM QY20(5,90),92069-16060 REV.1912 790109
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-18083
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C 
C 
C 
C  REPORT GENERATION IS MADE UP OF THREE MODULES: 
C  1) QS06 - INITIALIZATION 
C  2) QS15 - CONTROL BREAKS 
C  3) QS12 - TOTALS 
C  4) QS20 - GROUPS/DETAILS 
C 
C 
C  REPORT TABLE FORMAT IN ARRAY SS(6,100).
C  THIS TABLE IS BUILT BY QS02, LOGIC 
C  CHECKED BY QS04, AND SORTED (IF NEEDED)
C  BY QS05. 
C 
C  EACH ROW OF ARRAY S CONTAINS INFORMATION 
C  ABOUT EACH REPORT STATEMENT: 
C 
C     1. REPORT STATEMENT TYPE
C         10-15 SORT STATEMENT
C         21-25 HEADER STATEMENT
C         31-36 TOTAL STATEMENT 
C         41-46 GROUP STATEMENT 
C         50-59 DETAIL STATEMENT
C         60-69 EDIT MASKS
C 
C     2. DATA-ITEM NUMBER 
C 
C     3. LITERAL POINTER TO QSKIB.  QSKIB IS AN RTE TRACK 
C        WHICH CONTAINS ALL LITERALS OR EDIT
C        MASKS IN A2 FORMAT, PRECEDED BY IT'S 
C        CHARACTER LENGTH.
C 
C     4. END PRINT POSITION 
C 
C     5. REPORT OPTION 1
C        UNITS PLACE     = SPACE BEFORE (0-5) 
C        TENS PLACE      = SPACE AFTER  (0-5) 
C        HUNDREDS PLACE  = SKIP BEFORE (0-1)
C        THOUSANDS PLACE = SKIP AFTER (0-1) 
C        TEN THOUSANDS   = ADD (0-1)
C 
C     6. REPORT OPTION 2
C        UNITS PLACE  = O NO EDIT  = 1 ZERO SUPPRESS
C        60 - 69  EDIT MASK 
C        HUNDREDS PLACE  = COUNT (0-1)
C        THOUSANDS PLACE = AVERAGE (0-1)
C 
C     7. OFFSET INTO THE LIST-ARRAY 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C     T ARRAY IS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS 
C 
C     U ARRAY IS USED TO FOR TOTAL COUNT
C        1. FIELD MAP          (1,I)
C        2. ACCUMULATE COUNTS  (2,I) - (7,I)
C 
C     ATOTAL ARRAY IS FOR TOTAL ADD 10*5
C       NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON 
C 
C     LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER
C 
C         FIRST ENTRY IS DIFFERENT THAN THE OTHERS
C            1. CONTAINS # OF ENTRIES IN ARRAY
C            2 - 5. ARE EMPTY 
C            6. CONTAINS THE # OF SORT ITEMS
C                 NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY
C 
C         OTHER ENTRIES 
C            1. ITEM NUMBER 
C            2. ITEM TYPE 
C            3. ITEM LENGTH 
C            4. ELEMENT COUNT 
C            5. OFFSET INTO DBMS BUFFER 
C            6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM 
C 
C 
C 
C    LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK
C     STRINGS 
C 
C    LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING 
C 
C 
C 
C 
C 
      LOGICAL HDFLG 
      LOGICAL LEVBRK
      INTEGER CS(66),V(8),NTST,N
      REAL    DINT,REAL 
      INTEGER INTGR,R 
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 INTGR/111B/
      DATA R/122B/
      DATA HDFLG/.FALSE./ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C ACCUMULATE COUNTS AND TOTALS
C 
      DO 50 I = 1,5 
      IF( U(1,I) .EQ. 0) GOTO 60
C 
C INCREASE COUNT ON EACH LEVEL
C 
      DO 10 I2 = 2,7
      U(I2,I) = U(I2,I) + 1 
10    CONTINUE
C 
C ACCUMULATE
C 
      LNDX = U(1,I) 
      IOFF = LIST(LNDX,5) 
      IOFF2 = IOFF + LIST(LNDX,3) - 1 
      ITYPE = LIST(LNDX,2)
C 
C INTEGER?
C 
      IF(ITYPE .NE. INTGR) GOTO 30
      CALL SMOVE(IBUFF,IOFF,IOFF2,INUM,1) 
      DINT = DBLEI(INUM)
C 
C 
C 
      DO 20 I3 = 1,6
      ATOTAL (I3,I) = DAD(ATOTAL(I3,I),DINT)
20    CONTINUE
      GOTO 50 
C 
C REAL
C 
30    CONTINUE
      IF(ITYPE .NE. R) GOTO 50
      CALL SMOVE(IBUFF,IOFF,IOFF2,REAL,1) 
      DO 40 I3 = 1,6
      ATOTAL(I3,I) = ATOTAL(I3,I) + REAL
40    CONTINUE
C 
C 
C END OF MAJOR LOOP 
C 
C 
50    CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C PRINT GROUPS WITH DETAIL STATEMENTS 
C 
60    CONTINUE
      CALL SFILL(CS,1,COLLIM,40B) 
      BREAK = .FALSE. 
      LEVBRK = .FALSE.
C 
C 
C 
      DO 90 I = 1,R3
      N = SS(1,I) 
      IF(N .EQ. 50) GOTO 75 
      IF(N .LT. 40  .OR.  N .GT. 49) GOTO 90
C 
C BUFFER THE INPUT LINE 
C 
      IF(L(N-40) .NE. 0) GOTO 90
C 
C SET LEVBRK TRUE SO IF LAST LINE IT WILL BE PRINTED
C 
75    CONTINUE
      LEVBRK = .TRUE. 
C 
C BUFFER THE FIELD
C 
      CALL BUFLN(I,V,CS)
C 
C 
C 
C END OF LOOP 
C 
90    CONTINUE
C 
C PRINT THE LAST LINE IF NECESSARY
C 
      IF( .NOT. LEVBRK) GOTO 120
      CALL PRTLN(CS,COLLIM,V,HDFLG) 
      IF(BREAK) GOTO 180
C 
C PRINT ALL THE DETAIL LINES
C 
120   CONTINUE
      NTST = 0
      DO 150 I = 1,R3 
      N = SS(1,I) 
      IF(N .LT. 51  ) GOTO 150
      IF(N .GT. 59  ) GOTO 160
      IF(NTST .EQ. N  .OR. NTST .EQ. 0) GOTO 140
      CALL PRTLN(CS,COLLIM,V,HDFLG) 
      IF(BREAK) GOTO 180
C 
C BUFFER THE FIELD
C 
140   CONTINUE
      NTST = N
      CALL BUFLN(I,V,CS)
150   CONTINUE
C 
C PRINT THE LAST LINE 
C 
160   CONTINUE
      IF(NTST .EQ. 0) GOTO 170
      CALL PRTLN(CS,COLLIM,V,HDFLG) 
      IF(BREAK) GOTO 180
C 
C 
C 
170   CONTINUE
      SNAM(2) = 2H15
C 
C LOAD AND EXECUTE SEGMENT
C 
175   CONTINUE
      CALL LOAD(SNAM) 
C 
C ERROR EXIT
C 
180   CONTINUE
      SNAM(2) = 2H
      GOTO 175
      END 
                                                                                              