source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrderSaveQuick.pas@ 1742

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

Uploading from OR_30_258

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