FTN4
      PROGRAM QY06(5,90),92069-16060 REV.1912 790111
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-18069
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  REPORT GENERATION MODULE #1
C 
C     THIS IS THE INITIALIZATION MODULE 
C 
C 
C  REPORT GENERATION IS MADE UP OF THREE MODULES: 
C  1) QS06 - INITIALIZATION 
C  2) QS15 - CONTROL BREAKS AND GROUP/DETAILS 
C  3) QS12 - TOTALS 
C  4) QS20 - GROUPS/DETAILS 
C 
C  THE PURPOSE OF THESE MODULES IS TO 
C  GENERATE A REPORT BASED ON THE S TABLE.
C  IT IS ASSUMED THAT ALL LOGIC AND SYNTAX
C  ERRORS HAVE BEEN CORRECTED.
C 
C  REPORT TABLE FORMAT IN ARRAY S(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  = 0 IMPLIES EDIT LEVEL 0
C                       1 IMPLIES ZERO SUPRESS
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     T ARRAY IS USED TO HOLD 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 
C 
C 
      LOGICAL IFTTY 
      INTEGER CS(66)
      INTEGER ERR1(8) 
      INTEGER ERR2(12)
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 I,2HLL,2HEG,2HAL,2H L,2HU ,2HLO,2HCK,
     &    2H R,2HEQ,2HUE,2HST/
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C LOCK THE LIST LU
C 
      CALL LUREQ(RMOTE,1,ILP,IERR)
      IF(IERR .NE. 0) GOTO 7010 
      CALL TOPAG(RMOTE,ILP,IERR)
C 
C INITIALIZE THE RECORD COUNT 
C 
1     CONTINUE
      RCOUNT = RRCNT
C 
C 
C 
C 
C 
C 
      DO 2 J=1,5
      DO 2 I=1,6
2     ATOTAL(I,J) = 0 
C 
C 
C 
C 
C     CHECK IF "PAGENO" EXISTS AMONG HEADERS
C 
      PAGCNT = -1 
      DO 160 J=1,R3 
      IF (SS(1,J).LT.20) GO TO 160
      IF (SS(1,J).GT.30) GO TO 170
      IF (SS(2,J).EQ.0) GO TO 160 
      PAGCNT = 1
160   CONTINUE
C 
C 
C 
170   DO 171 J=1,5
      T(J) = -1 
      U(1,J) = 0
      DO 171 I=2,7
      U(I,J) = 0
  171 CONTINUE
C 
C     INITIALIZE STRINGS TO NULL
C 
      DO 200 I = 1,5
      LEVLEN(I) = 0 
200   CONTINUE
C 
C  PUT SORT LIST-ARRAY OFFSET IN "T"
C 
      R5 = 0
      DO 330 J=1,R3 
      I = SS(1,J) 
      IF (I.GT.20) GO TO 240
      IF (I.EQ.10) GO TO 330
      N = I - 10
      T(N) = SS(7,J)
      GO TO 330 
  240 IF (I.GT.40) GO TO 335
      IF (I.LT.30) GO TO 330
      IF (SS(7,J).EQ.0)  GO TO 330
C 
C  PUT TOTAL LIST-ARRAY OFFSET IN "U" 
C 
      IDATA = SS(7,J) 
      DO 310 J1=1,5 
      I = U(1,J1) 
      IF(I.EQ.0) GO TO 320
      IF(I.EQ.IDATA) GO TO 330
  310 CONTINUE
C 
C INTERNAL ERROR
C 
      CALL ERIO(2,ITTY,ERR1,8)
      GOTO 330
C 
C 
C 
320   CONTINUE
      U(1,J1) = IDATA 
C 
C END OF LOOP 
C 
330   CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
C     L(7) IS A SWITCH WHICH IS SET TO NOT RECOGNIZE
C     A CONTROL BREAK ON FIRST DETAIL RECORD READ 
C     (TOTAL PRINTING SUPPRESSION). 
C 
C     L(1) TO L(5) ARE RESET WHEN A CONTROL BREAK 
C     OCCURS AT THAT LEVEL. 
C     L(6) IS RESET WHEN THE LAST RECORD
C     IS ENCOUNTERED. 
C 
335   CONTINUE
      DO 340 I = 1,7
      L(I) = -1 
340   CONTINUE
C 
C  READ QSKIB INTO 'IB' 
C 
      CALL EXEC(1,IDILU,IB,-R6,TRKNM,0) 
C 
C INITIALIZE PROPER COUNTERS
C 
      LNCNT = 0 
      CALL SFILL(CS,1,COLLIM,40B) 
      CALL PHDRI(CS)
C 
C INITIALIZE SELT BUFFER
C 
      RCOUNT = RRCNT
      RSEC = DBLEI(1) 
      CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) 
      IF(ISTAT .GE. 0) GOTO 350 
      CALL FMERR(ISTAT,ITTY)
      SNAM(2) = 2H
      GOTO 360
C 
C 
C 
350   CONTINUE
      RSEC = DIN(RSEC)
      IPTR = 9
C 
C  LOAD REPORT MODULE QS15
C 
      SNAM(2) = 2H15
360   CALL LOAD(SNAM) 
C 
C 
C 
C ILLEGAL LU LOCK REQUEST 
C 
C 
7010  CONTINUE
      CALL ERIO(2,ITTY,ERR2,12) 
      SNAM(2) = 2H
      GOTO 360
      END 
$ 
                                                                              