PDP-10 Archive: uetp/dtvr1s.cbl from BB-4148F-BM

Trailing-Edge - PDP-10 Archives - BB-4148F-BM_1984 - uetp/dtvr1s.cbl
There is 1 other file named dtvr1s.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. DTVR1S.

*	Program DTVR1S - Basic DML Verb Test Main Program
*	(99% variant of DTVRB1 - 1% non functioning in current COBOLs)
*	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.

*	LARGE DML TEST, ENCOMPASSING AT LEAST ONE OF ALL DML
*	SYNTACTICAL CONSTRUCTS, PLUS AUXILARY FUNCTIONS AND ROUTINES
*	USED TO TEST DML VERB PROCESSORS, AND DBCS IN GENERAL
*	  LAST UNIQUE ERROR NUMBER = 294

*	****************** NOTE ******************
*	THIS IS A SUBSET OF THE FULL DTVRB1 COBOL TEST - SEE DTVRB1.CBL
*	DEVIATIONS DUE TO BUGS IN ONE COBOL VERSION OR ANOTHER:
*	EVERY 'MOVE [CURRENCY] STATUS [FOR] ...' VERB HAS A 'FOR' CLAUSE
*	THERE ARE NO 'STORE ... SUPPRESS {REC!AREA} SET-NAME' CLAUSES
*	THERE ARE NO 'FIND ... SUPPRESS {REC!AREA} SET-NAME' CLAUSES

ENVIRONMENT DIVISION.
DATA DIVISION.
SCHEMA SECTION.

*	*******************
*	*  SIMPLE INVOKE  *
*	*******************
	INVOKE DTSSV1 OF SCHEMA DTVRB.

WORKING-STORAGE SECTION.
01 I1 USAGE DBKEY.
01 I2 USAGE DBKEY.
01 I3 USAGE DBKEY.
01 J1 USAGE DBKEY.
01 J2 USAGE DBKEY.
01 K1 USAGE DBKEY.
01 K2 USAGE DBKEY.
01 K3 USAGE DBKEY.
01 L1 USAGE DBKEY.
01 L2 USAGE DBKEY.
01 L3 USAGE DBKEY.
01 L4 USAGE DBKEY.
01 L5 USAGE DBKEY.
01 L6 USAGE DBKEY.
01 N1 USAGE DBKEY.
01 N2 USAGE DBKEY.
01 N3 USAGE DBKEY.
01 N4 USAGE DBKEY.
01 N5 USAGE DBKEY.
01 N6 USAGE DBKEY.
01 LCOUNT USAGE COMP PIC S9(10).
01 NCOUNT USAGE COMP PIC S9(10).
01 IRU USAGE DBKEY.
01 JRU USAGE DBKEY.
01 IA1 USAGE DBKEY.
01 JA1 USAGE DBKEY.
01 IO1 USAGE DBKEY.
01 JO1 USAGE DBKEY.
01 IM1 USAGE DBKEY.
01 JM1 USAGE DBKEY.
01 IO1M1 USAGE DBKEY.
01 JO1M1 USAGE DBKEY.
01 IO1M2 USAGE DBKEY.
01 JO1M2 USAGE DBKEY.
01 IO1M3 USAGE DBKEY.
01 JO1M3 USAGE DBKEY.
01 IO1M4 USAGE DBKEY.
01 JO1M4 USAGE DBKEY.
01 D1 USAGE COMP PIC S9(10).
01 D2 USAGE COMP PIC S9(10).
01 DD1 USAGE COMP PIC S9(18).
01 DD2 REDEFINES DD1 USAGE COMP.
   02 FILLER PIC S9(10).
   02 D3 PIC S9(10).
01 IPAD USAGE COMP PIC S9(10).
01 IER USAGE COMP PIC S9(10).
*	IN CASE DIFFERENT EDIT NUMBER
01 IGN USAGE COMP PIC S9(10) VALUE 1500.
01 WORK-NAME USAGE DISPLAY-7.
	02 FILLER USAGE COMP PIC S9(10).
	02 WNB2 USAGE COMP PIC S9(10).
	02 FILLER USAGE COMP PIC S9(10).
	02 FILLER USAGE COMP PIC S9(10).
	02 FILLER USAGE COMP PIC S9(10).
	02 FILLER USAGE COMP PIC S9(10).
*	P1<NULLS>
01 P1-NAME-SIXBIT USAGE DISPLAY-6.
	02 FILLER PIC X(6) VALUE 'H,0   '.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
01 P1-NAME REDEFINES P1-NAME-SIXBIT USAGE DISPLAY-7 PIC X(30).
*	TESTA2<NULLS>
01 TESTA2-NAME-SIXBIT USAGE DISPLAY-6.
	02 FILLER PIC X(6) VALUE 'J1:=2"'.
	02 FILLER PIC X(6) VALUE '9     '.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
01 TESTA2-NAME REDEFINES TESTA2-NAME-SIXBIT USAGE DISPLAY-7 PIC X(30).
*	M2<NULLS>
01 M2-NAME-SIXBIT USAGE DISPLAY-6.
	02 FILLER PIC X(6) VALUE 'FL@   '.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
01 M2-NAME REDEFINES M2-NAME-SIXBIT USAGE DISPLAY-7 PIC X(30).
*	O1M2<NULLS>
01 O1M2-NAME-SIXBIT USAGE DISPLAY-6.
	02 FILLER PIC X(6) VALUE 'GL9K( '.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
	02 FILLER PIC X(6) VALUE SPACES.
01 O1M2-NAME REDEFINES O1M2-NAME-SIXBIT USAGE DISPLAY-7 PIC X(30).
PROCEDURE DIVISION.

DECLARATIVES.

*	********************************
*	*  USE PROCEDURE DECLARATIONS  *
*	********************************
USE-EON SECTION.
	USE IF ERROR-STATUS IS 0307,0326.
EEON.
*	PROCESS ESA (0307) AND NRS (0326) ONLY
	IF ERROR-STATUS NOT = 307 AND ERROR-STATUS NOT = 326 GO TO EEON-1.
	IF IGN NOT = 0 AND IGN NOT = ERROR-STATUS GO TO EEON-2.
	MOVE ERROR-STATUS TO IER.
	GO TO EEON-EXIT.
EEON-1.
	DISPLAY '?TRAPPING EXCEPTION 307 OR 326, RECEIVED ',ERROR-STATUS.
	STOP RUN.
EEON-2.
	DISPLAY '?UNEXPECTED EXCEPTION ',ERROR-STATUS.
	STOP RUN.
EEON-EXIT.
	EXIT.
USE-UMR SECTION.
	USE IF ERROR-STATUS 0009.
EUMR.
*	PROCESS ALL UMR (**09) EXCEPTIONS
	DIVIDE ERROR-STATUS BY 100 GIVING D1.
	MULTIPLY D1 BY 100 GIVING DD1.
	SUBTRACT D3 FROM ERROR-STATUS GIVING D1.
	IF D1 NOT = 9 GO TO EUMR-1.
	IF ERROR-STATUS NOT = 209 AND ERROR-STATUS NOT = 809 GO TO EUMR-2.
	IF IGN NOT = 209 AND IGN NOT = 809 GO TO EUMR-3.
	MOVE ERROR-STATUS TO IER.
	GO TO EUMR-EXIT.
