Top
NetCOBOL V11.0 Messages
FUJITSU Software

2.2.5 JMN5000 - JMN5999

5000

5001

5002

5005

5007

5008

5009

5100

5101

5102

5103

5104

5105

5108

5109

5110

5111

5112

5113

5114

5115

5116

5117

5118

5119

5120

5121

5122

5123

5125

5126

5127

5128

5129

5130

5131

5132

5133

5134

5135

5136

5137

5138

5140

5141

5142

5143

5144

5145

5146

5147

5148

5149

5150

5151

5152

5153

5154

5155

5156

5157

5158

5159

5160

5260

5400

5410

5411

5412

5500

5501

5504

5505

5507

5508

5509

5510

5511

5512

5513

5514

5515

5516

5517

5518

5519

5520

5521

5522

5525

5526

5527

5528

5530

5531

5532

5533

5534

5535

5536

5537

5538

5539

5540

5541

5542

5543

5544

5545

5546

5547

5548

5549

5550

5551

5552

5553

5555

5556

5557

5559

5560

5561

5562

5563

5564

5565

5566

5567

5568

5569

5570

5571

5572

5573

5574

5575

5576

5578

5579

5580

5581

5582

5583

5584

5585

5590

5591

5592

5593

5595

5596

5600

5601

5602

5783

5784

5785

5786

5787

5788

5789

5790

5791

5792

JMN5000I-S

Method '@1@' was defined with the OVERRIDE clause, but no method of that name was found in the parent class. The OVERRIDE phrase is ignored.

Parameter explanation

@1@ : User-defined word specified in METHOD-ID paragraph.

Example

