PROGRAM	REMPRINT
C************************************************************************
C*
C*  COPYRIGHT (c) 1982,1985,1986,1987
C*  Westinghouse Electric Corporation
C*
C*  THIS SOFTWARE IS FURNISHED WITHOUT LICENSE AND MAY BE USED AND
C*  COPIED ONLY WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.
C*
C*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
C*  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY WESTINGHOUSE.
C*
C*  WESTINGHOUSE ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
C*  OF THIS SOFTWARE.
C*
C****************************************************************************
C	 8-Oct-1982 by Paul Orszula
C		Loosely based on the program NETPRT by Kevin Klughart.
C	 5-Aug-1986 by Marty Adkins
C		Major rewrite (Paul wouldn't recognize it!) -
C		  Use external CLD and call CLI routines for most parsing.
C		  Use LIB$FIND_FILE for all file parse/search.
C-----------------------------------------------------------------------*
C  This program permits users to print files on another DECnet-VAX node
C  with most of the normal PRINT qualifiers.
C  The files are copied to a scratch directory on the remote node and
C  the remote PRINT command is executed after the username and account
C  have been set to that of the local user.
C  There are 3 possible syntax types:
C	REMPRINT node file1,file2,... /print_args
C	REMPRINT node /ABORT=(job1,job2,...) queue_name
C	REMPRINT node /SHOW_QUEUE
C  REMPRINT requires NETMBX and TMPMBX privileges for proper operation.
C-----------------------------------------------------------------------*
C	Language:	VAX-11 FORTRAN V4.5
C	System:		VAX/VMS V4.4
C	DECnet:		phase IV
C	Externals:	WUTIL$LIB:VAXLIB/INCLUDE=LENGTH
C			REMPRINT.CLD - add to DCLTABLES
C			WUTIL$:NETJOB.EXE - sets username & account
C-----------------------------------------------------------------------*

      IMPLICIT INTEGER (A-Z)
      PARAMETER l_id		= 80		! length of id
      PARAMETER max_line	= 1024		! maximum line length
      PARAMETER max_file	= 255		! maximum file length
      PARAMETER max_user	= 12		! maximum username length
      PARAMETER max_acc		= 15		! maximum account length
      PARAMETER ZERO            = ICHAR('0')

      INCLUDE '($JPIDEF)'
      INCLUDE '($SYIDEF)'
      INCLUDE '($LNMDEF)'
      INCLUDE '($RMSDEF)'
      PARAMETER CLI$M_NOWAIT = '00000001'X
      PARAMETER CLI$M_NOCLISYM = '00000002'X
      PARAMETER CLI$M_NOKEYPAD = '00000008'X
      PARAMETER CLI$_PRESENT = '0003FD19'X
      PARAMETER CLI$_NEGATED = '000381F8'X

      EXTERNAL SS$_NORMAL,LIB$SET_SYMBOL,LIB$GET_SYMBOL
      EXTERNAL LIB$K_CLI_LOCAL_SYM,LIB$K_CLI_GLOBAL_SYM
      EXTERNAL LIB$_NOCLI,LIB$_AMBSYMDEF,LIB$_FATERRLIB,LIB$_INVSYMNAM
      EXTERNAL LIB$_NOSUCHSYM,LIB$_STRTRU

      Structure /Item_List/
        Union
          Map
            Integer*2 Buffer_Length, Item_Code
            Integer*4 Buffer_Address, Return_Address
          End Map
          Map
            Integer*4 End_List
          End Map
        End Union
      End Structure
      
      Record /Item_List/ Job_Item_List(3), System_Item_List(2),
     1                   logical_name_item_list(2)

      CHARACTER*(max_line) prtstr, clistr, cpystr, quals, tmpstr
      CHARACTER*(max_line) copy_string, print_string, abort_string
      CHARACTER*(max_file) filename, exp_filename, temp_file
      CHARACTER*(max_file) extname, blank_string, cont_string
      CHARACTER*(max_file) killstr, string
      CHARACTER rmt_node*10, temp_node*10, verb*8
      CHARACTER username*(max_user), account*(max_acc), id*(l_id)
      CHARACTER temp_char, temp_queue*10, name*15
      CHARACTER nodename*15, cpid*8, account_flag, log_name*8

      INTEGER*4 node_del, context, wait, rmssts, rmsstv, temp_l_node
      INTEGER*4 l_prtstr, l_rn, l_string, l_username, l_acc, userpid
      INTEGER*4 jpi_table(7), iosb(2), l_temp_queue, l_tmpstr, itemp
      INTEGER*4 l_nodename, al_id, temp, l_temp_file, l_extname
      INTEGER*4 l_exp_filename, i_aster, i_percent, temp_flag

      LOGICAL abort, more_files, show_queue, first_file, temp_flag2

      abort = .FALSE.
      show_queue = .FALSE.
      account_flag = '0'
      blank_string = ' '
      cont_string = '!'
      log_name = 'SYS$NODE'

      LOCAL  = %LOC(LIB$K_CLI_LOCAL_SYM)
      GLOBAL = %LOC(LIB$K_CLI_GLOBAL_SYM)

C-----------------------------------------------------------------------*
C	Get username and account of calling process
C-----------------------------------------------------------------------*

      job_item_list(1).buffer_length = 12
      job_item_list(1).item_code = JPI$_USERNAME
      job_item_list(1).buffer_address = %LOC(username)
      job_item_list(1).return_address = %LOC(l_username)
      job_item_list(2).buffer_length = 8
      job_item_list(2).item_code = JPI$_ACCOUNT
      job_item_list(2).buffer_address = %LOC(account)
      job_item_list(2).return_address = %LOC(l_acc)
      job_item_list(3).end_list = 0

      STATUS = SYS$GETJPIW(,,,job_item_list,iosb,,)
      IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

      system_item_list(1).buffer_length = 15
      system_item_list(1).item_code = SYI$_NODENAME
      system_item_list(1).buffer_address = %LOC(nodename)
      system_item_list(1).return_address = %LOC(l_nodename)
      system_item_list(2).end_list = 0

      STATUS = SYS$GETSYIW(,,,system_item_list,iosb,,)
      IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

      IF (l_nodename .le. 0) THEN
        logical_name_item_list(1).buffer_length = 8
        logical_name_item_list(1).item_code = LNM$_STRING
        logical_name_item_list(1).buffer_address = %loc(nodename)
        logical_name_item_list(1).return_address = %loc(l_nodename)
        logical_name_item_list(2).end_list = 0

        status = sys$trnlnm (,'LNM$SYSTEM_TABLE',log_name,,
     1                       logical_name_item_list)
        IF (.NOT. status) CALL lib$stop(%VAL(STATUS))
        temp = index (nodename, ':')
        IF (temp .gt. 1) l_nodename = temp - 1

        IF (l_nodename .le. 0) THEN
          CALL LIB$PUT_OUTPUT
     1               ('%REMPRINT-F-DECNETERR, SYS$NODE not defined')
          CALL LIB$STOP(%VAL(STATUS))
        end if
      end if
C-----------------------------------------------------------------------*
C	Form an ID string based on local node, username, and time
C-----------------------------------------------------------------------*
      istat = SYS$ASCTIM(,string,,%val(1))
      l_username = length(username)
      id = nodename(:l_nodename)//username(:l_username)//string(1:2)//
     +     string(4:5)//string(7:8)//string(10:10)
      al_id = l_nodename + l_username + 7

C-----------------------------------------------------------------------*
C	There are 3 possible syntax types:
C	  REMPRINT node file1,file2,... /print_args
C	  REMPRINT node /ABORT=(job1,job2,...) queue_name
C	  REMPRINT node /SHOW_QUEUE
C-----------------------------------------------------------------------*
      CALL CLI$GET_VALUE('NODE', RMT_NODE, L_NODE)
      node_del = INDEX(rmt_node(1:L_NODE) // '::', '::')
      temp_node = rmt_node(1:node_del-1)
      l_temp_node = node_del - 1
      rmt_node = rmt_node(1:node_del-1) // '::'
      l_rn = node_del + 1

      IF (CLI$PRESENT('SHOW_QUEUE')) THEN
C        build SHOW QUEUE /DEVICE 
        show_queue = .TRUE.

      ELSE IF (CLI$PRESENT('ABORT')) THEN
C        build DELETE/ENTRY=(n,n,...) P2
        abort = .TRUE.
        string = ' '
        l_string = 0
        MORE_FILES = .TRUE.
        DO WHILE (MORE_FILES)
          MORE_FILES = CLI$GET_VALUE('ABORT', filename,l_file)
          IF (MORE_FILES) THEN
            IF (l_string .GT. 0) THEN
              string(l_string + 1 : l_string + l_file + 1) =
     +               filename(:l_file)//','
            ELSE
              string(:l_file + 1) = filename(:l_file)//','
            END IF
            l_string = l_string + l_file + 1
            IF (l_string .gt. max_file) go to 700
          END IF
        END DO
        l_string = l_string - 1
        l_killstr = 21 + l_string
        IF (l_killstr .gt. max_file) go to 700
        killstr = 'DELETE/QUEUE/ENTRY=('//string(:l_string)//')'
        CALL CLI$GET_VALUE('P2', temp_queue, l_temp_queue)
        itemp = l_killstr + l_temp_queue + 1
        IF (itemp .gt. max_file) go to 700
        killstr(l_killstr + 1:itemp) = ' '//temp_queue(:l_temp_queue)
        l_killstr = itemp

      ELSE						!Regular remote printing
        CALL CLI$GET_VALUE('$LINE', CLISTR, L_CS)

        WAIT = CLI$PRESENT('WAIT')
        IF (WAIT .EQ. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/W', 2)		!Strip /[NO]WAIT
        ELSE IF (WAIT .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOW', 4)
        ENDIF
        CALL CLI$GET_VALUE('$VERB',VERB)
C        WRITE (6,*) VERB, LENGTH(VERB)
        CALL STRIP(CLISTR, L_CS, VERB, 3)
        CALL STRIP(CLISTR, L_CS, temp_node, l_temp_node)

        quals = ' '
        l_quals = 1
        IF (CLI$PRESENT('AFTER')) THEN
          i_tmp = INDEX(clistr(:l_cs),' 0')
          if (i_tmp .gt. 0) clistr(i_tmp:i_tmp) = ':'
        END IF
        IF (CLI$PRESENT('ACCOUNT')) THEN
          CALL CLI$GET_VALUE('ACCOUNT',account,l_acc)
          CALL STRIP(CLISTR, L_CS, '/ACC', 4)
          account_flag = '1'
        END IF
        temp_flag = CLI$PRESENT('BACKUP')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/BAC', 4)
          itemp = l_quals + 7
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/BACKUP'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOBAC', 6)
          itemp = l_quals + 7
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/BACKUP'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('BEFORE')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/BEF', 4)
          CALL CLI$GET_VALUE('BEFORE', filename,l_file)
          i_tmp = INDEX(filename(:l_file),' ')	!CLI BUG - puts space
          if (i_tmp .gt. 0) THEN		!between date & time
            filename(i_tmp:i_tmp) = ':'		!replace with :
            CALL STRIP(CLISTR, L_CS,
     1           filename(i_tmp + 1 : i_tmp + 1), 1)
          end if
          itemp = l_quals + 7 + l_file
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/BEFORE='//filename(:l_file)
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOBEF', 6)
          itemp = l_quals + 9
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOBEFORE'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('BY_OWNER')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/BY_', 4)
          CALL CLI$GET_VALUE('BY_OWNER', filename,l_file)
          itemp = l_quals + 9
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/BY_OWNER'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOBY_', 6)
          itemp = l_quals + 11
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOBY_OWNER'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('CONFIRM')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/CON', 4)
          itemp = l_quals + 8
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/CONFIRM'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOCON', 6)
          itemp = l_quals + 10
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOCONFIRM'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('CREATED')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/CRE', 4)
          itemp = l_quals + 8
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/CREATED'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOCRE', 6)
          itemp = l_quals + 10
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOCREATED'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('EXCLUDE')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/EXC', 4)
          string = ' '
          l_string = 0
          MORE_FILES = .TRUE.
          DO WHILE (MORE_FILES)
            MORE_FILES = CLI$GET_VALUE('EXCLUDE', filename,l_file)
            IF (MORE_FILES) THEN
              IF (l_string .GT. 0) THEN
                string(l_string + 1 : l_string + l_file + 1) =
     +                 filename(:l_file)//','
              ELSE
                string(:l_file + 1) = filename(:l_file)//','
              END IF
              l_string = l_string + l_file + 1
              IF (l_string .gt. max_file) go to 700
            END IF
          END DO
          l_string = l_string - 1
          itemp = l_quals + 11 + l_string
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/EXCLUDE=('//string(:l_string)//
     +                               ')'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOEXC', 6)
          itemp = l_quals + 10
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOEXCLUDE'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('EXPIRED')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/EXP', 4)
          itemp = l_quals + 8
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/EXPIRED'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOEXP', 6)
          itemp = l_quals + 10
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOEXPIRED'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('MODIFIED')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/MOD', 4)
          itemp = l_quals + 9
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/MODIFIED'
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOMOD', 6)
          itemp = l_quals + 11
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOMODIFIED'
          l_quals = itemp
        END IF
        temp_flag = CLI$PRESENT('SINCE')
        IF (temp_flag .eq. CLI$_PRESENT) THEN
          CALL STRIP(CLISTR, L_CS, '/SIN', 4)
          CALL CLI$GET_VALUE('SINCE', filename,l_file)
          i_tmp = INDEX(filename(:l_file),' ')	!CLI BUG - puts space
          if (i_tmp .gt. 0) THEN		!between date & time
            filename(i_tmp:i_tmp) = ':'		!replace with :
            CALL STRIP(CLISTR, L_CS,
     1           filename(i_tmp + 1 : i_tmp + 1), 1)
          end if
          itemp = l_quals + 7 + l_file
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/SINCE='//filename(:l_file)
          l_quals = itemp
        ELSE IF (temp_flag .EQ. CLI$_NEGATED) THEN
          CALL STRIP(CLISTR, L_CS, '/NOSIN', 6)
          itemp = l_quals + 8
          IF (itemp .gt. max_line) go to 700
          quals(l_quals + 1:itemp) = '/NOSINCE'
          l_quals = itemp
        END IF

