*********************************************************************
* Copyright 1993, UFO Computing, Inc.
* All Rights Reserved
*
* Version 1.301
*
* Modified: 07/14/93
*	db_order, db_report, db_locate, db_filter, db_count
*	db_mark, db_marksel, db_markall, db_marknone
*		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.
*	dr_setup
*		Added a TRIM() around the call to the custom setup program
*		because wouldn't work with a procedure
*********************************************************************

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

EXTERNAL ARRAY re_info

* Squeeze duplicates from procstak.
EXTERNAL ARRAY procstack
PROCEDURE dstk_sqz
PARAMETERS procstack, stacklen
	PRIVATE level, curprogram
	m.level = 2
	m.curprogram = PROGRAM(m.level)
	DO WHILE !EMPTY(m.curprogram)
		FOR m.i = 1 TO m.stacklen
			IF PADR(m.curprogram, 10) == PADR(UPPER(procstack[m.i]), 10)
				=ADEL(m.procstack, m.i)
				m.stacklen = m.stacklen - 1
				EXIT
			ENDIF
		ENDFOR
		m.level = m.level + 1
		m.curprogram = PROGRAM(m.level)
	ENDDO

* Setup FoxPro "set" variables
PROCEDURE dset_set
	SET MEMOWIDTH TO 80
	SET TALK       OFF
	SET DELETED    ON
	SET EXCLUSIVE  OFF
	SET SAFETY     OFF
	SET EXACT      OFF
	SET CURSOR     ON
	SET MULTILOCKS ON
	SET NEAR       OFF
	SET NOTIFY     ON
	CLEAR MACROS
	CLEAR
	IF _WINDOWS
		SET STATUS BAR OFF
	ENDIF
	
* END OF PROCEDURE dset_set

* Setup up global variables used for records
PROCEDURE drec_set
	* For the one file only, one to one and one to many items, the
	* first few items MUST have corresponding indexes. 
	* Starting at *_mode to *_primfil
	* Functions in this and f_recs all use the rof_* (one file) indexes
	* for simplicity, even when a one to one or one to many file
	* is being editing.
	
	* Flat file editing structure
	PUBLIC rof_ftop, rof_fprev, rof_fnext, rof_fbottom
	PUBLIC rof_fedit, rof_fadd, rof_fdelete, rof_fprdel
	PUBLIC rof_fok, rof_fcancel, rof_fquit, rof_fsrch, rof_floc
	PUBLIC rof_fshow, rof_fhide
	PUBLIC rof_finit, rof_fvalid, rof_fdel, rof_fmove
	PUBLIC rof_fpread, rof_fpstad, rof_fpreed, rof_fpsted, rof_fpstok
	PUBLIC rof_mode, rof_inedit, rof_marks, rof_markexp
	PUBLIC rof_showflt, rof_holdflt, rof_curgrp, rof_primfil
	PUBLIC rof_frstord, rof_frstrep, rof_frstflt
	PUBLIC rof_gotord,  rof_gotrep,  rof_gotflt
	PUBLIC rof_type
	PUBLIC rof_delmsg, rof_autoid, rof_edmsg, rof_srchord
	PUBLIC rof_lsvmsg, rof_labmsg
	PUBLIC rof_abaask, rof_abeask, rof_autoed, rof_fsave
	PUBLIC rof_numcols
	rof_ftop    = 1
	rof_fprev   = 2
	rof_fnext   = 3
	rof_fbottom = 4
	rof_fedit   = 5
	rof_fadd    = 6
	rof_fdelete = 7
	rof_fok     = 8
	rof_fcancel = 9
	rof_fquit   = 10
	rof_fshow   = 11
	rof_fhide   = 12
	rof_finit   = 13
	rof_fvalid  = 14
	rof_fdel    = 15
	rof_fmove   = 16
	rof_fpread  = 17
	rof_fpstad  = 18
	rof_fpreed  = 19
	rof_fpsted  = 20
	rof_frstord = 21
	rof_frstrep = 22
	rof_frstflt = 23
	rof_gotord  = 24
	rof_gotrep  = 25
	rof_gotflt  = 26
	rof_showflt = 27
	rof_holdflt = 28
	rof_curgrp  = 29
	rof_primfil = 30
	rof_mode    = 31
	rof_inedit  = 32
	rof_type    = 33
	rof_delmsg  = 34
	rof_autoid  = 35
	rof_edmsg   = 36
	rof_fpstok  = 37
	rof_marks   = 38
	rof_markexp = 39
	rof_fprdel  = 40
	rof_srchord = 41
	rof_lsvmsg  = 42
	rof_labmsg  = 43
	rof_abaask  = 44
	rof_abeask  = 45
	rof_autoed  = 46
	rof_fsrch   = 47
	rof_floc    = 48
	rof_fsave   = 49
	* End of common fields
	rof_numcols = 49

	* One to one file editing structure
	PUBLIC roo_ftop, roo_fprev, roo_fnext, roo_fbottom
	PUBLIC roo_fedit, roo_fadd, roo_fdelete
	PUBLIC roo_fok, roo_fcancel, roo_fquit, roo_fpstok, roo_fsrch, roo_floc
	PUBLIC roo_fshow, roo_fhide
	PUBLIC roo_finit, roo_fvalid, roo_fdel, roo_fmove
	PUBLIC roo_fpread, roo_fpstad, roo_fpreed, roo_fpsted
	PUBLIC roo_mode, roo_inedit, roo_marks, roo_markexp
	PUBLIC roo_showflt, roo_holdflt, roo_curgrp, roo_primfil
	PUBLIC roo_frstord, roo_frstrep, roo_frstflt
	PUBLIC roo_gotord,  roo_gotrep,  roo_gotflt
	PUBLIC roo_type
	PUBLIC roo_delmsg, roo_autoid, roo_edmsg, roo_fprdel, roo_srchord
	PUBLIC roo_numfil, roo_abaask, roo_abeask
	PUBLIC roo_lsvmsg, roo_labmsg, roo_autoed, roo_fsave
	PUBLIC roo_numcols
	roo_ftop    = 1
	roo_fprev   = 2
	roo_fnext   = 3
	roo_fbottom = 4
	roo_fedit   = 5
	roo_fadd    = 6
	roo_fdelete = 7
	roo_fok     = 8
	roo_fcancel = 9
	roo_fquit   = 10
	roo_fshow   = 11
	roo_fhide   = 12
	roo_finit   = 13
	roo_fvalid  = 14
	roo_fdel    = 15
	roo_fmove   = 16
	roo_fpread  = 17
	roo_fpstad  = 18
	roo_fpreed  = 19
	roo_fpsted  = 20
	roo_frstord = 21
	roo_frstrep = 22
	roo_frstflt = 23
	roo_gotord  = 24
	roo_gotrep  = 25
	roo_gotflt  = 26
	roo_showflt = 27
	roo_holdflt = 28
	roo_curgrp  = 29
	roo_primfil = 30
	roo_mode    = 31
	roo_inedit  = 32
	roo_type    = 33
	roo_delmsg  = 34
	roo_autoid  = 35
	roo_edmsg   = 36
	roo_fpstok  = 37
	roo_marks   = 38
	roo_markexp = 39
	roo_fprdel  = 40
	roo_srchord = 41
	roo_lsvmsg  = 42
	roo_labmsg  = 43
	roo_abaask  = 44
	roo_abeask  = 45
	roo_autoed  = 46
	roo_fsrch   = 47
	roo_floc    = 48
	roo_fsave   = 49
	* End of common fields
	roo_numfil  = 50
	roo_numcols = 50

	* One to many editing structure
	PUBLIC rom_ftop, rom_fprev, rom_fnext, rom_fbottom
	PUBLIC rom_fedit, rom_fadd, rom_fdelete
	PUBLIC rom_fok, rom_fcancel, rom_fquit, rom_fsrch, rom_floc
	PUBLIC rom_fshow, rom_fhide, rom_fpstok
	PUBLIC rom_finit, rom_fvalid, rom_fdel, rom_fmove
	PUBLIC rom_fpread, rom_fpstad, rom_fpreed, rom_fpsted
	PUBLIC rom_frstord, rom_frstrep, rom_frstflt
	PUBLIC rom_gotord,  rom_gotrep,  rom_gotflt
	PUBLIC rom_mode, rom_inedit, rom_type, rom_marks, rom_markexp
	PUBLIC rom_delmsg, rom_autoid, rom_edmsg, rom_fsave
	PUBLIC rom_fokln, rom_fcclln, rom_abaask, rom_abeask, rom_frdln
	PUBLIC rom_showflt, rom_holdflt, rom_curgrp, rom_primfil
	PUBLIC rom_laction, rom_fchkobj
	PUBLIC rom_showall, rom_fprdel, rom_srchord
	PUBLIC rom_lsvmsg, rom_labmsg, rom_autoed
	PUBLIC rom_lrecs, rom_flhide
	PUBLIC rom_numcols
	rom_ftop    = 1
	rom_fprev   = 2
	rom_fnext   = 3
	rom_fbottom = 4
	rom_fedit   = 5
	rom_fadd    = 6
	rom_fdelete = 7
	rom_fok     = 8
	rom_fcancel = 9
	rom_fquit   = 10
	rom_fshow   = 11
	rom_fhide   = 12
	rom_finit   = 13
	rom_fvalid  = 14
	rom_fdel    = 15
	rom_fmove   = 16
	rom_fpread  = 17
	rom_fpstad  = 18
	rom_fpreed  = 19
	rom_fpsted  = 20
	rom_frstord = 21
	rom_frstrep = 22
	rom_frstflt = 23
	rom_gotord  = 24
	rom_gotrep  = 25
	rom_gotflt  = 26
	rom_showflt = 27
	rom_holdflt = 28
	rom_curgrp  = 29
	rom_primfil = 30
	rom_mode    = 31
	rom_inedit  = 32
	rom_type    = 33
	rom_delmsg  = 34
	rom_autoid  = 35
	rom_edmsg   = 36
	rom_fpstok  = 37
	rom_marks   = 38
	rom_markexp = 39
	rom_fprdel  = 40
	rom_srchord = 41
	rom_lsvmsg  = 42
	rom_labmsg  = 43
	rom_abaask  = 44
	rom_abeask  = 45
	rom_autoed  = 46
	rom_fsrch   = 47
	rom_floc    = 48
	rom_fsave   = 49
	* End of common fields
	rom_fokln   = 50
	rom_fcclln  = 51
	rom_laction = 52
	rom_fchkobj = 53
	rom_showall = 54
	rom_lrecs   = 55
	rom_flhide  = 56
	rom_frdln   = 57
	rom_numcols = 57

	* Setup report structure
	PUBLIC rr_namedes, rr_name, rr_type, rr_rptname, rr_userord
	PUBLIC rr_userfilt, rr_usermark, rr_setprog, rr_view
	PUBLIC rr_procfile
	PUBLIC rr_category, rr_initprg, rr_cleanprg, rr_prepprg
	PUBLIC rr_id
	PUBLIC rr_wrptname, rr_prompt, rr_runwhere, rr_numcols
	rr_namedes   = 1
	rr_name      = 2
	rr_type      = 3
	rr_rptname   = 4
	rr_userord   = 5
	rr_userfilt  = 6
	rr_usermark  = 7
	rr_initprg   = 8
	rr_setprog   = 9
	rr_cleanprog = 10
	rr_prepprg   = 11
	rr_view      = 12
	rr_procfile  = 13
	rr_category  = 14
	rr_id        = 15
	rr_wrptname  = 16
	rr_prompt    = 17
	rr_runwhere  = 18
	rr_numcols   = 18

	* Setup order structure
	PUBLIC ro_namedes, ro_name, ro_tag, ro_desc, ro_numcols
	ro_namedes = 1
	ro_name    = 2
	ro_tag     = 3
	ro_desc    = 4
	ro_numcols = 4

	* Setup report order structure
	PUBLIC rro_namedes, rro_name, rro_tag, rro_numcols
	rro_namedes = 1
	rro_name    = 2
	rro_tag     = 3
	rro_numcols = 4

	* Current order structure
	PUBLIC rco_name, rco_desc, rco_tag, rco_numcols
	rco_name    = 1
	rco_desc    = 2
	rco_tag     = 3
	rco_numcols = 3
		
	* Setup filter structure
	PUBLIC rf_namedesc, rf_dbase, rf_field, rf_picture, rf_numcols
	rf_namedesc = 1
	rf_dbase    = 2
	rf_field    = 3
	rf_picture  = 4
	rf_numcols  = 4

	* Setup current filter structure
	PUBLIC rfc_name, rfc_dbase, rfc_field, rfc_type
	PUBLIC rfc_not, rfc_not, rfc_low
	PUBLIC rfc_high, rfc_andor, rfc_uclc, rfc_orlevel, rfc_cond, rfc_numcols
	rfc_dbase   = 1
	rfc_field   = 2
	rfc_type    = 3
	rfc_not     = 4
	rfc_low     = 5
	rfc_high    = 6
	rfc_andor   = 7
	rfc_orlevel = 8
	rfc_cond    = 9
	rfc_uclc    = 10
	rfc_name    = 11
	rfc_numcols = 11

	* Setup printer setup structure
	PUBLIC rp_namedesc, rp_name, rp_defport
	PUBLIC rp_numcols
	rp_namedesc   = 1
	rp_name       = 2
	rp_defport    = 3
	rp_numcols    = 3
	
	* Setup printer port structure
	PUBLIC rpp_name, rpp_setstr, rpp_numcols
	rpp_name    = 1
	rpp_setstr  = 2
	rpp_numcols = 2
	
	* Setup view restoration structure
	PUBLIC rv_areas, rv_control, rv_db, rv_readin, rv_ord
	PUBLIC rv_filter, rv_recno, rv_rels, rv_skips, rv_baseflt
	PUBLIC rv_dbf, rv_alias, rv_closed, rv_dbssaved
	PUBLIC rv_numcols
	rv_areas    = 1
	rv_control  = 2
	rv_baseflt  = 3
	rv_dbssaved = 4
	rv_db       = 5
	rv_readin   = 6
	rv_ord      = 7 
	rv_filter   = 8 
	rv_recno    = 9 
	rv_rels     = 10
	rv_skips    = 11
	rv_closed   = 12
	rv_dbf      = 13
	rv_alias    = 14
	rv_numcols  = 14

	* Setup line item structure
	PUBLIC rl_totitems, rl_numrows, rl_numcolms, rl_topline
	PUBLIC rl_curitem, rl_rowsused, rl_numgtcols, rl_vararr
	PUBLIC rl_fadel, rl_fcopy, rl_ffill, rl_ffills, rl_flastln, rl_fvalid
	PUBLIC rl_finsert, rl_fdelete, rl_fswap, rl_fcpyline, rl_fcpydo
	PUBLIC rl_canadd, rl_candel, rl_fsave, rl_fread, rl_dbase
	PUBLIC rl_origar, rl_getar, rl_finit, rl_fshow, rl_fcompl, rl_dels
	PUBLIC rl_prevrow
	PUBLIC rl_scolnum, rl_scolst, rl_scolar, rl_insub
	PUBLIC rl_fchkdel, rl_fchkins, rl_fchkswap, rl_fnewpos, rl_incr
	PUBLIC rl_numcols
	rl_totitems  = 1
	rl_curitem   = 2
	rl_numrows   = 3
	rl_numcolms  = 4
	rl_topline   = 5
	rl_rowsused  = 6
	rl_numgtcols = 7
	rl_vararr    = 8
	rl_fadel     = 9 
	rl_fcopy     = 10
	rl_ffill     = 11
	rl_ffills    = 12
	rl_flastln   = 13
	rl_fvalid    = 14
	rl_finsert   = 15
	rl_fdelete   = 16
	rl_fswap     = 17
	rl_canadd    = 18
	rl_candel    = 19
	rl_origar    = 20
	rl_finit     = 21
	rl_fshow     = 22
	rl_fcompl    = 23
	rl_dels      = 24 
	rl_getar     = 25
	rl_prevrow   = 26
	rl_scolnum   = 27
	rl_scolst    = 28
	rl_scolar    = 29
	rl_insub     = 30
	rl_fchkdel   = 31
	rl_fchkins   = 32
	rl_fchkswap  = 33
	rl_fnewpos   = 34
	rl_fcpyline  = 35
	rl_fcpydo    = 36
	rl_fsave     = 37
	rl_dbase     = 38
	rl_fread     = 39
	rl_incr      = 40
	rl_numcols   = 40

	* Setup selection window header structure
	PUBLIC rsh_dbase, rsh_numsel, rsh_stitle, rsh_mtitle
	PUBLIC rsh_mexp, rsh_numcols
	m.rsh_dbase   = 1
	m.rsh_stitle  = 2
	m.rsh_mtitle  = 3
	m.rsh_numsel  = 4
	m.rsh_mexp    = 5
	m.rsh_numcols = 5
	
	* Setup selection window structure
	PUBLIC rs_dbase, rs_id, rs_name, rs_srchexp, rs_selpic
	PUBLIC rs_tag, rs_desc, rs_srchtag, rs_srchdesc, rs_retexpr, rs_selexpr
	PUBLIC rs_lenexpr, rs_pref, rs_len, rs_numcols
	m.rs_dbase    = 1
	m.rs_id       = 2
	m.rs_name     = 3
	m.rs_srchexp  = 4
	m.rs_selpic   = 5
	m.rs_tag      = 6
	m.rs_srchtag  = 7
	m.rs_retexpr  = 8
	m.rs_selexpr  = 9 
	m.rs_len      = 10
	m.rs_lenexpr  = 11
	m.rs_pref     = 12
	m.rs_desc     = 13
	m.rs_srchdesc = 14
	m.rs_numcols  = 14
	
	PUBLIC rlk_type, rlk_code, rlk_mod, rlk_func, rlk_params, rlk_numcols
	m.rlk_type    = 1
	m.rlk_code    = 2
	m.rlk_mod     = 3
	m.rlk_func    = 4
	m.rlk_params  = 5
	m.rlk_numcols = 5
	
