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 $