c****************************************************************
c
	program ak_repair
c
c****************************************************************
c akrepair.for
c
c  Written by:  K. Trumbley,  Software Kinetics Ltd
c  date:        30 May 1986
c
c	This program checks, repairs and edits (if selected) the
c  accounting totals file (default = sys$account:akcount.tot).
c
c  This program calls the routines AK$SWITCH and CMP_DATE, both
c  of which are found in the file AKSWITCH.FOR.
c
c  This program includes both AK.INC and AKCONFIG.INC files.
c
c
	include 'ak.inc/nolist'
	external lib$put_output,lib$get_input,lbr$output_help
	include '($rmsdef)/nolist'
	include '($hlpdef)/nolist'
	include '($libclidef)/nolist'
	character username*12,line*132
	logical*1 err_flag
	equivalence (dummy_log,dummy_str)
	include 'akconfig.inc/nolist'
c
c  get command line from user
c
	call lib$get_foreign(line,,line_len)
c
1	tot_usr = 0
	new_file_flag = .false.
	no_kill_flag = .false.
	err_flag = .false.
	fix_flag = .false.
	auto_fix_flag = .false.
	user_flag = .false.
	exit_flag = .false.
	quit_flag = .false.
	edit_flag = .false.
	help_flag = .false.
	input_flag = .false.
	output_flag = .false.
	begin_flag = .false.
	end_flag = .false.

c
	if (line_len.gt.0) then
c
c  parse command switches in command line
c
	  call str$upcase(line(1:line_len),line(1:line_len))
	  call ak$switch(form_repair,username,line,line_len)
	else
	  write(6,10)
10	  format(/,'$akrepair> ')
	  read(5,20,end=999,err=999) line_len,line
20	  format(q,a)
	  if (line_len.eq.0) goto 1
	  call str$upcase(line(1:line_len),line(1:line_len))
	  if (line.eq.'EX'.or.line.eq.'EXI'.or.
     &	      line.eq.'EXIT') goto 999
	  if (line.eq.'QU'.or.line.eq.'QUI'.or.
     &	      line.eq.'QUIT') goto 999
	  if (line.ne.'HELP'.and.line.ne.'?') goto 1
	  help_flag = .true.
	end if
c
c  Print help documentation if selected
c
	if (help_flag) then
	  status = lbr$output_help(lib$put_output,,'AKREPAIR',
     &	                           'SYS$ACCOUNT:AKCOUNT.HLB',,
     &	                           lib$get_input)
	  if (.not.status) call lib$signal(%val(status))
	  line_len = 0
	  goto 1
	end if
c
c  If edit_flag is TRUE and both user_flag and header_flag are
c  FALSE then prompt user for one or the other.
c
	if (edit_flag.and..not.user_flag.and..not.header_flag) then
30	  write(6,40)
40	  format(/,'$Do you want to edit (U)ser records, (H)eader',
     &	           ' records or (B)oth : ')
	  read(5,20,end=999,err=999) line_len,line
	  if (line_len.eq.0) goto 30
	  call str$upcase(line(1:line_len),line(1:line_len))
	  if (line.eq.'U'.or.line.eq.'B') user_flag = .TRUE.
	  if (line.eq.'H'.or.line.eq.'B') header_flag = .TRUE.
	  if (.not.user_flag.and..not.header_flag) goto 30
	end if

c
c  open old accounting totals file
c
	open(unit=o_tot_fil,name=akcount_filename,status='old',
     &	  carriagecontrol='list')
c
c  open new accounting totals file if fix or autofix mode
c
	if (fix_flag.or.auto_fix_flag.or.edit_flag) then
c
c  Disable normal Control-C and Control-Y actions
c
	  new_file_flag = .true.
	  call set_terminal_ast
	  if (output_flag) then
	    open(unit=n_tot_fil,name=output_filename,status='new',
     &	         carriagecontrol='list')
	  else
	    open(unit=n_tot_fil,name=akcount_filename,status='new',
     &	         carriagecontrol='list')
	  end if
	end if
c
c  read one weeks worth of user records from totals file at a time.
c  Do until all blocks desired have been looked at.
c
	do while (.not.err_flag.and..not.quit_flag)
	  no_kill_flag = .true.
	  call read_tot_file(err_flag)
	  no_kill_flag = .false.
	  if (.not.quit_flag) then
c
c  Check if EDIT selected
c
	    if (edit_flag) then
	      if (.not.exit_flag) call edit_tot_file(username)
	    else
c
c  check and repair header start and end dates
c
	      if (.not.exit_flag) call fix_header(err_flag)
c
c  check and repair each record in the summary array
c
	      do i = 1,tot_usr
	        if (.not.quit_flag) then
	          ak$record = ak$summary(i)
	          if (.not.exit_flag) call fix_record
	          ak$summary(i) = ak$record
	        end if
	      end do
	    end if

c
c  write block to new totals file if fix, autofix or edit mode
c
	    if (fix_flag.or.auto_fix_flag.or.edit_flag) then
	      if (.not.quit_flag) then
	        no_kill_flag = .true.
	        call write_block
	        no_kill_flag = .false.
	      end if
	    end if
	  end if
	end do
