!FILE LAST CHANGED ON  15/02/83
!  *******************************************************************
!  *                                                                 *
!  *    THE JOURNAL SYSTEM:    PACKAGE D                             *
!  *    THIS PACKAGE CONTAINS THE ROUTINES THAT GIVE THE             *
!  *    SYSTEM MANAGER THE CONTROL OF SYSTEM STATISTICS              *
!  *                                                                 *
!  *    DESIGNED AND WRITTEN BY JOHN HENSHALL                        *
!  *                                                                 *
!  *    JOHN MURISON                       VERSION: 015              *
!  *                                                                 *
!  *                                                                 *
!  *******************************************************************

constinteger  kent = 0, ercc = 1
constinteger  journalsite = kent

!********** SYSTEM ROUTINE SPECS 

  recordformat  rf(integer  conad, filetype, datastart, dataend)
  systemroutinespec  connect(string (31) file, integer  mode, hole,
          project, record (rf)name  r, integername  flag)
  systemroutinespec  newgen(string (31) s, t, integername  flag)
  systemroutinespec  rename(string (31) file,newfile,integername  flag)
  systemroutinespec  destroy(string (31) s, integername  flag)
  systemroutinespec  disconnect( string (31) file, integername  flag)
  systemroutinespec  outfile(string (31) s, integer  size, hole,
          protection, integername  conad, flag)
  systemintegerfnspec  pack date and time(string (8) date, time)
  systemstringfnspec  unpack date(integer  packed)
  systemstringfnspec  unpack time(integer  packed)

!**********EXTERNAL ROUTINE SPECS.

  externalroutinespec  copy(string (255) s)
  externalroutinespec  define(string (255) s)
  externalroutinespec  print help(integer  n)
  externalroutinespec  journal analysis(string (255) s)
  externalroutinespec  list(string (255) s)
  externalroutinespec  prompt(string (255) s)
  externalstringfnspec  date
  externalroutinespec  send(string (255) s)

!**********ROUTINE AND FUNCTION SPECS.

  routinespec  output queues(string (255)s )
  if  journalsite = kent then  start 
     routinespec  consumables analysis(string (255) s)
  finish 
  routinespec  background analysis(string (255) s)
  routinespec  s spaces(integer  n)
  routinespec  s newpage
  routinespec  s printstring(string (72) s)
  routinespec  s newlines(integer  n)
  routinespec  s write(integer  i, j)
  routinespec  s print(integer  i, j, real  r)
  externalroutinespec  read description(stringname  reply)
  externalroutinespec  read prompt reply(stringname  reply)
  externalintegerfnspec  s to i(string (255) s)
  externalstringfnspec  intostr(integer  value)

!**********CONSTANTS.

  constinteger  total devices = 128
  !THE MAXIMUM POSSIBLE DEVICES CONNECTED TO EMAS 2900(MUST
  !BE AN EVEN NUMBER)
  constinteger  nsys = 99
  constinteger  max users = 3001; ! This no is prime - it needs to be for hashing.
  !THE MAX USERS POPULATION. CAN BE ALTERED FOR ANY SITE.(MAX POSSIBLE: 16, 383)
  constinteger  block = 4096
  !BYTES IN EPAGE.
  constinteger  max terminal lines = 18
  !LINES OF OUTPUT ON ENGINEERS TERMINAL
  constinteger  max printer lines = 60
  !MAX LINES ON AN OUTPUT(LP) REPORT
  constinteger  on = 1
  constinteger  off = 0
  constinteger  match = 1
  constinteger  no match = 0
  constinteger  no = 0
  constinteger  yes = 1
  conststring (9) jtxt = "Journal: "

!***********OWNS

  ownstring (255) ns1; ! used in imp9->imp80 translation of ...->(..)..
  owninteger  printer = off
  owninteger  terminal = off
  !THESE TWO DEFINE WHERE THE OUTPUT IS DIRECTED.
  owninteger  p print = off
  owninteger  t print = off
  !THESE TWO DRIVE THE OUTPUT IN THE SPECIAL 'S' OUTPUT ROUTINES.
  owninteger  terminal lines =1
  owninteger  printer lines = 1
  owninteger  period reporting = off
  !THIS IS USED WHEN REPORTS BEING MADE UP ARE PERIODIC ACCUMULATION REPORTS

!**********EXTERNAL ROUTINES


! *************************************************************
! *************************************************************
! *************************************************************
  externalroutine  output and background analyses(string (255) s)
  !THIS ROUTINE IS CALLED BY 'JOURNAL ANALYSIS' IN THE AUTOMATIC
  !ANALYSIS OF SPOOLR FILES WHEN A 30 DAY REPORTING PERIOD HAS BEEN
  !COMPLETED AND REPORTS ARE REQUIRED.
  integer  flag
  period reporting=on
  output queues("")
  select output(0)
  if  period reporting=on start 
    printstring(jtxt." output queues report failed, leaving rerun")
    newline
    printstring("          and background analysis until next run.")
    newlines(2)
    return 
  finish 
  printstring(jtxt." output queues report completed.")
  newline
  period reporting = on
  background analysis ("")
  select output(0)
  if  period reporting=on start 
    printstring(jtxt." background analysis report failed, leaving rerun")
    newline
    printstring("          and background analysis until next run.")
    newlines(2)
    return 
  finish 
  printstring(jtxt." background analysis completed.")
  newline
  destroy("JJ#SPCJOB",flag)
  if  flag#0 start 
    printstring(jtxt." cannot destroy accumulation file, flag: ")
    write(flag, 2)
    newline
    printstring("          Please do the following command manually:")
    newline
    printstring("          Command:DESTROY(JJ#SPCJOB)")
    newline
    printstring("          This will clear down the accumulations.")
    newlines(2)
  finish 
  if  journalsite = kent then  start 
     period reporting=on
     consumables analysis("")
     selectoutput(0)
     if  period reporting = on start 
        printstring(jtxt." consumables report failed, leaving rerun")
        newline
        printstring("          and consumables analysis until next run.")
        newlines(2)
        return 
     finish 
     printstring(jtxt." consumables analysis completed.")
     newline
     destroy("JJ#SPCONS",flag)
     if  flag # 0 then  start 
        printstring(jtxt." cannot destroy accumulation file, flag:")
        write(flag, 1)
        newline
        printstring("          please do the following command manually:")
        newline
        printstring("          Command:DESTROY(JJ#SPCONS)")
        newline
        printstring("          This will clear down the accumulations")
        newlines(2)
     finish 
  finish 
end ;  !OF OUTPUT AND BACKGROUND ANALYSES.

! *********************************************************
! *  THE MANAGEMENT SUMMARY CALLS.
! *********************************************************

  externalroutine  background summary(string (255) s)
    s="MANFACL:SPOOLR,BACKGROUND SUMMARY"
    journal analysis(s)
  end 