[C5000CP.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5000CP.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     MO1.
000011 DATA           DIVISION.
000012 PROCEDURE      DIVISION.
000013     DISPLAY "METHOD OF PARENT CLASS".
000014 END METHOD     MO1.
000015 END OBJECT.
000016 END CLASS C5000CP.
[C5000.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5000 INHERITS C5000CP.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005  REPOSITORY.
000006     CLASS  C5000CP.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     MO2 OVERRIDE.
000014 DATA           DIVISION.
000015 PROCEDURE      DIVISION.
000016     DISPLAY "METHOD OF CHILD CLASS".
000017 END METHOD     MO2.
000018 END OBJECT.
000019 END CLASS C5000.

C5000.cob 13: JMN5000I-S Method 'MO2' was defined with the OVERRIDE clause, but no method of that name was found in the parent class. The OVERRIDE phrase is ignored.

Explanation

A method was defined with the OVERRIDE clause, but no method of that name was found in the parent class.

Note that when OVERRIDE is specified for a method, the comparison of the method name with the parent class methods is case-sensitive, even if the program is compiled with the compile option ALPHAL(AUTO). Otherwise, comparison of method names is not case-sensitive.

JMN5001I-S

Method '@1@' is defined multiple times. The method-name must be unique in @3@ '@2@'.

Parameter explanation

@1@ : a method-name.

@2@ : a class-name.

@3@ : class

Example

[C5001.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5001.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     MO1.
000011 DATA           DIVISION.
000012 PROCEDURE      DIVISION.
000013     DISPLAY "METHOD MO1-1".
000014 END METHOD     MO1.
000015 IDENTIFICATION DIVISION.
000016 METHOD-ID.     MO1.
000017 DATA           DIVISION.
000018 PROCEDURE      DIVISION.
000019     DISPLAY "METHOD MO1-2".
000020 END METHOD     MO1.
000021 END OBJECT.
000022 END CLASS C5001.

C5001.cob 16: JMN5001I-S Method 'MO1' is defined multiple times. The method-name must be unique in class 'C5001'.

Explanation

Two or more methods with the same name in the class being compiled were detected.

JMN5002I-S

Method '@1@' that is defined or overridden in class '@2@' cannot override. The method '@1@' definition is ignored.

Parameter explanation

@1@ : User-defined word specified in METHOD-ID paragraph.

@2@ : User-defined word specified in CLASS-ID paragraph.

Example

[C5002.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5002.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     MO1.
000011 DATA           DIVISION.
000012 PROCEDURE      DIVISION.
000013     DISPLAY "ORIGINAL MO1".
000014 END METHOD     MO1.
000015 IDENTIFICATION DIVISION.
000016 METHOD-ID.     MO1 OVERRIDE.
000017 DATA           DIVISION.
000018 PROCEDURE      DIVISION.
000019     DISPLAY "MO1 OVERRIDED".
000020 END METHOD     MO1.
000021 END OBJECT.
000022 END CLASS C5002.

C5002.cob 16: JMN5002I-S Method 'MO1' that is defined or overridden in class 'C5002' cannot override. The method 'MO1' definition is ignored.

Explanation

If the OVERRIDE clause is specified, the inherited method with the same external name as the method declared in this method definition must be defined in the inherited class.

JMN5005I-S

The method prototype definition of '@1@' is missing. Method '@1@' is ignored.

Parameter explanation

@1@ : User-defined word specified in the METHOD-ID paragraph.

Example

[C5005C.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5005C.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     MO2 PROTOTYPE.
000011 END METHOD     MO2.
000012 END OBJECT.
000013 END CLASS C5005C.
[C5005.cob]
000001 IDENTIFICATION DIVISION.
000002 METHOD-ID.     C5005 OF C5005C.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005  REPOSITORY.
000006     CLASS  C5005C.
000007 DATA           DIVISION.
000008 PROCEDURE      DIVISION.
000009     DISPLAY "METHOD OF CHILD CLASS".
000010 END METHOD     C5005.

C5005.cob 2: JMN5005I-S The method prototype definition of 'C5005' is missing. Method 'C5005' is ignored.

Explanation

There is no method prototype definition (method definition that has the PROTOTYPE phrase in its METHOD-ID paragraph) corresponding to a separate method definition. Verify that the corresponding method prototype definition is included in the class definition specified for the OF phrase in the METHOD-ID paragraph of a separate method definition.

JMN5007I-S

Property-name '@1@' cannot be a data-name with a PROPERTY clause.

Parameter explanation

@1@ : User-defined word specified in the METHOD-ID paragraph as a property name.

Example

[C5007.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5007.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 PROP1       PIC X(8) PROPERTY.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     GET PROPERTY PROP1.
000011 DATA           DIVISION.
000012 LINKAGE        SECTION.
000013 01  LK1        PIC X(8).
000014 PROCEDURE      DIVISION RETURNING LK1.
000015     MOVE PROP1(1:) TO LK1.
000016     EXIT METHOD.
000017 END METHOD.
000018 END OBJECT.
000019 END CLASS C5007.

C5007.cob 10: JMN5007I-S Property-name 'PROP1' cannot be a data-name with a PROPERTY clause.

Explanation

The property-name specified for the METHOD-ID paragraph should not be the same name as the data-name of a data description entry that specifies a PROPERTY clause.

JMN5008I-S

Property-name '@1@' specified in the property-specifier is undefined. The property-specifier is ignored.

Parameter explanation

@1@ : User-defined word specified in the property specifier.

Example

[C5008.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5008.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION  SECTION.
000005 REPOSITORY.
000006     PROPERTY  PR2 AS  "NO-SHEET" *> Undefined
000007    .
000008 OBJECT.
000009 END OBJECT.
000010 END CLASS C5008.

C5008.cob 6: JMN5008I-S Property-name 'NO-SHEET' specified in the property-specifier is undefined. The property-specifier is ignored.

Explanation

The property-specifier declares a name that can be specified by an object property within the scope of the ENVIRONMENT DIVISION.

JMN5009I-S

Property-name '@1@' specified in the property-specifier is defined multiple times. The property-specifier is ignored.

Parameter explanation

@1@ : User-defined word specified in the property specifier.

Example

[C5009.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5009.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION  SECTION.
000005 REPOSITORY.
000006     PROPERTY  PR1 AS  "PROC1"
000007     PROPERTY  AA AS  "BB"
000008     PROPERTY  BB.
000009 OBJECT.
000010 DATA           DIVISION.
000011 WORKING-STORAGE SECTION.
000012 01 PR1         PIC X(8) PROPERTY.
000013 END OBJECT.
000014 END CLASS C5009.

C5009.cob 6: JMN5009I-S Property-name 'PR1' specified in the property-specifier is defined multiple times. The property-specifier is ignored.

C5009.cob 7: JMN5009I-S Property-name 'BB' specified in the property-specifier is defined multiple times. The property-specifier is ignored.

Explanation

Multiple definitions were detected for the property-name specified in the repository paragraph of the environment division. This could be caused by one of the following:

  • An alias of the property-name and a data-name of a data description entry that specifies the PROPERTY clause are the same. (The alias is shown by the literal specified for the AS phrase of the property-specifier.)

  • A property-name in the property-specifier and an alias of the property-name in another property-specifier are the same.

JMN5100I-S

The class-name specified in the @1@ clause is invalid. The class-name is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[C5100.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. C5100.
000003 DATA DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 OBJA USAGE OBJECT REFERENCE XX.
000006 PROCEDURE DIVISION.
000007 END PROGRAM  C5100.

C5100.cob 5: JMN5100I-S The class-name specified in the USAGE OBJECT REFERENCE clause is invalid. The class-name is ignored.

Explanation

This diagnostic message is output when corresponding to the following either of names specified for the USAGE OBJECT REFERENCE clause.

  • Undefined name

  • Name of multiple definition

  • Names other than class name

JMN5101I-S

The @1@ clause can only be specified in a program definition. The @1@ clause is ignored.

Parameter explanation

@1@ : APPLY SAVED-AREA, APPLY MULTICONVERSATION-MODE, APPLY RECORD-OVERFLOW, APPLY CORE-INDEX or APPLY REORG-CRITERIA

Example

[C5101.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5101 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 SPECIAL-NAMES.
000006     ON-YOMI IS JIS1.
000007 REPOSITORY.
000008     CLASS FJBASE.
000009 IDENTIFICATION DIVISION.
000010 OBJECT.
000011 ENVIRONMENT    DIVISION.
000012 PROCEDURE      DIVISION.
000013 IDENTIFICATION DIVISION.
000014 METHOD-ID.     M5101.
000015 ENVIRONMENT    DIVISION.
000016 INPUT-OUTPUT    SECTION.
000017 FILE-CONTROL.
000018     SELECT CSFILE4 ASSIGN TO SYS001
000019       FILE STATUS    IS WFS1.
000020 I-O-CONTROL.
000021     APPLY MULTICONVERSATION-MODE TO CSFILE4
000022     APPLY SAVED-AREA TO WSVAR ON CSFILE4.
000023 DATA           DIVISION.
000024 FILE            SECTION.
000025 FD CSFILE4.
000026 01 CSF4REC.
000027   02                   PIC X(80).
000028 WORKING-STORAGE SECTION.
000029 01 WFS1        PIC X(2).
000030 01 WSVAR       PIC X(80).
000031 END METHOD     M5101.
000032 END OBJECT.
000033 END CLASS    C5101.

C5101.cob 21: JMN5101I-S The APPLY MULTICONVERSATION-MODE clause can only be specified in a program definition. The APPLY MULTICONVERSATION-MODE clause is ignored.

C5101.cob 22: JMN5101I-S The APPLY SAVED-AREA clause can only be specified in a program definition. The APPLY SAVED-AREA clause is ignored.

JMN5102I-S

The @1@ clause cannot be specified with a @2@ clause. The @1@ clause is ignored.

Parameter explanation

@1@ : Clause which can specified in a data description entry.

@2@ : TYPE, TYPEDEF or USAGE

Example

[C5102.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. C5102.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 OBJA USAGE OBJECT REFERENCE BLANK WHEN ZERO.
000006 01 OBJB USAGE OBJECT REFERENCE SYNC.
000007 01 OBJC USAGE OBJECT REFERENCE VALUE "AA".
000008 01 OBJD PIC X(10) OBJECT REFERENCE.
000009 01 RR PIC X(08).
000010 01 OBJE REDEFINES RR USAGE OBJECT REFERENCE.
000011 PROCEDURE DIVISION.
000012 END PROGRAM C5102.

C5102.cob 5: JMN5102I-S The USAGE OBJECT REFERENCE clause cannot be specified with a BLANK WHEN ZERO clause. The USAGE OBJECT REFERENCE clause is ignored.

C5102.cob 6: JMN5102I-S The USAGE OBJECT REFERENCE clause cannot be specified with a SYNCHRONIZED clause. The USAGE OBJECT REFERENCE clause is ignored.

C5102.cob 7: JMN5102I-S The USAGE OBJECT REFERENCE clause cannot be specified with a VALUE clause. The USAGE OBJECT REFERENCE clause is ignored.

C5102.cob 10: JMN5102I-S The USAGE OBJECT REFERENCE clause cannot be specified with a REDEFINES clause. The USAGE OBJECT REFERENCE clause is ignored.

JMN5103I-S

[Solaris][Linux]The @1@ clause can only be specified in WORKING-STORAGE SECTION or LINKAGE SECTION. The @1@ clause is ignored.

[Linux64]The @1@ clause can only be specified in WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION. The @1@ clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[C5103.cob]
000001 IDENTIFICATION   DIVISION.
000002 PROGRAM-ID.      C5103.
000003 DATA             DIVISION.
000004 BASED-STORAGE     SECTION.
000005 01 WOBR          OBJECT REFERENCE.
000006 PROCEDURE        DIVISION.
000007 END PROGRAM      C5103.
  • [Solaris][Linux]

    C5103.cob 5: JMN5103I-S The USAGE OBJECT REFERENCE clause can only be specified in WORKING-STORAGE SECTION or LINKAGE SECTION. The USAGE OBJECT REFERENCE clause is ignored.

  • [Linux64]

    C5103.cob 5: JMN5103I-S The USAGE OBJECT REFERENCE clause can only be specified in WORKING-STORAGE SECTION , LOCAL-STORAGE SECTION or LINKAGE SECTION. The USAGE OBJECT REFERENCE clause is ignored.

Explanation

The USAGE OBJECT REFERENCE clause cannot be specified in the BASED-STORAGE SECTION, the FILE SECTION, the CONSTANT SECTION, the SCREEN SECTION, or the REPORT SECTION.

JMN5104I-S

The @1@ clause cannot be specified for a group item. The @1@ clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE, PROPERTY

Example

[C5104.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    C5104.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 OBJA        USAGE OBJECT REFERENCE.
000006   02 OBJB      USAGE OBJECT REFERENCE.
000007 PROCEDURE      DIVISION.
000008 END PROGRAM    C5104.

C5104.cob 5: JMN5104I-S The USAGE OBJECT REFERENCE clause cannot be specified for a group item. The USAGE OBJECT REFERENCE clause is ignored.

Explanation

The USAGE OBJECT REFERENCE clause and the PROPERTY clause can be specified only in an elementary item.

JMN5105I-W

A condition-name cannot specified for a data item in the LINKAGE SECTION of the method prototype definition. The condition-name is ignored.

Example

[C5105.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5105 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5105 PROTOTYPE.
000012 DATA           DIVISION.
000013 LINKAGE         SECTION.
000014 01 LK1         PIC X(2).
000015 88 ZOK         VALUE "OK".
000016 88 ZNG         VALUE "NG".
000017 PROCEDURE      DIVISION
000018                    USING LK1.
000019 END METHOD     M5105.
000020 END OBJECT.
000021 END CLASS    C5105.

C5105.cob 15: JMN5105I-W A condition-name cannot specified for a data item in the LINKAGE SECTION of the method prototype definition. The condition-name is ignored.

Explanation

A method prototype specifies the method-name and parameter types, and a returning item (if specified) for a method. The method prototype does not contain the condition-name that is set to the method parameters and a returning item.

JMN5108I-S

A @1@ clause cannot be specified for an item with an OCCURS clause or its subordinate item. The @1@ clause is ignored.

Parameter explanation

@1@ : PROPERTY

Example

[C5108.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5108.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008  01 AA.
000009   02  BB.
000010    03  PROP1   PROPERTY  OCCURS 3 TIMES  PIC X(8).
000011  01 CC .
000012   02 DD       OCCURS 2 TIMES.
000013    03 PROP2   PIC X(8) PROPERTY.
000014 PROCEDURE      DIVISION.
000015 IDENTIFICATION DIVISION.
000016 METHOD-ID.     MO1.
000017 DATA           DIVISION.
000018 WORKING-STORAGE SECTION.
000019  01 OBR1       USAGE OBJECT REFERENCE.
000020 PROCEDURE      DIVISION.
000021 END METHOD     MO1.
000022 END OBJECT.
000023 END CLASS C5108.

C5108.cob 10: JMN5108I-S A PROPERTY clause cannot be specified for an item with an OCCURS clause or its subordinate item. The PROPERTY clause is ignored.

C5108.cob 13: JMN5108I-S A PROPERTY clause cannot be specified for an item with an OCCURS clause or its subordinate item. The PROPERTY clause is ignored.

JMN5109I-S

An item redefined by a REDEFINES clause cannot have a @1@ clause, or cannot be subordinate to a data item with a @1@ clause. The REDEFINES clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[C5109.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    C5109.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 OBJA        USAGE OBJECT REFERENCE.
000006 01 AA REDEFINES OBJA PIC X(08).
000007 01 BB .
000008   02 OBJB      USAGE OBJECT REFERENCE.
000009 01 CC REDEFINES BB PIC X(08).
000010 PROCEDURE      DIVISION.
000011 END PROGRAM    C5109.

C5109.cob 6: JMN5109I-S An item redefined by a REDEFINES clause cannot have a USAGE OBJECT REFERENCE clause, or cannot be subordinate to a data item with a USAGE OBJECT REFERENCE clause. The REDEFINES clause is ignored.

C5109.cob 9: JMN5109I-S An item redefined by a REDEFINES clause cannot have a USAGE OBJECT REFERENCE clause, or cannot be subordinate to a data item with a USAGE OBJECT REFERENCE clause. The REDEFINES clause is ignored.

JMN5110I-S

The data-name in the RENAMES clause or in the THROUGH phrase cannot have a @1@ clause, or cannot be subordinate to a data item with a @1@ clause. The RENAMES clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[C5110.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    C5110.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 A1 .
000006   02 B1        USAGE OBJECT REFERENCE.
000007   02 B2        PIC X(08).
000008   02 B3        USAGE OBJECT REFERENCE.
000009 66 RR RENAMES B1 THROUGH B3.
000010 PROCEDURE      DIVISION.
000011 END PROGRAM    C5110.

C5110.cob 9: JMN5110I-S The data-name in the RENAMES clause or in the THROUGH phrase cannot have a USAGE OBJECT REFERENCE clause, or cannot be subordinate to a data item with a USAGE OBJECT REFERENCE clause. The RENAMES clause is ignored.

JMN5111I-S

The USAGE OBJECT REFERENCE SELF clause can only be specified in a FACTORY definition or a FACTORY method definition. SELF is ignored.

Example

[C5111.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5111.
000003 IDENTIFICATION DIVISION.
000004 FACTORY.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     C5111-FM1.
000008 END METHOD     C5111-FM1.
000009 END FACTORY.
000010 IDENTIFICATION DIVISION.
000011 OBJECT.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 OBJA        USAGE OBJECT REFERENCE SELF.
000015 PROCEDURE      DIVISION.
000016 IDENTIFICATION DIVISION.
000017 METHOD-ID.     C5111-OM1.
000018 DATA           DIVISION.
000019 WORKING-STORAGE SECTION.
000020 01 OBJB        USAGE OBJECT REFERENCE SELF.
000021 END METHOD     C5111-OM1.
000022 END OBJECT.
000023 END CLASS      C5111.

C5111.cob 14: JMN5111I-S The USAGE OBJECT REFERENCE SELF clause can only be specified in a FACTORY definition or a FACTORY method definition. SELF is ignored.

C5111.cob 20: JMN5111I-S The USAGE OBJECT REFERENCE SELF clause can only be specified in a FACTORY definition or a FACTORY method definition. SELF is ignored.

Explanation

The USAGE OBJECT REFERENCE SELF clause declares the area for holding the object (instance) of itself.

JMN5112I-S

The USAGE OBJECT REFERENCE @1@ OF SELF clause can only be specified in an object definition or an object method definition. @1@ OF SELF is ignored.

Parameter explanation

@1@ : FACTORY or CLASS

Example

[C5112.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5112.
000003 IDENTIFICATION DIVISION.
000004 FACTORY.
000005 DATA DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 OBJA        USAGE OBJECT REFERENCE FACTORY OF SELF.
000008 01 OBJB        USAGE OBJECT REFERENCE CLASS OF SELF.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     C5112-FM1.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 OBJC        USAGE OBJECT REFERENCE FACTORY OF SELF.
000015 01 OBJD        USAGE OBJECT REFERENCE CLASS OF SELF.
000016 END METHOD     C5112-FM1.
000017 END FACTORY.
000018 IDENTIFICATION DIVISION.
000019 OBJECT.
000020 PROCEDURE      DIVISION.
000021 IDENTIFICATION DIVISION.
000022 METHOD-ID.     C5112-OM1.
000023 END METHOD     C5112-OM1.
000024 END OBJECT.
000025 END CLASS      C5112.

C5112.cob 7: JMN5112I-S The USAGE OBJECT REFERENCE FACTORY OF SELF clause can only be specified in an object definition or an object method definition. FACTORY OF SELF is ignored.

C5112.cob 8: JMN5112I-S The USAGE OBJECT REFERENCE CLASS OF SELF clause can only be specified in an object definition or an object method definition. CLASS OF SELF is ignored.

C5112.cob 14: JMN5112I-S The USAGE OBJECT REFERENCE FACTORY OF SELF clause can only be specified in an object definition or an object method definition. FACTORY OF SELF is ignored.

C5112.cob 15: JMN5112I-S The USAGE OBJECT REFERENCE CLASS OF SELF clause can only be specified in an object definition or an object method definition. CLASS OF SELF is ignored.

Explanation

The USAGE OBJECT REFERENCE FACTORY OF SELF clause declares the area for holding the factory object. The USAGE OBJECT REFERENCE CLASS OF SELF clause declares the area for holding the object (instance) of itself.

JMN5113I-S

The @1@ clause cannot be specified in DATA DIVISION of a factory definition or object definition. The @1@ clause is ignored.

Parameter explanation

@1@ : LINAGE

Example

[C5113.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5113.
000003 IDENTIFICATION DIVISION.
000004 FACTORY.
000005 ENVIRONMENT    DIVISION.
000006  INPUT-OUTPUT   SECTION.
000007   FILE-CONTROL.
000008     SELECT DATAFILE
000009         ASSIGN       TO  infile
000010         ORGANIZATION IS  SEQUENTIAL.
000011*
000012 DATA           DIVISION.
000013 FILE            SECTION.
000014 FD  DATAFILE    LINAGE 10.
000015 01  DATARECORD.
000016   02  ITEMRECORD.
000017     03  ITEMCODE  PIC X(4).
000018     03            PIC X.
000019     03  ITEMNAME  PIC N(20).
000020     03            PIC X.
000021     03 PRICE      PIC 9(4).
000022*
000023 PROCEDURE      DIVISION.
000024 IDENTIFICATION DIVISION.
000025 METHOD-ID.     METHODF1.
000026 END METHOD     METHODF1.
000027 END FACTORY.
000028 IDENTIFICATION DIVISION.
000029 OBJECT.
000030 PROCEDURE      DIVISION.
000031 IDENTIFICATION DIVISION.
000032 METHOD-ID.     METHODO1.
000033 END METHOD     METHODO1.
000034 END OBJECT.
000035 END CLASS      C5113.

C5113.cob 14: JMN5113I-S The LINAGE clause cannot be specified in DATA DIVISION of a factory definition or object definition. The LINAGE clause is ignored.

Explanation

The LINEAGE clause can be specified in the data division of the method definition.

JMN5114I-S

The @1@ clause cannot be specified in an item with an OCCURS DEPENDING ON clause. The OCCURS DEPENDING ON clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5114.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5114.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 A.
000006   02 OBJA      USAGE OBJECT REFERENCE
000007                OCCURS 1 TO 10 TIMES
000008                         DEPENDING ON DD.
000009 01 DD          PIC S9(04).
000010 PROCEDURE      DIVISION.
000011 END PROGRAM    P5114.

P5114.cob 7: JMN5114I-S The USAGE OBJECT REFERENCE clause cannot be specified in an item with an OCCURS DEPENDING ON clause. The OCCURS DEPENDING ON clause is ignored.

JMN5115I-S

The item specified in the @1@ clause cannot be subordinate to a data item with an OCCURS DEPENDING ON clause. It is accepted as written.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5115.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5115.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 AA .
000006   02 BB        OCCURS 1 TO 10 TIMES
000007                    DEPENDING ON DD.
000008     03         OBJA USAGE OBJECT REFERENCE.
000009 01 DD          PIC S9(04).
000010 PROCEDURE      DIVISION.
000011 END PROGRAM    P5115.

P5115.cob 8: JMN5115I-S The item specified in the USAGE OBJECT REFERENCE clause cannot be subordinate to a data item with an OCCURS DEPENDING ON clause. It is accepted as written.

JMN5116I-S

The @1@ clause cannot be specified in a variable address item. It is accepted as written.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5116.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5116.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 .
000006   02 .
000007     03 BB      OCCURS 1 TO 10 TIMES DEPENDING ON DD.
000008       04       PIC X(08).
000009     03 OBJA    USAGE OBJECT REFERENCE.
000010   02 OBJB      USAGE OBJECT REFERENCE.
000011 01 DD          PIC S9(04).
000012 PROCEDURE      DIVISION.
000013 END PROGRAM    P5116.

P5116.cob 9: JMN5116I-S The USAGE OBJECT REFERENCE clause cannot be specified in a variable address item. It is accepted as written.

P5116.cob 10: JMN5116I-S The USAGE OBJECT REFERENCE clause cannot be specified in a variable address item. It is accepted as written.

JMN5117I-S

The @1@ clause cannot be specified for an item specified in an EXTERNAL clause or for its subordinate item. It is accepted as written.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5117.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5117.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 OBJA        USAGE OBJECT REFERENCE EXTERNAL.
000006 01 AA EXTERNAL.
000007   02 OBJB      USAGE OBJECT REFERENCE.
000008 PROCEDURE      DIVISION.
000009 END PROGRAM    P5117.

P5117.cob 5: JMN5117I-S The USAGE OBJECT REFERENCE clause cannot be specified for an item specified in an EXTERNAL clause or for its subordinate item. It is accepted as written.

P5117.cob 7: JMN5117I-S The USAGE OBJECT REFERENCE clause cannot be specified for an item specified in an EXTERNAL clause or for its subordinate item. It is accepted as written.

JMN5118I-S

The @1@ clause cannot be specified for a subordinate item with a REDEFINES clause. It is accepted as written.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5118.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5118.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 AA          PIC X(08).
000006 01 RR REDEFINES AA.
000007   02 OBJA      USAGE OBJECT REFERENCE.
000008 PROCEDURE      DIVISION.
000009 END PROGRAM    P5118.

P5118.cob 7: JMN5118I-S The USAGE OBJECT REFERENCE clause cannot be specified for a subordinate item with a REDEFINES clause. It is accepted as written.

JMN5119I-S

The @1@ clause can only be specified for the item that is unique with no qualifiers. The @1@ clause is ignored.

Parameter explanation

@1@ : PROPERTY

Example

[C5119.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5119.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008  01 BB.
000009   02  PROP1  PIC X(8) PROPERTY.
000010  01 AA.
000011   02  PROP1  PIC X(8)
000012              PROPERTY.
000013  01 PROP1    PIC S9(8) BINARY PROPERTY.
000014 PROCEDURE      DIVISION.
000015 IDENTIFICATION DIVISION.
000016 METHOD-ID.     MO1.
000017 DATA           DIVISION.
000018 WORKING-STORAGE SECTION.
000019  01 OBR1       USAGE OBJECT REFERENCE.
000020 PROCEDURE      DIVISION.
000021     DISPLAY PROP1 OF OBR1.
000022 END METHOD     MO1.
000023 END OBJECT.
000024 END CLASS C5119.

C5119.cob 9: JMN5119I-S The PROPERTY clause can only be specified for the item that is unique with no qualifiers. The PROPERTY clause is ignored.

C5119.cob 12: JMN5119I-S The PROPERTY clause can only be specified for the item that is unique with no qualifiers. The PROPERTY clause is ignored.

C5119.cob 13: JMN5119I-S The PROPERTY clause can only be specified for the item that is unique with no qualifiers. The PROPERTY clause is ignored.

JMN5120I-S

The @1@ clause cannot be specified for a pointer data item. The @1@ clause is ignored.

Parameter explanation

@1@ : PROPERTY

Example

[C5120.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5120.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008  01 PROP1      POINTER PROPERTY.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     MO1.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014  01 OBR1       USAGE OBJECT REFERENCE.
000015 PROCEDURE      DIVISION.
000016 END METHOD     MO1.
000017 END OBJECT.
000018 END CLASS      C5120.

C5120.cob 8: JMN5120I-S The PROPERTY clause cannot be specified for a pointer data item. The PROPERTY clause is ignored.

JMN5121I-S

The data item specified in the @1@ clause cannot appear between a data item in a RENAMES clause and a data item in a THROUGH phrase. The RENAMES clause is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[P5121.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5121.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 A .
000006  02 A1         PIC X(08).
000007  02 A2         USAGE OBJECT REFERENCE.
000008  02 A3         PIC X(08).
000009 66 B RENAMES A1 THROUGH A3.
000010 PROCEDURE      DIVISION.
000011 END PROGRAM    P5121.

P5121.cob 9: JMN5121I-S The data item specified in the USAGE OBJECT REFERENCE clause cannot appear between a data item in a RENAMES clause and a data item in a THROUGH phrase. The RENAMES clause is ignored.

JMN5122I-S

The @1@ clause cannot be specified for an object reference data item with SELF, FACTORY OF SELF, or CLASS OF SELF. The @1@ clause is ignored.

Parameter explanation

@1@ : PROPERTY

Example

[C5122.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5122.
000003 ENVIRONMENT    DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 PP          USAGE OBJECT REFERENCE
000008                             FACTORY OF SELF
000009                    PROPERTY WITH NO GET.
000010 END OBJECT.
000011 END CLASS      C5122.

C5122.cob 7: JMN5122I-S The PROPERTY clause cannot be specified for an object reference data item with SELF, FACTORY OF SELF, or CLASS OF SELF. The PROPERTY clause is ignored.

Explanation

A class-name must be specified for the USAGE OBJECT REFERENCE clause.

JMN5123I-S

If a special class is specified in the @1@ clause, another optional phrase cannot be specified. Other OPTIONAL phrase is ignored.

Parameter explanation

@1@ : USAGE OBJECT REFERENCE

Example

[C5123.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. C5123.
000003 ENVIRONMENT DIVISION.
000004 CONFIGURATION SECTION.
000005 REPOSITORY.
000006     CLASS C5123C AS "*OLE".
000007 DATA DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 OBJA USAGE OBJECT REFERENCE C5123C ONLY.
000010 01 OBJB USAGE OBJECT REFERENCE FACTORY OF C5123C.
000011 01 OBJB USAGE OBJECT REFERENCE FACTORY OF C5123C ONLY.
000012 PROCEDURE DIVISION.
000013 END PROGRAM C5123.

C5123.cob 9: JMN5123I-S If a special class is specified in the USAGE OBJECT REFERENCE clause, another optional phrase cannot be specified. Other OPTIONAL phrase is ignored.

C5123.cob 10: JMN5123I-S If a special class is specified in the USAGE OBJECT REFERENCE clause, another optional phrase cannot be specified. Other OPTIONAL phrase is ignored.

C5123.cob 11: JMN5123I-S If a special class is specified in the USAGE OBJECT REFERENCE clause, another optional phrase cannot be specified. Other OPTIONAL phrase is ignored.

Explanation

If a special class name is specified for the USAGE OBJECT REFERENCE clause, 'FACTORY OF' and 'ONLY' of this clause cannot be specified.

If the literal of a class-specifier in the repository paragraph of the environment division is among those listed below, the class-name is a special class name.

  • "*COM" (or "*OLE")

  • "*COM-ARRAY" (or "*OLE-ARRAY")

  • "*COM-EXCEPTION" ( or "*OLE-EXCEPTION")

  • "*COB-BINDTABLE"

  • "*COM:COM server name:COM class name" (COM server name = arbitrary name used for association with a type library, COM class name = dispinterface name or coclass name)

JMN5125I-S

A 'CHARACTER TYPE' clause with a DEPENDING ON phrase cannot be specified in the DATA DIVISION of @1@.

Parameter explanation

@1@ : FACTORY DEFINITION, OBJECT DEFINITION or STATIC DEFINITION.

Example

[C5125.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5125.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005  SPECIAL-NAMES.
000006       PRINTING MODE PM1 FOR ALL IN SIZE 5 POINT
000007       PRINTING MODE PM2 FOR ALL FONT GOTHIC
000008       PRINTING MODE PM3 FOR ALL IN SIZE 20 POINT AT ANGLE 90.
000009 FACTORY.
000010 DATA            DIVISION.
000011 WORKING-STORAGE SECTION.
000012  01 WK1         PIC N(10) CHARACTER TYPE PM1 PM2 PM3
000013                           DEPENDING ON PM-DEP1.
000014  01 PM-DEP1     PIC S9(4) BINARY.
000015 END FACTORY.
000016 OBJECT.
000017 DATA            DIVISION.
000018 WORKING-STORAGE SECTION.
000019  01 PM-DEP2     PIC S9(4) BINARY.
000020 CONSTANT        SECTION.
000021  01 CS1         PIC N(10) CHARACTER TYPE PM3 PM2 PM1
000022                           DEPENDING ON PM-DEP2
000023                           VALUE NC"CONST".
000024 END OBJECT.
000025 END CLASS       C5125.

C5125.cob 12: JMN5125I-S A 'CHARACTER TYPE' clause with a DEPENDING ON phrase cannot be specified in the DATA DIVISION of factory definition.

C5125.cob 21: JMN5125I-S A 'CHARACTER TYPE' clause with a DEPENDING ON phrase cannot be specified in the DATA DIVISION of object definition.

Explanation

A 'CHARACTER TYPE' clause with a DEPENDING ON phrase can be specified in the data division of the method definition.

JMN5126I-S

The @1@ clause cannot be specified in the LINKAGE SECTION of a method prototype definition or a separate method definition. The @1@ clause is ignored.

Parameter explanation

@1@ : CHARACTER TYPE or PRINTING POSITION

Example

[C5126.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5126.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005  SPECIAL-NAMES.
000006       YA IS CT1.
000007 FACTORY.
000008 PROCEDURE       DIVISION.
000009 METHOD-ID.      FMT1.
000010 DATA            DIVISION.
000011 LINKAGE         SECTION.
000012  01 PRM1        PIC N(10) CHARACTER TYPE IS CT1. *> NO ERROR
000013 PROCEDURE       DIVISION  USING PRM1.
000014 END METHOD      FMT1.
000015 END FACTORY.
000016 OBJECT.
000017 PROCEDURE       DIVISION.
000018 METHOD-ID.      IMT1 PROTOTYPE.
000019 DATA            DIVISION.
000020 LINKAGE         SECTION.
000021  01 PRM2        PIC N(10) CHARACTER TYPE MODE-1     *> ERROR
000022                           PRINTING POSITION IS 8.   *> ERROR
000023 PROCEDURE       DIVISION RETURNING PRM2.
000024 END METHOD      IMT1.
000025 END OBJECT.
000026 END CLASS       C5126.

C5126.cob 21: JMN5126I-S The CHARACTER TYPE clause cannot be specified in the LINKAGE SECTION of a method prototype definition or a separate method definition. The CHARACTER TYPE clause is ignored.

C5126.cob 22: JMN5126I-S The PRINTING POSITION clause cannot be specified in the LINKAGE SECTION of a method prototype definition or a separate method definition. The PRINTING POSITION clause is ignored.

Explanation

A method prototype is the method-name and parameter types and a returning item (if specified) for a method. A method prototype does not contain the information for print defined by the CHARACTER TYPE clause or the PRINTING POSITION clause.

JMN5127I-S

A condition-name cannot be specified for an object reference data item.

Example

[P5127.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5127.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 X1          OBJECT REFERENCE.
000006 88 A           VALUE "XX".
000007 END PROGRAM    P5127.

P5127.cob 6: JMN5127I-S A condition-name cannot be specified for an object reference data item.

JMN5128I-S

The LINAGE clause can only be specified with an EXTERNAL clause in a program definition. The LINAGE clause is ignored.

Example

[C5128.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5128.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     METHODF1.
000008 ENVIRONMENT    DIVISION.
000009 INPUT-OUTPUT    SECTION.
000010 FILE-CONTROL.
000011     SELECT MASTRFIL
000012         ASSIGN       TO  INFILE
000013         ORGANIZATION IS  SEQUENTIAL.
000014 DATA           DIVISION.
000015 FILE            SECTION.
000016 FD MASTRFIL LINAGE 10
000017             EXTERNAL.
000018 01 MASTREC.
000019   02 PRODUCT-REC.
000020     03 PRODUCT-CODE  PIC X(4).
000021     03               PIC X.
000022     03 PRODCT-NAME   PIC N(20).
000023     03               PIC X.
000024     03 PRICE         PIC 9(4).
000025*
000026 END METHOD METHODF1.
000027 END OBJECT.
000028 END CLASS C5128.

C5128.cob 16: JMN5128I-S The LINAGE clause can only be specified with an EXTERNAL clause in a program definition. The LINAGE clause is ignored.

JMN5129I-S

The data-name in the @1@ clause cannot be an object reference data item or a group item which contains an object reference data item.

Parameter explanation

@1@ : APPLY SAVED-AREA, CONTROL, SOURCE, DESTINATION CONTROL, TRACK-AREA, ACTUAL KEY, NOMINAL KEY, KEY IS, APPLY REORG-CRITERIA

Example

[C5129.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    C5129.
000003 ENVIRONMENT    DIVISION.
000004 INPUT-OUTPUT   SECTION.
000005 FILE-CONTROL.
000006     SELECT PRFILE ASSIGN TO GS-SYS001
000007     SYMBOLIC DESTINATION IS "PRT"
000008     DESTINATION-1 IS DIST.
000009 I-O-CONTROL.
000010     APPLY SAVED-AREA TO ASV1  ASV2 .
000011 DATA           DIVISION.
000012 FILE SECTION.
000013 FD PRFILE.
000014 01 PRREC  PIC X(50).
000015 WORKING-STORAGE SECTION.
000016 01 DIST        PIC X(8).
000017 01 ASV1        PIC X(10).
000018 01 ASV2        USAGE OBJECT REFERENCE.
000019 PROCEDURE      DIVISION.
000020     OPEN I-O PRFILE
000021     MOVE "NMSVR20" TO  DIST
000022     WRITE  PRREC
000023     READ   PRFILE
000024     CLOSE  PRFILE
000025 END PROGRAM     C5129.

C5129.cob 10: JMN5129I-S The data-name in the APPLY SAVED-AREA clause cannot be an object reference data item or a group item which contains an object reference data item.

JMN5130I-S

The ANY LENGTH clause cannot be specified for a data-item without a PICTURE clause. PICTURE X is assumed.

Example

[C5130.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5130.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5130.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 01 LK1         ANY LENGTH.
000018 PROCEDURE      DIVISION
000019                      USING LK1.
000020 END METHOD     M5130.
000021 END OBJECT.
000022 END CLASS      C5130.

C5130.cob 17: JMN5130I-S The ANY LENGTH clause cannot be specified for a data-item without a PICTURE clause. PICTURE X is assumed.

Explanation

The ANY LENGTH clause specifies that the length of the data item of the LINKAGE SECTION is determined at execution time. The ANY LENGTH clause can be specified in an item in which only the PICTURE clause is specified. The character string of the PICTURE clause must be one character, either "X" or "N".

JMN5131I-S

A data-item with an ANY LENGTH clause can only be specified in a PICTURE clause. It is ignored, and the compiler skips to the next level-number, section or division.

Example

[C5131.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5131.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5131.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 01 LK1         PIC X ANY LENGTH JUSTIFIED.
000018 PROCEDURE      DIVISION
000019                      USING LK1.
000020 END METHOD     M5131.
000021 END OBJECT.
000022 END CLASS      C5131.

C5131.cob 17: JMN5131I-S A data-item with an ANY LENGTH clause can only be specified in a PICTURE clause. It is ignored, and the compiler skips to the next level-number, section or division.

Explanation

The ANY LENGTH clause specifies that the length of the data item of the LINKAGE SECTION is determined at execution time. The ANY LENGTH clause can be specified in an item in which only the PICTURE clause is specified. The character string of the PICTURE clause must be one character, either "X" or "N".

JMN5132I-S

An ANY LENGTH clause cannot be specified for a data-item in a get property method or a set property method. The ANY LENGTH clause is ignored.

Example

[C5132.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5132.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     SET PROPERTY M5132.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 01 LK1         PIC X ANY LENGTH.
000018 PROCEDURE      DIVISION
000019                      USING LK1.
000020 END METHOD.
000021 END OBJECT.
000022 END CLASS      C5132.

C5132.cob 17: JMN5132I-S An ANY LENGTH clause cannot be specified for a data-item in a get property method or a set property method. The ANY LENGTH clause is ignored.

Explanation

The ANY LENGTH clause can be specified in an 01 item that is specified in the LINKAGE SECTION of the method definition, except for the property method.

JMN5133I-S

An ANY LENGTH clause cannot be specified for a group item. The ANY LENGTH clause is ignored.

Example

[C5133.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5133.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5133.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 01 LK1         PIC X ANY LENGTH.
000018  02 WLENG      PIC S9(4).
000019  02 WBUF       PIC X(40).
000020 PROCEDURE      DIVISION
000021                      USING LK1.
000022 END METHOD     M5133.
000023 END OBJECT.
000024 END CLASS      C5133.

C5133.cob 17: JMN5133I-S An ANY LENGTH clause cannot be specified for a group item. The ANY LENGTH clause is ignored.

Explanation

The ANY LENGTH clause specifies that the length of the data item of the LINKAGE SECTION is determined during at execution time. The ANY LENGTH clause can be specified in the item in which only the PICTURE clause is specified. The character string of the PICTURE clause must be one character, either "X" or "N".

JMN5134I-S

Data-name @2@ in the @1@ clause cannot have an ANY LENGTH clause.

Parameter explanation

@1@ : Clause of INPUT-OUTPUT SECTION or DATA DIVISION.

@2@ : Data name specified for the @1@ clause.

Example

[C5134.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5134.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5134.
000014 ENVIRONMENT    DIVISION.
000015 INPUT-OUTPUT    SECTION.
000016 FILE-CONTROL.
000017     SELECT SQFILE ASSIGN TO SYS001
000018       FILE STATUS IS LK1.
000019 DATA           DIVISION.
000020 FILE            SECTION.
000021 FD SQFILE.
000022 01 SQREC       PIC X(80).
000023 LINKAGE         SECTION.
000024 01 LK1         PIC X ANY LENGTH.
000025 PROCEDURE      DIVISION
000026                      USING LK1.
000027 END METHOD     M5134.
000028 END OBJECT.
000029 END CLASS    C5134.

C5134.cob 18: JMN5134I-S Data-name LK1 in the FILE STATUS clause cannot have an ANY LENGTH clause.

JMN5135I-S

The data-name of the ASSIGN clause in file-name '@1@' cannot be an item with an ANY LENGTH clause, a group item that includes an object reference item, or a strongly typed item.

Parameter explanation

@1@ : File name specified for the ASSIGN clause that causes the error.

Example

[C5135.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5135.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 OBJECT.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 PROCEDURE      DIVISION.
000010 METHOD-ID.     M5135.
000011 ENVIRONMENT    DIVISION.
000012 INPUT-OUTPUT    SECTION.
000013 FILE-CONTROL.
000014     SELECT SQFILE ASSIGN TO LK1
000015       FILE STATUS IS WFS1.
000016     SELECT SQFILE2 ASSIGN TO WK1.
000017 DATA           DIVISION.
000018 FILE            SECTION.
000019 FD SQFILE.
000020 01 SQREC       PIC X(80).
000021 FD SQFILE2.
000022 01 SQREC2      PIC X(80).
000023 WORKING-STORAGE SECTION.
000024 01 WFS1        PIC X(2).
000025 01 WK1   TYPE  TYP1.
000026 01 TYP1  TYPEDEF.
000027  02  DATA1 PIC 9(4).
000028  02  DATA2 PIC X(8).
000029 LINKAGE         SECTION.
000030 01 LK1         PIC X ANY LENGTH.
000031 PROCEDURE      DIVISION
000032                      USING LK1.
000033 END METHOD     M5135.
000034 END OBJECT.
000035 END CLASS      C5135.

C5135.cob 19: JMN5135I-S The data-name of the ASSIGN clause in file-name 'SQFILE' cannot be an item with an ANY LENGTH clause, a group item that includes an object reference item, or a strongly typed item.

JMN5136I-S

A condition-name cannot be specified for a data-item with an ANY LENGTH clause.

Example

[C5136.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5136.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5136.
000014 ENVIRONMENT    DIVISION.
000015 INPUT-OUTPUT    SECTION.
000016 DATA           DIVISION.
000017 LINKAGE         SECTION.
000018 01 LK1         PIC X ANY LENGTH.
000019 88 ZOK         VALUE "OK".
000020 88 ZNG         VALUE "OK".
000021 PROCEDURE      DIVISION
000022                      USING LK1.
000023 END METHOD     M5136.
000024 END OBJECT.
000025 END CLASS      C5136.

C5136.cob 19: JMN5136I-S A condition-name cannot be specified for a data-item with an ANY LENGTH clause.

C5136.cob 20: JMN5136I-S A condition-name cannot be specified for a data-item with an ANY LENGTH clause.

JMN5137I-S

The data-name in @1@ cannot be an object reference data item or a group item which contains an object reference data item.

Parameter explanation

@1@ : FROM phrase of PICTURE clause, USING phrase of PICTURE clause, TO phrase of PICTURE clause, PROMPT clause, CONTROL clause, SIZE clause, LINE NUMBER clause or COLUMN NUMBER clause

Example

[P5137.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5137.
000003 ENVIRONMENT    DIVISION.
000004 DATA           DIVISION.
000005 WORKING-STORAGE SECTION.
000006 01 WOBR        OBJECT REFERENCE.
000007 SCREEN          SECTION.
000008 01 WSCR        PIC X(8) USING WOBR.
000009 PROCEDURE      DIVISION.
000010 END PROGRAM    P5137.

P5137.cob 8: JMN5137I-S The data-name in USING phrase of the PICTURE clause cannot be an object reference data item or a group item which contains an object reference data item.

JMN5138I-S

A strongly-typed group item cannot be specified for the parameter of a get property method or a set property method. The specified parameter is ignored.

Example

[C5138.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5138.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     SET PROPERTY M5138.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 01 LK1         TYPE STY.
000018 01 STY TYPEDEF STRONG.
000019   02 S1        PIC S9(4) BINARY.
000020   02 S2        PIC X(30).
000021 PROCEDURE      DIVISION
000022                      USING LK1.
000023 END METHOD.
000024 END OBJECT.
000025 END CLASS      C5138.

C5138.cob 22: JMN5138I-S A strongly-typed group item cannot be specified for the parameter of a get property method or a set property method. The specified parameter is ignored.

JMN5140I-S

'@1@' specified in the TYPE clause must be a unique type-name. The TYPE clause is ignored.

Parameter explanation

@1@ : Symbol specified for the TYPE clause.

Example

[P5140.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5140.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005  01 A TYPE B.
000006  01 B.
000007   02 B1   PIC S9(9) BINARY.
000008   02 B2   PIC X(1024).
000009 PROCEDURE       DIVISION.
000010      STOP RUN.
000011 END  PROGRAM    P5140.

P5140.cob 5: JMN5140I-S 'B' specified in the TYPE clause must be a unique type-name. The TYPE clause is ignored.

Explanation

A type-name must be specified in the TYPE clause that specifies the type declaration. (The type-name is a name declared in the level-number 01 data description entry that specifies the TYPEDEF clause.)

JMN5141I-S

The definition of type-name '@1@' refers to type-name '@2@'. '@1@' is ignored.

Parameter explanation

@1@ : User-defined word defined as a type name.

@2@ : User-defined word defined as a type name.

Example

[P5141.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5141.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005  01 X TYPEDEF   TYPE X.
000006  01 A TYPEDEF.
000007   02 A1         PIC S9(9) BINARY.
000008   02 A2         TYPE B.
000009  01 B TYPEDEF.
000010   02 B1         PIC S9(9) BINARY.
000011   02 B2         TYPE C.
000012  01 C TYPEDEF.
000013   02 C1         PIC S9(9) BINARY.
000014   02 C2         TYPE A.
000015 PROCEDURE       DIVISION.
000016     STOP RUN.
000017 END  PROGRAM    P5141.

P5141.cob 5: JMN5141I-S The definition of type-name 'X' refers to type-name 'X'. 'X' is ignored.

P5141.cob 6: JMN5141I-S The definition of type-name 'A' refers to type-name 'A'. 'A' is ignored.

P5141.cob 9: JMN5141I-S The definition of type-name 'B' refers to type-name 'A'. 'B' is ignored.

P5141.cob 12: JMN5141I-S The definition of type-name 'C' refers to type-name 'A'. 'C' is ignored.

Explanation

The type can be referred to further by the TYPE clause in the type declaration (data description entry that specifies the TYPEDEF clause). However, the type including own type cannot be referred to.

JMN5142I-S

The TYPE clause cannot be specified for an item subordinate to a group item that has a USAGE clause, SIGN clause, SYNCHRONIZED clause, or CHARACTER TYPE clause. It is accepted as written.

Example

[P5142.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5142.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 A TYPEDEF.
000006    02 A1        PIC S9(9).
000007    02 A2        PIC X(80).
000008 01 GRP1  .
000009   02            USAGE BINARY.
000010     03 B1       TYPE A.
000011     03 B2       PIC S9(9).
000012   02            SIGN TRAILING.
000013     03 C1       TYPE A.
000014 PROCEDURE       DIVISION.
000015      STOP RUN.
000016 END  PROGRAM    P5142.

P5142.cob 10: JMN5142I-S The TYPE clause cannot be specified for an item subordinate to a group item that has a USAGE clause, SIGN clause, SYNCHRONIZED clause, or CHARACTER TYPE clause. It is accepted as written.

P5142.cob 13: JMN5142I-S The TYPE clause cannot be specified for an item subordinate to a group item that has a USAGE clause, SIGN clause, SYNCHRONIZED clause, or CHARACTER TYPE clause. It is accepted as written.

Explanation

The data description entry that specifies the TYPE clause is called the typed item. The typed item defined by this specification has all of the characteristics of the referenced type. The USAGE clause, the SIGN clause, the SYNCHRONIZED clause or the CHARACTER TYPE clause specified for the item, including the typed item, cannot overwrite the attribute of the typed item.

JMN5143I-S

The @1@ clause cannot be specified for an item specified in a TYPEDEF clause or for its subordinate item. The @1@ clause is ignored.

Parameter explanation

@1@ : REDEFINES, RENAMES, CHARACTER TYPE, PRINTING POSITION, PROPERTY or ANY LENGTH

Example

[P5143.cob]
000001 PROGRAM-ID.     P5143.
000002 DATA            DIVISION.
000003 WORKING-STORAGE  SECTION.
000004  01 VCHR TYPEDEF.
000005   02 LENG       PIC S9(9).
000006   02 XCHR       PIC X(80).
000007   02 NCHR       CHARACTER TYPE MODE-1
000008                 PIC N(40).
000009  01 ADDR        TYPE VCHR.
000010 PROCEDURE       DIVISION.
000011     STOP RUN.
000012 END PROGRAM     P5143.

P5143.cob 7: JMN5143I-S The CHARACTER TYPE clause cannot be specified for an item specified in a TYPEDEF clause or for its subordinate item. The CHARACTER TYPE clause is ignored.

JMN5144I-S

The data name specified for the @1@ clause cannot be an item which expands from the type. The @1@ clause is ignored.

Parameter explanation

@1@ : RENAMES

Example

[P5144.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5144.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 BLOB TYPEDEF.
000006   02 RESEV      PIC S9(9) BINARY.
000007   02 LENG       PIC  9(9) BINARY.
000008   02 BUFF       PIC X(1024).
000009 01 GRP1  .
000010   02 B1         TYPE BLOB.
000011   66 C1 RENAMES LENG OF B1 THRU BUFF OF B1.
000012 PROCEDURE       DIVISION.
000013     STOP RUN.
000014 END PROGRAM     P5144.

P5144.cob 11: JMN5144I-S The data name specified for the RENAMES clause cannot be an item which expands from the type. The RENAMES clause is ignored.

Explanation

The name included in the referred type cannot be renamed.

JMN5145I-W

A value is specified for a type that already has a value. It is accepted as written.

Example

[P5145.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5145.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005  01 A TYPEDEF   PIC 9(2) VALUE 99.
000006  01 B           TYPE A   VALUE 33.
000007 PROCEDURE       DIVISION.
000008     STOP RUN.
000009 END PROGRAM    P5145.

P5145.cob 6: JMN5145I-W A value is specified for a type that already has a value. It is accepted as written.

Explanation

This message is output when a value is specified for a type that already has a value, such as in the example above, when the VALUE clause is specified for type declaration (TYPEDEF) and the data description entry specifies the TYPE clause that refers to the type. In this case, the VALUE clause of the data description entry that specifies the TYPE clause is effective.

JMN5146I-S

The level numbers of items subordinate to the item specified by the type declaration exceed @1@. The items with invalid level-numbers are ignored.

Parameter explanation

@1@ : 49 or 77

Example

[P5146.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5146.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 BLOB TYPEDEF.
000006   02 RESEV      PIC S9(9) BINARY.
000007   02 LENG       PIC  9(9) BINARY.
000008   02 BUFF       PIC X(1024).
000009 77 GRP1  TYPE BLOB.
000010 PROCEDURE       DIVISION.
000011     STOP RUN.
000012 END PROGRAM     P5146.

P5146.cob 9: JMN5146I-S The level numbers of items subordinate to the item specified by the type declaration exceed 77. The items with invalid level-numbers are ignored.

Explanation

The hierarchical structure of the record of type (TYPEDEF) is applied to the data description entry that specifies the TYPE clause. As a result, when the level-number of the typed item exceeds 49, this diagnostic message is output.

JMN5147I-S

A type which is referred to by a conditional variable, must be defined as an elementary item. The condition-name is ignored.

Example

[P5147.cob]
000001 PROGRAM-ID.     P5147.
000002 DATA            DIVISION.
000003 WORKING-STORAGE  SECTION.
000004 01 BLOB TYPEDEF.
000005   02 RESEV      PIC S9(9) BINARY.
000006   02 LENG       PIC  9(9) BINARY.
000007   02 BUFF       PIC X(1024).
000008 01 GRP1         TYPE BLOB.
000009 88 ZSP          VALUE SPACE.
000010 PROCEDURE       DIVISION.
000011     STOP RUN.
000012 END  PROGRAM    P5147.

P5147.cob 8: JMN5147I-S A type which is referred to by a conditional variable, must be defined as an elementary item. The condition-name is ignored.

Explanation

A data item associated with the condition-name defined by the condition-name description entry (level-number 88) is called a conditional variable. When the TYPE clause is specified for the conditional variable, a type specified for the TYPE clause should be a type of an elementary item.

JMN5148I-S

A type which is referred to by a conditional variable cannot have a condition-name. The condition-name is ignored.

Example

[P5148.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5148.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 COLORV  TYPEDEF  PIC 9(4).
000006   88 BLUE       VALUE 1.
000007   88 RED        VALUE 2.
000008 01 WBCG         TYPE COLORV.
000009   88 GREEN      VALUE 3.
000010 PROCEDURE       DIVISION.
000011     STOP RUN.
000012 END  PROGRAM    P5148.

P5148.cob 8: JMN5148I-S A type which is referred to by a conditional variable cannot have a condition-name. The condition-name is ignored.

Explanation

A data item associated with the condition-name defined by the condition-name description entry (level-number 88) is called a conditional variable. When the TYPE clause is specified for the conditional variable, a type specified for the TYPE clause must not contain a condition-name description entry.

JMN5149I-S

When a TYPE clause is specified for the first elementary item within a group item with a REDEFINES clause, the redefined item must be adjusted to an 8 byte boundary. The TYPE clause is assumed to be valid, but no slack bits are inserted and the object file is not created.

Example

[P5149.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5149.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 VCHR TYPEDEF.
000006   02 WLENG      PIC S9(4) BINARY.
000007 01 WSTOCK.
000008   02 WPNO       PIC 9(7).
000009   02 WNAM       PIC X(22).
000010   02 WRNAM  REDEFINES WNAM.
000011     03          TYPE VCHR.
000012   02 WQOH       PIC S9(8) BINARY.
000013 PROCEDURE       DIVISION.
000014     STOP RUN.
000015 END PROGRAM     P5149.

P5149.cob 11: JMN5149I-S When a TYPE clause is specified for the first elementary item within a group item with a REDEFINES clause, the redefined item must be adjusted to an 8 byte boundary. The TYPE clause is assumed to be valid, but no slack bits are inserted and the object file is not created.

Explanation

The redefined item must be aligned on an 8-byte boundary.

JMN5150I-S

A type which is referred to by a variable-address item must be defined as an elementary item. Boundary not adjusted.

Example

[P5150.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5150.
000003 DATA            DIVISION.
000004 WORKING-STORAGE  SECTION.
000005 01 VCHR    TYPEDEF.
000006   02 WLENG      PIC S9(4) BINARY.
000007   02 WBUFF      PIC X(20).
000008 01 WVTBL.
000009   02 WQT        PIC S9(4) BINARY.
000010   02 WOCC       OCCURS 10 TIMES DEPENDING ON WQT.
000011     03          PIC X(1).
000012   02 WNAM       TYPE VCHR.
000013 PROCEDURE       DIVISION.
000014     STOP RUN.
000015 END PROGRAM     P5150.

P5150.cob 12: JMN5150I-S A type which is referred to by a variable-address item must be defined as an elementary item. Boundary not adjusted.

Explanation

The variable position in the record is the area allocated after the data description entry that specifies the OCCURS clause with the DEPENDING phrase.

When the TYPE clause is specified in the data description entry that is located in a variable position in a record, the type specified for the TYPE clause should be the type of an elementary item.

JMN5151I-S

The type declared in the class definition which has an OCCURS clause with 'DEPENDING ON' or 'KEY IS' cannot be referenced in a separate method. The TYPE clause is ignored.

Example

[C5151.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5151.
000003 ENVIRONMENT     DIVISION.
000004 OBJECT.
000005 DATA            DIVISION.
000006 WORKING-STORAGE  SECTION.
000007 01 VGRP TYPEDEF.
000008   02            OCCURS 3 TO 5 TIMES DEPENDING ON  ODO1
000009                 PIC S9(4) BINARY.
000010 01 ODO1         PIC S9(4) BINARY.
000011 PROCEDURE       DIVISION.
000012 METHOD-ID.      M5151 PROTOTYPE.
000013 PROCEDURE       DIVISION.
000014 END METHOD      M5151.
000015 END OBJECT.
000016 END CLASS       C5151.
[M5151.cob]
000001 IDENTIFICATION  DIVISION.
000002 METHOD-ID.      M5151 OF C5151.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006      CLASS      C5151.
000007 DATA            DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 METDATA      TYPE VGRP.
000010 PROCEDURE       DIVISION.
000011     MOVE ZERO  TO  METDATA.
000012     EXIT METHOD.
000013 END METHOD      M5151.

M5151.cob 9: JMN5151I-S The type declared in the class definition which has an OCCURS clause with 'DEPENDING ON' or 'KEY IS' cannot be referenced in a separate method. The TYPE clause is ignored.

JMN5152I-S

A type declaration with a STRONG phrase must be a group item. The STRONG phrase is ignored.

Example

[P5152.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5152.
000003 ENVIRONMENT     DIVISION.
000004 DATA            DIVISION.
000005 WORKING-STORAGE  SECTION.
000006  01 STY TYPEDEF STRONG
000007                 PIC X(20).
000008 PROCEDURE       DIVISION.
000009 END PROGRAM     P5152.

P5152.cob 6: JMN5152I-S A type declaration with a STRONG phrase must be a group item. The STRONG phrase is ignored.

Explanation

STRONG cannot be specified for elementary items.

JMN5153I-S

A type declaration with a STRONG phrase or a strongly typed item cannot contain a @1@ clause.

Parameter explanation

@1@ : VALUE, REDEFINES, OCCURS DEPENDING ON or USAGE OBJECT REFERENCE with SELF.

Example

[P5153.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5153.
000003 ENVIRONMENT     DIVISION.
000004 DATA            DIVISION.
000005 WORKING-STORAGE  SECTION.
000006 01 STY1 TYPEDEF STRONG.
000007   02 ITEM11    PIC X(20) VALUE SPACE.
000008   02 ITEM12    PIC S9(9) BINARY.
000009 01 DATA1       TYPE  STY2 VALUE SPACE.
000010 01 STY2 TYPEDEF STRONG.
000011   02 ITEM2     PIC X(20).
000012 01 STY3 TYPEDEF STRONG.
000013   02 ITEM3     PIC X(20).
000014   02 ITEM3R  REDEFINES ITEM3.
000015     03 ITEM31  PIC X(10).
000016     03 ITEM32  TYPE STY2 VALUE SPACE.
000017 PROCEDURE      DIVISION.
000018 END PROGRAM    P5153.

P5153.cob 7: JMN5153I-S A type declaration with a STRONG phrase or a strongly typed item cannot contain a VALUE clause.

P5153.cob 9: JMN5153I-S A type declaration with a STRONG phrase or a strongly typed item cannot contain a VALUE clause.

P5153.cob 14: JMN5153I-S A type declaration with a STRONG phrase or a strongly typed item cannot contain a REDEFINES clause.

P5153.cob 16: JMN5153I-S A type declaration with a STRONG phrase or a strongly typed item cannot contain a VALUE clause.

Explanation

A strongly typed item is a data description entry that specifies the TYPE clause that refers to type declaration (TYPEDEF) with a STRONG phrase.

JMN5154I-S

A strongly typed item cannot be defined in the BASED-STORAGE SECTION. A weakly typed item is assumed.

Example

[P5154.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5154.
000003 ENVIRONMENT     DIVISION.
000004 DATA            DIVISION.
000005 BASED-STORAGE   SECTION.
000006 01 DATA1        TYPE STY1.
000007 WORKING-STORAGE  SECTION.
000008 01 STY1 TYPEDEF STRONG.
000009   02 ITEM11     PIC X(4) .
000010   02 ITEM12     PIC X(4).
000011 PROCEDURE       DIVISION.
000012 END PROGRAM     P5154.

P5154.cob 6: JMN5154I-S A strongly typed item cannot be defined in the BASED-STORAGE SECTION. A weakly typed item is assumed.

Explanation

The TYPE clause that refers the type (TYPEDEF) defined with a STRONG phrase cannot be specified for data description entries of the BASED-STORAGE SECTION.

JMN5155I-S

A type declaration with a STRONG phrase can only be referred by a level 01 data item or by an item that is subordinate to a type declaration with a STRONG phrase. A weakly typed item is assumed.

Example

[P5155.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5155.
000003 ENVIRONMENT     DIVISION.
000004 DATA            DIVISION.
000005 WORKING-STORAGE  SECTION.
000006 01 STY1 TYPEDEF STRONG.
000007   02 ITEM11     PIC X(4) .
000008   02 ITEM12     PIC X(4).
000009 01 DATA1.
000010   02 DATA2      TYPE  STY1.
000011 PROCEDURE DIVISION.
000012 END PROGRAM     P5155.

P5155.cob 10: JMN5155I-S A type declaration with a STRONG phrase can only be referred by a level 01 data item or by an item that is subordinate to a type declaration with a STRONG phrase. A weakly typed item is assumed.

JMN5156I-S

Data-name @2@ in the @1@ cannot be a strongly typed item.

Parameter explanation

@1@ : Clause of the INPUT-OUTPUT SECTION or DATA DIVISION.

@2@ : Data name specified for the @1@.

Example

[P5156.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5156.
000003 ENVIRONMENT     DIVISION.
000004 INPUT-OUTPUT     SECTION.
000005 FILE-CONTROL.
000006     SELECT FILE1 ASSIGN  TO  SYS001
000007            FILE  STATUS  DATA1.
000008 DATA            DIVISION.
000009 FILE SECTION.
000010 FD FILE1.
000011 01  REC1        PIC X(80).
000012 WORKING-STORAGE  SECTION.
000013 01 STY1 TYPEDEF STRONG.
000014   02 ITEM11     PIC X(4) .
000015   02 ITEM12     PIC X(4).
000016 01 DATA1        TYPE STY1.
000017 PROCEDURE       DIVISION.
000018 END PROGRAM     P5156.

Explanation

A strongly typed item is a data description entry that specifies the TYPE clause that refers to type declaration (TYPEDEF) with a STRONG phrase.

JMN5157I-S

The TYPEDEF clause has a STRONG phrase that cannot be specified with a TYPE clause. The STRONG phrase is ignored.

Example

[P5157.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     P5157.
000003 ENVIRONMENT     DIVISION.
000004 DATA            DIVISION.
000005 WORKING-STORAGE  SECTION.
000006 01 STY  TYPEDEF STRONG
000007                 TYPE TYP1.
000008 01 TYP1 TYPEDEF.
000009   02 T1         PIC X(10).
000010 PROCEDURE       DIVISION.
000011 END PROGRAM     P5157.

P5157.cob 7: JMN5157I-S The TYPEDEF clause has a STRONG phrase that cannot be specified with a TYPE clause. The STRONG phrase is ignored.

JMN5158I-S

If the runtime code set of national data is unicode, data-name '@2@' in the @1@ clause cannot be a group item that contains a national item. It is accepted as written.

Parameter explanation

@1@ : ASSIGN

@2@ : Data name specified for @1@ clause

Example

[P5158.cob]
000001 @OPTIONS RCS(UTF16)
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    P5158.
000004 ENVIRONMENT    DIVISION.
000005 INPUT-OUTPUT    SECTION.
000006 FILE-CONTROL.
000007     SELECT SQFILE1 ASSIGN TO WFILNM
000008       ORGANIZATION   IS SEQUENTIAL
000009       FILE STATUS    IS WFS1.
000010 I-O-CONTROL.
000011 DATA           DIVISION.
000012 FILE            SECTION.
000013 FD SQFILE1.
000014 01 SQF1REC.
000015   02           PIC X(80).
000016 WORKING-STORAGE SECTION.
000017 01 WFS1        PIC X(2).
000018 01 WFILNM.
000019   02           PIC N(10).
000020 PROCEDURE      DIVISION.
000021 END PROGRAM    P5158.

P5158.cob 18: JMN5158I-S If the runtime code set of national data is unicode, data-name 'WFILNM' in the ASSIGN clause cannot be a group item that contains a national item. It is accepted as written.

Explanation

When NetCOBOL handles Unicode data, UCS-2 is used for the encoding form of national data items, and UTF-8 is used for the encoding form of group items (this class is alphanumeric). If the data item is treated as a group item, the national item subordinate to the group item cannot have an appropriate value because the data of the UTF-8 encoding form is stored in the area of the national item also.

JMN5159I-S

If the runtime code set of national data is unicode, the line sequential file record cannot have both national and non-national items.

Example

[P5159.cob]
000001 @OPTIONS RCS(UTF16)
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    P5159.
000004 ENVIRONMENT    DIVISION.
000005 INPUT-OUTPUT    SECTION.
000006 FILE-CONTROL.
000007     SELECT SQFILE1 ASSIGN TO SYS001
000008       ORGANIZATION   IS LINE SEQUENTIAL
000009       FILE STATUS    IS WFS1.
000010 I-O-CONTROL.
000011 DATA           DIVISION.
000012 FILE            SECTION.
000013 FD SQFILE1.
000014 01 SQF1REC1.
000015   02           PIC X(80).
000016 01 SQF1REC2.
000017   02           PIC N(40).
000018 WORKING-STORAGE SECTION.
000019 01 WFS1        PIC X(2).
000020 PROCEDURE      DIVISION.
000021 END PROGRAM    P5159.

P5159.cob 13: JMN5159I-S If the runtime code set of national data is unicode, the line sequential file record cannot have both national and non-national items.

Explanation

When NetCOBOL handles Unicode data, UCS-2 is used for the encoding form of national data items, and ASCII(UTF-8) is used for the encoding form of alphanumeric items. Data with different encoding forms cannot be treated at the same time in one record.

JMN5160I-W

Group item '@2@' which contains a national item is specified as a data-name of the @1@ clause. If the runtime code set of national data is unicode, the national part of this item is not compared as national.

Parameter explanation

@1@ : RECORD KEY, ALTERNATE RECORD KEY, KEY IS.

@2@ : Data name that causes the error.

Example

[P5160.cob]
000001 @OPTIONS RCS(UTF16)
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    P5160.
000004 ENVIRONMENT    DIVISION.
000005 INPUT-OUTPUT    SECTION.
000006 FILE-CONTROL.
000007     SELECT IXFILE1 ASSIGN TO SYS001
000008       ORGANIZATION   IS INDEXED
000009       RECORD KEY     IS KEY1.
000010 I-O-CONTROL.
000011 DATA           DIVISION.
000012 FILE            SECTION.
000013 FD IXFILE1.
000014 01 IXF1REC.
000015   02 KEY1.
000016     03         PIC N(2).
000017   02           PIC X(80).
000018 WORKING-STORAGE SECTION.
000019 PROCEDURE      DIVISION.
000020 END PROGRAM    P5160.

P5160.cob 9: JMN5160I-W Group item 'KEY1' which contains a national item is specified as a data-name of the RECORD KEY clause. If the runtime code set of national data is unicode, the national part of this item is not compared as national.

Explanation

When NetCOBOL handles Unicode data, UCS-2 is used for the encoding form of national data items, and UTF-8 is used for the encoding form of group items (this class is alphanumeric). If the data item is treated as a group item, the national item subordinate to the group item cannot have an appropriate value because the data of the UTF-8 encoding form is stored in the area of a national item also.

JMN5260I-S

Data-name @2@ in the @1@ clause cannot have a @3@ clause.

Parameter explanation

@1@ : Clause of INPUT-OUTPUT SECTION or DATA DIVISION.

@2@ : Data name that causes the error.

@3@ : USAGE BINARY-CHAR.

Example

[C5260.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    C5260.
000003 ENVIRONMENT    DIVISION.
000004 INPUT-OUTPUT    SECTION.
000005 FILE-CONTROL.
000006     SELECT RLFILE1 ASSIGN TO SYS001
000007       ORGANIZATION   IS RELATIVE
000008         RELATIVE KEY IS WRKY
000009       FILE STATUS    IS WFS1.
000010 I-O-CONTROL.
000011 DATA           DIVISION.
000012 FILE            SECTION.
000013 FD RLFILE1.
000014 01 RLF1REC.
000015   02                   PIC X(80).
000016 WORKING-STORAGE SECTION.
000017 01 WFS1        PIC X(2).
000018 01 WRKY        BINARY-CHAR UNSIGNED.
000019 PROCEDURE      DIVISION.
000020 END PROGRAM    C5260.

C5260.cob 8: JMN5260I-S Data-name WRKY in the RELATIVE KEY clause cannot have a USAGE BINARY-CHAR clause.

JMN5400I-U

Compiler restriction. Total size of data items, and compiler generation area exceeds maximum value. Compilation terminated.

Example

[C5400.cob]
000001 PROGRAM-ID.  C5400.
000002 DATA  DIVISION.
000003 WORKING-STORAGE SECTION.
000004 01 A    PIC X(1500000000).
000005 01 B    PIC X(1500000000).
000006 PROCEDURE  DIVISION.
000007 P-START.
000008     MOVE A TO B.
000009     STOP RUN.

C5400.cob 0: JMN5400I-U Compiler restriction. Total size of data items, and compiler generation area exceeds maximum value. Compilation terminated.

JMN5410I-U

The program size is too large for this system. Compilation terminated. The program should be separated into proper size programs.

JMN5411I-U

The program size is too large for MODEL(SMALL) option. The program should be compiled whit MODEL(COMPACT) option.

JMN5412I-U

The program size is too large for MODEL(MEDIUM) option. The program should be compiled with MODEL(LARGE) option.

JMN5500I-S

The identifier in the @1@ statement must be a specified object reference identifier.

Parameter explanation

@1@ : RAISE.

Example

[C5500.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5500.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID      M5500.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 AAA         PIC X(4).
000011 PROCEDURE      DIVISION.
000012     RAISE AAA
000013 END METHOD     M5500.
000014 END OBJECT.
000015 END CLASS      C5500.

C5500.cob 12: JMN5500I-S The identifier in the RAISE statement must be a specified object reference identifier.

JMN5501I-S

An @2@ phrase cannot be specified in a @1@ statement.

Parameter explanation

@1@ : RAISE.

@2@ : EXCEPTION.

Example

[C5501.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5501.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID      M5501.
000008 PROCEDURE      DIVISION.
000009     RAISE EXCEPTION EC-00
000010 END METHOD     M5501.
000011 END OBJECT.
000012 END CLASS      C5501.

C5501.cob 9: JMN5501I-S An EXCEPTION phrase cannot be specified in a RAISE statement.

JMN5504I-S

An object property or in-line method invocation cannot be specified in the USING phrase of the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE or CALL.

Example

[C5504.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5504.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 PR5504      PIC S9(9) COMP-5 PROPERTY.
000008 PROCEDURE DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5504.
000011 DATA           DIVISION.
000012 LINKAGE         SECTION.
000013 01 LK1         PIC S9(9) COMP-5.
000014 01 LK2         PIC S9(9) COMP-5.
000015 PROCEDURE      DIVISION USING     LK1
000016                         RETURNING LK2.
000017 END METHOD     M5504.
000018 END OBJECT.
000019 END CLASS      C5504.
[P5504.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5504.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5504.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR USAGE OBJECT REFERENCE C5504.
000010 PROCEDURE DIVISION.
000011* object property
000012     INVOKE WOBR "M5504" USING PR5504 OF WOBR
000013* in-line invocation
000014     INVOKE WOBR "M5504" USING WOBR :: "M5504" (12)
000015 END PROGRAM    P5504.

P5504.cob 12: JMN5504I-S An object property or in-line method invocation cannot be specified in the USING phrase of the INVOKE statement. The INVOKE statement is ignored.

P5504.cob 14: JMN5504I-S An object property or in-line method invocation cannot be specified in the USING phrase of the INVOKE statement. The INVOKE statement is ignored.

Explanation

Store the result of the in-line method invocation or the object property in another data item, and specify the data item for the USING phrase.

JMN5505I-S

Method-name '@3@' specified for @1@ is not defined in class '@2@'. @1@ is ignored.

Parameter explanation

@1@ : INVOKE statement or method inline invocation.

@2@ : Class name that causes the error.

@3@ : Method name that causes the error.

Example

[C5505.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5505.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5505X.
000008 PROCEDURE      DIVISION.
000009 END METHOD     M5505X.
000010 END OBJECT.
000011 END CLASS      C5505.
[P5505.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5505.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5505.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE C5505.
000010 PROCEDURE      DIVISION.
000011     INVOKE WOBR "M5505".
000012 END PROGRAM    P5505.

P5505.cob 11: JMN5505I-S Method-name 'M5505' specified for INVOKE statement is not defined in class 'C5505'. INVOKE statement is ignored.

Explanation

Confirm that the target method exists in the class that specifies it. Check the method-name and the parameter interface.

JMN5507I-S

The identifier in the RAISING phrase of the @1@ statement must be an object reference identifier.

Parameter explanation

@1@ : EXIT.

Example

[C5507.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5507.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5507.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WERROR      PIC X(20).
000011 PROCEDURE      DIVISION.
000012     EXIT METHOD RAISING WERROR
000013 END METHOD     M5507.
000014 END OBJECT.
000015 END CLASS      C5507.

C5507.cob 12: JMN5507I-S The identifier in the RAISING phrase of the EXIT statement must be an object reference identifier.

JMN5508I-S

The @1@ statement can only be specified in a program definition.

Parameter explanation

@1@ : CONNECT, DISCONNECT, ERASE, ENTRY, FIND, FINISH, GET, IF DB-EXCEPTION, MODIFY, READY, STORE or USE FOR DB-EXCEPTION

Example

[C5508.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5508.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 PROCEDURE      DIVISION.
000008 IDENTIFICATION DIVISION.
000009 METHOD-ID.     M5508.
000010 ENVIRONMENT    DIVISION.
000011 DATA           DIVISION.
000012 LINKAGE         SECTION.
000013 01 LK1         PIC X.
000014 PROCEDURE      DIVISION.
000015     READY.
000016 END METHOD     M5508.
000017 END OBJECT.
000018 END CLASS    C5508.

C5508.cob 15: JMN5508I-S The READY statement can only be specified in a program definition.

JMN5509I-S

@1@ cannot be specified for a receiving item.

Parameter explanation

@1@ : Predefined object identifier SELF, predefined object identifier SUPER, predefined object identifier EXCEPTION-OBJECT, class-name, in-line method invocation or identifier with object modifier.

Example

[C5509.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5509.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION  SECTION.
000005 IDENTIFICATION DIVISION.
000006 OBJECT.
000007 PROCEDURE      DIVISION.
000008 IDENTIFICATION DIVISION.
000009 METHOD-ID.        M5509.
000010 DATA           DIVISION.
000011 LINKAGE         SECTION.
000012 01 LK1         PIC X(2).
000013 PROCEDURE      DIVISION RETURNING LK1.
000014     SET SELF TO NULL.
000015     MOVE SPACE TO SELF :: "M5509"
000016 END METHOD        M5509.
000017 END OBJECT.
000018 END CLASS         C5509.

C5509.cob 14: JMN5509I-S Predefined object identifier SELF cannot be specified for a receiving item.

C5509.cob 15: JMN5509I-S In-line method invocation cannot be specified for a receiving item.

JMN5510I-S

The @1@ phrase and the @2@ phrase cannot be specified simultaneously. The @2@ phrase is ignored.

Parameter explanation

@1@ : WITH.

@2@ : RAISING.

Example

[P5510.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5510.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION  SECTION.
000005 DATA           DIVISION.
000006 LINKAGE        SECTION.
000007 PROCEDURE      DIVISION
000008                WITH STDCALL LINKAGE
000009                RAISING BASE.
000010     DISPLAY "PARAMETER ERROR".
000011     STOP RUN.

P5510.cob 9: JMN5510I-S The WITH phrase and the RAISING phrase cannot be specified simultaneously. The RAISING phrase is ignored.

JMN5511I-S

The @1@ phrase cannot be specified in the PROCEDURE DIVISION of a method definition.

Parameter explanation

@1@ : WITH.

Example

[C5511.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5511.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 PROCEDURE      DIVISION.
000007 IDENTIFICATION DIVISION.
000008 METHOD-ID.     MF1.
000009 DATA           DIVISION.
000010 PROCEDURE      DIVISION  WITH STDCALL LINKAGE.
000011     DISPLAY "PHRASE ERROR".
000012 END METHOD MF1.
000013 END OBJECT.
000014 END CLASS C5511.

C5511.cob 10: JMN5511I-S The WITH phrase cannot be specified in the PROCEDURE DIVISION of a method definition.

Explanation

The WITH phrase of the procedure division header specifies the calling conventions for a called program. The calling conventions cannot be specified in the method definition.

JMN5512I-S

A RETURNING phrase can only have one operand.

Example

[C5512.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5512.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5512.
000011 DATA           DIVISION.
000012 LINKAGE         SECTION.
000013  01 LK1        PIC S9(4) DISPLAY.
000014  01 LK2        PIC X(4).
000015 PROCEDURE      DIVISION RETURNING LK1 LK2.
000016     DISPLAY "PARAMETER ERROR".
000017 END METHOD     M5512.
000018 END OBJECT.
000019 END CLASS C5512.

C5512.cob 15: JMN5512I-S A RETURNING phrase can only have one operand.

Explanation

The data description entry that stores the value returned to the calling program is specified in the RETURNING phrase of the procedure division header. Only one value can be returned.

JMN5513I-S

Operand '@1@' in the @2@ phrase must be defined in the LINKAGE SECTION of this source unit as a level 01 or 77 item without a REDEFINES clause.

Parameter explanation

@1@ : User-defined word specified for USING or RETURNING parameter.

@2@ : USING or RETURNING.

Example

[C5513.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5513.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5513.
000011 DATA           DIVISION.
000012 WORKING-STORAGE SECTION.
000013  01 WK1        PIC X(8).
000014 LINKAGE         SECTION.
000015  01 LK1        PIC X(8).
000016  01 LK2        PIC S9(4) DISPLAY.
000017  01 RET        REDEFINES LK2 PIC X(4).
000018 PROCEDURE      DIVISION
000019                USING WK1 LK1
000020                RETURNING RET.
000021       DISPLAY "PARAMETER ERROR".
000022 END METHOD     M5513.
000023 END OBJECT.
000024 END CLASS      C5513.

C5513.cob 19: JMN5513I-S Operand 'WK1' in the USING phrase must be defined in the LINKAGE SECTION of this source unit as a level 01 or 77 item without a REDEFINES clause.

C5513.cob 20: JMN5513I-S Operand 'RET' in the RETURNING phrase must be defined in the LINKAGE SECTION of this source unit as a level 01 or 77 item without a REDEFINES clause.

JMN5514I-S

'@1@' is already specified as the operand in the USING phrase.

Parameter explanation

@1@ : User-defined word specified for the USING parameter.

Example

[C5514.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5514.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     MO1.
000011 DATA           DIVISION.
000012 LINKAGE        SECTION.
000013  01 LK1        PIC X(10).
000014  01 LK2        PIC X(10).
000015 PROCEDURE      DIVISION USING LK1 LK1.
000016     DISPLAY "PARAMETER ERROR".
000017 END METHOD     MO1.
000018 END OBJECT.
000019 END CLASS C5514.

C5514.cob 15: JMN5514I-S 'LK1' is already specified as the operand in the USING phrase.

Explanation

The data-name of one data description entry cannot be specified two or more times for the USING phrase of the procedure division header.

JMN5515I-S

SELF, FACTORY OF SELF, and CLASS OF SELF cannot be specified as operand '@1@' in a USING phrase of a PROCEDURE DIVISION.

Parameter explanation

@1@ : User-defined word that is the name of the object reference data item.

Example

[C5515.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5515.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5515.
000011 DATA           DIVISION.
000012 LINKAGE        SECTION.
000013  01 LK1        USAGE OBJECT REFERENCE CLASS OF SELF.
000014  01 LK2        PIC S9(4) BINARY.
000015 PROCEDURE      DIVISION USING LK1 LK2.
000016     DISPLAY "PARAMETER ERROR".
000017 END METHOD     M5515.
000018 END OBJECT.
000019 END CLASS      C5515.

C5515.cob 15: JMN5515I-S SELF, FACTORY OF SELF, and CLASS OF SELF cannot be specified as operand 'LK1' in a USING phrase of a PROCEDURE DIVISION.

JMN5516I-S

The operand in the RETURNING phrase cannot be the same as the operand in the USING phrase.

Example

[C5516.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5516.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5516.
000011 DATA           DIVISION.
000012 LINKAGE        SECTION.
000013  01 LK1        PIC S9(4) DISPLAY.
000014  01 LK2        PIC X(4).
000015 PROCEDURE      DIVISION
000016                USING LK1 RETURNING LK1.
000017     DISPLAY "PARAMETER ERROR".
000018 END METHOD     M5516.
000019 END OBJECT.
000020 END CLASS      C5516.

C5516.cob 16: JMN5516I-S The operand in the RETURNING phrase cannot be the same as the operand in the USING phrase.

Explanation

Specify another item.

JMN5517I-S

The @2@ phrase cannot be specified in the PROCEDURE DIVISION header of @1@.

Parameter explanation

@1@ : factory definition, static definition, object definition or interface definition.

@2@ : USING, RETURNING or WITH.

JMN5518I-S

DECLARATIVES cannot be specified in the PROCEDURE DIVISION of @1@.

Parameter explanation

@1@ : Factory definition, object definition

Example

[C5518.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5518.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 IDENTIFICATION DIVISION.
000006 OBJECT.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 PROCEDURE      DIVISION.
000010 DECLARATIVES.
000011 ERR-1 SECTION.
000012     USE AFTER EXCEPTION C5518.
000013     DISPLAY "*** ERROR ***".
000014 END DECLARATIVES.
000015 END OBJECT.
000016 END CLASS      C5518.

C5518.cob 10: JMN5518I-S DECLARATIVES cannot be specified in the PROCEDURE DIVISION of object definition.

Explanation

Only the procedure division header can be specified.

JMN5519I-S

An EXIT PROGRAM statement cannot be specified in a method definition.

Example

[C5519.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5519.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 IDENTIFICATION DIVISION.
000006 OBJECT.
000007 PROCEDURE      DIVISION.
000008 IDENTIFICATION DIVISION.
000009 METHOD-ID.     M5519.
000010 PROCEDURE      DIVISION.
000011     EXIT PROGRAM
000012 END METHOD     M5519.
000013 END OBJECT.
000014 END CLASS      C5519.

C5519.cob 11: JMN5519I-S An EXIT PROGRAM statement cannot be specified in a method definition.

Explanation

The EXIT PROGRAM statement is specified in the procedure division of the program definition.

JMN5520I-S

An EXIT METHOD statement can only be specified in a method definition.

Example

[P5520.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5520.
000003 ENVIRONMENT    DIVISION.
000004 DATA           DIVISION.
000005 PROCEDURE      DIVISION.
000006     EXIT METHOD
000007 END PROGRAM    P5520.

P5520.cob 6: JMN5520I-S An EXIT METHOD statement can only be specified in a method definition.

JMN5521I-S

'@1@' must be the class-name that is specified in the REPOSITORY paragraph.

Parameter explanation

@1@ : Data name specified for the RAISING phrase.

Example

[P5521.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5521.
000003 ENVIRONMENT    DIVISION.
000004 DATA           DIVISION.
000005 WORKING-STORAGE SECTION.
000006 01 WDA1        PIC X(10).
000007 PROCEDURE      DIVISION
000008                  RAISING WDA1.
000009 END PROGRAM    P5521.

P5521.cob 8: JMN5521I-S 'WDA1' must be the class-name that is specified in the REPOSITORY paragraph.

Explanation

The class-name that is declared in a class-specifier in the repository paragraph of the environment division is specified for the RAISING phrase of the procedure division header.

JMN5522I-S

Class-name '@1@' cannot be the name of a special class.

Parameter explanation

@1@ : User-defined word specified as a class name.

Example

[C5522.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5522.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION  SECTION.
000005 REPOSITORY.
000006     CLASS COM AS "*OLE".
000007   IDENTIFICATION DIVISION.
000008 OBJECT.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5522.
000014 DATA           DIVISION.
000015 PROCEDURE      DIVISION
000016                RAISING  COM.
000017     DISPLAY "PARAMETER ERROR".
000018 END METHOD     M5522.
000019 END OBJECT.
000020 END CLASS C5522.

C5522.cob 16: JMN5522I-S Class-name 'COM' cannot be the name of a special class.

Explanation

The special class name cannot be specified for the RAISING phrase of the procedure division header or the USE statement of the exception object.

If the literal of a class-specifier in the repository paragraph of the environment division is below, the class-name is a special class name.

  • "*COM" (or "*OLE")

  • "*COM-ARRAY" (or "*OLE-ARRAY")

  • "*COM-EXCEPTION" ( or "*OLE-EXCEPTION")

  • "*COB-BINDTABLE"

  • "*COM:COM server name:COM class name" (COM server name = arbitrary name used for association with a type library, COM class name = dispinterface name or coclass name)

JMN5525I-S

The identifier specified immediately after @1@ must be an object identifier. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE.

Example

[P5525.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5525.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 WDX         PIC X(08).
000006 PROCEDURE      DIVISION.
000007     INVOKE WDX "M5525".
000008 END PROGRAM    P5525.

P5525.cob 7: JMN5525I-S The identifier specified immediately after INVOKE must be an object identifier. The INVOKE statement is ignored.

Explanation

The object with the target procedure (method) is identified by the object identifier specified just after INVOKE.

JMN5526I-S

The method-name specified in the INVOKE statement must be an identifier, nonnumeric literal, or national character literal. The INVOKE statement is ignored.

Example

[P5526.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5526.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 WOBR        USAGE OBJECT REFERENCE.
000006 PROCEDURE      DIVISION.
000007 L5526.
000008     INVOKE WOBR L5526.
000009 END PROGRAM    P5526.

P5526.cob 8: JMN5526I-S The method-name specified in the INVOKE statement must be an identifier, nonnumeric literal, or national character literal. The INVOKE statement is ignored.

JMN5527I-S

If identifier '@1@' is specified in an INVOKE statement, the identifier specified immediately after INVOKE must be an identifier specified untyped OBJECT REFERENCE clause. The INVOKE statement is ignored.

Parameter explanation

@1@ : Identifier which causes error.

Example

[C5527.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5527.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5527.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 LINKAGE         SECTION.
000011 PROCEDURE      DIVISION.
000012 END METHOD     M5527.
000013 END OBJECT.
000014 END CLASS      C5527.
[P5527.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5527.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5527.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE C5527.
000010 01 WMET        PIC X(8).
000011 PROCEDURE      DIVISION.
000012     MOVE "M5527" TO WMET
000013     INVOKE WOBR WMET
000014 END PROGRAM    P5527.

P5527.cob 13: JMN5527I-S If identifier 'WMET' is specified in an INVOKE statement, the identifier specified immediately after INVOKE must be an identifier specified untyped OBJECT REFERENCE clause. The INVOKE statement is ignored.

Explanation

An 'untyped OBJECT REFERENCE clause' is a USAGE OBJECT REFERENCE clause in which none of the following phrases is specified:

  • SELF

  • FACTORY OF SELF

  • CLASS OF SELF

  • class-name

  • class-name ONLY

  • FACTORY OF class-name

  • FACTORY OF class-name ONLY

JMN5528I-S

A pointer data item cannot specified for the RETURNING phrase in a PROCEDURE DIVISION of a method definition.

Example

[C5528.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5528.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     METHODO1.
000008 DATA           DIVISION.
000009 LINKAGE         SECTION.
000010 01 LKD1        POINTER.
000011 PROCEDURE      DIVISION
000012                    RETURNING LKD1.
000013 END METHOD METHODO1.
000014 END OBJECT.
000015 END CLASS         C5528.

C5528.cob 12: JMN5528I-S A pointer data item cannot specified for the RETURNING phrase in a PROCEDURE DIVISION of a method definition.

JMN5530I-S

Predefined object identifier SUPER can be used to invoke a method in the INVOKE statement or in-line method invocation, or as the object in an object property. The @1@ statement is ignored.

Parameter explanation

@1@ : Statement that refers to predefined object identifier SUPER.

Example

[C5530.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5530 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 ENVIRONMENT    DIVISION.
000010 DATA           DIVISION.
000011 WORKING-STORAGE SECTION.
000012 PROCEDURE      DIVISION.
000013 IDENTIFICATION DIVISION.
000014 METHOD-ID.     M5530.
000015 ENVIRONMENT    DIVISION.
000016 DATA           DIVISION.
000017 WORKING-STORAGE SECTION.
000018 01 WOBJ        OBJECT REFERENCE.
000019 PROCEDURE      DIVISION.
000020     SET WOBJ TO SUPER.
000021 END METHOD     M5530.
000022 END OBJECT.
000023 END CLASS      C5530.

C5530.cob 20: JMN5530I-S Predefined object identifier SUPER can be used to invoke a method in the INVOKE statement or in-line method invocation, or as the object in an object property. The SET statement is ignored.

JMN5531I-S

Predefined object identifier @1@ cannot be used in a program definition. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Parameter explanation

@1@ : SELF or SUPER.

Example

[P5531.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID     P5531.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 PROCEDURE      DIVISION.
000007     INVOKE SELF "NO-METHOD".
000008 END PROGRAM    P5531.

P5531.cob 7: JMN5531I-S Predefined object identifier SELF cannot be used in a program definition. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

JMN5532I-S

Predefined object identifier SUPER must specify a class-name in the class which inherits multiple classes. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Example

[C5532A.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5532A.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5532.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 LINKAGE         SECTION.
000011 PROCEDURE      DIVISION.
000012 END METHOD     M5532.
000013 END OBJECT.
000014 END CLASS      C5532A.
[C5532B.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5532B.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5532.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 LINKAGE         SECTION.
000011 PROCEDURE      DIVISION.
000012 END METHOD     M5532.
000013 END OBJECT.
000014 END CLASS      C5532B.
[C5532.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5532 INHERITS C5532A C5532B.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5532A
000007     CLASS C5532B.
000008 IDENTIFICATION DIVISION.
000009 OBJECT.
000010 PROCEDURE      DIVISION.
000011 IDENTIFICATION DIVISION.
000012 METHOD-ID.     M5532 OVERRIDE.
000013 ENVIRONMENT    DIVISION.
000014 DATA           DIVISION.
000015 LINKAGE         SECTION.
000016 PROCEDURE      DIVISION.
000017     INVOKE SUPER "M5532"
000018 END METHOD     M5532.
000019 END OBJECT.
000020 END CLASS      C5532.

C5532.cob 17: JMN5532I-S Predefined object identifier SUPER must specify a class-name in the class which inherits multiple classes. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Explanation

Two or more class-names can be specified for the INHERITS phrase of the CLASS-ID paragraph. When the predefined object identifier SUPER is used in such a class, "class-name OF SUPER" should be written, and the parent class should be indicated.

JMN5533I-S

Predefined object identifier SUPER cannot be used in a class that does not inherit any class. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Example

[C5533.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5533.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5533.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 OBJFU       USAGE OBJECT REFERENCE CLASS OF SELF.
000011 PROCEDURE      DIVISION.
000012     INVOKE SUPER "NEW" RETURNING OBJFU.
000013 END METHOD     M5533.
000014 END OBJECT.
000015 END CLASS      C5533.

C5533.cob 12: JMN5533I-S Predefined object identifier SUPER cannot be used in a class that does not inherit any class. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Explanation

The predefined object identifier SUPER corresponds to the parent class, so it can be used only in the class that inherits from other classes.

JMN5534I-S

Predefined object identifier EXCEPTION-OBJECT can only be used in DECLARATIVES that correspond to the USE statement with class-name. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Example

[P5534.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID     P5534.
000003 ENVIRONMENT    DIVISION.
000004 PROCEDURE      DIVISION.
000005     INVOKE EXCEPTION-OBJECT "NO-METHOD"
000006 END PROGRAM    P5534.

P5534.cob 5: JMN5534I-S Predefined object identifier EXCEPTION-OBJECT can only be used in DECLARATIVES that correspond to the USE statement with class-name. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

JMN5535I-S

@2@ cannot be specified in a @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : SEARCH.

@2@ : Predefined object identifier SELF, predefined object identifier SUPER, predefined object identifier EXCEPTION-OBJECT, class-name, in-line method invocation, identifier with object modifier or predefined object identifier NULL.

Example

[C5535.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5535.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5535.
000011 ENVIRONMENT    DIVISION.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 WGRP.
000015   02 WOCC      OCCURS 10 INDEXED BY IX1.
000016     03         PIC X.
000017 PROCEDURE      DIVISION.
000018     SEARCH SELF VARYING IX1
000019     WHEN WOCC(IX1) = "X"
000020       DISPLAY "FIND"
000021     END-SEARCH
000022 END METHOD     M5535.
000023 END OBJECT.
000024 END CLASS      C5535.

C5535.cob 18: JMN5535I-S Predefined object identifier SELF cannot be specified in a SEARCH statement. The SEARCH statement is ignored.

JMN5536I-S

A class-name that is specified in predefined object identifier SUPER must be specified in an INHERITS clause. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

Example

[C5536A.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5536A.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 PROCEDURE      DIVISION.
000008 END OBJECT.
000009 END CLASS      C5536A.
[C5536B.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5536B.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 PROCEDURE      DIVISION.
000008 END OBJECT.
000009 END CLASS      C5536B.
[C5536.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5536 INHERITS FJBASE C5536A.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5536A
000007     CLASS C5536B
000008     CLASS FJBASE.
000009 IDENTIFICATION DIVISION.
000010 OBJECT.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5536.
000014 ENVIRONMENT    DIVISION.
000015 DATA           DIVISION.
000016 LINKAGE         SECTION.
000017 PROCEDURE      DIVISION.
000018     INVOKE C5536B OF SUPER "M5536"
000019 END METHOD     M5536.
000020 END OBJECT.
000021 END CLASS    C5536.

C5536.cob 18: JMN5536I-S A class-name that is specified in predefined object identifier SUPER must be specified in an INHERITS clause. Untyped object reference data item 'UNTYPED-OBJECT' is assumed.

JMN5537I-S

The PROCEDURE DIVISION of a get property or set property method is missing a required parameter. An alphanumeric item of 1 character is assumed.

Example

[C5537.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5537.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 01 WK1         PIC X(8).
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     SET PROPERTY PR5537.
000012 DATA           DIVISION.
000013 PROCEDURE      DIVISION.
000014     MOVE SPACE TO WK1.
000015     EXIT METHOD.
000016 END METHOD.
000017 END OBJECT.
000018 END CLASS      C5537.

C5537.cob 11: JMN5537I-S The PROCEDURE DIVISION of a get property or set property method is missing a required parameter. An alphanumeric item of 1 character is assumed.

Explanation

Only the RETURNING phrase is specified in the procedure division header of the get property method definition (method definition to specify the GET phrase for the METHOD-ID paragraph).

A USING phrase with only one parameter is specified in the procedure division header of the set property method definition (method definition to specify the SET phrase for the METHOD-ID paragraph).

JMN5538I-S

Only one @2@ parameter can be specified in a PROCEDURE DIVISION for a method definition with a @1@ phrase.

Parameter explanation

@1@ : GET or SET.

@2@ : USING or RETURNING.

Example

[C5538.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5538.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 01 W5538       PIC S9(4) COMP-5.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     SET PROPERTY PR5538.
000012 DATA           DIVISION.
000013 LINKAGE        SECTION.
000014 01  LK1        PIC S9(4) COMP-5.
000015 01  LK2        PIC S9(4) COMP-5.
000016 PROCEDURE      DIVISION USING LK1
000017                         RETURNING LK2.
000018     MOVE LK1 TO W5538.
000019     EXIT METHOD.
000020 END METHOD.
000021 END OBJECT.
000022 END CLASS      C5538.

C5538.cob 11: JMN5538I-S Only one USING parameter can be specified in a PROCEDURE DIVISION for a method definition with a SET phrase.

Explanation

Only the RETURNING phrase is specified in the procedure division header of the get property method definition (method definition to specify the GET phrase for the METHOD-ID paragraph).

A USING phrase with only one parameter is specified in the procedure division header of the set property method definition (method definition to specify the SET phrase for the METHOD-ID paragraph).

JMN5539I-S

The identifier used to invoke a method in an in-line method invocation must be an object reference identifier. The in-line method invocation is ignored.

Example

[C5539.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5539.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 DATA           DIVISION.
000007 WORKING-STORAGE SECTION.
000008 01 PR5539         PIC S9(4) COMP-5 PROPERTY.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5539.
000012 DATA           DIVISION.
000013 LINKAGE        SECTION.
000014 01  LK1        PIC X(8).
000015 PROCEDURE      DIVISION RETURNING LK1.
000016     MOVE PR5539 OF SELF :: "M5539" TO LK1.
000017     EXIT METHOD.
000018 END METHOD     M5539.
000019 END OBJECT.
000020 END CLASS      C5539.

C5539.cob 16: JMN5539I-S The identifier used to invoke a method in an in-line method invocation must be an object reference identifier. The in-line method invocation is ignored.

Explanation

The object with the target procedure (method) is identified by the object identifier specified just before the invocation operator (a pair of adjacent colon characters '::').

JMN5540I-S

An object modifier cannot be specified for predefined object identifier SUPER or NULL.

Example

[C5540A.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5540A.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5540.
000008 PROCEDURE      DIVISION.
000009 END METHOD     M5540.
000010 END OBJECT.
000011 END CLASS      C5540A.
[C5540.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5540  INHERITS FJBASE.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS  C5540A
000007     CLASS  FJBASE.
000008 IDENTIFICATION  DIVISION.
000009 OBJECT.
000010 DATA            DIVISION.
000011 WORKING-STORAGE SECTION.
000012 PROCEDURE       DIVISION.
000013 IDENTIFICATION  DIVISION.
000014 METHOD-ID.      M5540.
000015 DATA            DIVISION.
000016 WORKING-STORAGE SECTION.
000017 01 OBJ          OBJECT REFERENCE.
000018 PROCEDURE       DIVISION.
000019     SET OBJ TO SUPER AS C5540A.
000020 END METHOD      M5540.
000021 END OBJECT.
000022 END CLASS       C5540.

C5540.cob 19: JMN5540I-S An object modifier cannot be specified for predefined object identifier SUPER or NULL.

Explanation

An object modifier specifies that the identifier type in front of AS is considered to be a type specified after AS.

Predefined object identifiers SUPER and NULL cannot be considered another type.

JMN5541I-S

An object modifier must be a specified class-name or universal. Universal is assumed.

Example

[C5541.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5541.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5541.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 WOBR        OBJECT REFERENCE FJBASE.
000015 01 WCLS        PIC X(6) VALUE "FJBASE".
000016 PROCEDURE      DIVISION.
000017     SET WOBR TO SELF AS WCLS
000018 END METHOD     M5541.
000019 END OBJECT.
000020 END CLASS      C5541.

C5541.cob 17: JMN5541I-S An object modifier must be a specified class-name or universal. Universal is assumed.

Explanation

The class-name or UNIVERSAL must be specified after AS of the object modifier.

JMN5542I-S

@1@ cannot be used to invoke a method in an in-line method invocation or as the object in an object property.

Parameter explanation

@1@ : predefined object identifier NULL.

Example

[C5542.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5542  INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS  FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5542.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 WRT         PIC X(1).
000015 LINKAGE         SECTION.
000016 01 LK1         OBJECT REFERENCE FJBASE.
000017 01 LK2         PIC X(1).
000018 PROCEDURE      DIVISION
000019                 USING     LK1
000020                 RETURNING LK2.
000021     MOVE SELF :: "M5542" (NULL :: "NEW")
000022                   TO WRT.
000023 END METHOD     M5542.
000024 END OBJECT.
000025 END CLASS      C5542.

C5542.cob 21: JMN5542I-S Predefined object identifier NULL cannot be used to invoke a method in an in-line method invocation or as the object in an object property.

JMN5543I-S

The identifier in @1@ must be the object reference that refers to the class specified in the REPOSITORY paragraph.

Parameter explanation

@1@ : In-line method invocation or object property.

Example

[C5543.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5543.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5543.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WOBR        USAGE OBJECT REFERENCE.
000011 01 WDA1        PIC X(20).
000012 PROCEDURE      DIVISION.
000013     MOVE WOBR :: "GETNAME" TO WDA1.
000014 END METHOD     M5543.
000015 END OBJECT.
000016 END CLASS      C5543.

C5543.cob 13: JMN5543I-S The identifier in in-line method invocation must be the object reference that refers to the class specified in the REPOSITORY paragraph.

JMN5544I-S

Only a PROCEDURE DIVISION header can be specified in the PROCEDURE DIVISION of @1@.

Parameter explanation

@1@ : Method prototype definition.

Example

[C5544.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5544.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 PROCEDURE      DIVISION.
000007 IDENTIFICATION DIVISION.
000008 METHOD-ID.        M5544 PROTOTYPE.
000009 DATA           DIVISION.
000010 LINKAGE         SECTION.
000011 01  LK1        PIC X(4).
000012 PROCEDURE      DIVISION RETURNING LK1.
000013     EXIT METHOD.
000014 END METHOD     M5544.
000015 END OBJECT.
000016 END CLASS      C5544.

C5544.cob 12: JMN5544I-S Only a PROCEDURE DIVISION header can be specified in the PROCEDURE DIVISION of method prototype definition.

JMN5545I-S

The USE FOR DEAD-LOCK statement can only be specified in a program definition.

Example

[C5545.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5545.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5545.
000008 PROCEDURE      DIVISION.
000009 DECLARATIVES.
000010 DEAD-LOCK-ERR SECTION.
000011     USE FOR DEAD-LOCK
000012     DISPLAY "**********  Result  NG  **********" .
000013 END DECLARATIVES.
000014 END METHOD     M5545.
000015 END OBJECT.
000016 END CLASS      C5545.

C5545.cob 11: JMN5545I-S The USE FOR DEAD-LOCK statement can only be specified in a program definition.

JMN5546I-S

The interface for method '@1@' must conform to that of the overridden method. Method '@1@' is ignored.

Parameter explanation

@1@ : Method name which causes error.

Example

[C5546A.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5546A.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5546.
000008 DATA           DIVISION.
000009 LINKAGE         SECTION.
000010 01 LK1         PIC X(2).
000011 PROCEDURE      DIVISION RETURNING LK1.
000012 END METHOD     M5546.
000013 END OBJECT.
000014 END CLASS      C5546A.
[C5546.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5546 INHERITS C5546A.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5546A.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5546 OVERRIDE.
000012 DATA           DIVISION.
000013 LINKAGE         SECTION.
000014 01 LK1         PIC X(2).
000015 PROCEDURE      DIVISION USING LK1.
000016 END METHOD     M5546.
000017 END OBJECT.
000018 END CLASS      C5546.

C5546.cob 11: JMN5546I-S The interface for method 'M5546' must conform to that of the overridden method. Method 'M5546' is ignored.

Explanation

The procedure division header of the method definition that specifies the OVERRIDE phrase must define the same parameter interface as the overwritten method of the parent class.

JMN5547I-S

There is no PROCEDURE DIVISION header in @1@. A PROCEDURE DIVISION header is assumed.

Parameter explanation

@1@ : Factory definition or object definition.

Example

[C5547.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5547.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 IDENTIFICATION DIVISION.
000006 METHOD-ID.     M5547.
000007 DATA           DIVISION.
000008 LINKAGE         SECTION.
000009 01 LK1         PIC X(10).
000010 PROCEDURE      DIVISION RETURNING LK1.
000011 END METHOD     M5547.
000012 END OBJECT.
000013 END CLASS      C5547.

C5547.cob 6: JMN5547I-S There is no PROCEDURE DIVISION header in object definition. A PROCEDURE DIVISION header is assumed.

Explanation

In a class definition, method definitions follow a PROCEDURE DIVISION header.

JMN5548I-S

The class-name specified in the RAISING phrase of the PROCEDURE DIVISION header must have the same specifier as defined in the prototype method. It is accepted as written.

Example

[C5548.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5548 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5548 PROTOTYPE.
000012 DATA           DIVISION.
000013 PROCEDURE      DIVISION
000014                   RAISING FJBASE.
000015 END METHOD     M5548.
000016 END OBJECT.
000017 END CLASS      C5548.
[M5548.cob]
000001 IDENTIFICATION DIVISION.
000002 METHOD-ID.     M5548 OF C5548.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5548.
000007 DATA           DIVISION.
000008 PROCEDURE      DIVISION
000009                   RAISING C5548.
000010 END METHOD     M5548.

M5548.cob 2: JMN5548I-S The class-name specified in the RAISING phrase of the PROCEDURE DIVISION header must have the same specifier as defined in the prototype method. It is accepted as written.

Explanation

The class-name specified for the RAISING phrase of the procedure division header of a separate method definition should be the same as the class-name specified for the RAISING phrase of the procedure division header of the method prototype definition (definition that specifies the PROTOTYPE phrase for the METHOD-ID paragraph) corresponding to this method definition.

JMN5549I-S

Only the method definition can be specified in the PROCEDURE DIVISION of @1@.

Parameter explanation

@1@ : Factory definition or object definition.

Example

[C5549.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5549.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006     DISPLAY "OBJECT DEFINITION".
000007 END OBJECT.
000008 END CLASS      C5549.

C5549.cob 5: JMN5549I-S Only the method definition can be specified in the PROCEDURE DIVISION of object definition.

JMN5550I-S

'@2@' specified in a @1@ statement cannot be specified in a USING phrase. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE or CALL.

@2@ : Word that causes the error specified for @1@.

Example

[P5550.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5550.
000003 ENVIRONMENT    DIVISION.
000004 INPUT-OUTPUT    SECTION.
000005 FILE-CONTROL.
000006     SELECT SQFILE1 ASSIGN TO SYS001.
000007 I-O-CONTROL.
000008 DATA           DIVISION.
000009 FILE            SECTION.
000010 FD SQFILE1.
000011 01 SQF1REC.
000012   02           PIC X(80).
000013 WORKING-STORAGE SECTION.
000014 01 WOBR        OBJECT REFERENCE.
000015 PROCEDURE      DIVISION.
000016     INVOKE WOBR "M5550" USING SQFILE1.
000017 END PROGRAM    P5550.

P5550.cob 16: JMN5550I-S 'SQFILE1' specified in a INVOKE statement cannot be specified in a USING phrase. The INVOKE statement is ignored.

JMN5551I-S

A literal, predefined object identifier, or class-name cannot be specified for the BY REFERENCE phrase of the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE or CALL.

Example

[P5551.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5551.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE.
000010 PROCEDURE      DIVISION.
000011     INVOKE WOBR "M5551" USING BY REFERENCE 123.
000012 END PROGRAM    P5551.

P5551.cob 11: JMN5551I-S A literal, predefined object identifier, or class-name cannot be specified for the BY REFERENCE phrase of the INVOKE statement. The INVOKE statement is ignored.

JMN5552I-S

A conditional phrase cannot be specified in the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE.

Example

[P5552.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5552.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 WOBR        OBJECT REFERENCE.
000006 PROCEDURE      DIVISION.
000007     INVOKE WOBR "M5552"
000008        ON EXCEPTION DISPLAY "NG".
000009     INVOKE WOBR "M5552"
000010        ON OVERFLOW DISPLAY "NG".
000011 END PROGRAM    P5552.

P5552.cob 7: JMN5552I-S A conditional phrase cannot be specified in the INVOKE statement. The INVOKE statement is ignored.

P5552.cob 9: JMN5552I-S A conditional phrase cannot be specified in the INVOKE statement. The INVOKE statement is ignored.

Explanation

In this example, the conditional phrases are ON OVERFLOW and ON EXCEPTION.

JMN5553I-S

The ordinal position of the USING phrase for the @1@ statement is invalid. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE.

Example

[P5553.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5553.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 WOBR        OBJECT REFERENCE.
000006 01 WPR1        PIC X(08).
000007 01 WRT         PIC X(08).
000008 PROCEDURE      DIVISION.
000009     INVOKE WOBR "M5553" RETURNING WRT
000010                         USING     WPR.
000011 END PROGRAM    P5553.

P5553.cob 10: JMN5553I-S The ordinal position of the USING phrase for the INVOKE statement is invalid. The INVOKE statement is ignored.

Explanation

The USING phrase cannot be specified after the RETURNING phrase.

JMN5555I-S

[Solaris][Linux]
The RETURNING phrase identifier for the @1@ statement must be defined in a file, WORKING-STORAGE, or LINKAGE SECTION. The @1@ statement is ignored.

[Linux64]
The RETURNING phrase identifier for the @1@ statement must be defined in the FILE, WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE | CALL

Example

[P5555.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5555.
000003 DATA           DIVISION.
000004 WORKING-STORAGE SECTION.
000005 01 WOBR        OBJECT REFERENCE.
000006 CONSTANT       SECTION.
000007 01 CNST-DATA   PIC X(10) VALUE "XXX".
000008 PROCEDURE      DIVISION.
000009     INVOKE WOBR "M5555" RETURNING CNST-DATA.
000010 END PROGRAM    P5555.
  • [Solaris][Linux]

    P5555.cob 9: JMN5555I-S The RETURNING phrase identifier for the INVOKE statement must be defined in a file, WORKING-STORAGE, or LINKAGE SECTION. The INVOKE statement is ignored.

  • [Linux64]

    P5555.cob 9: JMN5555I-S The RETURNING phrase identifier for the INVOKE statement must be defined in the FILE, WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION. The INVOKE statement is ignored.

JMN5556I-S

The method result for the identifier in the INVOKE statement must be the object identifier.

Example

[C5556.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5556.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5556A.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 LINKAGE         SECTION.
000011 01 LK1         OBJECT REFERENCE C5556.
000012 PROCEDURE      DIVISION RETURNING LK1.
000013 END METHOD     M5556A.
000014 IDENTIFICATION DIVISION.
000015 METHOD-ID.     M5556B.
000016 ENVIRONMENT    DIVISION.
000017 DATA           DIVISION.
000018 LINKAGE         SECTION.
000019 01 LK1         PIC X(10).
000020 PROCEDURE      DIVISION RETURNING LK1.
000021 END METHOD     M5556B.
000022 END OBJECT.
000023 END CLASS    C5556.
[P5556.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5556.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5556.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE C5556.
000010 PROCEDURE      DIVISION.
000011*
000012     INVOKE WOBR::"M5556A" "M5556B".
000013*
000014     INVOKE WOBR::"M5556B" "M5556A".
000015 END PROGRAM      P5556.

P5556.cob 14: JMN5556I-S The method result for the identifier in the INVOKE statement must be the object identifier.

Explanation

This diagnostic message is output when an in-line method invocation does not return an object reference or such the object property is specified for an identifier just after INVOKE.

JMN5557I-S

The interface for the separate method definition must conform to that for the method prototype.

Example

[C5557.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5557.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 PROCEDURE      DIVISION.
000007 IDENTIFICATION DIVISION.
000008 METHOD-ID.     M5557 PROTOTYPE.
000009 DATA           DIVISION.
000010 LINKAGE        SECTION.
000011 01 LK1         PIC 9(4).
000012 PROCEDURE      DIVISION USING LK1.
000013 END METHOD     M5557.
000014 END OBJECT.
000015 END CLASS      C5557.
[M5557.cob]
000001 IDENTIFICATION DIVISION.
000002 METHOD-ID.     M5557 OF  C5557.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005  REPOSITORY.
000006     CLASS  C5557.
000007 DATA           DIVISION.
000008 PROCEDURE      DIVISION.
000009     DISPLAY "NOT CONFORM".
000010 END METHOD     M5557.

M5557.cob 2: JMN5557I-S The interface for the separate method definition must conform to that for the method prototype.

Explanation

The following should match in the procedure division headers of the separate method definition and the method prototype definition corresponding to it:

  • Presence of USING phrase and RETURNING phrase

  • Number of USING parameters, and attribute of each parameter at the corresponding position in order of the parameter specified for USING phrase

JMN5559I-S

The RETURNING phrase cannot be specified in the program definition PROCEDURE DIVISION containing an ENTRY statement. The RETURNING phrase is ignored.

Example

[P5559.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5559.
000003 ENVIRONMENT    DIVISION.
000004 DATA           DIVISION.
000005 LINKAGE        SECTION.
000006 01 LK1         PIC X(8).
000007 01 LK2         PIC S9(8) BINARY.
000008 PROCEDURE      DIVISION
000009                RETURNING LK1.
000010     DISPLAY "MAIN ENTRY"
000011     EXIT PROGRAM.
000012     ENTRY "P5559SUB".
000013     DISPLAY "SECONDARY ENTRY".
000014     EXIT PROGRAM.
000015 END PROGRAM    P5559.

P5559.cob 8: JMN5559I-S The RETURNING phrase cannot be specified in the program definition PROCEDURE DIVISION containing an ENTRY statement. The RETURNING phrase is ignored.

JMN5560I-S

Method-name '@2@' specified in @1@ is undefined in the parent class or the class that is inherited in the parent class. @1@ is ignored.

Parameter explanation

@1@ : INVOKE statement or in-line method invocation

@2@ : Method name that caused the error.

Example

[C5560.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5560 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.        M5560.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 WX          PIC X(4).
000015 PROCEDURE      DIVISION.
000016     INVOKE SUPER "M5560".
000017 END METHOD        M5560.
000018 END OBJECT.
000019 END CLASS         C5560.

C5560.cob 16: JMN5560I-S Method-name 'M5560' specified in INVOKE statement is undefined in the parent class or the class that is inherited in the parent class. INVOKE statement is ignored.

Explanation

The predefined object identifier SUPER indicates the parent class. When the predefined object identifier SUPER is used for the method invoking, the invoked method should exist in the ancestor class (the class of the parent class or the class that the parent class inherits from).

JMN5561I-S

The method-name specified in an in-line method invocation must be a nonnumeric literal or a national character literal. The in-line method invocation is ignored.

Example

[C5561.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5561.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5561.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WMETNM      PIC X(8).
000011 01 WX          PIC X(4).
000012 PROCEDURE      DIVISION.
000013     MOVE SELF :: WMETNM TO WX.
000014 END METHOD     M5561.
000015 END OBJECT.
000016 END CLASS     C5561.

C5561.cob 13: JMN5561I-S The method-name specified in an in-line method invocation must be a nonnumeric literal or a national character literal. The in-line method invocation is ignored.

JMN5562I-S

@1@ cannot be specified as an argument of @2@.

Parameter explanation

@1@ : In-line method invocation, object property, identifier with object modifier, arithmetic expression or function name that causes the error.

@2@ : In-line method invocation, FUNCTION ADDR, FUNCTION LENG, or FUNCTION LENGTH

Example

[C5562.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5562.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5562.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WX          PIC X(4).
000011 LINKAGE         SECTION.
000012 01 LX1         PIC X(4).
000013 01 LX2         PIC X(4).
000014 PROCEDURE      DIVISION
000015                  USING     LX1
000016                  RETURNING LX2.
000017     MOVE SELF :: "M5562" (SELF :: "M5562"(WX)) TO WX.
000018 END METHOD     M5562.
000019 END OBJECT.
000020 END CLASS      C5562.

C5562.cob 17: JMN5562I-S In-line method invocation cannot be specified as an argument of in-line method invocation.

JMN5563I-S

@1@ cannot be specified as the @2@ identifier.

Parameter explanation

@1@ : In-line method invocation or object property.

@2@ : ADDRESS OF or LENGTH OF.

Example

[C5563.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.         C5563.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.        M5563.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WPX         POINTER.
000011 LINKAGE         SECTION.
000012 01 LX1         PIC X(4).
000013 01 LX2         PIC X(4).
000014 PROCEDURE      DIVISION
000015                  USING LX1
000016                  RETURNING LX2.
000017     SET WPX TO ADDRESS OF SELF :: "M5563"(LX1).
000018 END METHOD     M5563.
000019 END OBJECT.
000020 END CLASS      C5563.

C5563.cob 17: JMN5563I-S In-line method invocation cannot be specified as the ADDRESS OF identifier.

JMN5564I-S

Property-name '@1@' is @2@.

Parameter explanation

@1@ : Property name that causes the error.

@2@ : undefined or multi-defined.

Example

[C5564.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5564.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5564.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WX          PIC X(4).
000011 LINKAGE         SECTION.
000012 01 LX1         PIC X(4).
000013 01 LX2         PIC X(4).
000014 PROCEDURE      DIVISION
000015                  USING LX1
000016                  RETURNING LX2.
000017     MOVE PR5564 OF SELF TO WX.
000018 END METHOD     M5564.
000019 END OBJECT.
000020 END CLASS      C5564.

C5564.cob 17: JMN5564I-S Property-name 'PR5564' is undefined.

JMN5565I-S

[Solaris][Linux]
The data item for the argument of the in-line method invocation must be defined in the FILE SECTION, WORKING-STORAGE SECTION or LINKAGE SECTION.

[Linux64]
The data item for the argument of the in-line method invocation must be defined in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION.

Example

[C5565.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID       C5565.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5565.
000008 DATA           DIVISION.
000009 LINKAGE         SECTION.
000010 01 LK1         PIC X(6).
000011 01 LK2         PIC X(8).
000012 PROCEDURE      DIVISION USING LK1
000013                         RETURNING LK2.
000014 END METHOD     M5565.
000015 END OBJECT.
000016 END CLASS      C5565.
[P5565.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5565.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5565.
000007 INPUT-OUTPUT    SECTION.
000008 FILE-CONTROL.
000009     SELECT REPFILE ASSIGN TO SYS001.
000010 DATA           DIVISION.
000011 FILE            SECTION.
000012 FD REPFILE REPORT IS REP1.
000013 WORKING-STORAGE SECTION.
000014 01 YYMMDD      PIC X(6).
000015 01 YYYYMMDD    PIC X(8).
000016 01 WOBR        OBJECT REFERENCE C5565.
000017 REPORT          SECTION.
000018 RD REP1 PAGE 66
000019         FIRST DETAIL 6.
000020 01 PH-ITEM TYPE PH.
000021   02 LINE 2.
000022     03 DATA1   COLUMN 50 PIC X(6) SOURCE YYMMDD.
000023 PROCEDURE      DIVISION.
000024     MOVE WOBR :: "M5565"(DATA1) TO YYYYMMDD
000025 END PROGRAM    P5565.
  • [Solaris][Linux]

    P5565.cob 24: JMN2691I-S 'DATA1' in the REPORT SECTION cannot be referred in the PROCEDURE DIVISION.

    P5565.cob 24: JMN5565I-S The data item for the argument of the in-line method invocation must be defined in the FILE SECTION, WORKING-STORAGE SECTION or LINKAGE SECTION.

  • [Linux64]

    P5565.cob 24: JMN2691I-S 'DATA1' in the REPORT SECTION cannot be referred in the PROCEDURE DIVISION.

    P5565.cob 24: JMN5565I-S The data item for the argument of the in-line method invocation must be defined in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION.

JMN5566I-S

[Solaris][Linux]
The in-line method invocation argument must be one of the following: SELF, EXCEPTION-OBJECT, NULL, the class name that is specified in the REPOSITORY paragraph, the data-item in the FILE SECTION, WORKING-STORAGE SECTION or LINKAGE SECTION, or the literal.

[Linux64]
The in-line method invocation argument must be one of the following: SELF, EXCEPTION-OBJECT, NULL, the class name that is specified in the REPOSITORY paragraph, the data-item in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION, or the literal.

Example

[C5566.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5566.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5566.
000008 ENVIRONMENT    DIVISION.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 01 WGP.
000012   02 WOCC      PIC X(1) OCCURS 10 INDEXED BY IX1.
000013 LINKAGE         SECTION.
000014 01 LK1         PIC S9(9) COMP-5.
000015 01 LK2         PIC X(9).
000016 PROCEDURE      DIVISION USING LK1
000017                         RETURNING LK2.
000018     MOVE SELF :: "M5566" (IX1) TO LK2.
000019 END METHOD     M5566.
000020 END OBJECT.
000021 END CLASS      C5566.
  • [Solaris][Linux]

    C5566.cob 18: JMN5566I-S The in-line method invocation argument must be one of the following: SELF, EXCEPTION-OBJECT, NULL, the class name that is specified in the REPOSITORY paragraph, the data-item in the FILE SECTION, WORKING-STORAGE SECTION or LINKAGE SECTION, or the literal.

    C5566.cob 18: JMN3430I-S The parameter number specified in the USING phrase of the INVOKE statement or in-line invocation must be the same parameter number specified in the USING phrase of the PROCEDURE DIVISION.

  • [Linux64]

    C5566.cob 18: JMN5566I-S The in-line method invocation argument must be one of the following: SELF, EXCEPTION-OBJECT, NULL, the class name that is specified in the REPOSITORY paragraph, the data-item in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION, or the literal.

    C5566.cob 18: JMN3430I-S The parameter number specified in the USING phrase of the INVOKE statement or in-line invocation must be the same parameter number specified in the USING phrase of the PROCEDURE DIVISION.

JMN5567I-S

A class-name used as an argument in the in-line method invocation cannot be the class-name of a special class.

Example

[C5567.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5567.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS EXCEL AS "*OLE".
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.     M5567A.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 PROCEDURE      DIVISION.
000015     DISPLAY SELF :: "M5567B" (EXCEL)
000016 END METHOD     M5567A.
000017 IDENTIFICATION DIVISION.
000018 METHOD-ID.     M5567B.
000019 DATA           DIVISION.
000020 LINKAGE         SECTION.
000021 01 WOBJ        OBJECT REFERENCE.
000022 01 WRTSTR      PIC X(2).
000023 PROCEDURE      DIVISION
000024                USING WOBJ
000025                RETURNING WRTSTR.
000026 END METHOD     M5567B.
000027 END OBJECT.
000028 END CLASS      C5567.

C5567.cob 15: JMN5567I-S A class-name used as an argument in the in-line method invocation cannot be the class-name of a special class.

Explanation

If the literal of a class-specifier in the repository paragraph of the environment division is listed below, the class-name is a special class name.

  • "*COM" (or "*OLE")

  • "*COM-ARRAY" (or "*OLE-ARRAY")

  • "*COM-EXCEPTION" ( or "*OLE-EXCEPTION")

  • "*COB-BINDTABLE"

  • "*COM:COM server name:COM class name" (COM server name = arbitrary name used for association with a type library, COM class name = dispinterface name or coclass name)

JMN5568I-S

The @1@ statement for screen handling can only be used in the program definition.

Parameter explanation

@1@ : ACCEPT or DISPLAY.

Example

[C5568.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5568.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5568.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 PROCEDURE      DIVISION.
000011     DISPLAY "SRCEEN FUNCTION" UPON CRT.
000012 END METHOD        M5568.
000013 END OBJECT.
000014 END CLASS         C5568.

C5568.cob 11: JMN5568I-S The DISPLAY statement for screen handling can only be used in the program definition.

JMN5569I-S

The GLOBAL phrase cannot be specified in a USE statement with a class-name. The GLOBAL phrase is ignored.

Example

[C5569.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5569.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 PROCEDURE DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5569.
000011 DATA           DIVISION.
000012 WORKING-STORAGE SECTION.
000013 01 WX          PIC X(4).
000014 LINKAGE         SECTION.
000015 PROCEDURE      DIVISION.
000016 DECLARATIVES.
000017 ERR1 SECTION. USE GLOBAL AFTER EXCEPTION C5569.
000018     DISPLAY "ERROR SECTION".
000019 END DECLARATIVES.
000020 END METHOD     M5569.
000021 END OBJECT.
000022 END CLASS      C5569.

C5569.cob 17: JMN5569I-S The GLOBAL phrase cannot be specified in a USE statement with a class-name. The GLOBAL phrase is ignored.

JMN5570I-S

An object modifier cannot be specified for a special class or for an object reference identifier that refers to a special class except an early-binding special class and '*COM(*OLE)'.

Example

[C5570.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5570.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS  FJBASE
000007     CLASS  BNDTBL-CL AS "*COB-BINDTABLE".
000008 IDENTIFICATION DIVISION.
000009 OBJECT.
000010 PROCEDURE      DIVISION.
000011 IDENTIFICATION DIVISION.
000012 METHOD-ID.     M5570.
000013 DATA           DIVISION.
000014 WORKING-STORAGE SECTION.
000015 01 WOBR1       OBJECT REFERENCE.
000016 01 WOBR2       OBJECT REFERENCE BNDTBL-CL.
000017 PROCEDURE      DIVISION.
000018     SET WOBR1 TO  WOBR2 AS FJBASE.
000019 END METHOD     M5570.
000020 END OBJECT.
000021 END CLASS      C5570.

C5570.cob 18: JMN5570I-S An object modifier cannot be specified for a special class or for an object reference identifier that refers to a special class except an early-binding special class and '*COM(*OLE)'.

Explanation

An object modifier specifies that the identifier type specified in front of AS is considered to be a type specified after AS.

A special object (the OLE object, etc.) is not a COBOL object. An object modifier cannot specify a special object except for special objects that refer to the following classes.

Class in which the value of the literal in the class specifier in the REPOSITORY paragraph of the environment division is:

  • "*COM" (or "*OLE")

  • "*COM:COM server name:COM class name" (COM server name = user-defined name used for association with a type library, COM class name = dispinterface name or coclass name)

JMN5571I-S

The class-name specified with the object modifier cannot be the class-name of a special class. Universal is assumed.

Example

[C5571.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5571.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS COM AS "*COM".
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 PROCEDURE      DIVISION.
000010 IDENTIFICATION DIVISION.
000011 METHOD-ID.        M5571.
000012 DATA           DIVISION.
000013 WORKING-STORAGE SECTION.
000014 01 WOBR1       OBJECT REFERENCE.
000015 01 WOBR2       OBJECT REFERENCE COM.
000016 PROCEDURE      DIVISION.
000017     SET WOBR2 TO  WOBR1 AS COM.
000018 END METHOD     M5571.
000019 END OBJECT.
000020 END CLASS      C5571.

C5571.cob 17: JMN5571I-S The class-name specified with the object modifier cannot be the class-name of a special class. Universal is assumed.

Explanation

The class-names of a special class other than the class-name of an early bind special class cannot be specified after the AS phrase of an object modifier.

JMN5572I-S

The object reference identifier in @1@ cannot refer to a special class.

Parameter explanation

@1@ : In-line method invocation or object property.

Example

[C5572.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.            C5572.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS SPL-CL AS "*OLE".
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 01 OBJB        OBJECT REFERENCE.
000012 01 OBJX        OBJECT REFERENCE SPL-CL.
000013 PROCEDURE      DIVISION.
000014 IDENTIFICATION DIVISION.
000015 METHOD-ID.        M5572A.
000016 DATA           DIVISION.
000017 WORKING-STORAGE SECTION.
000018 01 WRST        PIC X(2).
000019 PROCEDURE      DIVISION.
000020     MOVE  OBJX :: "M5572B" (OBJX) TO WRST.
000021 END METHOD        M5572A.
000022 IDENTIFICATION DIVISION.
000023 METHOD-ID.        M5572B.
000024 DATA           DIVISION.
000025 LINKAGE         SECTION.
000026 01 WOBJ        OBJECT REFERENCE.
000027 01 WRTSTR      PIC X(2).
000028 PROCEDURE      DIVISION
000029                USING WOBJ
000030                RETURNING WRTSTR.
000031     IF WOBJ NOT = NULL THEN
000032       MOVE "OK" TO WRTSTR
000033     ELSE
000034       MOVE "NG" TO WRTSTR
000035     END-IF.
000036 END METHOD        M5572B.
000037 END OBJECT.
000038 END CLASS         C5572.

C5572.cob 20: JMN5572I-S The object reference identifier in in-line method invocation cannot refer to a special class.

Explanation

If the literal of a class-specifier in the repository paragraph of the environment division is listed below, the class-name is a special class name.

  • "*COM" (or "*OLE")

  • "*COM-ARRAY" (or "*OLE-ARRAY")

  • "*COM-EXCEPTION" ( or "*OLE-EXCEPTION")

  • "*COB-BINDTABLE"

  • "*COM:COM server name:COM class name" (COM server name = arbitrary name used for association with a type library, COM class name = dispinterface name or coclass name)

JMN5573I-S

The file organization is mismatched. The WRITE statement with the ADVANCING phrase is ignored.

Example

[C5573.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5573.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 ENVIRONMENT    DIVISION.
000006 INPUT-OUTPUT   SECTION.
000007 FILE-CONTROL.
000008     SELECT OUTFILE ASSIGN TO SYS001.
000009 DATA           DIVISION.
000010 FILE           SECTION.
000011  FD OUTFILE.
000012  01 OUTDATA  PIC X(80).
000013 WORKING-STORAGE SECTION.
000014 PROCEDURE      DIVISION.
000015 IDENTIFICATION DIVISION.
000016 METHOD-ID.     M5573 PROTOTYPE.
000017 PROCEDURE      DIVISION.
000018 END METHOD     M5573.
000019 END OBJECT.
000020 END CLASS      C5573.
[M5573.cob]
000001 IDENTIFICATION DIVISION.
000002 METHOD-ID.     M5573 OF C5573.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5573.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009  01 DATAM      PIC X(80).
000010 PROCEDURE      DIVISION.
000011     OPEN OUTPUT OUTFILE.
000012     MOVE "FILE ERROR" TO DATAM.
000013     WRITE OUTDATA FROM DATAM AFTER ADVANCING 10 LINE.
000014     CLOSE  OUTFILE.
000015     EXIT METHOD.
000016 END METHOD     M5573.

M5573.cob 13: JMN5573I-S The file organization is mismatched. The WRITE statement with the ADVANCING phrase is ignored.

Explanation

In the procedure division of the separate method definition (the method definition that is not included in the class definition), it is necessary to meet either of the following requirements if the ADVANCING phrase is written in the WRITE statement of the file declared in the factory definition or the object definition.

  • PRINTER or PRINTER-n (n is an integer to 1-9) is specified by the ASSIGN phrase for the file.

  • The WRITE statement with the ADVANCING phrase for the file is written by the procedure of the source unit in which the file is declared.

  • The file is a print file with the FORMAT clause.

JMN5574I-S

The special class class-name cannot be specified in the USING phrase of the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE.

Example

[P5574.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5574.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS COM AS "*COM".
000007 DATA DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR1        OBJECT REFERENCE.
000010 PROCEDURE DIVISION.
000011     INVOKE WOBR1 "XX" USING COM.
000012 END PROGRAM    P5574.

P5574.cob 11: JMN5574I-S The special class class-name cannot be specified in the USING phrase of the INVOKE statement. The INVOKE statement is ignored.

JMN5575I-S

The predefined object identifier NULL cannot be use as an object identifier for the INVOKE statement.

Example

[P5575.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5575.
000003 DATA DIVISION.
000004 WORKING-STORAGE SECTION.
000005 PROCEDURE DIVISION.
000006     INVOKE NULL "M5575".
000007 END PROGRAM    P5575.

P5575.cob 6: JMN5575I-S The predefined object identifier NULL cannot be use as an object identifier for the INVOKE statement.

JMN5576I-S

[Solaris][Linux]
The USING phrase identifier for the @1@ statement must be defined in a file, WORKING-STORAGE or LINKAGE SECTION.

[Linux64]
The USING phrase identifier for the @1@ statement must be defined in the FILE, WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION.

Parameter explanation

@1@ : INVOKE | CALL.

Example

[C5576.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID       C5576.
000003 IDENTIFICATION DIVISION.
000004 OBJECT.
000005 PROCEDURE      DIVISION.
000006 IDENTIFICATION DIVISION.
000007 METHOD-ID.     M5576.
000008 DATA           DIVISION.
000009 LINKAGE         SECTION.
000010 01 LK1         PIC X(6).
000011 01 LK2         PIC X(8).
000012 PROCEDURE      DIVISION USING LK1
000013                         RETURNING LK2.
000014 END METHOD     M5576.
000015 END OBJECT.
000016 END CLASS      C5576.
[P5576.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5576.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5576.
000007 INPUT-OUTPUT    SECTION.
000008 FILE-CONTROL.
000009     SELECT REPFILE ASSIGN TO SYS001.
000010 DATA           DIVISION.
000011 FILE            SECTION.
000012 FD REPFILE REPORT IS REP1.
000013 WORKING-STORAGE SECTION.
000014 01 YYMMDD      PIC X(6).
000015 01 YYYYMMDD    PIC X(8).
000016 01 WOBR        OBJECT REFERENCE C5576.
000017 REPORT          SECTION.
000018 RD REP1 PAGE 66
000019         FIRST DETAIL 6.
000020 01 PH-ITEM TYPE PH.
000021   02 LINE 2.
000022     03 COLUMN 50 PIC X(6) SOURCE YYMMDD.
000023 PROCEDURE      DIVISION.
000024     INVOKE WOBR "M5576" USING PH-ITEM
000025                         RETURNING YYYYMMDD
000026 END PROGRAM    P5576.
  • [Solaris][Linux]

    P5576.cob 24: JMN2691I-S 'PH-ITEM' in the REPORT SECTION cannot be referred in the PROCEDURE DIVISION.

    P5576.cob 24: JMN5576I-S The USING phrase identifier for the INVOKE statement must be defined in a file, WORKING-STORAGE or LINKAGE SECTION.

  • [Linux64]

    P5576.cob 24: JMN2691I-S 'PH-ITEM' in the REPORT SECTION cannot be referred in the PROCEDURE DIVISION.

    P5576.cob 24: JMN5576I-S The USING phrase identifier for the INVOKE statement must be defined in the FILE, WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION.

JMN5578I-S

@1@ cannot be specified for the identifier in the SEARCH statement. It is ignored, and the compiler skips to the next AT END or WHEN phrase.

Parameter explanation

@1@ : In-line method invocation or identifier with object modifier.

Example

[P5578.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5578.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE.
000010 PROCEDURE      DIVISION.
000011     SEARCH WOBR AS FJBASE
000012        WHEN WOBR = NULL
000013          DISPLAY "END"
000014     END-SEARCH.
000015 END PROGRAM    P5578.

P5578.cob 11: JMN5578I-S Identifier with object modifier cannot be specified for the identifier in the SEARCH statement. It is ignored, and the compiler skips to the next AT END or WHEN phrase.

JMN5579I-S

@3@ cannot be specified for the @2@ phrase in the @1@ statement. The @2@ phrase is ignored.

Parameter explanation

@1@ : ACCEPT or DISPLAY.

@2@ : AT, LINE, COLUMN, SIZE or PROMPT.

@3@ : In-line method invocation, identifier with object modifier, object property, class-name, predefined object identifier SELF, predefined object identifier SUPER, predefined object identifier EXCEPTION-OBJECT or predefined object identifier NULL.

Example

[SYSEXP.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      SYSEXP.
000003 END CLASS      SYSEXP.
[P5579.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5579.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS SYSEXP.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WDA1.
000010   02 WDA11     PIC S9(4).
000011   02 WDA12     PIC S9(4).
000012   02 WDA13     PIC X(20).
000013 PROCEDURE      DIVISION.
000014 DECLARATIVES.
000015 ERR-1 SECTION. USE EXCEPTION SYSEXP.
000016     ACCEPT  WDA1 AT EXCEPTION-OBJECT
000017           ON EXCEPTION DISPLAY "NG in 1600 LINE".
000018 END DECLARATIVES.
000019 END PROGRAM    P5579.

P5579.cob 16: JMN5579I-S Predefined object identifier EXCEPTION-OBJECT cannot be specified for the AT phrase in the ACCEPT statement. The AT phrase is ignored.

JMN5580I-S

The @1@ statement can only be used in the program definition. The @1@ statement is ignored.

Parameter explanation

@1@ : ALTER, ENTER, ENTRY, GENERATE, GO TO MORE-LABELS, INITIATE, TERMINATE, SEEK, SUPPRESS, GOBACK, SERVICE-LAVEL, TRANSACTION or USE LABEL.

Example

[C5580.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5580.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 PROCEDURE      DIVISION.
000011 IDENTIFICATION DIVISION.
000012 METHOD-ID.     M5580.
000013 ENVIRONMENT    DIVISION.
000014 DATA           DIVISION.
000015 LINKAGE         SECTION.
000016 PROCEDURE      DIVISION.
000017     DISPLAY "M5580".
000018     GOBACK.
000019 END METHOD     M5580.
000020 END OBJECT.
000021 END CLASS      C5580.

C5580.cob 18: JMN5580I-S The GOBACK statement can only be used in the program definition. The GOBACK statement is ignored.

JMN5581I-S

@1@ can be used in the program definition. @1@ is ignored.

Parameter explanation

@1@ : STOP statement with literal, OPEN statement with REVERSE phrase or GO TO statement without a procedure-name.

Example

[C5581.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5581.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 PROCEDURE      DIVISION.
000007 IDENTIFICATION DIVISION.
000008 METHOD-ID.     M5581.
000009 ENVIRONMENT    DIVISION.
000010 DATA           DIVISION.
000011 WORKING-STORAGE SECTION.
000012 PROCEDURE      DIVISION.
000013     DISPLAY "TEST START".
000014     STOP    "Restart Now !".
000015     DISPLAY "TEST END".
000016 END METHOD     M5581.
000017 END OBJECT.
000018 END CLASS      C5581.

C5581.cob 14: JMN5581I-S STOP statement with literal can be used in the program definition. STOP statement with literal is ignored.

JMN5582I-S

Predefined object identifier SELF cannot be specified in the KEY phrase of a SORT or MERGE statement.

Example

[C5582.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5582 .
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5582.
000011 ENVIRONMENT    DIVISION.
000012 INPUT-OUTPUT    SECTION.
000013 FILE-CONTROL.
000014     SELECT SQFILE1 ASSIGN TO SYS001.
000015     SELECT SQFILE2 ASSIGN TO SYS002.
000016     SELECT SRFILE  ASSIGN TO SYS003.
000017 I-O-CONTROL.
000018 DATA           DIVISION.
000019 FILE            SECTION.
000020 FD SQFILE1.
000021 01 SQF1REC     PIC X(80).
000022 FD SQFILE2.
000023 01 SQF2REC     PIC X(80).
000024 SD SRFILE.
000025 01 SRFREC.
000026   02 SRKEY     PIC X(08).
000027   02           PIC X(72).
000028 LINKAGE         SECTION.
000029 PROCEDURE      DIVISION.
000030     OPEN INPUT  SQFILE1
000031          OUTPUT SQFILE2
000032     SORT SRFILE
000033          ON ASCENDING KEY SRKEY SELF
000034            USING    SQFILE1
000035            GIVING   SQFILE2.
000036     CLOSE SQFILE1 SQFILE2.
000037 END METHOD     M5582.
000038 END OBJECT.
000039 END CLASS      C5582.

C5582.cob 33: JMN5582I-S Predefined object identifier SELF cannot be specified in the KEY phrase of a SORT or MERGE statement.

JMN5583I-S

Special register @1@ can only be used in the program definition.

Parameter explanation

@1@ : PROGRAM-STATUS or RETURN-CODE.

Example

[C5583.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5583.
000003 ENVIRONMENT    DIVISION.
000004 IDENTIFICATION DIVISION.
000005 OBJECT.
000006 PROCEDURE      DIVISION.
000007 IDENTIFICATION DIVISION.
000008 METHOD-ID.     M5581.
000009 ENVIRONMENT    DIVISION.
000010 DATA           DIVISION.
000011 WORKING-STORAGE SECTION.
000012 PROCEDURE      DIVISION.
000013     DISPLAY PROGRAM-STATUS.
000014     DISPLAY RETURN-CODE.
000015 END METHOD     M5581.
000016 END OBJECT.
000017 END CLASS      C5583.

C5583.cob 13: JMN5583I-S Special register PROGRAM-STATUS can only be used in the program definition.

C5583.cob 14: JMN5583I-S Special register RETURN-CODE can only be used in the program definition.

Explanation

The special registers PROGRAM-STATUS (RETURN-CODE) are automatically created for programs that do not have the RETURNING phrase in the PROCEDURE DIVISION header. PROGRAM-STATUS and RETURN-CODE are synonymous. PROGRAM-STATUS is used to pass a return code to the operating system or to the program that called it.

JMN5584I-S

A predefined object identifier or class-name cannot be specified in the USING phrase of the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : CALL.

Example

[P5584.cob]
000001 IDENTIFICATION   DIVISION.
000002 PROGRAM-ID.      P5584.
000003 ENVIRONMENT      DIVISION.
000004 CONFIGURATION    SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 DATA            DIVISION.
000008 WORKING-STORAGE  SECTION.
000009 PROCEDURE       DIVISION.
000010     CALL "S5584" USING FJBASE.
000011 END PROGRAM      P5584.

P5584.cob 10: JMN5584I-S A predefined object identifier or class-name cannot be specified in the USING phrase of the CALL statement. The CALL statement is ignored.

JMN5585I-S

The object property cannot be specified in the RETURNING phrase of the @1@ statement.

Parameter explanation

@1@ : CALL or INVOKE.

Example

[C5585.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5585.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 PR5585      PIC S9(9) COMP-5 PROPERTY.
000011 PROCEDURE      DIVISION.
000012 IDENTIFICATION DIVISION.
000013 METHOD-ID.     M5585.
000014 DATA           DIVISION.
000015 LINKAGE         SECTION.
000016 01 LK1         PIC S9(9) COMP-5.
000017 PROCEDURE      DIVISION RETURNING LK1.
000018 END METHOD     M5585.
000019 END OBJECT.
000020 END CLASS      C5585.
[P5585.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5585.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5585.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR        OBJECT REFERENCE C5585.
000010 PROCEDURE      DIVISION.
000011     INVOKE WOBR "M5585"
000012                RETURNING PR5585 OF WOBR
000013 END PROGRAM    P5585.

P5585.cob 12: JMN5585I-S The object property cannot be specified in the RETURNING phrase of the INVOKE statement.

JMN5590I-S

[Solaris][Linux]
'@2@' is not usable for compile option @1@.

[Linux64]
'@2@' items are not valid for compile option @1@.

Parameter explanation

  • [Solaris][Linux]

    @1@ : THREAD(MULTI) | RCS(UTF16).

    @2@ : CMD | TRM | WST | CONNECT | DISCONNECT | ERASE | FIND | FINISH | GET | MODIFY | READY | STORE | IF DB-EXCEPTION | USE FOR DB-EXCEPTION | USE FOR DEAD-LOCK | TRANSACTION | JAPANESE | KANJI | DBCS or FUNCTION CAST-ALPHANUMERIC.

  • [Linux64]

    @1@ : THREAD(MULTI) | RCS(UTF16) | ENCODE | ENCODE(UTF8,UTF16) | ENCODE(UTF8,UTF32) | ENCODE(SJIS,SJIS).

    @2@ : CMD | TRM | WST | CONNECT | DISCONNECT | ERASE | FIND | FINISH | GET | MODIFY | READY | STORE | IF DB-EXCEPTION | USE FOR DBEXCEPTION | USE FOR DEAD-LOCK | TRANSACTION | JAPANESE | KANJI | DBCS | FUNCTION CAST-ALPHANUMERIC | FUNCTION NATIONAL-OF | UNICODE1 | BMP | SCREEN SECTION | ACCEPT statement and DISPLAY statement for screen handling.

Example

[P5590.cob]
000001 @OPTIONS RCS(UTF16)
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    P5590.
000004 ENVIRONMENT    DIVISION.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 WDA         PIC N(10).
000008 PROCEDURE      DIVISION.
000009     IF WDA IS KANJI THEN
000010       DISPLAY "KANJI"
000011     END-IF
000012 END PROGRAM    P5590.
  • [Solaris][Linux]

    P5590.cob 9: JMN5590I-S 'KANJI' is not usable for compile option RCS(UTF16).

  • [Linux64]

    P5590.cob 9: JMN5590I-S 'KANJI' items are not valid for compile option RCS(UTF16).

Explanation

In the program that uses an OSIV-series specific function, the following compiler options settings cannot be specified.

  • The runtime data codeset is set to Unicode by the RCS compiler option.

  • The generation of a multithread object is set by the THREAD compiler option.

JMN5591I-S

When an object reference in an INVOKE statement is an in-line method invocation or an object property, the object reference must refer to the class-name specified in the REPOSITORY paragraph.

Example

[C5591.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5591 INHERITS FJBASE.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS FJBASE.
000007 IDENTIFICATION DIVISION.
000008 OBJECT.
000009 DATA           DIVISION.
000010 WORKING-STORAGE SECTION.
000011 01 P5591       OBJECT REFERENCE FACTORY OF FJBASE
000012                PROPERTY.
000013 PROCEDURE      DIVISION.
000014 IDENTIFICATION DIVISION.
000015 METHOD-ID.     M5591.
000016 ENVIRONMENT    DIVISION.
000017 DATA           DIVISION.
000018 LINKAGE         SECTION.
000019 01 LK1         OBJECT REFERENCE FACTORY OF FJBASE.
000020 PROCEDURE      DIVISION
000021                   RETURNING LK1.
000022 END METHOD     M5591.
000023 END OBJECT.
000024 END CLASS      C5591.
[P5591.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5591.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5591.
000007 DATA           DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 WOBR1       OBJECT REFERENCE C5591.
000010 01 WOBR2       OBJECT REFERENCE.
000011 PROCEDURE      DIVISION.
000012     INVOKE WOBR1 :: "M5591" "GETCLASS"
000013                RETURNING WOBR2.
000014 END PROGRAM    P5591.

P5591.cob 12: JMN5591I-S When an object reference in an INVOKE statement is an in-line method invocation or an object property, the object reference must refer to the class-name specified in the REPOSITORY paragraph.

JMN5592I-S

OMITTED cannot be specified for the BY CONTENT phrase of the @1@ statement. The @1@ statement is ignored.

Parameter explanation

@1@ : INVOKE.

Example

[C5592.cob]
000001 IDENTIFICATION DIVISION.
000002 CLASS-ID.      C5592.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006 IDENTIFICATION DIVISION.
000007 OBJECT.
000008 PROCEDURE      DIVISION.
000009 IDENTIFICATION DIVISION.
000010 METHOD-ID.     M5592.
000011 ENVIRONMENT    DIVISION.
000012 DATA           DIVISION.
000013 LINKAGE         SECTION.
000014 01 LK1         PIC X(10).
000015 01 LK2         PIC 9(10).
000016 PROCEDURE      DIVISION
000017                    USING LK1 LK2.
000018 END METHOD     M5592.
000019 END OBJECT.
000020 END CLASS    C5592.
[P5592.cob]
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID.    P5592.
000003 ENVIRONMENT    DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS C5592
000007     .
000008 DATA           DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 WOBJ        OBJECT REFERENCE C5592.
000011 PROCEDURE      DIVISION.
000012     INVOKE WOBJ "M5592" USING BY CONTENT OMITTED 20.
000013 END PROGRAM    P5592.

P5592.cob 12: JMN5592I-S OMITTED cannot be specified for the BY CONTENT phrase of the INVOKE statement. The INVOKE statement is ignored.

JMN5593I-S

@1@ can only be used if the runtime code set is Unicode.

Parameter explanation

@1@ : FUNCTION UTF8-OF or FUNCTION UCS2-OF.

Example

[C5593.cob]
000001 @OPTIONS RCS(ACP)
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    C5593.
000004 ENVIRONMENT    DIVISION.
000005 DATA           DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01 WCHR        PIC X(20).
000008 01 WNCHR       PIC N(10).
000009 01 WLENG       PIC S9(4) BINARY.
000010 PROCEDURE      DIVISION.
000011*
000012     MOVE FUNCTION UCS2-OF (WCHR) TO WNCHR
000013*
000014     MOVE FUNCTION UTF8-OF(WNCHR) TO WCHR
000015*
000016     COMPUTE WLENG = FUNCTION STORED-CHAR-LENGTH(WCHR)
000017     COMPUTE WLENG = FUNCTION STORED-CHAR-LENGTH(WNCHR)
000018 END PROGRAM    C5593.

P5593.cob 12: JMN5593I-S FUNCTION UCS2-OF can only be used if the runtime code set is Unicode.

P5593.cob 14: JMN5593I-S FUNCTION UTF8-OF can only be used if the runtime code set is Unicode.

JMN5595I-S

For the main program, the parameter specified for the USING phrase of the PROCEDURE DIVISION header should be only one group item that does not exceed 102 bytes, and the first subordinate elementary item must be a 2 byte binary item.

Example

[P5595.cob]
000001 @OPTIONS MAIN
000002 IDENTIFICATION DIVISION.
000003 PROGRAM-ID.    P5595.
000004 ENVIRONMENT    DIVISION.
000005 DATA           DIVISION.
000006 LINKAGE         SECTION.
000007 01 WPRM1.
000008   02 WPRM1L    PIC 9(4).
000009   02 WPRM1X    PIC 9(4).
000010 01 WPRM2.
000011   02 WPRM1L    PIC 9(4).
000012   02 WPRM1X    PIC 9(4).
000013 PROCEDURE      DIVISION
000014                   USING WPRM1 WPRM2.
000015     MOVE WPRM1 TO WPRM2
000016 END PROGRAM    P5595.

P5595.cob 7: JMN5595I-S For the main program, the parameter specified for the USING phrase of the PROCEDURE DIVISION header should be only one group item that does not exceed 102 bytes, and the first subordinate elementary item must be a 2 byte binary item.

Explanation

In the LINKAGE section of the main program, only one data item for receiving the parameter in the global server system format can be defined.

When the format of the data item in the LINKAGE section is wrong, this diagnostic message is output.

Refer to the "NetCOBOL User's Guide" for details of the global server system format parameters.

If it is a data item not used for this purpose, you should correct to define it in the WORKING-STORAGE section.

JMN5596I-S

When the ENCODING clause is specified in the parameter described by the USING statement in the main program procedure division, then the encoding must be the same as the Alphanumeric data item specified in the compilation option ENCODE. The specified parameter will be disabled.

Example

[p5596.cob]
000001 @OPTIONS MAIN,ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     P5596.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET SJIS IS SJIS
000008     .
000009 DATA            DIVISION.
000010 LINKAGE         SECTION.
000011 01 WPRM1.
000012   02 WPRM1L     PIC 9(4) COMP-5.
000013   02 WPRM1X     PIC X(100) ENCODING SJIS.
000014 PROCEDURE       DIVISION USING WPRM1 .
000015     DISPLAY WPRM1(1:WPRM1L)
000016 END PROGRAM     P5596.

P5596.cob 13: JMN5596I-S When the ENCODING clause is specified in the parameter described by the USING statement in the main program procedure division, then the encoding must be the same as the Alphanumeric data item specified in the compilation option ENCODE. The specified parameter will be disabled.

JMN5600I-S

A class-name of early-bind special class must be specified for the object modifier which applies to the object identifier of the special class.

Example

[C5600.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5600.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS SHEET AS "*COM:EXCEL:WORKSHEET"
000007     CLASS FJBASE.
000008 OBJECT.
000009 PROCEDURE       DIVISION.
000010 METHOD-ID.      M5600.
000011 DATA            DIVISION.
000012 WORKING-STORAGE SECTION.
000013 01 WEXCEL       OBJECT REFERENCE SHEET.
000014 01 WOBR         OBJECT REFERENCE FJBASE.
000015 PROCEDURE       DIVISION.
000016       SET WOBR TO WEXCEL AS FJBASE.
000017 END METHOD      M5600.
000018 END OBJECT.
000019 END CLASS       C5600.

C5600.cob 16: JMN5600I-S A class-name of early-bind special class must be specified for the object modifier which applies to the object identifier of the special class.

JMN5601I-S

The left side of 'AS' must be an object identifier of special class, if a class-name of special class is specified for the object modifier.

Example

[C5601.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5601.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS SHEET AS "*COM:EXCEL:WORKSHEET"
000007     CLASS FJBASE.
000008 OBJECT.
000009 PROCEDURE       DIVISION.
000010 METHOD-ID.      M5601.
000011 DATA            DIVISION.
000012 WORKING-STORAGE SECTION.
000013 01 WEXCEL       OBJECT REFERENCE SHEET.
000014 01 WOBR         OBJECT REFERENCE FJBASE.
000015 PROCEDURE       DIVISION.
000016       SET WEXCEL TO WOBR AS SHEET.
000017 END METHOD      M5601.
000018 END OBJECT.
000019 END CLASS       C5601.

C5601.cob 16: JMN5601I-S The left side of 'AS' must be an object identifier of special class, if a class-name of special class is specified for the object modifier.

JMN5602I-S

Other optional phrase cannot be specified, if a class-name of special class is specified for the object modifier.

Example

[C5602.cob]
000001 IDENTIFICATION  DIVISION.
000002 CLASS-ID.       C5602.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 REPOSITORY.
000006     CLASS EXCEL AS "*COM:EXCEL:APPLICATION"
000007     CLASS SHEET AS "*COM:EXCEL:WORKSHEET".
000008 OBJECT.
000009 PROCEDURE       DIVISION.
000010 METHOD-ID.      M5602.
000011 DATA            DIVISION.
000012 WORKING-STORAGE SECTION.
000013 01 WEXCEL       OBJECT REFERENCE EXCEL.
000014 01 WSHEET       OBJECT REFERENCE SHEET.
000015 PROCEDURE       DIVISION.
000016       SET WSHEET TO WEXCEL AS FACTORY OF SHEET.
000017       SET WEXCEL TO WSHEET AS EXCEL ONLY.
000018 END METHOD      M5602.
000019 END OBJECT.
000020 END CLASS       C5602.

C5602.cob 16: JMN5602I-S Other optional phrase cannot be specified, if a class-name of special class is specified for the object modifier.

C5602.cob 17: JMN5602I-S Other optional phrase cannot be specified, if a class-name of special class is specified for the object modifier.

Explanation

When the special class name is specified for the object modifier, 'FACTORY OF' and 'ONLY' cannot be specified.

JMN5783I-S

The ENCODING clause can be specified for an FD or SD data item, data description group item or elementary item as long as the item type is alphanumeric character, edited alphanumeric character, national, or national edited item. The ENCODING clause is disabled.

Example

[c5783.cob]
000001 IDENTIFICATION  DIVISION.
000002 PROGRAM-ID.     C5783.
000003 ENVIRONMENT     DIVISION.
000004 CONFIGURATION   SECTION.
000005 SPECIAL-NAMES.
000006     ALPHABET UTF16 FOR NATIONAL IS UTF16.
000007 DATA            DIVISION.
000008 WORKING-STORAGE SECTION.
000009 01 DATA1        PIC S9(9) DISPLAY ENCODING UTF16.
000010 END PROGRAM     C5783.

c5783.cob 9: JMN5783I-S The ENCODING clause can be specified for an FD or SD data items, data description group item or elementary item as long as the item type is alphanumeric character, edited alphanumeric character, national, or national edited item. The ENCODING clause is disabled.

JMN5784I-S

In the ENCODING clause of @1@, the alphabet name for encoding format @2@ must be specified. The ENCODING clause is disabled.

Parameter explanation

@1@ : ALPHANUMERIC item or ALPHANUMERIC edited item | NATIONAL item or NATIONAL edited item

@2@ : ALPHANUMERIC | NATIONAL

Example

[c5784.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5784.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF16 FOR NATIONAL IS UTF16.
000008 DATA            DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 DATA1        PIC X(20) DISPLAY ENCODING UTF16.
000011 END PROGRAM     C5784.

c5784.cob 10: JMN5784I-S In the ENCODING clause of ALPHANUMERIC item or ALPHANUMERIC edited item, the alphabet name for encoding format ALPHANUMERIC must be specified. The ENCODING clause is disabled.

JMN5785I-S

In the @1@ item of the MOVE statement where CONVERSION is specified, partial reference, function identifier, inline method calling and property name cannot be specified. The MOVE statement is disabled.

Parameter explanation

@1@ : sending | receiving

Example

[c5785.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5785.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF16 FOR NATIONAL IS UTF16.
000008 DATA            DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 DATA1        PIC X(20) DISPLAY.
000011 01 DATA2        PIC N(20) DISPLAY.
000012 PROCEDURE       DIVISION.
000013     MOVE CONVERSION DATA1(1:10) TO DATA2
000014 END PROGRAM     C5785.

c5785.cob 13: JMN5785I-S In the sending item of the MOVE statement where CONVERSION is specified, partial reference, function identifier, inline method calling and property name cannot be specified. The MOVE statement is disabled.

JMN5786I-S

Alphanumeric data item or national item can be specified in the @1@ items of the MOVE statement where CONVERSION is specified. The MOVE statement is disabled.

Parameter explanation

@1@ : sending | receiving

Example

[c5786.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5786.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF16 FOR NATIONAL IS UTF16.
000008 DATA            DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 DATA1        PIC S9(9) DISPLAY.
000011 01 DATA2        PIC N(10) DISPLAY.
000012 PROCEDURE       DIVISION.
000013     MOVE CONVERSION DATA1 TO DATA2
000014 END PROGRAM     C5786.

c5786.cob 13: JMN5786I-S Alphanumeric data item or national item can be specified in the sending items of the MOVE statement where CONVERSION is specified. The MOVE statement is disabled.

JMN5787I-S

A constant cannot be specified in the MOVE statement when CONVERSION is specified. The MOVE statement is disabled.

Example

[c5787.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5787.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF16 FOR NATIONAL IS UTF16.
000008 DATA            DIVISION.
000009 WORKING-STORAGE SECTION.
000010 01 DATA1        PIC N(10) DISPLAY.
000011 PROCEDURE       DIVISION.
000012     MOVE CONVERSION "文字列" TO DATA1
000013 END PROGRAM     C5787.

c5787.cob 12: JMN5787I-S A constant cannot be specified in the MOVE statement when CONVERSION is specified. The MOVE statement is disabled.

JMN5788I-S

The alphabet name associated with the encoding cannot be described in the @1@ statement specifying COLLATING SEQUENCE. The @1@ statement is disabled.

Parameter explanation

@1@ : SORT | MERGE

Example

[c5788.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5788.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF16 NATIONAL UTF16
000008     .
000009 INPUT-OUTPUT    SECTION.
000010 FILE-CONTROL.
000011     SELECT SMFILE ASSIGN DA-S-SM1F.
000012 DATA            DIVISION.
000013 FILE            SECTION.
000014   SD SMFILE LABEL RECORD IS STANDARD.
000015   01 R1.
000016     02 KEY-1    PIC X(4).
000017     02 KEY-2    PIC X(4).
000018     02 R1-1     PIC X(72).
000019 WORKING-STORAGE SECTION.
000020   77 ERR-SWT    PIC 9(1).
000021 PROCEDURE       DIVISION.
000022     SORT   SMFILE ON ASCENDING KEY KEY-2
000023            COLLATING SEQUENCE UTF16.
000024 END PROGRAM     C5788.

c5788.cob 22: JMN5788I-S The alphabet name associated with the encoding cannot be described in the SORT statement specifying COLLATING SEQUENCE. The SORT statement is disabled.

JMN5789I-S

There are multiple encodings that are mixed in the record display file definition, which is specified in printer device or display device in the destination type and printing file. Only one type of encoding can be specified in each alphanumeric data item and national item.

Example

[c5789.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     C5789.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABET UTF8 IS UTF8
000008     ALPHABET UTF16 FOR NATIONAL UTF16
000009     ALPHABET UTF32 FOR NATIONAL UTF32
000010     .
000011 INPUT-OUTPUT    SECTION.
000012   FILE-CONTROL.
000013     SELECT F1 ASSIGN TO PRINTER.
000014 DATA            DIVISION.
000015 FILE            SECTION.
000016 FD F1.
000017 01 REC1.
000018   02 DATA1      PIC X(2).
000019   02 DATA2      PIC N(5) ENCODING UTF16.
000020   02 DATA3      PIC N(5) ENCODING UTF32.
000021 PROCEDURE       DIVISION.
000022 END PROGRAM     C5789.

c5789.cob 17: JMN5789I-S There are multiple encodings that are mixed in the record display file definition, which is specified in printer device or display device in the destination type and printing file. Only one type of encoding can be specified in each alphanumeric data item and national item.

JMN5790I-S

The FILLER cannot be omitted in the WITH FILLER phrase. FILLER is required.

JMN5791I-S

It is not possible to include multiple encodings at the same time in the records of the Line file.

Example

[p5791.cob]
000001 @OPTIONS ENCODE(UTF8,UTF16)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     P5791.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 SPECIAL-NAMES.
000007     ALPHABSET UTF32 FOR NATIONAL IS UTF32
000008     .
000009 INPUT-OUTPUT    SECTION.
000010 FILE-CONTROL.
000011     SELECT SQFILE1   ASSIGN TO SYS001
000012       ORGANIZATION   IS LINE SEQUENTIAL
000013       FILE STATUS    IS WFS1.
000014 I-O-CONTROL.
000015 DATA            DIVISION.
000016 FILE            SECTION.
000017 FD SQFILE1.
000018 01 SQF1REC1.
000019   02            PIC N(80).
000020 01 SQF1REC2.
000021   02            PIC N(40) ENCODING UTF32.
000022 WORKING-STORAGE SECTION.
000023 01 WFS1         PIC X(2).
000024 PROCEDURE       DIVISION.
000025 END PROGRAM     P5791.

P5791.cob 17: JMN5791I-S It is not possible to include multiple encodings at the same time in the records of the Line file.

JMN5792I-S

The length of the national hexadecimal nonnumeric literal of encoding UTF32 must be rounded off to a multiple of 8.

Example

[p5792.cob]
000001 @OPTIONS ENCODE(UTF8,UTF32)
000002 IDENTIFICATION  DIVISION.
000003 PROGRAM-ID.     P5792.
000004 DATA            DIVISION.
000005 WORKING-STORAGE SECTION.
000006 01 WDN1         PIC N(2) VALUE NX"3000".
000007 END PROGRAM     P5792.

P5792.cob 6: JMN5792I-S The length of the national hexadecimal nonnumeric literal of encoding UTF32 must be rounded off to a multiple of 8.