C-----------------------------------------------------------------------*
C	Get filespecs and check for existance
C-----------------------------------------------------------------------*
        l_cpystr = 1
        RMSSTS = .TRUE.
        MORE_FILES = .TRUE.
        extname = ' '
        i_aster = 0
        i_percent = 0
        first_file = .true.

        DO WHILE (RMSSTS .AND. MORE_FILES)
 400      MORE_FILES = CLI$GET_VALUE('P2', filename, l_file)
          IF (MORE_FILES) THEN
            i_aster = INDEX(filename(:l_file),'*')
            i_percent = INDEX(filename(:l_file),'%')
 410        rmssts = LIB$FIND_FILE(filename(1:l_file), exp_filename,
     +                             context, '.LIS', , rmsstv, 2)
            IF (rmssts .eq. rms$_nmf) goto 410	!Quirk of LIB$FIND_FILE
            IF (rmssts .ne. rms$_normal) GO TO 800
            if (index(filename(:l_file),';') .eq. 0) then
              l_exp_filename = index(exp_filename,';') - 1
            else
              l_exp_filename = length(exp_filename)
            end if
            If (i_aster .eq. 0 .and. i_percent .eq. 0) then
              Call strip_file(exp_filename, temp_file, l_exp_filename,
     +                        l_temp_file)
              if (index(filename(:l_file),'[') .gt. 0 .or.
     +            index(filename(:l_file),':') .gt. 0) then
                itemp = l_cpystr + l_exp_filename + 1
                IF (itemp .gt. max_line) go to 700
                cpystr(l_cpystr:l_cpystr+l_exp_filename) =
     +                             exp_filename(:l_exp_filename)//','
                l_cpystr = itemp
              else
                itemp = l_cpystr + l_temp_file + 1
                IF (itemp .gt. max_line) go to 700
                cpystr(l_cpystr:l_cpystr+l_temp_file) =
     +                             temp_file(:l_temp_file)//','
                l_cpystr = itemp
              end if
            Else
              itemp = l_cpystr + l_file + 1
              IF (itemp .gt. max_line) go to 700
              cpystr(l_cpystr:l_cpystr+l_file) =
     +                             filename(:l_file)//','
              l_cpystr = itemp
              Call strip_file(filename, temp_file, l_file, l_temp_file)
            End if
            if (first_file) then
              first_file = .false. 
              itemp = l_temp_file + al_id + 9
              IF (itemp .gt. max_file) go to 700
              temp_file = '[.PRINT.'//id(:al_id)//']'//
     +                     temp_file(:l_temp_file)
              l_temp_file = itemp
            end if
            itemp = index(filename(:l_file),'.')
            itemp2 = index(temp_file(:l_temp_file),'.')
            temp_flag2 = .false.
            if (itemp .gt. 0) then
               if (filename(:l_file) .ne. temp_file(:l_temp_file))
     +              temp_flag2 = .true.
            else
               if (itemp2 .ge. 2) then
                 if (filename(:l_file) .ne. temp_file(:itemp2 - 1))
     +               temp_flag2 = .true.
               end if
            end if
            if (temp_flag2) then
            itemp = index(clistr(:l_cs),filename(:l_file))
            if ((itemp + l_file - 1) .eq. l_cs) then
              itemp2 = itemp - 1 + l_temp_file
              IF (itemp2 .gt. max_line) go to 700
              clistr = clistr(:itemp - 1)//temp_file(:l_temp_file)
              l_cs = itemp2
            else
              itemp2 = l_cs + l_temp_file - l_file
              IF (itemp2 .gt. max_line) go to 700
              clistr = clistr(:itemp - 1)//temp_file(:l_temp_file)//
     +                 clistr(itemp + l_file:l_cs)
              l_cs = itemp2
            end if
            end if
          ENDIF
        END DO

        IF (context .NE. 0) CALL LIB$FIND_FILE_END(context)
        l_cpystr = l_cpystr - 2				!Drop trailing comma
      ENDIF

