FTN SUBROUTINE LVCHK(INDX,STRNG,LEN),92069-16061 REV.1912 781025 INTEGER INDX,STRNG(66),LEN 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-18104 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C LVCHK CHECKS TO SEE IF THERE IS A LEVEL BREAK, AND SETS THE L-ARRAY C ACCORDINGLY. C C CALLING SEQUENCE: C C CALL LVCHK(INDX,STRNG,LEN) C C WHERE: C C INDX C IS THE INDEX INTO THE T-ARRAY AND L-ARRAY C T-ARRAY CONTAINS INDEX INTO THE LIST-ARRAY C L-ARRAY INDICATES LEVEL BREAKS C -1 INDICATES NO BREAK C 0 INDICATES BREAK C LIST-ARRAY CONTAINS GOOD INFORMATION ABOUT THE C DBMS BUFFER, (ITEM NUMBER, ITEM TYPE, ITEM C LENGTH, # ELEMENTS, OFFSET INTO DBMS BUFFER, C A FLAG INDICATING WHETHER IT IS A SORT ITEM OR NOT) C C C C STRNG C IS THE BUFFER IN WHICH THE CURRENT LEVEL'S STRING C IS PLACED. C C LEN C IS THE LEVELS CURRENT LENGTH C C ON EXIT: C C STRNG - CONTAINS CURRENT LEVEL BREAK STRING C LEN - CONTAINS LENGTH OF CURRENT STRING C L-ARRAY ENTRY IS SET TO ZERO IF THE STRING CHANGED C C C INTEGER DS(66),LDS 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 C C BEGIN C C T(N) IS EQUAL TO -1 WHEN THERE ARE NO MORE LEVELS C IF(T(INDX) .EQ. -1) GOTO 20 C C CONVERT THE ITEM TO ASCII C NOTE: THAT A ZERO IS BEING SENT AS AN EDIT MASK C THIS WILL INSURE THAT ALL INTEGERS COME BACK C WITH THEIR SIGN ON THE LEFT HAND SIDE. C THIS IS OK SINCE THE LEVEL STRINGS NEVER GET C PRINTED. AS A MATTER OF FACT LEVEL STRINGS ARE C ASSOCIATED WITH SORT LEVELS AND SORT LEVELS DO C NOT NECESSARILY GET PRINTED. C C CALL FIELD(LIST,T(INDX),0,IBUFF,DS,LDS) IF(LDS .NE. LEN) GOTO 10 IF(JSCOM(DS,1,LDS,STRNG,1) .EQ. 0) GOTO 20 C C A LEVEL BREAK HAS OCCURED C 10 CONTINUE LEN = LDS CALL SMOVE(DS,1,LDS,STRNG,1) L(INDX) = 0 C C EXIT C 20 CONTINUE RETURN END