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

25. ORACLE:SNMYEAR_5 - календарь работы 5-дн. дневного стационара

YEAR NUMBER(4, 0) Год

MES_1 CHAR(42) 1-й месяц года

MES_2 CHAR(42)2-й месяц года

MES_3 CHAR(42) 3-й месяц года

MES_4 CHAR(42) 4-й месяц года

MES_5 CHAR(42)5-й месяц года

MES_6 CHAR(42)6-й месяц года

MES_7 CHAR(42) 7-й месяц года

MES_8 CHAR(42) 8-й месяц года

MES_9 CHAR(42) 9-й месяц года

MES_10 CHAR(42) 10-й месяц года

MES_11 CHAR(42) 11-й месяц года

MES_12 CHAR(42) 12-й месяц года

Приложение №5

Код основного модуля

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls, Buttons, ExtCtrls, RxGrdCpt, Grids, DBGrids,

bdeutils, fileutil, strutils, Db, DBTables, RXCtrls, SpeedBar, vclutils, ToolWin,

ImgList,DBLists;

type

TForm1 = class(TForm)

RxGradientCaption1: TRxGradientCaption;

SpeedBar1: TSpeedBar;

SpeedbarSection1: TSpeedbarSection;

SpeedItem1: TSpeedItem;

ToolBar1: TToolBar;

tbtn1: TToolButton;

tbtn2: TToolButton;

RxGradientCaption2: TRxGradientCaption;

ImageList1: TImageList;

Panel1: TPanel;

Animate1: TAnimate;

Label1: TLabel;

ToolButton1: TToolButton;

RxGradientCaption3: TRxGradientCaption;

Label2: TLabel;

Tbtn3: TToolButton;

procedure FormShow(Sender: TObject);

procedure SpeedItem1Click(Sender: TObject);

procedure ToolButton1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

procedure TblUpdt(s: TDatabaseItems);

public

{ Public declarations }

end;

var

Form1: TForm1;

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='Документов без ошибок ';

str6: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.