FTN4 PROGRAM QY22(5,90),92069-16060 REV.1912 781221 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18085 C RELOC: 92069-16060 C C C************************************************************ C C C UPDATE SERVICE MODULE (PART III) C UPDATE ADD ROUTINE C INTEGER INBR(128) INTEGER ISTAT(10) INTEGER ISTAT2(10) INTEGER ERROR(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 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE(S(1,1),ICHAR) EQUIVALENCE(S(3,1),INBR) C DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C C C C UPDATE NAME = ; C A,; C D; C R,=""; C C C C C C BEGIN C C C C C C LOCK THE DATA BASE C CALL DBLCK(DBNAM,DSNUM,1,ISTAT) IF(ISTAT .EQ. 0) GOTO 70 C C DBMS ERROR C 30 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 GOTO 55 C C EXIT C 50 CONTINUE SNAM(2) = 2H 55 CALL LOAD(SNAM) C C C ADD THE RECORD TO THE DATA BASE C C 70 CONTINUE CALL DBPUT(DBNAM,DSNUM,1,ISTAT,INBR,IBUFF) C C UNLOCK THE DATA BASE C CALL DBUNL(DBNAM,DSNUM,1,ISTAT2) C C CHECK THE STATUS OF THE ADD C IF(ISTAT .NE. 0) GOTO 30 C C CHECK THE STATUS OF THE UNLOCK C ISTAT= ISTAT2 IF(ISTAT .NE. 0) GOTO 30 GOTO 50 END