C-----------------------------------------------------------------------*
C	Build COPY string
C-----------------------------------------------------------------------*
      IF (.NOT. abort .AND. .NOT. show_queue) THEN
        if (l_quals .le. 0) l_quals = 1
        l_copy_string = 26 + l_cpystr + 1 + l_rn + 11 + al_id + l_quals
        IF (l_copy_string .gt. max_line) go to 700
        copy_string = 'COPY/PROT=(S:RD,O:RD,G,W)'//quals(:l_quals)//
     +                ' '//cpystr(1:l_cpystr)//' '//
     +                temp_node(1:l_temp_node)//'""::'
     +                //'[.PRINT.'//id(:al_id)//']'
      END IF

C-----------------------------------------------------------------------*
C	Build PRINT string
C-----------------------------------------------------------------------*
      IF (account(l_acc:l_acc) .eq. '!') l_acc = l_acc - 1
      IF (abort) THEN
        abort_string = killstr(:l_killstr)
        l_abort_string = l_killstr
        IF (l_abort_string .gt. max_line) go to 700
      ELSE IF (.NOT. show_queue) THEN
C        build print command -
        l_print_string = 13 + l_cs
        IF (l_print_string .gt. max_line) go to 700
        print_string = 'PRINT/DELETE '//clistr(:l_cs)
      END IF

