$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user EWV
$! on 17-JUL-1992 11:13:39.13.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 5 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 20 files:
$!        APPEND.FOR
$!        CHECK.FOR
$!        CONVERT_STATUS.FOR
$!        GETKEY.FOR
$!        JOB_CONTROL.FOR
$!        JOB_DISPLAY.FOR
$!        LENGTH.FOR
$!        MESSAGE_TRAP.FOR
$!        OPCON.FOR
$!        PROCESS_CONTROL.FOR
$!        PROCESS_SELECT.FOR
$!        QUEUE_CONTROL.FOR
$!        QUEUE_FIND.FOR
$!        QUEUE_MONITOR.FOR
$!        QUEUE_SELECT.FOR
$!        SEND.FOR
$!        SMG_COMMON.FOR
$!        USER_SELECT.FOR
$!        VIEW_MESSAGES.FOR
$!        YES_NO.FOR
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START: 
$ FILE_IS = "APPEND.FOR"
$ CHECKSUM_IS = 337363107
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine append(log_message)
X     `032
X      implicit none
X     `032
X      common /user/ username
X     `032
X      character*(*) log_message
X      character*80  junk
X      character*8   tod
X      character*9   when
X      character*12  username
X     `032
V      open (32,file='accuser:[acc_op.opcon]opcon.log',status='unknown',err=13
X00)
X           `032
X 1000 read (32,'(a)',end=1100,err=1200) junk  !Go to end of current file
X      go to 1000
X
X 1100 continue
X
X      call time(tod)   !Get time and date, then write out message
X      call date(when)
X     `032
X      write (32,5000,err=1300) tod,when,username,log_message`032
X           `032
X 1200 close(32)
X     `032
X 1300 continue
X
X      return
X`032
X 5000 format(1X,A8,1X,A9,1X,A12,/,1X,A)    `032
X     `032
X      end     `032
$ GOSUB UNPACK_FILE

$ FILE_IS = "CHECK.FOR"
$ CHECKSUM_IS = 236073452
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine check(uic,terminal,full)
X
X******************************************************************
X*     This routine is quite site specific.  As it is now, it     *
X*     restricts access to users in our center and with UIC codes *
X*     corresponding to our operators.                            *
X******************************************************************
X
X
X      implicit none
X      integer number_groups
X      integer uic
X      character*7 terminal
X
X      parameter (number_groups=3)              !number of authorized groups
X
X      integer i
X      logical full,ok                          !allows process termination
X                                               !full gives full access, ok
X                                               !gives partial access
X      integer ok_uics(number_groups)           !list of UIC codes allowed
X      data ok_uics / '42'O, '11'O, '12'O /     !to run program
X
X      ok = .false.
X      full = .false.
X
X      do i = 1,number_groups
X        if (ok_uics(i) .eq. uic) then
X          ok = .true.
X        end if
X      end do
X
X      if (terminal(1:2) .eq. 'OP') then      !Full access in machine room
X        full = .true.
X      else if (terminal(1:2) .eq. 'QT') then !Partial access over network
X        full = .false.
X      else
X        full = .false.                       !No access over modem, etc.
X        ok = .false.
X      end if
X
X      ok = .true.               !Remove this before installing.  Gives full
X      full = .true.             !access to ALL users
X
X      if (.not. ok) then
X        write (*,*) 'You are not authorized to run this program.'
X        write (*,*) 'Only ACC Student Consultants and staff are authorized'
X        write (*,*) 'to run this program.'
X        write (*,*) 'You need to be in the machine room or on the network'
X        write (*,*) 'to run this program.  You may not log in from a'
X        stop        'subprocess.'
X      end if
X
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "CONVERT_STATUS.FOR"
$ CHECKSUM_IS = 2082091667
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine convert_status_queue(numerical,textual)
X     `032
X      implicit none
X     `032
X      integer numerical
X      character*(*) textual
X      include '($quidef)'
X     `032
X      if ((numerical .and. qui$m_queue_closed) .eq. qui$m_queue_closed) then
X        textual = 'Closed'
V      else if ((numerical .and. qui$m_queue_unavailable) .eq. qui$m_queue_una
Xvailable) then
X        textual = 'Unavailable'
V      else if ((numerical .and. qui$m_queue_stopped) .eq. qui$m_queue_stopped
X) then
X        textual = 'Stopped'
V      else if ((numerical .and. qui$m_queue_stalled) .eq. qui$m_queue_stalled
X) then
X        textual = 'Stalled'
V      else if ((numerical .and. qui$m_queue_paused) .eq. qui$m_queue_paused)
X then
X        textual = 'Paused'
V      else if ((numerical .and. qui$m_queue_pausing) .eq. qui$m_queue_pausing
X) then
X        textual = 'Pausing'
V      else if ((numerical .and. qui$m_queue_resetting) .eq. qui$m_queue_reset
Xting) then
X        textual = 'Resetting'
V      else if ((numerical .and. qui$m_queue_resuming) .eq. qui$m_queue_resumi
Xng) then
X        textual = 'Resuming'
V      else if ((numerical .and. qui$m_queue_starting) .eq. qui$m_queue_starti
Xng) then
X        textual = 'Starting'
V      else if ((numerical .and. qui$m_queue_stopping) .eq. qui$m_queue_stoppi
Xng) then
X        textual = 'Stopping'
X      else if ((numerical .and. qui$m_queue_idle) .eq. qui$m_queue_idle) then
X        textual = 'Idle'
X      else
X        textual = 'Processing'
X      end if
X
X      return
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "GETKEY.FOR"
$ CHECKSUM_IS = 858805019
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine getkey(delay,terminator)
X     `032
X      implicit none
X
X      include '($smgdef)'
X      include 'smg_common.for'
X     `032
X      integer status
X      integer*2 terminator
X      integer delay
X           `032
X      status = smg$read_keystroke (kb,terminator,,delay,,,)
X     `032
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "JOB_CONTROL.FOR"
$ CHECKSUM_IS = 857607186
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine job_control(entry_number,username)
X     `032
X      implicit none
X     `032
X      include '($sjcdef)'
X      include '($smgdef)'
X      include 'smg_common.for'
X                 `032
X      structure   /itmlst/
X        union
X          map
X            integer*2 buflen,itmcod
X            integer*4 bufadr,retadr
X          end map
X          map
X            integer*4 end_list
X          end map
X        end union
X      end structure
X     `032
X      structure   /iosblk/
X        integer*4 sts,zeroed
X      end structure
X
X      logical verify,quit
X     `032
X      integer   status
X      integer   sys$sndjbcw
X      integer   terminator
X      integer   choice
X      integer   entry_number
X      integer   job_action_menu
X      integer   length
X     `032
X      character*15  job_action(10)
X      character*50  log_message
X      character*4   entry_string
X      character*12  username
X     `032
X      record /itmlst/ submit_list(6)
X      record /iosblk/ iosb
X                 `032
X      submit_list(1).buflen = 4
X      submit_list(1).itmcod = sjc$_entry_number
X      submit_list(1).bufadr = %loc(entry_number)
X      submit_list(1).retadr = 0
X      submit_list(2).end_list = 0
X           `032
X      job_action(1)  = 'Delete Entry'
X
X      job_action(10) = 'Exit'
X     `032
V      status = smg$create_virtual_display(14,24,job_action_menu,smg$m_border,
X,)
X      status = smg$create_menu(job_action_menu,job_action,smg$k_vertical,,,,)
X      status = smg$paste_virtual_display(job_action_menu,pbid,7,30)
X                 `032
V      status = smg$select_from_menu(kb,job_action_menu,choice,,,,,terminator,
X,,)
X
X      if (choice .eq. 10 .or. terminator .eq. smg$k_trm_ctrlz) then`032
X        quit = .true.
X      else if (choice .eq. 1) then
X        call yes_no_selection(verify)
X        if (verify) then
X          status = sys$sndjbcw(,%val(sjc$_delete_job),,submit_list,iosb,,)
X          if (.not. status) call lib$signal(%val(status))
X          write (entry_string,'(i4)') entry_number
X          log_message = 'Deleted Entry ' // entry_string // ' (' //
X     &                  username(1:length(username)) // ')'
X          call append(log_message)
X        end if                 `032
X      end if
X                                                         `032
X      status = smg$delete_virtual_display(job_action_menu)
X     `032
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "JOB_DISPLAY.FOR"
$ CHECKSUM_IS = 895947968
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine job_display(queue_name)
X`032
X      implicit none
X`032
X      include     '($quidef)'
X      include     '($smgdef)'
X      include     'smg_common.for'
X`032
X      structure   /itmlst/
X        union
X          map
X            integer*2 buflen,itmcod
X            integer*4 bufadr,retadr
X          end map
X          map
X            integer*4 end_list
X          end map
X        end union
X      end structure
X`032
X      structure   /iosblk/
X        integer*4 sts,zeroed
X      end structure
X`032
X      structure /qstatus/
X        character*4     entry
X        character*12    username
X        character*12    status
X      end structure
X`032
X      logical     quit
X
X      integer     sys$getquiw
X      integer     length
X
X      integer*4   search_flags
X      integer     queue_status
X      integer     username_len
X      integer     job_status
X      integer     i,j,k
X      integer     choice
X      integer     terminator
X      integer     job_window
X      integer     entry_number
X      integer     number_of_jobs
X      integer     entry_number_of_job(200)
X      integer     status
X      integer*2   search_name_len
X
X      character*31  search_name
X      character*31  queue_name
X      character*30  label   /'Entry Username        Status'/
X      character*12  username
X      character*30  menu_choices(200)
X
X      record /qstatus/ job(100)
X      record /itmlst/ queue_list(4)
X      record /itmlst/ job_list(10)
X      record /iosblk/ iosb
X
X      quit = .false.
X`032
X******************************************
X*     Setup Window                       *
X******************************************
X`032
X      status = smg$create_virtual_display(20,32,job_window,smg$m_border,,)
X      status = smg$paste_virtual_display(job_window,pbid,2,24)
X      status = smg$label_border(job_window,label,,2,smg$m_reverse,,)
X`032
X      search_name = queue_name
X      search_name_len = length(search_name)
X`032
X      queue_list(1).buflen = search_name_len
X      queue_list(1).itmcod = qui$_search_name
X      queue_list(1).bufadr = %loc(search_name)
X      queue_list(1).retadr = 0
X      queue_list(2).buflen = 4
X      queue_list(2).itmcod = qui$_search_flags
X      queue_list(2).bufadr = %loc(search_flags)
X      queue_list(2).retadr = 0
X      queue_list(3).buflen = 4
X      queue_list(3).itmcod = qui$_queue_status
X      queue_list(3).bufadr = %loc(queue_status)
X      queue_list(3).retadr = 0
X      queue_list(4).end_list = 0
X`032
X      job_list(1).buflen = 4
X      job_list(1).itmcod = qui$_search_flags
X      job_list(1).bufadr = %loc(search_flags)
X      job_list(1).retadr = 0
X      job_list(2).buflen = 4
X      job_list(2).itmcod = qui$_entry_number
X      job_list(2).bufadr = %loc(entry_number)
X      job_list(2).retadr = 0
X      job_list(3).buflen = 12
X      job_list(3).itmcod = qui$_username
X      job_list(3).bufadr = %loc(username)
X      job_list(3).retadr = %loc(username_len)
-+-+-+-+-+ End of part 1 +-+-+-+-+-

