Проектирование АРМ сотрудника отдела автоматизации информационного обеспечения Ивановского филиала ФОМС

reg : Byte;

implementation

{$R *.DFM}

uses data1, Data, main;

procedure create_msg(fi: string; n_ch: integer; d: tdatetime;cou, cou_bad: integer; tot, tot_bad: real);

const

str1:AnsiString='Получен счет:';

str2:AnsiString='Счет:';

str3:AnsiString='Дата:';

str4:AnsiString='Результаты автоматичекой проверки:';

str5:AnsiString='Документов без ошибок ';

s

tr6:AnsiString='Документов с ошибками ';

str7:AnsiString='Отдел АИО ТФ ОМС г.Иваново';

str8:AnsiString=' на сумму ';

var f: textFile;

begin

if fileexists(fi) then Exit;

AssignFile(f,fi);

Rewrite(f);

writeln(f,strtooem(str1));

writeln(f,strtooem(str2)+inttostr(n_ch));

writeln(f,strtooem(str3)+DateTimeToStr(d));

writeln(f,strtooem(str4));

writeln(f,strtooem(str5)+IntToStr(cou)+strtooem(str8)+floattostrF(tot, ffFixed,10,2 ));

writeln(f,strtooem(str6)+IntToStr(cou_bad)+strtooem(str8)+floattostrF(tot_bad,ffFixed,10,2));

writeln(f,strtooem(str7));

CloseFile(f);

end;

procedure create_pst(p,fi1,fi2: string);

var f: textFile;

begin

AssignFile(f,fi1);

Rewrite(f);

writeln(f,'PATH:'+p);

writeln(f,'FILE:'+fi2);

writeln(f,strtooem('КТО : decodsch.exe'));

writeln(f,strtooem('ДАТА: '+ datetimetostr(now)));

CloseFile(f);

end;

procedure ChangeLangDrv(drv: string);

var l: TStrings;

begin

Session.Close;

l := TStringList.Create;

l.Add('LANGDRIVER='+drv);

Session.ModifyDriver('DBASE',l);

Session.Open;

l.Free;

end;

procedure kod_lpu(t: TTable);

begin

t.TableName := 'L2'+Copy(t.TableName,3,3)+'.DBF';

t.Open;

if not(t.IsEmpty) then

with dm1.Query1 do begin

Close;

SQL.Clear;

sql.Add('UPDATE AMB_US SET KOD_LPU='+

t.FieldByName('kod_lpu').asstring+' , N_CH='''+

t.FieldByName('n_ch').asstring+''' , DAT_SC='''+

t.FieldByName('dat_sc').AsString+''' WHERE KOD_LPU IS NULL');

ExecSQL;

end;

t.Close;

end;

procedure TForm1.TblUpdt(s: TDatabaseItems);

var t: TTable;

begin

Label1.Caption := 'Идет подготовка таблиц .'; delay(10);

t := TTable.Create(self);

case reg of

1: t.DatabaseName := 'dbSTA';

2: t.DatabaseName := 'dbAMB';

4: t.DatabaseName := 'dbSTO';

end;

{cоздание БД переносимых LPU и счетов}

if deletefile('d:\data\toORA\z.dbf') then;

with dm1.Query2 do

begin

sql.Clear;

sql.Add('CREATE TABLE "z" (kod_lpu numeric(3),n_ch character(10), dat_sc date, vid numeric(1) )');

Prepare;

ExecSQL;

end;

with s do begin

Open;

First;

while not eof do begin

t.TableName := ItemName;

TableUpdate(t);

Next;

end;

Close;

{Формирование БД переносимых LPU и счетов}

{ если весь счет забракован в ошибки, то усложняется SQL на INSERT в z.dbf }

with dm1.Query2 do

begin

sql.Clear;

case reg of

1: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 1 as vid from sta ');

2: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 2 as vid from amb ');

4: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 4 as vid from sto ');

end;

ExecSQL;

sql.Clear;

case reg of

1: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 1 as vid from sta_bad where kod_lpu not in (select distinct kod_lpu from sta) ');

2: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 2 as vid from amb_bad where kod_lpu not in (select distinct kod_lpu from amb) ');

4: sql.Add('INSERT INTO "z" (kod_lpu, n_ch, dat_sc, vid) select distinct kod_lpu, n_ch, dat_sc, 4 as vid from sto_bad where kod_lpu not in (select distinct kod_lpu from sto) ');

end;

ExecSQL;

Close;

end;

end;

t.Free;

end;

procedure TForm1.FormShow(Sender: TObject);

begin

Icon := Application.Icon;

ToolBar1.Buttons[0].Down := True;

Label1.Caption := '';

Label2.Caption := '';

try

dm1.dbORA.Connected := True;

except

MessageDlg('Ошибка при подключении к серверу ORACLE(WG73)!', mtWarning, [mbOK], 0);

end;

end;

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

ChangeLangDrv('db866ru0');

Close;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ChangeLangDrv('db866ru0');

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

ChangeLangDrv('db866ru0');

end;

end.

 Скачать реферат