IDENTIFICATION DIVISION.
PROGRAM-ID.    UTL550.
AUTHOR.        Barry L. Wallis.
INSTALLATION.  Fleetwood Enterprises, Inc.
DATE-WRITTEN.  03-Nov-83.

*******************************************************************************
*
*	PROGRAM FUNCTIONS.
*		This subroutine will always return a status code to DCL.  The
*	status code it returns is based on the value that is passed to it. 
*	
*	VALUE PASSED	DCL CODE	MEANING		
*	------------	-------		-------------	
*	     W		  41		Warning		
*	     S		   2		Success
*	     E		  43		Error
*	     I		   4		Informational
*	     F		  45		Fatal error
*	
*	
*	NOTE:  This subroutine will never return to the calling program!!!
*	
*	This subroutine will also print out a standard program termination 
*	message.  The program id must be supplied as specified in the 
*	Fleetwood standards document (i.e., with a "-" after the program
*	name).
*
*	PROGRAM OPTIONS.
*		None.
*
*	PROGRAM MODIFICATIONS.
*
*	AUTHOR	X. XXX
*	DATE	99-XXX-99
*	VERSION	9-X
*
*	PROGRAM CHANGES:
*
*******************************************************************************

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.	VAX-11.
OBJECT-COMPUTER.	VAX-11.

DATA DIVISION.
WORKING-STORAGE SECTION.
01	MESSAGES.
	05  ABNORMAL-TERMINATION-MSG	PIC X(20)
	    VALUE "ABNORMAL TERMINATION".
	05  INVALID-ERROR-CODE-MSG	PIC X(43)
	    VALUE ">>> Invalid error code passed to UTL550 <<<".
	05  NORMAL-TERMINATION-MSG	PIC X(18)
	    VALUE "NORMAL TERMINATION".

01	PROG-ID-LENGTH			PIC S9(9)	COMP.

01	STATUS-VALUES			COMP.
	05  ERROR-STATUS		PIC S9(9)	VALUE 42.
	05  FATAL-STATUS		PIC S9(9)	VALUE 44.
	05  INFORMATIONAL-STATUS	PIC S9(9)	VALUE 3.
	05  SUCCESS-STATUS		PIC S9(9)	VALUE 1.
	05  WARNING-STATUS		PIC S9(9)	VALUE 40.

LINKAGE SECTION.
01	ERROR-CODE			PIC X(1).
01	PROG-ID				PIC X(35).

PROCEDURE DIVISION USING PROG-ID, ERROR-CODE.
000-BEGIN.
	MOVE ZERO TO PROG-ID-LENGTH.
	INSPECT PROG-ID TALLYING PROG-ID-LENGTH FOR CHARACTERS BEFORE "-".
	DISPLAY " ".
	EVALUATE ERROR-CODE
	    WHEN "S"
		DISPLAY PROG-ID (1:PROG-ID-LENGTH), SPACE, 
		    NORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE SUCCESS-STATUS
	    WHEN "I"
		DISPLAY PROG-ID (1:PROG-ID-LENGTH), SPACE
		    NORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE INFORMATIONAL-STATUS
	    WHEN "W"
		DISPLAY "?", PROG-ID (1:PROG-ID-LENGTH), SPACE
		    ABNORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE WARNING-STATUS
	    WHEN "E"
		DISPLAY "?", PROG-ID (1:PROG-ID-LENGTH), SPACE
		    ABNORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE ERROR-STATUS
	    WHEN "F"
		DISPLAY "?", PROG-ID (1:PROG-ID-LENGTH), SPACE
		    ABNORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE FATAL-STATUS
	    WHEN OTHER
		DISPLAY INVALID-ERROR-CODE-MSG
		DISPLAY "?", PROG-ID (1:PROG-ID-LENGTH), SPACE
		    ABNORMAL-TERMINATION-MSG
		CALL "SYS$EXIT" USING BY VALUE FATAL-STATUS
	END-EVALUATE.

*	The program should never be able to get this far!!!

	EXIT PROGRAM.