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

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

Sortable grids, fixed hint-bug
File size: 82.1 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
[828]39 ValEdit, SortStringGrid;
[476]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
[828]51 TGridDataLoader = procedure (GridInfo: TGridInfo) of object;
[476]52 TGridInfo = class (TObject)
53 public
[828]54 Grid : TSortStringGrid; //doesn't own object
[476]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;
[828]63 end;
[476]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;
[828]81 AdvancedUsersGrid: TSortStringGrid;
82 BasicUsersGrid: TSortStringGrid;
[476]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;
[828]94 BasicSettingsGrid: TSortStringGrid;
[476]95 tsAdvancedSettings: TTabSheet;
[828]96 AdvancedSettingsGrid: TSortStringGrid;
[476]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;
[828]110 BasicPatientGrid: TSortStringGrid;
[476]111 tsAdvancedPatients: TTabSheet;
[828]112 AdvancedPatientGrid: TSortStringGrid;
[476]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;
[828]126 AnyFileGrid: TSortStringGrid;
[476]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;
[828]216 function GetVisibleGrid: TSortStringGrid;
[476]217 function GetVisibleGridInfo : TGridInfo;
[828]218 function GetInfoForGrid(Grid : TSortStringGrid) : TGridInfo;
219 function GetInfoIndexForGrid(Grid : TSortStringGrid) : integer;
220 procedure SetVisibleGridIdx(Grid : TSortStringGrid);
[476]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;
[828]238 procedure CompileChanges(Grid : TSortStringGrid; CurrentUserData,Changes : TStringList);
239 function PostChanges(Grid : TSortStringGrid) : TModalResult;
[476]240 function PostVisibleGrid: TModalResult;
[828]241 procedure LoadAnyGrid(Grid : TSortStringGrid; BasicMode: boolean; FileNum,IENS : string; CurrentData : TStringList);
[476]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;
[828]246 function GetGridHint(Grid : TSortStringGrid; FileNum : string; ACol, ARow : integer) : string;
247 function FieldHelp(FileNum, IENS, FieldNum, HelpStyle : string) : string;
248 procedure DoRevert(BasicGrid,AdvancedGrid : TSortStringGrid);
[476]249 public
250 { Public declarations }
251 CurrentUserName: string;
252 LastSelTreeNode : TTreeNode;
[488]253 DebugMode : boolean;
[828]254 function GetUserLine(CurrentUserData : TStringList; Grid : TSortStringGrid; ARow:integer) :integer;
255 function GetLineInfo(Grid : TSortStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
[476]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);
[828]263 procedure AddGridInfo(Grid: TSortStringGrid; Data : TStringList; BasicMode : boolean;
[476]264 DataLoader : TGridDataLoader; FileNum : string;
265 ApplyBtn,RevertBtn : TButton);
266 procedure LoadAnyGridFromInfo(GridInfo : TGridInfo);
[828]267 procedure ClearGrid(Grid : TSortStringGrid);
[476]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
[828]400 procedure TMainForm.AddGridInfo(Grid: TSortStringGrid;
[476]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
[828]1038 procedure TMainForm.ClearGrid(Grid : TSortStringGrid);
[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
[828]1050 procedure TMainForm.LoadAnyGrid(Grid : TSortStringGrid; //the TSortStringGrid to load
[476]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
[828]1079 Grid : TSortStringGrid; //the TSortStringGrid to load
[476]1080 BasicMode: boolean;
1081 FileNum : string;
1082 IENS : string;
1083 CurrentData : TStringList;
1084
[828]1085 procedure LoadOneLine (Grid : TSortStringGrid; oneEntry : string; GridRow : integer);
[476]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;
[828]1210 Grid : TSortStringGrid;
[476]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...
[828]1218 Grid := (Sender as TSortStringGrid);
[476]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
[828]1303 function TMainForm.GetLineInfo(Grid : TSortStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
[476]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
[828]1329 function TMainForm.GetUserLine(CurrentUserData : TStringList; Grid : TSortStringGrid; ARow: integer) : integer;
[476]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
[828]1431 function TMainForm.GetVisibleGrid: TSortStringGrid;
[476]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
[828]1440 function TMainForm.GetInfoForGrid(Grid : TSortStringGrid) : TGridInfo;
[476]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
[828]1452 function TMainForm.GetInfoIndexForGrid(Grid : TSortStringGrid) : integer;
[476]1453 var s : string;
1454 begin
1455 s := IntToStr(integer(Grid));
1456 result := DataForGrid.IndexOf(s);
1457 end;
1458
[828]1459 procedure TMainForm.SetVisibleGridIdx(Grid : TSortStringGrid);
[476]1460 begin
1461 FVisibleGridIdx := GetInfoIndexForGrid(Grid);
1462 end;
[542]1463
1464
[828]1465 procedure TMainForm.CompileChanges(Grid : TSortStringGrid; CurrentUserData,Changes : TStringList);
[476]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);
[828]1481 //Reject any value containing a "^"
[542]1482 //Do we need an @ here as well?
[828]1483 if AnsiPos('^',Entry.newvalue) > 0 then begin //or (AnsiPos(':',Entry.newvalue) > 0) or (AnsiPos(';',Entry.newvalue) > 0) //elh Taken out because : used in time
[542]1484 messagedlg('Invalid value entered for ' + Entry.Fieldname + #13 + #10
1485 + #13 + #10 + 'Invalid Entry: ' + Entry.newvalue + #13 + #10 +
1486 'Ignoring Value.',mtError,[mbOK],0);
1487 end else begin
1488 if Entry.oldValue <> Entry.newValue then begin
1489 if (Entry.newValue <> CLICK_FOR_SUBS) and
1490 (Entry.newValue <> COMPUTED_FIELD) and
1491 (Entry.newValue <> CLICK_TO_EDIT) then begin
1492 oneEntry := Entry.FileNum + '^' + Entry.IENS + '^' + Entry.Field + '^' + Entry.FieldName;
1493 //Test to see if change is an AV Code (2 or 11) or ES Code (20.4) in User File (200)
1494 //If so, make it uppercase. 8/12/09 elh
1495 if Entry.FileNum = '200' then begin
1496 if ((Entry.Field = '2') and (UCaseOnly = true)) or
1497 ((Entry.Field = '11') and (UCaseOnly = true)) or
1498 ((Entry.Field = '20.4') and (UCaseOnly = true)) then begin
1499 messagedlg('Converting ' + Entry.Fieldname + ' to uppercase for VistA interactivity.' +#13 +#10 +
1500 #13 +#10 +
1501 'Old Value: ' + Entry.newvalue + ' ' + 'New Value: ' + Uppercase(Entry.newvalue),
1502 mtinformation,[mbOK],0);
1503 Entry.newValue := Uppercase(Entry.newValue);
1504 end;
1505 end;
1506 oneEntry := oneEntry + '^' + Entry.newValue + '^' + Entry.oldValue;
1507 Changes.Add(oneEntry);
1508 end;
1509 end;
[476]1510 end;
1511 end;
1512 end;
1513
[542]1514
[828]1515 function TMainForm.PostChanges(Grid : TSortStringGrid) : TModalResult;
[476]1516 //Results: mrNone -- no post done (not needed)
1517 // mrCancel -- user pressed cancel on confirmation screen.
1518 // mrNo -- signals posting error.
1519 var Changes : TStringList;
1520 PostResult : TModalResult;
1521 CurrentData : TStringList;
1522 GridInfo : TGridInfo;
1523 IENS : string;
1524 begin
1525 Result := mrNone; //default to No changes
1526 GridInfo := GetInfoForGrid(Grid);
1527 if GridInfo=nil then exit;
1528 CurrentData := GridInfo.Data;
1529 if CurrentData=nil then exit;
1530 if CurrentData.Count = 0 then exit;
1531 IENS := GridInfo.IENS;
1532 if IENS='' then exit;
1533 Changes := TStringList.Create;
1534 CompileChanges(Grid,CurrentData,Changes);
1535 if Changes.Count>0 then begin
1536 PostForm.PrepForm(Changes);
1537 PostResult := PostForm.ShowModal;
1538 if PostResult = mrOK then begin
1539 if DisuserChanged(Changes) then begin //looks for change in file 200, field 4
1540 InitializeUsersTreeView;
1541 end else begin
1542 if Pos('+',IENS)>0 then begin
1543 GridInfo.IENS := PostForm.GetNewIENS(IENS);
1544 end;
1545 if assigned(GridInfo.DataLoadProc) then begin
1546 GridInfo.DataLoadProc(GridInfo);
1547 end;
1548 {
1549 if CurrentData = CurrentUserData then begin
1550 LoadUserData(IENS,CurrentData); //reload record from server.
1551 end else if CurrentData = CurrentSettingsData then begin
1552 GetSettingsInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1553 end else if CurrentData = CurrentPatientData then begin
1554 GetPatientInfo(GridInfo.IENS, CurrentData);
1555 end else if CurrentData = CurrentAnyFileData then begin
1556 GetAnyFileInfo(GridInfo.FileNum, GridInfo.IENS, CurrentData);
1557 end;
1558 }
1559 end;
1560 end else if PostResult = mrNo then begin //mrNo is signal of post Error
1561 // show error...
1562 end;
1563 Result := PostResult;
1564 end else begin
1565 Result := mrNone;
1566 end;
1567 Changes.Free;
1568 end;
1569
1570 function TMainForm.DisuserChanged(Changes: TStringList) : boolean;
1571 var i : integer;
1572 //Changes format:
1573 // FileNum^IENS^FieldNum^FieldName^newValue^oldValue
1574 begin
1575 result := false;
1576 for i := 0 to Changes.Count-1 do begin
1577 if piece(Changes.Strings[i],'^',1)<> '200' then continue;
1578 if piece(Changes.Strings[i],'^',4)<> 'DISUSER' then continue;
1579 result := true;
1580 break;
1581 end;
1582 end;
1583
1584
1585 procedure TMainForm.btnUsersApplyClick(Sender: TObject);
1586 var result : TModalResult;
1587 begin
1588 result:= PostVisibleGrid;
1589 if result <> mrNone then InitializeUsersTreeView;
1590 end;
1591
1592 procedure TMainForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1593 begin
1594 btnUsersRevert.Enabled := true;
1595 btnUsersApply.Enabled := true;
1596 end;
1597
1598 procedure TMainForm.BasicSettingsGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
1599 begin
1600 btnSettingsRevert.Enabled := true;
1601 btnSettingsApply.Enabled := true;
1602 end;
1603
1604
1605 procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
1606 begin
1607 PostVisibleGrid;
1608 RPCBrokerV.Connected := false; //disconnect
1609 end;
1610
[488]1611 procedure TMainForm.ExitMenuItemClick(Sender: TObject);
[476]1612 begin
1613 Close;
1614 end;
1615
1616 procedure TMainForm.UserPageControlDrawTab(Control: TCustomTabControl;
1617 TabIndex: Integer;
1618 const Rect: TRect;
1619 Active: Boolean);
1620 begin
1621 DrawTab(Control,TabIndex,Rect,Active);
1622 end;
1623
1624 procedure TMainForm.DrawTab(Control: TCustomTabControl;
1625 TabIndex: Integer;
1626 const Rect: TRect;
1627 Active: Boolean);
1628 var
1629 oRect : TRect;
1630 sCaption,temp : String;
1631 iTop : Integer;
1632 iLeft : Integer;
1633 i : integer;
1634
1635 begin
1636 oRect := Rect;
1637 temp := TPageControl(Control).Pages[TabIndex].Caption;
1638 for i := 1 to length(temp) do begin
1639 if temp[i] <> '&' then sCaption := sCaption + temp[i];
1640 end;
1641
1642 iTop := Rect.Top + ((Rect.Bottom - Rect.Top - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
1643 iLeft := Rect.Left + ((Rect.Right - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
1644
1645 if Active then begin
1646 Control.Canvas.Brush.Color := TColor($0000FFFF); //Bright yellow
1647 Control.Canvas.FillRect(Rect);
1648// Frame3d(Control.Canvas,oRect,clBtnHighLight,clBtnShadow,3);
1649
1650 end else begin
1651 Control.Canvas.Brush.Color := TColor($000079EFE8); //dull yellow
1652 Control.Canvas.FillRect(Rect);
1653 end;
1654 Control.Canvas.TextOut(iLeft,iTop,sCaption);
1655 end;
1656
1657
1658 procedure TMainForm.AboutMenuClick(Sender: TObject);
1659 begin
1660 AboutForm.show;
1661 end;
1662
1663 procedure TMainForm.CloneBtnClick(Sender: TObject);
1664 var IEN : longInt;
1665 newName : string;
1666 IENS,newIENS : string;
1667
1668 begin
1669 if btnUsersApply.Enabled then btnUsersApplyClick(self); //post any changes first.
1670 if MessageDlg('Clone user: '+LastSelTreeNode.Text+' --> New user?' + #10 + #13 +
1671 'Note: This can not be undone.',
1672 mtConfirmation, mbOKCancel,0) = mrCancel then exit;
1673 IEN := longInt(LastSelTreeNode.Data);
1674 IENS := IntToStr(IEN) + ',';
1675 WaitForm.Show;
1676 newName := 'TEMP,MUST-EDIT';
1677 newIENS := DoCloneUser(IENS,newName);
1678 InitializeUsersTreeView; //refresh UsersTreeView.
1679 WaitForm.Hide;
1680 MessageDlg('A new cloned user has been created,' + #10 + #13 +
1681 'named: ' + newName + #10 + #13 +
1682 #10 + #13 +
1683 'This user can be found in the ''Inactive users'' list,' + #10 + #13 +
1684 'but must must be edited before it may be used.' + #10 + #13 +
1685 'Edit it''s DISUSER field to a value of ''NO''' + #10 + #13 +
1686 'to activate.',mtInformation,[mbOK],0);
1687 end;
1688
1689
1690 function TMainForm.DoCloneRecord(FileNum, SourceIENS, New01Field : String) : string;
1691 //Returns IENS of new record in FileNum, or '' if error
1692 var cmd,RPCResult : string;
1693 begin
1694 Result := '';
1695 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1696 RPCBrokerV.param[0].ptype := list;
1697 cmd := 'CLONE RECORD' + '^' + FileNum + '^' + SourceIENS + '^' + New01Field;
1698 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1699 RPCBrokerV.Call;
1700 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1701 if piece(RPCResult,'^',1)='-1' then begin
1702 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1703 FMErrorForm.PrepMessage;
1704 FMErrorForm.ShowModal;
1705 end else begin
1706 result := piece(RPCResult,'^',3);
1707 end;
1708 end;
1709
1710 function TMainForm.DoCloneUser(SourceIENS, New01Field : String) : string;
1711 //Returns IENS of new record in FileNum, or '' if error
1712 var cmd,RPCResult : string;
1713 begin
1714 Result := '';
1715 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1716 RPCBrokerV.param[0].ptype := list;
1717 cmd := 'CLONE USER' + '^' + SourceIENS + '^' + New01Field;
1718 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1719 RPCBrokerV.Call;
1720 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1^ShortMsg; success=1^Success^NewIENS
1721 if piece(RPCResult,'^',1)='-1' then begin
1722 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1723 FMErrorForm.PrepMessage;
1724 FMErrorForm.ShowModal;
1725 end else begin
1726 result := piece(RPCResult,'^',3);
1727 end;
1728 end;
1729
[828]1730 function TMainForm.FieldHelp(FileNum, IENS, FieldNum, HelpStyle : string) : string;
[476]1731 var
1732 RPCResult: string;
1733 cmd : string;
1734 SrchStr : string;
1735 Idx : integer;
1736 begin
1737 Result := '';
[828]1738 SrchStr := FileNum + '^' + FieldNum + '^' + HelpStyle + '^' + IENS;
[476]1739 Idx := CachedHelpIdx.IndexOf(SrchStr);
[542]1740 if Idx = -1 then begin
[476]1741 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1742 RPCBrokerV.param[0].ptype := list;
1743 cmd := 'GET HELP MSG^' + SrchStr;
1744 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1745 RPCBrokerV.Call;
1746 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1747 if piece(RPCResult,'^',1)='-1' then begin
1748 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1749 FMErrorForm.PrepMessage;
1750 FMErrorForm.ShowModal;
1751 end else begin
1752 RPCBrokerV.Results.Delete(0);
[542]1753 if RPCBrokerV.Results.Count > 0 then begin
1754 if RPCBrokerV.Results.Strings[RPCBrokerV.Results.Count-1]='' then begin
1755 RPCBrokerV.Results.Delete(RPCBrokerV.Results.Count-1);
1756 end;
[476]1757 end;
[542]1758 result := RPCBrokerV.Results.Text;
1759 if result = '' then result := ' ';
[476]1760 //Maybe later replace text with "Enter F1 for more help."
[542]1761 Result := AnsiReplaceText(Result,'Enter ''??'' for more help.','');
[476]1762 while Result[Length(Result)] in [#10,#13] do begin
1763 Result := AnsiLeftStr(Result,Length(Result)-1);
1764 end;
1765 Idx := CachedHelp.Add(result);
1766 CachedHelpIdx.AddObject(SrchStr,Pointer(Idx)); //Store index here to help stored in CachedHelp
1767 end;
1768 end else begin
1769 Idx := Integer(CachedHelpIdx.Objects[Idx]);
1770 if (Idx >= 0) and (Idx < CachedHelp.Count) then begin
1771 result := CachedHelp.Strings[Idx];
1772 end;
1773 end;
1774 end;
1775
[828]1776 function TMainForm.GetGridHint(Grid : TSortStringGrid; FileNum : string; ACol, ARow : integer) : string;
[476]1777 var fieldNum : string;
[828]1778 GridInfo : TGridInfo;
[476]1779 begin
1780 Result := '';
1781 //Result := 'Row=' + IntToStr(ARow) + ', Col='+ IntToStr(ACol);
1782 if ARow > Grid.RowCount-1 then exit;
[828]1783 if (ARow < 1) or (ACol < 0) then exit;
[476]1784 if ACol=0 then begin
[828]1785 Result := 'This is the database field NUMBER';
[476]1786 end else if ACol=1 then begin
[828]1787 Result := 'This is the database field NAME';
[476]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
[828]1799 GridInfo := GetInfoForGrid(Grid);
1800 Result := FieldHelp(FileNum, GridInfo.IENS, fieldNum, '?');
1801 end;
[476]1802 end;
1803 end;
1804
1805
1806 procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
1807 begin
1808 end; (*ApplicationIdle*)
1809
1810
1811 procedure TMainForm.ApplicationEventsShowHint(var HintStr: String;
1812 var CanShow: Boolean;
1813 var HintInfo: THintInfo);
1814 var
1815 Pos : TPoint;
1816 Handle : Hwnd;
1817 ItemBuffer : array[0..256] of Char;
1818 ClassName : AnsiString;
1819 ACol,ARow : integer;
1820 VisibleGridInfo : TGridInfo;
1821 begin
1822 CanShow := true;
1823 //Label2.Caption := HintStr;
1824 Pos := Mouse.CursorPos;
1825 Handle := WindowFromPoint(Pos);
1826 if Handle = 0 then Exit;
1827 GetClassName(Handle, ItemBuffer, SizeOf(ItemBuffer));
1828 ClassName := ItemBuffer;
1829 Windows.ScreenToClient(Handle, Pos);
1830 VisibleGridInfo := GetVisibleGridInfo;
1831 if VisibleGridInfo = nil then exit;
1832 if VisibleGridInfo.Grid = nil then exit;
[828]1833 if (ClassName='TSortStringGrid') then begin
[476]1834 VisibleGridInfo.Grid.MouseToCell(Pos.X,Pos.Y,ACol,ARow);
1835 HintInfo.HintStr := GetGridHint(VisibleGridInfo.Grid,VisibleGridInfo.FileNum,ACol, ARow);
1836 if HintInfo.HintStr = '' then CanShow := False;
1837 HintInfo.HideTimeout := 1000;
1838 HintInfo.ReshowTimeout := 2000;
1839 HintInfo.HintMaxWidth:= 300; //hint box width.
1840 end;
1841
1842 end;
1843
1844 procedure TMainForm.PageControlChanging(Sender: TObject; var AllowChange: Boolean);
1845 begin
1846 AllowChange := (PostVisibleGrid <> mrNO);
1847 if AllowChange then begin
1848 LastSelTreeNode := nil;
1849 end;
1850 end;
1851
1852 procedure TMainForm.PatientORComboBoxNeedData(Sender: TObject;
1853 const StartFrom: String; Direction, InsertAt: Integer);
1854 var
1855 Result : TStrings;
1856 begin
1857 Result := FieldLookUpForm.SubSetOfFile('2', StartFrom, Direction);
1858 TORComboBox(Sender).ForDataUse(Result);
1859 end;
1860
1861
1862 procedure TMainForm.PageControlChange(Sender: TObject);
1863 begin
1864 if (PageControl.ActivePage = tsUsers) then begin
1865 UserPageControlChange(nil);
1866 end else if (PageControl.ActivePage = tsSettings) then begin
1867 SettingsPageControlChange(nil);
1868 end else if (PageControl.ActivePage = tsPatients) then begin
1869 PatientsPageControlChange(nil);
1870 end else if (PageControl.ActivePage = tsAdvanced) then begin
1871 SetVisibleGridIdx(AnyFileGrid);
1872 end;
1873
1874 end;
1875
1876 procedure TMainForm.PatientORComboBoxClick(Sender: TObject);
1877 var IEN : longInt;
1878 ModalResult : TModalResult;
1879 GridInfo : TGridInfo;
1880 begin
1881 ModalResult := PostVisibleGrid;
1882 if ModalResult = mrNo then exit;
1883 IEN := PatientORComboBox.ItemIEN; //get info from selected patient
1884 if IEN = 0 then exit;
1885 GridInfo := GetInfoForGrid(BasicPatientGrid);
1886 if GridInfo = nil then exit;
1887 GridInfo.IENS := IntToStr(IEN)+',';
1888 GetPatientInfo(GridInfo);
1889 end;
1890
1891 procedure TMainForm.PatientsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1892 begin
1893 AllowChange := (PostVisibleGrid <> mrNO);
1894 end;
1895
1896 procedure TMainForm.PatientsPageControlChange(Sender: TObject);
1897 begin
1898 if PatientsPageControl.ActivePage = tsBasicPatients then begin
1899 SetVisibleGridIdx(BasicPatientGrid);
1900 end else begin
1901 SetVisibleGridIdx(AdvancedPatientGrid);
1902 end;
1903 end;
1904
1905
1906 procedure TMainForm.UserPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1907 var result : TModalResult;
1908 begin
1909 result := PostVisibleGrid;
1910 AllowChange := (result <> mrNO);
1911 if (result <> mrNone) then begin
1912 InitializeUsersTreeView;
1913 end;
1914 end;
1915
1916 procedure TMainForm.UserPageControlChange(Sender: TObject);
1917 begin
[756]1918 if UserPageControl.ActivePage = tsBasicPage then begin
1919 SetVisibleGridIdx(BasicUsersGrid);
[476]1920 end else begin
1921 SetVisibleGridIdx(AdvancedUsersGrid);
1922 end;
1923 end;
1924
1925
1926 procedure TMainForm.SettingsPageControlChanging(Sender: TObject; var AllowChange: Boolean);
1927 begin
1928 AllowChange := (PostVisibleGrid <> mrNO);
1929 end;
1930
1931 procedure TMainForm.SettingsPageControlChange(Sender: TObject);
1932 begin
1933 if SettingsPageControl.ActivePage = tsBasicSettings then begin
1934 SetVisibleGridIdx(BasicSettingsGrid);
1935 end else begin
1936 SetVisibleGridIdx(AdvancedSettingsGrid);
1937 end;
1938 end;
1939
1940 procedure TMainForm.FileORComboBoxClick(Sender: TObject);
1941 begin
1942 PostVisibleGrid;
1943 InitORCombobox(RecordORComboBox,'');
1944 ClearGrid(GetVisibleGrid);
1945 end;
1946
1947 procedure TMainForm.FileORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1948 var Result : TStrings;
1949 begin
1950 Result := FieldLookUpForm.SubSetOfFile('1', StartFrom, Direction);
1951 TORComboBox(Sender).ForDataUse(Result);
1952 end;
1953
1954
1955 procedure TMainForm.RecordORComboBoxNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
1956 var Result : TStrings;
1957 FileNum : string;
1958 begin
1959 FileNum := FileORComboBox.ItemID;
1960 Result := FieldLookUpForm.SubSetOfFile(FileNum, StartFrom, Direction);
1961 TORComboBox(Sender).ForDataUse(Result);
1962 end;
1963
1964 procedure TMainForm.RecordORComboBoxClick(Sender: TObject);
1965 var ModalResult : TModalResult;
1966 IEN : LongInt;
1967 FileNum : String;
1968 GridInfo : TGridInfo;
1969 begin
1970 ModalResult := PostVisibleGrid;
1971 if ModalResult = mrNo then exit;
[828]1972 FileNum := FileORComboBox.ItemID;
[476]1973 IEN := RecordORComboBox.ItemID; //get info from selected record
1974 if IEN=0 then exit;
1975 GridInfo := GetInfoForGrid(AnyFileGrid);
1976 if GridInfo = nil then exit;
1977 GridInfo.IENS := IntToStr(IEN) + ',';
1978 GridInfo.FileNum := FileNum;
1979 GetAnyfileInfo(GridInfo);
1980 //GetAnyfileInfo(FileNum,IntToStr(IEN)+',',CurrentAnyFileData);
1981 end;
1982
1983 procedure TMainForm.btnAddAnyRecordClick(Sender: TObject);
1984 var IENS, FileNum : string;
1985 BlankFileInfo : TStringList;
1986 begin
1987 BlankFileInfo := Tstringlist.Create;
1988 btnAdvancedRevert.Enabled := True;
1989 btnAdvancedApply.Enabled := True;
1990 FileNum := FileORComboBox.ItemID;
1991 IENS := '+1,';
1992 GetOneRecord(FileNum,IENS,CurrentAnyFileData, BlankFileInfo);
1993
1994 LoadAnyGridFromInfo(GetInfoForGrid(AnyFileGrid));
1995 BlankFileInfo.Free;
1996 end;
1997
1998 procedure TMainForm.AddBtnClick(Sender: TObject);
1999 var IENS : string;
2000 BlankFileInfo : TStringList;
2001 GridInfo : TGridInfo;
2002 begin
2003 BlankFileInfo := Tstringlist.Create;
2004 btnPatientRevert.Enabled := True;
2005 btnPatientApply.Enabled := True;
2006 GridInfo := GetVisibleGridInfo;
2007 IENS := '+1,';
2008 GetOneRecord(GridInfo.FileNum, IENS, GridInfo.Data, BlankFileInfo);
2009 GridInfo.IENS := IENS;
2010 LoadAnyGridFromInfo(GridInfo); //load Basic or Advanced Grid
2011 if GridInfo.Grid = BasicPatientGrid then begin
2012 GridInfo := GetInfoForGrid(AdvancedPatientGrid)
2013 end else begin //Advanced grid is visible.
2014 GridInfo := GetInfoForGrid(BasicPatientGrid)
2015 end;
2016 GridInfo.IENS := IENS;
2017 LoadAnyGridFromInfo(GridInfo); // Load OTHER grid, Advanced or Basic grid.
2018 BlankFileInfo.Free;
2019 end;
2020
2021 procedure TMainForm.btnAdvancedApplyClick(Sender: TObject);
2022 begin
2023 PostVisibleGrid;
2024 end;
2025
2026 procedure TMainForm.btnAdvancedRevertClick(Sender: TObject);
2027 //var tempInfo: TGridInfo;
2028 begin
2029 DoRevert(nil,AnyFileGrid);
2030 {
2031 tempInfo := GetInfoForGrid(AnyFileGrid);
2032 LoadAnyGridFromInfo(tempInfo);
2033 tempInfo.ApplyBtn.Enabled := false;
2034 tempInfo.RevertBtn.Enabled := false;
2035 }
2036 end;
2037
2038 procedure TMainForm.AnyFileGridClick(Sender: TObject);
2039 begin
2040 btnAdvancedApply.Enabled := True;
2041 btnAdvancedRevert.Enabled := True;
2042 end;
2043
2044 procedure TMainForm.btnBatchAddClick(Sender: TObject);
2045 begin
2046 BatchAddForm.ShowModal;
2047 InitORCombobox(PatientORComboBox,'A');
2048 end;
2049
[488]2050 procedure TMainForm.ShowDebugClick(Sender: TObject);
2051 begin
2052 DebugForm.Show;
2053 end;
2054
[476]2055 procedure TMainForm.ChangeSkinClick(Sender: TObject);
2056 var result : TModalResult;
2057 begin
2058 try
2059 result := SkinForm.ShowModal;
2060 case result of
2061 mrOK : SkinForm.ActivateCurrentSkin;
2062 mrNo : SkinForm.InactivateSkin;
2063 end; {case}
2064 except
2065 on EInvalidOperation do MessageDlg('Error1',mtInformation,[mbOK],0);
2066 else MessageDlg('Error Applying Skin. Please try another Skin.',mtInformation,[mbOK],0);
2067 end;
2068 end;
2069
2070 procedure TMainForm.InitORComboBox(ORComboBox: TORComboBox; initValue : string);
2071 begin
2072 ORComboBox.Items.Clear;
2073 ORComboBox.Text := initValue;
2074 ORComboBox.InitLongList(initValue);
2075 if ORComboBox.Items.Count > 0 then begin
2076 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
2077 end else begin
2078 ORComboBox.Text := '<Start Typing to Search>';
2079 end;
2080 end;
2081
2082
2083 procedure TMainForm.btnPatientApplyClick(Sender: TObject); //Added elh 8/15/08
2084 begin
2085 PostVisibleGrid;
2086 InitORCombobox(PatientORComboBox,'A');
2087 end;
2088
2089 procedure TMainForm.btnPatientRevertClick(Sender: TObject); //Added elh 8/15/08
2090 //var tempInfo : TGridInfo;
2091 begin
2092 DoRevert(BasicUsersGrid,AdvancedUsersGrid);
2093 {
2094 tempInfo := GetInfoForGrid(AdvancedUsersGrid);
2095 LoadAnyGridFromInfo(tempInfo);
2096
2097 tempInfo := GetInfoForGrid(BasicUsersGrid);
2098 LoadAnyGridFromInfo(tempInfo);
2099
2100 tempInfo.ApplyBtn.Enabled := false;
2101 tempInfo.RevertBtn.Enabled := false;
2102 }
2103 end;
2104
2105 procedure TMainForm.BasicPatientGridClick(Sender: TObject); //Added elh 8/15/08
2106 begin
2107 btnPatientRevert.Enabled := true;
2108 btnPatientApply.Enabled := true;
2109 end;
2110
2111 Procedure TMainForm.GetBlankFileInfo(FileNum : string; BlankList : TStringList);
2112 var RPCResult: string;
2113 //Returned format for BlankList is:
2114 //FileNum^^FieldNum^^FieldName^More DDInfo
2115 //FileNum^^FieldNum^^FieldName^More DDInfo
2116 begin
2117 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2118 RPCBrokerV.Param[0].Value := '.X'; // not used
2119 RPCBrokerV.param[0].ptype := list;
2120 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'GET EMPTY ENTRY^' + FileNum;
2121 RPCBrokerV.Call;
2122 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2123 //Return Format is: FileNum^^FieldNum^^DDInfo...
2124 if piece(RPCResult,'^',1)='-1' then begin
2125 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2126 FMErrorForm.PrepMessage;
2127 FMErrorForm.ShowModal;
2128 end else begin
2129 BlankList.Assign(RPCBrokerV.Results);
2130 end;
2131 end;
2132
2133
2134 procedure TMainForm.GetOneRecord(FileNum, IENS : string; Data, BlankFileInfo: TStringList);
2135 var cmd,RPCResult : string;
2136 i : integer;
2137 oneEntry : string;
2138 begin
2139 Data.Clear;
2140 if (IENS='') then exit;
2141 if Pos('+',IENS)=0 then begin //don't ask server to load +1 records.
2142 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
2143 RPCBrokerV.Param[0].Value := '.X'; // not used
2144 RPCBrokerV.param[0].ptype := list;
2145 cmd := 'GET ONE RECORD^' + FileNum + '^' + IENS;
2146 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
2147 RPCBrokerV.Call;
2148 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
2149 if piece(RPCResult,'^',1)='-1' then begin
2150 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
2151 FMErrorForm.PrepMessage;
2152 FMErrorForm.ShowModal;
2153 end else begin
2154 Data.Assign(RPCBrokerV.Results);
2155 end;
2156 end else begin
2157 Data.Add('1^Success'); //to keep same as call to server
2158 if BlankFileInfo.Count = 0 then begin
2159 //Format is: FileNum^^FieldNum^^DDInfo...
2160 GetBlankFileInfo(FileNum,BlankFileInfo);
2161 end;
2162 for i := 1 to BlankFileInfo.Count-1 do begin //0 is 1^success
2163 oneEntry := BlankFileInfo.Strings[i];
2164 SetPiece(oneEntry,'^',2,IENS);
2165 Data.Add(oneEntry);
[542]2166 end;
[476]2167 end;
2168 end;
[542]2169
2170
[476]2171 procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
2172 begin
2173 if E.Message <> 'Cannot focus a disabled or invisible window' then begin
2174 ShowException(E,nil);
2175 end;
2176 end;
2177
2178
2179 procedure TMainForm.btnSettingsRevertClick(Sender: TObject);
2180 //var tempInfo : TGridInfo;
2181 begin
2182 DoRevert(BasicSettingsGrid,AdvancedSettingsGrid);
2183 {
2184 tempInfo := GetInfoForGrid(BasicSettingsGrid);
2185 LoadAnyGridFromInfo(tempInfo);
2186
2187 tempInfo := GetInfoForGrid(AdvancedSettingsGrid);
2188 LoadAnyGridFromInfo(tempInfo);
2189
2190 tempInfo.ApplyBtn.Enabled := false;
2191 tempInfo.RevertBtn.Enabled := false;
2192 }
2193 end;
2194
2195
[828]2196 procedure TMainForm.DoRevert(BasicGrid,AdvancedGrid : TSortStringGrid);
[476]2197 //BasicGrid doesn't have to be supplied. Can be nil value.
2198 //AdvancedGrid is required.
2199 var tempInfo : TGridInfo;
2200 begin
2201 tempInfo := GetInfoForGrid(AdvancedGrid);
2202 LoadAnyGridFromInfo(tempInfo);
2203 tempInfo.ApplyBtn.Enabled := false;
2204 tempInfo.RevertBtn.Enabled := false;
2205
2206 if BasicGrid <> nil then begin
2207 tempInfo := GetInfoForGrid(BasicGrid);
2208 LoadAnyGridFromInfo(tempInfo);
2209 end;
2210 end;
2211
2212
2213 procedure TMainForm.btnSettingsApplyClick(Sender: TObject);
2214 begin
2215 PostVisibleGrid;
2216 end;
2217
[542]2218
2219
[476]2220end.
2221
Note: See TracBrowser for help on using the repository browser.