source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/SubfilesU.pas@ 838

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

Fixed crash on non-login
File size: 13.7 KB
RevLine 
[541]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, fPtDemoEdit,
[819]32 Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls, Buttons, SortStringGrid;
[541]33
34type
35 TSubfileForm = class(TForm)
36 Panel1: TPanel;
37 TreeView: TTreeView;
[819]38 SubFileGrid: TSortStringGrid;
[541]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
[819]77 procedure CompileChanges(Grid : TSortStringGrid; CurrentUser,Changes : TStringList);
78 procedure PostChanges(Grid : TSortStringGrid; IENS : string; SilentMode : boolean = false);
[541]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 //fPtDemoEdit.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 //fPtDemoEdit.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 //fPtDemoEdit.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 frmPtDemoEdit.GetOneRecord(GridInfo.FileNum, GridInfo.IENS, GridInfo.Data, BlankFileInfo);
177 frmPtDemoEdit.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;
[793]205 //RPCBrokerV.Call;
206 CallBroker;
[541]207 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
208 if piece(RPCResult,'^',1)='-1' then begin
209 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
210 FMErrorForm.PrepMessage;
211 FMErrorForm.ShowModal;
212 end else begin
213 SubRecsList.Assign(RPCBrokerV.Results);
214 end;
215 end;
216
217 procedure TSubfileForm.FormCreate(Sender: TObject);
218 begin
219 AllSubRecords := TStringList.Create;
220 BlankFileInfo := TStringList.Create;
221 IENS_Store := TStringList.Create;
222 CurrentSubFileData := TStringList.Create;
223 GridInfo := TGridInfo.Create;
224
225 ModifiedForm := False;
226 end;
227
228 procedure TSubfileForm.FormDestroy(Sender: TObject);
229 begin
230 AllSubRecords.Free;
231 BlankFileInfo.Free;
232 IENS_Store.Free;
233 CurrentSubFileData.Free;
234// fPtDemoEdit.UnRegisterGridInfo(GridInfo);
235 GridInfo.Free;
236 end;
237
238 procedure TSubfileForm.SubFileGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
239 begin
240 GridInfo.Message := MSG_SUB_FILE;
241 frmPtDemoEdit.gridPatientDemoSelectCell(Sender, ACol, ARow, CanSelect);
242 end;
243
244
245 procedure TSubfileForm.AddBtnClick(Sender: TObject);
246 var Name,IENS : string;
247 tempNode : TTreeNode;
248 dataLine : integer;
249 begin
250 RevertBtn.Enabled := True;
251 ApplyBtn.Enabled := True;
252 ModifiedForm := True;
253 Inc(LastAddNum);
254 IENS := '+' + IntToStr(LastAddNum) + ',' + FParentIENS;
255 Name := '<NEW>';
256 dataLine := StoreIENS(IENS);
257 tempNode := TreeView.Items.AddChildObject(Root,Name,Pointer(dataLine));
258 frmPtDemoEdit.GetOneRecord(FSubfileNum,IENS,CurrentSubFileData, BlankFileInfo);
259 Root.expand(true);
260 TreeView.Select(tempNode);
261 end;
262
263 procedure TSubfileForm.FormShow(Sender: TObject);
264 begin
265 LastAddNum := 0;
266 end;
267
268 procedure TSubfileForm.RevertBtnClick(Sender: TObject);
269 begin
270 ModifiedForm := False;
271 frmPtDemoEdit.LoadAnyGridFromInfo(GridInfo);
272 end;
273
274 procedure TSubfileForm.ApplyBtnClick(Sender: TObject);
275 var IENS : string;
276 begin
277 ModifiedForm := False;
278 IENS := GetIENS(FLastSelectedNode);
279 PostChanges(SubFileGrid,IENS);
280 end;
281
282 procedure TSubfileForm.SubFileGridClick(Sender: TObject);
283 //var sel : TGridRect;
284 // temp : boolean;
285 begin
286 ModifiedForm := True;
287 RevertBtn.Enabled := True;
288 ApplyBtn.Enabled := True;
289 {//kt Eddie, what was the purpose of this? Causes unexpected click
290 when returning from sub-sub file...
291 Sel := SubFileGrid.Selection;
292 if Sel.Top <> FLastSelectedRow then begin
293 SubFileGridSelectCell(SubFileGrid, Sel.Left, Sel.Top, temp);
294 end;
295 }
296 end;
297
298
[819]299 procedure TSubfileForm.PostChanges(Grid : TSortStringGrid; IENS : string; SilentMode : boolean);
[541]300
301 function NewIENS(oldIENS : string; PostResults : TStringList) : string;
302 //format of PostResults is: oldIENS^newIENS
303 var i : integer;
304 oneEntry : string;
305 newIENS,
306 parentIENS : string;
307 begin
308 result := '';
309 newIENS := piece(oldIENS,',',1); // +1,123, --> +1
310 parentIENS := MidStr(oldIENS,length(newIENS)+1,99);
311 newIENS := piece(newIENS,'+',2); // +1 --> 1
312 for i := 1 to PostResults.Count-1 do begin //0 is 1^Success
313 oneEntry := PostResults.Strings[i];
314 if piece(oneEntry,'^',1) <> newIENS then continue;
315 result := piece(oneEntry,'^',2) + parentIENS;
316 break;
317 end;
318 end;
319
320 var Changes : TStringList;
321 PostResult : TModalResult;
322 begin
323 Changes := TStringList.Create;
324 CompileChanges(Grid,CurrentSubFileData,Changes);
325 if Changes.Count>0 then begin
326 if SilentMode = false then begin
327 PostForm.PrepForm(Changes);
328 PostResult := PostForm.ShowModal;
329 end else begin
330 PostResult := PostForm.SilentPost(Changes);
331 end;
332 if PostResult in [mrOK,mrNone] then begin
333 RevertBtn.Enabled := false;
334 ApplyBtn.Enabled := false;
335 if PostResult = mrOK then InitTreeView;
336 end else if PostResult = mrNo then begin //mrNo is signal of post Error
337 // show error...
338 end;
339 end;
340 Changes.Free;
341 end;
342
[819]343 procedure TSubfileForm.CompileChanges(Grid : TSortStringGrid; CurrentUser,Changes : TStringList);
[541]344 //Output format:
345 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
346
347 var row : integer;
348 Entry : tFileEntry;
349 oneEntry : string;
350 begin
351 for row := 1 to Grid.RowCount-1 do begin
352 Entry := frmPtDemoEdit.GetLineInfo(Grid,CurrentSubFileData,row);
353 if (Entry.oldValue <> Entry.newValue) then begin
354 if (Entry.newValue <> CLICK_FOR_SUBS) and
355 (Entry.newValue <> COMPUTED_FIELD) and
356 (Entry.newValue <> CLICK_TO_EDIT) then begin
357 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
358 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
359 Changes.Add(oneEntry);
360 end;
361 end;
362 end;
363 end;
364
365
366 procedure TSubfileForm.DoneBtnClick(Sender: TObject);
367 var Changes : TStringList;
368 begin
369 if ModifiedForm = True then begin
370 Changes := TStringList.Create;
371 CompileChanges(SubFileGrid,CurrentSubFileData,Changes);
372 if Changes.Count>0 then begin
373 ApplyBtnClick(self);
374 ModalResult := mrNo;
375 end else begin
376 ModalResult := mrNo;
377 end;
378 end else begin
379 ModalResult := mrNo;
380 end;
381 end;
382
383 procedure TSubfileForm.DeleteBtnClick(Sender: TObject);
384 var IENS : string;
385 row,ARow : integer;
386 response: integer;
387 begin
388 //The rows can be rearranged, so row 1 will not reliably hold
389 //the .01 field. And if there is a .001 field, it might be
390 //shown above the .01 field etc.
391 response := messagedlg('Are you sure you want to delete ' + TreeView.Selected.Text,mtWarning,[mbYes,mbNo],0);
392 if response = mrYes then begin
393 ARow := 0;
394 for row := 1 to SubFileGrid.RowCount-1 do begin
395 if SubFileGrid.Cells[0,row]='.01' then begin
396 ARow := row; break;
397 end;
398 end;
399 if ARow > 0 then begin
400 SubFileGrid.Cells[2,ARow] := '@'; //columns can't be rearranged (for now)
401 IENS := GetIENS(FLastSelectedNode);
402 //I wonder what Fileman will say if the .01 field has '@'
403 // and there are other fields with changes also. I might
404 // complain about making changes and a deletion at the same
405 // time. Perhaps we ought to have a custom delete function
406 // that deletes everything from the CompiledChanges except for
407 // the .01 record. Let's wait and see if this is a problem or
408 // not first.
409 PostChanges(SubfileGrid,IENS,true); //<-- true = SilentMode
410 end else begin
411 MessageDlg('Unable to find row containing .01 field',mtError,[mbOK],0);
412 end;
413 end;
414 end;
415
416
417
418end.
419
Note: See TracBrowser for help on using the repository browser.