source: cprs/trunk/CPRS-Chart/fNoteBD.pas@ 730

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 3.6 KB
RevLine 
[456]1unit fNoteBD;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7 StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uTIU;
8
9type
10 TfrmNotesByDate = class(TForm)
11 pnlBase: TORAutoPanel;
12 lblBeginDate: TLabel;
13 calBeginDate: TORDateBox;
14 lblEndDate: TLabel;
15 calEndDate: TORDateBox;
16 radSort: TRadioGroup;
17 cmdOK: TButton;
18 cmdCancel: TButton;
19 procedure cmdOKClick(Sender: TObject);
20 procedure cmdCancelClick(Sender: TObject);
21 procedure calBeginDateKeyPress(Sender: TObject; var Key: Char);
22 procedure calEndDateKeyPress(Sender: TObject; var Key: Char);
23 private
24 FChanged: Boolean;
25 FBeginDate: string;
26 FFMBeginDate: TFMDateTime;
27 FEndDate: string;
28 FFMEndDate: TFMDateTime;
29 FAscending: Boolean;
30 end;
31
32 TNoteDateRange = record
33 Changed: Boolean;
34 BeginDate: string;
35 FMBeginDate: TFMDateTime;
36 EndDate: string;
37 FMEndDate: TFMDateTime;
38 Ascending: Boolean;
39 end;
40
41procedure SelectNoteDateRange(FontSize: Integer; CurrentContext: TTIUContext; var NoteDateRange: TNoteDateRange);
42
43implementation
44
45{$R *.DFM}
46
47uses rCore, rTIU;
48
49const
50 TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
51 TX_DATE_ERR_CAP = 'Error in Date Range';
52
53procedure SelectNoteDateRange(FontSize: Integer; CurrentContext: TTIUContext; var NoteDateRange: TNoteDateRange);
54{ displays date range select form for progress notes and returns a record of the selection }
55var
56 frmNotesByDate: TfrmNotesByDate;
57 W, H: Integer;
58begin
59 frmNotesByDate := TfrmNotesByDate.Create(Application);
60 try
61 with frmNotesByDate do
62 begin
63 Font.Size := FontSize;
64 W := ClientWidth;
65 H := ClientHeight;
66 ResizeToFont(FontSize, W, H);
67 ClientWidth := W; pnlBase.Width := W;
68 ClientHeight := H; pnlBase.Height := W;
69 FChanged := False;
70 calBeginDate.Text := CurrentContext.BeginDate;
71 calEndDate.Text := CurrentContext.EndDate;
72 if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
73 FAscending := CurrentContext.TreeAscending;
74 with radSort do if FAscending then ItemIndex := 0 else ItemIndex := 1;
75 ShowModal;
76 with NoteDateRange do
77 begin
78 Changed := FChanged;
79 BeginDate := FBeginDate;
80 FMBeginDate := FFMBeginDate;
81 EndDate := FEndDate;
82 FMEndDate := FFMEndDate;
83 Ascending := FAscending;
84 end; {with NoteDateRange}
85 end; {with frmNotesByDate}
86 finally
87 frmNotesByDate.Release;
88 end;
89end;
90
91procedure TfrmNotesByDate.cmdOKClick(Sender: TObject);
92var
93 bdate, edate: TFMDateTime;
94begin
95 if calBeginDate.Text <> '' then
96 bdate := StrToFMDateTime(calBeginDate.Text)
97 else
98 bdate := 0 ;
99
100 if calEndDate.Text <> '' then
101 edate := StrToFMDateTime(calEndDate.Text)
102 else
103 edate := 0 ;
104
105 if (bdate <= edate) then
106 begin
107 FChanged := True;
108 FBeginDate := calBeginDate.Text;
109 FFMBeginDate := bdate;
110 FEndDate := calEndDate.Text;
111 FFMEndDate := edate;
112 FAscending := radSort.ItemIndex = 0;
113 end
114 else
115 begin
116 InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
117 Exit;
118 end;
119 Close;
120end;
121
122procedure TfrmNotesByDate.cmdCancelClick(Sender: TObject);
123begin
124 Close;
125end;
126
127procedure TfrmNotesByDate.calBeginDateKeyPress(Sender: TObject;
128 var Key: Char);
129begin
130 if (Key = #13) then cmdOKClick(Self);
131end;
132
133procedure TfrmNotesByDate.calEndDateKeyPress(Sender: TObject;
134 var Key: Char);
135begin
136 if (Key = #13) then cmdOKClick(Self);
137end;
138
139end.
Note: See TracBrowser for help on using the repository browser.