* END OF PROCEDURE drec_set

* Set up standard development SET PATH TO statement
PROCEDURE ds_stdpath
PARAMETERS morepath
	IF PARAMETERS() < 1
		m.morepath = ""
	ELSE
		m.morepath = ";" + m.morepath
	ENDIF
	
	SET PATH TO ..\dbfs;..\reports;&g_foxframe.extprgs;&g_foxframe.prgs;&g_foxframe.screens;&g_foxframe.menus;&g_foxframe.api\plbs;&morepath

* END OF PROCEDURE ds_stdpath

* Set up global variables. Open all databases that remain
* open throughout the program.
* Log the current user onto the system. Set up his/her resource file.
* Set up the error handler.
PROCEDURE dsys_set
PARAMETERS dologin, checkuser, resodir
	IF PARAMETERS() < 3
		m.resodir = ""
	ENDIF
	IF PARAMETERS() < 2
		m.checkuser = .T.
	ENDIF
	IF PARAMETERS() < 1
		m.dologin = .T.
	ENDIF 

	* Save screen font and set to FoxPro default
	IF _WINDOWS
		PUBLIC g_orgfntnm, g_orgfntsz, g_orgfntst
		m.g_orgfntnm = WFONT(1, "")
		m.g_orgfntsz = WFONT(2, "")
		m.g_orgfntst = WFONT(3, "")
		MODIFY WINDOW SCREEN FONT "FoxFont", 9 STYLE "N"
	ENDIF
	
	* Set up DOS based printer driver
	PUBLIC g_genpd, g_pdsetup
	m.g_genpd    = _GENPD
	m.g_pdsetup  = _PDSETUP

	IF FILE("&g_foxframe.genpd\genpd.app")
		_GENPD = "&g_foxframe.genpd\genpd.app"
	ELSE
		_GENPD = "genpd.app"
	ENDIF
	CLEAR PROGRAM

	PUBLIC g_lastkey, g_basefilt, g_origreso, g_maxarea, g_eol
	m.g_lastkey  = 0
	m.g_basefilt = ""
	m.g_origreso = SET("RESOURCE", 1)
	m.g_maxarea  = 225
	m.g_eol      = CHR(13) + CHR(10)
	
	PUBLIC g_ordfile, g_repfile, g_repdbfile
	PUBLIC g_filtfile, g_fltrpfile, g_fltdbfile
	PUBLIC g_viewfile, g_printfile, g_portfile, g_pcodes
	PUBLIC g_paramfile, g_rordfile, g_selfile, g_selhdfile
	PUBLIC g_user, g_group
	PUBLIC g_reservdb
				
	m.g_group     = SPACE(10)
	m.g_ordfile   = "db_ords"
	m.g_rordfile  = "db_rords"
	m.g_repfile   = "db_reps"
	m.g_repdbfile = "db_repdb"
	m.g_filtfile  = "db_flt"
	m.g_fltrpfile = "db_fltrp"
	m.g_fltdbfile = "db_fltdb"
	m.g_viewfile  = "db_views"
	m.g_printfile = "db_print"
	m.g_portfile  = "db_ports"
	m.g_selhdfile = "db_selhd"
	m.g_selfile   = "db_sel"
	m.g_pcodes    = "db_pcode"
	
	PUBLIC g_rsetprog, g_ordprog, g_fltldprg, g_fltsvprg, g_repprog
	PUBLIC g_filtprog
	m.g_rsetprog = "repset1.spr"
	m.g_ordprog  = "order1.spr"
	m.g_fltldprg = "filtload.spr"
	m.g_fltsvprg = "filtsave.spr"
	m.g_repprog  = "report1.spr"
	m.g_filtprog = "filter1.spr"
	 
	* Open files which stays open throughout run of the program
	CLOSE DATABASE
	m.g_reservdb = ";"
	
	SELECT 0
	USE db_views
	m.g_reservdb = m.g_reservdb + LTRIM(STR(SELECT())) + ";"

	IF m.dologin OR m.checkuser
		SELECT 0
		USE db_logon ORDER user
		m.g_reservdb = m.g_reservdb + LTRIM(STR(SELECT())) + ";"

		m.g_user = GETENV("USER")
		IF EMPTY(m.g_user)
			m.g_user = "USER"
		ENDIF
	ENDIF
		
	m.g_passwd = ""
	
	IF m.checkuser
		DO du_logon WITH m.g_user, m.g_group, m.dologin
	ELSE
		m.g_user = ""
		m.g_group = SPACE(10)
	ENDIF
	
	IF m.g_group <> PADR("DEVELOPER", LEN(m.g_group))
		DO de_seterror IN errorhnd
		SET ESCAPE OFF
	ELSE
		ON ERROR
		SET ESCAPE ON
	ENDIF

	m.g_user = TRIM(m.g_user)
	
	* Read selections
	PRIVATE i, numdb, curdb, numsel
	PUBLIC g_sels, g_selhd
	
	SET PROCEDURE TO f_string
	
	=dv_select0(m.g_selfile)
	DIMENSION g_sels[1, m.rs_numcols]
	SELECT database, id, name, srchexp, selpicture, tag, srchtag, ;
			retexpr, selexpr, 0, lenexpr, pref, desc, srchdesc ;
		FROM (m.g_selfile) ;
		INTO ARRAY g_sels ;
		ORDER BY database, order
	USE
		
	=dv_select0(m.g_selhdfile)
	DIMENSION g_selhd[1, m.rsh_numcols]
	SELECT database, seltitle, marktitle, 0, markexp ;
		FROM (m.g_selhdfile) ;
		INTO ARRAY g_selhd ;
		ORDER BY database
	USE

	m.numdb = ALEN(g_selhd, 1)
	FOR m.i = 1 TO m.numdb
		m.curdb = g_selhd[m.i, m.rsh_dbase]
		g_selhd[m.i, m.rsh_numsel] = da_count(@m.g_sels, m.curdb, ;
			m.rs_dbase)
		g_selhd[m.i, m.rsh_stitle] = TRIM(g_selhd[m.i, m.rsh_stitle])
		g_selhd[m.i, m.rsh_mtitle] = TRIM(g_selhd[m.i, m.rsh_mtitle])
		g_selhd[m.i, m.rsh_mexp]   = TRIM(g_selhd[m.i, m.rsh_mexp])
	ENDFOR
	
	m.numsel = ALEN(g_sels, 1)
	FOR m.i = 1 TO m.numsel
		g_sels[m.i, m.rs_id]      = TRIM(g_sels[m.i, m.rs_id])
		g_sels[m.i, m.rs_name]    = TRIM(g_sels[m.i, m.rs_name])
		g_sels[m.i, m.rs_srchexp] = TRIM(g_sels[m.i, m.rs_srchexp])
		g_sels[m.i, m.rs_selpic]  = TRIM(g_sels[m.i, m.rs_selpic])
		g_sels[m.i, m.rs_tag]     = TRIM(g_sels[m.i, m.rs_tag])
		g_sels[m.i, m.rs_srchtag] = TRIM(g_sels[m.i, m.rs_srchtag])
		g_sels[m.i, m.rs_retexpr] = TRIM(g_sels[m.i, m.rs_retexpr])
		g_sels[m.i, m.rs_selexpr] = TRIM(g_sels[m.i, m.rs_selexpr])
		g_sels[m.i, m.rs_lenexpr] = TRIM(g_sels[m.i, m.rs_lenexpr])
		g_sels[m.i, m.rs_pref]    = TRIM(g_sels[m.i, m.rs_pref])
	ENDFOR
	
	SET PROCEDURE TO
	
	* Create or open resource file for storing selection window settings
	IF m.dologin OR m.checkuser
		PRIVATE resofile, origsel
		m.origsel = SELECT()
		
		m.resofile = TRIM(m.resodir) + m.g_user + "RS"
	
		IF !FILE(m.resofile + ".DBF") OR !FILE(m.resofile + ".FPT")
			CREATE TABLE (m.resofile) ( ;
				type     C(12), ;
				id       C(12), ;
				name     C(24), ;
				readonly L, ;
				ckval    N(6,0), ;
				data     M, ;
				updated  D ;
			)
			USE
		ENDIF

		SET RESOURCE TO (m.resofile)
		SELECT (m.origsel)
	ENDIF

	PUBLIC g_portinfo, g_prninfo
	m.g_portinfo = ""
	m.g_prninfo  = ""	
	
	DO ds_port  WITH m.g_portinfo
	DO ds_print WITH m.g_prninfo	

* END OF PROCEDURE dsys_set

