constantstring (4) cuse = "CUSE"
recordformat  crecf(string (6) user, integer  next,usep,filep)
ownrecord (crecf)arrayformat  crecaf(0 : 3000)
recordformat  statsf(string (6) user, integer  next,fsys,kinst,pturn,
   kbtsldev,kbfsldev,msocp,connect,afile,akb,dfile,dkb,cfile,ckb)
! Format of accounting record returned by DSFI 42.
recordformat  zstatsf(integer  kinsti,kinstb,pturni,pturnb,kbtsldev,
kbfsldev,msocpi,msocpb,connect,afile,akb,dfile,dkb,cfile,ckb,dapsecs)
ownrecord (statsf)arrayformat  statsaf(0 : 3000)
externalstringfunctionspec  date
externalstringfunctionspec  time
systemroutinespec  destroy(string (31) file, integername  flag)
externalintegerfunctionspec  exist(string (24) file)
externalintegerfunctionspec  smaddr(integer  chan, integername  size)
externalroutinespec  define(string (255) s)
externalroutinespec  newsmfile(string (255) s)
externalroutinespec  copy(string (255) s)
externalroutinespec  closesm(integer  chan)
externalroutinespec  changesm(integer  chan,size)
externalroutinespec  send(string (255) s)
!*
!*

externalroutine  getuse(string (6) user, integer  fsys,reset,adr)
!* This routine returns accounting information in a record array starting
!* at ADR, for all accredited EMAS users (if FSYS is -1), or for all
!* users on the disc pack specified by FSYS, or for a single user (if
!* USER is non-null).  In the latter case FSYS can be used to specify
!* where the user's file index resides, if known.
!* The record array starting at ADR is assumed to be (0:n) (STATSF).
!* The records are held in a list structure to give alphabetic order
!* (_NEXT giving the next item in the list). This list is terminated
!* by a dummy record held in array element 0, with _USER="ZZZZZZ".
!* The genuine last user record thus has _NEXT=0.
!* The 0th record, on return from GETUSE, holds two items of
!* information:
!*   (0)_NEXT  gives the FIRST record in the list structure
!*   (0)_FSYS  gives the TOTAL number of (genuine) user records in the
!*             structure
!* If on entry (0)_NEXT is non-zero, this indicates that a
!* record array structure already exists.  In this case
!* the accounting information is added in to the corresponding record
!* (unless no such record currently exists, when one is created).  When
!* (0)_NEXT is non-zero on entry, it is assumed to point to the start
!* of the structure, and (0)_FSYS is assumed to give the total number of
!* user records in the structure.
!* If all the file systems are searched and more than one file index is
!* found for a particular user, then the accounting information for each
!* is stored in a separate record of the record array.
!* If RESET is 0 on entry, the accounting information is merely
!* read from the users' file indexes.  If it is 1, the file indexes are
!* also reset.
!* It is expected that GETUSE will be called on a regular basis with RESET=1,
!* and that either all the discpacks will be searched in a single call,
!* or that GETUSE will be called for each discpack in turn, the calling program
!* having used GET AV FSYS beforehand.
externalroutinespec  get av fsys(integername  nfsys,
    integerarrayname  discpack)
externalintegerfunctionspec  getusnames(integername  nusers, integer  adr,fsys)
externalintegerfunctionspec  dsfi(string (6) user, integer  fsys,type,set,adr)
record (statsf) name  current,exist
record (zstatsf) zcurrent
record (statsf) arrayname  stats
recordformat  userf(string (6) user)
record (userf) array  duser(1:512)
integerarray  discpack(0:63)
integer  i,j,nd,error,ndusers
stringname  uuz
integername  nusers,start

routine  addtolist(integername  new,start)
!* Finds correct position for CURRENT (i.e. STATS(NEW)) and links it in.
integer  oldp,p
if  current_user < stats(start)_user start 
!* At start of list.
   current_next = start; start = new
   return 
finish 
p = start
oldp = p and  p = stats(p)_next while  c 
   current_user > stats(p)_user or (current_user = stats(p)_user and  c 
   current_fsys > stats(p)_fsys)
