FTN SUBROUTINE BUFLN(INDX,VOPT,STRNG),92069-16061 REV.1912 781025 INTEGER VOPT(8),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-18110 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C BUFLN BUFFERS A ITEM VALUE INTO A PRINT LINE ACCORDING C TO INFORMATION IN THE SS-ARRAY. THE V-ARRAY WILL BE C MODIFIED TO CONTAIN THE NECESSARY INFORMATION FOR SKIPPING C LINES AND PAGES. C C CALLING SEQUENCE: C C CALL BUFLN(INDX,VOPT,STRNG) C C WHERE: C C INDX IS THE INDEX INTO THE SS-ARRAY C C VOPT C IS THE BUFFER CONTAINING THE SPLIT APART PRINT OPTIONS C C STRNG C IS THE STRING TO WHICH THE FIELD IS BUFFERED C C ON EXIT: C C VOPT-ARRAY CONTAINS INFORMATION FOR PRINT OPTIONS C C STRNG CONTAINS THE ASCII VALUE OF THE ITEM C C C C C C C C C INTEGER DS(66) INTEGER LEN,JBEG,ISTRT,R 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 R/122B/ C C C C C C C C BEGIN C C C PUT THE PRINT OPTIONS IN THE VOPT-ARRAY C CALL SPLIT( SS(5,INDX), SS(6,INDX), VOPT) C C CHECK WHETHER LITERAL OR ITEM VALUE C I = SS(3,INDX) IF (I .EQ. 0) GOTO 10 C C THIS IS A LITERAL VALUE C CALL LIT(I,DS,LEN) GOTO 20 C C PROCESS ITEM VALUE C C GET THE ASCII VALUE IN THE DS STRING C 10 CONTINUE LNDX = SS(7,INDX) IF(SS(2,INDX) .EQ. 0) GOTO 40 CALL FIELD (LIST,LNDX,VOPT(6),IBUFF,DS,LEN) C C IS THERE AN EDIT MASK? C IF(VOPT(6) .EQ. 0 .OR. LIST(LNDX,2) .EQ. R ) GOTO 20 CALL EDIT(VOPT(6),DS,LEN) C C FIND THE START COLUMN FOR THE STRING C 20 CONTINUE I = SS(4,INDX) JBEG = 1 ISTRT = I - LEN + 1 IF (ISTRT .GT. 0) GOTO 30 ISTRT = 1 JBEG = LEN - I + 1 LEN = I C C PUT THE STRING IN THE PRINT STRING C 30 CONTINUE CALL SMOVE(DS,JBEG,LEN,STRNG,ISTRT) C C EXIT C 40 CONTINUE RETURN END