FTN4
      PROGRAM QY12(5,90),92069-16060 REV.1912 790123
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-18075
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,LEVBRK
      INTEGER ERR1(8),ERR2(8) 
      REAL DINT 
      INTEGER R 
      INTEGER DS(66),LDS,CS(66),V(8)
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 ERR1/2H I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR /
      DATA ERR2/2H B,2HRE,2HAK,2H R,2HEQ,2HUE,2HST,2HED/
      DATA HDFLG/.FALSE./ 
      DATA INTGR/111B/
      DATA R/122B/
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C PRINT TOTALS
C 
      BREAK = .FALSE. 
      NTST = 0
      LEVBRK = .FALSE.
C 
C INITIALIZE THE PRINT BUFFER 
C 
      CALL SFILL(CS,1,COLLIM,40B) 
C 
C 
C 
      DO 210 I = 1,R3 
      N = SS(1,I) 
      IF(N .LT. 30) GOTO 210
      IF(N .GT. 39) GOTO 220
C 
C THIS IS A PRINT.  HAS THE LEVEL CHANGED?
C 
      IF((NTST .EQ. N) .OR. (NTST .EQ. 0).OR. .NOT. LEVBRK) GOTO 10 
C 
C YES, PRINT THE LINE AND CHECK THE BREAK REQUEST 
C 
      CALL PRTLN(CS,COLLIM,V,HDFLG) 
      IF(BREAK) GOTO 240
C 
C PUT THIS TOTAL IN THE PRINT BUFFER
C 
10    CONTINUE
      NTST = N
      LEVBRK = .FALSE.
      N = N-30
      IF(L(N) .NE. 0) GOTO 210
      LEVBRK = .TRUE. 
C 
C IS THIS A LITERAL?
C 
      IF(SS(3,I) .NE. 0) GOTO 205 
C 
C NO, THEN A ADD, COUNT, OR AVERAGE, OR PRINT ITEM VALUE REQUESTED
C 
C FIND IT'S PLACE IN THE COUNT ARRAY
C 
      CALL SPLIT(SS(5,I),SS(6,I),V) 
      LNDX = SS(7,I)
C 
C 
C 
      DO 30 I2 = 1,5
      IF(U(1,I2).EQ. LNDX) GOTO 40
30    CONTINUE
C 
C ERROR - THIS SHOULD NEVER HAPPEN
C 
      CALL ERIO(2,ITTY,ERR1,7)
      GOTO 250
C 
C IS THE ADD OPTION SET?
C 
40    CONTINUE
      IF(V(5) .EQ. 0) GOTO 90 
      V(5) = 0
C 
C INITIALIZE FROM THE LIST ARRAY
C 
      ITYPE = LIST(LNDX,2)
      LEN = LIST(LNDX,3)
      IOFF = LIST(LNDX,5) 
      IOFF2 = IOFF + LEN + 1
C 
C INTEGER ADD PROCESSOR 
C 
      IF(ITYPE .NE. INTGR) GOTO 50
      DINT = ATOTAL(N,I2) 
      GOTO 130
C 
C REAL  ADD PROCESSOR 
C 
50    CONTINUE
      REAL = ATOTAL(N,I2) 
      GOTO 150
C 
C COUNT OPTION PROCESSOR
C 
90    CONTINUE
      IF(V(7) .EQ. 0) GOTO 120
      V(7) = 0
      INUM = U(N+1,I2)
      IF(INUM .LT. 0) GOTO 210
      CALL CITA(INUM,DS)
      LDS = 6 
      GOTO 160
C 
C AVERAGE OPTION PROCESSOR
C 
120   CONTINUE
      IF(V(8) .EQ. 0) GOTO 205
      V(8) = 0
C 
C GET THE NUMBER OF OCCURANCES
C 
      INUM = U(N+1,I2)
C 
C GET INFORMATION FROM THE LIST ARRAY 
C 
      ITYPE = LIST(LNDX,2)
      LEN = LIST(LNDX,3)
      IOFF = LIST(LNDX,5) 
      IOFF2 = IOFF + LEN -1 
C 
C INTEGER AVERAGE 
C 
      IF(ITYPE .NE. INTGR) GOTO 140 
      DINT = DDI(ATOTAL(N,I2),DBLEI(INUM) ) 
