*DECK CBERROR 
USETEXT TSBP2CM                                                         007660
      PROC CBERROR(MSGNUMB,LINENUMBER,INSERT,INSERTL);
      BEGIN 
 #
* *   ERROR 
* *   C O GIMBER                                 10.9.74
* 
* DC  PURPOSE 
* 
*     WRITE CBPASS2 ERROR MESSAGE TO THE OUTPUT LISTING.
*     ERROR NUMBERS ARE INSERTED INTO THE MESSAGES. 
*     IF A ITEM LINE NUMBER IS DESIRED IT IS PUT IN THE MESSAGE.
*     IF SOMETHING IS TO BE INSERTED IN THE MESSAGE TEXT, 
*       THEN AN "'" (UPARROW) WILL DESIGNATE WHERE. 
* 
* DC  ENTRY CONDITIONS
* 
*     PASSED PARAMETERS 
*       MSGNUMB = DDL ERROR NUMBER
*       LINENUMBER = TRUE IF LINE NUMBER IS TO BE INSERTED
*       INSERT = CHARACTER STRING TO E INSERTED WHERE AN "'"
*         (UPARROW) APPEARS IN THE ERROR MESSAGE. 
*       INSERTL = THE LENGTH IN CHARACTERS OF THE STRING TO BE INSERTED.
* 
*     IF A LINENUMBER IS TO BE INSETED THEN 
*       SSITEMOFFSET = OFFSET IN SUBSCHEMA OF THE ITEM ENTRY. 
 #
  
      CONTROL EJECT;
# PASSED PARAMETERS#
      ITEM MSGNUMB;          #DDL ERROR NUMBER# 
      ITEM LINENUMBER B;     #TRUE IF LINE NUMBER TO BE INSERTED# 
      ITEM INSERT C(30);     #CHARACTER STRING TO BE INSERTED#
      ITEM INSERTL;          #LENGTH OF CHARACTER STRING TO BE INSERTED#
  
# EXTERNAL REFERENCES#
      XREF ITEM ERRCNTR;     #DDL ERROR COUNT#
      XREF ITEM ABORTFLAG;   # SET FLAG TO INDICATE FATAL ERROR.       #
      XREF ITEM TRVERR;      # TRIVIAL ERROR FLAG                      #
      XREF PROC DDLPRNT;     #DDL LINE PRINT ROUTINE# 
  
# LOCAL VARIABLES#
      ITEM ERRORBUFFER C(130) = "  ***  **"; # BUFF FOR ERROR MESSAGES# 
      ITEM FROMINDEX;#INDEX INTO ERROR MESSAGE# 
      ITEM TEMP1; 
      ITEM TEMP2; 
      ITEM TOINDEX;          #INDEX INTO ERROR BUFFER#
      CONTROL EJECT;
