อันล่าง ใส่หน้า source
-----------------------------------
unit StatExchange;
// version 0.1.1
// 2006-09-05
// Chaiyaporn Suratemekul
// 2006-10-28
// Tawee Supklang
var StatPath: string;
MainForm: TForm;
StartButton: TButton;
AbortButton: TButton;
StatusMemo: TMemo;
FAbort: Boolean;
StatusLabel : TLabel;
ErrMemo:TMemo;
LastErr: string;
implementation
Procedure AddLog(s:string);
begin
StatusMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+'>'+s);
end;
Procedure CheckErr;
begin
if LastErr<>'' then
if Pos('CommandText', LastErr) = 0 then ErrMemo.Lines.Add(formatdatetime('hh:nn:ss',now)+' '+LastErr);
end;
procedure StartExport;
var
sconnection: string; // variable for hold connection string
st: string; // variable for hold any string
tc, StatCDS: Tclientdataset;
QueueCDS: TClientDataset;
begin
if StatPath = '' then
begin
StatPath := VarToStr(GetSQLData('select statroot from opdconfig'));
StatusMemo.Lines.Add('Stat Path = ' + statPath);
end;
if StatPath = '' then
begin
AddLog('Error : no information in opdconfig.statroot');
exit;
end;
sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\PUB;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
ado_connection.connected := false;
ado_connection.connectionstring := sconnection;
ado_connection.connected := true;
tc := tclientdataset.create(nil);
statcds := tclientdataset.create(nil);
// tc.data:=HOSxP_GetADODataset('select count(*) as cc from patient1');
// StatusMemo.lines.add('Start Import Patient');
QueueCDS := TClientDataset.create(nil);
repeat
QueueCDS.data := HOSxP_GetDataset('select * from stat_queue where process_count = 0 and queue_type = "OPDCARD" order by queue_date_time');
while not QueueCDS.eof do
begin
LastErr := '';
tc.data := HOSxP_GetDataset('select * from patient where hn = "' + queuecds.fieldbyname('id').asstring + '"');
statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient1 where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then
begin
LastErr := '';
StatusMemo.Lines.Add('======= New Patient ====== [' + tc.fieldbyname('hn').asstring+']');
AddLog('Insert patient 1 '+tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('insert into patient1 (hn,sex,name,birthday,derive,mother,father,lastdate,time,person_id,class,clinic) values ("' + tc['hn'] + '","' + tc['sex'] + '","' +
vartostr(tc['fname']) + ' ' + vartostr(tc['lname']) + ',' +
vartostr(tc['pname']) + '",Date(' + formatdatetime('yyyy', tc.fieldbyname('birthday').asdatetime) + ',' +
formatdatetime('m', tc.fieldbyname('birthday').asdatetime) + ',' +
formatdatetime('d', tc.fieldbyname('birthday').asdatetime) + '),"1","' +
vartostr(tc['mathername']) + '","' +
vartostr(tc['fathername']) + '", ' +
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + '), ' +
'"' + formatdatetime('hhnn', now) + '", "' +
tc.fieldbyname('cid').asstring + '" ,"' +
tc.fieldbyname('pttype').asstring + '" ,"' +
'01"' +
' )');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient1 where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat Insert Fail !!!');
end else
begin
LastErr := '';
AddLog('Edit patient1 ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update patient1 set sex = "' + vartostr(tc['sex']) + '" , ' +
'name = "' + vartostr(tc['fname']) + ' ' + vartostr(tc['lname']) + ',' + vartostr(tc['pname']) + '" ,' +
'birthday = Date(' + formatdatetime('yyyy', tc.fieldbyname('birthday').asdatetime) + ',' +
formatdatetime('m', tc.fieldbyname('birthday').asdatetime) + ',' +
formatdatetime('d', tc.fieldbyname('birthday').asdatetime) + ') , ' +
'mother = "' + vartostr(tc['mathername']) + '" , ' +
'father = "' + vartostr(tc['fathername']) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient2 where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then
begin
AddLog('Insert patient2 ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('insert into patient2 (hn,occupa,nation,race,marriage,phone,contact) values ("' + tc['hn'] + '","' +
vartostr(tc['occupation']) + '", "' +
tc.fieldbyname('nationality').asstring + '" ,"' +
tc.fieldbyname('citizenship').asstring + '" ,"' +
tc.fieldbyname('marrystatus').asstring + '" ,"' +
tc.fieldbyname('hometel').asstring + '" ,"' +
tc.fieldbyname('informname').asstring + '" ' +
' )');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from patient2 where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat patient2 Insert Fail !!!');
end else
begin
AddLog('Edit patient2 ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update patient2 set occupa = "' + vartostr(tc['occupation']) + '" ,' +
'nation = "' + vartostr(tc['nationality']) + '" , ' +
'race = "' + vartostr(tc['citizenship']) + '", ' +
'marriage = "' + vartostr(tc['marrystatus']) + '", ' +
'phone = "' + vartostr(tc['hometel']) + '" ,' +
'contact = "' + vartostr(tc['informname']) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from contact where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then
begin
AddLog('Insert contact ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('insert into contact (hn,address,village,tambon,ampur,changwat,owner) values ("' + tc['hn'] + '","' +
vartostr(tc['addrpart']) + '", "' +
tc.fieldbyname('moopart').asstring + '" ,"' +
tc.fieldbyname('tmbpart').asstring + '" ,"' +
tc.fieldbyname('amppart').asstring + '" ,"' +
tc.fieldbyname('chwpart').asstring + '" ,"' +
'1' + '" ' +
' )');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from contact where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then StatusMemo.lines.add('Stat contact Insert Fail !!!');
end else
begin
LastErr := '';
AddLog('Edit contact ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update contact set address = "' + vartostr(tc['addrpart']) + '" ,' +
'village = "' + vartostr(tc['moopart']) + '" , ' +
'tambon = "' + vartostr(tc['tmbpart']) + '", ' +
'ampur = "' + vartostr(tc['amppart']) + '", ' +
'changwat = "' + vartostr(tc['chwpart']) + '" ,' +
'owner = "1" ' +
' where hn = "' + vartostr(tc['hn']) + '" and owner="1" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
end;
CheckErr;
QueueCDS.edit;
QueueCDS.fieldbyname('process_count').asinteger := QueueCDS.fieldbyname('process_count').asinteger + 1;
if Pos('CommandText', LastErr) > 0 then QueueCDS.fieldbyname('error').asinteger:= QueueCDS.fieldbyname('error').asinteger+1;
QueueCDs.post;
QueueCDS.next;
end;
if QueueCDs.ChangeCount > 0 then
HOSxP_updateDelta(Queuecds.Delta, 'select * from stat_queue where process_count = 0 and queue_type = "OPDCARD" order by queue_date_time');
until ((QueueCDS.RecordCount = 0) or FAbort);
repeat
QueueCDS.data := HOSxP_GetDataset('select * from stat_queue where process_count = 0 and queue_type = "VISIT" order by queue_date_time');
while not QueueCDS.Eof do
begin
LastErr := '';
sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\PUB;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
ado_connection.connected := false;
ado_connection.connectionstring := sconnection;
ado_connection.connected := true;
tc.data := HOSxP_GetDataset('select * from vn_stat where vn = "' + QueueCDS.fieldbyname('id').asstring + '"');
if tc.recordcount > 0 then
begin
LastErr := '';
StatusMemo.Lines.add('===== New Visit =====');
AddLog('Edit patient1 class ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update patient1 set class = "' + vartostr(tc['pttype']) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
//check insurelog
sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\CREDIT\DATA;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
ado_connection.connected := false;
ado_connection.connectionstring := sconnection;
ado_connection.connected := true;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then
begin
LastErr := '';
AddLog('Insert insurlog ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('insert into insurlog (hn,subtype,inscl,cid,hospmain,hospsub,name,datein,dateexp,notedate,note,recordby,verifyby) values ("' +
tc['hn'] + '","' +
vartostr(tc['pcode']) + '", "' +
tc.fieldbyname('pttype').asstring + '" ,"' +
tc.fieldbyname('pttypeno').asstring + '" ,"' +
tc.fieldbyname('hospmain').asstring + '" ,"' +
tc.fieldbyname('hospsub').asstring + '" ,"' +
vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '", ' +
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') , '+
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') , '+
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') ,'+
' " " ,'+ // note
' "HOSxP" , '+ // recordby
' "HOSxP" '+ // verifyby
' )');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then ErrMemo.lines.add('Stat insurlog Insert Fail !!!');
end else
begin
LastErr := '';
AddLog('Edit insurlog ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update insurlog set subtype = "' + vartostr(tc['pcode']) + '" ,' +
'inscl = "' + vartostr(tc['pttype']) + '" , ' +
'cid = "' + vartostr(tc['pttypeno']) + '", ' +
'hospmain = "' + vartostr(tc['hospmain']) + '", ' +
'hospsub = "' + vartostr(tc['hospsub']) + '" ,' +
'name = "' + vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
end;
end;
// if Pos('CommandText', LastErr) > 0 then
// begin
QueueCDS.edit;
QueueCDS.fieldbyname('process_count').asinteger := QueueCDS.fieldbyname('process_count').asinteger + 1;
if Pos('CommandText', LastErr) > 0 then QueueCDS.fieldbyname('error').asinteger:= QueueCDS.fieldbyname('error').asinteger+1;
QueueCDs.post;
QueueCDS.next;
//end;
end;
if QueueCDs.ChangeCount > 0 then
HOSxP_updateDelta(Queuecds.Delta, 'select * from stat_queue where process_count = 0 and queue_type = "VISIT" order by queue_date_time');
/////////////////////////////////////////////////////////////////// ipttrana
repeat
QueueCDS.data := HOSxP_GetDataset('select * from stat_queue where process_count = 0 and queue_type = "ADMIT" order by queue_date_time');
while not QueueCDS.Eof do
begin
LastErr := '';
sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\IPD;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
ado_connection.connected := false;
ado_connection.connectionstring := sconnection;
ado_connection.connected := true;
tc.data := HOSxP_GetDataset('select * from an_stat where vn = "' + QueueCDS.fieldbyname('id').asstring + '"');
if tc.recordcount > 0 then
begin
LastErr := '';
StatusMemo.Lines.add('===== New admit =====');
AddLog('Edit admin class ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update patient1 set class = "' + vartostr(tc['pttype']) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
//check insurelog
sconnection := 'Provider=VFPOLEDB.1;Data Source=' + StatPath + '\CREDIT\DATA;Mode=Share Deny None;Extended Properties="";User ID="";Password="";Mask Password=False;Cache Authentication=False;Encrypt Password=False;Collating Sequence=THAI;DSN=""';
ado_connection.connected := false;
ado_connection.connectionstring := sconnection;
ado_connection.connected := true;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then
begin
LastErr := '';
AddLog('Insert insurlog ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('insert into insurlog (hn,subtype,inscl,cid,hospmain,hospsub,name,datein,dateexp,notedate,note,recordby,verifyby) values ("' +
tc['hn'] + '","' +
vartostr(tc['pcode']) + '", "' +
tc.fieldbyname('pttype').asstring + '" ,"' +
tc.fieldbyname('pttypeno').asstring + '" ,"' +
tc.fieldbyname('hospmain').asstring + '" ,"' +
tc.fieldbyname('hospsub').asstring + '" ,"' +
vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '", ' +
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') , '+
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') , '+
' Date(' + formatdatetime('yyyy', date) + ',' +
formatdatetime('m', date) + ',' +
formatdatetime('d', date) + ') ,'+
' " " ,'+ // note
' "HOSxP" , '+ // recordby
' "HOSxP" '+ // verifyby
' )');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
statcds.data := HOSxP_GetADODataset('select count(*) as cc from insurlog where hn = "' + tc.fieldbyname('hn').asstring + '"');
if statcds.fieldbyname('cc').asinteger = 0 then ErrMemo.lines.add('Stat insurlog Insert Fail !!!');
end else
begin
LastErr := '';
AddLog('Edit insurlog ' + tc.fieldbyname('hn').asstring);
try
HOSxP_GetADODataset('update insurlog set subtype = "' + vartostr(tc['pcode']) + '" ,' +
'inscl = "' + vartostr(tc['pttype']) + '" , ' +
'cid = "' + vartostr(tc['pttypeno']) + '", ' +
'hospmain = "' + vartostr(tc['hospmain']) + '", ' +
'hospsub = "' + vartostr(tc['hospsub']) + '" ,' +
'name = "' + vartostr(getsqldata('select concat(fname," ",lname,",",pname) as name from patient where hn="'+tc.fieldbyname('hn').asstring+'"')) + '" ' +
' where hn = "' + vartostr(tc['hn']) + '" ');
except
on e: exception do
begin
LastErr := E.message;
end;
end;
CheckErr;
end;
end;
// if Pos('CommandText', LastErr) > 0 then
// begin
QueueCDS.edit;
QueueCDS.fieldbyname('process_count').asinteger := QueueCDS.fieldbyname('process_count').asinteger + 1;
if Pos('CommandText', LastErr) > 0 then QueueCDS.fieldbyname('error').asinteger:= QueueCDS.fieldbyname('error').asinteger+1;
QueueCDs.post;
QueueCDS.next;
//end;
end;
if QueueCDs.ChangeCount > 0 then
HOSxP_updateDelta(Queuecds.Delta, 'select * from stat_queue where process_count = 0 and queue_type = "VISIT" order by queue_date_time');
until ((QueueCDS.RecordCount = 0) or FAbort);
/////////////////////////////////////////////////////////////////////////
until ((QueueCDS.RecordCount = 0) or FAbort);
ado_connection.connected := false;
tc.free;
queuecds.free;
statcds.free;
// StatusMemo.lines.add('Patient Export Done.');
if StatusMemo.lines.count > 1000 then Statusmemo.lines.clear;
end;
procedure StartButtonClick(Sender: TObject);
var Tk: LongInt;
begin
StartButton.enabled := false;
AbortButton.enabled:=true;
FAbort := false;
while not FAbort do
begin
StatusLabel.caption:=formatdatetime('dd/mm/ee hh:nn:ss',now);
StartExport;
tk := GetTickCount;
repeat
application.processmessages;
until ((GetTickCount - Tk) > 3000);
end;
startButton.enabled := true;
end;
procedure AbortButtonClick(Sender: TObject);
begin
FAbort := true;
AbortButton.enabled:=false;
end;
procedure Main;
begin
MainForm := TForm.Create(nil);
MainForm.top := 200;
MainForm.left := 200;
MainForm.Width := 750;
MainForm.Height := 400;
StartButton := TButton.Create(MainForm);
StartButton.parent := mainForm;
startButton.left := 30;
StartButton.top := 20;
StartButton.Width := 100;
StartButton.caption := 'Start';
StartButton.OnClick := StartButtonClick;
AbortButton := TButton.Create(MainForm);
AbortButton.parent := mainForm;
AbortButton.left := 140;
AbortButton.top := 20;
AbortButton.Width := 100;
AbortButton.caption := 'Abort';
AbortButton.OnClick := AbortButtonClick;
AbortButton.enabled:=false;
StatusMemo := TMemo.create(MainForm);
StatusMemo.parent := MainForm;
StatusMemo.left := 30;
Statusmemo.top := 50;
Statusmemo.width := 300;
StatusMemo.height := 300;
ErrMemo := TMemo.create(MainForm);
ErrMemo.parent := MainForm;
ErrMemo.left:=350;
ErrMemo.top:=50;
ErrMemo.width := 300;
ErrMemo.Height := 300;
StatusLabel := TLabel.create(Mainform);
STatusLabel.parent:=Mainform;
StatusLabel.left:=280;
StatusLabel.top := 20;
StatusLabel.caption:='Status';
MainForm.Caption := 'Stat Exchange version 0.1';
MainForm.Showmodal;
MainForm.free;
end;
end.
end.
หัวข้อ: ฝากให้พี่กำพลครับ (อ่าน 3959 ครั้ง)