if  current_user < stats(p)_user or (current_user = stats(p)_user and  c 
   current_fsys < stats(p)_fsys) start 
!* CURRENT goes in between OLDP and P.
   stats(oldp)_next = new; current_next = p
finishelsestart 
!* Same user, same fsys as STATS(P) - add in info from CURRENT.
   exist == stats(p)
   exist_kinst = exist_kinst + current_kinst
   exist_pturn = exist_pturn + current_pturn
   exist_kbtsldev = exist_kbtsldev + current_kbtsldev
   exist_kbfsldev = exist_kbfsldev + current_kbfsldev
   exist_msocp = exist_msocp + current_msocp
   exist_connect = exist_connect + current_connect
!* REMAINING INFO IS ASSIGNED, NOT ADDED IN.
   exist_afile = current_afile
   exist_akb = current_akb
   exist_dfile = current_dfile
   exist_dkb = current_dkb
   exist_cfile = current_cfile
   exist_ckb = current_ckb
   new = new - 1;                       ! Decrement total no of records.
finish 
end ;                                   ! Of %externalroutine ADDTOLIST.
stats == array(adr,statsaf)
nusers == stats(0)_fsys
start == stats(0)_next
if  start = 0 start 
   stats(0)_user = "ZZZZZZ"; nusers = 0
finish 
if  fsys =  - 1 then  getavfsys(nd,discpack) else  c 
   nd = 1 and  discpack(0) = fsys
while  nd > 0 cycle ;                   ! "FSYS" cycle.
   nd = nd - 1; fsys = discpack(nd)
   error = getusnames(ndusers,addr(duser(1)),fsys)
!* Returns into DUSER the names of the NDUSERS on this FSYS.
   unless  error = 0 start 
      printstring("Director fault"); write(error,1)
      printstring(" from GETUSNAMES with FSYS =")
      write(fsys,1)
      newline
      ndusers = 0
   finish 
   if  user # "" start ;                ! Single user specified in input parameters.
      ndusers = ndusers - 1 while  ndusers > 0 and  duser(ndusers)_user # user
      i = ndusers; i = i - 1 unless  i = 0
   finishelse  i = 0
   while  i < ndusers cycle ;           ! "Users within FSYS" cycle.
      i = i + 1
!* Now want to get (and possibly reset) the info for user I on disc FSYS.
      uuz == duser(i)_user
      if  uuz # "" and  uuz # "SPOOLR" and  uuz # "VOLUMS" and  c 
         uuz # "MAILER" start 
         nusers = nusers + 1
         current == stats(nusers);      ! Map CURRENT onto end of record array.
         current_user = duser(i)_user;  ! Current user's name.
         error = dsfi(current_user,fsys,42,0,addr(zcurrent))
         current_kinst = zcurrent_kinsti + zcurrent_kinstb
         current_pturn = zcurrent_pturni + zcurrent_pturnb
         current_kbtsldev = zcurrent_kbtsldev
         current_kbfsldev = zcurrent_kbfsldev
         current_msocp = zcurrent_msocpi + zcurrent_msocpb
         current_connect = zcurrent_connect
         current_afile = zcurrent_afile
         current_akb = zcurrent_akb
         current_dfile = zcurrent_dfile
         current_dkb = zcurrent_dkb
         current_cfile = zcurrent_cfile
         current_ckb = zcurrent_ckb
         !
         if  reset = 1 and  error = 0 start 
            error = dsfi(current_user,fsys,42,1,addr(zcurrent))
         finish 
         if  error # 0 start 
            printstring("Director fault no.")
            write(error,1)
            printstring(" when accessing file index for user ".current_user)
            printstring(" on FSYS"); write(fsys,1)
            newline
         finish 
!* Now all info read into CURRENT, and reset in user's index
!* (if RESET=1).
!* Next, position CURRENT in record list.
         addtolist(nusers,start) if  error = 0
      finish 
   repeat ;                             ! "Users within FSYS" cycle.
repeat ;                                ! FSYS CYCLE
end ;                                   ! Of %externalroutine GETUSE.
!*