EUMR-1.
	DISPLAY '?TRAPPING EXCEPTION **09, RECEIVED ',ERROR-STATUS.
	STOP RUN.
EUMR-2.
	DISPLAY '?EXPECTING EXCEPTION 0209 OR 0809, RECEIVED ',ERROR-STATUS.
	STOP RUN.
EUMR-3.
	DISPLAY '?UNEXPECTED EXCEPTION ',ERROR-STATUS.
	STOP RUN.
EUMR-EXIT.
	EXIT.
USE-DEL SECTION.
	USE IF ERROR-STATUS IS 0200.
EDEL.
*	PROCESS ANY DELETE VERB (02**) ERROR
	IF ERROR-STATUS LESS THAN 200 OR
		ERROR-STATUS GREATER THAN 299 GO TO EDEL-1.
	IF ERROR-STATUS NOT = 230 GO TO EDEL-2.
	IF ERROR-STATUS NOT = IGN GO TO EDEL-3.
	MOVE 230 TO IER.
	GO TO EDEL-EXIT.
EDEL-1.
	DISPLAY '?TRAPPING EXCEPTION 02**, RECEIVED ',ERROR-STATUS.
	STOP RUN.
EDEL-2.
	DISPLAY '?EXPECTING EXCEPTION 0230, RECEIVED ',ERROR-STATUS.
	STOP RUN.
EDEL-3.
	DISPLAY '?UNEXPECTED EXCEPTION 0230'.
	STOP RUN.
EDEL-EXIT.
	EXIT.
USE-GEN SECTION.
	USE IF ERROR-STATUS.
EGEN.
*	HANDLE ALL EXCEPS NOT HANDLED ABOVE
	IF ERROR-STATUS NOT = IGN GO TO EGEN-1.
	MOVE ERROR-STATUS TO IER.
	GO TO EGEN-EXIT.
EGEN-1.
	DISPLAY '?UNEXPECTED EXCEPTION ',ERROR-STATUS.
	STOP RUN.
EGEN-EXIT.
	EXIT.

END DECLARATIVES.

*	THE BASIC DML VERB TESTS

	DISPLAY '[Beginning basic DML tests]'.
	DISPLAY ' '.

*	*********************************
*	*  BASIC OPEN/CLOSE USAGES      *
*	*  SOME JM???? JRN MANIP CALLS  *
*	*  PLUS JRDATA & JRTEXT CALLS   *
*	*  VARIOUS OTHER VERBS AS WELL  *
*	*********************************

	MOVE 0 TO IER,IGN.
	MOVE 40 TO IPAD.
	ENTER MACRO JMDISK.
	OPEN ALL USAGE-MODE IS UPDATE PRIVACY KEY IS BADM.
	MOVE 2 TO O1C.
	STORE O1.

*	MUST CHECK PADDING OF SYSCOM ITEMS
*	V6 SPACE PADDED AFTER MOVE STATUS, NUL PADDED AFTER OTHERS
*	V6.1 SPACE PADS ALL AS DISTRIBUTED BUT CUST MAY SELECT 6 BEHAV
*	DEFAULT IPAD=<>0=ALL BLANKS, =0=V6 BEHAV
	MOVE RECORD-NAME TO WORK-NAME.
	IF WNB2 = 0 MOVE 0 TO IPAD.

	MOVE 'TESTA2' TO P1AREA.
	MOVE 0 TO DIRKE2.
	ENTER MACRO JRTEXT USING 'ABOUT TO STORE A P1 RECORD'.
	STORE P1.

*	CHECKOUT SYSCOM
	IF IPAD = 0 GO TO P10.
	IF RECORD-NAME NOT = 'P1                            ' STOP '?8880B1'.
	IF AREA-NAME NOT = 'TESTA2                        ' STOP '?8881B1'.
	GO TO P20.
P10.
	IF RECORD-NAME NOT = P1-NAME STOP '?8882B1'.
	IF AREA-NAME NOT = TESTA2-NAME STOP '?8883B1'.
P20.
	MOVE STATUS FOR RUN-UNIT TO I1.
	IF DATA-BASE-KEY NOT = I1 STOP '?8884B1'.

	ENTER MACRO JRTEXT USING 'P1 RECORD STORED'.
	CLOSE JOURNAL.

	OPEN AREA TESTA1 USAGE-MODE IS RETRIEVAL PRIVACY KEY BRET.
	OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE RETRIEVAL.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?8885B1'.

	MOVE STATUS FOR RUN-UNIT TO I1.
	IF DATA-BASE-KEY NOT = I1 STOP '?8886B1'.

	GET.
	MOVE 809 TO IGN.
	MODIFY O1.
	IF ERROR-STATUS NOT = 809 STOP '?8853B1'.
	IF IER NOT = 809 STOP '?8887B1'.
	MOVE 0 TO IGN.
	FIND FIRST RECORD OF TESTA2 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?8888B1'.
	MOVE 209 TO IGN.
	DELETE.
	IF ERROR-STATUS NOT = 209 STOP '?8854B1'.
	IF IER NOT = 209 STOP '??8889B1'.
	MOVE 0 TO IGN.
	CLOSE RUN-UNIT.

	ENTER MACRO JMNAME USING 'DSK:DTVRB.JRN'.
	ENTER MACRO JMAFT USING 0.
	OPEN JOURNAL USAGE-MODE UPDATE.
	OPEN AREA TESTA1 USAGE-MODE PROTECTED RETRIEVAL PRIVACY KEY BPRET.
	OPEN AREA TESTA2 USAGE-MODE PROTECTED UPDATE.
	MOVE 20 TO M2D1.
	STORE M2.
	MOVE 706 TO IGN.
	INSERT M2 INTO ALL SETS.
	IF ERROR-STATUS NOT = 706 STOP '?8855B1'.
	IF IER NOT = 706 STOP '?8890B1'.

*	CHECKOUT SYSCOM
	IF IPAD = 0 GO TO P30.
	IF ERROR-RECORD NOT = 'M2                            ' STOP '?8891B1'.
	IF ERROR-AREA NOT = 'TESTA2                        ' STOP '?8892B1'.
	IF ERROR-SET NOT = 'O1M2                          ' STOP '?8893B1'.
	GO TO P40.
P30.
	IF ERROR-RECORD NOT = M2-NAME STOP '?8894B1'.
	IF ERROR-AREA NOT = TESTA2-NAME STOP '?8895B1'.
	IF ERROR-SET NOT = O1M2-NAME  STOP '?8896B1'.