C-----------------------------------------------------------------------*
C	Invoke local command procedure which will startup remote object
C-----------------------------------------------------------------------*
      IF (abort) THEN
          NAME = 'ABORT_STRING'
          STATUS = LIB$SET_SYMBOL(NAME(:12),
     +                            abort_string(:l_abort_string),LOCAL)
        If (.not. status) GO TO 700
        CALL LIB$DO_COMMAND('@WUTIL$:REMPRINT ABORT '//rmt_node(:l_rn))
      ELSE IF (show_queue) THEN
        CALL LIB$DO_COMMAND('@WUTIL$:REMPRINT SHOW_QUEUE '//
     +                       rmt_node(:l_rn))
      ELSE
        temp_start_index = 1
        temp_end_index = 0
        do temp_number = 1, 4
          if (l_copy_string - temp_end_index .gt. 255) then
            temp_length = temp_start_index + 255 - 2     ! start backscan at 254
 500        if (copy_string(temp_length:temp_length) .eq. ',') then
              temp_end_index = temp_length
            else if (copy_string(temp_length:temp_length) .eq. '/') then
              temp_end_index = temp_length - 1
            else
              temp_length = temp_length - 1
              go to 500
            end if
            NAME = 'COPY$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:13),
     +               copy_string(temp_start_index:temp_end_index)//'-',
     +               LOCAL)
            If (.not. status) GO TO 700
            temp_start_index = temp_end_index + 1
          else if (temp_end_index .lt. l_copy_string) then
            NAME = 'COPY$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:13),
     +               copy_string(temp_start_index:l_copy_string),
     +               LOCAL)
            If (.not. status) GO TO 700
            temp_end_index = l_copy_string + 1
          else
            NAME = 'COPY$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:13),cont_string,LOCAL)
            If (.not. status) GO TO 700
          end if
        end do
        temp_start_index = 1
        temp_end_index = 0
        do temp_number = 1, 4
          if (l_print_string - temp_end_index .gt. 255) then
            temp_length = temp_start_index + 255 - 2     ! start backscan at 254
 600        if (print_string(temp_length:temp_length) .eq. ',') then
              temp_end_index = temp_length
            else if (print_string(temp_length:temp_length) .eq. '/')then
              temp_end_index = temp_length - 1
            else
              temp_length = temp_length - 1
              go to 600
            end if
            NAME = 'PRINT$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:14),
     +               print_string(temp_start_index:temp_end_index)//'-',
     +               LOCAL)
            If (.not. status) GO TO 700
            temp_start_index = temp_end_index + 1
          else if (temp_end_index .lt. l_print_string) then
            NAME = 'PRINT$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:14),
     +               print_string(temp_start_index:l_print_string),
     +               LOCAL)
            If (.not. status) GO TO 700
            temp_end_index = l_print_string + 1
          else
            NAME = 'PRINT$STRING$'//char(temp_number + zero)
            STATUS = LIB$SET_SYMBOL(NAME(:14),cont_string,LOCAL)
            If (.not. status) GO TO 700
          end if
        end do
        IF (wait) THEN
          CALL LIB$DO_COMMAND('@wutil$:REMPRINT PRINT '//
     +                         rmt_node(:l_rn)//' '//id(:al_id)//' '//
     +                         username(:l_username)//' '//
     +                         account(:l_acc)//' '//account_flag)
        ELSE
          CALL LIB$SPAWN('@WUTIL$:REMPRINT PRINT '//rmt_node(:l_rn)//
     +                   ' '//id(:al_id)//' '//username(:l_username)//
     +                   ' '//account(:l_acc)//' '//account_flag,,,
     +                    CLI$M_NOWAIT .OR. CLI$M_NOKEYPAD)
          CALL LIB$PUT_OUTPUT
     +    ('%REMPRINT-I-CAUTION, logging off will kill copy operation!')
        END IF
      END IF
      GO TO 900

C-----------------------------------------------------------------------*
C	Error exits
C-----------------------------------------------------------------------*
  700 CALL LIB$PUT_OUTPUT
     +('%REMPRINT-F-COMERR, command string too long')
      CALL LIB$STOP(%VAL(STATUS))

  800 CALL LIB$PUT_OUTPUT('REMPRINT-F-OPENIN, error searching for '//
     +    exp_filename(1:LENGTH(exp_filename)) )
      CALL LIB$SIGNAL(%VAL(RMSSTS),%VAL(RMSSTV))

  900 CONTINUE
      END