# ERROR MESSAGES FOR CBPASS2# 
      ARRAY[300:316] S(8);
        ITEM ERRORMESSAGE C(0,0,80) = [ 
      "RECORD ' NOT FOUND IN SCHEMA.",                        #300# 
      "MAXIMUM ARRAY ELEMENTS IN SUBSCHEMA GREATER THAN IN SCHEMA FOR IT
EM '.",                                                       #301# 
      "SUBSCHEMA ITEM ' DOES NOT APPEAR IN SCHEMA.",          #302# 
      "ITEM NOT IN SCHEMA CANNOT HAVE VARIABLE OCCURS.",      #303# 
      "KEY ITEM FOR REALM ' NOT FOUND IN SUBSCHEMA.", 
      "IMBEDDED PRIMARY KEY FOR AK REALM ' NOT IDENTICAL.", 
      "TYPE OF REPEATING ITEM ' DOES NOT AGREE WITH TYPE OF REPEATING IT
EM IN SCHEMA.",                                               #306# 
      "ILLEGAL ITEM CONVERSION FOR ITEM '.",                  #307# 
      "REALM ' NOT FOUND IN SCHEMA.",                         #308# 
      "DEPENDS ON CLAUSE DOES NOT AGREE WITH SCHEMA.",        #309# 
      " INSUFFICIENT FL FOR DDLF PASS 2 ",                   #310#
      "NEW GROUP ITEM NAME MUST NOT APPEAR IN SCHEMA OR REPEATING GROUPS
 DO NOT AGREE.",                                              #311# 
      "HIERARCHY OF SUBSCHEMA ITEM ' DIFFERS FROM CORRESPONDING ITEM IN 
SCHEMA.",                                                     #312# 
      "ITEM ' DOES NOT QUALIFY IN A VALID CONCATENATED KEY.", #313# 
      "WARNING: ITEM -'- SS SIZE GR SCHEMA SIZE - MAY CAUSE TRUNCATION E
RRORS.",                                                      #314# 
      "SUBSCHEMA ITEM ' CANNOT DIFFER FROM SCHEMA ITEM WITH CHECK IS PIC
TURE OPTION.",                                                #315# 
      "THE PRIMARY CONCATENATED KEY ITEM ' WAS NOT FOUND IN THE SUBSCHEM
A."                                                         #316# 
];
  
  
# DECLARATIONS BETWEEN $BEGIN AND $END BLOCKS ARE SATISFIED BY SYMPL   #007680
# TEXTS AS INDICATED IN THE USETEXT DIRECTIVE.                         #007690
                                                                        007700
      $BEGIN     # SYMPL TEXT * TSBP2CM * USED #                        007710
                                                                        007720
*CALL CBPASS2CM 
                                                                        007740
      $END                                                              007750
      CONTROL EJECT;
# INCREMENT ERROR COUNT BY 1# 
      ERRCNTR = ERRCNTR+1;
# CHECK ERROR TYPE AND SET THE ABORT FLAG ACCORDINGLY # 
      IF MSGNUMB NQ 314 THEN
        ABORTFLAG = 1;
      ELSE
        TRVERR = 1; 
# PUT ERROR NUMBER INTO MESSAGE#
      TEMP1 = MSGNUMB;
      FOR TOINDEX=7 STEP -1 UNTIL 5 DO
        BEGIN 
         TEMP2 = TEMP1/10;
        C<TOINDEX>ERRORBUFFER = TEMP1-10*TEMP2+"0"; 
        TEMP1 = TEMP2;
        END 
# PUT ITEM LINE NUMBER INTO MESSAGE IF IT IS SPECIFIED IN CALL# 
      IF LINENUMBER THEN
        BEGIN 
        TEMP1 = SBITMSRCLNEN[SSITEMOFFSET]; 
        FOR TOINDEX=19 STEP -1 UNTIL 15 DO
          BEGIN 
           TEMP2 = TEMP1/10;
          C<TOINDEX>ERRORBUFFER = TEMP1-10*TEMP2+"0"; 
          TEMP1 = TEMP2;
          END 
        END 
      ELSE
        C<15,5>ERRORBUFFER = "*****"; 
# TRANSFER MESSAGE FROM ERROR MESSAGE ARRAY TO ERROR MESSAGE BUFFER#
# ADD ANY INSERTS WHILE TRANSFERING MESSAGE#
      FROMINDEX = 0;
      FOR TOINDEX=27 STEP 1 UNTIL 129 DO
        BEGIN 
        IF C<FROMINDEX>ERRORMESSAGE[MSGNUMB] EQ "'" THEN
          BEGIN 
          C<TOINDEX,INSERTL>ERRORBUFFER = C<0,INSERTL>INSERT; 
          TOINDEX = TOINDEX+INSERTL-1;
          FROMINDEX = FROMINDEX+1;
          TEST TOINDEX; 
          END 
        C<TOINDEX>ERRORBUFFER = C<FROMINDEX>ERRORMESSAGE[MSGNUMB];
        IF C<FROMINDEX>ERRORMESSAGE[MSGNUMB] EQ "." THEN GOTO ERROROUT; 
        FROMINDEX = FROMINDEX+1;
        END 
      TOINDEX = 130;
# PRINT THE ERROR MESSAGE LINE# 
ERROROUT: 
      DDLPRNT(ERRORBUFFER,TOINDEX); 
      RETURN; 
      END 
      TERM; 