P40.
	MOVE 0 TO IGN.
	ENTER MACRO JRDATA USING SYSCOM,44.
	CLOSE AREA TESTA1,TESTA2.
	CLOSE JOURNAL.

	ENTER MACRO JMBOTH USING 'TESTA1','TESTA2'.
	OPEN ALL USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD.
	OPEN TRANSACTION TU.
	ENTER MACRO JRTEXT USING 'DELETEING ALL RECORDS'.
	FIND FIRST O1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?8897B1'.
	DELETE ALL.
	FIND FIRST P1 RECORD OF TESTA2 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?8898B1'.
	DELETE P1.
	FIND M2.
	IF ERROR-STATUS NOT = 0 STOP '?8899B1'.
	DELETE.
	ENTER MACRO JRDATA USING SYSCOM,44.
	CLOSE TRANSACTION TU.
	CLOSE ALL.
	CLOSE RUN-UNIT.

	ENTER MACRO JMNONE USING 'TESTA2'.
	OPEN JOURNAL USAGE-MODE EXCLUSIVE UPDATE.
	MOVE 938 TO IGN.
	OPEN ALL USAGE-MODE UPDATE PRIVACY KEY BADM.
	IF ERROR-STATUS NOT = 938 STOP '?8856B1'.
	IF IER NOT = 938 STOP '?88104B1'.
	MOVE 0 TO IGN.
	CLOSE JOURNAL.

	ENTER MACRO JMBEF USING 'TESTA2'.
	OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE UPDATE.
	MOVE 938 TO IGN.
	OPEN AREA TESTA1 USAGE-MODE IS UPDATE PRIVACY KEY IS BUPD.
	IF ERROR-STATUS NOT = 938 STOP '?8857B1'.
	IF IER NOT = 938 STOP '?88138B1'.
	MOVE 0 TO IGN.
	CLOSE JOURNAL.

*	*****************************
*	*  SOME TRANSACTION MANIPS  *
*	*****************************
	OPEN AREA TESTA1 USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD.
	OPEN TRANSACTION TUA1.
	MOVE 99 TO O1C.
	MOVE 99 TO O1D1.
	STORE O1.
	CLOSE TRANSACTION.
	ENTER MACRO JSTRAN USING 'O1MANIP',1.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88100B1'.
	MOVE 30 TO O1D1.
	MODIFY.
	ENTER MACRO JETRAN USING 'O1MANIP',1.
	OPEN TRANSACTION TUA1.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88101B1'.
	MOVE 40 TO O1D1.
	MODIFY O1 O1C,O1D1.
	DELETE TRANSACTION TUA1.
	ENTER MACRO JSTRAN USING 'O1READ',2.
	FIND CURRENT OF O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88102B1'.
	DELETE O1.
	ENTER MACRO JBTRAN USING 0.
	ENTER MACRO JSTRAN USING 'O1NEGATE',3.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88103B1'.
	MODIFY O1.
	ENTER MACRO JBTRAN USING 2.
	OPEN TRANSACTION TUA1.
	DELETE O1 ALL.
	CLOSE TRANSACTION TUA1.
	OPEN TRANSACTION TRA1.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 326 STOP '?88105B1'.
	DELETE TRANSACTION.
	CLOSE JOURNAL.

*	*******************************
*	*  SOME MANUAL CALLS TO DBCS  *
*	*******************************
*	OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD
	ENTER MACRO OPEND USING -21,0,'BUPD','TESTA1'.
*	OPEN TRANSACTION TUA1
	ENTER MACRO OPENT USING 'TUA1'.
	MOVE 29 TO O1C, O1D1.
*	STORE O1
	ENTER MACRO STORED USING 'O1'.
	MOVE 29 TO M1D1, M1D2.
*	STORE M1
	ENTER MACRO STORED USING 'M1'.
*	FIND FIRST M1 RECORD OF O1M1 SET
	ENTER MACRO FIND3 USING -12,'M1','O1M1',-20.
	IF ERROR-STATUS NOT = 0 STOP '?88106B1'.
*	FIND OWNER OF O1M1 SET
	ENTER MACRO FIND4 USING 'O1M1'.
	IF ERROR-STATUS NOT = 0 STOP '?88107B1'.
*	GET O1
	ENTER MACRO GETS USING 'O1'.
*	DELETE O1 ALL
	ENTER MACRO DELETR USING 'O1',-17.
*	CLOSE TRANSACTION TUA1
	ENTER MACRO CLOTR USING 'TUA1'.
*	CLOSE AREA TESTA1
	ENTER MACRO CLOSED USING -18,'TESTA1'.
*	CLOSE JOURNAL
	ENTER MACRO CLOSED USING -28.

*	***********************
*	*  BASIC VERB USAGES  *
*	***********************
	OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD.

*	******************************************
*	*  STORES WITH VARYING SUPPRESS CLAUSES  *
*	*  MOVE CURRENCY FOR CHECKING SUPPRESS   *
*	*  SET-PREDICATES WITH BOTH              *
*	*  PLUS SOME FINDS AND DELETES           *
*	******************************************

*	FIRST THE SET-PREDICATES
	MOVE 10 TO O1C,O1D1.
P71.
	STORE O1.
	MOVE 11 TO M1D1, M1D2.
	STORE M1 SUPPRESS O1M1 CURRENCY UPDATES.
	FIND CURRENT OF O1M1 SET SUPPRESS ALL.
	IF ERROR-STATUS NOT = 0 STOP '?88108B1'.
	IF RECORD OWNER OF O1M1 SET
		NEXT SENTENCE
		ELSE MOVE 1 TO D1.
	IF RECORD NOT OWNER OF O1M1 SET STOP '?881B1'.
	IF RECORD MEMBER OF O1M1 SET STOP '?882B1'.
	IF RECORD NOT MEMBER OF O1M1 SET
		MOVE 0 TO D1
	ELSE NEXT SENTENCE.
	IF O1M1 SET NOT EMPTY
		MOVE 0 TO D1
	ELSE
		MOVE 1 TO D1.
	IF O1M1 SET EMPTY STOP '?883B1'.
	IF RECORD NOT OWNER OF O1M1 SET
		IF RECORD NOT MEMBER OF O1M1 SET STOP '?8858B1'.
	IF RECORD NOT OWNER OF ANY SET STOP '?8859B1'.
	IF RECORD OWNER OF ANY SET
		NEXT SENTENCE ELSE MOVE 1 TO D1.
	IF RECORD MEMBER OF ANY SET STOP '?8860B1'.
	IF RECORD NOT OWNER OF ANY SET
		IF RECORD NOT MEMBER OF ANY SET STOP '?8861B1'.
	IF RECORD NOT MEMBER OF ANY SET
		NEXT SENTENCE ELSE MOVE 1 TO D1.
P72.
	FIND CURRENT OF M1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88109B1'.
	IF RECORD NOT MEMBER OF O1M1 SET
		IF RECORD NOT OWNER OF O1M1 SET STOP '?884B1'.
	IF RECORD NOT MEMBER OF O1M1 SET STOP '?885B1'.
*	THIS CURR SET OCC IDENT BY MEM.
	IF O1M1 SET EMPTY STOP '?886B1'.
	IF RECORD OWNER OF O1M1 SET STOP '?8862B1'.
	IF RECORD NOT MEMBER OF ANY SET
		IF RECORD NOT OWNER OF ANY SET STOP '?8863B1'.
	IF RECORD NOT MEMBER OF ANY SET STOP '?8864B1'.
	IF RECORD OWNER OF ANY SET STOP '?8865B1'.

