FTN,L,C 
      PROGRAM DBSPA(3,90),92063-16014 REV.1913 790125 
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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 
C 
C************************************************************ 
C 
C 
C     RELOC.  92063-16014 
C     SOURCE  92063-18014 
C 
C 
C***********************************************************************
C SPACE PRINTS THE NUMBER OF RECORDS REMAINING IN 
C  A DATA BASES DATA SETS.
C 
C CALLING SEQUENCE
C     :RU,DBSPA,P1,P2 
C 
C       WHERE: P1 IS CONSOLE
C              P2 IS LIST DEVICE
      INTEGER P(5),FNAME(3),ISTAT(4)
      INTEGER E1,E2,E3
      DIMENSION IBUF(500),IREC(100) 
      DIMENSION ILEVL(3),ITEMP(256) 
      DIMENSION ISEGN(4)
      DATA I1,I2/1,2/ 
      DATA N16,N20,N28/-16,-20,-28/ 
      DATA N1,N2/-1,-2/ 
      DATA N6/-6/ 
      DATA IBLNK/2H  /
      DATA ISEGN/1,2HDB,2HSP,2HA /
C 
C 
      CALL RMPAR(P) 
      ITTY=P(1) 
      ILP=P(2)
      IF (ITTY.EQ.0) ITTY=1 
      IF (ILP .EQ.0) ILP=6
      WRITE(ITTY,10)
10    FORMAT("DATA BASE NAME? _") 
      FNAME(1)=IBLNK
      FNAME(2)=IBLNK
      FNAME(3)=IBLNK
      READ(ITTY,20)FNAME
20    FORMAT(3A2) 
C GET LEVEL 
      WRITE(ITTY,30)
30    FORMAT("DATA BASE LEVEL? _")
      ILEVL(1)=IBLNK
      ILEVL(2)=IBLNK
      ILEVL(3)=IBLNK
      READ(ITTY,40)ILEVL
40    FORMAT(3A2) 
C GET SECURITY CODE 
      WRITE(ITTY,50)
50    FORMAT("DATA BASE SECURITY CODE? _")
      READ(ITTY,*)ISC 
C     OPEN THE DATA BASE
107   MODE=1
      CALL DBINT(FNAME,ISC,ISEGN,ISTAT) 
      IF (ISTAT.NE.0) GOTO 110
      CALL DBOPN(FNAME,ILEVL,ISC,MODE,ISTAT)
C     IF ERROR IN DBOPN, PUT OUT APRROPRIATE ERR NO. AND EXIT 
      IF (ISTAT.NE.0) GO TO 110 
C  GET DATA SET CAPACITIES
      WRITE(ILP ,140) 
140   FORMAT(" DATA SET NAME    CAPACITY   FREE RECORDS  RECORDS USED 
     1DIFFERENCE")
      WRITE(ILP ,150) 
150   FORMAT(" -------------    --------   ------------  ------------ 
     1----------")
      CALL GTSIZ(IBUF,ISIZE)
      K=5 
        DO 205 J=1,ISIZE
        IREC(J)=0 
          DO 200 I=1,IBUF(K)
          CALL DBGET(J,3,ISTAT,ITEMP,I) 
          IF (ISTAT(1).EQ.114) GOTO 200 
          IF (ISTAT(1).NE.0) GOTO 111 
          IREC(J)=IREC(J)+1 
 200      CONTINUE
C 
        K=K+5 
205     CONTINUE
210   I=1 
      DO 300 J=1,ISIZE
      IDIFF=IBUF(I+4)-(IBUF(I)+IREC(J)) 
C 
C IF NUMBER OF RECORDS USED PLUS NUMBER OF FREE RECORDS DON'T ADD UP TO 
C THE CAPACITY OF THE DATA SET THEN SET A FLAG INDICATING POSSIBLE
C NON-INTACT DATA BASE
C 
      IF (IDIFF.NE.0) IFLG=1
      WRITE(ILP,130)IBUF(I+1),IBUF(I+2),IBUF(I+3),IBUF(I+4),IBUF(I),
     1IREC(J),IDIFF 
130   FORMAT(1X,3A2,12X,I5,10X,I5,8X,I5,8X,I6)
      I=I+5 
300   CONTINUE
C 
      IF(IFLG.EQ.1) WRITE(ILP,400)
400   FORMAT(///" DATA BASE MAY NOT BE GOOD -  TRY PROGRAM 'RECOV'
     1TO RECOVER IT") 
C 
      CALL DBCLS(I0,ISTAT)
      IF (ISTAT.NE.0) GOTO 110
      STOP
110   WRITE(ITTY,120)ISTAT(1) 
120   FORMAT(" ERROR ",I4)
      STOP
111   WRITE(ITTY,120)ISTAT(1) 
      CALL DBCLS(I0,ISTAT)
      STOP
      END 
      END$
                                                                                                            