69 lines
2.1 KiB
Plaintext
69 lines
2.1 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* 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
|