FTN4
      PROGRAM QY04(5,90),92069-16060 REV.2026 800507
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-18067
C     RELOC:     92069-16060
C 
C     ALTERED:   FEBRUARY 21, 1980 TO INCREASE SIZE OF X - CEJ
C 
C 
C************************************************************ 
C 
C 
C     THIS PROGRAM PERFORMS ALL THE LOGIC 
C     CHECKING FOR REPORT PROCEDURE 
C 
C 
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. OFFSET INTO LIST-ARRAY  (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 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
      INTEGER X(7),Q(255),R5
      INTEGER XASCII
      INTEGER R 
      INTEGER INFO(13)
      INTEGER ISTAT(10) 
      INTEGER ERR1(19)
      INTEGER ERR2(23)
      INTEGER ERR3(14)
      INTEGER ERR4(13)
      INTEGER ERR5(25)
      INTEGER ERR6(22)
      INTEGER ERR7(17)
      INTEGER ERR8(20)
      INTEGER ERR9(21)
      INTEGER ERR10(14) 
      INTEGER ERR11(18) 
      INTEGER ERR12(13) 
      INTEGER ERROR(8)
C 
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 
C SORT LEVEL XX IS MISSING OR DUPLICATED
      DATA ERR1/2H S,2HOR,2HT ,2HLE,2HVE, 
     1 2HL ,2HXX,2H I,2HS ,2HMI,2HSS,2HIN,
     2 2HG ,2HOR,2H D,2HUP,2HLI,2HCA,2HTE/
C DUPLICATE DATA ITEM NAMES IN SORT STATEMENTS
      DATA ERR2/2H D,2HUP,2HLI,2HCA,2HTE,2H D,
     1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HES,
     2 2H I,2HN ,2HSO,2HRT,2H S,2HTA,2HTE,2HME,2HNT,2HS / 
C CONTROL BREAK INCONSISTENCY 
      DATA ERR3/2H C,2HON,2HTR,2HOL,2H B,2HRE,
     1 2HAK,2H I,2HNC,2HON,2HSI,2HST,2HEN,2HCY/ 
C DUPLICATE EDIT STATEMENTS 
      DATA ERR4/2H D,2HUP,2HLI,2HCA,2HTE,2H E,
     1 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/
C INCONSISTENCY BETWEEN OPTIONS AND EDIT STATEMENTS 
      DATA ERR5/2H I,2HNC,2HON,2HSI,
     1 2HST,2HEN,2HCY,2H B,2HET,2HWE,2HEN,
     2 2H O,2HPT,2HIO,2HNS,2H A,2HND,2H E,
     3 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/
C SAME LINES HAVE CONFLICTING REPORT OPTIONS
      DATA ERR6/2H S,2HAM,2HE ,2HLI,2HNE,2HS ,
     1 2HHA,2HVE,2H C,2HON,2HFL,2HIC,2HTI,2HNG, 
     2 2H R,2HEP,2HOR,2HT ,2HOP,2HTI,2HON,2HS / 
C CONSTANT LITERAL AS EDIT OPTION 
      DATA ERR7/2H C,2HON,2HST,2HAN,2HT , 
     1 2HLI,2HTE,2HRA,2HL ,2HHA,2HS , 
     2 2HED,2HIT,2H O,2HPT,2HIO,2HN / 
C MORE THAN 5 FIELDS ARE BEING SORTED ON
      DATA ERR8/2H M,2HOR,2HE ,2HTH,2HAN,2H 5,
     1 2H F,2HIE,2HLD,2HS ,2HAR,2HE ,2HBE,
     2 2HIN,2HG ,2HTO,2HTA,2HLE,2HD ,2HON/
C REPORT CAN NOT BE GENERATED DUE TO ERRORS 
      DATA ERR9/2H R,2HEP,2HOR,2HT ,2HCA,2HNN,
     1 2HOT,2H B,2HE ,2HGE,2HNE,2HRA,2HTE,2HD , 
     2 2HDU,2HE ,2HTO,2H E,2HRR,2HOR,2HS /
C DETAIL LEVEL XX IS MISSING
      DATA ERR10/2H D,2HET,2HAI,2HL ,2HLE,2HVE,2HL ,2HXX,2H I,2HS , 
     &     2HMI,2HSS,2HIN,2HG / 
C CAN NOT ADD OR AVERAGE ASCII VALUES 
      DATA ERR11/2H C,2HAN,2H N,2HOT,2H A,2HDD,2H O,2HR ,2HAV,2HER, 
     &     2HAG,2HE ,2HAS,2HCI,2HI ,2HVA,2HLU,2HES/ 
C ERROR NO. XXXXXX
      DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ 
C CAN NOT EDIT REAL VALUES
      DATA ERR12/2H C,2HAN,2H N,2HOT,2H E,2HDI,2HT ,2HRE,2HAL,
     &   2H V,2HAL,2HUE,2HS / 
C 
      DATA XASCII/130B/ 
      DATA R/122B/
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C CLEAR ERROR INDICATOR 
C 
      IE = 0
C 
C     SORT ARRAY SS(7 * 100) BY REPORT STATEMENT
C     INDEX AND END PRINT POSITION
C 
      IF(R3.EQ.1) GOTO 65 
      DO 60 N = 1,R3-1
      DO 50 I = N+1,R3
      DO 10 J=1,7 
      X(J) = SS(J,N)
   10 CONTINUE
      IF (X(1) - SS(1,I)) 50,20,30
   20 IF (X(4) - SS(4,I)) 50,50,30
   30 DO 40 J=1,7 
      SS(J,N) = SS(J,I) 
      SS(J,I) = X(J)
      X(J)   = SS(J,N)
   40 CONTINUE
   50 CONTINUE
   60 CONTINUE
C 
C     CHECK TO SEE IF SORT LEVELS ARE 
C       1) CONTIGUOUS,
C       2) ONLY ONE STATEMENT APPEARS FOR 
C          A NON-EMPTY SORT LEVEL, AND
C       3) DATA ITEM NAMES DISTINCT 
C 
   65 R5 = 0
      N = 11
      DO 70 I=1,255 
      Q(I) = 0
   70 CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
      DO 78 I=1,R3
