Module

fOptionsCombinations

Path

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

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
rCore -
rOptions -

Classes

Name Comments
TCombination -
TfrmOptionsCombinations -

Procedures

Name Owner Declaration Scope Comments
btnAddClick TfrmOptionsCombinations procedure btnAddClick(Sender: TObject); Public/Published -
btnOKClick TfrmOptionsCombinations procedure btnOKClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmOptionsCombinations procedure btnRemoveClick(Sender: TObject); Public/Published -
DialogOptionsCombinations - procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
FormCreate TfrmOptionsCombinations procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmOptionsCombinations procedure FormShow(Sender: TObject); Public/Published -
LoadCombinations TfrmOptionsCombinations procedure LoadCombinations(alist: TStrings); Private -
lstAddByChange TfrmOptionsCombinations procedure lstAddByChange(Sender: TObject); Public/Published -
lstAddByEnter TfrmOptionsCombinations procedure lstAddByEnter(Sender: TObject); Public/Published -
lstAddByExit TfrmOptionsCombinations procedure lstAddByExit(Sender: TObject); Public/Published -
lstAddByKeyUp TfrmOptionsCombinations procedure lstAddByKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
lstAddByNeedData TfrmOptionsCombinations procedure lstAddByNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
lvwCombinationsChange TfrmOptionsCombinations procedure lvwCombinationsChange(Sender: TObject; Item: TListItem; Change: TItemChange); Public/Published -
lvwCombinationsColumnClick TfrmOptionsCombinations procedure lvwCombinationsColumnClick(Sender: TObject; Column: TListColumn); Public/Published -
lvwCombinationsCompare TfrmOptionsCombinations procedure lvwCombinationsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); Public/Published -
radAddByTypeClick TfrmOptionsCombinations procedure radAddByTypeClick(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
Duplicate TfrmOptionsCombinations function Duplicate(avalueien, asource: string): boolean; Private -

Global Variables

Name Type Declaration Comments
frmOptionsCombinations TfrmOptionsCombinations frmOptionsCombinations: TfrmOptionsCombinations; -


Module Source

1     unit fOptionsCombinations;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, StdCtrls, ORCtrls, OrFn, ComCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmOptionsCombinations = class(TfrmBase508Form)
12        radAddByType: TRadioGroup;
13        lblInfo: TMemo;
14        lblAddby: TLabel;
15        lblCombinations: TLabel;
16        lstAddBy: TORComboBox;
17        btnAdd: TButton;
18        btnRemove: TButton;
19        pnlBottom: TPanel;
20        btnOK: TButton;
21        btnCancel: TButton;
22        bvlBottom: TBevel;
23        lvwCombinations: TCaptionListView;
24        procedure radAddByTypeClick(Sender: TObject);
25        procedure lstAddByNeedData(Sender: TObject; const StartFrom: String;
26          Direction, InsertAt: Integer);
27        procedure FormCreate(Sender: TObject);
28        procedure btnAddClick(Sender: TObject);
29        procedure lvwCombinationsColumnClick(Sender: TObject;
30          Column: TListColumn);
31        procedure lvwCombinationsCompare(Sender: TObject; Item1,
32          Item2: TListItem; Data: Integer; var Compare: Integer);
33        procedure btnRemoveClick(Sender: TObject);
34        procedure lstAddByChange(Sender: TObject);
35        procedure lstAddByKeyUp(Sender: TObject; var Key: Word;
36          Shift: TShiftState);
37        procedure btnOKClick(Sender: TObject);
38        procedure lstAddByEnter(Sender: TObject);
39        procedure lstAddByExit(Sender: TObject);
40        procedure lvwCombinationsChange(Sender: TObject; Item: TListItem;
41          Change: TItemChange);
42        procedure FormShow(Sender: TObject);
43      private
44        { Private declarations }
45        FsortCol: integer;
46        FsortAscending: boolean;
47        FDirty: boolean;
48        function Duplicate(avalueien, asource: string): boolean;
49        procedure LoadCombinations(alist: TStrings);
50      public
51        { Public declarations }
52      end;
53    
54    var
55      frmOptionsCombinations: TfrmOptionsCombinations;
56    
57    procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
58    
59    implementation
60    
61    uses rOptions, rCore;
62    
63    {$R *.DFM}
64    
65    type
66      TCombination = class
67      public
68        IEN: string;
69        Entry: string;
70        Source: string;
71    end;
72    
73    procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
74    // create the form and make it modal, return an action
75    var
76      frmOptionsCombinations: TfrmOptionsCombinations;
77    begin
78      frmOptionsCombinations := TfrmOptionsCombinations.Create(Application);
79      actiontype := 0;
80      try
81        with frmOptionsCombinations do
82        begin
83          if (topvalue < 0) or (leftvalue < 0) then
84            Position := poScreenCenter
85          else
86          begin
87            Position := poDesigned;
88            Top := topvalue;
89            Left := leftvalue;
90          end;
91          ResizeAnchoredFormToFont(frmOptionsCombinations);
92          ShowModal;
93          actiontype := btnOK.Tag;
94        end;
95      finally
96        frmOptionsCombinations.Release;
97      end;
98    end;
99    
100   procedure TfrmOptionsCombinations.radAddByTypeClick(Sender: TObject);
101   begin
102     with lstAddBy do
103     begin
104       case radAddByType.ItemIndex of
105         0: begin
106              ListItemsOnly := false;
107              LongList := false;
108              ListWardAll(lstAddBy.Items);
109              MixedCaseList(lstAddBy.Items);
110              lblAddby.Caption := 'Ward:';
111            end;
112         1: begin
113              ListItemsOnly := true;
114              LongList := true;
115              InitLongList('');
116              lblAddby.Caption := 'Clinic:';
117            end;
118         2: begin
119              ListItemsOnly := true;
120              LongList := true;
121              InitLongList('');
122              lblAddby.Caption := 'Provider:';
123            end;
124         3: begin
125              ListItemsOnly := false;
126              LongList := false;
127              ListSpecialtyAll(lstAddBy.Items);
128              lblAddby.Caption := 'Specialty:';
129            end;
130         4: begin
131              ListItemsOnly := false;
132              LongList := false;
133              ListTeamAll(lstAddBy.Items);
134              lblAddby.Caption := 'List:';
135            end;
136       end;
137       lstAddBy.Caption := lblAddby.Caption;
138       ItemIndex := -1;
139       Text := '';
140       btnAdd.Enabled := false;
141     end;
142   end;
143   
144   procedure TfrmOptionsCombinations.lstAddByNeedData(Sender: TObject;
145     const StartFrom: String; Direction, InsertAt: Integer);
146   begin
147     with lstAddBy do
148     begin
149       case radAddByType.ItemIndex of
150         0: begin
151              Pieces := '2';
152            end;
153         1: begin
154              Pieces := '2';
155              ForDataUse(SubSetOfClinics(StartFrom, Direction));
156            end;
157         2: begin
158              Pieces := '2,3';
159              ForDataUse(SubSetOfProviders(StartFrom, Direction));
160            end;
161         3: begin
162              Pieces := '2';
163            end;
164         4: begin
165              Pieces := '2';
166            end;
167       end;
168     end;
169   end;
170   
171   procedure TfrmOptionsCombinations.FormCreate(Sender: TObject);
172   begin
173     radAddByType.ItemIndex := 0;
174     radAddByTypeClick(self);
175     FDirty := false;
176   end;
177   
178   procedure TfrmOptionsCombinations.btnAddClick(Sender: TObject);
179   var
180     aListItem: TListItem;
181     aCombination: TCombination;
182     valueien, valuename, valuesource: string;
183   begin
184     valuesource := radAddByType.Items[radAddByType.ItemIndex];
185     if copy(valuesource, 1, 1) = '&' then
186       valuesource := copy(valuesource, 2, length(valuesource) - 1);
187    { if radAddByType.ItemIndex = 2 then
188      valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1)
189     else } //Removed per PTM 274 - should not peice by the "-" at all
190      valuename := lstAddBy.DisplayText[lstAddBy.ItemIndex];
191     valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
192     if Duplicate(valueien, valuesource) then exit; // check for duplicates
193     aListItem := lvwCombinations.Items.Add;
194     with aListItem do
195     begin
196       Caption := valuename;
197       SubItems.Add(valuesource);
198     end;
199     aCombination := TCombination.Create;
200     with aCombination do
201     begin
202       IEN := valueien;
203       Entry := valuename;
204       Source := valuesource;
205     end;
206     aListItem.SubItems.AddObject('combo object', aCombination);
207     btnAdd.Enabled := false;
208     FDirty := true;
209   end;
210   
211   procedure TfrmOptionsCombinations.lvwCombinationsColumnClick(
212     Sender: TObject; Column: TListColumn);
213   begin
214     if FsortCol = Column.Index then
215       FsortAscending := not FsortAscending
216     else
217       FsortAscending := true;
218     FsortCol := Column.Index;
219     (Sender as TListView).AlphaSort;
220   end;
221   
222   procedure TfrmOptionsCombinations.lvwCombinationsCompare(Sender: TObject;
223     Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
224   begin
225     if not(Sender is TListView) then exit;
226     if FsortAscending then
227     begin
228       if FsortCol = 0 then
229         Compare := CompareStr(Item1.Caption, Item2.Caption)
230       else
231         Compare := CompareStr(Item1.SubItems[FsortCol - 1],
232           Item2.SubItems[FsortCol - 1]);
233     end
234     else
235     begin
236       if FsortCol = 0 then
237         Compare := CompareStr(Item2.Caption, Item1.Caption)
238       else
239         Compare := CompareStr(Item2.SubItems[FsortCol - 1],
240           Item1.SubItems[FsortCol - 1]);
241     end;
242   end;
243   
244   procedure TfrmOptionsCombinations.btnRemoveClick(Sender: TObject);
245   var
246     i: integer;
247   begin
248     with lvwCombinations do
249     for i := Items.Count - 1 downto 0 do
250       if Items[i].Selected then
251         Items[i].Delete;
252     btnRemove.Enabled := false;
253     FDirty := true;
254   end;
255   
256   procedure TfrmOptionsCombinations.lstAddByChange(Sender: TObject);
257   var
258     valueien, source: string;
259   begin
260     if lstAddBy.ItemIndex = -1 then
261       btnAdd.Enabled := false
262     else
263     begin
264       source := radAddByType.Items[radAddByType.ItemIndex];
265       if copy(source, 1, 1) = '&' then
266         source := copy(source, 2, length(source) - 1);
267       valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
268       btnAdd.Enabled :=  not Duplicate(valueien, source);
269     end;
270     btnRemove.Enabled := false;
271   end;
272   
273   function TfrmOptionsCombinations.Duplicate(avalueien,
274     asource: string): boolean;
275   var
276     i: integer;
277     aCombination :TCombination;
278   begin
279     result := false;
280     with lvwCombinations do
281     for i := 0 to Items.Count - 1 do
282       if asource = Items[i].Subitems[0] then
283       begin
284         aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
285         if aCombination.IEN = avalueien then
286         begin
287           Result := true;
288         end;
289       end;
290   end;
291   
292   procedure TfrmOptionsCombinations.lstAddByKeyUp(Sender: TObject;
293     var Key: Word; Shift: TShiftState);
294   begin
295     if Key = 13 then Perform(WM_NextDlgCtl, 0, 0);
296   end;
297   
298   procedure TfrmOptionsCombinations.btnOKClick(Sender: TObject);
299   var
300     i: integer;
301     alist: TStringList;
302     aCombination :TCombination;
303   begin
304     if FDirty then
305     begin
306       alist := TStringList.Create;
307       with lvwCombinations do
308       for i := 0 to Items.Count - 1 do
309       begin
310         aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
311         with aCombination do alist.Add(IEN + '^' + Source);
312       end;
313       rpcSetCombo(alist);
314       alist.Free;
315     end;
316   end;
317   
318   procedure TfrmOptionsCombinations.lstAddByEnter(Sender: TObject);
319   begin
320     btnAdd.Default := true;
321   end;
322   
323   procedure TfrmOptionsCombinations.lstAddByExit(Sender: TObject);
324   begin
325     btnAdd.Default := false;
326   end;
327   
328   procedure TfrmOptionsCombinations.lvwCombinationsChange(Sender: TObject;
329     Item: TListItem; Change: TItemChange);
330   begin
331     btnRemove.Enabled := lvwCombinations.SelCount > 0;
332   end;
333   
334   procedure TfrmOptionsCombinations.LoadCombinations(alist: TStrings);
335   var
336     i: integer;
337     aListItem: TListItem;
338     aCombination: TCombination;
339     valueien, valuename, valuesource: string;
340   begin
341     for i := 0 to alist.Count - 1 do
342     begin
343       valuesource := Piece(alist[i], '^', 1);
344       valuename := Piece(alist[i], '^', 2);
345       valueien := Piece(alist[i], '^', 3);
346       aListItem := lvwCombinations.Items.Add;
347       with aListItem do
348       begin
349         Caption := valuename;
350         SubItems.Add(valuesource);
351       end;
352       aCombination := TCombination.Create;
353       with aCombination do
354       begin
355         IEN := valueien;
356         Entry := valuename;
357         Source := valuesource;
358       end;
359       aListItem.SubItems.AddObject('combo object', aCombination);
360     end;
361   end;
362   
363   procedure TfrmOptionsCombinations.FormShow(Sender: TObject);
364   begin
365     LoadCombinations(rpcGetCombo);
366   end;
367   
368   end.

Module Calls (2 levels)


fOptionsCombinations
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 └rCore...

Module Called-By (2 levels)


fOptionsCombinations
          fOptions┘ 
          fFrame┘