*	NOW MOVE CURRENCY
P1000.
	MOVE STATUS FOR RUN-UNIT TO IRU.
	MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1.
	IF AREA-NAME NOT = 'TESTA1                        ' STOP '?88110B1'.
	MOVE CURRENCY STATUS FOR O1 RECORD TO IO1.
	IF RECORD-NAME NOT = 'O1                            '  STOP '?88111B1'.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	MOVE 1000 TO O1C,O1D1.
	STORE O1 SUPPRESS ALL CURRENCY.
	MOVE STATUS FOR RUN-UNIT TO JRU.
	MOVE CURRENCY STATUS FOR TESTA1 AREA TO JA1.
	MOVE CURRENCY STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	IF IA1 NOT = JA1 OR IO1 NOT = JO1 OR IO1M1 NOT = JO1M1
		OR IO1M2 NOT = JO1M2 STOP '?8866B1'.
	IF IRU = JRU STOP '?8867B1'.
	FIND CURRENT OF RUN-UNIT.
	IF ERROR-STATUS NOT = 0 STOP '?88112B1'.
	MOVE STATUS FOR RUN-UNIT TO IRU.
	MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1.
	MOVE CURRENCY STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	IF IA1 = JA1 OR IO1 = JO1 OR IO1M1 = JO1M1
		OR IO1M2 = JO1M2 STOP '?8868B1'.
	IF IRU NOT = JRU STOP '?8869B1'.

*	AND THE REMAINING STORE SUPPRESS VARIANTS
	MOVE 21 TO M1D1.
P1001.
	STORE M1 SUPPRESS RECORD UPDATES.
	FIND CURRENT OF M1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88113B1'.
	GET.
	IF M1D1 NOT = 11 STOP '?8870B1'.
	MOVE 30 TO M1D2.
	MODIFY M1,M1D2.
	MOVE 0 TO M1D2.
	GET M1,M1D2.
	IF M1D2 NOT = 30 STOP '?88114B1'.
	MOVE 31 TO M1D1.
P1002.
	STORE M1 SUPPRESS AREA.
	FIND CURRENT OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88115B1'.
	GET M1.
	IF M1D1 NOT = 11 STOP '?8871B1'.
	MODIFY.
	MOVE 2000 TO O1C.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
P1003.
	STORE O1 SUPPRESS SET CURRENCY UPDATES.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	IF IO1M1 NOT = JO1M1 OR IO1M2 NOT = JO1M2 STOP '?8872B1'.
	FIND CURRENT OF RUN-UNIT.
	IF ERROR-STATUS NOT = 0 STOP '?88116B1'.
	MOVE 41 TO M1D1.
	MOVE STATUS FOR M1 RECORD TO IM1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
P1004.
*	STORE M1 SUPPRESS RECORD, O1M1 UPDATES.
	STORE M1 SUPPRESS RECORD UPDATES.
	MOVE STATUS FOR M1 RECORD TO JM1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
*	IF IM1 NOT = JM1 OR IO1M1 NOT = JO1M1 STOP '?8873B1'.
	IF IM1 NOT = JM1 STOP '?8873B1'.
	MOVE 51 TO M1D1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
P1005.
*	STORE M1 SUPPRESS AREA O1M1 CURRENCY.
	STORE M1 SUPPRESS AREA CURRENCY.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
*	IF IA1 NOT = JA1 OR IO1M1 NOT = JO1M1 STOP '?8874B1'.
	IF IA1 NOT = JA1 STOP '?8874B1'.
	MOVE 3000 TO O1C.
	MOVE STATUS FOR O1 RECORD TO IO1.
*	THE FOLLOWING 1 STATEMENT REQUIRED DUE TO SUPPRESS BUGS ABOVE
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
P1006.
	STORE O1 SUPPRESS RECORD SET CURRENCY UPDATES.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	IF IO1 NOT = JO1 OR IO1M1 NOT = JO1M1 OR IO1M2 NOT = JO1M2
		STOP '?8875B1'.
	FIND CURRENT OF RUN-UNIT SUPPRESS O1M1.
	IF ERROR-STATUS NOT = 0 STOP '?88117B1'.
	MOVE 61 TO M1D1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
P1007.
	STORE M1 SUPPRESS AREA SET CURRENCY.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	IF IA1 NOT = JA1 OR IO1M1 NOT = JO1M1  STOP '?8876B1'.
	FIND CURRENT OF RUN-UNIT.
	IF ERROR-STATUS NOT = 0 STOP '?88118B1'.
P1008.
	DELETE.
	MOVE STATUS FOR M1 RECORD TO IM1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
P1009.
	STORE M1 SUPPRESS RECORD AREA CURRENCY UPDATES.
	MOVE STATUS FOR M1 RECORD TO JM1.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	IF IM1 NOT = JM1 OR IA1 NOT = JA1 STOP '?8877B1'.
	MOVE CURRENCY STATUS FOR O1M1 SET TO IO1M1.
	MOVE CURRENCY STATUS FOR O1M2 SET TO IO1M2.
P1010.
	STORE O1 SUPPRESS O1M1, O1M2 CURRENCY.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	IF IO1M1 NOT = JO1M1 OR IO1M2 NOT = JO1M2 STOP '?8878B1'.
	MOVE 71 TO M1D1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
P1011.
*	STORE M1 SUPPRESS RECORD, AREA, O1M1 UPDATES.
	STORE M1 SUPPRESS RECORD, AREA UPDATES.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR M1 RECORD TO JM1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
*	IF IA1 NOT = JA1 OR IM1 NOT = JM1 OR IO1M1 NOT = JO1M1 STOP '?8879B1'.
	IF IA1 NOT = JA1 OR IM1 NOT = JM1 STOP '?8879B1'.

*	CLEANUP FOR REST OF TEST
	MOVE 1000 TO O1C.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88119B1'.
	DELETE ALL.
	MOVE 2000 TO O1C.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88120B1'.
	DELETE MEMBERS.
	DELETE.
	MOVE 3000 TO O1C.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88121B1'.
	DELETE.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88122B1'.
	DELETE O1.
	MOVE 10 TO O1C.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88123B1'.
	FIND NEXT RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88124B1'.
	FIND NEXT RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88125B1'.
	DELETE M1.

*	ONE LAST STORE/SUPPRESS, MOVE CURRENCY CHECK, SETUP FOR LATER
	MOVE 12 TO M1D1,M1D2.
P73.
	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 ERROR-STATUS NOT = 0 STOP '?88236B1'.
	MOVE CURRENCY STATUS FOR TESTA1 AREA TO J2.
	IF I1 NOT = I2 STOP '?887B1'.
	IF J1 NOT = J2 STOP '?888B1'.
	IF I1 = J1 STOP '?889B1'.

*	****************************
*	*  FIND CALC (RSE5) CASES  *
*	****************************

