SUBROUTINE SYSSTAT (USRMSG,STATUS,DISP)
C-----------------------------------------------------------------------
C  FILE = SYSSTAT.FOR
C-----------------------------------------------------------------------
C  INPUT: USRMSG (user message - CHARACTER string)
C         STATUS (system status code - INTEGER*4)
C         DISP (halt indicator - BYTE, INTEGER*2 or literal)
C  OUTPUT: If the severity code is not S, the USRMSG is sent to
C          logical unit 6 followed by the formatted status code
C          message. The routine then halts or returns according to
C          the following table:
C 
C  |---------------|--------------|-----------|-----------|-----------|
C  |    DISP       | SEVERITY=I,S |SEVERITY=W |SEVERITY=E |SEVERITY=F |
C  |---------------|--------------|-----------|-----------|-----------|
C  |'W' or 'w'     |  return      | halt      | halt      | halt      |
C  |---------------|--------------|-----------|-----------|-----------|
C  |'E', 'e' or    |  return      | return    | halt      | halt      |
C  | no arg. (def) |              |           |           |           |
C  |---------------|--------------|-----------|-----------|-----------|
C  |'F' or 'f'     |  return      | return    | return    | halt      |
C  |---------------|--------------|-----------|-----------|-----------|
C 
C    To maintain compatibility with previous versions of this routine,
C   DISP may be 0 (for 'e'), -1 (for 'w'), or +1 (for 'f').
C 
C  The format of the system status code is:
C  ______________________________________________________
C  |    FACILITY ISSUING    | NUMERIC STATUS | SEVERITY |
C  |       THIS CODE        |      CODE      |   CODE   |
C  ------------------------------------------------------
C   31                    16 15             3 2        0
C
C      SEVERITY CODE         MEANING
C      -------------         -------
C           0                W - warning
C           1                S - success
C           2                E - error
C           3                I - informational
C           4                F - severe or fatal error
C           5-7              ? - reserved
C-----------------------------------------------------------------------
      BYTE DISP(1),TYPE
      INTEGER*4 STATUS,SYSCOD,SYS$GETMSG,SEVERITY
      CHARACTER USRMSG*(*),MSGBUF*256
      SEVERITY = STATUS.AND.'00000007'X
      IF (SEVERITY.EQ.1) RETURN
      SYSCOD = SYS$GETMSG(%VAL(STATUS),LENM,MSGBUF,%VAL('F'X),)
      LENU = LEN(USRMSG)
      IF (LENU+LENM.LE.131) GO TO 10
      LENU = MIN(LENU,132)
      LENM = MIN(LENM,132)
      WRITE (6,2002) USRMSG(1:LENU),MSGBUF(1:LENM)
 2002 FORMAT (1X,A/1X,A)
      GO TO 20
   10 WRITE (6,2001) USRMSG(1:LENU),MSGBUF(1:LENM)
 2001 FORMAT (1X,A,1X,A)
C**** Determine if DISP is W, E or F.
   20 TYPE = 0
      IF (%LOC(DISP(1)).EQ.0) GO TO 30
      IF (DISP(1).EQ.'00'X.OR.DISP(1).EQ.'45'X.OR.DISP(1).EQ.'65'X)
     X     TYPE = 0
      IF (DISP(1).EQ.'01'X.OR.DISP(1).EQ.'46'X.OR.DISP(1).EQ.'66'X)
     X     TYPE = +1
      IF (DISP(1).EQ.'FF'X.OR.DISP(1).EQ.'57'X.OR.DISP(1).EQ.'77'X)
     X     TYPE = -1
C**** Check severity code and DISP to decide whether to exit or return.
   30 IF (SEVERITY.EQ.4) CALL EXIT
      IF (SEVERITY.EQ.2.AND.TYPE.LE.0) CALL EXIT
      IF (SEVERITY.EQ.0.AND.TYPE.LT.0) CALL EXIT
      RETURN
      END