*********************************************************************
* Copyright 1993, UFO Computing, Inc.
* All Rights Reserved
*
* Version 1.301
*
* Modified: 07/14/93
*	db_save
*		Changed the 'checkmenu' parameter to 'checkvalid'.
*		'checkvalid' is checked to see if 'db_valid' should be called.
*	db_ok
*		Now calls the 'fsave' procedure with the parameter .T.
*	db_edit, db_add, db_quit
*		All added one optional parameter, checkvalid, which defaults
*		to .T. This parameter is passed to the 'fsave' procedure.
*		If these procedures are called by a push button, then .F.
*		should be passed or a recursive procedure call will insue.
*********************************************************************

PARAMETERS proclist, listptr
EXTERNAL ARRAY proclist
	m.listptr = m.listptr + 1
	DO (proclist[m.listptr]) WITH m.proclist, m.listptr
RETURN

FUNCTION r_add
PARAMETER nextid, searchdel
	PRIVATE i, fnd, blankarray, nextid

	IF PARAMETERS() < 2
		m.searchdel = .T.
	ENDIF
	IF PARAMETERS() < 1
		m.nextid = .F.
	ENDIF

	IF m.searchdel
		SET DELETED OFF

		PRIVATE origord
		m.origord = ORDER()
		SET ORDER TO DELETED
		SEEK .T.
		m.fnd = FOUND()
		SET ORDER TO (m.origord)
		
		SET DELETED ON
		IF !m.fnd
			FOR m.i = 1 TO 5
				APPEND BLANK
				DELETE
			ENDFOR
			IF !RLOCK()
				RETURN .F.
			ENDIF
			RECALL
		ELSE
			IF !RLOCK()
				RETURN .F.
			ENDIF
			RECALL
			SCATTER MEMO BLANK TO m.blankarray
			GATHER MEMO FROM m.blankarray
		ENDIF
	ELSE
		APPEND BLANK
	ENDIF

	IF m.nextid
		m.nextid = r_nextid()
		IF EMPTY(m.nextid)
			DELETE && If can't get an ID, delete new record
			RETURN .F.
		ENDIF
	ENDIF

	RETURN .T.

* END OF PROCEDURE r_add
	
FUNCTION r_delete
PARAMETERS verify, moverec
	IF PARAMETERS() < 2
		m.moverec = .T.
	ENDIF
	
	IF PARAMETERS() < 1
		verify = .F.
	ENDIF

	PRIVATE currec, newrec, blankarray
	
	IF !RLOCK()
		RETURN .F.
	ENDIF

	IF m.moverec	
		m.currec = RECNO()
		SKIP
		IF !EOF()
			m.newrec = RECNO()
		ELSE
			GO TOP
			m.newrec = RECNO()
		ENDIF
		GO (m.currec)
	ENDIF
	
	IF verify
		IF yorn("Are you sure you want to delete this record")
			IF m.moverec
				SCATTER MEMO TO m.blankarray BLANK
				GATHER FROM m.blankarray MEMO
			ENDIF
			DELETE
		ELSE
			UNLOCK
			RETURN .F.
		ENDIF
	ELSE
		IF m.moverec
			SCATTER MEMO TO m.blankarray BLANK
			GATHER FROM m.blankarray MEMO
		ENDIF
		DELETE
	ENDIF
	
	UNLOCK
	IF m.moverec
		IF m.newrec <= RECCOUNT()
			GO (m.newrec)
		ELSE
			GO BOTTOM
			IF !EOF()
				SKIP
			ENDIF
		ENDIF
	ENDIF

	RETURN .T.

* END OF PROCEDURE r_delete
	
FUNCTION r_edit
	IF !RLOCK()
		RETURN .F.
	ELSE
		RETURN .T.
	ENDIF

* END OF PROCEDURE r_edit

PROCEDURE r_top
	GOTO TOP
	RETURN .T.
	
PROCEDURE r_bottom
	GOTO BOTTOM
	RETURN .T.

* END OF PROCEDURE r_bottom
	