c
c  close all open files
c
	close(unit=o_tot_fil)
	if (fix_flag.or.auto_fix_flag.or.edit_flag) then
	  if (quit_flag) then
	    close(unit=n_tot_fil,dispose='DELETE')
	  else
	    close(unit=n_tot_fil,dispose='KEEP')
	  end if
	end if
c
999	continue
c
c  Enable VMS handling of Control-Y
c
	istat = lib$enable_ctrl(%ref(lib$m_cli_ctrly))
	end

c*********************************************************************
c
	subroutine edit_tot_file(username)
c
c*********************************************************************
c
c	This routine edits the header record and the user records
c  which are currently stored in the ak$summary array. Before
c  beginning the editting session, the dates of the header record
c  are check to see if this block is within the specified dates.
c  If the dates are ok then edit header record if header_flag is TRUE.
c  Once finished with header record then if user_flag is TRUE then
c  edit user record(s).
c
	include 'ak.inc/nolist'
	character username*12
	logical*1 cmp_date
	equivalence (dummy_log,dummy_str)
c
c  Check to see if header record falls within date range specified.
c
	if (begin_flag) then
	  if (.not.cmp_date(ak$end_date,begin_date)) return
	end if
	if (end_flag) then
	  if (cmp_date(ak$start_date,end_date)) return
	end if
c
c  Do  HEADER record edit
c
	if (header_flag.and..not.quit_flag) then
	  call edit_header_record
	end if
c
c  Do USER record edit
c
	if (user_flag.and..not.quit_flag) then
	  i = 0
	  do while (i.le.tot_usr.and..not.exit_flag.and.
     &	                             .not.quit_flag)
	    i = i + 1
	    ak$record = ak$summary(i)
	    if (username.eq.'*'.or.username.eq.ak$usr_nam) then
	      call edit_user_record
	      ak$summary(i) = ak$record
	    end if
	  end do
	end if
	return
	end

c*********************************************************************
c
	subroutine edit_header_record
c
c*********************************************************************
c
c	This routine controls all editting of the header record. The
c  only possible functions are:
c
c	Exit          - exit program with all changes saved
c	Quit          - exit program without any changes being applied
c	Set new dates - set new start or end date in header record
c
	include 'ak.inc/nolist'
	integer*4 tmp_start_date(2),tmp_end_date(2)
	character tmp_start_str*24,tmp_end_str*24
	character line*132
	equivalence (dummy_log,dummy_str)
c
	call display_header
c
	write(6,9001)
9001	format(/,'$Do you want to (E)xit, (Q)uit, ',
     &	         '(S)et new date(s) : ')
c
c  Read user response and do action requested
c
	read(5,9002,end=10) line_len,line
9002	format(q,a)
	if (line.eq.'E'.or.line.eq.'e') then
c
c  EXIT and save all changes made so far
c
10	  quit_flag = .false.
	  exit_flag = .true.
	  return
	else if (line.eq.'Q'.or.line.eq.'q') then
c
c  QUIT and throw away all changes made so far
c
	  quit_flag = .true.
	  exit_flag = .true.
	  return

	else if (line.eq.'S'.or.line.eq.'s') then
c
c  SET new header start date
c
20	  write(6,9004)
9004	  format('$Enter start date (form = 12-jul-1986',
     &	             ' 12:03:01) : ')
	  read(5,9002,end=10) line_len,line(1:line_len)
	  if (line_len.ne.0) then
	    call str$upcase(line(1:line_len),line(1:line_len))
	    istat = sys$bintim(line(1:line_len),tmp_start_date)
	    if (.not.istat) goto 20
	    ak$start_date(1) = tmp_start_date(1)
	    ak$start_date(2) = tmp_start_date(2)
	    istat = sys$asctim(,tmp_start_str,tmp_start_date,)
	    write(6,9003) tmp_start_str
9003	    format(' start date set to => ',a,/)
	  end if
c
c  SET new header end date
c
30	  write(6,9014)
9014	  format('$Enter end date (form = 12-jul-1986',
     &	             ' 12:03:01) : ')
	  read(5,9002,end=10) line_len,line(1:line_len)
	  if (line_len.ne.0) then
	    call str$upcase(line(1:line_len),line(1:line_len))
	    istat = sys$bintim(line(1:line_len),tmp_end_date)
	    if (.not.istat) goto 30
	    ak$end_date(1) = tmp_end_date(1)
	    ak$end_date(2) = tmp_end_date(2)
	    istat = sys$asctim(,tmp_end_str,tmp_end_date,)
	    write(6,9013) tmp_end_str
9013	    format(' end date set to => ',a,/)
	  end if
	end if
	return
	end

c*********************************************************************
c
	subroutine edit_user_record
c
c*********************************************************************
c
c	This routine controls all editting of the user record. The
c  only possible functions are:
c
c	Exit            - exit program with all changes saved
c	Quit            - exit program without changes being applied
c	Delete record   - delete the current user record
c	Get next record - fetch next user record
c	edit field      - edit field specified by field number
c
	include 'ak.inc/nolist'
	logical*1 finished
	equivalence (dummy_log,dummy_str)
c
	finished = .false.
c
	do while (.not.finished)
c
c  Display user record on terminal
c
	  call display_record
c
c  Prompt user for action or field number
c
	  write(6,10)
10	  format(/,' Do you want to (E)xit, (Q)uit,',
     &	           ' (D)elete record, (G)et next record or',/,
     &	           '$enter a field number : ')
	  read(5,20,end=30) line_len,line
