Unit Script;
const
dbf_path = 'd:\statwin\';
HoursPerDay = 24;
MinsPerHour = 60;
SecsPerMin = 60;
MSecsPerSec = 1000;
MinsPerDay = HoursPerDay * MinsPerHour;
SecsPerDay = MinsPerDay * SecsPerMin;
MSecsPerDay = SecsPerDay * MSecsPerSec;
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
MSecs: Integer): TDateTime;
begin
Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
if Result < 0 then
Result := Result + 1;
end;
function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, Delta, 0, 0, 0);
end;
function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, 0, Delta, 0, 0);
end;
function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, 0, 0, Delta, 0);
end;
function addzero(s:string;i:integer):string;
begin
//result:=s;
while length(s)<i do
begin
s:='0'+s;
end;
result:=s;
end;
function CheckPID(pid: string): boolean;
var
i: integer;
nMod, nValue, cv: integer;
snmod: string;
begin
pid := replacestr(pid, '-', '');
result := false;
if length(replacestr(pid, ' ', '')) <> 13 then
exit;
try
cv := strtoint(copy(pid, 1, 1));
nValue := cv * 13;
for i := 2 to 12 do
begin
cv := strtoint(copy(pid, i, 1));
nValue := nValue + (cv * (14 - i));
end;
nMod := 11 - (nValue mod 11);
snmod := inttostr(nmod);
snmod := copy(snmod, length(snmod), 1);
result := copy(pid, 13, 1) = snmod;
except
result := false;
end;
end;
function MakeFullCID(cid: string): string;
begin
result := cid;
if length(cid) = 17 then
exit;
result := '';
if length(cid) <> 13 then
exit;
result := copy(cid, 1, 1) + '-' +
copy(cid, 2, 4) + '-' +
copy(cid, 6, 5) + '-' +
copy(cid, 11, 2) + '-' +
copy(cid, 13, 1);
end;
Procedure DoImportPatient;
var
i:integer;
card_tablename:string;
ic,ip:integer;
fhn:string;
cid:string;
begin
dbf1.close;
dbf1.tablename:=dbf_path+'data\opd\mainrec.dbf';
dbf1.open;
setstatuslabel('Importing... opd patient data');
setcursorbusy(true);
dbf1.first;
i:=0;
while not dbf1.eof do
begin
i:=i+1;
dbf1.next;
end;
setprogressbar(0,i);
fcds.close;
fcds.datarequest('select * from patient');
fcds.open;
fcds3.close;
fcds3.datarequest('select * from ptcardno');
fcds3.open;
dbf1.first;
ic:=0;
ip:=0;
DisableReconcileDialog;
while not dbf1.eof do
begin
ip:=ip+1;
setprogressbar(ip,i);
//fhn:=addzero(dbf1.fieldbyname('hn').asstring,7);
fhn:=dbf1.fieldbyname('hn').asstring;
ic:=ic+1;
if (ic mod 25)=0 then
setstatuslabel('Processing ... '+inttostr(ic)+'/'+inttostr(i));
fcds.insert;
fcds.fieldbyname('hos_guid').asstring:=get_new_guid;
fcds.fieldbyname('hn').asstring:=fhn;
fcds.fieldbyname('pname').asstring:=dbf1.fieldbyname('status').asstrin g;
fcds.fieldbyname('fname').asstring:=dbf1.fieldbyname('fname').asstring ;
fcds.fieldbyname('lname').asstring:=dbf1.fieldbyname('lname').asstring ;
try fcds.fieldbyname('birthday').asdatetime:=dbf1.fieldbyname('dob').asdat etime; except end;
fcds.fieldbyname('sex').asstring:=dbf1.fieldbyname('sex').asstring;
fcds.fieldbyname('marrystatus').asstring:=dbf1.fieldbyname('marriage') .asstring;
fcds.fieldbyname('addrpart').asstring:=dbf1.fieldbyname('address').ass tring;
fcds.fieldbyname('node_id').asstring:='';
fcds.fieldbyname('road').asstring:=dbf1.fieldbyname('road').asstring;
fcds.fieldbyname('moopart').asstring:=dbf1.fieldbyname('village').asst ring;
fcds.fieldbyname('chwpart').asstring:=dbf1.fieldbyname('changwat').ass tring;
fcds.fieldbyname('amppart').asstring:=dbf1.fieldbyname('amphur').asstr ing;
fcds.fieldbyname('tmbpart').asstring:=dbf1.fieldbyname('tambon').asstr ing;
fcds.fieldbyname('po_code').asstring:=dbf1.fieldbyname('zipcode').asst ring;
fcds.fieldbyname('hometel').asstring:=dbf1.fieldbyname('phone').asstri ng;
fcds.fieldbyname('religion').asstring:='01';
fcds.fieldbyname('occupation').asstring:=dbf1.fieldbyname('occupa').as string;
fcds.fieldbyname('nationality').asstring:=dbf1.fieldbyname('nation').a sstring;
fcds.fieldbyname('citizenship').asstring:=dbf1.fieldbyname('nation').a sstring;
//fcds.fieldbyname('bloodgrp').asstring:=dbf1.fieldbyname('bl_gr').ass tring;
//fcds.fieldbyname('drugallergy').asstring:=dbf1.fieldbyname('dallergy ').asstring;
cid:='';
if checkpid(dbf1.fieldbyname('person_id').asstring) then
cid:=dbf1.fieldbyname('person_id').asstring;
if cid<>'' then
begin
fcds.fieldbyname('cid').asstring:=cid;
fcds3.insert;
fcds3.fieldbyname('hn').asstring:=fhn;
fcds3.fieldbyname('cardtype').asstring:='01';
fcds3.fieldbyname('cardno').asstring:=MakeFullCID(cid);
fcds3.post;
end;
fcds.post;
if (ip mod 50)=0 then
begin
fcds.datarequest('select * from patient limit 0');
applyupdate_fcds;
fcds3.datarequest('select * from ptcardno limit 0');
applyupdate_fcds3;
end;
dbf1.next;
end;
fcds.datarequest('select * from patient limit 0');
applyupdate_fcds;
fcds3.datarequest('select * from ptcardno limit 0');
applyupdate_fcds3;
fcds3.close;
fcds.close;
dbf1.close;
setcursorbusy(false);
end;
Procedure Main;
begin
if messagedlg('Please confirm import'+#13+'patient and ptcardno data will be delete '+#13+
'Current statwin data path = '+dbf_path,mtconfirmation,[mbyes,mbno],0)=mryes then
begin
DoImportPatient;
end;
end;
end.
หัวข้อ: ตัวอย่าง DBF -> patient import script (อ่าน 3643 ครั้ง)