C 
C PROCESS SORT LEVELS (10 - 15) 
C 
      IF(SS(1,I).GT.15) GO TO 80
C 
C MORE THAN ONE SORT STATEMENT WITHOUT A LEVEL
C IS ALLOWED. ALL SORT STATEMENTS WITH LEVELS MUST BE UNIQUE
C 
      IF (SS(1,I).EQ.10) GO TO 74 
      IF (SS(1,I).EQ.N) GO TO 72
      IN = N - 10 
C 
C  ERROR - SORT LEVEL MISSING OR DUPLICATE
C 
      CALL CITA(IN,IMA) 
      ERR1(7) = IMA(3)
      CALL QRIO(2,ITTY,ERR1,19) 
      IE = 1
      N = SS(1,I) 
C 
C INDICATE NEXT EXPECTED LEVEL IN N 
C 
   72 N = N + 1 
C 
C BE SURE THIS ITEM HAS NOT ALREADY BEEN USED AS A SORT ITEM
C 
   74 J = SS(2,I) 
      IF (Q(J).EQ.0) GO TO 76 
C  ERROR - DUPLICATE DATA ITEM NAMES
      CALL QRIO(2,ITTY,ERR2,23) 
      IE = 1
   76 Q(J) = 1
C 
C COUNT SORT STATEMENTS IN R5 
C 
      R5 = R5 + 1 
   78 CONTINUE
C 
C 
C 
C 
C 
C 
C     CHECK FOR A MATCH BETWEEN SORT LEVELS,
C     GROUPS, AND TOTALS (OTHER THAN FINAL) 
C 
   80 N = N - 11
      DO 85 I=1,R3
C 
C PICK OFF SORT AND HEADING STATEMENTS
C 
      IF (SS(1,I).LT.30) GO TO 85 
C 
C PICK OFF DETAIL AND EDIT STATEMENTS 
C 
      IF (SS(1,I).GT.45) GO TO 90 
C 
C  PROCESS TOTAL AND GROUP STATEMENTS 
C 
      J = SS(1,I) - SS(1,I)/10 * 10 
      IF (J.EQ.6) GO TO 85
      IF (J.LE.N) GO TO 85
C  ERROR - CONTROL BREAK INCONSISTENCY
      CALL QRIO(2,ITTY,ERR3,14) 
      IE = 1
   85 CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C     CHECK THAT EDIT MASKS ARE SEPARATE AND