externalroutine  charges(string (255) dummy)
systemintegerfunctionspec  current packed dt
externalintegerfunctionspec  pstoi(string (4) n)
record (statsf) arrayname  stats
record (statsf) name  current
record (crecf) arrayname  crec
!*
constantstring (8) juse = "JUSE", jusesize = "255000"
constantinteger  defaultdays = 1
string (8) dd,mm,usecharge,filecharge,ctime,odd,omm
integername  cnusers
integer  c,i,j,next,oldcp,cp,days,mmi,ddi,ommi,oddi
integer  flag
constantintegerarray  cumdays(1 : 12) = c 
0, 31, 59, 90, 120, 151, 181,
          212, 243, 273, 304, 334
constantinteger  usemin = 5, filemin = 5
! Any individual charge less than the corresponding minimum is ignored.
!*
!*

routine  cupdate(integername  adr)
!* ADR POINTS AT THE FROM/TO DATE PAIR AT THE START OF THE
!* CUSE FILE ON ENTRY.
string(adr + 10) = date; adr = adr + 20
end ;                                   ! OF %routine CUPDATE.

integerfunction  filech
result  = 0
end ;   ! of filech
!
!
integerfunction  usech
! This returns the use charge in units derived from the values in record
! 'current'.
real  total
total = current_msocp * 0.001 + current_pturn * 0.004 + current_connect * 0. c 
   01666666 + (current_kbtsldev + current_kbfsldev) * 26.0 * 0.003333333
result  = int(3.85 * total)
! The  meaning  of  the  constants  in  the  above  formula, in order of
! appearance, is:
! 0.001      converts ms OCP to seconds.  The charge is 1 unit/sec.
! 0.004    = 1/250, the cost in units per page turn.
! 0.0166.. = 1/60, the cost in units per connect time second.
! 26.0     = estimated records/kb of slow device material.
! 0.00333..= 1/300, the cost in units per slow device record.
! 3.85     = overall constant.
end ;   ! of usech
!*
!* FIRST, PREPARE THE FILES.
dd = date; length(dd) = 5
dd -> dd.("/").mm
if  exist(cuse) # 0 start ;             ! CUMULATIVE USE FILE.
   c = 1
   define("74,".cuse)
   i = smaddr(74,j);                    ! IGNORE J.
! CALCULATE NO. OF DAYS SINCE CHARGE LAST MADE (RELEVANT FOR FILE
!* SPACE CHARGES).
   odd = string(i + 10);                ! DATE FROM CUSE FILE.
   length(odd) = 5; odd -> odd.("/").omm
   if  omm = "00" then  days = defaultdays elsestart 
!* I.E. CUSE FILE EXISTS BUT IS EMPTY.
      ddi = pstoi(dd); oddi = pstoi(odd); ! STRING -> INTEGER.
      if  omm = mm then  days = ddi - oddi elsestart 
         mmi = pstoi(mm); ommi = pstoi(omm)
         days = cumdays(mmi) + ddi - (cumdays(ommi) + oddi)
         days = days + 365 if  days < 0
      finish 
   finish 
   cupdate(i)
!* THIS ROUTINE CHANGES THE "END" DATE AT THE START OF THE FILE
!* TO TODAY'S DATE, AND MOVES I TO THE START OF THE RECORD STRUCTURE.
   crec == array(i,crecaf);             ! RECORD ARRAY NOW MAPPED ON TO CUSE.
