unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, DB, DBClient, Grids, DBGrids, ComCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
DBGrid1: TDBGrid;
cds: TClientDataSet;
ds: TDataSource;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
cxDateEdit1: TcxDateEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function IMin(Val1, Val2: Integer): Integer;
begin
Result := Val1;
if Val2 < Val1 then
Result := Val2;
end;
procedure AssignRecordx(Source, Dest: TDataSet; ByName: Boolean);
var
I: Integer;
F, FSrc: TField;
begin
if ByName then
begin
for I := 0 to Source.FieldCount - 1 do
begin
F := Dest.FindField(Source.Fields[I].FieldName);
if F <> nil then
begin
try
F.Value := Source.Fields[I].Value;
except
end;
end;
end;
end
else
begin
for I := 0 to iMin(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
begin
F := Dest.FindField(Dest.FieldDefs[I].Name);
FSrc := Source.FindField(Source.FieldDefs[I].Name);
if (F <> nil) and (FSrc <> nil) then
begin
try
F.Value := FSrc.Value;
except
end;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
cds.data := hosxp_getdataset('select o.hn,o.vstdate,o.vsttime,p.pname,p.fname,p.lname ' +
' from ovst o ' +
' left outer join patient p on p.hn = o.hn ' +
' where o.vstdate = "' + formatdatetime('yyyy-mm-dd', cxdateedit1.date) + '"');
end;
procedure TForm1.Button2Click(Sender: TObject);
var dbf1: tdbf;
i: integer;
nf: boolean;
begin
dbf1 := tdbf.create(nil);
dbf1.close;
dbf1.tablelevel := 4;
dbf1.fielddefs.assign(cds.fielddefs);
repeat
nf := false;
for i := 0 to (dbf1.fielddefs.count - 1) do
begin
if not nf then
if (dbf1.fielddefs.items[i].datatype = ftTime) then
begin
dbf1.fielddefs.items[i].datatype := ftstring;
dbf1.fielddefs.items[i].size := 8;
nf := true;
end;
end;
until not nf;
dbf1.tablename := 'c:\dbase.dbf';
dbf1.createtable;
dbf1.open;
cds.first;
while not cds.eof do
begin
dbf1.append;
assignrecordx(cds, dbf1, true);
dbf1.post;
cds.next;
end;
dbf1.close;
dbf1.free;
showmessage('Done.');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
fcds.data := cds.data;
CreateDatasetReport('HOSxP Report');
end;
end.