1020  REM  Generates a system account report from HP/2000 access
1030  REM  sleep or hibe tape. This data may optionally be save to
1040  REM  a file or read from a file.
2000  REM *DEF*
2010  FILES *,*
2020  DIM A$[23],H$[255],H0$[255],X$[255]
2030  REM *pack function*
2040  DEF FNQ()=256*NUM(A$[])+NUM(A$[+1])
2050  REM *convert function*
2060  DEF FNL()=(>9)+(>99)+(>999)+(>9999)
2070  REM *set flags*
2080  F2=F3=F4=F5=0
2090  REM *INPUT STUFF*
2100  G0=G1=G2=G3=0
2110  H$="Input from tape or file? "
2120  GOSUB 9000
2130  G0=POS("TF",H0$[1,1])
2140  IF  NOT G0 THEN 2110
2150  RESTORE 2160
2160  DATA "MAG TAPE file name? ","File name? "
2170  FOR X=1 TO G0
2180  READ H$
2190  NEXT X
2200  GOSUB 9000
2210  ASSIGN H0$,1,X
2220  IF X<3 THEN 2250
2230  PRINT "File missing or not accessible"
2240  GOTO 2200
2250  IF  END #1 THEN 9300
2260  IF G0=2 THEN 2430
2270  H$="Keep data on file? "
2280  GOSUB 9000
2290  G1=POS("Y",H0$[1,1])
2300  IF  NOT G1 THEN 2430
2310  H$="File name? "
2320  GOSUB 9000
2330  ASSIGN H0$,2,X
2340  IF X<3 THEN 2370
2350  PRINT "File not available"
2360  GOTO 2310
2370  IF  END #2 THEN 9200
2380  IF G0=2 THEN 2530
2390  H$="Printout? "
2400  GOSUB 9000
2410  G2= NOT POS("Y",H0$[1,1])
2420  IF G2 THEN 2530
2430  H$="Include passwords? "
2440  GOSUB 9000
2450  G3=POS("Y",H0$[1,1])
2460  H$="Page length? "
2470  GOSUB 9000
2480  CONVERT H0$ TO L,1566
2490  IF L<10 OR L>90 THEN 2460
2500  L0=L
2510  PRINT "Line up page"
2520  ENTER 255,X,X
2530  REM *do it all*
2540  REM *get headers*
2550  GOSUB G0 OF 3000,3500
2560  REM *save head*
2570  GOSUB G1 OF 3530
2580  PRINT LIN(5* NOT G2);
2590  GOTO 4000
3000  REM *get header*
3010  LINPUT #1;A$[1,23]
3020  REM *make sure tape A*
3030  X=NUM(A$[10])
3040  IF X=1 THEN 3090
3050  CONVERT X TO X$
3060  PRINT "Mount reel number '1', not '"X$"', press return"
3070  ENTER 255,X,X
3080  GOTO 3010
3090  REM *get sysid*
3100  LINPUT #1;X$
3110  X$=X$[75]
3120  X$=X$[1,POS(X$,'0)-1]
3130  REM *sysid*
3140  H$="<< WA SYSTEMS DIVISION >>"
3150  H0$="Business Research & Investment Corp"
3160  H$=H$[1,66]
3170  H$[35,38]="Page"
3180  H$[48,48+LEN(X$)]=X$
3190  H$[60]="REPORT (    )"
3200  H0$=H0$[1,54]
3210  H0$[48]="00/00/00  00:00:00"
3220  REM *year*
3230  X=NUM(A$[12])
3240  CONVERT X TO H0$[55-FNL(X),55]
3250  REM *month and day*
3260  X1=X/4=INT(X/4)
3270  X=FNQ(13)
3280  X0=X4=INT(X/24)
3290  FOR X2=1 TO 12
3300  X3=31-(X2=4 OR X2=6 OR X2=9 OR X2=11)-(3-X1)*(X2=2)
3310  IF X0-X3<1 THEN 3340
3320  X0=X0-X3
3330  NEXT X2
3340  CONVERT X2 TO H0$[49-FNL(X2),49]
3350  CONVERT X0 TO H0$[52-FNL(X0),52]
3360  REM *hour,min,sec*
3370  X0=X-X4*24
3380  CONVERT X0 TO H0$[59-FNL(X0),59]
3390  X=FNQ(15)
3400  X=ABS(X-36000.)
3410  X0=INT(X/600)
3420  CONVERT X0 TO H0$[62-FNL(X0),62]
3430  X0=(X-X0*600)/10
3440  CONVERT X0 TO H0$[65-FNL(X0),65]
3450  REM *to idt section*
3460  FOR X=1 TO 2
3470  LINPUT #1;B$[1,1]
3480  NEXT X
3490  RETURN 
3500  REM *from file*
3510  READ #1;H$,H0$
3520  RETURN 
3530  REM *save head*
3540  PRINT #2;H$,H0$
3550  RETURN 
4000  REM *get next*
4010  IF G0=2 THEN 4240
4020  A$='0'0'0
4030  REM *input from tape*
4040  F1=0
4050  IF  ERROR  THEN 4180
4060  IF A$[1,3]='0'0'0 THEN 4150
4070  READ #1;A$
4080  REM *didnt read all of account*
4090  X=LEN(A$)
4100  IF (X+F5-3)/2048=INT((X+F5-3)/2048) THEN 4150
4110  REM *add quote and a wild guess (crtl @)*
4120  A$[X+1]='34'0
4130  REM *inform user of bad data*
4140  F1=F3=1
4150  REM *continue read*
4160  READ #1;A$[LEN(A$)+1]
4170  GOTO 4080
4180  REM *count*
4190  F5=F5+24
4200  A$=A$[4,21]
4210  REM *check for legal account, if not exit*
4220  IF NUM(A$)/4<1 THEN 4330
4230  GOTO 4280
4240  REM *input from file*
4250  IF  END #1 THEN 4330
4260  READ #1;F1,A$
4270  F3=F3 OR F1
4280  REM *save to file*
4290  GOSUB G1 OF 5000
4300  REM *p.out*
4310  GOSUB  NOT G2 OF 5030
4320  GOTO G0 OF 4030,4240
4330  REM *done*
4340  IF G0#1 THEN 4370
4350  PRINT #1;CTL(24)
4360  ASSIGN *,1
4370  IF G2 THEN 4390
4380  PRINT LIN(L0-L);
4390  IF  NOT G1 THEN 4410
4400  PRINT #2; END 
4410  STOP 
5000  REM *keep to file*
5010  PRINT #2;F1,A$
5020  RETURN 
5030  REM *print out*
5040  X0=FNQ(1)
5050  X1=INT(X0/1024)
5060  X2=X0-X1*1024
5070  X$="000"
5080  CONVERT X2 TO X$[3-FNL(X2)]
5090  IF L<L0-10 AND X1=F2 THEN 5270
5100  REM *new page*
5110  IF  NOT F3 THEN 5140
5120  PRINT LIN(1)"*  Denotes data may not be accurate"
5130  L=L+2
5140  PRINT LIN(L0-L);
5150  F4=F4+1
5160  CONVERT F4 TO H$[40,41]
5170  H$[68,68]=CHR$(X1+64)
5180  H$[69,71]=X$
5190  PRINT H$
5200  PRINT H0$
5210  PRINT 
5220  PRINT "                      TIME         SPACE"
5230  PRINT "ACCOUNT  PASSWORD  PERM  USED    PERM  USED  DEVICES AND";
5231  PRINT " CAPABILITIES"
5240  PRINT 
5250  L=6
5260  F3=0
5270  REM *save account*
5280  F2=X1
5290  REM *pr account*
5300  PRINT CHR$(32+10*F1);CHR$(X1+64);X$;TAB(10);
5310  REM *convert passwords, crtl shifted to lowercase*
5320  IF G3 THEN 5350
5330  PRINT "------";
5340  GOTO 5400
5350  FOR X=3 TO 8
5360  X0=NUM(A$[X])
5370  X0=X0+32* NOT X0+96*(X0>0 AND X0<32)
5380  PRINT CHR$(X0);
5390  NEXT X
5400  REM *decode time and space*
5410  FOR X0=0 TO 1
5420  FOR X1=0 TO 1
5430  X=FNQ(9+4*X0+2*X1)
5440  X$="     "
5450  CONVERT X TO X$[5-FNL(X)]
5460  PRINT TAB(18+14*X0+6*X1);X$[1,5];
5470  NEXT X1
5480  NEXT X0
5490  REM *devices*
5500  PRINT TAB(45);
5510  RESTORE 5520
5520  DATA "LT","RP","JT","JL","JP","JI","JM","MT","PP","PR","LP","CR"
5530  DATA "","PFA","FCP","MWA"
5540  X=FNQ(17)
5550  X0=0
5560  FOR X1=15 TO 0 STEP -1
5570  READ X$
5580  X2=INT(X/2^X1)
5590  X=X-X2*2^X1
5600  IF  NOT X2 THEN 5680
5610  IF  NOT X0 THEN 5630
5620  PRINT  USING "#,"'34","'34
5630  IF LEN(X$)=3 THEN 5660
5640  PRINT  USING "#,AA";X$
5650  GOTO 5670
5660  PRINT  USING "#,AAA";X$
5670  X0=1
5680  NEXT X1
5690  PRINT 
5700  L=L+1
5710  RETURN 
9000  REM *input*
9010  PRINT H$;
9020  LINPUT H0$
9030  H0$=UOS$(H0$)
9040  IF H0$[1,2]#"//" THEN 9099
9050  IF POS("STOP",H0$[3])=1 THEN 9999
9060  PRINT "Illegal //command"
9070  GOTO 9010
9099  RETURN 
9200  REM *end of output file*
9210  PRINT "End of output file"
9220  GOTO 9999
9300  REM *end of infile*
9310  PRINT "Input file not properly formatted"
9999  END 
