1 | { **************************************************************
|
---|
2 | Package: XWB - Kernel RPCBroker
|
---|
3 | Date Created: Sept 18, 1997 (Version 1.1)
|
---|
4 | Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
|
---|
5 | Developers: Danila Manapsal, Don Craven, Joel Ivey
|
---|
6 | Description: Handles Division selection for multidivision
|
---|
7 | users.
|
---|
8 | Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
|
---|
9 | *************************************************************** }
|
---|
10 |
|
---|
11 | {**************************************************
|
---|
12 | This will ONLY be invoked when user has more than one division to select from
|
---|
13 | in NEW Person file. If user only has one division, that division will be used;
|
---|
14 | else it will default to whatever is in the Kernel Site Parameter file.
|
---|
15 |
|
---|
16 | XWB*1.1*13, Silent Login, allows for silent log-in functionality - DCM
|
---|
17 | last updated: 5/24/00
|
---|
18 | ------------------------------------------------------------------------------}
|
---|
19 |
|
---|
20 |
|
---|
21 | unit SelDiv;
|
---|
22 |
|
---|
23 | interface
|
---|
24 |
|
---|
25 | uses
|
---|
26 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
27 | StdCtrls, MFunStr, Buttons, Trpcb;
|
---|
28 |
|
---|
29 | type
|
---|
30 | TSelDivForm = class(TForm)
|
---|
31 | btnOK: TBitBtn;
|
---|
32 | btnCancel: TBitBtn;
|
---|
33 | btnHelp: TBitBtn;
|
---|
34 | DivLabel1: TLabel;
|
---|
35 | DivListBox: TListBox;
|
---|
36 | procedure btnOKClick(Sender: TObject);
|
---|
37 | procedure btnCancelClick(Sender: TObject);
|
---|
38 | procedure btnHelpClick(Sender: TObject);
|
---|
39 | procedure FormCreate(Sender: TObject);
|
---|
40 | private
|
---|
41 | { Private declarations }
|
---|
42 | public
|
---|
43 | { Public declarations }
|
---|
44 | procedure Enter;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | function ChooseDiv(userid : string; MDivBroker: TRPCBroker): Boolean;
|
---|
48 | function SetDiv(division : string; MDivBroker: TRPCBroker): boolean; //p13
|
---|
49 | function MultDiv(MDivBroker: TRPCBroker): boolean;
|
---|
50 | function SelectDivision(DivisionArray: TStrings; MDivBroker: TRPCBroker): Boolean;
|
---|
51 |
|
---|
52 | var
|
---|
53 | SelDivForm: TSelDivForm;
|
---|
54 |
|
---|
55 | implementation
|
---|
56 |
|
---|
57 | var
|
---|
58 | DivSel : string;
|
---|
59 | CntDiv : integer;
|
---|
60 | DivArray : TStrings; //Holds Results from 'XUS Division Get'
|
---|
61 | {$R *.DFM}
|
---|
62 |
|
---|
63 | {------------------------------ChooseDiv---------------------------------}
|
---|
64 | { This function will retrieve the divisions for a user. The user will
|
---|
65 | then choose one division for signon. 'USERID' parameter is for future use
|
---|
66 | that will bring back a list of divisions for a user based on their DUZ
|
---|
67 | (or username to lookup DUZ), not based on the DUZ as it exists in the
|
---|
68 | symbol table. }
|
---|
69 |
|
---|
70 | function ChooseDiv(userid : string; MDivBroker: TRPCBroker): Boolean;
|
---|
71 | var
|
---|
72 | division : string;
|
---|
73 | begin
|
---|
74 | Result := false; // stays 'false' if user not select division.
|
---|
75 | with MDivBroker do begin
|
---|
76 | if userid <> '' then // future use - - DUZ is passed in.
|
---|
77 | begin
|
---|
78 | with Param[0] do begin
|
---|
79 | Value := userid;
|
---|
80 | PType := literal;
|
---|
81 | end;
|
---|
82 | end;
|
---|
83 | RemoteProcedure := 'XUS DIVISION GET';
|
---|
84 | Call;
|
---|
85 | CntDiv := StrToInt(MDivBroker.Results[0]); //count of divisions.
|
---|
86 | end;{with}
|
---|
87 |
|
---|
88 | if CntDiv = 0 then Result := true; //using the Kernel default division.
|
---|
89 |
|
---|
90 | if CntDiv > 0 then
|
---|
91 | begin
|
---|
92 | DivArray := TStringlist.Create; //Put Results in DivArray
|
---|
93 | DivArray.Assign(MDivBroker.Results);
|
---|
94 | try
|
---|
95 | SelDivForm := TSelDivForm.Create(Application); //create division form.
|
---|
96 | ShowApplicationAndFocusOK(Application);
|
---|
97 | SetForegroundWindow(SelDivForm.Handle);
|
---|
98 | SelDivForm.Enter;
|
---|
99 | finally;
|
---|
100 | SelDivForm.Free;
|
---|
101 | end;
|
---|
102 | end;{if/begin}
|
---|
103 |
|
---|
104 | if SelDiv.DivSel <> '' then
|
---|
105 | begin
|
---|
106 | Result := True; //user selected a division.
|
---|
107 | division := Piece((Piece(SelDiv.DivSel,'(',2)),')',1);
|
---|
108 | if SetDiv(division,MDivBroker) then MDivBroker.User.Division := Division;
|
---|
109 |
|
---|
110 | end;{if/begin}
|
---|
111 | end;{procedure}
|
---|
112 |
|
---|
113 | function SelectDivision(DivisionArray: TStrings; MDivBroker: TRPCBroker): Boolean;
|
---|
114 | var
|
---|
115 | division : string;
|
---|
116 | begin
|
---|
117 | Result := false;
|
---|
118 | with MDivBroker do
|
---|
119 | begin
|
---|
120 | if DivisionArray.Count = 0 then
|
---|
121 | begin
|
---|
122 | RemoteProcedure := 'XUS DIVISION GET';
|
---|
123 | Call;
|
---|
124 | CntDiv := StrToInt(Results[0]); //count of divisions.
|
---|
125 | DivisionArray.Assign(Results);
|
---|
126 | end;
|
---|
127 | end;{with}
|
---|
128 | if CntDiv = 0 then //using the Kernel default division.
|
---|
129 | begin
|
---|
130 | Result := true;
|
---|
131 | exit;
|
---|
132 | end;
|
---|
133 | if CntDiv > 0 then
|
---|
134 | begin
|
---|
135 | DivArray := TStringlist.Create; //Put Results in DivArray
|
---|
136 | DivArray.Assign(DivisionArray);
|
---|
137 | try
|
---|
138 | SelDivForm := TSelDivForm.Create(Application); //create division form.
|
---|
139 | ShowApplicationAndFocusOK(Application);
|
---|
140 | SetForegroundWindow(SelDivForm.Handle);
|
---|
141 | SelDivForm.Enter;
|
---|
142 | finally;
|
---|
143 | SelDivForm.Free;
|
---|
144 | end; {try}
|
---|
145 | end; {if/begin}
|
---|
146 | if DivSel <> '' then
|
---|
147 | begin
|
---|
148 | Result := True; //user selected a division.
|
---|
149 | division := Piece((Piece(SelDiv.DivSel,'(',2)),')',1);
|
---|
150 | //division := Piece(SelDiv.DivSel,'^',2);
|
---|
151 | if SetDiv(division,MDivBroker) then MDivBroker.User.Division := Division;
|
---|
152 | end{if divsel}
|
---|
153 | else MDivBroker.LogIn.ErrorText := 'Invalid Division';
|
---|
154 | end;{function}
|
---|
155 |
|
---|
156 | function MultDiv(MDivBroker: TRPCBroker): boolean;
|
---|
157 | begin
|
---|
158 | Result := False;
|
---|
159 | with MDivBroker do
|
---|
160 | begin
|
---|
161 | RemoteProcedure := 'XUS DIVISION GET';
|
---|
162 | Call;
|
---|
163 | CntDiv := StrToInt(Results[0]); //count of divisions.
|
---|
164 | if CntDiv > 0 then
|
---|
165 | with Login do
|
---|
166 | begin
|
---|
167 | DivList.Assign(Results);//store the divisions
|
---|
168 | MultiDivision := True;
|
---|
169 | Result := True;
|
---|
170 | end;
|
---|
171 | end;
|
---|
172 | end;
|
---|
173 |
|
---|
174 | {----------------------------SetDiv--------------------------------}
|
---|
175 | { This function will set DUZ(2) to the division the user selected. }
|
---|
176 |
|
---|
177 | function SetDiv(division : string; MDivBroker: TRPCBroker): boolean;
|
---|
178 | begin
|
---|
179 | Result := False;
|
---|
180 | with MDivBroker do begin
|
---|
181 | Param[0].Value := division;
|
---|
182 | Param[0].PType := literal;
|
---|
183 | RemoteProcedure := 'XUS DIVISION SET';
|
---|
184 | Call;
|
---|
185 | if Results[0] = '1' then Result := True //1= DUZ(2) set successfully to division.
|
---|
186 | else Login.ErrorText := 'Invalid Division';
|
---|
187 | end;{with} //0= DUZ(2) NOT able to set to division.
|
---|
188 | end;
|
---|
189 |
|
---|
190 | procedure TSelDivForm.Enter;
|
---|
191 | begin
|
---|
192 | try
|
---|
193 | ShowModal; //invoke division form
|
---|
194 | finally
|
---|
195 |
|
---|
196 | end;
|
---|
197 | end;
|
---|
198 |
|
---|
199 | procedure TSelDivForm.btnOKClick(Sender: TObject);
|
---|
200 | begin
|
---|
201 | if DivListBox.ItemIndex = -1 then //nothing selected.
|
---|
202 | ShowMessage('A Division was not selected!')
|
---|
203 | else
|
---|
204 | begin
|
---|
205 | SelDiv.DivSel := DivListBox.Items [DivListBox.ItemIndex]; //division
|
---|
206 | close; // selected.
|
---|
207 | end;
|
---|
208 | end;
|
---|
209 |
|
---|
210 | procedure TSelDivForm.btnCancelClick(Sender: TObject);
|
---|
211 | begin
|
---|
212 | close;
|
---|
213 | end;
|
---|
214 |
|
---|
215 | procedure TSelDivForm.btnHelpClick(Sender: TObject);
|
---|
216 | begin
|
---|
217 | ShowMessage('Select a division from the list and click OK.'+
|
---|
218 | ' A division must be selected in order to continue with your signon.' +
|
---|
219 | ' To abort process click on Cancel but signon will NOT be completed.')
|
---|
220 | end;
|
---|
221 |
|
---|
222 | procedure TSelDivForm.FormCreate(Sender: TObject);
|
---|
223 | var
|
---|
224 | I : integer;
|
---|
225 | X : string;
|
---|
226 | y,def: string;
|
---|
227 | begin
|
---|
228 | def := '';
|
---|
229 | SelDiv.DivSel := ''; //clear any old selection
|
---|
230 | I := 1;
|
---|
231 | while not (I > CntDiv) do
|
---|
232 | begin
|
---|
233 | X := DivArray[I];
|
---|
234 | y := '(' + Piece(X,U,3) + ') ' + Piece(X,U,2); //p13 moved div# in front
|
---|
235 | //of div name
|
---|
236 | DivListBox.Items.Add(y); // + ' ^' + IntToStr(I));
|
---|
237 | if Piece(X,U,4) = '1' then def := y;
|
---|
238 | I := I + 1;
|
---|
239 | end;
|
---|
240 | DivListBox.Sorted := TRUE;
|
---|
241 | if def <> '' then DivListBox.ItemIndex := DivListBox.Items.Indexof(def); //use itemindex to highlight the default division
|
---|
242 | end;
|
---|
243 |
|
---|
244 | end.
|
---|
245 |
|
---|