FTN4    
      PROGRAM QS12(5,90),92063-16012 REV. 1940 771027 
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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     LISTING:   92063-19012
C     SOURCE:    92063-18012
C     RELOC:     92063-16012
C 
C 
C************************************************************ 
C 
C  REPORT GENERATION MODULE #3
C 
C     THIS MODULES PROCESSES
C     TOTAL REPORT STATEMENTS 
C 
C 
C  REPORT GERERATION IS MADE UP OF THREE MODULES: 
C  1) QS06 - INITIALIZATION 
C  2) QS15 - CONTROL BREAKS AND GROUP/DETAILS 
C  3) QS12 - TOTALS 
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    DETAIL STATEMENT
C         60-69 EDIT MASKS
C 
C     2. DATA-ITEM NUMBER 
C 
C     3. LITERAL POINTER TO QSKIB.  QSKIB IS A DISC TRAK
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 
      COMMON ITTY,ILP,IDCB(144),JDCB(144) 
      COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM
      COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN 
      COMMON IPFLAG 
      COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 
      COMMON R6 
      COMMON V
      COMMON STRA 
      COMMON STRC 
      COMMON STRD 
      COMMON P1,P2
      COMMON J1 
      COMMON ISORT(256) 
      COMMON T,U
      COMMON STRE,STRF,STRG,STRH,STRI 
      COMMON L,ATOTAL 
      COMMON ISELD,IRSE,IPTR
      COMMON RCOUNT,N 
C 
      INTEGER DBNAM(3),DSNAM(3),DINAM(3)
      INTEGER SELECT(3),SNAM(3) 
      INTEGER DSNUM,DINUM 
      DIMENSION IMA(36),IB(349) 
      INTEGER V(8)
      INTEGER T(5)
      INTEGER U(7,5)
      INTEGER R3,S(6,100),R5,TRKNM
      INTEGER R6
      INTEGER STRA(37)
      INTEGER STRC(67)
      INTEGER STRD(37)
      INTEGER STRE(37)
      INTEGER STRF(37)
      INTEGER STRG(37)
      INTEGER STRH(37)
      INTEGER STRI(37)
      INTEGER AS(36)
      INTEGER CS(66)
      INTEGER DS(36)
      INTEGER ES(36)
      INTEGER FS(36)
      INTEGER GS(36)
      INTEGER HS(36)
      INTEGER IS(36)
      INTEGER P1,P2 
      DIMENSION L(6)
      INTEGER ATOTAL(60,5)
      DIMENSION ISELD(128)
      INTEGER RCOUNT
C 
      EQUIVALENCE (STRA(1),LAS), (STRA(2),AS) 
      EQUIVALENCE (STRC(1),LCS), (STRC(2),CS) 
      EQUIVALENCE (STRD(1),LDS), (STRD(2),DS) 
      EQUIVALENCE (STRE(1),LES), (STRE(2),ES) 
      EQUIVALENCE (STRF(1),LFS), (STRF(2),FS) 
      EQUIVALENCE (STRG(1),LGS), (STRG(2),GS) 
      EQUIVALENCE (STRH(1),LHS), (STRH(2),HS) 
      EQUIVALENCE (STRI(1),LIS), (STRI(2),IS) 
C 
C     T ARRAY IS USED TO HOLD SORT FIELDS 
C 
C     U ARRAY IS USED 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*6)*5 IN ASCII 
C 
C     N 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 
C  TOTAL
C 
 1070 J3 = 0
      DO 1390 J1=1,R3 
      IF(S(1,J1).LT.30) GOTO 1390 
      IF(S(1,J1).GT.40) GOTO 1400 
      J2 = S(1,J1) - 10*(S(1,J1)/10)
      IF (L(J2).NE.0) GO TO 1390
      IF (J2.EQ.J3) GO TO 1200
      IF (J3.EQ.0) GO TO 1190 
C  LINE SPACING AND SKIPPING BEFORE PRINTING
      CALL CSBP 
      DO 1072 I=LCS,1,-1
      CALL SGET(CS,I,ICHAR) 
      IF(ICHAR.NE.40B) GOTO 1074
 1072 CONTINUE
      GOTO 1076 
 1074 CALL REIO(2,ILP,CS,-I)
      P2=P2+1 
      IF (IFBRK(IDUM).NE.0) GOTO 1470 
 1076 CONTINUE
C  LINE SPACING AND SKIPPING AFTER PRINTING 
      CALL CSAP 
 1190 J3 = J2 
 1200 IF (S(2,J1).NE.0) GO TO 1230
C  BUFFER PART OF LINE
 1220 CALL BUFLN
      GO TO 1390
C  SPLIT APART REPORT OPTIONS (INTO "V")
 1230 CALL SPLIT
      DO 1260 J4=1,5
      IF(S(2,J1).EQ.IABS(U(1,J4))) GO TO 1270 
 1260 CONTINUE
      GO TO 1390
C 
 1270 IF (V(5).EQ.0) GO TO 1300 
C 
C  ADD
      J5 = (J2-1)*10 + 1
      KBEG = 1
      KEND = 20 
      DO 1280 IX=KBEG,KEND
C SCAN FIELD AND SUSPRESS LEADING ZERO'S
      CALL SGET(ATOTAL(J5,J4),IX,ICHAR) 
      IF(ICHAR.NE.60B) GOTO 1290
 1280 CONTINUE
