source: cprs/branches/GUI-config/backups/8-23-08/SubfilesU.~pas@ 476

Last change on this file since 476 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility
File size: 13.7 KB
Line 
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;
33
34type
35 TSubfileForm = class(TForm)
36 Panel1: TPanel;
37 TreeView: TTreeView;
38 SubFileGrid: TStringGrid;
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 DirtyForm : boolean; //Used to see if current record is unsaved
77 procedure CompileChanges(Grid : TStringGrid; CurrentUser,Changes : TStringList);
78 procedure PostChanges(Grid : TStringGrid; 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, Trpcb,
98 ToolWin, SelDateTimeU, SetSelU, LookupU, PostU, FMErrorU;
99
100{$R *.dfm}
101
102 procedure TSubfileForm.PrepForm(subFileNum : string; ParentIENS : string);
103 //Format is: FileNum^IENS^FieldNum^ExternalValue^DDInfo...
104 begin
105 GridInfo.Grid := SubFileGrid;
106 GridInfo.Data := CurrentSubFileData;
107 GridInfo.BasicMode := false;
108 GridInfo.FileNum := subFileNum;
109 GridInfo.IENS := ParentIENS;
110 MainForm.RegisterGridInfo(GridInfo);
111
112 BlankFileInfo.Clear;
113 IENS_Store.Clear;
114 FSubFileNum := subFileNum;
115 FParentIENS := ParentIENS;
116 self.caption := 'Edit Sub-File Entries in Subfile #' + subFileNum;
117 ClearTreeView;
118 InitTreeView;
119 end;
120
121 procedure TSubfileForm.InitTreeView;
122 begin
123 IgnoreSelections := true;
124 GetAllSubRecords(FSubFileNum,FParentIENS, AllSubRecords);
125 MainForm.ClearGrid(SubFileGrid);
126 LoadTreeView(AllSubRecords);
127 Root.Expand(true);
128 IgnoreSelections := false;
129 end;
130
131 Procedure TSubfileForm.LoadTreeView(AllSubRecords : TStringList);
132 //Format is: FullIENS^.01Value
133
134 var i : integer;
135 dataLine : integer;
136 oneEntry,value,Name,IENS : string;
137 begin
138 ClearTreeView;
139 for i := 1 to AllSubRecords.Count-1 do begin //0 is 1^Success
140 oneEntry := AllSubRecords.Strings[i];
141 IENS := Piece(oneEntry,'^',1);
142 value := Piece(oneEntry,'^',2);
143 dataLine := StoreIENS(IENS);
144 Name := value;
145 //Name := value + '^'+ IENS;
146 //TreeView.Items.AddChild(Root,Name);
147 TreeView.Items.AddChildObject(Root,Name,Pointer(dataLine));
148 end;
149 End;
150
151 Procedure TSubfileForm.ClearTreeView;
152 begin
153 TreeView.Items.Clear;
154 IENS_Store.Clear;
155 Root := TreeView.Items.Add(nil,'Subrecords');
156 //if Root.HasChildren then Root.DeleteChildren;
157// ClearGrid;
158 MainForm.ClearGrid(SubFileGrid);
159
160 end;
161
162
163 procedure TSubfileForm.TreeViewChanging(Sender: TObject; Node: TTreeNode;
164 var AllowChange: Boolean);
165 begin
166 ApplyBtnClick(self);
167 end;
168
169 procedure TSubfileForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
170 begin
171 FLastSelectedNode := Node;
172 GridInfo.IENS := GetIENS(Node);
173 MainForm.GetOneRecord(GridInfo.FileNum, GridInfo.IENS, GridInfo.Data, BlankFileInfo);
174 MainForm.LoadAnyGridFromInfo(GridInfo);
175 end;
176
177 function TSubfileForm.GetIENS(Node: TTreeNode) : string;
178 var dataLine : integer;
179 begin
180 if Node= nil then exit;
181 dataLine := integer(Node.Data);
182 if dataLine < IENS_Store.Count then begin
183 result := IENS_Store.Strings[dataLine];
184 end else result := '';
185 end;
186
187 function TSubfileForm.StoreIENS(IENS: string) : integer;
188 begin
189 result := IENS_Store.Add(IENS);
190 end;
191
192
193 procedure TSubfileForm.GetAllSubRecords(SubFileNum, ParentIENS : string; SubRecsList : TStringList);
194 var cmd,RPCResult : string;
195 begin
196 SubRecsList.Clear;
197 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
198 RPCBrokerV.Param[0].Value := '.X'; // not used
199 RPCBrokerV.param[0].ptype := list;
200 cmd := 'GET SUB RECS LIST' + '^' + SubFileNum + '^' + ParentIENS;
201 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
202 RPCBrokerV.Call;
203 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
204 if piece(RPCResult,'^',1)='-1' then begin
205 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
206 FMErrorForm.PrepMessage;
207 FMErrorForm.ShowModal;
208 end else begin
209 SubRecsList.Assign(RPCBrokerV.Results);
210 end;
211 end;
212
213 procedure TSubfileForm.FormCreate(Sender: TObject);
214 begin
215 AllSubRecords := TStringList.Create;
216 BlankFileInfo := TStringList.Create;
217 IENS_Store := TStringList.Create;
218 CurrentSubFileData := TStringList.Create;
219 GridInfo := TGridInfo.Create;
220
221 DirtyForm := False;
222 end;
223
224 procedure TSubfileForm.FormDestroy(Sender: TObject);
225 begin
226 AllSubRecords.Free;
227 BlankFileInfo.Free;
228 IENS_Store.Free;
229 CurrentSubFileData.Free;
230 MainForm.UnRegisterGridInfo(GridInfo);
231 GridInfo.Free;
232 end;
233
234 procedure TSubfileForm.SubFileGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
235 begin
236 GridInfo.Message := MSG_SUB_FILE;
237 MainForm.GridSelectCell(Sender, ACol, ARow, CanSelect);
238 end;
239
240
241 procedure TSubfileForm.AddBtnClick(Sender: TObject);
242 var Name,IENS : string;
243 tempNode : TTreeNode;
244 dataLine : integer;
245 begin
246 RevertBtn.Enabled := True;
247 ApplyBtn.Enabled := True;
248 DirtyForm := True;
249 Inc(LastAddNum);
250 IENS := '+' + IntToStr(LastAddNum) + ',' + FParentIENS;
251 Name := '<NEW>';
252 dataLine := StoreIENS(IENS);
253 tempNode := TreeView.Items.AddChildObject(Root,Name,Pointer(dataLine));
254 MainForm.GetOneRecord(FSubfileNum,IENS,CurrentSubFileData, BlankFileInfo);
255 Root.expand(true);
256 TreeView.Select(tempNode);
257 end;
258
259 procedure TSubfileForm.FormShow(Sender: TObject);
260 begin
261 LastAddNum := 0;
262 end;
263
264 procedure TSubfileForm.RevertBtnClick(Sender: TObject);
265 begin
266 DirtyForm := False;
267 MainForm.LoadAnyGridFromInfo(GridInfo);
268 end;
269
270 procedure TSubfileForm.ApplyBtnClick(Sender: TObject);
271 var IENS : string;
272 begin
273 DirtyForm := False;
274 IENS := GetIENS(FLastSelectedNode);
275 PostChanges(SubFileGrid,IENS);
276 end;
277
278 procedure TSubfileForm.SubFileGridClick(Sender: TObject);
279 var sel : TGridRect;
280 temp : boolean;
281 begin
282 DirtyForm := True;
283 RevertBtn.Enabled := True;
284 ApplyBtn.Enabled := True;
285 {//kt Eddie, what was the purpose of this? Causes unexpected click
286 when returning from sub-sub file...
287 Sel := SubFileGrid.Selection;
288 if Sel.Top <> FLastSelectedRow then begin
289 SubFileGridSelectCell(SubFileGrid, Sel.Left, Sel.Top, temp);
290 end;
291 }
292 end;
293
294
295 procedure TSubfileForm.PostChanges(Grid : TStringGrid; IENS : string; SilentMode : boolean);
296
297 function NewIENS(oldIENS : string; PostResults : TStringList) : string;
298 //format of PostResults is: oldIENS^newIENS
299 var i : integer;
300 oneEntry : string;
301 newIENS,
302 parentIENS : string;
303 begin
304 result := '';
305 newIENS := piece(oldIENS,',',1); // +1,123, --> +1
306 parentIENS := MidStr(oldIENS,length(newIENS)+1,99);
307 newIENS := piece(newIENS,'+',2); // +1 --> 1
308 for i := 1 to PostResults.Count-1 do begin //0 is 1^Success
309 oneEntry := PostResults.Strings[i];
310 if piece(oneEntry,'^',1) <> newIENS then continue;
311 result := piece(oneEntry,'^',2) + parentIENS;
312 break;
313 end;
314 end;
315
316 var Changes : TStringList;
317 PostResult : TModalResult;
318 begin
319 Changes := TStringList.Create;
320 CompileChanges(Grid,CurrentSubFileData,Changes);
321 if Changes.Count>0 then begin
322 if SilentMode = false then begin
323 PostForm.PrepForm(Changes);
324 PostResult := PostForm.ShowModal;
325 end else begin
326 PostResult := PostForm.SilentPost(Changes);
327 end;
328 if PostResult in [mrOK,mrNone] then begin
329 RevertBtn.Enabled := false;
330 ApplyBtn.Enabled := false;
331 if PostResult = mrOK then InitTreeView;
332 end else if PostResult = mrNo then begin //mrNo is signal of post Error
333 // show error...
334 end;
335 end;
336 Changes.Free;
337 end;
338
339 procedure TSubfileForm.CompileChanges(Grid : TStringGrid; CurrentUser,Changes : TStringList);
340 //Output format:
341 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
342
343 var row : integer;
344 Entry : tFileEntry;
345 oneEntry : string;
346 begin
347 for row := 1 to Grid.RowCount-1 do begin
348 Entry := MainForm.GetLineInfo(Grid,CurrentSubFileData,row);
349 if Entry.oldValue <> Entry.newValue then begin
350 if (Entry.newValue <> CLICK_FOR_SUBS) and
351 (Entry.newValue <> COMPUTED_FIELD) and
352 (Entry.newValue <> CLICK_TO_EDIT) then begin
353 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
354 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
355 Changes.Add(oneEntry);
356 end;
357 end;
358 end;
359 end;
360
361
362 procedure TSubfileForm.DoneBtnClick(Sender: TObject);
363 var
364 Changes : TStringList;
365 //result : integer;
366 begin
367 if DirtyForm = True then begin
368 Changes := TStringList.Create;
369 CompileChanges(SubFileGrid,CurrentSubFileData,Changes);
370 if Changes.Count>0 then begin
371 //result := messagedlg('Your changes have not been saved. Would you like to save them now?',mtWarning,mbYesNoCancel,0);
372 //if result = mrYes then begin
373 ApplyBtnClick(self);
374 ModalResult := mrNo;
375 //end else if result = mrNo then begin
376 //ModalResult := mrNo;
377 //end;
378 end else begin
379 ModalResult := mrNo;
380 end;
381 end else begin
382 ModalResult := mrNo;
383 end;
384 end;
385
386 procedure TSubfileForm.DeleteBtnClick(Sender: TObject);
387 var IENS : string;
388 row,ARow : integer;
389 response: integer;
390 begin
391 //The rows can be rearranged, so row 1 will not reliably hold
392 //the .01 field. And if there is a .001 field, it might be
393 //shown above the .01 field etc.
394 response := messagedlg('Are you sure you want to delete ' + TreeView.Selected.Text,mtWarning,[mbYes,mbNo],0);
395 if response = mrYes then begin
396 ARow := 0;
397 for row := 1 to SubFileGrid.RowCount-1 do begin
398 if SubFileGrid.Cells[0,row]='.01' then begin
399 ARow := row; break;
400 end;
401 end;
402 if ARow > 0 then begin
403 SubFileGrid.Cells[2,ARow] := '@'; //columns can't be rearranged (for now)
404 IENS := GetIENS(FLastSelectedNode);
405 //I wonder what Fileman will say if the .01 field has '@'
406 // and there are other fields with changes also. I might
407 // complain about making changes and a deletion at the same
408 // time. Perhaps we ought to have a custom delete function
409 // that deletes everything from the CompiledChanges except for
410 // the .01 record. Let's wait and see if this is a problem or
411 // not first.
412 PostChanges(SubfileGrid,IENS,true); //<-- true = SilentMode
413 end else begin
414 MessageDlg('Unable to find row containing .01 field',mtError,[mbOK],0);
415 end;
416 end;
417 end;
418
419
420
421end.
422
Note: See TracBrowser for help on using the repository browser.