PROCEDURE r_prev
	PRIVATE currec
	IF EOF()
		RETURN
	ENDIF
	currec = RECNO()
	SKIP -1
	IF BOF()
		GO currec
	ENDIF
		
PROCEDURE r_next
	PRIVATE currec
	IF EOF()
		RETURN
	ENDIF
	
	m.currec = RECNO()
	SKIP
	IF EOF()
		GO m.currec
	ENDIF

* END OF PROCEDURE r_next
	
FUNCTION r_nextid
PARAMETERS database
	PRIVATE origarea, retval, found, lastid, nextid, nextidstr
	PRIVATE replfield
	
	IF PARAMETERS() = 0
		m.database = UPPER(DBF())
		DO CASE
		CASE AT("\", m.database) <> 0
			m.database = SUBSTR(m.database, RAT("\", m.database) + 1)
		CASE AT(":", m.database) <> 0
			m.database = SUBSTR(m.database, RAT(":", m.database) + 1)
		ENDCASE
		
		IF AT(".", m.database) <> 0
			m.database = LEFT(m.database, AT(".", m.database) - 1)
		ENDIF
	ENDIF
	
	m.origarea = SELECT()
	SELECT 0
	USE db_files ORDER database_u ALIAS a_nextid AGAIN
	IF !SEEK(m.database)
		DO msg WITH "R_NEXTID: Error with database " + m.database
		SELECT (m.origarea)
		RETURN ""
	ENDIF
	
	IF !RLOCK()
		RETURN ""
	ENDIF
	
	SELECT 0
	USE (m.database) ORDER (a_nextid.aiseekord) ALIAS a_dbase AGAIN

	m.lastid = a_nextid.ailastid
	m.nextid = m.lastid
	IF m.nextid > 0
		m.nextid = m.nextid - 1
	ENDIF
	m.found = .F.
	DO WHILE !m.found
		m.nextid = m.nextid + 1
		IF m.nextid > a_nextid.aihighid
			m.nextid = 1
		ENDIF
		IF a_nextid.aizeros
			m.nextidstr = PADL(LTRIM(STR(m.nextid)), ;
				LEN(EVAL(a_nextid.aifield)), "0")
		ELSE
			m.nextidstr = PADL(LTRIM(STR(m.nextid)), ;
				LEN(EVAL(a_nextid.aifield)), " ")
		ENDIF
		IF !SEEK(m.nextidstr)
			m.found = .T.
			SELECT a_nextid
			REPLACE a_nextid.ailastid WITH m.nextid
		ENDIF
	ENDDO

	SELECT (m.origarea)	
	m.replfield = a_nextid.aifield
	REPLACE (replfield) WITH m.nextidstr
	
	SELECT a_nextid
	UNLOCK
	USE
	SELECT a_dbase
	USE
	
	IF !EMPTY(m.origarea)
		SELECT (m.origarea)
	ENDIF
	
	RETURN m.nextid

* END OF PROCEDURE r_nextid

FUNCTION r_isunique
PARAMETERS var, field, srchexpr, srchval
	IF EMPTY(m.var) && Ignore empty choice
		RETURN .F.
	ENDIF

	PRIVATE ok, currec, i

	REPLACE &field WITH m.var
	m.currec = RECNO()
	
	m.ok = .T.	
	IF PARAMETERS() = 2
		LOCATE FOR &field == m.var
	ELSE
		LOCATE FOR &srchexpr = EVAL(m.srchval)
	ENDIF
	IF FOUND()
		IF RECNO() = m.currec
			CONTINUE
			m.ok = !FOUND()
		ELSE
			m.ok = .F.
		ENDIF
	ENDIF
	
	GO (m.currec)
	IF !m.ok
		DO CASE
		CASE TYPE("&field") = "C"
			REPLACE &field WITH ""
		CASE TYPE("&field") = "N"
			REPLACE &field WITH 0
		ENDCASE
	ENDIF
	
	RETURN m.ok
		
* END OF PROCEDURE r_isunique (function)

* The following are standard functions for flat, one to one and
* one to many files

EXTERNAL ARRAY re_info
PROCEDURE db_top
	PRIVATE currec
	m.currec = RECNO()
	DO r_top
	IF !EOF()
		IF m.currec <> RECNO()
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF
	
			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(re_info[m.rof_fmove])
				DO (re_info[m.rof_fmove]) WITH "TOP"
			ENDIF
			SHOW GETS
		ELSE
			WAIT WINDOW "This is the first record in this file" NOWAIT
		ENDIF
	ELSE
		WAIT WINDOW "This file is empty" NOWAIT
	ENDIF
	RETURN 0

* END OF PROCEDURE db_top

EXTERNAL ARRAY re_info
PROCEDURE db_prev
	PRIVATE currec
	m.currec = RECNO()
	DO r_prev
	IF !EOF()
		IF m.currec <> RECNO()
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF

			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(re_info[m.rof_fmove])
				DO (re_info[m.rof_fmove]) WITH "PREV"
			ENDIF
			SHOW GETS
		ELSE
			WAIT WINDOW "This is the first record in this file" NOWAIT
		ENDIF
	ELSE
		WAIT WINDOW "This file is empty" NOWAIT
	ENDIF
	RETURN 0

* END OF PROCEDURE db_prev
	
EXTERNAL ARRAY re_info
PROCEDURE db_next
	PRIVATE currec
	m.currec = RECNO()
	DO r_next
	IF !EOF()
		IF m.currec <> RECNO()
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF

			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(re_info[m.rof_fmove])
				DO (re_info[m.rof_fmove]) WITH "NEXT"
			ENDIF
			SHOW GETS
		ELSE
			WAIT WINDOW "This is the last record in this file" NOWAIT
		ENDIF
	ELSE
		WAIT WINDOW "This file is empty" NOWAIT
	ENDIF
	RETURN 0

* END OF PROCEDURE db_next
	
EXTERNAL ARRAY re_info
PROCEDURE db_bottom
	PRIVATE currec
	m.currec = RECNO()
	DO r_bottom
	IF !EOF()
		IF m.currec <> RECNO()
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF

			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(re_info[m.rof_fmove])
				DO (re_info[m.rof_fmove]) WITH "BOTTOM"
			ENDIF
			SHOW GETS
		ELSE
			WAIT WINDOW "This is the last record in this file" NOWAIT
		ENDIF
	ELSE
		WAIT WINDOW "This file is empty" NOWAIT
	ENDIF
	RETURN 0

* END OF PROCEDURE db_bottom

EXTERNAL ARRAY re_info
FUNCTION db_edit
PARAMETERS checkvalid
	IF PARAMETERS() < 1
		m.checkvalid = .T.
	ENDIF
	
	IF EOF()
		DO msg WITH "This file is empty"
		RETURN .F.
	ENDIF
	
	IF re_info[m.rof_inedit] && Already editing
		PRIVATE fsave
		m.fsave = re_info[m.rof_fsave]
		IF !&fsave(m.checkvalid)
			RETURN
		ENDIF
	ENDIF

	PRIVATE retval, origarea, preedit, postedit

	m.preedit  = re_info[m.rof_fpreed]
	m.postedit = re_info[m.rof_fpsted]

	IF !EMPTY(m.preedit)
		IF !&preedit()
			RETURN .F.
		ENDIF
	ENDIF

	m.origarea = SELECT()
	SELECT (re_info[m.rof_primfil])
	
	m.retval = r_edit()
	IF m.retval
		IF re_info[m.rof_type] == "ONE TO ONE"
			DO dbo_scatter
		ELSE
			SCATTER MEMVAR MEMO
		ENDIF
		re_info[m.rof_mode] = "EDIT"
		re_info[m.rof_inedit] = .T.
		IF !EMPTY(m.postedit)
			DO (m.postedit)
		ENDIF

		DO c_editon && Call function in control window to toggle editing on	
		DO (re_info[m.rof_fshow]) && Show gets in this window
		SHOW GETS
		_curobj = 1
	ELSE
		DO msg WITH "Can't lock this record to edit it"
	ENDIF
	
	IF !EMPTY(m.origarea)
		SELECT (m.origarea)
	ENDIF
	
	RETURN m.retval
	
* END OF PROCEDURE db_edit

EXTERNAL ARRAY re_info
PROCEDURE db_add
PARAMETERS nextid, checkvalid
	IF PARAMETERS() < 2
		m.checkvalid = .T.
	ENDIF
	IF PARAMETERS() < 1
		m.nextid = .F.
	ENDIF

	IF re_info[m.rof_inedit]
		PRIVATE fsave
		m.fsave = re_info[m.rof_fsave]
		IF !&fsave(m.checkvalid)
			RETURN
		ENDIF
	ENDIF

	PRIVATE preadd, postadd, recinit, recmove
	preadd  = re_info[m.rof_fpread]
	postadd = re_info[m.rof_fpstad]
	recinit = re_info[m.rof_finit]
	recmove = re_info[m.rof_fmove]
	
	IF !EMPTY(m.preadd)
		IF !&preadd()
			RETURN
		ENDIF
	ENDIF

	PRIVATE origproc, retval
	SELECT (re_info[m.rof_primfil])
	
	m.retval = r_add(m.nextid)
	IF m.retval
		GO RECNO() && Update relations
		IF re_info[m.rof_type] == "ONE TO ONE"
			DO dbo_add
			DO dbo_scatter
		ELSE
			SCATTER MEMVAR MEMO
		ENDIF
		re_info[m.rof_mode] = "ADD"
		re_info[m.rof_inedit] = .T.
		m.mode = "ADD"
		m.editing = .T.

		IF !EMPTY(m.recinit)
			DO (m.recinit)
		ENDIF
		IF !EMPTY(m.postadd)
			DO (m.postadd)
		ENDIF

		IF re_info[m.rof_type] = "ONE TO MANY"
			DO re_info[m.rom_frdln]
		ENDIF

		IF !EMPTY(m.recmove)
			DO (m.recmove) WITH "ADD"
		ENDIF

		DO c_editon
		DO (re_info[m.rof_fshow])
		SHOW GETS
		_curobj = 1
	ELSE
		DO msg WITH "Cannot add a record"
	ENDIF

* END OF PROCEDURE db_add

EXTERNAL ARRAY re_info
PROCEDURE db_delete
	PRIVATE delfunc, recmove

	m.delfunc = re_info[m.rof_fdel]
	IF !EMPTY(m.delfunc)
		IF !&delfunc()
			RETURN
		ENDIF
	ENDIF
	
	m.recmove = re_info[m.rof_fmove]
	
	SELECT (re_info[m.rof_primfil])
	IF !RLOCK()	
		DO msg WITH "Can't delete, someone else is using this record"
	ELSE
		IF yorn(re_info[m.rof_delmsg])
			IF re_info[m.rof_inedit]
				IF re_info[m.rof_type] == "ONE TO ONE"
					DO dbo_scatter
				ELSE
					SCATTER MEMVAR MEMO
				ENDIF
			ENDIF

			IF !EMPTY(re_info[m.rom_fprdel])
				DO (re_info[m.rom_fprdel])
			ENDIF
			
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_delete
			ENDIF
			
			DO r_delete WITH .F., .T.
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF

			IF re_info[m.rof_inedit]
				DO re_info[m.rof_fhide]
				DO c_editoff
				re_info[m.rof_inedit] = .F.
			ENDIF
			
			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(m.recmove)
				DO (m.recmove) WITH "DELETE"
			ENDIF
			SHOW GETS
		ENDIF
		UNLOCK
	ENDIF

* END OF PROCEDURE db_delete

PROCEDURE db_quit
PARAMETERS checkvalid
	IF PARAMETERS() < 1
		m.checkvalid = .T.
	ENDIF

	IF re_info[m.rof_inedit]
		PRIVATE fsave
		m.fsave = re_info[m.rof_fsave]
		IF !&fsave(m.checkvalid)
			RETURN
		ENDIF
	ENDIF
	
	CLEAR READ

* END OF PROCEDURE db_quit
	
EXTERNAL ARRAY re_info
PROCEDURE db_ok
	DO (re_info[m.rof_fsave]) WITH .F.
	
* END OF PROCEDURE db_ok

PROCEDURE db_autook
	PRIVATE currec, recvalid, savemsg
	
	m.recvalid = re_info[m.rof_fvalid]

	IF !EMPTY(m.recvalid)	
		IF !&recvalid()
			RETURN
		ENDIF
	ENDIF
	
	m.savemsg = re_info[m.rof_lsvmsg]
	IF !EMPTY(m.savemsg)
		DO msg_up WITH m.savemsg
	ENDIF
	
	IF re_info[m.rof_mode] = "ADD"
		m.currec = RECNO()
		GO m.currec
	ENDIF
	SELECT (re_info[m.rof_primfil])
	GATHER MEMVAR MEMO
	IF re_info[m.rof_type] == "ONE TO MANY"
		DO (re_info[m.rom_fokln])
	ENDIF
	UNLOCK

	PRIVATE endedit
	
	m.endedit = .T.
	IF !EMPTY(re_info[m.rof_fpstok])
		DO (re_info[m.rof_fpstok]) WITH re_info[m.rof_mode]
	ENDIF

	IF !EMPTY(m.savemsg)
		DO msg_down
	ENDIF

	IF re_info[m.rof_mode] = "ADD"
		m.endedit = .F.
		PRIVATE preadd, postadd, recinit, recmove
		preadd  = re_info[m.rof_fpread]
		postadd = re_info[m.rof_fpstad]
		recinit = re_info[m.rof_finit]
		recmove = re_info[m.rof_fmove]
	
		IF !EMPTY(m.preadd)
			IF !&preadd()
				m.endedit = .T.
			ENDIF
		ENDIF

		PRIVATE origproc, retval
		SELECT (re_info[m.rof_primfil])
	
		m.retval = r_add(re_info[m.rof_autoid], .T.)
		IF m.retval
			GO RECNO() && Update relations
			SCATTER MEMVAR MEMO
			re_info[m.rof_mode] = "ADD"
			re_info[m.rof_inedit] = .T.

			IF !EMPTY(m.recinit)
				DO (m.recinit)
			ENDIF
			IF !EMPTY(m.postadd)
				DO (m.postadd)
			ENDIF

			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(m.recmove)
				DO (m.recmove) WITH "ADD"
			ENDIF

			DO (re_info[m.rof_fshow])
			SHOW GETS
			_curobj = 1
		ELSE
			DO msg WITH "Cannot add a record"
			m.endedit = .T.
		ENDIF
	ENDIF

	IF m.endedit
		DO c_editoff
		DO (re_info[m.rof_fhide])
		SHOW GETS
		re_info[m.rof_inedit] = .F.
		SHOW MENU _MSYSMENU
	ENDIF

* END OF PROCEDURE db_autook

EXTERNAL ARRAY re_info
PROCEDURE db_cancel
PARAMETERS verify
	IF PARAMETERS() < 1
		m.verify = .T.
	ENDIF

	PRIVATE blankarray, abortmsg, recmove
	m.abortmsg = re_info[m.rof_labmsg]
	m.recmove = re_info[m.rof_fmove]
	
	IF re_info[m.rof_mode] = "ADD"
		IF (m.verify AND yorn(re_info[m.rof_abaask])) OR !m.verify
			IF !EMPTY(m.abortmsg)
				DO msg_up WITH m.abortmsg
			ENDIF
			DELETE
			SCATTER BLANK TO m.blankarray
			GATHER FROM m.blankarray
			DO r_top
			IF re_info[m.rof_type] == "ONE TO ONE"
				DO dbo_scatter
			ELSE
				SCATTER MEMVAR MEMO
			ENDIF
			
			IF re_info[m.rof_type] == "ONE TO MANY" AND ;
				!EMPTY(re_info[m.rom_fcclln])
				DO (re_info[m.rom_fcclln])
			ENDIF

			IF re_info[m.rof_type] = "ONE TO MANY"
				DO re_info[m.rom_frdln]
			ENDIF

			IF !EMPTY(m.recmove)
				DO (m.recmove) WITH "LOCATE"
			ENDIF
		ELSE
			_curobj = 1
			RETURN
		ENDIF
	ELSE
		IF m.verify AND !yorn(re_info[m.rof_abeask])
			_curobj = 1
			RETURN
		ENDIF
		IF !EMPTY(m.abortmsg)
			DO msg_up WITH m.abortmsg
		ENDIF
	ENDIF
	SELECT (re_info[m.rof_primfil])
	IF re_info[m.rof_type] == "ONE TO ONE"
		DO dbo_scatter
	ELSE
		SCATTER MEMVAR MEMO
	ENDIF
	IF re_info[m.rof_type] == "ONE TO MANY" AND ;
		!EMPTY(re_info[m.rom_fcclln])
		DO (re_info[m.rom_fcclln])
	ENDIF

	IF re_info[m.rof_type] = "ONE TO MANY"
		DO re_info[m.rom_frdln]
	ENDIF

	IF !EMPTY(m.recmove)
		DO (m.recmove) WITH "LOCATE"
	ENDIF

	UNLOCK
	DO c_editoff
	DO (re_info[m.rof_fhide])
	SHOW GETS
	re_info[m.rof_inedit] = .F.
	SHOW MENU _MSYSMENU
	IF !EMPTY(m.abortmsg)
		DO msg_down
	ENDIF

* END OF PROCEDURE db_cancel

FUNCTION db_save
PARAMETERS checkvalid
	IF m.checkvalid
		IF !db_valid(@m.scr_vals, _CUROBJ)
			RETURN .F.
		ENDIF
	ENDIF

	PRIVATE currec, recvalid, savemsg
	
	m.recvalid = re_info[m.rof_fvalid]
	
	IF !EMPTY(m.recvalid)
		IF !&recvalid()
			RETURN .F.
		ENDIF
	ENDIF

	m.savemsg = re_info[m.rof_lsvmsg]
	IF !EMPTY(m.savemsg)
		DO msg_up WITH m.savemsg
	ENDIF
	
	IF re_info[m.rof_mode] = "ADD"
		IF re_info[m.rof_type] != "ONE TO ONE"
			m.currec = RECNO()
			GO m.currec
		ENDIF
	ENDIF
	SELECT (re_info[m.rof_primfil])
	IF re_info[m.rof_type] == "ONE TO ONE"
		DO dbo_gather
	ELSE
		GATHER MEMVAR MEMO
	ENDIF
	IF re_info[m.rof_type] == "ONE TO MANY"
		DO (re_info[m.rom_fokln])
	ENDIF
	UNLOCK
	DO c_editoff
	DO (re_info[m.rof_fhide])
	IF !EMPTY(re_info[m.rof_fpstok])
		DO (re_info[m.rof_fpstok]) WITH re_info[m.rof_mode]
	ENDIF
	SHOW GETS
	re_info[m.rof_inedit] = .F.
	SHOW MENU _MSYSMENU
	IF !EMPTY(m.savemsg)
		DO msg_down
	ENDIF
	
	RETURN .T.

* END OF PROCEDURE db_save (FUNCTION)

FUNCTION db_valid
PARAMETERS d_vals, d_curobj
	PRIVATE d_retval, d_valexpr

	m.d_valexpr = SUBSTR(m.d_vals, AT(CHR(10), m.d_vals, m.d_curobj) + 1)
	m.d_valexpr = LEFT(m.d_valexpr, AT(CHR(10), m.d_valexpr) - 1)
	IF EMPTY(m.d_valexpr)
		RETURN .T.
	ELSE
		m.d_retval = &d_valexpr
		SHOW GETS
		IF TYPE("m.d_retval") = "L" && TRUE or FALSE
			RETURN m.d_retval
		ELSE && Numeric
			RETURN m.d_retval <> 0
		ENDIF
	ENDIF
	
* END OF PROCEDURE db_valid (FUNCTION)


*** Start of one to one functions

EXTERNAL ARRAY a_dbases, re_info
PROCEDURE dbo_scatter
	PRIVATE i, numdbases
	m.numdbases = re_info[m.roo_numfil]
	FOR m.i = 2 TO m.numdbases
		SELECT (a_dbases[m.i])
		SCATTER MEMVAR MEMO
	ENDFOR
	SELECT (a_dbases[1])
	SCATTER MEMVAR MEMO
	
* END OF PROCEDURE dbo_scatter

EXTERNAL ARRAY a_dbases, re_info
PROCEDURE dbo_gather
	PRIVATE i, numdbases
	m.numdbases = re_info[m.roo_numfil]
	FOR m.i = 1 TO m.numdbases
		SELECT (a_dbases[m.i])
		GATHER MEMVAR MEMO
	ENDFOR
	SELECT (a_dbases[1])
	
* END OF PROCEDURE dbo_gather

EXTERNAL ARRAY a_dbases, re_info
PROCEDURE dbo_add
	PRIVATE i, numdbases
	m.numdbases = re_info[m.roo_numfil]
	FOR m.i = 2 TO m.numdbases
		SELECT (a_dbases[m.i])
		DO r_add WITH .F.
	ENDFOR
	SELECT (a_dbases[1])

* END OF PROCEDURE dbo_add

EXTERNAL ARRAY a_dbases, re_info
PROCEDURE dbo_delete
	PRIVATE i, numdbases
	m.numdbases = re_info[m.roo_numfil]
	FOR m.i = 2 TO m.numdbases
		SELECT (a_dbases[m.i])
		DO r_delete WITH .F.
	ENDFOR
	SELECT (a_dbases[1])

* END OF PROCEDURE dbo_delete

FUNCTION db_getmode
PARAMETERS params, paramoffset, editmode, editid, searchord
EXTERNAL ARRAY params
	PRIVATE numparams, editparams, atpos, origord, retval, doseek

	m.doseek     = .T.
	m.retval     = .F.
	m.numparams  = params[m.paramoffset+1]
	m.editparams = params[m.paramoffset+2]
	m.atpos = AT(":", m.editparams)
	IF m.atpos = 0
		m.editmode = params[m.paramoffset+2]
		m.editid = ""
		m.doseek = .F.
	ELSE
		m.editmode = LEFT(m.editparams, m.atpos - 1)
		m.editid   = SUBSTR(m.editparams, m.atpos + 1)
	ENDIF

	IF EMPTY(m.editmode)
		m.editmode = "VIEW"
	ELSE
		m.editmode = UPPER(ALLTRIM(m.editmode))
	ENDIF

	m.origord = ORDER()
	SET ORDER TO (m.searchord)
	
	PRIVATE keytype, key
	m.key     = EVAL(KEY(VAL(SYS(21))))
	m.keytype = TYPE("m.key")

	IF m.keytype = "C"
		m.editid = PADR(m.editid, LEN(m.key))
	ENDIF

	IF m.doseek
		SEEK m.editid
		IF !FOUND()
			m.retval = .T.
		ENDIF
	ELSE
		m.retval = .T.
	ENDIF
	SET ORDER TO (m.origord)

	RETURN m.retval

* END OF PROCEDURE db_getmode (FUNCTION)

PROCEDURE db_begmode
PARAMETERS editmode
	DO CASE
	CASE m.editmode = "EDIT"
		KEYBOARD "{Ctrl+E}"
	CASE m.editmode = "DELETE"
		KEYBOARD "{Ctrl+D}"
	CASE m.editmode = "LOCATE"
		KEYBOARD "{F5}"
	CASE m.editmode = "ADD"
		KEYBOARD "{Ctrl+A}"
	OTHERWISE && VIEW or missing
		* Do nothing
	ENDCASE		
		
* END OF PROCEDURE db_begmode
