source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsTitles.pas@ 1099

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

Initial upload of TMG-CPRS 1.0.26.69

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