C     DISTINCT, AND THAT EDIT MASKS SPECIFIED 
C     IN A DETAIL, GROUP, OR TOTAL STATEMENT
C     APPEAR AS REPORT STATEMENTS 
C 
   90 DO 91 I=1,255 
      Q(I) = 0
   91 CONTINUE
C 
C 
C 
      DO 95 I=1,R3
C 
C SKIP OVER SORT AND HEADING STATEMENTS 
C 
      IF (SS(1,I).LT.30) GO TO 95 
C 
C PICK OFF TOTAL, GROUP, AND DETAIL STATEMENTS
C 
      IF (SS(1,I).GT.59) GO TO 94 
      J = SS(6,I) - SS(6,I)/100 * 100 
      IF (J .LT. 60) GOTO 95
      N = J - 59
      Q(N) = J
      GOTO 95 
C 
C PROCESS EDIT STATEMENTS VERIFYING UNIQUE EDIT LEVELS
C 
94    IF (SS(1,I).NE.Q(11))GO TO 92 
C  ERROR - DUPLICATE EDIT STATEMENTS
      CALL QRIO(2,ITTY,ERR4,13) 
      IE = 1
   92 Q(11) = SS(1,I) 
      DO 93 J=1,10
      IF (Q(11).NE.Q(J))GO TO 93
      Q(J) = 0
      GO TO 95
93    CONTINUE
C 
C EDIT STATEMENT IS NOT USED
C 
      GO TO 97
   95 CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
C VERIFY EACH EDIT STATEMENT WAS USED 
C 
      DO 96 I=1,10
      IF (Q(I).NE.0) GO TO 97 
   96 CONTINUE
      GO TO 100 
C 
C  ERROR - INCONSISTENCY BETWEEN OPTION AND EDIT STATEMENTS 
C 
   97 CALL QRIO(2,ITTY,ERR5,25) 
      IE = 1
C 
C 
C 
C 
C 
C VERIFY DETAIL STATEMENTS IN ORDER 
C 
100   CONTINUE
      N = 51
      DO 320 I =1,R3
      NLEV = SS(1,I)
C 
C PICK OUT DETAIL STATEMENTS
C 
      IF(NLEV .LT. 51) GOTO 320 
      IF(NLEV .GT. 59) GOTO 330 
C 
C VERIFY THIS STATEMENT IS IN ORDER 
C 
      IF(N .EQ. NLEV  .OR.  N+1 .EQ. NLEV) GOTO 300 
      CALL CITA(N+1-50,IMA) 
      ERR10(8) = IMA(3) 
      CALL QRIO(2,ITTY,ERR10,14)
      IE = -1 
C 
C SET N TO CURRENT LEVEL
C 
300   CONTINUE
      N = NLEV
320   CONTINUE
C 
C 
C 
C 
C 
C     CHECK THAT THE SAME LINES DO NOT HAVE 
C     DUPLICATE REPORT OPTIONS (SAME LINES
C     OR ALSO WHERE ALL GROUPS AND DETAILS
C     WOULD CONFLICT OR TOTALS AT THE SAME
C     LEVEL WOULD CONFLICT).
C 
C     NOTE: 
C        1.  EDIT STATEMENTS MAY BE IN CONFLICT 
C        ON THE SAME LINE SINCE THEY APPLY TO 
C        DIFFERENT FIELDS.
C 
C        2.  CONSTANT LITERALS AND EDIT MASKS 
C        CANNOT APPEAR IN THE SAME STATEMENT. 
C 
330   CONTINUE
      N = 0 
      DO 335 I = 1,10 
335   Q(I) = 0
C 
C 
C 
C 
      DO 118 J=1,R3 
C 
C SKIP OVER SORT, AND EDIT STATEMENTS 
C 
      NLEV = SS(1,J)
      IF (NLEV.LT.20 .OR. NLEV.GT.59) GO TO 118 
C 
C PICK OFF TOTAL, GROUP,DETAIL, AND HEADING STATEMENTS
C 
      IF (NLEV.EQ.N) GO TO 104
