If using COBOL then a macro like this is very handy.
---- start cut here ----
$preprocessor delimiter = #
$control locon
* *************************************************************
* %CobolFileError(location#,filename#)
* -------------------------------------------------------------
* Generates the relevent message for a Cobol/iX file error and
* executes FatalGoBack.
* *************************************************************
$if x1=off
$control locoff
$if
01 COBOLFILEERROR-MACRO.
05 COBOLFILEERROR-STATUS.
10 COBOLFILEERROR-STATUS-1 Pic X(001).
88 COBOLFILEERROR-IMPLEMENTOR Value "9".
10 COBOLFILEERROR-STATUS-2 Pic X(001).
05 COBOLFILEERROR-RESULT Pic 9(004).
05 COBOLFILEERROR-NUMBER Pic S9(04) Comp.
05 COBOLFILEERROR-MSG-BUFFER Pic X(256).
05 COBOLFILEERROR-MSG-LENGTH Pic S9(04) Comp.
$preprocessor delimiter = ~
$define %CobolFileError=
$if x1=off
$control locoff
$if
D Display " - CobolFileError (!2)"
* Check if it's an implementor defined file error.
If COBOLFILEERROR-IMPLEMENTOR Then
* Get the MPE/iX file system error number.
Call "CKERROR" Using COBOLFILEERROR-STATUS
COBOLFILEERROR-RESULT
End-Call
Move COBOLFILEERROR-RESULT To COBOLFILEERROR-NUMBER
* Get the error message associated with the error code.
Call Intrinsic "FERRMSG" Using COBOLFILEERROR-NUMBER
COBOLFILEERROR-MSG-BUFFER
COBOLFILEERROR-MSG-LENGTH
End-Call
Move Spaces To FATALGOBACK-MESSAGE
String
"!2: "
COBOLFILEERROR-MSG-BUFFER Delimited By Size
Into FATALGOBACK-MESSAGE
End-String
Else
* Not an implementor defined error, check for standard error.
Evaluate COBOLFILEERROR-STATUS
* Permanent Errors.
When "30"
Move "!2: No more information available."
To FATALGOBACK-MESSAGE
When "31"
Move "!2: Dynamic file attribute conflict."
To FATALGOBACK-MESSAGE
When "34"
Move "!2: Boundry violation."
To FATALGOBACK-MESSAGE
When "35"
Move "!2: Missing file."
To FATALGOBACK-MESSAGE
When "37"
Move "!2: Invalid device/unwritable file."
To FATALGOBACK-MESSAGE
When "38"
Move "!2: Open on file closed with LOCK."
To FATALGOBACK-MESSAGE
When "39"
Move "!2: Fixed file attribute conflict."
To FATALGOBACK-MESSAGE
* Logic Errors.
When "41"
Move "!2: File is already open."
To FATALGOBACK-MESSAGE
When "42"
Move "!2: File is already closed."
To FATALGOBACK-MESSAGE
When "43"
Move "!2: No read before rewrite/delete."
To FATALGOBACK-MESSAGE
When "44"
Move "!2: Boundry violation."
To FATALGOBACK-MESSAGE
When "46"
Move "!2: Unsuccessful read/start."
To FATALGOBACK-MESSAGE
When "47"
Move "!2: File not open for input."
To FATALGOBACK-MESSAGE
When "48"
Move "!2: File not open for output."
To FATALGOBACK-MESSAGE
When "49"
Move "!2: File not open for I-O."
To FATALGOBACK-MESSAGE
When Other
Move Spaces To FATALGOBACK-MESSAGE
String
"!2: Unknown error code ("
COBOLFILEERROR-STATUS
") detected." Delimited By Size
Into FATALGOBACK-MESSAGE
End-String
End-Evaluate
End-If
* Execute FatalGoBack returning the error message.
%FatalGoBack(!1#,FILE#, #,COBOL#)
$control locon
~
---- end cut here ----
Comment banner from %FatalGoBack:
* *************************************************************
* %FatalGoBack(location#,subsystem#,message#,intrinsic#)
* -------------------------------------------------------------
* Initialises the fatal error fields and performs Z999-ABORT.
* *************************************************************
Source to Z999-ABORT.
* ---------------------------------------------------------------
* Abnormal termination processing.
* ---------------------------------------------------------------
* Display error termination message on programs $STDLIST.
Display Space
Display "***************************************************"
Display "* PROGRAM HAS TERMINATED IN AN ERROR STATE *"
Display "*-------------------------------------------------*"
Display " Location : " FATALGOBACK-LOCATION
Display " SubLocation : " FATALGOBACK-SUBLOCATION
Display " SubSystem : " FATALGOBACK-SUBSYSTEM
Display " Message : " FATALGOBACK-MESSAGE
Display " Intrinsic : " FATALGOBACK-INTRINSIC
Display "***************************************************"
Display Space
* Stop the program.
Stop Run
regards,
Robert W.Mills
Business Systems Development Analyst
Group Information Systems & Technology
Pinnacle Entertainment
DDI: +44 (0)20 8309 3604
-----Original Message-----
From: HP-3000 Systems Discussion [mailto:[log in to unmask]] On
Behalf Of Brian Donaldson
Sent: 28 May 2008 07:09
To: [log in to unmask]
Subject: Re: [HP3000-L] file status error number 9
It has been my experience whenever I have encountered these "9x", "9]"
type of errors in Cobol is because the program is trying to manipulate a
file (open?) that is already open or cannot be opened for some reason
(security violation maybe, or another process has the file opened
exclusively)
The Cobol manual isn't very good at giving away these error codes and
their meaning. Page 6-42 "Environment Division" section gives some
flimsy info on these "9x" errors ("Some 9x values have been changed to
other codes. For example, the ANSI COBOL '85 file status 38 was
previously a 9x code".)
Pages 6-43, 6-44 and 6-45 of the Cobol manual give you all the Cobol
file system error numbers and a description of what the error is but is
missing the 9x error codes and their meaning.
Brian Donaldson.
On Wed, 28 May 2008 11:29:30 +0800, Serrano, Marianne
<[log in to unmask]> wrote:
>Sorry for typo error. That should be "9]" instead of "9" only.
>
>Thanks,
>Ianne
>
>-----Original Message-----
>From: ianne [mailto:[log in to unmask]]
>Sent: Wednesday, May 28, 2008 11:20 AM
>To: HP3000 List
>Cc: Serrano, Marianne
>Subject: file status error number 9
>
>Hi,
>
>Can anyone help and enlighten me with the file error I'm encountering -
>file status 9?
>
>Any help is very much appreciated. =)
>
>Thanks!
>
>* To join/leave the list, search archives, change list settings, *
>* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
