1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
2 | unit fOrderSaveQuick;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
8 | fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders,
|
---|
9 | DKLang;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TfrmSaveQuickOrder = class(TfrmAutoSz)
|
---|
13 | Panel1: TPanel;
|
---|
14 | memOrder: TMemo;
|
---|
15 | lblDisplayName: TLabel;
|
---|
16 | txtDisplayName: TCaptionEdit;
|
---|
17 | Panel2: TPanel;
|
---|
18 | lblQuickList: TLabel;
|
---|
19 | lstQuickList: TORListBox;
|
---|
20 | pnlUpButton: TKeyClickPanel;
|
---|
21 | cmdUp: TSpeedButton;
|
---|
22 | pnlDownButton: TKeyClickPanel;
|
---|
23 | cmdRename: TButton;
|
---|
24 | cmdDelete: TButton;
|
---|
25 | cmdDown: TSpeedButton;
|
---|
26 | Panel3: TPanel;
|
---|
27 | cmdOK: TButton;
|
---|
28 | cmdCancel: TButton;
|
---|
29 | procedure FormCreate(Sender: TObject);
|
---|
30 | procedure cmdOKClick(Sender: TObject);
|
---|
31 | procedure cmdCancelClick(Sender: TObject);
|
---|
32 | procedure txtDisplayNameChange(Sender: TObject);
|
---|
33 | procedure cmdUpClick(Sender: TObject);
|
---|
34 | procedure cmdDownClick(Sender: TObject);
|
---|
35 | procedure cmdRenameClick(Sender: TObject);
|
---|
36 | procedure cmdDeleteClick(Sender: TObject);
|
---|
37 | procedure pnlUpButtonEnter(Sender: TObject);
|
---|
38 | procedure pnlUpButtonExit(Sender: TObject);
|
---|
39 | private
|
---|
40 | OKPressed: Boolean;
|
---|
41 | end;
|
---|
42 |
|
---|
43 | function EditCommonList(ADisplayGroup: Integer): Boolean;
|
---|
44 | function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
|
---|
45 |
|
---|
46 | implementation
|
---|
47 |
|
---|
48 | {$R *.DFM}
|
---|
49 |
|
---|
50 | uses rODBase, rOrders, fRename;
|
---|
51 |
|
---|
52 | //const
|
---|
53 | //TX_DNAME_REQ = 'A name for the quick order must be entered in order to save it.'; <-- original line. //kt 8/8/2007
|
---|
54 | //TC_DNAME_REQ = 'Display Name Missing'; <-- original line. //kt 8/8/2007
|
---|
55 | //TX_DEL_CONFIRM = 'Remove the following quick order from your list?' + CRLF + CRLF; <-- original line. //kt 8/8/2007
|
---|
56 | //TC_DEL_CONFIRM = 'Remove Quick Order'; <-- original line. //kt 8/8/2007
|
---|
57 | //TX_QO_RENAME = 'Rename Quick Order'; <-- original line. //kt 8/8/2007
|
---|
58 | //TX_NO_DEL_NEW = 'A new quick order cannot be deleted. Press <Cancel> instead.'; <-- original line. //kt 8/8/2007
|
---|
59 | //TC_NO_DEL_NEW = 'Remove Quick Order'; <-- original line. //kt 8/8/2007
|
---|
60 | //TX_NO_TEXT = 'No fields have been entered - cannot save as quick order.'; <-- original line. //kt 8/8/2007
|
---|
61 | //TC_NO_TEXT = 'Save as Quick Order'; <-- original line. //kt 8/8/2007
|
---|
62 |
|
---|
63 | var
|
---|
64 | TX_DNAME_REQ : string; //kt
|
---|
65 | TC_DNAME_REQ : string; //kt
|
---|
66 | TX_DEL_CONFIRM : string; //kt
|
---|
67 | TC_DEL_CONFIRM : string; //kt
|
---|
68 | TX_QO_RENAME : string; //kt
|
---|
69 | TX_NO_DEL_NEW : string; //kt
|
---|
70 | TC_NO_DEL_NEW : string; //kt
|
---|
71 | TX_NO_TEXT : string; //kt
|
---|
72 | TC_NO_TEXT : string; //kt
|
---|
73 |
|
---|
74 | procedure SetupVars;
|
---|
75 | //kt Added entire function to replace constant declarations 8/8/2007
|
---|
76 | begin
|
---|
77 | TX_DNAME_REQ := DKLangConstW('fOrderSaveQuick_A_name_for_the_quick_order_must_be_entered_in_order_to_save_itx');
|
---|
78 | TC_DNAME_REQ := DKLangConstW('fOrderSaveQuick_Display_Name_Missing');
|
---|
79 | TX_DEL_CONFIRM := DKLangConstW('fOrderSaveQuick_Remove_the_following_quick_order_from_your_listx') + CRLF + CRLF;
|
---|
80 | TC_DEL_CONFIRM := DKLangConstW('fOrderSaveQuick_Remove_Quick_Order');
|
---|
81 | TX_QO_RENAME := DKLangConstW('fOrderSaveQuick_Rename_Quick_Order');
|
---|
82 | TX_NO_DEL_NEW := DKLangConstW('fOrderSaveQuick_A_new_quick_order_cannot_be_deletedx__Press_xCancelx_insteadx');
|
---|
83 | TC_NO_DEL_NEW := DKLangConstW('fOrderSaveQuick_Remove_Quick_Order');
|
---|
84 | TX_NO_TEXT := DKLangConstW('fOrderSaveQuick_No_fields_have_been_entered_x_cannot_save_as_quick_orderx');
|
---|
85 | TC_NO_TEXT := DKLangConstW('fOrderSaveQuick_Save_as_Quick_Order');
|
---|
86 | end;
|
---|
87 |
|
---|
88 | function EditCommonList(ADisplayGroup: Integer): Boolean;
|
---|
89 | var
|
---|
90 | frmSaveQuickOrder: TfrmSaveQuickOrder;
|
---|
91 | DGroupName: string;
|
---|
92 | begin
|
---|
93 | Result := False;
|
---|
94 | frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
|
---|
95 | try
|
---|
96 | ResizeFormToFont(TForm(frmSaveQuickOrder));
|
---|
97 | with frmSaveQuickOrder do
|
---|
98 | begin
|
---|
99 | if ADisplayGroup = ClinDisp then
|
---|
100 | ADisplayGroup := InptDisp;
|
---|
101 | DGroupName := NameOfDGroup(ADisplayGroup);
|
---|
102 | // Caption := 'Edit Common Order List (' + DGroupName + ')'; <-- original line. //kt 8/8/2007
|
---|
103 | Caption := DKLangConstW('fOrderSaveQuick_Edit_Common_Order_List_x') + DGroupName + ')'; //kt added 8/8/2007
|
---|
104 | // lblQuickList.Caption := 'Common List for ' + DGroupName; <-- original line. //kt 8/8/2007
|
---|
105 | lblQuickList.Caption := DKLangConstW('fOrderSaveQuick_Common_List_for') + DGroupName; //kt added 8/8/2007
|
---|
106 | lstQuickList.Caption := lblQuickList.Caption;
|
---|
107 | lblDisplayName.Font.Color := clGrayText;
|
---|
108 | txtDisplayName.Enabled := False;
|
---|
109 | txtDisplayName.Color := clBtnFace;
|
---|
110 | with lstQuickList do
|
---|
111 | begin
|
---|
112 | LoadQuickListForOD(Items, ADisplayGroup);
|
---|
113 | ItemIndex := 0;
|
---|
114 | end;
|
---|
115 | ShowModal;
|
---|
116 | if OKPressed then
|
---|
117 | begin
|
---|
118 | Result := True;
|
---|
119 | // replace the user's quick list with this new quick list
|
---|
120 | SaveQuickListForOD(lstQuickList.Items, ADisplayGroup);
|
---|
121 | end; {if OKPressed}
|
---|
122 | end; {with frmSaveQuickOrder}
|
---|
123 | finally
|
---|
124 | frmSaveQuickOrder.Release;
|
---|
125 | end;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
|
---|
129 | const
|
---|
130 | EMPTY_CRC = 'FFFFFFFF';
|
---|
131 | var
|
---|
132 | frmSaveQuickOrder: TfrmSaveQuickOrder;
|
---|
133 | DGroupName, QuickName, CRC: string;
|
---|
134 | NewIEN, AnIndex, i: Integer;
|
---|
135 | IsClinicOrder: boolean;
|
---|
136 | begin
|
---|
137 | SetupVars; //kt added 8/8/2007 to replace constants with vars.
|
---|
138 | Result := False;
|
---|
139 | CRC := ResponseSet.OrderCRC;
|
---|
140 | IsClinicOrder := False;
|
---|
141 | if CRC = EMPTY_CRC then
|
---|
142 | begin
|
---|
143 | InfoBox(TX_NO_TEXT, TC_NO_TEXT, MB_OK);
|
---|
144 | Exit;
|
---|
145 | end;
|
---|
146 | frmSaveQuickOrder := TfrmSaveQuickOrder.Create(Application);
|
---|
147 | try
|
---|
148 | ResizeFormToFont(TForm(frmSaveQuickOrder));
|
---|
149 | with frmSaveQuickOrder do
|
---|
150 | begin
|
---|
151 | if (ResponseSet.DisplayGroup = ClinDisp) and (ResponseSet.Dialog = 'PSJI OR PAT FLUID OE') then
|
---|
152 | begin
|
---|
153 | ResponseSet.DisplayGroup := IVDisp;
|
---|
154 | IsClinicOrder := True;
|
---|
155 | end;
|
---|
156 | if ResponseSet.DisplayGroup = ClinDisp then
|
---|
157 | DGroupName := NameOfDGroup(InptDisp)
|
---|
158 | else
|
---|
159 | DGroupName := NameOfDGroup(ResponseSet.DisplayGroup);
|
---|
160 | // Caption := 'Add Quick Order (' + DGroupName + ')'; <-- original line. //kt 8/8/2007
|
---|
161 | Caption := DKLangConstW('fOrderSaveQuick_Add_Quick_Order_x') + DGroupName + ')'; //kt added 8/8/2007
|
---|
162 | // lblQuickList.Caption := 'Common List for ' + DGroupName; <-- original line. //kt 8/8/2007
|
---|
163 | lblQuickList.Caption := DKLangConstW('fOrderSaveQuick_Common_List_for') + DGroupName; //kt added 8/8/2007
|
---|
164 | lstQuickList.Caption := lblQuickList.Caption;
|
---|
165 | QuickName := GetQuickName(CRC);
|
---|
166 | memOrder.Text := ResponseSet.OrderText;
|
---|
167 | txtDisplayName.Text := QuickName;
|
---|
168 | with lstQuickList do
|
---|
169 | begin
|
---|
170 | if ResponseSet.DisplayGroup = ClinDisp then
|
---|
171 | LoadQuickListForOD(Items, InptDisp)
|
---|
172 | else
|
---|
173 | LoadQuickListForOD(Items, ResponseSet.DisplayGroup);
|
---|
174 | if Length(QuickName) > 0
|
---|
175 | then Items.Insert(0, '-1^' + QuickName)
|
---|
176 | // else Items.Insert(0, '-1^<New Quick Order>'); <-- original line. //kt 8/8/2007
|
---|
177 | else Items.Insert(0, DKLangConstW('fOrderSaveQuick_x1xxNew_Quick_Orderx')); //kt added 8/8/2007
|
---|
178 | ItemIndex := 0;
|
---|
179 | end;
|
---|
180 | ShowModal;
|
---|
181 | if OKPressed then
|
---|
182 | begin
|
---|
183 | Result := True;
|
---|
184 | // save reponses as quick order
|
---|
185 | ResponseSet.SaveQuickOrder(NewIEN, txtDisplayName.Text);
|
---|
186 | // find the new quick order and set the new IEN
|
---|
187 | AnIndex := -1;
|
---|
188 | with lstQuickList do for i := 0 to Items.Count - 1 do
|
---|
189 | if GetIEN(i) = -1 then AnIndex := i;
|
---|
190 | if AnIndex > -1 then lstQuickList.Items[AnIndex] := IntToStr(NewIEN) + U +
|
---|
191 | txtDisplayName.Text;
|
---|
192 | // replace the user's quick list with this new quick list
|
---|
193 | if ResponseSet.DisplayGroup = ClinDisp then
|
---|
194 | SaveQuickListForOD(lstQuickList.Items, InptDisp)
|
---|
195 | else
|
---|
196 | SaveQuickListForOD(lstQuickList.Items, ResponseSet.DisplayGroup);
|
---|
197 | end; {if OKPressed}
|
---|
198 | if IsClinicOrder = True then ResponseSet.DisplayGroup := ClinDisp;
|
---|
199 | end; {with frmSaveQuickOrder}
|
---|
200 | finally
|
---|
201 | frmSaveQuickOrder.Release;
|
---|
202 | end;
|
---|
203 | end;
|
---|
204 |
|
---|
205 | procedure TfrmSaveQuickOrder.txtDisplayNameChange(Sender: TObject);
|
---|
206 | var
|
---|
207 | AnIndex, i: Integer;
|
---|
208 | begin
|
---|
209 | inherited;
|
---|
210 | if txtDisplayName.Text = '' then Exit;
|
---|
211 | AnIndex := -1;
|
---|
212 | with lstQuickList do for i := 0 to Items.Count - 1 do
|
---|
213 | if GetIEN(i) = -1 then AnIndex := i;
|
---|
214 | if AnIndex > -1 then lstQuickList.Items[AnIndex] := '-1^' + txtDisplayName.Text;
|
---|
215 | end;
|
---|
216 |
|
---|
217 | procedure TfrmSaveQuickOrder.cmdUpClick(Sender: TObject);
|
---|
218 | var
|
---|
219 | NewIndex: Integer;
|
---|
220 | begin
|
---|
221 | inherited;
|
---|
222 | with lstQuickList do
|
---|
223 | begin
|
---|
224 | if ItemIndex < 1 then Exit;
|
---|
225 | NewIndex := ItemIndex - 1;
|
---|
226 | Items.Move(ItemIndex, NewIndex);
|
---|
227 | ItemIndex := NewIndex;
|
---|
228 | end;
|
---|
229 | end;
|
---|
230 |
|
---|
231 | procedure TfrmSaveQuickOrder.cmdDownClick(Sender: TObject);
|
---|
232 | var
|
---|
233 | NewIndex: Integer;
|
---|
234 | begin
|
---|
235 | inherited;
|
---|
236 | with lstQuickList do
|
---|
237 | begin
|
---|
238 | if ItemIndex > Items.Count - 2 then Exit;
|
---|
239 | NewIndex := ItemIndex + 1;
|
---|
240 | Items.Move(ItemIndex, NewIndex);
|
---|
241 | ItemIndex := NewIndex;
|
---|
242 | end;
|
---|
243 | end;
|
---|
244 |
|
---|
245 | procedure TfrmSaveQuickOrder.cmdRenameClick(Sender: TObject);
|
---|
246 | var
|
---|
247 | AName: string;
|
---|
248 | begin
|
---|
249 | SetupVars; //kt added 8/8/2007 to replace constants with vars.
|
---|
250 | inherited;
|
---|
251 | with lstQuickList do
|
---|
252 | begin
|
---|
253 | if ItemIndex < 0 then Exit;
|
---|
254 | AName := Piece(Items[ItemIndex], U, 2);
|
---|
255 | if ExecuteRename(AName, TX_QO_RENAME)
|
---|
256 | then Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
|
---|
257 | end;
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TfrmSaveQuickOrder.cmdDeleteClick(Sender: TObject);
|
---|
261 | begin
|
---|
262 | SetupVars; //kt added 8/8/2007 to replace constants with vars.
|
---|
263 | inherited;
|
---|
264 | with lstQuickList do
|
---|
265 | begin
|
---|
266 | if ItemIndex < 0 then Exit;
|
---|
267 | if ItemIEN = -1 then
|
---|
268 | begin
|
---|
269 | InfoBox(TX_NO_DEL_NEW, TC_NO_DEL_NEW, MB_OK);
|
---|
270 | Exit;
|
---|
271 | end;
|
---|
272 | if InfoBox(TX_DEL_CONFIRM + DisplayText[ItemIndex], TC_DEL_CONFIRM,
|
---|
273 | MB_YESNO or MB_ICONQUESTION) = IDYES then Items.Delete(ItemIndex);
|
---|
274 | end;
|
---|
275 | end;
|
---|
276 |
|
---|
277 | procedure TfrmSaveQuickOrder.FormCreate(Sender: TObject);
|
---|
278 | begin
|
---|
279 | inherited;
|
---|
280 | OKPressed := False;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
|
---|
284 | begin
|
---|
285 | SetupVars; //kt added 8/8/2007 to replace constants with vars.
|
---|
286 | inherited;
|
---|
287 | if txtDisplayName.Enabled and (txtDisplayName.Text = '') then
|
---|
288 | begin
|
---|
289 | InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
|
---|
290 | Exit;
|
---|
291 | end;
|
---|
292 | OKPressed := True;
|
---|
293 | Close;
|
---|
294 | end;
|
---|
295 |
|
---|
296 | procedure TfrmSaveQuickOrder.cmdCancelClick(Sender: TObject);
|
---|
297 | begin
|
---|
298 | inherited;
|
---|
299 | Close;
|
---|
300 | end;
|
---|
301 |
|
---|
302 | procedure TfrmSaveQuickOrder.pnlUpButtonEnter(Sender: TObject);
|
---|
303 | begin
|
---|
304 | inherited;
|
---|
305 | TPanel(Sender).BevelOuter := bvRaised;
|
---|
306 | end;
|
---|
307 |
|
---|
308 | procedure TfrmSaveQuickOrder.pnlUpButtonExit(Sender: TObject);
|
---|
309 | begin
|
---|
310 | inherited;
|
---|
311 | TPanel(Sender).BevelOuter := bvNone;
|
---|
312 | end;
|
---|
313 |
|
---|
314 | end.
|
---|