20	  format(q,a)
c
c  Do action requested (if present)
c
	  if (line_len.eq.0.or.line.eq.'G'.or.line.eq.'g') then
	    finished = .true.
	  else if (line.eq.'E'.or.line.eq.'e') then
30	    finished = .true.
	    exit_flag = .true.
	  else if (line.eq.'Q'.or.line.eq.'q') then
	    finished = .true.
	    quit_flag = .true.
	  else if (line.eq.'D'.or.line.eq.'d') then
	    ak$akrec_typ0 = 20
	    finished = .true.
	  end if
c
c  Check if valid field number
c
	  if (.not.finished.and..not.exit_flag.and.
     &	        .not.quit_flag) then
	    decode(line_len,'(i)',line,err=35) field_number
	    if (field_number.le.0.or.field_number.gt.18) then
35	      write(6,40) char(7)
40	      format(/,' ',a,'*** ERROR: invalid field number ***')
	      call wait_time_interval(2)
	    else
	      call edit_field(field_number)
	    end if
	  end if
	end do
	return
	end

c*********************************************************************
c
	subroutine edit_field(field_number)
c
c*********************************************************************
c
c	This routine displays the field specified by FIELD_NUMBER
c  then prompts the user for new data to insert in the field. Each
c  response is checked for validity before acceptance. All invalid
c  entries will print an error message then redisplay and reprompt
c  the user for valid data. If the user enters a <CR> or CNTL-Z
c  for the prompt, the field is not changed and the routine exits.
c
	include 'ak.inc/nolist'
	character line*132,t_str*30
	equivalence (dummy_log,dummy_str)
c
c
	goto (100,200,300,400,500,600,700,800,900,1000,1100,
     &	      1200,1300,1400,1500,1600,1700,1800) field_number
c
c----------------------------------------------------------------
c			Username field edit
c----------------------------------------------------------------
c
100	call lib$erase_page(1,1)
	write(6,110) ak$usr_nam
110	format(////,' Current username   = ',a12,//,
     &	            '$Enter new username : ')
	read(5,120,end=999) line_len,line
120	format(q,a)
	if (line_len.gt.0) then
	  ak$usr_nam = line(1:12)
	  call str$upcase(ak$usr_nam,ak$usr_nam)
	end if
999	return
c
c----------------------------------------------------------------
c			Account field edit
c----------------------------------------------------------------
c
200	call lib$erase_page(1,1)
	write(6,210) ak$usr_acc
