{*******************************MULTI-EDIT MACRO******************************

Name: DB

Description:  Simple, note card style, text database manager.

File Format:  The header is composed of one field definition per line as
							follows (except for /DBF, the format is the same as individual
							string fields in DATA_IN):

		/TP=field_type/T=field_name/L=line/C=col/W=field_width
		    + /ML=max_field_length/DBF=field_designator
		(any number of repeats of the above line)
		****START****
		(data records)

							The /DBF field designator must be unique, and represents the
							identifier in each record for that field.

							See PHONE.DB for a sample note card file.

Parameters:
						/F=  The file name of the database file.
						/NL= No list.  If 1, the DVMENU of records is bypassed.  Display
								/FV= record.
						/FV=  Field value first field of record to be displayed.  Only
									used if /NL=1 or /C=1.
						/C=  Immediately create a new record if /FV= is not found.  Can be
								 used only with /NL=.

						/HF=str  Specifies a header file.  This allows you to use
								a seperate file for your field definitions.

               (C) Copyright 1988 by American Cybernetics, Inc.
******************************************************************************}

$macro db;
	def_int( x, y, field_count, max_record_count, tp,No_List,Create,Search_result,
					old_id, record_count, jx, need_rebuild, end_field, tbc, header_win, db_win );

	def_str( tstr[1000], tstr2, tstr3, header_file );

	No_List := Parse_Int('/NL=',MParm_Str);
	Create := Parse_Int('/C=',MParm_Str);
	Search_Result := 1;
	refresh := false;
	old_id := window_id;
	create_window;
	db_win := window_id;
	header_win := window_id;


	max_record_count := 0;
	field_count := 0;
	tbc := box_count;

	{Calculate position of box}
	x := parse_int('/X=', mparm_str);
	y := parse_int('/Y=', mparm_str);
	if x <= 0 then
		x := 2;
	end;
	if y <= 0 then
		y := 2;
	end;

	{Get file name.  If no path is specified, then assume the ME directory}
	tstr := parse_str('/F=', mparm_str);
	if get_path(tstr) = '' then
		tstr := me_path + tstr;
	end; 
	tstr := fexpand(tstr);
	load_file( tstr );
	if error_level <> 0 then
		error_level := 0;
		file_name := tstr;
	end;

	{Check for a seperate header file}
	header_file := parse_str( '/HF=', mparm_str );
	if header_file <> '' then
		create_window;
		if get_path(header_file) = '' then
			header_file := me_path + header_file;
		end;
		header_file := fexpand(header_file);
		{If the header_file is not the same as the db file then load the header
			file}
		if header_file <> tstr then
			load_file(header_file);
			if error_level <> 0 then
				beep;
				goto exit;
			end;
			header_win := window_id;
		end;
	end;



	need_rebuild := true;
	call build_fields;
	max_record_count := 0;
	return_str := global_str( 'DB#' + truncate_path(file_name));

main_loop:
	{Display the list of all of the fields}

	IF (No_List) THEN
		Goto NO_LIST;
	END;
	call build_record_list;

	{Exit from DB}
	if return_int = 0 then
NO_LIST_EXIT:
		if file_changed then
			save_file;
		end;
		set_global_str( 'DB#' + truncate_path(file_name), return_str );
		goto exit;
	end;

	{Display selected record}
	if return_int = 1 then
NO_LIST:
		IF (No_List) THEN
			Return_Str := Parse_Str('/FV=',MParm_Str);
		END;
		call find_data;
		IF ((No_List = 1) and (Search_Result = 0)) THEN
			IF (Create = 0) THEN
				Goto EXIT;
			ELSE
				Goto NO_LIST_CREATE;
			END;
		END;
display_fields:
		call get_data;
		run_macro('USERIN^DATA_IN /X=' + str(x + 2) + '/Y=' + str(y + 2) +
									'/NC=1/T=' + truncate_path(file_name) + '/A=2' + '/#=' + str(field_count));
		call set_data;
		return_str := global_str('ISTR_1');
		IF (No_List) THEN
			Goto NO_LIST_EXIT;
		END;
		goto main_loop;
	end;

	{Create new record.  Put it in the file in alphabetical order}
	if return_int = 2 then
NO_LIST_CREATE:
		eof;
		if c_col <> 1 then
			down;
		end;
		tstr := '' + parse_str('/DBF=', global_str('IPARM_1')) + '=' + return_str;
		call set_data2;
		need_rebuild := true;
		goto display_fields;
	end;

	{Delete selected record}
	if return_int = 3 then
		call find_data;
		del_line;
		need_rebuild := true;
		goto main_loop;
	end;

	goto main_loop;


{Searches for the specified record, according to field 1}
find_data:
	tof;
	Search_Result := search_fwd('' + parse_str('/DBF=', global_str('IPARM_1')) + '=' + return_str, 0);
	if (Search_Result = 0) then
		IF (No_List) THEN
			Ret;
		END;
		eof;
	end;
	ret;

