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

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

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