* Restore the system to its original state.
PROCEDURE dsys_rest
	SET RESOURCE TO (m.g_origreso)
	IF USED("db_logon")
		USE IN db_logon
		USE
	ENDIF
	IF USED("db_views")
		USE IN db_views
	ENDIF
	
	* Restore screen font and set to FoxPro default
	IF _WINDOWS
		MODIFY WINDOW SCREEN FONT m.g_orgfntnm, m.g_orgfntsz STYLE m.g_orgfntst
	ENDIF

	_GENPD = m.g_genpd
	CLEAR PROGRAM
	_PDSETUP = m.g_pdsetup
	
	SET SAFETY ON
	SET TALK ON
	SET MULTILOCKS OFF
	ON ERROR
	
	IF _WINDOWS
		SET STATUS BAR ON
	ENDIF

* END OF PROCEDURE dsys_rest

* Log the user onto the system
FUNCTION du_logon
PARAMETERS g_user, g_group, dologin
	PRIVATE userlen, keepon, origsel, passwd, holduser, row
	PRIVATE holdborder
	
	SET REPROCESS TO 1
	SET PROCEDURE TO f_msgs
	
	m.origsel = SELECT()
	SELECT 0
	USE user ORDER user
	
	m.userlen = LEN(db_logon.user)
	
	IF EMPTY(m.g_user)
		m.g_user = SPACE(m.userlen)
	ELSE
		m.g_user = PADR(LEFT(m.g_user, m.userlen), m.userlen)
	ENDIF

	m.g_user   = PADR(UPPER(m.g_user), LEN(user.user))
	m.passwd = SPACE(LEN(user.password))

	IF m.dologin
		DEFINE WINDOW logon ;
			FROM 0, 0  ;
			SIZE 6, 50 ;
			DOUBLE ;
			COLOR SCHEME 5 ;
			FONT "ARIAL", 14
		MOVE WINDOW logon CENTER
		
		ACTIVATE WINDOW logon
	
		@ 0, (WCOLS() - 13) / 2 SAY "System Logon"
	
		m.keepon = .T.
		DO WHILE keepon
			m.holdborder = SET("READBORDER")
			SET READBORDER ON

			m.passwd = SPACE(LEN(user.password))
			
			DO CASE
			CASE _DOS
				@ 2, 13 SAY "User Name:" GET m.g_user PICTURE "@K!"
				@ 3, 13 SAY " Password:" GET m.passwd ;
					COLOR ,W/W PICTURE "@K"
					
			CASE _WINDOWS
				@ 2,   11 SAY "User Name:" SIZE 1, 14 PICTURE "@J"
				@ 3.2, 11 SAY " Password:" SIZE 1, 14 PICTURE "@J"

				@ 2,   26 GET m.g_user PICTURE "@K !!!!!!" SIZE 1, 10
				@ 3.2, 26 GET m.passwd COLOR ,W/W PICTURE "@K" SIZE 1, 10
			ENDCASE

			READ MODAL WHEN du_logmenu()
			
			SET READBORDER &holdborder
			m.passwd = UPPER(m.passwd)
			
			SELECT user
			IF SEEK(m.g_user)
				IF m.passwd == user.password
					m.keepon = .F.
				ELSE
					IF !yorn("Invalid Login. Do you want to try again?")
						RELEASE WINDOW logon
						CANCEL
					ENDIF
				ENDIF
			ELSE
				IF !yorn("Invalid Login. Do you want to try again?")
					RELEASE WINDOW logon
					CANCEL
				ENDIF
			ENDIF
		
			IF !m.keepon
				SELECT db_logon
				IF SEEK(m.g_user)
					IF RLOCK()
						m.keepon = .F.
					ELSE
						IF !yorn("Someone else is logged in as " + ;
							TRIM(m.g_user) + ". Do you want to try again?")
							RELEASE WINDOW logon
							CANCEL
						ELSE
							m.keepon = .T.
						ENDIF
					ENDIF
				ELSE
					m.holduser = m.g_user
					DO r_add IN f_recs
					m.g_user = m.holduser
				ENDIF
			ENDIF
		ENDDO
	ELSE
		IF !SEEK(m.g_user, "user")
			DO msg WITH "User " + TRIM(m.g_user) + " does not exist."
			CANCEL
		ENDIF
		
		SELECT db_logon
		IF SEEK(m.g_user)
			IF !RLOCK()
				DO msg WITH "Someone else is logged in as " + ;
					TRIM(m.g_user) + "."
				CANCEL
			ENDIF
		ELSE
			DO r_add IN f_recs
		ENDIF
	ENDIF

	REPLACE user   WITH m.g_user
	REPLACE dateon WITH DATE()
	REPLACE timeon WITH TIME()

	m.g_group = UPPER(user.group)

	SET REPROCESS TO AUTOMATIC
	SET PROCEDURE TO
	
	SELECT user
	USE
	SELECT (m.origsel)

	RELEASE WINDOW logon

	RETURN .T.
		
* END OF PROCEDURE du_logon (function)

PROCEDURE du_logmenu
	DO editmenu.mpr

* END OF PROCEDURE du_logmenu

* Select the orders for the passed database

FUNCTION ds_order
PARAMETERS ordinfo, wheredb
	DIMENSION ordinfo[1, ro_numcols]
	ordinfo[1, 1] = ""
	
	PRIVATE origsel
	m.origsel = dv_select0(m.g_ordfile)
	
	m.wheredb = UPPER(m.wheredb)
	SELECT name + " - " + descript, name, tagname, descript ;
		FROM (m.g_ordfile) ;
		INTO ARRAY ordinfo ;
		WHERE database = m.wheredb ;
		ORDER BY name

	SELECT (m.g_ordfile)
	USE
	SELECT (m.origsel)
		
	RETURN !EMPTY(ordinfo[1, 1])
	
* END OF PROCEDURE ds_order
	
* Select the filter fields for the passed database
FUNCTION ds_filter
PARAMETERS filtinfo, wheredb
	DIMENSION filtinfo[1, rf_numcols]
	filtinfo[1, 1] = ""
	
	PRIVATE origsel
	m.origsel = dv_select0(m.g_filtfile)
	=dv_select0(m.g_fltdbfile)

	m.wheredb = UPPER(m.wheredb)
	SELECT fldalias + " - " + flddesc, database, fldname, picture ;
		FROM (m.g_filtfile) parent, (m.g_fltdbfile) child ;
		INTO ARRAY filtinfo ;
		WHERE parent.id == child.id AND child.group = m.wheredb ;
		ORDER BY fldname

	SELECT (m.g_filtfile)
	USE
	SELECT (m.g_fltdbfile)
	USE
	SELECT (m.origsel)

	RETURN !EMPTY(filtinfo[1, 1])
		
* END OF PROCEDURE ds_filter

* Select the reports for the passed database
FUNCTION ds_report
PARAMETERS repinfo, wheredb
	DIMENSION repinfo[1, rr_numcols]
	repinfo = ""

	PRIVATE origsel
	m.origsel = dv_select0(m.g_repfile)
	=dv_select0(m.g_repdbfile)
	
	PRIVATE environ
	DO CASE
	CASE _DOS
		m.environ = "DOS"
	CASE _WINDOWS
		m.environ = "WINDOWS"
	ENDCASE

	m.wheredb = UPPER(m.wheredb)
	SELECT name + "|" + descript + "|" + category, name, type, rptname, ;
		userorder, userfilter, usermarks, initprog, setupprog, cleanprog, ;
		prepprog, viewname, procfile, ;
		category, main.id, winrptname, prompt, runwhere ;
		FROM (m.g_repfile) main, (m.g_repdbfile) db ;
		INTO ARRAY repinfo ;
		WHERE group = m.wheredb AND main.id == db.report ;
			AND (main.runwhere = m.environ OR main.runwhere = "ALL") ;
		ORDER BY category, name
	
	SELECT (m.g_repfile)
	USE
	SELECT (m.g_repdbfile)
	USE
	SELECT (m.origsel)
	
	RETURN !EMPTY(repinfo[1, 1])
		
* END OF PROCEDURE ds_report (FUNCTION)
	
* Select the orders for the passed report
FUNCTION ds_rorder
PARAMETERS ordinfo, whererep
	DIMENSION ordinfo[1, rro_numcols]

	PRIVATE origsel
	m.origsel = dv_select0(m.g_rordfile)

	m.whererep = UPPER(m.whererep)
	SELECT name + " - " + descript, name, tagname ;
		FROM (m.g_rordfile) ;
		INTO ARRAY ordinfo ;
		WHERE report = m.whererep ;
		ORDER BY name
		
	SELECT (m.g_rordfile)
	USE
	SELECT (m.origsel)
		
	RETURN !EMPTY(ordinfo[1, 1])
	
* END OF PROCEDURE ds_rorder (FUNCTION)
	
* Select the filter fields for the passed report
FUNCTION ds_rfilter
PARAMETERS filtinfo, whererep
	DIMENSION filtinfo[1, rf_numcols]

	PRIVATE origsel
	m.origsel = dv_select0(m.g_filtfile)
	=dv_select0(m.g_fltrpfile)

	m.wheredb = UPPER(m.whererep)
	SELECT fldalias + " - " + flddesc, database, fldname, picture ;
		FROM (m.g_filtfile) parent, (m.g_fltrpfile) child ;
		INTO ARRAY filtinfo ;
		WHERE parent.id == child.id AND child.report = m.whererep ;
		ORDER BY fldname
		
	SELECT (m.g_filtfile)
	USE
	SELECT (m.g_fltrpfile)
	USE
	SELECT (m.origsel)
	
	RETURN !EMPTY(filtinfo[1, 1])
	
	
* END OF PROCEDURE ds_rfilter (FUNCTINO)

* Select the printer setups for the passed condition
PROCEDURE ds_print
PARAMETERS printinfo, wherecl
	IF PARAMETERS() = 1
		m.wherecl = ".T."
	ENDIF

	PRIVATE origsel
	m.origsel = dv_select0(m.g_printfile)
	
	DIMENSION printinfo[1, rp_numcols]
	SELECT name + SPACE(20) + "|" + defport, name, defport ;
		FROM (m.g_printfile) ;
		INTO ARRAY printinfo ;
		WHERE &wherecl ;
		ORDER BY name

	SELECT (m.g_printfile)
	USE
	SELECT (m.origsel)
	
	RETURN !EMPTY(printinfo[1, 1])
		
* END OF PROCEDURE ds_print (FUNCTION)

* Select the printer ports for the passed condition
FUNCTION ds_port
PARAMETERS portinfo, wherecl
	IF PARAMETERS() = 1
		m.wherecl = ".T."
	ENDIF
	
	PRIVATE origsel
	m.origsel = dv_select0(m.g_portfile)
	
	DIMENSION portinfo[1, rpp_numcols]
	SELECT name, setupstr ;
		FROM (m.g_portfile) ;
		INTO ARRAY portinfo ;
		WHERE &wherecl ;
		ORDER BY name
		
	SELECT (m.g_portfile)
	USE
	SELECT (m.origsel)
	
	RETURN !EMPTY(portinfo[1, 1])
		
* END OF PROCEDURE ds_port (FUNCTION)

* Get the default order for the passed database
PROCEDURE do_getdef
PARAMETERS curorder, database, doset
	IF PARAMETERS() < 3
		m.doset = .T.
	ENDIF

	PRIVATE savesel
	m.savesel = dv_select0(m.g_ordfile, "dbasedef", SYS(2015), .T.)
	SEEK PADR(UPPER(m.database), LEN(database))
	DIMENSION curorder[m.rco_numcols]
	curorder[m.rco_name] = name
	curorder[m.rco_desc] = descript
	curorder[m.rco_tag]  = tagname
	
	USE
	DO dv_rest0 WITH m.savesel
	
	IF m.doset
		SET ORDER TO TRIM(curorder[m.rco_tag])
	ENDIF

* END OF PROCEDURE do_getdef

* Set the current output printer to the passed setup name
PROCEDURE dp_setprint
PARAMETERS name, port, winreport
	IF PARAMETERS() < 3
		m.winreport = _WINDOWS
	ENDIF
	IF PARAMETERS() < 2 && Output not being sent to a printer
		IF !m.winreport
			_PDSETUP = ""
		ENDIF
		RETURN
	ENDIF

	IF !m.winreport OR !_WINDOWS
		PRIVATE origsel
	
		m.origsel = SELECT()
		SELECT 0
		USE (m.g_printfile) AGAIN ORDER name
	
		m.name = PADR(m.name, LEN(name))
		IF !EMPTY(m.name)
			SEEK m.name
		ELSE
			LOCATE FOR default
		ENDIF
		
		_PDSETUP = name
	
		USE

		USE
		SELECT (m.origsel)
	ENDIF
	
	SET PRINTER TO &port


* END OF PROCEDURE dp_setprint

* Present the filter set load dialog box for the user.
FUNCTION df_loadall
PARAMETERS curfilt, append, filename
	IF PARAMETERS() < 3
		m.filename = ""
	ENDIF
	
	PRIVATE origsel, retval
	m.retval = .T.
	m.origsel = dv_select0("db_fltst", "name_u")
	DO (m.g_fltldprg) WITH m.retval, m.filename

	IF m.retval
		IF !m.append
			m.curfilt = ""
		ENDIF
		DO df_load WITH m.filename, m.curfilt
	ENDIF
	
	USE
	SELECT (m.origsel)
	
	RETURN m.retval