P74.
	MOVE 23 TO O1C,O1D1.
	ENTER MACRO CALCHN USING 'O1'.
	MOVE DATA-BASE-KEY TO K1.
	STORE O1.
	MOVE DATA-BASE-KEY TO K2.
	DIVIDE K1 BY 512 GIVING D1.
	DIVIDE K2 BY 512 GIVING D2.
	IF D1 NOT = D2 STOP '?88126B1'.
	MOVE 10 TO O1C.
	ENTER MACRO CALCHN USING 'O1'.
	MOVE DATA-BASE-KEY TO K1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
*	FIND O1 SUPPRESS AREA, RECORD, O1M1 CURRENCY.
	FIND O1 SUPPRESS AREA, RECORD CURRENCY.
	IF ERROR-STATUS NOT = 0 STOP '?88237B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	IF IA1 NOT = JA1 STOP '?88238B1'.
	IF IO1 NOT = JO1 STOP '?88239B1'.
*	IF IO1M1 NOT = JO1M1 STOP '?88240B1'.
	MOVE DATA-BASE-KEY TO K2.
	DIVIDE K1 BY 512 GIVING D1.
	DIVIDE K2 BY 512 GIVING D2.
	IF D1 NOT = D2 STOP '?88127B1'.
	IF ERROR-STATUS NOT = 0 STOP '?8810B1'.
	MOVE 0 TO O1C.
	GET O1.
	IF O1C NOT = 10 STOP '?8811B1'.
	FIND DUPLICATE O1.
	IF ERROR-STATUS NOT = 326 STOP '?8812B1'.
	MOVE 11 TO O1D1.
P75.
	STORE O1.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
	MOVE STATUS FOR O1M4 SET TO IO1M4.
	FIND O1 RECORD SUPPRESS AREA,SET CURRENCY UPDATES.
	IF ERROR-STATUS NOT = 0 STOP '?8813B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	MOVE STATUS FOR O1M4 SET TO JO1M4.
	IF IA1 NOT = JA1 STOP '?88241B1'.
	IF IO1M1 NOT = JO1M1 STOP '?88242B1'.
	IF IO1M2 NOT = JO1M2 STOP '?88243B1'.
	IF IO1M3 NOT = JO1M3 STOP '?88244B1'.
	IF IO1M4 NOT = JO1M4 STOP '?88245B1'.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
*	FIND NEXT DUPLICATE WITHIN O1 RECORD SUPPRESS
*		 AREA ,O1M1, RECORD, O1M3 UPDATES.
	FIND NEXT DUPLICATE WITHIN O1 RECORD SUPPRESS
		 AREA, RECORD UPDATES.
	IF ERROR-STATUS NOT = 0 STOP '?8814B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	IF IA1 NOT = JA1 STOP '?88246B1'.
	IF IO1 NOT = JO1 STOP '?88247B1'.
*	IF IO1M1 NOT = JO1M1 STOP '?88248B1'.
*	IF IO1M3 NOT = JO1M3 STOP '?88249B1'.
	GET O1,O1C.
	IF O1C NOT = 10 STOP '?8815B1'.

*	*******************************************
*	*  FIND DIRECT (RSE1)                     *
*	*  FIND [OWN] CURRENT (RSE2) COMPLICATED  *
*	*  FIND OWNER (RSE4)                      *
*	*******************************************
*	I1=I2=DATA-BASE-KEY 2ND M1 IN 1ST O1
*	J1=J2=DATA-BASE-KEY F1
P76.
	FIND F1 USING J1.
	IF ERROR-STATUS NOT = 0 STOP '?8816B1'.
	FIND F1 USING I1.
	IF ERROR-STATUS NOT = 326 STOP '?8817B1'.
	FIND USING I1.
	IF ERROR-STATUS NOT = 0 STOP '?8818B1'.

	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR M1 RECORD TO IM1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
	MOVE STATUS FOR O1M4 SET TO IO1M4.
P77.
	FIND OWNER O1M1 CURRENT O1M1 SET SUPPRESS RECORD,AREA,SET.
	IF ERROR-STATUS NOT = 0 STOP '?88250B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR M1 RECORD TO JM1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	MOVE STATUS FOR O1M4 SET TO JO1M4.
	IF IA1 NOT = JA1 STOP '?88251B1'.
	IF IO1 NOT = JO1 STOP '?88252B1'.
	IF IM1 NOT = JM1 STOP '?88253B1'.
	IF IO1M1 NOT = JO1M1 STOP '?88254B1'.
	IF IO1M2 NOT = JO1M2 STOP '?88255B1'.
	IF IO1M3 NOT = JO1M3 STOP '?88256B1'.
	IF IO1M4 NOT = JO1M4 STOP '?88257B1'.
	IF RECORD NOT OWNER OF ANY SET STOP '?8819B1'.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	FIND OWNER O1M1 CURRENT TESTA1 AREA SUPPRESS RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88258B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1 RECORD TO JO1.
	IF IO1 NOT = JO1 STOP '?88260B1'.
	IF IM1 NOT = JM1 STOP '?88261B1'.
	MOVE STATUS FOR M1 RECORD TO I3.
*	INSURE OLD VALUE.
	IF I1 NOT = I3 STOP '?8820B1'.
*	NOW CHK FIND CURR AND STRING MANIP
	MOVE STATUS FOR O1M1 SET TO K1.
	IF RECORD-NAME NOT = 'O1                            ' STOP '?8821B1'.
P1030.
	MOVE 99 TO M4D1.
	MOVE 999 TO M4D2.
	STORE M4.
	INSERT INTO ALL SETS.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
*	FIND LAST M1 RECORD OF TESTA1 AREA SUPPRESS O1M1, AREA CURRENCY UPDATES.
	FIND LAST M1 RECORD OF TESTA1 AREA SUPPRESS AREA CURRENCY UPDATES.
	IF ERROR-STATUS NOT = 0 STOP '?88217B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	IF IA1 NOT = JA1 STOP '?88262B1'.
*	IF IO1M1 NOT = JO1M1 STOP '?88263B1'.
	MOVE STATUS FOR M1 RECORD TO IM1.
	FIND M1 USING IM1.
	IF ERROR-STATUS NOT = 0 STOP '?88294B1'.
	FIND CURRENT OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88218B1'.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	IF IM1 NOT = IA1 STOP '?88219B1'.
	GET.
	IF M1D1 NOT = 12 STOP '?88220B1'.
	IF M1D2 NOT = 12 STOP '?88221B1'.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	FIND OWNER IN O1M1 OF CURRENT OF M1 RECORD SUPPRESS O1M1.
	IF ERROR-STATUS NOT = 0 STOP '?88264B1'.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	IF IO1M1 NOT = JO1M1 STOP '?88265B1'.
	GET.
	IF O1C NOT = 10 STOP '?88222B1'.
	IF O1D1 NOT = 10 STOP '?88223B1'.
	MOVE STATUS FOR RUN-UNIT TO IO1.
	FIND FIRST M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88224B1'.
	FIND OWNER IN O1M1 CURRENT OF RUN-UNIT.
	IF ERROR-STATUS NOT = 0 STOP '?88225B1'.
	MOVE STATUS FOR O1 RECORD TO JO1.
	IF IO1 NOT = JO1 STOP '?88226B1'.
	FIND FIRST M4 RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88227B1'.
	FIND OWNER IN F1M4 CURRENT OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88228B1'.
	MOVE STATUS FOR F1 RECORD TO J2.
	IF J1 NOT = J2 STOP '?88229B1'.
	FIND CURRENT OF M4 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88230B1'.
	FIND OWNER IN F1M4 CURRENT OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88231B1'.
	MOVE STATUS FOR RUN-UNIT TO J2.
	IF J1 NOT = J2 STOP '?88232B1'.
	FIND LAST M4 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88233B1'.
	REMOVE M4 FROM F1M4,O1M4.
	DELETE.

