* Program DTVRB1 - Basic DML Verb Test Main Program * (offshoot of BAS01F.TDM) * Part of the UETP and verify test system for DBMS-20 * Copyright (C) 1984 by * Digital Equipment Corporation, Maynard, Mass. * * This software is furnished under a license, and may be used * or copied only in accordance with the terms of that license. C LARGE DML TEST, ENCOMPASSING AT LEAST ONE OF ALL DML C SYNTACTICAL CONSTRUCTS, PLUS AUXILARY FUNCTIONS AND ROUTINES C USED TO TEST DML VERB PROCESSORS, AND DBCS IN GENERAL C LAST UNIQUE ERROR NUMBER = 294 PROGRAM DTVRB1 C THE BASIC DML VERB TESTS COMMON IER,IGN C ******************* C * SIMPLE INVOKE * C ******************* *DBMS INVOKE DTSSV1 OF DTVRB. C ******************************** C * USE PROCEDURE DECLARATIONS * C ******************************** C NO INVOKE USE PROC SINCE SETUP AFTER INVOKE C NOTE THAT SINCE SYSCOM ITEMS ARE IN COMMON BLOCK NAMED C AFTER SUB-SCHEMA, WITH 2 SUB-SCHEMAS EACH TRYING TO SHARE C THE SAME ERROR PROCS, EACH MUST HAVE AN OPUTER LAYER C SUB-SCHEMA SPECIFIC TO PASS INFO ALONG C THEREFORE EEON1 AND EEON2 JACKET EEON PROCESSOR *DBMS USE EEON1 IF ERROR-STATUS IS 0307,0326. ! FIND ESA, NRS *DBMS USE EUMR1 IF ERSTAT 0009. !ANY UMR * DBMS USE EDEL1 IF ERSTAT 0200. !ANY DELETE EXCEP *DBMS USE EGEN1 IF ERROR-STATUS. !ANY EXCEP NOT CASED ABOVE TYPE 9991 9991 FORMAT(' [Beginning basic DML tests]'/) C ********************************* C * BASIC OPEN/CLOSE USAGES * C * SOME JM???? JRN MANIP CALLS * C * PLUS JRDATA & JRTEXT CALLS * * * VARIOUS OTHER VERBS AS WELL * C ********************************* IER=0 IGN=0 IPAD=40 CALL JMDISK *DBMS OPEN ALL USAGE-MODE IS UPDATE PRIVACY KEY IS BADM. OIC=2 *DBMS STORE O1. C MUST CHECK PADDING OF SYSCOM ITEMS C V6 SPACE PADDED AFTER MOVE STATUS, NUL PADDED AFTER OTHERS C V6.1 SPACE PADS ALL AS DISTRIBUTED BUT CUST MAY SELECT 6 BEHAV C DEFAULT IPAD=<>0=ALL BLANKS, =0=V6 BEHAV IF(RECNAM(2).EQ.0)IPAD=0 P1AREA(1)='TESTA' P1AREA(2)='2 ' DIRKE2=0 CALL JRTEXT('ABOUT TO STORE A P1 RECORD') *DBMS STORE P1. C CHECKOUT SYSCOM IF(IPAD.EQ.0)GO TO 10 IF(RECNAM(1).NE.'P1 ' .OR. RECNAM(2).NE.' ' 1 .OR. RECNAM(3).NE.' ' .OR. RECNAM(4).NE.' ' 2 .OR. RECNAM(5).NE.' ')STOP '?8880B1' IF(ARNAM(1).NE.'TESTA' .OR. ARNAM(2).NE.'2 ' 1 .OR. ARNAM(3).NE.' ' .OR. ARNAM(4).NE.' ' 2 .OR. ARNAM(5).NE.' ')STOP '?8881B1' GO TO 20 10 IF(RECNAM(1).NE.('P1 '.AND."777760000000) 1 .OR. RECNAM(2).NE.0 .OR. RECNAM(3).NE.0 2 .OR. RECNAM(4).NE.0 .OR. RECNAM(5).NE.0)STOP '?8882B1' IF(ARNAM(1).NE.'TESTA' 1 .OR. ARNAM(2).NE.('2 '.AND."774000000000) 1 .OR. ARNAM(3).NE.0 .OR. ARNAM(4).NE.0 2 .OR. ARNAM(5).NE.0)STOP '?8883B1' 20 MOVE STATUS RUN-UNIT TO I1. IF(DBKEY.NE.I1)STOP '?8884B1' CALL JRTEXT('P1 RECORD STORED') *DBMS CLOSE JOURNAL. OPEN AREA TESTA1 USAGE-MODE IS RETRIEVAL PRIVACY KEY BRET. OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE RETRIEVAL. FIND O1. IF(ERSTAT.NE.0)STOP '?8885B1' MOVE STATUS RUN-UNIT TO I1. IF(DBKEY.NE.I1)STOP '?8886B1' GET. IGN=809 MODIFY O1. IF(ERSTAT.NE.809)STOP '?8853B1' IF(IER.NE.809)STOP '?8887B1' IGN=0 FIND FIRST RECORD OF TESTA2 AREA. IF(ERSTAT.NE.0)STOP '?8888B1' IGN=209 DELETE. IF(ERSTAT.NE.209)STOP '?8854B1' IF(IER.NE.209)STOP '??8889B1' IGN=0 CLOSE RUN-UNIT. CALL JMNAME('DSK:DTVRB.JRN') CALL JMAFT(0) *DBMS OPEN JOURNAL USAGE-MODE UPDATE. *DBMS OPEN AREA TESTA1 USAGE-MODE PROTECTED RETRIEVAL PRIVACY KEY BPRET. *DBMS OPEN AREA TESTA2 USAGE-MODE PROTECTED UPDATE. M2D1=20 *DBMS STORE M2. IGN=706 *DBMS INSERT M2 INTO ALL SETS. IF(ERSTAT.NE.706)STOP '?8855B1' IF(IER.NE.706)STOP '?8890B1' C CHECKOUT SYSCOM IF(IPAD.EQ.0)GO TO 30 IF(ERREC(1).NE.'M2 ' .OR. ERREC(2).NE.' ' 1 .OR. ERREC(3).NE.' ' .OR. ERREC(4).NE.' ' 2 .OR. ERREC(5).NE.' ')STOP '?8891B1' IF(ERAREA(1).NE.'TESTA' .OR. ERAREA(2).NE.'2 ' 1 .OR. ERAREA(3).NE.' ' .OR. ERAREA(4).NE.' ' 2 .OR. ERAREA(5).NE.' ')STOP '?8892B1' IF(ERSET(1).NE.'O1M2 ' .OR. ERSET(2).NE.' ' 1 .OR. ERSET(3).NE.' ' .OR. ERSET(4).NE.' ' 2 .OR. ERSET(5).NE.' ')STOP '?8893B1' GO TO 40 30 IF(ERREC(1).NE.('M2 '.AND."777760000000) 1 .OR. ERREC(2).NE.0 2 .OR. ERREC(3).NE.0 .OR. ERREC(4).NE.0 3 .OR. ERREC(5).NE.0)STOP '?8894B1' IF(ERAREA(1).NE.'TESTA' 1 .OR. ERAREA(2).NE.('2 '.AND."774000000000) 2 .OR. ERAREA(3).NE.0 .OR. ERAREA(4).NE.0 3 .OR. ERAREA(5).NE.0)STOP '?8895B1' IF(ERSET(1).NE.('O1M2 '.AND."777777777400) 1 .OR. ERSET(2).NE.0 2 .OR. ERSET(3).NE.0 .OR. ERSET(4).NE.0 3 .OR. ERSET(5).NE.0)STOP '?8896B1' 40 IGN=0 CALL JRDATA(SYSCOM,44) *DBMS CLOSE AREA TESTA1,TESTA2. *DBMS CLOSE JOURNAL. CALL JMBOTH('TESTA1','TESTA2') OPEN ALL USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD. OPEN TRANSACTION TU. CALL JRTEXT('DELETEING ALL RECORDS') FIND FIRST O1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?8897B1' DELETE ALL. FIND FIRST P1 RECORD OF TESTA2 AREA. IF(ERSTAT.NE.0)STOP '?8898B1' DELETE P1. FIND M2. IF(ERSTAT.NE.0)STOP '?8899B1' DELETE. CALL JRDATA(SYSCOM,44) CLOSE TRANSACTION TU. CLOSE ALL. CLOSE RUN-UNIT. CALL JMNONE('TESTA2') *DBMS OPEN JOURNAL USAGE-MODE EXCLUSIVE UPDATE. IGN=938 *DBMS OPEN ALL USAGE-MODE UPDATE PRIVACY KEY BADM. IF(ERSTAT.NE.938)STOP '?8856B1' IF(IER.NE.938)STOP '?88104B1' IGN=0 *DBMS CLOSE JOURNAL. CALL JMBEF('TESTA2') OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE UPDATE. IGN=938 OPEN AREA TESTA1 USAGE-MODE IS UPDATE PRIVACY KEY IS BUPD. IF(ERSTAT.NE.938)STOP '?8857B1' IF(IER.NE.938)STOP '?88138B1' IGN=0 CLOSE JOURNAL. C ***************************** C * SOME TRANSACTION MANIPS * C ***************************** OPEN AREA TESTA1 USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD. OPEN TRANSACTION TUA1. O1C=99 O1D1=99 STORE O1. CLOSE TRANSACTION. CALL JSTRAN('O1MANIP',1) FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88100B1' O1D1=30 MODIFY. CALL JETRAN('O1MANIP',1) OPEN TRANSACTION TUA1. FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88101B1' O1D1=40 MODIFY O1 O1C,O1D1. DELETE TRANSACTION TUA1. CALL JSTRAN('O1READ',2) FIND CURRENT OF O1 RECORD. IF(ERSTAT.NE.0)STOP '?88102B1' DELETE O1. CALL JBTRAN(0) CALL JSTRAN('O1NEGATE',3) FIND O1. IF(ERSTAT.NE.0)STOP '?88103B1' MODIFY O1. CALL JBTRAN(2) OPEN TRANSACTION TUA1. DELETE O1 ALL. CLOSE TRANSACTION TUA1. OPEN TRANSACTION TRA1. FIND O1 RECORD. IF(ERSTAT.NE.326)STOP '?88105B1' DELETE TRANSACTION. CLOSE JOURNAL. C ******************************* C * SOME MANUAL CALLS TO DBCS * C ******************************* C OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD CALL OPEND(-21,0,'BUPD','TESTA1') C OPEN TRANSACTION TUA1 CALL OPENT('TUA1') O1C=29 O1D1=29 C STORE O1 CALL STORED('O1') M1D1=29 M1D2=29 C STORE M1 CALL STORED('M1') C FIND FIRST M1 RECORD OF O1M1 SET CALL FIND3(-12,'M1','O1M1',-20) IF(ERSTAT.NE.0)STOP '?88106B1' C FIND OWNER OF O1M1 SET CALL FIND4('O1M1') IF(ERSTAT.NE.0)STOP '?88107B1' C GET O1 CALL GETS('O1') C DELETE O1 ALL CALL DELETR('O1',-17) C CLOSE TRANSACTION TUA1 CALL CLOTR('TUA1') C CLOSE AREA TESTA1 CALL CLOSED(-18,'TESTA1') C CLOSE JOURNAL CALL CLOSED(-28) C *********************** C * BASIC VERB USAGES * C *********************** *DBMS OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD. C ****************************************** C * STORES WITH VARYING SUPPRESS CLAUSES * C * MOVE CURRENCY FOR CHECKING SUPPRESS * C * SET-PREDICATES WITH BOTH * C * PLUS SOME FINDS AND DELETES * C ****************************************** !FIRST THE SET-PREDICATES O1C=10 O1D1=10 *DBMS 71 STORE O1. M1D1=11 M1D2=M1D1 STORE M1 SUPPRESS O1M1 CURRENCY UPDATES. FIND CURRENT OF O1M1 SET SUPPRESS ALL. IF(ERSTAT.NE.0)STOP '?88108B1' IF (.NOT. OWNER('O1M1')) STOP '?881B1' IF (MEMBER('O1M1')) STOP '?882B1' IF (EMPTY('O1M1')) STOP '?883B1' IF (.NOT. TENANT('O1M1')) STOP '?8858B1' IF (.NOT. OWNER(0)) STOP '?8859B1' IF (MEMBER(0)) STOP '?8860B1' IF (.NOT. TENANT(0)) STOP '?8861B1' 72 FIND CURRENT OF M1 RECORD. IF(ERSTAT.NE.0)STOP '?88109B1' IF (.NOT. TENANT('O1M1')) STOP '?884B1' IF (.NOT. MEMBER ('O1M1')) STOP '?885B1' IF (EMPTY('O1M1')) STOP '?886B1' !THIS CURR SET OCC IDENT BY MEM IF (OWNER('O1M1')) STOP '?8862B1' IF (.NOT. TENANT(0)) STOP '?8863B1' IF (.NOT. MEMBER(0)) STOP '?8864B1' IF (OWNER(0)) STOP '?8865B1' !NOW MOVE CURRENCY 1000 MOVE STATUS RUN-UNIT TO IRU. MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1. IF(ARNAM(1).NE.'TESTA' .OR. ARNAM(2).NE.'1 ' 1 .OR. ARNAM(3).NE.' ' .OR. ARNAM(4).NE.' ' 2 .OR. ARNAM(5).NE.' ')STOP '?88110B1' MOVE CURRENCY STATUS O1 RECORD TO IO1. IF(RECNAM(1).NE.'O1 ' .OR. RECNAM(2).NE.' ' 1 .OR. RECNAM(3).NE.' ' .OR. RECNAM(4).NE.' ' 2 .OR. RECNAM(5).NE.' ')STOP '?88111B1' MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. O1C=1000 O1D1=O1C STORE O1 SUPPRESS ALL CURRENCY. MOVE STATUS RUN-UNIT TO JRU. MOVE CURRENCY STATUS FOR TESTA1 AREA TO JA1. MOVE CURRENCY STATUS O1 RECORD TO JO1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. IF(IA1.NE.JA1 .OR. IO1.NE.JO1 .OR. IO1M1.NE.JO1M1 1 .OR. IO1M2.NE.JO1M2)STOP '?8866B1' IF(IRU.EQ.JRU)STOP '?8867B1' FIND CURRENT OF RUN-UNIT. IF(ERSTAT.NE.0)STOP '?88112B1' MOVE STATUS RUN-UNIT TO IRU. MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1. MOVE CURRENCY STATUS O1 RECORD TO IO1. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. IF(IA1.EQ.JA1 .OR. IO1.EQ.JO1 .OR. IO1M1.EQ.JO1M1 1 .OR. IO1M2.EQ.JO1M2)STOP '?8868B1' IF(IRU.NE.JRU)STOP '?8869B1' !AND THE REMAINING STORE SUPPRESS VARIANTS M1D1=21 1001 STORE M1 SUPPRESS RECORD UPDATES. FIND CURRENT OF M1 RECORD. IF(ERSTAT.NE.0)STOP '?88113B1' GET. IF(M1D1.NE.11)STOP '?8870B1' M1D2=30 MODIFY M1,M1D2. M1D2=0 GET M1,M1D2. IF(M1D2.NE.30)STOP '?88114B1' M1D1=31 1002 STORE M1 SUPPRESS AREA. FIND CURRENT OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88115B1' GET M1. IF(M1D1.NE.11)STOP '?8871B1' MODIFY. O1C=2000 MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. 1003 STORE O1 SUPPRESS SET CURRENCY UPDATES. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. IF(IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2)STOP '?8872B1' FIND CURRENT OF RUN-UNIT. IF(ERSTAT.NE.0)STOP '?88116B1' M1D1=41 MOVE STATUS M1 RECORD TO IM1. MOVE STATUS O1M1 SET TO IO1M1. 1004 STORE M1 SUPPRESS RECORD, O1M1 UPDATES. MOVE STATUS M1 RECORD TO JM1. MOVE STATUS O1M1 SET TO JO1M1. IF(IM1.NE.JM1 .OR. IO1M1.NE.JO1M1)STOP '?8873B1' M1D1=51 MOVE STATUS TESTA1 AREA TO IA1. 1005 STORE M1 SUPPRESS AREA O1M1 CURRENCY. MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1M1 SET TO JO1M1. IF(IA1.NE.JA1 .OR. IO1M1.NE.JO1M1)STOP '?8874B1' O1C=3000 MOVE STATUS O1 RECORD TO IO1. MOVE STATUS O1M2 SET TO IO1M2. 1006 STORE O1 SUPPRESS RECORD SET CURRENCY UPDATES. MOVE STATUS O1 RECORD TO JO1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. IF(IO1.NE.JO1 .OR. IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2) 1 STOP '?8875B1' FIND CURRENT OF RUN-UNIT SUPPRESS O1M1. IF(ERSTAT.NE.0)STOP '?88117B1' M1D1=61 MOVE STATUS TESTA1 AREA TO IA1. 1007 STORE M1 SUPPRESS AREA SET CURRENCY. MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1M1 SET TO JO1M1. IF(IA1.NE.JA1 .OR. IO1M1.NE.JO1M1) STOP '?8876B1' FIND CURRENT OF RUN-UNIT. IF(ERSTAT.NE.0)STOP '?88118B1' 1008 DELETE. MOVE STATUS M1 RECORD TO IM1. MOVE STATUS TESTA1 AREA TO IA1. 1009 STORE M1 SUPPRESS RECORD AREA CURRENCY UPDATES. MOVE STATUS M1 RECORD TO JM1. MOVE STATUS TESTA1 AREA TO JA1. IF(IM1.NE.JM1 .OR. IA1.NE.JA1)STOP '?8877B1' MOVE CURRENCY STATUS FOR O1M1 SET TO IO1M1. MOVE CURRENCY STATUS FOR O1M2 SET TO IO1M2. 1010 STORE O1 SUPPRESS O1M1, O1M2 CURRENCY. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. IF(IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2)STOP '?8878B1' M1D1=71 MOVE STATUS TESTA1 AREA TO IA1. 1011 STORE M1 SUPPRESS RECORD, AREA, O1M1 UPDATES. MOVE STATUS FOR TESTA1 AREA TO JA1. MOVE STATUS M1 RECORD TO JM1. MOVE STATUS O1M1 SET TO JO1M1. IF(IA1.NE.JA1 .OR. IM1.NE.JM1 .OR. IO1M1.NE.JO1M1)STOP '?8879B1' !CLEANUP FOR REST OF TEST O1C=1000 FIND O1. IF(ERSTAT.NE.0)STOP '?88119B1' DELETE ALL. O1C=2000 FIND O1. IF(ERSTAT.NE.0)STOP '?88120B1' DELETE MEMBERS. DELETE. O1C=3000 FIND O1. IF(ERSTAT.NE.0)STOP '?88121B1' DELETE. FIND O1. IF(ERSTAT.NE.0)STOP '?88122B1' DELETE O1. O1C=10 FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88123B1' FIND NEXT RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88124B1' FIND NEXT RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88125B1' DELETE M1. !ONE LAST STORE/SUPPRESS, MOVE CURRENCY CHECK, SETUP FOR LATER M1D1=12 M1D2=M1D1 73 STORE M1. MOVE STATUS FOR TESTA1 AREA TO I1. STORE F1 SUPPRESS AREA UPDATES. MOVE STATUS FOR TESTA1 AREA TO I2. MOVE STATUS FOR RUN-UNIT TO J1. FIND CURRENT OF RUN-UNIT. IF(ERSTAT.NE.0)STOP '?88236B1' MOVE CURRENCY STATUS FOR TESTA1 AREA TO J2. IF (I1.NE.I2) STOP '?887B1' IF (J1.NE.J2) STOP '?888B1' IF (I1.EQ.J1) STOP '?889B1' C **************************** C * FIND CALC (RSE5) CASES * C **************************** 74 O1C=23 O1D1=O1C CALL CALCHN('O1') K1=DBKEY STORE O1. K2=DBKEY IF(K1/512.NE.K2/512)STOP '?88126B1' O1C=10 CALL CALCHN('O1') K1=DBKEY MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1 RECORD TO IO1. MOVE STATUS O1M1 SET TO IO1M1. FIND O1 SUPPRESS AREA, RECORD, O1M1 CURRENCY. IF(ERSTAT.NE.0)STOP '?88237B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1 RECORD TO JO1. MOVE STATUS O1M1 SET TO JO1M1. IF(IA1.NE.JA1)STOP '?88238B1' IF(IO1.NE.JO1)STOP '?88239B1' IF(IO1M1.NE.JO1M1)STOP '?88240B1' K2=DBKEY IF(K1/512.NE.K2/512)STOP '?88127B1' IF (ERSTAT.NE.0) STOP '?8810B1' O1C=0 GET O1. IF (O1C.NE.10) STOP'?8811B1' FIND DUPLICATE O1. IF (ERSTAT.NE.326) STOP '?8812B1' O1D1=11 75 STORE O1. MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. MOVE STATUS O1M3 SET TO IO1M3. MOVE STATUS O1M4 SET TO IO1M4. FIND O1 RECORD SUPPRESS AREA,SET CURRENCY UPDATES. IF (ERSTAT.NE.0) STOP '?8813B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. MOVE STATUS O1M3 SET TO JO1M3. MOVE STATUS O1M4 SET TO JO1M4. IF(IA1.NE.JA1)STOP '?88241B1' IF(IO1M1.NE.JO1M1)STOP '?88242B1' IF(IO1M2.NE.JO1M2)STOP '?88243B1' IF(IO1M3.NE.JO1M3)STOP '?88244B1' IF(IO1M4.NE.JO1M4)STOP '?88245B1' MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1 RECORD TO IO1. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M3 SET TO IO1M3. * DBMS FIND NEXT DUPLICATE WITHIN O1 RECORD SUPPRESS AREA ,O1M1, RECORD, O1M3 UPDATES. IF (ERSTAT.NE.0) STOP '?8814B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1 RECORD TO JO1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M3 SET TO JO1M3. IF(IA1.NE.JA1)STOP '?88246B1' IF(IO1.NE.JO1)STOP '?88247B1' IF(IO1M1.NE.JO1M1)STOP '?88248B1' IF(IO1M3.NE.JO1M3)STOP '?88249B1' GET O1,O1C. IF (O1C.NE.10) STOP '?8815B1' C ******************************************* C * FIND DIRECT (RSE1) * C * FIND [OWN] CURRENT (RSE2) COMPLICATED * C * FIND OWNER (RSE4) * C ******************************************* C I1=I2=DBKEY 2ND M1 IN 1ST O1 C J1=J2=DBKEY F1 76 FIND F1 USING J1. IF (ERSTAT.NE.0) STOP '?8816B1' FIND F1 USING I1. IF (ERSTAT.NE.326) STOP '?8817B1' FIND USING I1. IF (ERSTAT.NE.0) STOP '?8818B1' MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1 RECORD TO IO1. MOVE STATUS M1 RECORD TO IM1. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. MOVE STATUS O1M3 SET TO IO1M3. MOVE STATUS O1M4 SET TO IO1M4. 77 FIND OWNER O1M1 CURRENT O1M1 SET SUPPRESS RECORD,AREA,SET. IF(ERSTAT.NE.0)STOP '?88250B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1 RECORD TO JO1. MOVE STATUS M1 RECORD TO JM1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. MOVE STATUS O1M3 SET TO JO1M3. MOVE STATUS O1M4 SET TO JO1M4. IF(IA1.NE.JA1)STOP '?88251B1' IF(IO1.NE.JO1)STOP '?88252B1' IF(IM1.NE.JM1)STOP '?88253B1' IF(IO1M1.NE.JO1M1)STOP '?88254B1' IF(IO1M2.NE.JO1M2)STOP '?88255B1' IF(IO1M3.NE.JO1M3)STOP '?88256B1' IF(IO1M4.NE.JO1M4)STOP '?88257B1' IF (.NOT. OWNER(0)) STOP '?8819B1' MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1 RECORD TO IO1. FIND OWNER O1M1 CURRENT TESTA1 AREA SUPPRESS RECORD. IF(ERSTAT.NE.0)STOP '?88258B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1 RECORD TO JO1. IF(IO1.NE.JO1)STOP '?88260B1' IF(IM1.NE.JM1)STOP '?88261B1' MOVE STATUS M1 RECORD TO I3. IF (I1.NE.I3) STOP '?8820B1' !INSURE OLD VALUE MOVE STATUS O1M1 SET TO K1. !NOW CHK FIND CURR AND STRING MANIP IF ('O1'.NE.RECNAM(1)) STOP '?8821B1' 1030 M4D1=99 M4D2=999 STORE M4. INSERT INTO ALL SETS. MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1M1 SET TO IO1M1. FIND LAST M1 RECORD OF TESTA1 AREA SUPPRESS O1M1, AREA CURRENCY UPDATES. IF(ERSTAT.NE.0)STOP '?88217B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1M1 SET TO JO1M1. IF(IA1.NE.JA1)STOP '?88262B1' IF(IO1M1.NE.JO1M1)STOP '?88263B1' MOVE STATUS M1 RECORD TO IM1. FIND M1 USING IM1. IF(ERSTAT.NE.0)STOP '?88294B1' FIND CURRENT OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88218B1' MOVE STATUS TESTA1 AREA TO IA1. IF(IM1.NE.IA1)STOP '?88219B1' GET. IF(M1D1.NE.12)STOP '?88220B1' IF(M1D2.NE.12)STOP '?88221B1' MOVE STATUS O1M1 SET TO IO1M1. FIND OWNER IN O1M1 OF CURRENT OF M1 RECORD SUPPRESS O1M1. IF(ERSTAT.NE.0)STOP '?88264B1' MOVE STATUS O1M1 SET TO JO1M1. IF(IO1M1.NE.JO1M1)STOP '?88265B1' GET. IF(O1C.NE.10)STOP '?88222B1' IF(O1D1.NE.10)STOP '?88223B1' MOVE STATUS RUN-UNIT TO IO1. FIND FIRST M1 RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88224B1' FIND OWNER IN O1M1 CURRENT OF RUN-UNIT. IF(ERSTAT.NE.0)STOP '?88225B1' MOVE STATUS O1 RECORD TO JO1. IF(IO1.NE.JO1)STOP '?88226B1' FIND FIRST M4 RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88227B1' FIND OWNER IN F1M4 CURRENT OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88228B1' MOVE STATUS F1 RECORD TO J2. IF(J1.NE.J2)STOP '?88229B1' FIND CURRENT OF M4 RECORD. IF(ERSTAT.NE.0)STOP '?88230B1' FIND OWNER IN F1M4 CURRENT OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88231B1' MOVE STATUS RUN-UNIT TO J2. IF (J1.NE.J2)STOP '?88232B1' FIND LAST M4 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88233B1' REMOVE M4 FROM F1M4,O1M4. DELETE. 78 FIND OWNER OF O1M1. IF(ERSTAT.NE.0)STOP '?88128B1' MOVE STATUS FOR O1M1 SET TO K2. FIND M1 USING I1. !GET OWNER WHEN CURR OF SET IS MEM IF(ERSTAT.NE.0)STOP '?88129B1' FIND OWNER OF O1M1. IF(ERSTAT.NE.0)STOP '?88266B1' MOVE STATUS FOR O1M1 SET TO K3. IF (K1.NE.K2) STOP '?8822B1' IF (K1.NE.K3) STOP '?8823B1' C ****************************************************** C * FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF AREA (RSE3) * C ****************************************************** OPEN TRANSACTION TRA1. MOVE STATUS O1 RECORD TO IO1. MOVE STATUS O1M3 SET TO IO1M3. 79 FIND FIRST RECORD TESTA1 AREA SUPPRESS O1M3, RECORD. IF(ERSTAT.NE.0)STOP '?88267B1' MOVE STATUS O1 RECORD TO JO1. MOVE STATUS O1M3 SET TO JO1M3. IF(IO1.NE.JO1)STOP '?88268B1' IF(IO1M3.NE.JO1M3)STOP '?88269B1' MOVE STATUS FOR TESTA1 AREA TO L1. FIND PRIOR RECORD OF TESTA1 AREA. !VERIF REALLY AT 1ST IF (ERSTAT.NE.307) STOP '?8824B1' IF(IER.NE.307)STOP '?88194B1' ! NOW FIND ALL RECORDS LCOUNT=0 11 FIND NEXT RECORD OF TESTA1 AREA. LCOUNT=LCOUNT+1 !COUNTS FIND BEFORE 1 JUST DONE IF (ERSTAT.NE.307) GOTO 11 IF (LCOUNT.NE.6) STOP '?8825B1' !THE NUM OF STORE STATS 710 MOVE STATUS FOR TESTA1 AREA TO L2. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M4 SET TO IO1M4. FIND LAST RECORD OF TESTA1 AREA SUPPRESS O1M1, O1M4. IF (ERSTAT.NE.0) STOP '?8826B1' !DON'T WANT NOOP TO BE REASON NEXT TEST SUCS MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M4 SET TO JO1M4. IF(IO1M1.NE.JO1M1)STOP '?88270B1' IF(IO1M4.NE.JO1M4)STOP '?88271B1' MOVE STATUS FOR TESTA1 AREA TO L3. IF (L2.NE.L3) STOP '?8827B1' 12 FIND PRIOR RECORD OF TESTA1 AREA. IF (ERSTAT.NE.307) GOTO 12 MOVE STATUS FOR TESTA1 AREA TO L4. IF (L1.NE.L4) STOP '?8828B1' MOVE STATUS O1 RECORD TO IO1. MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. MOVE STATUS O1M3 SET TO IO1M3. MOVE STATUS O1M4 SET TO IO1M4. 711 FIND LCOUNT RECORD OF TESTA1 AREA SUPPRESS SET RECORD CURRENCY. IF(ERSTAT.NE.0)STOP '?88272B1' MOVE STATUS O1 RECORD TO JO1. MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. MOVE STATUS O1M3 SET TO JO1M3. MOVE STATUS O1M4 SET TO JO1M4. IF(IO1.NE.JO1)STOP '?88273B1' IF(IO1M1.NE.JO1M1)STOP '?88274B1' IF(IO1M2.NE.JO1M2)STOP '?88275B1' IF(IO1M3.NE.JO1M3)STOP '?88276B1' IF(IO1M4.NE.JO1M4)STOP '?88277B1' MOVE STATUS FOR TESTA1 AREA TO L5. IF (L2.NE.L5) STOP '?8829B1' MOVE STATUS O1M1 SET TO IO1M1. MOVE STATUS O1M2 SET TO IO1M2. MOVE STATUS O1M3 SET TO IO1M3. MOVE STATUS O1M4 SET TO IO1M4. FIND -6 RECORD OF TESTA1 AREA SUPPRESS SET UPDATES. IF(ERSTAT.NE.0)STOP '?88278B1' MOVE STATUS O1M1 SET TO JO1M1. MOVE STATUS O1M2 SET TO JO1M2. MOVE STATUS O1M3 SET TO JO1M3. MOVE STATUS O1M4 SET TO JO1M4. IF(IO1M1.NE.JO1M1)STOP '?88279B1' IF(IO1M2.NE.JO1M2)STOP '?88280B1' IF(IO1M3.NE.JO1M3)STOP '?88281B1' IF(IO1M4.NE.JO1M4)STOP '?88282B1' MOVE STATUS FOR TESTA1 AREA TO L6. IF (L1.NE.L6) STOP '?8830B1' ! SPEC A RECORD TYPE EXPLIC (& INVOLVE RANGE SCOPING IN FND.NA) 712 FIND FIRST M1 RECORD OF TESTA1 AREA. IF (ERSTAT.NE.0) STOP '?8831B1' FIND NEXT M1 RECORD OF TESTA1 AREA. IF (ERSTAT.NE.0) STOP '?8832B1' FIND NEXT M1 RECORD OF TESTA1 AREA. !KNOWN TO BE 2 M1'S, SO SHOULD FAIL IF (ERSTAT.NE.307) STOP '?8833B1' FIND LAST M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88198B1' FIND PRIOR M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88199B1' FIND PRIOR M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.307)STOP '?88200B1' FIND 2 M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88201B1' FIND NEXT M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.307)STOP '?88202B1' FIND -1 M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88203B1' FIND PRIOR M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88204B1' CLOSE TRANSACTION TRA1. C ***************************************************** C * FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF SET (RES3) * C ***************************************************** MOVE STATUS TESTA1 AREA TO IA1. 713 FIND FIRST RECORD O1M1 SET SUPPRESS AREA CURRENCY. IF(ERSTAT.NE.0)STOP '?88130B1' MOVE STATUS TESTA1 AREA TO JA1. IF(IA1.NE.JA1)STOP '?88283B1' MOVE STATUS FOR O1M1 SET TO N1. FIND PRIOR RECORD OF O1M1 SET. !VERIF REALLY AT 1ST IF (ERSTAT.NE.307) STOP '?8835B1' ! NOW FIND ALL RECORDS NCOUNT=0 16 M1D1=2 M1D2=3 MODIFY M1,M1D2,M1D1. M1D1=0 M1D2=0 GET M1,M1D1,M1D2. IF (M1D1.NE.2 .OR. M1D2.NE.3) STOP '?8836B1' FIND NEXT RECORD OF O1M1 SET. NCOUNT=NCOUNT+1 !COUNTS FIND BEFORE 1 JUST DONE IF (ERSTAT.NE.307) GOTO 16 IF (NCOUNT.NE.2) STOP '?8837B1' !THE NUM OF STORE STATS OPEN TRANSACTION TRA1. 714 MOVE STATUS FOR O1M1 SET TO N2. ! VERIFY FIND OF PRIOR REC USING OB.CPRI FIND PRIOR RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88284B1' MOVE STATUS FOR O1M1 SET TO N3. IF (N1.NE.N3) STOP '?8837AB1' ! VERIF FIND LAST (AGAINST LAST OF 16-LOOP) FIND LAST RECORD OF O1M1 SET. IF (ERSTAT.NE.0) STOP '?8838B1' !DON'T WANT NOOP TO BE REASON NEXT TEXT SUCS MOVE STATUS FOR O1M1 SET TO N3. IF (N2.NE.N3) STOP '?8839B1' 17 FIND PRIOR RECORD OF O1M1 SET. IF (ERSTAT.NE.307) GOTO 17 MOVE STATUS FOR O1M1 SET TO N4. IF (N1.NE.N4) STOP '?8840B1' MOVE STATUS TESTA1 AREA TO IA1. MOVE STATUS O1 RECORD TO IO1. MOVE STATUS M1 RECORD TO IM1. 715 FIND NCOUNT RECORD OF O1M1 SET SUPPRESS AREA RECORD UPDATES. IF(ERSTAT.NE.0)STOP '?88285B1' MOVE STATUS TESTA1 AREA TO JA1. MOVE STATUS O1 RECORD TO JO1. MOVE STATUS M1 RECORD TO JM1. IF(IA1.NE.JA1)STOP '?88286B1' IF(IO1.NE.JO1)STOP '?88287B1' IF(IM1.NE.JM1)STOP '?88288B1' MOVE STATUS FOR O1M1 SET TO N5. IF (N2.NE.N5) STOP '?8841B1' FIND -2 RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88289B1' MOVE STATUS FOR O1M1 SET TO N6. IF (N1.NE.N6) STOP '?8842B1' CLOSE TRANSACTION. ! SPEC A REC TYPE EXPLIC 716 FIND FIRST M1 RECORD OF O1M1 SET. IF (ERSTAT.NE.0) STOP '?8843B1' REMOVE FROM ALL. FIND NEXT M1 RECORD OF O1M1 SET. IF (ERSTAT.NE.0) STOP '?8844B1' FIND NEXT M1 RECORD OF O1M1 SET. !KNOWN TO BE 2 M1'S, SO SHOULD FAIL IF (ERSTAT.NE.307) STOP '?8845B1' REMOVE M1 FROM O1M1. FIND NEXT RECORD OF O1M1 SET. IF (ERSTAT.NE.326) STOP '?8846B1' IF(IER.NE.326)STOP '?88195B1' FIND FIRST M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88210B1' INSERT INTO ALL SETS. FIND NEXT M1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88211B1' INSERT INTO O1M1. FIND LAST M1 RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88205B1' FIND PRIOR M1 RECORD O1M1 SET. IF(ERSTAT.NE.0)STOP '?88206B1' FIND PRIOR M1 RECORD O1M1 SET. IF(ERSTAT.NE.307)STOP '?88207B1' FIND 2 M1 RECORD OF O1M1 SET. IF(ERSTAT.NE.0)STOP '?88208B1' FIND NEXT M1 RECORD OF O1M1 SET. IF(ERSTAT.NE.307)STOP '?88209B1' FIND -1 M1 RECORD O1M1 SET. IF(ERSTAT.NE.0)STOP '?88210B1' REMOVE FROM O1M1. FIND PRIOR M1 RECORD O1M1 SET. IF(ERSTAT.NE.0)STOP '?88211B1' REMOVE FROM ALL. C *************************************************** C * FIND SORTED (RSE6) SORTED/UNSORTED, AND FINS6 * C * PLUS ASSORTED INSERTS AND REMOVES * C *************************************************** 1050 FIND FIRST F1 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88131B1' O1C=10 FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88290B1' M3D1=100 STORE M3. M3D1=200 STORE M3. M3D1=150 STORE M3. M4D1=1000 M4D2=10 STORE M4. INSERT INTO ALL. M4D2=20 STORE M4. INSERT M4 INTO ALL. M4D1=2000 M4D2=10 STORE M4. INSERT M4 INTO O1M4,F1M4. M4D2=20 STORE M4. INSERT INTO F1M4. M4D2=30 STORE M4. INSERT INTO O1M4. 1051 O1C=23 FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88291B1' M3D1=75 STORE M3. M3D1=200 STORE M3. M4D1=1000 M4D2=40 STORE M4. INSERT M4 INTO ALL SETS. M4D2=50 STORE M4. INSERT M4 INTO O1M4. M4D1=2000 M4D2=40 STORE M4. INSERT M4 INTO ALL. M4D1=3000 M4D2=10 STORE M4. M4D2=20 STORE M4. INSERT M4 INTO ALL. O1C=10 C EXACT (NON RANGE) FINDS, SORTED, SINGLE KEY 1052 FIND O1. IF(ERSTAT.NE.0)STOP '?88139B1' M3D1=150 FIND M3 VIA CURRENT OF O1M3 USING M3D1. IF(ERSTAT.NE.0)STOP '?88140B1' M3D1=75 FIND M3 VIA CURRENT OF O1M3 USING M3D1. IF(ERSTAT.NE.326)STOP '?88141B1' 1053 O1C=23 FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88142B1' FIND M3 VIA CURRENT OF O1M3 USING M3D1. IF(ERSTAT.NE.0)STOP '?88143B1' CALL FINS6('M3','O1M3') IF(ERSTAT.NE.0)STOP '?88144B1' C RANGE CASE FINDS, SORTED, MULTI KEY 1054 M4D1=1000 M4D2=60 FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2. IF(ERSTAT.NE.0)STOP '?88145B1' IF(ERDATA.NE.2)STOP '?88146B1' GET M4. IF(M4D1.NE.2000)STOP '?88147B1' IF(M4D2.NE.40)STOP '?88148B1' M4D1=3000 M4D2=0 FIND M4 VIA CURRENT OF O1M4 USING M4D1,M4D2. IF(ERSTAT.NE.0)STOP '?88149B1' IF(ERDATA.NE.1)STOP '?88150B1' GET M4 M4D1,M4D2. IF(M4D1.NE.3000)STOP '?88151B1' IF(M4D2.NE.20)STOP '?88152B1' C BOUNDARY AND EMPTY CHECKS M4D2=30 FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2. IF(ERSTAT.NE.307)STOP '?88153B1' M3D1=10 FIND M3 VIA CURRENT O1M3 USING M3D1. IF(ERSTAT.NE.326)STOP '?88154B1' 1055 O1C=10 FIND O1. IF(ERSTAT.NE.0)STOP '?88155B1' FIND DUPLICATE O1. IF(ERSTAT.NE.0)STOP '?88156B1' FIND M3 VIA CURRENT O1M3 USING M3D1. IF(ERSTAT.NE.326)STOP '?88157B1' FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2. IF(ERSTAT.NE.307)STOP '?88158B1' C SORTED, NON SORTED FINDS SAME SET OCC 1056 FIND O1. !BACK TO 1ST OCC IF(ERSTAT.NE.0)STOP '?88196B1' FIND OWNER F1M4 SET. IF(ERSTAT.NE.0)STOP '?88197B1' M4D1=2000 M4D2=10 FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET. IF(ERSTAT.NE.0)STOP '?88159B1' IF(ERDATA.NE.0)STOP '?88160B1' GET M4. IF(M4D1.NE.2000)STOP '?88161B1' IF(M4D2.NE.10)STOP '?88162B1' FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2 SUPPRESS SET. IF(ERSTAT.NE.0)STOP '?88163B1' GET. IF(M4D1.NE.2000)STOP '?88164B1' IF(M4D2.NE.10)STOP '?88165B1' M4D2=20 FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2. !FROM SET PREV IF(ERSTAT.NE.0)STOP '?88166B1' GET M4. IF(M4D1.NE.2000)STOP '?88167B1' IF(M4D2.NE.20)STOP '?88168B1' FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET. IF(ERSTAT.NE.0)STOP '?88169B1' IF(ERDATA.NE.2)STOP '?88170B1' GET M4. IF(M4D1.NE.2000)STOP '?88171B1' IF(M4D2.NE.30)STOP '?88172B1' FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2. IF(ERSTAT.NE.307)STOP '?88173B1' CALL FINS6('M4','O1M4') IF(ERSTAT.NE.0)STOP '?88174B1' 1057 M4D1=1000 M4D2=30 FIND M4 VIA CURRENT O1M4 USING M4D1. !1 KEY DEFS FND 3 IF(ERSTAT.NE.307)STOP '?88175B1' FIND OWNER O1M4 SET. IF(ERSTAT.NE.0)STOP '?88176B1' FIND OWNER F1M4 SET. IF(ERSTAT.NE.0)STOP '?88177B1' FIND M4 VIA CURRENT O1M4 USING M4D1. IF(ERSTAT.NE.0)STOP '?88178B1' GET. IF(M4D1.NE.1000)STOP '?88179B1' IF(M4D2.NE.10)STOP '?88180B1' FIND M4 VIA CURRENT F1M4 USING M4D1. IF(ERSTAT.NE.0)STOP '?88181B1' GET. IF(M4D1.NE.1000)STOP '?88182B1' IF(M4D2.NE.20)STOP '?88183B1' C CLEANUP 1058 FIND OWNER O1M4 SET. IF(ERSTAT.NE.0)STOP '?88184B1' DELETE MEMBERS FROM O1M3. FIND FIRST RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88185B1' REMOVE FROM ALL. DELETE. FIND NEXT RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88186B1' REMOVE M4 FROM ALL. DELETE M4. FIND NEXT RECORD OF F1M4 SET. IF(ERSTAT.NE.0)STOP '?88187B1' REMOVE M4 FROM ALL SETS. DELETE. FIND NEXT RECORD OF F1M4 SET. IF(ERSTAT.NE.0)STOP '?88188B1' REMOVE M4 FROM F1M4. DELETE. FIND NEXT RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88189B1' REMOVE M4 FROM O1M4. DELETE. 1059 O1C=23 FIND O1. IF(ERSTAT.NE.0)STOP '?88190B1' FIND NEXT RECORD OF F1M4 SET. IF(ERSTAT.NE.0)STOP '?88191B1' REMOVE FROM O1M4,F1M4. DELETE. FIND NEXT RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88192B1' REMOVE M4 FROM ALL SETS. DELETE. FIND NEXT RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88193B1' REMOVE M4 FROM F1M4,O1M4. DELETE. FIND LAST RECORD OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88214B1' REMOVE M4 FROM ALL. DELETE. FIND LAST M4 RECORD OF TESTA1 AREA. IF(ERSTAT.NE.0)STOP '?88215B1' DELETE. FIND OWNER OF O1M4 SET. IF(ERSTAT.NE.0)STOP '?88216B1' DELETE MEMBERS FROM O1M3. C **************************************************** C * DELETES, HANDLED FROM SUBS WITH 2ND SUB-SCHEMA * C * TRIVIAL CASE DONE THROUGHOUT MAIN PROGRAM * C **************************************************** CALL DTVRB2 !INIT CALL DELCAS(1) !DELETE RECORD THEN DELETE ALL CALL DELCAS(2) !DELETE SELECTIVE CALL DELCAS(3) !DELETE RECORD ONLY CALL DELCAS(4) !DELETE MEMBERS C MAKE SURE ORIG SUB-SCHEMA NOT AFFECTED O1C=10 FIND O1 RECORD. IF(ERSTAT.NE.0)STOP '?88132B1' GET O1 O1D1. DELETE ALL. CALL DELCAS(5) !DELETE RECORD ALL MEMBERS CALL DELCAS(6) !DELETE RECORD SELECTIVE MEMBERS OPEN TRANSACTION TUA1. FIND NEXT DUPLICATE WITHIN O1 RECORD. IF(ERSTAT.NE.0)STOP '?88292B1' DELETE ALL. CLOSE TRANSACTION. CALL DELCAS(7) !DELETE RECORD ONLY MEMBERS CALL DELCAS(8) !DELETE RECORD SELECTIVE MEMBERS SET CALL DELCAS(9) !DELETE RECORD ONLY MEMBERS SET1,SET2 CALL DELCAS(10) !CLOSE AREA O1C=23 FIND O1. IF(ERSTAT.NE.0)STOP '?88293B1' DELETE MEMBERS. DELETE O1. 99 CLOSE AREA TESTA1. CLOSE JOURNAL. CALL STATS TYPE 9992 9992 FORMAT(' [Completed basic DML tests]') * DBMS END DTVRB1. SUBROUTINE EUMR1 * DBMS ACCESS SUB-SCHEMA DTSSV1 OF SCHEMA DTVRB PRIVACY KEY COMPILE BOGUS. CALL EUMR(ERSTAT) RETURN *DBMS END EUMR1. SUBROUTINE EUMR2 * DBMS ACCESS SUB-SCHEMA DTSSV2 OF SCHEMA DTVRB PRIVACY KEY COMPILE B2. CALL EUMR(ERSTAT) RETURN *DBMS END EUMR2. SUBROUTINE EUMR(ERSTAT) C PROCESS ALL UMR (**09) EXCEPTIONS INTEGER ERSTAT COMMON IER,IGN IF((ERSTAT-((ERSTAT/100)*100)).NE.9)GO TO 2020 IF(ERSTAT.NE.209 .AND. ERSTAT.NE.809)GO TO 2030 IF(IGN.NE.209 .AND. IGN.NE.809)GO TO 2040 IER=ERSTAT RETURN 2020 TYPE 2025,ERSTAT 2025 FORMAT(' ?TRAPPING EXCEPTION **09, RECEIVED ',I5) STOP 2030 TYPE 2035,ERSTAT 2035 FORMAT(' ?EXPECTING EXCEPTION 0209 OR 0809, RECEIVED ',I5) STOP 2040 TYPE 2045,ERSTAT 2045 FORMAT(' ?UNEXPECTED EXCEPTION ',I5) STOP * DBMS END EUMR. SUBROUTINE EEON1 * DBMS ACCESS SUB-SCHEMA DTSSV1 OF SCHEMA DTVRB PRIVACY KEY FOR COMPILE IS BOGUS. CALL EEON(ERSTAT) RETURN * DBMS END EEON1. SUBROUTINE EEON2 * DBMS ACCESS SUB-SCHEMA DTSSV2 OF SCHEMA DTVRB PRIVACY KEY FOR COMPILE IS B2. CALL EEON(ERSTAT) RETURN * DBMS END EEON2. SUBROUTINE EEON(ERSTAT) C PROCESS ESA (0307) AND NRS (0326) ONLY INTEGER ERSTAT COMMON IER,IGN IF(ERSTAT.NE.307 .AND. ERSTAT.NE.326)GO TO 3020 IF(IGN.NE.0 .AND. IGN.NE.ERSTAT)GO TO 3030 IER=ERSTAT RETURN 3020 TYPE 3025,ERSTAT 3025 FORMAT(' ?TRAPPING EXCEPTION 307 OR 326, RECEIVED ',I5) STOP 3030 TYPE 3035,ERSTAT 3035 FORMAT(' ?UNEXPECTED EXCEPTION ',I5) STOP * DBMS END EEON. SUBROUTINE EDEL1 * DBMS ACCESS SUB-SCHEMA DTSSV1 OF DTVRB. CALL EDEL(ERSTAT) RETURN * DBMS END EDEL1. SUBROUTINE EDEL2 * DBMS ACCESS SUB-SCHEMA DTSSV2 OF DTVRB PRIVACY KEY COMPILE B2. CALL EDEL(ERSTAT) RETURN * DBMS END EDEL2. SUBROUTINE EDEL(ERSTAT) C PROCESS ANY DELETE VERB (02**) ERROR INTEGER ERSTAT COMMON IER,IGN IF(ERSTAT.LT.200 .OR. ERSTAT.GT.299)GO TO 4020 IF(ERSTAT.NE.230)GO TO 4030 IF(ERSTAT.NE.IGN)GO TO 4040 IER=230 RETURN 4020 TYPE 4025,ERSTAT 4025 FORMAT(' ?TRAPPING EXCEPTION 02**, RECEIVED ',I5) STOP 4030 TYPE 4035,ERSTAT 4035 FORMAT(' ?EXPECTING EXCEPTION 0230, RECEIVED ',I5) STOP 4040 TYPE 4045 4045 FORMAT(' ?UNEXPECTED EXCEPTION 0230') STOP * DBMS END EDEL. SUBROUTINE EGEN1 * DBMS ACCESS DTSSV1 OF SCHEMA DTVRB. CALL EGEN(ERSTAT) RETURN * DBMS END EGEN1. SUBROUTINE EGEN2 * DBMS ACCESS DTSSV2 OF SCHEMA DTVRB PRIVACY KEY COMPILE B2. CALL EGEN(ERSTAT) RETURN * DBMS END EGEN2. SUBROUTINE EGEN(ERSTAT) C HANDLE ALL EXCEPS NOT HANDLED ABOVE INTEGER ERSTAT COMMON IER,IGN IF(ERSTAT.NE.IGN)GO TO 5020 IER=ERSTAT RETURN 5020 TYPE 5025,ERSTAT 5025 FORMAT(' ?UNEXPECTED EXCEPTION ',I5) STOP * DBMS END EGEN.