C 
C CONVERT AND SCAN OFF ZEROS
C 
130   CONTINUE
      CALL DCITA(DINT,DS) 
      LDS = 10
C 
C ACCOUNT FOR MINUS 
C 
      IF(DCO(DINT,DBLEI(0)))132,160,160 
C 
C IF EDIT MASK IS NOT PRESENT THEN PUT MINUS IN 
C 
132   CONTINUE
      IF(V(6) .NE. 0) GOTO 135
      DO 133 I3 =10,1,-1
      CALL SGET(DS,I3,ICHAR)
      CALL SPUT(DS,I3+1,ICHAR)
133   CONTINUE
      CALL SPUT(DS,1,55B) 
      LDS = 11
      GOTO 160
C 
C ZONE THE LAST CHARACTER 
C 
135   CONTINUE
      CALL SZONE(DS,10,2,NOZ) 
      GOTO 160
C 
C AVERAGE REALS 
C 
140   CONTINUE
      REAL = ATOTAL(N,I2)/INUM
C 
C CONVERT REAL TO ASCII 
C 
150   CONTINUE
      CALL CRTA(REAL,DS)
      LDS = 13
C 
C EDIT FIELD WHEN NECESSARY 
C 
160   CONTINUE
      IF(V(6) .EQ. 0  .OR. ITYPE .EQ. R) GOTO 190 
      CALL EDIT(V(6),DS,LDS)
C 
C FIGURE START COLUMN 
C 
190   CONTINUE
      I3 = SS(4,I)
      JBEG = 1
      ISTRT = I3 - LDS + 1
C 
C DOES THE FIELD UNDER FLOW PRINT LINE ?
C 
      IF(ISTRT .GT. 0) GOTO 200 
      ISTRT = 1 
      JBEG = LDS - I3 + 1 
      LDS = I3
C 
C PUT THE VALUE IN THE PRINT LINE 
C 
200   CONTINUE
      CALL SMOVE(DS,JBEG,LDS,CS,ISTRT)
      GOTO 210
C 
C NO OPTIONS REQUESTED - PRINT THE ITEM VALUE 
C 
205   CONTINUE
      CALL BUFLN(I,V,CS)
C 
C 
C END OF LOOP 
C 
C 
210   CONTINUE
C 
C 
C 
C 
C PRINT THE LAST LINE 
C 
220   CONTINUE
      IF(.NOT. LEVBRK  .OR.   NTST .EQ. 0) GOTO 221 
      CALL PRTLN(CS,COLLIM,V,HDFLG) 
      IF(BREAK) GOTO 240
C 
C 
C 
C 
C 
C 
C 
C ZERO OUT THE NECESSARY TOTALS AND COUNTS
C 
221   CONTINUE
      DO 225 I = 1,R3 
      N = SS(1,I) 
      IF( N .LT. 30) GOTO 225 
      IF(N .GT. 39) GOTO 230
C 
C THIS IS A GROUP STATEMENT, SEE IF THERE WAS A LEVEL BREAK 
C 
      N = N-30
      IF(L(N) .NE. 0) GOTO 225
C 
C GET THE INDEX INTO THE LIST ARRAY 
C 
      LNDX = SS(7,I)
      IF(LNDX .EQ. 0) GOTO 225
C 
C FIND THE ENTRY IN THE U-ARRAY FOR THIS ITEM 
C 
      DO 223 I2 = 1,5 
      IF(U(1,I2) .EQ. LNDX) GOTO 224
223   CONTINUE
      GOTO 225
C 
C ZERO OUT THE TOTALED VALUE AND THE COUNT VALUE
C 
224   CONTINUE
      ATOTAL(N,I2) = 0
      U(N+1,I2) = 0 
225   CONTINUE
C 
C LOAD AND EXECUTE GROUP/DETAIL PROCESSOR 
C 
230   CONTINUE
      SNAM(2) = 2H20
      IF(DCO(RCOUNT,DBLEI(0)))250,260,260 
C 
C BREAK EXIT
C 
240   CONTINUE
      CALL ERIO(2,ITTY,ERR2,8)
C 
C ERROR EXIT
C 
250   CONTINUE
      SNAM(2) = 2H
C 
C SEGMENT LOAD
C 
260   CONTINUE
      CALL LOAD(SNAM) 
      END 
                  