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

Last change on this file since 542 was 542, checked in by Kevin Toppenberg, 15 years ago

v1.1 Fixes Access/Verify code issues
File size: 81.7 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;
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 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: TStringGrid;
217 function GetVisibleGridInfo : TGridInfo;
218 function GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
219 function GetInfoIndexForGrid(Grid : TStringGrid) : integer;
220 procedure SetVisibleGridIdx(Grid : TStringGrid);
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 : TStringGrid; CurrentUserData,Changes : TStringList);
239 function PostChanges(Grid : TStringGrid) : TModalResult;
240 function PostVisibleGrid: TModalResult;
241 procedure LoadAnyGrid(Grid : TStringGrid; 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 : TStringGrid; FileNum : string; ACol, ARow : integer) : string;
247 function FieldHelp(FileNum, FieldNum, HelpStyle : string) : string;
248 procedure DoRevert(BasicGrid,AdvancedGrid : TStringGrid);
249 public
250 { Public declarations }
251 CurrentUserName: string;
252 LastSelTreeNode : TTreeNode;
253 DebugMode : boolean;
254 function GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow:integer) :integer;
255 function GetLineInfo(Grid : TStringGrid; 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: TStringGrid; Data : TStringList; BasicMode : boolean;
264 DataLoader : TGridDataLoader; FileNum : string;
265 ApplyBtn,RevertBtn : TButton);
266 procedure LoadAnyGridFromInfo(GridInfo : TGridInfo);
267 procedure ClearGrid(Grid : TStringGrid);
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: TStringGrid;
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 : TStringGrid);
1039 begin
1040 Grid.Cells[0,1] := '';
1041 Grid.Cells[1,1] := '';
1042 Grid.Cells[2,1] := '';
1043 Grid.RowCount :=2;
1044 end;
1045
1046
1047 procedure TMainForm.LoadAnyGrid(Grid : TStringGrid; //the TStringGrid to load
1048 BasicMode: boolean;
1049 FileNum : string;
1050 IENS : string;
1051 CurrentData : TStringList);
1052 var
1053 GridInfo : TGridInfo;
1054 begin
1055 //This stores load information into GridInfo.
1056 GridInfo := GetInfoForGrid(Grid);
1057 if GridInfo = nil then exit;
1058 GridInfo.Grid := Grid;
1059 GridInfo.BasicMode := BasicMode;
1060 GridInfo.FileNum := FileNum;
1061 GridInfo.IENS := IENS;
1062 GridInfo.Data := CurrentData;
1063 LoadAnyGridFromInfo(GridInfo);
1064 end;
1065
1066
1067 procedure TMainForm.LoadAnyGridFromInfo(GridInfo : TGridInfo);
1068 //Format of CurrentData:
1069 //Data[0]=1^Success
1070 //Data[1]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1071 //Data[2]='FileNum^IENS^FieldNum^ExtValue^FieldName^DDInfo...
1072 //...
1073
1074 //This assumes that GridInfo already has loaded info.
1075 var
1076 Grid : TStringGrid; //the TStringGrid to load
1077 BasicMode: boolean;
1078 FileNum : string;
1079 IENS : string;
1080 CurrentData : TStringList;
1081
1082 procedure LoadOneLine (Grid : TStringGrid; oneEntry : string; GridRow : integer);
1083 var
1084 tempFile,IENS : string;
1085 fieldNum,fieldName,fieldDef : string;
1086 subFileNum : string;
1087 value : string;
1088 begin
1089 tempFile := Piece(oneEntry,'^',1);
1090 if tempFile = FileNum then begin //handle subfiles later...
1091 IENS := Piece(oneEntry,'^',2);
1092 fieldNum := Piece(oneEntry,'^',3);
1093 value := Piece(oneEntry,'^',4);
1094 fieldName := Piece(oneEntry,'^',5);
1095 fieldDef := Piece(oneEntry,'^',6);
1096 Grid.RowCount := GridRow + 1;
1097 Grid.Cells[0,GridRow] := fieldNum;
1098 Grid.Cells[1,GridRow] := fieldName;
1099 if Pos('W',fieldDef)>0 then begin
1100 Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
1101 end else if IsSubFile(fieldDef, subFileNum) then begin
1102 if IsWPField(FileNum,fieldNum) then begin
1103 Grid.Cells[2,GridRow] := CLICK_TO_EDIT;
1104 end else begin
1105 Grid.Cells[2,GridRow] := CLICK_FOR_SUBS;
1106 end;
1107 end else if Pos('C',fieldDef)>0 then begin
1108 Grid.Cells[2,GridRow] := COMPUTED_FIELD;
1109 end else begin
1110 Grid.Cells[2,GridRow] := value;
1111 end;
1112 Grid.RowHeights[GridRow] := DEF_GRID_ROW_HEIGHT;
1113 end;
1114 end;
1115
1116 function getOneLine(CurrentData : TStringList; oneFileNum,oneFieldNum : string) : string;
1117 var i : integer;
1118 FileNum,FieldNum : string;
1119 begin
1120 result := '';
1121 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1122 for i := 1 to CurrentData.Count - 1 do begin
1123 FileNum := piece(CurrentData.Strings[i],'^',1);
1124 if FileNum <> oneFileNum then continue;
1125 FieldNum := piece(CurrentData.Strings[i],'^',3);
1126 if FieldNum <> oneFieldNum then continue;
1127 result := CurrentData.Strings[i];
1128 break;
1129 end;
1130 end;
1131
1132 var i : integer;
1133 oneEntry : string;
1134 oneFileNum,oneFieldNum : string;
1135 gridRow : integer;
1136 //GridInfo : TGridInfo;
1137
1138 begin
1139 FLoadingGrid := true;
1140
1141 if GridInfo=nil then exit;
1142
1143 Grid := GridInfo.Grid;
1144 BasicMode := GridInfo.BasicMode;
1145 FileNum := GridInfo.FileNum;
1146 IENS := GridInfo.IENS;
1147 CurrentData := GridInfo.Data;
1148
1149 ClearGrid(Grid);
1150 Grid.ColWidths[0] := 50;
1151 Grid.ColWidths[1] := 200;
1152 Grid.ColWidths[2] := 300;
1153 Grid.Cells[0,0] := '#';
1154 Grid.Cells[1,0] := 'Name';
1155 Grid.Cells[2,0] := 'Value';
1156
1157 if BasicMode=false then begin
1158 for i := 1 to CurrentData.Count-1 do begin //start at 1 because [0] = 1^Success
1159 oneEntry := CurrentData.Strings[i];
1160 LoadOneLine (Grid,oneEntry,i);
1161 end;
1162 end else if BasicMode=true then begin
1163 gridRow := 1;
1164 for i := 0 to BasicTemplate.Count-1 do begin
1165 oneFileNum := Piece(BasicTemplate.Strings[i],'^',1);
1166 if oneFileNum <> fileNum then continue;
1167 oneFieldNum := Piece(BasicTemplate.Strings[i],'^',2);
1168 oneEntry := getOneLine(CurrentData,oneFileNum,oneFieldNum);
1169 LoadOneLine (Grid,oneEntry,gridRow);
1170 Inc(GridRow);
1171 end;
1172 end;
1173 FLoadingGrid := false;
1174 end;
1175
1176
1177 procedure TMainForm.GridSelectCell(Sender: TObject; ACol, ARow: Integer;
1178 var CanSelect: Boolean);
1179 (*
1180 For Field def, here is the legend
1181 character meaning
1182
1183 BC The data is Boolean Computed (true or false).
1184 C The data is Computed.
1185 Cm The data is multiline Computed.
1186 DC The data is Date-valued, Computed.
1187 D The data is Date-valued.
1188 F The data is Free text.
1189 I The data is uneditable.
1190 Pn The data is a Pointer reference to file "n".
1191 S The data is from a discrete Set of codes.
1192
1193 N The data is Numeric-valued.
1194
1195 Jn To specify a print length of n characters.
1196 Jn,d To specify printing n characters with decimals.
1197
1198 V The data is a Variable pointer.
1199 W The data is Word processing.
1200 WL The Word processing data is normally printed in Line mode (i.e., without word wrap).
1201 *)
1202 var oneEntry,FieldDef : string;
1203 date,time: string;
1204 FileNum,FieldNum,SubFileNum : string;
1205 GridFileNum : string;
1206 UserLine : integer;
1207 Grid : TStringGrid;
1208 IEN : int64;
1209 IENS : string;
1210 CurrentData : TStringList;
1211 GridInfo : TGridInfo;
1212 SubFileForm : TSubFileForm;
1213 begin
1214 if FLoadingGrid then exit; //prevent pseudo-clicks during loading...
1215 Grid := (Sender as TStringGrid);
1216 GridInfo := GetInfoForGrid(Grid);
1217 if GridInfo=nil then exit;
1218 GridFileNum := GridInfo.FileNum;
1219 CanSelect := false; //default to NOT selectable.
1220 CurrentData := GridInfo.Data;
1221 if CurrentData=nil then exit;
1222 if CurrentData.Count = 0 then exit;
1223 UserLine := GetUserLine(CurrentData,Grid,ARow);
1224 if UserLine = -1 then exit;
1225 oneEntry := CurrentData.Strings[UserLine];
1226 FieldDef := Piece(oneEntry,'^',6);
1227 if Pos('F',FieldDef)>0 then begin //Free text
1228 CanSelect := true;
1229 end else if IsSubFile(FieldDef,SubFileNum) then begin //Subfiles.
1230 FileNum := Piece(oneEntry,'^',1);
1231 FieldNum := Piece(oneEntry,'^',3);
1232 if IsWPField(FileNum,FieldNum) then begin
1233 IENS := Piece(oneEntry,'^',2);
1234 EditTextForm.PrepForm(FileNum,FieldNum,IENS);
1235 EditTextForm.ShowModal;
1236 end else begin
1237 //handle subfiles here
1238 IENS := '';
1239 if GridInfo.Message = MSG_SUB_FILE then begin //used message from subfile Grid
1240 IENS := GridInfo.IENS;
1241 end else if LastSelTreeNode <> nil then begin //this is one of the selction trees.
1242 IEN := longInt(LastSelTreeNode.Data);
1243 if IEN > 0 then IENS := InttoStr(IEN) + ',';
1244 end else if GridInfo.Data = CurrentAnyFileData then begin
1245 IEN := RecordORComboBox.ItemID; //get info from selected record
1246 if IEN > 0 then IENS := InttoStr(IEN) + ',';
1247 end;
1248 if IENS <> '' then begin
1249 SubFileForm := TSubFileForm.Create(self);
1250 SubFileForm.PrepForm(SubFileNum,IENS);
1251 SubfileForm.ShowModal; // note: may call this function again recursively for sub-sub-files etc.
1252 SubFileForm.Free;
1253 end else begin
1254 MessageDlg('IENS for File="". Can''t process.',mtInformation,[MBOK],0);
1255 end;
1256 end;
1257 end else if Pos('C',FieldDef)>0 then begin //computed fields.
1258 CanSelect := false;
1259 end else if Pos('D',FieldDef)>0 then begin //date field
1260 date := piece(Grid.Cells[ACol,ARow],'@',1);
1261 time := piece(Grid.Cells[ACol,ARow],'@',2);
1262 if date <> '' then begin
1263 SelDateTimeForm.DateTimePicker.Date := StrToDate(date);
1264 end else begin
1265 SelDateTimeForm.DateTimePicker.Date := SysUtils.Date;
1266 end;
1267 if SelDateTimeForm.ShowModal = mrOK then begin
1268 date := DateToStr(SelDateTimeForm.DateTimePicker.Date);
1269 time := TimeToStr(SelDateTimeForm.DateTimePicker.Time);
1270 if time <> '' then date := date; // + '@' + time; elh 8/15/08
1271 Grid.Cells[ACol,ARow] := date;
1272 end;
1273 CanSelect := true;
1274 end else if Pos('S',FieldDef)>0 then begin //Set of Codes
1275 SetSelForm.PrepForm(Piece(oneEntry,'^',7));
1276 if SetSelForm.ShowModal = mrOK then begin
1277 Grid.Cells[ACol,ARow] := SetSelForm.ComboBox.Text;
1278 CanSelect := true;
1279 end;
1280 end else if Pos('I',FieldDef)>0 then begin //uneditable
1281 MessageDlg('Sorry. Flagged as UNEDITABLE.',mtInformation ,[mbOK],0);
1282 end else if Pos('P',FieldDef)>0 then begin //Pointer to file.
1283 FileNum := ExtractNum (FieldDef,Pos('P',FieldDef)+1);
1284 //check for validity here...
1285 FieldLookupForm.PrepForm(FileNum,Grid.Cells[ACol,ARow]);
1286 if FieldLookupForm.ShowModal = mrOK then begin
1287 Grid.Cells[ACol,ARow] := FieldLookupForm.ORComboBox.Text;
1288 CanSelect := true;
1289 end;
1290 end;
1291 if CanSelect then begin
1292 FLastSelectedRow := ARow;
1293 FLastSelectedCol := ACol;
1294 end;
1295 GridInfo.ApplyBtn.Enabled := true;
1296 GridInfo.RevertBtn.Enabled := true;
1297 end;
1298
1299
1300 function TMainForm.GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
1301 var fieldNum : string;
1302 oneEntry : string;
1303 fileNum : string;
1304 gridRow : integer;
1305 begin
1306 fieldNum := Grid.Cells[0,ARow];
1307 gridRow := FindInStrings(fieldNum, CurrentUserData, fileNum);
1308 if gridRow > -1 then begin
1309 oneEntry := CurrentUserData.Strings[gridRow];
1310 Result.Field := fieldNum;
1311 Result.FieldName := Grid.Cells[1,ARow];
1312 Result.FileNum := fileNum;
1313 Result.IENS := Piece(oneEntry,'^',2);
1314 Result.oldValue := Piece(oneEntry,'^',4);
1315 Result.newValue := Grid.Cells[2,ARow];
1316 end else begin
1317 Result.Field := '';
1318 Result.FieldName := '';
1319 Result.FileNum := '';
1320 Result.IENS := '';
1321 Result.oldValue := '';
1322 Result.newValue := '';
1323 end;
1324 end;
1325
1326 function TMainForm.GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow: integer) : integer;
1327 var fieldNum: string;
1328 tempFileNum : string;
1329 begin
1330 fieldNum := Grid.Cells[0,ARow];
1331 Result := FindInStrings(fieldNum,CurrentUserData,tempFileNum);
1332 end;
1333
1334 function TMainForm.FindInStrings(fieldNum : string; Strings : TStringList; var fileNum : string) : integer;
1335 //Note: if fileNum is passed blank, then first matching file will be placed in it (i.e. OUT parameter)
1336 var tempFieldNum : string;
1337 oneEntry,tempFile : string;
1338 i : integer;
1339 begin
1340 result := -1;
1341 fileNum := '';
1342 for i := 1 to Strings.Count-1 do begin //0 --> 1^success
1343 oneEntry := Strings.Strings[i];
1344 tempFile := Piece(oneEntry,'^',1);
1345 if fileNum='' then fileNum := tempFile;
1346 if tempFile <> fileNum then continue; //ignore subfiles
1347 tempFieldNum := Piece(oneEntry,'^',3);
1348 if tempFieldNum <> fieldNum then continue;
1349 Result := i;
1350 break;
1351 end;
1352 end;
1353
1354
1355 function TMainForm.IsSubFile(FieldDef: string ; var SubFileNum : string) : boolean;
1356 //SubFileNum is OUT parameter
1357 begin
1358 SubFileNum := ExtractNum(FieldDef,1);
1359 result := (SubFileNum <> '');
1360 end;
1361
1362 function TMainForm.IsWPField(FileNum,FieldNum : string) : boolean;
1363 var RPCResult : string;
1364 SrchStr : string;
1365 Idx: integer;
1366 begin
1367 SrchStr := FileNum + '^' + FieldNum + '^';
1368 Idx := CachedWPField.IndexOf(SrchStr + 'YES');
1369 if Idx > -1 then begin Result := true; exit; end;
1370 Idx := CachedWPField.IndexOf(SrchStr + 'NO');
1371 if Idx > -1 then begin Result := false; exit; end;
1372
1373 result := false;
1374 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1375 RPCBrokerV.param[0].ptype := list;
1376 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum;
1377 RPCBrokerV.Call;
1378 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1379 if piece(RPCResult,'^',1)='-1' then begin
1380 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1381 FMErrorForm.PrepMessage;
1382 FMErrorForm.ShowModal;
1383 end else begin
1384 RPCResult := piece(RPCResult,'^',3);
1385 result := (RPCResult = 'YES');
1386 CachedWPField.Add(SrchStr + RPCResult);
1387 end;
1388 end;
1389
1390
1391 function TMainForm.ExtractNum (S : String; StartPos : integer) : string;
1392 var i : integer;
1393 ch : char;
1394 begin
1395 result := '';
1396 if (S = '') or (StartPos < 0) then exit;
1397 i := StartPos;
1398 repeat
1399 ch := S[i];
1400 i := i + 1;
1401 if ch in ['0'..'9','.'] then begin
1402 Result := Result + ch;
1403 end;
1404 until (i > length(S)) or not (ch in ['0'..'9','.'])
1405 end;
1406
1407 procedure TMainForm.Button1Click(Sender: TObject);
1408 begin
1409 FieldLookupForm.Show;
1410 end;
1411
1412 procedure TMainForm.btnUsersRevertClick(Sender: TObject);
1413 begin
1414 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
1415 {
1416 LoadAnyGridFromInfo(GetInfoForGrid(AdvancedUsersGrid));
1417 LoadAnyGridFromInfo(GetInfoForGrid(BasicUsersGrid));
1418 btnUsersRevert.Enabled := false;
1419 btnUsersApply.Enabled := false;
1420 }
1421 end;
1422
1423 function TMainForm.GetVisibleGridInfo : TGridInfo;
1424 begin
1425 result := GetInfoForGrid(GetVisibleGrid);
1426 end;
1427
1428 function TMainForm.GetVisibleGrid: TStringGrid;
1429 begin
1430 if FVisibleGridIdx > -1 then begin
1431 result := TGridInfo(DataForGrid.Objects[FVisibleGridIdx]).Grid;
1432 end else begin
1433 result := nil;
1434 end;
1435 end;
1436
1437 function TMainForm.GetInfoForGrid(Grid : TStringGrid) : TGridInfo;
1438 var i : integer;
1439 begin
1440 i := GetInfoIndexForGrid(Grid);
1441 if i > -1 then begin
1442 result := TGridInfo(DataForGrid.Objects[i]);
1443 end else begin
1444 result := nil;
1445 end;
1446 end;
1447
1448
1449 function TMainForm.GetInfoIndexForGrid(Grid : TStringGrid) : integer;
1450 var s : string;
1451 begin
1452 s := IntToStr(integer(Grid));
1453 result := DataForGrid.IndexOf(s);
1454 end;
1455
1456 procedure TMainForm.SetVisibleGridIdx(Grid : TStringGrid);
1457 begin
1458 FVisibleGridIdx := GetInfoIndexForGrid(Grid);
1459 end;
1460
1461
1462 procedure TMainForm.CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
1463 //Output format:
1464 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1465
1466 var row : integer;
1467 Entry : tFileEntry;
1468 oneEntry : string;
1469 iniFile : TIniFile; // 8-12-09 elh
1470 UCaseOnly : boolean;
1471 begin
1472 FINIFileName := ExtractFilePath(ParamStr(0)) + 'GUI_Config.ini';
1473 iniFile := TIniFile.Create(FINIFileName); //8-12-09 elh
1474 UCaseOnly := inifile.ReadBool('Settings','UCaseOnly',true);
1475 iniFile.Free;
1476 for row := 1 to Grid.RowCount-1 do begin
1477 Entry := GetLineInfo(Grid,CurrentUserData, row);
1478 //Reject any value containing a "^"
1479 //Do we need an @ here as well?
1480 if (AnsiPos('^',Entry.newvalue) > 0){ or (AnsiPos('@',Entry.newvalue) > 0)} then begin
1481 messagedlg('Invalid value entered for ' + Entry.Fieldname + #13 + #10
1482 + #13 + #10 + 'Invalid Entry: ' + Entry.newvalue + #13 + #10 +
1483 'Ignoring Value.',mtError,[mbOK],0);
1484 end else begin
1485 if Entry.oldValue <> Entry.newValue then begin
1486 if (Entry.newValue <> CLICK_FOR_SUBS) and
1487 (Entry.newValue <> COMPUTED_FIELD) and
1488 (Entry.newValue <> CLICK_TO_EDIT) then begin
1489 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
1490 //Test to see if change is an AV Code (2 or 11) or ES Code (20.4) in User File (200)
1491 //If so, make it uppercase. 8/12/09 elh
1492 if Entry.FileNum = '200' then begin
1493 if ((Entry.Field = '2') and (UCaseOnly = true)) or
1494 ((Entry.Field = '11') and (UCaseOnly = true)) or
1495 ((Entry.Field = '20.4') and (UCaseOnly = true)) then begin
1496 messagedlg('Converting ' + Entry.Fieldname + ' to uppercase for VistA interactivity.' +#13 +#10 +
1497 #13 +#10 +
1498 'Old Value: ' + Entry.newvalue + ' ' + 'New Value: ' + Uppercase(Entry.newvalue),
1499 mtinformation,[mbOK],0);
1500 Entry.newValue := Uppercase(Entry.newValue);
1501 end;
1502 end;
1503 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
1504 Changes.Add(oneEntry);
1505 end;
1506 end;
1507 end;
1508 end;
1509 end;
1510
1511
1512 function TMainForm.PostChanges(Grid : TStringGrid) : TModalResult;
1513 //Results: mrNone -- no post done (not needed)
1514 // mrCancel -- user pressed cancel on confirmation screen.
1515 // mrNo -- signals posting error.
1516 var Changes : TStringList;
1517 PostResult : TModalResult;
1518 CurrentData : TStringList;
1519 GridInfo : TGridInfo;
1520 IENS : string;
1521 begin
1522 Result := mrNone; //default to No changes
1523 GridInfo := GetInfoForGrid(Grid);
1524 if GridInfo=nil then exit;
1525 CurrentData := GridInfo.Data;
1526 if CurrentData=nil then exit;
1527 if CurrentData.Count = 0 then exit;
1528 IENS := GridInfo.IENS;
1529 if IENS='' then exit;
1530 Changes := TStringList.Create;
1531 CompileChanges(Grid,CurrentData,Changes);
1532 if Changes.Count>0 then begin
1533 PostForm.PrepForm(Changes);
1534 PostResult := PostForm.ShowModal;
1535 if PostResult = mrOK then begin
1536 if DisuserChanged(Changes) then begin //looks for change in file 200, field 4
1537 InitializeUsersTreeView;
1538 end else begin
1539 if Pos('+',IENS)>0 then begin
1540 GridInfo.IENS := PostForm.GetNewIENS(IENS);
1541 end;
1542 if assigned(GridInfo.DataLoadProc) then begin
1543 GridInfo.DataLoadProc(GridInfo);
1544 end;
1545 {
1546 if CurrentData = CurrentUserData then begin
1547 LoadUserData(IENS,CurrentData); //reload record from server.
1548 end else if CurrentData = CurrentSettingsData then begin
1549 GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1550 end else if CurrentData = CurrentPatientData then begin
1551 GetPatientInfo(GridInfo.IENS, CurrentData);
1552 end else if CurrentData = CurrentAnyFileData then begin
1553 GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1554 end;
1555 }
1556 end;
1557 end else if PostResult = mrNo then begin //mrNo is signal of post Error
1558 // show error...
1559 end;
1560 Result := PostResult;
1561 end else begin
1562 Result := mrNone;
1563 end;
1564 Changes.Free;
1565 end;
1566
1567 function TMainForm.DisuserChanged(Changes: TStringList) : boolean;
1568 var i : integer;
1569 //Changes format:
1570 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1571 begin
1572 result := false;
1573 for i := 0 to Changes.Count-1 do begin
1574 if piece(Changes.Strings[i],'^',1)<> '200' then continue;
1575 if piece(Changes.Strings[i],'^',4)<> 'DISUSER' then continue;
1576 result := true;
1577 break;
1578 end;
1579 end;
1580
1581
1582 procedure TMainForm.btnUsersApplyClick(Sender: TObject);
1583 var result : TModalResult;
1584 begin
1585 result:= PostVisibleGrid;
1586 if result <> mrNone then InitializeUsersTreeView;
1587 end;
1588
1589 procedure TMainForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1590 begin
1591 btnUsersRevert.Enabled := true;
1592 btnUsersApply.Enabled := true;
1593 end;
1594
1595 procedure TMainForm.BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1596 begin
1597 btnSettingsRevert.Enabled := true;
1598 btnSettingsApply.Enabled := true;
1599 end;
1600
1601
1602 procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
1603 begin
1604 PostVisibleGrid;
1605 RPCBrokerV.Connected := false; //disconnect
1606 end;
1607
1608 procedure TMainForm.ExitMenuItemClick(Sender: TObject);
1609 begin
1610 Close;
1611 end;
1612
1613 procedure TMainForm.UserPageControlDrawTab(Control: TCustomTabControl;
1614 TabIndex: Integer;
1615 const Rect: TRect;
1616 Active: Boolean);
1617 begin
1618 DrawTab(Control,TabIndex,Rect,Active);
1619 end;
1620
1621 procedure TMainForm.DrawTab(Control: TCustomTabControl;
1622 TabIndex: Integer;
1623 const Rect: TRect;
1624 Active: Boolean);
1625 var
1626 oRect : TRect;
1627 sCaption,temp : String;
1628 iTop : Integer;
1629 iLeft : Integer;
1630 i : integer;
1631
1632 begin
1633 oRect := Rect;
1634 temp := TPageControl(Control).Pages[TabIndex].Caption;
1635 for i := 1 to length(temp) do begin
1636 if temp[i] <> '&' then sCaption := sCaption + temp[i];
1637 end;
1638
1639 iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
1640 iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
1641
1642 if Active then begin
1643 Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow
1644 Control.Canvas.FillRect(Rect);
1645// Frame3d(Control.Canvas,oRect,clBtnHighLight,clBtnShadow,3);
1646
1647 end else begin
1648 Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow
1649 Control.Canvas.FillRect(Rect);
1650 end;
1651 Control.Canvas.TextOut(iLeft,iTop,sCaption);
1652 end;
1653
1654
1655 procedure TMainForm.AboutMenuClick(Sender: TObject);
1656 begin
1657 AboutForm.show;
1658 end;
1659
1660 procedure TMainForm.CloneBtnClick(Sender: TObject);
1661 var IEN : longInt;
1662 newName : string;
1663 IENS,newIENS : string;
1664
1665 begin
1666 if btnUsersApply.Enabled then btnUsersApplyClick(self); //post any changes first.
1667 if MessageDlg('Clone user: '+LastSelTreeNode.Text+' --> New user?' + #10 + #13 +
1668 'Note: This can not be undone.',
1669 mtConfirmation, mbOKCancel,0) = mrCancel then exit;
1670 IEN := longInt(LastSelTreeNode.Data);
1671 IENS := IntToStr(IEN) + ',';
1672 WaitForm.Show;
1673 newName := 'TEMP,MUST-EDIT';
1674 newIENS := DoCloneUser(IENS,newName);
1675 InitializeUsersTreeView; //refresh UsersTreeView.
1676 WaitForm.Hide;
1677 MessageDlg('A new cloned user has been created,' + #10 + #13 +
1678 'named: ' + newName + #10 + #13 +
1679 #10 + #13 +
1680 'This user can be found in the ''Inactive users'' list,' + #10 + #13 +
1681 'but must must be edited before it may be used.' + #10 + #13 +
1682 'Edit it''s DISUSER field to a value of ''NO''' + #10 + #13 +
1683 'to activate.',mtInformation,[mbOK],0);
1684 end;
1685
1686
1687 function TMainForm.DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string;
1688 //Returns IENS of new record in FileNum, or '' if error
1689 var cmd,RPCResult : string;
1690 begin
1691 Result := '';
1692 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1693 RPCBrokerV.param[0].ptype := list;
1694 cmd := 'CLONE RECORD' + '^' + FileNum + '^' + SourceIENS + '^' + New01Field;
1695 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1696 RPCBrokerV.Call;
1697 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1698 if piece(RPCResult,'^',1)='-1' then begin
1699 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1700 FMErrorForm.PrepMessage;
1701 FMErrorForm.ShowModal;
1702 end else begin
1703 result := piece(RPCResult,'^',3);
1704 end;
1705 end;
1706
1707 function TMainForm.DoCloneUser(SourceIENS, New01Field : String) : string;
1708 //Returns IENS of new record in FileNum, or '' if error
1709 var cmd,RPCResult : string;
1710 begin
1711 Result := '';
1712 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1713 RPCBrokerV.param[0].ptype := list;
1714 cmd := 'CLONE USER' + '^' + SourceIENS + '^' + New01Field;
1715 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1716 RPCBrokerV.Call;
1717 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1718 if piece(RPCResult,'^',1)='-1' then begin
1719 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1720 FMErrorForm.PrepMessage;
1721 FMErrorForm.ShowModal;
1722 end else begin
1723 result := piece(RPCResult,'^',3);
1724 end;
1725 end;
1726
1727 function TMainForm.FieldHelp(FileNum, FieldNum, HelpStyle : string) : string;
1728 var
1729 RPCResult: string;
1730 cmd : string;
1731 SrchStr : string;
1732 Idx : integer;
1733 begin
1734 Result := '';
1735 SrchStr := FileNum + '^' + FieldNum + '^' + HelpStyle;
1736 Idx := CachedHelpIdx.IndexOf(SrchStr);
1737 if Idx = -1 then begin
1738 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1739 RPCBrokerV.param[0].ptype := list;
1740 cmd := 'GET HELP MSG^' + SrchStr;
1741 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1742 RPCBrokerV.Call;
1743 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1744 if piece(RPCResult,'^',1)='-1' then begin
1745 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1746 FMErrorForm.PrepMessage;
1747 FMErrorForm.ShowModal;
1748 end else begin
1749 RPCBrokerV.Results.Delete(0);
1750 if RPCBrokerV.Results.Count > 0 then begin
1751 if RPCBrokerV.Results.Strings[RPCBrokerV.Results.Count-1]='' then begin
1752 RPCBrokerV.Results.Delete(RPCBrokerV.Results.Count-1);
1753 end;
1754 end;
1755 result := RPCBrokerV.Results.Text;
1756 if result = '' then result := ' ';
1757 //Maybe later replace text with "Enter F1 for more help."
1758 Result := AnsiReplaceText(Result,'Enter ''??'' for more help.','');
1759 while Result[Length(Result)] in [#10,#13] do begin
1760 Result := AnsiLeftStr(Result,Length(Result)-1);
1761 end;
1762 Idx := CachedHelp.Add(result);
1763 CachedHelpIdx.AddObject(SrchStr,Pointer(Idx)); //Store index here to help stored in CachedHelp
1764 end;
1765 end else begin
1766 Idx := Integer(CachedHelpIdx.Objects[Idx]);
1767 if (Idx >= 0) and (Idx < CachedHelp.Count) then begin
1768 result := CachedHelp.Strings[Idx];
1769 end;
1770 end;
1771 end;
1772
1773 function TMainForm.GetGridHint(Grid : TStringGrid; FileNum : string; ACol, ARow : integer) : string;
1774 var fieldNum : string;
1775 begin
1776 Result := '';
1777 //Result := 'Row=' + IntToStr(ARow) + ', Col='+ IntToStr(ACol);
1778 if ARow > Grid.RowCount-1 then exit;
1779 if (ARow < 0) or (ACol < 0) then exit;
1780 if ACol=0 then begin
1781 Result := 'This is the database field NUMBER';
1782 end else if ACol=1 then begin
1783 Result := 'This is the database field NAME';
1784 end else begin
1785 fieldNum := Grid.Cells[0,ARow];
1786 if Grid.Cells[ACol,ARow]=CLICK_FOR_SUBS then begin
1787 result := 'Clicking will open new window...';
1788 end else if Grid.Cells[ACol,ARow]=COMPUTED_FIELD then begin
1789 result := 'This field can''t be edited';
1790 end else if Grid.Cells[ACol,ARow]=HIDDEN_FIELD then begin
1791 result := 'Original value hidden. Click to edit new value.';
1792 end else if Grid.Cells[ACol,ARow]=CLICK_TO_EDIT then begin
1793 result := 'Clicking will open new window...';
1794 end else begin
1795 Result := FieldHelp(FileNum, fieldNum, '?');
1796 end;
1797 end;
1798 end;
1799
1800
1801 procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
1802 begin
1803 end; (*ApplicationIdle*)
1804
1805
1806 procedure TMainForm.ApplicationEventsShowHint(var HintStr: String;
1807 var CanShow: Boolean;
1808 var HintInfo: THintInfo);
1809 var
1810 Pos : TPoint;
1811 Handle : Hwnd;
1812 ItemBuffer : array[0..256] of Char;
1813 ClassName : AnsiString;
1814 ACol,ARow : integer;
1815 VisibleGridInfo : TGridInfo;
1816 begin
1817 CanShow := true;
1818 //Label2.Caption := HintStr;
1819 Pos := Mouse.CursorPos;
1820 Handle := WindowFromPoint(Pos);
1821 if Handle = 0 then Exit;
1822 GetClassName(Handle, ItemBuffer, SizeOf(ItemBuffer));
1823 ClassName := ItemBuffer;
1824 Windows.ScreenToClient(Handle, Pos);
1825 VisibleGridInfo := GetVisibleGridInfo;
1826 if VisibleGridInfo = nil then exit;
1827 if VisibleGridInfo.Grid = nil then exit;
1828 if (ClassName='TStringGrid') then begin
1829 VisibleGridInfo.Grid.MouseToCell(Pos.X,Pos.Y,ACol,ARow);
1830 HintInfo.HintStr := GetGridHint(VisibleGridInfo.Grid,VisibleGridInfo.FileNum,ACol, ARow);
1831 if HintInfo.HintStr = '' then CanShow := False;
1832 HintInfo.HideTimeout := 1000;
1833 HintInfo.ReshowTimeout := 2000;
1834 HintInfo.HintMaxWidth:= 300; //hint box width.
1835 end;
1836
1837 end;
1838
1839 procedure TMainForm.PageControlChanging(Sender: TObject; var AllowChange: Boolean);
1840 begin
1841 AllowChange := (PostVisibleGrid <> mrNO);
1842 if AllowChange then begin
1843 LastSelTreeNode := nil;
1844 end;
1845 end;
1846
1847 procedure TMainForm.PatientORComboBoxNeedData(Sender: TObject;
1848 const StartFrom: String; Direction, InsertAt: Integer);
1849 var
1850 Result : TStrings;
1851 begin
1852 Result := FieldLookUpForm.SubSetOfFile('2', StartFrom, Direction);
1853 TORComboBox(Sender).ForDataUse(Result);
1854 end;
1855
1856
1857 procedure TMainForm.PageControlChange(Sender: TObject);
1858 begin
1859 if (PageControl.ActivePage = tsUsers) then begin
1860 UserPageControlChange(nil);
1861 end else if (PageControl.ActivePage = tsSettings) then begin
1862 SettingsPageControlChange(nil);
1863 end else if (PageControl.ActivePage = tsPatients) then begin
1864 PatientsPageControlChange(nil);
1865 end else if (PageControl.ActivePage = tsAdvanced) then begin
1866 SetVisibleGridIdx(AnyFileGrid);
1867 end;
1868
1869 end;
1870
1871 procedure TMainForm.PatientORComboBoxClick(Sender: TObject);
1872 var IEN : longInt;
1873 ModalResult : TModalResult;
1874 GridInfo : TGridInfo;
1875 begin
1876 ModalResult := PostVisibleGrid;
1877 if ModalResult = mrNo then exit;
1878 IEN := PatientORComboBox.ItemIEN; //get info from selected patient
1879 if IEN = 0 then exit;
1880 GridInfo := GetInfoForGrid(BasicPatientGrid);
1881 if GridInfo = nil then exit;
1882 GridInfo.IENS := IntToStr(IEN)+',';
1883 GetPatientInfo(GridInfo);
1884 end;
1885
1886 procedure TMainForm.PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1887 begin
1888 AllowChange := (PostVisibleGrid <> mrNO);
1889 end;
1890
1891 procedure TMainForm.PatientsPageControlChange(Sender: TObject);
1892 begin
1893 if PatientsPageControl.ActivePage = tsBasicPatients then begin
1894 SetVisibleGridIdx(BasicPatientGrid);
1895 end else begin
1896 SetVisibleGridIdx(AdvancedPatientGrid);
1897 end;
1898 end;
1899
1900
1901 procedure TMainForm.UserPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1902 var result : TModalResult;
1903 begin
1904 result := PostVisibleGrid;
1905 AllowChange := (result <> mrNO);
1906 if (result <> mrNone) then begin
1907 InitializeUsersTreeView;
1908 end;
1909 end;
1910
1911 procedure TMainForm.UserPageControlChange(Sender: TObject);
1912 begin
1913 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1914 SetVisibleGridIdx(BasicUsersGrid);
1915 end else begin
1916 SetVisibleGridIdx(AdvancedUsersGrid);
1917 end;
1918 end;
1919
1920
1921 procedure TMainForm.SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1922 begin
1923 AllowChange := (PostVisibleGrid <> mrNO);
1924 end;
1925
1926 procedure TMainForm.SettingsPageControlChange(Sender: TObject);
1927 begin
1928 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1929 SetVisibleGridIdx(BasicSettingsGrid);
1930 end else begin
1931 SetVisibleGridIdx(AdvancedSettingsGrid);
1932 end;
1933 end;
1934
1935 procedure TMainForm.FileORComboBoxClick(Sender: TObject);
1936 begin
1937 PostVisibleGrid;
1938 InitORCombobox(RecordORComboBox,'');
1939 ClearGrid(GetVisibleGrid);
1940 end;
1941
1942 procedure TMainForm.FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1943 var Result : TStrings;
1944 begin
1945 Result := FieldLookUpForm.SubSetOfFile('1', StartFrom, Direction);
1946 TORComboBox(Sender).ForDataUse(Result);
1947 end;
1948
1949
1950 procedure TMainForm.RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1951 var Result : TStrings;
1952 FileNum : string;
1953 begin
1954 FileNum := FileORComboBox.ItemID;
1955 Result := FieldLookUpForm.SubSetOfFile(FileNum, StartFrom, Direction);
1956 TORComboBox(Sender).ForDataUse(Result);
1957 end;
1958
1959 procedure TMainForm.RecordORComboBoxClick(Sender: TObject);
1960 var ModalResult : TModalResult;
1961 IEN : LongInt;
1962 FileNum : String;
1963 GridInfo : TGridInfo;
1964 begin
1965 ModalResult := PostVisibleGrid;
1966 if ModalResult = mrNo then exit;
1967 FileNum := FileORComboBox.ItemID;
1968 IEN := RecordORComboBox.ItemID; //get info from selected record
1969 if IEN=0 then exit;
1970 GridInfo := GetInfoForGrid(AnyFileGrid);
1971 if GridInfo = nil then exit;
1972 GridInfo.IENS := IntToStr(IEN) + ',';
1973 GridInfo.FileNum := FileNum;
1974 GetAnyfileInfo(GridInfo);
1975 //GetAnyfileInfo(FileNum,IntToStr(IEN)+',',CurrentAnyFileData);
1976 end;
1977
1978 procedure TMainForm.btnAddAnyRecordClick(Sender: TObject);
1979 var IENS, FileNum : string;
1980 BlankFileInfo : TStringList;
1981 begin
1982 BlankFileInfo := Tstringlist.Create;
1983 btnAdvancedRevert.Enabled := True;
1984 btnAdvancedApply.Enabled := True;
1985 FileNum := FileORComboBox.ItemID;
1986 IENS := '+1,';
1987 GetOneRecord(FileNum,IENS,CurrentAnyFileData, BlankFileInfo);
1988
1989 LoadAnyGridFromInfo(GetInfoForGrid(AnyFileGrid));
1990 BlankFileInfo.Free;
1991 end;
1992
1993 procedure TMainForm.AddBtnClick(Sender: TObject);
1994 var IENS : string;
1995 BlankFileInfo : TStringList;
1996 GridInfo : TGridInfo;
1997 begin
1998 BlankFileInfo := Tstringlist.Create;
1999 btnPatientRevert.Enabled := True;
2000 btnPatientApply.Enabled := True;
2001 GridInfo := GetVisibleGridInfo;
2002 IENS := '+1,';
2003 GetOneRecord(GridInfo.FileNum, IENS, GridInfo.Data, BlankFileInfo);
2004 GridInfo.IENS := IENS;
2005 LoadAnyGridFromInfo(GridInfo); //load Basic or Advanced Grid
2006 if GridInfo.Grid = BasicPatientGrid then begin
2007 GridInfo := GetInfoForGrid(AdvancedPatientGrid)
2008 end else begin //Advanced grid is visible.
2009 GridInfo := GetInfoForGrid(BasicPatientGrid)
2010 end;
2011 GridInfo.IENS := IENS;
2012 LoadAnyGridFromInfo(GridInfo); // Load OTHER grid, Advanced or Basic grid.
2013 BlankFileInfo.Free;
2014 end;
2015
2016 procedure TMainForm.btnAdvancedApplyClick(Sender: TObject);
2017 begin
2018 PostVisibleGrid;
2019 end;
2020
2021 procedure TMainForm.btnAdvancedRevertClick(Sender: TObject);
2022 //var tempInfo: TGridInfo;
2023 begin
2024 DoRevert(nil,AnyFileGrid);
2025 {
2026 tempInfo := GetInfoForGrid(AnyFileGrid);
2027 LoadAnyGridFromInfo(tempInfo);
2028 tempInfo.ApplyBtn.Enabled := false;
2029 tempInfo.RevertBtn.Enabled := false;
2030 }
2031 end;
2032
2033 procedure TMainForm.AnyFileGridClick(Sender: TObject);
2034 begin
2035 btnAdvancedApply.Enabled := True;
2036 btnAdvancedRevert.Enabled := True;
2037 end;
2038
2039 procedure TMainForm.btnBatchAddClick(Sender: TObject);
2040 begin
2041 BatchAddForm.ShowModal;
2042 InitORCombobox(PatientORComboBox,'A');
2043 end;
2044
2045 procedure TMainForm.ShowDebugClick(Sender: TObject);
2046 begin
2047 DebugForm.Show;
2048 end;
2049
2050 procedure TMainForm.ChangeSkinClick(Sender: TObject);
2051 var result : TModalResult;
2052 begin
2053 try
2054 result := SkinForm.ShowModal;
2055 case result of
2056 mrOK : SkinForm.ActivateCurrentSkin;
2057 mrNo : SkinForm.InactivateSkin;
2058 end; {case}
2059 except
2060 on EInvalidOperation do MessageDlg('Error1',mtInformation,[mbOK],0);
2061 else MessageDlg('Error Applying Skin. Please try another Skin.',mtInformation,[mbOK],0);
2062 end;
2063 end;
2064
2065 procedure TMainForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string);
2066 begin
2067 ORComboBox.Items.Clear;
2068 ORComboBox.Text := initValue;
2069 ORComboBox.InitLongList(initValue);
2070 if ORComboBox.Items.Count > 0 then begin
2071 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
2072 end else begin
2073 ORComboBox.Text := '<Start Typing to Search>';
2074 end;
2075 end;
2076
2077
2078 procedure TMainForm.btnPatientApplyClick(Sender: TObject); //Added elh 8/15/08
2079 begin
2080 PostVisibleGrid;
2081 InitORCombobox(PatientORComboBox,'A');
2082 end;
2083
2084 procedure TMainForm.btnPatientRevertClick(Sender: TObject); //Added elh 8/15/08
2085 //var tempInfo : TGridInfo;
2086 begin
2087 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
2088 {
2089 tempInfo := GetInfoForGrid(AdvancedUsersGrid);
2090 LoadAnyGridFromInfo(tempInfo);
2091
2092 tempInfo := GetInfoForGrid(BasicUsersGrid);
2093 LoadAnyGridFromInfo(tempInfo);
2094
2095 tempInfo.ApplyBtn.Enabled := false;
2096 tempInfo.RevertBtn.Enabled := false;
2097 }
2098 end;
2099
2100 procedure TMainForm.BasicPatientGridClick(Sender: TObject); //Added elh 8/15/08
2101 begin
2102 btnPatientRevert.Enabled := true;
2103 btnPatientApply.Enabled := true;
2104 end;
2105
2106 Procedure TMainForm.GetBlankFileInfo(FileNum : string; BlankList : TStringList);
2107 var RPCResult: string;
2108 //Returned format for BlankList is:
2109 //FileNum^^FieldNum^^FieldName^More DDInfo
2110 //FileNum^^FieldNum^^FieldName^More DDInfo
2111 begin
2112 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2113 RPCBrokerV.Param[0].Value := '.X'; // not used
2114 RPCBrokerV.param[0].ptype := list;
2115 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET EMPTY ENTRY^' + FileNum;
2116 RPCBrokerV.Call;
2117 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2118 //Return Format is: FileNum^^FieldNum^^DDInfo...
2119 if piece(RPCResult,'^',1)='-1' then begin
2120 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2121 FMErrorForm.PrepMessage;
2122 FMErrorForm.ShowModal;
2123 end else begin
2124 BlankList.Assign(RPCBrokerV.Results);
2125 end;
2126 end;
2127
2128
2129 procedure TMainForm.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
2130 var cmd,RPCResult : string;
2131 i : integer;
2132 oneEntry : string;
2133 begin
2134 Data.Clear;
2135 if (IENS='') then exit;
2136 if Pos('+',IENS)=0 then begin //don't ask server to load +1 records.
2137 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2138 RPCBrokerV.Param[0].Value := '.X'; // not used
2139 RPCBrokerV.param[0].ptype := list;
2140 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
2141 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
2142 RPCBrokerV.Call;
2143 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2144 if piece(RPCResult,'^',1)='-1' then begin
2145 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2146 FMErrorForm.PrepMessage;
2147 FMErrorForm.ShowModal;
2148 end else begin
2149 Data.Assign(RPCBrokerV.Results);
2150 end;
2151 end else begin
2152 Data.Add('1^Success'); //to keep same as call to server
2153 if BlankFileInfo.Count = 0 then begin
2154 //Format is: FileNum^^FieldNum^^DDInfo...
2155 GetBlankFileInfo(FileNum,BlankFileInfo);
2156 end;
2157 for i := 1 to BlankFileInfo.Count-1 do begin //0 is 1^success
2158 oneEntry := BlankFileInfo.Strings[i];
2159 SetPiece(oneEntry,'^',2,IENS);
2160 Data.Add(oneEntry);
2161 end;
2162 end;
2163 end;
2164
2165
2166 procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
2167 begin
2168 if E.Message <> 'Cannot focus a disabled or invisible window' then begin
2169 ShowException(E,nil);
2170 end;
2171 end;
2172
2173
2174 procedure TMainForm.btnSettingsRevertClick(Sender: TObject);
2175 //var tempInfo : TGridInfo;
2176 begin
2177 DoRevert(BasicSettingsGrid,AdvancedSettingsGrid);
2178 {
2179 tempInfo := GetInfoForGrid(BasicSettingsGrid);
2180 LoadAnyGridFromInfo(tempInfo);
2181
2182 tempInfo := GetInfoForGrid(AdvancedSettingsGrid);
2183 LoadAnyGridFromInfo(tempInfo);
2184
2185 tempInfo.ApplyBtn.Enabled := false;
2186 tempInfo.RevertBtn.Enabled := false;
2187 }
2188 end;
2189
2190
2191 procedure TMainForm.DoRevert(BasicGrid,AdvancedGrid : TStringGrid);
2192 //BasicGrid doesn't have to be supplied. Can be nil value.
2193 //AdvancedGrid is required.
2194 var tempInfo : TGridInfo;
2195 begin
2196 tempInfo := GetInfoForGrid(AdvancedGrid);
2197 LoadAnyGridFromInfo(tempInfo);
2198 tempInfo.ApplyBtn.Enabled := false;
2199 tempInfo.RevertBtn.Enabled := false;
2200
2201 if BasicGrid <> nil then begin
2202 tempInfo := GetInfoForGrid(BasicGrid);
2203 LoadAnyGridFromInfo(tempInfo);
2204 end;
2205 end;
2206
2207
2208 procedure TMainForm.btnSettingsApplyClick(Sender: TObject);
2209 begin
2210 PostVisibleGrid;
2211 end;
2212
2213
2214
2215end.
2216
Note: See TracBrowser for help on using the repository browser.