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

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

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