source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrderSaveQuick.pas@ 1156

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 10.7 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOrderSaveQuick;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders,
9 DKLang;
10
11type
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
43function EditCommonList(ADisplayGroup: Integer): Boolean;
44function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
45
46implementation
47
48{$R *.DFM}
49
50uses 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
63var
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
74procedure SetupVars;
75//kt Added entire function to replace constant declarations 8/8/2007
76begin
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');
86end;
87
88function EditCommonList(ADisplayGroup: Integer): Boolean;
89var
90 frmSaveQuickOrder: TfrmSaveQuickOrder;
91 DGroupName: string;
92begin
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;
126end;
127
128function SaveAsQuickOrder(ResponseSet: TResponses): Boolean;
129const
130 EMPTY_CRC = 'FFFFFFFF';
131var
132 frmSaveQuickOrder: TfrmSaveQuickOrder;
133 DGroupName, QuickName, CRC: string;
134 NewIEN, AnIndex, i: Integer;
135 IsClinicOrder: boolean;
136begin
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, '-1^'+DKLangConstW('fOrderSaveQuick_xNew_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;
203end;
204
205procedure TfrmSaveQuickOrder.txtDisplayNameChange(Sender: TObject);
206var
207 AnIndex, i: Integer;
208begin
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;
215end;
216
217procedure TfrmSaveQuickOrder.cmdUpClick(Sender: TObject);
218var
219 NewIndex: Integer;
220begin
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;
229end;
230
231procedure TfrmSaveQuickOrder.cmdDownClick(Sender: TObject);
232var
233 NewIndex: Integer;
234begin
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;
243end;
244
245procedure TfrmSaveQuickOrder.cmdRenameClick(Sender: TObject);
246var
247 AName: string;
248begin
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;
258end;
259
260procedure TfrmSaveQuickOrder.cmdDeleteClick(Sender: TObject);
261begin
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;
275end;
276
277procedure TfrmSaveQuickOrder.FormCreate(Sender: TObject);
278begin
279 inherited;
280 OKPressed := False;
281end;
282
283procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
284begin
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;
294end;
295
296procedure TfrmSaveQuickOrder.cmdCancelClick(Sender: TObject);
297begin
298 inherited;
299 Close;
300end;
301
302procedure TfrmSaveQuickOrder.pnlUpButtonEnter(Sender: TObject);
303begin
304 inherited;
305 TPanel(Sender).BevelOuter := bvRaised;
306end;
307
308procedure TfrmSaveQuickOrder.pnlUpButtonExit(Sender: TObject);
309begin
310 inherited;
311 TPanel(Sender).BevelOuter := bvNone;
312end;
313
314end.
Note: See TracBrowser for help on using the repository browser.