{Retrieves the data in the current record and puts it into a DATA_IN compatible
 globals}
get_data:
	jx := 0;
	tstr := get_line;
	while jx < field_count do
		++jx;
		tp := parse_int('/TP=', global_str('IPARM_' + str(jx)));
		if (tp = 0) or (tp = 8) then
			set_global_str('ISTR_' + str(jx),
				parse_str('' + parse_str('/DBF=', global_str('IPARM_' + str(jx))) + '=',
				tstr ));
		else
			if (tp = 1) or (tp = 3) or (tp = 4) or (tp = 5) or (tp = 7) then
				set_global_int('IINT_' + str(jx),
					parse_int('' + parse_str('/DBF=', global_str('IPARM_' + str(jx))) + '=',
					tstr ));
			end;
		end;
	end;
	ret;

{Takes the current record out of the DATA_IN globals and puts it in the file}
set_data:
	jx := 0;
	tstr := '';
	while jx < field_count do
		++jx;
		tp := parse_int('/TP=', global_str('IPARM_' + str(jx)));
		if (tp = 0) or (tp = 8) then
			if global_str('ISTR_' + str(jx)) <> '' then
				tstr := tstr + '' + parse_str('/DBF=', global_str('IPARM_' + str(jx))) + '=' +
							global_str('ISTR_' + str(jx));
			end;
		end;
		if (tp = 1) or (tp = 3) or (tp = 4) or (tp = 5) or (tp = 7) then
			if global_int('IINT_' + str(jx)) <> 0 then
				tstr := tstr + '' + parse_str('/DBF=', global_str('IPARM_' + str(jx))) + '=' +
							str(global_int('IINT_' + str(jx)));
			end;
		end;
	end;
	if (tstr <> get_line) then
		del_line;

{This entry point is only used by CREATE}
set_data2:
		goto_line(end_field+1);
		tstr2 := '' + parse_str('/DBF=', global_str('IPARM_1')) + '=';
		tstr3 := caps(parse_str(tstr2,tstr));
		goto_col(1);
		while not(at_eof) and (caps(parse_str(tstr2,get_line)) < tstr3) do
			down;
		end;
		if not(at_eof) then
			cr;
			up;
		end;
		put_line(tstr);
		need_rebuild := true;
	end;
	ret;

{Takes the file header that defines the fields and builds DATA_IN compatible
 global parameter variables.}
build_fields:
	if switch_win_id( header_win ) then
		field_count := 0;
		tof;
	floop:
		tstr := get_line;
		if (tstr = '****START****') or (At_Eof) then
			end_field := c_line;
			goto floop_exit;
		end;
		++field_count;
		set_global_str('IPARM_' + str(field_count), tstr);
		set_global_str('ISTR_' + str(field_count), parse_str('/ISTR=', tstr));
		set_global_int('IINT_' + str(field_count), parse_int('/IINT=', tstr));
		down;
		goto floop;

	floop_exit:
		if field_count <= 0 then
			goto exit;
		end;
		down;
	end;
	if db_win <> header_win then
		end_field := 0;
	end;
	if switch_win_id( db_win ) then end;
	ret;

{Builds the Variable Length Menu that lists all of the records by their
 first field}
build_record_list:
	while box_count > tbc do
		kill_box;
	end;

	if need_rebuild then
		goto_col(1);
		goto_line(end_field + 1);
		tstr := parse_str('/DBF=', global_str('IPARM_1') );
		record_count := 0;
		while not(at_eof) do
			++record_count;
			set_global_str('@@' + str(record_count), parse_str('' + tstr + '=', get_line));
			down;
		end;
		need_rebuild := false;
	end;
	if record_count > max_record_count then
		max_record_count := record_count;
	end;
	run_macro('USERIN^DVMENU /P=@@/X=' + str(x) + '/Y=' + str(y) +
			'/CT=ENTER NAME OF NEW RECORD/W=60/NR=1/C=1/D=1/EC=1/ED=1/S=' + return_str +
			'/T=' + truncate_path(file_name) +
			'/H=XX/B=1/K=0/I=%/#=' + str(record_count));
	ret;

exit:
	Return_Int := Search_Result - 1;
		{Clean up globals}
	jx := 0;
	while jx <= max_record_count do
		++jx;
		set_global_str('@@' + str(jx), '');
	end;

	jx := 0;
	while jx < field_count do
		++jx;
		set_global_str('IPARM_' + str(jx), '');
		set_global_str('ISTR_' + str(jx), '');
		set_global_int('IINT_' + str(jx), 0);
	end;
	while box_count > tbc do
		kill_box;
	end;

	if switch_win_id( db_win ) then
		delete_window;
	end;
	if switch_win_id( header_win ) then
		delete_window;
	end;

	if switch_win_id(old_id) then end;
end_macro;