******************************************************************************
*
*	SQL Integrity Check Subroutine
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	08/07/96 18144 CSM Generate error message if referential problem
*	07/02/93 11741 PVW Changed messages and call for error code 8
*	06/30/93 11741 PVW Made a few enhancements and comments
*	06/23/93 11741 PVW Handle SQL Integrity Constraint Checking.
*
*******************************************************************************

   SUBROUTINE SqlIntegrityCheck(dynamic.array,file.var,key,file.name,io.var)

*  io.var contains information passed to this subroutine by the calling
*  routine. The value of io.var<1> determines what error messages are
*  to be printed. A value of:
*  0 means do not print any error messages.
*  1 means print error messages (before write attempted)
*  2 means print error messages (after write attempted)

   PrintStatus = io.var<1>
   
   io.var = ICHECK(dynamic.array,file.var,key)
   error.code = io.var<1>
   IF error.code THEN
      column = io.var<2>
      IF column = -1 THEN
         column = "(multi)"
      END ELSE
         IF column = 0 THEN column = "primary_key"
      END
      constraint = io.var<3>
      BEGIN CASE
         CASE error.code = 1 ;* SINGLEVALUED
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, not SINGLEVALUED' 
               CALL *UVPRINTMSG(923001,column)
            END
         CASE error.code = 2 ;* NOT NULL failure
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, NULL'
               CALL *UVPRINTMSG(923002,column)
            END
         CASE error.code = 3 ;* NOT EMPTY failure
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, EMPTY'
               CALL *UVPRINTMSG(923003,column)
            END
         CASE error.code = 4 ;* ROWUNIQUE failure
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, not ROWUNIQUE'
               CALL *UVPRINTMSG(923005,column)
            END
         CASE error.code = 5 OR error.code = 6 ;* UNIQUE failure
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, not UNIQUE'
               CALL *UVPRINTMSG(923004,column)
            END
         CASE error.code = 7      ;* KEY ROWUNIQUE
            IF PrintStatus THEN
               * 'integrity constraint violation'
               CALL *UVPRINTMSG(923000,"")
            END
         CASE error.code = 8      ;* CHECK CONSTRAINT
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, constraint %s'
               CALL *UVPRINTMSG(923007,constraint)
            END
         CASE error.code = 9      ;* PRIMARY KEY FAILURE
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, key has too many fields'
               CALL *UVPRINTMSG(923009,"")
            END
         CASE error.code = 10     ;* REFERENTIAL FAILURE
            IF PrintStatus THEN
               * 'Integrity Constraint Violation, column %s, REFERENTIAL'
               CALL *UVPRINTMSG(923006,column)
            END
         CASE error.code = 11     ;* INVALID REFERENCED COLUMN VALUE
            IF PrintStatus THEN
               * 'Referenced column %s has invalid value, must be numeric'
               CALL *UVPRINTMSG(923019,column)
            END
         CASE 1
            IF PrintStatus THEN
               * 'integrity constraint violation'
               CALL *UVPRINTMSG(923000,"")
            END
      END CASE
      IF PrintStatus THEN
         IF PrintStatus = 2 THEN
            * 'Write Aborted.  '
            CALL *UVPRINTMSG(923017,"")
         END
         file.name = trim(file.name)
         * 'Filename : %s  Key : %s'
         CALL *UVPRINTMSG(923018,file.name:@fm:key)
      END
   END ELSE
      io.var = ""
   END
   RETURN
   END