ตัวอย่าง scipt รวมมาไว้ทีเดี่ยวกันจะได้หาง่ายๆๆ

[doramon]

โค๊ด: Delphi

1.  
2. Unit AccessImport;
3.  
4. // example script for import data from access database
5. // this script use WelfareUC2 database as sample file
6. // version 0.1
7. // 2005-07-11
8. // Chaiyaporn Suratemekul
9.  
10. procedure Main;
11. var
12.   sconnection:string;      // variable for hold connection string
13.   st:string;               // variable for hold any string
14.  
15. begin
16.   sconnection:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;'+
17.   'Data Source=G:\WelfareUC2\UCDB.mdb;'+    // change access filename here
18.   'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";'+
19.   'Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;'+
20.   'Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;'+
21.   'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";'+
22.   'Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;'+
23.   'Jet OLEDB:Don''t Copy Locale on Compact=False;'+
24.   'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False ';
25.  
26.  
27.   // jconnection is remote database connection
28.   // you can set jconnection to connected any database
29.  
30.   jconnection.connected:=false;
31.   jconnection.protocol:='ado';
32.   jconnection.database:=sconnection;
33.  
34.   jconnection.connected:=true;
35.  
36.  
37.   // jquery is remote dataset object
38.   // use jquery to get remote data
39.  
40.   jquery.close;
41.  
42.   // set sql statement
43.   // select sample data from table ucdata just 10 records
44.   jquery.sql.text:='select top 10 * from ucdata';
45.  
46.   // open dataset
47.   jquery.open;
48.  
49.  
50.   // zquery is dataset point to current database (hosxp database)
51.   // this example try to erase old data from table tempreport
52.   // table tempreport use to t store temporary report data
53.   // but can use to hold any temp data too
54.  
55.   zquery.close;
56.   // delete all data from tempreport
57.   zquery.sql.text:='delete from tempreport';
58.   zquery.execsql;
59.   zquery.close;
60.   // open table tempreport
61.   zquery.sql.text:='select * from tempreport';
62.   zquery.open;
63.  
64.  
65.   // loop dataset until end of file (first to last record)
66.   // when open dataset record pointer is at first record by default
67.   while not jquery.eof do
68.   begin
69.     // prepare to insert data to temptable
70.     zquery.insert;
71.  
72.     zquery.fieldbyname('id').asstring:=jquery.fieldbyname('pid').asstring;
73.  
74.     // insert data from access field fname + lname to table tempreport field name
75.     zquery.fieldbyname('name').asstring:=
76.        jquery.fieldbyname('fname').asstring+' '+jquery.fieldbyname('lname').asstring;
77.  
78.     zquery.fieldbyname('name1').asstring:=jquery.fieldbyname('sex').asstring;
79.  
80.  
81.     // now commit change to database
82.     zquery.post;
83.  
84.  
85.     jquery.next;
86.   end;
87.  
88.   jquery.close;
89.   zquery.close;
90.  
91.   showmessage('Import OK');
92.  
93.   // ok now open table tempreport to see what happen
94.  
95. end;
96.  
97.  
98. end.
99.  
100.  

[doramon]

โค๊ด: Delphi