C 
C GROUP BREAKS AND D[NULL] STATEMENTS MUST HAVE COMPATIBLE PRINT
C OPTIONS.  DO NOT INTIALIZE THE Q ARRAY BETWEEN PROCESSING.
C BUT DO INITIALIZE THE Q ARRAY THE FIRST TIME A STATEMENT IS 
C A GROUP BREAK OR A D[NULL]. 
C 
      IF ((NLEV.GT.40).AND.(NLEV .LT. 51).AND.(N .GT. 40))GO TO 104 
C 
C 
C   CHECK THAT THERE ARE NO CONFLICTING PRINT OPTIONS ( SKIP BEFORE,
C   SKIP AFTER, ETC.) IN TOTALS.  AFTER TOTALS HAVE BEEN CHECKED SEE
C   THAT GROUPS AND D [NULL] HAVE COMPATIBLE PRINT OPTIONS. 
C 
C   ZERO THE Q-ARRAY FOR EACH NEW LEVEL OF HEADR, TOTAL, AND
C   FOR THE FIRST GROUP BREAK.  CLEAR Q(5) FOR EACH NEW STATEMENT 
C   REGUARDLESS OF THE LEVEL. Q(5) IS A FLAG THAT INDICATES THAT
C   A TOTAL OPTION (ADD,COUNT, OR AVERAGE) HAS ALREADY BEEN 
C   SELECTED FOR THIS STATEMENT.  NO TOTAL STATEMENT CAN REQUEST
C   MORE THAN ONE OPTION BUT ALL OPTIONS CAN BE CHOOSEN AT ANY
C   PARTICULIAR LEVEL OF TOTAL STATEMENTS.
C 
C 
C 
      DO 102 I=1,10 
      Q(I) = 0
  102 CONTINUE
C 
C 
104   CONTINUE
      N = NLEV
      Q(5) = 0
C 
C 
C 
C 
C 
      I = SS(5,J) 
      IF (I.EQ.0) GO TO 110 
      DO 108 I4=1,4 
      IF (I.EQ.0) GO TO 110 
      IFAC = 10**I4 
      I7 = I - I/IFAC * IFAC
      I = I - I7
      IF (I7.EQ.0) GO TO 108
      IF (Q(I4).EQ.0) GO TO 106 
C  ERROR - CONFILICTING REPORT OPTIONS
      CALL QRIO(2,ITTY,ERR6,22) 
      IE = 1
  106 Q(I4) =1
  108 CONTINUE
      IF (I .NE. 0) Q(5) = 1
C 
C 
C 
C 
C 
C CHECK THAT TOTALS,GROUPS, AND DETAILS DO NOT HAVE EDIT MASKS
C WITH REAL VALUES. 
C 
110   CONTINUE
      IF(NLEV .LT.30    .OR. NLEV .GT. 59) GOTO 111 
      ITM = SS(2,J) 
      IF(ITM .EQ. 0) GOTO 111 
C 
C IS THERE AN EDIT MASK?
C 
      NN = SS(6,J)
      IF(NN - NN/100*100   .EQ. 0) GOTO 111 
C 
C GET THE ITEM TYPE 
C 
      CALL DBINF(DBNAM,ITM,102,ISTAT,INFO)
      IF(ISTAT .EQ. 0) GOTO 109 
C 
C ERROR - LOAD AND EXECUTE ERROR PROCESSOR
C 
      QSERR = ISTAT 
      SNAM(2) = 2H23
      GOTO 150
C 
C GET THE ITEM TYPE FROM THE BUFFER 
C 
109   CONTINUE
      CALL SGET(INFO,17,ITYPE)
      IF(ITYPE .NE. R) GOTO 111 
C 
C 
C 
C OUTPUT "CAN NOT EDIT REAL VALUES" 
C 
      CALL QRIO(2,ITTY,ERR12,13)
      IE = -1 
C 
C 
C 
C 
C 
C 
C 
C TOTAL, GROUPS, HEADING STATEMENTS 
C   VERIFY THAT EDIT MASKS DON'T EXIST WITH LITERALS
C 
111   CONTINUE
      I3 = SS(6,J)
      IF (I3.EQ.0) GO TO 118
      DO 116 I4=2,3 
      IF (I3.EQ.0) GO TO 118
      IFAC = 10**I4 
      I7 = I3 - I3/IFAC * IFAC
      I3 = I3 - I7
      IF (I7.EQ.0) GO TO 116
