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