Google
 

Trailing-Edge - PDP-10 Archives - AP-4172F-BM - 3a-sources/acct20.for
There are 3 other files named acct20.for in the archive. Click here to see a list.
C       ACCT20
C       PERFORMS ACCOUNTING FOR THE  TOPS20 SYSTEM FROM
C       THE BINARY FACT FILES
C       JOHN MAKHOUL - DECEMBER 20,1971 - VERSION 6
C	EDITED 3/23/76 BY LOU COHEN FOR TCO # 1201.
C	 THIS EDIT CHANGES ONE "HELP" TO START WITH A CHARACTER
C	 OTHER THAN "?".
C
C	EDITED 10/18/76 BY T. HESS TO REMOVE DISC UTILIZATION
C	CODE (CANNOT SUPPORT MULTIPLE STRUCTURES)


CTHIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
C  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C
CCOPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION

	PROGRAM ACCT20
	IMPLICIT INTEGER (A-Z)
	REAL DISCRT,CHARGE,TCHARG,SCHARG,OTHER,TOTHER,FILFIX,DOLLAR
	REAL GRCPU,GRCON,GRCHAR,GRLINE,GRCARD
	REAL CRCPU,CRCON,CRCHAR,CRLINE,CRCARD
	REAL RCPU,RCON,CPU2,CON2,DCPU,DCON,XTEM
	REAL CHARG,C,D,E,F,G
	LOGICAL ALL,INSERT,DELETE,SPL,ITEM,REPORT,SUMARY
	LOGICAL FIRST,EOF,WORDR,BOUTF,ACTINF
	COMMON /OUTB/BOUTF,ACTINF
	COMMON /ACCOUN/ID(1001),ACNT(10001),ACTNM(501),ACTAL(3000)
	COMMON /DATES/ BEGTAD, ENDTAD
	COMMON /ENTRY/WORD(40),NID,NENTRY,NNACT,NFLCK,NCRASH,UPTIME,
	1  EMPTY, MINSIZ
	COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7,ACTMSK,NBIT2
	COMMON /OUT/ZERO,CRLF,CRLF2,FORMF
	COMMON /FACT/LOG(1001),ASCI(15),PAYDT(8)
	COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
	1 ACTFIL, ACTLPT, ACTCDR
	DIMENSION REASON(9),SP(1200),TEXT(10), CH(5)
	DIMENSION DEFALT(3000), LEGACT(1000)
	DATA GRCPU,GRCON,GRCHAR,GRLINE,GRCARD/6.,6.,.384,.01,.01/
	DATA CRCPU,CRCON,CRCHAR,CRLINE,CRCARD/6.,6.,.384,.01,.01/
	DATA BEGTAD, ENDTAD, YTDSIZ / "377777777777, 0, 8 /
	DATA DEFUSR, DEFACT, DEFSIZ, DEFMAX, LEGMAX /0,1,2,3000,1000/
	DATA CH / "774000000000, "003760000000, "000017700000,
	1 "000000077400, "000000000376 /
	DATA STAR4,BIT01,DISCRT/"251245225000,"600000000000,1./
	DATA SIXMSK,LBYTE/"375767737576,"774000000000/
	DATA CR,COLON,MINUS/"065004020100,"350000000000,"264000000000/

C CHARG(RCPU,RCONS,RPAGE,RLINES,RCARDS) - COMPUTES THE CHARGES USING GIVEN RATES
	CHARG(C,D,E,F,G)= CPU*C/60. + CONS*D/3600. + PAGE*E*DISCRT
	1   + LINES*F + CARDS*G + OTHER

	TO = ' TO '  .AND. .NOT. CH(5)

C COMMANDS TO ACCT20
	ASSIGN 20 TO CNTLE
	CALL ION(CNTLE)
	CALL CLOSE
	CALL OPENOF('TTY:')
	TYPE 5
5	FORMAT(' TOPS20 ACCOUNTING SYSTEM'/'   [TYPE ? FOR
	1 HELP]')
	GO TO 170
10	ASSIGN 20 TO CNTLE
	CALL ION(CNTLE)
	GO TO 30
20	CALL CLOSI
30	CALL PSOUTR(ZERO)
40	TYPE 50
50	FORMAT(' ACCT20>'$)
	COMND2=0
	COMND3=0
	CALL RCHAR(COMAND)
	IF (COMAND.EQ. CR)  GO TO 65
	IF (COMAND.EQ.'S')  GO TO 265
	IF (COMAND.EQ.'I')  GO TO 165
	IF (COMAND.EQ.'O')  GO TO 140
	IF (COMAND.EQ.'L')  GO TO 150
	IF (COMAND.EQ.'R')  GO TO 180
	IF (COMAND.EQ.'W')  GO TO 90
	IF (COMAND.EQ.'F')  GO TO 110
	IF (COMAND.EQ.'G')  GO TO 280
	IF (COMAND.EQ.'A')  GO TO 1800
	IF (COMAND.EQ.'H')  GO TO 190
	IF (COMAND.EQ.'B')  GO TO 200
	IF (COMAND.EQ.'D')  GO TO 250
	IF (COMAND.EQ.'V')  GO TO 4000
	IF (COMAND.EQ.'E')  GO TO 105
	IF (COMAND.EQ.'?')  GO TO 70
	TYPE 60
60	FORMAT (/' ?Command error')
	GO TO 40
65	CALL RCHAR(TEMP)
	GO TO 40
70	TYPE 80
80	FORMAT(' ACCT20  -    TYPE FIRST CHARACTER ',
	1'TO HAVE EFFECT:'/' INITIALIZE ACCOUNTING SYSTEM'/
	2' READ FACT FILE'/
	3' OUTPUT ACCOUNTING INFORMATION'/' WRITE ONTO FILE'/
	4' LOGOUT DATA FILE'/' GO TO REPORTING SEC',
	5'TION'/' FILE DISCOUNT RATE DEFINITION'/' ADJUST CHARGES'/
	6' SET CHARGING RATES'/' VALIDATE ACCOUNTS'/
	7' HISTOGRAM'/' BINARY FILE LISTING'/' EXIT TO MONITOR'/
	8' DATE CONVERSION (GIVE SYSTEM FORMAT)'/'  '/
	9' TYPE A QUESTION MARK (?) TO CAUSE ACCT20 TO TYPE THIS TEXT'/)
	GO TO 40
90	TYPE 100
100	FORMAT ('+RITE ONTO FILE: '$)
	CALL OPENOF
	IF (COMND2.EQ.'W')  GO TO 530
	GO TO 40
C EXIT TO MONITOR
105	TYPE 106
106	FORMAT ('+XIT TO MONITOR')
	CALL EXIT

C FILE DISCOUNT RATE - DISCRT
110	TYPE 120
120	FORMAT ('+ILE DISCOUNT RATE: '$)
	ACCEPT 130, DISCRT
130	FORMAT (F)
	GO TO 40

C OUTPUT ACCOUNTING INFORMATION
140	TYPE 142
142	FORMAT ('+UTPUT ACCOUNTING INFORMATION')
	ACTINF = .TRUE.
	GO TO 40

C LOGOUT DATA FILE
150	TYPE 152
152	FORMAT ('+OGOUT DATA FILE: '$)
	CALL BINOF
	BOUTF = .TRUE.
	GO TO 40

C INITIALIZE ACCOUNTING SYSTEM
165	TYPE 167
167	FORMAT ('+NITIALIZE ACCOUNTING SYSTEM')
170	ACTINF=.FALSE.
	BOUTF=.FALSE.
	ID(1)=0
	ACNT(1)=2
	ACTNM(1)=-1
	ACTAL(1)=0
	LOG(1)=-2
	SP(1)=2
	CALL RFACT(-2)
	NCRASH=0
	NFLCK=0
	NID=0
	NENTRY=0
	NNACT=0
	EMPTY=0
	UPTIME=-1
	REPORT=.TRUE.
	GO TO 40

C READ ACCOUNTS FROM FACT FILES
180	CALL RFACT(0)
	CALL SOUTZ(CRLF)
	REPORT=.FALSE.
	GO TO 40

C CPU AND CONSOLE TIME HISTOGRAM
190	CALL PSOUTR('ISTOGRAM')
	CALL PSOUTZ(' OUTPUT FILE:')
	CALL OPENOF
	CALL RFACT(-1)
	CALL OPENOF('TTY:')
	GO TO 40

C OUTPUT BINARY FILE AS OCTAL NUMBERS
200	CALL PSOUTR('INARY-FILE LISTING')
	TYPE 210
210	FORMAT('  WRITE ONTO FILE:  '$)
	CALL OPENOF
	CALL PSOUTZ(' READ BINARY FILE:  ')
	CALL OPENFZ(1)
	ASSIGN 240 TO EOF
	WORDNO=-1
220	CALL RWORD(BWORD,EOF)
	WORDNO=WORDNO+1
	ENCODE (20,230,ASCI) WORDNO,BWORD
230	FORMAT(O6,O14)
	ASCI(5)=0
	CALL SOUTCR(ASCI)
	GO TO 220
240	CALL SOUTCR('END OF FILE')
	CALL OPENOF('TTY:')
	GO TO 40

C PRINT LOCAL TIME, GIVEN TOPS20 FORMAT TIME
250	CALL PSOUTZ('ATE (TOPS20 FORMAT): ')
	ACCEPT 260,DATE
260	FORMAT(O)
	CALL PSOUTZ(BIT1)
	CALL ODTIMZ(DATE)
	CALL PSOUTR(0)
	GO TO 40

C SET CHARGING RATES
265	TYPE 266
266	FORMAT ('+ET CHARGING RATES'/
	1' COMMERCIAL --'/' 	CPU TIME (PER MINUTE): '$)
	ACCEPT 267, CRCPU
267	FORMAT (F)
	TYPE 268
268	FORMAT ('		CONSOLE TIME (PER HOUR): '$)
	ACCEPT 267, CRCON
	TYPE 269
269	FORMAT ('		DISK STORAGE (PER FILE PAGE): '$)
	ACCEPT 267, CRCHAR
	TYPE 270
270	FORMAT ('		PRINTER USAGE (PER PRINTED PAGE): '$)
	ACCEPT 267, CRLINE
	TYPE 271
271	FORMAT ('		CARD READER USAGE (PER CARD): '$)
	ACCEPT 267,CRCARD
	TYPE 272
272	FORMAT (' GOVERNMENT --'/' 	CPU TIME (PER MINUTE): '$)
	ACCEPT 267, GRCPU
	TYPE 268
	ACCEPT 267,GRCON
	TYPE 269
	ACCEPT 267,GRCHAR
	TYPE 270
	ACCEPT 267,GRLINE
	TYPE 271
	ACCEPT 267,GRCARD
	GO TO 40


C REPORTS PROGRAM
280	CALL PSOUTR('O TO REPORTS')
	IF(NENTRY.NE.0)  GO TO 285
	CALL PSOUTR('NO CHARGES')
	GO TO 10
285	IACF=-3+ACNTSZ*NENTRY
	IF(REPORT)  GO TO 350
C PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT
	CALL SOUTCR('ACCOUNTING FOR JOBS NOT LOGGED OUT')
	CALL RFACT(1)
	REPORT=.TRUE.

C CLOSE LOGOUT DATA FILE
	IF(BOUTF)  CALL CLOSB
	BOUTF=.FALSE.

C OUTPUT ALPHANUMERIC ACCOUNTS
	IF(.NOT.ACTINF)  GO TO 310
	CALL SOUTCR(0)
	CALL SOUTCR('ALPHANUMERIC ACCOUNTS')
	IA=0
	SIZE=0
290	IA=IA+SIZE+1
	IF(ACTAL(IA).EQ.0)  GO TO 310
	II=-IA
	ENCODE(10,300,ASCI) II
300	FORMAT(1X,I6,3X)
	ASCI(3)=0
	CALL SOUTZ(ASCI)
	DO 303 I = 1, 10
303	TEXT(I) = 0
	SIZE=ACTAL(IA).AND.R7
	DO 305 I = 1, SIZE
	J = IA + I
305	TEXT(I) = ACTAL(J)
	CALL SOUTCR(TEXT)
	GO TO 290

C PUT CPU AND CONSOLE TIME IN SECONDS
C DIVIDE NO. OF PAGES BY NFLCK
310	DO 320 I=2,IACF,ACNTSZ
	ACNT(I+ACTCPU)=IFIXR(ACNT(I+ACTCPU)/1000.)
	ACNT(I+ACTCON)=IFIXR(ACNT(I+ACTCON)/1000.)
	IF (ACNT(I+ACTFIL).EQ.0)GO TO 320
	ACNT(I+ACTFIL)=IFIXR((ACNT(I+ACTFIL)+0.)/NFLCK)
320	CONTINUE

C CLASSIFY USERS:BIT0=1,ALPHANUMERIC; OTHERWISE NUMERIC
C GET FIRST WORD OF USER NAME
C LOG TABLE IS NOW USED TO ALPHABETIZE USER ID'S
	CALL PSOUTR('CLASSIFICATION OF USERS AND ACCOUNTS, ETC.')
	DO 340 I=1,NID
	CALL CATEG(ID(I))
	USER=ID(I).AND.R7
	CALL DIRSTZ(USER,TEXT,NCHAR)
	LOG(I+1) = TEXT(1)
	IF(NCHAR.NE.0)  GO TO 340
	LOG(I+1)='?????'
	TYPE 330,USER