C 
C VERIFY THAT A LITERAL DOES NOT HAVE AN EDIT MASK
C 
      IF (I4.NE.2) GO TO 112
      IF (SS(3,J).EQ.0) GO TO 116 
C  ERROR - LITERAL HAS EDIT OPTION
      CALL QRIO(2,ITTY,ERR7,17) 
      IE = 1
      GO TO 116 
C 
C VERIFY THAT THE TOTAL STATEMENT ONLY HAS ONE OF THE 
C ACTION OPTIONS (ADD,AVERAGE, OR COUNT)
C 
C NOTE: 
C 
C   ONLY TOTAL STATEMENTS WILL HAVE THE FLAG SET
C 
  112 IF (Q(5).EQ.0) GO TO 114
C  ERROR - CONFLICTING REPORT OPTIONS 
      CALL QRIO(2,ITTY,ERR6,22) 
      IE = 1
  114 Q(5) = I3 
  116 CONTINUE
      IF ((I3 .EQ. 0) .OR. (Q(5) .EQ. 0)) GOTO 118
      CALL QRIO(2,ITTY,ERR6,22) 
      IE = 1
  118 CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C     CHECK TO SEE THAT NOT MORE THAN 5 
C     FIELDS ARE BEING TOTALED ON.
C     ALSO VERIFY THAT ASCII VALUES ARE 
C     ONLY BEING COUNTED, AND NOT ADDED OR AVERAGED.
C 
C 
C 
C 
C 
      DO 120 I=1,255
      Q(I) = 0
  120 CONTINUE
C 
C 
C 
C 
      DO 122 J=1,R3 
C 
C PICK OFF SORT, AND HEADING STATEMENTS 
C 
      NLEV = SS(1,J)
      IF (NLEV.LT.30) GO TO 122 
C 
C PICK OFF GROUP, DETAIL, AND EDIT STATEMENTS 
C 
      IF (NLEV.GT.40) GO TO 124 
C 
C SET INDICATOR THAT THIS ITEM IS BEING TOTALED ON
C 
      N = SS(2,J) 
      IF (N.EQ.0) GO TO 122 
      Q(N) = 1
C 
C VERFY THAT  ASCII VALUES ARE ONLY BEING COUNTED 
C 
      IF ((SS(5,J)/10000 .EQ. 0) .AND. (SS(6,J)/1000 .EQ. 0)) GOTO 122
      CALL DBINF(DBNAM,N,102,ISTAT,INFO)
      IF(ISTAT .EQ. 0) GOTO 209 
C 
C DBMS ERROR - LOAD AND EXECUTE THE DBMS ERROR HANDLING SEGMENT 
C 
      QSERR = ISTAT 
      SNAM(2) = 2H23
      GOTO 150
C 
C GET THE ITEM TYPE 
C 
209   CALL SGET(INFO,17,ITYPE)
      IF(ITYPE .NE. XASCII) GOTO 122
C 
C OUTPUT "CAN NOT ADD OR AVERAGE ON ASCII VALUES" 
C 
      CALL QRIO(2,ITTY,ERR11,18)
      IE = 1
  122 CONTINUE
C 
C 
C 
C 
C 
C 
C ADD # OF DIFFERENT ITEMS
C 
  124 N = 0 
      DO 126 J=1,255
      IF (Q(J).NE.0) N = N + 1
  126 CONTINUE
      IF (N.LE.5) GO TO 130 
C  ERROR - > 5 FIELDS TOTALED ON
      CALL QRIO(2,ITTY,ERR8,20) 
      IE = 1
C 
C 
C 
C 
C 
C CHECKING COMPLETE - WAS THERE ANY ERRORS
C 
  130 IF (IE.EQ.0) GO TO 140
C  ERROR - NO REPORT GENERATED
      CALL ERIO(2,ITTY,ERR9,21) 
C  CALL MAIN PROGRAM (QS) 
C 
135   CONTINUE
      SNAM(2) = 2H
      GO TO 150 