! **********************************************************
! *********************************************************
! *********************************************************
  externalroutine  background analysis(string (255) s)
  record  (rf) r 
  recordformat  f hour table(integer  jobs, act cpu, req cpu, pts)
  record (f hour table)array  hour table(0:23)
  record (f hour table)name  hth
  recordformat  f batch table(integer  jobs, req cpu, act cpu, pts, wait,
          elapse)
  record (f batch table)array  batch table(1:15)
  record (f batch table)name  be, bt
  recordformat  f job entry(string (6) user, string (16) device,
          integer  size, mins qd, mins ex, byteinteger  fsys)
  record (f job entry)arrayformat  af job entry(1:100000)
  record (f job entry)arrayname  job entry
  record (f job entry)name  je
  recordformat  cjob head f(integer  end, start, size, filetype, checksum,
     datetime, format, sp0, next job slot, max job slots, start date, end date)
  record (cjob head f)name  cjob head
  integer  i, j, k, flag, cat, total entries, n
  integer  hour, htot jobs, htot act cpu
  real  rl
  string (6) ss
  string (8) start date, start time, end date, end time

  connect("JJ#SPCJOB", 0, 0, 0, r, flag)
  if  flag#0 start 
    printstring(jtxt." cannot connect completed-job stats file")
    newline
    printstring("          'JJ#SPCJOB', flag: "); write(flag, 3)
    newlines(2)
    disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
    stop 
  finish 
  cjob head == record(r_conad)
  total entries = cjob head_next job slot-1
  start date = unpack date(cjob head_start date)
  start time = unpack time(cjob head_start date)
  end date = unpack date(cjob head_end date)
  end time = unpack time(cjob head_end date)

  job entry == array(addr(cjob head)+cjob head_start, af job entry)

  define("STREAM01,JSTATSFILE")
  select output(1)
  if  total entries=0 start 
    printstring(jtxt." no statistics on output queues collected.")
    newlines(2)
    return 
  finish 
  batch table(i)=0 for  i=1, 1, 15
  hour table(i)=0 for  i=0, 1, 23

  n = 0
  for  i=1, 1, total entries cycle 
    je==job entry(i)
    continue  if  je_user="JOURNL" or  je_device#"BATCH"
    j=je_size&x'0000FFFF'
    n = n+1 and  continue  if  (j+10)<je_mins ex&x'FFFF'
    if  j<=600 then  cat=((j-1)//60+1) else  start 
      cat=11 if  j<=900
      cat=12 if  900<j<=1200
      cat=13 if  1200<j<=3600
      cat=14 if  j>3600
    finish 
    !WE NOW HAVE THE SIZE DIVISION FOR TABLE ENTRY.
    hour=je_mins qd&x'000000FF'
    if  0<=hour<=23 start 
      hth == hour table(hour)
      hth_jobs=hth_jobs+1
      hth_req cpu= hth_req cpu+je_size&x'0000FFFF'
      hth_act cpu= hth_act cpu+je_mins ex&x'0000FFFF'
    finish 
    be==batch table(cat)
    be_jobs=be_jobs+1
    be_req cpu=be_req cpu+je_size&x'0000FFFF'
    be_act cpu=be_act cpu+(je_mins ex&x'0000FFFF')
    be_wait=be_wait+je_size>>16
    be_elapse=be_elapse+(je_mins ex>>16)
    be_pts=be_pts+je_mins qd>>8
  repeat 

  if  n>0 start 
     newlines(4)
     write(n,1)
     printstring(" job(s) used 10 seconds more cpu time than requested.")
     newline
     printstring("They have not been included in the following report.")
     newlines(2)
  finish 
  bt==batch table(15); ! Element 15 used to accumulate totals.
  for  cat=1, 1, 14 cycle 
    be==batch table(cat)
    bt_jobs=bt_jobs+be_jobs
    bt_req cpu=bt_req cpu+be_req cpu
    bt_act cpu=bt_act cpu+be_act cpu
  repeat 

  !NOW MAKE UP THE REPORT.
  newpage
  printstring("EMAS 2900 Journal System Report on Batch Jobs")
  newlines(2)
  printstring(start date."(".start time.") to ")
  printstring(end date."(".end time.")")
  newlines(2)
  if  period reporting=on start 
     newlines(10)
    printstring("    ***********************************************")
    newlines(1)
    printstring("    * 30 day accumulation report to be retained   *")
    newlines(1)
    printstring("    ***********************************************")
    newlines(2)
  finish 
  newlines(5)
  printstring("Requested cpu"); spaces(17)
  printstring("0     61    121    181    241    301    361    421    ")
  printstring("481    541    601    901   1201")
  newline
  printstring("Seconds for job:"); spaces(9)
  printstring("To: 60    120    180    240    300    360")
  printstring("    420    480    540    600    900   1200")
  printstring("   3600  >3600  Total")
  newline; spaces(25)
  printsymbol('-') for  i=1, 1, 105
  newlines(2)
  printstring("Jobs"); spaces(19); printstring(":")
  write(batch table(i)_jobs, 6) for  i=1, 1, 15
  newline; printstring("As % of total jobs     :")
  rl = 100/bt_jobs
  print(batch table(i)_jobs*rl, 3, 2) for  i=1, 1, 15
  newlines(2); printstring("CPU seconds requested  :")
  write(batch table(i)_req cpu, 6) for  i=1, 1, 15
  newline; printstring("CPU seconds used       :")
  write(batch table(i)_act cpu, 6) for  i=1, 1, 15
  newline; printstring("Used as % of requested :")
  for  i=1, 1, 15 cycle 
    if  batch table(i)_req cpu>0 then   c 
      rl=(batch table(i)_act cpu/batch table(i)_req cpu)*100 else  rl=0
    print(rl, 3, 2)
  repeat 
  newline; printstring("Used as % of total used:")
  for  i=1, 1, 15 cycle 
    if  bt_act cpu>0 then  c 
    rl=(batch table(i)_act cpu/bt_act cpu)*100 else  rl=0
    print(rl, 3, 2)
  repeat 
  newlines(2); printstring("Mean req CPU per job   :")
  for  i=1, 1, 15 cycle 
    if  batch table(i)_jobs>0 then  c 
      rl=batch table(i)_req cpu/batch table(i)_jobs else  rl=0
    print(rl, 4, 1)
  repeat 
  newlines(2); printstring("Mean act. CPU per job  :")
  for  i=1, 1, 15 cycle 
    if  batch table(i)_jobs>0 then  c 
      rl=batch table(i)_act cpu/batch table(i)_jobs else  rl=0
    print(rl, 4, 1)
  repeat 
  newlines(2); printstring("Mean wait time (mins)  :")
  for  i=1, 1, 15 cycle 
    if  batch table(i)_jobs>0 then  c 
    rl=batch table(i)_wait/batch table(i)_jobs else  rl=0
    print(rl, 4, 1)
  repeat 
  newlines(2); printstring("Mean exec time (mins)  :")
  for  i=1, 1, 15 cycle 
    if  batch table(i)_jobs>0 then  c 
      rl=batch table(i)_elapse/batch table(i)_jobs else  rl=0
    print(rl, 4, 1)
  repeat 
  newlines(2); spaces(25)
  printsymbol('-') for  i=1, 1, 105
  newline
  newpage
  htot jobs=0
  htot act cpu=0
  for  i=0, 1, 23 cycle 
    htot jobs=htot jobs+hour table(i)_jobs
    htot act cpu=htot act cpu+hour table(i)_act cpu
  repeat 
  newlines(12)
  spaces(33)
  printstring("Actual CPU of jobs ending in hour")
  spaces(22); printstring("Jobs ending in hour")
  newline
  spaces(28)
  printstring("H    As % of total actual CPU.")
  spaces(30); printstring("As % of total jobs.")
  newline
  printstring("  JOBS  REQ CPU  ACT CPU    O")
  newline
  spaces(28)
  printstring("U 5         4         3         2         1     ")
  spaces(9)
  printstring("     1         2         3         4         5")
  newline
  spaces(28); printstring("R ")
  printstring("0         ") for  i=1, 1, 10
  printstring("0")
  newline; spaces(30)
  printsymbol('-') for  i=1, 1, 101
  newline
  for  i=0, 1, 23 cycle 
    write(hour table(i)_jobs, 5)
    write(hour table(i)_req cpu, 8)
    write(hour table(i)_act cpu, 8)
    spaces(3); ss=intostr(i)
    ss=" ".ss if  length(ss)=1
    printstring(ss." ")
    rl=(hour table(i)_act cpu/htot act cpu)*100
    j=int pt(rl)
    j=j+1 if  rl-j>=0.5
    if  j>50 then  ss="+" and  j=50 else  ss="*"
    spaces(50-j)
    printstring(ss) for  k=1, 1, j
    printstring("|")
    rl=(hour table(i)_jobs/htot jobs)*100
    j=int pt(rl)
    j=j+1 if  rl-j>=0.5
    if  j>50 then  ss="+" and  j=50 else  ss="*"
    printstring(ss) for  k=1, 1, j
    newline
  repeat 
  select output(0)
  close stream(1)
  if  period reporting = on then  start 
     if  journalsite = kent then  list("JSTATSFILE,.LP,1")
  finish 
  send("JSTATSFILE,.LP")
  disconnect("JWORKFILE", flag)
  destroy("JWORKFILE", flag)
  period reporting=off if  period reporting=on
  !IE INDICATE THAT THE REPORTING WAS COMPLETED.
  end ;  ! %external %routine background analysis.


   externalroutine  restore analysis(string (255) s)
      ! Print out info held in file JJ#VOLRTAB, then clear the file.
      integer  flag, restore entries, restore start date, restore end date,
               rm25, rm5, i, j, k, range, max
      realarray  rtload, rtrest(0:31)
      real  lcum, rcum
      ownintegerarray  range max(1:5) = 10, 20, 40, 50, 100
      ownstring (3)array  range val(0:5, 1:5) = c 
          "  0", "  2", "  4", "  6", "  8", " 10",
          "  0", "  4", "  8", " 12", " 16", " 20",
          "  0", "  8", " 16", " 24", " 32", " 40",
          "  0", " 10", " 20", " 30", " 40", " 50",
          "  0", " 20", " 40", " 60", " 80", "100"
      record  (rf) r
      integerarray  trest, tload(0:31)
      byteintegerarray  page(0:100, 4:35)
      recordformat  f restore table(string (6) tsn, user, byteinteger  fsys,
        integer  epages, mins rest wait, mins load wait, mins age)
      record (f restore table)arrayformat  af restore table(1:6000)
      record (f restore table)arrayname  restore table

      connect("JJ#VOLRTAB", 0, 0, 0, r, flag)
      if  flag#0 start 
         printstring(jtxt."cannot connect restore data file")
         newline
         printstring("         'JJ#VOLRTAB', flag:")
         write(flag, 3)
         newlines(2)
         disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
         stop 
      finish 

      restore table == array(r_conad+x'30', af restore table)
      restore start date = integer(r_conad+x'24')
      restore end date = integer(r_conad+x'28')
      restore entries = integer(r_conad+x'20')
      define("1,T#RESTFILE")
      selectoutput(1)
      ! JJ#VOLRTAB destroyed after analysis.

      printstring("EMAS 2900 Journal System Report on File Restorations
Period: ".unpack date(restore start date)." ".unpack time(restore start date))
      printstring(" to ".unpack date(restore end date)." ".unpack time c 
       (restore end date))
      newlines(2)
      printstring("Total number of files restored:"); write(restore entries, 3)
      newlines(6)
      return  if  restore entries=0

      for  j=4, 1, 35 cycle 
         page(i, j) = ' ' for  i=1, 1, 100
      repeat 
      string(addr(page(7, 35))) = "Time from restore request"
      string(addr(page(63, 35))) = string(addr(page(7, 35)))
      page(7, 35) = ' '; page(63, 35) = ' '
      string(addr(page(10, 34))) = "to mag tape loaded"
      page(10, 34) = ' '
      string(addr(page(67, 34))) = "to file restored"
      page(67, 34) = ' '
      page(4, j) = '|' for  j=29, -1, 9
      page(60, j) = '|' for  j=29, -1, 9
      page(3, 32) = '%'; page(59, 32) = '%'
      for  i=1, 1, 36 cycle 
         page(4+i, 9) = '-'; page(60+i, 9) = '-'
      repeat 
      string(addr(page(3, 8))) = " 0    5   10   15   20   25   30(>30)"
      string(addr(page(59, 8))) = string(addr(page(3, 8)))
      page(3, 8) = ' '; page(59, 8) = ' '
      string(addr(page(15, 4))) = "Time (minutes)"
      string(addr(page(71, 4))) = string(addr(page(15, 4)))
      page(15, 4) = ' '; page(71, 4) = ' '
      
      ! Now work out the histogram values from the restore table array.
      trest(i) = 0 and  tload(i) = 0 for  i=0, 1, 31
      for  j=1, 1, restore entries cycle 
         i = restore table(j)_mins load wait
         i = 31 if  i>30
         i = 0 if  i<0
         tload(i) = tload(i)+1
         i = restore table(j)_mins rest wait
         i = 31 if  i>30
         i = 0 if  i<0
         trest(i) = trest(i)+1
      repeat 

      max = 0
      for  j=0, 1, 31 cycle 
         max = tload(j) if  max<tload(j)
         max = trest(j) if  max<trest(j)
      repeat 
      i = 100*max//restore entries
      range = 0
      range = range+1 until  range max(range)>=i
      ! We now have the appropriate range for the Y-axis.
      for  j = 29, -4, 9 cycle 
         string(addr(page(0, j))) = range val((j-9)//4, range)
         string(addr(page(56, j))) = string(addr(page(0, j)))
         page(56, j) = ' '
      repeat 

      rm5 = 5*range max(range)*restore entries//100; rm25 = rm5>>1
      for  i=0, 1, 31 cycle 
         rtload(i) = 100*tload(i)/restore entries
         k = (100*tload(i)+rm25)//rm5
         page(i+5, j+9) = '*' for  j=k, -1, 1
         rtrest(i) = 100*trest(i)/restore entries
         k = (100*trest(i)+rm25)//rm5
         page(i+61, j+9) = '*' for  j=k, -1, 1
      repeat 

      ! Now print out the page array.
      for  j=35, -1, 4 cycle 
         i = 100
         i = i-1 while  i>0 and  page(i, j)=' '
         page(0, j) = i
         spaces(15); printstring(string(addr(page(0, j))))
         newline
      repeat 
      newpage
      ! Now print out the values already output in histogram form.
      newlines(4)
      printstring("        Time   || % Mag tape loaded | % Mag tape loaded   ||")
      printstring("    % File restored | % File restored ||  Time")
      newline
      printstring("     (minutes) ||  (in each minute) |    (cumulative)     ||")
      printstring("   (in each minute) |  (cumulative)   || (minutes)")
      newline
      spaces(5); printsymbol('-') for  i=6, 1, 110
      newlines(2)
      lcum = 0.0; rcum = 0.0
      for  i=0, 1, 31 cycle 
         write(i, 9); printstring("     ||     ")
         print(rtload(i), 3, 1); printstring("        |     ")
         lcum = lcum+rtload(i)
         print(lcum, 3, 1); printstring("          ||       ")
         print(rtrest(i), 3, 1); printstring("       |     ")
         rcum = rcum+rtrest(i)
         print(rcum, 3, 1); printstring("      ||")
         write(i, 5)
         newline
      repeat 
      spaces(5); printsymbol('-') for  i=6, 1, 110
      newlines(3)
      selectoutput(0); closestream(1)

      disconnect("T#RESTFILE", flag)
      disconnect("JJ#VOLRTAB", flag)
      send("T#RESTFILE")
      destroy("JJ#VOLRTAB", flag)
      if  flag#0 start 
        printstring(jtxt." cannot destroy accumulation file, flag: ")
        write(flag, 2)
        newline
        printstring("          please do the following command manually:")
        newline
        printstring("          DESTROY(JJ#VOLRTAB)")
        newline
        printstring("          this will clear down the accumulations.")
        newlines(2)
      finish 
   end ; ! Of %externalroutine restore analysis.
! ***********************************************************
! ***********************************************************
! ***********************************************************
  externalroutine  queue description(string (255) s)
  output queues("DEFINE")
  end 


! **************************************************
! **************************************************
! **************************************************
  externalroutine  output queues(string (255) s)
  record  (rf)r 
  recordformat  f dev(integer  jobs, kbytes)
  integerarray  fsys map(0:nsys);  !IE LINK INTO USER TABLE WORK SPACE.
  recordformat  f user(string (6) user, integer  jobs, kbytes,
         link, record (f dev)array  dev(1:total devices))
  record (f user)arrayformat  af user(1:max users)
  record (f user)arrayname  user
  record (f user)name  up
  record (f dev)name  updj, updk
  recordformat  f s unit(integer  jobs, kbytes, mins qd, mins ex)
  recordformat  f dev table(string (16) device, integer  jobs,
          kbytes, record (f s unit)array  s unit(1:6))
  record (f s unit)name  dtjsuk
  record (f dev table)array   dev table(1:total devices)
  record (f dev table)name  dti, dtj
  recordformat  f job entry(string (6) user, string (16) device,
          integer  size, mins qd, mins ex, byteinteger  fsys)
  record (f job entry)arrayformat  af job entry(1:100000)
  record (f job entry)arrayname  job entry
  record (f job entry)name  jei
  recordformat  cjob head f(integer  end, start, size, filetype, checksum,
     datetime, format, sp0, next job slot, max job slots, start date, end date)
  record (cjob head f)name  cjob head
  recordformat  f tots(integer  jobs, kbytes)
  record (f tots)array  tots(1:total devices, 0:43)
  recordformat  f dev descriptors(string (16) dev,
          string (32) description)
  record (f dev descriptors)arrayformat  af dev descriptors c 
    (1:total devices)
  record (f dev descriptors)arrayname  dev descriptors
  integername  descriptor count
  integer  descriptor addr
  integerarray  entry(0:max users)
  conststring (10) array  scale a(17:43)= c 
    "  0->20K |", "  20-40K |", "  40-60K |", "  60-80K |", " 80-100K |",
    "100-120K |", "120-140K |", "140-160K |", "160-180K |", "180-200K |",
    "200-220K |", "220-240K |", "240-260K |", "260-280K |", "280-300K |",
    "300-320K |", "320-340K |", "340-360K |", "360-380K |", "380-400K |",
    "400-420K |", "420-440K |", "440-460K |", "460-480K |", "480-500K |",
    "500-520K |", "   >520K |"
  conststring (5) array  scale b(0:16)= c 
    " 0K |", " 1K |", " 2K |", " 3K |", " 4K |", " 5K |", " 6K |", " 7K |",
    " 8K |", " 9K |", "10K |", "11K |", "12K |", "13K |", "14K |", "15K |",
    "16K |"
  integer  i, j, k, l, m, flag, size, total entries, totj, totkb
  integer  page, fsys, conad, jj, link, next user, count, pointer, unused
  real  rl
  string (6) iouser
  string (16) device
  string (8) start date, start time, end date, end time
  string (100) pst
  string (64)st, ss, desc

  integerfn  hash(string (6) user, integer  prime)
  integer  a, j, w
  constintegerarray  p(1:6) = 47, 53, 13, 11, 29, 37
     a=addr(user)
     w = 0
     for  j=1, 1, 6 cycle 
        w=w+(byteinteger(a+j)&x'1F') * p(j)
     repeat 
     result =w - (w//prime)*prime+1
  end ; ! hash

  routine  continue
  integer  flag
    string (16) s1, s2
    cycle 
      prompt("CONTINUE:")
      read prompt reply(s1)
      exit  if  (s1->ns1.("Y").s2 and  ns1="") or  c 
        (s1->ns1.("N").s2 and  ns1="")
    repeat 
    return  if  (s1->ns1.("Y").s2 and  ns1="")
    select output(0)
    if  printer=on start 
      printstring("Do you wish the printer report completed?")
      newline
      cycle 
        prompt("YES OR NO:")
        read prompt reply(s1)
        exit  if  (s1->ns1.("Y").s2 and  ns1="") or  c 
          (s1->ns1.("N").s2 and  ns1="")
      repeat 
      if  (s1->ns1.("Y").s2 and  ns1="") start 
        terminal = off; t print=off
        printstring(jtxt." terminal report ended, completing ")
        printstring("printer report.")
        newline
        return 
      finish 
    finish 
    printstring(jtxt." run abandoned  as requested.")
    newline
    if  printer=on start 
      close stream(1)
      destroy("JSTATSFILE", flag)
    finish 
    disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
    disconnect("T#SPDEVID", flag)
    newgen("T#SPDEVID","JJ#SPDEVID",flag)
    stop 
  end ;  !OF CONTINUE

  routine  quick sort(integer  array  name  x, integer  a, b)
    integer  l, u, d
    return  if  a >= b
    l = a; u = b
    d = x(u)
    cycle 
      l=l+1 while  l<u and  x(l)<=d
      exit  if  l=u
      x(u) = x(l)
      u=u-1 while  u>l and  x(u)>=d
      exit  if  l=u
      x(l) = x(u)
    repeat 
    x(u)=d
    l = l-1; u = u+1
    quick sort(x, a, l) if  a<l
    quick sort(x, u, b) if  u<b
  end ; ! Of %routine quicksort.

  connect("JJ#SPCJOB", 0, 0, 0, r, flag)
  if  flag#0 start 
    printstring(jtxt." cannot connect output stats file")
    newline
    printstring("          'JJ#SPCJOB', flag: "); write(flag, 3)
    newlines(2)
    disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
    stop 
  finish 
  outfile("JWORKFILE", 1050*max users, 0, 0, conad, flag)
  if  flag#0 start 
    printstring(jtxt."cannot create work file!!")
    newline
    return 
  finish 
  user==array(conad+x'20', af user)
  !INITIALISE THE FSYS/USER LINK MAP.
  fsys map(i)=0 for  i=0, 1, nsys
  cjob head == record(r_conad)
  total entries = cjob head_next job slot-1
  if  total entries=0 start 
    printstring(jtxt." no statistics on output queues collected.")
    newlines(2)
    return 
  finish 
  start date = unpack date(cjob head_start date)
  start time = unpack time(cjob head_start date)
  end date = unpack date(cjob head_end date)
  end time = unpack time(cjob head_end date)

  job entry == array(addr(cjob head)+cjob head_start, af job entry)


  connect("JJ#SPDEVID", 0, 0, 0, r, flag)
  if  flag#0 start 
    printstring(jtxt." device descriptor file missing, flag: ")
    printstring(intostr(flag)); newline
    printstring("          creating new file.")
    newlines(2)
    outfile("T#SPDEVID", 2*4096, 0, 0, conad, flag)
    if  flag#0 start 
      printstring(jtxt."cannot create file, flag: ".intostr(flag))
      newlines(2); return 
    finish 
    integer(conad)=x'2000'
    descriptor addr=conad
    dev descriptors==array(conad+x'30', af dev descriptors)
    for  i=1, 1, total devices cycle 
      dev descriptors(i)_dev=""
      dev descriptors(i)_description="??????????"
    repeat 
    integer(conad+x'29')=0
  finish  else  start 
    disconnect("JJ#SPDEVID", flag)
    copy("JJ#SPDEVID,T#SPDEVID")
    connect("T#SPDEVID", 3, 0, 0, r, flag)
    if  flag#0 start 
      printstring(jtxt." cannot access device descriptor file!!")
      newlines(2)
      return 
    finish 
    descriptor addr=r_conad
    dev descriptors==array(r_conad+x'30', af dev descriptors)
  finish 
  descriptor count==integer(descriptor addr+x'20')
  terminal=on and  ->define if  s="DEFINE"
  if  period reporting=off  start 
    !IE PERIODIC REPORT ONLY TO THE PRINTER
    printstring("Terminal, printer or both?")
    newline
    cycle 
      prompt("? ")
      read prompt reply(st)
      exit  if  (st->ns1.("T").ss and  ns1="") or  c 
        (st->ns1.("P").ss and  ns1="") or  (st->ns1.("B").ss and  ns1="")
    repeat 
    if  (st->ns1.("T").ss and  ns1="") or  (st->ns1.("B").ss and  ns1="") c 
      then  terminal = on
    if  (st->ns1.("P").ss and  ns1="") or  (st->ns1.("B").ss and  ns1="") c 
      then  printer = on
  finish  else  printer=on
  define("STREAM01,JSTATSFILE,512") if  printer = on
  p print=printer
  t print=terminal

  dev table(i) = 0 for  i=1, 1, total devices
  for  i=0, 1, 43 cycle 
    tots(j, i)=0 for  j=1, 1, total devices
  repeat 
  unused = max users; ! No of user slots available.
  !INITIALISE THE USER TABLE WHICH IS ACCESSED VIA THE FSYS MAP.
  for  i=1, 1, max users cycle 
    user(i) = 0
    user(i)_link=-1
  repeat 
  next user=1
  for  i=1, 1, total entries cycle 
    jei == job entry(i)
    device=jei_device
    continue  if  device="BATCH"
    for  j=1, 1, total devices cycle 
      dtj == dev table(j)
      dtj_device=device if  dtj_device=""
      ! This device not encountered so far - give it a slot.
      exit  if  dtj_device=device
      if  j=total devices start 
        printstring(jtxt." more than ".intostr(total devices))
        printstring(" devices??  Disaster")
        newlines(2)
        disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
        disconnect("T#SPDEVID", flag)
        newgen("T#SPDEVID","JJ#SPDEVID",flag)
        return 
      finish 
    repeat 
    size=jei_size
    if  size<0 start 
      printstring("Warning neg file size, entry ".intostr(i).", ignored.")
      printstring("    User: ".jei_user.", device: ".jei_device)
      newline
      continue 
    finish 
    if  size>2000 start ; ! Corrupt value - ignore to avoid overflow.
       printstring("Invalid size value: ".intostr(size)."?  (ignored)")
       printstring("   User: ".jei_user.", device: ".jei_device)
       newline
       continue 
    finish 
    dtj_jobs=dtj_jobs+1
    dtj_kbytes=dtj_kbytes+size
    if  size<=16 start 
      tots(j,size)_jobs = tots(j,size)_jobs+1
      tots(j,size)_kbytes = tots(j,size)_kbytes+size
    finish 
    l=(size//20+17);  !LINK INTO THE HISTOGRAM TABLES.
    l = 43 if  l>43
    tots(j, l)_jobs=tots(j, l)_jobs+1
    tots(j, l)_kbytes=tots(j, l)_kbytes+size
    k=1 if  size<=16
    k=2 if  16<size<=64
    k=3 if  64<size<=128
    k=4 if  128<size<=256
    k=5 if  256<size<=512
    k=6 if  size>512
    dtjsuk == dtj_s unit(k)
    dtjsuk_jobs=dtjsuk_jobs+1
    dtjsuk_kbytes=dtjsuk_kbytes+size
    dtjsuk_mins ex=dtjsuk_mins ex+ jei_mins ex
    dtjsuk_mins qd=dtjsuk_mins qd + jei_mins qd
    iouser=jei_user; fsys=jei_fsys
    pointer = hash(iouser, max users)
    cycle 
       exit  if  user(pointer)_link=-1 or  user(pointer)_user=iouser
       pointer = pointer+1
       pointer = 1 if  pointer>maxusers
    repeat 
    up == user(pointer)
    if  up_link=-1 start 
       ! User not encountered before.
       unused = unused-1
       if  unused<20 start 
         printstring(jtxt." warning, site about to exceed ")
         printstring(intostr(max users)." users, see documentation")
         newlines(2)
       finish 
       if  unused=0 start 
         printstring(jtxt." max users exceeded!!!")
         newlines(2)
         stop 
       finish 
       up_link = fsys map(fsys)
       ! Points at last user on this fsys.  First user on fsys has pointer 0.
       fsys map(fsys) = pointer
       up_user = iouser
    finish 
    ! Now add in values.
    up_jobs=up_jobs+1
    up_kbytes=up_kbytes+size
    updj == up_dev(j)
    updj_jobs = updj_jobs+1
    updj_kbytes = updj_kbytes+size
  repeat ; ! i loop.

  !NOW CHECK THAT ALL THE DEVICES ARE RECOGNISED IN THE DEVICE
  !DESCRIPTOR FILE.
  for  i=1, 1, total devices cycle 
    dti == dev table(i)
    exit  if  dti_device=""
    for  j=0, 1, descriptor count cycle 
      exit  if  j#0 and  dti_device=dev descriptors(j)_dev
      if  j=descriptor count start 
        descriptor count=descriptor count+1
        if  descriptor count>total devices start 
          printstring(jtxt." >".intostr(total devices))
          printstring(" devices in the network??")
          newlines(2)
          descriptor count=total devices
          disconnect("T#SPDEVID", flag)
          newgen("T#SPDEVID","JJ#SPDEVID",flag)
          disconnect("JWORKFILE", flag); destroy("JWORKFILE", flag)
          return 
        finish 
        dev descriptors(descriptor count)_dev=dti_device
        exit 
      finish 
    repeat 
  repeat 
  !IF WE ARE INTERACTING VIA TERMINAL THEN SEE IF THERE ARE
  !ANY DEVICE DESCRIPTIONS OUTSTANDING AND IF THE USER WISHES
  !TO GIVE A DESCRIPTION OR CHANGE AN EXISTING ONE.
define:
  if  terminal=on and  descriptor count>0 start 
    j=0
    for  i=1, 1, descriptor count cycle 
      if  dev descriptors(i)_description->ns1.("?").st and  c 
        ns1="" then  j=1 and  exit 
    repeat 
    if  j#0 start 
      printstring("The following queue(s) require description.")
      newline
      j=0
      for  i=1, 1, descriptor count cycle 
        if  dev descriptors(i)_description->ns1.("?").st and  c 
           ns1="" start 
          printstring(dev descriptors(i)_dev."  ")
          j=j+1
          if  j=8 start 
            j=0
            newline
          finish 
        finish 
      repeat 
      newline
      printstring("Do you wish to add a description to any?")
      newline
      cycle 
        prompt("YES OR NO:")
        read prompt reply(st)
        exit  if  (st->ns1.("Y").ss and  ns1="") or  c 
          (st->ns1.("N").ss and  ns1="")
      repeat 
      if  (st->ns1.("Y").ss and  ns1="") start 
        cycle 
          prompt("Queue:")
          read prompt reply(st)
          for  i=1, 1, descriptor count cycle 
            if  st=dev descriptors(i)_dev start 
              cycle 
                prompt("Description:")
                read description(st)
                exit  if  0<length(st)<=32
              repeat 
              dev descriptors(i)_description=st
              exit 
            finish 
          repeat 
          exit  if  st="END"
        repeat 
      finish 
    finish 
    newline
    printstring("Do you wish to change any queue description(s)?")
    newline
    cycle 
      prompt("YES OR NO:")
      read prompt reply(st)
      exit  if  (st->ns1.("Y").ss and  ns1="") or  c 
        (st->ns1.("N").ss and  ns1="")
    repeat 
    if  (st->ns1.("Y").ss and  ns1="") start 
      cycle 
        prompt("Queue")
        read prompt reply(st)
        for  i=1, 1, descriptor count cycle 
          if  st=dev descriptors(i)_dev start 
            printstring("Current descriptor is: ")
            printstring(dev descriptors(i)_description); newline
            cycle 
              prompt("Description:")
              read description(st)
              exit  if  0<length(st)<=32
            repeat 
            dev descriptors(i)_description=st
            exit 
          finish 
        repeat 
        exit  if  st="END"
      repeat 
    finish 
  finish 
  if  s="DEFINE" start 
    disconnect("T#SPDEVID", flag)
    newgen("T#SPDEVID","JJ#SPDEVID",flag)
    return 
  finish 
  !NOW MAKE UP THE REPORT.
  s newpage
  sprintstring("Journal Report on Output Queues, EMAS 2900")
  s newlines(2)
  sprintstring(start date."(".start time.") to ")
  sprintstring(end date."(".end time.")")
  snewlines(2)
  if  terminal=on  and  printer = off start 
    select output(0)
    printstring("Note that the details given on the printer would ")
    printstring("include histograms")
    newline
    printstring("and details of individual users' output as well ")
    printstring("as the summaries "); newline
    printstring("that follow.")
    newlines(2)
  finish 
  if  period reporting=on start 
    s newlines(10)
    sprintstring("    ***********************************************")
    snewlines(1)
    sprintstring("    *  30 day accumulation report to be retained  *")
    snewlines(1)
    sprintstring("    ***********************************************")
    snewlines(2)
  finish 
  terminal lines=max terminal lines+1 if  terminal=on
  printer lines=max printer lines+1 if  printer=on
  for  i=1, 1, total devices cycle 
    dti == dev table(i)
    exit  if  dti_device=""
    t print=off; p print=off
    t print=on if  terminal lines>max terminal lines
    p print=on if  printer lines>max printer lines
    if  t print+ pprint>off start 
      !IE A PAGE SKIP IS REQUIRED BY AT LEAST ONE OF THE OUTPUT STREAMS
      continue if  t print=on
      s newpage
      s newlines(1)
      s printstring("Queue         Total Jobs  Total Kbytes")
      s printstring("  Queue description")
      s newlines(1)
      s printstring("---------------------------------------")
      s printstring("------------------------------")
      s newlines(2)
      terminal lines=4 if  t print=on
      printer lines=4 if  p print=on
    finish 
    t print=terminal; p print=printer
    s printstring(" ".dti_device)
    s spaces(16-length(dti_device))
    s write(dti_jobs, 6)
    s write(dti_kbytes, 13)
    desc="??????????"
    if  descriptor count>0 start 
      for  j=1, 1, descriptor count cycle 
        if  dev descriptors(j)_dev=dti_device start 
          desc=dev descriptors(j)_description
          exit 
        finish 
      repeat 
    finish 
    s printstring("  ".desc)
    s newlines(1)
  repeat 

  s newlines(4)
  s printstring("End of queue totals, 'By Queue' summary follows.")
  s newlines(1)

  for  i=1, 1, total devices cycle 
    dti == dev table(i)
    exit  if  dti_device=""
    continue if  t print=on
    s newpage
    select output(0) and  newline if  t print=on
    sprintstring("Queue: ".dti_device)
    s spaces(7-length(dti_device))
    desc="??????????"
    if  descriptor count>0 start 
      for  j=1, 1, descriptor count cycle 
        if  dev descriptors(j)_dev=dti_device start 
          desc=dev descriptors(j)_description
          exit 
        finish 
      repeat 
    finish 
    s printstring(desc."   ")
    if  t print=on start 
      select output(0)
      newline
    finish 
    s printstring("Total jobs:")
    s write(dti_jobs, 5)
    s printstring("    Kilobytes:")
    s write(dti_kbytes, 6)
    if  p print=on start 
     select output(1)
     spaces(2); printstring(start date."(".start time.") to ")
     printstring(end date."(".end time.")")
    finish 
    s newlines(2)
    s printstring("Jobs by size (Kbytes): <=16    17-64  65-128 ")
    s printstring("129-256 257-512  > 512")
    s newlines(1)
    s spaces(20)
    s printstring("|-------|-------|-------|-------|-------|-------|")
    s newlines(1)
    s printstring("Jobs"); s spaces(16)
    for  j=1, 1, 6 cycle 
      if  dti_s unit(j)_jobs=0 then  s spaces(8) else  start 
      swrite(dti_s unit(j)_jobs, 6)
      s spaces(1)
      finish 
    repeat 
    s newlines(1)
    s printstring("As % of total       ")
    for  j=1, 1, 6 cycle 
      if  dti_s unit(j)_jobs=0 then  s spaces(8) else  start 
      s print(4, 1, dti_s unit(j)_jobs/dti_jobs*100)
      s spaces(1)
      finish 
    repeat 
    s newlines(1); s printstring("Kilobytes           ")
    for  j=1, 1, 6 cycle 
      if  dti_s unit(j)_kbytes=0 then  sspaces(8) else  start 
      s write(dti_s unit(j)_kbytes, 6)
      s spaces(1)
      finish 
    repeat 
    s newlines(1)
    sprintstring("As % of total      ")
    for  j=1, 1, 6 cycle 
      if  dti_sunit(j)_kbytes=0 then  sspaces(8) else  start 
      s print(5, 1, dti_s unit(j)_kbytes/dti_kbytes*100)
      finish 
    repeat 
    s newlines(1); s printstring("Av queued time(mins)")
    for  j=1, 1, 6 cycle 
      if  dti_sunit(j)_jobs=0 then  sspaces(8) else  start 
      sprint(4, 1, dti_sunit(j)_minsqd/dti_sunit(j)_jobs)
      s spaces(1)
      finish 
    repeat 
    snewlines(1); s printstring("Av execution  (mins)")
    for  j=1, 1, 6 cycle 
      if  dti_sunit(j)_jobs=0 then  s spaces(8) else  start 
      sprint(4, 1, Dti_sunit(j)_minsex/dti_sunit(j)_jobs)
      s spaces(1)
      finish 
    repeat 
    s newlines(1)
    if  printer=on start 
      select output(1)
      newlines(1)
      spaces(12); printstring("As % of jobs <= 16 kilobytes")
      spaces(32)
      printstring("As % of total kbytes of jobs <= 16k")
      newline
      spaces(14)
      printstring("10   20   30   40   50   60   70   80   90   100")
      spaces(12)
      printstring("10   20   30   40   50   60   70   80   90   100")
      newline
      spaces(9)
      printstring("-----------------------------------------------------")
      spaces(7)
      printstring("-----------------------------------------------------")
      newline
      totj=0; totkb=0
      for  j=0, 1, 16 cycle 
        totj=totj+tots(i, j)_jobs
        totkb=totkb+tots(i, j)_kbytes
      repeat 
      if  totj#0 start 
        for  j=0, 1, 16 cycle 
          spaces(5); printstring(scale b(j))
          pst=""
          rl=tots(i, j)_jobs/(totj<<1)*100
          k = intpt(rl)
          pst=pst."*" for  l=1, 1, k
          pst=pst."*" if  rl-k>0.5
          printstring(pst)
          spaces(59-length(pst))
          printstring("|"); pst=""
          rl=tots(i, j)_kbytes/(totkb<<1)*100
          k = intpt(rl)
          pst=pst."*" for  l=1, 1, k
          pst=pst."*" if  rl-k>0.5
          printstring(pst); newline
        repeat 
      finish 
      newline
      spaces(12); printstring("As % of all jobs"); spaces(44)
      printstring("As % of total kilobytes")
      newline
      spaces(14)
      printstring("10   20   30   40   50   60   70   80   90   100")
      spaces(12)
      printstring("10   20   30   40   50   60   70   80   90   100")
      newline
      spaces(9)
      printstring("-----------------------------------------------------")
      spaces(7)
      printstring("-----------------------------------------------------")
      newline
      totj=0; totkb=0
      for  j=17, 1, 43 cycle 
        totj=totj+tots(i, j)_jobs
        totkb=totkb+tots(i, j)_kbytes
      repeat 
      if  totj#0 start 
        for  j=17, 1, 43 cycle 
          printstring(scale a(j))
          pst=""
          rl=tots(i, j)_jobs/(totj<<1)*100
          k = intpt(rl)
          pst=pst."*" for  l=1, 1, k
          pst=pst."*" if  rl-k>0.5
          printstring(pst)
          spaces(59-length(pst))
          printstring("|"); pst=""
          rl=tots(i, j)_kbytes/(totkb<<1)*100
          k = intpt(rl)
          pst=pst."*" for  l=1, 1, k
          pst=pst."*" if  rl-k>0.5
          printstring(pst); newline
        repeat 
      finish 
    finish 
  repeat ; ! i loop.

  s printstring("End of queue summary.")
  s newlines(1)

  if  printer=on start 

    select output(1)
    for  i=0, 1, nsys cycle 
      continue  if  fsys map(i)=0
      printer lines=max printer lines+1
      page=1
      !SORT THE ENTRIES FOR THE FSYS INTO ORDER OF MOST KBYTES DOWN..
      count=1
      link=fsys map(i)
      cycle 
        entry(count)=user(link)_kbytes
        entry(count)=x'3FFFF' if  entry(count)>x'3FFFF'
        entry(count)=entry(count)<<14+link
        link=user(link)_link
        exit  if  link=0
        count=count+1
      repeat 
      quicksort(entry,1,count)
      entry(k) = entry(k)&x'3FFF' for  k=1, 1, count
      for  jj=1, 1, count cycle 
        j=entry(jj)
        up == user(j)
        if  printer lines>max printer lines start 
          newpage
          printstring("User output list for ")
          printstring("Period ".start date."(".start time.") to ")
          printstring(end date."(".end time.").   File system: ")
          printstring(intostr(i)."  Page: ".intostr(page))
          newlines(2)
          printstring("        Totals------  Entries:  Queue (total job")
          printstring("s/total kbytes)")
          newline
          printstring("User    Jobs  Kbytes")
          newline
          printsymbol('-') for  m=1, 1, 120
          newlines(2)
          page=page+1
          printer lines=6
        finish 
        printstring(up_user); write(up_jobs, 6)
        write(up_kbytes, 6)
        l=-1
        for  k=1, 1, total devices cycle 
          updk == up_dev(k)
          continue  if  updk_jobs=0
          l=l+1
          if  l=5 start 
            l=0; newline; spaces(20)
            printer lines=printer lines+1
          finish 
          pst=dev table(k)_device."(".intostr(updk_jobs)
          pst=pst."/".intostr(updk_kbytes).")"
          spaces(20-length(pst))
          printstring(pst)
        repeat 
        newline; printer lines=printer lines+1
      repeat 
    repeat 
  finish 
  select output(0)
  close stream(1) if  printer=on
  list("JSTATSFILE,.LP") if  period reporting=on
  send("JSTATSFILE,.LP") if  printer=on
  disconnect("JWORKFILE", flag)
  destroy("JWORKFILE", flag)

  disconnect("T#SPDEVID", flag)
  newgen("T#SPDEVID","JJ#SPDEVID",flag)
  period reporting=off if  period reporting=on
  ! indicate that the reporting was completed.
  end ;  !OF ROUTINE OUTPUT QUEUES!



if  journalsite = kent then  start 
! **************************************************
! **************************************************
! **************************************************
  externalroutine  consumables analysis(string (255) s)
  integer  flag, i, total entries, page, lines
  string (8) start date, start time, end date, end time
  integerarray  x(1:4096)
  record (rf) r
  recordformat  f ucons entry(string (6) user, integer  pages, cards, c 
      ppfeet, gpfeet, spare5)
  record (f ucons entry)arrayformat  af ucons entry(1:4096)
  record (f ucons entry)arrayname  uci
  record (f ucons entry)array  ucr(1:4096)
  record (f ucons entry)name  uce
  !
  !
  routine  quicksort(integer  a, b)
  integer  l, u, d
  !
  return  if  a >= b
  l = a; u = b; d = x(u)
  -> l2
  l1:  l = l + 1
       -> l4 if  l = u
  l2:  -> l1 unless  ucr(x(l))_user > ucr(d)_user
       x(u) = x(l)
  l3:  u = u - 1
       -> l4 if  l = u
       -> l3 unless  ucr(x(u))_user < ucr(d)_user
       x(l) = x(u)
       -> l1
  l4:  x(u) = d
       quicksort(a, l-1)
       quicksort(u+1, b)
  end 
  !
  !
  routine  heading
  newpage
  lines = 6
  printstring("EMAS 2900 Journal report on use of consumable items")
  printstring("          Page:"); write(page, 1)
  newlines(2)
  printstring(start date."(".start time.") to ")
  printstring(end date."(".end time.")")
  newlines(2)
  printstring("           User              Printed Pages")
  printstring("        Cards Punched      Feet of Paper Tape")
  printstring("  Feet of Graph Paper")
  newlines(2)
  page = page + 1
  end 
  !
  !
  connect("JJ#SPCONS", 1, 0, 0, r, flag)
  if  flag # 0 then  start 
     printstring(jtxt." cannot connect consumables stats file")
     newline
     printstring("          'JJ#SPCONS', flag: "); write(flag, 1)
     newlines(2)
     return 
  finish 
  !
  uci == array(r_conad+x'40', af ucons entry)
  start date = unpack date(integer(r_conad+x'24'))
  start time = unpack time(integer(r_conad+x'24'))
  end date = unpack date(integer(r_conad+x'28'))
  end time = unpack time(integer(r_conad+x'28'))
  total entries = 0
  for  i = 1, 1, 4096 cycle 
     if  uci(i)_user # "" then  start 
        total entries = total entries + 1
        ucr(total entries) = uci(i)
     finish 
  repeat 
  if  total entries = 0 then  start 
     printstring(jtxt." no statistics on use of consumables")
     newline
     printstring("          have been collected.")
     newlines(2)
     return 
  finish 
  !
  define("1,JCONSFILE")
  selectoutput(1)
  if  period reporting=on then  start 
    newlines(10)
    printstring("    ***********************************************")
    newline
    printstring("    *  30 day accumulation report to be retained  *")
    newline
    printstring("    ***********************************************")
    newlines(2)
  finish 
  for  i = 1, 1, total entries cycle 
     x(i) = i
  repeat 
  quicksort(1, total entries)
  !
  page = 1
  heading
  for  i = 1, 1, total entries cycle 
     uce == ucr(x(i))
     spaces(10)
     printstring(uce_user)
     spaces(10)
     write(uce_pages, 10)
     spaces(10)
     write(uce_cards, 10)
     spaces(10)
     write(uce_ppfeet, 10)
     spaces(10)
     write(uce_gpfeet, 10)
     newline
     lines = lines + 1
     if  lines > 66 then  heading
  repeat 
  selectoutput(0)
  closestream(1)
  if  period reporting = on then  list("JCONSFILE,.LP,1")
  send("JCONSFILE,.LP")
  period reporting = off
  end ; ! of routine CONSUMABLES ANALYSIS
finish 



! ****************************************************************
! ***************************************************************
  externalroutine  session monitor(string (255) s)
  !THIS ROUTINE GIVES BOTH A MONTHLY REPORT ON DEMAND BY THE AUTO ANALYSIS
  !OF DIRECT LOGS AND ALSO CONTROLS THE INTERACTIVE INTERROGATION OF THE SESSION
  !MONITOR DATABASE.
  routinespec  determine range by date
  routinespec  session file sort(integer  from, to)
  routinespec  group reports(integer  groups, from, to, string (8) c 
          from date, from time, to date, to time)
  routinespec  user report(string (6) user, integer  from, to)
  recordformat  f sessions list(integer  end, pageturns, cpu, elapse,
          procs, byteinteger  type, string (6) user)
  recordformat  f descriptor(integer  copies, keys,
      string (6) array  key(1:50), string (30) array  description(1:50))
  record (f descriptor)name  descriptor
  constinteger  max monthly sessions = 100000
  constinteger  max proc slots = 256
  constinteger  max keys = 50
  record (f sessions list)arrayformat  af sessions list c 
      (1:max monthly sessions)   
  record (f sessions list)arrayname  sessions list
  constinteger  foreground = 1
  constinteger  background = 2
  record  (rf)r
  string (64) st
  string (8) from date, from time, to date, to time
  integer  entries, flag, low entry, high entry, dtfrom, dtto, histograms
  integer  groupreps, copies, keys, i, j
  integerarray  alpha list(1:max monthly sessions)
  integer  conad
  string (20) dtime, ddate, reply
  string (6) array  group key(1:max keys)
  string (30) array  group desc(1:max keys)
  switch  sw(1:7)

  routine  check date and time(stringname  ddate, dtime,
          integername  flag)
    integer  i
    string (8) st, dt
    dt=date
    if  length(ddate)=4 start 
      byteinteger(addr(ddate)+5)=byteinteger(addr(dt)+7)
      byteinteger(addr(ddate)+6)=byteinteger(addr(dt)+8)
      length(ddate)=6
    finish 
    for  i=1, 1, 6 cycle 
      flag=1 and  return  unless  x'30'<=byteinteger(addr(ddate)+i)<=x'39'
    repeat 
    st = substring(ddate, 1, 2)."/".substring(ddate, 3, 4)."/".substring(ddate, 5, 6)
    ddate=st
    if  length(dtime)=4 start 
      byteinteger(addr(dtime)+5)='0'
      byteinteger(addr(dtime)+6)='0'
      length(dtime)=6
    finish 
    for  i=1, 1, 6 cycle 
      flag=1 and  return  unless  x'30'<=byteinteger(addr(dtime)+i)<=x'39'
    repeat 
    st = substring(dtime, 1, 2).".".substring(dtime, 3, 4).".".substring(dtime, 5, 6)
    dtime=st
    flag=0
      return 
  end ;  !OF CHECK DATE AND TIME.

  histograms=no; groupreps=no; keys=0; copies=0
  connect("JJ#DIRSESS", 0, 0, 0, r, flag)
  if  flag#0 start 
    printstring("Session database not available.")
    newline
    return 
  finish 
  cycle 
    connect("JJ#DIRCON", 0, 0, 0, r, flag)
    exit  if  flag=0
    printstring("Cannot connect sessions descriptor file " c 
      .", creating new file.")
    newline
    outfile("T#DIRCON", 4096, 0, 0, conad, flag)
    if  flag#0 start 
      printstring("Cannot create file!!")
      newline
      return 
    finish 
    descriptor==record(conad+x'20')
    integer(conad)=x'1000'
    integer(conad+8)=x'1000'
    descriptor_copies=1
    descriptor_keys=1
    descriptor_key(1)="ALL"
    descriptor_description(1)="COMPLETE LIST"
    disconnect("T#DIRCON", flag)
    rename("T#DIRCON","JJ#DIRCON",flag)
    newgen("T#DIRCON","JJ#DIRCON",flag)
    printstring("File created with defaults: " c 
     ."copies 1, groups 1 ('ALL', for complete list)")
    newline
  repeat 
  descriptor==record(r_conad+x'20')
  connect("JJ#DIRSESS", 0, 0, 0, r, flag)
  if  flag#0 start 
    printstring("Cannot access the session database!")
    newline
    return 
  finish 
  sessions list==array(r_conad+x'50'+max proc slots*24, af sessions list)
  entries=integer(r_conad+x'20')
  from date=unpackdate(integer(r_conad+x'24'))
  from time=unpacktime(integer(r_conad+x'24'))
  to date=unpackdate(integer(r_conad+x'28'))
  to time=unpacktime(integer(r_conad+x'28'))
  ->sw(7) if  s="AUTOMONTHLY"
  cycle 
    prompt("Option:")
    read prompt reply(st)
    ->sw(1) if  st="ADD GROUP"
    ->sw(2) if  st="REMOVE GROUP"
    ->sw(3) if  st->ns1.("MONTHLY COPIES ").st and  ns1="" and  "1"<=st<="9"
    ->sw(4) if  st="REPORT"
    ->sw(5) if  st="CPU PROFILE"
    ->sw(6) if  st->st.(" BREAKDOWN") and  length(st)=6
    printstring("Invalid option!")
    newline
  repeat 

sw(1):    !add a new group to the monthly report.
  disconnect("JJ#DIRCON", flag)
  copy("JJ#DIRCON,T#DIRCON")
  connect("T#DIRCON", 3, 0, 0, r, flag)
  descriptor==record(r_conad+x'20')
  cycle 
    cycle 
      prompt("Group:")
      read prompt reply(st)
      exit  if  length(st)=6 or  st="END"
      printstring("Reply length 6 or 'END'")
      newline
    repeat 
    exit  if  st="END"
    if  descriptor_keys=max keys start 
      printstring("Monthly descriptor groups list full!")
      newline
      exit 
    finish 
    descriptor_keys=descriptor_keys+1
    descriptor_key(descriptor_keys)=st
    prompt("Description:")
    read description(st)
    length(st)=30 if  length(st)>30
    descriptor_description(descriptor_keys)=st
  repeat 
  disconnect("T#DIRCON", flag)
  newgen("T#DIRCON","JJ#DIRCON", flag)
  return 

sw(2):      !remove a group entry from the monthly report.
  disconnect("JJ#DIRCON", flag)
  copy("JJ#DIRCON,T#DIRCON")
  connect("T#DIRCON", 3, 0, 0, r, flag)
  descriptor==record(r_conad+x'20')
  cycle 
    cycle 
      prompt("Group:")
      read prompt reply(st)
      exit  if  st="END" or  length(st)=6 or  st="ALL"
      printstring("Reply length 6 or 'END'")
      newline
    repeat 
    exit  if  st="END"
    if  descriptor_keys#0 start 
      for  i=1, 1, descriptor_keys cycle 
        if  descriptor_key(i)=st start 
          if  i<descriptor_keys start 
            for  j=i+1, 1, descriptor_keys cycle 
              descriptor_key(j-1)=descriptor_key(j)
              descriptor_description(j-1)=descriptor_description(j)
            repeat 
          finish 
          descriptor_keys=descriptor_keys-1
          exit 
        finish 
        if  i=descriptor_keys start 
          printstring("Group: ".st." not found in monthly group list.")
          newline
        finish 
      repeat 
    finish  else  start 
      printstring("No groups in list!!")
      newline
      exit 
    finish 
  repeat 
  disconnect("T#DIRCON", flag)
  newgen("T#DIRCON","JJ#DIRCON",flag)
  return 

sw(3):      !set copies for monthly run.
  disconnect("JJ#DIRCON", flag)
  copy("JJ#DIRCON,T#DIRCON")
  connect("T#DIRCON", 3, 0, 0, r, flag)
  descriptor==record(r_conad+x'20')
  descriptor_copies = s to i(st)
  disconnect("T#DIRCON", flag)
  newgen("T#DIRCON","JJ#DIRCON",flag)
  return 

sw(4):        !make up a report(not the monthly run)
  printstring("The on line database covers " c 
  .from date." ".from time." to ".to date." ".to time)
  newline
  determine range by date
  unless  1<=low entry<=high entry start 
    printstring("No entries found for this period.")
    newline
    return 
  finish 
  cycle 
    prompt("Histograms:")
    read prompt reply(st)
    histograms=yes and  exit  if  st="YES"
    histograms=no and  exit  if  st="NO"
    printstring("YES or NO.")
    newline
  repeat 
  cycle 
    prompt("Group Reports:")
    read prompt reply(st)
    groupreps=no and  exit  if  st="NO"
    if  st="DEFAULTS" start 
      for  i=1, 1, descriptor_keys cycle 
        group key(i)=descriptor_key(i)
        group desc(i)=descriptor_description(i)
      repeat 
      keys=descriptor_keys
      groupreps=yes
      exit 
    finish 
    if  st="SPECIFIC" start 
      cycle 
        prompt("Group:")
        read prompt reply(st)
        exit  if  st="END" and  keys>0
        if  length(st)=6 or  st="ALL" start 
          keys=keys+1
          group key(keys)=st
          prompt("Description:")
          read description(st)
          length(st)=30 if  length(st)>30
          group desc(keys)=st
        finish  else  start 
           printstring("At least one 6 char group, term with 'END'")
          newline
        finish 
      repeat 
      groupreps=yes
      exit 
    finish 
    printstring("'NO' or 'SPECIFIC' or 'DEFAULTS'")
    newline
  repeat 
  if  groupreps=yes or  histograms=yes start 
    cycle 
      prompt("Copies:")
      read prompt reply(st)
      copies = s to i(st)
      exit  if  1<=copies<=10
      printstring("1->10!")
      newline
    repeat 
  finish 
  session file sort(low entry, high entry)
  !  %IF HISTOGRAMS=YES %THEN .......
  if  groupreps=yes start 
    group reports(keys, low entry, high entry, unpackdate(dtfrom),
     unpacktime(dtfrom), unpackdate(dtto), unpacktime(dtto))
    list("SESSIONREP,.LP,".intostr(copies)) if  copies>0
    printstring("Reports printed.")
    newline
  finish 
  return 

sw(5):

sw(6):        !make a list of sessions for the user(group) defined.
  printstring("The on line database covers " c 
  .from date." ".from time." to ".to date." ".to time)
  newline
  determine range by date
  unless  1<=low entry<=high entry start 
    printstring("No entries for this period!")
    newline
    return 
  finish 
  user report(st, low entry, high entry)
  list("SESSIONLIST,.LP")
  return 

sw(7):
  for  i=1, 1, descriptor_keys cycle 
    group key(i)=descriptor_key(i)
    group desc(i)=descriptor_description(i)
  repeat 
  copies=descriptor_copies
  session file sort(1, entries)
  !HISTOGRAMS HERE.
  group reports(descriptor_keys, 1, entries, from date,
    from time, to date, to time)
  list("SESSIONREP,.LP,".intostr(copies-1)) if  copies>1
  list("SESSIONREP,.LP")
  printstring("Reports Printed for Session Monitor"); newline
  copy("JJ#DIRSESS,T#DIRSESS")
  connect("T#DIRSESS", 3, 0, 0, r, flag)
  if  flag#0 start 
    printstring("Cannot connect session monitor file to clear down.")
    newline
    return 
  finish 
  integer(r_conad+x'20')=0
  integer(r_conad+x'24')=0
  integer(r_conad+x'28')=0
  integer(r_conad)=x'60'+max proc slots*24
  integer(r_conad+8)=(integer(r_conad)>>12+1)<<12
  disconnect("T#DIRSESS", flag)
  newgen("T#DIRSESS","JJ#DIRSESS",flag)
  return 


  routine  determine range by date
  integer  i
  cycle 
    cycle 
      prompt("*Low date, time:")
      read prompt reply(reply)
      if  reply="HELP" then  print help(3) else  start 
        if  reply->ddate.(",").dtime start 
          ddate -> (" ").ddate while  charno(ddate,1)=' '
          dtime -> (" ").dtime while  charno(dtime,1)=' '
          if  4<=length(ddate)<=6 and  4<=length(dtime)<=6 start 
            if  length(ddate)#5 and  length(dtime)#5 start 
              check date and time(ddate, dtime, flag)
              exit  if  flag=0
            finish 
          finish 
        finish 
        newline
        printstring(jtxt." check your reply!")
        newline
      finish 
    repeat 
    dtfrom=pack date and time(ddate, dtime)
    cycle 
      prompt("*High date, time:")
      read prompt reply(reply)
      if  reply="HELP" then  print help(3) else  start 
        if  reply->ddate.(",").dtime start 
          ddate -> (" ").ddate while  charno(ddate,1)=' '
          dtime -> (" ").dtime while  charno(dtime,1)=' '
          if  4<=length(ddate)<=6 and  4<=length(dtime)<=6 start 
            if  length(ddate)#5 and  length(dtime)#5 start 
              check date and time(ddate, dtime, flag)
              exit  if  flag=0
            finish 
          finish 
        finish 
        newline
        printstring(jtxt." check your reply!")
        newline
      finish 
    repeat 
    dtto=pack date and time(ddate, dtime)
    unless  dtfrom<dtto start 
      printstring(jtxt." unordered time sequence?")
      newline
    finish  else  exit 
  repeat 
  low entry=0; high entry=0
  for  i=1, 1, entries cycle 
    if  sessions list(i)_end>dtfrom start 
      low entry=i if  low entry=0
      if  sessions list(i)_end>dtto then  exit  c 
        else  high entry=i
    finish 
  repeat 
end ; ! of %routine determine range by date.

routine  session file sort(integer  from, to)
  !This routine takes the main session file and sorts pointers to
  !part of it (from - to), into alphabetical order.
  !The resulting list of pointers is in alpha list(from:to)

  integer  i, d
  string (6) slduser

  routine  quick sort(integer  a, b)
    integer  l, u
    return  if  a >= b
    l = a-1; u = b
    d = alpha list(u); slduser = sessions list(d)_user
    cycle 
      cycle 
        l=l+1
        -> l4 if  l=u
        exit  if  sessions list(alpha list(l))_user>slduser
      repeat 
      alpha list(u)=alpha list(l)
      cycle 
        u=u-1
        ->l4 if  l=u
        exit  if  sessions list(alpha list(u))_user<slduser
      repeat 
      alpha list(l)=alpha list(u)
    repeat 
l4: alpha list(u)=d
    quick sort(a, l-1)
    quick sort(u+1, b)
  end ; ! Of %routine quicksort.

  alpha list(i)=i for  i=from, 1, to
  quick sort(from, to)
end ;  !OF ROUTINE SESSION FILE SORT.

  integerfn  matchkey(string (6) key, user)
    !THIS FN RETURNS MATCH IF THE USER MATTCHES A KEY
    !IGNORING * POSITIONS.
    integer  i
    if  key="ALL" start 
      if  (user->ns1.("EYR").user and  ns1="") then  result  = no match c 
       else  result =match
      !THIS IS TO EXCLUDE ERTE PROCS (NON ERCC SITES MAY WISH THIS REMOVED).
    finish 
    for  i=1, 1, 6 cycle 
      result =no match if  charno(key, i)#'*' and  charno(key, i)#charno(user, i)
    repeat 
    result =match
  end ;  !OF INTEGERFN MATCHKEY

routine  group reports(integer  groups, from, to, string (8) c 
          from date, from time, to date, to time)
  !THIS ROUTINE PRODUCES REPORTS ON SESSIONS FOR EACH OF
  !'GROUPS' USER GROUPS.
  record (f sessions list)name  entry
  record (f sessions list) empty
  integerarray  top(1:groups)
  integerarrayformat  linkf(1:groups, 1:to-from+1)
  integerarrayname  link
  integer  i, j, k, lines, n, page, flag, conad, ali
  integer  cpu, pageturns, fsessions, bsessions, felapse, belapse, fcpu, bcpu
  integer  fpageturns, bpageturns
  integer  totfcpu, totfpts, totfelapse, totfsessions, totbsessions, totbcpu
  integer  totbpts, totbelapse
  string (6) user

  outfile("JSESSIONWK", ((to-from+1)*groups*4)+64, 0, 0, conad, flag)
  if  flag # 0 start 
    printstring("Session monitor group report fails, no file space?")
    newline
    stop 
  finish 
  link == array(conad+x'20', linkf)
  top(i)=0 for  i=1, 1, groups
  !THE LIST 'TOP' TELLS US HOW MANY ENTRIES THERE ARE FOR EACH
  !GROUP TYPE.
  for  i=from, 1, to cycle 
    ali = alpha list(i)
    user = sessions list(ali)_user
    for  j=1, 1, groups cycle 
      if  matchkey(group key(j), user)=match then  top(j)=top(j)+1 and  c 
        link(j, top(j))=ali
    repeat 
  repeat 
  !WE NOW HAVE FORMED THE ALPHABETIC LINKAGE TABLE FOR EACH GROUP.
  define("STREAM01,SESSIONREP,512")
  select output(1)
  newlines(10); spaces(10)
  printstring("EMAS 2900 Journal System session monitor")
  printstring(" report for the period ".from time." ")
  printstring(from date." to ".to time." ".to date.".")
  newline
  empty = 0; ! Null record.
  cpu=0;pageturns=0;fsessions=0;bsessions=0;felapse=0;belapse=0
  fcpu=0;bcpu=0;fpageturns=0;bpageturns=0
  user=""

  for  i=1, 1, groups cycle 
    if  top(i)=0 start 
      newpage
      printstring("No records for the group: ".group key(i))
      newline
      continue 
    finish 
    page=0; lines=max printer lines

    totfelapse=0;totfsessions=0;totbsessions=0
    totfcpu=0;totbcpu=0;totfpts=0;totbpts=0;totbelapse=0

    n = top(i)+1
    for  j=1, 1, n cycle 
      if  j<n then  entry==sessions list(link(i, j)) else  entry==empty
      if  user#entry_user start 
        if  lines>=max printer lines start 
          page=page+1
          lines=10
          newpage
          printstring("Session monitor report " c 
            ."for the period ".from time." " c 
            .from date." to ".to time." ".to date.".")
          printstring("     Page: "); write(page, 2)
          newline
          printstring("User group: ".group key(i)."   ".group desc(i))
          newlines(2)
          spaces(11)
          printstring("Total----------   Foreground----------" c 
            ."------------------------    Background-----------------" c 
            ."-----------------")
          newline
          printstring(" User       CPU  Pageturns   Sessions   " c 
            ."Elapse/Sess   CPU/CMIN   PTS/CPUS    Sessions   " C 
            ."Elapse/Sess   CPU/CMIN   PTS/CPUS")
          newline
          printsymbol('-') for  k=1, 1, 121
          newline
        finish 
        if  user#"" start 
          !IE THE END OF A PARTICULAR USER, REPORT ON HIM.
          printstring(user)
          write(cpu, 8); write(pageturns, 10);write(fsessions, 10)
          if  fsessions > 0 then  print(felapse/fsessions, 11, 1) c 
            else  write(fsessions, 13)
          if  felapse>0 then  print(fcpu/felapse, 8, 1) c 
            else  write(felapse, 10)
          if  fcpu>0 then  print(fpageturns/fcpu, 8, 1) c 
            else  write(fcpu, 10)
          write(bsessions, 11)
          if  bsessions>0 then  print(belapse/bsessions, 11, 1) c 
            else  write(bsessions, 13)
          if  belapse>0 then  print(bcpu/belapse, 8, 1) c 
            else  write(belapse, 10)
          if  bcpu>0 then  print(bpageturns/bcpu, 8, 1) c 
            else  write(bcpu, 10)
          newline
          lines=lines+1
          cpu=0
          pageturns=0
          totfsessions=totfsessions+fsessions; fsessions=0
          totbsessions=totbsessions+bsessions; bsessions=0
          totfcpu=totfcpu+fcpu; fcpu=0
          totbcpu=totbcpu+bcpu; bcpu=0
          totfpts=totfpts+fpageturns; fpageturns=0
          totbpts=totbpts+bpageturns; bpageturns=0
          totbelapse=totbelapse+belapse; belapse=0
          totfelapse=totfelapse+felapse; felapse=0
        finish 
        user=entry_user
      finish 
      cpu=cpu+entry_cpu
      pageturns=pageturns+entry_pageturns
      if  entry_type=foreground start 
        fsessions=fsessions+1
        fcpu=fcpu+entry_cpu
        felapse=felapse+entry_elapse
        fpageturns=fpageturns+entry_pageturns
      finish  else  if  entry_type=background start 
        bsessions=bsessions+1
        bcpu=bcpu+entry_cpu
        belapse=belapse+entry_elapse
        bpageturns=bpageturns+entry_pageturns
      finish 
    repeat ; ! j cycle

    newline
    printstring("Totals for group     Sessions       CPU     " c 
      ." PAGETURNS   ELAPSE/SESS    CPU/CMIN    PTS/CPUS")
    newlines(2)
    printstring("     Foreground:")
    write(totfsessions, 12); write(totfcpu, 9);write(totfpts, 14)
    if  totfsessions>0 then  print(totfelapse/totfsessions, 11, 1) c 
      else  write(totfsessions, 13)
    if  totfelapse>0 then  print(totfcpu/totfelapse, 9, 1) c 
      else  write(totfelapse, 11)
    if  totfcpu>0 then  print(totfpts/totfcpu, 9, 1) c 
      else  write(totfcpu, 11)

    newline
    printstring("     Background:")
    write(totbsessions, 12);write(totbcpu, 9);write(totbpts, 14)
    if  totbsessions>0 then  print(totbelapse/totbsessions, 11, 1) c 
      else  write(totbsessions, 13)
    if  totbelapse>0 then  print(totbcpu/totbelapse, 9, 1) c 
      else  write(totbelapse, 11)
    if  totbcpu>0 then  print(totbpts/totbcpu, 9, 1) c 
      else  write(totbcpu, 11)

    newline
    printstring("   All sessions:")
    write(totbsessions+totfsessions, 12);write(totbcpu+totfcpu, 9);write(totbpts+totfpts, 14)
    if  totbsessions+totfsessions>0 then  print((totbelapse+totfelapse)/(totbsessions+totfsessions), 11, 1) c 
      else  write(totbsessions+totfsessions, 13)
    if  totbelapse+totfelapse>0 then  print((totbcpu+totfcpu)/(totbelapse+totfelapse), 9, 1) c 
      else  write(totbelapse+totfelapse, 11)
    if  totbcpu+totfcpu>0 then  print((totbpts+totfpts)/(totbcpu+totfcpu), 9, 1) c 
      else  write(totbcpu+totfcpu, 11)
  repeat ; ! i cycle.
  newpage
  printstring("End of session monitor report.")
  newlines(2)
  select output(0)
  close stream(1)
  disconnect("JSESSIONWK", flag)
  destroy("JSESSIONWK", flag)
end ;  !OF ROUTINE GROUP REPORTS.

routine  user report(string (6) user, integer  from, to)
  !MAKE UP A LIST OF SESSIONS FOR THE DEFINED USER(GROUP).
  integer  i, j, lines, page

  define("STREAM01,SESSIONLIST")
  select output(1)
  newlines(10); spaces(10)
  printstring("EMAS 2900 Journal System Session Monitor " C 
  ."List for user: ".user)
  newline
  lines=max printer lines
  page=0
  for  i=from, 1, to cycle 
    if  matchkey(user, sessions list(i)_user)=match start 
      if  lines>= max printer lines start 
        newpage
        page=page+1
        lines=10
        newline
        printstring(" User  Session ends----- Elapse    Type      " c 
        ."    CPU       PTS        Page: ".intostr(page))
        newline
        for  j=1, 1, 62 cycle 
          printsymbol('-')
        repeat 
        newlines(2)
      finish 
      printstring(sessions list(i)_user." ".unpackdate( c 
      sessions list(i)_end)." ".unpacktime(sessions list(i)_end))
      write(sessions list(i)_elapse, 6)
      if  sessions list(i)_type=foreground then  c 
        printstring("  Foreground") else  printstring("  Background")
      write(sessions list(i)_cpu, 8)
      write(sessions list(i)_pageturns, 9)
      newlines(2); lines=lines+2
    finish 
  repeat 
  select output(0)
  close stream(1)
  return 
  end ;  !OF USER REPORT
end ; ! Of %external %routine session monitor.

!**************************************************************************
!          ROUTINES AND FUNCTIONS COMMON TO THE SYSTEM.
!**************************************************************************

  routine  s spaces(integer  n)
    select output(0) and  spaces(n) if  t print=on
    select output(1) and  spaces(n) if  p print=on
  end ;  !OF S SPACES

  routine  s newpage
    select output(0) and  newpage if  t print=on
    select output(1) and  newpage if  p print=on
  end ;  !OF S NEWPAGE

  routine  s printstring(string (72) s)
    select output(0) and  printstring(s) if  t print=on
    select output(1) and  printstring(s) if  p print=on
  end ;  !OF S PRINTSTRING

  routine  s newlines(integer  n)
    if  t print=on start 
    select output(0)
    newlines(n)
    terminal lines=terminal lines+n
    finish 
    if  p print=on start 
      select output(1)
      newlines(n)
      printer lines=printer lines+n
    finish 
  end ;  !OF S NEWLINES

  routine  s write(integer  i, j)
    select output(0) and  write(i, j) if  t print=on
    select output(1) and  write(i, j) if  p print=on
  end ;  !OF S WRITE

  routine  s print(integer  i, j, real  r)
    select output(0) and  print(r, i, j) if  t print=on
    select output(1) and  print(r, i, j) if  p print=on
  end ;  !OF S PRINT

endoffile