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

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

Fixed several issues with Advanced Users tab
File size: 81.9 KB
RevLine 
[476]1unit MainU;
2
3 (*
4 WorldVistA Configuration Utility
5 (c) 8/2008 Kevin Toppenberg
6 Programmed by Kevin Toppenberg, Eddie Hagood
[542]7
[476]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
[493]26 *)
[476]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,
[493]34 AppEvnts, Menus, ImgList,
35 {$IFDEF USE_SKINS}
36 ipSkinManager,
[476]37 {$ENDIF}
[542]38 Trpcb, //needed for .ptype types
[476]39 ValEdit;
40
41type
42 tFileEntry = record
43 Field : string;
44 FileNum : string;
45 FieldName : String;
46 IENS : string;
47 oldValue,newValue : string;
[493]48 end;
[476]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;
[488]84 FileMenu: TMenuItem;
85 ExitMenuItem: TMenuItem;
[476]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);
[488]151 procedure ExitMenuItemClick(Sender: TObject);
[476]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;
[542]203 FLastSelectedRow,FLastSelectedCol : integer;
[476]204 FLoadingGrid: boolean;
205 DataForGrid : TStringList; // doesn't own TGridInfo objects
206 CachedHelp : TStringList;
207 CachedHelpIdx : TStringList;
208 CachedWPField : TStringList;
209 FVisibleGridIdx : integer;
[542]210 FINIFileName : string; // 8-12-09 elh
[493]211 procedure ShowDebugClick(Sender: TObject);
[488]212 function FindParam(Param : string) : string;
[476]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;
[488]253 DebugMode : boolean;
[476]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
[542]285 frmSplash, LookupU, SubfilesU, SetSelU, SelDateTimeU, PostU,
[476]286 FMErrorU, AboutU, PleaseWaitU, EditTextU, CreateTemplateU, SkinFormU,
[542]287 BatchAddU, DebugU,
288 inifiles; //8-12-09 elh
[476]289
290{$R *.dfm}
291const
292 RPC_CONTEXT = 'TMG RPC CONTEXT GUI_CONFIG';
293
294 procedure TMainForm.Initialize;
[493]295 var tempMenu,tempSubMenu : TMenuItem;
[476]296 begin
[488]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);
[493]304 end else begin
305 DebugForm.Hide;
306 end;
307 {$IFDEF USE_SKINS}
[488]308 DebugForm.Memo.Lines.Add('Adding Menus');
[476]309 tempMenu := TMenuItem.Create(MainMenu);
310 tempMenu.Caption := '&Appearance';
311 tempSubMenu := TMenuItem.Create(tempMenu);
312 tempSubMenu.Caption := '&Change Skin';
313 tempSubMenu.OnClick := ChangeSkinClick;
[493]314 tempMenu.Add(tempSubMenu);
[476]315 MainMenu.Items.Add(tempMenu);
316 {$ENDIF}
317
[488]318 DebugForm.Memo.Lines.Add('Showing Splash');
[476]319 SplashForm.show;
[493]320
[476]321 FLoadingGrid := false;
322 SettingsFiles := TStringList.Create;
323 CurrentUserData := TStringList.create;
324 CurrentSettingsData := TStringList.Create;
325 CurrentPatientData := TStringList.Create;
326 CurrentAnyFileData := TStringList.Create;
[493]327
[476]328 DataForGrid := TStringList.Create; //will own GridInfo objects.
329 CachedHelp := TStringList.Create;
[493]330 CachedHelpIdx := TStringList.Create;
331 CachedWPField := TStringList.Create;
332
[488]333 DebugForm.Memo.Lines.Add('Adding Grid Info');
[476]334 AddGridInfo(BasicUsersGrid,CurrentUserData,true,LoadUserData,'200',btnUsersApply,btnUsersRevert);
[493]335 AddGridInfo(AdvancedUsersGrid,CurrentUserData,false,LoadUserData,'200',btnUsersApply,btnUsersRevert);
[476]336 AddGridInfo(BasicSettingsGrid,CurrentSettingsData,true,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert);
[493]337 AddGridInfo(AdvancedSettingsGrid,CurrentSettingsData,false,GetSettingsInfo,'',btnSettingsApply,btnSettingsRevert);
[476]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;
[493]343
[488]344 DebugForm.Memo.Lines.Add('Trying to connect to server');
[476]345 if not ORNet.ConnectToServer(RPC_CONTEXT) then begin
[488]346 DebugForm.Memo.Lines.Add('Failed connection. Closing.');
[542]347 messagedlg('Login Failed.',mtError,[mbOK],0);
[493]348 Close;
[476]349 Exit;
350 end;
[488]351 DebugForm.Memo.Lines.Add('Connected to server!');
[476]352 Application.ProcessMessages;
353 LastSelTreeNode := nil;
354 RPCBrokerV.ClearParameters := true;
355 BasicTemplate := TStringList.create;
356 BasicTemplate.Sorted := false;
357
[488]358 DebugForm.Memo.Lines.Add('Initializing Combo Boxes');
[476]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
[488]374 DebugForm.Memo.Lines.Add('Activating Skins');
[476]375 SkinForm.ActivateCurrentSkin;
376 end;
377 {$ENDIF}
378
[488]379 self.Visible := true;
[476]380 SplashForm.Hide;
[488]381 DebugForm.Memo.Lines.Add('Done Initializing.');
[476]382 end;
383
[488]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
[476]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);
[756]1039 var i:integer;
[476]1040 begin
[756]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;
[476]1046 Grid.RowCount :=2;
1047 end;
1048
1049
1050 procedure TMainForm.LoadAnyGrid(Grid : TStringGrid; //the TStringGrid 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 : TStringGrid; //the TStringGrid to load
1080 BasicMode: boolean;
1081 FileNum : string;
1082 IENS : string;
1083 CurrentData : TStringList;
1084
1085 procedure LoadOneLine (Grid : TStringGrid; 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;
[542]1175 end;
[476]1176 FLoadingGrid := false;
1177 end;
1178
1179
1180 procedure TMainForm.GridSelectCell(Sender: TObject; ACol, ARow: Integer;
1181 var CanSelect: Boolean);
[542]1182 (*
[476]1183 For Field def, here is the legend
1184 character meaning
[542]1185
[476]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.
[542]1195
1196 N The data is Numeric-valued.
1197
[476]1198 Jn To specify a print length of n characters.
1199 Jn,d To specify printing n characters with decimals.
[542]1200
[476]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 *)
[542]1205 var oneEntry,FieldDef : string;
[476]1206 date,time: string;
1207 FileNum,FieldNum,SubFileNum : string;
1208 GridFileNum : string;
1209 UserLine : integer;
1210 Grid : TStringGrid;
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 TStringGrid);
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) + ',';
[542]1250 end;
[476]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);
[542]1258 end;
[476]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;
[542]1276 CanSelect := true;
[476]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;
[542]1292 end;
[476]1293 end;
1294 if CanSelect then begin
1295 FLastSelectedRow := ARow;
1296 FLastSelectedCol := ACol;
1297 end;
[542]1298 GridInfo.ApplyBtn.Enabled := true;
1299 GridInfo.RevertBtn.Enabled := true;
[476]1300 end;
1301
[542]1302
[476]1303 function TMainForm.GetLineInfo(Grid : TStringGrid; 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];
[542]1310 gridRow := FindInStrings(fieldNum, CurrentUserData, fileNum);
[476]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);
[542]1318 Result.newValue := Grid.Cells[2,ARow];
[476]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 : TStringGrid; 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;
[542]1355 end;
1356
1357
[476]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: TStringGrid;
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 : TStringGrid) : 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 : TStringGrid) : 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 : TStringGrid);
1460 begin
1461 FVisibleGridIdx := GetInfoIndexForGrid(Grid);
1462 end;
[542]1463
1464
[476]1465 procedure TMainForm.CompileChanges(Grid : TStringGrid; CurrentUserData,Changes : TStringList);
1466 //Output format:
1467 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1468
1469 var row : integer;
1470 Entry : tFileEntry;
1471 oneEntry : string;
[542]1472 iniFile : TIniFile; // 8-12-09 elh
1473 UCaseOnly : boolean;
[476]1474 begin
[542]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;
[476]1479 for row := 1 to Grid.RowCount-1 do begin
1480 Entry := GetLineInfo(Grid,CurrentUserData, row);
[544]1481 //Reject any value containing a "^" , ":" , ";"
[542]1482 //Do we need an @ here as well?
[756]1483 if (AnsiPos('^',Entry.newvalue) > 0) or //(AnsiPos(':',Entry.newvalue) > 0) or //elh Taken out because : used in time
[544]1484 (AnsiPos(';',Entry.newvalue) > 0)then begin
[542]1485 messagedlg('Invalid value entered for ' + Entry.Fieldname + #13 + #10
1486 + #13 + #10 + 'Invalid Entry: ' + Entry.newvalue + #13 + #10 +
1487 'Ignoring Value.',mtError,[mbOK],0);
1488 end else begin
1489 if Entry.oldValue <> Entry.newValue then begin
1490 if (Entry.newValue <> CLICK_FOR_SUBS) and
1491 (Entry.newValue <> COMPUTED_FIELD) and
1492 (Entry.newValue <> CLICK_TO_EDIT) then begin
1493 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
1494 //Test to see if change is an AV Code (2 or 11) or ES Code (20.4) in User File (200)
1495 //If so, make it uppercase. 8/12/09 elh
1496 if Entry.FileNum = '200' then begin
1497 if ((Entry.Field = '2') and (UCaseOnly = true)) or
1498 ((Entry.Field = '11') and (UCaseOnly = true)) or
1499 ((Entry.Field = '20.4') and (UCaseOnly = true)) then begin
1500 messagedlg('Converting ' + Entry.Fieldname + ' to uppercase for VistA interactivity.' +#13 +#10 +
1501 #13 +#10 +
1502 'Old Value: ' + Entry.newvalue + ' ' + 'New Value: ' + Uppercase(Entry.newvalue),
1503 mtinformation,[mbOK],0);
1504 Entry.newValue := Uppercase(Entry.newValue);
1505 end;
1506 end;
1507 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
1508 Changes.Add(oneEntry);
1509 end;
1510 end;
[476]1511 end;
1512 end;
1513 end;
1514
[542]1515
[476]1516 function TMainForm.PostChanges(Grid : TStringGrid) : TModalResult;
1517 //Results: mrNone -- no post done (not needed)
1518 // mrCancel -- user pressed cancel on confirmation screen.
1519 // mrNo -- signals posting error.
1520 var Changes : TStringList;
1521 PostResult : TModalResult;
1522 CurrentData : TStringList;
1523 GridInfo : TGridInfo;
1524 IENS : string;
1525 begin
1526 Result := mrNone; //default to No changes
1527 GridInfo := GetInfoForGrid(Grid);
1528 if GridInfo=nil then exit;
1529 CurrentData := GridInfo.Data;
1530 if CurrentData=nil then exit;
1531 if CurrentData.Count = 0 then exit;
1532 IENS := GridInfo.IENS;
1533 if IENS='' then exit;
1534 Changes := TStringList.Create;
1535 CompileChanges(Grid,CurrentData,Changes);
1536 if Changes.Count>0 then begin
1537 PostForm.PrepForm(Changes);
1538 PostResult := PostForm.ShowModal;
1539 if PostResult = mrOK then begin
1540 if DisuserChanged(Changes) then begin //looks for change in file 200, field 4
1541 InitializeUsersTreeView;
1542 end else begin
1543 if Pos('+',IENS)>0 then begin
1544 GridInfo.IENS := PostForm.GetNewIENS(IENS);
1545 end;
1546 if assigned(GridInfo.DataLoadProc) then begin
1547 GridInfo.DataLoadProc(GridInfo);
1548 end;
1549 {
1550 if CurrentData = CurrentUserData then begin
1551 LoadUserData(IENS,CurrentData); //reload record from server.
1552 end else if CurrentData = CurrentSettingsData then begin
1553 GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1554 end else if CurrentData = CurrentPatientData then begin
1555 GetPatientInfo(GridInfo.IENS, CurrentData);
1556 end else if CurrentData = CurrentAnyFileData then begin
1557 GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1558 end;
1559 }
1560 end;
1561 end else if PostResult = mrNo then begin //mrNo is signal of post Error
1562 // show error...
1563 end;
1564 Result := PostResult;
1565 end else begin
1566 Result := mrNone;
1567 end;
1568 Changes.Free;
1569 end;
1570
1571 function TMainForm.DisuserChanged(Changes: TStringList) : boolean;
1572 var i : integer;
1573 //Changes format:
1574 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1575 begin
1576 result := false;
1577 for i := 0 to Changes.Count-1 do begin
1578 if piece(Changes.Strings[i],'^',1)<> '200' then continue;
1579 if piece(Changes.Strings[i],'^',4)<> 'DISUSER' then continue;
1580 result := true;
1581 break;
1582 end;
1583 end;
1584
1585
1586 procedure TMainForm.btnUsersApplyClick(Sender: TObject);
1587 var result : TModalResult;
1588 begin
1589 result:= PostVisibleGrid;
1590 if result <> mrNone then InitializeUsersTreeView;
1591 end;
1592
1593 procedure TMainForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1594 begin
1595 btnUsersRevert.Enabled := true;
1596 btnUsersApply.Enabled := true;
1597 end;
1598
1599 procedure TMainForm.BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1600 begin
1601 btnSettingsRevert.Enabled := true;
1602 btnSettingsApply.Enabled := true;
1603 end;
1604
1605
1606 procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
1607 begin
1608 PostVisibleGrid;
1609 RPCBrokerV.Connected := false; //disconnect
1610 end;
1611
[488]1612 procedure TMainForm.ExitMenuItemClick(Sender: TObject);
[476]1613 begin
1614 Close;
1615 end;
1616
1617 procedure TMainForm.UserPageControlDrawTab(Control: TCustomTabControl;
1618 TabIndex: Integer;
1619 const Rect: TRect;
1620 Active: Boolean);
1621 begin
1622 DrawTab(Control,TabIndex,Rect,Active);
1623 end;
1624
1625 procedure TMainForm.DrawTab(Control: TCustomTabControl;
1626 TabIndex: Integer;
1627 const Rect: TRect;
1628 Active: Boolean);
1629 var
1630 oRect : TRect;
1631 sCaption,temp : String;
1632 iTop : Integer;
1633 iLeft : Integer;
1634 i : integer;
1635
1636 begin
1637 oRect := Rect;
1638 temp := TPageControl(Control).Pages[TabIndex].Caption;
1639 for i := 1 to length(temp) do begin
1640 if temp[i] <> '&' then sCaption := sCaption + temp[i];
1641 end;
1642
1643 iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
1644 iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
1645
1646 if Active then begin
1647 Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow
1648 Control.Canvas.FillRect(Rect);
1649// Frame3d(Control.Canvas,oRect,clBtnHighLight,clBtnShadow,3);
1650
1651 end else begin
1652 Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow
1653 Control.Canvas.FillRect(Rect);
1654 end;
1655 Control.Canvas.TextOut(iLeft,iTop,sCaption);
1656 end;
1657
1658
1659 procedure TMainForm.AboutMenuClick(Sender: TObject);
1660 begin
1661 AboutForm.show;
1662 end;
1663
1664 procedure TMainForm.CloneBtnClick(Sender: TObject);
1665 var IEN : longInt;
1666 newName : string;
1667 IENS,newIENS : string;
1668
1669 begin
1670 if btnUsersApply.Enabled then btnUsersApplyClick(self); //post any changes first.
1671 if MessageDlg('Clone user: '+LastSelTreeNode.Text+' --> New user?' + #10 + #13 +
1672 'Note: This can not be undone.',
1673 mtConfirmation, mbOKCancel,0) = mrCancel then exit;
1674 IEN := longInt(LastSelTreeNode.Data);
1675 IENS := IntToStr(IEN) + ',';
1676 WaitForm.Show;
1677 newName := 'TEMP,MUST-EDIT';
1678 newIENS := DoCloneUser(IENS,newName);
1679 InitializeUsersTreeView; //refresh UsersTreeView.
1680 WaitForm.Hide;
1681 MessageDlg('A new cloned user has been created,' + #10 + #13 +
1682 'named: ' + newName + #10 + #13 +
1683 #10 + #13 +
1684 'This user can be found in the ''Inactive users'' list,' + #10 + #13 +
1685 'but must must be edited before it may be used.' + #10 + #13 +
1686 'Edit it''s DISUSER field to a value of ''NO''' + #10 + #13 +
1687 'to activate.',mtInformation,[mbOK],0);
1688 end;
1689
1690
1691 function TMainForm.DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string;
1692 //Returns IENS of new record in FileNum, or '' if error
1693 var cmd,RPCResult : string;
1694 begin
1695 Result := '';
1696 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1697 RPCBrokerV.param[0].ptype := list;
1698 cmd := 'CLONE RECORD' + '^' + FileNum + '^' + SourceIENS + '^' + New01Field;
1699 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1700 RPCBrokerV.Call;
1701 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1702 if piece(RPCResult,'^',1)='-1' then begin
1703 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1704 FMErrorForm.PrepMessage;
1705 FMErrorForm.ShowModal;
1706 end else begin
1707 result := piece(RPCResult,'^',3);
1708 end;
1709 end;
1710
1711 function TMainForm.DoCloneUser(SourceIENS, New01Field : String) : string;
1712 //Returns IENS of new record in FileNum, or '' if error
1713 var cmd,RPCResult : string;
1714 begin
1715 Result := '';
1716 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1717 RPCBrokerV.param[0].ptype := list;
1718 cmd := 'CLONE USER' + '^' + SourceIENS + '^' + New01Field;
1719 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1720 RPCBrokerV.Call;
1721 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1722 if piece(RPCResult,'^',1)='-1' then begin
1723 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1724 FMErrorForm.PrepMessage;
1725 FMErrorForm.ShowModal;
1726 end else begin
1727 result := piece(RPCResult,'^',3);
1728 end;
1729 end;
1730
1731 function TMainForm.FieldHelp(FileNum, FieldNum, HelpStyle : string) : string;
1732 var
1733 RPCResult: string;
1734 cmd : string;
1735 SrchStr : string;
1736 Idx : integer;
1737 begin
1738 Result := '';
1739 SrchStr := FileNum + '^' + FieldNum + '^' + HelpStyle;
1740 Idx := CachedHelpIdx.IndexOf(SrchStr);
[542]1741 if Idx = -1 then begin
[476]1742 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1743 RPCBrokerV.param[0].ptype := list;
1744 cmd := 'GET HELP MSG^' + SrchStr;
1745 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1746 RPCBrokerV.Call;
1747 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1748 if piece(RPCResult,'^',1)='-1' then begin
1749 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1750 FMErrorForm.PrepMessage;
1751 FMErrorForm.ShowModal;
1752 end else begin
1753 RPCBrokerV.Results.Delete(0);
[542]1754 if RPCBrokerV.Results.Count > 0 then begin
1755 if RPCBrokerV.Results.Strings[RPCBrokerV.Results.Count-1]='' then begin
1756 RPCBrokerV.Results.Delete(RPCBrokerV.Results.Count-1);
1757 end;
[476]1758 end;
[542]1759 result := RPCBrokerV.Results.Text;
1760 if result = '' then result := ' ';
[476]1761 //Maybe later replace text with "Enter F1 for more help."
[542]1762 Result := AnsiReplaceText(Result,'Enter ''??'' for more help.','');
[476]1763 while Result[Length(Result)] in [#10,#13] do begin
1764 Result := AnsiLeftStr(Result,Length(Result)-1);
1765 end;
1766 Idx := CachedHelp.Add(result);
1767 CachedHelpIdx.AddObject(SrchStr,Pointer(Idx)); //Store index here to help stored in CachedHelp
1768 end;
1769 end else begin
1770 Idx := Integer(CachedHelpIdx.Objects[Idx]);
1771 if (Idx >= 0) and (Idx < CachedHelp.Count) then begin
1772 result := CachedHelp.Strings[Idx];
1773 end;
1774 end;
1775 end;
1776
1777 function TMainForm.GetGridHint(Grid : TStringGrid; FileNum : string; ACol, ARow : integer) : string;
1778 var fieldNum : string;
1779 begin
1780 Result := '';
1781 //Result := 'Row=' + IntToStr(ARow) + ', Col='+ IntToStr(ACol);
1782 if ARow > Grid.RowCount-1 then exit;
1783 if (ARow < 0) or (ACol < 0) then exit;
1784 if ACol=0 then begin
1785 Result := 'This is the database field NUMBER';
1786 end else if ACol=1 then begin
1787 Result := 'This is the database field NAME';
1788 end else begin
1789 fieldNum := Grid.Cells[0,ARow];
1790 if Grid.Cells[ACol,ARow]=CLICK_FOR_SUBS then begin
1791 result := 'Clicking will open new window...';
1792 end else if Grid.Cells[ACol,ARow]=COMPUTED_FIELD then begin
1793 result := 'This field can''t be edited';
1794 end else if Grid.Cells[ACol,ARow]=HIDDEN_FIELD then begin
1795 result := 'Original value hidden. Click to edit new value.';
1796 end else if Grid.Cells[ACol,ARow]=CLICK_TO_EDIT then begin
1797 result := 'Clicking will open new window...';
1798 end else begin
1799 Result := FieldHelp(FileNum, fieldNum, '?');
1800 end;
1801 end;
1802 end;
1803
1804
1805 procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
1806 begin
1807 end; (*ApplicationIdle*)
1808
1809
1810 procedure TMainForm.ApplicationEventsShowHint(var HintStr: String;
1811 var CanShow: Boolean;
1812 var HintInfo: THintInfo);
1813 var
1814 Pos : TPoint;
1815 Handle : Hwnd;
1816 ItemBuffer : array[0..256] of Char;
1817 ClassName : AnsiString;
1818 ACol,ARow : integer;
1819 VisibleGridInfo : TGridInfo;
1820 begin
1821 CanShow := true;
1822 //Label2.Caption := HintStr;
1823 Pos := Mouse.CursorPos;
1824 Handle := WindowFromPoint(Pos);
1825 if Handle = 0 then Exit;
1826 GetClassName(Handle, ItemBuffer, SizeOf(ItemBuffer));
1827 ClassName := ItemBuffer;
1828 Windows.ScreenToClient(Handle, Pos);
1829 VisibleGridInfo := GetVisibleGridInfo;
1830 if VisibleGridInfo = nil then exit;
1831 if VisibleGridInfo.Grid = nil then exit;
1832 if (ClassName='TStringGrid') then begin
1833 VisibleGridInfo.Grid.MouseToCell(Pos.X,Pos.Y,ACol,ARow);
1834 HintInfo.HintStr := GetGridHint(VisibleGridInfo.Grid,VisibleGridInfo.FileNum,ACol, ARow);
1835 if HintInfo.HintStr = '' then CanShow := False;
1836 HintInfo.HideTimeout := 1000;
1837 HintInfo.ReshowTimeout := 2000;
1838 HintInfo.HintMaxWidth:= 300; //hint box width.
1839 end;
1840
1841 end;
1842
1843 procedure TMainForm.PageControlChanging(Sender: TObject; var AllowChange: Boolean);
1844 begin
1845 AllowChange := (PostVisibleGrid <> mrNO);
1846 if AllowChange then begin
1847 LastSelTreeNode := nil;
1848 end;
1849 end;
1850
1851 procedure TMainForm.PatientORComboBoxNeedData(Sender: TObject;
1852 const StartFrom: String; Direction, InsertAt: Integer);
1853 var
1854 Result : TStrings;
1855 begin
1856 Result := FieldLookUpForm.SubSetOfFile('2', StartFrom, Direction);
1857 TORComboBox(Sender).ForDataUse(Result);
1858 end;
1859
1860
1861 procedure TMainForm.PageControlChange(Sender: TObject);
1862 begin
1863 if (PageControl.ActivePage = tsUsers) then begin
1864 UserPageControlChange(nil);
1865 end else if (PageControl.ActivePage = tsSettings) then begin
1866 SettingsPageControlChange(nil);
1867 end else if (PageControl.ActivePage = tsPatients) then begin
1868 PatientsPageControlChange(nil);
1869 end else if (PageControl.ActivePage = tsAdvanced) then begin
1870 SetVisibleGridIdx(AnyFileGrid);
1871 end;
1872
1873 end;
1874
1875 procedure TMainForm.PatientORComboBoxClick(Sender: TObject);
1876 var IEN : longInt;
1877 ModalResult : TModalResult;
1878 GridInfo : TGridInfo;
1879 begin
1880 ModalResult := PostVisibleGrid;
1881 if ModalResult = mrNo then exit;
1882 IEN := PatientORComboBox.ItemIEN; //get info from selected patient
1883 if IEN = 0 then exit;
1884 GridInfo := GetInfoForGrid(BasicPatientGrid);
1885 if GridInfo = nil then exit;
1886 GridInfo.IENS := IntToStr(IEN)+',';
1887 GetPatientInfo(GridInfo);
1888 end;
1889
1890 procedure TMainForm.PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1891 begin
1892 AllowChange := (PostVisibleGrid <> mrNO);
1893 end;
1894
1895 procedure TMainForm.PatientsPageControlChange(Sender: TObject);
1896 begin
1897 if PatientsPageControl.ActivePage = tsBasicPatients then begin
1898 SetVisibleGridIdx(BasicPatientGrid);
1899 end else begin
1900 SetVisibleGridIdx(AdvancedPatientGrid);
1901 end;
1902 end;
1903
1904
1905 procedure TMainForm.UserPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1906 var result : TModalResult;
1907 begin
1908 result := PostVisibleGrid;
1909 AllowChange := (result <> mrNO);
1910 if (result <> mrNone) then begin
1911 InitializeUsersTreeView;
1912 end;
1913 end;
1914
1915 procedure TMainForm.UserPageControlChange(Sender: TObject);
1916 begin
[756]1917 if UserPageControl.ActivePage = tsBasicPage then begin
1918 SetVisibleGridIdx(BasicUsersGrid);
[476]1919 end else begin
1920 SetVisibleGridIdx(AdvancedUsersGrid);
1921 end;
1922 end;
1923
1924
1925 procedure TMainForm.SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1926 begin
1927 AllowChange := (PostVisibleGrid <> mrNO);
1928 end;
1929
1930 procedure TMainForm.SettingsPageControlChange(Sender: TObject);
1931 begin
1932 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1933 SetVisibleGridIdx(BasicSettingsGrid);
1934 end else begin
1935 SetVisibleGridIdx(AdvancedSettingsGrid);
1936 end;
1937 end;
1938
1939 procedure TMainForm.FileORComboBoxClick(Sender: TObject);
1940 begin
1941 PostVisibleGrid;
1942 InitORCombobox(RecordORComboBox,'');
1943 ClearGrid(GetVisibleGrid);
1944 end;
1945
1946 procedure TMainForm.FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1947 var Result : TStrings;
1948 begin
1949 Result := FieldLookUpForm.SubSetOfFile('1', StartFrom, Direction);
1950 TORComboBox(Sender).ForDataUse(Result);
1951 end;
1952
1953
1954 procedure TMainForm.RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1955 var Result : TStrings;
1956 FileNum : string;
1957 begin
1958 FileNum := FileORComboBox.ItemID;
1959 Result := FieldLookUpForm.SubSetOfFile(FileNum, StartFrom, Direction);
1960 TORComboBox(Sender).ForDataUse(Result);
1961 end;
1962
1963 procedure TMainForm.RecordORComboBoxClick(Sender: TObject);
1964 var ModalResult : TModalResult;
1965 IEN : LongInt;
1966 FileNum : String;
1967 GridInfo : TGridInfo;
1968 begin
1969 ModalResult := PostVisibleGrid;
1970 if ModalResult = mrNo then exit;
1971 FileNum := FileORComboBox.ItemID;
1972 IEN := RecordORComboBox.ItemID; //get info from selected record
1973 if IEN=0 then exit;
1974 GridInfo := GetInfoForGrid(AnyFileGrid);
1975 if GridInfo = nil then exit;
1976 GridInfo.IENS := IntToStr(IEN) + ',';
1977 GridInfo.FileNum := FileNum;
1978 GetAnyfileInfo(GridInfo);
1979 //GetAnyfileInfo(FileNum,IntToStr(IEN)+',',CurrentAnyFileData);
1980 end;
1981
1982 procedure TMainForm.btnAddAnyRecordClick(Sender: TObject);
1983 var IENS, FileNum : string;
1984 BlankFileInfo : TStringList;
1985 begin
1986 BlankFileInfo := Tstringlist.Create;
1987 btnAdvancedRevert.Enabled := True;
1988 btnAdvancedApply.Enabled := True;
1989 FileNum := FileORComboBox.ItemID;
1990 IENS := '+1,';
1991 GetOneRecord(FileNum,IENS,CurrentAnyFileData, BlankFileInfo);
1992
1993 LoadAnyGridFromInfo(GetInfoForGrid(AnyFileGrid));
1994 BlankFileInfo.Free;
1995 end;
1996
1997 procedure TMainForm.AddBtnClick(Sender: TObject);
1998 var IENS : string;
1999 BlankFileInfo : TStringList;
2000 GridInfo : TGridInfo;
2001 begin
2002 BlankFileInfo := Tstringlist.Create;
2003 btnPatientRevert.Enabled := True;
2004 btnPatientApply.Enabled := True;
2005 GridInfo := GetVisibleGridInfo;
2006 IENS := '+1,';
2007 GetOneRecord(GridInfo.FileNum, IENS, GridInfo.Data, BlankFileInfo);
2008 GridInfo.IENS := IENS;
2009 LoadAnyGridFromInfo(GridInfo); //load Basic or Advanced Grid
2010 if GridInfo.Grid = BasicPatientGrid then begin
2011 GridInfo := GetInfoForGrid(AdvancedPatientGrid)
2012 end else begin //Advanced grid is visible.
2013 GridInfo := GetInfoForGrid(BasicPatientGrid)
2014 end;
2015 GridInfo.IENS := IENS;
2016 LoadAnyGridFromInfo(GridInfo); // Load OTHER grid, Advanced or Basic grid.
2017 BlankFileInfo.Free;
2018 end;
2019
2020 procedure TMainForm.btnAdvancedApplyClick(Sender: TObject);
2021 begin
2022 PostVisibleGrid;
2023 end;
2024
2025 procedure TMainForm.btnAdvancedRevertClick(Sender: TObject);
2026 //var tempInfo: TGridInfo;
2027 begin
2028 DoRevert(nil,AnyFileGrid);
2029 {
2030 tempInfo := GetInfoForGrid(AnyFileGrid);
2031 LoadAnyGridFromInfo(tempInfo);
2032 tempInfo.ApplyBtn.Enabled := false;
2033 tempInfo.RevertBtn.Enabled := false;
2034 }
2035 end;
2036
2037 procedure TMainForm.AnyFileGridClick(Sender: TObject);
2038 begin
2039 btnAdvancedApply.Enabled := True;
2040 btnAdvancedRevert.Enabled := True;
2041 end;
2042
2043 procedure TMainForm.btnBatchAddClick(Sender: TObject);
2044 begin
2045 BatchAddForm.ShowModal;
2046 InitORCombobox(PatientORComboBox,'A');
2047 end;
2048
[488]2049 procedure TMainForm.ShowDebugClick(Sender: TObject);
2050 begin
2051 DebugForm.Show;
2052 end;
2053
[476]2054 procedure TMainForm.ChangeSkinClick(Sender: TObject);
2055 var result : TModalResult;
2056 begin
2057 try
2058 result := SkinForm.ShowModal;
2059 case result of
2060 mrOK : SkinForm.ActivateCurrentSkin;
2061 mrNo : SkinForm.InactivateSkin;
2062 end; {case}
2063 except
2064 on EInvalidOperation do MessageDlg('Error1',mtInformation,[mbOK],0);
2065 else MessageDlg('Error Applying Skin. Please try another Skin.',mtInformation,[mbOK],0);
2066 end;
2067 end;
2068
2069 procedure TMainForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string);
2070 begin
2071 ORComboBox.Items.Clear;
2072 ORComboBox.Text := initValue;
2073 ORComboBox.InitLongList(initValue);
2074 if ORComboBox.Items.Count > 0 then begin
2075 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
2076 end else begin
2077 ORComboBox.Text := '<Start Typing to Search>';
2078 end;
2079 end;
2080
2081
2082 procedure TMainForm.btnPatientApplyClick(Sender: TObject); //Added elh 8/15/08
2083 begin
2084 PostVisibleGrid;
2085 InitORCombobox(PatientORComboBox,'A');
2086 end;
2087
2088 procedure TMainForm.btnPatientRevertClick(Sender: TObject); //Added elh 8/15/08
2089 //var tempInfo : TGridInfo;
2090 begin
2091 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
2092 {
2093 tempInfo := GetInfoForGrid(AdvancedUsersGrid);
2094 LoadAnyGridFromInfo(tempInfo);
2095
2096 tempInfo := GetInfoForGrid(BasicUsersGrid);
2097 LoadAnyGridFromInfo(tempInfo);
2098
2099 tempInfo.ApplyBtn.Enabled := false;
2100 tempInfo.RevertBtn.Enabled := false;
2101 }
2102 end;
2103
2104 procedure TMainForm.BasicPatientGridClick(Sender: TObject); //Added elh 8/15/08
2105 begin
2106 btnPatientRevert.Enabled := true;
2107 btnPatientApply.Enabled := true;
2108 end;
2109
2110 Procedure TMainForm.GetBlankFileInfo(FileNum : string; BlankList : TStringList);
2111 var RPCResult: string;
2112 //Returned format for BlankList is:
2113 //FileNum^^FieldNum^^FieldName^More DDInfo
2114 //FileNum^^FieldNum^^FieldName^More DDInfo
2115 begin
2116 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2117 RPCBrokerV.Param[0].Value := '.X'; // not used
2118 RPCBrokerV.param[0].ptype := list;
2119 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET EMPTY ENTRY^' + FileNum;
2120 RPCBrokerV.Call;
2121 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2122 //Return Format is: FileNum^^FieldNum^^DDInfo...
2123 if piece(RPCResult,'^',1)='-1' then begin
2124 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2125 FMErrorForm.PrepMessage;
2126 FMErrorForm.ShowModal;
2127 end else begin
2128 BlankList.Assign(RPCBrokerV.Results);
2129 end;
2130 end;
2131
2132
2133 procedure TMainForm.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
2134 var cmd,RPCResult : string;
2135 i : integer;
2136 oneEntry : string;
2137 begin
2138 Data.Clear;
2139 if (IENS='') then exit;
2140 if Pos('+',IENS)=0 then begin //don't ask server to load +1 records.
2141 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2142 RPCBrokerV.Param[0].Value := '.X'; // not used
2143 RPCBrokerV.param[0].ptype := list;
2144 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
2145 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
2146 RPCBrokerV.Call;
2147 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2148 if piece(RPCResult,'^',1)='-1' then begin
2149 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2150 FMErrorForm.PrepMessage;
2151 FMErrorForm.ShowModal;
2152 end else begin
2153 Data.Assign(RPCBrokerV.Results);
2154 end;
2155 end else begin
2156 Data.Add('1^Success'); //to keep same as call to server
2157 if BlankFileInfo.Count = 0 then begin
2158 //Format is: FileNum^^FieldNum^^DDInfo...
2159 GetBlankFileInfo(FileNum,BlankFileInfo);
2160 end;
2161 for i := 1 to BlankFileInfo.Count-1 do begin //0 is 1^success
2162 oneEntry := BlankFileInfo.Strings[i];
2163 SetPiece(oneEntry,'^',2,IENS);
2164 Data.Add(oneEntry);
[542]2165 end;
[476]2166 end;
2167 end;
[542]2168
2169
[476]2170 procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
2171 begin
2172 if E.Message <> 'Cannot focus a disabled or invisible window' then begin
2173 ShowException(E,nil);
2174 end;
2175 end;
2176
2177
2178 procedure TMainForm.btnSettingsRevertClick(Sender: TObject);
2179 //var tempInfo : TGridInfo;
2180 begin
2181 DoRevert(BasicSettingsGrid,AdvancedSettingsGrid);
2182 {
2183 tempInfo := GetInfoForGrid(BasicSettingsGrid);
2184 LoadAnyGridFromInfo(tempInfo);
2185
2186 tempInfo := GetInfoForGrid(AdvancedSettingsGrid);
2187 LoadAnyGridFromInfo(tempInfo);
2188
2189 tempInfo.ApplyBtn.Enabled := false;
2190 tempInfo.RevertBtn.Enabled := false;
2191 }
2192 end;
2193
2194
2195 procedure TMainForm.DoRevert(BasicGrid,AdvancedGrid : TStringGrid);
2196 //BasicGrid doesn't have to be supplied. Can be nil value.
2197 //AdvancedGrid is required.
2198 var tempInfo : TGridInfo;
2199 begin
2200 tempInfo := GetInfoForGrid(AdvancedGrid);
2201 LoadAnyGridFromInfo(tempInfo);
2202 tempInfo.ApplyBtn.Enabled := false;
2203 tempInfo.RevertBtn.Enabled := false;
2204
2205 if BasicGrid <> nil then begin
2206 tempInfo := GetInfoForGrid(BasicGrid);
2207 LoadAnyGridFromInfo(tempInfo);
2208 end;
2209 end;
2210
2211
2212 procedure TMainForm.btnSettingsApplyClick(Sender: TObject);
2213 begin
2214 PostVisibleGrid;
2215 end;
2216
[542]2217
2218
[476]2219end.
2220
Note: See TracBrowser for help on using the repository browser.