P78.
	FIND OWNER OF O1M1.
	IF ERROR-STATUS NOT = 0 STOP '?88128B1'.
	MOVE STATUS FOR O1M1 SET TO K2.
*	GET OWNER WHEN CURR OF SET IS MEM
	FIND M1 USING I1.
	IF ERROR-STATUS NOT = 0 STOP '?88129B1'.
	FIND OWNER OF O1M1.
	IF ERROR-STATUS NOT = 0 STOP '?88266B1'.
	MOVE STATUS FOR O1M1 SET TO K3.
	IF K1 NOT = K2 STOP '?8822B1'.
	IF K1 NOT = K3 STOP '?8823B1'.

*	******************************************************
*	*  FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF AREA (RSE3)  *
*	******************************************************
	OPEN TRANSACTION TRA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
P79.
*	FIND FIRST RECORD TESTA1 AREA SUPPRESS O1M3, RECORD.
	FIND FIRST RECORD TESTA1 AREA SUPPRESS RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88267B1'.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	IF IO1 NOT = JO1 STOP '?88268B1'.
*	IF IO1M3 NOT = JO1M3 STOP '?88269B1'.
	MOVE STATUS FOR TESTA1 AREA TO L1.
*	VERIF REALLY AT 1ST.
	FIND PRIOR RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 307 STOP '?8824B1'.
	IF IER NOT = 307 STOP '?88194B1'.
*	 NOW FIND ALL RECORDS
	MOVE 0 TO LCOUNT.
P11.
	FIND NEXT RECORD OF TESTA1 AREA.
*	COUNTS FIND BEFORE 1 JUST DONE
	ADD 1 TO LCOUNT.
	IF ERROR-STATUS NOT = 307 GO TO P11.
*	THE NUM OF STORE STATS.
	IF LCOUNT NOT = 6 STOP '?8825B1'.
P710.
	MOVE STATUS FOR TESTA1 AREA TO L2.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M4 SET TO IO1M4.
	FIND LAST RECORD OF TESTA1 AREA SUPPRESS O1M1, O1M4.
*	DON'T WANT NOOP TO BE REASON NEXT TEST SUCS.
	IF ERROR-STATUS NOT = 0 STOP '?8826B1'.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M4 SET TO JO1M4.
	IF IO1M1 NOT = JO1M1 STOP '?88270B1'.
	IF IO1M4 NOT = JO1M4 STOP '?88271B1'.
	MOVE STATUS FOR TESTA1 AREA TO L3.
	IF L2 NOT = L3 STOP '?8827B1'.
P12.
	FIND PRIOR RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 307 GO TO P12.
	MOVE STATUS FOR TESTA1 AREA TO L4.
	IF L1 NOT = L4 STOP '?8828B1'.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
	MOVE STATUS FOR O1M4 SET TO IO1M4.
P711.
	FIND LCOUNT RECORD OF TESTA1 AREA SUPPRESS SET RECORD CURRENCY.
	IF ERROR-STATUS NOT = 0 STOP '?88272B1'.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	MOVE STATUS FOR O1M4 SET TO JO1M4.
	IF IO1 NOT = JO1 STOP '?88273B1'.
	IF IO1M1 NOT = JO1M1 STOP '?88274B1'.
	IF IO1M2 NOT = JO1M2 STOP '?88275B1'.
	IF IO1M3 NOT = JO1M3 STOP '?88276B1'.
	IF IO1M4 NOT = JO1M4 STOP '?88277B1'.
	MOVE STATUS FOR TESTA1 AREA TO L5.
	IF L2 NOT = L5 STOP '?8829B1'.
	MOVE STATUS FOR O1M1 SET TO IO1M1.
	MOVE STATUS FOR O1M2 SET TO IO1M2.
	MOVE STATUS FOR O1M3 SET TO IO1M3.
	MOVE STATUS FOR O1M4 SET TO IO1M4.
	FIND -6 RECORD OF TESTA1 AREA SUPPRESS SET UPDATES.
	IF ERROR-STATUS NOT = 0 STOP '?88278B1'.
	MOVE STATUS FOR O1M1 SET TO JO1M1.
	MOVE STATUS FOR O1M2 SET TO JO1M2.
	MOVE STATUS FOR O1M3 SET TO JO1M3.
	MOVE STATUS FOR O1M4 SET TO JO1M4.
	IF IO1M1 NOT = JO1M1 STOP '?88279B1'.
	IF IO1M2 NOT = JO1M2 STOP '?88280B1'.
	IF IO1M3 NOT = JO1M3 STOP '?88281B1'.
	IF IO1M4 NOT = JO1M4 STOP '?88282B1'.
	MOVE STATUS FOR TESTA1 AREA TO L6.
	IF L1 NOT = L6 STOP '?8830B1'.
*	 SPEC A RECORD TYPE EXPLIC (& INVOLVE RANGE SCOPING IN FND.NA)
P712.
	FIND FIRST M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?8831B1'.
	FIND NEXT M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?8832B1'.
*	KNOWN TO BE 2 M1'S, SO SHOULD FAIL
	FIND NEXT M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 307 STOP '?8833B1'.

	FIND LAST M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88198B1'.
	FIND PRIOR M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88199B1'.
	FIND PRIOR M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 307 STOP '?88200B1'.
	FIND 2 M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88201B1'.
	FIND NEXT M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 307 STOP '?88202B1'.
	FIND -1 M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88203B1'.
	FIND PRIOR M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88204B1'.
	CLOSE TRANSACTION TRA1.

*	*****************************************************
*	*  FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF SET (RES3)  *
*	*****************************************************
	MOVE STATUS FOR TESTA1 AREA TO IA1.
P713.
	FIND FIRST RECORD O1M1 SET SUPPRESS AREA CURRENCY.
	IF ERROR-STATUS NOT = 0 STOP '?88130B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	IF IA1 NOT = JA1 STOP '?88283B1'.
	MOVE STATUS FOR O1M1 SET TO N1.
*	VERIF REALLY AT 1ST.
	FIND PRIOR RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 307 STOP '?8835B1'.
*	 NOW FIND ALL RECORDS
	MOVE 0 TO NCOUNT.
P16.
	MOVE 2 TO M1D1.
	MOVE 3 TO M1D2.
	MODIFY M1,M1D2,M1D1.
	MOVE 0 TO M1D1, M1D2.
	GET M1,M1D1,M1D2.
	IF M1D1 NOT = 2 OR M1D2 NOT = 3 STOP '?8836B1'.
	FIND NEXT RECORD OF O1M1 SET.
