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