1 | unit fGraphData;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
7 | Dialogs, StdCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmGraphData = class(TfrmBase508Form)
|
---|
11 | lblCurrent: TLabel;
|
---|
12 | lblInfo: TLabel;
|
---|
13 | lblInfoCurrent: TLabel;
|
---|
14 | lblInfoPersonal: TLabel;
|
---|
15 | lblInfoPublic: TLabel;
|
---|
16 | lblPersonal: TLabel;
|
---|
17 | lblPublic: TLabel;
|
---|
18 | pnlData: TPanel;
|
---|
19 | pnlInfo: TPanel;
|
---|
20 | btnData: TButton;
|
---|
21 | btnRefresh: TButton;
|
---|
22 | btnTesting: TButton;
|
---|
23 | memTesting: TMemo;
|
---|
24 |
|
---|
25 | procedure FormCreate(Sender: TObject);
|
---|
26 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
27 | procedure FormDestroy(Sender: TObject);
|
---|
28 |
|
---|
29 | procedure btnDataClick(Sender: TObject);
|
---|
30 | procedure btnRefreshClick(Sender: TObject);
|
---|
31 | procedure btnTestingClick(Sender: TObject);
|
---|
32 | private
|
---|
33 | procedure ClearMemos;
|
---|
34 | procedure FillMemos;
|
---|
35 | procedure MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
---|
36 | public
|
---|
37 | procedure ClearGtsl;
|
---|
38 | procedure ClearPtData;
|
---|
39 | procedure FreeGtsl;
|
---|
40 | procedure MakeGtsl;
|
---|
41 | procedure MakeUserSettings;
|
---|
42 | procedure MakeGraphActivity;
|
---|
43 |
|
---|
44 | function AllowContextChange(var WhyNot: string): Boolean;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | var
|
---|
48 | frmGraphData: TfrmGraphData;
|
---|
49 | GtslData: TStringList;
|
---|
50 | GtslItems: TStringList;
|
---|
51 | GtslTypes: TStringList;
|
---|
52 | GtslAllTypes: TStringList;
|
---|
53 | GtslAllViews: TStringList;
|
---|
54 | GtslTestSpec: TStringList;
|
---|
55 | GtslDrugClass: TStringList;
|
---|
56 | GtslViews: TStringList;
|
---|
57 | GtslCheck: TStringList;
|
---|
58 | GtslNonNum: TStringList;
|
---|
59 | GtslNonNumDates: TStringList;
|
---|
60 | GtslScratchSwap: TStringList;
|
---|
61 | GtslScratchTemp: TStringList;
|
---|
62 | GtslScratchLab: TStringList;
|
---|
63 | GtslSpec1: TStringList;
|
---|
64 | GtslSpec2: TStringList;
|
---|
65 | GtslSpec3: TStringList;
|
---|
66 | GtslSpec4: TStringList;
|
---|
67 | GtslMultiSpec: TStringList;
|
---|
68 | GtslTempCheck: TStringList;
|
---|
69 | GtslTemp: TStringList;
|
---|
70 | GtslSelCopyTop: TStringList;
|
---|
71 | GtslSelCopyBottom: TStringList;
|
---|
72 | GtslZoomHistoryFloat: TStringList;
|
---|
73 | GtslZoomHistoryReport: TStringList;
|
---|
74 | GtslSelPrevTopFloat: TStringList;
|
---|
75 | GtslSelPrevTopReport: TStringList;
|
---|
76 | GtslSelPrevBottomFloat: TStringList;
|
---|
77 | GtslSelPrevBottomReport: TStringList;
|
---|
78 | GtslViewPersonal: TStringList;
|
---|
79 | GtslViewPublic: TStringList;
|
---|
80 | GtslLabGroup: TStringList;
|
---|
81 |
|
---|
82 | //procedure GraphDataForm; // perhaps use this to create only when displayed??
|
---|
83 |
|
---|
84 | procedure GraphDataOnUser;
|
---|
85 | procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
---|
86 |
|
---|
87 | function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
---|
88 | function GetCurrentSetting: string;
|
---|
89 | function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
---|
90 | function GetGraphStatus: string;
|
---|
91 | function GetOldDFN: string;
|
---|
92 | function GetPersonalSetting: string;
|
---|
93 | function GetPublicSetting: string;
|
---|
94 | function GraphPublicEditor: boolean;
|
---|
95 | function GraphTurboOn: boolean;
|
---|
96 | procedure SetCurrentSetting(aString: string);
|
---|
97 | procedure SetGraphStatus(aString: string);
|
---|
98 | procedure SetOldDFN(aString: string);
|
---|
99 | procedure SetPersonalSetting(aString: string);
|
---|
100 | procedure SetPublicSetting(aString: string);
|
---|
101 |
|
---|
102 | implementation
|
---|
103 |
|
---|
104 | {$R *.dfm}
|
---|
105 |
|
---|
106 | uses
|
---|
107 | uCore, rGraphs, uGraphs;
|
---|
108 |
|
---|
109 | var
|
---|
110 | FGraphActivity: TGraphActivity;
|
---|
111 |
|
---|
112 | {procedure GraphDataForm; // not used - perhaps with separate object for data
|
---|
113 | var
|
---|
114 | frmGraphData: TfrmGraphData;
|
---|
115 | begin
|
---|
116 | frmGraphData := TfrmGraphData.Create(Application);
|
---|
117 | try
|
---|
118 | with frmGraphData do
|
---|
119 | begin
|
---|
120 | ResizeAnchoredFormToFont(frmGraphData);
|
---|
121 | ShowModal;
|
---|
122 | end;
|
---|
123 | finally
|
---|
124 | frmGraphData.Release;
|
---|
125 | end;
|
---|
126 | end;}
|
---|
127 |
|
---|
128 | procedure TfrmGraphData.FormCreate(Sender: TObject);
|
---|
129 | begin // called from fFrame after user signon
|
---|
130 | if GtslData <> nil then
|
---|
131 | exit; // only create one time
|
---|
132 | MakeGraphActivity;
|
---|
133 | MakeUserSettings;
|
---|
134 | MakeGtsl;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | procedure TfrmGraphData.MakeGraphActivity;
|
---|
138 | begin
|
---|
139 | FGraphActivity := TGraphActivity.Create;
|
---|
140 | with FGraphActivity do
|
---|
141 | begin
|
---|
142 | CurrentSetting := '';
|
---|
143 | OldDFN := '';
|
---|
144 | PublicSetting := '';
|
---|
145 | PersonalSetting := '';
|
---|
146 | PublicEditor := false;
|
---|
147 | Status := '';
|
---|
148 | TurboOn := true;
|
---|
149 | Cache := true;
|
---|
150 | end;
|
---|
151 | end;
|
---|
152 |
|
---|
153 | procedure TfrmGraphData.MakeUserSettings;
|
---|
154 | var
|
---|
155 | setting, turbo: string;
|
---|
156 | aList: TStrings;
|
---|
157 | begin
|
---|
158 | aList := TStringList.Create;
|
---|
159 | FastAssign(rpcGetGraphSettings, aList);
|
---|
160 | if aList.Count > 0 then
|
---|
161 | begin
|
---|
162 | setting := aList[0];
|
---|
163 | FGraphActivity.PublicSetting := aList[1];
|
---|
164 | FGraphActivity.Cache := not (Piece(aList[2], '^', 1) = '-1');
|
---|
165 | if length(setting) > 0 then
|
---|
166 | begin // maxselectmax - system max selection limit
|
---|
167 | SetPiece(setting, '|', 8, Piece(FGraphActivity.PublicSetting, '|', 8));
|
---|
168 | turbo := Piece(FGraphActivity.PublicSetting, '|', 6);
|
---|
169 | if (turbo = '0') or (not FGraphActivity.Cache) then // deactivate users if public turbo (6th piece) is off
|
---|
170 | begin
|
---|
171 | SetPiece(setting, '|', 6, '0');
|
---|
172 | FGraphActivity.TurboOn := false;
|
---|
173 | end
|
---|
174 | else
|
---|
175 | FGraphActivity.TurboOn := true;
|
---|
176 | FGraphActivity.PersonalSetting := setting;
|
---|
177 | end
|
---|
178 | else
|
---|
179 | FGraphActivity.PersonalSetting := FGraphActivity.PublicSetting;
|
---|
180 | FGraphActivity.CurrentSetting := FGraphActivity.PersonalSetting;
|
---|
181 | FGraphActivity.PublicEditor := rpcPublicEdit; // use this as PublicEdit permission for user
|
---|
182 | end;
|
---|
183 | FreeAndNil(aList);
|
---|
184 | end;
|
---|
185 |
|
---|
186 | procedure GraphDataOnUser;
|
---|
187 | var // called from fFrame after this form is created
|
---|
188 | i: integer; // gets static info
|
---|
189 | dfntype, listline: string;
|
---|
190 | begin
|
---|
191 | if GtslData = nil then
|
---|
192 | exit; // do not setup if graphing is off
|
---|
193 | FastAssign(rpcGetTypes('0', false), GtslAllTypes);
|
---|
194 | for i := 0 to GtslAllTypes.Count - 1 do // uppercase all filetypes
|
---|
195 | begin
|
---|
196 | listline := GtslAllTypes[i];
|
---|
197 | dfntype := UpperCase(Piece(listline, '^', 1));
|
---|
198 | SetPiece(listline, '^', 1, dfntype);
|
---|
199 | GtslAllTypes[i] := listline;
|
---|
200 | end;
|
---|
201 | FastAssign(rpcGetTestSpec, GtslTestSpec);
|
---|
202 | FastAssign(rpcGetViews(VIEW_PUBLIC, 0), GtslAllViews);
|
---|
203 | FastAddStrings(rpcGetViews(VIEW_PERSONAL, User.DUZ), GtslAllViews);
|
---|
204 | FastAddStrings(rpcGetViews(VIEW_LABS, User.DUZ), GtslAllViews);
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure TfrmGraphData.ClearPtData;
|
---|
208 | var // called when patient is selected
|
---|
209 | oldDFN, faststatus: string;
|
---|
210 | begin
|
---|
211 | inherited;
|
---|
212 | if FGraphActivity.CurrentSetting = '' then
|
---|
213 | exit; // if graphing is turned off, don't process
|
---|
214 | ClearMemos;
|
---|
215 | ClearGtsl;
|
---|
216 | pnlData.Hint := '';
|
---|
217 | oldDFN := FGraphActivity.OldDFN; // cleanup any previous patient cache
|
---|
218 | FastAssign(rpcGetTypes(Patient.DFN, false), GtslTypes);
|
---|
219 | faststatus := rpcFastTask(Patient.DFN, oldDFN);
|
---|
220 | FGraphActivity.Cache := (faststatus = '1');
|
---|
221 | FGraphActivity.OldDFN := Patient.DFN;
|
---|
222 | end;
|
---|
223 |
|
---|
224 | procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
---|
225 | begin
|
---|
226 | // need to call this when patient is selected
|
---|
227 | end;
|
---|
228 |
|
---|
229 | function TfrmGraphData.AllowContextChange(var WhyNot: string): Boolean;
|
---|
230 | begin
|
---|
231 | Result := true; // perhaps add logic in the future
|
---|
232 | end;
|
---|
233 |
|
---|
234 | //----------------------------- Gtsl* are tstringlists used to hold data - global in scope
|
---|
235 |
|
---|
236 | procedure TfrmGraphData.MakeGtsl;
|
---|
237 | begin
|
---|
238 | GtslData := TStringList.Create;
|
---|
239 | GtslItems := TStringList.Create;
|
---|
240 | GtslTypes := TStringList.Create;
|
---|
241 | GtslAllTypes := TStringList.Create;
|
---|
242 | GtslAllViews := TStringList.Create;
|
---|
243 | GtslTestSpec := TStringList.Create;
|
---|
244 | GtslDrugClass := TStringList.Create;
|
---|
245 | GtslViews := TStringList.Create;
|
---|
246 | GtslCheck := TStringList.Create;
|
---|
247 | GtslNonNum := TStringList.Create;
|
---|
248 | GtslNonNumDates := TStringList.Create;
|
---|
249 | GtslScratchSwap := TStringList.Create;
|
---|
250 | GtslScratchTemp := TStringList.Create;
|
---|
251 | GtslScratchLab := TStringList.Create;
|
---|
252 | GtslSpec1 := TStringList.Create;
|
---|
253 | GtslSpec2 := TStringList.Create;
|
---|
254 | GtslSpec3 := TStringList.Create;
|
---|
255 | GtslSpec4 := TStringList.Create;
|
---|
256 | GtslMultiSpec := TStringList.Create;
|
---|
257 | GtslTempCheck := TStringList.Create;
|
---|
258 | GtslTemp := TStringList.Create;
|
---|
259 | GtslSelCopyTop := TStringList.Create;
|
---|
260 | GtslSelCopyBottom := TStringList.Create;
|
---|
261 | GtslZoomHistoryFloat := TStringList.Create;
|
---|
262 | GtslZoomHistoryReport := TStringList.Create;
|
---|
263 | GtslSelPrevTopFloat := TStringList.Create;
|
---|
264 | GtslSelPrevTopReport := TStringList.Create;
|
---|
265 | GtslSelPrevBottomFloat := TStringList.Create;
|
---|
266 | GtslSelPrevBottomReport := TStringList.Create;
|
---|
267 | GtslViewPersonal := TStringList.Create;
|
---|
268 | GtslViewPublic := TStringList.Create;
|
---|
269 | GtslLabGroup := TStringList.Create;
|
---|
270 | end;
|
---|
271 |
|
---|
272 | procedure TfrmGraphData.ClearGtsl;
|
---|
273 | begin
|
---|
274 | if GtslData = nil then exit;
|
---|
275 | //GtslAllTypes.Clear; // these types are not patient specific
|
---|
276 | //GtslTestSpec.Clear;
|
---|
277 | //GtslAllViews.Clear;
|
---|
278 | GtslData.Clear;
|
---|
279 | GtslItems.Clear;
|
---|
280 | GtslTypes.Clear;
|
---|
281 | GtslDrugClass.Clear;
|
---|
282 | GtslViews.Clear;
|
---|
283 | GtslCheck.Clear;
|
---|
284 | GtslNonNum.Clear;
|
---|
285 | GtslNonNumDates.Clear;
|
---|
286 | GtslScratchSwap.Clear;
|
---|
287 | GtslScratchTemp.Clear;
|
---|
288 | GtslScratchLab.Clear;
|
---|
289 | GtslSpec1.Clear;
|
---|
290 | GtslSpec2.Clear;
|
---|
291 | GtslSpec3.Clear;
|
---|
292 | GtslSpec4.Clear;
|
---|
293 | GtslMultiSpec.Clear;
|
---|
294 | GtslTempCheck.Clear;
|
---|
295 | GtslTemp.Clear;
|
---|
296 | GtslSelCopyTop.Clear;
|
---|
297 | GtslSelCopyBottom.Clear;
|
---|
298 | GtslZoomHistoryFloat.Clear;
|
---|
299 | GtslZoomHistoryReport.Clear;
|
---|
300 | GtslSelPrevTopFloat.Clear;
|
---|
301 | GtslSelPrevTopReport.Clear;
|
---|
302 | GtslSelPrevBottomFloat.Clear;
|
---|
303 | GtslSelPrevBottomReport.Clear;
|
---|
304 | GtslViewPersonal.Clear;
|
---|
305 | GtslViewPublic.Clear;
|
---|
306 | GtslLabGroup.Clear;
|
---|
307 | end;
|
---|
308 |
|
---|
309 | procedure TfrmGraphData.FreeGtsl;
|
---|
310 | begin
|
---|
311 | FreeAndNil(GtslData);
|
---|
312 | FreeAndNil(GtslItems);
|
---|
313 | FreeAndNil(GtslTypes);
|
---|
314 | FreeAndNil(GtslAllTypes);
|
---|
315 | FreeAndNil(GtslAllViews);
|
---|
316 | FreeAndNil(GtslTestSpec);
|
---|
317 | FreeAndNil(GtslDrugClass);
|
---|
318 | FreeAndNil(GtslNonNum);
|
---|
319 | FreeAndNil(GtslNonNumDates);
|
---|
320 | FreeAndNil(GtslScratchSwap);
|
---|
321 | FreeAndNil(GtslScratchTemp);
|
---|
322 | FreeAndNil(GtslScratchLab);
|
---|
323 | FreeAndNil(GtslSpec1);
|
---|
324 | FreeAndNil(GtslSpec2);
|
---|
325 | FreeAndNil(GtslSpec3);
|
---|
326 | FreeAndNil(GtslSpec4);
|
---|
327 | FreeAndNil(GtslMultiSpec);
|
---|
328 | FreeAndNil(GtslTempCheck);
|
---|
329 | FreeAndNil(GtslSelCopyTop);
|
---|
330 | FreeAndNil(GtslSelCopyBottom);
|
---|
331 | FreeAndNil(GtslZoomHistoryFloat);
|
---|
332 | FreeAndNil(GtslZoomHistoryReport);
|
---|
333 | FreeAndNil(GtslSelPrevTopFloat);
|
---|
334 | FreeAndNil(GtslSelPrevTopReport);
|
---|
335 | FreeAndNil(GtslSelPrevBottomFloat);
|
---|
336 | FreeAndNil(GtslSelPrevBottomReport);
|
---|
337 | FreeAndNil(GtslViewPersonal);
|
---|
338 | FreeAndNil(GtslViewPublic);
|
---|
339 | FreeAndNil(GtslLabGroup);
|
---|
340 | end;
|
---|
341 |
|
---|
342 | //----------------------------- displays when testing
|
---|
343 |
|
---|
344 | procedure TfrmGraphData.btnDataClick(Sender: TObject);
|
---|
345 | var
|
---|
346 | left, top, width, height: integer;
|
---|
347 | begin
|
---|
348 | height := pnlData.Height div 8;
|
---|
349 | height := height - lblInfo.Height;
|
---|
350 | top := lblInfo.Height;
|
---|
351 | left := 1;
|
---|
352 | width := pnlData.Width - 2;
|
---|
353 | MakeMemos('GtslData', GtslData, 1, left, top, width, height);
|
---|
354 | top := top + height + lblInfo.Height;
|
---|
355 | MakeMemos('GtslItems', GtslItems, 2, left, top, width, height);
|
---|
356 | top := top + height + lblInfo.Height;
|
---|
357 | MakeMemos('GtslTypes', GtslTypes, 3, left, top, width, height);
|
---|
358 | width := width div 6;
|
---|
359 | top := top + height + lblInfo.Height;
|
---|
360 | left := 1;
|
---|
361 | MakeMemos('GtslAllTypes', GtslAllTypes, 4, left, top, width, height);
|
---|
362 | left := left + width;
|
---|
363 | MakeMemos('GtslTestSpec', GtslTestSpec, 5, left, top, width, height);
|
---|
364 | left := left + width;
|
---|
365 | MakeMemos('GtslDrugClass', GtslDrugClass, 6, left, top, width, height);
|
---|
366 | left := left + width;
|
---|
367 | MakeMemos('GtslViews', GtslViews, 7, left, top, width, height);
|
---|
368 | left := left + width;
|
---|
369 | MakeMemos('GtslCheck', GtslCheck, 8, left, top, width, height);
|
---|
370 | left := left + width;
|
---|
371 | MakeMemos('GtslNonNum', GtslNonNum, 9, left, top, width, height);
|
---|
372 | top := top + height + lblInfo.Height;
|
---|
373 | left := 1;
|
---|
374 | MakeMemos('GtslNonNumDates', GtslNonNumDates, 10, left, top, width, height);
|
---|
375 | left := left + width;
|
---|
376 | MakeMemos('GtslScratchSwap', GtslScratchSwap, 11, left, top, width, height);
|
---|
377 | left := left + width;
|
---|
378 | MakeMemos('GtslScratchTemp', GtslScratchTemp, 12, left, top, width, height);
|
---|
379 | left := left + width;
|
---|
380 | MakeMemos('GtslScratchLab', GtslScratchLab, 13, left, top, width, height);
|
---|
381 | left := left + width;
|
---|
382 | MakeMemos('GtslSpec1', GtslSpec1, 14, left, top, width, height);
|
---|
383 | left := left + width;
|
---|
384 | MakeMemos('GtslSpec2', GtslSpec2, 15, left, top, width, height);
|
---|
385 | top := top + height + lblInfo.Height;
|
---|
386 | left := 1;
|
---|
387 | MakeMemos('GtslSpec3', GtslSpec3, 16, left, top, width, height);
|
---|
388 | left := left + width;
|
---|
389 | MakeMemos('GtslSpec4', GtslSpec4, 17, left, top, width, height);
|
---|
390 | left := left + width;
|
---|
391 | MakeMemos('GtslMultiSpec', GtslMultiSpec, 18, left, top, width, height);
|
---|
392 | left := left + width;
|
---|
393 | MakeMemos('GtslTempCheck', GtslTempCheck, 19, left, top, width, height);
|
---|
394 | left := left + width;
|
---|
395 | MakeMemos('GtslTemp', GtslTemp, 20, left, top, width, height);
|
---|
396 | left := left + width;
|
---|
397 | MakeMemos('GtslSelCopyTop', GtslSelCopyTop, 21, left, top, width, height);
|
---|
398 | top := top + height + lblInfo.Height;
|
---|
399 | left := 1;
|
---|
400 | MakeMemos('GtslSelCopyBottom', GtslSelCopyBottom, 22, left, top, width, height);
|
---|
401 | left := left + width;
|
---|
402 | MakeMemos('GtslZoomHistoryFloat', GtslZoomHistoryFloat, 23, left, top, width, height);
|
---|
403 | left := left + width;
|
---|
404 | MakeMemos('GtslZoomHistoryReport', GtslZoomHistoryReport, 24, left, top, width, height);
|
---|
405 | left := left + width;
|
---|
406 | MakeMemos('GtslSelPrevTopFloat', GtslSelPrevTopFloat, 25, left, top, width, height);
|
---|
407 | left := left + width;
|
---|
408 | MakeMemos('GtslSelPrevTopReport', GtslSelPrevTopReport, 26, left, top, width, height);
|
---|
409 | left := left + width;
|
---|
410 | MakeMemos('GtslSelPrevBottomFloat', GtslSelPrevBottomFloat, 27, left, top, width, height);
|
---|
411 | top := top + height + lblInfo.Height;
|
---|
412 | left := 1;
|
---|
413 | MakeMemos('GtslSelPrevBottomReport', GtslSelPrevBottomReport, 28, left, top, width, height);
|
---|
414 | left := left + width;
|
---|
415 | MakeMemos('GtslViewPersonal', GtslViewPersonal, 29, left, top, width, height);
|
---|
416 | left := left + width;
|
---|
417 | MakeMemos('GtslViewPublic', GtslViewPublic, 30, left, top, width, height);
|
---|
418 | left := left + width;
|
---|
419 | MakeMemos('GtslLabGroup', GtslLabGroup, 31, left, top, width, height);
|
---|
420 | left := left + width;
|
---|
421 | MakeMemos('GtslAllViews', GtslAllViews, 32, left, top, width, height);
|
---|
422 | btnData.Enabled := false;
|
---|
423 | btnRefresh.Enabled := true;
|
---|
424 | lblCurrent.Caption := FGraphActivity.CurrentSetting;
|
---|
425 | lblPersonal.Caption := FGraphActivity.PersonalSetting;
|
---|
426 | lblPublic.Caption := FGraphActivity.PublicSetting;
|
---|
427 | end;
|
---|
428 |
|
---|
429 | procedure TfrmGraphData.btnRefreshClick(Sender: TObject);
|
---|
430 | begin
|
---|
431 | frmGraphData.WindowState := wsMaximized;
|
---|
432 | ClearMemos;
|
---|
433 | FillMemos;
|
---|
434 | end;
|
---|
435 |
|
---|
436 | procedure TfrmGraphData.btnTestingClick(Sender: TObject);
|
---|
437 | begin
|
---|
438 | FastAssign(rpcTesting, memTesting.Lines);
|
---|
439 | end;
|
---|
440 |
|
---|
441 | procedure TfrmGraphData.MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
---|
442 | var
|
---|
443 | aMemo: TMemo;
|
---|
444 | aLabel: TLabel;
|
---|
445 | begin
|
---|
446 | aMemo := TMemo.Create(self);
|
---|
447 | aMemo.Parent := pnlData;
|
---|
448 | aMemo.Name := 'mem' + aName;
|
---|
449 | aMemo.Tag := aTag;
|
---|
450 | aMemo.Left := left; aMemo.Top := top; aMemo.Width := width; aMemo.Height := height;
|
---|
451 | aMemo.ScrollBars := ssVertical;
|
---|
452 | aMemo.WordWrap := false;
|
---|
453 | FastAssign(aList, aMemo.Lines);
|
---|
454 | aLabel := TLabel.Create(self);
|
---|
455 | aLabel.Parent := pnlData;
|
---|
456 | aLabel.Caption := aName + ' (' + inttostr(aList.Count) + ')';
|
---|
457 | aLabel.Left := left; aLabel.Top := top - lblInfo.Height; aLabel.Width := width; aLabel.Height := lblInfo.height;
|
---|
458 | end;
|
---|
459 |
|
---|
460 | procedure TfrmGraphData.ClearMemos;
|
---|
461 | var
|
---|
462 | i: integer;
|
---|
463 | ChildControl: TControl;
|
---|
464 | begin
|
---|
465 | for i := 0 to pnlData.ControlCount - 1 do
|
---|
466 | begin
|
---|
467 | ChildControl := pnlData.Controls[i];
|
---|
468 | if ChildControl is TMemo then
|
---|
469 | (ChildControl as TMemo).Clear;
|
---|
470 | end;
|
---|
471 | end;
|
---|
472 |
|
---|
473 | procedure TfrmGraphData.FillMemos;
|
---|
474 | var
|
---|
475 | i: integer;
|
---|
476 | aMemo: TMemo;
|
---|
477 | ChildControl: TControl;
|
---|
478 | begin
|
---|
479 | for i := 0 to pnlData.ControlCount - 1 do
|
---|
480 | begin
|
---|
481 | ChildControl := pnlData.Controls[i];
|
---|
482 | if ChildControl is TMemo then
|
---|
483 | begin
|
---|
484 | aMemo := (ChildControl as TMemo);
|
---|
485 | case aMemo.Tag of
|
---|
486 | 1: FastAssign(GtslData, aMemo.Lines);
|
---|
487 | 2: FastAssign(GtslItems, aMemo.Lines);
|
---|
488 | 3: FastAssign(GtslTypes, aMemo.Lines);
|
---|
489 | 4: FastAssign(GtslAllTypes, aMemo.Lines);
|
---|
490 | 5: FastAssign(GtslTestSpec, aMemo.Lines);
|
---|
491 | 6: FastAssign(GtslDrugClass, aMemo.Lines);
|
---|
492 | 7: FastAssign(GtslViews, aMemo.Lines);
|
---|
493 | 8: FastAssign(GtslCheck, aMemo.Lines);
|
---|
494 | 9: FastAssign(GtslNonNum, aMemo.Lines);
|
---|
495 | 10: FastAssign(GtslNonNumDates, aMemo.Lines);
|
---|
496 | 11: FastAssign(GtslScratchSwap, aMemo.Lines);
|
---|
497 | 12: FastAssign(GtslScratchTemp, aMemo.Lines);
|
---|
498 | 13: FastAssign(GtslScratchLab, aMemo.Lines);
|
---|
499 | 14: FastAssign(GtslSpec1, aMemo.Lines);
|
---|
500 | 15: FastAssign(GtslSpec2, aMemo.Lines);
|
---|
501 | 16: FastAssign(GtslSpec3, aMemo.Lines);
|
---|
502 | 17: FastAssign(GtslSpec4, aMemo.Lines);
|
---|
503 | 18: FastAssign(GtslMultiSpec, aMemo.Lines);
|
---|
504 | 19: FastAssign(GtslTempCheck, aMemo.Lines);
|
---|
505 | 20: FastAssign(GtslTemp, aMemo.Lines);
|
---|
506 | 21: FastAssign(GtslSelCopyTop, aMemo.Lines);
|
---|
507 | 22: FastAssign(GtslSelCopyBottom, aMemo.Lines);
|
---|
508 | 23: FastAssign(GtslZoomHistoryFloat, aMemo.Lines);
|
---|
509 | 24: FastAssign(GtslZoomHistoryReport, aMemo.Lines);
|
---|
510 | 25: FastAssign(GtslSelPrevTopFloat, aMemo.Lines);
|
---|
511 | 26: FastAssign(GtslSelPrevTopReport, aMemo.Lines);
|
---|
512 | 27: FastAssign(GtslSelPrevBottomFloat, aMemo.Lines);
|
---|
513 | 28: FastAssign(GtslSelPrevBottomReport, aMemo.Lines);
|
---|
514 | 29: FastAssign(GtslViewPersonal, aMemo.Lines);
|
---|
515 | 30: FastAssign(GtslViewPublic, aMemo.Lines);
|
---|
516 | 31: FastAssign(GtslLabGroup, aMemo.Lines);
|
---|
517 | 32: FastAssign(GtslAllViews, aMemo.Lines);
|
---|
518 | end;
|
---|
519 | end;
|
---|
520 | end;
|
---|
521 | end;
|
---|
522 |
|
---|
523 | //---------------------------------------------------
|
---|
524 |
|
---|
525 | function GetCurrentSetting: string;
|
---|
526 | begin
|
---|
527 | Result := FGraphActivity.CurrentSetting;
|
---|
528 | end;
|
---|
529 |
|
---|
530 | function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
---|
531 | var // temporary fix - converting definitions in GtslAllViews to rpc format
|
---|
532 | allviews, fulltext: boolean;
|
---|
533 | i: integer;
|
---|
534 | vtype, aline, avtype, avc, avnum, aname, atype, aitem, partsnum, bigline: string;
|
---|
535 | //auser: string;
|
---|
536 | begin
|
---|
537 | if (userx > 0) and (userx <> User.DUZ) then
|
---|
538 | Result := rpcGetGraphProfiles(profiles, permission, ext, userx)
|
---|
539 | else
|
---|
540 | begin
|
---|
541 | profiles := UpperCase(profiles);
|
---|
542 | if permission = '1' then vtype := '-2'
|
---|
543 | else vtype := '-1';
|
---|
544 | allviews := (profiles = '1');
|
---|
545 | fulltext := (ext = 1);
|
---|
546 | partsnum := '0';
|
---|
547 | bigline := '';
|
---|
548 | GtslScratchTemp.Clear;
|
---|
549 | for i := 0 to GtslAllViews.Count - 1 do
|
---|
550 | begin
|
---|
551 | aline := GtslAllViews[i];
|
---|
552 | avtype := Piece(aline, '^', 1);
|
---|
553 | avc := Piece(aline, '^', 2);
|
---|
554 | avnum := Piece(aline, '^', 3);
|
---|
555 | aname := UpperCase(Piece(aline, '^', 4));
|
---|
556 | atype := UpperCase(Piece(aline, '^', 5));
|
---|
557 | aitem := Piece(aline, '^', 6);
|
---|
558 | //auser := Piece(aline, '^', 7);
|
---|
559 | if partsnum <> '0' then
|
---|
560 | begin //AddLine(ext, aname, atype, aitem);
|
---|
561 | if (avc = 'C') and (partsnum = avnum) then
|
---|
562 | begin
|
---|
563 | if ext <> 1 then
|
---|
564 | begin
|
---|
565 | if aitem = '0' then bigline := bigline + '0~' + atype + '~|'
|
---|
566 | else bigline := bigline + atype + '~' + aitem + '~|'
|
---|
567 | end
|
---|
568 | else
|
---|
569 | begin
|
---|
570 | if aitem = '0' then
|
---|
571 | GtslScratchTemp.Add('0^' + atype + '^' + aname)
|
---|
572 | else
|
---|
573 | GtslScratchTemp.Add(atype + '^' + aitem + '^' + aname)
|
---|
574 | end;
|
---|
575 | end
|
---|
576 | else
|
---|
577 | begin
|
---|
578 | if length(bigline) > 0 then
|
---|
579 | GtslScratchTemp.Add(bigline);
|
---|
580 | break;
|
---|
581 | end;
|
---|
582 | end
|
---|
583 | else
|
---|
584 | if avtype = vtype then
|
---|
585 | begin
|
---|
586 | if allviews and (avc = 'V') then
|
---|
587 | begin
|
---|
588 | GtslScratchTemp.Add(aname);
|
---|
589 | end
|
---|
590 | else if (avc = 'V') and (aname = profiles) then
|
---|
591 | partsnum := avnum;
|
---|
592 | end;
|
---|
593 | end;
|
---|
594 | if allviews or fulltext then
|
---|
595 | MixedCaseList(GtslScratchTemp);
|
---|
596 | Result := GtslScratchTemp;
|
---|
597 | end;
|
---|
598 | end;
|
---|
599 |
|
---|
600 | function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
---|
601 | var // temporary fix - converting definitions in GtslAllViews to rpc format
|
---|
602 | i: integer;
|
---|
603 | aline, avtype, avc, avnum, aname, aitem, partsnum: string;
|
---|
604 | //atype, auser: string;
|
---|
605 | begin
|
---|
606 | if (userx > 0) and (userx <> User.DUZ) then
|
---|
607 | Result := rpcATestGroup(testgroup, userx)
|
---|
608 | else
|
---|
609 | begin
|
---|
610 | partsnum := '0';
|
---|
611 | GtslScratchTemp.Clear;
|
---|
612 | for i := 0 to GtslAllViews.Count - 1 do
|
---|
613 | begin
|
---|
614 | aline := GtslAllViews[i];
|
---|
615 | avtype := Piece(aline, '^', 1);
|
---|
616 | avc := Piece(aline, '^', 2);
|
---|
617 | avnum := Piece(aline, '^', 3);
|
---|
618 | aname := Piece(aline, '^', 4);
|
---|
619 | //atype := UpperCase(Piece(aline, '^', 5));
|
---|
620 | aitem := Piece(aline, '^', 6);
|
---|
621 | //auser := Piece(aline, '^', 7);
|
---|
622 | if avtype = VIEW_LABS then
|
---|
623 | begin
|
---|
624 | if (avc = 'V') and (partsnum <> '0') then
|
---|
625 | break;
|
---|
626 | if (avc = 'C') and (partsnum = avnum) then
|
---|
627 | GtslScratchTemp.Add(aitem + '^' + aname)
|
---|
628 | else if (avc = 'V')
|
---|
629 | and (testgroup = strtointdef(Piece(aname, ')', 1), BIG_NUMBER)) then
|
---|
630 | partsnum := avnum;
|
---|
631 | end;
|
---|
632 | end;
|
---|
633 | //MixedCaseList(GtslScratchTemp);
|
---|
634 | Result := GtslScratchTemp;
|
---|
635 | end;
|
---|
636 | end;
|
---|
637 |
|
---|
638 | function GetGraphStatus: string;
|
---|
639 | begin
|
---|
640 | Result := FGraphActivity.Status;
|
---|
641 | end;
|
---|
642 |
|
---|
643 | function GetOldDFN: string;
|
---|
644 | begin
|
---|
645 | Result := FGraphActivity.OldDFN;
|
---|
646 | end;
|
---|
647 |
|
---|
648 | function GetPersonalSetting: string;
|
---|
649 | begin
|
---|
650 | Result := FGraphActivity.PersonalSetting;
|
---|
651 | end;
|
---|
652 |
|
---|
653 | function GetPublicSetting: string;
|
---|
654 | begin
|
---|
655 | Result := FGraphActivity.PublicSetting;
|
---|
656 | end;
|
---|
657 |
|
---|
658 | function GraphPublicEditor: boolean;
|
---|
659 | begin
|
---|
660 | Result := FGraphActivity.PublicEditor;
|
---|
661 | end;
|
---|
662 |
|
---|
663 | function GraphTurboOn: boolean;
|
---|
664 | begin
|
---|
665 | Result := (FGraphActivity.TurboOn and FGraphActivity.Cache);
|
---|
666 | end;
|
---|
667 |
|
---|
668 | procedure SetCurrentSetting(aString: string);
|
---|
669 | begin
|
---|
670 | FGraphActivity.CurrentSetting := aString;
|
---|
671 | end;
|
---|
672 |
|
---|
673 | procedure SetGraphStatus(aString: string);
|
---|
674 | begin
|
---|
675 | FGraphActivity.Status := aString;
|
---|
676 | end;
|
---|
677 |
|
---|
678 | procedure SetOldDFN(aString: string);
|
---|
679 | begin
|
---|
680 | FGraphActivity.OldDFN := aString;
|
---|
681 | end;
|
---|
682 |
|
---|
683 | procedure SetPersonalSetting(aString: string);
|
---|
684 | begin
|
---|
685 | FGraphActivity.PersonalSetting := aString;
|
---|
686 | end;
|
---|
687 |
|
---|
688 | procedure SetPublicSetting(aString: string);
|
---|
689 | begin
|
---|
690 | FGraphActivity.PublicSetting := aString;
|
---|
691 | end;
|
---|
692 | //---------------------------------------------------
|
---|
693 |
|
---|
694 | procedure TfrmGraphData.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
695 | var
|
---|
696 | faststatus: string;
|
---|
697 | begin
|
---|
698 | if FGraphActivity.Cache then
|
---|
699 | begin
|
---|
700 | faststatus := rpcFastTask('0', Patient.DFN); // cleanup patient cache
|
---|
701 | if faststatus = '-1' then
|
---|
702 | FGraphActivity.Cache := false;
|
---|
703 | end;
|
---|
704 | end;
|
---|
705 |
|
---|
706 | procedure TfrmGraphData.FormDestroy(Sender: TObject);
|
---|
707 | begin
|
---|
708 | FreeGtsl;
|
---|
709 | end;
|
---|
710 |
|
---|
711 | end.
|
---|