* END OF PROCEDURE df_loadall (FUNCTION)

* Present the filter set save dialog box for the user.
FUNCTION df_saveall
PARAMETERS curfilt, filename
	IF PARAMETERS() < 2
		m.filename = ""
	ENDIF
	
	PRIVATE origsel, retval, filedesc
	m.retval = .T.
	m.filedesc = ""
	m.origsel = dv_select0("db_fltst", "name_u")
	DO (m.g_fltsvprg) WITH m.retval, m.filename, m.filedesc
	IF m.retval AND (!EMPTY(m.filename) OR !EMPTY(m.filedesc))
		DO df_save WITH m.filename, m.filedesc, m.curfilt
	ENDIF
	
	USE
	SELECT (m.origsel)
	
	RETURN m.retval

* END OF PROCEDURE df_saveall (FUNCTION)

* Load a filter set into 'filtset'
PROCEDURE df_load
PARAMETERS filename, filtset
	m.filename = PADR(m.filename, LEN(db_fltst.name))
	IF !SEEK(UPPER(m.filename))
		RETURN .F.
	ENDIF
	
	PRIVATE newfilt
	m.newfilt = ""
	
	m.newfilt = ""
	DO ds_getparm WITH "FILTERSET", (data), "", m.newfilt

	IF EMPTY(m.filtset)
		DIMENSION filtset[ALEN(newfilt, 1), m.rfc_numcols]
		=ACOPY(newfilt, filtset)
	ELSE
		PRIVATE oldrows, newrows
		m.oldrows = ALEN(filtset, 1)
		m.newrows = ALEN(newfilt, 1)
		DIMENSION filtset[m.oldrows + m.newrows, m.rfc_numcols]
		=ACOPY(newfilt, filtset, 1, m.newrows * m.rfc_numcols, ;
			m.oldrows * m.rfc_numcols + 1)
	ENDIF

* END OF PROCEDURE df_load

* Save a filter set from 'filtset'
PROCEDURE df_save
PARAMETERS filename, filedesc, filtset
	PRIVATE data, origsel, newuse, retval

	m.origsel = SELECT()
	m.newuse  = .F.
	IF !USED("db_fltst")
		=dv_select0("db_fltst", "name_u")
		m.newuse = .T.
	ENDIF

	m.filename = PADR(m.filename, LEN(db_fltst.name))
	IF !SEEK(UPPER(m.filename))
		APPEND BLANK
	ENDIF

	IF RLOCK()
		m.data = ""
		DO ds_addparm WITH m.data, "FILTERSET", m.filtset, "A"
	
		REPLACE name     WITH m.filename
		REPLACE descript WITH m.filedesc
		REPLACE data     WITH m.data
		UNLOCK
		m.retval = .T.
	ELSE
		m.retval = .F.
	ENDIF
	
	IF m.newuse
		USE
	ENDIF
	SELECT (m.origsel)
	
	RETURN m.retval

* END OF PROCEDURE df_save

* Set a filter on the current view with filter info passed	
FUNCTION df_filtset
PARAMETERS filtinfo, retstr, filtstrs, setfilter
	IF PARAMETERS() < 3
		m.filtstrs = ""
		m.setfilter = .T.
	ELSE
		IF PARAMETERS() < 4
			m.setfilter = .F.
		ENDIF
	ENDIF
	PRIVATE i, numclauses, clauses
	PRIVATE curfield, curcond, curlow, curhigh, currawlow, currawhigh
	PRIVATE curuclc, fieldlen, highlevel, andclause, orclauses
	PRIVATE orlevel, filtstr
	DIMENSION filtstrs[8]
	m.filtstrs = ""
	
	m.highlevel = 0
	IF TYPE("filtinfo[1, 1]") = "U"
		m.retstr = "OK"
		RETURN .T.
	ENDIF
	
	m.numclauses = ALEN(filtinfo, 1)
	DIMENSION clauses[m.numclauses]

	* Get each clause into the clauses array and find the highest
	* Or Level used
	FOR m.i = 1 TO m.numclauses
		m.curfield = TRIM(filtinfo[m.i, m.rfc_dbase]) + "." + ;
			TRIM(filtinfo[m.i, m.rfc_field])
		m.curcond    = filtinfo[m.i, m.rfc_cond]
		m.curtype    = filtinfo[m.i, m.rfc_type]
		m.curuclc    = filtinfo[m.i, m.rfc_uclc]
		m.currawlow  = filtinfo[m.i, m.rfc_low]
		m.currawhigh = filtinfo[m.i, m.rfc_high]

		DO CASE

		CASE m.curtype = "C"
			m.fieldlen = LEN(eval(m.curfield))
			IF m.curcond = 2 && Exactly Equal
				m.curlow  = "'" + PADR(m.currawlow,  m.fieldlen) + "'"
				m.curhigh = "'" + PADR(m.currawhigh, m.fieldlen) + "'"
			ELSE
				m.curlow  = "'" + TRIM(m.currawlow)  + "'"
				m.curhigh = "'" + TRIM(m.currawhigh) + "'"
			ENDIF
			IF m.curuclc
				m.curfield = "UPPER(" + m.curfield + ")"
				m.curlow   = UPPER(m.curlow)
				m.curhigh  = UPPER(m.curhigh)
			ENDIF

		CASE m.curtype = "N"
			m.curlow = LTRIM(STR(m.currawlow))
			m.curhigh = LTRIM(STR(m.currawhigh))

		CASE m.curtype = "L"
			m.curlow = IIF(m.currawlow, ".T.", ".F.")
			m.curhigh = IIF(m.currawhigh, ".T.", ".F.")
			
		CASE m.curtype = "D"
			m.curlow  = "{" + DTOC(m.currawlow) + "}"
			m.curhigh = "{" + DTOC(m.currawhigh) + "}"
		ENDCASE		
			
		DO CASE
		CASE m.curcond = 1 && Starts With
			clauses[m.i] = m.curfield + "=" + m.curlow
			
		CASE m.curcond = 2 && Exactly Equal
			clauses[m.i] = m.curfield + "=" + m.curlow
			
		CASE m.curcond = 3 && Less Than
			clauses[m.i] = m.curfield + "<" + m.curlow
			
		CASE m.curcond = 4 && Less Than or Equal
			clauses[m.i] = m.curfield + "<=" + m.curlow
			
		CASE m.curcond = 5 && Greater Than
			clauses[m.i] = m.curfield + ">" + m.curlow
			
		CASE m.curcond = 6 && Greater Than or Equal
			clauses[m.i] = m.curfield + ">=" + m.curlow
			
		CASE m.curcond = 7 && Contains
			clauses[m.i] = m.curfield + "$" + m.curlow
			
		CASE m.curcond = 8 && Between
			clauses[m.i] = m.curfield + ">" + m.curlow + ;
				" AND " + m.curfield + "<" + m.curhigh
			
		CASE m.curcond = 9 && Between Equal
			clauses[m.i] = m.curfield + ">=" + m.curlow + ;
				" AND " + m.curfield + "<=" + m.curhigh
			
		ENDCASE

		IF filtinfo[m.i, m.rfc_not]
			clauses[m.i] = "!(" + clauses[m.i] + ")"
		ENDIF
		
		IF VAL(filtinfo[m.i, m.rfc_orlevel]) > m.highlevel
			m.highlevel = VAL(filtinfo[m.i, m.rfc_orlevel])
		ENDIF
	ENDFOR

	* Set up all the clauses, putting ANDs into one string and each
	* OR Level into its own string
	IF m.highlevel > 0
		DIMENSION orclauses[m.highlevel]
	ENDIF
	andclause = ""
	FOR m.i = 1 TO m.highlevel
		orclauses[m.i] = ""
	ENDFOR
	
	FOR m.i = 1 TO m.numclauses
		IF filtinfo[m.i, m.rfc_andor] = 1 && And
			IF EMPTY(m.andclause)
				m.andclause = clauses[m.i]
			ELSE
				m.andclause = m.andclause + " AND " + clauses[m.i]
			ENDIF
		ELSE
			m.orlevel = VAL(filtinfo[m.i, m.rfc_orlevel])
			IF m.orlevel > 0
				IF EMPTY(orclauses[m.orlevel])
					orclauses[m.orlevel] = "(" + clauses[m.i]
				ELSE
					orclauses[m.orlevel] = orclauses[m.orlevel] + ;
						" OR " + clauses[m.i]
				ENDIF
			ENDIF
		ENDIF
	ENDFOR
	FOR m.i = 1 TO m.highlevel
		IF !EMPTY(orclauses[m.i])
			orclauses[m.i] = orclauses[m.i] + ")"
		ENDIF
	ENDFOR

	* Setup the single filter string
	m.filtstr = m.andclause
	FOR m.i = 1 TO m.highlevel
		IF !EMPTY(orclauses[m.i])
			IF !EMPTY(m.filtstr)
				m.filtstr = m.filtstr + " AND "
			ENDIF
			m.filtstr = m.filtstr + " " + orclauses[m.i]
		ENDIF
	ENDFOR

	* Break up the single filter string into parts small enough
	* to be managed by macros (maximum of 255 characters each)
	* If more than 255 * 8, return false
	PRIVATE maxlen
	m.maxlen = 255 * 8
	
	IF !EMPTY(m.g_basefilt)
		m.maxlen = m.maxlen - (LEN(m.g_basefilt) + 7)
	ENDIF
	IF LEN(m.filtstr) > m.maxlen
		m.retstr = "TOO LONG"
		RETURN .F.
	ENDIF

	FOR m.i = 0 TO 7
		filtstrs[m.i + 1] = SUBSTR(m.filtstr, m.i * 255 + 1, 255)
	ENDFOR

	PRIVATE filtstr1, filtstr2, filtstr3, filtstr4
	PRIVATE filtstr5, filtstr6, filtstr7, filtstr8
	m.filtstr1 = filtstrs[1]
	m.filtstr2 = filtstrs[2]
	m.filtstr3 = filtstrs[3]
	m.filtstr4 = filtstrs[4]
	m.filtstr5 = filtstrs[5]
	m.filtstr6 = filtstrs[6]
	m.filtstr7 = filtstrs[7]
	m.filtstr8 = filtstrs[8]

	IF m.setfilter
		IF EMPTY(m.g_basefilt)	
			SET FILTER TO &filtstr1.&filtstr2.&filtstr3.&filtstr4.&filtstr5.&filtstr6.&filtstr7.&filtstr8
		ELSE
			PRIVATE tempfilt
			m.tempfilt = "(" + m.g_basefilt + ")"
			SET FILTER TO &tempfilt AND &filtstr1.&filtstr2.&filtstr3.&filtstr4.&filtstr5.&filtstr6.&filtstr7.&filtstr8

		ENDIF
	ENDIF

	m.retstr = "OK"
	RETURN .T.

* END OF PROCEDURE df_filtset

* Do everything for a report given the ID
PROCEDURE dr_doreport
PARAMETERS repid
	PRIVATE repinfo
	m.repinfo = ""
	IF !dr_getrpt(m.repid, @m.repinfo)
		DO msg WITH "Error. Can't find report: " + TRIM(m.repid) + ;
			". Notify consultant"
		CANCEL
	ENDIF
	
	DO dr_repdoall WITH m.repinfo

* END OF PROCEDURE dr_doreport

* Get the report info for the passed report name
FUNCTION dr_getrpt
PARAMETERS repid, repinfo
	DIMENSION repinfo[m.rr_numcols]
	PRIVATE areasave

	m.areasave = dv_select0(m.g_repfile, "id", SYS(2015), .T.)
	IF SEEK(PADR(m.repid, LEN(id)))
		SCATTER FIELDS name, name, type, rptname, ;
			userorder, userfilter, usermarks, initprog, setupprog, ;
			cleanprog, prepprog, viewname, procfile, ;
			category, id, winrptname, prompt, runwhere ;
		TO m.repinfo
		
		repinfo[1] = name + " - " + descript
		m.retval = .T.
	ELSE
		m.retval = .F.
	ENDIF
	 
	USE
	DO dv_rest0 WITH m.areasave
	RETURN m.retval

* END OF PROCEDURE dr_getrpt

* Do everything for the passed report info structure
PROCEDURE dr_repdoall
PARAMETERS repinfo, curfilt, curmarks
	PRIVATE numparams
	m.numparams = PARAMETERS()
	IF m.numparams < 3
		m.curmarks = ""
	ENDIF
	IF m.numparams < 2
		m.curfilt = ""
	ENDIF
	
	PRIVATE printset, viewsave, title, locfilt, locmarks, origproc
	m.printset = ""
	m.viewsave = ""
	m.title    = ""

	IF EMPTY(m.curfilt)
		m.locfilt = ""
	ELSE
		=ACOPY(curfilt, locfilt)
	ENDIF
	
	IF EMPTY(m.curmarks)
		m.locmarks = ";"
	ELSE
		m.locmarks = m.curmarks
	ENDIF
	
	m.origproc = SET("PROCEDURE")
	IF !EMPTY(repinfo[m.rr_procfile])
		SET PROCEDURE TO (TRIM(repinfo[m.rr_procfile]))
	ENDIF

	IF !dr_repsetup(@m.repinfo, @m.printset, @m.title, @m.viewsave, ;
		@m.locfilt, @m.locmarks)
		RETURN
	ENDIF
	
	DO dr_reprun WITH m.repinfo, m.printset, TRIM(m.title), m.locmarks

	IF !EMPTY(repinfo[m.rr_cleanprg])
		DO (TRIM(repinfo[m.rr_cleanprg]))
	ENDIF

	IF !EMPTY(m.origproc)
		SET PROCEDURE TO (m.origproc)
	ELSE
		SET PROCEDURE TO
	ENDIF

	DO dv_vuerest WITH m.viewsave