C 
C BUILD THE LIST ARRAY
C 
C    LIST IS A 101 BY 6 ARRAY 
C 
C     THE FIRST ENTRY IS AS FOLLOWS 
C        WORD 1 -  NUMBER OF ENTRIES IN THE ARRAY 
C        WORD 7 -  NUMBER OF SORT ITEMS IN THE ARRAY
C 
C     NOTE: THE SORT ITEMS ARE AT THE TOP OF THE ARRAY
C 
C     THE OTHER ENTRIES LOOK AS FOLLOWS 
C 
C        WORD 1 - ITEM NUMBER 
C        WORD 2 - ITEM TYPE 
C        WORD 3 - ITEM LENGTH IN BYTES
C        WORD 4 - ELEMENT COUNT 
C        WORD 5 - OFF SET INTO RECORD IN BYTES
C        WORD 6 - ITEM NUMBER REPEATED
C 
C    NOTE: THIS ARRAY IS SET UP IN THE ABOVE MANNER SO THAT 
C    COLUMN 1 AND 6 OF THE LIST ARRAY MAY BE USED WHEN MAKING 
C    DBGET CALLS. 
C 
C    THE SORT PROCESSOR AND OTHER PROCESSORS USE THE INFORMATION IN 
C    THE TABLE TO FORMAT THE REPORT IN THE CORRECT MANNER.
C 
140   CONTINUE
      DO 170 I = 1,101
      DO 170 J = 1,6
170   LIST(I,J) = 0 
C 
C BE SURE THERE IS ONLY ONE ENTRY IN THE LIST ARRAY FOR EVERY 
C UNIQUE ITEM.
C 
      IOFF = 1
      LIST = 0
      LIST(1,6) = 0 
C 
C 
C 
      DO 220 I = 1,R3 
      NLEV = SS(1,I)
C 
C BE SURE TO SKIP HEADERS 
C 
      IF(NLEV .GT. 20  .AND.  NLEV .LT. 29) GOTO 220
C 
C DO NOT LOOK AT STATEMENTS THAT DON'T HAVE ITEM NUMBERS
C 
      DINUM = SS(2,I) 
      IF(DINUM .EQ. 0) GOTO 220 
C 
C SEE IF IT ALREADY EXITS IN THE LIST 
C 
      IF(LIST .EQ. 0) GOTO 200
      DO 190 J = 2,LIST +1
      IF (LIST(J,1) .EQ. DINUM) GOTO 180
190   CONTINUE
C 
C 
C 
C PUT ITEM IN LIST ARRAY
C  INCREASE THE COUNT OF ENTRIES IN THE  LIST ARRAY 
C  SET J TO THE INDEX INTO THE LIST ARRAY FOR THAT ENTRY
C 
200   CONTINUE
      LIST = LIST+1 
      J = LIST + 1
      LIST(J,1) = DINUM 
C 
C GET THE ITEM INFORMATION
C 
      CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO)
      IF (ISTAT .EQ. 0) GOTO 210
C 
C DBMS ERROR
C 
      QSERR = ISTAT 
      SNAM(2) = 2H23
      GOTO 150
210   CONTINUE
      CALL SGET(INFO,17,ITYPE)
      LIST(J,2) = ITYPE 
      IF(ITYPE .NE. XASCII) INFO(10) = 2 * INFO(10) 
      LIST(J,3) = INFO(10)
      LIST(J,4) = INFO(11)
      LIST(J,5) = IOFF
      IOFF = IOFF+ INFO(11) * INFO(10)
C 
C IF THIS IS A SORT STATEMENT 
C   INCREASE THE SORT COUNT 
C   PUT THE ITEM NUMBER AS A FLAG INDICATING THAT THIS IS A SORT ITEM 
C 
      IF(SS(1,I) .GT. 15) GOTO 180
      LIST(1,6) = LIST(1,6) + 1 
      LIST(J,6) = DINUM 
C 
C PUT LIST ARRAY OFFSET IN SS-ARRAY 
C 
180   CONTINUE
      SS(7,I) = J 
220   CONTINUE
C 
C 
C 
C 
C 
C 
C 
C  CALL REPORT GENERATOR PROGRAM
C 
      IF(R5 .NE. 0) GOTO 160
      SNAM(2) = 2H06
C 
C 
C 
150   CONTINUE
      CALL LOAD(SNAM) 
C 
C 
C 
C  CALL PRE-SORT
C 
  160 SNAM(2) = 2H05
      GO TO 150 
      END 
$