*	COUNTS FIND BEFORE 1 JUST DONE
	ADD 1 TO NCOUNT.
	IF ERROR-STATUS NOT = 307 GO TO P16.
*	THE NUM OF STORE STATS.
	IF NCOUNT NOT = 2 STOP '?8837B1'.

	OPEN TRANSACTION TRA1.
P714.
	MOVE STATUS FOR O1M1 SET TO N2.
*	 VERIFY FIND OF PRIOR REC USING OB.CPRI
	FIND PRIOR RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88284B1'.
	MOVE STATUS FOR O1M1 SET TO N3.
	IF N1 NOT = N3 STOP '?8837AB1'.
*	 VERIF FIND LAST (AGAINST LAST OF 16-LOOP).
	FIND LAST RECORD OF O1M1 SET.
*	DON'T WANT NOOP TO BE REASON NEXT TEXT SUCS.
	IF ERROR-STATUS NOT = 0 STOP '?8838B1'.
	MOVE STATUS FOR O1M1 SET TO N3.
	IF N2 NOT = N3 STOP '?8839B1'.
P17.
	FIND PRIOR RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 307 GO TO P17.
	MOVE STATUS FOR O1M1 SET TO N4.
	IF N1 NOT = N4 STOP '?8840B1'.
	MOVE STATUS FOR TESTA1 AREA TO IA1.
	MOVE STATUS FOR O1 RECORD TO IO1.
	MOVE STATUS FOR M1 RECORD TO IM1.
P715.
	FIND NCOUNT RECORD OF O1M1 SET SUPPRESS AREA RECORD UPDATES.
	IF ERROR-STATUS NOT = 0 STOP '?88285B1'.
	MOVE STATUS FOR TESTA1 AREA TO JA1.
	MOVE STATUS FOR O1 RECORD TO JO1.
	MOVE STATUS FOR M1 RECORD TO JM1.
	IF IA1 NOT = JA1 STOP '?88286B1'.
	IF IO1 NOT = JO1 STOP '?88287B1'.
	IF IM1 NOT = JM1 STOP '?88288B1'.
	MOVE STATUS FOR O1M1 SET TO N5.
	IF N2 NOT = N5 STOP '?8841B1'.
	FIND -2 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88289B1'.
	MOVE STATUS FOR O1M1 SET TO N6.
	IF N1 NOT = N6 STOP '?8842B1'.
	CLOSE TRANSACTION.

*	 SPEC A REC TYPE EXPLIC
P716.
	FIND FIRST M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?8843B1'.
	REMOVE FROM ALL.
	FIND NEXT M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?8844B1'.
*	KNOWN TO BE 2 M1'S, SO SHOULD FAIL
	FIND NEXT M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 307 STOP '?8845B1'.
	REMOVE M1 FROM O1M1.
	FIND NEXT RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 326 STOP '?8846B1'.
	IF IER NOT = 326 STOP '?88195B1'.

	FIND FIRST M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88210B1'.
	INSERT INTO ALL SETS.
	FIND NEXT M1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88211B1'.
	INSERT INTO O1M1.
	FIND LAST M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88205B1'.
	FIND PRIOR M1 RECORD O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88206B1'.
	FIND PRIOR M1 RECORD O1M1 SET.
	IF ERROR-STATUS NOT = 307 STOP '?88207B1'.
	FIND 2 M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88208B1'.
	FIND NEXT M1 RECORD OF O1M1 SET.
	IF ERROR-STATUS NOT = 307 STOP '?88209B1'.
	FIND -1 M1 RECORD O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88210B1'.
	REMOVE FROM O1M1.
	FIND PRIOR M1 RECORD O1M1 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88211B1'.
	REMOVE FROM ALL.

*	***************************************************
*	*  FIND SORTED (RSE6) SORTED/UNSORTED, AND FINS6  *
*	*  PLUS ASSORTED INSERTS AND REMOVES              *
*	***************************************************
P1050.
	FIND FIRST F1 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88131B1'.
	MOVE 10 TO O1C.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88290B1'.
	MOVE 100 TO M3D1.
	STORE M3.
	MOVE 200 TO M3D1.
	STORE M3.
	MOVE 150 TO M3D1.
	STORE M3.
	MOVE 1000 TO M4D1.
	MOVE 10 TO M4D2.
	STORE M4.
	INSERT INTO ALL.
	MOVE 20 TO M4D2.
	STORE M4.
	INSERT M4 INTO ALL.
	MOVE 2000 TO M4D1.
	MOVE 10 TO M4D2.
	STORE M4.
	INSERT M4 INTO O1M4,F1M4.
	MOVE 20 TO M4D2.
	STORE M4.
	INSERT INTO F1M4.
	MOVE 30 TO M4D2.
	STORE M4.
	INSERT INTO O1M4.
P1051.
	MOVE 23 TO O1C.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88291B1'.
	MOVE 75 TO M3D1.
	STORE M3.
	MOVE 200 TO M3D1.
	STORE M3.
	MOVE 1000 TO M4D1.
	MOVE 40 TO M4D2.
	STORE M4.
	INSERT M4 INTO ALL SETS.
	MOVE 50 TO M4D2.
	STORE M4.
	INSERT M4 INTO O1M4.
	MOVE 2000 TO M4D1.
	MOVE 40 TO M4D2.
	STORE M4.
	INSERT M4 INTO  ALL.
	MOVE 3000 TO M4D1.
	MOVE 10 TO M4D2.
	STORE M4.
	MOVE 20 TO M4D2.
	STORE M4.
	INSERT M4 INTO ALL.
	MOVE 10 TO O1C.

*	EXACT (NON RANGE) FINDS, SORTED, SINGLE KEY
P1052.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88139B1'.
	MOVE 150 TO M3D1.
	FIND M3 VIA CURRENT OF O1M3 USING M3D1.
	IF ERROR-STATUS NOT = 0 STOP '?88140B1'.
	MOVE 75 TO M3D1.
	FIND M3 VIA CURRENT OF O1M3 USING M3D1.
	IF ERROR-STATUS NOT = 326 STOP '?88141B1'.
P1053.
	MOVE 23 TO O1C.
	FIND O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88142B1'.
	FIND M3 VIA CURRENT OF O1M3 USING M3D1.
	IF ERROR-STATUS NOT = 0 STOP '?88143B1'.
	ENTER MACRO FINS6 USING 'M3','O1M3'.
	IF ERROR-STATUS NOT = 0 STOP '?88144B1'.

*	RANGE CASE FINDS, SORTED, MULTI KEY
P1054.
	MOVE 1000 TO M4D1.
	MOVE 60 TO M4D2.
	FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 0 STOP '?88145B1'.
	IF ERROR-DATA NOT = 2 STOP '?88146B1'.
	GET M4.
	IF M4D1 NOT = 2000 STOP '?88147B1'.
	IF M4D2 NOT = 40 STOP '?88148B1'.
	MOVE 3000 TO M4D1.
	MOVE 0 TO M4D2.
	FIND M4 VIA CURRENT OF O1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 0 STOP '?88149B1'.
	IF ERROR-DATA NOT = 1 STOP '?88150B1'.
	GET M4 M4D1,M4D2.
	IF M4D1 NOT = 3000 STOP '?88151B1'.
	IF M4D2 NOT = 20 STOP '?88152B1'.