1.  
2. var
3.   Excel : Variant;
4.   Workbook : Variant;
5.   Worksheet : Variant;
6.   Cells : Variant;
7.   Item : Variant;
8.   X, Y : Integer;
9.   row_count : Integer;
10.   cell_data : string;
11.   hn_int:integer;
12.   fhn : string;
13.   fpname,ffname,flname,fsex : string;
14.   age_y:integer;
15.   fbirthday:tdatetime;
16.   fnation,fcitizen : string;
17.   femployer : string;
18.   finformaddr:string;
19.   ffirstday: tdatetime;
20.   fcardno:string;
21.   fdatapath:string;
22.  
23. begin
24.  
25.   fdatapath:='c:\temp\excel.xls';
26.  
27.   showmessage('Excel import data BPK9  version 0.1'+#13+
28.   'Data path = '+fdatapath);
29.   if messagedlg('Please confirm import , old data (same hn) will be replace ?',
30.      mtconfirmation,[mbyes,mbno],0)<>mryes then exit;
31.  
32.   Excel := CreateOleObject('Excel.Application');
33.   try
34.     Workbook := Excel.Workbooks.open(fdatapath);
35.     Cells := Excel.Cells;
36.     x:=1;
37.     y:=1;
38.     row_count:=0;
39.     repeat
40.       cell_data := cells.item(y,x);
41.       row_count:=row_count+1;
42.       y:=y+1;
43.     until cell_data='';
44.  
45.     Item := Cells.Item(2,2); // row, col
46.  
47.     //showmessage(formatdatetime('yyyy-mm-dd',item));
48.  
49.     row_count:=row_count-1;
50.  
51.     showmessage('row count = '+inttostr(row_count));
52.  
53.     for x:=2 to row_count do
54.     begin
55.       fhn:=cells.item(x,1);  // HN in column number 1
56.  
57.       SetStatusLabel('Processing HN '+fhn);
58.       SetProgressBar(x,row_count);
59.       try
60.         hn_int := strtoint(fhn);
61.       except
62.         hn_int :=0;
63.       end;
64.  
65.       if length(fhn)=7 then
66.       if hn_int > 0 then    // valid hn code
67.       begin
68.         fpname:=cells.item(x,4);
69.         ffname:=cells.item(x,5);
70.         flname:=cells.item(x,6);
71.         if flname='' then flname:='--';
72.         fsex:= cells.item(x,8);
73.         if fsex='&ordf;&Ograve;&Acirc;' then fsex:='1' else fsex:='2';
74.         try
75.          age_y:=cells.item(x,7);
76.         except
77.           age_y:=1;
78.         end;
79.  
80.         fcardno:=cells.item(x,3);
81.  
82.         fbirthday:=incyear(date,0-age_y);
83.  
84.         try ffirstday :=  cells.item(x,2);
85.  
86.         except end;
87.  
88.         fcitizen := cells.item(x,11);
89.  
90.         if fcitizen='&frac34;&Aacute;&egrave;&Ograve;' then fcitizen := '48' else
91.         if fcitizen='&Aring;&Ograve;&Ccedil;' then fcitizen := '56' else
92.         if fcitizen='&iexcl;&Ntilde;&Aacute;&frac34;&Ugrave;&ordf;&Ograve;' then fcitizen := '57'  else
93.            fcitizen:='99';
94.  
95.         fnation := cells.item(x,12);
96.  
97.         if fnation='&frac34;&Aacute;&egrave;&Ograve;' then fnation := '48' else
98.         if fnation='&Aring;&Ograve;&Ccedil;' then fnation := '56' else
99.         if fnation='&iexcl;&Ntilde;&Aacute;&frac34;&Ugrave;&ordf;&Ograve;' then fnation := '57'  else
100.            fnation:='99';
101.  
102.         femployer := cells.item(x,13);
103.  
104.         finformaddr := cells.item(x,14);
105.  
106.  
107.  
108.  
109.         fcds.close;
110.         fcds.datarequest('select * from patient where hn="'+fhn+'"');
111.         fcds.open;
112.         if fcds.recordcount=0 then fcds.insert else fcds.edit;
113.         if fcds.fieldbyname('hos_guid').asstring='' then
114.            fcds.fieldbyname('hos_guid').asstring:=get_new_guid;
115.         fcds.fieldbyname('hn').asstring:=fhn;
116.         fcds.fieldbyname('pname').asstring:=fpname;
117.         fcds.fieldbyname('fname').asstring:=ffname;
118.         fcds.fieldbyname('lname').asstring:=flname;
119.         fcds.fieldbyname('sex').asstring:=fsex;
120.         try fcds.fieldbyname('birthday').asdatetime:=fbirthday; except end;
121.         try fcds.fieldbyname('firstday').asdatetime:=ffirstday; except end;
122.         fcds.fieldbyname('informaddr').asstring:=finformaddr;
123.  
124.         fcds.fieldbyname('nationality').asstring:=fnation;
125.         fcds.fieldbyname('citizenship').asstring:=fcitizen;
126.  
127.         fcds.post;
128.         fcds.datarequest('select * from patient where hn="'+fhn+'"');
129.         applyupdate_fcds;
130.  
131.         fcds.close;
132.  
133.         fcds.datarequest('select * from ptcardno where hn="'+fhn+'" and cardtype="02" ');
134.         fcds.open;
135.         if fcds.recordcount=0 then fcds.insert else fcds.edit;
136.         fcds.fieldbyname('hn').asstring:=fhn;
137.         fcds.fieldbyname('cardtype').asstring:='02';
138.         fcds.fieldbyname('cardno').asstring:=fcardno;
139.         fcds.post;
140.         fcds.datarequest('select * from ptcardno where hn="'+fhn+'" and cardtype="02" ');
141.         applyupdate_fcds;
142.         fcds.close;
143.  
144.         fcds.datarequest('select * from patient_employer where hn="'+fhn+'"');
145.         fcds.open;
146.         if fcds.recordcount=0 then fcds.insert else fcds.edit;
147.         fcds.fieldbyname('hn').asstring:=fhn;
148.         fcds.fieldbyname('employer_name').asstring:= femployer;
149.         fcds.post;
150.         fcds.datarequest('select * from patient_employer where hn="'+fhn+'"');
151.         applyupdate_fcds;
152.         fcds.close;
153.  
154.  
155.       end;
156.  
157.       application.processmessages;
158.  
159.     end;
160.  
161.  
162.   finally
163.  
164.     Excel.Quit;
165.   end;
166.  
167.   showmessage('Import Done.');
168.  
169. end;
170.  
171.  