finishelsestart ;                       ! I.E. FILE DOES NOT EXIST.
   printstring("Cumulative file ".cuse." does not exist.
No summary information recorded.")
   newline
   c = 0
   days = defaultdays;                  ! NO OF DAYS SINCE LAST CHARGED FOR (ASSUMED).
finish 
!
! Now get the JOURNAL file.
!
if  exist(juse) # 0 then  send(juse.",.JOURNAL")
newsmfile(juse.",".jusesize)
define("79,".juse)
i = smaddr(79,j);                       ! IGNORE J.
! Insert header information for JOURNL file.
j = i & x'FFFF0000' + 20
integer(j) = current packed dt
integer(j + 4) = x'FFFFFF03'
stats == array(i,statsaf);              ! STATS RECORD ARRAY MAPPED ON TO JUSE.
!* NOW GET THE INFORMATION.
stats(0)_next = 0;                      ! MEANS THAT THE RECORD STRUCTURE IS NEW.
getuse("",-1,1,addr(stats(0)))
!
! All users, all fsyss, reset file indexes.
! GETUSE generates messages as necessary.
! Now go through the record structure, working out the charges
! and writing them to the charge files and the cumulative file.
! First set up charge files (character streams).
ctime = time
next = stats(0)_next;                   ! START OF LIST.
if  c = 1 start ;                       ! CUMULATIVE FILE.
   oldcp = 0; cp = crec(0)_next
   cnusers == crec(0)_usep
finish 
while  next > 0 cycle 
   current == stats(next)
   i = usech; j = filech;               ! FUNCTIONS USING VALUES IN RECORD "CURRENT".
   if  c = 1 start ;                    ! Cumulative file to be updated.
      oldcp = cp and  cp = crec(cp)_next while  current_user > crec(cp)_user
      if  current_user < crec(cp)_user start 
!* NEW USER: CREATE NEW RECORD, AND INSERT BETWEEN OLDCP AND CP.
         cnusers = cnusers + 1
         crec(oldcp)_next = cnusers; crec(cnusers)_next = cp
         crec(cnusers)_user = current_user
         crec(cnusers)_usep = i; crec(cnusers)_filep = j
         cp = cnusers;                  ! (CONSECUTIVE INPUT RECORDS CAN BE FOR THE SAME USER.)
      finishelsestart ;                 ! RECORD EXISTS FOR THIS USER - ADD IN INFO.
         crec(cp)_usep = crec(cp)_usep + i
         crec(cp)_filep = crec(cp)_filep + j
      finish 
   finish ;                             ! END OF CUSE UPDATE.
   next = current_next
repeat 
selectoutput(0)
if  c = 1 start ;                       ! TIDY UP CUSE FILE.
   i = (cnusers + 2) * 20;              ! APPROX NO. OF BYTES IN USE.
   closesm(74)
   printstring("Cumulative file ".cuse." updated.")
   newline
finish 
!
! JUSE file.
!
i = (stats(0)_fsys + 5) << 6;           ! APPROX SIZE.
closesm(79)
changesm(79,i)
printstring("File ".juse." complete.")
newline
copy(juse.",JUSECOPY")
send(juse.",.JOURNAL")
end ;                                   ! OF %externalroutine CHARGES.
!*

externalroutine  listcuse(string (255) usermask)
externalroutinespec  prompt(string (15) s)
string (30) outfile
integer  i,j,next
record (crecf) arrayname  crec
record (crecf) name  current
recordformat  rec1f(string (6) user, integer  start,number)
record (rec1f) name  rec1
!*
integer  subn
integerarray  substa(1:3); integerarray  subfina(1:3)
!* Pointers to start and finish of substrings of mask.
string (6) array  suba(1:3);            ! Substrings of mask.

routine  matchinit(string (6) user mask)
!* A routine to set up substring variables used by MATCH.
integer  p,l
l = length(user mask)
p = 1; subn = 0
while  p <= l cycle 
   p = p + 1 while  p <= l and  charno(user mask,p) = '?'
   exitif  p > l
   subn = subn + 1
   substa(subn) = p
   p = p + 1 while  p <= l and  charno(user mask,p) # '?'
   subfina(subn) = p - 1
   suba(subn) = substring(user mask,substa(subn),subfina(subn))
repeat 
end ;                                   ! OF %routine MATCHINIT.
!*

integerfunction  match(string (6) user)
integer  p
p = 0
while  p < subn cycle 
   p = p + 1
   result  = 0 unless  suba(p) = substring(user,substa(p),subfina(p))
repeat 
result  = 1
end ;                                   ! OF %integerfunction MATCH.
!*
if  exist(cuse) = 0 start ;             ! FILE DOES NOT EXIST - CREATE IT.
   newsmfile(cuse.",70000");            ! ENOUGH FOR 3500 USERS.
   define("74,".cuse)
   i = smaddr(74,j);                    ! IGNORE J.
   string(i) = date; string(i + 10) = "00/00/00"
   rec1 == record(i + 20);              ! SET UP EMPTY RECORD STRUCTURE.
   rec1_user = "ZZZZZZ"
   rec1_start = 0
   rec1_number = 0
   printstring("File ".cuse." created and initialised.")
   newline
finishelsestart ;                       ! CUSE EXISTS - LIST IT.
   outfile = ".OUT" unless  usermask -  > usermask.(",").outfile
   define("74,".cuse)
   i = smaddr(74,j);                    ! IGNORE J.
   crec == array(i + 20,crecaf)
!* NOW SET UP USER MASK.
   if  0 # length(usermask) # 6 start 
      printstring("Faulty parameters.")
      newline
   finishelsestart 
      matchinit(usermask)
      define("75,".outfile)
      selectoutput(75)
      newlines(2)
      printstring("EMAS 2900 Charging Summary, from ")
      printstring(string(i)." to ".string(i + 10))
      printstring("
-----------------------------------------------------")
      newlines(2)
      next = crec(0)_next
      printstring(" User       Usage  File Space")
      newline
      printstring("           (pence)   (pence)")
      newlines(2)
      while  next > 0 cycle 
         current == crec(next)
         if  match(current_user) = 1 start 
            printstring(current_user); write(current_usep,9)
            write(current_filep,9)
            newline
         finish 
         next = current_next
      repeat 
!*
      selectoutput(0)
   finish 
   newlines(2)
   prompt("Reset ".cuse."?")
   readsymbol(j) until  j & 95 = 'Y' or  j & 95 = 'N' or  j & 95 = nl
   if  j & 95 = 'Y' start 
      string(i) = date; string(i + 10) = "00/00/00"
      rec1 == record(i + 20)
      rec1_start = 0; rec1_number = 0
   finish 
finish ;                                ! END OF FILE LISTING SECTION.
closesm(74)
end ;                                   ! OF %externalroutine LISTCUSE.

externalroutine  listjuse(string (255) juse)
! LISTS THE CONTENTS OF FILE JUSE, THE FILE CREATED FOR THE JOURNAL SYSTEM.
! ON EACH RUN OF THE CHARGING ROUTINE CHARGES.
recordformat  f2(string (6) user, integerarray  d(1:14))
record (f2) name  r
record (statsf) arrayname  stats
integer  i,j,next
string (20) out
!*
out = ".OUT" unless  juse -  > juse.(",").out
if  exist(juse) = 0 start 
   printstring("File ".juse." does not exist, or no access.")
   newline
   return 
finish 
define("75,".out)
selectoutput(75)
define("79,".juse)
i = smaddr(79,j);                       ! IGNORE J.
i = i + 1 while  string(i) # "ZZZZZZ";  ! SKIP OVER 'JOURNAL HEADER' (VARIOUS FORMATS).
stats == array(i,statsaf)
! STATS (RECORD ARRAY) NOW MAPPED ONTO TO RECORD STRUCTURE IN JUSE.
next = stats(0)_next;                   ! ARRAY SUBSCRIPT OF START OF LIST.
printstring(" USER       FSYS    KINST    PTURN KBTSLDEV KBFSLDEV")
printstring("    MSOCP  CONNECT    AFILE      AKB    DFILE")
printstring("      DKB    CFILE      CKB"); newlines(2)
cycle  i = 1,1,stats(0)_fsys
   if  next = 0 start 
      selectoutput(0)
      printstring("Only")
      write(i,1)
      printstring(" records in file:")
      write(stats(0)_fsys,1)
      printstring(" expected.")
      newline
      return 
   finish 
   r == stats(next)
   printstring(r_user); space
   cycle  j = 2,1,14
      write(r_d(j),8)
   repeat 
   newline
   next = r_d(1)
repeat 
newlines(2)
selectoutput(0)
end ;                                   ! OF %externalroutine LISTJUSE.
endoffile