source: cprs/branches/GUI-config/MainU.pas@ 488

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

Added debug log form
File size: 80.0 KB
Line 
1unit MainU;
2
3 (*
4 WorldVistA Configuration Utility
5 (c) 8/2008 Kevin Toppenberg
6 Programmed by Kevin Toppenberg, Eddie Hagood
7
8 Family Physicians of Greeneville, PC
9 1410 Tusculum Blvd, Suite 2600
10 Greeneville, TN 37745
11 kdtop@yahoo.com
12
13 This library is free software; you can redistribute it and/or
14 modify it under the terms of the GNU Lesser General Public
15 License as published by the Free Software Foundation; either
16 version 2.1 of the License, or (at your option) any later version.
17
18 This library is distributed in the hope that it will be useful,
19 but WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 Lesser General Public License for more details.
22
23 You should have received a copy of the GNU Lesser General Public
24 License along with this library; if not, write to the Free Software
25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
26 *)
27
28interface
29
30uses
31 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
32 Dialogs, StdCtrls, StrUtils,
33 ORNet, ORFn, ComCtrls, ToolWin, Grids, ORCtrls, ExtCtrls, Buttons,
34 AppEvnts, Menus, ImgList,
35 {$IFDEF USE_SKINS}
36 ipSkinManager,
37 {$ENDIF}
38 ValEdit;
39
40type
41 tFileEntry = record
42 Field : string;
43 FileNum : string;
44 FieldName : String;
45 IENS : string;
46 oldValue,newValue : string;
47 end;
48
49 TGridInfo = class; //forward declaration
50 TGridDataLoader = procedure (GridInfo: TGridInfo) of object;
51 TGridInfo = class (TObject)
52 public
53 Grid : TStringGrid; //doesn't own object
54 FileNum : string;
55 IENS : string;
56 BasicMode : Boolean;
57 Data : TStringList; //doesn't own object
58 Message : string; //optional text.
59 DataLoadProc : TGridDataLoader;
60 ApplyBtn : TButton;
61 RevertBtn : TButton;
62 end;
63
64
65 TMainForm = class(TForm)
66 PageControl: TPageControl;
67 tsUsers: TTabSheet;
68 UsersTreeView: TTreeView;
69 UserPageControl: TPageControl;
70 tsBasicPage: TTabSheet;
71 tsAdvancedPage: TTabSheet;
72 RightPanel: TPanel;
73 ButtonPanel: TPanel;
74 btnUsersApply: TBitBtn;
75 btnUsersRevert: TBitBtn;
76 LeftPanel: TPanel;
77 Splitter1: TSplitter;
78 Panel5: TPanel;
79 ApplicationEvents: TApplicationEvents;
80 AdvancedUsersGrid: TStringGrid;
81 BasicUsersGrid: TStringGrid;
82 MainMenu: TMainMenu;
83 FileMenu: TMenuItem;
84 ExitMenuItem: TMenuItem;
85 AboutMenu: TMenuItem;
86 CloneBtn: TBitBtn;
87 ImageList1: TImageList;
88 tsSettings: TTabSheet;
89 Panel1: TPanel;
90 Panel2: TPanel;
91 SettingsPageControl: TPageControl;
92 tsBasicSettings: TTabSheet;
93 BasicSettingsGrid: TStringGrid;
94 tsAdvancedSettings: TTabSheet;
95 AdvancedSettingsGrid: TStringGrid;
96 Panel3: TPanel;
97 btnSettingsApply: TBitBtn;
98 btnSettingsRevert: TBitBtn;
99 Panel4: TPanel;
100 SettingsTreeView: TTreeView;
101 Panel6: TPanel;
102 Splitter2: TSplitter;
103 tsPatients: TTabSheet;
104 Panel7: TPanel;
105 Splitter3: TSplitter;
106 Panel8: TPanel;
107 PatientsPageControl: TPageControl;
108 tsBasicPatients: TTabSheet;
109 BasicPatientGrid: TStringGrid;
110 tsAdvancedPatients: TTabSheet;
111 AdvancedPatientGrid: TStringGrid;
112 Panel9: TPanel;
113 btnPatientApply: TBitBtn;
114 btnPatientRevert: TBitBtn;
115 Panel10: TPanel;
116 Panel11: TPanel;
117 AddBtn: TBitBtn;
118 PatientORComboBox: TORComboBox;
119 tsAdvanced: TTabSheet;
120 Panel12: TPanel;
121 Splitter4: TSplitter;
122 RtAdvPanel: TPanel;
123 AnyFilePageControl: TPageControl;
124 TabSheet2: TTabSheet;
125 AnyFileGrid: TStringGrid;
126 Panel14: TPanel;
127 btnAdvancedApply: TBitBtn;
128 btnAdvancedRevert: TBitBtn;
129 LeftAdvPanel: TPanel;
130 BotLeftAdvBtnPanel: TPanel;
131 btnAddAnyRecord: TBitBtn;
132 FileORComboBox: TORComboBox;
133 Label1: TLabel;
134 RecordORComboBox: TORComboBox;
135 Label2: TLabel;
136 TopLeftAdvPanel: TPanel;
137 BotLeftAdvPanel: TPanel;
138 Splitter5: TSplitter;
139 Panel13: TPanel;
140 btnBatchAdd: TBitBtn;
141 procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
142 procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
143 procedure FormDestroy(Sender: TObject);
144 procedure UsersTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
145 procedure UsersTreeViewChange(Sender: TObject; Node: TTreeNode);
146 procedure Button1Click(Sender: TObject);
147 procedure btnUsersRevertClick(Sender: TObject);
148 procedure btnUsersApplyClick(Sender: TObject);
149 procedure FormClose(Sender: TObject; var Action: TCloseAction);
150 procedure ExitMenuItemClick(Sender: TObject);
151 procedure UserPageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
152 procedure AboutMenuClick(Sender: TObject);
153 procedure CloneBtnClick(Sender: TObject);
154 procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
155 procedure ApplicationEventsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo);
156 procedure SettingsTreeViewChange(Sender: TObject; Node: TTreeNode);
157 procedure SettingsTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
158 procedure BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
159 procedure PageControlChanging(Sender: TObject; var AllowChange: Boolean);
160 procedure UserPageControlChanging(Sender: TObject; var AllowChange: Boolean);
161 procedure PatientORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
162 procedure PageControlChange(Sender: TObject);
163 procedure PatientORComboBoxClick(Sender: TObject);
164 procedure PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
165 procedure SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
166 procedure PatientsPageControlChange(Sender: TObject);
167 procedure SettingsPageControlChange(Sender: TObject);
168 procedure UserPageControlChange(Sender: TObject);
169 procedure FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
170 procedure FileORComboBoxClick(Sender: TObject);
171 procedure RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
172 procedure RecordORComboBoxClick(Sender: TObject);
173 procedure btnAddAnyRecordClick(Sender: TObject);
174 procedure AddBtnClick(Sender: TObject);
175 procedure btnAdvancedApplyClick(Sender: TObject);
176 procedure btnAdvancedRevertClick(Sender: TObject);
177 procedure AnyFileGridClick(Sender: TObject);
178 procedure btnBatchAddClick(Sender: TObject);
179 procedure ChangeSkinClick(Sender: TObject);
180 procedure btnPatientApplyClick(Sender: TObject);
181 procedure btnPatientRevertClick(Sender: TObject);
182 procedure BasicPatientGridClick(Sender: TObject);
183 procedure ApplicationEventsException(Sender: TObject; E: Exception);
184 procedure btnSettingsRevertClick(Sender: TObject);
185 procedure btnSettingsApplyClick(Sender: TObject);
186 private
187 { Private declarations }
188 CurrentUserData : TStringList;
189 CurrentSettingsData : TStringList;
190 CurrentPatientData : TStringList;
191 CurrentAnyFileData : TStringList;
192 BasicTemplate : TStringList;
193 AllUsers : TTreeNode;
194 AllSettings : TTreeNode;
195 ActiveUsers : TTreeNode;
196 InactiveUsers : TTreeNode;
197 SettingsFiles : TStringList;
198 KernelSysParams : TTreeNode;
199 HospLoc : TTreeNode;
200 RPCBrokerParams : TTreeNode;
201 Devices : TTreeNode;
202 FLastSelectedRow,FLastSelectedCol : integer;
203 FLoadingGrid: boolean;
204 DataForGrid : TStringList; // doesn't own TGridInfo objects
205 CachedHelp : TStringList;
206 CachedHelpIdx : TStringList;
207 CachedWPField : TStringList;
208 FVisibleGridIdx : integer;
209 procedure ShowDebugClick(Sender: TObject);
210 function FindParam(Param : string) : string;
211 function GetCurrentUserName : string;
212 procedure SetCursorImage(Cursor : TCursor);
213 function FileNumForSettingsNode (Node : TTreeNode) : string;
214 function GetVisibleGrid: TStringGrid;
215 function GetVisibleGridInfo : TGridInfo;
216 function GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
217 function GetInfoIndexForGrid(Grid : TStringGrid) : integer;
218 procedure SetVisibleGridIdx(Grid : TStringGrid);
219 procedure GetUsersList(UsersList : TStringList; HideInactive: boolean);
220 procedure GetRecordsList(RecordsList : TStringList; FileNum : string);
221 procedure InitializeUsersTreeView;
222 procedure InitializeSettingsFilesTreeView;
223 procedure InitUsersStuff;
224 procedure InitSettingsFilesStuff;
225 Procedure LoadUsersTreeView(UsersList : TStringList);
226 Procedure LoadSettingsTreeView(RecordsList : TStringList;DestNode : TTreeNode);
227 //procedure LoadUserData(IENS : String; Data : TStringList);
228 procedure LoadUserData(GridInfo : TGridInfo);
229 //procedure GetSettingsInfo(FileNum : String; IENS : String; Data : TStringList);
230 procedure GetSettingsInfo(GridInfo : TGridInfo);
231 procedure GetPatientInfo(GridInfo : TGridInfo);
232 //procedure GetPatientInfo(IENS : String; Data : TStringList);
233 procedure GetAnyfileInfo(GridInfo : TGridInfo);
234 //procedure GetAnyfileInfo(FileNum : String; IENS : String; Data : TStringList);
235 function FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer;
236 procedure CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
237 function PostChanges(Grid : TStringGrid) : TModalResult;
238 function PostVisibleGrid: TModalResult;
239 procedure LoadAnyGrid(Grid : TStringGrid; BasicMode: boolean; FileNum,IENS : string; CurrentData : TStringList);
240 function DisuserChanged(Changes: TStringList) : boolean;
241 procedure DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
242 function DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string;
243 function DoCloneUser(SourceIENS, New01Field : String) : string;
244 function GetGridHint(Grid : TStringGrid; FileNum : string; ACol, ARow : integer) : string;
245 function FieldHelp(FileNum, FieldNum, HelpStyle : string) : string;
246 procedure DoRevert(BasicGrid,AdvancedGrid : TStringGrid);
247 public
248 { Public declarations }
249 CurrentUserName: string;
250 LastSelTreeNode : TTreeNode;
251 DebugMode : boolean;
252 function GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow:integer) :integer;
253 function GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
254 function IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean;
255 function IsWPField(FileNum,FieldNum : string) : boolean;
256 function ExtractNum (S : String; StartPos : integer) : string;
257 procedure Initialize;
258 procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string);
259 Procedure GetBlankFileInfo(FileNum : string; BlankList : TStringList);
260 procedure GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo : TStringList);
261 procedure AddGridInfo(Grid: TStringGrid; Data : TStringList; BasicMode : boolean;
262 DataLoader : TGridDataLoader; FileNum : string;
263 ApplyBtn,RevertBtn : TButton);
264 procedure LoadAnyGridFromInfo(GridInfo : TGridInfo);
265 procedure ClearGrid(Grid : TStringGrid);
266 procedure RegisterGridInfo(GridInfo : TGridInfo);
267 procedure UnRegisterGridInfo(GridInfo : TGridInfo);
268 end;
269
270var
271 MainForm: TMainForm;
272
273Const
274 DEF_GRID_ROW_HEIGHT = 17;
275 CLICK_FOR_SUBS = '<CLICK for Sub-Entries>';
276 COMPUTED_FIELD = '<Computed Field --> CAN''T EDIT>';
277 CLICK_TO_EDIT = '<CLICK to Edit Text>';
278 HIDDEN_FIELD = '<Hidden>';
279
280implementation
281
282uses
283 frmSplash, Trpcb , LookupU, SubfilesU, SetSelU, SelDateTimeU, PostU,
284 FMErrorU, AboutU, PleaseWaitU, EditTextU, CreateTemplateU, SkinFormU,
285 BatchAddU, DebugU;
286
287{$R *.dfm}
288const
289 RPC_CONTEXT = 'TMG RPC CONTEXT GUI_CONFIG';
290
291 procedure TMainForm.Initialize;
292 var tempMenu,tempSubMenu : TMenuItem;
293 begin
294 DebugMode := (FindParam('debug')='enable');
295 if DebugMode then begin
296 DebugForm.show;
297 tempMenu := TMenuItem.Create(FileMenu);
298 tempMenu.Caption := '&Show Debug Log';
299 tempMenu.OnClick := ShowDebugClick;
300 FileMenu.Add(tempMenu);
301 end;
302 {$IFDEF USE_SKINS}
303 DebugForm.Memo.Lines.Add('Adding Menus');
304 tempMenu := TMenuItem.Create(MainMenu);
305 tempMenu.Caption := '&Appearance';
306 tempSubMenu := TMenuItem.Create(tempMenu);
307 tempSubMenu.Caption := '&Change Skin';
308 tempSubMenu.OnClick := ChangeSkinClick;
309 tempMenu.Add(tempSubMenu);
310 MainMenu.Items.Add(tempMenu);
311 {$ENDIF}
312
313 DebugForm.Memo.Lines.Add('Showing Splash');
314 SplashForm.show;
315
316 FLoadingGrid := false;
317 SettingsFiles := TStringList.Create;
318 CurrentUserData := TStringList.create;
319 CurrentSettingsData := TStringList.Create;
320 CurrentPatientData := TStringList.Create;
321 CurrentAnyFileData := TStringList.Create;
322
323 DataForGrid := TStringList.Create; //will own GridInfo objects.
324 CachedHelp := TStringList.Create;
325 CachedHelpIdx := TStringList.Create;
326 CachedWPField := TStringList.Create;
327
328 DebugForm.Memo.Lines.Add('Adding Grid Info');
329 AddGridInfo(BasicUsersGrid,CurrentUserData,true,LoadUserData,'200',btnUsersApply,btnUsersRevert);
330 AddGridInfo(AdvancedUsersGrid,CurrentUserData,false,LoadUserData,'200',btnUsersApply,btnUsersRevert);
331 AddGridInfo(BasicSettingsGrid,CurrentSettingsData,true,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert);
332 AddGridInfo(AdvancedSettingsGrid,CurrentSettingsData,false,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert);
333 AddGridInfo(BasicPatientGrid,CurrentPatientData,true,GetPatientInfo,'2',btnPatientApply,btnPatientRevert);
334 AddGridInfo(AdvancedPatientGrid,CurrentPatientData,false,GetPatientInfo,'2',btnPatientApply,btnPatientRevert);
335 AddGridInfo(AnyFileGrid,CurrentAnyFileData,false,GetAnyFileInfo,'',btnAdvancedApply,btnAdvancedRevert);
336
337 MainForm.Visible := false;
338 DebugForm.Memo.Lines.Add('Trying to connect to server');
339 if not ORNet.ConnectToServer(RPC_CONTEXT) then begin
340 DebugForm.Memo.Lines.Add('Failed connection. Closing.');
341 Close;
342 Exit;
343 end;
344 DebugForm.Memo.Lines.Add('Connected to server!');
345 Application.ProcessMessages;
346 LastSelTreeNode := nil;
347 RPCBrokerV.ClearParameters := true;
348 BasicTemplate := TStringList.create;
349 BasicTemplate.Sorted := false;
350
351 DebugForm.Memo.Lines.Add('Initializing Combo Boxes');
352 InitORCombobox(PatientORComboBox,'A');
353 InitORCombobox(FileORComboBox,'A');
354
355 InitUsersStuff;
356 InitSettingsFilesStuff;
357 CurrentUserName := GetCurrentUserName;
358
359 PageControl.ActivePage := tsUsers;
360 UserPageControl.ActivePage := tsBasicPage;
361 SettingsPageControl.ActivePage := tsBasicSettings;
362
363 PageControlChange(nil); //ensure VisibleGridIdx is initialized.
364
365 {$IFDEF USE_SKINS}
366 if SkinForm.cbSkinAtStartup.Checked then begin
367 DebugForm.Memo.Lines.Add('Activating Skins');
368 SkinForm.ActivateCurrentSkin;
369 end;
370 {$ENDIF}
371
372 self.Visible := true;
373 SplashForm.Hide;
374 DebugForm.Memo.Lines.Add('Done Initializing.');
375 end;
376
377 function TMainForm.FindParam(Param : string) : string;
378 //Searches command line parameters for Param. If found, then value returned.
379 //Case insensitive
380 //Must be in 'param=value' format, i.e. must have '='
381 var i : integer;
382 tempS : string;
383 begin
384 Result := '';
385 Param := LowerCase(Param);
386 for i := 1 to ParamCount do begin
387 tempS := LowerCase (ParamStr(i));
388 if Pos(Param,tempS)>0 then Result := Piece(tempS,'=',2);
389 end;
390 end;
391
392
393 procedure TMainForm.AddGridInfo(Grid: TStringGrid;
394 Data : TStringList;
395 BasicMode : boolean;
396 DataLoader : TGridDataLoader;
397 FileNum : string;
398 ApplyBtn,RevertBtn : TButton );
399 var tempGridInfo : TGridInfo;
400 begin
401 tempGridInfo := TGridInfo.Create;
402 tempGridInfo.Grid := Grid;
403 tempGridInfo.Data := Data;
404 tempGridInfo.BasicMode := BasicMode;
405 tempGridInfo.FileNum := FileNum;
406 tempGridInfo.DataLoadProc := DataLoader;
407 tempGridInfo.ApplyBtn := ApplyBtn;
408 tempGridInfo.RevertBtn := RevertBtn;
409 RegisterGridInfo(tempGridInfo);
410 end;
411
412 procedure TMainForm.RegisterGridInfo(GridInfo : TGridInfo);
413 var s : string;
414 begin
415 if GridInfo = nil then exit;
416 s := IntToStr(integer(GridInfo.Grid));
417 DataForGrid.AddObject(s,GridInfo);
418 end;
419
420 procedure TMainForm.UnRegisterGridInfo(GridInfo : TGridInfo);
421 var s : string;
422 i : integer;
423 begin
424 if GridInfo = nil then exit;
425 s := IntToStr(integer(GridInfo.Grid));
426 i := DataForGrid.IndexOf(s);
427 if i > -1 then DataForGrid.Delete(i);
428 end;
429
430 function TMainForm.GetCurrentUserName : string;
431 var RPCResult : string;
432 begin
433 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
434 RPCBrokerV.param[0].ptype := list;
435 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET CURRENT USER NAME';
436 RPCBrokerV.Call;
437 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
438 if piece(RPCResult,'^',1)='-1' then begin
439 CurrentUserName := '';
440 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
441 FMErrorForm.PrepMessage;
442 FMErrorForm.ShowModal;
443 end else begin
444 result := piece(RPCResult,'^',3);
445 end;
446 end;
447
448 procedure TMainForm.GetUsersList(UsersList : TStringList; HideInactive: boolean);
449 var RPCResult : string;
450 begin
451 UsersList.Clear;
452 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
453 RPCBrokerV.Param[0].Value := '.X'; // not used
454 RPCBrokerV.param[0].ptype := list;
455 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET USER LIST';
456 RPCBrokerV.Call;
457 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
458 if piece(RPCResult,'^',1)='-1' then begin
459 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
460 FMErrorForm.PrepMessage;
461 FMErrorForm.ShowModal;
462 end else begin
463 UsersList.Assign(RPCBrokerV.Results);
464 end;
465 end;
466
467 procedure TMainForm.GetRecordsList(RecordsList : TStringList; FileNum : string);
468 //Format of Records list:
469 // .01Value^IEN^FileNum
470 // .01Value^IEN^FileNum
471 var RPCResult : string;
472 begin
473 RecordsList.Clear;
474 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
475 RPCBrokerV.param[0].ptype := list;
476 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET RECORDS LIST^' + FileNum;
477 RPCBrokerV.Call;
478 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
479 if piece(RPCResult,'^',1)='-1' then begin
480 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
481 FMErrorForm.PrepMessage;
482 FMErrorForm.ShowModal;
483 end else begin
484 RecordsList.Assign(RPCBrokerV.Results);
485 end;
486 end;
487
488 Procedure TMainForm.LoadUsersTreeView(UsersList : TStringList);
489 //UsersList Format:
490 // Name^IEN^FileNum^Disuser(1 or 0)
491 // Name^IEN^FileNum^Disuser(1 or 0)
492
493 procedure AddChild(Parent : TTreeNode; Name : string;IEN : longInt);
494 var Node : TTreeNode;
495 begin
496 Node := UsersTreeView.Items.AddChildObject(Parent,Name,pointer(IEN));
497 if Parent=InactiveUsers then begin
498 Node.ImageIndex := 1;
499 Node.SelectedIndex := 4;
500 end else begin
501 Node.ImageIndex := 0;
502 Node.SelectedIndex := 5;
503 end;
504 end;
505
506 var i : integer;
507 oneEntry,Name,IENStr,inactive : string;
508 IEN : longInt;
509 begin
510 for i := 1 to UsersList.Count-1 do begin
511 oneEntry := UsersList.Strings[i];
512 Name := Piece(oneEntry,'^',1);
513 IENStr := Piece(oneEntry,'^',2);
514 inactive := Piece(oneEntry,'^',4);
515 if (Pos('.',IENStr)=0) then begin
516 IEN := StrToInt(IENStr);
517 if (inactive='1') then begin
518 AddChild(InactiveUsers,Name,IEN)
519 end else begin
520 AddChild(ActiveUsers,Name,IEN)
521 end;
522 end;
523 end;
524 End;
525
526
527 Procedure TMainForm.LoadSettingsTreeView(RecordsList : TStringList;DestNode : TTreeNode);
528 //RecordsList Format:
529 // .01Value^IEN^FileNum
530 // .01Value^IEN^FileNum
531 //Note: Will ADD into tree view, leaving prior entries intact
532
533 var i : integer;
534 oneEntry,Name,IENStr : string;
535 IEN : longInt;
536 Node: TTreeNode;
537 begin
538 for i := 1 to RecordsList.Count-1 do begin
539 oneEntry := RecordsList.Strings[i];
540 Name := Piece(oneEntry,'^',1);
541 IENStr := Piece(oneEntry,'^',2);
542 IEN := StrToInt(IENStr);
543 Node := UsersTreeView.Items.AddChildObject(DestNode,Name,pointer(IEN));
544 Node.ImageIndex := 9; //change later for icon
545 Node.SelectedIndex := 10; //change later for icon
546 end;
547 End;
548
549
550 procedure TMainForm.InitUsersStuff;
551 begin
552 BasicTemplate.Add('200^.01'); //Name
553 BasicTemplate.Add('200^1'); //initials
554 BasicTemplate.Add('200^13'); //Nickname
555 BasicTemplate.Add('200^10.6'); //Degree
556 BasicTemplate.Add('200^53.2'); //DEA#
557 BasicTemplate.Add('200^2'); //Access Code
558 BasicTemplate.Add('200^11'); //Verify Code
559 BasicTemplate.Add('200^7'); //DISUSER
560 BasicTemplate.Add('200^20.2'); //Signature block printed name
561 BasicTemplate.Add('200^20.3'); //Signature block title
562 BasicTemplate.Add('200^20.4'); //Electronic signature code
563 BasicTemplate.Add('200^51'); //Keys
564 BasicTemplate.Add('200^8932.1');//Person class
565 BasicTemplate.Add('200^53.5'); //Provider class
566 BasicTemplate.Add('200^53.7'); //Requires cosigner
567 BasicTemplate.Add('200^53.8'); //Usually cosigner
568 BasicTemplate.Add('200^101.13'); //CPRS TAb
569 BasicTemplate.Add('200^200.1');//Timed read #sec
570 BasicTemplate.Add('200^201'); //Primary menu option
571 InitializeUsersTreeView;
572 end;
573
574 procedure TMainForm.InitSettingsFilesStuff;
575 begin
576 // -- KERNEL SYSTEM PARAMETERS
577 BasicTemplate.Add('8989.3^.01'); // DOMAIN NAME
578 BasicTemplate.Add('8989.3^202'); // DEFAULT # OF ATTEMPTS
579 BasicTemplate.Add('8989.3^203'); // DEFAULT LOCK-OUT TIME
580 BasicTemplate.Add('8989.3^204'); // DEFAULT MULTIPLE SIGN-ON
581 BasicTemplate.Add('8989.3^205'); // ASK DEVICE TYPE AT SIGN-ON
582 BasicTemplate.Add('8989.3^206'); // DEFAULT AUTO-MENU
583 BasicTemplate.Add('8989.3^207'); // DEFAULT LANGUAGE
584 BasicTemplate.Add('8989.3^209'); // DEFAULT TYPE-AHEAD
585 BasicTemplate.Add('8989.3^210'); // DEFAULT TIMED-READ (SECONDS)
586 BasicTemplate.Add('8989.3^214'); // LIFETIME OF VERIFY CODE
587 BasicTemplate.Add('8989.3^217'); // DEFAULT INSTITUTION
588 BasicTemplate.Add('8989.3^218'); // DEFAULT AUTO SIGN-ON
589 BasicTemplate.Add('8989.3^219'); // DEFAULT MULTIPLE SIGN-ON LIMIT
590 BasicTemplate.Add('8989.3^230'); // BROKER ACTIVITY TIMEOUT
591 BasicTemplate.Add('8989.3^240'); // INTRO MESSAGE
592 BasicTemplate.Add('8989.3^245'); // POST SIGN-IN MESSAGE
593 BasicTemplate.Add('8989.3^320'); // DEFAULT DIRECTORY FOR HFS
594 BasicTemplate.Add('8989.3^501'); // PRODUCTION account
595
596 // -- HOSPITAL LOCATION
597 BasicTemplate.Add('44^.01'); // NAME
598 BasicTemplate.Add('44^1'); // ABBREVIATION
599 BasicTemplate.Add('44^2'); // TYPE
600 BasicTemplate.Add('44^2.1'); // TYPE EXTENSION
601 BasicTemplate.Add('44^3'); // INSTITUTION
602 BasicTemplate.Add('44^3.5'); // DIVISION
603 BasicTemplate.Add('44^5'); // DEFAULT DEVICE
604 BasicTemplate.Add('44^9'); // SERVICE
605 BasicTemplate.Add('44^9.5'); // TREATING SPECIALTY
606 BasicTemplate.Add('44^10'); // PHYSICAL LOCATION
607 BasicTemplate.Add('44^15'); // CATEGORY OF VISIT
608 BasicTemplate.Add('44^16'); // DEFAULT PROVIDER
609 BasicTemplate.Add('44^23'); // AGENCY
610 BasicTemplate.Add('44^29'); // CLINIC SERVICES RESOURCE
611 BasicTemplate.Add('44^99'); // TELEPHONE
612 BasicTemplate.Add('44^101'); // ASSOCIATED LOCATION TYPES
613 BasicTemplate.Add('44^1916'); // PRINCIPAL CLINIC
614 BasicTemplate.Add('44^2505'); // INACTIVATE DATE
615 BasicTemplate.Add('44^2506'); // REACTIVATE DATE
616 BasicTemplate.Add('44^2507'); // DEFAULT APPOINTMENT TYPE
617 BasicTemplate.Add('44^2508'); // NO SHOW LETTER
618 BasicTemplate.Add('44^2509'); // PRE-APPOINTMENT LETTER
619 BasicTemplate.Add('44^2510'); // CLINIC CANCELLATION LETTER
620 BasicTemplate.Add('44^2511'); // APPT. CANCELLATION LETTER
621 BasicTemplate.Add('44^2600'); // PROVIDER
622 BasicTemplate.Add('44^2700'); // DIAGNOSIS
623 BasicTemplate.Add('44^2801'); // DEFAULT TO PC PRACTITIONER?
624
625 // -- RPC BROKER SITE PARAMETERS
626 BasicTemplate.Add('8994.1^.01'); // DOMAIN NAME
627 BasicTemplate.Add('8994.1^2'); // MAIL GROUP FOR ALERTS
628 BasicTemplate.Add('8994.1^7'); // LISTENER
629
630 // -- DEVICE file
631 BasicTemplate.Add('3.5^.01'); // NAME
632 BasicTemplate.Add('3.5^.02'); // LOCATION OF TERMINAL
633 BasicTemplate.Add('3.5^.03'); // MNEMONIC
634 BasicTemplate.Add('3.5^.04'); // LOCAL SYNONYM
635 BasicTemplate.Add('3.5^1'); // $I
636 BasicTemplate.Add('3.5^1.95'); // SIGN-ON/SYSTEM DEVICE
637 BasicTemplate.Add('3.5^2'); // TYPE
638 BasicTemplate.Add('3.5^3'); // SUBTYPE
639 BasicTemplate.Add('3.5^5.5'); // QUEUING
640 BasicTemplate.Add('3.5^6'); // OUT-OF-SERVICE DATE
641 BasicTemplate.Add('3.5^7'); // NEAREST PHONE
642 BasicTemplate.Add('3.5^8'); // KEY OPERATOR
643 BasicTemplate.Add('3.5^9'); // MARGIN WIDTH
644 BasicTemplate.Add('3.5^11'); // PAGE LENGTH
645 BasicTemplate.Add('3.5^16'); // CLOSEST PRINTER
646 BasicTemplate.Add('3.5^19'); // OPEN PARAMETERS
647 BasicTemplate.Add('3.5^19.3'); // CLOSE PARAMETERS
648 BasicTemplate.Add('3.5^19.5'); // USE PARAMETERS
649 BasicTemplate.Add('3.5^19.7'); // PRE-OPEN EXECUTE
650 BasicTemplate.Add('3.5^19.8'); // POST-CLOSE EXECUTE
651 BasicTemplate.Add('3.5^27'); // PASSWORD
652 BasicTemplate.Add('3.5^51.5'); // ASK DEVICE TYPE AT SIGN-ON
653 BasicTemplate.Add('3.5^51.6'); // AUTO MENU
654 BasicTemplate.Add('3.5^51.9'); // TYPE-AHEAD
655
656 // -- PATIENT file
657 BasicTemplate.Add('2^.01'); // NAME
658 BasicTemplate.Add('2^.02'); // SEX
659 BasicTemplate.Add('2^.03'); // DATE OF BIRTH
660 BasicTemplate.Add('2^.05'); // MARITAL STATUS
661 BasicTemplate.Add('2^.06'); // RACE
662 BasicTemplate.Add('2^.07'); // OCCUPATION
663 BasicTemplate.Add('2^.08'); // RELIGIOUS PREFERENCE
664 BasicTemplate.Add('2^.09'); // SOCIAL SECURITY NUMBER
665 BasicTemplate.Add('2^.091'); // REMARKS
666 BasicTemplate.Add('2^.092'); // PLACE OF BIRTH [CITY]
667 BasicTemplate.Add('2^.093'); // PLACE OF BIRTH [STATE]
668 BasicTemplate.Add('2^.096'); // WHO ENTERED PATIENT
669 BasicTemplate.Add('2^.097'); // DATE ENTERED INTO FILE
670 BasicTemplate.Add('2^.098'); // HOW WAS PATIENT ENTERED?
671 BasicTemplate.Add('2^.103'); // TREATING SPECIALTY
672 BasicTemplate.Add('2^.104'); // PROVIDER
673 BasicTemplate.Add('2^.1041'); // ATTENDING PHYSICIAN
674 BasicTemplate.Add('2^.111'); // STREET ADDRESS [LINE 1]
675 BasicTemplate.Add('2^.1112'); // ZIP+4
676 BasicTemplate.Add('2^.112'); // STREET ADDRESS [LINE 2]
677 BasicTemplate.Add('2^.113'); // STREET ADDRESS [LINE 3]
678 BasicTemplate.Add('2^.114'); // CITY
679 BasicTemplate.Add('2^.115'); // STATE
680 BasicTemplate.Add('2^.116'); // ZIP CODE
681 BasicTemplate.Add('2^.117'); // COUNTY
682 BasicTemplate.Add('2^.131'); // PHONE NUMBER [RESIDENCE]
683 BasicTemplate.Add('2^.132'); // PHONE NUMBER [WORK]
684 BasicTemplate.Add('2^.133'); // PHONE [CELL}
685 BasicTemplate.Add('2^.2401'); // FATHER'S NAME
686 BasicTemplate.Add('2^.2402'); // MOTHER'S NAME
687 BasicTemplate.Add('2^.2403'); // MOTHER'S MAIDEN NAME
688 BasicTemplate.Add('2^994'); // MULTIPLE BIRTH INDICATOR
689 BasicTemplate.Add('2^1901'); // VETERAN (Y/N)?
690
691 InitializeSettingsFilesTreeView;
692 end;
693
694 procedure TMainForm.InitializeUsersTreeView;
695 var
696 UsersList : TStringList;
697
698 begin
699 CurrentUserData.Clear;
700 ClearGrid(AdvancedUsersGrid);
701 ClearGrid(BasicUsersGrid);
702 UsersTreeView.Items.Clear;
703 AllUsers := UsersTreeView.Items.Add(nil, 'All Users'); { Add root node }
704 AllUsers.ImageIndex := 2;
705 AllUsers.SelectedIndex := 2;
706 ActiveUsers := UsersTreeView.Items.AddChild(AllUsers,'Active Users');
707 ActiveUsers.ImageIndex := 0;
708 ActiveUsers.SelectedIndex := 0;
709 InactiveUsers := UsersTreeView.Items.AddChild(AllUsers,'Inactive Users');
710 InactiveUsers.ImageIndex := 1;
711 InactiveUsers.SelectedIndex := 1;
712 AllUsers.Expand(true);
713 UsersList := TStringList.create;
714 UsersList.Sorted := false;
715 GetUsersList(UsersList,false);
716 LoadUsersTreeView(UsersList);
717 UsersList.free;
718 end;
719
720
721 procedure TMainForm.InitializeSettingsFilesTreeView;
722 var
723 RecordsList : TStringList;
724 index : integer;
725 begin
726 RecordsList := TStringList.Create;
727 SettingsFiles.Clear;
728 SettingsFiles.Add('<blank line>'); // to index 0 is not used for file info.
729 ClearGrid(AdvancedSettingsGrid);
730 ClearGrid(BasicSettingsGrid);
731 SettingsTreeView.Items.Clear;
732 AllSettings := SettingsTreeView.Items.Add(nil, 'All Settings Files'); { Add root node }
733 AllSettings.ImageIndex := 8;
734 AllSettings.SelectedIndex := 8;
735 AllSettings.StateIndex := 7;
736
737 index := SettingsFiles.Add('8989.3');
738 KernelSysParams := SettingsTreeView.Items.AddChildObject(AllSettings,'Kernel System Parameters',Pointer(index));
739 KernelSysParams.ImageIndex := 8;
740 KernelSysParams.SelectedIndex := 8;
741 KernelSysParams.StateIndex := 7;
742 GetRecordsList(RecordsList,'8989.3'); // KERNEL SYSTEM PARAMETERS file
743 LoadSettingsTreeView(RecordsList,KernelSysParams);
744 RecordsList.Clear;
745
746 index := SettingsFiles.Add('44');
747 HospLoc := SettingsTreeView.Items.AddChildObject(AllSettings,'Practice Locations',Pointer(index));
748 HospLoc.ImageIndex := 8;
749 HospLoc.SelectedIndex := 8;
750 HospLoc.StateIndex := 7;
751 GetRecordsList(RecordsList,'44'); //HOSPITAL LOCATION file
752 LoadSettingsTreeView(RecordsList,HospLoc);
753 RecordsList.Clear;
754
755 index := SettingsFiles.Add('8994.1');
756 RPCBrokerParams := SettingsTreeView.Items.AddChildObject(AllSettings,'RPC Broker Settings',Pointer(index));
757 RPCBrokerParams.ImageIndex := 8;
758 RPCBrokerParams.SelectedIndex := 8;
759 RPCBrokerParams.StateIndex := 7;
760 GetRecordsList(RecordsList,'8994.1'); // RPC BROKER SITE PARAMETERS
761 LoadSettingsTreeView(RecordsList,RPCBrokerParams);
762 RecordsList.Clear;
763
764 index := SettingsFiles.Add('3.5');
765 Devices := SettingsTreeView.Items.AddChildObject(AllSettings,'Devices',Pointer(index));
766 Devices.ImageIndex := 8;
767 Devices.SelectedIndex := 8;
768 Devices.StateIndex := 7;
769 GetRecordsList(RecordsList,'3.5'); // DEVICE
770 LoadSettingsTreeView(RecordsList,Devices);
771 RecordsList.Clear;
772
773 RecordsList.Free;
774 end;
775
776
777 procedure TMainForm.FormDestroy(Sender: TObject);
778 var i : integer;
779 tempInfo : TGridInfo;
780 begin
781 CurrentUserData.Free;
782 BasicTemplate.Free;
783 SettingsFiles.Free;
784 CurrentSettingsData.Free;
785 CurrentPatientData.Free;
786 CurrentAnyFileData.Free;
787 for i := 0 to DataForGrid.Count-1 do begin
788 tempInfo := TGridInfo(DataForGrid.Objects[i]);
789 //tempInfo.Data.Free; //not owned here....
790 tempInfo.Free;
791 end;
792 DataForGrid.Free;
793
794 CachedHelp.Free;
795 CachedHelpIdx.Free;
796 CachedWPField.Free;
797
798 end;
799
800
801 procedure TMainForm.UsersTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
802 begin
803 AllowChange := (PostVisibleGrid <> mrNO);
804 if AllowChange then LastSelTreeNode := Node;
805 end;
806
807
808 function TMainForm.PostVisibleGrid: TModalResult;
809 begin
810 result := PostChanges(GetVisibleGrid);
811 end;
812
813
814 procedure TMainForm.SettingsTreeViewChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
815 begin
816 AllowChange := (PostVisibleGrid <> mrNO);
817 if AllowChange then LastSelTreeNode := Node;
818 end;
819
820
821 procedure TMainForm.UsersTreeViewChange(Sender: TObject; Node: TTreeNode);
822 var IEN : longInt;
823 GridInfo : TGridInfo;
824 begin
825 //get info from selected node.
826 LastSelTreeNode := Node;
827 IEN := longInt(Node.Data);
828 if IEN = 0 then exit;
829 GridInfo := GetInfoForGrid(BasicUsersGrid);
830 if GridInfo = nil then exit;
831 GridInfo.IENS := IntToStr(IEN) + ',';
832 LoadUserData(GridInfo);
833 end;
834
835 procedure TMainForm.SettingsTreeViewChange(Sender: TObject; Node: TTreeNode);
836 var IEN : longInt;
837 FileNum : string;
838 GridInfo : TGridInfo;
839 begin
840 //get info from selected node.
841 LastSelTreeNode := Node;
842 GridInfo := GetInfoForGrid(BasicSettingsGrid);
843 if GridInfo = nil then exit;
844 IEN := longInt(Node.Data);
845 if IEN = 0 then exit;
846 FileNum := FileNumForSettingsNode (Node);
847 if FileNum = '' then exit;
848 GridInfo.IENS := IntToStr(IEN) + ',';
849 GridInfo.FileNum := FileNum;
850 GetSettingsInfo(GridInfo);
851 end;
852
853 function TMainForm.FileNumForSettingsNode (Node : TTreeNode) : string;
854 var index : integer;
855 Parent : TTreeNode;
856 begin
857 Result := '';
858 Parent := Node.Parent;
859 if Parent <> nil then begin
860 index := integer(Parent.Data);
861 if (index >0) and (index < SettingsFiles.count) then Result := SettingsFiles.Strings[index];
862 end;
863 end;
864
865
866 procedure TMainForm.LoadUserData(GridInfo : TGridInfo);
867 //Purpose: Get all fields from server for one record.
868 //Data is an OUT parameter.
869 var cmd,RPCResult : string;
870 IENS : String;
871 Data : TStringList;
872 begin
873 Data := GridInfo.Data;
874 IENS := GridInfo.IENS;
875 Data.Clear;
876 ClearGrid(AdvancedUsersGrid);
877 ClearGrid(BasicUsersGrid);
878 SetCursorImage(crHourGlass);
879 if IENS <> '0,' then begin
880 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
881 RPCBrokerV.param[0].ptype := list;
882 cmd := 'GET ONE USER^' + IENS;
883 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
884 RPCBrokerV.Call;
885 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
886 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
887 //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
888 if piece(RPCResult,'^',1)='-1' then begin
889 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
890 FMErrorForm.PrepMessage;
891 FMErrorForm.ShowModal;
892 end else begin
893 Data.Assign(RPCBrokerV.results);
894 LoadAnyGrid(AdvancedUsersGrid,false,'200',IENS,Data);
895 LoadAnyGrid(BasicUsersGrid,true,'200',IENS,Data);
896 btnUsersRevert.Enabled := false;
897 btnUsersApply.Enabled := false;
898 end;
899 end;
900 SetCursorImage(crDefault);
901
902 end;
903
904 procedure TMainForm.SetCursorImage(Cursor : TCursor);
905 begin
906 BasicUsersGrid.Cursor := Cursor;
907 AdvancedUsersGrid.Cursor := Cursor;
908 UsersTreeView.Cursor := Cursor;
909
910 BasicSettingsGrid.Cursor := Cursor;
911 AdvancedSettingsGrid.Cursor := Cursor;
912 SettingsTreeView.Cursor := Cursor;
913
914 PatientORComboBox.Cursor := Cursor;
915 BasicPatientGrid.Cursor := Cursor;
916 AdvancedPatientGrid.Cursor := Cursor;
917
918 end;
919
920
921 procedure TMainForm.GetSettingsInfo(GridInfo : TGridInfo);
922 //Purpose: Get all fields from server for one record.
923 //Data is an OUT parameter.
924 var cmd,RPCResult : string;
925 FileNum : String;
926 IENS : String;
927 Data : TStringList ;
928 begin
929 FileNum := GridInfo.FileNum;
930 IENS := GridInfo.IENS;
931 Data := GridInfo.Data;
932 Data.Clear;
933 ClearGrid(AdvancedSettingsGrid);
934 ClearGrid(BasicSettingsGrid);
935 if IENS <> '0,' then begin
936 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
937 RPCBrokerV.param[0].ptype := list;
938 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
939 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
940 RPCBrokerV.Call;
941 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
942 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
943 //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
944 if piece(RPCResult,'^',1)='-1' then begin
945 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
946 FMErrorForm.PrepMessage;
947 FMErrorForm.ShowModal;
948 end else begin
949 Data.Assign(RPCBrokerV.results);
950 LoadAnyGrid(AdvancedSettingsGrid,false,FileNum,IENS,Data);
951 LoadAnyGrid(BasicSettingsGrid,true,FileNum,IENS,Data);
952 btnSettingsRevert.Enabled := false;
953 btnSettingsApply.Enabled := false;
954 end;
955 end;
956 end;
957
958 procedure TMainForm.GetPatientInfo(GridInfo : TGridInfo);
959 var cmd,RPCResult : string;
960 IENS : String;
961 Data : TStringList;
962 begin
963 IENS := GridInfo.IENS;
964 Data := GridInfo.Data;
965 Data.Clear;
966 ClearGrid(AdvancedPatientGrid);
967 ClearGrid(BasicPatientGrid);
968 SetCursorImage(crHourGlass);
969 if IENS <> '0,' then begin
970 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
971 RPCBrokerV.param[0].ptype := list;
972 cmd := 'GET ONE RECORD^2^' + IENS;
973 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
974 RPCBrokerV.Call;
975 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
976 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
977 //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
978 if piece(RPCResult,'^',1)='-1' then begin
979 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
980 FMErrorForm.PrepMessage;
981 FMErrorForm.ShowModal;
982 end else begin
983 Data.Assign(RPCBrokerV.results);
984 LoadAnyGrid(AdvancedPatientGrid,false,'2',IENS,Data);
985 LoadAnyGrid(BasicPatientGrid,true,'2',IENS,Data);
986 btnPatientRevert.Enabled := false;
987 btnPatientApply.Enabled := false;
988 end;
989 end;
990 SetCursorImage(crDefault);
991 end;
992
993
994 procedure TMainForm.GetAnyfileInfo(GridInfo : TGridInfo);
995 //Purpose: Get all fields from server for one record.
996 //Data is an OUT parameter.
997 var cmd,RPCResult : string;
998 FileNum : String;
999 IENS : String;
1000 Data : TStringList;
1001 begin
1002 FileNum := GridInfo.FileNum;
1003 IENS := GridInfo.IENS;
1004 Data := GridInfo.Data;
1005 Data.Clear;
1006 ClearGrid(AnyFileGrid);
1007 if IENS <> '0,' then begin
1008 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1009 RPCBrokerV.param[0].ptype := list;
1010 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
1011 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1012 RPCBrokerV.Call;
1013 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1014 //Results[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1015 //Results[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1016 if piece(RPCResult,'^',1)='-1' then begin
1017 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1018 FMErrorForm.PrepMessage;
1019 FMErrorForm.ShowModal;
1020 end else begin
1021 Data.Assign(RPCBrokerV.results);
1022 LoadAnyGrid(AnyFileGrid,false,FileNum,IENS,Data);
1023 btnAdvancedRevert.Enabled := false;
1024 btnAdvancedApply.Enabled := false;
1025 end;
1026 end;
1027 end;
1028
1029
1030
1031 procedure TMainForm.ClearGrid(Grid : TStringGrid);
1032 begin
1033 Grid.Cells[0,1] := '';
1034 Grid.Cells[1,1] := '';
1035 Grid.Cells[2,1] := '';
1036 Grid.RowCount :=2;
1037 end;
1038
1039
1040 procedure TMainForm.LoadAnyGrid(Grid : TStringGrid; //the TStringGrid to load
1041 BasicMode: boolean;
1042 FileNum : string;
1043 IENS : string;
1044 CurrentData : TStringList);
1045 var
1046 GridInfo : TGridInfo;
1047 begin
1048 //This stores load information into GridInfo.
1049 GridInfo := GetInfoForGrid(Grid);
1050 if GridInfo = nil then exit;
1051 GridInfo.Grid := Grid;
1052 GridInfo.BasicMode := BasicMode;
1053 GridInfo.FileNum := FileNum;
1054 GridInfo.IENS := IENS;
1055 GridInfo.Data := CurrentData;
1056 LoadAnyGridFromInfo(GridInfo);
1057 end;
1058
1059
1060 procedure TMainForm.LoadAnyGridFromInfo(GridInfo : TGridInfo);
1061 //Format of CurrentData:
1062 //Data[0]=1^Success
1063 //Data[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1064 //Data[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1065 //...
1066
1067 //This assumes that GridInfo already has loaded info.
1068 var
1069 Grid : TStringGrid; //the TStringGrid to load
1070 BasicMode: boolean;
1071 FileNum : string;
1072 IENS : string;
1073 CurrentData : TStringList;
1074
1075 procedure LoadOneLine (Grid : TStringGrid; oneEntry : string; GridRow : integer);
1076 var
1077 tempFile,IENS : string;
1078 fieldNum,fieldName,fieldDef : string;
1079 subFileNum : string;
1080 value : string;
1081 begin
1082 tempFile := Piece(oneEntry,'^',1);
1083 if tempFile = FileNum then begin //handle subfiles later...
1084 IENS := Piece(oneEntry,'^',2);
1085 fieldNum := Piece(oneEntry,'^',3);
1086 value := Piece(oneEntry,'^',4);
1087 fieldName := Piece(oneEntry,'^',5);
1088 fieldDef := Piece(oneEntry,'^',6);
1089 Grid.RowCount := GridRow + 1;
1090 Grid.Cells[0,GridRow] := fieldNum;
1091 Grid.Cells[1,GridRow] := fieldName;
1092 if Pos('W',fieldDef)>0 then begin
1093 Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
1094 end else if IsSubFile(fieldDef, subFileNum) then begin
1095 if IsWPField(FileNum,fieldNum) then begin
1096 Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
1097 end else begin
1098 Grid.Cells[2,GridRow] := CLICK_FOR_SUBS;
1099 end;
1100 end else if Pos('C',fieldDef)>0 then begin
1101 Grid.Cells[2,GridRow] := COMPUTED_FIELD;
1102 end else begin
1103 Grid.Cells[2,GridRow] := value;
1104 end;
1105 Grid.RowHeights[GridRow] := DEF_GRID_ROW_HEIGHT;
1106 end;
1107 end;
1108
1109 function getOneLine(CurrentData : TStringList; oneFileNum,oneFieldNum : string) : string;
1110 var i : integer;
1111 FileNum,FieldNum : string;
1112 begin
1113 result := '';
1114 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1115 for i := 1 to CurrentData.Count - 1 do begin
1116 FileNum := piece(CurrentData.Strings[i],'^',1);
1117 if FileNum <> oneFileNum then continue;
1118 FieldNum := piece(CurrentData.Strings[i],'^',3);
1119 if FieldNum <> oneFieldNum then continue;
1120 result := CurrentData.Strings[i];
1121 break;
1122 end;
1123 end;
1124
1125 var i : integer;
1126 oneEntry : string;
1127 oneFileNum,oneFieldNum : string;
1128 gridRow : integer;
1129 //GridInfo : TGridInfo;
1130
1131 begin
1132 FLoadingGrid := true;
1133
1134 if GridInfo=nil then exit;
1135
1136 Grid := GridInfo.Grid;
1137 BasicMode := GridInfo.BasicMode;
1138 FileNum := GridInfo.FileNum;
1139 IENS := GridInfo.IENS;
1140 CurrentData := GridInfo.Data;
1141
1142 ClearGrid(Grid);
1143 Grid.ColWidths[0] := 50;
1144 Grid.ColWidths[1] := 200;
1145 Grid.ColWidths[2] := 300;
1146 Grid.Cells[0,0] := '#';
1147 Grid.Cells[1,0] := 'Name';
1148 Grid.Cells[2,0] := 'Value';
1149
1150 if BasicMode=false then begin
1151 for i := 1 to CurrentData.Count-1 do begin //start at 1 because [0] = 1^Success
1152 oneEntry := CurrentData.Strings[i];
1153 LoadOneLine (Grid,oneEntry,i);
1154 end;
1155 end else if BasicMode=true then begin
1156 gridRow := 1;
1157 for i := 0 to BasicTemplate.Count-1 do begin
1158 oneFileNum := Piece(BasicTemplate.Strings[i],'^',1);
1159 if oneFileNum <> fileNum then continue;
1160 oneFieldNum := Piece(BasicTemplate.Strings[i],'^',2);
1161 oneEntry := getOneLine(CurrentData,oneFileNum,oneFieldNum);
1162 LoadOneLine (Grid,oneEntry,gridRow);
1163 Inc(GridRow);
1164 end;
1165 end;
1166 FLoadingGrid := false;
1167 end;
1168
1169
1170 procedure TMainForm.GridSelectCell(Sender: TObject; ACol, ARow: Integer;
1171 var CanSelect: Boolean);
1172 (*
1173 For Field def, here is the legend
1174 character meaning
1175
1176 BC The data is Boolean Computed (true or false).
1177 C The data is Computed.
1178 Cm The data is multiline Computed.
1179 DC The data is Date-valued, Computed.
1180 D The data is Date-valued.
1181 F The data is Free text.
1182 I The data is uneditable.
1183 Pn The data is a Pointer reference to file "n".
1184 S The data is from a discrete Set of codes.
1185
1186 N The data is Numeric-valued.
1187
1188 Jn To specify a print length of n characters.
1189 Jn,d To specify printing n characters with decimals.
1190
1191 V The data is a Variable pointer.
1192 W The data is Word processing.
1193 WL The Word processing data is normally printed in Line mode (i.e., without word wrap).
1194 *)
1195 var oneEntry,FieldDef : string;
1196 date,time: string;
1197 FileNum,FieldNum,SubFileNum : string;
1198 GridFileNum : string;
1199 UserLine : integer;
1200 Grid : TStringGrid;
1201 IEN : int64;
1202 IENS : string;
1203 CurrentData : TStringList;
1204 GridInfo : TGridInfo;
1205 SubFileForm : TSubFileForm;
1206 begin
1207 if FLoadingGrid then exit; //prevent pseudo-clicks during loading...
1208 Grid := (Sender as TStringGrid);
1209 GridInfo := GetInfoForGrid(Grid);
1210 if GridInfo=nil then exit;
1211 GridFileNum := GridInfo.FileNum;
1212 CanSelect := false; //default to NOT selectable.
1213 CurrentData := GridInfo.Data;
1214 if CurrentData=nil then exit;
1215 if CurrentData.Count = 0 then exit;
1216 UserLine := GetUserLine(CurrentData,Grid,ARow);
1217 if UserLine = -1 then exit;
1218 oneEntry := CurrentData.Strings[UserLine];
1219 FieldDef := Piece(oneEntry,'^',6);
1220 if Pos('F',FieldDef)>0 then begin //Free text
1221 CanSelect := true;
1222 end else if IsSubFile(FieldDef,SubFileNum) then begin //Subfiles.
1223 FileNum := Piece(oneEntry,'^',1);
1224 FieldNum := Piece(oneEntry,'^',3);
1225 if IsWPField(FileNum,FieldNum) then begin
1226 IENS := Piece(oneEntry,'^',2);
1227 EditTextForm.PrepForm(FileNum,FieldNum,IENS);
1228 EditTextForm.ShowModal;
1229 end else begin
1230 //handle subfiles here
1231 IENS := '';
1232 if GridInfo.Message = MSG_SUB_FILE then begin //used message from subfile Grid
1233 IENS := GridInfo.IENS;
1234 end else if LastSelTreeNode <> nil then begin //this is one of the selction trees.
1235 IEN := longInt(LastSelTreeNode.Data);
1236 if IEN > 0 then IENS := InttoStr(IEN) + ',';
1237 end else if GridInfo.Data = CurrentAnyFileData then begin
1238 IEN := RecordORComboBox.ItemID; //get info from selected record
1239 if IEN > 0 then IENS := InttoStr(IEN) + ',';
1240 end;
1241 if IENS <> '' then begin
1242 SubFileForm := TSubFileForm.Create(self);
1243 SubFileForm.PrepForm(SubFileNum,IENS);
1244 SubfileForm.ShowModal; // note: may call this function again recursively for sub-sub-files etc.
1245 SubFileForm.Free;
1246 end else begin
1247 MessageDlg('IENS for File="". Can''t process.',mtInformation,[MBOK],0);
1248 end;
1249 end;
1250 end else if Pos('C',FieldDef)>0 then begin //computed fields.
1251 CanSelect := false;
1252 end else if Pos('D',FieldDef)>0 then begin //date field
1253 date := piece(Grid.Cells[ACol,ARow],'@',1);
1254 time := piece(Grid.Cells[ACol,ARow],'@',2);
1255 if date <> '' then begin
1256 SelDateTimeForm.DateTimePicker.Date := StrToDate(date);
1257 end else begin
1258 SelDateTimeForm.DateTimePicker.Date := SysUtils.Date;
1259 end;
1260 if SelDateTimeForm.ShowModal = mrOK then begin
1261 date := DateToStr(SelDateTimeForm.DateTimePicker.Date);
1262 time := TimeToStr(SelDateTimeForm.DateTimePicker.Time);
1263 if time <> '' then date := date; // + '@' + time; elh 8/15/08
1264 Grid.Cells[ACol,ARow] := date;
1265 end;
1266 CanSelect := true;
1267 end else if Pos('S',FieldDef)>0 then begin //Set of Codes
1268 SetSelForm.PrepForm(Piece(oneEntry,'^',7));
1269 if SetSelForm.ShowModal = mrOK then begin
1270 Grid.Cells[ACol,ARow] := SetSelForm.ComboBox.Text;
1271 CanSelect := true;
1272 end;
1273 end else if Pos('I',FieldDef)>0 then begin //uneditable
1274 MessageDlg('Sorry. Flagged as UNEDITABLE.',mtInformation ,[mbOK],0);
1275 end else if Pos('P',FieldDef)>0 then begin //Pointer to file.
1276 FileNum := ExtractNum (FieldDef,Pos('P',FieldDef)+1);
1277 //check for validity here...
1278 FieldLookupForm.PrepForm(FileNum,Grid.Cells[ACol,ARow]);
1279 if FieldLookupForm.ShowModal = mrOK then begin
1280 Grid.Cells[ACol,ARow] := FieldLookupForm.ORComboBox.Text;
1281 CanSelect := true;
1282 end;
1283 end;
1284 if CanSelect then begin
1285 FLastSelectedRow := ARow;
1286 FLastSelectedCol := ACol;
1287 end;
1288 GridInfo.ApplyBtn.Enabled := true;
1289 GridInfo.RevertBtn.Enabled := true;
1290 end;
1291
1292
1293 function TMainForm.GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
1294 var fieldNum : string;
1295 oneEntry : string;
1296 fileNum : string;
1297 gridRow : integer;
1298 begin
1299 fieldNum := Grid.Cells[0,ARow];
1300 gridRow := FindInStrings(fieldNum, CurrentUserData, fileNum);
1301 if gridRow > -1 then begin
1302 oneEntry := CurrentUserData.Strings[gridRow];
1303 Result.Field := fieldNum;
1304 Result.FieldName := Grid.Cells[1,ARow];
1305 Result.FileNum := fileNum;
1306 Result.IENS := Piece(oneEntry,'^',2);
1307 Result.oldValue := Piece(oneEntry,'^',4);
1308 Result.newValue := Grid.Cells[2,ARow];
1309 end else begin
1310 Result.Field := '';
1311 Result.FieldName := '';
1312 Result.FileNum := '';
1313 Result.IENS := '';
1314 Result.oldValue := '';
1315 Result.newValue := '';
1316 end;
1317 end;
1318
1319 function TMainForm.GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow: integer) : integer;
1320 var fieldNum: string;
1321 tempFileNum : string;
1322 begin
1323 fieldNum := Grid.Cells[0,ARow];
1324 Result := FindInStrings(fieldNum,CurrentUserData,tempFileNum);
1325 end;
1326
1327 function TMainForm.FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer;
1328 //Note: if fileNum is passed blank, then first matching file will be placed in it (i.e. OUT parameter)
1329 var tempFieldNum : string;
1330 oneEntry,tempFile : string;
1331 i : integer;
1332 begin
1333 result := -1;
1334 fileNum := '';
1335 for i := 1 to Strings.Count-1 do begin //0 --> 1^success
1336 oneEntry := Strings.Strings[i];
1337 tempFile := Piece(oneEntry,'^',1);
1338 if fileNum='' then fileNum := tempFile;
1339 if tempFile <> fileNum then continue; //ignore subfiles
1340 tempFieldNum := Piece(oneEntry,'^',3);
1341 if tempFieldNum <> fieldNum then continue;
1342 Result := i;
1343 break;
1344 end;
1345 end;
1346
1347
1348 function TMainForm.IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean;
1349 //SubFileNum is OUT parameter
1350 begin
1351 SubFileNum := ExtractNum(FieldDef,1);
1352 result := (SubFileNum <> '');
1353 end;
1354
1355 function TMainForm.IsWPField(FileNum,FieldNum : string) : boolean;
1356 var RPCResult : string;
1357 SrchStr : string;
1358 Idx: integer;
1359 begin
1360 SrchStr := FileNum + '^' + FieldNum + '^';
1361 Idx := CachedWPField.IndexOf(SrchStr + 'YES');
1362 if Idx > -1 then begin Result := true; exit; end;
1363 Idx := CachedWPField.IndexOf(SrchStr + 'NO');
1364 if Idx > -1 then begin Result := false; exit; end;
1365
1366 result := false;
1367 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1368 RPCBrokerV.param[0].ptype := list;
1369 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum;
1370 RPCBrokerV.Call;
1371 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1372 if piece(RPCResult,'^',1)='-1' then begin
1373 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1374 FMErrorForm.PrepMessage;
1375 FMErrorForm.ShowModal;
1376 end else begin
1377 RPCResult := piece(RPCResult,'^',3);
1378 result := (RPCResult = 'YES');
1379 CachedWPField.Add(SrchStr + RPCResult);
1380 end;
1381 end;
1382
1383
1384 function TMainForm.ExtractNum (S : String; StartPos : integer) : string;
1385 var i : integer;
1386 ch : char;
1387 begin
1388 result := '';
1389 if (S = '') or (StartPos < 0) then exit;
1390 i := StartPos;
1391 repeat
1392 ch := S[i];
1393 i := i + 1;
1394 if ch in ['0'..'9','.'] then begin
1395 Result := Result + ch;
1396 end;
1397 until (i > length(S)) or not (ch in ['0'..'9','.'])
1398 end;
1399
1400 procedure TMainForm.Button1Click(Sender: TObject);
1401 begin
1402 FieldLookupForm.Show;
1403 end;
1404
1405 procedure TMainForm.btnUsersRevertClick(Sender: TObject);
1406 begin
1407 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
1408 {
1409 LoadAnyGridFromInfo(GetInfoForGrid(AdvancedUsersGrid));
1410 LoadAnyGridFromInfo(GetInfoForGrid(BasicUsersGrid));
1411 btnUsersRevert.Enabled := false;
1412 btnUsersApply.Enabled := false;
1413 }
1414 end;
1415
1416 function TMainForm.GetVisibleGridInfo : TGridInfo;
1417 begin
1418 result := GetInfoForGrid(GetVisibleGrid);
1419 end;
1420
1421 function TMainForm.GetVisibleGrid: TStringGrid;
1422 begin
1423 if FVisibleGridIdx > -1 then begin
1424 result := TGridInfo(DataForGrid.Objects[FVisibleGridIdx]).Grid;
1425 end else begin
1426 result := nil;
1427 end;
1428 end;
1429
1430 function TMainForm.GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
1431 var i : integer;
1432 begin
1433 i := GetInfoIndexForGrid(Grid);
1434 if i > -1 then begin
1435 result := TGridInfo(DataForGrid.Objects[i]);
1436 end else begin
1437 result := nil;
1438 end;
1439 end;
1440
1441
1442 function TMainForm.GetInfoIndexForGrid(Grid : TStringGrid) : integer;
1443 var s : string;
1444 begin
1445 s := IntToStr(integer(Grid));
1446 result := DataForGrid.IndexOf(s);
1447 end;
1448
1449 procedure TMainForm.SetVisibleGridIdx(Grid : TStringGrid);
1450 begin
1451 FVisibleGridIdx := GetInfoIndexForGrid(Grid);
1452 end;
1453
1454
1455 procedure TMainForm.CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
1456 //Output format:
1457 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1458
1459 var row : integer;
1460 Entry : tFileEntry;
1461 oneEntry : string;
1462 begin
1463 for row := 1 to Grid.RowCount-1 do begin
1464 Entry := GetLineInfo(Grid,CurrentUserData, row);
1465 if Entry.oldValue <> Entry.newValue then begin
1466 if (Entry.newValue <> CLICK_FOR_SUBS) and
1467 (Entry.newValue <> COMPUTED_FIELD) and
1468 (Entry.newValue <> CLICK_TO_EDIT) then begin
1469 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
1470 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
1471 Changes.Add(oneEntry);
1472 end;
1473 end;
1474 end;
1475 end;
1476
1477
1478 function TMainForm.PostChanges(Grid : TStringGrid) : TModalResult;
1479 //Results: mrNone -- no post done (not needed)
1480 // mrCancel -- user pressed cancel on confirmation screen.
1481 // mrNo -- signals posting error.
1482 var Changes : TStringList;
1483 PostResult : TModalResult;
1484 CurrentData : TStringList;
1485 GridInfo : TGridInfo;
1486 IENS : string;
1487 begin
1488 Result := mrNone; //default to No changes
1489 GridInfo := GetInfoForGrid(Grid);
1490 if GridInfo=nil then exit;
1491 CurrentData := GridInfo.Data;
1492 if CurrentData=nil then exit;
1493 if CurrentData.Count = 0 then exit;
1494 IENS := GridInfo.IENS;
1495 if IENS='' then exit;
1496 Changes := TStringList.Create;
1497 CompileChanges(Grid,CurrentData,Changes);
1498 if Changes.Count>0 then begin
1499 PostForm.PrepForm(Changes);
1500 PostResult := PostForm.ShowModal;
1501 if PostResult = mrOK then begin
1502 if DisuserChanged(Changes) then begin //looks for change in file 200, field 4
1503 InitializeUsersTreeView;
1504 end else begin
1505 if Pos('+',IENS)>0 then begin
1506 GridInfo.IENS := PostForm.GetNewIENS(IENS);
1507 end;
1508 if assigned(GridInfo.DataLoadProc) then begin
1509 GridInfo.DataLoadProc(GridInfo);
1510 end;
1511 {
1512 if CurrentData = CurrentUserData then begin
1513 LoadUserData(IENS,CurrentData); //reload record from server.
1514 end else if CurrentData = CurrentSettingsData then begin
1515 GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1516 end else if CurrentData = CurrentPatientData then begin
1517 GetPatientInfo(GridInfo.IENS, CurrentData);
1518 end else if CurrentData = CurrentAnyFileData then begin
1519 GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1520 end;
1521 }
1522 end;
1523 end else if PostResult = mrNo then begin //mrNo is signal of post Error
1524 // show error...
1525 end;
1526 Result := PostResult;
1527 end else begin
1528 Result := mrNone;
1529 end;
1530 Changes.Free;
1531 end;
1532
1533 function TMainForm.DisuserChanged(Changes: TStringList) : boolean;
1534 var i : integer;
1535 //Changes format:
1536 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1537 begin
1538 result := false;
1539 for i := 0 to Changes.Count-1 do begin
1540 if piece(Changes.Strings[i],'^',1)<> '200' then continue;
1541 if piece(Changes.Strings[i],'^',4)<> 'DISUSER' then continue;
1542 result := true;
1543 break;
1544 end;
1545 end;
1546
1547
1548 procedure TMainForm.btnUsersApplyClick(Sender: TObject);
1549 var result : TModalResult;
1550 begin
1551 result:= PostVisibleGrid;
1552 if result <> mrNone then InitializeUsersTreeView;
1553 end;
1554
1555 procedure TMainForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1556 begin
1557 btnUsersRevert.Enabled := true;
1558 btnUsersApply.Enabled := true;
1559 end;
1560
1561 procedure TMainForm.BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1562 begin
1563 btnSettingsRevert.Enabled := true;
1564 btnSettingsApply.Enabled := true;
1565 end;
1566
1567
1568 procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
1569 begin
1570 PostVisibleGrid;
1571 RPCBrokerV.Connected := false; //disconnect
1572 end;
1573
1574 procedure TMainForm.ExitMenuItemClick(Sender: TObject);
1575 begin
1576 Close;
1577 end;
1578
1579 procedure TMainForm.UserPageControlDrawTab(Control: TCustomTabControl;
1580 TabIndex: Integer;
1581 const Rect: TRect;
1582 Active: Boolean);
1583 begin
1584 DrawTab(Control,TabIndex,Rect,Active);
1585 end;
1586
1587 procedure TMainForm.DrawTab(Control: TCustomTabControl;
1588 TabIndex: Integer;
1589 const Rect: TRect;
1590 Active: Boolean);
1591 var
1592 oRect : TRect;
1593 sCaption,temp : String;
1594 iTop : Integer;
1595 iLeft : Integer;
1596 i : integer;
1597
1598 begin
1599 oRect := Rect;
1600 temp := TPageControl(Control).Pages[TabIndex].Caption;
1601 for i := 1 to length(temp) do begin
1602 if temp[i] <> '&' then sCaption := sCaption + temp[i];
1603 end;
1604
1605 iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
1606 iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
1607
1608 if Active then begin
1609 Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow
1610 Control.Canvas.FillRect(Rect);
1611// Frame3d(Control.Canvas,oRect,clBtnHighLight,clBtnShadow,3);
1612
1613 end else begin
1614 Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow
1615 Control.Canvas.FillRect(Rect);
1616 end;
1617 Control.Canvas.TextOut(iLeft,iTop,sCaption);
1618 end;
1619
1620
1621 procedure TMainForm.AboutMenuClick(Sender: TObject);
1622 begin
1623 AboutForm.show;
1624 end;
1625
1626 procedure TMainForm.CloneBtnClick(Sender: TObject);
1627 var IEN : longInt;
1628 newName : string;
1629 IENS,newIENS : string;
1630
1631 begin
1632 if btnUsersApply.Enabled then btnUsersApplyClick(self); //post any changes first.
1633 if MessageDlg('Clone user: '+LastSelTreeNode.Text+' --> New user?' + #10 + #13 +
1634 'Note: This can not be undone.',
1635 mtConfirmation, mbOKCancel,0) = mrCancel then exit;
1636 IEN := longInt(LastSelTreeNode.Data);
1637 IENS := IntToStr(IEN) + ',';
1638 WaitForm.Show;
1639 newName := 'TEMP,MUST-EDIT';
1640 newIENS := DoCloneUser(IENS,newName);
1641 InitializeUsersTreeView; //refresh UsersTreeView.
1642 WaitForm.Hide;
1643 MessageDlg('A new cloned user has been created,' + #10 + #13 +
1644 'named: ' + newName + #10 + #13 +
1645 #10 + #13 +
1646 'This user can be found in the ''Inactive users'' list,' + #10 + #13 +
1647 'but must must be edited before it may be used.' + #10 + #13 +
1648 'Edit it''s DISUSER field to a value of ''NO''' + #10 + #13 +
1649 'to activate.',mtInformation,[mbOK],0);
1650 end;
1651
1652
1653 function TMainForm.DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string;
1654 //Returns IENS of new record in FileNum, or '' if error
1655 var cmd,RPCResult : string;
1656 begin
1657 Result := '';
1658 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1659 RPCBrokerV.param[0].ptype := list;
1660 cmd := 'CLONE RECORD' + '^' + FileNum + '^' + SourceIENS + '^' + New01Field;
1661 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1662 RPCBrokerV.Call;
1663 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1664 if piece(RPCResult,'^',1)='-1' then begin
1665 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1666 FMErrorForm.PrepMessage;
1667 FMErrorForm.ShowModal;
1668 end else begin
1669 result := piece(RPCResult,'^',3);
1670 end;
1671 end;
1672
1673 function TMainForm.DoCloneUser(SourceIENS, New01Field : String) : string;
1674 //Returns IENS of new record in FileNum, or '' if error
1675 var cmd,RPCResult : string;
1676 begin
1677 Result := '';
1678 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1679 RPCBrokerV.param[0].ptype := list;
1680 cmd := 'CLONE USER' + '^' + SourceIENS + '^' + New01Field;
1681 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1682 RPCBrokerV.Call;
1683 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1684 if piece(RPCResult,'^',1)='-1' then begin
1685 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1686 FMErrorForm.PrepMessage;
1687 FMErrorForm.ShowModal;
1688 end else begin
1689 result := piece(RPCResult,'^',3);
1690 end;
1691 end;
1692
1693 function TMainForm.FieldHelp(FileNum, FieldNum, HelpStyle : string) : string;
1694 var
1695 RPCResult: string;
1696 cmd : string;
1697 SrchStr : string;
1698 Idx : integer;
1699 begin
1700 Result := '';
1701 SrchStr := FileNum + '^' + FieldNum + '^' + HelpStyle;
1702 Idx := CachedHelpIdx.IndexOf(SrchStr);
1703 if Idx = -1 then begin
1704 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1705 RPCBrokerV.param[0].ptype := list;
1706 cmd := 'GET HELP MSG^' + SrchStr;
1707 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1708 RPCBrokerV.Call;
1709 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1710 if piece(RPCResult,'^',1)='-1' then begin
1711 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1712 FMErrorForm.PrepMessage;
1713 FMErrorForm.ShowModal;
1714 end else begin
1715 RPCBrokerV.Results.Delete(0);
1716 if RPCBrokerV.Results.Strings[RPCBrokerV.Results.Count-1]='' then begin
1717 RPCBrokerV.Results.Delete(RPCBrokerV.Results.Count-1);
1718 end;
1719 result := RPCBrokerV.Results.Text;
1720 //Maybe later replace text with "Enter F1 for more help."
1721 Result := AnsiReplaceText(Result,'Enter ''??'' for more help.','');
1722 while Result[Length(Result)] in [#10,#13] do begin
1723 Result := AnsiLeftStr(Result,Length(Result)-1);
1724 end;
1725 Idx := CachedHelp.Add(result);
1726 CachedHelpIdx.AddObject(SrchStr,Pointer(Idx)); //Store index here to help stored in CachedHelp
1727 end;
1728 end else begin
1729 Idx := Integer(CachedHelpIdx.Objects[Idx]);
1730 if (Idx >= 0) and (Idx < CachedHelp.Count) then begin
1731 result := CachedHelp.Strings[Idx];
1732 end;
1733 end;
1734 end;
1735
1736 function TMainForm.GetGridHint(Grid : TStringGrid; FileNum : string; ACol, ARow : integer) : string;
1737 var fieldNum : string;
1738 begin
1739 Result := '';
1740 //Result := 'Row=' + IntToStr(ARow) + ', Col='+ IntToStr(ACol);
1741 if ARow > Grid.RowCount-1 then exit;
1742 if (ARow < 0) or (ACol < 0) then exit;
1743 if ACol=0 then begin
1744 Result := 'This is the database field NUMBER';
1745 end else if ACol=1 then begin
1746 Result := 'This is the database field NAME';
1747 end else begin
1748 fieldNum := Grid.Cells[0,ARow];
1749 if Grid.Cells[ACol,ARow]=CLICK_FOR_SUBS then begin
1750 result := 'Clicking will open new window...';
1751 end else if Grid.Cells[ACol,ARow]=COMPUTED_FIELD then begin
1752 result := 'This field can''t be edited';
1753 end else if Grid.Cells[ACol,ARow]=HIDDEN_FIELD then begin
1754 result := 'Original value hidden. Click to edit new value.';
1755 end else if Grid.Cells[ACol,ARow]=CLICK_TO_EDIT then begin
1756 result := 'Clicking will open new window...';
1757 end else begin
1758 Result := FieldHelp(FileNum, fieldNum, '?');
1759 end;
1760 end;
1761 end;
1762
1763
1764 procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
1765 begin
1766 end; (*ApplicationIdle*)
1767
1768
1769 procedure TMainForm.ApplicationEventsShowHint(var HintStr: String;
1770 var CanShow: Boolean;
1771 var HintInfo: THintInfo);
1772 var
1773 Pos : TPoint;
1774 Handle : Hwnd;
1775 ItemBuffer : array[0..256] of Char;
1776 ClassName : AnsiString;
1777 ACol,ARow : integer;
1778 VisibleGridInfo : TGridInfo;
1779 begin
1780 CanShow := true;
1781 //Label2.Caption := HintStr;
1782 Pos := Mouse.CursorPos;
1783 Handle := WindowFromPoint(Pos);
1784 if Handle = 0 then Exit;
1785 GetClassName(Handle, ItemBuffer, SizeOf(ItemBuffer));
1786 ClassName := ItemBuffer;
1787 Windows.ScreenToClient(Handle, Pos);
1788 VisibleGridInfo := GetVisibleGridInfo;
1789 if VisibleGridInfo = nil then exit;
1790 if VisibleGridInfo.Grid = nil then exit;
1791 if (ClassName='TStringGrid') then begin
1792 VisibleGridInfo.Grid.MouseToCell(Pos.X,Pos.Y,ACol,ARow);
1793 HintInfo.HintStr := GetGridHint(VisibleGridInfo.Grid,VisibleGridInfo.FileNum,ACol, ARow);
1794 if HintInfo.HintStr = '' then CanShow := False;
1795 HintInfo.HideTimeout := 1000;
1796 HintInfo.ReshowTimeout := 2000;
1797 HintInfo.HintMaxWidth:= 300; //hint box width.
1798 end;
1799
1800 end;
1801
1802 procedure TMainForm.PageControlChanging(Sender: TObject; var AllowChange: Boolean);
1803 begin
1804 AllowChange := (PostVisibleGrid <> mrNO);
1805 if AllowChange then begin
1806 LastSelTreeNode := nil;
1807 end;
1808 end;
1809
1810 procedure TMainForm.PatientORComboBoxNeedData(Sender: TObject;
1811 const StartFrom: String; Direction, InsertAt: Integer);
1812 var
1813 Result : TStrings;
1814 begin
1815 Result := FieldLookUpForm.SubSetOfFile('2', StartFrom, Direction);
1816 TORComboBox(Sender).ForDataUse(Result);
1817 end;
1818
1819
1820 procedure TMainForm.PageControlChange(Sender: TObject);
1821 begin
1822 if (PageControl.ActivePage = tsUsers) then begin
1823 UserPageControlChange(nil);
1824 end else if (PageControl.ActivePage = tsSettings) then begin
1825 SettingsPageControlChange(nil);
1826 end else if (PageControl.ActivePage = tsPatients) then begin
1827 PatientsPageControlChange(nil);
1828 end else if (PageControl.ActivePage = tsAdvanced) then begin
1829 SetVisibleGridIdx(AnyFileGrid);
1830 end;
1831
1832 end;
1833
1834 procedure TMainForm.PatientORComboBoxClick(Sender: TObject);
1835 var IEN : longInt;
1836 ModalResult : TModalResult;
1837 GridInfo : TGridInfo;
1838 begin
1839 ModalResult := PostVisibleGrid;
1840 if ModalResult = mrNo then exit;
1841 IEN := PatientORComboBox.ItemIEN; //get info from selected patient
1842 if IEN = 0 then exit;
1843 GridInfo := GetInfoForGrid(BasicPatientGrid);
1844 if GridInfo = nil then exit;
1845 GridInfo.IENS := IntToStr(IEN)+',';
1846 GetPatientInfo(GridInfo);
1847 end;
1848
1849 procedure TMainForm.PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1850 begin
1851 AllowChange := (PostVisibleGrid <> mrNO);
1852 end;
1853
1854 procedure TMainForm.PatientsPageControlChange(Sender: TObject);
1855 begin
1856 if PatientsPageControl.ActivePage = tsBasicPatients then begin
1857 SetVisibleGridIdx(BasicPatientGrid);
1858 end else begin
1859 SetVisibleGridIdx(AdvancedPatientGrid);
1860 end;
1861 end;
1862
1863
1864 procedure TMainForm.UserPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1865 var result : TModalResult;
1866 begin
1867 result := PostVisibleGrid;
1868 AllowChange := (result <> mrNO);
1869 if (result <> mrNone) then begin
1870 InitializeUsersTreeView;
1871 end;
1872 end;
1873
1874 procedure TMainForm.UserPageControlChange(Sender: TObject);
1875 begin
1876 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1877 SetVisibleGridIdx(BasicUsersGrid);
1878 end else begin
1879 SetVisibleGridIdx(AdvancedUsersGrid);
1880 end;
1881 end;
1882
1883
1884 procedure TMainForm.SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1885 begin
1886 AllowChange := (PostVisibleGrid <> mrNO);
1887 end;
1888
1889 procedure TMainForm.SettingsPageControlChange(Sender: TObject);
1890 begin
1891 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1892 SetVisibleGridIdx(BasicSettingsGrid);
1893 end else begin
1894 SetVisibleGridIdx(AdvancedSettingsGrid);
1895 end;
1896 end;
1897
1898 procedure TMainForm.FileORComboBoxClick(Sender: TObject);
1899 begin
1900 PostVisibleGrid;
1901 InitORCombobox(RecordORComboBox,'');
1902 ClearGrid(GetVisibleGrid);
1903 end;
1904
1905 procedure TMainForm.FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1906 var Result : TStrings;
1907 begin
1908 Result := FieldLookUpForm.SubSetOfFile('1', StartFrom, Direction);
1909 TORComboBox(Sender).ForDataUse(Result);
1910 end;
1911
1912
1913 procedure TMainForm.RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1914 var Result : TStrings;
1915 FileNum : string;
1916 begin
1917 FileNum := FileORComboBox.ItemID;
1918 Result := FieldLookUpForm.SubSetOfFile(FileNum, StartFrom, Direction);
1919 TORComboBox(Sender).ForDataUse(Result);
1920 end;
1921
1922 procedure TMainForm.RecordORComboBoxClick(Sender: TObject);
1923 var ModalResult : TModalResult;
1924 IEN : LongInt;
1925 FileNum : String;
1926 GridInfo : TGridInfo;
1927 begin
1928 ModalResult := PostVisibleGrid;
1929 if ModalResult = mrNo then exit;
1930 FileNum := FileORComboBox.ItemID;
1931 IEN := RecordORComboBox.ItemID; //get info from selected record
1932 if IEN=0 then exit;
1933 GridInfo := GetInfoForGrid(AnyFileGrid);
1934 if GridInfo = nil then exit;
1935 GridInfo.IENS := IntToStr(IEN) + ',';
1936 GridInfo.FileNum := FileNum;
1937 GetAnyfileInfo(GridInfo);
1938 //GetAnyfileInfo(FileNum,IntToStr(IEN)+',',CurrentAnyFileData);
1939 end;
1940
1941 procedure TMainForm.btnAddAnyRecordClick(Sender: TObject);
1942 var IENS, FileNum : string;
1943 BlankFileInfo : TStringList;
1944 begin
1945 BlankFileInfo := Tstringlist.Create;
1946 btnAdvancedRevert.Enabled := True;
1947 btnAdvancedApply.Enabled := True;
1948 FileNum := FileORComboBox.ItemID;
1949 IENS := '+1,';
1950 GetOneRecord(FileNum,IENS,CurrentAnyFileData, BlankFileInfo);
1951
1952 LoadAnyGridFromInfo(GetInfoForGrid(AnyFileGrid));
1953 BlankFileInfo.Free;
1954 end;
1955
1956 procedure TMainForm.AddBtnClick(Sender: TObject);
1957 var IENS : string;
1958 BlankFileInfo : TStringList;
1959 GridInfo : TGridInfo;
1960 begin
1961 BlankFileInfo := Tstringlist.Create;
1962 btnPatientRevert.Enabled := True;
1963 btnPatientApply.Enabled := True;
1964 GridInfo := GetVisibleGridInfo;
1965 IENS := '+1,';
1966 GetOneRecord(GridInfo.FileNum, IENS, GridInfo.Data, BlankFileInfo);
1967 GridInfo.IENS := IENS;
1968 LoadAnyGridFromInfo(GridInfo); //load Basic or Advanced Grid
1969 if GridInfo.Grid = BasicPatientGrid then begin
1970 GridInfo := GetInfoForGrid(AdvancedPatientGrid)
1971 end else begin //Advanced grid is visible.
1972 GridInfo := GetInfoForGrid(BasicPatientGrid)
1973 end;
1974 GridInfo.IENS := IENS;
1975 LoadAnyGridFromInfo(GridInfo); // Load OTHER grid, Advanced or Basic grid.
1976 BlankFileInfo.Free;
1977 end;
1978
1979 procedure TMainForm.btnAdvancedApplyClick(Sender: TObject);
1980 begin
1981 PostVisibleGrid;
1982 end;
1983
1984 procedure TMainForm.btnAdvancedRevertClick(Sender: TObject);
1985 //var tempInfo: TGridInfo;
1986 begin
1987 DoRevert(nil,AnyFileGrid);
1988 {
1989 tempInfo := GetInfoForGrid(AnyFileGrid);
1990 LoadAnyGridFromInfo(tempInfo);
1991 tempInfo.ApplyBtn.Enabled := false;
1992 tempInfo.RevertBtn.Enabled := false;
1993 }
1994 end;
1995
1996 procedure TMainForm.AnyFileGridClick(Sender: TObject);
1997 begin
1998 btnAdvancedApply.Enabled := True;
1999 btnAdvancedRevert.Enabled := True;
2000 end;
2001
2002 procedure TMainForm.btnBatchAddClick(Sender: TObject);
2003 begin
2004 BatchAddForm.ShowModal;
2005 InitORCombobox(PatientORComboBox,'A');
2006 end;
2007
2008 procedure TMainForm.ShowDebugClick(Sender: TObject);
2009 begin
2010 DebugForm.Show;
2011 end;
2012
2013 procedure TMainForm.ChangeSkinClick(Sender: TObject);
2014 var result : TModalResult;
2015 begin
2016 try
2017 result := SkinForm.ShowModal;
2018 case result of
2019 mrOK : SkinForm.ActivateCurrentSkin;
2020 mrNo : SkinForm.InactivateSkin;
2021 end; {case}
2022 except
2023 on EInvalidOperation do MessageDlg('Error1',mtInformation,[mbOK],0);
2024 else MessageDlg('Error Applying Skin. Please try another Skin.',mtInformation,[mbOK],0);
2025 end;
2026 end;
2027
2028 procedure TMainForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string);
2029 begin
2030 ORComboBox.Items.Clear;
2031 ORComboBox.Text := initValue;
2032 ORComboBox.InitLongList(initValue);
2033 if ORComboBox.Items.Count > 0 then begin
2034 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
2035 end else begin
2036 ORComboBox.Text := '<Start Typing to Search>';
2037 end;
2038 end;
2039
2040
2041 procedure TMainForm.btnPatientApplyClick(Sender: TObject); //Added elh 8/15/08
2042 begin
2043 PostVisibleGrid;
2044 InitORCombobox(PatientORComboBox,'A');
2045 end;
2046
2047 procedure TMainForm.btnPatientRevertClick(Sender: TObject); //Added elh 8/15/08
2048 //var tempInfo : TGridInfo;
2049 begin
2050 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
2051 {
2052 tempInfo := GetInfoForGrid(AdvancedUsersGrid);
2053 LoadAnyGridFromInfo(tempInfo);
2054
2055 tempInfo := GetInfoForGrid(BasicUsersGrid);
2056 LoadAnyGridFromInfo(tempInfo);
2057
2058 tempInfo.ApplyBtn.Enabled := false;
2059 tempInfo.RevertBtn.Enabled := false;
2060 }
2061 end;
2062
2063 procedure TMainForm.BasicPatientGridClick(Sender: TObject); //Added elh 8/15/08
2064 begin
2065 btnPatientRevert.Enabled := true;
2066 btnPatientApply.Enabled := true;
2067 end;
2068
2069 Procedure TMainForm.GetBlankFileInfo(FileNum : string; BlankList : TStringList);
2070 var RPCResult: string;
2071 //Returned format for BlankList is:
2072 //FileNum^^FieldNum^^FieldName^More DDInfo
2073 //FileNum^^FieldNum^^FieldName^More DDInfo
2074 begin
2075 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2076 RPCBrokerV.Param[0].Value := '.X'; // not used
2077 RPCBrokerV.param[0].ptype := list;
2078 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET EMPTY ENTRY^' + FileNum;
2079 RPCBrokerV.Call;
2080 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2081 //Return Format is: FileNum^^FieldNum^^DDInfo...
2082 if piece(RPCResult,'^',1)='-1' then begin
2083 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2084 FMErrorForm.PrepMessage;
2085 FMErrorForm.ShowModal;
2086 end else begin
2087 BlankList.Assign(RPCBrokerV.Results);
2088 end;
2089 end;
2090
2091
2092 procedure TMainForm.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
2093 var cmd,RPCResult : string;
2094 i : integer;
2095 oneEntry : string;
2096 begin
2097 Data.Clear;
2098 if (IENS='') then exit;
2099 if Pos('+',IENS)=0 then begin //don't ask server to load +1 records.
2100 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2101 RPCBrokerV.Param[0].Value := '.X'; // not used
2102 RPCBrokerV.param[0].ptype := list;
2103 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
2104 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
2105 RPCBrokerV.Call;
2106 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2107 if piece(RPCResult,'^',1)='-1' then begin
2108 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2109 FMErrorForm.PrepMessage;
2110 FMErrorForm.ShowModal;
2111 end else begin
2112 Data.Assign(RPCBrokerV.Results);
2113 end;
2114 end else begin
2115 Data.Add('1^Success'); //to keep same as call to server
2116 if BlankFileInfo.Count = 0 then begin
2117 //Format is: FileNum^^FieldNum^^DDInfo...
2118 GetBlankFileInfo(FileNum,BlankFileInfo);
2119 end;
2120 for i := 1 to BlankFileInfo.Count-1 do begin //0 is 1^success
2121 oneEntry := BlankFileInfo.Strings[i];
2122 SetPiece(oneEntry,'^',2,IENS);
2123 Data.Add(oneEntry);
2124 end;
2125 end;
2126 end;
2127
2128
2129 procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
2130 begin
2131 if E.Message <> 'Cannot focus a disabled or invisible window' then begin
2132 ShowException(E,nil);
2133 end;
2134 end;
2135
2136
2137 procedure TMainForm.btnSettingsRevertClick(Sender: TObject);
2138 //var tempInfo : TGridInfo;
2139 begin
2140 DoRevert(BasicSettingsGrid,AdvancedSettingsGrid);
2141 {
2142 tempInfo := GetInfoForGrid(BasicSettingsGrid);
2143 LoadAnyGridFromInfo(tempInfo);
2144
2145 tempInfo := GetInfoForGrid(AdvancedSettingsGrid);
2146 LoadAnyGridFromInfo(tempInfo);
2147
2148 tempInfo.ApplyBtn.Enabled := false;
2149 tempInfo.RevertBtn.Enabled := false;
2150 }
2151 end;
2152
2153
2154 procedure TMainForm.DoRevert(BasicGrid,AdvancedGrid : TStringGrid);
2155 //BasicGrid doesn't have to be supplied. Can be nil value.
2156 //AdvancedGrid is required.
2157 var tempInfo : TGridInfo;
2158 begin
2159 tempInfo := GetInfoForGrid(AdvancedGrid);
2160 LoadAnyGridFromInfo(tempInfo);
2161 tempInfo.ApplyBtn.Enabled := false;
2162 tempInfo.RevertBtn.Enabled := false;
2163
2164 if BasicGrid <> nil then begin
2165 tempInfo := GetInfoForGrid(BasicGrid);
2166 LoadAnyGridFromInfo(tempInfo);
2167 end;
2168 end;
2169
2170
2171 procedure TMainForm.btnSettingsApplyClick(Sender: TObject);
2172 begin
2173 PostVisibleGrid;
2174 end;
2175
2176end.
2177
Note: See TracBrowser for help on using the repository browser.