SPL,L,O,M 
!     NAME:   RU..
!     SOURCE: 92070-18031 
!     RELOC:  92070-16031 
!     PGMR:   M.L.K.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
! 
      NAME RU..(7) "  92070-1X031  REV.1941  790712"
! 
!  EXTERNAL SUBROUTINES 
      LET .DFER     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET CLOSE     BE SUBROUTINE,EXTERNAL
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET FM.ER     BE SUBROUTINE,EXTERNAL
      LET IDRPL     BE SUBROUTINE,EXTERNAL
      LET IER.      BE SUBROUTINE,EXTERNAL,DIRECT 
      LET MSS.      BE SUBROUTINE,EXTERNAL
      LET OPEN.     BE SUBROUTINE,EXTERNAL
      LET PR.IT     BE SUBROUTINE,EXTERNAL
      LET RMPAR     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET IDSGA     BE FUNCTION,EXTERNAL
      LET LOGLU     BE FUNCTION,EXTERNAL
!  EXTERNAL INTEGERS
      LET .E.R      BE INTEGER,EXTERNAL 
      LET %TMP1     BE INTEGER,EXTERNAL 
      LET BUF.      BE INTEGER,EXTERNAL 
      LET C.BUF     BE INTEGER,EXTERNAL 
      LET CAD.      BE INTEGER,EXTERNAL 
      LET ECH       BE INTEGER,EXTERNAL 
      LET G0..(48)  BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET NO.RD     BE INTEGER,EXTERNAL 
!  INTERNAL SUBROUTINES 
      LET RU..      BE SUBROUTINE 
      LET XQ..      BE SUBROUTINE 
!  INTERNAL VARIBLES
      LET ABEND(4)  BE INTEGER
      LET ABX(7)    BE INTEGER
      INITIALIZE ABEND,ABX TO " ABEND  XXXXX ABORTED "
      LET SC        BE INTEGER
      LET A05       BE INTEGER
      INITIALIZE SC,A05 TO "SC","05"
! 
! 
XQ..: SUBROUTINE(NM,PRM,ER) GLOBAL
      ER_ -1                                     !SET XQ FLAG 
      RU..(NM,PRM,ER)                            !CALL RU SUBROUTINE
      RETURN
      END 
! 
! 
RU..: SUBROUTINE(NUM,PRAM,ERR) GLOBAL 
      LET ERR       BE INTEGER                   !ERROR PARAMETER 
      LET NUM       BE INTEGER                   !NUMBER OF PARAMETERS
      LET PRAM(64)  BE INTEGER                   !PARSED PARAMETERS 
! 
      CODE_ 100027K                              !PRE-SET TO RU 
      IF ERR = -1  THEN [CODE_ 100012K ; ERR_0]  !IF XQ CHANGE CODE 
      IF PRAM(1) # 3  THEN [ ERR_ 56; RETURN]    !CHECK FOR ASCII NAME
      IF IDSGA(PRAM(2))  THEN GOTO SCHED         !IF PROG EXISTS, RUN IT
! 
!     RP THE PROGRAM
! 
RPIT: OPEN.(I.BUF,PRAM(2),N.OPL,5)               !OPEN & FORCE TO TYPE 1
      IER.                                       !TEST FOR READ ERROR 
      IDRPL(I.BUF,ERR,PRAM(2),0)                 !TEMPORARY RP
      TEMP_ .B.                                  !SAVE ID ADDRESS 
      IF ERR = 40  THEN[                         \IF SOMEONE ALREADY THERE
         MSS.(40);                               \ISSUE ERROR 
         PR.IT(TEMP,1);                          \PRINT PROGRAM NAME
         ERR_ 0;                                 \DON'T RE-ISSUE ERROR
         RETURN]                                 !EXIT
      IF ERR  THEN RETURN                        !RETURN ON ERROR 
      CLOSE(I.BUF)                               !CLOSE TYPE 6
! 
!     SCHEDULE THE PROGRAM
! 
SCHED:IFNOT PRAM(5)  THEN[                       \IF 1ST PRAM DEFAULT 
         PRAM(6)_ [IF G0..(1)=1 THEN G0..(2),    \USE 0G IF NUMERIC 
                   ELSE LOGLU(D)]]               !ELSE USE CRT LU 
      $1_ -1                                     !PRESET THE B REGISTER 
      EXEC(CODE,PRAM(2),PRAM(6),PRAM(10),PRAM(14), \SCHEDULE PROGRAM
           PRAM(18),PRAM(22),C.BUF,ECH);GOTO SCER !NO ABORT 
      IF $1 # -1  THEN RMPAR(G0..(42))           !PICK UP PARAMETERS
      .E.R_ 0 
      IF $$%TMP1 = 100000K  THEN[                \IF PROG ABORTED 
         .DFER(ABX,PRAM(2));                     \SET THE NAME IN MESSAGE 
         FM.ER(2,ABEND,11)]                      !AND PRINT 
      EXEC(14,1,C.BUF,40); ECH_ .B.              !GET RETURN STRING 
      IFNOT ECH  THEN RETURN                     !IF NO STRING, RETURN
      IF (C.BUF AND 177400K) = 35000K  THEN[     \IF BEGINS WITH ":"
         NO.RD_ -1;                              \DON'T READ ANOTHER COMMAND
         C.BUF_ C.BUF - 15000K]                  !REPLACE ":" WITH <BLANK>
      RETURN                                     !ALL DONE
! 
SCER: T1_ .A.                                    !GET ERROR CODE
      T2_ .B.                                    !FROM A & B REG
      IF T1 = SC  THEN[                          \IF NO ID SEG ERROR
         IF T2 = A05  THEN GOTO RPIT]            !TRY AGAIN 
      ERR_ 49                                    !CAN'T RUN PROGRAM 
      RETURN
      END 
      END 
      END$
                                                                          