C FIELD IS ALL ZERO'S - SET LENGTH TO 1 
      IX = KEND - 1 
 1290 KBEG = IX 
      LDS = KEND-KBEG+1 
      CALL SMOVE(ATOTAL(J5,J4),KBEG,KEND,DS,1)
      V(5) = 0
      GO TO 1340
C 
 1300 IF (V(7).EQ.0) GO TO 1330 
C 
C  COUNT
      J8 = U(J2+1,J4) 
      CALL CITA(J8,DS)
      DO 1310 I=2,5 
      CALL SGET(DS,I,ICHAR) 
      IF(ICHAR.NE.60B) GOTO 1320
 1310 CONTINUE
 1320 LDS = 7 - I 
      CALL SMOVE(DS,I,6,DS,1) 
      V(7) = 0
      GO TO 1340
C 
 1330 CONTINUE
C 
C  AVERAGE
      IF(V(8).EQ.0) GO TO 1220
      J8 = U(J2+1,J4) 
      IF(J8.LE.0) GOTO 1336 
      CALL CITA(J8,DS)
C  SUPPRESS LEADING ZERO'S FROM DIVISOR 
      DO 1332 I=2,5 
      CALL SGET(DS,I,ICHAR) 
      IF(ICHAR.NE.60B) GOTO 1335
 1332 CONTINUE
 1335 JBEG = I
      LDS = 6 
      DO 1331 I=1,26
 1331 IMA(I) = 2H00 
      J5 = (J2-1)*10 + 1
      DO 1333 I=27,36 
C  MOVE ATOTAL(J5,J4) TO RH END OF IMA
      IMA(I) = ATOTAL(J5,J4)
 1333 J5 = J5 + 1 
C  SUPPRESS LEADING ZERO'S
      KBEG = 52 
      KEND = 72 
      DO 1334 IX=KBEG,KEND
      CALL SGET(IMA,IX,ICHAR) 
      IF(ICHAR.NE.60B) GOTO 1337
 1334 CONTINUE
 1336 CONTINUE
      DS = 2H00 
      JBEG = 1
      LDS = 2 
      GO TO 1339
 1337 CONTINUE
      KBEG = IX 
      JEND = LDS
      IERR = 0
      CALL SDIV(DS,JBEG,JEND,IMA,KBEG,KEND,IERR)
C  IF ERROR FROM SDIV - DIVISOR > QUOTIENT
      IF(IERR) 1336,1338,1336 
 1338 CONTINUE
      LDS = JEND-JBEG+1 
      JBEG = KBEG - LDS 
      JEND = KEND - LDS 
      LDS = JEND - JBEG + 1 
      CALL SMOVE(IMA,JBEG,JEND,DS,1)
 1339 V(8) = 0
C 
 1340 CONTINUE
      JBEG = 1
      IF (V(6).EQ.0) GO TO 1370 
C 
C  EDIT RETURNS EDITED FIELD IN DS
C 
      CALL EDIT 
 1370 LEN = S(4,J1) - LDS + 1 
      IF(LEN.GT.0) GOTO 1380
      LEN = 1 
      JBEG = LDS - S(4,J1) + 1
 1380 CALL SMOVE(DS,JBEG,LDS,CS,LEN)
 1390 CONTINUE
C 
 1400 CONTINUE
      DO 1404 I=LCS,1,-1
      CALL SGET(CS,I,ICHAR) 
      IF (ICHAR.NE.40B) GO TO 1410
 1404 CONTINUE
      GOTO 1420 
 1410 CONTINUE
C  LINE SPACING AND SKIPPING BEFORE PRINTING
      CALL CSBP 
      CALL REIO(2,ILP,CS,-I)
      P2=P2+1 
      IF (IFBRK(IDUM).NE.0) GOTO 1470 
C  LINE SPACING AND SKIPPING AFTER PRINTING 
      CALL CSAP 
 1420 CONTINUE
C 
C  CLEAR COUNT AND TOTAL FIELDS 
      IF(L(6).EQ.0) GOTO 1470 
      DO 1460 J1=1,R3 
      IF(S(1,J1).LT.30) GOTO 1460 
      IF(S(1,J1).GT.40) GOTO 780
      J2 = S(1,J1) - 10*(S(1,J1)/10)
      IF(L(J2).NE.0) GOTO 1460
      DO 1430 J4=1,5
      IF(S(2,J1).EQ.IABS(U(1,J4))) GO TO 1440 
 1430 CONTINUE
      GOTO 1460 
 1440 CONTINUE
C  ZERO COUNT 
      U(J2+1,J4) = 0
C  ZERO TOTAL 
      J5 = (J2-1)*10 + 1
      DO 1450 I=J5,J5+9 
 1450 ATOTAL(I,J4) = 2H00 
 1460 CONTINUE
C 
C  LOAD QS15 MODULE FOR GROUP/DETAIL
C 
  780 SNAM(2) = 2H15
      GOTO 1475 
C 
C  RETURN TO MAIN MODULE (QS) 
C 
 1470 CONTINUE
      SNAM(2) = 2H
 1475 CONTINUE
      CALL EXEC(8,SNAM) 
      END 
$ 
                                                                                                                        