*	BOUNDARY AND EMPTY CHECKS
	MOVE 30 TO M4D2.
	FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 307 STOP '?88153B1'.
	MOVE 10 TO M3D1.
	FIND M3 VIA CURRENT O1M3 USING M3D1.
	IF ERROR-STATUS NOT = 326 STOP '?88154B1'.
P1055.
	MOVE 10 TO O1C.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88155B1'.
	FIND DUPLICATE O1.
	IF ERROR-STATUS NOT = 0 STOP '?88156B1'.
	FIND M3 VIA CURRENT O1M3 USING M3D1.
	IF ERROR-STATUS NOT = 326 STOP '?88157B1'.
	FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 307 STOP '?88158B1'.

*	SORTED, NON SORTED FINDS SAME SET OCC
P1056.
*	BACK TO 1ST OCC
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88196B1'.
	FIND OWNER F1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88197B1'.
	MOVE 2000 TO M4D1.
	MOVE 10 TO M4D2.
	FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET.
	IF ERROR-STATUS NOT = 0 STOP '?88159B1'.
	IF ERROR-DATA NOT = 0 STOP '?88160B1'.
	GET M4.
	IF M4D1 NOT = 2000 STOP '?88161B1'.
	IF M4D2 NOT = 10 STOP '?88162B1'.
	FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2 SUPPRESS SET.
	IF ERROR-STATUS NOT = 0 STOP '?88163B1'.
	GET.
	IF M4D1 NOT = 2000 STOP '?88164B1'.
	IF M4D2 NOT = 10 STOP '?88165B1'.
	MOVE 20 TO M4D2.
*	FROM SET PREV
	FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 0 STOP '?88166B1'.
	GET M4.
	IF M4D1 NOT = 2000 STOP '?88167B1'.
	IF M4D2 NOT = 20 STOP '?88168B1'.
	FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET.
	IF ERROR-STATUS NOT = 0 STOP '?88169B1'.
	IF ERROR-DATA NOT = 2 STOP '?88170B1'.
	GET M4.
	IF M4D1 NOT = 2000 STOP '?88171B1'.
	IF M4D2 NOT = 30 STOP '?88172B1'.
	FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2.
	IF ERROR-STATUS NOT = 307 STOP '?88173B1'.
	ENTER MACRO FINS6 USING 'M4','O1M4'.
	IF ERROR-STATUS NOT = 0 STOP '?88174B1'.
P1057.
	MOVE 1000 TO M4D1.
	MOVE 30 TO M4D2.
*	1 KEY DEFS FND 3
	FIND M4 VIA CURRENT O1M4 USING M4D1.
	IF ERROR-STATUS NOT = 307 STOP '?88175B1'.
	FIND OWNER O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88176B1'.
	FIND OWNER F1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88177B1'.
	FIND M4 VIA CURRENT O1M4 USING M4D1.
	IF ERROR-STATUS NOT = 0 STOP '?88178B1'.
	GET.
	IF M4D1 NOT = 1000 STOP '?88179B1'.
	IF M4D2 NOT = 10 STOP '?88180B1'.
	FIND M4 VIA CURRENT F1M4 USING M4D1.
	IF ERROR-STATUS NOT = 0 STOP '?88181B1'.
	GET.
	IF M4D1 NOT = 1000 STOP '?88182B1'.
	IF M4D2 NOT = 20 STOP '?88183B1'.

*	CLEANUP
P1058.
	FIND OWNER O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88184B1'.
	DELETE MEMBERS FROM O1M3.
	FIND FIRST RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88185B1'.
	REMOVE FROM ALL.
	DELETE.
	FIND NEXT RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88186B1'.
	REMOVE M4 FROM ALL.
	DELETE M4.
	FIND NEXT RECORD OF F1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88187B1'.
	REMOVE M4 FROM ALL SETS.
	DELETE.
	FIND NEXT RECORD OF F1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88188B1'.
	REMOVE M4 FROM F1M4.
	DELETE.
	FIND NEXT RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88189B1'.
	REMOVE M4 FROM O1M4.
	DELETE.
P1059.
	MOVE 23 TO O1C.
	FIND O1.
	IF ERROR-STATUS NOT = 0 STOP '?88190B1'.
	FIND NEXT RECORD OF F1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88191B1'.
	REMOVE FROM O1M4,F1M4.
	DELETE.
	FIND NEXT RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88192B1'.
	REMOVE M4 FROM ALL SETS.
	DELETE.
	FIND NEXT RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88193B1'.
	REMOVE M4 FROM F1M4,O1M4.
	DELETE.
	FIND LAST RECORD OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88214B1'.
	REMOVE M4 FROM ALL.
	DELETE.
	FIND LAST M4 RECORD OF TESTA1 AREA.
	IF ERROR-STATUS NOT = 0 STOP '?88215B1'.
	DELETE.
	FIND OWNER OF O1M4 SET.
	IF ERROR-STATUS NOT = 0 STOP '?88216B1'.
	DELETE MEMBERS FROM O1M3.

*	****************************************************
*	*  DELETES, HANDLED FROM SUBS WITH 2ND SUB-SCHEMA  *
*	*  TRIVIAL CASE DONE THROUGHOUT MAIN PROGRAM       *
*	****************************************************
*	INIT
	CALL DTVRB2.
*	DELETE RECORD THEN DELETE ALL
	CALL DELCAS USING 1.
*	DELETE SELECTIVE
	CALL DELCAS USING 2.
*	DELETE RECORD ONLY
	CALL DELCAS USING 3.
*	DELETE MEMBERS
	CALL DELCAS USING 4.

*	MAKE SURE ORIG SUB-SCHEMA NOT AFFECTED
	MOVE 10 TO O1C.
	FIND O1 RECORD.
	GET O1 O1D1.
	DELETE ALL.
*	DELETE RECORD ALL MEMBERS
	CALL DELCAS USING 5.
*	DELETE RECORD SELECTIVE MEMBERS
	CALL DELCAS USING 6.

	OPEN TRANSACTION TUA1.
	FIND NEXT DUPLICATE WITHIN O1 RECORD.
	IF ERROR-STATUS NOT = 0 STOP '?88292B1'.
	DELETE ALL.
	CLOSE TRANSACTION.
*	DELETE RECORD ONLY MEMBERS
	CALL DELCAS USING 7.
*	DELETE RECORD SELECTIVE MEMBERS SET
	CALL DELCAS USING 8.
*	DELETE RECORD ONLY MEMBERS SET1,SET2
	CALL DELCAS USING 9.
*	CLOSE AREA
	CALL DELCAS USING 10.
	MOVE 23 TO O1C.
	FIND O1.
	DELETE MEMBERS.
	DELETE O1.

P99.
	CLOSE AREA TESTA1.
	CLOSE JOURNAL.

	ENTER MACRO STATS.
	DISPLAY '[Completed basic DML tests]'.
	STOP RUN.