IDENTIFICATION DIVISION.
       PROGRAM-ID.  XTS715.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  xyz.
       OBJECT-COMPUTER.  xyz.
       DATA DIVISION.
       WORKING-STORAGE SECTION.


      * Standard COBOL (file "XTS715.SCO") calling SQL
      * procedures in file "XTS715.MCO".


      *Copyright 1995 National Computing Centre Limited               
      *and Computer Logic R&D S.A                                     
      *on behalf of the CTS5 SQL2 Project.                            
      *All rights reserved.                                          
      *The CTS5 SQL2 Project is sponsored by the European Community. 
      *                                                             
      *The National Computing Centre Limited and Computer Logic R&D  
      *have given permission to NIST to distribute this program      
      *over the World Wide Web in order to promote SQL standards.    
      *DISCLAIMER:                                                   
      *This program was reviewed by employees of NIST for            
      *conformance to the SQL standards.                             
      *NIST assumes no responsibility for any party's use of         
      *this program.                                                 


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * SQL VALIDATION TEST SUITE V6.0                               
      *                                                              
      * XTS715.SCO                                                   
      * WRITTEN BY: Manolis Megaloikonomou                           
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      * REVIEW  BY: Nickos  Backalidis                               
      *                                                              
      * Schema definition - explicit name and auth-id.               
      *                                                              
      *          Programs run under identifier CTS4                  
      *                                                              
      * REFERENCES                                                   
      *   11.1    -- <Schema definition>                             
      *   11.1    GR.3                                               
      *   12.5    -- <SQL procedure statement>                       
      *   12.5 LR.2a -- Entry SQL restriction                        
      *                 An <SQL procedure statement> shall not be an 
      *                 <SQL schema definition statement> (Raised)   
      *   21.2.4  -- SCHEMATA view.                                  
      *   F#17    -- Multiple schemas per user.                      
      *   F#2     -- Basic information schema.                       
      *   F#31    -- Schema definition statement.                    
      *                                                              
      * DATE LAST ALTERED  12/12/95 CTS5 Hand-over Test              
      *                                                              
      * Cleanups and fixes by V. Kogakis 01/12/95                    
      *                                                              
      * QA Status: QA Check                                          
      *                                                              
      *Revised 1/23/96 by DWF                                        
      *  Added info on workarounds                                   
      *  Wrong data expected in information schema, fixed            
      *  Removed status checks after cursor definitions              
      *  Fixed SDL transactions                                      
      *  Fixed string truncation                                     
      ****************************************************************



      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  bb PIC  X(3).
       01  aa PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *  EXEC SQL END DECLARE SECTION END-EXEC
       01  norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ALPNUM-TABLE VALUE IS
               "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ".
           05  ALPNUM PIC X OCCURS 36 TIMES.
       01  NORMSQ.
           05  NORMSQX PIC X OCCURS 5 TIMES.
       01  errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration 
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).
       01  flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       PROCEDURE DIVISION.
       P0.

             MOVE "CTS4              " TO uid
             CALL "AUTHID" USING uid
             MOVE "not logged in, not" TO uidx
      *  EXEC SQL SELECT USER INTO :uidx FROM CTS1.ECCO;
             CALL "SUB1" USING SQLCODE SQLSTATE uidx
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB2" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid, " expected.  User ", uidx, "
      -    " connected"
            STOP RUN
             END-IF
             MOVE 0 TO errcnt

             DISPLAY "SQL Test Suite, V6.0, Module COBOL, xts715.sco"
             DISPLAY
           "59-byte ID"
             DISPLAY "TEd Version #"
      *date_time print 
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

      ******************** BEGIN TEST7015 *******************

             MOVE 1 TO flag
             DISPLAY "                  TEST7015 "
             DISPLAY "    Schema definition - explicit name and
      -    " auth-id."
             DISPLAY "References:"
             DISPLAY "    11.1    -- <Schema definition>"
             DISPLAY "    11.1    GR.3"
             DISPLAY "    12.5    -- <SQL procedure statement>"
             DISPLAY "    12.5 LR.2a --Entry SQL restriction ""An <SQL
      -    " procedure"
             DISPLAY "                 statement> shall not be an <SQL
      -    " schema"
             DISPLAY "                 definition statement> (Raised)"""
             DISPLAY "    21.2.4  -- SCHEMATA view."
             DISPLAY "    F#17    -- Multiple schemas per user."
             DISPLAY "    F#2     -- Basic information schema."
             DISPLAY "    F#31    -- Schema definition statement."
             DISPLAY "   - - - - - - - - - - - - - - - - - - -"

             DISPLAY "This test attempts to create schemas with
      -    " different"
             DISPLAY "authorizations.  Because authorizations are
      -    " implementation-"
             DISPLAY "defined, this test may need modification.  The
      -    " following"
             DISPLAY "actions may help to pass the test:"
             DISPLAY "  -- Change the initial authid to an authid with
      -    " DBA privileges"
             DISPLAY "  -- Insert code to work around
      -    " implementation-defined"
             DISPLAY "     authentication mechanisms (e.g. to reconnect
      -    " with a"
             DISPLAY "     different authid)."

      *Initialise error reporting variables 
             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Create schema and table 
             DISPLAY "CREATE SCHEMA T7015aPC AUTHORIZATION CTS4"
             DISPLAY "CREATE TABLE T7015aPC.TESTAB2931"
             DISPLAY "   (TNUM NUMERIC(5),"
             DISPLAY "   TCHAR CHAR(3));"
      *  EXEC SQL CREATE SCHEMA T7015aPC AUTHORIZATION CTS4
      *    CREATE TABLE T7015aPC.TESTAB2931 
      *    (TNUM NUMERIC(5),
      *    TCHAR CHAR(3));
             CALL "SUB3" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB4" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check that the schema exists in Information schema 
             MOVE 0 TO aa
             DISPLAY "SELECT COUNT(*) INTO :aa"
             DISPLAY "FROM INFORMATION_SCHEMA.SCHEMATA "
             DISPLAY "WHERE SCHEMA_NAME = 'T7015APC';"
      *  EXEC SQL SELECT COUNT(*) INTO :aa 
      *    FROM INFORMATION_SCHEMA.SCHEMATA 
      *    WHERE SCHEMA_NAME = 'T7015APC';
             CALL "SUB5" USING SQLCODE SQLSTATE aa
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 1; its value is ", aa
             if ( aa  NOT =  1 ) then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *Then insert values into the table T7015aPC.TESTAB2931 
             DISPLAY "INSERT INTO T7015aPC.TESTAB2931"
             DISPLAY "VALUES(4,'DD');"
      *  EXEC SQL INSERT INTO T7015aPC.TESTAB2931
      *    VALUES(4,'DD');
             CALL "SUB6" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015aPC.TESTAB2931"
             DISPLAY "VALUES(3,'CC');"
      *  EXEC SQL INSERT INTO T7015aPC.TESTAB2931
      *    VALUES(3,'CC');
             CALL "SUB7" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015aPC.TESTAB2931"
             DISPLAY "VALUES(2,'BB');"
      *  EXEC SQL INSERT INTO T7015aPC.TESTAB2931
      *    VALUES(2,'BB');
             CALL "SUB8" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015aPC.TESTAB2931"
             DISPLAY "VALUES(5,'EE');"
      *  EXEC SQL INSERT INTO T7015aPC.TESTAB2931
      *    VALUES(5,'EE');
             CALL "SUB9" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015aPC.TESTAB2931"
             DISPLAY "VALUES(1,'AA');"
      *  EXEC SQL INSERT INTO T7015aPC.TESTAB2931
      *    VALUES(1,'AA');
             CALL "SUB10" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *And commit 
             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB11" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "


      *Using a cursor declaration, check for correct values 
      *in table T7015aPC.TESTAB2931 
             DISPLAY "DECLARE ALPHA CURSOR"
             DISPLAY "FOR SELECT * FROM T7015aPC.TESTAB2931 ORDER BY
      -    " TNUM;"
      *  EXEC SQL DECLARE ALPHA CURSOR
      *    FOR SELECT * FROM T7015aPC.TESTAB2931
      *    ORDER BY TNUM END-EXEC

             DISPLAY "OPEN ALPHA;"
      *  EXEC SQL OPEN ALPHA;
             CALL "SUB12" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *init host vars and check 1st value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH ALPHA INTO :aa, :bb;"
      *  EXEC SQL FETCH ALPHA INTO :aa, :bb;
             CALL "SUB13" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 1;  its value is ", aa
             DISPLAY "bb should be AA; its value is ", bb
             if ( aa  NOT =  1  OR  bb  NOT  =   "AA") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 2nd value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH ALPHA INTO :aa, :bb;"
      *  EXEC SQL FETCH ALPHA INTO :aa, :bb;
             CALL "SUB14" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 2;  its value is ", aa
             DISPLAY "bb should be BB; its value is ", bb
             if ( aa  NOT =  2  OR  bb  NOT  =   "BB") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 3rd value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH ALPHA INTO :aa, :bb;"
      *  EXEC SQL FETCH ALPHA INTO :aa, :bb;
             CALL "SUB15" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 3;  its value is ", aa
             DISPLAY "bb should be CC; its value is ", bb
             if ( aa  NOT =  3  OR  bb  NOT  =   "CC") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 4th value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH ALPHA INTO :aa, :bb;"
      *  EXEC SQL FETCH ALPHA INTO :aa, :bb;
             CALL "SUB16" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 4;  its value is ", aa
             DISPLAY "bb should be DD; its value is ", bb
             if ( aa  NOT =  4  OR  bb  NOT  =   "DD") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 5th value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH ALPHA INTO :aa, :bb;"
      *  EXEC SQL FETCH ALPHA INTO :aa, :bb;
             CALL "SUB17" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 5;  its value is ", aa
             DISPLAY "bb should be EE; its value is ", bb
             if ( aa  NOT =  5  OR  bb  NOT  =   "EE") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *close ALPHA CURSOR 
             DISPLAY "CLOSE ALPHA;"
      *  EXEC SQL CLOSE ALPHA;
             CALL "SUB18" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Create 2nd schema and table 
             DISPLAY "CREATE SCHEMA T7015bPC AUTHORIZATION CTS3"
             DISPLAY "CREATE TABLE TESTBA2931"
             DISPLAY "   (TNUM NUMERIC(5),"
             DISPLAY "   TCHAR CHAR(3))"
             DISPLAY "GRANT SELECT, INSERT, UPDATE ON TESTBA2931 TO
      -    " CTS4;"
      *  EXEC SQL CREATE SCHEMA T7015bPC AUTHORIZATION CTS3
      *    CREATE TABLE TESTBA2931
      *    (TNUM NUMERIC(5),
      *    TCHAR CHAR(3))
      *    GRANT SELECT, INSERT, UPDATE ON TESTBA2931 TO CTS4
      * ;
             CALL "SUB20" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB21" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Insert values into table T7015bPC.TESTBA2931 
             DISPLAY "INSERT INTO T7015bPC.TESTBA2931"
             DISPLAY "VALUES(4,'DD');"
      *  EXEC SQL INSERT INTO T7015bPC.TESTBA2931
      *    VALUES(4,'DD');
             CALL "SUB22" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015bPC.TESTBA2931"
             DISPLAY "VALUES(3,'CC');"
      *  EXEC SQL INSERT INTO T7015bPC.TESTBA2931
      *    VALUES(3,'CC');
             CALL "SUB23" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015bPC.TESTBA2931"
             DISPLAY "VALUES(2,'BB');"
      *  EXEC SQL INSERT INTO T7015bPC.TESTBA2931
      *    VALUES(2,'BB');
             CALL "SUB24" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015bPC.TESTBA2931"
             DISPLAY "VALUES(5,'EE');"
      *  EXEC SQL INSERT INTO T7015bPC.TESTBA2931
      *    VALUES(5,'EE');
             CALL "SUB25" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "
             DISPLAY "INSERT INTO T7015bPC.TESTBA2931"
             DISPLAY "VALUES(1,'AA');"
      *  EXEC SQL INSERT INTO T7015bPC.TESTBA2931
      *    VALUES(1,'AA');
             CALL "SUB26" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check existance of table and its contents 
             MOVE 0 TO aa
             DISPLAY "SELECT COUNT(*) INTO :aa FROM
      -    " T7015bPC.TESTBA2931;"
      *  EXEC SQL SELECT COUNT(*) INTO :aa FROM T7015bPC.TESTBA2931
      * ;
             CALL "SUB27" USING SQLCODE SQLSTATE aa
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 5;  its value is ", aa
             if (aa  NOT =  5) then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *Declare cursor to fetch table contents and check them 
             DISPLAY "DECLARE BETA CURSOR"
             DISPLAY "FOR SELECT * FROM T7015bPC.TESTBA2931 ORDER BY
      -    " TNUM;"
      *  EXEC SQL DECLARE BETA CURSOR
      *    FOR SELECT * FROM T7015bPC.TESTBA2931 ORDER BY TNUM
      *  END-EXEC

             DISPLAY "OPEN BETA;"
      *  EXEC SQL OPEN BETA;
             CALL "SUB28" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *init host vars and check 1st value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH BETA INTO :aa, :bb;"
      *  EXEC SQL FETCH BETA INTO :aa, :bb;
             CALL "SUB29" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 1;  its value is ", aa
             DISPLAY "bb should be AA; its value is ", bb
             if ( aa  NOT =  1  OR  bb  NOT  =   "AA") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 2nd value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH BETA INTO :aa, :bb;"
      *  EXEC SQL FETCH BETA INTO :aa, :bb;
             CALL "SUB30" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 2;  its value is ", aa
             DISPLAY "bb should be BB; its value is ", bb
             if ( aa  NOT =  2  OR  bb  NOT  =   "BB") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 3rd value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH BETA INTO :aa, :bb;"
      *  EXEC SQL FETCH BETA INTO :aa, :bb;
             CALL "SUB31" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 3;  its value is ", aa
             DISPLAY "bb should be CC; its value is ", bb
             if ( aa  NOT =  3  OR  bb  NOT  =   "CC") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 4th value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH BETA INTO :aa, :bb;"
      *  EXEC SQL FETCH BETA INTO :aa, :bb;
             CALL "SUB32" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 4;  its value is ", aa
             DISPLAY "bb should be DD; its value is ", bb
             if ( aa  NOT =  4  OR  bb  NOT  =   "DD") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

      *init host vars and check 5th value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "FETCH BETA INTO :aa, :bb;"
      *  EXEC SQL FETCH BETA INTO :aa, :bb;
             CALL "SUB33" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 5;  its value is ", aa
             DISPLAY "bb should be EE; its value is ", bb
             if ( aa  NOT =  5  OR  bb  NOT  =   "EE") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

             DISPLAY "CLOSE BETA;"
      *  EXEC SQL CLOSE BETA;
             CALL "SUB34" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check for a correct UPDATE in table T7015bPC.TESTBA2931 
             DISPLAY "UPDATE T7015bPC.TESTBA2931"
             DISPLAY "SET TCHAR = 'XX'"
             DISPLAY "WHERE TNUM = 1;"
      *  EXEC SQL UPDATE T7015bPC.TESTBA2931
      *    SET TCHAR = 'XX'
      *    WHERE TNUM = 1;
             CALL "SUB35" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *init host vars and check again 1st value 
             COMPUTE aa = -1
             MOVE "xxx" TO bb
             DISPLAY "SELECT TNUM, TCHAR INTO :aa, :bb"
             DISPLAY "FROM T7015bPC.TESTBA2931"
             DISPLAY "WHERE TNUM = 1;"
      *  EXEC SQL SELECT TNUM, TCHAR INTO :aa, :bb 
      *    FROM T7015bPC.TESTBA2931
      *    WHERE TNUM = 1;
             CALL "SUB36" USING SQLCODE SQLSTATE aa bb
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "aa should be 1;  its value is ", aa
             DISPLAY "bb should be XX; its value is ", bb
             if ( aa  NOT =  1  OR  bb  NOT  =   "XX") then
               MOVE 0 TO flag
             END-IF
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB37" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *now clean up schemas 
             DISPLAY "DROP SCHEMA T7015aPC CASCADE;"
      *  EXEC SQL DROP SCHEMA T7015aPC CASCADE;
             CALL "SUB38" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB39" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *printf("SET SESSION AUTHORIZATION 'CTS3';\n"); 
      *EXEC SQL SET SESSION AUTHORIZATION 'CTS3';    
      *CHCKOK(); 
      *printf("\n"); 

             DISPLAY "DROP SCHEMA T7015bPC CASCADE;"
      *  EXEC SQL DROP SCHEMA T7015bPC CASCADE;
             CALL "SUB40" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB41" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *record results 

             if ( flag  =  1 ) then
               DISPLAY "       xts715.mco  *** pass *** "
      *    EXEC SQL INSERT INTO CTS1.TESTREPORT
      *      VALUES('7015','pass','MCO');
               CALL "SUB42" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "       xts715.mco  *** fail *** "
      *    EXEC SQL INSERT INTO CTS1.TESTREPORT
      *      VALUES('7015','fail','MCO');
               CALL "SUB43" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "========================================"

      *  EXEC SQL COMMIT WORK;
             CALL "SUB44" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

      ******************** END TEST7015 ********************

      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

      *Test SQLCODE and SQLSTATE for normal completion. 
       CHCKOK.
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE NOT =  0  OR   NORMSQ NOT = "00000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ = "00000"  AND  NORMSQ NOT = SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             .

       NOSUBCLASS.

      *This routine replaces valid implementation-defined       
      *subclasses with 000.  This replacement equates valid     
      *implementation-defined subclasses with the 000 value     
      *expected by the test case; otherwise the test will fail. 
      *After calling NOSUBCLASS, NORMSQ will be tested          
      *                          SQLSTATE will be printed.      

           MOVE SQLSTATE TO NORMSQ

           MOVE 3 TO norm1
      *subclass begins in position 3 of char array NORMSQ 
      *valid subclass begins with 5-9, I-Z, end of ALPNUM table 
           PERFORM VARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM
           
      *Quit if NORMSQ is unchanged.  Subclass is not impl.-def. 
      *Changed NORMSQ means implementation-defined subclass,    
      *so proceed to zero it out, if valid (0-9,A-Z)            
           if (NORMSQ   =   SQLSTATE) then
             GO TO EXIT-NOSUBCLASS
           END-IF

           MOVE 4 TO norm1
      *examining position 4 of char array NORMSQ 
      *valid characters are 0-9, A-Z 
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM
          
           MOVE 5 TO norm1
      *valid characters are 0-9, A-Z 
      *examining position 5 of char array NORMSQ 
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM
   
      *implementation-defined subclasses are allowed for warnings 
      *(class = 01).  These equate to successful completion 
      *SQLSTATE values of 00000. 
      *Reference SQL-92 4.28 SQL-transactions, paragraph 2 

           if (NORMSQX(1)  =  "0"  AND  NORMSQX(2)  =  "1") then
             MOVE "0" TO NORMSQX(2)
           END-IF
           .

       EXIT-NOSUBCLASS.
           EXIT.