source: cprs/trunk/CPRS-Chart/fGraphData.pas@ 877

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

Upgrading to version 27

File size: 23.5 KB
Line 
1unit fGraphData;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
8
9type
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
47var
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
106implementation
107
108{$R *.dfm}
109
110uses
111 uCore, rGraphs, uGraphs;
112
113var
114 FGraphActivity: TGraphActivity;
115
116{procedure GraphDataForm; // not used - perhaps with separate object for data
117var
118 frmGraphData: TfrmGraphData;
119begin
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;
130end;}
131
132procedure TfrmGraphData.FormCreate(Sender: TObject);
133begin // called from fFrame after user signon
134 if GtslData <> nil then
135 exit; // only create one time
136 MakeGraphActivity;
137 MakeUserSettings;
138 MakeGtsl;
139end;
140
141procedure TfrmGraphData.MakeGraphActivity;
142begin
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;
157end;
158
159procedure TfrmGraphData.MakeUserSettings;
160var
161 setting, turbo: string;
162 aList: TStrings;
163begin
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);
192end;
193
194procedure GraphDataOnUser;
195var // called from fFrame after this form is created
196 i: integer; // gets static info
197 dfntype, listline: string;
198begin
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);
213end;
214
215procedure TfrmGraphData.ClearPtData;
216var // called when patient is selected
217 oldDFN, faststatus: string;
218begin
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;
229end;
230
231procedure GraphDataOnPatient(var allitems, alldata: boolean);
232begin
233 // need to call this when patient is selected
234end;
235
236function TfrmGraphData.AllowContextChange(var WhyNot: string): Boolean;
237begin
238 Result := true; // perhaps add logic in the future
239end;
240
241//----------------------------- Gtsl* are tstringlists used to hold data - global in scope
242
243procedure TfrmGraphData.MakeGtsl;
244begin
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;
277end;
278
279procedure TfrmGraphData.ClearGtsl;
280begin
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;
314end;
315
316procedure TfrmGraphData.FreeGtsl;
317begin
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);
347end;
348
349//----------------------------- displays when testing
350
351procedure TfrmGraphData.btnDataClick(Sender: TObject);
352var
353 left, top, width, height: integer;
354begin
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;
434end;
435
436procedure TfrmGraphData.btnRefreshClick(Sender: TObject);
437begin
438 ClearMemos;
439 FillMemos;
440end;
441
442procedure TfrmGraphData.btnTestingClick(Sender: TObject);
443begin
444 FastAssign(rpcTesting, memTesting.Lines);
445end;
446
447procedure TfrmGraphData.MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
448var
449 aMemo: TMemo;
450 aLabel: TLabel;
451begin
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;
464end;
465
466procedure TfrmGraphData.ClearMemos;
467var
468 i: integer;
469 ChildControl: TControl;
470begin
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;
477end;
478
479procedure TfrmGraphData.FillMemos;
480var
481 i: integer;
482 aMemo: TMemo;
483 ChildControl: TControl;
484begin
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;
527end;
528
529//---------------------------------------------------
530
531function GetCurrentSetting: string;
532begin
533 Result := FGraphActivity.CurrentSetting;
534end;
535
536function GetDefaultInpatientDate: string;
537begin
538 Result := FGraphActivity.DefaultInpatientDate;
539end;
540
541function GetDefaultOutpatientDate: string;
542begin
543 Result := FGraphActivity.DefaultOutpatientDate;
544end;
545
546function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
547var // 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;
552begin
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;
614end;
615
616function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
617var // 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;
621begin
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;
652end;
653
654function GetGraphStatus: string;
655begin
656 Result := FGraphActivity.Status;
657end;
658
659function GetOldDFN: string;
660begin
661 Result := FGraphActivity.OldDFN;
662end;
663
664function GetPersonalSetting: string;
665begin
666 Result := FGraphActivity.PersonalSetting;
667end;
668
669function GetPublicSetting: string;
670begin
671 Result := FGraphActivity.PublicSetting;
672end;
673
674function GraphPublicEditor: boolean;
675begin
676 Result := FGraphActivity.PublicEditor;
677end;
678
679function GraphTurboOn: boolean;
680begin
681 Result := (FGraphActivity.TurboOn and FGraphActivity.Cache);
682end;
683
684procedure SetCurrentSetting(aString: string);
685begin
686 FGraphActivity.CurrentSetting := aString;
687end;
688
689procedure SetDefaultInpatientDate(aString: string);
690begin
691 FGraphActivity.DefaultInpatientDate := aString;
692end;
693
694procedure SetDefaultOutpatientDate(aString: string);
695begin
696 FGraphActivity.DefaultOutpatientDate := aString;
697end;
698
699procedure SetGraphStatus(aString: string);
700begin
701 FGraphActivity.Status := aString;
702end;
703
704procedure SetOldDFN(aString: string);
705begin
706 FGraphActivity.OldDFN := aString;
707end;
708
709procedure SetPersonalSetting(aString: string);
710begin
711 FGraphActivity.PersonalSetting := aString;
712end;
713
714procedure SetPublicSetting(aString: string);
715begin
716 FGraphActivity.PublicSetting := aString;
717end;
718//---------------------------------------------------
719
720procedure TfrmGraphData.FormClose(Sender: TObject; var Action: TCloseAction);
721var
722 faststatus: string;
723begin
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;
730end;
731
732procedure TfrmGraphData.FormDestroy(Sender: TObject);
733begin
734 FreeGtsl;
735end;
736
737end.
Note: See TracBrowser for help on using the repository browser.