close Warning: Can't use blame annotator: 
svn blame failed on cprs/branches/GUI-config/SubfilesU.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/branches/GUI-config/SubfilesU.pas@ 1094

Last change on this file since 1094 was 828, checked in by Kevin Toppenberg, 14 years ago

Sortable grids, fixed hint-bug
File size: 13.6 KB
RevLine 
1unit SubfilesU;
2 (*
3 WorldVistA Configuration Utility
4 (c) 8/2008 Kevin Toppenberg
5 Programmed by Kevin Toppenberg, Eddie Hagood
6
7 Family Physicians of Greeneville, PC
8 1410 Tusculum Blvd, Suite 2600
9 Greeneville, TN 37745
10 kdtop@yahoo.com
11
12 This library is free software; you can redistribute it and/or
13 modify it under the terms of the GNU Lesser General Public
14 License as published by the Free Software Foundation; either
15 version 2.1 of the License, or (at your option) any later version.
16
17 This library is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 Lesser General Public License for more details.
21
22 You should have received a copy of the GNU Lesser General Public
23 License along with this library; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25 *)
26
27interface
28
29uses
30 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
31 StrUtils, MainU,
32 Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls, Buttons, SortStringGrid;
33
34type
35 TSubfileForm = class(TForm)
36 Panel1: TPanel;
37 TreeView: TTreeView;
38 SubFileGrid: TSortStringGrid;
39 Splitter1: TSplitter;
40 SubFileLabel: TLabel;
41 RightPanel: TPanel;
42 ButtonPanel: TPanel;
43 ApplyBtn: TBitBtn;
44 RevertBtn: TBitBtn;
45 DoneBtn: TBitBtn;
46 LeftPanel: TPanel;
47 Panel5: TPanel;
48 AddBtn: TBitBtn;
49 DeleteBtn: TBitBtn;
50 procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
51 procedure TreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
52 procedure FormCreate(Sender: TObject);
53 procedure FormDestroy(Sender: TObject);
54 procedure SubFileGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
55 procedure AddBtnClick(Sender: TObject);
56 procedure FormShow(Sender: TObject);
57 procedure RevertBtnClick(Sender: TObject);
58 procedure ApplyBtnClick(Sender: TObject);
59 procedure SubFileGridClick(Sender: TObject);
60 procedure DoneBtnClick(Sender: TObject);
61 procedure DeleteBtnClick(Sender: TObject);
62 private
63 { Private declarations }
64 Root : TTreeNode;
65 FSubFileNum : string;
66 FParentIENS : string;
67 IENS_Store : TStringList;
68 BlankFileInfo : TStringList;
69 //FLastSelectedRow : integer;
70 FLastSelectedNode : TTreeNode;
71 AllSubRecords : TStringList;
72 LastAddNum : integer;
73 IgnoreSelections : boolean;
74 CurrentSubFileData : TStringList;
75 GridInfo : TGridInfo;
76 ModifiedForm : boolean; //Used to see if current record is unsaved
77 procedure CompileChanges(Grid : TSortStringGrid; CurrentUser,Changes : TStringList);
78 procedure PostChanges(Grid : TSortStringGrid; IENS : string; SilentMode : boolean = false);
79 procedure GetAllSubRecords(SubFileNum, ParentIENS : string; SubRecsList : TStringList);
80 procedure InitTreeView;
81 Procedure LoadTreeView(AllSubRecords : TStringList);
82 Procedure ClearTreeView;
83// procedure ClearGrid;
84 function GetIENS(Node: TTreeNode) : string;
85 function StoreIENS(IENS: string) : integer;
86 public
87 { Public declarations }
88 procedure PrepForm(subFileNum : string; ParentIENS : string);
89 end;
90
91const
92 MSG_SUB_FILE = 'SubFile';
93
94implementation
95
96uses
97 ORNet, ORFn, ORCtrls,
98 Trpcb, //needed for .ptype types
99 ToolWin, SelDateTimeU, SetSelU, LookupU, PostU, FMErrorU;
100
101{$R *.dfm}
102
103 procedure TSubfileForm.PrepForm(subFileNum : string; ParentIENS : string);
104 //Format is: FileNum^IENS^FieldNum^ExternalValue^DDInfo...
105 begin
106 GridInfo.Grid := SubFileGrid;
107 GridInfo.Data := CurrentSubFileData;
108 GridInfo.BasicMode := false;
109 GridInfo.FileNum := subFileNum;
110 GridInfo.IENS := ParentIENS;
111 GridInfo.ApplyBtn := ApplyBtn;
112 GridInfo.RevertBtn := RevertBtn;
113 MainForm.RegisterGridInfo(GridInfo);
114
115 BlankFileInfo.Clear;
116 IENS_Store.Clear;
117 FSubFileNum := subFileNum;
118 FParentIENS := ParentIENS;
119 self.caption := 'Edit Sub-File Entries in Subfile #' + subFileNum;
120 ClearTreeView;
121 InitTreeView;
122 end;
123
124 procedure TSubfileForm.InitTreeView;
125 begin
126 IgnoreSelections := true;
127 GetAllSubRecords(FSubFileNum,FParentIENS, AllSubRecords);
128 MainForm.ClearGrid(SubFileGrid);
129 LoadTreeView(AllSubRecords);
130 Root.Expand(true);
131 IgnoreSelections := false;
132 end;
133
134 Procedure TSubfileForm.LoadTreeView(AllSubRecords : TStringList);
135 //Format is: FullIENS^.01Value
136
137 var i : integer;
138 dataLine : integer;
139 oneEntry,value,Name,IENS : string;
140 begin
141 ClearTreeView;
142 for i := 1 to AllSubRecords.Count-1 do begin //0 is 1^Success
143 oneEntry := AllSubRecords.Strings[i];
144 IENS := Piece(oneEntry,'^',1);
145 value := Piece(oneEntry,'^',2);
146 dataLine := StoreIENS(IENS);
147 Name := value;
148 //Name := value + '^'+ IENS;
149 //TreeView.Items.AddChild(Root,Name);
150 TreeView.Items.AddChildObject(Root,Name,Pointer(dataLine));
151 end;
152 End;
153
154 Procedure TSubfileForm.ClearTreeView;
155 begin
156 TreeView.Items.Clear;
157 IENS_Store.Clear;
158 Root := TreeView.Items.Add(nil,'Subrecords');
159 //if Root.HasChildren then Root.DeleteChildren;
160// ClearGrid;
161 MainForm.ClearGrid(SubFileGrid);
162
163 end;
164
165
166 procedure TSubfileForm.TreeViewChanging(Sender: TObject; Node: TTreeNode;
167 var AllowChange: Boolean);
168 begin
169 ApplyBtnClick(self);
170 end;
171
172 procedure TSubfileForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
173 begin
174 FLastSelectedNode := Node;
175 GridInfo.IENS := GetIENS(Node);
176 MainForm.GetOneRecord(GridInfo.FileNum, GridInfo.IENS, GridInfo.Data, BlankFileInfo);
177 MainForm.LoadAnyGridFromInfo(GridInfo);
178 end;
179
180 function TSubfileForm.GetIENS(Node: TTreeNode) : string;
181 var dataLine : integer;
182 begin
183 if Node= nil then exit;
184 dataLine := integer(Node.Data);
185 if dataLine < IENS_Store.Count then begin
186 result := IENS_Store.Strings[dataLine];
187 end else result := '';
188 end;
189
190 function TSubfileForm.StoreIENS(IENS: string) : integer;
191 begin
192 result := IENS_Store.Add(IENS);
193 end;
194
195
196 procedure TSubfileForm.GetAllSubRecords(SubFileNum, ParentIENS : string; SubRecsList : TStringList);
197 var cmd,RPCResult : string;
198 begin
199 SubRecsList.Clear;
200 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
201 RPCBrokerV.Param[0].Value := '.X'; // not used
202 RPCBrokerV.param[0].ptype := list;
203 cmd := 'GET SUB RECS LIST' + '^' + SubFileNum + '^' + ParentIENS;
204 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
205 RPCBrokerV.Call;
206 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
207 if piece(RPCResult,'^',1)='-1' then begin
208 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
209 FMErrorForm.PrepMessage;
210 FMErrorForm.ShowModal;
211 end else begin
212 SubRecsList.Assign(RPCBrokerV.Results);
213 end;
214 end;
215
216 procedure TSubfileForm.FormCreate(Sender: TObject);
217 begin
218 AllSubRecords := TStringList.Create;
219 BlankFileInfo := TStringList.Create;
220 IENS_Store := TStringList.Create;
221 CurrentSubFileData := TStringList.Create;
222 GridInfo := TGridInfo.Create;
223
224 ModifiedForm := False;
225 end;
226
227 procedure TSubfileForm.FormDestroy(Sender: TObject);
228 begin
229 AllSubRecords.Free;
230 BlankFileInfo.Free;
231 IENS_Store.Free;
232 CurrentSubFileData.Free;
233 MainForm.UnRegisterGridInfo(GridInfo);
234 GridInfo.Free;
235 end;
236
237 procedure TSubfileForm.SubFileGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
238 begin
239 GridInfo.Message := MSG_SUB_FILE;
240 MainForm.GridSelectCell(Sender, ACol, ARow, CanSelect);
241 end;
242
243
244 procedure TSubfileForm.AddBtnClick(Sender: TObject);
245 var Name,IENS : string;
246 tempNode : TTreeNode;
247 dataLine : integer;
248 begin
249 RevertBtn.Enabled := True;
250 ApplyBtn.Enabled := True;
251 ModifiedForm := True;
252 Inc(LastAddNum);
253 IENS := '+' + IntToStr(LastAddNum) + ',' + FParentIENS;
254 Name := '<NEW>';
255 dataLine := StoreIENS(IENS);
256 tempNode := TreeView.Items.AddChildObject(Root,Name,Pointer(dataLine));
257 MainForm.GetOneRecord(FSubfileNum,IENS,CurrentSubFileData, BlankFileInfo);
258 Root.expand(true);
259 TreeView.Select(tempNode);
260 end;
261
262 procedure TSubfileForm.FormShow(Sender: TObject);
263 begin
264 LastAddNum := 0;
265 end;
266
267 procedure TSubfileForm.RevertBtnClick(Sender: TObject);
268 begin
269 ModifiedForm := False;
270 MainForm.LoadAnyGridFromInfo(GridInfo);
271 end;
272
273 procedure TSubfileForm.ApplyBtnClick(Sender: TObject);
274 var IENS : string;
275 begin
276 ModifiedForm := False;
277 IENS := GetIENS(FLastSelectedNode);
278 PostChanges(SubFileGrid,IENS);
279 end;
280
281 procedure TSubfileForm.SubFileGridClick(Sender: TObject);
282 //var sel : TGridRect;
283 // temp : boolean;
284 begin
285 ModifiedForm := True;
286 RevertBtn.Enabled := True;
287 ApplyBtn.Enabled := True;
288 {//kt Eddie, what was the purpose of this? Causes unexpected click
289 when returning from sub-sub file...
290 Sel := SubFileGrid.Selection;
291 if Sel.Top <> FLastSelectedRow then begin
292 SubFileGridSelectCell(SubFileGrid, Sel.Left, Sel.Top, temp);
293 end;
294 }
295 end;
296
297
298 procedure TSubfileForm.PostChanges(Grid : TSortStringGrid; IENS : string; SilentMode : boolean);
299
300 function NewIENS(oldIENS : string; PostResults : TStringList) : string;
301 //format of PostResults is: oldIENS^newIENS
302 var i : integer;
303 oneEntry : string;
304 newIENS,
305 parentIENS : string;
306 begin
307 result := '';
308 newIENS := piece(oldIENS,',',1); // +1,123, --> +1
309 parentIENS := MidStr(oldIENS,length(newIENS)+1,99);
310 newIENS := piece(newIENS,'+',2); // +1 --> 1
311 for i := 1 to PostResults.Count-1 do begin //0 is 1^Success
312 oneEntry := PostResults.Strings[i];
313 if piece(oneEntry,'^',1) <> newIENS then continue;
314 result := piece(oneEntry,'^',2) + parentIENS;
315 break;
316 end;
317 end;
318
319 var Changes : TStringList;
320 PostResult : TModalResult;
321 begin
322 Changes := TStringList.Create;
323 CompileChanges(Grid,CurrentSubFileData,Changes);
324 if Changes.Count>0 then begin
325 if SilentMode = false then begin
326 PostForm.PrepForm(Changes);
327 PostResult := PostForm.ShowModal;
328 end else begin
329 PostResult := PostForm.SilentPost(Changes);
330 end;
331 if PostResult in [mrOK,mrNone] then begin
332 RevertBtn.Enabled := false;
333 ApplyBtn.Enabled := false;
334 if PostResult = mrOK then InitTreeView;
335 end else if PostResult = mrNo then begin //mrNo is signal of post Error
336 // show error...
337 end;
338 end;
339 Changes.Free;
340 end;
341
342 procedure TSubfileForm.CompileChanges(Grid : TSortStringGrid; CurrentUser,Changes : TStringList);
343 //Output format:
344 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
345
346 var row : integer;
347 Entry : tFileEntry;
348 oneEntry : string;
349 begin
350 for row := 1 to Grid.RowCount-1 do begin
351 Entry := MainForm.GetLineInfo(Grid,CurrentSubFileData,row);
352 if Entry.oldValue <> Entry.newValue then begin
353 if (Entry.newValue <> CLICK_FOR_SUBS) and
354 (Entry.newValue <> COMPUTED_FIELD) and
355 (Entry.newValue <> CLICK_TO_EDIT) then begin
356 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
357 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
358 Changes.Add(oneEntry);
359 end;
360 end;
361 end;
362 end;
363
364
365 procedure TSubfileForm.DoneBtnClick(Sender: TObject);
366 var Changes : TStringList;
367 begin
368 if ModifiedForm = True then begin
369 Changes := TStringList.Create;
370 CompileChanges(SubFileGrid,CurrentSubFileData,Changes);
371 if Changes.Count>0 then begin
372 ApplyBtnClick(self);
373 ModalResult := mrNo;
374 end else begin
375 ModalResult := mrNo;
376 end;
377 end else begin
378 ModalResult := mrNo;
379 end;
380 end;
381
382 procedure TSubfileForm.DeleteBtnClick(Sender: TObject);
383 var IENS : string;
384 row,ARow : integer;
385 response: integer;
386 begin
387 //The rows can be rearranged, so row 1 will not reliably hold
388 //the .01 field. And if there is a .001 field, it might be
389 //shown above the .01 field etc.
390 response := messagedlg('Are you sure you want to delete ' + TreeView.Selected.Text,mtWarning,[mbYes,mbNo],0);
391 if response = mrYes then begin
392 ARow := 0;
393 for row := 1 to SubFileGrid.RowCount-1 do begin
394 if SubFileGrid.Cells[0,row]='.01' then begin
395 ARow := row; break;
396 end;
397 end;
398 if ARow > 0 then begin
399 SubFileGrid.Cells[2,ARow] := '@'; //columns can't be rearranged (for now)
400 IENS := GetIENS(FLastSelectedNode);
401 //I wonder what Fileman will say if the .01 field has '@'
402 // and there are other fields with changes also. I might
403 // complain about making changes and a deletion at the same
404 // time. Perhaps we ought to have a custom delete function
405 // that deletes everything from the CompiledChanges except for
406 // the .01 record. Let's wait and see if this is a problem or
407 // not first.
408 PostChanges(SubfileGrid,IENS,true); //<-- true = SilentMode
409 end else begin
410 MessageDlg('Unable to find row containing .01 field',mtError,[mbOK],0);
411 end;
412 end;
413 end;
414
415
416
417end.
418
Note: See TracBrowser for help on using the repository browser.