330	FORMAT('  USER ID ',O6,' NOT IN USE'/)
340	LOG(I+1)=LOG(I+1).AND.SIXMSK

C ORDER NUMERIC ACCOUNTS
350	IF (NNACT.LE.1)  GO TO 380
360	FLAG=0
	DO 370 I=NNACT,2,-1
	J=I-1
	IF(ACTNM(I).GE.ACTNM(J))  GO TO 370
	TEMP=ACTNM(I)
	ACTNM(I)=ACTNM(J)
	ACTNM(J)=TEMP
	FLAG=1
370	CONTINUE
	IF(FLAG.EQ.1)  GO TO 360

C ORDER USERS ALPHABETICALLY
380	IF(NID.LE.1)  GO TO 430
390	FLAG=0
	DO 420 I=NID,2,-1
	K=I+1
	J=I-1
	IF(LOG(K)-LOG(I))  410,400,420
400	IF((ID(J).AND.R7).LT.(ID(I).AND.R7))  GO TO 420
410	TEMP=LOG(I)
	LOG(I)=LOG(K)
	LOG(K)=TEMP
	TEMP=ID(I)
	ID(I)=ID(J)
	ID(J)=TEMP
	FLAG=1
420	CONTINUE
	IF(FLAG.EQ.1)  GO TO 390

C CLASSIFY ACCOUNTS BY CHARGE CLASS
430	DO 460 I=1,NID
	USER=ID(I).AND.R7
	IAC=(ID(I).AND.L7)/BIT17
440	NACCT=ACNT(IAC+ACTACT)
	ASSIGN 450 TO CLASS
	GO TO 3140
450	ACNT(IAC+ACTACT)=NACCT
	IF(ACNT(IAC+ACTPTR).LT.0)  GO TO 460
	IAC=ACNT(IAC+ACTPTR).AND.R7
	GO TO 440
460	CONTINUE
C CLASSIFY SPECIAL CHARGES
470	K=0
	S=2
480	S=S+K
	IF(S.EQ.SP(1))  GO TO 500
	USER=(SP(S).AND.L7)/BIT17
	NACCT=SP(S+1)
	ASSIGN 490 TO CLASS
	GO TO 3140
490	SP(S+1)=NACCT
	K=SP(S).AND.R7
	GO TO 480

500	IF(COMAND.EQ.'A'.AND.COMND3.EQ.0)  GO TO 1810

C COMMANDS TO REPORTS PROGRAM
	ASSIGN 510 TO CNTLE
	CALL ION(CNTLE)
	GO TO 520
510	CALL CLOSI
520	CALL PSOUTR(ZERO)
530	TYPE 540
540	FORMAT (' REPORT>'$)
	ALL=.FALSE.
	COMND3=0
	ITEM=.FALSE.
	SUMARY=.FALSE.
	CALL RCHAR(COMND2)
	IF (COMND2.EQ.CR) GO TO 545
	IF (COMND2.EQ.'E')  GO TO 570
	IF (COMND2.EQ.'D')  GO TO 580
	IF (COMND2.EQ.'C')  GO TO 620
	IF (COMND2.EQ.'F'.OR.COMND2.EQ.'T')  GO TO 850
	IF (COMND2.EQ.'J')  GO TO 1150
	IF (COMND2.EQ.'S')  GO TO 1700
	IF (COMND2.EQ.'U')  GO TO 1290
	IF (COMND2.EQ.'I')  GO TO 1480
	IF (COMND2.EQ.'A')  GO TO 1800
	IF (COMND2.EQ.'W')  GO TO 90
	IF (COMND2.EQ.'Y')  GO TO 1580
	IF (COMND2.EQ.'?')  GO TO 550
	TYPE 60
	GO TO 530
545	CALL RCHAR(TEMP)
	GO TO 530
550	TYPE 560
560	FORMAT(' ACCT20-REPORTING SECTION  TYPE FIRST CHARACTER ',
	1'TO HAVE EFFECT:'/' EXIT TO ACCT20'/' DO ALL COST '
	2'SUMMARIES (C+F+T+J)'/' COST SUMMARY'/' FINAL COST SUMMARY'/
	3' JOB SUMMARY'/' USER COST SUMMARY'/' INDIVIDUAL JOB SUMMARY'/
	4' ADJUST CHARGES'/' WRITE FILE'/' YEAR TO DATE ACCOUNTING'
	5/' SUMMARY FOR YEAR TO DATE FILE')
	GO TO 530
570	CALL PSOUTR('XIT TO ACCT20')
	ASSIGN 20 TO CNTLE
	CALL ION(CNTLE)
	GO TO 40

C DO ALL COST SUMMARIES
580	CALL PSOUTR('O ALL COST SUMMARIES')
	ALL=.TRUE.
	CALL PSOUTZ('    C')
	GO TO 620
590	COMND2='F'
	CALL PSOUTZ('    F')
	GO TO 850
600	IF (COMND2.EQ.'T')  GO TO 610
	COMND2='T'
	CALL PSOUTZ('    T')
	GO TO 850
610	COMND2='J'
	CALL PSOUTZ('    J')
	GO TO 1150

C COST SUMMARY BY CATEGORY
620	CALL PSOUTR('OST SUMMARY')
	CALL SOUTZ(FORMF)
	CALL SOUTZ('     TOPS20 SUMMARY SHEET FOR ')
	CALL ODTIMZ(BEGTAD)
	CALL SOUTZ(TO)
	CALL ODTIMZ(ENDTAD)
	CALL SOUTZ(CRLF2)
	CALL SOUTZ('JOB TYPE')
	ENCODE (61,630,ASCI) BIT1
630	FORMAT(A1,'   CPU TIME   CONSOLE TIME   FILE PAGES   LPT PAGES',
	1 '   CARDS ')
	ASCI(13) = 0
	CALL SOUTZ(ASCI)
	ENCODE (21,635,ASCI) BIT1
635	FORMAT(A1,'   OTHER     CHARGES')
	ASCI(5) = ASCI(5) .AND. CH(1)
	CALL SOUTCR(ASCI)
	CALL SOUTZ(CRLF)
	TYPE=0
	ASSIGN 640 TO TZERO
	GO TO 3040
640	TYPE=TYPE+1
	CPU=0
	CONS=0
	PAGE=0
	LINES=0
	CARDS=0
	OTHER=0.
	CHARGE=0.
	GO TO (650,670,680,690,700,710) TYPE

C EXTERNAL CLIENTS - TYPE=1
C ACCOUNTS < 200000
650	CALL SOUTCR('EXTERNAL CLIENTS')
	CALL SOUTZ('          ')
	ACODE=BIT2
	ASSIGN 660 TO SUM
	GO TO 770
660	ASSIGN 640 TO OUT
	GO TO 3050
C CHARGEABLE OVERHEAD - TYPE=2
670	CALL SOUTCR('CHARGEABLE OVERHEAD')
	CALL SOUTZ('          ')
	ACODE=BIT2
	GO TO 770
C NONCHARGEABLE - TYPE=3
680	CALL SOUTCR('NONCHARGEABLE')
	CALL SOUTZ('          ')
	ACODE=0
	GO TO 770
C COMPUTER CENTERS - TYPE=4
690	CALL SOUTCR('COMPUTER CENTERS')
	CALL SOUTZ('          ')
	ACODE=0
	GO TO 770
C TOTAL
700	CALL SOUTZ(CRLF)
	CALL SOUTZ('TOTAL     ')
	CPU=TCPU
	CONS=TCONS
	PAGE=TPAGE
	LINES = TLINES
	CARDS = TCARDS
	OTHER=TOTHER
	CHARGE=TCHARG
	GO TO 3080

C FINAL SUMMARY
710	CALL SOUTZ(CRLF2)
	ENCODE(60,720,ASCI) GRCPU,GRCON,GRCHAR
720	FORMAT(' 	$'F5.2,'/MIN   $'F5.2,'/HR  $',
	1      F5.3,'/PAGE/PAY PERIOD')
	ASCI(13)=0
	CALL SOUTCR('GOVERNMENT CHARGE RATES --')
	CALL SOUTCR(ASCI)
	ENCODE (60,721,ASCI) GRLINE, GRCARD
721	FORMAT (' 	$',F5.3,'/PRINTED PAGE, $',F5.3,'/CARD READ')
	ASCI(13)=0
	CALL SOUTCR(ASCI)
	ENCODE(60,720,ASCI) CRCPU, CRCON, CRCHAR
	ASCI(13)=0
	CALL SOUTCR('COMMERCIAL CHARGE RATES --')
	CALL SOUTCR(ASCI)
	ENCODE (60,721,ASCI) CRLINE, CRCARD
	ASCI(13)=0
	CALL SOUTCR(ASCI)
	ENCODE(60,730,ASCI) BIT1
730	FORMAT(39X,'(1 PAGE=512*5 CHARS)',A1)
	ASCI(13)=0
	CALL SOUTCR(ASCI)
	CALL SOUTZ(CRLF)
	ENCODE(50,740,ASCI) NCRASH
740	FORMAT('THERE WERE'I4,' SYSTEM RESTARTS THIS PAY PERIOD    ')
	ASCI(11)=0
	CALL SOUTCR(ASCI)
	CALL SOUTZ(CRLF)
	IF(UPTIME.EQ.-1)  UPTIME=0
	MIN=UPTIME/60
	SEC=UPTIME-MIN*60
	HOUR=MIN/60
	MIN=MIN-HOUR*60
	ENCODE(40,750,ASCI) HOUR,MIN,SEC
750	FORMAT('TOTAL UPTIME THIS PAY PERIOD:',I4,':'I2,':'I2,1X)
	ASCI(9)=0
	CALL SOUTCR(ASCI)
	CALL SOUTZ(CRLF)
	CALL SOUTZ('FILE CHARGES HAVE BEEN DISCOUNTED BY A FACTOR OF')
	ENCODE(5,760,ASCI) DISCRT
760	FORMAT(F5.3)
	ASCI(2)=0
	CALL SOUTCR(ASCI)

	IF (ALL)  GO TO 590
	GO TO 530

C (SUM) - SUM ACCOUNTS
770	DO 790 I=2,IACF,ACNTSZ
	IF(ACNT(I).EQ.NBIT2)  GO TO 790
	NACCT=ACNT(I).AND.ACTMSK
	ASSIGN 780 TO SCLASS
	ASSIGN 790 TO NOSUM
	GO TO 830
780	CPU =   CPU  + ACNT(I+ACTCPU)
	CONS =  CONS + ACNT(I+ACTCON)
	PAGE =  PAGE + ACNT(I+ACTFIL)
	LINES = LINES + ACNT(I+ACTLPT)
	CARDS = CARDS + ACNT(I+ACTCDR)
790	CONTINUE
	K=0
	S=2
800	S=S+K
	IF(S.EQ.SP(1))  GO TO SUM
	IF(SP(S).LT.0)  GO TO 820
	IF((SP(S+1).AND.BIT12).NE.ACODE)  GO TO 820
	NACCT=SP(S+1).AND.ACTMSK
	ASSIGN 810 TO SCLASS
	ASSIGN 820 TO NOSUM
	GO TO 830
810	OTHER=OTHER+SP(S+2)/100.
820	K=SP(S).AND.R7
	GO TO 800
C (SCLASS) - SUBCLASSIFY
C (NOSUM)  - DO NOT SUM
C	CURRENT SUB-CLASSIFICATION ALGORITHM --
C		NUMERIC ACCOUNTS < 1000 ARE NON-CHARGEABLE
C		ALL OTHER ACCOUNTS ARE EXTERNAL CLIENTS
830	IF ( TYPE .EQ. 1 .AND. NACCT .LT. 0 ) GO TO SCLASS
	IF ( TYPE .EQ. 1 .AND. NACCT .GE. 1000 ) GO TO SCLASS
	GO TO NOSUM


C COST SUMMARY BY ACCOUNT NUMBER
850	IF (COMND2.EQ.'F')  GO TO 860
	CALL PSOUTR('OTAL COST')
	GO TO 870
860	CALL PSOUTR('INAL COST SUMMARY FOR ACCOUNTING')
870	CALL SOUTZ(FORMF)
	CALL SOUTZ ('   TOPS20 TIME SHEET FOR ')
	CALL ODTIMZ(BEGTAD)
	CALL SOUTZ(TO)
	CALL ODTIMZ(ENDTAD)
	CALL SOUTZ(CRLF)
	CALL SOUTZ('JOB NUMBER')
	ENCODE(61,630,ASCI) BIT1
	ASCI(13) = 0
	CALL SOUTZ(ASCI)
	ENCODE (21,635,ASCI) BIT1
	ASCI(5) = ASCI(5) .AND. CH(1)
	CALL SOUTCR(ASCI)
C NUMERIC ACCOUNTS
880	IA=0
	ASSIGN 890 TO TZERO
	GO TO 3040
