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

Last change on this file since 842 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

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