source: cprs/trunk/CPRS-Chart/Orders/fOrderSaveQuick.pas@ 924

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

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