********************************************************************************
*
*	Support of PR1ME INFORMATION subroutine '!REPORT.ERROR'
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	09/20/93 12299 LA  Initial implementation.
*
*******************************************************************************
*  START-DESCRIPTION:
*
*   This subroutine can be used to report Operating system or uniVerse errors
*   returned to a basic program. It retrieves the text, based on error number,
*   from the SYS.MESSAGE file.
*
*   The subroutine only exists for compatibility with PI/open. It will produce
*   messages of the following format:
*
*   Error: Calling "routine name" from "program name". OS error 1: [ENOENT]
*
*   The ERROR.NO argument may be either an error number or a dynamic array
*   consisting of the error number followed by one or more error message
*   parameters which will be inserted into the error message.
*
*  END-DESCRIPTION
*

$OPTIONS DEFAULT

subroutine PR1ME(PROGRAM.NAME, ROUTINE.NAME, ERROR.NO)

* Check if error parameters have been supplied

   POS = INDEX(ERROR.NO, @FM, 1)
   IF POS = 0 THEN
      ERRNUM = ERROR.NO
      PARAMS = ""
   END ELSE
      ERRNUM = ERROR.NO<1>
      PARAMS = FIELD(ERROR.NO, @FM, 2, 99)
   END
   
* If error number < 1000, it is an OS error, otherwise it is a uniVerse
* error:

   IF ERRNUM < 1000 THEN
      OSNAME = "OS"
   END ELSE
      OSNAME = "uniVerse"
   END

   PRINT 'Error: Calling "':ROUTINE.NAME:'" from "':PROGRAM.NAME:'". ':OSNAME:' error ':ERRNUM:': ':
   CALL *UVPRINTMSG(ERRNUM, PARAMS)

   RETURN

END