Limit Appointment
- สามารถกำหนดวันที่เราต้องการนัดได้ เช่น จ. - ศ.
- สำมารถกำหนดคลินิคที่เราต้องการนัดได้
- สามารถเลือกเดือนที่ต้องการนัดได้
Source
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Spin, WideStrings, DB, SqlExpr,
DBXMySql, FMTBcd, XPMan, DBClient, DBXMsSQL,DateUtils,jvjclutils;
type
Tfrmmain = class(TForm)
Panel1: TPanel;
Label3: TLabel;
BtnOk: TButton;
BtnCancel: TButton;
Label4: TLabel;
Label6: TLabel;
CboClinic: TComboBox;
DTPStart: TDateTimePicker;
Label1: TLabel;
txttotalAppointment: TEdit;
GroupBox1: TGroupBox;
chkMon: TCheckBox;
chkTue: TCheckBox;
ChkThr: TCheckBox;
ChkWen: TCheckBox;
ChkFri: TCheckBox;
ChkSat: TCheckBox;
ChkSun: TCheckBox;
GroupBox2: TGroupBox;
cds: TClientDataSet;
ds: TDataSource;
procedure BtnCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnOkClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure BtnRefreshClick(Sender: TObject);
function GetListFromTable(sql:string):TStringList;
function UpdateLimit(StrDate:string):boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmmain: Tfrmmain;
implementation
{$R *.dfm}
procedure Tfrmmain.BtnCancelClick(Sender: TObject);
begin
// Show a confirmation dialog at 20,100
if MessageDlg('¤Ø³µéͧ¡ÒáàÅÔ¡¡ÒÃãªé§Ò¹ã¹Êèǹ¹ÕéãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrYes then close;
end;
procedure Tfrmmain.BtnOkClick(Sender: TObject);
Var
MyMonthID:string;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
MyIntMonth:integer;
MyDep:string;
MyDashPos:Integer;
MyLastDayCurrMon:string;
MyLastDayCurrMonth:word;
intStartLoop:integer;
CurrDateSet:tdatetime;
MyCurrDateSet:string;
MyCustomDate:string;
DaysInMonth: array[1..12]of Integer ;
tcd:tclientdataset;
strsql:string;
ChkDate:boolean;
BolShowDebug:boolean;
begin
if MessageDlg('¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅ¡ÒùѴËÁÒÂãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
begin
exit;
End;
ChkDate:=false;
if chkMon.State = cbchecked then
begin
ChkDate:=true;
end;
if chkTue.State = cbchecked then
begin
ChkDate:=true;
end;
if chkWen.state = cbchecked then
begin
ChkDate:=true;
end;
if ChkThr.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkFri.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkSat.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkSun.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkDate=false then
begin
MessageDlg('¡ÃسÒàÅ×Í¡ÇѹÍÂèÒ§¹éÍ 1 Çѹ ', mtWarning, [mbOK], 0) ;
exit;
end;
if CboClinic.Text='' then
MessageDlg('¡ÃسÒàÅ×Í¡¤ÅÔ¹Ô¤¡è͹', mtWarning, [mbOK], 0) ;
if txttotalAppointment.text= '' then
begin
MessageDlg('¡ÃسÒãÊè¨Ó¹Ç¹¤¹·Õèµéͧ¡Òáè͹', mtWarning, [mbOK], 0) ;
exit;
end;
if StrToInt(txttotalAppointment.text) <= 0 then
begin
MessageDlg('¨Ó¹Ç¹¤¹µéͧÁÒ¡¡ÇèÒ 1 ', mtWarning, [mbOK], 0) ;
exit;
end;
if ChkShowDBug.State = cbChecked then
begin
BolShowDebug:=true;
end;
if ChkShowDBug.State = cbUnChecked then
begin
BolShowDebug:=false;
end;
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
MyIntMonth:= StrToInt(MyMonthID);
MyDashPos:= Pos('-',CboClinic.Text);
MyDep:= Copy(CboClinic.Text,0,MyDashPos-1);
DaysInMonth[1]:=(31);
DaysInMonth[2]:=(28);
DaysInMonth[3]:=(31);
DaysInMonth[4]:=(30);
DaysInMonth[5]:=(31);
DaysInMonth[6]:=(30);
DaysInMonth[7]:=(31);
DaysInMonth[8]:=(31);
DaysInMonth[9]:=(30);
DaysInMonth[10]:=(31);
DaysInMonth[11]:=(30);
DaysInMonth[12]:=(31);
//MyLastDayCurrMonth:=DaysInMonth(DTPStart.Date);
MyLastDayCurrMonth:=DaysInMonth[MyIntMonth];
//ntStartLoop:= 1;
for intStartLoop:=1 to Integer(MyLastDayCurrMonth) do
begin
if Length(IntToStr(intStartLoop)) = 1 then
begin
MyCustomDate:= '0'+ IntToStr(intStartLoop) ;
end;
if Length(IntToStr(intStartLoop)) > 1 then
begin
MyCustomDate:= IntToStr(intStartLoop) ;
end;
CurrDateSet:=StrToDate(MyCustomDate+'/'+MyMonthID+'/'+MyTHyear);
MyCurrDateSet:= Inttostr(DayOfWeek(CurrDateSet));
// showdebugtext('MyCurrDateSet = '+MyCurrDateSet);
case StrToInt(MyCurrDateSet) of
2:
if chkMon.State = cbChecked then
begin
//MessageDlg(('Clinic '+ MyDep +' ¨Ñ¹·Ãì·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
end;
3:
if chkTue.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' Íѧ¤Ò÷Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
4:
if ChkWen.state = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ¾Ø¸·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
5:
if ChkThr.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ¾ÄËÑʺ´Õ·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
6:
if ChkFri.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ÈØ¡Ãì·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
7:
if ChkSat.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' àÊÒÃì·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
1:
if ChkSun.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ÍÒ·ÔµÂì·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
end;
end;
cds.data := hosxp_getdataset('select * from oapp_limit');
MessageDlg('Done', mtInformation, [mbOK], 0) ;
end;
procedure Tfrmmain.BtnRefreshClick(Sender: TObject);
var
MyMonthID:string;
MyIntMonth:integer;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
begin
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyIntMonth:= StrToInt(MyMonthID);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
cds.data := hosxp_getdataset('select * from oapp_limit where month(oapp_date) = "' +MyMonthID + '"' );
end;
procedure Tfrmmain.FormCreate(Sender: TObject);
var
MyMonthID:string;
MyIntMonth:integer;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
begin
DTPStart.Date := Now;
{ GetList from Hosxp }
CboClinic.items.assign(GetListFromTable('select concat(clinic,"-",name) from clinic order by clinic'));
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyIntMonth:= StrToInt(MyMonthID);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
cds.data := hosxp_getdataset('select * from oapp_limit where month(oapp_date) = "' +MyMonthID + '"' );
end;
procedure Tfrmmain.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key ='' then
begin
if MessageDlg('¤Ø³µéͧ¡ÒáàÅÔ¡¡ÒÃãªé§Ò¹ã¹Êèǹ¹ÕéãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrYes then close;
end;
end;
{ Pas addition Code }
function GetListFromTable(sql:string):TStringList;
var tc:tclientdataset;
begin
result:=TStringList.create;
tc:=tclientdataset.create(nil);
tc.data:=HOSxP_Getdataset(sql);
while not tc.eof do
begin
result.add(tc.fields[0].asstring);
tc.next;
end;
tc.free;
end;
function UpdateLimit(StrTHDate,StrENDate,StrClinic :string;IntLimit:integer;showDBug:boolean):boolean;
var tc,tc2:tclientdataset;NextSerialId:integer;
begin
result:=false;
tc:=tclientdataset.create(nil);
tc.data:=HOSxP_Getdataset('select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
if showDBug = true then
begin
showdebugtext('select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
end;
if tc.recordcount > 0 then
begin
tc.edit;
tc.fieldbyname('oapp_limit').asstring := IntLimit;
tc.post;
if tc.changecount > 0 then
begin
HOSxP_UpdateDelta(tc.delta,'select * from oapp_limit where oapp_date ="'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
if showDBug = true then
begin
showdebugtext('Found 1 Record : Update Field (limit) = '+IntLimit);
showdebugtext('Update Complete');
end;
end;
end;
if tc.recordcount = 0 then
begin
tc2:=tclientdataset.create(nil);
tc2.data:=HOSxP_Getdataset('select * from serial where name = "oapp_limit_id"');
if tc2.recordcount > 0 then
begin
NextSerialId := tc2.fieldbyname('serial_no').asstring+1;
//showdebugtext(NextSerialId);
tc2.edit;
tc2.fieldbyname('serial_no').asstring := NextSerialId;
tc2.post;
end;
tc.Insert;
tc.fieldbyname('oapp_limit_id').asstring := NextSerialId;
tc.fieldbyname('oapp_limit').asstring := IntLimit;
tc.fieldbyname('oapp_clinic').asstring := StrClinic;
tc.fieldbyname('oapp_date').asstring := StrToDate(StrENDate);
tc.post;
if tc.changecount > 0 then
HOSxP_UpdateDelta(tc.delta,'select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
HOSxP_UpdateDelta(tc2.delta,'select * from serial where name = "oapp_limit_id"');
if showDBug = true then
begin
showdebugtext('Record not found : Insert New Record');
showdebugtext('oapp_limit_id = '+InttoStr(NextSerialId));
showdebugtext('oapp_limit = '+IntLimit);
showdebugtext('oapp_clinic = '+StrClinic);
showdebugtext('oapp_date = '+StrENDate);
showdebugtext('Insert Complete');
end;
end;
tc.free;
result:=true;
end;
end.
DFM
object frmmain: Tfrmmain
Left = 0
Top = 0
BorderStyle = bsDialog
Caption = #3619#3632#3610#3610#3585#3635#3627#3609#3604#3592#3635#3609#3623#3609#3609#3633#3604#3627#3617#3634#3618#3626#3635#3627#3619#3633#3610#3588#3621#3636#3609#3636#3588#3605#3656#3634#3591#3654
ClientHeight = 536
ClientWidth = 416
Color = clCream
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 257
Top = 199
Width = 40
Height = 16
Caption = #3592#3635#3609#3623#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 345
Top = 199
Width = 18
Height = 16
Caption = #3588#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 27
Top = 70
Width = 64
Height = 16
Caption = #3648#3621#3639#3629#3585#3588#3621#3636#3609#3636#3588
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 26
Top = 199
Width = 115
Height = 16
Caption = #3648#3621#3639#3629#3585#3648#3604#3639#3629#3609#3607#3637#3656#3605#3657#3629#3591#3585#3634#3619
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object GroupBox2: TGroupBox
Left = 8
Top = 55
Width = 401
Height = 226
TabOrder = 7
end
object GroupBox1: TGroupBox
Left = 20
Top = 104
Width = 373
Height = 78
Caption = #3609#3633#3604#3648#3593#3614#3634#3632#3623#3633#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
object chkMon: TCheckBox
Left = 12
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3592#3633#3609#3607#3619#3660
TabOrder = 0
end
object chkTue: TCheckBox
Left = 87
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3629#3633#3591#3588#3634#3619
TabOrder = 1
end
object ChkThr: TCheckBox
Left = 258
Top = 24
Width = 77
Height = 17
Caption = #3623#3633#3609#3614#3620#3627#3633#3626#3610#3604#3637
TabOrder = 2
end
object ChkWen: TCheckBox
Left = 171
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3614#3640#3608
TabOrder = 3
end
object ChkFri: TCheckBox
Left = 12
Top = 47
Width = 61
Height = 17
Caption = #3623#3633#3609#3624#3640#3585#3619#3660
TabOrder = 4
end
object ChkSat: TCheckBox
Left = 87
Top = 47
Width = 61
Height = 17
Caption = #3623#3633#3609#3648#3626#3634#3619#3660
TabOrder = 5
end
object ChkSun: TCheckBox
Left = 171
Top = 47
Width = 73
Height = 17
Caption = #3623#3633#3609#3629#3634#3607#3636#3605#3618#3660
TabOrder = 6
end
end
object Panel1: TPanel
Left = 6
Top = 8
Width = 403
Height = 41
Caption = #3619#3632#3610#3610#3585#3635#3627#3609#3604#3592#3635#3609#3623#3609#3609#3633#3604#3627#3617#3634#3618#3626#3635#3627#3619#3633#3610#3588#3621#3636#3609#3636#3588#3605#3656#3634#3591#3654
Color = clMoneyGreen
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentBackground = False
ParentFont = False
TabOrder = 2
end
object BtnOk: TButton
Left = 132
Top = 242
Width = 75
Height = 25
Caption = #3605#3585#3621#3591
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = BtnOkClick
end
object BtnCancel: TButton
Left = 213
Top = 242
Width = 75
Height = 25
Caption = #3618#3585#3648#3621#3636#3585
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = BtnCancelClick
end
object CboClinic: TComboBox
Left = 97
Top = 69
Width = 225
Height = 21
AutoDropDown = True
Style = csDropDownList
ItemHeight = 13
TabOrder = 3
Items.Strings = (
'00-'#3652#3617#3656#3619#3632#3610#3640)
end
object DTPStart: TDateTimePicker
Left = 147
Top = 199
Width = 104
Height = 21
Date = 40212.000000000000000000
Format = 'MMM yyyy'
Time = 40212.000000000000000000
TabOrder = 4
end
object txttotalAppointment: TEdit
Left = 306
Top = 198
Width = 33
Height = 21
TabOrder = 5
Text = '80'
end
object cds: TClientDataSet
Aggregates = <>
CommandText =
#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39 +
#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39';kk'
Params = <>
ProviderName = 'DataSetProvider1'
Left = 360
Top = 64
end
object ds: TDataSource
DataSet = cds
Left = 328
Top = 64
end
object ChkShowDBug: TCheckBox
Left = 280
Top = 287
Width = 129
Height = 17
Caption = 'Show Debug Messages'
TabOrder = 9
end
object LimitGrid: TDBGrid
Left = 8
Top = 312
Width = 399
Height = 217
TabOrder = 8
DataSource = ds
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object BtnRefresh: TButton
Left = 294
Top = 242
Width = 109
Height = 25
Caption = #3649#3626#3604#3591#3612#3621#3605#3634#3619#3634#3591#3651#3627#3617#3656
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 10
OnClick = BtnRefreshClick
end
end
หัวข้อ: Script สำหรับจำกัดจำนวนนัดหมายที่เดียวได้ทั้งเดือน (อ่าน 15460 ครั้ง)