890	IA=IA+1
900	CPU=0
	CONS=0
	PAGE=0
	LINES=0
	CARDS=0
	OTHER=0.
	CHARGE=0.
	SPL=.FALSE.
	IF(COMND2.NE.'Y')  GO TO 910
	ASSIGN 910 TO READB
	GO TO 1640
910	IF(IA.GT.NNACT)  GO TO 930
	NACCT=ACTNM(IA)
	IF(COMND2.NE.'Y')  GO TO 940
	ACNUM=NACCT
	IF(WORD(1).LT.0.OR.WORD(1).GE.NACCT.OR.EOF.OR.FIRST)  GO TO 940
920	ASSIGN 900 TO BINO
	GO TO 1670
930	IF(COMND2.NE.'Y')  GO TO 1000
	IF(WORD(1).LT.0.OR.EOF.OR.FIRST)  GO TO 1000
	GO TO 920
940	DO 960 I=1,NID
C	IF(ID(I).LT.0)  GO TO 960
	ASSIGN 950 TO LOCENT
	ASSIGN 960 TO ENTNF
	GO TO 3320
950	IF ( ACNT(IAC+ACTACT) .LT. 0 ) GO TO 960
	ACODE=ACNT(IAC+ACTACT).AND.BIT12
	IF(COMND2.EQ.'F'.AND.ACODE.EQ.0)  GO TO 890
	IF((ACNT(IAC+ACTSP).AND.L7).NE.0)  SPL=.TRUE.
	CPU=CPU+ACNT(IAC+ACTCPU)
	CONS=CONS+ACNT(IAC+ACTCON)
	PAGE=PAGE+ACNT(IAC+ACTFIL)
	LINES=LINES+ACNT(IAC+ACTLPT)
	CARDS=CARDS+ACNT(IAC+ACTCDR)
960	CONTINUE
	IF(COMND2.EQ.'Y')  GO TO 970
	ASSIGN 970 TO ACTNO
	GO TO 3280
970	IF(.NOT.SPL)  GO TO 980
	NACCT1=NACCT
	USER=-1
	ASSIGN 980 TO SPAD
	GO TO 3340
980	ASSIGN 890 TO OUT
	IF(COMND2.EQ.'Y')  ASSIGN 990 TO OUT
	GO TO 3050
990	ASSIGN 890 TO BINO
	IF(WORD(1).EQ.NACCT)  GO TO 1680
	GO TO 1690
C ALPHANUMERIC ACCOUNTS
1000	SUMARY=.TRUE.
	DO 1100 I=1,NID
	IF(ID(I).GE.0)  GO TO 1100
	USER=ID(I).AND.R7
	IAC=(ID(I).AND.L7)/BIT17
1010	SCPU=0
	SCONS=0
	SPAGE=0
	SLINES=0
	SCARDS=0
	OTHER=0.
	SCHARG=0.
	SPL=.FALSE.
	IF(COMND2.NE.'Y')  GO TO 1050
	ASSIGN 1020 TO READB
	GO TO 1640
1020	ACNUM=-USER
	IF(ACNUM.EQ.WORD(1).OR.EOF.OR.FIRST)  GO TO 1050
	USER2=-WORD(1)
	CALL DIRSTZ(USER2,ASCI,NCHAR)
	ASCI(1)=ASCI(1).AND.SIXMSK
	IF(ASCI(1)-LOG(I+1))  1040,1030,1050
1030	IF(WORD(1).LT.ACNUM)  GO TO 1050
1040	ASSIGN 1010 TO BINO
	GO TO 1670
1050	CPU=ACNT(IAC+ACTCPU)
	CONS=ACNT(IAC+ACTCON)
	PAGE=ACNT(IAC+ACTFIL)
	LINES=ACNT(IAC+ACTLPT)
	CARDS=ACNT(IAC+ACTCDR)
	ACODE=ACNT(IAC+ACTACT).AND.BIT12
	IF((ACNT(IAC+ACTSP).AND.L7).NE.0)  SPL=.TRUE.
	ASSIGN 1060 TO OUT
	GO TO 3050
1060	SCPU=SCPU+CPU
	SCONS=SCONS+CONS
	SPAGE=SPAGE+PAGE
	SLINES=SLINES+LINES
	SCARDS=SCARDS+CARDS
	SCHARG=SCHARG+CHARGE
	IF(ACNT(IAC+ACTPTR).LT.0)  GO TO 1070
	IAC=ACNT(IAC+ACTPTR).AND.R7
	GO TO 1050
1070	IF(.NOT.SPL)  GO TO 1080
	NACCT1=NBIT2
	ASSIGN 1080 TO SPAD
	GO TO 3340
1080	CPU=SCPU
	CONS=SCONS
	PAGE=SPAGE
	LINES=SLINES
	CARDS=SCARDS
	CHARGE=SCHARG
	TOTHER=TOTHER+OTHER
	IF(COMND2.EQ.'Y')  GO TO 1090
	IF(CHARGE.EQ.0.AND.COMND2.EQ.'F')  GO TO 1100
	ASSIGN 1100 TO OUT
	ASSIGN 3080 TO NAME
	GO TO 3190
1090	ASSIGN 1100 TO BINO
	IF(ACNUM.EQ.WORD(1))  GO TO 1680
	GO TO 1690
1100	CONTINUE
	IF(COMND2.NE.'Y')  GO TO 1120
	ASSIGN 1110 TO READB
	GO TO 1640
1110	IF(EOF.OR.FIRST)  GO TO 1630
	ASSIGN 1640 TO BINO
	GO TO 1670
C TOTAL
1120	SUMARY=.FALSE.
	ASSIGN 1130 TO OUT
	GO TO 700
1130	IF(COMND2.EQ.'T')  GO TO 1140
	CALL SOUTZ(CRLF2)
	CALL SOUTCR('APPROVED BY: ..............................')
	CALL SOUTCR('                     (SIGNATURE)')
1140	IF (ALL)  GO TO 600
	GO TO 530


C JOB SUMMARIES
1150	CALL PSOUTR('OB SUMMARIES')
	IA=0
1160	IA=IA+1
	IF (IA.GT.NNACT)  GO TO 1300
1170	CALL SOUTZ(FORMF)
	CALL SOUTZ('      TOPS20 CHARGES FOR ')
	CALL ODTIMZ(BEGTAD)
	CALL SOUTZ(TO)
	CALL ODTIMZ(ENDTAD)
	CALL SOUTZ(CRLF)
	ENCODE(40,1180,ASCI) ACTNM(IA)
1180	FORMAT(23X,'ACCOUNT:',I9)
	ASCI(9)=0
	CALL SOUTZ(ASCI)
	CALL SOUTZ(CRLF2)
	CALL SOUTZ('  USER    ')
	ENCODE(61,630,ASCI) BIT1
	ASCI(13) = 0
	CALL SOUTZ(ASCI)
	ENCODE (21,635,ASCI) BIT1
	ASCI(5) = ASCI(5) .AND. CH(1)
	CALL SOUTCR(ASCI)
	SPL=.FALSE.
	NACCT=ACTNM(IA)
	ASSIGN 1190 TO TZERO
	GO TO 3040
1190	DO 1230 I=1,NID
	ASSIGN 1200 TO LOCENT
	ASSIGN 1230 TO ENTNF
	GO TO 3320
1200	IF (ACNT(IAC+ACTACT).LT.0) GO TO 1230
	USER=ID(I).AND.R7
	ASSIGN 1210 TO NAME
	GO TO 3190
1210	CPU=ACNT(IAC+ACTCPU)
	CONS=ACNT(IAC+ACTCON)
	PAGE=ACNT(IAC+ACTFIL)
	LINES=ACNT(IAC+ACTLPT)
	CARDS=ACNT(IAC+ACTCDR)
	OTHER=0.
	CHARGE=0.
	ASSIGN 1230 TO OUT
	ACODE=ACNT(IAC+ACTACT).AND.BIT12
	IF((ACNT(IAC+ACTSP).AND.L7).NE.0)  GO TO 1220
	GO TO 3050
1220	NACCT1=NACCT
	ASSIGN 3050 TO SPAD
	GO TO 3340
1230	CONTINUE
	ASSIGN 1240 TO OUT
	GO TO 700
C ITEMIZE OTHER
1240	IF(.NOT.SPL)  GO TO 1280
	CALL SOUTCR(CRLF2)
	ENCODE(50,1250,ASCI) ACTNM(IA)
1250	FORMAT(15X,'ITEMIZED OTHER COSTS FOR',I9,2X)
	ASCI(11)=0
	CALL SOUTZ(ASCI)
	CALL SOUTZ(CRLF2)
	CALL SOUTZ('  USER    ')
	ENCODE (50,1260,ASCI) BIT1
1260	FORMAT(12X,'ITEM',A1,26X,'CHARGE')
	CALL SOUTCR(ASCI)
	ITEM=.TRUE.
	USER=-1
	ASSIGN 1270 TO SPAD
	GO TO 3340
1270	ITEM=.FALSE.
1280	IF (COMND2.EQ.'I')  GO TO 530
	GO TO 1160

C USER COST SUMMARIES
1290	CALL PSOUTR('SER COST SUMMARIES')
1300	DO 1470 I=1,NID
	IF(COMND2.EQ.'J'.AND.ID(I).GE.0)  GO TO 1470
	USER=ID(I).AND.R7
1310	IAC=(ID(I).AND.L7)/BIT17
	CALL SOUTZ(FORMF)
	CALL SOUTZ('      TOPS20 CHARGES FOR ')
	CALL ODTIMZ(BEGTAD)
	CALL SOUTZ(TO)
	CALL ODTIMZ(ENDTAD)
	CALL SOUTZ(CRLF)
	CALL DIRSTZ(USER,ASCI,NCHAR)
	CALL SOUTZ('                       USER: ')
	CALL SOUTZ(ASCI)
	CALL SOUTZ(CRLF2)
	SPL=.FALSE.
	IF(ID(I).LT.0)  GO TO 1320
	CALL SOUTZ('  ACCOUNT ')
	GO TO 1330
1320	CALL SOUTZ('ACCOUNT   ')
1330	ENCODE (61,630,ASCI) BIT1
	ASCI(13) = 0
	CALL SOUTZ(ASCI)
	ENCODE (21,635,ASCI) BIT1
	ASCI(5) = ASCI(5) .AND. CH(1)
	CALL SOUTCR(ASCI)
	ASSIGN 1340 TO TZERO
	GO TO 3040
1340	ASSIGN 1400 TO OUT
	ASSIGN 1380 TO ACTNO
1350	NACCT=ACNT(IAC+ACTACT)
	IF ( NACCT .EQ. NBIT2 ) GO TO 1400
	ACODE=ACNT(IAC+ACTACT).AND.BIT12
	GO TO 3280
1380	CPU=ACNT(IAC+ACTCPU)
	CONS=ACNT(IAC+ACTCON)
	PAGE=ACNT(IAC+ACTFIL)
	LINES=ACNT(IAC+ACTLPT)
	CARDS=ACNT(IAC+ACTCDR)
	OTHER=0.
	CHARGE=0.
	IF((ACNT(IAC+ACTSP).AND.L7).NE.0)  GO TO 1390
	GO TO 3050
1390	NACCT1=NACCT
	ASSIGN 3050 TO SPAD
	GO TO 3340
1400	IF(ACNT(IAC+ACTPTR).LT.0)  GO TO 1410
	IAC=ACNT(IAC+ACTPTR).AND.R7
	GO TO 1350
1410	ASSIGN 1420 TO OUT
	GO TO 700
C ITEMIZE OTHER
1420	IF(.NOT.SPL)  GO TO 1460
	CALL SOUTZ(CRLF2)
	CALL SOUTZ(CRLF)
	CALL DIRSTZ(USER,ASCI,NCHAR)
	CALL SOUTZ('               ITEMIZED OTHER COSTS FOR ')
	CALL SOUTZ(ASCI)
	CALL SOUTZ(CRLF2)
	IF(ID(I).LT.0)  GO TO 1430
	CALL SOUTZ('  ACCOUNT ')
	GO TO 1440
1430	CALL SOUTZ('ACCOUNT   ')
1440	ENCODE(50,1260,ASCI) BIT1
	ASCI(11)=0
	CALL SOUTCR(ASCI)
	ITEM=.TRUE.
	NACCT1=NBIT2
	ASSIGN 1450 TO SPAD
	GO TO 3340
1450	ITEM=.FALSE.
1460	IF(COMND2.EQ.'I')  GO TO 530
1470	CONTINUE
	GO TO 530

C INDIVIDUAL JOB SUMMARY
1480	TYPE 1490
1490	FORMAT('+NDIVIDUAL JOB SUMMARY FOR (N,U): '$)
	CALL RCHAR(NA)
	IF(NA.EQ.'N'.OR.NA.EQ.'U')  GO TO 1500
	TYPE 60
	GO TO 530
1500	TYPE 1510
1510	FORMAT(2H+ $)
	IF(NA.EQ.'U')  GO TO 1550
C NUMERIC
1520	ACCEPT 1530,NACCT
1530	FORMAT(I)
	DO 1540 IA=1,NNACT
	IF(ACTNM(IA).EQ.NACCT)  GO TO 1170
