source: cprs/trunk/CPRS-Chart/Options/fOptionsTitles.pas@ 1215

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

Upgrade to version 27

File size: 11.4 KB
Line 
1unit fOptionsTitles;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, StdCtrls, ORCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
8
9type
10 TfrmOptionsTitles = class(TfrmBase508Form)
11 lblDocumentClass: TLabel;
12 lblDocumentTitles: TLabel;
13 lblYourTitles: TLabel;
14 lblDefaultTitle: TStaticText;
15 lblDefault: TStaticText;
16 cboDocumentClass: TORComboBox;
17 lstYourTitles: TORListBox;
18 btnAdd: TButton;
19 btnRemove: TButton;
20 btnDefault: TButton;
21 btnSaveChanges: TButton;
22 pnlBottom: TPanel;
23 bvlBottom: TBevel;
24 btnOK: TButton;
25 btnCancel: TButton;
26 cboDocumentTitles: TORComboBox;
27 lblDocumentPreference: TStaticText;
28 btnUp: TButton;
29 btnDown: TButton;
30 procedure FormShow(Sender: TObject);
31 procedure btnOKClick(Sender: TObject);
32 procedure cboDocumentClassClick(Sender: TObject);
33 procedure cboDocumentTitlesNeedData(Sender: TObject;
34 const StartFrom: String; Direction, InsertAt: Integer);
35 procedure btnSaveChangesClick(Sender: TObject);
36 procedure btnDefaultClick(Sender: TObject);
37 procedure btnAddClick(Sender: TObject);
38 procedure lstYourTitlesChange(Sender: TObject);
39 procedure btnRemoveClick(Sender: TObject);
40 procedure cboDocumentTitlesChange(Sender: TObject);
41 procedure btnUpClick(Sender: TObject);
42 procedure btnDownClick(Sender: TObject);
43 function GetFirstSelection(aList: TORListBox): integer;
44 procedure SetItem(aList: TORListBox; index: integer);
45 procedure RemoveSelected;
46 procedure lstYourTitlesClick(Sender: TObject);
47 private
48 { Private declarations }
49 FLastClass: integer;
50 procedure AddIfUnique(entry: string; aList: TORListBox);
51 function MemberNotOnList(alist: TStrings; listnum: string): boolean;
52 procedure CheckEnable;
53 public
54 { Public declarations }
55 end;
56
57var
58 frmOptionsTitles: TfrmOptionsTitles;
59
60procedure DialogOptionsTitles(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
61
62implementation
63
64{$R *.DFM}
65
66uses
67 rOptions, uOptions, rCore, rTIU, rConsults, rDCSumm;
68
69procedure DialogOptionsTitles(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
70// create the form and make it modal, return an action
71var
72 frmOptionsTitles: TfrmOptionsTitles;
73begin
74 frmOptionsTitles := TfrmOptionsTitles.Create(Application);
75 actiontype := 0;
76 try
77 with frmOptionsTitles do
78 begin
79 if (topvalue < 0) or (leftvalue < 0) then
80 Position := poScreenCenter
81 else
82 begin
83 Position := poDesigned;
84 Top := topvalue;
85 Left := leftvalue;
86 end;
87 ResizeAnchoredFormToFont(frmOptionsTitles);
88 ShowModal;
89 actiontype := btnOK.Tag;
90 end;
91 finally
92 frmOptionsTitles.Release;
93 end;
94end;
95
96procedure TfrmOptionsTitles.FormShow(Sender: TObject);
97var
98 i: integer;
99begin
100 FLastClass := -1;
101 with cboDocumentClass do
102 begin
103 FastAssign(rpcGetClasses, cboDocumentClass.Items);
104 Items.Add(IntToStr(IdentifyConsultsClass) + U + 'Consults');
105 for i := 0 to Items.Count - 1 do
106 if Piece(Items[i], '^', 2) = 'Progress Notes' then
107 begin
108 ItemIndex := i;
109 FLastClass := ItemIndex;
110 break;
111 end;
112 end;
113 cboDocumentClassClick(self);
114end;
115
116procedure TfrmOptionsTitles.btnOKClick(Sender: TObject);
117begin
118 if btnSaveChanges.Enabled then
119 btnSaveChangesClick(self);
120 ResetTIUPreferences;
121 ResetDCSummPreferences;
122end;
123
124procedure TfrmOptionsTitles.cboDocumentClassClick(Sender: TObject);
125var
126 aList: TStringList;
127 defaultIEN: integer;
128begin
129 if btnSaveChanges.Enabled then
130 begin
131 if InfoBox('Do you want to save changes to your '
132 + Piece(cboDocumentClass.Items[FLastClass], '^', 2) + ' defaults?',
133 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
134 btnSaveChangesClick(self);
135 end;
136 cboDocumentTitles.Text := '';
137 cboDocumentTitles.InitLongList('');
138 aList := TStringList.Create;
139 with lstYourTitles do
140 begin
141 FastAssign(rpcGetTitlesForUser(cboDocumentClass.ItemIEN), aList);
142 SortByPiece(aList, '^', 3);
143 FastAssign(aList, lstYourTitles.Items);
144 defaultIEN := rpcGetTitleDefault(cboDocumentClass.ItemIEN);
145 if defaultIEN > 0 then SelectByIEN(defaultIEN)
146 else ItemIndex := -1;
147 if ItemIndex > -1 then
148 begin
149 lblDefault.Caption := DisplayText[ItemIndex];
150 lblDefault.Tag := ItemIEN;
151 end
152 else
153 begin
154 lblDefault.Caption := '<no default specified>';
155 lblDefault.Tag := 0;
156 end;
157 end;
158 lstYourTitlesChange(self);
159 btnSaveChanges.Enabled := false;
160 FLastClass := cboDocumentClass.ItemIndex;
161 aList.Free;
162 CheckEnable;
163end;
164
165procedure TfrmOptionsTitles.cboDocumentTitlesNeedData(Sender: TObject;
166 const StartFrom: String; Direction, InsertAt: Integer);
167begin
168 with cboDocumentTitles do
169 begin
170 HideSynonyms := (cboDocumentClass.ItemIEN <> CLS_PROGRESS_NOTES);
171 ForDataUse(rpcGetTitlesForClass(cboDocumentClass.ItemIEN, StartFrom, Direction));
172 end;
173end;
174
175procedure TfrmOptionsTitles.btnSaveChangesClick(Sender: TObject);
176var
177 classnum: integer;
178begin
179 classnum := strtointdef(Piece(cboDocumentClass.Items[FLastClass], '^', 1), 0);
180 if classnum > 0 then
181 begin
182 rpcSaveDocumentDefaults(classnum, lblDefault.Tag, lstYourTitles.Items);
183 btnSaveChanges.Enabled := false;
184 if classnum = CLS_PROGRESS_NOTES then ResetNoteTitles
185 else if classnum = CLS_DC_SUMM then ResetDCSummTitles
186 else if classnum = IdentifyConsultsClass then ResetConsultTitles
187 else if classnum = IdentifyClinProcClass then ResetClinProcTitles;
188 end;
189end;
190
191procedure TfrmOptionsTitles.btnDefaultClick(Sender: TObject);
192begin
193 with lstYourTitles do
194 if ItemIndex > -1 then
195 begin
196 if btnDefault.Caption = 'Set as Default' then
197 begin
198 lblDefault.Caption := DisplayText[ItemIndex];
199 lblDefault.Tag := ItemIEN;
200 btnDefault.Caption := 'Remove Default';
201 end
202 else
203 begin
204 lblDefault.Caption := '<no default specified>';
205 lblDefault.Tag := 0;
206 btnDefault.Caption := 'Set as Default';
207 end;
208 btnDefault.Enabled := true;
209 end
210 else
211 begin
212 lblDefault.Caption := '<no default specified>';
213 lblDefault.Tag := 0;
214 btnDefault.Enabled := false;
215 end;
216 btnSaveChanges.Enabled := true;
217end;
218
219procedure TfrmOptionsTitles.btnAddClick(Sender: TObject);
220begin
221 AddIfUnique(cboDocumentTitles.Items[cboDocumentTitles.ItemIndex], lstYourTitles);
222 lstYourTitles.SelectByIEN(cboDocumentTitles.ItemIEN);
223 btnSaveChanges.Enabled := true;
224 btnAdd.Enabled := false;
225 CheckEnable;
226end;
227
228procedure TfrmOptionsTitles.lstYourTitlesChange(Sender: TObject);
229begin
230 with btnDefault do
231 begin
232 if lstYourTitles.SelCount = 1 then
233 begin
234 if lstYourTitles.ItemIEN = lblDefault.Tag then
235 Caption := 'Remove Default'
236 else
237 Caption := 'Set as Default';
238 Enabled := true;
239 end
240 else
241 Enabled := false;
242 end;
243 //CheckEnable; // ?? causes access violation
244end;
245
246procedure TfrmOptionsTitles.btnRemoveClick(Sender: TObject);
247var
248 index: integer;
249begin
250 index := GetFirstSelection(lstYourTitles);
251 RemoveSelected;
252 SetItem(lstYourTitles, index);
253 CheckEnable;
254 if lstYourTitles.Items.Count = 0 then
255 begin
256 btnDefault.Enabled := false;
257 btnRemove.Enabled := false;
258 end
259 else
260 lstYourTitlesChange(self);
261 btnSaveChanges.Enabled := true;
262end;
263
264procedure TfrmOptionsTitles.AddIfUnique(entry: string; aList: TORListBox);
265var
266 i: integer;
267 ien: string;
268 inlist: boolean;
269begin
270 ien := Piece(entry, '^', 1);
271 inlist := false;
272 with aList do
273 for i := 0 to Items.Count - 1 do
274 if ien = Piece(Items[i], '^', 1) then
275 begin
276 inlist := true;
277 break;
278 end;
279 if not inlist then
280 aList.Items.Add(entry);
281end;
282
283function TfrmOptionsTitles.MemberNotOnList(alist: TStrings; listnum: string): boolean;
284var
285 i: integer;
286begin
287 result := true;
288 with alist do
289 for i := 0 to Count - 1 do
290 if listnum = Piece(alist[i], '^', 1) then
291 begin
292 result := false;
293 break;
294 end;
295end;
296
297procedure TfrmOptionsTitles.cboDocumentTitlesChange(Sender: TObject);
298begin
299 CheckEnable;
300end;
301
302procedure TfrmOptionsTitles.btnUpClick(Sender: TObject);
303var
304 newindex, i: integer;
305begin
306 with lstYourTitles do
307 begin
308 i := 0;
309 while i < Items.Count do
310 begin
311 if Selected[i] then
312 begin
313 newindex := i - 1;
314 Items.Move(i, newindex);
315 Selected[newindex] := true;
316 end;
317 inc(i)
318 end;
319 end;
320 btnSaveChanges.Enabled := true;
321 CheckEnable;
322 lstYourTitlesChange(self);
323end;
324
325procedure TfrmOptionsTitles.btnDownClick(Sender: TObject);
326var
327 newindex, i: integer;
328begin
329 with lstYourTitles do
330 begin
331 i := Items.Count - 1;
332 while i > -1 do
333 begin
334 if Selected[i] then
335 begin
336 newindex := i + 1;
337 Items.Move(i, newindex);
338 Selected[newindex] := true;
339 end;
340 dec(i)
341 end;
342 end;
343 btnSaveChanges.Enabled := true;
344 CheckEnable;
345 lstYourTitlesChange(self);
346end;
347
348function TfrmOptionsTitles.GetFirstSelection(aList: TORListBox): integer;
349begin
350 for result := 0 to aList.Items.Count - 1 do
351 if aList.Selected[result] then exit;
352 result := LB_ERR;
353end;
354
355procedure TfrmOptionsTitles.SetItem(aList: TORListBox; index: integer);
356var
357 maxindex: integer;
358begin
359 with aList do
360 begin
361 SetFocus;
362 maxindex := aList.Items.Count - 1;
363 if Index = LB_ERR then
364 Index := 0
365 else if Index > maxindex then Index := maxindex;
366 Selected[index] := true;
367 end;
368 //CheckEnable;
369end;
370
371procedure TfrmOptionsTitles.RemoveSelected;
372var
373 i: integer;
374begin
375 for i := lstYourTitles.Items.Count - 1 downto 0 do
376 begin
377 if lstYourTitles.Selected[i] then
378 begin
379 if strtoint(Piece(lstYourTitles.Items[i], '^' ,1)) = lblDefault.Tag then
380 begin
381 lblDefault.Caption := '<no default specified>';
382 lblDefault.Tag := 0;
383 btnDefault.Enabled := false;
384 end;
385 lstYourTitles.Items.Delete(i);
386 end;
387 end;
388end;
389
390procedure TfrmOptionsTitles.CheckEnable;
391// allow buttons to be enabled or not depending on selections
392var
393 astring: string;
394begin
395 with lstYourTitles do
396 begin
397 if Items.Count > 0 then
398 begin
399 if SelCount > 0 then
400 begin
401 btnUp.Enabled := (SelCount > 0)
402 and (not Selected[0]);
403 btnDown.Enabled := (SelCount > 0)
404 and (not Selected[Items.Count - 1]);
405 btnRemove.Enabled := true;
406 end
407 else
408 begin
409 btnUp.Enabled := false;
410 btnDown.Enabled := false;
411 btnRemove.Enabled := false;
412 end;
413 end
414 else
415 begin
416 btnUp.Enabled := false;
417 btnDown.Enabled := false;
418 btnRemove.Enabled := false;
419 end;
420 end;
421 with cboDocumentTitles do
422 if ItemIndex > -1 then
423 begin
424 astring := ItemID;
425 btnAdd.Enabled := MemberNotOnList(lstYourTitles.Items, astring);
426 end
427 else
428 btnAdd.Enabled := false;
429end;
430
431procedure TfrmOptionsTitles.lstYourTitlesClick(Sender: TObject);
432begin
433 lstYourTitlesChange(self); // need to check default
434 CheckEnable;
435end;
436
437end.
Note: See TracBrowser for help on using the repository browser.