PROGRAM DATABASE;

(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  	DATABASE EXAMPLE VERSION 1.0 9/14/82  0935
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

(*$E-*)

CONST
	MAX_KEY = 2;
	MAX_FIELD = 7;
	MAX_KEY_LEN = 20;
	MAX_FLD_LEN = 20;
	NAME_LEN = 14;
	FLD_NAME_LEN = 18;
	ACTION_LEN = 4;
	NEW_MODE = 1;
	OLD_MODE = 2;
	YES = 1;
	NO = 0;
	SAVE = 1;
	DELT = 2;
	BACK = 3;
	CONT = 4;
	STOP = 5;

TYPE
	BYTEPTR = ^BYTE;
	KEYSTR = STRING[MAX_KEY_LEN];
	FLDSTR = STRING[MAX_FLD_LEN];

	FLD_REC = RECORD;
		LENBYTE : BYTE;
		FLDCHR  : ARRAY[1..MAX_FLD_LEN] OF CHAR;
	END;

	CUST_REC = RECORD;
		CDF : CHAR;
		FLD : ARRAY[1..99] OF CHAR;
	END;

(* WORKING VARIABLES *)

VAR
	KEY,TERMINAL,TRAP_ERRORS,TIME_OUT_TEST_DELAY,NO_BUFFERS : INTEGER;
	NO_NODE_SECTORS,NO_DATA_FILES,NO_KEYZ,FILE_NO : INTEGER;
	RECORD_LENGTH : INTEGER;
	SET_LENGTH,IDX_KEY,SPACE : KEYSTR;
	OLD_ACTION : INTEGER;
	FILNAME : STRING[NAME_LEN];
	NULL_BYT : BYTE;
	NULL_CHR : CHAR;

(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  	 DATABASE FIELD & KEY DESCRIPTORS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

	DATBUF : CUST_REC;
	DATBUF_PTR : ^CUST_REC;
	FLD_NAME,KEY_NAME : ARRAY[0..MAX_FIELD] OF STRING[FLD_NAME_LEN];
	FLD_LEN : ARRAY[0..MAX_FIELD] OF BYTE;
	OLD_FLD,NEW_FLD : ARRAY[0..MAX_FIELD] OF FLDSTR;
	NO_FIELDS : INTEGER;

	IDX_NAME : ARRAY[0..MAX_KEY] OF STRING[NAME_LEN];
	KEY_LEN,KEY_MAP,KEY_TYPE,KEY_NUM,KEY_DUP : ARRAY[0..MAX_KEY] OF
		INTEGER;
	FOR_EVER : BOOLEAN;
	UNIQ_KEY,NLOCK,SLOCK,XLOCK,SFILE,XFILE,RLOCK : INTEGER;
  
(*   	INTERFACE TO ACCESS MANAGER(tm)
  
   	AM86EXTR.PSC CONTAINS THE EXTERNAL DEFINITIONS OF THE ACCESS MANAGER
	ROUTINES. *)

{$I AM86EXTR.PSC}

EXTERNAL FUNCTION @BDOS86(FUNC:INTEGER; PARM:BYTEPTR) : INTEGER;

(*$P*)
PROCEDURE GO_OP_SYS;

VAR
	DUMMY : INTEGER;
	DPARM : BYTEPTR;

	BEGIN
	DUMMY := @BDOS86(0,DPARM);
	END;{GO_OP_SYS}

(*$P*)
PROCEDURE DATA_BASE;

	BEGIN
	CLRSCR;

	CASE MAIN_MENU OF

1: DBNEW;
2: DBSCAN;
3: DBLIST;
4: DBSTAT;
5: DBSAVE;
6: DBTERM;
	END;{OF CASE}
	END;{DATA_BASE}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		ENTER NEW CUSTOMERS
   
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBNEW;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


  BEGIN
     ACTION := SAVE;
     WHILE (ACTION = SAVE) DO
	BEGIN
	ACTION := NEWDAT;
	LOCK_CODE := 0;
	IF ACTION = SAVE THEN
		BEGIN
		NDRN := UPDATE(0);
		LOCK_CODE := FRELOK(FILE_NO,XLOCK,NDRN);
		END;

	IF LOCK_CODE <> 0 THEN
		LOCK_TYPE(8);
	END;
   END;{DBNEW}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		SCAN/UPDATE/DELETE CUSTOMERS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBSCAN;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


   BEGIN
     KEY := SEARCH_KEY;
     WRITELN;
     WRITELN ('Enter target value for ',KEY_NAME[KEY],',');
     WRITE('     or enter a period (.) to see main menu>>');
     READLN(TARGET);
     IF TARGET <> '.' THEN
	BEGIN
	CONV_TARGET := TARGET;
	KEY_FORMAT(KEY,CONV_TARGET);
	STAYPUT := TRUE;
	WHILE (STAYPUT) DO
		BEGIN
		DRN := SERKEY(KEY_NUM[KEY],FILE_NO,SLOCK,
			CONV_TARGET,IDX_KEY);
		IF ERRCOD <> 0 THEN
			ERROR_TYPE(KEY,2);
		IF LOKCOD <> 0 THEN
			STAYPUT := CHECK_LOCK(KEY,DRN)
		ELSE
			STAYPUT :=FALSE;
		END;
	
	OLD_ACTION := CONT;
	CONTINUE := TRUE;
	WHILE (CONTINUE) AND (DRN <> 0) DO
		BEGIN
		LDRN := DRN;
		READ_CUST(DRN);
		ACTION := OLDDAT(DRN);
		SAVE_KEY := KEY;
		IF ACTION = SAVE THEN
			DRN := UPDATE(DRN);
		IF ACTION = DELT THEN
			DELETE(DRN);
		IF (ACTION <> DELT) AND (FRELOK(FILE_NO,RLOCK,LDRN) <> 0)
			THEN LOCK_TYPE(2);
		IF (ACTION = SAVE) OR (ACTION = DELT) THEN
			BEGIN 
			KEY := SAVE_KEY;
			ACTION := OLD_ACTION;
			END;
		OLD_ACTION := ACTION;
		CONV_TARGET := COPY(IDX_KEY,1,KEY_LEN[KEY]);
		IDX_KEY := SET_LENGTH;
		LOCK_CODE := 0;

		STAYPUT := TRUE;
		WHILE (STAYPUT) DO
		    BEGIN
		    IF ACTION = CONT THEN
			BEGIN
			DRN := AFTKEY(KEY_NUM[KEY],FILE_NO,
				SLOCK, CONV_TARGET,IDX_KEY);
			LOCK_CODE := LOKCOD;
			END;
		    IF ACTION = BACK THEN
			BEGIN
			DRN := BEFKEY(KEY_NUM[KEY],FILE_NO,
				SLOCK, CONV_TARGET,IDX_KEY);
			LOCK_CODE := LOKCOD;
			END;

		    IF LOCK_CODE <> 0 THEN
			STAYPUT := CHECK_LOCK(KEY,DRN)
		    ELSE
			STAYPUT := FALSE;
		    END;

		IF ACTION = STOP THEN
			CONTINUE := FALSE;
		END;

	WRITELN;
	WRITELN('SCAN ENDED');
	PAUSE;
	END;
   END;{DBSCAN}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   			LIST CUSTOMERS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBLIST;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


   BEGIN
	KEY := SEARCH_KEY;
	WRITELN;
	WRITE('Do you want listing routed to printer (Y/N) >>');
	READLN(ROUTE);
	IF ROUTE = 'y' THEN ROUTE := 'Y';
	
	WRITELN;
	WRITELN;
	WRITELN(
'Enter lower and upper limits for ',KEY_NAME[KEY],' listing;');
	WRITE('     place values on separate lines >>') ;
	READLN(L_VALUE);
	READLN(U_VALUE);
	KEY_FORMAT(KEY,L_VALUE);
	KEY_FORMAT(KEY,U_VALUE);
	DRN := SERKEY(KEY_NUM[KEY],FILE_NO,SLOCK,
		L_VALUE,IDX_KEY);
	IF LOKCOD <> 0 THEN
		SKIP_LOCK(KEY,DRN);

	NO_LISTED := 0;
	WHILE (DRN <> 0) AND (COMPARE(KEY,IDX_KEY,U_VALUE) <= 0) DO
		BEGIN
		READ_CUST(DRN);
		PRINT_CUST(ROUTE);
		NO_LISTED := NO_LISTED + 1;
		IF FRELOK(FILE_NO,SLOCK,DRN) <> 0 THEN
			LOCK_TYPE(4);
		L_VALUE := COPY(IDX_KEY,1,KEY_LEN[KEY]);
		IDX_KEY := SET_LENGTH;
		DRN := AFTKEY(KEY_NUM[KEY],FILE_NO,SLOCK,
			L_VALUE,IDX_KEY);
		IF LOKCOD <> 0 THEN
			SKIP_LOCK(KEY,DRN);
		END;

	IF DRN <> 0 THEN
		LOCK_CODE := FRELOK(FILE_NO,SLOCK,DRN)
	ELSE
		LOCK_CODE := 0;
	IF LOCK_CODE <> 0 THEN
		LOCK_TYPE(5);

	WRITELN;
	WRITELN(NO_LISTED,' records listed.');
	PAUSE;
   END;{DBLIST}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		DATABASE STATISTICS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBSTAT;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


   BEGIN
	CLRSCR;
	WRITELN(FILNAME,' has ',GETDFS(FILE_NO),
		' records; currently, ',GETDFU(FILE_NO),
		' of them are in use.');
	WRITELN;
	WRITELN;
	WRITELN('    INDEX','ENTRIES':30);
	WRITELN ('-----------------','-------':22);
	FOR KEY := 0 TO MAX_KEY DO
		WRITELN(KEY_NAME[KEY]:16,' ':16,NOKEYS(KEY):7);

	WRITELN;
	WRITELN;
	PAUSE;
   END;{DBSTAT}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		SAVE DATABASE UPDATES & RESTART
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBSAVE;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


   BEGIN
	IF SAVDAT(FILE_NO) <> 0 THEN
		ERROR_TYPE(0,7);
	FOR KEY := 0 TO MAX_KEY DO
		IF SAVIDX(KEY_NUM[KEY]) <> 0 THEN
			ERROR_TYPE(KEY,3); 
   END;{DBSAVE}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		SAVE DATABASE UPDATES & TERMINATE
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DBTERM;
VAR
	KEY,LOCK_CODE,NDRN,DRN,CHOICE : INTEGER;
	SAVE_KEY,LDRN,NO_LISTED : INTEGER;
	ROUTE : CHAR;
	CONTINUE,STAYPUT : BOOLEAN;
	L_VALUE,U_VALUE,CONV_TARGET,TARGET : KEYSTR;
	ACTION : INTEGER;


   BEGIN
	IF FRELOK(FILE_NO,SFILE,0) <> 0 THEN
		ERROR_TYPE(0,13);
	IF CLSDAT(FILE_NO) <> 0 THEN
		ERROR_TYPE(0,15);
	FOR KEY := 0 TO MAX_KEY DO
		IF CLSIDX(KEY_NUM[KEY]) <> 0 THEN
			ERROR_TYPE(KEY,16);


	WRITELN;
	WRITELN(' ***  SUCCESSFUL TERMINATION ***');
	FOR_EVER := FALSE;
   END;{DBTERM}  
      
(*$P*)
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  		BEGINNING OF UTILITY FUNCTIONS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		CLEAR SCREEN ROUTINE
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 *)

PROCEDURE CLRSCR;

	BEGIN
	WRITE(CHR(27), 'E'); (* IBM-PC *)
	END;{CLRSCR}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		MAIN MENU ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION MAIN_MENU : INTEGER;
VAR
	OP : INTEGER;

	BEGIN
	WRITELN(' ':19,' ACCESS MANAGER(tm) DEMONSTRATION');
	WRITELN;
	WRITELN(' ':19,'   Customer Database Operations') ;
	WRITELN(' ':19,'          Terminal ',TERMINAL);
	WRITELN(' ':19,'   ****************************');
	WRITELN;
	WRITELN;
	WRITELN('    1. Enter New Customers');
	WRITELN('    2. Scan/Update/Delete Customer Records');
	WRITELN('    3. List Customer Records');
	WRITELN('    4. Database Statistics');
	WRITELN('    5. Save All Files & Restart Operations');
	WRITELN('    6. Terminate Operations');

	OP := 0;
	WHILE (OP < 1) OR (OP > 6) DO
		BEGIN
		WRITELN;
		WRITE('Enter desired operation number>>');
		READLN(OP);
		END;
	MAIN_MENU := OP;
	END;{MAIN_MENU}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		SELECT SEARCH KEY ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION SEARCH_KEY : INTEGER;
VAR
	KEY,KEY_NO : INTEGER;

	BEGIN
	CLRSCR;
	WRITELN(' ':24,'Customer Database Search Keys');
	WRITELN;
	WRITELN;
	WRITELN;

	FOR KEY := 0 TO MAX_KEY DO
		BEGIN
		KEY_NO := KEY + 1;
		WRITELN(KEY_NO,' - ',KEY_NAME[KEY]) 
		END;

	KEY := 0;
	WHILE (KEY < 1) OR (KEY > NO_KEYZ) DO
		BEGIN
		WRITELN;
		WRITELN;
		WRITE('Enter desired key number>>');
		READLN(KEY);
		END;
	SEARCH_KEY := KEY-1;
	END;{SEARCH_KEY}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		ERROR HANDLING
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE ERROR_TYPE(INFO,LOCALE : INTEGER);
VAR
	DUMMY : INTEGER;

PROCEDURE ET_CLOSE;
VAR
	T_KEY : INTEGER;

	BEGIN
	DUMMY := CLSDAT(FILE_NO);
	FOR T_KEY := 0 TO MAX_KEY DO
		IF T_KEY <> INFO THEN DUMMY := CLSIDX(KEY_NUM[T_KEY]);
	ET_STOP;
	END;

PROCEDURE ET_PCLOSE;
VAR
	L_KEY,T_KEY : INTEGER;
	
	BEGIN
	L_KEY := INFO + 1;
	IF L_KEY > MAX_KEY THEN GO_OP_SYS;
	FOR T_KEY := L_KEY TO MAX_KEY DO
		DUMMY := CLSIDX(KEY_NUM[T_KEY]);
	END;

PROCEDURE ET_STOP;

	BEGIN
	WRITELN;
	WRITELN('DATABASE terminating with Error Code #',ERRCOD);
	GO_OP_SYS;
	END;


	BEGIN
	WRITELN;
	WRITELN;
	WRITE('User Error #',ERRCOD,' occurred while trying to ');

	CASE LOCALE OF
		
1:	WRITELN('open ',IDX_NAME[INFO]);
2:	WRITELN('search ',KEY_NAME[INFO],' Index File');
3:	WRITELN('save ',IDX_NAME[INFO]);
4:	WRITELN('remove old key from ',IDX_NAME[INFO]);
5:	WRITELN('enter key into ',IDX_NAME[INFO]);
6:	WRITELN('delete key from ',IDX_NAME[INFO]);
7: BEGIN
	WRITELN('save ',FILNAME);
	INFO := -1;
   END;
8:	WRITELN('get a new data record',' (',FILE_NO,')');
9:	WRITELN('delete data record #',INFO);
10:	WRITELN('open ',FILNAME,' (',FILE_NO,')');
11:	WRITELN('read data record #',INFO);
12:	WRITELN('write data record #',INFO);
13:	WRITELN('release shared file lock on ',FILNAME);
14: BEGIN
	WRITELN('initialize user.');
	GO_OP_SYS;
    END;
15: BEGIN
	WRITELN('close ',FILNAME);
	INFO := -1;
    END;
16:	WRITELN('close ',IDX_NAME[INFO]);

	END;{OF CASE}

	IF (LOCALE = 1) OR ((LOCALE > 7) AND (LOCALE < 13)) THEN
		ET_STOP
	ELSE IF (LOCALE = 2) OR ((LOCALE > 3) AND (LOCALE < 7)) OR
	    (LOCALE = 13) THEN
		ET_CLOSE
	ELSE
		ET_PCLOSE;


	END;{ERROR_TYPE}

PROCEDURE LOCK_TYPE(LOCALE : INTEGER);
VAR
	T_KEY,DUMMY : INTEGER;

	BEGIN
	WRITELN('Lock Type: ',LOCALE,'  Lock Code:',LOKCOD);
	DUMMY := CLSDAT(FILE_NO);
	FOR T_KEY := 0 TO MAX_KEY DO
		DUMMY := CLSIDX(KEY_NUM[T_KEY]);
	GO_OP_SYS;
	END;{LOCK_TYPE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		READ DATA RECORD ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE READ_CUST(DRN : INTEGER);
VAR
	FLD,CHR,POS_PTR : INTEGER;
	TMP_FLD : FLDSTR;
	FLDPTR : ^FLD_REC;

	BEGIN
	IF READAT(FILE_NO,DRN,DATBUF_PTR) <> 0 THEN
		ERROR_TYPE(DRN,11);

	FLDPTR := ADDR(TMP_FLD); (* PTR TO STRING *)

	POS_PTR := 0;
	FOR FLD := 0 TO MAX_FIELD DO
		BEGIN
		FLDPTR^.LENBYTE := FLD_LEN[FLD];
		FOR CHR := 1 TO FLDPTR^.LENBYTE DO
			FLDPTR^.FLDCHR[CHR] := DATBUF.FLD[POS_PTR + CHR];
		
		WHILE (FLDPTR^.FLDCHR[FLDPTR^.LENBYTE] = ' ') AND 
		    (FLDPTR^.LENBYTE > 0) DO
			FLDPTR^.LENBYTE := FLDPTR^.LENBYTE - 1;
		OLD_FLD[FLD] := TMP_FLD;
		POS_PTR := POS_PTR + FLD_LEN[FLD];
		END;
		
	END;{READ_CUST}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		LIST CUSTOMER RECORD ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE PRINT_CUST(ROUTE : CHAR);
VAR
	DUMMY : INTEGER;
	LIST_FILE : TEXT;

	BEGIN
	IF ROUTE = 'Y' THEN
		ASSIGN(LIST_FILE,'LST:')
	ELSE
		ASSIGN(LIST_FILE,'CON:');
	RESET(LIST_FILE);

	WRITELN(LIST_FILE);
	WRITELN(LIST_FILE,' ':4,OLD_FLD[0]:10,'  ',OLD_FLD[7]);            
	WRITELN(LIST_FILE,' ':24,OLD_FLD[1],' ',OLD_FLD[2]);
	WRITELN(LIST_FILE,' ':24,OLD_FLD[3]);
	WRITELN(LIST_FILE,' ':24,OLD_FLD[4],', ',OLD_FLD[5],'    ',OLD_FLD[6]);
	WRITELN(LIST_FILE);
	CLOSE(LIST_FILE,DUMMY);
	END;{PRINT_CUST}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		PAUSE ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE PAUSE;
VAR
	NULL : CHAR;

	BEGIN
	WRITE('Press "RETURN" to continue ---');
	READLN(NULL);
	END;{PAUSE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   	CONVERT TARGET VALUE TO KEY FORMAT ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE KEY_FORMAT(KEY : INTEGER; VAR TARGET : KEYSTR);
VAR
	TEMP : STRING[40];

	BEGIN
	IF UNIQ_KEY = KEY THEN
		EXIT
	ELSE
		BEGIN
		TEMP := CONCAT(TARGET,SPACE);
		TEMP :=COPY(TEMP,1,KEY_LEN[KEY]-2);
		TARGET :=  CONCAT(TEMP,NULL_CHR,NULL_CHR);
		END;
	END;{KEY_FORMAT}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		COMPARE IDX_KEY & U_VALUE ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION COMPARE(KEY : INTEGER; IDXVAL,UPVAL : KEYSTR) : INTEGER;
VAR
	KL : INTEGER;
	C1,C2 :  STRING[40];

	BEGIN
	IF KEY = UNIQ_KEY THEN
		KL := KEY_LEN[KEY]
	ELSE
		KL := KEY_LEN[KEY]-2;

	C1 := CONCAT(IDXVAL,SPACE);
	C1 := COPY(C1,1,KL);
	C2 := CONCAT(UPVAL,SPACE);
	C2 := COPY(C2,1,KL);

	IF C1<C2 THEN
		COMPARE := -1
      	ELSE IF C1>C2 THEN
		COMPARE := 1
      	ELSE
		COMPARE := 0;
	END;{COMPARE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  		CHECK LOCK ROUTINES
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE SKIP_LOCK(KEY,DRN : INTEGER);
VAR
	L_VALUE : KEYSTR;

	BEGIN
	WHILE (DRN <> 0) AND (LOKCOD <> 0) DO
		BEGIN
		L_VALUE := COPY(IDX_KEY,1,KEY_LEN[KEY]);
		IDX_KEY := SET_LENGTH;
		DRN := AFTKEY(KEY_NUM[KEY],FILE_NO,SLOCK,
			L_VALUE,IDX_KEY);
		END;
	END;{SKIP_LOCK}

FUNCTION CHECK_LOCK(KEY,DRN : INTEGER) : BOOLEAN;
VAR
	CONV_TARGET : KEYSTR;
	DUMMY : CHAR;

	BEGIN
	WRITELN;
	WRITE(
'Enter a "W" if you wish to wait for locked record(s)>>');
	READLN(DUMMY);

	IF (DUMMY = 'W') OR (DUMMY = 'w') THEN
		BEGIN
		CHECK_LOCK := TRUE;
		EXIT;
		END;

	WHILE (DRN <> 0) AND (LOKCOD <> 0) DO
		BEGIN
		CONV_TARGET := COPY(IDX_KEY,1,KEY_LEN[KEY]);
		IDX_KEY := SET_LENGTH;
		IF OLD_ACTION = CONT THEN
			DRN := AFTKEY(KEY_NUM[KEY],FILE_NO,
				SLOCK, CONV_TARGET,IDX_KEY)
		ELSE
			DRN := BEFKEY(KEY_NUM[KEY],FILE_NO,
				SLOCK, CONV_TARGET,IDX_KEY);
		END;
	CHECK_LOCK := FALSE;
	END;{CHECK_LOCK}

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  		WARNING MESSAGES
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE WARNING_TYPE(KEY,LOCALE,RET_CODE : INTEGER);

	BEGIN
	WRITELN;
	WRITE('WARNING...Return Code #',RET_CODE,
		' occurred while trying to ');
	
	CASE LOCALE OF

1:	WRITELN('remove old key from ',IDX_NAME[KEY]);

2:	WRITELN('enter key into ',IDX_NAME[KEY]);

3:	WRITELN('delete key from ',IDX_NAME[KEY]);

	END; {OF CASE}
	PAUSE;
	END;{WARNING_TYPE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		ADD NEW KEY VALUE ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE ADD_A_KEY(KEY,DRN : INTEGER);
VAR
	RET_CODE,K_FLD : INTEGER;

	BEGIN
	K_FLD := KEY_MAP[KEY];

(*	REMOVE OLD KEY VALUE *)

	RET_CODE := DELKEY(KEY_NUM[KEY],FILE_NO,
		XLOCK,OLD_FLD[K_FLD],DRN);

	IF ERRCOD <> 0 THEN
		ERROR_TYPE(KEY,4);
	IF LOKCOD <> 0 THEN
		LOCK_TYPE(6);
	IF RET_CODE <> 1 THEN
		WARNING_TYPE(KEY,1,RET_CODE);

(*	ADD NEW KEY VALUE *)

	RET_CODE := ADDKEY(KEY_NUM[KEY],FILE_NO,
		XLOCK,NEW_FLD[K_FLD],DRN);

	IF ERRCOD <> 0 THEN
		ERROR_TYPE(KEY,5);
	IF LOKCOD <> 0 THEN
		LOCK_TYPE(7);
	IF RET_CODE <> 1 THEN
		WARNING_TYPE(KEY,2,RET_CODE);

	END;{ADD_A_KEY}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		WRITE NEW DATA RECORD ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE WRITE_CUST(DRN : INTEGER);
VAR
	FLD,CHR,POS_PTR : INTEGER;
	TMP_FLD : FLDSTR;
	FLDPTR : ^FLD_REC;

	BEGIN
	DATBUF.CDF := NULL_CHR;

	FLDPTR := ADDR(TMP_FLD); (* PTR TO STRING *)

	POS_PTR := 0;
	FOR FLD := 0 TO MAX_FIELD DO
		BEGIN
		TMP_FLD := NEW_FLD[FLD];
		FOR CHR := 1 TO FLDPTR^.LENBYTE DO
			DATBUF.FLD[POS_PTR + CHR] := 
				FLDPTR^.FLDCHR[CHR];
		
		WHILE (FLDPTR^.LENBYTE < FLD_LEN[FLD]) DO
			BEGIN
			FLDPTR^.LENBYTE := FLDPTR^.LENBYTE + 1;
			DATBUF.FLD[POS_PTR + FLDPTR^.LENBYTE] := ' ';
			END;
		POS_PTR := POS_PTR + FLD_LEN[FLD];
		END;
		
	IF WRTDAT(FILE_NO,DRN,DATBUF_PTR) <> 0 THEN
		ERROR_TYPE(DRN,12);
	END;{WRITE_CUST}
 
(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		DELETE KEY VALUE FROM INDEX ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DEL_A_KEY(KEY,DRN : INTEGER);
VAR
	RET_CODE,K_FLD : INTEGER;

	BEGIN
	K_FLD := KEY_MAP[KEY];
	
	RET_CODE := DELKEY(KEY_NUM[KEY],FILE_NO,
		XLOCK,OLD_FLD[K_FLD],DRN);

	IF ERRCOD <> 0 THEN
		ERROR_TYPE(KEY,6);
	IF LOKCOD <> 0 THEN
		LOCK_TYPE(10);
	IF RET_CODE <> 1 THEN
		WARNING_TYPE(KEY,3,RET_CODE);
	
	END;{DEL_A_KEY}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		UPDATE INDICES & DATA FILE ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION UPDATE(DATA_RECORD : INTEGER) : INTEGER;
VAR
	FLD,KEY : INTEGER;

	BEGIN
	IF DATA_RECORD = 0 THEN
		BEGIN
		DATA_RECORD := NEWREC(FILE_NO,XLOCK);
		IF ERRCOD <> 0 THEN
			ERROR_TYPE(0,8);
		IF LOKCOD <> 0 THEN
			LOCK_TYPE(3) ;
		END;

	UPDATE := DATA_RECORD;
	FOR KEY := 0 TO MAX_KEY DO
		BEGIN
		FLD := KEY_MAP[KEY];
		IF OLD_FLD[FLD] <> NEW_FLD[FLD] THEN
			ADD_A_KEY(KEY,DATA_RECORD);
		END;

	FOR FLD := 0 TO MAX_FIELD DO
		IF OLD_FLD[FLD] <> NEW_FLD[FLD] THEN
			BEGIN 
			WRITE_CUST(DATA_RECORD);
			EXIT;
			END;
	END;{UPDATE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		DELETE INDEX & DATA FILE ENTRY ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE DELETE(DATA_RECORD : INTEGER);
VAR
	FLD,KEY : INTEGER;

	BEGIN
	FOR KEY := 0 TO MAX_KEY DO
		BEGIN
		FLD := KEY_MAP[KEY];
		IF OLD_FLD[FLD] <> '' THEN
			DEL_A_KEY(KEY,DATA_RECORD);
		END;
	
	IF RETREC(FILE_NO,XLOCK,DATA_RECORD) <> 0 THEN
		ERROR_TYPE(DATA_RECORD,9);
	IF LOKCOD <> 0 THEN
		LOCK_TYPE(9);
	END;{DELETE}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		NEW DATA ENTRY ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION NEWDAT : INTEGER;

VAR
	TMPFLD : STRING[40];
	UNIQUE : BOOLEAN;
	TMPDAT : INTEGER;
	FLD,OP_VAL,FLD_NO : INTEGER;
	OP1 : CHAR;
	OP1_BYT : BYTE;

LABEL
	111;

	BEGIN
		FOR FLD := 0 TO MAX_FIELD DO
			OLD_FLD[FLD] := '';

		CLRSCR;

		WRITELN(' ':19,'Enter New Customer Information');
		WRITELN(' ':19,'******************************');
		WRITELN;
		WRITELN;
		WRITELN(
		    '    [Press "RETURN" for customer # to see main menu.]');
		WRITELN;

		FOR FLD := 0 TO MAX_FIELD DO
			BEGIN
			FLD_NO := FLD + 1;
111:
			WRITE(FLD_NO:6,' - ',FLD_NAME[FLD]:20,
				'(',FLD_LEN[FLD]:2,') >>');
			READLN(NEW_FLD[FLD]);
			IF (FLD = KEY_MAP[UNIQ_KEY]) AND (NEW_FLD[FLD] = '')
			    	THEN BEGIN
				NEWDAT := STOP;
				EXIT;
				END;

			IF FLD = KEY_MAP[UNIQ_KEY] THEN
				BEGIN
				NEW_FLD[FLD] := CONCAT('0000',NEW_FLD[FLD]);
				RIGHT(NEW_FLD[FLD],FLD_LEN[FLD]);
				UNIQUE := TEST_UNIQUENESS;
				END
			ELSE
				BEGIN
				TMPFLD := CONCAT(NEW_FLD[FLD],
					'                    ');
				NEW_FLD[FLD] := COPY(TMPFLD,1,FLD_LEN[FLD]);
				UNIQUE := TRUE;
				END;

			IF ~UNIQUE THEN GOTO 111;
			END;
 
	WHILE (FOR_EVER) DO
		BEGIN
		WRITELN;
		WRITELN;
		WRITELN;
		WRITELN(' ':19,'Current customer information');
		WRITELN;

		FOR FLD := 0 TO MAX_FIELD DO
			BEGIN
			FLD_NO := FLD + 1;
			WRITELN(FLD_NO:6,' - ',FLD_NAME[FLD]:20,'   ',
				NEW_FLD[FLD]);
			END;

		
			OP_VAL := 0;
			WHILE (OP_VAL < 1) OR (OP_VAL > NO_FIELDS) DO
				BEGIN
				WRITELN;
				WRITELN;
				WRITELN(
'Enter S to save data, Field # to change data,');
				WRITE(
'D to delete data, or E to end input >>') ;
				READLN(OP1);
				TMPDAT := 0;
				IF (OP1 = 'S') OR (OP1 = 's') THEN
					TMPDAT := SAVE;
				IF (OP1 = 'D') OR (OP1 = 'd') THEN
					TMPDAT := DELT;
				IF (OP1 = 'E') OR (OP1 = 'e') THEN
					TMPDAT := STOP;
				IF TMPDAT <> 0 THEN
					BEGIN
					NEWDAT := TMPDAT;
					EXIT;
					END;
				OP1_BYT := OP1;
				OP_VAL := OP1_BYT - 48;
				END;
			UPDATE_FIELD(OP_VAL);
			END;
		
	END;{NEWDAT}

FUNCTION OLDDAT(DRN: INTEGER) : INTEGER;

VAR
	UNIQUE : BOOLEAN;
	TMPDAT : INTEGER;
	FLD,OP_VAL,FLD_NO : INTEGER;
	OP1 : CHAR;
	OP1_BYT : BYTE;


	BEGIN

		FOR FLD := 0 TO MAX_FIELD DO
			NEW_FLD[FLD] := OLD_FLD[FLD];

		CLRSCR;
 
	WHILE (FOR_EVER) DO
		BEGIN
		WRITELN;
		WRITELN;
		WRITELN;
		WRITELN(' ':19,'Current customer information');
		WRITELN;

		FOR FLD := 0 TO MAX_FIELD DO
			BEGIN
			FLD_NO := FLD + 1;
			WRITELN(FLD_NO:6,' - ',FLD_NAME[FLD]:20,'   ',
				NEW_FLD[FLD]);
			END;

			OP_VAL := 0;
			WHILE (OP_VAL < 1) OR (OP_VAL > NO_FIELDS) DO
				BEGIN
				WRITELN;
				WRITELN;
				WRITELN(
'Enter C to continue scan, Field # to change data, S to save changes,');
				WRITE(
'D to delete data, B for back scan, or E to end scan >>');
				READLN(OP1);
				TMPDAT := 0;
				IF (OP1 = 'C') OR (OP1 = 'c') THEN
					TMPDAT := CONT;
				IF (OP1 = 'S') OR (OP1 = 's') THEN
					TMPDAT := SAVE;
				IF (OP1 = 'D') OR (OP1 = 'd') THEN
					TMPDAT := SET_XLOCK(OP1,DRN);
				IF (OP1 = 'B') OR (OP1 = 'b') THEN
					TMPDAT := BACK;
				IF (OP1 = 'E') OR (OP1 = 'e') THEN
					TMPDAT := STOP;
				IF TMPDAT <> 0 THEN
					BEGIN
					OLDDAT := TMPDAT;
					EXIT;
					END;
				OP1_BYT := OP1;
				OP_VAL := OP1_BYT - 48;
				END;
			UPDATE_FIELD(OP_VAL);
			
		END;
	END;{OLDDAT}


FUNCTION SET_XLOCK(OP : CHAR; DRN : INTEGER) : INTEGER;
VAR
	DUMMY : CHAR;

	BEGIN
	DUMMY := 'W';
	WHILE (DUMMY = 'W') AND (SETLOK(FILE_NO,XLOCK,DRN) <>  0) DO
		BEGIN
		WRITELN;
		WRITELN('Customer update on hold due to record lock');
		WRITE(
'Enter W if you wish to wait or any other key to cancel update>>');
		READLN(DUMMY);
		IF DUMMY = 'w' THEN DUMMY := 'W';
		END;
	
	IF DUMMY = 'W' THEN
                BEGIN
		IF OP = 'S' THEN
			SET_XLOCK := SAVE
		ELSE
			SET_XLOCK := DELT;
		END
	ELSE
		SET_XLOCK := OLD_ACTION;
	END;{SET_XLOCK}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		UPDATE DATA FIELD ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE UPDATE_FIELD(FLD_NO : INTEGER);
VAR
	TMPFLD : STRING[40];
	TEST : BOOLEAN;
	FIELD_NO : INTEGER;

	BEGIN
	FIELD_NO := FLD_NO-1;
	TEST := FALSE;

	WHILE (~TEST) DO
		BEGIN
		WRITELN;
		WRITE('Input new ',FLD_NAME[FIELD_NO],'>>');
		READLN(NEW_FLD[FIELD_NO]);
	
		IF FIELD_NO = KEY_MAP[UNIQ_KEY] THEN
			BEGIN
			NEW_FLD[FIELD_NO] := CONCAT('0000',NEW_FLD[FIELD_NO]);
			RIGHT(NEW_FLD[FIELD_NO],FLD_LEN[FIELD_NO]);
			END
		ELSE
			BEGIN
			TMPFLD := CONCAT(NEW_FLD[FIELD_NO],
				'                    ');
			NEW_FLD[FIELD_NO] := COPY(TMPFLD,1,FLD_LEN[FIELD_NO]);
			END;

		IF (FIELD_NO = KEY_MAP[UNIQ_KEY]) AND (NEW_FLD[FIELD_NO] <>
		    OLD_FLD[FIELD_NO]) THEN
			TEST := TEST_UNIQUENESS
		ELSE
			TEST := TRUE;
		END;
	END;{UPDATE_FIELD}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		CUST # UNIQUENESS TEST ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

FUNCTION TEST_UNIQUENESS : BOOLEAN;
VAR
	TEMP : INTEGER;
	TEST : FLDSTR;

	BEGIN
	TEST := NEW_FLD[KEY_MAP[UNIQ_KEY]];
	TEMP := GETKEY(UNIQ_KEY,0,NLOCK,TEST);

	IF LOKCOD <> 0 THEN
		LOCK_TYPE(12);
	IF TEMP = 0 THEN
		TEST_UNIQUENESS := TRUE
      	ELSE
		BEGIN
		WRITELN;
		WRITELN(' *** Already Assigned ***');
		WRITELN;
		TEST_UNIQUENESS := FALSE;
		END;
	END;{TEST_UNIQUENESS}

(*$P*)
(* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		RIGHT STRING ROUTINE
  
   ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

PROCEDURE RIGHT(VAR FLDVAL : FLDSTR; FLDLEN : INTEGER);

	BEGIN
	FLDVAL := COPY(FLDVAL,LENGTH(FLDVAL)-FLDLEN+1,FLDLEN);
	END;{RIGHT}

(*		END OF UTILITY FUNCTIONS
 
   ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
  	 SET-UP DATABASE FIELD & KEY DESCRIPTORS
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

BEGIN
NO_FIELDS := MAX_FIELD + 1;

FLD_NAME[0] := 'Customer Number';
FLD_LEN[0] := 4;
FLD_NAME[1] := 'First Name';
FLD_LEN[1] := 16;
FLD_NAME[2] := 'Last Name';
FLD_LEN[2] := 20;
FLD_NAME[3] := 'Street Address';
FLD_LEN[3] := 20;
FLD_NAME[4] := 'City';
FLD_LEN[4] := 20;
FLD_NAME[5] := 'State';
FLD_LEN[5] := 2;
FLD_NAME[6] := 'Zipcode';
FLD_LEN[6] := 9;
FLD_NAME[7] := 'Customer Status';
FLD_LEN[7] := 8;


KEY_LEN[0]:=10;
KEY_TYPE[0]:=0;
KEY_MAP[0]:=2 ;	(*   KEY 0 = LAST NAME		*)
KEY_LEN[1]:=11;
KEY_TYPE[1]:=0;
KEY_MAP[1]:=6 ;	(*   KEY 1 = ZIPCODE		*)
KEY_LEN[2]:=4 ;
KEY_TYPE[2]:=0;
KEY_MAP[2]:=0 ;	(*   KEY 2 = CUST NUMBER	*)

UNIQ_KEY := 2 ;	(*  USED IN TEST OF UNIQUENESS	*)

FOR KEY := 0 TO MAX_KEY DO
	BEGIN
	IF KEY = UNIQ_KEY THEN
		KEY_DUP[KEY] := NO
	ELSE
		KEY_DUP[KEY] := YES;

	KEY_NAME[KEY] := FLD_NAME[KEY_MAP[KEY]];
	END;

IDX_NAME[0] := 'NAME.IDX';
IDX_NAME[1] := 'ZIPC.IDX';
IDX_NAME[2] := 'NUMB.IDX';

NLOCK := 0;	(* IGNORE LOCKS			*)
SLOCK := 1;	(* SHARED RECORD LOCK		*)
XLOCK := 2;	(* EXCLUSIVE RECORD LOCK	*)
SFILE := 3;	(* SHARED FILE LOCK		*)
XFILE := 4;	(* EXCLUSIVE FILE LOCK		*)
RLOCK := 5;	(* RELEASE SLOCK) OR (XLOCK	*)

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		INITIALIZE INDEX FILES
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

	SET_LENGTH := '12345678901';
	IDX_KEY := SET_LENGTH;
	SPACE :=      '           ';

(*	SET TERMINAL TO -1 FOR AUTOMATIC ASSIGNMENT BY ACCESS MANAGER *)

	TERMINAL := -1;
	TRAP_ERRORS := YES;
	TIME_OUT_TEST_DELAY := 2;  (* APPROXIMATELY 2 SECONDS *)
	TERMINAL := INTUSR(TERMINAL,TRAP_ERRORS,TIME_OUT_TEST_DELAY);
	IF ERRCOD <> 0 THEN
		ERROR_TYPE(0,14);

	NO_BUFFERS := 5;
	NO_NODE_SECTORS := 4;
	NO_DATA_FILES := 1;
	NO_KEYZ := MAX_KEY + 1;

	IF SETUP(NO_BUFFERS,NO_KEYZ,NO_NODE_SECTORS,NO_DATA_FILES) <> 0 THEN
		BEGIN
		WRITELN('Illegal SETUP Parameters');
		EXIT;
		END;

	FOR KEY := 0 TO MAX_KEY DO
		BEGIN
		KEY_NUM[KEY] := OPNIDX(-1,IDX_NAME[KEY],
			KEY_LEN[KEY], KEY_TYPE[KEY],KEY_DUP[KEY]);
		IF ERRCOD <> 0 THEN
			ERROR_TYPE(KEY,1);
		END;

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		INITIALIZE DATA FILE
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

	FILE_NO := -1;
	RECORD_LENGTH := 100;
	FILNAME := 'CUSTOMER.DAT';
	FILE_NO := OPNDAT(FILE_NO,SFILE,FILNAME,RECORD_LENGTH);
	IF ERRCOD <> 0 THEN
		ERROR_TYPE(0,10);
	IF LOKCOD <> 0 THEN
		LOCK_TYPE(1);

(*	CUST_REC IS THE DATA FILE BUFFER AREA *)

	DATBUF_PTR := ADDR(DATBUF);

(*$P*)
(* ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
   		BEGIN DATABASE OPERATION
  
   :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

	NULL_BYT := 0;
	NULL_CHR := NULL_BYT;

	FOR_EVER := TRUE;

	WHILE (FOR_EVER) DO
	  DATA_BASE;
	EXIT;

END.