1 | unit fConsultBS;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form,
|
---|
8 | VA508AccessibilityManager;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TfrmConsultsByService = class(TfrmBase508Form)
|
---|
12 | pnlBase: TORAutoPanel;
|
---|
13 | lblService: TLabel;
|
---|
14 | radSort: TRadioGroup;
|
---|
15 | cmdOK: TButton;
|
---|
16 | cmdCancel: TButton;
|
---|
17 | treService: TORTreeView;
|
---|
18 | cboService: TORComboBox;
|
---|
19 | procedure cmdCancelClick(Sender: TObject);
|
---|
20 | procedure cmdOKClick(Sender: TObject);
|
---|
21 | procedure treServiceChange(Sender: TObject; Node: TTreeNode);
|
---|
22 | procedure cboServiceSelect(Sender: TObject);
|
---|
23 | private
|
---|
24 | FChanged: Boolean;
|
---|
25 | FService: string;
|
---|
26 | FServiceName: string;
|
---|
27 | FAscending: Boolean;
|
---|
28 | fConsultUser: boolean ;
|
---|
29 | end;
|
---|
30 |
|
---|
31 | TServiceContext = record
|
---|
32 | Changed: Boolean;
|
---|
33 | Service: string;
|
---|
34 | ServiceName: string;
|
---|
35 | Ascending: Boolean;
|
---|
36 | ConsultUser: Boolean ;
|
---|
37 | end;
|
---|
38 |
|
---|
39 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
|
---|
40 |
|
---|
41 | implementation
|
---|
42 |
|
---|
43 | {$R *.DFM}
|
---|
44 |
|
---|
45 | uses rConsults, rCore, uCore;
|
---|
46 |
|
---|
47 | var
|
---|
48 | SvcList: TStrings ;
|
---|
49 | SvcInfo: string ;
|
---|
50 | uChanging: Boolean;
|
---|
51 |
|
---|
52 | const
|
---|
53 | TX_SVC_TEXT = 'Select a consult service or press Cancel.';
|
---|
54 | TX_SVC_CAP = 'Missing Service';
|
---|
55 |
|
---|
56 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
|
---|
57 | { displays service select form for consults and returns a record of the selection }
|
---|
58 | var
|
---|
59 | frmConsultsByService: TfrmConsultsByService;
|
---|
60 | W, H, i: Integer;
|
---|
61 | CurrentService: string;
|
---|
62 | begin
|
---|
63 | frmConsultsByService := TfrmConsultsByService.Create(Application);
|
---|
64 | try
|
---|
65 | with frmConsultsByService do
|
---|
66 | begin
|
---|
67 | Font.Size := FontSize;
|
---|
68 | W := ClientWidth;
|
---|
69 | H := ClientHeight;
|
---|
70 | ResizeToFont(FontSize, W, H);
|
---|
71 | ClientWidth := W; pnlBase.Width := W;
|
---|
72 | ClientHeight := H; pnlBase.Height := H;
|
---|
73 | FChanged := False;
|
---|
74 | //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV}
|
---|
75 | FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV}
|
---|
76 | SortByPiece(TStringList(SvcList), U, 2); {RV}
|
---|
77 | for i := 0 to SvcList.Count - 1 do
|
---|
78 | if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then {RV}
|
---|
79 | //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
|
---|
80 | cboService.Items.Add(SvcList.Strings[i]);
|
---|
81 | BuildServiceTree(treService, SvcList, '0', nil) ;
|
---|
82 | with treService do
|
---|
83 | for i := 0 to Items.Count-1 do
|
---|
84 | begin
|
---|
85 | if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
|
---|
86 | TopItem := Items[0] ;
|
---|
87 | Selected := Items[0] ;
|
---|
88 | end ;
|
---|
89 | FAscending := CurrentContext.Ascending;
|
---|
90 | radSort.ItemIndex := Ord(not FAscending);
|
---|
91 | CurrentService := CurrentContext.Service;
|
---|
92 | if StrToIntDef(CurrentService, 0) > 0 then
|
---|
93 | begin
|
---|
94 | cboservice.SelectByID(CurrentService);
|
---|
95 | cboServiceSelect(frmConsultsByService);
|
---|
96 | end;
|
---|
97 | ShowModal;
|
---|
98 | with ServiceContext do
|
---|
99 | begin
|
---|
100 | Changed := FChanged;
|
---|
101 | Service := FService;
|
---|
102 | ServiceName := FServiceName;
|
---|
103 | Ascending := FAscending;
|
---|
104 | ConsultUser := FConsultUser ;
|
---|
105 | Result := Changed ;
|
---|
106 | end; {with ServiceContext}
|
---|
107 | end; {with frmConsultsByService}
|
---|
108 | finally
|
---|
109 | frmConsultsByService.Release;
|
---|
110 | end;
|
---|
111 | end;
|
---|
112 |
|
---|
113 | procedure TfrmConsultsByService.cmdCancelClick(Sender: TObject);
|
---|
114 | begin
|
---|
115 | Close;
|
---|
116 | end;
|
---|
117 |
|
---|
118 | procedure TfrmConsultsByService.cmdOKClick(Sender: TObject);
|
---|
119 | begin
|
---|
120 | if (treService.Selected = nil) and (StrToIntDef(FService, 0) = 0 ) then
|
---|
121 | begin
|
---|
122 | InfoBox(TX_SVC_TEXT, TX_SVC_CAP, MB_OK or MB_ICONWARNING);
|
---|
123 | Exit;
|
---|
124 | end;
|
---|
125 | FChanged := True;
|
---|
126 | FService := Piece(SvcInfo,u,1);
|
---|
127 | FServiceName := Piece(SvcInfo,u,2) ;
|
---|
128 | FAscending := (radSort.ItemIndex = 0);
|
---|
129 | FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
|
---|
130 | Close;
|
---|
131 | end;
|
---|
132 |
|
---|
133 | procedure TfrmConsultsByService.treServiceChange(Sender: TObject;
|
---|
134 | Node: TTreeNode);
|
---|
135 | begin
|
---|
136 | if uChanging then Exit;
|
---|
137 | SvcInfo := TORTreeNode(treService.Selected).StringData ;
|
---|
138 | cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text)); {RV}
|
---|
139 | //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
|
---|
140 | end;
|
---|
141 |
|
---|
142 | procedure TfrmConsultsByService.cboServiceSelect(Sender: TObject);
|
---|
143 | var
|
---|
144 | i: integer;
|
---|
145 | begin
|
---|
146 | uChanging := True;
|
---|
147 | with treService do for i := 0 to Items.Count-1 do
|
---|
148 | begin
|
---|
149 | if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
|
---|
150 | begin
|
---|
151 | Selected := Items[i];
|
---|
152 | //treServiceChange(Self, Items[i]);
|
---|
153 | break;
|
---|
154 | end;
|
---|
155 | end;
|
---|
156 | uChanging := False;
|
---|
157 | SvcInfo := TORTreeNode(treService.Selected).StringData ;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | initialization
|
---|
161 | SvcList := TStringList.Create ;
|
---|
162 |
|
---|
163 | finalization
|
---|
164 | SvcList.Free ;
|
---|
165 |
|
---|
166 | end.
|
---|