* END OF PROCEDURE dr_repdoall

* Do all the setup for the given report
EXTERNAL ARRAY filterinfo
FUNCTION dr_repsetup
PARAMETERS repinfo, printset, title, viewsave, filterset, marksset
	PRIVATE orderinfo, filterinfo, printinfo, portinfo, markinfo
	PRIVATE orderset,  filterset,  title
	PRIVATE retval
	PRIVATE i, j, filtlen, numfields, curdbase, curfield
	PRIVATE numdels, currow, delrows
	
	STORE "" TO m.orderinfo, m.filterinfo, m.printinfo, m.portinfo, m.markinfo
	STORE "" TO m.orderset
	STORE "" TO m.retval
	
	DO dv_vueset WITH repinfo[m.rr_view], m.viewsave, 2
	IF !EMPTY(repinfo[m.rr_initprg])
		DO (TRIM(repinfo[m.rr_initprg]))
	ENDIF

	IF EMPTY(repinfo[m.rr_setprog]) && Use default setup program
		IF repinfo[m.rr_userord]
			DO ds_rorder  WITH m.orderinfo,  repinfo[m.rr_id]
		ENDIF
		
		IF repinfo[m.rr_userfilt]
			DO ds_rfilter WITH m.filterinfo, repinfo[m.rr_id]
		ELSE
			m.filterset = ""
		ENDIF
		
		* Remove filters that don't match
		IF !EMPTY(m.filterset)
			m.delrows = ";"
			m.filtlen   = ALEN(filterset, 1)
			m.numfields = ALEN(filterinfo, 1)
			FOR m.i = 1 TO m.filtlen
				m.curdbase = PADR(filterset[m.i, m.rfc_dbase], ;
					LEN(filterinfo[m.rf_dbase]))
				m.curfield = PADR(filterset[m.i, m.rfc_field], ;
					LEN(filterinfo[m.rf_field]))
					
				FOR m.j = 1 TO m.numfields
    				IF (m.curdbase == filterinfo[m.j, m.rf_dbase]) AND ;
    					(m.curfield == filterinfo[m.j, m.rf_field])
						EXIT
					ENDIF
				ENDFOR
				IF m.j > m.numfields
					m.delrows = m.delrows + LTRIM(STR(m.i)) + ";"
				ENDIF
			ENDFOR
			
			m.numdels = ds_count(";", m.delrows) - 1
			IF m.numdels = m.filtlen
				m.filterset = ""
			ELSE
				FOR m.i = 1 TO m.numdels
					m.currow = VAL(ds_gtdelim(m.delrows, ";", m.i))
					=ADEL(filterset, m.currow)
				ENDFOR
				DIMENSION filterset[m.filtlen - m.numdels, m.rfc_numcols]
			ENDIF
		ENDIF		

		IF repinfo[m.rr_usermark]
			m.markinfo = "dr_marks"
		ELSE
			m.marksset = ";"
		ENDIF
		
		DO (m.g_rsetprog) WITH m.retval, repinfo[m.rr_name], ;
			m.g_prninfo, m.orderinfo, m.filterinfo, m.g_portinfo, ;
			m.markinfo, m.printset, m.orderset, m.filterset, ;
			m.marksset, m.title, !EMPTY(repinfo[m.rr_wrptname])
			
	ELSE && Do the custom setup program
		DO TRIM(repinfo[m.rr_setprog]) WITH m.retval, m.repinfo, ;
			m.printset, m.orderset, m.filterset, m.marksset, m.title
	ENDIF
	
	IF !m.retval
		DO dv_vuerest WITH m.viewsave
		RETURN .F.
	ENDIF

	IF EMPTY(repinfo[m.rr_prepprg])
		IF LEN(m.marksset) <= 1	&& Didn't mark records
			IF repinfo[m.rr_userord]
				DO dr_repord WITH m.orderset
			ENDIF

			IF repinfo[m.rr_userfilt] AND TYPE("filterset[1]") <> "U"
				* First save as user's last filter then use it for report
				DO df_save WITH PROPER(m.g_user) + "Last", ;
					PROPER(m.g_user) + "'s Last Filter", m.filterset
				DO dr_repfilt WITH m.filterset
			ENDIF
		ELSE && Marked records
			DO dr_repmarks WITH m.marksset, m.orderset
		ENDIF
	ELSE
		* First save last filter then call custom prep program
		IF repinfo[m.rr_userfilt] AND TYPE("filterset[1]") <> "U"
			DO df_save WITH PROPER(m.g_user) + "Last", ;
				PROPER(m.g_user) + "'s Last Filter", m.filterset
		ENDIF
		DO (TRIM(repinfo[m.rr_prepprg])) WITH m.repinfo, m.orderset, ;
			m.filterset, m.marksset
	ENDIF

	RETURN .T.
	
* END OF PROCEDURE dr_repsetup

* Get the marks for the report
PROCEDURE dr_marks
PARAMETERS marks
	PRIVATE searches, title, numsearches, saverec, markexp
	
	m.searches = ""
	m.title = ""
	m.markexp = ""
	m.numsearches = s_getsrch(@m.searches, @m.title, ;
		UPPER(m.database), "MARK", @m.markexp)
	
	m.saverec = RECNO()
	=s_select(@m.searches, m.numsearches, 1, "", m.title, m.markexp, ;
		@m.marks)

	GO (m.saverec)

* END OF PROCEDURE dr_marks

PROCEDURE dr_repord
PARAMETERS orderset
	SET ORDER TO (m.orderset)

* END OF PROCEDURE dr_repord

PROCEDURE dr_repfilt
PARAMETERS filterset
	PRIVATE retstr, filtstrs
	m.retstr = ""
	m.filtstrs = ""

	DO msg_up WITH "Generating Report"
	
	SET FILTER TO
	IF !df_filtset(@m.filterset, @m.retstr, @m.filtstrs, .F.)
		WAIT WINDOW "Filter was too complex, running without filter" NOWAIT
		SET FILTER TO &g_basefilt
	ENDIF
	
	* Copy the primary keys for records fitting the filter
	* into a cursor
	PRIVATE keyexpr, keylen, headdb, tempfilt, clausestr
	PRIVATE headskip
	m.keyexpr = FIELD(1)
	m.keylen  = FSIZE(m.keyexpr)
	m.headdb  = SELECT()
	CREATE CURSOR reportrun ( key C(m.keylen) )
	SELECT (m.headdb)
	IF EMPTY(m.g_basefilt)
		m.tempfilt = ""
	ELSE
		m.tempfilt = "(" + m.g_basefilt + ")"
		IF !EMPTY(filtstrs[1])
			m.tempfilt = m.tempfilt + " AND "
		ENDIF
	ENDIF
	
	IF EMPTY(m.tempfilt) AND EMPTY(filtstrs[1]) && Empty filter
		m.clausestr = ""
	ELSE
		m.clausestr = "FOR"
	ENDIF
	
	m.headskip = SET("SKIP")
	SET SKIP TO
	PRIVATE i
	PRIVATE filtstr1, filtstr2, filtstr3, filtstr4
	PRIVATE filtstr5, filtstr6, filtstr7, filtstr8
	FOR m.i = 1 TO 8
		STORE filtstrs[m.i] TO ("filtstr" + LTRIM(STR(m.i)))
	ENDFOR

	SCAN &clausestr &tempfilt.&filtstr1.&filtstr2.&filtstr3. ;
		&filtstr4.&filtstr5.&filtstr6.&filtstr7.&filtstr8
		SELECT reportrun
		APPEND BLANK
		SELECT (m.headdb)
		REPLACE reportrun.key WITH EVAL(m.keyexpr)
	ENDSCAN

	SELECT (m.headdb)
	SET ORDER TO (m.keyexpr)
	
	SELECT reportrun
	SET RELATION TO key INTO (m.headdb)
	SET SKIP TO &headskip

* END OF PROCEDURE dr_repfilt

PROCEDURE dr_repmarks
PARAMETERS marks, orderset
	PRIVATE i, nummarks
	m.nummarks = ds_count(";", m.marks) - 1
	IF m.nummarks <= 1
		RETURN
	ENDIF

	DO msg_up WITH "Generating Report"

	PRIVATE primkey, primkeylen, headdb, keyexpr, keyexprlen
	PRIVATE keytype, saveskip
	m.headdb     = SELECT()
	m.primkey    = FIELD(1)
	m.primkeylen = FSIZE(m.primkey)

	SET ORDER TO (m.orderset)	
	m.keyexpr    = KEY(VAL(SYS(21)))
	m.keyexprlen = LEN(EVAL(m.keyexpr))
	m.keytype    = TYPE("EVAL(m.keyexpr)")

	DO CASE
	CASE m.keytype = "C"
		CREATE CURSOR reportrun (key C(m.primkeylen), ;
			orderkey C(m.keyexprlen))
	CASE m.keytype = "N"
		CREATE CURSOR reportrun (key C(m.primkeylen), ;
			orderkey N(m.keylen))
	CASE m.keytype = "D"
		CREATE CURSOR reportrun (key C(m.primkeylen), ;
			orderkey D)
	CASE m.keytype = "L"
		CREATE CURSOR reportrun (key C(m.primkeylen), ;
			orderkey L)
	ENDCASE

	PRIVATE curmark

	SELECT (m.headdb)
	m.saveskip = SET("SKIP")
	SET SKIP TO
	SET ORDER TO (m.primkey)
	FOR m.i = 1 TO m.nummarks
		m.curmark = ds_gtdelim(m.marks, ";", m.i)
		SEEK m.curmark
		SELECT reportrun
		APPEND BLANK
		SELECT (m.headdb)
		REPLACE reportrun.key      WITH EVAL(m.primkey)
		REPLACE reportrun.orderkey WITH EVAL(m.keyexpr)
	ENDFOR
	
	SELECT reportrun
	INDEX ON orderkey TAG runorder
	SET RELATION TO key INTO (headdb)
	SET SKIP TO &saveskip

* END OF PROCEDURE dr_repmarks

PROCEDURE dr_reprun
PARAMETERS repinfo, printset, title, marks
	PRIVATE vuesave, numparams
	m.numparams = PARAMETERS()
	m.vuesave = ""
	
	DO msg_up WITH "One Moment Please..."
	
	IF repinfo[m.rr_type] = "PROGRAM"
		DO (TRIM(repinfo[m.rr_rptname])) WITH m.printset, m.title, ;
			m.marks
	ELSE
		PRIVATE repname
		m.repname = repinfo[m.rr_rptname]
		IF _WINDOWS AND !EMPTY(repinfo[m.rr_wrptname])
			m.repname = repinfo[m.rr_wrptname]
		ENDIF
		DO dr_repfrx WITH m.repname, m.printset, ;
			m.title, repinfo[m.rr_type], m.marks, ;
			!EMPTY(repinfo[m.rr_wrptname]), repinfo[m.rr_prompt]
	ENDIF
	
* END OF PROCEDURE dr_reprun

