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

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

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