[doramon]

โค๊ด: Delphi

1. unit MyIPDReport;
2.  
3. function getsqlsubquerydatax(sql:string):string;
4. begin
5.   result:='';
6.   zquery.close;
7.   zquery.sql.text:=sql;
8.   zquery.open;
9.   zquery.first;
10.     while not zquery.eof do
11.     begin
12.        if result='' then result:=''''+zquery.fields[0].asstring+'''' else
13.        result:=result+','''+zquery.fields[0].asstring+'''';
14.  
15.        zquery.next;
16.     end;
17.   zquery.close;
18.     if result='' then result:='''''';
19.  
20. end;
21.  
22. procedure main;
23. var d1,d2:tdatetime;
24. people_distinct_count1 : integer;
25. people_count1 : integer;
26. ds1,ds2:string;
27. pttype_list1 : string;
28. pttype,pttype_name:string;
29. hospcode_list:string;
30. money1:currency;
31. i:integer;
32.  
33. begin
34.    showmessage('เกี่ยวกับรายงาน'+#13+'Custom OPD-NK2');
35.  
36.    pttype:= getpickuplist('select name from pttype where isuse="Y" order by name');
37.    if pttype='' then exit;
38.  
39.    pttype_name:=pttype;
40.  
41.    pttype:=getsqldata('select pcode from pttype where name="'+pttype+'"');
42.    if pttype='UA' then pttype:='UC';
43.    if pttype='UB' then pttype:='UC';
44.  
45.    if pttype='UC' then pttype_name:=getsqlsubquerydata('select name from pttype where pcode in ("UC","UA","UB")') else
46.     pttype_name := getsqlsubquerydata('select name from pttype where pcode="'+pttype+'"');
47.  
48.    showmessage('use pcode = '+pttype);
49.  
50.    if not getdaterange() then exit;
51.    d1:=date_result1();
52.    d2:=date_result2();
53.  
54.   // showmessage(formatdatetime('yyyy-mm-dd',d1)+' - '+
55.    //  formatdatetime('yyyy-mm-dd',d2));
56.  
57.    ds1:=formatdatetime('yyyy-mm-dd',d1);
58.    ds2:=formatdatetime('yyyy-mm-dd',d2);
59.  
60.  
61.    hospcode_list:=getsqlsubquerydata('select distinct hospmain from vn_stat where pcode = "'+pttype+'" and vstdate between "'+ds1+'" and "'+ds2+'" ');
62.    hospcode_list := getpickuplist('select concat(hospcode,":",hosptype," ",name) as name from hospcode where hospcode in ('+
63.      hospcode_list+') ');
64.  
65.    zquery.sql.text:='delete from tempreport where id = "CUSTOM-NK1OPD" ';
66.    zquery.execsql;
67.    fcds.close;
68.    fcds.datarequest('select * from tempreport where id = "CUSTOM-NK1OPD" ');
69.    fcds.open;
70.  
71.    fcds2.close;
72.    if hospcode_list='' then
73.    fcds2.datarequest('select * from vn_stat where pcode = "'+pttype+'" and vstdate between "'+ds1+'" and "'+ds2+'" order by vn ')
74.    else
75.    fcds2.datarequest('select * from vn_stat where pcode = "'+pttype+'" and vstdate between "'+ds1+'" and "'+ds2+'" '+
76.    ' and hospmain="'+copy(hospcode_list,1,5)+'" order by vn ');
77.    fcds2.open;
78.    setstatuslabel('Open result : '+inttostr(fcds2.recordcount)+' Records');
79.    fcds2.first;
80.    i:=0;
81.    while not fcds2.eof do
82.    begin
83.     i:=i+1;
84.     setprogressbar(i,fcds2.recordcount);
85.      fcds.insert;
86.    fcds['id']:='CUSTOM-NK1OPD';
87.    fcds['reportname']:='CUSTOM-NK1OPD';
88.   // fcds['name']:=fcds2['vn'];
89.    fcds['name1']:=pttype_name;
90.  
91.    fcds['name2']:=getsqldata('select concat(pname,fname,"  ",lname) as name from patient where hn="'+
92.       fcds2['hn']+'"');
93.    fcds['name3']:=fcds2['hn'];
94.    fcds['name4']:=fcds2['pttypeno'];
95.    fcds['date3']:=fcds2['pttype_expire'];
96.    fcds['name5']:=getsqldata('select concat(name,", ",hosptype) as name from hospcode where hospcode="'+
97.      fcds2['hospmain']+'"');
98.    fcds['name6']:=fcds2['cid'];
99.    if fcds2['sex']='1' then
100.      fcds['name7']:='ช' else
101.      fcds['name7']:='ญ';
102.    fcds['num1']:=fcds2['age_y'];
103.    fcds['name8']:=fcds2['pdx']+' '+fcds2['dx0'];
104.    fcds['name9']:=fcds2['op0']+' '+fcds2['op1'];
105.    fcds['name']:=getsqldata('select i_refer_number from ovst where vn="'+fcds2['vn']+'"');
106.  
107.    // finance summary
108.  
109.    fcds['mon1']:=fcds2['inc01'];
110.    fcds['mon2']:=fcds2['inc04'];
111.    fcds['mon3']:=fcds2['inc05'];
112.    fcds['mon4']:=fcds2['inc06'];
113.    fcds['mon5']:=fcds2['inc07'];
114.    fcds['mon6']:=fcds2['inc09'];
115.    fcds['mon7']:=fcds2['inc10'];
116.    fcds['mon8']:=fcds2['inc04'];
117.    fcds['mon9']:=fcds2['inc12'];
118.    fcds['mon10']:=fcds2['inc13'];
119.    fcds['mon11']:=fcds2['inc02']+fcds2['inc03']+fcds2['inc08']+
120.                   fcds2['inc11']+fcds2['inc14']+fcds2['inc15']+
121.                   fcds2['inc16']+fcds2['inc17'];
122.    fcds['mon12']:=fcds2['income'];
123.  
124.    fcds['date1']:=d1;
125.    fcds['date2']:=d2;
126.    fcds['date4']:=fcds2['vstdate'];
127.    fcds.post;
128.      fcds2.next;
129.    end;
130.  
131.    fcds.datarequest('select * from tempreport where id = "CUSTOM-NK1OPD" ');
132.    applyupdate_fcds();
133.  
134. end;
135.  
136. end.
137.  
138.  

[doramon]

โค๊ด: Delphi

1. Unit Script;
2.  
3.  
4. function addzero(s:string;i:integer):string;
5. begin
6.   //result:=s;
7.   while length(s)<i do
8.   begin
9.     s:='0'+s;
10.   end;
11.   result:=s;
12. end;
13.  
14. function CheckPID(pid: string): boolean;
15. var
16.   i: integer;
17.   nMod, nValue, cv: integer;
18.   snmod: string;
19. begin
20.   pid := replacestr(pid, '-', '');
21.   result := false;
22.   if length(replacestr(pid, ' ', '')) <> 13 then
23.     exit;
24.  
25.   try
26.  
27.     cv := strtoint(copy(pid, 1, 1));
28.     nValue := cv * 13;
29.  
30.     for i := 2 to 12 do
31.     begin
32.       cv := strtoint(copy(pid, i, 1));
33.       nValue := nValue + (cv * (14 - i));
34.  
35.     end;
36.  
37.     nMod := 11 - (nValue mod 11);
38.     snmod := inttostr(nmod);
39.     snmod := copy(snmod, length(snmod), 1);
40.     result := copy(pid, 13, 1) = snmod;
41.  
42.   except
43.     result := false;
44.  
45.   end;
46.  
47. end;
48.  
49. function MakeFullCID(cid: string): string;
50. begin
51.   result := cid;
52.   if length(cid) = 17 then
53.     exit;
54.   result := '';
55.   if length(cid) <> 13 then
56.     exit;
57.   result := copy(cid, 1, 1) + '-' +
58.     copy(cid, 2, 4) + '-' +
59.     copy(cid, 6, 5) + '-' +
60.     copy(cid, 11, 2) + '-' +
61.     copy(cid, 13, 1);
62. end;
63.  
64.  
65.  
66. Procedure Main;
67. var
68.   i:integer;
69.   dbf:TDBF;
70.   tc:tclientdataset;
71.   tcid:tclientdataset;
72. begin
73.  
74.   dbf:=tdbf.create(nil);
75.   dbf.tablename:='O:\CSCDMEM.DBF';
76.   dbf.open;
77.   dbf.first;
78.   tc:=tclientdataset.create(nil);
79.   tcid:=tclientdataset.create(nil);
80.   while not dbf.eof do
81.   begin
82.     tc.data:=HoSxP_GetDataset('select * from patient where hn = "'+dbf.fieldbyname('hn').asstring+'"');
83.     if tc.recordcount>0 then
84.     begin
85.       showdebugtext('Update patient : '+tc.fieldbyname('hn').asstring);
86.       tc.edit;
87.       tc.fieldbyname('gov_chronic_id').asstring:=dbf.fieldbyname('memberno').asstring;
88.       tc.fieldbyname('pttype').asstring:= '22';
89.       if checkpid(dbf.fieldbyname('cspid').asstring) then
90.       begin
91.         tc.fieldbyname('cid').asstring:=dbf.fieldbyname('cspid').asstring;
92.         tcid.data:=HOSxP_GetDataset('select * from ptcardno where hn="'+dbf.fieldbyname('hn').asstring+'" and cardtype="01"');
93.         if tcid.recordcount>0 then
94.         begin
95.           tcid.edit;
96.  
97.         end else
98.         begin
99.           tcid.insert;
100.         end;
101.  
102.         tcid.fieldbyname('hn').asstring:=dbf.fieldbyname('hn').asstring;
103.         tcid.fieldbyname('cardno').asstring:=makefullcid(dbf.fieldbyname('cspid').asstring);
104.         tcid.fieldbyname('cardtype').asstring:='01';
105.         tcid.post;
106.         if tcid.changecount>0 then
107.          HOSxP_UpdateDelta(tcid.delta, 'select * from ptcardno where hn="'+dbf.fieldbyname('hn').asstring+'" and cardtype="01"');
108.       end;
109.       tc.post;
110.  
111.       if tc.changecount>0 then
112.       HOSxP_UpdateDelta(tc.delta,'select * from patient where hn = "'+dbf.fieldbyname('hn').asstring+'"');
113.  
114.     end;
115.     dbf.next;
116.   end;
117.  
118.  
119.   dbf.free;
120.   tc.free;
121.   showmessage('done.');
122. end;
123.  
124.  
125.  
126.  
127.  
128. end.
129.  
130.  
131.  
132.  

[doramon]

โค๊ด: Pascal

1. Value := GetSQlStringData('select nextdate from oapp where hn ="'+ DBPipeline['HN']+'" '+
2.    ' and nextdate >= "'+formatdatetime('yyyy-mm-dd',currentdate)+'" order by nextdate limit 1');
3.  
4.  
5.  

[doramon]

โค๊ด: Delphi

1.  
2.  
3. Unit Script;
4.  
5. const
6.  
7.  
8.  
9.   dbf_path = 'd:\statwin\';
10.  
11.   HoursPerDay   = 24;
12.   MinsPerHour   = 60;
13.   SecsPerMin    = 60;
14.   MSecsPerSec   = 1000;
15.   MinsPerDay    = HoursPerDay * MinsPerHour;
16.   SecsPerDay    = MinsPerDay * SecsPerMin;
17.   MSecsPerDay   = SecsPerDay * MSecsPerSec;
18.  
19. function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
20.   MSecs: Integer): TDateTime;
21. begin
22.   Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
23.     Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
24.   if Result < 0 then
25.     Result := Result + 1;
26. end;
27.  
28. function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
29. begin
30.   Result := IncTime(ATime, Delta, 0, 0, 0);
31. end;
32.  
33. function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
34. begin
35.   Result := IncTime(ATime, 0, Delta, 0, 0);
36. end;
37.  
38. function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
39. begin
40.   Result := IncTime(ATime, 0, 0, Delta, 0);
41. end;
42.  
43.  
44. function addzero(s:string;i:integer):string;
45. begin
46.   //result:=s;
47.   while length(s)<i do
48.   begin
49.     s:='0'+s;
50.   end;
51.   result:=s;
52. end;
53.  
54. function CheckPID(pid: string): boolean;
55. var
56.   i: integer;
57.   nMod, nValue, cv: integer;
58.   snmod: string;
59. begin
60.   pid := replacestr(pid, '-', '');
61.   result := false;
62.   if length(replacestr(pid, ' ', '')) <> 13 then
63.     exit;
64.  
65.   try
66.  
67.     cv := strtoint(copy(pid, 1, 1));
68.     nValue := cv * 13;
69.  
70.     for i := 2 to 12 do
71.     begin
72.       cv := strtoint(copy(pid, i, 1));
73.       nValue := nValue + (cv * (14 - i));
74.  
75.     end;
76.  
77.     nMod := 11 - (nValue mod 11);
78.     snmod := inttostr(nmod);
79.     snmod := copy(snmod, length(snmod), 1);
80.     result := copy(pid, 13, 1) = snmod;
81.  
82.   except
83.     result := false;
84.  
85.   end;
86.  
87. end;
88.  
89. function MakeFullCID(cid: string): string;
90. begin
91.   result := cid;
92.   if length(cid) = 17 then
93.     exit;
94.   result := '';
95.   if length(cid) <> 13 then
96.     exit;
97.   result := copy(cid, 1, 1) + '-' +
98.     copy(cid, 2, 4) + '-' +
99.     copy(cid, 6, 5) + '-' +
100.     copy(cid, 11, 2) + '-' +
101.     copy(cid, 13, 1);
102. end;
103.  
104.  
105.  
106.  
107.  
108. Procedure DoImportPatient;
109. var
110.   i:integer;
111.   card_tablename:string;
112.   ic,ip:integer;
113.  
114.   fhn:string;
115.   cid:string;
116. begin
117.  
118.  
119.  
120.   dbf1.close;
121.   dbf1.tablename:=dbf_path+'data\opd\mainrec.dbf';
122.   dbf1.open;
123.  
124.  
125.  
126.   setstatuslabel('Importing... opd patient data');
127.  
128.   setcursorbusy(true);
129.  
130.   dbf1.first;
131.   i:=0;
132.   while not dbf1.eof do
133.   begin
134.     i:=i+1;
135.     dbf1.next;
136.   end;
137.  
138.   setprogressbar(0,i);
139.  
140.   fcds.datarequest('EXEC delete from patient');
141.   fcds.datarequest('EXEC delete from ptcardno');
142.   fcds.close;
143.   fcds.datarequest('select * from patient');
144.   fcds.open;
145.  
146.   fcds3.close;
147.   fcds3.datarequest('select * from ptcardno');
148.   fcds3.open;
149.  
150.   dbf1.first;
151.   ic:=0;
152.   ip:=0;
153.  
154.   DisableReconcileDialog;
155.  
156.   while not dbf1.eof do
157.   begin
158.     ip:=ip+1;
159.     setprogressbar(ip,i);
160.  
161.     //fhn:=addzero(dbf1.fieldbyname('hn').asstring,7);
162.     fhn:=dbf1.fieldbyname('hn').asstring;
163.     ic:=ic+1;
164.     if (ic mod 25)=0 then
165.     setstatuslabel('Processing ... '+inttostr(ic)+'/'+inttostr(i));
166.  
167.     fcds.insert;
168.     fcds.fieldbyname('hos_guid').asstring:=get_new_guid;
169.     fcds.fieldbyname('hn').asstring:=fhn;
170.     fcds.fieldbyname('pname').asstring:=dbf1.fieldbyname('status').asstrin g;
171.     fcds.fieldbyname('fname').asstring:=dbf1.fieldbyname('fname').asstring  ;
172.     fcds.fieldbyname('lname').asstring:=dbf1.fieldbyname('lname').asstring  ;
173.     try fcds.fieldbyname('birthday').asdatetime:=dbf1.fieldbyname('dob').asdat etime; except end;
174.     fcds.fieldbyname('sex').asstring:=dbf1.fieldbyname('sex').asstring;
175.     fcds.fieldbyname('marrystatus').asstring:=dbf1.fieldbyname('marriage') .asstring;
176.     fcds.fieldbyname('addrpart').asstring:=dbf1.fieldbyname('address').ass tring;
177.     fcds.fieldbyname('node_id').asstring:='';
178.     fcds.fieldbyname('road').asstring:=dbf1.fieldbyname('road').asstring;
179.     fcds.fieldbyname('moopart').asstring:=dbf1.fieldbyname('village').asst ring;
180.     fcds.fieldbyname('chwpart').asstring:=dbf1.fieldbyname('changwat').ass tring;
181.     fcds.fieldbyname('amppart').asstring:=dbf1.fieldbyname('amphur').asstr ing;
182.     fcds.fieldbyname('tmbpart').asstring:=dbf1.fieldbyname('tambon').asstr ing;
183.     fcds.fieldbyname('po_code').asstring:=dbf1.fieldbyname('zipcode').asst ring;
184.     fcds.fieldbyname('hometel').asstring:=dbf1.fieldbyname('phone').asstri ng;
185.     fcds.fieldbyname('religion').asstring:='01';
186.     fcds.fieldbyname('occupation').asstring:=dbf1.fieldbyname('occupa').as string;
187.     fcds.fieldbyname('nationality').asstring:=dbf1.fieldbyname('nation').a sstring;
188.     fcds.fieldbyname('citizenship').asstring:=dbf1.fieldbyname('nation').a sstring;
189.     //fcds.fieldbyname('bloodgrp').asstring:=dbf1.fieldbyname('bl_gr').ass tring;
190.     //fcds.fieldbyname('drugallergy').asstring:=dbf1.fieldbyname('dallergy ').asstring;
191.  
192.     cid:='';
193.  
194.     if checkpid(dbf1.fieldbyname('person_id').asstring) then
195.        cid:=dbf1.fieldbyname('person_id').asstring;
196.  
197.     if cid<>'' then
198.     begin
199.  
200.       fcds.fieldbyname('cid').asstring:=cid;
201.  
202.       fcds3.insert;
203.       fcds3.fieldbyname('hn').asstring:=fhn;
204.       fcds3.fieldbyname('cardtype').asstring:='01';
205.       fcds3.fieldbyname('cardno').asstring:=MakeFullCID(cid);
206.       fcds3.post;
207.     end;
208.  
209.  
210.  
211.     fcds.post;
212.  
213.  
214.    if (ip mod 50)=0 then
215.    begin
216.      fcds.datarequest('select * from patient limit 0');
217.      applyupdate_fcds;
218.  
219.      fcds3.datarequest('select * from ptcardno limit 0');
220.      applyupdate_fcds3;
221.  
222.    end;
223.  
224.    dbf1.next;
225.   end;
226.  
227.   fcds.datarequest('select * from patient limit 0');
228.   applyupdate_fcds;
229.  
230.   fcds3.datarequest('select * from ptcardno limit 0');
231.   applyupdate_fcds3;
232.   fcds3.close;
233.   fcds.close;
234.   dbf1.close;
235.  
236.   setcursorbusy(false);
237.  
238. end;
239.  
240.  
241. Procedure Main;
242. begin
243.  
244.  
245.  
246.  if messagedlg('Please confirm import'+#13+'patient and ptcardno data will be delete '+#13+
247.  'Current statwin data path = '+dbf_path,mtconfirmation,[mbyes,mbno],0)=mryes then
248.  begin
249.  
250.    DoImportPatient;
251.  
252. end;
253.  
254. end;
255.  
256. end.
257.  
258.  
259.  
260.  

[doramon]

doraemon_สำรองครับ

[doramon]

อีกอันเก็บไว้เดี่ยวหาไม่เจอ

[doramon]

วิธีนำเข้าข้อมูลที่เป็น excel    อันนี้นำเข้า icd10 จากไฟล์ excel

โค๊ด: Delphi

1.  
2. var
3.   Excel : Variant;
4.   Workbook : Variant;
5.   Worksheet : Variant;
6.   Cells : Variant;
7.   Item : Variant;
8.   X, Y : Integer;
9.   row_count : Integer;
10.   cell_data : string;
11.   hn_int:integer;
12.   fhn : string;
13.   fpname,ffname,flname,fsex : string;
14.   age_y:integer;
15.   fbirthday:tdatetime;
16.   fnation,fcitizen : string;
17.   femployer : string;
18.   finformaddr:string;
19.   ffirstday: tdatetime;
20.   fcardno:string;
21.   fdatapath:string;
22.  
23. begin
24.  
25.   fdatapath:='c:\icd101\map10v17-1.xls';
26.  
27.   showmessage('Excel import data BPK9  version 0.1'+#13+
28.   'Data path = '+fdatapath);
29.   if messagedlg('Please confirm import , old data (same hn) will be replace ?',
30.      mtconfirmation,[mbyes,mbno],0)<>mryes then exit;
31.  
32.   Excel := CreateOleObject('Excel.Application');
33.   try
34.     Workbook := Excel.Workbooks.open(fdatapath);
35.     Cells := Excel.Cells;
36.     x:=1;
37.     y:=1;
38.     row_count:=0;
39.     repeat
40.       cell_data := cells.item(y,x);
41.       row_count:=row_count+1;
42.       y:=y+1;
43.     until cell_data='';
44.  
45.     Item := Cells.Item(2,2); // row, col
46.  
47.     //showmessage(formatdatetime('yyyy-mm-dd',item));
48.  
49.     row_count:=row_count-1;
50.  
51.     showmessage('row count = '+inttostr(row_count));
52.  
53.     for x:=2 to row_count do
54.     begin
55.       fhn:=cells.item(x,1);  // HN in column number 1
56.       fpname:=cells.item(x,3);  // HN in column number 1
57.  
58.  
59.       SetStatusLabel('Processing HN '+fhn);
60.       SetProgressBar(x,row_count);
61.       try
62.         hn_int := strtoint(fhn);
63.       except
64.         hn_int :=0;
65.       end;
66.  
67.       if length(fhn) > 0 then
68.       begin
69.         fcds.close;
70.         fcds.datarequest('select * from icd101 where code="'+fhn+'"');
71.         fcds.open;
72.         SetStatusLabel('Processing HN '+fhn);
73.         if fcds.recordcount > 0 then
74.  
75.         begin
76.         fcds.edit;
77.         fcds.fieldbyname('name_W').asstring:=fpname;
78.         end else
79.         begin
80.         fcds.insert;
81.         fcds.fieldbyname('code').asstring:=fhn;
82.         fcds.fieldbyname('name').asstring:=fpname;
83.         fcds.fieldbyname('tname').asstring:='[chainat_add_icd101]';
84.         fcds.fieldbyname('name_W').asstring:=fpname;
85.         end;
86.  
87.         fcds.post;
88.  
89.  
90.         fcds.datarequest('select * from icd101 where code="'+fhn+'"');
91.         applyupdate_fcds;
92.       end;
93.  
94.       application.processmessages;
95.  
96.     end;
97.  
98.  
99.   finally
100.  
101.     Excel.Quit;
102.   end;
103.  
104.   showmessage('Import Done.');
105.  
106. end;
107.  
108.  
109.  

[วีระวัฒน์ (เอก)]

อ.อ๊อดช่วยแก้ไข script นำเข้าเบิกตรงด้วยนะครับ ที่ cid ไปแทนที่ ใน patient จะเอาข้อมูลในตาราง cscdmembers ฟิวด์ cspid (ของตัวข้าราชการ) ที่ถูกต้องเป็นฟิวด์ pid (ของตัวผู้ป่วยที่ตรงกันกับ cscdmembers.hn=patient.hn)

    tc.fieldbyname('cid').asstring:=dbf.fieldbyname('cspid').asstring;

[Bluebird]

อ.manoi ครับ มี Script เรียกใช้ OvstVaccineEditForm ไหมครับ 
เนื่องจาก บนหน้าจอซักประวัติของแพทย์ ยังไม่มีปุ่มการฉีด VACCINE
จะได้สร้างในปุ่มเรียกใช้ใน UE ไปก่อน ( ถ้า อ.manoi  สร้างปุ่ม VACCINE บนหน้าจอซักประวัติของแพทย์ เหมือนที่ ER ให้ก็จะดีมากเลยครับ )

ขอบคุณมากครับ

[doramon]

อ.อ๊อดช่วยแก้ไข script นำเข้าเบิกตรงด้วยนะครับ ที่ cid ไปแทนที่ ใน patient จะเอาข้อมูลในตาราง cscdmembers ฟิวด์ cspid (ของตัวข้าราชการ) ที่ถูกต้องเป็นฟิวด์ pid (ของตัวผู้ป่วยที่ตรงกันกับ cscdmembers.hn=patient.hn)

    tc.fieldbyname('cid').asstring:=dbf.fieldbyname('cspid').asstring;

ปรับแล้วครับ ที่ ฐาน รพ ผมครับ