FTN 
      SUBROUTINE FIELD(LST,LNDX,EMSK,IBUF,RESULT,LEN),92069-16061 REV.
     &1912 781027 
      INTEGER LST(101,6),LNDX,EMSK,IBUF(2048),RESULT(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-18105
C     RELOC:     92069-16060
C 
C 
C****************************************************************:
C 
C 
C 
C 
C 
C ABSTRACT: 
C 
C FIELD GETS A VALUE FROM THE DBMS BUFFER ACCORDING THE INFORMATION 
C IN THE LIST ARRAY.  THE ITEM VALUE IS CONVERTED TO ASCII AND
C PLACED IN THE RESULT BUFFER.  ASCII FIELDS ARE TRUNCATED TO 
C THE COLLUMN LIMIT SO THEY WON'T OVER RUN THE BUFFER. REALS ARE
C IN G13.5 FORMAT. INTEGERS ARE ZONED WHENEVER AN EDIT MASK IS
C ASSOCITED WITH THE REPORT STATEMENT. OTHERWISE INTEGERS HAVE
C THEIR SIGN IN THE LEFTMOST CHARACTER WHEN THE INTEGER IS
C NEGETIVE. 
C 
C CALLING SEQUENCE: 
C 
C    CALL FIELD(LST,LNDX,EMSK,IBUFF,RESULT,LEN) 
C 
C       WHERE:
C 
C           LST 
C           IS THE LIST ARRAY IN COMMON 
C 
C           LNDX
C           IS THE INDEX IN TO THE LIST ARRAY -  THIS VALUE 
C           USUALLY IS SS(7,N)
C 
C           EMSK
C           IS THE EDIT MASK NUMBER 
C 
C           IBUF
C           IS THE DBMS BUFFER
C 
C           RESULT
C           IS THE ASCII VALUE
C 
C           LEN 
C           IS THE LENGTH OF THE STRING 
C 
C ON EXIT:
C 
C      RESULT - CONTAINS THE ASCII VALUE
C      LEN    - LENGTH OF THE ASCII VALUE IN BYTES
C 
C 
C 
C 
C 
      INTEGER INTGR,R 
      INTEGER IOFF,IOFF2,INT,NOZ,N
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 INTGR/111B/
      DATA R/122B/
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
      IF(LNDX .EQ. 0) GOTO 30 
C 
C BLANK THE RESULT BUFFER 
C 
      CALL SFILL(RESULT,1,COLLIM,40B) 
C 
C GET THE LENGTH OF THE ITEM VALUE IN BYTES 
C 
      LEN = LST(LNDX,3) 
      IF(LEN .GT. COLLIM) LEN = COLLIM
C 
C GET THE OFFSET INTO THE DBMS BUFFER 
C 
      IOFF = LST(LNDX,5)
      IOFF2 = IOFF + LEN - 1
C 
C GET THE ITEM TYPE 
C 
      ITYPE = LST(LNDX,2) 
C 
C PROCESS INTEGERS
C 
      IF(ITYPE .NE. INTGR) GOTO 10
      CALL SMOVE(IBUF,IOFF,IOFF2,INT,1) 
      CALL CITA(INT,RESULT) 
C 
C IF THERE IS NOT AN EDIT MASK THEN LEAVE THE SIGN ON THE LEFT
C 
      LEN = 6 
      IF(EMSK .EQ. 0) GOTO 30 
C 
C OTHERWISE ZONE THE LAST CHARACTER FOR THE "SEDIT" ROUTINE 
C 
      CALL SZONE(RESULT,1,4,NOZ)
C 
C OVERLAY THE SIGN WITH THE REST OF THE NUMBER, 
C BE SURE TO OVERLAY THE LAST CHARACTER WITH A BLANK
C FROM THE SEVENTH POSITION 
C 
      CALL SMOVE(RESULT,2,7,RESULT,1) 
      CALL SZONE(RESULT,5,NOZ,N)
      LEN = 5 
      GOTO 30 
C 
C PROCESS REALS 
C 
10    CONTINUE
      IF(ITYPE .NE. R) GOTO 20
      CALL SMOVE(IBUF,IOFF,IOFF2,REAL,1)
      CALL CRTA(REAL,RESULT)
      LEN = 13
      GOTO 30 
C 
C ASCII 
C 
20    CONTINUE
      CALL SMOVE(IBUF,IOFF,IOFF2,RESULT,1)
C 
C EXIT
C 
30    CONTINUE
      RETURN
      END 
                                                                                                                                        