FTN SUBROUTINE EDIT(EMSK,STRNG,LEN),92069-16061 REV.1912 790112 INTEGER EMSK,STRNG,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-18109 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C EDIT GETS AN EDIT MASK AND USES IT ON THE DS STRING C C CALLING SEQUENCE: C C CALL EDIT(EMSK,STRNG,LEN) C C WHERE: C C EMSK C IS THE EDIT MASK NUMBER C C STRNG C IS THE STRING TO BE EDITED AND IN WHICH WILL BE C RETURNED THE EDITED STRING C C LEN C IS THE LENGTH OF THE STRING C C C C ON EXIT: C C STRNG IS EDITED ACCORDING TO THE EDIT MASK IN EMSK C C C C C C INTEGER AS(66),LAS INTEGER ERR1(8) INTEGER ZZZ(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 ERR1/2H I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR / DATA ZZZ/2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZ9/ C C C C C BEGIN C C C IS THEIS AN "EZ" EDIT? C IF(EMSK .NE. 1) GOTO 5 IF(LEN .GT. 14) LEN = 14 CALL SMOVE(ZZZ,1,LEN+2,AS,1) LAS = LEN+2 GOTO 25 C C FIND THE EDIT MASK C 5 CONTINUE DO 10 I = 1,R3 IF(SS(1,I) .EQ. EMSK ) GOTO 20 10 CONTINUE C C INTERNAL ERROR C CALL REIO(2,ITTY,ERR1,8) GOTO 30 C C GET THE EDIT MASK C 20 CONTINUE CALL LIT(SS(3,I),AS,LAS) C C EDIT THE STRING C 25 CONTINUE CALL SEDIT(STRNG,1,LEN,AS,1,LAS) CALL SMOVE(AS,1,LAS,STRNG,1) LEN = LAS 30 RETURN END