source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptions.pas@ 473

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 30.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptions;
3
4interface
5
6uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
7 Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
8 uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles;
9
10//kt added 6/29/07 ------------------
11{Note: an additional tab was added to form: tsLanguage, with caption "Language"
12 It contained a combo box (TTntComboxBox to support unicode language display)
13 It has an on change event added below. There was a memo field describing
14 how adding languages works:
15
16 For a given language to be available, a *.lng (e.g. spanish.lng) must be in the
17 same directory as CPRSchart.exe. *.lng may be created by users by working
18 with the CPRSchart.dklng file with the free language editor found at:
19 http://www.dk-soft.org/products/dklang/
20
21 Note: Cancel for language change is not currently supported
22 }
23
24type
25 TfrmOptions = class(TForm)
26 pnlMain: TPanel;
27 pnlBottom: TPanel;
28 pagOptions: TPageControl;
29 tsCoverSheet: TTabSheet;
30 tsNotifications: TTabSheet;
31 btnOK: TButton;
32 btnCancel: TButton;
33 btnApply: TButton;
34 tsOrderChecks: TTabSheet;
35 tsListsTeams: TTabSheet;
36 tsLanguage: TTabSheet; //kt added 6/29/07 (added in form editor)
37 lblCoverReminderDesc: TMemo;
38 lblCoverReminders: TStaticText;
39 lblCoverDaysDesc: TMemo;
40 lblCoverDays: TStaticText;
41 btnCoverDays: TButton;
42 bvlCoverDays: TBevel;
43 btnCoverReminders: TButton;
44 bvlCoverReminders: TBevel;
45 imgCoverDays: TImage;
46 imgCoverReminders: TImage;
47 lblPatientSelectionDesc: TMemo;
48 lblPatientSelection: TStaticText;
49 btnPatientSelection: TButton;
50 bvlPatientSelection: TBevel;
51 btnPersonalLists: TButton;
52 imgPatientSelection: TImage;
53 lblNotificationsOptions: TStaticText;
54 lblNotifications: TStaticText;
55 bvlNotifications: TBevel;
56 imgNotifications: TImage;
57 lblOrderChecksDesc: TLabel;
58 lblOrderChecks: TStaticText;
59 bvlOrderChecks: TBevel;
60 imgOrderChecks: TImage;
61 lblTeamsDesc: TMemo;
62 lblTeams: TStaticText;
63 btnTeams: TButton;
64 bvlTeams: TBevel;
65 lvwNotifications: TCaptionListView;
66 lblNotificationView: TLabel;
67 btnNotificationsRemove: TButton;
68 chkNotificationsFlagged: TCheckBox;
69 lvwOrderChecks: TCaptionListView;
70 lblOrderChecksView: TLabel;
71 btnSurrogate: TButton;
72 lblNotificationsSurrogate: TStaticText;
73 lblNotificationsSurrogateText: TStaticText;
74 btnCombinations: TButton;
75 bvlOtherParameters: TBevel;
76 lblOtherParameters: TStaticText;
77 imgOtherParameters: TImage;
78 lblOtherParametersDesc: TMemo;
79 btnOtherParameters: TButton;
80 tsNotes: TTabSheet;
81 lblNotesNotesDesc: TMemo;
82 lblNotesNotes: TStaticText;
83 bvlNotesNotes: TBevel;
84 btnNotesNotes: TButton;
85 lblNotesTitles: TStaticText;
86 bvlNotesTitles: TBevel;
87 lblNotesTitlesDesc: TMemo;
88 btnNotesTitles: TButton;
89 imgNotesNotes: TImage;
90 imgNotes: TImage;
91 imgTeams: TImage;
92 tsCprsReports: TTabSheet;
93 lblReports: TStaticText;
94 bvlReports: TBevel;
95 memReports: TMemo;
96 imgReports: TImage;
97 btnReports: TButton;
98 lblReport1: TStaticText;
99 memReport1: TMemo;
100 btnReport1: TButton;
101 bvlReport1: TBevel;
102 btnDiagnoses: TButton;
103 tsGraphs: TTabSheet;
104 lblGraphSettings: TStaticText;
105 bvlGraphSettings: TBevel;
106 imgGraphSettings: TImage;
107 btnGraphSettings: TButton;
108 bvlGraphViews: TBevel;
109 lblGraphViews: TStaticText;
110 imgGraphViews: TImage;
111 btnGraphViews: TButton;
112 memGraphSettings: TMemo;
113 memGraphViews: TMemo;
114 bvlReport2: TBevel;
115 lblReport2: TStaticText;
116 memReport2: TMemo;
117 imgReport1: TImage;
118 imgReport2: TImage;
119 rdoRDV: TRadioGroup;
120 cbLanguage: TTntComboBox;
121 Label1: TLabel;
122 Label2: TLabel;
123 DKLanguageController1: TDKLanguageController;
124 Image1: TImage;
125 Memo1: TMemo;
126 Button1: TButton;
127 procedure FormCreate(Sender: TObject);
128 procedure FormDestroy(Sender: TObject);
129 procedure btnCoverDaysClick(Sender: TObject);
130 procedure btnCoverRemindersClick(Sender: TObject);
131 procedure btnOtherParametersClick(Sender: TObject);
132 procedure btnPatientSelectionClick(Sender: TObject);
133 procedure btnPersonalListsClick(Sender: TObject);
134 procedure btnTeamsClick(Sender: TObject);
135 procedure btnNotificationsRemoveClick(Sender: TObject);
136 procedure btnApplyClick(Sender: TObject);
137 procedure chkNotificationsFlaggedClick(Sender: TObject);
138 procedure lvwNotificationsChange(Sender: TObject; Item: TListItem;
139 Change: TItemChange);
140 procedure lvwNotificationsColumnClick(Sender: TObject;
141 Column: TListColumn);
142 procedure lvwNotificationsCompare(Sender: TObject; Item1,
143 Item2: TListItem; Data: Integer; var Compare: Integer);
144 procedure lvwNotificationsDblClick(Sender: TObject);
145 procedure btnSurrogateClick(Sender: TObject);
146 procedure btnCombinationsClick(Sender: TObject);
147 procedure btnNotesNotesClick(Sender: TObject);
148 procedure btnNotesTitlesClick(Sender: TObject);
149 procedure btnReportsClick(Sender: TObject);
150 procedure btnReport1Click(Sender: TObject);
151 procedure lvwNotificationsEnter(Sender: TObject);
152 procedure lvwNotificationsMouseDown(Sender: TObject;
153 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
154 procedure btnDiagnosesClick(Sender: TObject);
155 procedure btnGraphSettingsClick(Sender: TObject);
156 procedure btnGraphViewsClick(Sender: TObject);
157 procedure rdoRDVClick(Sender: TObject);
158 procedure cbLanguageChange(Sender: TObject);
159 procedure Button1Click(Sender: TObject); //kt added 6/29/07
160 private
161 { Private declarations }
162 FdirtyNotifications: boolean; // used to determine edit changes to Notifications
163 FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks
164 FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings
165 FuseCheckBoxes: boolean;
166 FsortCol: integer;
167 FsortAscending: boolean;
168 FLastClickedItem: TListItem;
169 procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
170 procedure LoadNotifications;
171 procedure LoadOrderChecks;
172 procedure ApplyNotifications;
173 procedure ApplyOrderChecks;
174 procedure ApplyOtherStuff;
175 procedure CheckApply;
176 procedure LoadListView(aListView: TListView; aList: TStrings);
177 procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
178 public
179 { Public declarations }
180 end;
181
182var
183 frmOptions: TfrmOptions;
184
185procedure DialogOptions(var actiontype: Integer);
186
187implementation
188
189uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
190 fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
191 fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
192 fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
193 rOptions, rCore, uCore, uOptions, UBACore, fFrame,
194 //fTestDialog;
195
196 //kt mod 6/29/07 -----
197 ORNet, //allows access to RPCBrokerV
198 TntForms, TntSystem, TntSysUtils;
199 //kt end mod ---------
200
201
202{$R *.DFM}
203
204type
205 TRule = class
206 public
207 IEN: string;
208 OriginalValue: string;
209 ItemText: string;
210end;
211
212procedure DialogOptions(var actiontype: Integer);
213// create the form and make in modal, return an action
214const
215 PixelGapBetweenButtons = 5;
216var
217 frmOptions: TfrmOptions;
218begin
219 frmOptions := TfrmOptions.Create(Application);
220 try
221 with frmOptions do
222 begin
223 with pagOptions do
224 begin
225 tsCoverSheet.TabVisible := false;
226 tsNotifications.TabVisible := false;
227 tsOrderChecks.TabVisible := false;
228 tsListsTeams.TabVisible := false;
229 case actiontype of
230 1: begin
231 tsCoverSheet.TabVisible := true;
232 end;
233 2: begin
234 tsNotifications.TabVisible := true;
235 end;
236 3: begin
237 tsOrderChecks.TabVisible := true;
238 end;
239 4: begin
240 tsListsTeams.TabVisible := true;
241 end;
242 else
243 begin
244 tsCoverSheet.TabVisible := true;
245 tsNotifications.TabVisible := true;
246 tsOrderChecks.TabVisible := true;
247 tsListsTeams.TabVisible := true;
248 ActivePage := tsCoverSheet;
249// memReports.Text := 'Change the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
250 memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
251// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
252 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
253// memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
254 memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
255// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
256 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
257// btnReports.caption := 'Set All Reports...'; <-- original line. //kt 8/8/2007
258 btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
259// btnReport1.caption := 'Set Individual Reports...'; <-- original line. //kt 8/8/2007
260 btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
261 if User.IsReportsOnly then // For "Reports Only" users.
262 begin
263 tsCoverSheet.TabVisible := false;
264 tsNotifications.TabVisible := false;
265 tsOrderChecks.TabVisible := false;
266 tsListsTeams.TabVisible := false;
267 tsNotes.TabVisible := false;
268 if (not User.ToolsRptEdit) then
269 begin
270 btnOK.visible := false;
271 btnApply.visible := false;
272// btnCancel.caption := 'Close'; <-- original line. //kt 8/8/2007
273 btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
274 end;
275 end;
276 if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
277 begin
278// memReports.Text := 'View the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
279 memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
280// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
281 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
282// memReport1.Text := 'View the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
283 memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
284// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
285 DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
286// btnReports.caption := 'View All Report Settings...'; <-- original line. //kt 8/8/2007
287 btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
288// btnReport1.caption := 'View Individual Report Settings...'; <-- original line. //kt 8/8/2007
289 btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
290 end;
291 end;
292 end;
293 end;
294 actiontype := 0;
295 ResizeAnchoredFormToFont(frmOptions);
296 btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
297 btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
298 btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
299 ShowModal;
300 actiontype := btnOK.Tag;
301 end;
302 finally
303 frmOptions.Release;
304 end;
305end;
306
307procedure TfrmOptions.FormCreate(Sender: TObject);
308// initialize form
309var i : integer; //kt added 6/29/07
310begin
311 LoadNotifications;
312 LoadOrderChecks;
313 FdirtyNotifications := false;
314 FdirtyOrderChecks := false;
315 FdirtyOtherStuff := false;
316 CheckApply;
317
318 if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
319 btnDiagnoses.Enabled := False;
320 if UseVistaWeb then rdoRDV.ItemIndex := 1;
321
322 //kt begin modification 6/29/07 ---------------
323
324 // Fill cbLanguage with available languages
325 // Note: LangManager was populated at form creation of fFrame
326 for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
327 //Index=0 always means the default language
328 cbLanguage.ItemIndex := LangManager.LanguageIndex;
329
330 //kt end modification 6/29/07 ---------------
331
332
333end;
334
335procedure TfrmOptions.FormDestroy(Sender: TObject);
336// cleanup creation of objects
337var
338 i: integer;
339begin
340 for i := 0 to lvwOrderChecks.Items.Count - 1 do
341 lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
342 for i := 0 to lvwNotifications.Items.Count - 1 do
343 lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
344end;
345
346procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
347// display Date Range Defaults on Cover Sheet
348var
349 topsize, leftsize, value: integer;
350begin
351 value := 0;
352 Offset(topsize, -60, leftsize, -60);
353 DialogOptionsDays(topsize, leftsize, Font.Size, value);
354end;
355
356procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
357// display Clinical Reminder Options
358var
359 topsize, leftsize, value: integer;
360begin
361 value := 0;
362 Offset(topsize, -60, leftsize, -60);
363 DialogOptionsReminders(topsize, leftsize, Font.Size, value);
364end;
365
366procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
367// display Other Parameters Options
368var
369 topsize, leftsize, value: integer;
370begin
371 value := 0;
372 Offset(topsize, 40, leftsize, 40);
373 DialogOptionsOther(topsize, leftsize, Font.Size, value);
374end;
375
376procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
377// display Patient Selection Options
378var
379 topsize, leftsize, value: integer;
380begin
381 value := 0;
382 Offset(topsize, -60, leftsize, -60);
383 DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
384end;
385
386procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
387// display Personal Lists Options
388var
389 topsize, leftsize, value: integer;
390begin
391 value := 0;
392 Offset(topsize, -60, leftsize, -60);
393 DialogOptionsLists(topsize, leftsize, Font.Size, value);
394end;
395
396procedure TfrmOptions.btnTeamsClick(Sender: TObject);
397// display Team Options
398var
399 topsize, leftsize, value: integer;
400begin
401 value := 0;
402 Offset(topsize, -60, leftsize, -60);
403 DialogOptionsTeams(topsize, leftsize, Font.Size, value);
404end;
405
406procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
407// confirm before clearing notifications
408begin
409//if InfoBox('CAUTION: This will clear all the current notifications you have pending.' <-- original line. //kt 8/8/2007
410 if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
411// + #13 + 'If you say YES, these changes will take place immediately.' <-- original line. //kt 8/8/2007
412 + #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
413// + #13 + 'Are you sure you want to erase all of your notifications?', <-- original line. //kt 8/8/2007
414 + #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
415// 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then <-- original line. //kt 8/8/2007
416 DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
417 begin
418 rpcClearNotifications;
419 end;
420end;
421
422procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
423// get positions to display dialog
424begin
425 // use these top and left values to display dialog
426 topnum := Top;
427 leftnum := Left;
428 topnum := topnum + topoffset;
429 if topnum < 0 then topnum := 0;
430 leftnum := leftnum + leftoffset;
431 if leftnum < 0 then leftnum := 0;
432end;
433
434procedure TfrmOptions.btnApplyClick(Sender: TObject);
435// save actions without exiting
436begin
437 if FdirtyNotifications then
438 ApplyNotifications;
439 if FdirtyOrderChecks then
440 ApplyOrderChecks;
441 if FdirtyOtherStuff then
442 ApplyOtherStuff;
443 CheckApply;
444 if Sender = btnOK then
445 Close;
446end;
447
448procedure TfrmOptions.LoadNotifications;
449// load Notification tab
450var
451 notifydefaults, surrogateinfo, flag, enableerase: string;
452begin
453 LoadListView(lvwNotifications, rpcGetNotifications);
454 lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
455 notifydefaults := rpcGetNotificationDefaults;
456 flag := Piece(notifydefaults, '^', 2);
457 enableerase := Piece(notifydefaults, '^', 3);
458 chkNotificationsFlagged.Checked := flag = '1';
459 btnNotificationsRemove.Enabled := enableerase = '1';
460 surrogateinfo := rpcGetSurrogateInfo;
461 btnSurrogate.Hint := surrogateinfo;
462 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
463end;
464
465procedure TfrmOptions.LoadOrderChecks;
466// load Order Check tab
467begin
468 LoadListView(lvwOrderChecks, rpcGetOrderChecks);
469 lvwOrderChecks.Checkboxes := true;
470end;
471
472procedure TfrmOptions.ApplyNotifications;
473// save Notification changes
474var
475 i: integer;
476 newonoff: string;
477 aRule: TRule;
478 aList: TStringList;
479begin
480 aList := TStringList.Create;
481 for i := 0 to lvwNotifications.Items.Count - 1 do
482 begin
483 aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
484// if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then <-- original line. //kt 8/8/2007
485 if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
486 begin
487 newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
488 if aRule.OriginalValue <> newonoff then
489 begin
490 //***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
491 aList.Add(aRule.IEN + '^' + newonoff);
492 aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
493 end;
494 end;
495 end;
496 rpcSetNotifications(aList);
497 aList.free;
498 FdirtyNotifications := false;
499end;
500
501procedure TfrmOptions.ApplyOrderChecks;
502// save Order Check changes
503var
504 i: integer;
505 newonoff: string;
506 aRule: TRule;
507 aList: TStringList;
508begin
509 aList := TStringList.Create;
510 for i := 0 to lvwOrderChecks.Items.Count - 1 do
511 begin
512 aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
513 newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
514 if aRule.OriginalValue <> newonoff then
515 begin
516 aList.Add(aRule.IEN + '^' + newonoff);
517 aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
518 end;
519 end;
520 rpcSetOrderChecks(aList);
521 aList.free;
522 FdirtyOrderChecks := false;
523end;
524
525procedure TfrmOptions.ApplyOtherStuff;
526// save other changes
527var
528 aString: string;
529begin
530 aString := '';
531 if chkNotificationsFlagged.Checked then
532 aString := aString + '^1'
533 else
534 aString := aString + '^0';
535 rpcSetOtherStuff(aString);
536 FdirtyOtherStuff := false;
537end;
538
539procedure TfrmOptions.CheckApply;
540// determine if Apply button is enabled
541begin
542 btnApply.Enabled := FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
543end;
544
545procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
546// set notification flagged status
547begin
548 FdirtyOtherStuff := true;
549 CheckApply;
550end;
551
552procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
553// load a list view with: name, on/off, comment
554var
555 i: integer;
556 aListItem: TListItem;
557 aRule: TRule;
558 rulenum, ruletext, ruleonoff, rulecomment: string;
559begin
560 FuseCheckBoxes := false;
561 aListView.Items.Clear;
562 aListView.SortType := stNone; // if Sorting during load then potential error
563 with aList do
564 begin
565 for i := 0 to aList.Count - 1 do
566 begin
567 rulenum := Piece(aList[i], '^', 1);
568 ruletext := Piece(aList[i], '^', 2);
569 ruleonoff := Piece(aList[i], '^', 3);
570 rulecomment := Piece(aList[i], '^', 4);
571 aListItem := aListView.Items.Add;
572 with aListItem do
573 begin
574 Caption := ruletext;
575 SubItems.Add(ruleonoff);
576 if ruleonoff = 'On' then Checked := true;
577 SubItems.Add(rulecomment);
578 end;
579 aRule := TRule.Create;
580 with aRule do
581 begin
582 IEN := rulenum;
583 OriginalValue := ruleonoff;
584 ItemText := ruletext;
585 end;
586// aListItem.SubItems.AddObject('rule object', aRule); <-- original line. //kt 8/8/2007
587 aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
588 end;
589 end;
590 aListView.SortType := stBoth;
591 FuseCheckBoxes := true;
592end;
593
594procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
595 Item: TListItem; Change: TItemChange);
596// change on/off on checkmark
597begin
598 if (Sender as TListView).ItemIndex = -1 then exit;
599 if not FuseCheckBoxes then exit;
600 if (Sender as TListView).Checkboxes = false then exit;
601//if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin <-- original line. //kt 8/8/2007
602 if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
603 Item.Checked := True;
604 exit;
605 end;
606 if Item.Checked then
607 begin
608 if Item.SubItems[0] <> 'On' then
609 ChangeOnOff(Sender as TListView, Item);
610 Item.SubItems[0] := 'On';
611 end
612 else
613 begin
614// if Item.SubItems[0] <> 'Off' then <-- original line. //kt 8/8/2007
615 if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
616 ChangeOnOff(Sender as TListView, Item);
617// Item.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
618 Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
619 end;
620end;
621
622procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
623 Column: TListColumn);
624// toggle sort
625begin
626 if FsortCol = Column.Index then
627 FsortAscending := not FsortAscending
628 else
629 FsortAscending := true;
630 FsortCol := Column.Index;
631 (Sender as TListView).AlphaSort;
632end;
633
634procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
635 Item2: TListItem; Data: Integer; var Compare: Integer);
636// sort columns
637begin
638 if not(Sender is TListView) then exit;
639 if FsortAscending then
640 begin
641 if FsortCol = 0 then
642 Compare := CompareStr(Item1.Caption, Item2.Caption)
643 else
644 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
645 Item2.SubItems[FsortCol - 1]);
646 end
647 else
648 begin
649 if FsortCol = 0 then
650 Compare := CompareStr(Item2.Caption, Item1.Caption)
651 else
652 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
653 Item1.SubItems[FsortCol - 1]);
654 end;
655end;
656
657procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
658// toggle check marks with double click
659var
660 aListItem: TListItem;
661begin
662 with (Sender as TListView) do
663 begin
664 if Checkboxes = false then exit;
665 if Selected = nil then exit;
666// if Selected.SubItems[1] = 'Mandatory' then exit; <-- original line. //kt 8/8/2007
667 if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
668 if Selected <> FLastClickedItem then exit;
669 aListItem := Selected;
670 aListItem.Checked := not aListItem.Checked;
671 ChangeOnOff(Sender as TListView, aListItem);
672
673 if aListItem.Checked then
674 aListItem.SubItems[0] := 'On'
675 else
676// aListItem.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
677 aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
678 end;
679end;
680
681procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
682// check if list items were edited
683begin
684 if aListView = lvwNotifications then FdirtyNotifications := true;
685 if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
686 CheckApply;
687end;
688
689procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
690// display Surrogate Options
691var
692 topsize, leftsize: integer;
693 surrogateinfo: string;
694begin
695 surrogateinfo := btnSurrogate.Hint;
696 Offset(topsize, -30, leftsize, -30);
697 DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
698 LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
699 btnSurrogate.Hint := surrogateinfo;
700end;
701
702procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
703// display Combination List Options
704var
705 topsize, leftsize, value: integer;
706begin
707 value := 0;
708 Offset(topsize, -60, leftsize, -60);
709 DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
710end;
711
712procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
713// display Notes Options
714var
715 topsize, leftsize, value: integer;
716begin
717 value := 0;
718 Offset(topsize, -60, leftsize, -60);
719 DialogOptionsNotes(topsize, leftsize, Font.Size, value);
720end;
721
722procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
723// display Titles Options
724var
725 topsize, leftsize, value: integer;
726begin
727 value := 0;
728 Offset(topsize, -60, leftsize, -60);
729 DialogOptionsTitles(topsize, leftsize, Font.Size, value);
730end;
731
732procedure TfrmOptions.btnReportsClick(Sender: TObject);
733var
734 topsize, leftsize, value: integer;
735begin
736 value := 0;
737 Offset(topsize, 90, leftsize, 23);
738 DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
739end;
740
741procedure TfrmOptions.btnReport1Click(Sender: TObject);
742var
743 topsize, leftsize, value: integer;
744begin
745 value := 0;
746 Offset(topsize, -18, leftsize, -15);
747 DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
748end;
749
750procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
751begin
752 with Sender as TListView do begin
753 if (Selected = nil) and (Items.Count > 0) then
754 Selected := Items[0];
755 end;
756end;
757
758procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
759 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
760begin
761 FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
762end;
763
764procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
765// display Personal Diagnoses List
766var
767 topsize, leftsize, value: integer;
768begin
769 if IsCIDCProvider(User.DUZ) then //(hds7564)
770 begin
771 value := 0;
772 Offset(topsize, -60, leftsize, -60);
773 DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
774 end;
775end;
776
777procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
778// display GraphSettings
779var
780 actiontype: boolean;
781 topsize, leftsize: integer;
782begin
783 actiontype := false;
784 Offset(topsize, -60, leftsize, -60);
785 DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
786end;
787
788procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
789// display Graph Views
790var
791 actiontype: boolean;
792 topsize, leftsize: integer;
793begin
794 actiontype := false;
795 Offset(topsize, -60, leftsize, -60);
796 DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
797end;
798
799procedure TfrmOptions.rdoRDVClick(Sender: TObject);
800var
801 iIndex: integer;
802begin
803 iIndex := rdoRDV.ItemIndex;
804 with frmFrame do
805 if iIndex = 0 then
806 begin
807 ChangeVistaWebParam('0');
808 lblCIRN.Caption := ' Remote';
809 lblCIRNData.Caption := 'Data';
810 lblCIRNAvail.Caption := '';
811 lblCIRN.Width := 43;
812 lblCIRNData.Width := 43;
813 lblCIRNData.Alignment := taCenter;
814 lblCIRN.Alignment := taCenter;
815 lstCIRNLocations.Clear;
816 SetUpCIRN;
817 end
818 else
819 begin
820 ChangeVistaWebParam('1');
821 lblCIRN.Caption := 'Remote';
822 lblCIRNData.Caption := 'Data*'; //VistaWeb On
823 lblCIRN.Width := 43;
824 lblCIRNData.Width := 43;
825 lblCIRNData.Alignment := taCenter;
826 lblCIRN.Alignment := taCenter;
827 lblCIRN.Enabled := True;
828 lblCIRNData.Enabled := True;
829 pnlCIRN.TabStop := True;
830 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
831 begin
832 lblCIRN.Font.Color := clBlue;
833 lblCIRNData.Font.Color := clBlue;
834 lblCIRNAvail.Font.Color := clBlue;
835 lstCIRNLocations.Font.Color := clBlue;
836 end
837 else
838 begin
839 lblCIRN.Font.Color := clWindowText;
840 lblCIRNData.Font.Color := clWindowText;
841 lblCIRNAvail.Font.Color := clWindowText;
842 lstCIRNLocations.Font.Color := clWindowText;
843 end;
844 end;
845
846end;
847
848procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
849var iIndex: Integer;
850CPRSChartINI: TINIFile;
851begin
852 iIndex := cbLanguage.ItemIndex;
853 if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
854 try
855 LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
856 except
857 on EReadError do begin
858 //do nothing. Ignore error.
859 end
860 end;
861 frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
862 frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
863 frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
864 CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini'); // Write to INI elh 6/23/08
865 CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
866 CPRSChartINI.Free;
867
868end;
869
870procedure TfrmOptions.Button1Click(Sender: TObject);
871begin
872 MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
873 'must be in the same directory as CPRSchart.exe. This *.lng file '+
874 'may be created at any time by users by working with the CPRSchart.dklng '+
875 'file with the free language editor found at: '+
876 'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
877end;
878
879end.
880
Note: See TracBrowser for help on using the repository browser.