1540	CONTINUE
	CALL PSOUTR(' NONEXISTENT ACCOUNT')
	GO TO 530
C USER
1550	ASSIGN 1570 TO DIRERR
	CALL STDIRZ(USER,TYPE,DIRERR)
	DO 1560 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 1310
1560	CONTINUE
	CALL PSOUTR(' USER NOT ON USER LIST FOR THIS PAY PERIOD')
	GO TO 530
1570	CALL PSOUTR(' USER ID NOT IN DIRECTORY')
	GO TO 530

C YEAR-TO-DATE ACCOUNTING
1580	CALL PSOUTR('EAR-TO-DATE ACCOUNTING')
1590	CALL PSOUTZ('IS THIS THE FIRST PAY PERIOD OF THE YEAR? (Y,N)
	1  ')
	CALL RCHAR(CHAR)
	CALL PSOUTR(BIT1)
	IF(CHAR.EQ.'Y'.OR.CHAR.EQ.'N')  GO TO 1600
	TYPE 60
	GO TO 1590
1600	FIRST=.FALSE.
	IF(CHAR.EQ.'Y')  FIRST=.TRUE.
	IF(FIRST)  GO TO 1610
	CALL PSOUTZ('MOST RECENT YEAR-TO-DATE FILE:')
	ASSIGN 1660 TO ENDF
	REASON(1)=0
	CALL OPENFZ(REASON)
	EOF=.FALSE.
1610	CALL PSOUTZ('NEW YEAR-TO-DATE OUTPUT FILE:')
	CALL BINOF
	DO 1620 I=1,6
	CALL WWORD(PAYDT(I))
	IF(FIRST)  GO TO 1620
	CALL RWORD(WORD(I),ENDF)
1620	CONTINUE
	WORD(1)=-1
	WORDR=.FALSE.
	SUMARY=.TRUE.
	GO TO 880
C CLOSE BINARY FILE
1630	CALL CLOSB
	GO TO 530

C (READB) - READ FROM BINARY FILE
1640	IF(EOF.OR.FIRST.OR.WORDR)  GO TO READB
	DO 1650 II=1,6
1650	CALL RWORD(WORD(II),ENDF)
	WORDR=.TRUE.
	GO TO READB
C END OF FILE
1660	EOF=.TRUE.
	GO TO READB

C (BINO) - OUTPUT TO BINARY FILE
1670	CPU=0
	CONS=0
	PAGE=0
	LINES=0
	CARDS=0
	OTHER=0.
	CHARGE=0.
1680	ACNUM=WORD(1)
	CPU=CPU+WORD(2)
	CONS=CONS+WORD(3)
	PAGE=PAGE+WORD(4)
	OTHER=OTHER+WORD(5)/100.
	CHARGE=CHARGE+WORD(6)/100.
	WORDR=.FALSE.
1690	CALL WWORD(ACNUM)
	CALL WWORD(CPU)
	CALL WWORD(CONS)
	CALL WWORD(PAGE)
	TEMP=IFIXR(OTHER*100.)
	CALL WWORD(TEMP)
	TEMP=IFIXR(CHARGE*100.)
	CALL WWORD(TEMP)
	CALL WWORD(LINES)
	CALL WWORD(CARDS)
	GO TO BINO

C YEAR-TO-DATE SUMMARY
1700	CALL PSOUTZ('UMMARY FOR YEAR-TO-DATE FILE: ')
	SCOMND='S1'
	ASSIGN 1770 TO ENDF
	REASON(1)=0
1710	CALL OPENFZ(REASON)
	CALL SOUTZ(FORMF)
	CALL SOUTCR('                  CUMULATIVE YEAR-TO-DATE
	1 TIME SHEET')
	CALL SOUTZ('              ENDING IN PAY PERIOD ')
	DO 1720 I=1,6
1720	CALL RWORD(ASCI(I),ENDF)
	CALL SOUTZ(ASCI)
	CALL SOUTZ(CRLF2)
	CALL SOUTZ('JOB NUMBER')
	ENCODE(61,630,ASCI) BIT1
	ASCI(13) = 0
	CALL SOUTZ(ASCI)
	ENCODE (21,635,ASCI) BIT1
	ASCI(5) = ASCI(5) .AND. CH(1)
	CALL SOUTCR(ASCI)
	ASSIGN 1730 TO TZERO
	GO TO 3040
1730	DO 1740 I=1,YTDSIZ
1740	CALL RWORD(WORD(I),ENDF)
	IF(SCOMND.EQ.'S1'.AND.WORD(6).EQ.0)  GO TO 1730
	CPU=WORD(2)
	CONS=WORD(3)
	PAGE=WORD(4)
	OTHER=WORD(5)/100.
	CHARGE=WORD(6)/100.
	LINES=WORD(7)
	CARDS=WORD(8)
	IF(WORD(1).LT.0)  GO TO 1750
	NACCT=WORD(1)
	ASSIGN 1760 TO ACTNO
	GO TO 3280
1750	USER=-WORD(1)
	ASSIGN 1760 TO NAME
	GO TO 3190
1760	ASSIGN 1730 TO OUT
	GO TO 3070
C TOTAL
1770	ASSIGN 1780 TO OUT
	GO TO 700
1780	IF(SCOMND.EQ.'S2')  GO TO 530
	CALL SOUTZ(CRLF2)
	CALL SOUTCR('APPROVED BY: ..............................')
	CALL SOUTCR('                      (SIGNATURE)')
	SCOMND='S2'
	GO TO 1710


C ADJUST CHARGES PROGRAM
1790	CALL PSOUTR(' *OK*')
	GO TO 1830
1800	CALL PSOUTR('DJUST CHARGES')
	IF(.NOT.REPORT.AND.NENTRY.GT.0)  GO TO 285
1810	ASSIGN 1820 TO CNTLE
	CALL ION(CNTLE)
1820	CALL PSOUTR(ZERO)
1830	NACCT1=NBIT2
	WORD(5)=NBIT2
	USER=-1
	NACCT2=NBIT2
	CONS=0
	CPU=0
	PAGE=0
	LINES=0
	CARDS=0
	FILFIX=1.
	DELETE=.FALSE.
	REASON(1)=0
	DOLLAR=0.
	INSERT=.FALSE.
	COMND=0
1850	TYPE 1860
1860	FORMAT(' ADJUST>'$)
	CALL RCHAR(COMND3)
	IF (COMND3.EQ.'I')  GO TO 1920
	COMND=COMND+1
	IF (COMND3.EQ.CR )  GO TO 1875
	IF (COMND3.EQ.'L')  GO TO 2215
	IF (COMND3.EQ.'C')  GO TO 2217
	IF (COMND3.EQ.'E')  GO TO 1900
	IF (COMND3.EQ.'G')  GO TO 280
	IF (COMND3.EQ.'D')  GO TO 1910
	IF (COMND3.EQ.'A')  GO TO 1940
	IF (COMND3.EQ.'U')  GO TO 2000
	IF (COMND3.EQ.'N')  GO TO 2050
	IF (COMND3.EQ.'T')  GO TO 2090
	IF (COMND3.EQ.'F')  GO TO 2220
	IF (COMND3.EQ.'$')  GO TO 2250
	IF (COMND3.EQ.'R')  GO TO 2270
	IF (COMND3.EQ.'P')  GO TO 2300
	IF (COMND3.EQ.'B')  GO TO 2320
	IF (COMND3.EQ.'?')  GO TO 1880
	TYPE 60
1870	COMND=COMND-1
	GO TO 1850
1875	CALL RCHAR(TEMP)
	GO TO 1850
1880	TYPE 1890
1890	FORMAT(' ADJUSTMENT SECTION         TYPE FIRST CHARACTER',
	1'TO HAVE EFFECT:'/' EXIT TO ACCT20'/' GO TO REPORT ',
	2'SECTION'/' DELETE'/' ACCOUNT NR.'/' USER ID'/' NEW ACCOUNT ',
	3'NR.'/' CPU AND CONSOLE TIME'/' LINE PRINTER PAGES'/' CARDS READ'/
	4' FILE PAGE DISCOUNT'/' $ TO BE CHARGED'/' REASON FOR CHARGE'/
	5' PAGE ADJUSTMENT'/' BEGIN ADJUSTMENT'/' ?-THIS TEXT'/)
	GO TO 1870
1900	CALL PSOUTR('XIT TO ACCT20')
	GO TO 10

C DELETE,INSERT
1910	CALL PSOUTR('ELETE')
	IF(INSERT)  GO TO 1930
	DELETE=.TRUE.
	GO TO 1850
1920	CALL PSOUTR('NSERT')
	IF (COMND.NE.0)  GO TO 1930
	INSERT=.TRUE.
	GO TO 1850
1930	CALL PSOUTR(' INCONSISTENT COMMAND')
	GO TO 1850

C ACCOUNT NUMBER
1940	TYPE 1950
1950	FORMAT('+CCOUNT NUMBER (N,A)= '$)
	CALL RCHAR(NA)
	IF(NA.EQ.'N'.OR.NA.EQ.'A')  GO TO 1960
	TYPE 60
	GO TO 1850
1960	TYPE 1510
	IF(NA.EQ.'A')  GO TO 1990
C NUMERIC
1970	ACCEPT 1530,WORD(5)
	CALL ACCT(-2,0,NACCT1,0,0,0,0,0)
1980	IF(NACCT1.NE.NBIT2)  GO TO 1850
	IF(INSERT)  GO TO 1850
	CALL PSOUTR(' NONEXISTENT ACCOUNT')
	GO TO 1870
C ALPHANUMERIC
1990	DO 1991 II = 6,20
1991	WORD(II) = 0
	MINSIZ = 5
	CALL RALPH(WORD(6),NCHAR)
	WORD(MINSIZ)=-NCHAR
	SIZE=(NCHAR+4)/5
	WORD(1)=SIZE+MINSIZ
	CALL ACCT(-2,0,NACCT1,0,0,0,0,0)
	GO TO 1980

C USER ID CODE
2000	TYPE 2010
2010	FORMAT('+SER ID CODE: '$)
	ASSIGN 2020 TO DIRERR
	CALL STDIRZ(USER,TYPE,DIRERR)
	IF(INSERT)  GO TO 1850
	GO TO 2030
2020	CALL PSOUTR(' USER ID NOT IN DIRECTORY')
	GO TO 1870
2030	DO 2040 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 1850
2040	CONTINUE
	CALL PSOUTR(' USER NOT IN USER TABLE THIS PAY PERIOD')
	USER=-1
	GO TO 1870

C NEW ACCOUNT NUMBER
2050	TYPE 2060
2060	FORMAT('+EW ACCOUNT NUMBER (N,A)= '$)
	IF(INSERT)  GO TO 1930
	CALL RCHAR(NA)
	IF(NA.EQ.'N'.OR.NA.EQ.'A')  GO TO 2070
	TYPE 60
	GO TO 1850
2070	TYPE 1510
	IF(NA.EQ.'A')  GO TO 2080
	ACCEPT 1530,NACCT2
	GO TO 1850
2080	CALL RALPH(ASCI,NCHAR2)
	NACCT2=-1
	GO TO 1850

C TIME CHANGE
2090	TYPE 2100
2100	FORMAT('+IME CHANGE'/' CPU TIME = '$)
2110	CALL RALPH(ASCI,NCHAR)
	IF(NCHAR.EQ.0)  GO TO 2150
	CALL GETTIM(ASCI,TIME)
	CPU = TIME
2190	TYPE 2200
2200	FORMAT(' CONSOLE TIME = '$)
	CALL RALPH(ASCI,NCHAR)
	IF(NCHAR.EQ.0)  GO TO 2150
	CALL GETTIM(ASCI,TIME)
	CONS = TIME
	GO TO 1850
2150	CALL PSOUTR(' INCORRECT FORMAT')
	GO TO 1850

C FILE PAGE DISCOUNT
2220	TYPE 2230
2230	FORMAT('+ILE PAGE DISCOUNT = '$)
	ACCEPT 2240,FILFIX
2240	FORMAT(F)
	GO TO 1850

C LINES PRINTED
2215	TYPE 2216
2216	FORMAT ('+INE PRINTER PAGES = '$)
	ACCEPT 1530, LINES
	GO TO 1850

C CARDS READ
2217	TYPE 2218
2218	FORMAT ('+ARDS READ = '$)
	ACCEPT 1530,CARDS
	GO TO 1850

C $ TO BE CHARGED
2250	TYPE 2260
2260	FORMAT('+ TO BE CHARGED = '$)
	ACCEPT 2240,DOLLAR
	GO TO 1850

C REASON FOR CHARGE:
2270	TYPE 2280
2280	FORMAT('+EASON FOR CHARGE: '$)
	DO 2285 II = 1, 9
2285	REASON(II) = 0
	CALL RALPH(REASON,NCHAR)
	IF(NCHAR.EQ.0)  GO TO 1850
	SIZE=NCHAR/5+1
	REASON(9)=SIZE
	TEMP=SIZE*5-NCHAR-1
	IF(TEMP.EQ.0)  GO TO 1850
C FILL IN SPACES
	J="100
	DO 2290 I=1,TEMP
	J=128*J
2290	REASON(SIZE)=REASON(SIZE).OR.J
	GO TO 1850

C PAGE ADJUSTEMT
2300	TYPE 2310
2310	FORMAT('+AGE ADJUSTMENT = '$)
	ACCEPT 1530,PAGE
	GO TO 1850


C BEGIN ADJUSTMENT
2320	CALL PSOUTR('EGIN ADJUSTMENT')
	IF(INSERT)  GO TO 2370
	IF(NACCT1.NE.NBIT2.AND.USER.NE.-1)  GO TO 2360
	IF(USER.NE.-1)  GO TO 2340
	IF(NACCT1.EQ.NBIT2)  GO TO 2330
	IF(NACCT1.GE.0)  GO TO 2430
2330	CALL PSOUTR(' ILLEGAL ACCOUNT-USER COMBINATION')
	GO TO 1830
2340	IF(TYPE.GE.0)  GO TO 2330
	IF(NACCT2.EQ.NBIT2)  GO TO 2350
	CALL PSOUTR(' OLD ACCOUNT NOT GIVEN')
	GO TO 1830
2350	IF(DELETE)  GO TO 2430
	GO TO 2330
2360	CALL ACCT(-1,USER,NACCT1,0,0,0,0,0)
	IF(NACCT1.NE.NBIT2)  GO TO 2430
	CALL PSOUTR(' ACCOUNT-USER COMBINATION NONEXISTENT')
	GO TO 1830

C INSERT
2370	IF(REASON(1).NE.0.OR.DOLLAR.EQ.0.)  GO TO 2380
	CALL PSOUTR(' REASON FOR $ TO BE CHARGED NOT GIVEN')
	GO TO 1830
2380	IF(WORD(5).NE.NBIT2.AND.USER.NE.-1)  GO TO 2400
	IF(USER.NE.-1)  GO TO 2390
	CALL PSOUTR(' USER ID MISSING')
	GO TO 1830
2390	IF(TYPE.LT.0)  GO TO 2410
	CALL PSOUTR(' NUMERIC ACCOUNT MISSING')
	GO TO 1830
2400	IF((WORD(5).XOR.TYPE).GE.0)  GO TO 2420
	CALL PSOUTR(' ACCOUNT NO. AND USER ID OF MIXED TYPES')
	GO TO 1830
2410	IF(WORD(5).NE.NBIT2)  GO TO 2420
	WORD(5)=-4
	WORD(6)=STAR4
	WORD(1)=6
2420	TEMP=NID
	CALL ACCT(0,USER,NACCT1,0,0,0,0,0)
	IF(TEMP.EQ.NID)  GO TO 2430
	CALL CATEG(ID(NID))
	CALL DIRSTZ(USER,LOG(NID+1),NCHAR)
	LOG(NID+1)=LOG(NID+1).AND.SIXMSK


C ADJUSTMENTS
2430	IF(.NOT.DELETE)  GO TO 2630

C DELETE
	NACCT=NACCT1
	IF(USER.EQ.-1)  GO TO 2570
	DO 2440 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 2460
2440	CONTINUE
2450	CALL PSOUTR(' OPERATION ABORTED')
	GO TO 1830
2460	IF(NACCT1.EQ.NBIT2)  GO TO 2540
	ASSIGN 2470 TO LOCENT
	ASSIGN 2450 TO ENTNF
	GO TO 3320
2470	ACNT(IAC)=NBIT2
	EMPTY=EMPTY+1
	IF(IAC2.EQ.0)  GO TO 2490
	ACNT(IAC2+1)=(ACNT(IAC+1).AND.R7).OR.(ACNT(IAC2+1).AND.L7)
	1            .OR.(ACNT(IAC+1).AND.BIT0)
2480	IF((ACNT(IAC+1).AND.L7).EQ.0)  GO TO 2530
	ASSIGN 2530 TO SPAD
	GO TO 3340
2490	IF(ACNT(IAC+1).LT.0)  GO TO 2500
	ID(I)=(ID(I).AND.R7).OR.((ACNT(IAC+1).AND.R7)*BIT17).OR.
	1     (ID(I).AND.BIT0)
	GO TO 2480
2500	IF((ACNT(IAC+1).AND.L7).EQ.0)  GO TO 2510
	ASSIGN 2510 TO SPAD
	GO TO 3340
2510	DO 2520 J=I,NID
	LOG(J+1)=LOG(J+2)
2520	ID(J)=ID(J+1)
	NID=NID-1
	I=I-1
2530	IF(.NOT.DELETE)  GO TO 2710
	IF(NACCT1.EQ.NBIT2)  GO TO 1790
	IF(USER.EQ.-1)  GO TO 2580
	GO TO 1790
C DELETE ALPHANUMERIC USER
2540	IAC=(ID(I).AND.L7)/BIT17
2550	IAC=IAC.AND.R7
	NACCT=ACNT(IAC).AND.ACTMSK
	ACNT(IAC)=NBIT2
	EMPTY=EMPTY+1
	IF((ACNT(IAC+1).AND.L7).EQ.0)  GO TO 2560
	ASSIGN 2560 TO SPAD
	GO TO 3340
2560	IAC=ACNT(IAC+1)
	IF(IAC.GT.0)  GO TO 2550
	GO TO 2510
C DELETE ACCOUNT
2570	I=0
2580	I=I+1
	IF(ID(I).EQ.0)  GO TO 2590
	ASSIGN 2470 TO LOCENT
	ASSIGN 2580 TO ENTNF
	GO TO 3320
2590	IF(NACCT1.LT.0)  GO TO 1790
	DO 2600 I=1,NNACT
	IF(NACCT1.EQ.ACTNM(I))  GO TO 2610
2600	CONTINUE
	GO TO 2450
2610	DO 2620 J=I,NNACT
2620	ACTNM(J)=ACTNM(J+1)
	NNACT=NNACT-1
	GO TO 1790

C NEW ACCOUNT
2630	IF(NACCT2.EQ.NBIT2)  GO TO 2760
	WORD(5)=NACCT2
	IF(NACCT2.GE.0)  GO TO 2650
	WORD(5)=-NCHAR2
	SIZE=(NCHAR2+4)/5
	WORD(1)=SIZE+5
	DO 2640 I=1,SIZE
2640	WORD(5+I)=ASCI(I)
2650	IF(USER.EQ.-1)  GO TO 2730
	DO 2660 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 2670
2660	CONTINUE
	GO TO 2450
2670	NACCT=NACCT1
	ASSIGN 2680 TO LOCENT
	ASSIGN 2450 TO ENTNF
	GO TO 3320
2680	AC1=IAC
	TEMP=ID(I).AND.R7
	CALL ACCT(0,TEMP,NACCT2,0,0,0,0,0)
	NACCT=NACCT2
	ASSIGN 2690 TO LOCENT
	ASSIGN 2450 TO ENTNF
	GO TO 3320
2690	DO 2700 J=2,4
2700	ACNT(IAC+J)=ACNT(IAC+J)+ACNT(AC1+J)
	NACCT=NACCT1
	GO TO 2460
2710	IF(USER.EQ.-1)  GO TO 2740
	IF(NACCT1.LT.0)  GO TO 1790
	DO 2720 IA=2,IACF,ACNTSZ
	IF((ACNT(IA).AND.ACTMSK).EQ.NACCT1)  GO TO 1790
2720	CONTINUE
	GO TO 2590
C ALL USERS
2730	I=0
2740	I=I+1
	IF(ID(I).EQ.0)  GO TO 2590
	NACCT=NACCT1
	ASSIGN 2750 TO LOCENT
	ASSIGN 2740 TO ENTNF
	GO TO 3320
2750	GO TO 2680

C SPECIAL CHARGES
2760	IF(REASON(1).EQ.0)  GO TO 2840
	IF(USER.NE.-1)  GO TO 2770
	CALL PSOUTR(' USER ID MISSING')
	GO TO 1830
2770	DO 2780 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 2790
2780	CONTINUE
	GO TO 2450
2790	NACCT=NACCT1
	ASSIGN 2800 TO CLASS
	GO TO 3140
2800	IF((NACCT.AND.BIT12).NE.0)  GO TO 2810
	CALL PSOUTR(' NO SPECIAL CHARGES FOR NONCHARGEABLE ACCOUNTS')
	GO TO 1830
2810	NACCT=NACCT1
	ASSIGN 2820 TO LOCENT
	ASSIGN 2450 TO ENTNF
	GO TO 3320
2820	ACNT(IAC+1)=ACNT(IAC+1).OR.BIT17
	S=SP(1)
	K=REASON(9)+3
	SP(1)=SP(1)+K
	SP(S)=K.OR.(USER*BIT17)
	SP(S+1)=NACCT1
	SP(S+2)=DOLLAR*100.
	DO 2830 I=1,REASON(9)
2830	SP(S+I+2)=REASON(I)
	GO TO 1790

C CONS,CPU & PAGE CHARGES
C FILE CHARGE DISCOUNT
C DOLLARS TO BE CHARGED
2840	NACCT=NACCT1
	ASSIGN 2850 TO CLASS
	GO TO 3140
2850	ACODE=NACCT.AND.BIT12
	IF(ACODE.EQ.BIT1)  GO TO 2870
	IF(ACODE.EQ.BIT2)  GO TO 2860
	IF(DOLLAR.EQ.0.)  GO TO 2870
	CALL PSOUTR(' NO DOLLAR CHARGES FOR NONCHARGEABLE ACCOUNTS')
	GO TO 1830
2860	RCPU=GRCPU
	RCON=GRCON
	GO TO 2880
2870	RCPU=CRCPU
	RCON=CRCON
2880	IF(USER.EQ.-1)  GO TO 2950
	DO 2890 I=1,NID
	IF((ID(I).AND.R7).EQ.USER)  GO TO 2900
2890	CONTINUE
	GO TO 2450
2900	NACCT=NACCT1
	ASSIGN 2910 TO LOCENT
	ASSIGN 2450 TO ENTNF
	GO TO 3320
2910	TCPU=ACNT(IAC+2)
	TCONS=ACNT(IAC+3)
2920	DCPU=TCPU/60.*RCPU
	DCON=TCONS/3600.*RCON
	CHARGE=DCPU+DCON
	CPU2=CPU
	CON2=CONS
	IF(CHARGE.EQ.0.)  GO TO 2930
	CPU2=DCPU/CHARGE*DOLLAR/RCPU*60.+CPU2
	CON2=DCON/CHARGE*DOLLAR/RCON*3600.+CON2
2930	IF((CPU2+TCPU).GE.0..AND.(CON2+TCONS).GE.0.)  GO TO 2940
	CALL PSOUTR(' ADJUSTMENT RESULTS IN NEGATIVE CPU OR CONSOLE
	1 TIME')
	GO TO 1830
2940	IF(USER.EQ.-1)  GO TO 2980
	ACNT(IAC+ACTCPU)=IFIXR(TCPU+CPU2)
	ACNT(IAC+ACTCON)=IFIXR(TCONS+CON2)
	ACNT(IAC+ACTFIL)=IFIXR((ACNT(IAC+ACTFIL)+PAGE)*FILFIX)
	IF ( ACNT(IAC+ACTCDR)+CARDS  .GE. 0 ) GO TO 2943
	CALL PSOUTR ('? ADJUSTMENT RESULTS IN NEGATIVE # OF CARDS READ')
	GO TO 1850
2943	IF ( ACNT(IAC+ACTLPT)+LINES  .GE. 0 ) GO TO 2945
	CALL PSOUTR('? ADJUSTMENT RESULTS IN NEGATIVE # OF LINES PRINTED')
2945	ACNT(IAC+ACTLPT)=ACNT(IAC+ACTLPT)+LINES
	ACNT(IAC+ACTCDR)=ACNT(IAC+ACTCDR)+CARDS
	GO TO 1790
C ALL USERS
2950	NACCT=NACCT1
	TCPU=0
	TCONS=0
	TPAGE=0
	DO 2970 I=1,NID
	ASSIGN 2960 TO LOCENT
	ASSIGN 2970 TO ENTNF
	GO TO 3320
2960	TCPU=TCPU+ACNT(IAC+2)
	TCONS=TCONS+ACNT(IAC+3)
	TPAGE=TPAGE+ACNT(IAC+4)
2970	CONTINUE
	GO TO 2920
2980	DO 3030 I=1,NID
	ASSIGN 2990 TO LOCENT
	ASSIGN 3030 TO ENTNF
	GO TO 3320
2990	IF(TCPU.EQ.0)  GO TO 3000
	ACNT(IAC+2)=IFIXR(ACNT(IAC+2)*(1.+CPU2/TCPU))
3000	IF(TCONS.EQ.0)  GO TO 3010
	ACNT(IAC+3)=IFIXR(ACNT(IAC+3)*(1.+CON2/TCONS))
3010	XTEM=ACNT(IAC+4)*FILFIX
	IF(TPAGE.EQ.0)  GO TO 3020
	XTEM=ACNT(IAC+4)*(1.+(PAGE+0.)/TPAGE)*FILFIX
3020	ACNT(IAC+4)=IFIXR(XTEM)
3030	CONTINUE
	GO TO 1790



C (TZERO) - ZERO TOTALS
3040	TCPU=0
	TCONS=0
	TPAGE=0
	TLINES=0
	TCARDS=0
	TOTHER=0.
	TCHARG=0.
	GO TO TZERO

C (OUT) - OUTPUT CHARGES
3050	CHARGE=0.
	IF(ACODE.EQ.BIT1)  GO TO 3060
	IF(ACODE.EQ.0)  GO TO 3070
	CHARGE=CHARG(GRCPU,GRCON,GRCHAR,GRLINE,GRCARD)
	GO TO 3070
3060	CHARGE=CHARG(CRCPU,CRCON,CRCHAR,CRLINE,CRCARD)

3070	CHARGE=IFIXR(CHARGE*100.)/100.
	TCPU=TCPU+CPU
	TCONS=TCONS+CONS
	TPAGE=TPAGE+PAGE
	TLINES=TLINES+LINES
	TCARDS=TCARDS+CARDS
	TOTHER=TOTHER+OTHER
	TCHARG=TCHARG+CHARGE
	IF(SUMARY)  GO TO OUT

3080	TIME=CPU
	IND=1
	GO TO 3130
3090	ENCODE(20,3100,ASCI) HOUR,MIN,SEC
3100	FORMAT(I6,':'I2,':'I2,2X)
	ASCI(3)=ASCI(3).AND..NOT."377
	CALL SOUTZ(ASCI)
	TIME=CONS
	IND=2
	GO TO 3130
3110	ENCODE (20,3100,ASCI) HOUR,MIN,SEC
	ASCI(3)=ASCI(3).AND..NOT."377
	CALL SOUTZ(ASCI)
	ENCODE(53,3120,ASCI) PAGE,LINES,CARDS,OTHER,CHARGE
3120	FORMAT(I10,2X,I8,2X,I8,F11.2,F12.2)
	ASCI(11)=ASCI(11).AND."777777700000
	CALL SOUTCR(ASCI)
	GO TO OUT
3130	MIN=TIME/60
	SEC=TIME-MIN*60
	HOUR=MIN/60
	MIN=MIN-HOUR*60
	GO TO (3090,3110),IND


C (CLASS) - CLASSIFY ACCOUNT NUMBERS BY CHARGE CLASS
C GOVERNMENT RATE(01),COMMERCIAL RATE(10),FREE(00)
C
C	CURRENT CLASSIFICATION ALGORITHM --
C		NUMERIC ACCOUNTS < 1000 ARE NON-CHARGEABLE
C		ALL OTHER ACCOUNTS ARE COMMERCIAL RATE
C		GOVERNMENT RATE IS NOT USED
3140	IF((NACCT.AND.BIT12).NE.0)  GO TO CLASS
	IF ( NACCT .LT. 0 ) GO TO 3180
C NUMERIC ACCOUNTS
	TEMP = NACCT
C NON-CHARGEABLE ACCOUNTS
	IF(TEMP.LE.999)  GO TO CLASS
C COMMERCIAL RATE
3150	NACCT=TEMP.OR.BIT1
	GO TO CLASS
C GOVERNMENT RATE
3160	NACCT=TEMP.OR.BIT2
3170	GO TO CLASS
C ALPHANUMERIC ACCOUNTS
C COMMERCIAL RATE
3180	NACCT = NACCT .OR. BIT1
	GO TO CLASS


C (NAME) - OUTPUT USER NAME
3190	CALL DIRSTZ(USER,ASCI,NCHAR)
	IF(NCHAR.GT.0)  GO TO 3210
	ENCODE(31,3200,ASCI) USER
3200	FORMAT('*USER ID CODE ',O6,' NOT IN USE')
	ASCI(7)=ASCI(7).AND.LBYTE
	CALL SOUTZ(ASCI)
	GO TO 3260
3210	CALL SOUTZ(ASCI)
3220	IF (NCHAR-10)  3230,3270,3260
3230	IF (NCHAR.GT.5)  GO TO 3240
	CALL SOUTZ('     ')
	IF (NCHAR.EQ.5)  GO TO 3270
3240	TEMP=5-NCHAR+NCHAR/5*5
	DO 3250 J=1,TEMP
3250	CALL SOUTZ(BIT1)
	GO TO 3270
3260	CALL SOUTZ(CRLF)
	CALL SOUTZ('          ')
3270	GO TO NAME

C (ACTNO) - OUTPUT ACCOUNT NUMBER
3280	IF(NACCT.LT.0)  GO TO 3300
C NUMERIC
	NACCT=NACCT.AND.ACTMSK
	ENCODE(10,3290,ASCI) NACCT
3290	FORMAT(I9,1X)
	ASCI(3)=0
	CALL SOUTZ(ASCI)
	GO TO ACTNO
C ALPHANUMERIC
3300	IA=(NACCT.XOR.BIT0).AND.ACTMSK
	NCHAR=(ACTAL(IA).AND.L7)/BIT17
	LIM = NCHAR / 5
	IF ( NCHAR .GT. LIM*5 ) LIM = LIM + 1
	DO 3304 I = 1,10
3304	TEXT(I) = 0
	DO 3305 I = 1, LIM
3305	TEXT(I) = ACTAL(I+IA)
	CALL SOUTZ(TEXT)
	ASSIGN 3310 TO NAME
	GO TO 3220
3310	GO TO ACTNO

C (LOCENT) - LOCATE ENTRY
C (ENTNF) - ENTRY NOT FOUND
3320	IAC2=0
	NACCT=NACCT.AND.ACTMSK
	IAC=(ID(I).AND.L7)/BIT17
3330	TEM=ACNT(IAC+ACTACT).AND.ACTMSK
	IF(TEM.EQ.NACCT)  GO TO LOCENT
	IF(ACNT(IAC+ACTPTR).LT.0)  GO TO ENTNF
	IAC2=IAC
	IAC=ACNT(IAC+ACTPTR).AND.R7
	GO TO 3330

C (SPAD) - SPECIAL CHARGES - ADDED OR DELETED
3340	K=0
	S=2
3350	S=S+K
	IF(S.EQ.SP(1))  GO TO SPAD
	IF(SP(S).LT.0)  GO TO 3390
	IF(USER.EQ.-1)  GO TO 3360
	USE=(ID(I).AND.R7)*BIT17
	IF(USE.NE.(SP(S).AND.L7))  GO TO 3390
3360	IF(NACCT1.EQ.NBIT2)  GO TO 3370
	TEM=SP(S+1).AND.ACTMSK
	IF((NACCT.AND.ACTMSK) .NE. TEM)  GO TO 3390
3370	IF(COMND3.EQ.0)  GO TO 3380
	SP(S)=SP(S).OR.BIT0
	GO TO 3390
3380	IF(ITEM)  GO TO 3400
	OTHER=OTHER+SP(S+2)/100.
	SPL=.TRUE.
3390	K=SP(S).AND.R7
	GO TO 3350
C ITEMIZE
3400	IF(NACCT1.EQ.NBIT2)  GO TO 3420
	USER=(SP(S).AND.L7)/BIT17
	ASSIGN 3410 TO NAME
	GO TO 3190
3410	USER=-1
	GO TO 3430
3420	NACCT=SP(S+1)
	ASSIGN 3430 TO ACTNO
	GO TO 3280
3430	CALL SOUTZ(BIT1)
	CALL SOUTZ(SP(S+3))
	SIZE=(SP(S).AND.R7)-3
	TEMP=8-SIZE
	IF(SIZE.EQ.0)  GO TO 3450
	DO 3435 II = 1, 10
3435	TEXT(II) = 0
	DO 3440 II=1,SIZE
3440	TEXT(II) = SP( (S+3)+II-1 )
	NCHAR = 0
	DO 3442 II = 1, 8
	DO 3442 J = 1, 5
	K = CH(J) .AND. TEXT(II)
	IF ( K .NE. 0 ) NCHAR = NCHAR + 1
3442	CONTINUE
	CALL SOUTZ(TEXT)
	DO 3444 II = 1, 39-NCHAR
3444	CALL SOUTZ( BIT1 )
3450	OTHER=SP(S+2)/100.
	ENCODE(10,3460,ASCI) OTHER
3460	FORMAT(F9.2,1X)
	ASCI(3)=0
	CALL SOUTCR(ASCI)
	GO TO 3390

C	READ DEFAULT ACCOUNT FILE

4000	TYPE 4100
4100	FORMAT ('+ALIDATE ACCOUNTS'/' FILE OF DEFAULT ACCOUNTS: '$)
	CALL ASCIF (0)
	ASSIGN 5000 TO EOF

	DEFNDX = 1 - DEFSIZ
4200	DEFNDX = DEFNDX + DEFSIZ
4210	NCHAR = 39
	DO 4250 II = 1, 15
4250	ASCI(II) = 0
	CALL SINA (ASCI,EOF,NCHAR)
	CALL STDIR2(ASCI,USER)
	IF ( USER .EQ. -1 ) GO TO 4210
	DEFALT(DEFNDX+DEFUSR) = USER
	DO 4270 II = 1, 15
4270	ASCI(II) = 0
	CALL SINA2 (ASCI,EOF,NCHAR)
	CALL TSTNUM (ASCI, NACCT)
	IF (NACCT .EQ. -1) GO TO 4300
	DEFALT(DEFNDX+DEFACT) = NACCT
	GO TO 4200

C HERE FOR ALPHANUMERIC ACCOUNTS

4300	I = 1
	NWORDS = NCHAR / 5
	IF ( MOD(NCHAR,5) .NE. 0 )NWORDS=NWORDS+1
4400	K = ACTAL(I) .AND. R7
	IF ( K .EQ. 0 ) GO TO 4700
	IF ( K .NE. NWORDS ) GO TO 4600
	DO 4500 J = 1, NWORDS
4500	IF ( ACTAL(I+J) .NE. ASCI(J) )GO TO 4600
	DEFALT(DEFNDX+DEFACT) = I .OR. BIT0
	GO TO 4200
4600	I = I + K + 1
	GO TO 4400
4700	DEFALT(DEFNDX+DEFACT) = I .OR. BIT0
	ACTAL(I) = NCHAR*BIT17 + NWORDS
	DO 4800 J = 1, NWORDS
	ACTAL(I+J) = ASCI(J)
4800	ACTAL(I+J+1) = 0
	GO TO 4200
5000	DO 5010 I = 1, LEGMAX
5010	LEGACT(I) = -1
	TYPE 5025
5025	FORMAT (' FILE OF VALID ACCOUNTS: '$)
	CALL ASCIF(0)
	ASSIGN 6000 TO EOF
	LEGNDX = 1
5050	DO 5100 II = 1, 15
5100	ASCI(II) = 0
	NCHAR = 39
	CALL SINA2 (ASCI,EOF,NCHAR)
	CALL TSTNUM (ASCI, NACCT)
	IF (NACCT .EQ. -1) GO TO 5200
	LEGACT(LEGNDX) = NACCT
	LEGNDX = LEGNDX + 1
	IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
	GO TO 5050
5200	I = 1
	NWORDS = NCHAR / 5
	IF ( MOD(NCHAR,5) .NE. 0 )NWORDS=NWORDS+1
5400	K = ACTAL(I) .AND. R7
	IF ( K .EQ. 0 ) GO TO 5700
	IF ( K .NE. NWORDS ) GO TO 5600
	DO 5500 J = 1, NWORDS
5500	IF ( ACTAL(I+J) .NE. ASCI(J) )GO TO 5600
	LEGACT(LEGNDX) = I .OR. BIT0
	LEGNDX = LEGNDX + 1
	IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
	GO TO 5050
5600	I = I + K + 1
	GO TO 5400
5700	LEGACT(LEGNDX) = I .OR. BIT0
	ACTAL(I) = NCHAR*BIT17 + NWORDS
	DO 5800 J = 1, NWORDS
	ACTAL(I+J) = ASCI(J)
5800	ACTAL(I+J+1) = 0
	LEGNDX = LEGNDX + 1
	IF ( LEGNDX .GE. LEGMAX ) GO TO 5900
	GO TO 5050
5900	TYPE 5950
5950	FORMAT ('? ACCT20: INTERNAL ERROR')

C VALIDATE THE ACCOUNT FOR EACH ACCOUNT-USER ENTRY

6000	IF ( NID .LT. 1 ) GO TO 40
	DO 6900 I = 1, NID
	USER = ID(I) .AND. R7
	OLDIAC = 0
	IAC  = ( ID(I) .AND. L7 )/BIT17
	DEFIAC = 0

6200	NACCT = ACNT( IAC+ACTACT ) .AND. ACTMSK
	DO 6300 J = 1,LEGNDX-1
6300	IF ( NACCT .EQ. LEGACT(J) )GO TO 6800
	DO 6400 J = 1,DEFNDX,DEFSIZ
6400	IF ( DEFALT(J+DEFUSR) .EQ. USER )GO TO 6600
	CALL PSOUTZ (' DEFAULT ACCOUNT NOT FOUND FOR USER ')
	DO 6450 II = 1,15
6450	ASCI(II) = 0
	CALL DIRSTZ (USER,ASCI,NCHAR)
	CALL PSOUTR (ASCI)
	GO TO 6900
6600	IF ( DEFALT(J+DEFACT) .LT. 0 ) ID(I) = ID(I) .OR. BIT0
	IF ( DEFALT(J+DEFACT) .LT. 0 ) GO TO 6650
	NNACT = NNACT + 1
	ACTNM(NNACT) = DEFALT(J+DEFACT)
	ACTNM(NNACT+1) = -1
6650	IF ( DEFIAC .NE. 0 ) GO TO 6700
	ACNT(IAC+ACTACT) = DEFALT(J+DEFACT)
	1	.OR. (ACNT(IAC+ACTACT).AND.BIT12)
	DEFIAC = IAC
	GO TO 6800
6700	ACNT(DEFIAC+ACTCPU) = ACNT(DEFIAC+ACTCPU) + ACNT(IAC+ACTCPU)
	ACNT(DEFIAC+ACTCON) = ACNT(DEFIAC+ACTCON) + ACNT(IAC+ACTCON)
	ACNT(DEFIAC+ACTFIL) = ACNT(DEFIAC+ACTFIL) + ACNT(IAC+ACTFIL)
	ACNT(DEFIAC+ACTLPT) = ACNT(DEFIAC+ACTLPT) + ACNT(IAC+ACTLPT)
	ACNT(DEFIAC+ACTCDR) = ACNT(DEFIAC+ACTCDR) + ACNT(IAC+ACTCDR)
	ACNT(IAC+ACTACT) = NBIT2
	EMPTY = EMPTY + 1
	IF ( OLDIAC .EQ. 0 ) GO TO 6720
	ACNT(OLDIAC+ACTPTR) = (  ACNT(IAC+ACTPTR) .AND. R7    )
	1		.OR.  (  ACNT(IAC+ACTPTR) .AND. BIT0  )
	2		.OR.  (  ACNT(OLDIAC+ACTSP) .AND. L7  )
	GO TO 6800
6720	IF (  ACNT(IAC+ACTPTR) .LT. 0  ) GO TO 6740
	ID(I) = ( ID(I) .AND. R7 )  .OR.  ( ID(I) .AND. BIT0 )
	1	.OR. (( ACNT(IAC+ACTPTR).AND.R7)*BIT17)
	GO TO 6800
6740	DO 6760 J = I, NID
	LOG(J+1) = LOG(J+2)
6760	ID(J) = ID(J+1)
6800	OLDIAC = IAC
	IAC = ACNT(IAC+ACTPTR) .AND. R7
	IF (IAC .NE. 0) GO TO 6200
6900	CONTINUE
7000	IF (IACF .EQ. 0) IACF = -3+ACNTSZ*NENTRY
	I = 1
7100	DO 7200 IAC = 2, IACF, ACNTSZ
	IF ( ACNT(IAC+ACTACT) .EQ. NBIT2 ) GO TO 7200
	IF (ACTNM(I).EQ.(ACNT(IAC+ACTACT).AND.ACTMSK)) GO TO 7400
7200	CONTINUE
	NNACT = NNACT - 1
	J = I
7300	ACTNM(J) = ACTNM(J+1)
	IF (ACTNM(J) .EQ. -1) GO TO 7500
	J = J + 1
	GO TO 7300
7400	I = I + 1
7500	IF ( ACTNM(I) .NE. -1 ) GO TO 7100
	GO TO 40
	END

C       DATA

	BLOCK DATA
	IMPLICIT INTEGER (A-Z)
	COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7,ACTMSK,NBIT2
	COMMON /OUT/ZERO,CRLF,CRLF2,FORMF
	COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
	1 ACTFIL, ACTLPT, ACTCDR
	DATA ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU / 7, 0, 1, 1, 2 /
	DATA ACTCON, ACTFIL, ACTLPT, ACTCDR / 3, 4, 5, 6 /
	DATA BIT0,BIT1,BIT2/"400000000000,"200000000000,"100000000000/
	DATA BIT12,BIT17/"300000000000,"1000000/
	DATA L7,R7,ACTMSK/"377777000000,"777777,"477777777777/
	DATA CRLF,CRLF2,ZERO/"64240000000,"64241505000,0/
	DATA FORMF/"60000000000/
	DATA NBIT2/"677777777777/
	END

C       RFACT
C       SUBROUTINE THAT READS IN BINARY FACT FILES

	SUBROUTINE RFACT(N)

C       N=-2; ZERO HIST(I,J)
C       N=-1; OUTPUT HISTOGRAM
C       N=0 ; READ FACT FILE
C       N=1 ; PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT

	IMPLICIT INTEGER (A-Z)
	REAL XTEM
	LOGICAL BOUTF,ACTINF
	COMMON /OUTB/BOUTF,ACTINF
	COMMON /DATES/ BEGTAD, ENDTAD
	COMMON /ENTRY/WORD(40),NID,NENTRY,NNACT,NFLCK,NCRASH,UPTIME,
	1 EMPTY, MINSIZ
	COMMON /FACT/LOG(1001),ASCI(15),PAYDT(8)
	COMMON /BDATA/BIT0,BIT1,BIT2,BIT12,BIT17,L7,R7
	COMMON /ACTDEF/ ACNTSZ, ACTACT, ACTSP, ACTPTR, ACTCPU, ACTCON,
	1 ACTFIL, ACTLPT, ACTCDR
	DIMENSION ETYPES(5), MINLEN(5)
	DIMENSION HIST(40,20), TEXT(10)
	DATA ETYPES / "401000000000, "402000000000, "501000000000,
	1 "502000000000, "601000000000 /
	DATA MINLEN /   8,   8,   5,   5,   5 /
	DATA DEBUG /.FALSE./
	DATA NTYPES / 4 /
	DATA JBMSK, DETFLG/"777000000, "001000000000 /
	DATA T1,N1,M1,T2,N2,M2/5,3,9,5,3,5/

C CONSTM(A,B) - COMPUTES THE CONSOLE TIME IN MSEC BETWEEN DATE A
C               AND DATE B ; A & B ARE IN SYSTEM FORMAT
	CONSTM(A,B)=(((B.AND.L7)-(A.AND.L7))/BIT17*86400+
	1           (B.AND.R7)-(A.AND.R7))*1000
	IF (N)  830,10,610
10	TYPE 20
20	FORMAT ('+EAD FACT FILE: '$)
	ASSIGN 120 TO EOF
	CALL OPENFZ(1)
	IF(ACTINF)  GO TO 30
	IF ( .NOT. DEBUG ) GO TO 40
	CALL SOUTCR('   INT. DATE       LOCAL TIME         COMMENT')
	GO TO 40
30	CALL SOUTZ('  USER      DIR   ACCOUNT       DATE         ')
	CALL SOUTCR('CPU    CONSOLE')
40	WORDNO=-1
50	IF ( LASTDT .LT. WORD(3) ) LASTDT=WORD(3)
60	CALL RWORD(WORD(1),EOF)
	WORDNO=WORDNO+1
	SIZE=WORD(1).AND."77
	IF(SIZE.NE.0)  GO TO 70
	SIZE=1
	GO TO 180
70	CODE=WORD(1).AND."777000000000
	DO 71 AETYPE = 1, NTYPES
71	IF ( CODE .EQ. ETYPES(AETYPE) ) GO TO 130
	IF (CODE .EQ. "601000000000) GO TO 75
	COD=WORD(1).AND."777000000077
	IF(COD.NE."141000000005.AND.COD.NE."142000000003.AND.  COD.NE."143
	1000000003.AND.COD.NE."201000000005.AND.  COD.NE."740000000001.AND.
	2COD.NE."741000000003.AND.  COD.NE."540000000001)  GO TO 180
	IF (SIZE.EQ.1)  GO TO 90
75	DO 80 I=2,SIZE
	CALL RWORD(WORD(I),EOF)
80	WORDNO=WORDNO+1
	WORD(2)=WORD(2) .AND. R7
90	IF(WORD(3).EQ.-1)  WORD(3)=LASTDT
	ENCODE(15,100,ASCI) WORD(3)
100	FORMAT(2X,O12,1X)
	ASCI(4)=0
	DATE=WORD(3)
	IF ( DATE .LT. BEGTAD ) BEGTAD=DATE
	IF ( DATE .GT. ENDTAD ) ENDTAD=DATE
	IF(UPTIME.GE.0.OR.SIZE.LT.3)  GO TO 110
	OLDATE=WORD(3)
	UPTIME=0
110	IF (CODE.EQ."143000000000)  GO TO 2000
	IF (CODE.EQ."142000000000)  GO TO 2500
	IF (CODE.EQ."501000000000)  GO TO 220
	IF (CODE.EQ."401000000000)  GO TO 1000
	IF (CODE.EQ."402000000000)  GO TO 1500
	IF (CODE.EQ."141000000000)  GO TO 330
	IF (CODE.EQ."502000000000)  GO TO 390
	IF (CODE.EQ."201000000000)  GO TO 440
	IF (CODE.EQ."601000000000)  GO TO 50
	IF (CODE.EQ."540000000000)  GO TO 50
	IF (CODE.EQ."740000000000)  GO TO 520
	IF (CODE.EQ."741000000000)  GO TO 550
	GO TO 50
120	CALL SOUTCR('END OF FILE')
	DO 121 II = 1,20
121	ASCI(II) = 0
	CALL GETPER(BEGTAD,ENDTAD,PAYDT)
	RETURN
C CHECK 501,502 AND 601 ENTRIES
130	MINSIZ = MINLEN(AETYPE)
	IF( SIZE .LT. MINSIZ   ) GO TO 180
	IF( SIZE .GT. MINSIZ+8 ) GO TO 180
	DO 140 I=2,MINSIZ
	CALL RWORD(WORD(I),EOF)
140	WORDNO=WORDNO+1
	WORD(2)=WORD(2) .AND. R7
	IF(WORD(MINSIZ).LT.0)  GO TO 150
	IF(SIZE.EQ.MINSIZ)  GO TO 90
	GO TO 170
150	TEMP = - WORD(MINSIZ)
	TSIZE = TEMP/5
	IF ( MOD(TEMP,5) .NE. 0 ) TSIZE=TSIZE+1
	TSIZE = TSIZE + MINSIZ
	IF ( TSIZE .NE. SIZE ) GO TO 170
	DO 160 I=1,SIZE-MINSIZ
	CALL RWORD(WORD(I+MINSIZ),EOF)
	TEXT(I) = WORD(I+MINSIZ)
	TEXT(I+1)=0
160	WORDNO=WORDNO+1
	CALL TSTNUM(TEXT,NACCT)
	IF (NACCT .NE. -1 ) WORD(MINSIZ)=NACCT
	GO TO 90
170	NERR=5
	GO TO 190
C FACT FILE ERROR
180	NERR=1
190	WORDNO=WORDNO-NERR
	DO 210 I=1,NERR
	IF ( .NOT. DEBUG ) GO TO 60
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTZ('FACT FILE ERROR')
	WORDNO=WORDNO+1
	ENCODE(20,200,WORD(6)) WORDNO,WORD(I)
200	FORMAT(2X,O5,O13)
	WORD(10)=0
210	CALL SOUTCR(WORD(6))
	GO TO 60

C LOGIN
220	JOBN=WORD(1).AND.JBMSK
	ILG=1
230	IF (LOG(ILG).EQ.-2)  GO TO 240
	IF ((LOG(ILG).AND.JBMSK).EQ.JOBN)  GO TO 280
	ILG=ILG+5
	GO TO 230
C CORRECT LOGIN
240	DO 250 JLG=1,ILG,5
	IF (LOG(JLG).EQ.-1)  GO TO 270
250	CONTINUE
	LOG(ILG+5)=-2
260	JLG=ILG
270	LOG(JLG)=JOBN.OR.WORD(2)
	CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
	LOG(JLG+1)=NACCT
	LOG(JLG+2)=WORD(3)
	LOG(JLG+3)=-1
	GO TO 50
C ALREADY LOGGED IN
280	USER=LOG(ILG).AND.R7
	IF (.NOT. DEBUG ) GO TO 300
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	IF (USER.NE.WORD(2))  GO TO 290
	CALL SOUTCR('ALREADY LOGGED IN')
	GO TO 300
290	CALL SOUTCR('ALREADY LOGGED IN UNDER DIFFERENT ID')
300	IF (LOG(ILG+3).NE.-1)  GO TO 310
	CPUT=0
	CONST=0
	GO TO 320
310	CPUT=LOG(ILG+4)
	CONST=CONSTM(LOG(ILG+2),LOG(ILG+3))
320	ASSIGN 260 TO ACOUNT
	GO TO 640

C LOGOUT
330	JOBN=WORD(1).AND.JBMSK
	ILG=1
340	IF (LOG(ILG).EQ.-2)  GO TO 380
	IF ((LOG(ILG).AND.JBMSK).EQ.JOBN)  GO TO 350
	ILG=ILG+5
	GO TO 340
350	USER=LOG(ILG).AND.R7
	IF (USER.EQ.WORD(2))  GO TO 360
	IF (.NOT. DEBUG ) GO TO 360
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('LOGOUT ID CODE DIFFERENT FROM LOGIN')
360	CPUT=WORD(4)
	CONST=WORD(5)
	ASSIGN 370 TO ACOUNT
	GO TO 640
370	LOG(ILG)=-1
	IF (LOG(ILG+5).EQ.-2)  LOG(ILG)=-2
	GO TO 740
380	IF (.NOT. DEBUG ) GO TO 740
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('LOGOUT WITHOUT LOGIN')
	GO TO 740

C ACCOUNT NUMBER CHANGE
390	JOBN=WORD(1).AND.JBMSK
	ILG=1
400	IF (LOG(ILG).EQ.-2)  GO TO 430
	IF ((LOG(ILG).AND.JBMSK).EQ.JOBN)  GO TO 410
	ILG=ILG+5
	GO TO 400
410	USER=LOG(ILG).AND.R7
	IF (USER.EQ.WORD(2))  GO TO 420
	IF (.NOT. DEBUG ) GO TO 420
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('ACCT NO. CHANGE WITH DIFFERENT ID CODE')
420	CONST=CONSTM(LOG(ILG+2),WORD(3))
	CPUT=WORD(4)
	ASSIGN 260 TO ACOUNT
	GO TO 640
430	IF (.NOT. DEBUG ) GO TO 240
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('ACCT NO. CHANGE WITHOUT LOGIN')
	GO TO 240

C CHKPNT
440	JOBN=WORD(1).AND.JBMSK
	IF (JOBN.NE.0)  GO TO 450
	IF (.NOT. DEBUG ) GO TO 450
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('START CHECKPOINT')
450	ILG=1
460	IF (LOG(ILG).EQ.-2)  GO TO 490
	IF ((LOG(ILG).AND.JBMSK).EQ.JOBN)  GO TO 470
	ILG=ILG+5
	GO TO 460
470	IF ( LOG(ILG+2) .GE. WORD(3) ) GO TO 50
	IF ((LOG(ILG).AND.R7).EQ.WORD(2))  GO TO 480
	IF (.NOT. DEBUG ) GO TO 480
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('CHKPNT WITH DIFFERENT ID CODE')
480	IF (  (LOG(ILG) .AND. DETFLG) .NE. 1 ) LOG(ILG+3)=WORD(3)
	LOG(ILG+4)=WORD(4)
	GO TO 50
490	IF (.NOT. DEBUG ) GO TO 50
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('CHKPNT FOR JOB NOT LOGGED IN')
	GO TO 50

C START OF DISC UTILIZATION STATISTICS
500	IF (.NOT. DEBUG ) GO TO 505
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('START DISC UTILIZATION STATISTICS')
505	NFLCK=NFLCK+1
	GO TO 50

C DISK UTILIZATION
510	CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
	CALL ACCT(1,WORD(2),NACCT,0,0,WORD(4),0,0)
	GO TO 50

C SYSTEM RESTARTED FROM SCRATCH
520	IF (.NOT. DEBUG ) GO TO 525
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('SYSTEM RESTARTED')
525	NCRASH=NCRASH+1
	ILG=-4
530	ILG=ILG+5
	IF (LOG(ILG).EQ.-2)  GO TO 540
	IF (LOG(ILG).EQ.-1)  GO TO 530
	CONST = 0
	IF (  (LOG(ILG) .AND. DETFLG) .NE. 1  ) GO TO 535
	IF ( LOG(ILG+3) .EQ. -1 ) GO TO 538
	CONST=CONSTM( LOG(ILG+2), LOG(ILG+3) )
	GO TO 538
535	CONST=CONSTM(LOG(ILG+2),LASTDT)
538	CPUT=0
	IF (LOG(ILG+3).NE.-1)  CPUT=LOG(ILG+4)
	USER=LOG(ILG).AND.R7
	ASSIGN 530 TO ACOUNT
	GO TO 640
540	LOG(1)=-2
	UPTIME=UPTIME+CONSTM(OLDATE,LASTDT)/1000
	OLDATE=LASTDT
	GO TO 50

C TIME SET
550	IF (.NOT. DEBUG ) GO TO 555
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('TIME RESET')
555	IF(LOG(1).EQ.-2)  GO TO 600
	DAY=(WORD(3).AND.L7)-(LASTDT.AND.L7)
	SEC=(WORD(3).AND.R7)-(LASTDT.AND.R7)
	ILG=-4
560	ILG=ILG+5
	IF (LOG(ILG).EQ.-2)  GO TO 600
	IF (LOG(ILG).EQ.-1)  GO TO 560
	I=2
570	NSEC=(LOG(ILG+I).AND.R7)+SEC
	NDAY=DAY
	IF(NSEC.LT.0)  GO TO 580
	IF(NSEC.LT.86400)  GO TO 590
	NSEC=NSEC-86400
	NDAY=DAY+BIT17
	GO TO 590
580	NSEC=NSEC+86400
	NDAY=DAY-BIT17
590	LOG(ILG+I)=(LOG(ILG+I).AND.L7)+NDAY+NSEC
	IF(I.EQ.3)  GO TO 560
	IF(LOG(ILG+3).EQ.-1)  GO TO 560
	I=3
	GO TO 570
600	UPTIME=UPTIME+CONSTM(OLDATE,LASTDT)/1000
	OLDATE=DATE
	GO TO 50

C PERFORM ACCOUNTING FOR JOBS NOT LOGGED OUT
610	ILG=-4
620	ILG=ILG+5
	IF(LOG(ILG).EQ.-2)  GO TO 630
	IF(LOG(ILG).EQ.-1.OR.LOG(ILG+3).EQ.-1)  GO TO 620
	CONST=CONSTM(LOG(ILG+2),LOG(ILG+3))
	USER=LOG(ILG).AND.R7
	CPUT=LOG(ILG+4)
	DATE=LOG(ILG+3)
	ENCODE (15,100,ASCI) DATE
	ASCI(4)=0
	ASSIGN 620 TO ACOUNT
	GO TO 640
630	LOG(1)=-2
	UPTIME=UPTIME+CONSTM(OLDATE,DATE)/1000
	OLDATE=DATE
	RETURN

C (ACOUNT) - PERFORM ACCOUNTING AND CHECK FOR NEGATIVE CONST
640	IF(CONST.GE.0)  GO TO 650
	CONST=0
	IF (.NOT. DEBUG ) GO TO 650
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('NEGATIVE CONSOLE TIME')
650	IF(CPUT.GE.0)  GO TO 660
	CPUT=0
	IF (.NOT. DEBUG ) GO TO 660
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('NEGATIVE CPU TIME')
660	CALL ACCT(1,USER,LOG(ILG+1),CPUT,CONST,0,0,0)
C OUTPUT ACCOUNTING INFORMATION
	IF(.NOT.ACTINF)  GO TO 730
	CALL DIRSTZ(USER,ASCI(5),NCHAR)
	ASCI(7)=0
	CALL SOUTZ(ASCI(5))
	NCHAR=10-NCHAR
	IF(NCHAR.LE.0)  GO TO 680
	DO 670 I=1,NCHAR
670	CALL SOUTZ(BIT1)
680	IACCT=LOG(ILG+1)
	IF(IACCT.LT.0)  IACCT=-(IACCT.XOR.BIT0)
	ENCODE(30,690,ASCI(5)) USER,IACCT,DATE
690	FORMAT(1X,O5,I9,3X,O12)
	ASCI(11)=0
	CALL SOUTZ(ASCI(5))
	TIME=IFIXR(CPUT/1000.)
	IND=0
700	MIN=TIME/60
	SEC=TIME-MIN*60
	HOUR=MIN/60
	MIN=MIN-HOUR*60
	ENCODE(10,710,ASCI(5)) HOUR,MIN,SEC
710	FORMAT(I4,':'I2,':'I2)
	ASCI(7)=0
	CALL SOUTZ(ASCI(5))
	IF(IND.EQ.1)  GO TO 720
	TIME=IFIXR(CONST/1000.)
	IND=1
	GO TO 700
720	CALL SOUTCR(0)
730	GO TO ACOUNT


C HISTOGRAM ENTRY
740	T=T1*1000
	NN=N1
	M=M1
	TIME=WORD(4)
	IND=1
	GO TO 760
750	TEMP=DIM
	IND=2
	T=T2*60000
	NN=N2
	M=M2
	TIME=WORD(5)
760	TAU=T
	TTL=0
	DO 770 I=1,M
	TTL=TTL+NN*TAU
	IF(TIME.LE.TTL)  GO TO 780
770	TAU=TAU*2
	DIM=M*NN+1
	GO TO 810
780	TTL=TTL-NN*TAU
	DO 790 J=1,NN
	TTL=TTL+TAU
	IF(TIME.LE.TTL)  GO TO 800
790	CONTINUE
800	DIM=(I-1)*NN+J
810	IF(IND.EQ.1)  GO TO 750
	HIST(TEMP,DIM)=HIST(TEMP,DIM)+1
C OUTPUT LOGOUT DATA
	IF(.NOT.BOUTF)  GO TO 50
	DO 820 I=2,5
820	CALL WWORD(WORD(I))
	GO TO 50

C OUTPUT HISTOGRAM
830	MAX1=N1*M1+1
	MAX2=N2*M2+1
	IF (N.EQ.-2)  GO TO 870
	ENCODE(25,840,ASCI) T1,N1,M1,T2,N2,M2,MAX1,MAX2
840	FORMAT(8(I2,1H,),1X)
	ASCI(6)=0
	CALL SOUTZ(ASCI)
	ASCI(2)=0
	DO 860 I=1,MAX1
	DO 860 J=1,MAX2
	ENCODE(5,850,ASCI) HIST(I,J)
850	FORMAT(I4,1H,)
860	CALL SOUTZ(ASCI)
	RETURN

C ZERO HIST(I,J)
870	DO 880 I=1,MAX1
	DO 880 J=1,MAX2
880	HIST(I,J)=0
	RETURN

C LPT ENTRIES
1000	CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
	CALL ACCT(1,WORD(2),NACCT,WORD(4),0,0,WORD(6),0)
	GO TO 50
C CDR ENTRIES
1500	CALL ACCT(0,WORD(2),NACCT,0,0,0,0,0)
	CALL ACCT(1,WORD(2),NACCT,WORD(4),0,0,0,WORD(6))
	GO TO 50
C DETACH ENTRIES
2000	JOBN = WORD(1) .AND. JBMSK
	ILG=-4
2100	ILG=ILG+5
	IF ( LOG(ILG) .EQ. -2 ) GO TO 2400
	IF ((LOG(ILG).AND.JBMSK) .EQ. JOBN) GO TO 2200
	GO TO 2100
2200	IF ( (LOG(ILG).AND.R7) .EQ. (WORD(2).AND.R7) ) GO TO 2300
	IF ( .NOT. DEBUG ) GO TO 2300
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('DETACH WITH DIFFERENT ID CODE')
2300	LOG(ILG) = LOG(ILG) .OR. DETFLG
	GO TO 50
2400	IF ( .NOT. DEBUG ) GO TO 50
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('DETACH FOR JOB NOT LOGGED IN')
	GO TO 50
C ATTACH ENTRIES
2500	JOBN = WORD(1) .AND. JBMSK
	ILG=-4
2600	ILG=ILG+5
	IF ( LOG(ILG) .EQ. -2 ) GO TO 2900
	IF ((LOG(ILG).AND.JBMSK) .EQ. JOBN) GO TO 2800
	GO TO 2600
2700	IF ( (LOG(ILG).AND.R7) .EQ. (WORD(2).AND.R7) ) GO TO 2800
	IF ( .NOT. DEBUG ) GO TO 2800
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('ATTACH WITH DIFFERENT ID CODE')
2800	LOG(ILG) = LOG(ILG) .AND. ( .NOT.  DETFLG )
	GO TO 50
2900	IF ( .NOT. DEBUG ) GO TO 50
	CALL SOUTZ(ASCI)
	CALL ODTIM2(DATE)
	CALL SOUTCR('ATTACH FOR JOB NOT LOGGED IN')
	GO TO 50
	END

C ACCT - A SUBROUTINE THAT PERFORMS THE ACCOUNTING FOR EACH JOB

	SUBROUTINE ACCT(N,USER,NACCT,CPUT,CONST,NPAGE,LINES,CARDS)

C       N=-2	CHECK IF ACCOUNT IS IN ACCOUNT TABLES
C       N=-1	CHECK IF ACCT-USER ENTRY IS IN TABLE
C		AND IF NOT RETURN  NACCT=NBIT2
C       N=0	GET ACCOUNT NUMBER, INSERT POSSIBLE ENTRY
C       N=1	PERFORM ACCOUNTING
C       USER - USER ID CODE
C       NACCT - ACCOUNT NUMBER
C       CPUT - CPU TIME IN MSEC
C       CONST - CONSOLE TIME IN MSEC
C       NPAGE - NUMBER OF FILE BLOCKS IN PAGES
C	LINES - NUMBER OF LINES PRINTED
C	CARDS - NUMBER OF CARDS READ

	IMPLICIT INTEGER (A-Z)
	COMMON /ACCOUN/ID(1001),ACNT(10001),ACTNM(501),ACTAL(3000)
	COMMON /ENTRY