PROGRAM DSKACN
C --	THE PURPOSE OF THIS PROGRAM IS TO PROVIDE A TALLY OF ALL DISK BLOCKS
C --	USED.  IT IS DRIVEN FROM A TABLE FILE,LB:[1,2]DSK UIC.DAT, UPON WHICH
C --	THE FOLLOWING INFORMATION IS STORED IN ASCII:
C --		DEV:[UIC],ACCOUNT_NUMBER,ALLOWED_BLOCKS
C --	THE OUTPUT(DSKACNT.LST) MAY BE SPOOLED TO THE LINE PRINTER.
C --	ACCOUNTS USING MORE THAN THE ALLOCATED BLOCKS ARE FLAGGED SO THEY
C --	MAY BE EASILY DETECTED.
 

	LOGICAL*1 LACNT(14),LANUM(3),LALBLK(5),LBUF(132)
	INTEGER*4 ITOTAL(100)			! FOR STORAGE OF TOTALS
	OPEN(UNIT  =3,				! LUN=1, 2 RESERVED FOR THE
     -	     NAME  ='LB:[1,2]DSKUIC.DAT',	! DISK BLOCK ACCOUNTING SUB.
     -	     READONLY,				! UIC.LST EXISTS AS AN EDI 
     -	     ERR   =9980,			! TYPE FILE.
     -	     TYPE  ='OLD',			!
     -	     ACCESS='SEQUENTIAL')		!
	OPEN(UNIT	    =4,			! OUTPUT FILE
     -	     NAME	    ='LP.LST;1',	!
     -	     DISPOSE	    ='PRINT',		!
     -	     CARRIAGECONTROL='LIST',		!
     -	     TYPE           ='UNKNOWN',		!
     -       ERR	    =9990)		!
	WRITE(4,100)
100	FORMAT('  DIRECTORY',T16,'ACNT #',T22,
     -	'ALOC. BLKS',T35,' #FILES     #BLOCKS')	!
	DO 400, I=1,200				! PROCESS UP TO 200 ENTRIES
	READ(3,125,END=9000) N,(LBUF(J), J=1,N)	! INPUT INTIRE LINE OF ASCII
125	FORMAT(Q,132A1)				!
	DO 130,J=1,3				! NULL OUT OLD DATA
130	LANUM(J)=' '				!
	DO 135, J=1,5				! NULL OUT OLD DATA
135	LALBLK(J)=' '				!
	DO 150, J=1,15				! BREAK OUT ACNT FROM LINE
	LACNT(J)=LBUF(J)
	IF(LACNT(J).EQ.']')	GOTO 160	! STOP WHEN HIT ','
150	CONTINUE				!
160	J=J+1					! POINT TO THE ','
	LACNT(J)=0				! MAKE IT A NULL
	DO 170, K=J+1,J+4			! FIND NEXT NULL
	IF(LBUF(K).EQ.',')	GOTO 180	! DON'T TRANSFER THE ','
170	LANUM(K-J)=LBUF(K)			! TRANSFER TO ACNT NUMBER
180	DO 190, J=K+1,N				! ALL THE REST GO TO ALOWED
190	LALBLK(J-K)=LBUF(J)			! # OF BLOCKS ALLOWED
	DECODE((N-K),200,LALBLK)IALBLK		! GET INTEGER VALUE
200	FORMAT(I5)				! FOR COMPARE
	RFLAG='    '
	CALL UPDATE(LACNT,IFILES,IBLKS,IER)
	IF(IER.NE.1)WRITE(5,250)IER,LACNT
	IF(IBLKS.GT.IALBLK)RFLAG='****'
250	FORMAT(' ERROR = ',I4,' ON ',14A1)
	WRITE(4,300)LACNT,LANUM,LALBLK,IFILES,IBLKS,RFLAG
300	FORMAT(14A1,T19,3A1,T26,5A1,T34,I8,T46,I8,2X,A4)
400	CONTINUE
9000	CLOSE(UNIT=3)
	CLOSE(UNIT=4)
	GOTO 9999
9980	WRITE(5,9985)
9985	FORMAT(' OPEN ERROR ON UIC.LST')
	GOTO 9999
9990	WRITE(5,9995)
9995	FORMAT(' OPEN ERROR ON DSKACNT.LST')
9999	END