210	format(////,' Current account name   = ',a8,//,
     &	            '$Enter new account name : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  ak$usr_acc = line(1:8)
	  call str$upcase(ak$usr_acc,ak$usr_acc)
	end if
	return

c
c----------------------------------------------------------------
c			UIC field edit
c----------------------------------------------------------------
c
300	call lib$erase_page(1,1)
	write(6,310) ak$usr_grp,ak$usr_mem
310	format(////,' Current UIC   = [',i3,',',i3,']',//,
     &	            '$Enter new UIC, (form = [10,3]) : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  grp_st = index(line(1:line_len),'[')
	  if (grp_st.eq.0) goto 350
	  mem_st = index(line(1:line_len),',')
	  if (mem_st.eq.0) goto 350
	  mem_en = index(line(1:line_len),']')
	  if (mem_en.eq.0) goto 350
	  read(line(grp_st+1:mem_st-1),'(i)',err=350) grp_tmp
	  read(line(mem_st+1:mem_en-1),'(i)',err=350) mem_tmp
	  if (grp_tmp.le.0.or.grp_tmp.gt.32766) goto 350
	  if (mem_tmp.le.0.or.mem_tmp.gt.32766) goto 350
	  ak$usr_grp = grp_tmp
	  ak$usr_mem = mem_tmp
	end if
	return
c
c  ERROR: invalid UIC format
c
350	write(6,360) char(7)
360	format(/,1x,a,'*** ERROR: invalid UIC entry, form = ',
     &	                '[12,3] ***')
	call wait_time_interval(2)
	goto 300

c
c----------------------------------------------------------------
c			Connect time field edit
c----------------------------------------------------------------
c
400	continue
	t_str = 'prime connect time'
	t_len = 18
	hour = int(ak$p_con_tim/3600)
	min = ((ak$p_con_tim/3600.0)-int(ak$p_con_tim/3600))*60
	goto 405
500	continue
	t_str = 'non-prime connect time'
	t_len = 22
	hour = int(ak$n_con_tim/3600)
	min = ((ak$n_con_tim/3600.0)-int(ak$n_con_tim/3600))*60
405	call lib$erase_page(1,1)
	write(6,410) t_str(1:t_len),hour,min,t_str(1:t_len)
410	format(////,' Current ',a,'   = ',i5,
     &	                  ':',i2.2,//,
     &	   '$Enter new ',a,', (form = hr:mm) : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  min_st = index(line(1:line_len),':')
	  if (min_st.eq.0) goto 450
	  read(line(1:min_st-1),'(i)',err=450) hour_tmp
	  read(line(min_st+1:line_len),'(i)',err=450) min_tmp
	  if (hour_tmp.le.0.or.hour_tmp.gt.32766) goto 450
	  if (min_tmp.le.0.or.min_tmp.gt.59) goto 450
	  if (field_number.eq.4) then
	    ak$p_con_tim = hour_tmp*3600 + min_tmp*60
	  else
	    ak$n_con_tim = hour_tmp*3600 + min_tmp*60
	  end if
	end if
	return
c
c  ERROR: invalid connect time format
c
450	write(6,460) char(7)
460	format(/,1x,a,'*** ERROR: invalid connect time entry',
     &	                ', form = 123:45 ***')
	call wait_time_interval(2)
	goto 405

c
c----------------------------------------------------------------
c			CPU time field edit
c----------------------------------------------------------------
c
600	continue
	t_str = 'prime CPU time'
	t_len = 14
	tmp = ak$p_int_tim
	goto 605
700	continue
	t_str = 'non-prime CPU time'
	t_len = 18
	tmp = ak$n_int_tim
605	call lib$erase_page(1,1)
	write(6,610) t_str(1:t_len),tmp,t_str(1:t_len)
610	format(////,' Current ',a,'   = ',i9,//,
     &	            '$Enter new ',a,' : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  read(line(1:line_len),'(i)',err=650) CPU_tmp
	  if (field_number.eq.6) then
	    ak$p_int_tim = CPU_tmp
	  else
	    ak$n_int_tim = CPU_tmp
	  end if
	end if
	return
c
c  ERROR: invalid CPU time format
c
650	write(6,660) char(7)
660	format(/,1x,a,'*** ERROR: invalid CPU time entry',
     &	                ', form = 23456789 ***')
	call wait_time_interval(2)
	goto 605

c
c----------------------------------------------------------------
c			BATCH time field edit
c----------------------------------------------------------------
c
800	continue
	t_str = 'prime BATCH time'
	t_len = 16
	tmp = ak$p_bat_tim
	goto 805
900	continue
	t_str = 'non-prime BATCH time'
	t_len = 20
	tmp = ak$n_bat_tim
805	call lib$erase_page(1,1)
	write(6,810) t_str(1:t_len),tmp,t_str(1:t_len)
810	format(////,' Current ',a,'   = ',i9,//,
     &	            '$Enter new ',a,' : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  read(line(1:line_len),'(i)',err=850) BATCH_tmp
	  if (field_number.eq.8) then
	    ak$p_bat_tim = BATCH_tmp
	  else
	    ak$n_bat_tim = BATCH_tmp
	  end if
	end if
	return
c
c  ERROR: invalid BATCH time format
c
850	write(6,860) char(7)
860	format(/,1x,a,'*** ERROR: invalid BATCH time entry',
     &	                ', form = 23456789 ***')
	call wait_time_interval(2)
	goto 805
c
c----------------------------------------------------------------
c			Disk usage field edit
c----------------------------------------------------------------
c
1000	continue
	t_str = 'disk usage'
	t_len = 10
	tmp = ak$dsk_blk
	goto 1005

c
c----------------------------------------------------------------
c			Volumes mounted field edit
c----------------------------------------------------------------
c
1100	continue
	t_str = 'volumes mounted'
	t_len = 15
	tmp = ak$vol_mnt
	goto 1005
c
c----------------------------------------------------------------
c			Print jobs field edit
c----------------------------------------------------------------
c
1200	continue
	t_str = 'print jobs'
	t_len = 10
	tmp = ak$prt_job
	goto 1005
c
c----------------------------------------------------------------
c			Printed pages field edit
c----------------------------------------------------------------
c
1300	continue
	t_str = 'printed pages'
	t_len = 13
	tmp = ak$prt_pag
	goto 1005
c
c----------------------------------------------------------------
c			Login count field edit
c----------------------------------------------------------------
c
1400	continue
	t_str = 'login count'
	t_len = 11
	tmp = ak$log_cnt
	goto 1005

c
c----------------------------------------------------------------
c			Login failure field edit
c----------------------------------------------------------------
c
1500	continue
	t_str = 'login failure count'
	t_len = 19
	tmp = ak$log_fal
	goto 1005
c
c----------------------------------------------------------------
c			Direct I/O field edit
c----------------------------------------------------------------
c
1600	continue
	t_str = 'direct I/O count'
	t_len = 16
	tmp = ak$dir_io
	goto 1005
c
c----------------------------------------------------------------
c			Buffered I/O field edit
c----------------------------------------------------------------
c
1700	continue
	t_str = 'buffered I/O count'
	t_len = 18
	tmp = ak$buf_io
	goto 1005
c
c----------------------------------------------------------------
c			Page fault field edit
c----------------------------------------------------------------
c
1800	continue
	t_str = 'page fault count'
	t_len = 16
	tmp = ak$pag_flt
	goto 1005

c
c----------------------------------------------------------------
c		Common code for field numbers 11 to 18
c----------------------------------------------------------------
c
1005	call lib$erase_page(1,1)
	write(6,1010) t_str(1:t_len),tmp,t_str(1:t_len)
1010	format(////,' Current ',a,'   = ',i9,//,
     &	            '$Enter new ',a,' : ')
	read(5,120,end=999) line_len,line
	if (line_len.gt.0) then
	  read(line(1:line_len),'(i)',err=1050) field_tmp
	  if (field_number.eq.10) then
	    ak$dsk_blk = field_tmp
	  else if (field_number.eq.11) then
	    ak$vol_mnt = field_tmp
	  else if (field_number.eq.12) then
	    ak$prt_job = field_tmp
	  else if (field_number.eq.13) then
	    ak$prt_pag = field_tmp
	  else if (field_number.eq.14) then
	    ak$log_cnt = field_tmp
	  else if (field_number.eq.15) then
	    ak$log_fal = field_tmp
	  else if (field_number.eq.16) then
	    ak$dir_io = field_tmp
	  else if (field_number.eq.17) then
	    ak$buf_io = field_tmp
	  else if (field_number.eq.18) then
	    ak$pag_cnt = field_tmp
	  end if
	end if
	return
c
c  ERROR: invalid xxxxxxxxx entry
c
1050	write(6,1060) char(7),t_str(1:t_len)
1060	format(/,1x,a,'*** ERROR: invalid ',a,' entry',
     &	                ', form = 23456789 ***')
	call wait_time_interval(2)
	goto 1005
	end

c*********************************************************************
c
	subroutine fix_record
c
c*********************************************************************
c
c	This routine performs automatic fixing or queried fixing
c  depending on the state of AUTO_FIX_FLAG and FIX_FLAG. If both
c  flags are FALSE then routine only prints error message if an
c  error is detected. If in auto_fix mode then errors are repaired
c  automatically. If in fix mode (query mode), and an error is
c  detected, an error message is printed then the user is prompted
c  for one of the following actions:
c
c	IGNORE         - do not repair error
c	DELETE RECORD  - delete user record from file
c	EDIT RECORD    - edit the user record
c
	include 'ak.inc/nolist'
	character line*132
	equivalence (dummy_log,dummy_str)
c
c  Check if username is present
c
	if (ak$usr_nam.eq.' '.or.ak$usr_nam(1:1).eq.char(0)) then
c
c  print record contains blank username
c
	  write(6,8000)
8000	  format(/,' *** ERROR: Record contains blank username ***')
c
c  auto fix mode
c
	  if (auto_fix_flag) then
	      ak$akrec_typ0 = 20
	      write(6,'(a)') ' *** Record deleted ***'
	      return
	  end if

c
c  fix mode
c
	  if (fix_flag) then
8001	    write(6,8005)
8005	    format(/,'$Do you want to (I)gnore error, (E)dit ',
     &	           'the record, (D)elete record : ')
	    read(5,8010,end=8001) line_len,line
8010	    format(q,a)
	    if (line.eq.'D'.or.line.eq.'d') then
	      ak$akrec_typ0 = 20
	      write(6,'(a)') ' *** Record deleted ***'
	      return
	    else if (line.eq.'E'.or.line.eq.'e') then
	      call edit_user_record
	    end if
	  end if
	end if
c
c  Check if invalid account name <login>
c
	if (ak$usr_nam(1:7).ne.'<login>'.and.
     &	    ak$usr_acc(1:7).eq.'<login>') then
c
c  print record contains bad account name
c
	  write(6,8100)
8100	  format(/,' *** ERROR: Record contains invalid account',
     &	           ' name --  <login> ***')
c
c  auto fix mode
c
	  if (auto_fix_flag) then
	      ak$akrec_typ0 = 20
	      write(6,'(a)') ' *** Record deleted ***'
	      return
	  end if

c
c  fix mode
c
	  if (fix_flag) then
8101	    write(6,8105)
8105	    format(/,'$Do you want to (I)gnore error, (E)dit ',
     &	           'the record, (D)elete record : ')
	    read(5,8010,end=8101) line_len,line
	    if (line.eq.'D'.or.line.eq.'d') then
	      ak$akrec_typ0 = 20
	      write(6,'(a)') ' *** Record deleted ***'
	      return
	    else if (line.eq.'E'.or.line.eq.'e') then
	      call edit_user_record
	    end if
	  end if
	end if
c
	return
	end

c*********************************************************************
c
	subroutine fix_header(err_flag)
c
c*********************************************************************
c
c
c  check header start date
c	1. if value of zero then quiry user to see if they want to
c	     a. ignore error
c	     b. enter new date
c	     c. set to same date as previous block's end date
c	2. if not in repair mode than report error but do nothing
c
	include 'ak.inc/nolist'
	integer*4 next_start_date(2),prev_end_date(2)
	integer*4 tmp_start_date(2),tmp_end_date(2)
	character tmp_start_str*24,tmp_end_str*24
	character next_start_str*24,prev_end_str*24,line*132
	logical*1 err_flag
	equivalence (dummy_log,dummy_str)
	equivalence (next_start_date(1),dummy_str(2:2))
c
	data prev_end_date/0,0/
c
c  Check if header start date has the value zero. Repair if necessary
c
	istat = sys$asctim(,start_str,ak$start_date,)
	if ((ak$start_date(1).eq.0.and.ak$start_date(2).eq.0)) then
c
c  print illegal header start date
c
	  istat = sys$asctim(,prev_end_str,prev_end_date,)
	  write(6,9000) start_str(1:11),prev_end_str(1:11)
9000	  format(/,' *** ERROR: Illegal header start date',
     &	         ' found ***',/,
     &	         ' start date found => ',a11,
     &	         ', start date should be => ',a11)
c
c  auto fix mode
c
	  if (auto_fix_flag) then
	    ak$start_date(1) = prev_end_date(1)
	    ak$start_date(2) = prev_end_date(2)
	    write(6,9003) prev_end_str
	  end if

c
c  fix mode
c
	  if (fix_flag) then
10	    write(6,9001)
9001	    format(/,'$Do you want to (I)gnore, (E)nter new date',
     &	           ', (S)et to previous date : ')
	    read(5,9002,end=10) line_len,line
9002	    format(q,a)
	    if (line.eq.'S'.or.line.eq.'s') then
	      ak$start_date(1) = prev_end_date(1)
	      ak$start_date(2) = prev_end_date(2)
	      write(6,9003) prev_end_str
9003	      format(' start date set to => ',a,/)
	    else if (line.eq.'E'.or.line.eq.'e') then
20	      write(6,9004)
9004	      format('$Enter start date (form = 12-jul-1986',
     &	             ' 12:03:01) : ')
	      read(5,9002,end=20) line_len,line(1:line_len)
	      call str$upcase(line(1:line_len),line(1:line_len))
	      istat = sys$bintim(line(1:line_len),tmp_start_date)
	      if (.not.istat) goto 20
	      ak$start_date(1) = tmp_start_date(1)
	      ak$start_date(2) = tmp_start_date(2)
	      istat = sys$asctim(,tmp_start_str,tmp_start_date,)
	      write(6,9003) tmp_start_str
	    end if
	  end if
	end if
c
c  check header end date, (except for last block) if value
c  of zero then set to same date as next block's start date
c
	if (.not.err_flag) then
	  istat = sys$asctim(,end_str,ak$end_date,)
	  if (ak$end_date(1).eq.0.and.ak$end_date(2).eq.0) then
c
c  print illegal header end date
c
	    istat = sys$asctim(,next_start_str,next_start_date,)
	    write(6,9010) end_str(1:11),next_start_str(1:11)
9010	    format(/,' *** ERROR: Illegal header end date',
     &	           ' found ***',/,
     &	           ' end date found => ',a11,
     &	           ', end date should be => ',a11)
c
c  auto fix mode
c
	    if (auto_fix_flag) then
	      ak$end_date(1) = next_start_date(1)
	      ak$end_date(2) = next_start_date(2)
	      write(6,9013) next_start_str
	    end if

c
c  fix mode
c
	    if (fix_flag) then
29	      write(6,9001)
	      read(5,9002,end=29) line_len,line
	      if (line.eq.'S'.or.line.eq.'s') then
	        ak$end_date(1) = next_start_date(1)
	        ak$end_date(2) = next_start_date(2)
	        write(6,9013) next_start_str
9013	        format(' end date set to => ',a,/)
	      else if (line.eq.'E'.or.line.eq.'e') then
30	        write(6,9014)
9014	        format('$Enter end date (form = 12-jul-1986',
     &	               ' 12:03:01) : ')
	        read(5,9002,end=30) line_len,line(1:line_len)
	        call str$upcase(line(1:line_len),line(1:line_len))
	        istat = sys$bintim(line(1:line_len),tmp_end_date)
	        if (.not.istat) goto 30
	        ak$end_date(1) = tmp_end_date(1)
	        ak$end_date(2) = tmp_end_date(2)
	        istat = sys$asctim(,tmp_end_str,tmp_end_date,)
	        write(6,9013) tmp_end_str
	      end if
	    end if
	  end if
	end if
	prev_end_date(1) = ak$end_date(1)
	prev_end_date(2) = ak$end_date(2)
c
c  Check to see if header record type is correct
c  Should be:	 1 = all blocks but last block
c         	-1 = last block
c
	if (ak$akrec_typ1.ne.1.and.ak$akrec_typ1.ne.-1) then
	  write(6,9050)
9050	  format(/,' *** ERROR: Invalid header type ***')
	  if (fix_flag.or.auto_fix_flag) then
	    ak$akrec_typ1 = 1
	    if (err_flag) ak$akrec_typ1 = -1
	    write(6,'(a)') ' *** Header type fixed ***'
	  end if
	end if
c
	return
	end

c*********************************************************************
c
	subroutine read_tot_file(err_flag)
c
c*********************************************************************
c
c	This routine reads one blocks worth of user info from the
c  totals file into the summary array. The err_flag is set true when
c  the last block is read in. All sorts of error checking is done
c  to verify the records read in. The user is queried as to what
c  should be done when an error occurs.
c
	include 'ak.inc/nolist'
	logical*1 err_flag,blk_flag
	character record*32700,line*132
	equivalence (dummy_log,dummy_str)
c
	tot_usr = 0
	err_flag = .false.
	blk_flag = .false.
100	continue
	read(o_tot_fil,110,end=999) j,(record(1:j))
110	format(q,a)
	if (j.eq.128) then
	  dummy_str = record(1:128)
120	  if (dummy_log(1).eq.1.or.dummy_log(1).eq.-1) then
	    if (.not.blk_flag) then
	      ak$header = dummy_str
	      tot_usr = 0
	      blk_flag = .true.
	    else
	      backspace(unit=o_tot_fil)
	      return
	    end if
	  else if (dummy_log(1).eq.0) then
	    ak$record = dummy_str
	    tot_usr = tot_usr + 1
	    ak$summary(tot_usr) = ak$record
	  else
	    write(6,140)
140	    format(' *** ERROR: Undefined record type read ***',//)
	    goto 153
	  end if
	else

c
c  Record read does not contain 128 bytes, prompt user for QUIT
c  or CONTINUE. QUIT exits program, CONTINUE converts record to
c  128 bytes by either filling extra with zero or by truncating
c  record.
c
	  write(6,150) j
150	  format(/,' *** ERROR: record in file contains ',i5,
     &	           ' bytes; expected 128 bytes ***',//)
153	  if (.not.fix_flag) goto 165
	  write(6,155)
155	  format('$Do you want to Q(uit) or C(ontinue) : ')
	  read(5,160,end=170,err=153) line_len,line
160	  format(q,a)
	  if (line_len.le.0) goto 165
	  if (line.eq.'C'.or.line.eq.'c') then
165	    if (j.lt.128) then
	      dummy_str(1:j) = record(1:j)
	      do i = j,128
	        dummy_str(i:i) = char(0)
	      end do
	    else
	      dummy_str = record(1:128)
	    end if
	    dummy_str(1:1) = char(0)
	    goto 120
	  else if (line.eq.'Q'.or.line.eq.'q') then
170	    quit_flag = .true.
	    return
	  else
	    goto 153
	  end if
	end if
	goto 100
999	err_flag = .true.
	return
	end

c*********************************************************************
c
	subroutine write_block
c
c*********************************************************************
c
c	This routine writes the block of info contained in AK$HEADER
c  and AK$SUMMARY to the output totals file. User records with the
c  type byte set to DELETE are not copied to the output file.
c
	include 'ak.inc/nolist'
	equivalence (dummy_log,dummy_str)
c
c  output header
c
	dummy_str = ak$header
	write(n_tot_fil,'(128a1)') (dummy_log(j),j=1,128)
c
c  output all user records
c
	do i = 1,tot_usr
	  dummy_str = ak$summary(i)
	  if (dummy_log(1).ne.20) then
	    write(n_tot_fil,'(128a1)') (dummy_log(j),j=1,128)
	  end if
	end do
c
	return
	end

c*********************************************************************
c
	subroutine display_header
c
c*********************************************************************
c
c	This routine display the header record information on the
c  users terminal.
c
	include 'ak.inc/nolist'
	character tmp_start_str*24,tmp_end_str*24
	istat = sys$asctim(,tmp_start_str,ak$start_date,)
	istat = sys$asctim(,tmp_end_str,ak$end_date,)
c
	call lib$erase_page(1,1)
c
	write(6,100)
100	format(' ----------------------------------------------',
     &	        '--------------------------------')
110	format(' ')
	write(6,150) header_str
150	format(' ',a80)
	write(6,100)
	write(6,110)
	write(6,9000) tmp_start_str,tmp_end_str
9000	format(' Header start date = ',a,/,
     &	       '          end date = ',a,/)
	write(6,100)
	write(6,110)
	return
	end

c*********************************************************************
c
	subroutine display_record
c
c*********************************************************************
c
c	This routine displays the users record information on the
c  users terminal.
c
	include 'ak.inc/nolist'
	character line*132,tmp_start_str*24,tmp_end_str*24
	istat = sys$asctim(,tmp_start_str,ak$start_date,)
	istat = sys$asctim(,tmp_end_str,ak$end_date,)
c
	call lib$erase_page(1,1)
c
	write(6,100)
100	format(' ----------------------------------------------',
     &	        '--------------------------------')
110	format(' ')
	write(6,150) header_str
150	format(' ',a80)
	write(6,200) ak$usr_nam,ak$usr_acc,ak$usr_grp,ak$usr_mem
200	format(' Username (1) : ',a12,t33,'Account (2) : ',a8,
     &	       t58,'UIC (3) : [',i3,',',i3,']')
	write(6,110)
	write(6,205) tmp_start_str(1:12),tmp_end_str(1:12)
205	format(t17,'Record for  ',a12,' to  ',a12)
	write(6,100)
c
	phour = int(ak$p_con_tim/3600)
	pmin = ((ak$p_con_tim/3600.0)-int(ak$p_con_tim/3600))*60
c
	nhour = int(ak$n_con_tim/3600)
	nmin = ((ak$n_con_tim/3600.0)-int(ak$n_con_tim/3600))*60
c
	write(6,240)
240	format(t5,'PRIME TIME',t48,'NONPRIME TIME')
	write(6,110)
	write(6,242) phour,pmin,nhour,nmin
242	format(' Connect time (h:m)  (4) :  ',i5,':',i2.2,t40,
     &	       ' Connect time (h:m)  (5) :  ',i5,':',i2.2)
	write(6,245) ak$p_int_tim,ak$n_int_tim
245	format(' CPU time     (sec)  (6) : ',i9,t40,
     &	       ' CPU time     (sec)  (7) : ',i9)
	write(6,246) ak$p_bat_tim,ak$n_bat_tim
246	format(' BATCH time   (sec)  (8) : ',i9,t40,
     &	       ' BATCH time   (sec)  (9) : ',i9)
	write(6,110)
	write(6,247) ak$dsk_blk,ak$vol_mnt
247	format(' Disk usage (blks)  (10) : ',i9,t40,
     &	       ' Volumes mounted    (11) : ',i9)

	write(6,248) ak$prt_job,ak$prt_pag
248	format(' Print jobs         (12) : ',i9,t40,
     &	       ' Pages printed      (13) : ',i9)
	write(6,249) ak$log_cnt,ak$log_fal
249	format(' Login count        (14) : ',i9,t40,
     &	       ' Login failures     (15) : ',i9)
	write(6,250) ak$dir_io,ak$buf_io
250	format(' Direct I/O count   (16) : ',i9,t40,
     &	       ' Buffered I/O count (17) : ',i9)
	write(6,251) ak$pag_flt
251	format(' Page fault count   (18) : ',i9)
	write(6,100)
c
	return
	end

c*********************************************************************
c
	subroutine wait_time_interval(time)
c
c*********************************************************************
c
c	This routine waits the number of seconds specified in TIME
c  then exits.
c
	implicit integer(a-z)
	integer*4 timeout(2)
	character timeout_str*20
c
c  Convert time in seconds to timeout_str
c
	days = time/3600/24
	hours = (time-(days*3600*24))/3600
	minutes = (time-(days*3600*24)-(hours*3600))/60
	seconds = (time-(days*3600*24)-(hours*3600)-(minutes*60))
	timeout_str = '0000 00:00:00'
	encode(4,90,timeout_str(1:4)) days
	encode(2,100,timeout_str(6:7)) hours
	encode(2,100,timeout_str(9:10)) minutes
	encode(2,100,timeout_str(12:13)) seconds
90	format(i4.4)
100	format(i2.2)
c
c  Set timer going and wait for it to complete
c
	istat = sys$bintim(timeout_str,timeout)
	istat = sys$setimr(%val(20),timeout,,%val(10))
	istat = sys$waitfr(%val(20))
	return
	end

c****************************************************************
c
	subroutine set_terminal_ast
c
c****************************************************************
c
c	This routine checks to see if the AKREPAIR program is
c  currently talking to a real terminal from SYS$INPUT. If not
c  then don't bother doing the AST capture of control-C and
c  control-Y characters.
c
	implicit integer(a-z)
	include '($dcdef)'
	include '($dvidef)'
	include '($iodef)'
	include '($libclidef)'
	integer*2 t_chan, dvi_len, dvi_code
	integer*4 dvi_add(3), dvi_class, dvi_class_len
	common /dvicom/t_chan,dvi_len,dvi_code,dvi_add
c
c  Assign a channel to SYS$INPUT
c
	istat = sys$assign('SYS$INPUT:',t_chan,,)
	if (.not.istat) call lib$stop(%val(istat))
c
c  Setup for GETDVI system service
c
	dvi_len = 4
	dvi_code = DVI$_DEVCLASS
	dvi_add(1) = %loc(dvi_class)
	dvi_add(2) = %loc(dvi_class_len)
	dvi_add(3) = 0
c
c  Determine if real terminal connected to SYS$INPUT
c
	istat = sys$getdvi(,%val(t_chan),,%ref(dvi_len),,,,)
	if (.not.istat) call lib$stop(%val(istat))
	if (dvi_class.eq.DC$_TERM) call set_ast
	return
	end

c****************************************************************
c
	subroutine set_ast
c
c****************************************************************
c
c	This routine sets up the AST routine "terminal_ast" to
c  execute if the user types either a control-C or control-Y
c  character on their terminal. After which the VMS handling of
c  the control-Y character must be disabled so the AST routine
c  will execute.
c
	implicit integer(a-z)
	include '($iodef)'
	include '($libclidef)'
	integer*2 t_chan, dvi_len, dvi_code
	integer*4 dvi_add(3), dvi_class, dvi_class_len
	common /dvicom/t_chan,dvi_len,dvi_code,dvi_add
	external terminal_ast
c
c  Enable the routine terminal_ast to capture Control-C
c
	istat = sys$qio(,%val(t_chan),
     &	        %val(io$_setmode.or.io$m_ctrlcast),,,,
     &	        %ref(terminal_ast),,,,,,)
	if (.not.istat) call lib$stop(%val(istat))
c
c  Enable the routine terminal_ast to capture Control-Y
c
	istat = sys$qio(,%val(t_chan),
     &	        %val(io$_setmode.or.io$m_ctrlyast),,,,
     &	        %ref(terminal_ast),,,,,,)
	if (.not.istat) call lib$stop(%val(istat))
c
c  Disable VMS capture of Control-Y
c
	istat = lib$disable_ctrl(%ref(lib$m_cli_ctrly),)
	if (.not.istat) call lib$stop(%val(istat))
c
	return
	end

c****************************************************************
c
	subroutine terminal_ast
c
c****************************************************************
c
c	This routine executes whenever the user types a control-C
c  or control-Y character. When executed, this routine checks to
c  see if a new file is currently open and if so then closes it
c  and deletes it. After which the control characters are enabled
c  for the VMS operating system.
c
	include 'ak.inc/nolist'
	include '($libclidef)'
c
c  check to see if repair program killable. if not then set 
c  quit_flag and return.
c
	if (no_kill_flag) then
	  quit_flag = .true.
	  return
	end if
c
c  Check if NEW file currently open. If so then delete it then exit
c
	If (new_file_flag) then
	  close(unit=n_tot_fil,dispose='DELETE')
	end if
c
c  Enable VMS handling of Control-Y
c
	istat = lib$enable_ctrl(%ref(lib$m_cli_ctrly))
C
	call exit
	return
	end
