Module

fOptionsTitles

Path

C:\CPRS\CPRS30\Options\fOptionsTitles.pas

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rConsults -
rCore -
rDCSumm -
rOptions -
rTIU -
uOptions -

Classes

Name Comments
TfrmOptionsTitles -

Procedures

Name Owner Declaration Scope Comments
AddIfUnique TfrmOptionsTitles procedure AddIfUnique(entry: string; aList: TORListBox); Private -
btnAddClick TfrmOptionsTitles procedure btnAddClick(Sender: TObject); Public/Published -
btnDefaultClick TfrmOptionsTitles procedure btnDefaultClick(Sender: TObject); Public/Published -
btnDownClick TfrmOptionsTitles procedure btnDownClick(Sender: TObject); Public/Published -
btnOKClick TfrmOptionsTitles procedure btnOKClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmOptionsTitles procedure btnRemoveClick(Sender: TObject); Public/Published -
btnSaveChangesClick TfrmOptionsTitles procedure btnSaveChangesClick(Sender: TObject); Public/Published -
btnUpClick TfrmOptionsTitles procedure btnUpClick(Sender: TObject); Public/Published -
cboDocumentClassClick TfrmOptionsTitles procedure cboDocumentClassClick(Sender: TObject); Public/Published -
cboDocumentTitlesChange TfrmOptionsTitles procedure cboDocumentTitlesChange(Sender: TObject); Public/Published -
cboDocumentTitlesNeedData TfrmOptionsTitles procedure cboDocumentTitlesNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
CheckEnable TfrmOptionsTitles procedure CheckEnable; Private Allow buttons to be enabled or not depending on selections
DialogOptionsTitles - procedure DialogOptionsTitles(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
FormShow TfrmOptionsTitles procedure FormShow(Sender: TObject); Public/Published -
lstYourTitlesChange TfrmOptionsTitles procedure lstYourTitlesChange(Sender: TObject); Public/Published -
lstYourTitlesClick TfrmOptionsTitles procedure lstYourTitlesClick(Sender: TObject); Public/Published -
RemoveSelected TfrmOptionsTitles procedure RemoveSelected; Public/Published -
SetItem TfrmOptionsTitles procedure SetItem(aList: TORListBox; index: integer); Public/Published -

Functions

Name Owner Declaration Scope Comments
GetFirstSelection TfrmOptionsTitles function GetFirstSelection(aList: TORListBox): integer; Public/Published -
MemberNotOnList TfrmOptionsTitles function MemberNotOnList(alist: TStrings; listnum: string): boolean; Private -

Global Variables

Name Type Declaration Comments
frmOptionsTitles TfrmOptionsTitles frmOptionsTitles: TfrmOptionsTitles; -


Module Source

1     unit fOptionsTitles;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, StdCtrls, ORCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
8     
9     type
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    
57    var
58      frmOptionsTitles: TfrmOptionsTitles;
59    
60    procedure DialogOptionsTitles(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
61    
62    implementation
63    
64    {$R *.DFM}
65    
66    uses
67      rOptions, uOptions, rCore, rTIU, rConsults, rDCSumm;
68    
69    procedure DialogOptionsTitles(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
70    // create the form and make it modal, return an action
71    var
72      frmOptionsTitles: TfrmOptionsTitles;
73    begin
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;
94    end;
95    
96    procedure TfrmOptionsTitles.FormShow(Sender: TObject);
97    var
98      i: integer;
99    begin
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);
114   end;
115   
116   procedure TfrmOptionsTitles.btnOKClick(Sender: TObject);
117   begin
118     if btnSaveChanges.Enabled then
119       btnSaveChangesClick(self);
120     ResetTIUPreferences;
121     ResetDCSummPreferences;
122   end;
123   
124   procedure TfrmOptionsTitles.cboDocumentClassClick(Sender: TObject);
125   var
126     aList: TStringList;
127     defaultIEN: integer;
128   begin
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;
163   end;
164   
165   procedure TfrmOptionsTitles.cboDocumentTitlesNeedData(Sender: TObject;
166     const StartFrom: String; Direction, InsertAt: Integer);
167   begin
168     with cboDocumentTitles do
169       begin
170         HideSynonyms := (cboDocumentClass.ItemIEN <> CLS_PROGRESS_NOTES);
171         ForDataUse(rpcGetTitlesForClass(cboDocumentClass.ItemIEN, StartFrom, Direction));
172       end;
173   end;
174   
175   procedure TfrmOptionsTitles.btnSaveChangesClick(Sender: TObject);
176   var
177     classnum: integer;
178   begin
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;
189   end;
190   
191   procedure TfrmOptionsTitles.btnDefaultClick(Sender: TObject);
192   begin
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;
217   end;
218   
219   procedure TfrmOptionsTitles.btnAddClick(Sender: TObject);
220   begin
221     AddIfUnique(cboDocumentTitles.Items[cboDocumentTitles.ItemIndex], lstYourTitles);
222     lstYourTitles.SelectByIEN(cboDocumentTitles.ItemIEN);
223     btnSaveChanges.Enabled := true;
224     btnAdd.Enabled := false;
225     CheckEnable;
226   end;
227   
228   procedure TfrmOptionsTitles.lstYourTitlesChange(Sender: TObject);
229   begin
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
244   end;
245   
246   procedure TfrmOptionsTitles.btnRemoveClick(Sender: TObject);
247   var
248     index: integer;
249   begin
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;
262   end;
263   
264   procedure TfrmOptionsTitles.AddIfUnique(entry: string; aList: TORListBox);
265   var
266     i: integer;
267     ien: string;
268     inlist: boolean;
269   begin
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);
281   end;
282   
283   function TfrmOptionsTitles.MemberNotOnList(alist: TStrings; listnum: string): boolean;
284   var
285     i: integer;
286   begin
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;
295   end;
296   
297   procedure TfrmOptionsTitles.cboDocumentTitlesChange(Sender: TObject);
298   begin
299     CheckEnable;
300   end;
301   
302   procedure TfrmOptionsTitles.btnUpClick(Sender: TObject);
303   var
304     newindex, i: integer;
305   begin
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);
323   end;
324   
325   procedure TfrmOptionsTitles.btnDownClick(Sender: TObject);
326   var
327     newindex, i: integer;
328   begin
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);
346   end;
347   
348   function TfrmOptionsTitles.GetFirstSelection(aList: TORListBox): integer;
349   begin
350     for result := 0 to aList.Items.Count - 1 do
351       if aList.Selected[result] then exit;
352     result := LB_ERR;
353   end;
354   
355   procedure TfrmOptionsTitles.SetItem(aList: TORListBox; index: integer);
356   var
357     maxindex: integer;
358   begin
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;
369   end;
370   
371   procedure TfrmOptionsTitles.RemoveSelected;
372   var
373     i: integer;
374   begin
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;
388   end;
389   
390   procedure TfrmOptionsTitles.CheckEnable;
391   // allow buttons to be enabled or not depending on selections
392   var
393     astring: string;
394   begin
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;
429   end;
430   
431   procedure TfrmOptionsTitles.lstYourTitlesClick(Sender: TObject);
432   begin
433     lstYourTitlesChange(self);    // need to check default
434     CheckEnable;
435   end;
436   
437   end.

Module Calls (2 levels)


fOptionsTitles
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 ├rTIU
 │ ├rCore...
 │ ├uCore
 │ ├uConst
 │ ├uTIU
 │ └rMisc
 ├rConsults
 │ ├rCore...
 │ ├uCore...
 │ ├uConsults
 │ └uTIU
 └rDCSumm
   ├rCore...
   ├uCore...
   ├rTIU...
   ├uConst
   ├uTIU
   └uDCSumm

Module Called-By (2 levels)


fOptionsTitles
    fOptions┘ 
    fFrame┘