* Do the passed report form to the passed destination
PROCEDURE dr_repfrx
PARAMETERS repfrx, dest, title, type, r_marks, winreport, prompt
	IF PARAMETERS() < 7
		m.prompt = .F.
	ENDIF
	IF PARAMETERS() < 6
		m.winreport = _WINDOWS
	ENDIF
	IF PARAMETERS() < 5
		m.r_marks = ""
	ENDIF
	IF PARAMETERS() < 4
		m.type = "REPORT"
	ENDIF
	IF PARAMETERS() < 3
		m.title = ""
	ENDIF
	
	PRIVATE repoclause, r_total, r_count

	IF TYPE("m.r_marks") <> "C" OR LEN(m.r_marks) <= 1
		COUNT TO m.r_total
	ELSE
		m.r_total = ds_count(";", m.r_marks) - 1
	ENDIF
	m.r_count = 1

	PRIVATE printready, c
	m.printready = .T.

	IF LEFT(m.dest, 6) == "SCREEN" AND m.winreport AND _WINDOWS
		m.dest = "PREVIEW"
	ENDIF
	
	DO CASE 
	CASE LEFT(m.dest, 5) == "PRINT"
		DO dp_setprint WITH SUBSTR(m.dest, 7, AT("~", m.dest, 2) - 7), ;
			SUBSTR(m.dest, AT("~", m.dest, 2) + 1), m.winreport

		m.repoclause = "NOCONSOLE NOEJECT TO PRINT"
		IF m.winreport AND m.prompt AND _WINDOWS
			m.repoclause = m.repoclause + " PROMPT"
		ENDIF

		IF SYS(13) <> "READY"
			DO msg_up WITH "The printer is not ready" + m.g_eol + m.g_eol + ;
				"Correct the problem, and the printout will start" + ;
				m.g_eol + m.g_eol + "or press [Q] to abort"

			DO WHILE .T.
				IF SYS(13) = 'READY'
					EXIT
				ENDIF
				m.c = INKEY()
				IF m.c # 0 AND UPPER(CHR(c)) = 'Q'
					m.printready = .F.
					EXIT
				ENDIF
			ENDDO
			DO msg_down
		ENDIF

		IF m.printready
			DO msg_up WITH "Running Report"
		ENDIF

	CASE LEFT(m.dest, 4) == "FILE"
		DO dp_setprint WITH "FILE"
		m.repoclause = "TO FILE " + SUBSTR(m.dest, 6) + " NOCONSOLE"
		DO msg_up WITH "Running Report"

	CASE LEFT(m.dest, 7) == "PREVIEW"
		DO dp_setprint WITH "PREVIEW"
		m.repoclause = "PREVIEW"
		DO msg_up WITH "Running Report"

	CASE LEFT(m.dest, 6) == "SCREEN"
		DO dp_setprint WITH "SCREEN"	
		m.repoclause = "TO FILE '" + (TRIM(m.g_user) + "rp.txt") + "' NOCONSOLE"
		DO msg_up WITH "Running Report"
	ENDCASE

	IF m.printready
		IF m.type = "REPORT"
			REPORT FORM (m.repfrx) &repoclause && HEADING m.title
		ELSE
			m.repoclause = STRTRAN(m.repoclause, "NOEJECT", "")
			LABEL FORM (m.repfrx) &repoclause
		ENDIF
	ENDIF
	
	DO msg_down
	WAIT CLEAR
	
	IF LEFT(m.dest, 6) == "SCREEN" AND (!m.winreport OR !_WINDOWS) && Report to screen
		SET SYSMENU OFF
		
		DEFINE WINDOW repscrn1 ;
			FROM 0, 0 ;
			TO 2, 79 ;
			DOUBLE ;
			TITLE " Report Output "
			
		DEFINE WINDOW repscrn2 ;
			FROM 3, 0 ;
			TO SROWS(), SCOLS() ;
			NONE
		
		ACTIVATE WINDOW repscrn1
		@ 0, 10 SAY "Use Arrow Keys to Scroll      Press ESC to Exit"
		
		ACTIVATE WINDOW repscrn2
		MODIFY COMM (m.g_user + "rp.txt") WINDOW repscrn2 NOEDIT
		DELETE FILE (m.g_user + "rp.txt")
		RELEASE WINDOWS repscrn1, repscrn2
		
		SET SYSMENU AUTOMATIC
	ELSE
		IF m.printready
			DO msg WITH "Report Complete"
		ENDIF
	ENDIF

* END OF PROCEDURE dr_repfrx

FUNCTION dr_status
PARAMETERS count, docount, showeach
	IF PARAMETERS() < 3
		m.showeach = .F.
	ENDIF
	IF PARAMETERS() < 2
		m.docount = .T.
	ENDIF
	
	IF INKEY() = 27 && ESC
		DO msg_up WITH "Aborting..."
		GO BOTTOM
		IF !EOF()
			SKIP
		ENDIF
		RETURN
	ENDIF

	IF docount
		IF m.showeach
			WAIT WINDOW LTRIM(STR(m.count)) + " of " + ;
				LTRIM(STR(m.r_total)) + ". " + ;
				LTRIM(STR(m.count * 100 / m.r_total)) + "% Complete." + ;
				" Press ESC to Abort" ;
				NOWAIT
		ELSE
			WAIT WINDOW LTRIM(STR(m.count * 100 / m.r_total)) + "% Complete." + ;
				" Press ESC to Abort" ;
				NOWAIT
		ENDIF
		m.count = m.count + 1
	ELSE
		WAIT WINDOW "Running Report. Press ESC to Abort" NOWAIT
	ENDIF

	RETURN ""
		
* END OF PROCEDURE dr_status (FUNCTION)

* Select an open workarea and use a file there
FUNCTION dv_select0
PARAMETERS dbase, order, alias, again
	PRIVATE origsel

	m.origsel = SELECT()

	SELECT 0
	IF PARAMETERS() = 0
		RETURN m.retval
	ENDIF
	
	IF PARAMETERS() < 4
		m.again = .F.
	ENDIF
	IF PARAMETERS() < 3
		m.alias = m.dbase
	ENDIF
	IF PARAMETERS() < 2
		m.order = 0
	ENDIF

	IF m.again
		USE (m.dbase) AGAIN ORDER (m.order) ALIAS (m.alias)
	ELSE
		USE (m.dbase) ORDER (m.order) ALIAS (m.alias)
	ENDIF
	
	RETURN m.origsel

* END OF PROCEDURE dv_select0 (FUNCTION)

* Return to the work area returned by dv_select0
PROCEDURE dv_rest0
PARAMETERS area
	SELECT (m.area)

* END OF PROCEDURE dv_rest0

