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

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

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