FTN SUBROUTINE PHDRI(STRNG),92069-16061 REV.1912 790208 C 1/2 (AUDREY) QUIT USING L AS A VARIABLE, USE LENTH INSTEAD. INTEGER STRNG(66) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18111 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 C C C C C C C C C C C C C C C C C C C C C C ABSTRACT: C C PHDRI PRINTS THE HEADER LINES C C CALLING SEQUENCE: C C CALL PHRDI(STRNG) C C WHERE: C C STRNG C IS THE BUFFER USED TO HOLD THE HEADER LINE C C C C C LOGICAL HDFLG INTEGER LEVN,N INTEGER INUM(3) INTEGER V2(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 HDFLG/.TRUE./ C C BEGIN C LNCNT = 0 LEVN = 0 C C PICK OUT THE HEADER COMMANDS C DO 50 I = 1,R3 N = SS(1,I) IF(N .LT. 21) GOTO 50 IF( N .GT. 29) GOTO 60 IF( LEVN .EQ. 0 .OR. LEVN .EQ. N) GOTO 5 CALL HDLN(STRNG,COLLIM,V2,HDFLG) C C IF THIS IS A LITERAL THEN BUFFER IT C 5 CONTINUE LEVN = N IF(SS(3,I) .EQ. 0) GOTO 10 CALL BUFLN(I,V2,STRNG) GOTO 50 C C IS ARE PAGE NUMBERS REQUESTED C 10 CONTINUE IF (SS(2,I) .EQ. 0) GOTO 50 CALL CITA(PAGCNT,INUM) LENTH = 5 C C C DO 20 I2 = 2,6 CALL SGET(INUM,I2,ICHAR) IF(ICHAR .NE. 60B) GOTO 30 LENTH = LENTH-1 20 CONTINUE C C C 30 CONTINUE ITMP = SS(4,I) ISTRT = ITMP-LENTH+1 IF(ISTRT .GT. 0) GOTO 35 ISTRT = 1 I2 = LENTH - ITMP + 1 LENTH = ITMP C C PUT THE PAGE NO. IN THE PRINT LINE C 35 CONTINUE CALL SMOVE(INUM,I2,I2 + LENTH -1,STRNG, ISTRT) CALL SPLIT(SS(5,I),SS(6,I),V2) C C C 50 CONTINUE 60 CONTINUE IF(LEVN .NE.0) CALL HDLN(STRNG,COLLIM,V2,HDFLG) RETURN END