* Set up view passed in 'vuename'. Save old view in 'vuesave'
PROCEDURE dv_vueset
PARAMETERS vuename, vuesave, needfree
	* If third parameter omitted, assume no extra free work areas needed
	IF PARAMETERS() < 3
		m.needfree = 0
	ENDIF
	
	PRIVATE newused, origrec, numareas, vue, savewidth, origsel, i

	* No word wrap (as much as possible)
	m.savewidth = SET("MEMOWIDTH")
	SET MEMOWIDTH TO 255
	
	* Save original area (in case can't set view) and use the view file
	m.origsel = SELECT()
	IF USED(g_viewfile)
		m.newused = .F.
		SELECT (g_viewfile)
		m.origord = ORDER()
		SET ORDER TO name
	ELSE
		m.newused = .T.
		SELECT 0
		USE (g_viewfile) ORDER name
	ENDIF
	
	SEEK m.vuename
	* If can't find the view file, put up an error and crash
	IF !FOUND()
		DO msg WITH "View: " + m.vuename + " not found. Notify consultant"
		CANCEL
	ENDIF
	
	m.vue = view
	
	* Restore view file to its previous status
	IF m.newused
		USE
	ELSE
		SET ORDER TO (m.origord)
	ENDIF

	SELECT (m.origsel)
	
	m.numareas = 0
	DIMENSION vuesave[1, m.rv_numcols]

	PRIVATE dbases, aliases, curline, directive, curdb, curalias

	* If the view is empty restore and return now
	IF EMPTY(m.vue)
		SET MEMOWIDTH TO (m.savewidth)
		RETURN
	ENDIF

	* Get number of areas in the view
	m.curline = ATCLINE("#NUMAREAS", m.vue)
	IF m.curline <> 0
		m.numareas = VAL(dv_getparam(MLINE(m.vue, m.curline)))
	ELSE
		m.numareas = 0
	ENDIF
	
	* The first element, in addition to the normal stuff
	* holds the total number of areas used, the work area
	* for the old view and the base filter for the old view
	vuesave[1, m.rv_areas]    = m.numareas
	vuesave[1, m.rv_control]  = ALIAS(SELECT())
	vuesave[1, m.rv_baseflt]  = m.g_basefilt
	vuesave[1, m.rv_dbssaved] = 0
	m.g_basefilt = ""
		
	* Dimension the array to hold the databases
	DIMENSION dbases[m.numareas], aliases[m.numareas]
	STORE "" TO m.dbases, m.aliases

	* Get all the databases and aliases into the 'dbases' and 'aliases'
	* arrays
	FOR m.i = 1 TO m.numareas
		* Either a space or a tab can be between the directive and
		* the operands
		m.directive = "#DATABASE" + LTRIM(STR(m.i)) + " "
		m.curline   = ATCLINE(m.directive, m.vue)
		IF m.curline = 0
			m.directive = "#DATABASE" + LTRIM(STR(m.i)) + CHR(9) && Tab
			m.curline = ATCLINE(m.directive, m.vue)
		ENDIF
		* Get the current database and alias in 'curdb' and 'curalias'
		IF m.curline <> 0
			m.curdb    = dv_getparam(MLINE(m.vue, m.curline))
			m.curalias = dv_getword(m.curdb, 2)
			IF EMPTY(m.curalias)
				m.curalias = m.curdb
			ELSE
				m.curdb = dv_getword(m.curdb, 1)
			ENDIF
		ENDIF
		dbases[m.i]   = UPPER(TRIM(m.curdb))
		aliases[m.i]  = UPPER(TRIM(m.curalias))
	ENDFOR

	PRIVATE addsaveent
	m.addsaveent = 0
	
	* See if there are enough free databases and if not, free some
	DO dv_chkfree WITH m.dbases, m.aliases, m.vuesave, m.needfree, ;
		addsaveent
		
	* Dimension the array to save the view. The number of elements is
	* The number of work areas plus the number that were used
	* to free work areas plus 1 for the first element
	DIMENSION vuesave[m.numareas + m.addsaveent + 1, rv_numcols]

	PRIVATE vuei

	* Open databases
	FOR m.i = 1 TO m.numareas
		m.vuei = m.i + m.addsaveent + 1
		IF !EMPTY(dbases[m.i])
			m.curdb    = dbases[m.i]
			m.curalias = aliases[m.i]
			vuesave[m.vuei, m.rv_db] = m.curalias
			IF !USED(m.curalias) && Must open it ourselves
				SELECT 0
				USE (m.curdb) AGAIN ALIAS (m.curalias)
				vuesave[m.vuei, m.rv_readin] = .T.
			ELSE 
				* It's already open. Must save the order, record number,
				* filter, set relations and set skips
				SELECT (m.curalias)
				vuesave[m.vuei, m.rv_readin]  = .F.
				vuesave[m.vuei, m.rv_ord]     = ORDER()
				vuesave[m.vuei, m.rv_recno]   = RECNO()
				vuesave[m.vuei, m.rv_filter]  = FILTER()
				vuesave[m.vuei, m.rv_rels]    = SET("RELATION")
				vuesave[m.vuei, m.rv_skips]   = SET("SKIP")
			ENDIF
		ELSE
			dbases[m.i] = ""
			vuesave[m.vuei, m.rv_db] = ""
			vuesave[m.vuei, m.rv_readin] = .F.
		ENDIF
	ENDFOR

	* Set orders
	FOR m.i = 1 TO m.numareas
		SELECT (aliases[m.i])
		m.directive = "ORDER" + LTRIM(STR(m.i)) + " "
		m.curline = ATCLINE(m.directive, m.vue)
		IF m.curline <> 0
			PRIVATE curord
			m.curord = dv_getparam(MLINE(m.vue, m.curline))
			SET ORDER TO (m.curord)
		ELSE
			SET ORDER TO
		ENDIF
	ENDFOR

	* Set relations
	FOR m.i = 1 TO m.numareas
		SELECT (aliases[m.i])
		SET SKIP TO
		SET RELATION TO
		m.directive = "NUMRELATIONS" + LTRIM(STR(m.i)) + " "
		m.curline = ATCLINE(m.directive, m.vue)
		IF m.curline <> 0
			PRIVATE numrel, j
			m.numrel = VAL(dv_getparam(MLINE(m.vue, m.curline)))
			FOR m.j = 1 TO m.numrel
				m.directive = "RELATION"+LTRIM(STR(m.i))+"."+LTRIM(STR(m.j)) + " "
				m.curline = ATCLINE(m.directive, m.vue)
				DO dv_vuerel WITH dv_getparam(MLINE(m.vue, m.curline))
			ENDFOR
		ENDIF
	ENDFOR
	
	* Set controlling database
	m.curline = ATCLINE("#CONTROL", m.vue)
	IF m.curline <> 0
		PRIVATE controldb
		m.controldb = dv_getparam(MLINE(m.vue, m.curline))
		SELECT (m.controldb)
	ENDIF

	SET MEMOWIDTH TO (m.savewidth)

* END OF PROCEDURE dv_vueset

* Support procedure for dv_vueset
PROCEDURE dv_chkfree
PARAMETERS dbases, aliases, vuesave, needfree, addsaveent
	PRIVATE i, numfree, origsel
	
	m.numfree = 0
	m.origsel = SELECT()
	
	* Find out how many work areas are free
	FOR m.i = 1 TO m.g_maxarea
		IF EMPTY(ALIAS(m.i))
			m.numfree = m.numfree + 1
		ENDIF
	ENDFOR
	
	* Find how many new work areas are going to be needed for this
	* view and add that to the number needed free (that's in addition
	* to the number the caller asked to be left open)
	FOR m.i = 1 TO vuesave[1, m.rv_areas]
		IF !USED(aliases[m.i])
			m.needfree = m.needfree + 1
		ENDIF
	ENDFOR
	
	* If there are enough free, just return
	IF m.needfree <= m.numfree
		m.addsaveent = 0
		RETURN
	ENDIF
	
	* There aren't enough free so we need to close some.
	PRIVATE origsel, cursave
	m.origsel = SELECT()
	m.cursave = 2

	* Save all the info for all the used databases
	FOR m.i = 1 TO m.g_maxarea
		SELECT (m.i)
		* If there is a database used here
		IF !EMPTY(ALIAS(m.i))
			DIMENSION vuesave[m.cursave, m.rv_numcols]
			vuesave[1, m.rv_dbssaved]       = vuesave[1, m.rv_dbssaved] + 1
			vuesave[m.cursave, m.rv_closed] = .F.
			vuesave[m.cursave, m.rv_ord]    = ORDER()
			vuesave[m.cursave, m.rv_recno]  = RECNO()
			vuesave[m.cursave, m.rv_filter] = FILTER()
			vuesave[m.cursave, m.rv_rels]   = SET("RELATION")
			vuesave[m.cursave, m.rv_skips]  = SET("SKIP")
			vuesave[m.cursave, m.rv_alias]  = ALIAS()
			SET FILTER TO
			SET RELATION TO
			SET SKIP TO

			* If we don't need it and we still need more work areas,
 			IF (m.needfree > m.numfree) AND ASCAN(aliases, ALIAS()) = 0 AND ;
				AT(";" + LTRIM(STR(m.i)) + ";", m.g_reservdb) = 0
				
 				* Save it's name and close it
 				vuesave[m.cursave, m.rv_closed] = .T.
 				vuesave[m.cursave, m.rv_dbf]    = DBF()
 				USE
 				m.numfree = m.numfree + 1
 			ENDIF
			m.cursave = m.cursave + 1
		ENDIF 
	ENDFOR
	
	m.addsaveent = m.cursave - 2
	
* END OF PROCEDURE dv_chkfree

* Support procedure for dv_vueset
PROCEDURE dv_vuerel
PARAMETER str
	PRIVATE intodb, expr, setskip
	PRIVATE i, done, firstime

	m.intodb = dv_getword(str, 1)
	m.setskip = (UPPER(dv_getword(str, 2)) == "<SKIP>")

	* Skip past the database and if necessary the <SKIP> in the string
	m.i = 1
	m.done = .F.
	m.firsttime = .T.
	DO WHILE !done
		IF substr(m.str, m.i, 1) = " "
			IF !m.firsttime OR !m.setskip
				m.done = .T.
			ELSE
				m.firsttime = .F.
			ENDIF
		ENDIF
		m.i = m.i + 1
	ENDDO
	
	* The remainder of the string is the expression
	m.expr = SUBSTR(m.str, m.i)
	
	SET RELATION TO &expr INTO (m.intodb) ADDITIVE
	IF m.setskip
		SET SKIP TO (m.intodb)
	ENDIF
	
* END OF PROCEDURE dv_vuerel

****************************************************************************
* Restore the view saved in 'vuesave'. 'vuesave' may ONLY be setup
* by dv_vueset and may NOT be manipulated nor may its structure
* counted upon by other procedures
****************************************************************************
PROCEDURE dv_vuerest
PARAMETERS vuesave
	PRIVATE numareas, numrels, i, j
	PRIVATE filt, relations, skips, numsaved
	PRIVATE vuei

	m.numsaved = vuesave[1, m.rv_dbssaved]
	m.numareas = vuesave[1, m.rv_areas]
	FOR m.i = 1 TO m.numareas
		m.vuei = m.i + m.numsaved + 1
		SELECT (vuesave[m.vuei, m.rv_db])
		IF vuesave[m.vuei, m.rv_readin] && File was not already opened
			USE
		ELSE && File was already open. Restore its original order
			SET ORDER TO (vuesave[m.vuei, m.rv_ord]) && Restore order
			SET FILTER TO
			SET RELATION TO
			SET SKIP TO
		ENDIF
	ENDFOR

	FOR m.i = 1 TO m.numareas
		m.vuei = m.i + m.numsaved + 1
		IF !vuesave[m.vuei, m.rv_readin]
			SELECT (vuesave[m.vuei, m.rv_db])
			m.filt      = vuesave[m.vuei, m.rv_filter]
			m.relations = vuesave[m.vuei, m.rv_rels]
			m.skips     = vuesave[m.vuei, m.rv_skips]
			SET FILTER   TO &filt      && Restore filter
			SET RELATION TO &relations && Restore relation
			SET SKIP     TO &skips     && Restore Skips
			
			IF (vuesave[m.vuei, m.rv_recno]) > RECCOUNT() && Go to EOF
				GO BOTTOM
				IF !EOF()
					SKIP
				ENDIF
			ELSE
				GO (vuesave[m.vuei, m.rv_recno]) && Restore record number
			ENDIF
		ENDIF
	ENDFOR

	* Reopen any closed databases are reset file statuses if that happened
	FOR m.i = 1 TO m.numsaved
		m.vuei = m.i + 1
		IF vuesave[m.vuei, m.rv_closed] && This database was closed
			SELECT 0
			USE (vuesave[m.vuei, m.rv_dbf]) ALIAS (vuesave[m.vuei, m.rv_alias])
		ELSE
			SELECT (vuesave[m.vuei, m.rv_alias])
		ENDIF
		SET ORDER TO (vuesave[m.vuei, m.rv_ord])
	ENDFOR
	
	FOR m.i = 1 TO m.numsaved
		m.vuei = m.i + 1
		SELECT (vuesave[m.vuei, m.rv_alias])
		
		m.filt      = vuesave[m.vuei, m.rv_filter]
		m.relations = vuesave[m.vuei, m.rv_rels]
		m.skips     = vuesave[m.vuei, m.rv_skips]
		SET FILTER   TO &filt      && Restore filter
		SET RELATION TO &relations && Restore relation
		SET SKIP     TO &skips     && Restore Skips
			
		IF (vuesave[m.vuei, m.rv_recno]) > RECCOUNT() && Go to EOF
			GO BOTTOM
			IF !EOF()
				SKIP
			ENDIF
		ELSE
			GO (vuesave[m.vuei, m.rv_recno]) && Restore record number
		ENDIF
	ENDFOR
	
	* Restore controlling database
	IF !EMPTY(vuesave[1, m.rv_control])
		SELECT (vuesave[1, m.rv_control])
	ENDIF
	
	* Restore base filter
	m.g_basefilt = vuesave[1, m.rv_baseflt]

* END OF PROCEDURE dv_vuerest

* Set the base filter for the current view
PROCEDURE dv_stbasflt
PARAMETERS filter, doset
	IF PARAMETERS() < 2
		m.doset = .T.
	ENDIF
	m.g_basefilt = m.filter
	IF m.doset
		SET FILTER TO &filter
	ENDIF

* END OF PROCEDURE dv_stbasflt

* Append to the base filter for the current view. Appending always uses AND
PROCEDURE dv_apbasflt
PARAMETERS filter, doset
	IF PARAMETERS() < 2
		m.doset = .T.
	ENDIF
	IF !EMPTY(m.g_basefilt)
		m.g_basefilt = "(" + m.g_basefilt + ") AND " + m.filter
	ELSE
		m.g_basefilt = m.filter
	ENDIF
	
	IF m.doset
		SET FILTER TO &filter
	ENDIF

* END OF PROCEDURE dv_stbasflt

* Get the base filter for the current view
FUNCTION dv_gtbasflt
	RETURN m.g_basefilt

* END OF PROCEDURE dv_gtbasflt (FUNCTION)

FUNCTION dv_getparam
PARAMETER m.line
	PRIVATE m.whitespace
	m.whitespace = AT(' ',m.line)
	IF m.whitespace = 0
		m.whitespace = AT(CHR(9),m.line)
	ENDIF
	m.line = ALLTRIM(SUBSTR(m.line,m.whitespace))
	DO WHILE SUBSTR(m.line,1,1) = CHR(9)
		m.line = ALLTRIM(SUBSTR(m.line, 2))
	ENDDO
	RETURN m.line

* END OF FUNCTION dv_getparam

FUNCTION dv_getword
PARAMETERS str, wordnum
	PRIVATE i, len, curpos, retstr
	
	m.curpos = 1
	m.len = LEN(m.str)
	FOR m.i= 1 TO m.wordnum
		IF m.curpos > m.len
			RETURN ""
		ENDIF
		
		DO WHILE SUBSTR(m.str, m.curpos, 1) = " " AND m.curpos <= m.len
			m.curpos = m.curpos + 1
		ENDDO

		IF m.curpos > m.len
			RETURN ""
		ENDIF
				
		m.retstr = ""
		DO WHILE SUBSTR(m.str, m.curpos, 1) <> " " AND m.curpos <= m.len
			m.retstr = m.retstr + SUBSTR(m.str, m.curpos, 1)
			m.curpos = m.curpos + 1
		ENDDO
	ENDFOR
	RETURN m.retstr

* END OF PROCEDURE dv_getword
	
PROCEDURE db_order
PARAMETERS a_ordinfo, curorder, group, checkvalid
	IF PARAMETERS() < 4
		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

	IF re_info[m.rof_frstord]
		DO msg_up WITH "One Moment Please.."
		re_info[m.rof_gotord] = ds_order(@m.a_ordinfo, m.group)
		DO msg_down
	ENDIF
	
	re_info[m.rof_frstord] = .F.
	IF re_info[m.rof_gotord]
		DO (m.g_ordprog) WITH m.a_ordinfo, m.curorder
	ELSE
		DO msg WITH "No Orders Found"
	ENDIF

* END OF PROCEDURE db_order

PROCEDURE db_report
PARAMETERS a_repinfo, group, curfilt, curmarks, checkvalid
	IF PARAMETERS() < 5
		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

	PRIVATE retval
	m.retval = ""
	
	IF re_info[m.rof_frstrep]
		DO msg_up WITH "One Moment Please"
		re_info[m.rof_gotrep] = ds_report(@m.a_repinfo, m.group)
		DO msg_down
	ENDIF

	re_info[m.rof_frstrep] = .F.
	IF re_info[m.rof_gotrep]
		DO (m.g_repprog) WITH m.retval, m.a_repinfo, "", m.curfilt, ;
			m.curmarks, .T.
	ELSE
		DO msg WITH "There are no reports available for this database"
	ENDIF

* END OF PROCEDURE db_report

PROCEDURE db_repgrp
PARAMETERS group
	PRIVATE repinfo, retval
	
	m.repinfo = ""
	DO msg_up WITH "One Moment Please..."
	m.retval = ds_report(@m.repinfo, m.group)
	DO msg_down
	
	IF m.retval
		DO (m.g_repprog) WITH m.retval, m.repinfo
	ELSE
		DO msg WITH "No reports found"
	ENDIF
	
* END OF PROCEDURE db_repgrp

PROCEDURE db_locate
PARAMETERS database, checkvalid
	IF PARAMETERS() < 2
		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

	IF PARAMETERS() < 1
		m.database = ""
	ENDIF
	PRIVATE saverec, srchsetfunc
	
	IF EOF()
		DO msg WITH "This file is empty"
		RETURN
	ENDIF

	IF EMPTY(m.database)	
		m.database = LOWER(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

		m.database = LEFT(m.database, AT(".", m.database) - 1)
		m.database = PADR(m.database, 8)

		* See if this workds
		m.database = re_info[m.rof_curgrp]
	ENDIF

	m.database = UPPER(m.database)
	
	PRIVATE numsearches, searches, cursearch, title
	m.cursearch = re_info[m.rof_srchord]
	IF TYPE("m.cursearch") <> "N"
		m.cursearch = 1
	ENDIF
	
	m.title    = ""
	m.searches = ""
	DO s_getsrch WITH m.searches, m.title, m.database, "SELECT"
	m.numsearches = ALEN(searches, 1)
	
	m.saverec = RECNO()
	IF s_select(@m.searches, m.numsearches, @m.cursearch, "", m.title)	
		SCATTER MEMVAR MEMO

		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 "LOCATE"
		ENDIF
		IF re_info[m.rof_autoed]
			DO re_info[m.rof_fedit]
		ENDIF
		SHOW GETS
	ELSE
		GO (m.saverec)
	ENDIF
	
	re_info[m.rof_srchord] = m.cursearch

* END OF PROCEDURE db_locate

EXTERNAL ARRAY re_info
PROCEDURE db_filter
PARAMETERS a_filtinfo, curfilter, barnum, popupname, group, checkvalid
	IF PARAMETERS() < 6
		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

	PRIVATE retstr, showfilter

	m.showfilter = .F.
	IF re_info[m.rof_frstflt]
		DO msg_up WITH "One Moment Please"
		m.a_filtinfo = ""
		re_info[m.rof_gotflt] = ds_filter(@m.a_filtinfo, m.group)
		DO msg_down
	ENDIF

	re_info[m.rof_frstflt] = .F.
	IF re_info[m.rof_gotflt]
		m.retstr = ""
		DO (m.g_filtprog) WITH m.retstr, m.a_filtinfo, m.curfilter
		DO CASE
		CASE m.retstr == "FOUND"
			DO (re_info[m.rof_ftop])
			m.showfilter = .T.
			SET MARK OF BAR (m.barnum) OF (m.popupname) TO m.showfilter
			
		CASE m.retstr == "CLEARED"
			m.showfilter = .F.
			SET MARK OF BAR (m.barnum) OF (m.popupname) TO m.showfilter
		ENDCASE
	ELSE
		DO msg WITH "No filter can be set for this database"
	ENDIF
	
	re_info[m.rof_showflt] = m.showfilter 
	SHOW MENU _MSYSMENU

* END OF PROCEDURE db_filter

PROCEDURE db_filttog
PARAMETERS barnum, popupname
	PRIVATE holdfilter
	m.holdfilter = re_info[m.rof_holdflt]
	
	re_info[m.rof_showflt] = !re_info[m.rof_showflt]
	
	IF re_info[m.rof_showflt]
		SET FILTER TO &holdfilter
		WAIT WINDOW "Showing Matching Filter Records Only" NOWAIT
	ELSE
		m.holdfilter = FILTER()
		SET FILTER TO &g_basefilt
		WAIT WINDOW "Showing All Records" NOWAIT
	ENDIF
	
	re_info[m.rof_holdflt] = m.holdfilter
	SET MARK OF BAR (m.barnum) OF (m.popupname) TO re_info[m.rof_showflt]
	SHOW MENU _MSYSMENU
	
* END OF PROCEDURE db_filttog

PROCEDURE db_count
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

	PRIVATE currec, curcount, message
	m.currec = RECNO()
	COUNT TO m.curcount
	IF m.currec <= RECCOUNT()
		GO m.currec
	ENDIF
	
	m.message = "There " + IIF(m.curcount = 1, "is ", "are ") + ;
		LTRIM(STR(m.curcount)) + " record" + ;
		IIF(m.curcount = 1, ".", "s.")
		
	IF !EMPTY(re_info[m.rof_markexp])
		PRIVATE nummarks
		m.nummarks = ds_count(";", re_info[m.rof_marks]) - 1
		m.message = m.message + m.g_eol + m.g_eol + ;
			"There " + IIF(m.nummarks = 1, "is ", "are ") + ;
			LTRIM(STR(m.nummarks)) + " marked record" + ;
			IIF(m.nummarks = 1, ".", "s.")
	ENDIF
	
	DO msg WITH m.message
	
* END OF PROCEDURE db_count

PROCEDURE db_mark
PARAMETERS markexpr, type, checkvalid
	IF PARAMETERS() < 3
		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

	PRIVATE curval, ismarked, marks
	m.marks = re_info[m.rof_marks]
	m.curval   = EVAL(m.markexpr)
	m.ismarked = AT(";" + m.curval + ";", m.marks) <> 0

	IF m.type == "TOGGLE"
		IF m.ismarked
			m.type = "UNMARK"
		ELSE
			m.type = "MARK"
		ENDIF
	ENDIF
	
	DO CASE
	CASE m.type == "MARK"
		IF !m.ismarked
			m.marks = m.marks + m.curval + ";"
			re_info[m.rof_marks] = m.marks
			SHOW GETS OFF
		ENDIF

	CASE m.type == "UNMARK"
		IF m.ismarked
			m.marks = STRTRAN(m.marks, ";" + m.curval + ";", ";")
			re_info[m.rof_marks] = m.marks
			SHOW GETS OFF
		ENDIF
	
	ENDCASE
	
* END OF PROCEDURE db_mark

PROCEDURE db_marksel
PARAMETERS markexp, checkvalid
	IF PARAMETERS() < 2
		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

	PRIVATE saverec, database

	IF EOF()
		DO msg WITH "This file is empty"
		RETURN
	ENDIF
	
	m.database = UPPER(re_info[m.rof_curgrp])

	PRIVATE numsearches, searches, marks, title
	m.searches = ""
	m.title = ""
	m.numsearches = s_getsrch(@m.searches, @m.title, m.database, "MARK")
	m.marks       = re_info[m.rof_marks]
	
	m.saverec = RECNO()
	=s_select(@m.searches, m.numsearches, 1, "", m.title, m.markexp, ;
		@m.marks)

	re_info[m.rof_marks] = m.marks

	GO (m.saverec)

* END OF PROCEDURE db_marksel

PROCEDURE db_markall
PARAMETERS markexp, checkvalid
	IF PARAMETERS() < 2
		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

	PRIVATE currec, marks

	DO msg_up WITH "Marking Records. Please Wait..."
	m.marks = ";"
	m.currec = RECNO()

	SCAN
		m.marks = m.marks + EVAL(m.markexp) + ";"
	ENDSCAN

	IF m.currec <= RECCOUNT()
		GO (m.currec)
	ENDIF

	re_info[m.rof_marks] = m.marks
	DO msg_down
	SHOW GETS OFF

* END OF PROCEDURE db_markall

PROCEDURE db_marknone
PARAMETERS markexp, checkvalid
	IF PARAMETERS() < 2
		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

	re_info[m.rof_marks] = ";"
	SHOW GETS OFF

* END OF PROCEDURE db_marknone

* Standard menus
PROCEDURE db_stdutil
	IF m.g_group = PADR("DEVELOPER", LEN(m.g_group))
		DEFINE PAD utilities OF _MSYSMENU PROMPT "\<Utilities" COLOR SCHEME 3 ;
			KEY ALT+U, "ALT+U"

		ON PAD utilities OF _MSYSMENU ACTIVATE POPUP utilities
	
		DEFINE POPUP utilities MARGIN RELATIVE SHADOW COLOR SCHEME 4

		DEFINE BAR _MWI_MOVE OF utilities PROMPT "Move"
		DEFINE BAR _MWI_SIZE OF utilities PROMPT "Size"
		DEFINE BAR _MWI_ROTAT OF utilities PROMPT "Cycle" ;
			KEY CTRL+F1, "CTRL+F1"
		DEFINE BAR 4 OF utilities PROMPT "\-"
		DEFINE BAR _MWI_DEBUG OF utilities PROMPT "Debug"
		DEFINE BAR _MWI_TRACE OF utilities PROMPT "Trace"
		DEFINE BAR _MWI_CMD OF utilities PROMPT "Command Window" ;
			KEY CTRL+F2, "CTRL+F2"
		DEFINE BAR _MPR_RESUM OF utilities PROMPT "Resume" ;
			KEY CTRL+M, "CTRL+M"
		DEFINE BAR 9 OF utilities PROMPT "Suspend"
		DEFINE BAR 10 OF utilities PROMPT "View"
		DEFINE BAR 11 OF utilities PROMPT "Clear Key"
		DEFINE BAR 12 OF utilities PROMPT "Cancel"
		DEFINE BAR 13 OF utilities PROMPT "Default Menu" ;
			KEY CTRL+F3, "CTRL+F3"

		ON SELECTION BAR 9 OF utilities SUSPEND
		ON SELECTION BAR 10 OF utilities SET
		ON SELECTION BAR 11 OF utilities PUSH KEY CLEAR
		ON SELECTION BAR 12 OF utilities CANCEL
		ON SELECTION BAR 13 OF utilities SET SYSMENU TO DEFAULT
	ENDIF
	
* END OF PROCEDURE (db_stdutil)

* Initialise fields of the flat file structure
PROCEDURE dbrof_init
PARAMETERS re_info, primfile, group
	* Initialise everything to the empty string
	STORE "" TO re_info

	* Identify this type
	re_info[m.rof_type] = "FLAT FILE"

	* The following is to tell the control menu what functions to call
	re_info[m.rof_fok]     = "db_ok"
	re_info[m.rof_fcancel] = "db_cancel"
	re_info[m.rof_ftop]    = "db_top"
	re_info[m.rof_fprev]   = "db_prev"
	re_info[m.rof_fnext]   = "db_next"
	re_info[m.rof_fbottom] = "db_bottom"
	re_info[m.rof_fedit]   = "db_edit"
	re_info[m.rof_fadd]    = "db_add"
	re_info[m.rof_fdelete] = "db_delete"
	re_info[m.rof_fquit]   = "db_quit"
	re_info[m.rof_floc]    = "db_locate"
	re_info[m.rof_fsave]   = "db_save"
 	re_info[m.rof_fshow]   = "showgets"
	re_info[m.rof_fhide]   = "hidegets"

	re_info[m.rof_primfil] = m.primfile
	re_info[m.rof_inedit]  = .F.
	re_info[m.rof_marks]   = ";"

	* Initialise variables for the options menu
	re_info[m.rof_frstord] = .T.
	re_info[m.rof_frstrep] = .T.
	re_info[m.rof_frstflt] = .T.
	re_info[m.rof_gotord]  = .F.
	re_info[m.rof_gotrep]  = .F.
	re_info[m.rof_gotflt]  = .F.
	re_info[m.rof_showflt] = .F.
	re_info[m.rof_marks]   = ";"

	* Other variables
	re_info[m.rof_autoed]  = .F.
	re_info[m.rof_curgrp]  = m.group
	re_info[m.rof_autoid]  = .F.

	re_info[m.rof_edmsg]   = "Someone else is editing this record. " + ;
		"You can view it only."
	re_info[m.rof_abaask]  = "Are you sure you want to abandon this addition?"
	re_info[m.rof_abeask]  = "Are you sure you want to abandon your changes?"
	re_info[m.rof_delmsg]  = "Are you sure you want to delete this record?"
		
* END OF PROCEDURE dbrof_init

PROCEDURE dbrom_init
PARAMETERS re_info, primfile, group
	* First initialise all elements to the empty string
	STORE "" TO m.re_info

	* Identify this type
	re_info[m.rom_type] = "ONE TO MANY"

	* The following is to tell the control menu what functions to call
	re_info[m.rom_fok]     = "db_ok"
	re_info[m.rom_fokln]   = "l_saveline"
	re_info[m.rom_frdln]   = "l_readline"
	re_info[m.rom_flhide]  = "l_hideline"
	re_info[m.rom_fcancel] = "db_cancel"
	re_info[m.rom_ftop]    = "db_top"
	re_info[m.rom_fprev]   = "db_prev"
	re_info[m.rom_fnext]   = "db_next"
	re_info[m.rom_fbottom] = "db_bottom"
	re_info[m.rom_fedit]   = "db_edit"
	re_info[m.rom_fadd]    = "db_add"
	re_info[m.rom_fdelete] = "db_delete"
	re_info[m.rom_fquit]   = "db_quit"
	re_info[m.rom_floc]    = "db_locate"
	re_info[m.rom_fsave]   = "db_save"
	re_info[m.rom_fshow]   = "showgets"
	re_info[m.rom_fhide]   = "hidegets"
	re_info[m.rom_fchkobj] = "l_ckcurobj"
	re_info[m.rom_lrecs]   = ";"

	re_info[m.rom_primfil] = m.primfile
	re_info[m.rom_inedit]  = .F.
	re_info[m.rom_marks]   = ";"

	* Initialise variables for the options menu
	re_info[m.rom_frstord] = .T.
	re_info[m.rom_frstrep] = .T.
	re_info[m.rom_frstflt] = .T.
	re_info[m.rom_gotord]  = .F.
	re_info[m.rom_gotrep]  = .F.
	re_info[m.rom_gotflt]  = .F.
	re_info[m.rom_showflt] = .F.
	re_info[m.rom_autoed]  = .F.
	re_info[m.rom_curgrp]  = m.group
	re_info[m.rom_autoid]  = .F.
	re_info[m.rom_showall] = .F.
	re_info[m.rom_marks]   = ";"

	re_info[m.rom_edmsg]   = "Someone else is editing this record. " + ;
		"You can view it only."
	re_info[m.rom_abaask]  = "Are you sure you want to abandon this addition?"
	re_info[m.rom_abeask]  = "Are you sure you want to abandon your changes?"
	re_info[m.rom_delmsg]  = "Are you sure you want to delete this record?"

* END OF PROCEDURE dbrom_init

PROCEDURE dbroo_init
PARAMETERS re_info, primfile, group
	* First initialise all elements to the empty string
	STORE "" TO m.re_info

	* Identify this type
	re_info[m.roo_type] = "ONE TO ONE"

	* The following is to tell the control menu what functions to call
	re_info[m.roo_fok]     = "db_ok"
	re_info[m.roo_fcancel] = "db_cancel"
	re_info[m.roo_ftop]    = "db_top"
	re_info[m.roo_fprev]   = "db_prev"
	re_info[m.roo_fnext]   = "db_next"
	re_info[m.roo_fbottom] = "db_bottom"
	re_info[m.roo_fedit]   = "db_edit"
	re_info[m.roo_fadd]    = "db_add"
	re_info[m.roo_fdelete] = "db_delete"
	re_info[m.roo_fquit]   = "db_quit"
	re_info[m.roo_floc]    = "db_locate"
	re_info[m.roo_fsave]   = "db_save"
	re_info[m.roo_fshow]   = "showgets"
	re_info[m.roo_fhide]   = "hidegets"

	re_info[m.roo_primfil] = m.primfile
	re_info[m.roo_inedit]  = .F.
	re_info[m.roo_marks]   = ";"

	* Initialise variables for the options menu
	re_info[m.roo_frstord] = .T.
	re_info[m.roo_frstrep] = .T.
	re_info[m.roo_frstflt] = .T.
	re_info[m.roo_gotord]  = .F.
	re_info[m.roo_gotrep]  = .F.
	re_info[m.roo_gotflt]  = .F.
	re_info[m.roo_showflt] = .F.
	re_info[m.roo_autoed]  = .F.
	re_info[m.roo_curgrp]  = m.group
	re_info[m.roo_autoid]  = .F.
	re_info[m.roo_marks]   = ";"

	re_info[m.roo_edmsg]   = "Someone else is editing this record. " + ;
		"You can view it only."
	re_info[m.roo_abaask]  = "Are you sure you want to abandon this addition?"
	re_info[m.roo_abeask]  = "Are you sure you want to abandon your changes?"
	re_info[m.roo_delmsg]  = "Are you sure you want to delete this record?"

* END OF PROCEDURE dbroo_init

