source: cprs/trunk/CPRS-Chart/fGraphs.pas@ 716

Last change on this file since 716 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 205.5 KB
RevLine 
[456]1unit fGraphs;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, StdCtrls, ORCtrls, Menus, TeeProcs, TeEngine, Series, Chart, Math,
8 ComCtrls, GanttCh, ClipBrd, StrUtils, ORFn, ORDtTmRng, DateUtils, Printers,
9 OleServer, Variants, Word97, Word2000, ArrowCha, ORDtTm, uGraphs;
10
11type
12 TfrmGraphs = class(TForm)
13 btnChangeSettings: TButton;
14 btnClose: TButton;
15 btnGraphSelections: TButton;
16 bvlBottomLeft: TBevel;
17 bvlBottomRight: TBevel;
18 bvlTopLeft: TBevel;
19 bvlTopRight: TBevel;
20 calDateRange: TORDateRangeDlg;
21 cboDateRange: TORComboBox;
22 chartBase: TChart;
23 chartDatelineBottom: TChart;
24 chartDatelineTop: TChart;
25 chkDualViews: TCheckBox;
26 chkItemsBottom: TCheckBox;
27 chkItemsTop: TCheckBox;
28 dlgDate: TORDateTimeDlg;
29 lblDateRange: TLabel;
30 lblViewsBottom: TOROffsetLabel;
31 lblViewsTop: TOROffsetLabel;
32 lstAllTypes: TListBox;
33 lstCheck: TListBox;
34 lstData: TListBox;
35 lstDrugClass: TListBox;
36 lstItems: TListBox;
37 lstItemsTemp: TListBox;
38 lstMultiSpec: TListBox;
39 lstNonNumeric: TListBox;
40 lstScratchLab: TListBox;
41 lstScratchSwap: TListBox;
42 lstScratchTemp: TListBox;
43 lstSelCopyBottom: TListBox;
44 lstSelCopyTop: TListBox;
45 lstSpec1: TListBox;
46 lstSpec2: TListBox;
47 lstSpec3: TListBox;
48 lstSpec4: TListBox;
49 lstTemp: TListBox;
50 lstTempCheck: TListBox;
51 lstTestSpec: TListBox;
52 lstTypes: TListBox;
53 lstViews: TListBox;
54 lstZoomHistory: TListBox;
55 lvwItemsBottom: TListView;
56 lvwItemsTop: TListView;
57 mnumedsasgantt: TMenuItem;
58 mnumedsasganttvertheight: TMenuItem;
59 mnuPopGraph3D: TMenuItem;
60 mnuPopGraphClear: TMenuItem;
61 mnuPopGraphCopy: TMenuItem;
62 mnuPopGraphDates: TMenuItem;
63 mnuPopGraphDefineViews: TMenuItem;
64 mnuPopGraphDetails: TMenuItem;
65 mnuPopGraphDualViews: TMenuItem;
66 mnuPopGraphGradient: TMenuItem;
67 mnuPopGraphFixed: TMenuItem;
68 mnuPopGraphHints: TMenuItem;
69 mnuPopGraphHorizontal: TMenuItem;
70 mnuPopGraphIsolate: TMenuItem;
71 mnuPopGraphLegend: TMenuItem;
72 mnuPopGraphLines: TMenuItem;
73 mnuPopGraphPrint: TMenuItem;
74 mnuPopGraphRemove: TMenuItem;
75 mnuPopGraphReset: TMenuItem;
76 mnuPopGraphSeparate1: TMenuItem;
77 mnuPopGraphSort: TMenuItem;
78 mnuPopGraphSplit: TMenuItem;
79 mnuPopGraphStayOnTop: TMenuItem;
80 mnuPopGraphStuff: TPopupMenu;
81 mnuPopGraphSwap: TMenuItem;
82 mnuPopGraphToday: TMenuItem;
83 mnuPopGraphValues: TMenuItem;
84 mnuPopGraphVertical: TMenuItem;
85 mnuPopGraphZoomBack: TMenuItem;
86 N1: TMenuItem;
87 N2: TMenuItem;
88 N3: TMenuItem;
89 N4: TMenuItem;
90 pnlBlankBottom: TPanel;
91 pnlBlankTop: TPanel;
92 pnlBottom: TPanel;
93 pnlBottomRightPad: TPanel;
94 pnlData: TPanel;
95 pnlDatelineBottom: TPanel;
96 pnlDatelineBottomSpacer: TORAutoPanel;
97 pnlDatelineTop: TPanel;
98 pnlDatelineTopSpacer: TORAutoPanel;
99 pnlFooter: TPanel;
100 pnlHeader: TPanel;
101 pnlInfo: TORAutoPanel;
102 pnlItemsBottom: TPanel;
103 pnlItemsBottomInfo: TPanel;
104 pnlItemsTop: TPanel;
105 pnlItemsTopInfo: TPanel;
106 pnlMain: TPanel;
107 pnlScrollBottomBase: TPanel;
108 pnlScrollTopBase: TPanel;
109 pnlTemp: TPanel;
110 pnlTop: TPanel;
111 pnlTopRightPad: TPanel;
112 scrlBottom: TScrollBox;
113 scrlTop: TScrollBox;
114 serDatelineBottom: TGanttSeries;
115 serDatelineTop: TGanttSeries;
116 splGraphs: TSplitter;
117 splItemsBottom: TSplitter;
118 splItemsTop: TSplitter;
119 timHintPause: TTimer;
120 lstSelPrevTop: TListBox;
121 lstSelPrevBottom: TListBox;
122 lstComp: TListBox;
123 pnlViewsTopSpacer: TPanel;
124 cboViewsTop: TORComboBox;
125 pnlViewsTopSpacerRight: TPanel;
126 pnlViewsBottomSpacer: TPanel;
127 cboViewsBottom: TORComboBox;
128 pnlViewsBottomSpacerRight: TPanel;
129 testcount1: TMenuItem;
130 procedure FormCreate(Sender: TObject);
131 procedure FormShow(Sender: TObject);
132 procedure FormClose(Sender: TObject; var Action: TCloseAction);
133
134 procedure btnCloseClick(Sender: TObject);
135 procedure btnChangeSettingsClick(Sender: TObject);
136 procedure btnGraphSelectionsClick(Sender: TObject);
137
138 procedure chkDualViewsClick(Sender: TObject);
139 procedure chkItemsTopClick(Sender: TObject);
140 procedure chkItemsBottomClick(Sender: TObject);
141
142 procedure mnuMedsasganttClick(Sender: TObject);
143 procedure mnuPopGraph3DClick(Sender: TObject);
144 procedure mnuPopGraphClearClick(Sender: TObject);
145 procedure mnuPopGraphCopyClick(Sender: TObject);
146 procedure mnuPopGraphDatesClick(Sender: TObject);
147 procedure mnuPopGraphDetailsClick(Sender: TObject);
148 procedure mnuPopGraphDualViewsClick(Sender: TObject);
149 procedure mnuPopGraphFixedClick(Sender: TObject);
150 procedure mnuPopGraphGradientClick(Sender: TObject);
151 procedure mnuPopGraphHintsClick(Sender: TObject);
152 procedure mnuPopGraphIsolateClick(Sender: TObject);
153 procedure mnuPopGraphLegendClick(Sender: TObject);
154 procedure mnuPopGraphLinesClick(Sender: TObject);
155 procedure mnuPopGraphPrintClick(Sender: TObject);
156 procedure mnuPopGraphRemoveClick(Sender: TObject);
157 procedure mnuPopGraphResetClick(Sender: TObject);
158 procedure mnuPopGraphSeparate1Click(Sender: TObject);
159 procedure mnuPopGraphStayOnTopClick(Sender: TObject);
160 procedure mnuPopGraphSortClick(Sender: TObject);
161 procedure mnuPopGraphSplitClick(Sender: TObject);
162 procedure mnuPopGraphStuffPopup(Sender: TObject);
163 procedure mnuPopGraphSwapClick(Sender: TObject);
164 procedure mnuPopGraphTodayClick(Sender: TObject);
165 procedure mnuPopGraphValuesClick(Sender: TObject);
166 procedure mnuPopGraphHorizontalClick(Sender: TObject);
167 procedure mnuPopGraphVerticalClick(Sender: TObject);
168 procedure mnuPopGraphZoomBackClick(Sender: TObject);
169
170 procedure splGraphsMoved(Sender: TObject);
171 procedure splItemsBottomMoved(Sender: TObject);
172 procedure splItemsTopMoved(Sender: TObject);
173
174 procedure GetSize;
175 procedure SetSize;
176
177 procedure lvwItemsBottomClick(Sender: TObject);
178 procedure lvwItemsBottomColumnClick(Sender: TObject; Column: TListColumn);
179 procedure lvwItemsBottomCompare(Sender: TObject; Item1,
180 Item2: TListItem; Data: Integer; var Compare: Integer);
181 procedure lvwItemsTopClick(Sender: TObject);
182 procedure lvwItemsTopColumnClick(Sender: TObject; Column: TListColumn);
183 procedure lvwItemsTopCompare(Sender: TObject; Item1, Item2: TListItem;
184 Data: Integer; var Compare: Integer);
185
186 procedure cboDateRangeChange(Sender: TObject);
187 procedure cboViewsBottomChange(Sender: TObject);
188 procedure cboViewsTopChange(Sender: TObject);
189
190 procedure pnlScrollTopBaseResize(Sender: TObject);
191
192 procedure chartBaseClickLegend(Sender: TCustomChart;
193 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
194 procedure chartBaseClickSeries(Sender: TCustomChart; Series: TChartSeries;
195 ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
196 procedure chartBaseMouseDown(Sender: TObject; Button: TMouseButton;
197 Shift: TShiftState; X, Y: Integer);
198 procedure chartBaseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
199 procedure serDatelineTopGetMarkText(Sender: TChartSeries;
200 ValueIndex: Integer; var MarkText: String);
201
202 procedure ChartOnUndoZoom(Sender: TObject);
203 procedure ChartOnZoom(Sender: TObject);
204 procedure DisplayData(aSection: string);
205 procedure HideDates(aChart: TChart);
206 procedure SourcesDefault;
207 procedure StayOnTop;
208
209 procedure timHintPauseTimer(Sender: TObject);
210 procedure ZoomUpdate;
211 procedure ZoomUpdateInfo(SmallTime, BigTime: TDateTime);
212 procedure ZoomTo(SmallTime, BigTime: TDateTime);
213 procedure lvwItemsTopChange(Sender: TObject; Item: TListItem;
214 Change: TItemChange);
215 procedure lvwItemsTopKeyDown(Sender: TObject; var Key: Word;
216 Shift: TShiftState);
217 procedure lvwItemsBottomChange(Sender: TObject; Item: TListItem;
218 Change: TItemChange);
219 procedure testcount1Click(Sender: TObject);
220 procedure cboDateRangeDropDown(Sender: TObject);
221 procedure cboViewsTopDropDown(Sender: TObject);
222 procedure cboViewsTopDropDownClose(Sender: TObject);
223 procedure cboViewsBottomDropDown(Sender: TObject);
224 procedure cboViewsBottomDropDownClose(Sender: TObject);
225 procedure FormDestroy(Sender: TObject);
226 procedure lvwItemsTopEnter(Sender: TObject);
227 procedure lvwItemsBottomEnter(Sender: TObject);
228 procedure chkItemsBottomEnter(Sender: TObject);
229 procedure cboViewsBottomEnter(Sender: TObject);
230
231 private
232 { Private declarations }
233 FBSortAscending: boolean;
234 FBSortCol: integer;
235 FDate1: Double;
236 FDate2: Double;
237 FSortAscending: boolean;
238 FSortCol: integer;
239
240 FActiveGraph: TChart;
241 FArrowKeys: boolean;
242 FBHighTime, FBLowTime: Double;
243 FCreate: boolean;
244 FFirstClick: boolean;
245 FFirstSwitch: boolean;
246 FGraphClick: TCustomChart;
247 FGraphSeries: TChartSeries;
248 FGraphValueIndex: integer;
249 FGraphSetting: TGraphSetting;
250 FGraphType: char;
251 FItemsSortedTop: boolean;
252 FItemsSortedBottom: boolean;
253 FMouseDown: boolean;
254 FMTimestamp: string;
255 FMToday: TFMDateTime;
256 FMyProfiles, FProfiles: TStringList;
257 FNonNumerics: boolean; // used with pnlItemsTop.Tag & pnlItemsBottom.Tag
258 FOnLegend: integer;
259 FOnSeries: integer;
260 FOnValue: integer;
261 FPrevEvent: string;
262 FRetainZoom: boolean;
263 FSources: TStrings;
264 FSourcesDefault: TStrings;
265 FTHighTime, FTLowTime: Double;
266 FWarning: boolean;
267 FX, FY: integer;
268 FYMinValue: Double;
269 FYMaxValue: Double;
270
271 procedure AdjustTimeframe;
272 procedure AllTypeDate(aType, aTypeName, firstline, secondline: string; aDate, aDate2: double);
273 procedure AllDetails(aDate1, aDate2: TFMDateTime; aTempList: TStrings);
274 procedure AssignProfile(aProfile, aSection: string);
275 procedure AutoSelect(aListView: TListView);
276 procedure BaseResize(aScrollBox: TScrollBox);
277 procedure BottomAxis(aScrollBox: TScrollBox);
278 procedure ChangeStyle;
279 procedure ChartStyle(aChart: TChart);
280 procedure CheckProfile(var aProfile: string; var Updated: boolean);
281 procedure CheckToAddData(aListView: TListView; aSection, TypeToCheck: string);
282 procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle, Warning, DateRange: string);
283 procedure DateRangeItems(oldestdate, newestdate: double; filenum: string);
284 procedure UpdateView(filename, filenum, itemnum, aString: string; aListView: TListView);
285 procedure DisplayType(itemtype, displayed: string);
286 procedure FillViews;
287 procedure FilterListView(oldestdate, newestdate: double);
288 procedure FixedDates(var adatetime, adatetime1: TDateTime);
289 procedure GetData(aString: string);
290 procedure HideGraphs(action: boolean);
291 procedure HighLow(fmtime, fmtime1: string; aChart: TChart; var adatetime, adatetime1: TDateTime);
292 procedure InactivateHint;
293 procedure ItemCheck(aListView: TListView; aItemName: string;
294 var aNum: integer; var aTypeItem: string);
295 procedure ItemsClick(Sender: TObject; aListView, aOtherListView: TListView;
296 aCheckBox: TCheckBox; aComboBox: TORComboBox; aList: TListBox; aSection: string);
297 procedure ItemDateRange(Sender: TCustomChart);
298 procedure LabData(aItemType, aItemName, aSection: string);
299 procedure LoadDateRange;
300 procedure LoadDisplayCheck(typeofitem: string; var updated: boolean);
301 procedure LoadType(itemtype, displayed: string);
302 procedure NextPointerStyle(aSeries: TChartSeries; aSerCnt: integer);
303 procedure OneDayTypeDetails(aTypeItem: string);
304 procedure RefUnits(aItem, aSpec: string; var low, high, units: string);
305 procedure ResetSpec(aListBox: TListBox; aItemNum, aNewItemNum, aNewItemName, aNewString: string);
306 procedure TempCheck(typeitem: string; var levelseq: double);
307 procedure SelCopy(aListView: TListView; aListBox: TListBox);
308 procedure SelReset(aListbox: TListBox; aListView: TListView);
309 procedure SelectItem(aListView: TListView; typeitem: string);
310 procedure SetProfile(aProfile, aName: string; aListView: TListView);
311 procedure SizeDates(aChart: TChart; aSmallTime, aBigTime: TDateTime);
312 procedure SizeTogether(onlylines, nolines, anylines: Boolean; aScroll: TScrollBox;
313 aChart: TChart; aPanel, aPanelBase: TPanel; portion: Double);
314 procedure ViewsChange(aListView: TListView; aComboBox: TORComboBox; aSection: string);
315
316 procedure MakeDateline(section, aTitle, aFileType: string; aChart: TChart; graphtype: integer;
317 var bcnt, pcnt, gcnt, vcnt, acnt: integer);
318 procedure MakeSeparate(aScrollBox: TScrollBox; aListView: TListView; aPadPanel: TPanel; section: string);
319 procedure MakeTogether(aScrollBox: TScrollBox; aListView: TListView; aPadPanel: TPanel; section: string);
320
321 procedure MakeAGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
322 procedure MakeArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
323 procedure MakeBarSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
324 procedure MakeGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
325 procedure MakeLineSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt, aNonCnt: integer; multiline: boolean);
326 procedure MakeManyGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); // good one
327 procedure MakePointSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
328 procedure MakeVisitGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
329 procedure MakeWeightedArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
330 procedure MakeWeightedGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
331
332 function BPValue(aDateTime: TDateTime): string;
333 function DateRangeMultiItems(aOldDate, aNewDate: double; aMultiItem: string): boolean;
334 function DCName(aDCien: string): string;
335 function ExpandTax(profile: string): string;
336 function FileNameX(filenum: string): string;
337 function FMCorrectedDate(fmtime: string): string;
338 function GraphTypeNum(aType: string): integer;
339 function HSAbbrev(aType: string): boolean;
340 function InvVal(value: double): double;
341 function ItemName(filenum, itemnum: string): string;
342 function NextColor(aCnt: integer): TColor;
343 function PortionSize(lcnt, pcnt, gcnt, vcnt, bcnt, acnt: integer): double;
344 function SelectRef(aRef: string): string;
345 function StdDev(value, high, low: double): double;
346 function TypeIsDisplayed(itemtype: string): boolean;
347 function TypeIsLoaded(itemtype: string): boolean;
348 function Vfactor(aTitle: string): double;
349 function ValueText(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer): string;
350
351 public
352 { Public declarations }
353 procedure InitialData;
354 procedure Initialize;
355 procedure InitialRetain;
356 procedure LoadListView(aList: TStrings);
357 procedure SourceContext;
358 procedure ViewSelections;
359 procedure SetFontSize(FontSize: integer);
360 function FMToDateTime(FMDateTime: string): TDateTime;
361 end;
362
363var
364 frmGraphs: TfrmGraphs;
365 FHintWin: THintWindow;
366 FHintWinActive: boolean;
367 FHintStop: boolean;
368
369implementation
370
371uses fGraphSettings, fGraphProfiles, rGraphs,
372 ComObj, ActiveX, ShellAPI, fFrame, uCore, rCore, fRptBox, fReports,
373 uFormMonitor;
374
375{$R *.DFM}
376
377type
378 TGraphItem = class
379 public
380 Values: string;
381end;
382
383procedure TfrmGraphs.FormCreate(Sender: TObject);
384var
385 i: integer;
386 dfntype, listline, settings, settings1, t1, t2: string;
387 aList: TStrings;
388begin
389 FMToday := DateTimeToFMDateTime(Date);
390 FHintWinActive := false;
391 FHintStop := false;
392 FNonNumerics := false;
393 FMouseDown := false;
394 FItemsSortedTop := false;
395 FItemsSortedBottom := false;
396 FRetainZoom := false;
397 FFirstClick := true;
398 FArrowKeys := false;
399 FCreate := true;
400 FGraphType := Char(32);
401 aList := TStringList.Create;
402 FastAssign(rpcGetGraphSettings, aList);
403 btnClose.Tag := 0;
404 if aList.Count < 1 then
405 begin
406 Screen.Cursor := crDefault;
407 showmessage('CPRS is not configured for graphing.');
408 btnClose.Tag := 1;
409 FreeAndNil(aList);
410 Close;
411 Exit;
412 end;
413 t1 := aList[0]; t2 := aList[1]; // hint are current, t1 are personal, t2 public settings
414 if length(frmFrame.mnuToolsGraphing.Hint) > 0 then settings := frmFrame.mnuToolsGraphing.Hint
415 else if length(t1) > 0 then settings := t1
416 else settings := t2;
417 SetPiece(settings, '|', 8, Piece(t2, '|', 8)); //??????????
418 frmFrame.mnuToolsGraphing.Hint := settings;
419 settings1 := Piece(settings, '|', 1);
420 FSources := TStringList.Create;
421 FSourcesDefault := TStringList.Create;
422 FMyProfiles := TStringList.Create;
423 FProfiles := TStringList.Create;
424 FYMinValue := 0;
425 FYMaxValue := 0;
426 FTHighTime := 0;
427 FTLowTime := BIG_NUMBER;
428 FBHighTime := 0;
429 FBLowTime := BIG_NUMBER;
430 pnlInfo.Caption := TXT_INFO;
431 FOnLegend := BIG_NUMBER;
432 FOnSeries := BIG_NUMBER;
433 FOnValue := BIG_NUMBER;
434 FHintWin := THintWindow.Create(self);
435 FHintWin.Color := clInfoBk;
436 FHintWin.Canvas.Font.Color := clInfoBk;
437 FX := 0; FY :=0;
438 FastAssign(rpcGetTypes('0', false), lstAllTypes.Items);
439 for i := 0 to lstAllTypes.Items.Count - 1 do
440 begin
441 listline := lstAllTypes.Items[i];
442 dfntype := UpperCase(Piece(listline, '^', 1));
443 SetPiece(listline, '^', 1, dfntype);
444 lstAllTypes.Items[i] := listline;
445 end;
446 FGraphSetting := GraphSettingsInit(settings);
447 for i := 0 to BIG_NUMBER do
448 begin
449 dfntype := Piece(settings1, ';', i);
450 if length(dfntype) = 0 then break;
451 listline := dfntype + '^' + FileNameX(dfntype) + '^1';
452 FSources.Add(listline);
453 FSourcesDefault.Add(listline);
454 end;
455 serDatelineTop.Active := false;
456 serDatelineBottom.Active := false;
457 chartDatelineTop.Gradient.EndColor := clGradientActiveCaption;
458 chartDatelineTop.Gradient.StartColor := clWindow;
459 chartDatelineBottom.Gradient.EndColor := clGradientActiveCaption;
460 chartDatelineBottom.Gradient.StartColor := clWindow;
461 LoadDateRange;
462 chkItemsTop.Checked := true;
463 chkItemsBottom.Checked := true;
464 FastAssign(rpcGetTestSpec, lstTestSpec.Items);
465 FillViews;
466 FreeAndNil(aList);
467end;
468
469procedure TfrmGraphs.SourcesDefault;
470var
471 i: integer;
472 dfntype, listline, settings, settings1, t1, t2: string;
473 aList: TStrings;
474begin
475 aList := TStringList.Create;
476 FastAssign(rpcGetGraphSettings, aList);
477 t1 := aList[0]; t2 := aList[1]; // t1 are personal, t2 public settings
478 if length(frmFrame.mnuToolsGraphing.Hint) > 0 then settings := frmFrame.mnuToolsGraphing.Hint
479 else if length(t1) > 0 then settings := t1
480 else settings := t2;
481 SetPiece(settings, '|', 8, Piece(t2, '|', 8));
482 settings1 := Piece(settings, '|', 1);
483 FGraphSetting := GraphSettingsInit(settings);
484 for i := 0 to BIG_NUMBER do
485 begin
486 dfntype := Piece(settings1, ';', i);
487 if length(dfntype) = 0 then break;
488 listline := dfntype + '^' + FileNameX(dfntype) + '^1';
489 FSourcesDefault.Add(listline);
490 end;
491 FreeAndNil(aList);
492end;
493
494procedure TfrmGraphs.Initialize;
495var
496 i: integer;
497 rptview1, rptview2, rptviews: string;
498begin
499 InitialData;
500 SourceContext;
501 LoadListView(lstItems.Items);
502 if pnlMain.Tag > 0 then
503 begin
504 rptviews := MixedCase(rpcReportParams(pnlMain.Tag));
505 if length(rptviews) > 1 then
506 begin
507 rptview1 := Piece(rptviews, '^', 1);
508 rptview2 := Piece(rptviews, '^', 2);
509 if length(rptview1) > 0 then
510 begin
511 for i := 0 to cboViewsTop.Items.Count - 1 do
512 if Piece(cboViewsTop.Items[i], '^', 2) = rptview1 then
513 begin
514 cboViewsTop.ItemIndex := i;
515 break;
516 end;
517 end;
518 if length(rptview2) > 0 then
519 begin
520 chkDualViews.Checked := true;
521 chkDualViewsClick(self);
522 for i := 0 to cboViewsBottom.Items.Count - 1 do
523 if Piece(cboViewsBottom.Items[i], '^', 2) = rptview2 then
524 begin
525 cboViewsBottom.ItemIndex := i;
526 break;
527 end;
528 end;
529 end;
530 end;
531 if cboViewsTop.ItemIndex > -1 then
532 cboViewsTopChange(self)
533 else
534 lvwItemsTopClick(self);
535 if cboViewsBottom.ItemIndex > -1 then
536 cboViewsbottomChange(self)
537 else
538 lvwItemsBottomClick(self);
539 if pnlMain.Tag > 0 then
540 begin
541 pnlMain.Tag := 0;
542 cboDateRangeChange(self);
543 if cboViewsTop.ItemIndex > -1 then
544 cboViewsTopChange(self)
545 else
546 lvwItemsTopClick(self);
547 if cboViewsBottom.ItemIndex > -1 then
548 cboViewsbottomChange(self)
549 else
550 lvwItemsBottomClick(self);
551 end;
552end;
553
554procedure TfrmGraphs.InitialRetain;
555//var
556 //i: integer;
557begin
558 {//
559 allview=false
560 fullview=false
561 noview=true
562 go thru items
563 if selected
564 if view
565 noview=false
566 else
567 allview=false
568
569 else
570 if view
571 allview=false
572 fullview=false
573 noview=false
574 else
575 //
576 if noview
577 //
578 if allview
579 //
580 if fullview
581 //
582 else //partial view
583 //
584 //}
585end;
586
587procedure TfrmGraphs.FillViews;
588var
589 i: integer;
590begin
591 with cboViewsTop do
592 begin
593 Items.Clear;
594 Sorted := false;
595 lstTemp.Sorted := true;
596 FastAssign(rpcGetGraphProfiles('1', '0', 0), lstTemp.Items);
597 if lstTemp.Items.Count > 0 then
598 begin
599 for i := 0 to lstTemp.Items.Count - 1 do
600 Items.Add('-1^' + lstTemp.Items[i] + '^');
601 end;
602 FastAssign(rpcGetGraphProfiles('1', '1', 0), lstTemp.Items);
603 if lstTemp.Items.Count > 0 then
604 begin
605 Items.Add(LLS_LINE);
606 for i := 0 to lstTemp.Items.Count - 1 do
607 Items.Add('-2^' + lstTemp.Items[i] + '^');
608 end;
609 Items.Insert(0, '^<clear all selections>^0');
610 Items.Insert(1, '^<select items>^0');
611 end;
612 FastAssign(cboViewsTop.Items, cboViewsBottom.Items);
613end;
614
615procedure TfrmGraphs.SourceContext;
616begin
617 if frmFrame.GraphContext = '' then exit;
618 frmFrame.GraphContext := '';
619end;
620
621procedure TfrmGraphs.FormShow(Sender: TObject);
622begin
623 Font := MainFont;
624 ChangeStyle;
625 StayOnTop;
626 mnuPopGraphResetClick(self);
627 if pnlFooter.Tag = 1 then // do not show footer controls on reports tab
628 begin
629 pnlFooter.Visible := false;
630 if FCreate then
631 begin
632 FGraphType := GRAPH_REPORT;
633 FCreate := false;
634 GetSize;
635 end;
636 end
637 else
638 begin
639 chkDualViews.Checked := false;
640 chkDualViewsClick(self);
641 if FCreate then
642 begin
643 FGraphType := GRAPH_FLOAT;
644 FCreate := false;
645 GetSize;
646 end;
647 end;
648 if cboDateRange.ItemIndex < 0 then
649 cboDateRange.ItemIndex := cboDateRange.Items.Count - 1;
650 cboDateRangeChange(self);
651 lvwItemsTopClick(self);
652 if lvwItemsTop.Items.Count = 0 then
653 begin
654 cboViewsTop.ItemIndex := 0;
655 cboViewsTop.Text := '';
656 end;
657 //else
658 // lvwItemsTop.SetFocus;
659 //chkItemsTop.SetFocus;
660 cboViewsTop.SetFocus;
661 //Perform(WM_NextDlgCtl, 0, 0);
662end;
663
664procedure TfrmGraphs.FormClose(Sender: TObject; var Action: TCloseAction);
665begin
666 SetSize;
667 timHintPause.Enabled := false;
668 InactivateHint;
669 frmFrame.GraphFloatActive := false;
670end;
671
672procedure TfrmGraphs.GetSize;
673var
674 i, v1, v2, v3, v4: integer;
675 name, settings, value: string;
676 aList: TStrings;
677begin
678 aList := TStringList.Create;
679 FastAssign(rpcGetGraphSizing, aList);
680 for i := 0 to aList.Count - 1 do
681 begin
682 settings := aList[i];
683 name := Piece(settings, '^', 1);
684 value := Piece(settings, '^', 2);
685 if length(value) > 1 then
686 begin
687 v1 := strtointdef(Piece(value, ',', 1), 0);
688 v2 := strtointdef(Piece(value, ',', 2), 0);
689 v3 := strtointdef(Piece(value, ',', 3), 0);
690 v4 := strtointdef(Piece(value, ',', 4), 0);
691 if FGraphType = GRAPH_FLOAT then
692 begin
693 if name = 'FBOUNDS' then
694 begin
695 if value = '0,0,0,0' then
696 WindowState := wsMaximized
697 else
698 begin
699 if v1 > 0 then Left := v1;
700 if v2 > 0 then Top := v2;
701 if v3 > 0 then Width := v3;
702 if v4 > 0 then Height := v4;
703 end;
704 end
705 else if name = 'FWIDTH' then
706 begin
707 if v1 > 0 then
708 begin
709 pnlItemsTop.Width := v1;
710 splItemsTopMoved(self);
711 end;
712 end
713 else if name = 'FBOTTOM' then
714 begin
715 if v1 > 0 then
716 begin
717 chkDualViews.Checked := true;
718 chkDualViewsClick(self);
719 pnlBottom.Height := v1;
720 end;
721 end
722 else if name = 'FCOLUMN' then
723 begin
724 if v1 > 0 then lvwItemsTop.Column[0].Width := v1;
725 if v2 > 0 then lvwItemsTop.Column[1].Width := v2;
726 if v3 > 0 then lvwItemsTop.Column[2].Width := v3;
727 if v4 > 0 then lvwItemsTop.Column[3].Width := v4;
728 end
729 else if name = 'FBCOLUMN' then
730 begin
731 if v1 > 0 then lvwItemsBottom.Column[0].Width := v1;
732 if v2 > 0 then lvwItemsBottom.Column[1].Width := v2;
733 if v3 > 0 then lvwItemsBottom.Column[2].Width := v3;
734 if v4 > 0 then lvwItemsBottom.Column[3].Width := v4;
735 end;
736 end
737 else
738 begin
739 if name = 'RWIDTH' then
740 begin
741 if v1 > 0 then
742 begin
743 pnlItemsTop.Width := v1;
744 splItemsTopMoved(self);
745 end;
746 end
747 else if name = 'RBOTTOM' then
748 begin
749 if v1 > 0 then
750 begin
751 pnlBottom.Height := v1;
752 splGraphsMoved(splGraphs);
753 end;
754 end
755 else if name = 'RCOLUMN' then
756 begin
757 if v1 > 0 then lvwItemsTop.Column[0].Width := v1;
758 if v2 > 0 then lvwItemsTop.Column[1].Width := v2;
759 if v3 > 0 then lvwItemsTop.Column[2].Width := v3;
760 if v4 > 0 then lvwItemsTop.Column[3].Width := v4;
761 end
762 else if name = 'RBCOLUMN' then
763 begin
764 if v1 > 0 then lvwItemsBottom.Column[0].Width := v1;
765 if v2 > 0 then lvwItemsBottom.Column[1].Width := v2;
766 if v3 > 0 then lvwItemsBottom.Column[2].Width := v3;
767 if v4 > 0 then lvwItemsBottom.Column[3].Width := v4;
768 end;
769 end;
770 end;
771 end;
772 FreeAndNil(aList);
773end;
774
775procedure TfrmGraphs.SetSize;
776var
777 name, v1, v2, v3, v4: string;
778 aList: TStrings;
779begin
780 aList := TStringList.Create;
781 if FGraphType = GRAPH_FLOAT then
782 begin
783 name := 'FBOUNDS';
784 v1 := inttostr(Left);
785 v2 := inttostr(Top);
786 v3 := inttostr(Width);
787 v4 := inttostr(Height);
788 if WindowState = wsMaximized then
789 aList.Add(name + '^0,0,0,0')
790 else
791 aList.Add(name + '^' + v1 +',' + v2 +',' + v3 +',' + v4);
792 name := 'FWIDTH';
793 v1 := inttostr(splItemsTop.Left);
794 aList.Add(name + '^' + v1);
795 name := 'FBOTTOM';
796 if chkDualViews.Checked then
797 v1 := inttostr(pnlBottom.Height)
798 else
799 v1 := '0';
800 aList.Add(name + '^' + v1);
801 name := 'FCOLUMN';
802 v1 := inttostr(lvwItemsTop.Column[0].Width);
803 v2 := inttostr(lvwItemsTop.Column[1].Width);
804 v3 := inttostr(lvwItemsTop.Column[2].Width);
805 v4 := inttostr(lvwItemsTop.Column[3].Width);
806 aList.Add(name + '^' + v1 +',' + v2 +',' + v3 +',' + v4);
807 name := 'FBCOLUMN';
808 v1 := inttostr(lvwItemsBottom.Column[0].Width);
809 v2 := inttostr(lvwItemsBottom.Column[1].Width);
810 v3 := inttostr(lvwItemsBottom.Column[2].Width);
811 v4 := inttostr(lvwItemsBottom.Column[3].Width);
812 aList.Add(name + '^' + v1 +',' + v2 +',' + v3 +',' + v4);
813 end
814 else
815 begin
816 name := 'RWIDTH';
817 v1 := inttostr(splItemsTop.Left);
818 aList.Add(name + '^' + v1);
819 name := 'RBOTTOM';
820 if chkDualViews.Checked then
821 v1 := inttostr(pnlBottom.Height)
822 else
823 v1 := '0';
824 aList.Add(name + '^' + v1);
825 name := 'RCOLUMN';
826 v1 := inttostr(lvwItemsTop.Column[0].Width);
827 v2 := inttostr(lvwItemsTop.Column[1].Width);
828 v3 := inttostr(lvwItemsTop.Column[2].Width);
829 v4 := inttostr(lvwItemsTop.Column[3].Width);
830 aList.Add(name + '^' + v1 +',' + v2 +',' + v3 +',' + v4);
831 name := 'RBCOLUMN';
832 v1 := inttostr(lvwItemsBottom.Column[0].Width);
833 v2 := inttostr(lvwItemsBottom.Column[1].Width);
834 v3 := inttostr(lvwItemsBottom.Column[2].Width);
835 v4 := inttostr(lvwItemsBottom.Column[3].Width);
836 aList.Add(name + '^' + v1 +',' + v2 +',' + v3 +',' + v4);
837 end;
838 rpcSetGraphSizing(aList);
839 FreeAndNil(aList);
840end;
841
842procedure TfrmGraphs.btnCloseClick(Sender: TObject);
843begin
844 Close;
845end;
846
847procedure TfrmGraphs.btnChangeSettingsClick(Sender: TObject);
848var
849 needtoupdate, okbutton: boolean;
850 conv, i, preconv: integer;
851 PreMaxGraphs: integer;
852 PreMaxSelect: integer;
853 PreMinGraphHeight: integer;
854 PreSortColumn: integer;
855 PreFixedDateRange: boolean;
856 aSettings, filetype, sourcetype: string;
857 PreSources: TStrings;
858begin
859 okbutton := false;
860 conv := btnChangeSettings.Tag;
861 preconv := conv;
862 with FGraphSetting do
863 begin
864 PreMaxGraphs := MaxGraphs;
865 PreMaxSelect := MaxSelect;
866 PreMinGraphHeight := MinGraphHeight;
867 PreSortColumn := SortColumn;
868 PreFixedDateRange := FixedDateRange;
869 MaxSelectMin := Max(Max(lvwItemsTop.SelCount, lvwItemsBottom.SelCount), 1);
870 end;
871 PreSources := TStringList.Create;
872 PreSources.Assign(FSources);
873 DialogGraphSettings(Font.Size, okbutton, FGraphSetting, FSources, conv, aSettings);
874 if not okbutton then exit;
875 if length(aSettings) > 0 then frmFrame.mnuToolsGraphing.Hint := aSettings;
876 btnChangeSettings.Tag := conv;
877 pnlInfo.Font.Size := lblViewsTop.Font.Size;
878 SetFontSize(lblViewsTop.Font.Size);
879 pnlInfo.Visible := conv > 0;
880 if conv > 0 then
881 begin
882 pnlInfo.Caption := TXT_WARNING;
883 pnlInfo.Color := COLOR_WARNING;
884 end;
885 pnlHeader.Visible := pnlInfo.Visible;
886 StayOnTop;
887 needtoupdate := (conv <> preconv);
888 for i := 0 to FSources.Count - 1 do
889 begin
890 sourcetype := FSources[i];
891 if Copy(sourcetype, 1, 1) = '*' then
892 begin
893 FSources[i] := Pieces(sourcetype, '^', 2, 4);
894 filetype := Piece(FSources[i], '^', 1);
895 lstItems.Items.AddStrings(rpcGetItems(filetype, Patient.DFN));
896 needtoupdate := true;
897 end;
898 if not needtoupdate then
899 if Piece(PreSources[i], '^', 3) = '0' then
900 needtoupdate := TypeIsDisplayed(Piece(sourcetype, '^', 1))
901 else
902 needtoupdate := not TypeIsDisplayed(Piece(sourcetype, '^', 1));
903 end;
904 if not needtoupdate then
905 with FGraphSetting do
906 if MaxGraphs <> PreMaxGraphs then
907 needtoupdate := true
908 else if MaxSelect <> PreMaxSelect then
909 needtoupdate := true
910 else if MinGraphHeight <> PreMinGraphHeight then
911 needtoupdate := true
912 else if SortColumn <> PreSortColumn then
913 needtoupdate := true
914 else if FixedDateRange <> PreFixedDateRange then
915 needtoupdate := true;
916 if needtoupdate then
917 begin
918 cboDateRangeChange(self);
919 end;
920 ChangeStyle;
921 if lvwItemsTop.SelCount = 0 then
922 begin
923 cboViewsTop.ItemIndex := -1;
924 cboViewsTop.Text := '';
925 end;
926 if lvwItemsBottom.SelCount = 0 then
927 begin
928 cboViewsBottom.ItemIndex := -1;
929 cboViewsBottom.Text := '';
930 end;
931end;
932
933procedure TfrmGraphs.chkDualViewsClick(Sender: TObject);
934begin
935 if chkDualViews.Checked then
936 begin
937 pnlBottom.Height := pnlMain.Height div 2;
938 lvwItemsTopClick(self);
939 end
940 else
941 begin
942 lvwItemsBottom.ClearSelection;
943 lvwItemsBottomClick(self);
944 pnlBottom.Height := 1;
945 end;
946 mnuPopGraphDualViews.Checked := chkDualViews.Checked;
947 with pnlMain.Parent do
948 if BorderWidth <> 1 then // only do on Graph in Reports tab
949 frmReports.chkDualViews.Checked := chkDualViews.Checked;
950end;
951
952procedure TfrmGraphs.LoadListView(aList: TStrings);
953var
954 i: integer;
955 filename, filenum, itemnum: string;
956begin
957 lvwItemsTop.Items.Clear;
958 lvwItemsBottom.Items.Clear;
959 lvwItemsTop.SortType := stNone; // if Sorting during load then potential error
960 lvwItemsBottom.SortType := stNone; // if Sorting during load then potential error
961 with lvwItemsTop do
962 for i := 0 to aList.Count - 1 do
963 begin
964 filenum := Piece(aList[i], '^', 1);
965 filename := FileNameX(filenum); // change rpc **********
966 itemnum := Piece(aList[i], '^', 2);
967 UpdateView(filename, filenum, itemnum, aList[i], lvwItemsTop);
968 end;
969 lvwItemsBottom.Items.Assign(lvwItemsTop.Items);
970 lvwItemsTop.SortType := stBoth;
971 lvwItemsBottom.SortType := stBoth;
972 if not FItemsSortedTop then
973 begin
974 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[0]);
975 FItemsSortedTop := true;
976 end;
977 if not FItemsSortedBottom then
978 begin
979 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[0]);
980 FItemsSortedBottom := true;
981 end;
982 with FGraphSetting do
983 if SortColumn > 0 then
984 begin
985 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[SortColumn]);
986 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[SortColumn]);
987 FItemsSortedTop := false;
988 FItemsSortedBottom := false;
989 end;
990end;
991
992procedure TfrmGraphs.FilterListView(oldestdate, newestdate: double);
993var
994 colnum, i: integer;
995 lastdate: double;
996 aProfile, filename, filenum, itemnum: string;
997begin
998 lvwItemsTop.Scroll(-BIG_NUMBER, -BIG_NUMBER); //faster to set scroll at top
999 lvwItemsBottom.Scroll(-BIG_NUMBER, -BIG_NUMBER);
1000 lvwItemsTop.Items.Clear;
1001 lvwItemsBottom.Items.Clear;
1002 lvwItemsTop.SortType := stNone; // if Sorting during load then potential error
1003 lvwItemsBottom.SortType := stNone; // if Sorting during load then potential error
1004 if (cboDateRange.ItemIndex > 0) and (cboDateRange.ItemIndex < 9) then
1005 begin
1006 with lvwItemsTop do
1007 if TypeIsDisplayed('405') then
1008 DateRangeItems(oldestdate, newestdate, '405'); // does not matter for all results ******************
1009 if TypeIsDisplayed('52') then
1010 DateRangeItems(oldestdate, newestdate, '52'); // does not matter for all results ******************
1011 if TypeIsDisplayed('55') then
1012 DateRangeItems(oldestdate, newestdate, '55');
1013 if TypeIsDisplayed('55NVA') then
1014 DateRangeItems(oldestdate, newestdate, '55NVA');
1015 if TypeIsDisplayed('9999911') then
1016 DateRangeItems(oldestdate, newestdate, '9999911');
1017 for i := 0 to lstItems.Items.Count - 1 do
1018 begin
1019 filenum := UpperCase(Piece(lstItems.Items[i], '^', 1));
1020 if filenum <> '405' then
1021 if filenum <> '52' then
1022 if filenum <> '55' then
1023 if filenum <> '55NVA' then
1024 if filenum <> '9999911' then
1025 if TypeIsDisplayed(filenum) then
1026 begin
1027 lastdate := strtofloatdef(Piece(lstItems.Items[i], '^', 6), -BIG_NUMBER);
1028 if (lastdate > oldestdate) and (lastdate < newestdate) then
1029 begin
1030 filename := FileNameX(filenum);
1031 itemnum := Piece(lstItems.Items[i], '^', 2);
1032 UpdateView(filename, filenum, itemnum, lstItems.Items[i], lvwItemsTop);
1033 end;
1034 end;
1035 end;
1036 end
1037 else if (cboDateRange.ItemIndex = 0) or (cboDateRange.ItemIndex > 8) then
1038 begin // manual date range selection
1039 for i := 0 to lstAllTypes.Items.Count - 1 do
1040 begin
1041 filenum := Piece(lstAllTypes.Items[i], '^', 1);
1042 if TypeIsDisplayed(filenum) then
1043 begin
1044 DateRangeItems(oldestdate, newestdate, filenum);
1045 end;
1046 end;
1047 end;
1048 lvwItemsBottom.Items.Assign(lvwItemsTop.Items);
1049 lvwItemsTop.SortType := stBoth;
1050 lvwItemsBottom.SortType := stBoth;
1051 colnum := 0;
1052 if not FItemsSortedTop then
1053 begin
1054 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[0]);
1055 FItemsSortedTop := true;
1056 end;
1057 if not FItemsSortedBottom then
1058 begin
1059 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[0]);
1060 FItemsSortedBottom := true;
1061 end;
1062 with FGraphSetting do
1063 if SortColumn > 0 then
1064 begin
1065 colnum := SortColumn;
1066 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[SortColumn]);
1067 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[SortColumn]);
1068 FItemsSortedTop := false;
1069 FItemsSortedBottom := false;
1070 end;
1071 if cboViewsTop.ItemIndex > 1 then // sort by view
1072 begin
1073 aProfile := cboViewsTop.Items[cboViewsTop.ItemIndex];
1074 AssignProfile(aProfile, 'top');
1075 if not FItemsSortedTop then lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[colnum]);
1076 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[2]);
1077 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[2]);
1078 FItemsSortedTop := false;
1079 end;
1080 if cboViewsBottom.ItemIndex > 1 then // sort by view
1081 begin
1082 aProfile := cboViewsBottom.Items[cboViewsBottom.ItemIndex];
1083 AssignProfile(aProfile, 'bottom');
1084 if not FItemsSortedBottom then lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[colnum]);
1085 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[2]);
1086 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[2]);
1087 FItemsSortedBottom := false;
1088 end;
1089end;
1090
1091procedure TfrmGraphs.DateRangeItems(oldestdate, newestdate: double; filenum: string);
1092var
1093 i, j: integer;
1094 filename, itemnum, itemstuff, mitemnum: string;
1095begin
1096 FastAssign(rpcDateItem(oldestdate, newestdate, filenum, Patient.DFN), lstScratchTemp.Items);
1097 filename := FileNameX(filenum);
1098 with lvwItemsTop do
1099 for i := 0 to lstScratchTemp.Items.Count - 1 do
1100 begin
1101 itemstuff := lstScratchTemp.Items[i];
1102 itemnum := UpperCase(Piece(itemstuff, '^',2));
1103 for j := 0 to lstItems.Items.Count - 1 do
1104 if (filenum = UpperCase(Piece(lstItems.Items[j], '^', 1))) and (itemnum = UpperCase(Piece(lstItems.Items[j], '^', 2))) then
1105 UpdateView(filename, filenum, itemnum, lstItems.Items[j], lvwItemsTop);
1106 if filenum = '63' then
1107 for j := 0 to lstMultiSpec.Items.Count - 1 do
1108 begin
1109 mitemnum := Piece(lstMultiSpec.Items[j], '^', 2);
1110 if itemnum = Piece(mitemnum, '.', 1) then
1111 if DateRangeMultiItems(oldestdate, newestdate, mitemnum) then //******** check specific date range
1112 UpdateView(filename, filenum, mitemnum, lstMultiSpec.Items[j], lvwItemsTop);
1113 end;
1114 end;
1115end;
1116
1117procedure TfrmGraphs.UpdateView(filename, filenum, itemnum, aString: string; aListView: TListView);
1118var
1119 drugclass, itemname, itemqualifier: string;
1120 aGraphItem: TGraphItem;
1121 aListItem: TListItem;
1122begin
1123 itemname := Piece(aString, '^', 4);
1124 itemqualifier := Pieces(aString, '^', 5, 9);
1125 itemqualifier := filenum + '^' + itemnum + '^' + itemqualifier;
1126 drugclass := Piece(aString, '^', 8);
1127 aListItem := aListView.Items.Add;
1128 with aListItem do
1129 begin
1130 Caption := itemname;
1131 SubItems.Add(filename);
1132 SubItems.Add('');
1133 SubItems.Add(drugclass);
1134 aGraphItem := TGraphItem.Create;
1135 aGraphItem.Values := itemqualifier;
1136 SubItems.AddObject('info object', aGraphItem);
1137 end;
1138end;
1139
1140function TfrmGraphs.DateRangeMultiItems(aOldDate, aNewDate: double; aMultiItem: string): boolean;
1141var
1142 i: integer;
1143 checkdate: double;
1144 fileitem: string;
1145begin
1146 Result := false;
1147 fileitem := '63^' + aMultiItem;
1148 for i := 0 to lstData.Items.Count - 1 do
1149 if Pieces(lstData.Items[i], '^', 1, 2) = fileitem then
1150 begin
1151 checkdate := strtofloatdef(Piece(lstData.Items[i], '^', 3), BIG_NUMBER);
1152 if checkdate <> BIG_NUMBER then
1153 if checkdate >= aOldDate then
1154 if checkdate <= aNewDate then
1155 begin
1156 Result := true;
1157 break;
1158 end;
1159 end;
1160end;
1161
1162function TfrmGraphs.FileNameX(filenum: string): string;
1163var
1164 i: integer;
1165 typestring: string;
1166begin
1167 Result := '';
1168 with lstAllTypes do
1169 for i := 0 to Items.Count - 1 do
1170 begin
1171 typestring := Items[i];
1172 if Piece(typestring, '^', 1) = filenum then
1173 begin
1174 Result := Piece(Items[i], '^', 2);
1175 break;
1176 end;
1177 end;
1178 if Result = '' then
1179 begin
1180 with lstAllTypes do
1181 for i := 0 to Items.Count - 1 do
1182 begin
1183 typestring := Items[i];
1184 if lowercase(Piece(typestring, '^', 1)) = filenum then
1185 begin
1186 Result := Piece(Items[i], '^', 2);
1187 break;
1188 end;
1189 end;
1190 end;
1191end;
1192
1193function TfrmGraphs.ItemName(filenum, itemnum: string): string;
1194var
1195 i: integer;
1196 typestring: string;
1197begin
1198 Result := '';
1199 filenum := UpperCase(filenum);
1200 itemnum := UpperCase(itemnum);
1201 with lstItems do
1202 for i := 0 to Items.Count - 1 do
1203 begin
1204 typestring := UpperCase(Items[i]);
1205 if (Piece(typestring, '^', 1) = filenum) and
1206 (Piece(typestring, '^', 2) = itemnum) then
1207 begin
1208 Result := Piece(typestring, '^', 4);
1209 break;
1210 end;
1211 end;
1212end;
1213
1214procedure TfrmGraphs.InitialData;
1215var
1216 i, total: integer;
1217 dfntype, listline: string;
1218begin
1219 total := pnlData.ControlCount - 1;
1220 with pnlData do
1221 for i:= 0 to total do
1222 if Controls[i] is TListBox then
1223 if Controls[i] <> lstAllTypes then
1224 if Controls[i] <> lstTestSpec then
1225 (Controls[i] as TListBox).Items.Clear;
1226 SourcesDefault;
1227 FSources.Assign(FSourcesDefault);
1228 btnChangeSettings.Tag :=0;
1229 btnClose.Tag := 0;
1230 cboViewsTop.Tag :=0;
1231 chartDatelineTop.Tag :=0;
1232 lvwItemsBottom.Tag :=0;
1233 lvwItemsTop.Tag :=0;
1234 pnlFooter.Parent.Tag :=0;
1235 pnlItemsBottom.Tag :=0;
1236 pnlItemsTop.Tag :=0;
1237 pnlTop.Tag :=0;
1238 scrlTop.Tag :=0;
1239 splGraphs.Tag :=0;
1240 cboViewsTop.ItemIndex := -1;
1241 cboViewsBottom.ItemIndex := -1;
1242 FastAssign(rpcGetTypes(Patient.DFN, false), lstTypes.Items);
1243 for i := 0 to lstTypes.Items.Count - 1 do
1244 begin
1245 dfntype := UpperCase(Piece(lstTypes.Items[i], '^', 1));
1246 if TypeIsLoaded(dfntype) then
1247 lstItems.Items.AddStrings(rpcGetItems(dfntype, Patient.DFN));
1248 listline := lstTypes.Items[i];
1249 dfntype := UpperCase(Piece(listline, '^', 1));
1250 SetPiece(listline, '^', 1, dfntype);
1251 lstTypes.Items[i] := listline;
1252 end;
1253 lstTypes.Hint := Patient.DFN; // use to check for patient change
1254 FMTimestamp := floattostr(FMNow);
1255 FPrevEvent := '';
1256 FWarning := false;
1257 FFirstSwitch := true;
1258end;
1259
1260function TfrmGraphs.TypeIsLoaded(itemtype: string): boolean;
1261var
1262 i: integer;
1263 filetype: string;
1264begin
1265 Result := false;
1266 for i := 0 to FSources.Count - 1 do
1267 begin
1268 filetype := Piece(FSources[i], '^', 1);
1269 if itemtype = filetype then
1270 begin
1271 Result := true;
1272 break;
1273 end;
1274 end;
1275end;
1276
1277function TfrmGraphs.TypeIsDisplayed(itemtype: string): boolean;
1278var
1279 i: integer;
1280 displayed, filetype: string;
1281begin
1282 Result := false;
1283 for i := 0 to FSources.Count - 1 do
1284 begin
1285 filetype := Piece(FSources[i], '^', 1);
1286 displayed := Piece(FSources[i], '^', 3);
1287 if (itemtype = filetype) then
1288 begin
1289 if displayed = '1' then Result := true;
1290 break;
1291 end;
1292 end;
1293end;
1294
1295procedure TfrmGraphs.LoadDateRange;
1296var
1297 defaults, defaultrange: string;
1298begin
1299 FastAssign(rpcGetGraphDateRange('OR_GRAPHS'), cboDateRange.Items);
1300 with cboDateRange do
1301 begin
1302 defaults := Items[Items.Count - 1];
1303 defaultrange := Piece(defaults, '^', 1);
1304 //get report views - param 1 and param 2
1305 lvwItemsTop.Hint := Piece(defaults,'^', 8); // top view
1306 lvwItemsBottom.Hint := Piece(defaults,'^', 9); // bottom view
1307 //check if default range already exists
1308 if strtointdef(defaultrange, BIG_NUMBER) = BIG_NUMBER then
1309 ItemIndex := Items.Count - 1;
1310 end;
1311end;
1312
1313procedure TfrmGraphs.LoadType(itemtype, displayed: string);
1314var
1315 needtoadd: boolean;
1316 i: integer;
1317 filename, filetype: string;
1318begin
1319 if displayed <> '1' then displayed := '';
1320 needtoadd := true;
1321 for i := 0 to FSources.Count - 1 do
1322 begin
1323 filetype := Piece(FSources[i], '^', 1);
1324 if itemtype = filetype then
1325 begin
1326 needtoadd := false;
1327 break;
1328 end;
1329 end;
1330 if needtoadd then
1331 begin
1332 filename := FileNameX(itemtype);
1333 FSources.Add(itemtype + '^' + filename + '^' + displayed);
1334 lstItems.Items.AddStrings(rpcGetItems(itemtype, Patient.DFN));
1335 end;
1336end;
1337
1338procedure TfrmGraphs.DisplayType(itemtype, displayed: string);
1339var
1340 i: integer;
1341 filename, filetype: string;
1342begin
1343 if displayed <> '1' then displayed := '';
1344 for i := 0 to FSources.Count - 1 do
1345 begin
1346 filetype := Piece(FSources[i], '^', 1);
1347 if itemtype = filetype then
1348 begin
1349 filename := FileNameX(itemtype);
1350 FSources[i] := itemtype + '^' + filename + '^' + displayed;
1351 break;
1352 end;
1353 end;
1354end;
1355
1356procedure TfrmGraphs.DisplayData(aSection: string);
1357var
1358 aChart: TChart;
1359 aCheckBox: TCheckBox;
1360 aListView, aOtherListView: TListView;
1361 aDateline, aRightPad: TPanel;
1362 aScrollBox: TScrollBox;
1363begin
1364 FHintStop := true;
1365 SetFontSize(lblViewsTop.Font.Size);
1366 if aSection = 'top' then
1367 begin
1368 aListView := lvwItemsTop;
1369 aOtherListView := lvwItemsBottom;
1370 aDateline := pnlDatelineTop;
1371 aRightPad := pnlTopRightPad;
1372 aScrollBox := scrlTop;
1373 aChart := chartDatelineTop;
1374 aCheckBox := chkItemsTop;
1375 end
1376 else
1377 begin
1378 aListView := lvwItemsBottom;
1379 aOtherListView := lvwItemsTop;
1380 aDateline := pnlDatelineBottom;
1381 aRightPad := pnlBottomRightPad;
1382 aScrollBox := scrlBottom;
1383 aChart := chartDatelineBottom;
1384 aCheckBox := chkItemsBottom;
1385 end;
1386 if aListView.SelCount < 1 then
1387 begin
1388 if not FFirstClick then
1389 begin
1390 FFirstClick := true;
1391 while aScrollBox.ControlCount > 0 do
1392 aScrollBox.Controls[0].Free;
1393 exit;
1394 end;
1395 FFirstClick := false;
1396 aDateline.Visible := false;
1397 while aScrollBox.ControlCount > 0 do
1398 aScrollBox.Controls[0].Free;
1399 if aOtherListView.SelCount > 0 then
1400 if aOtherListView = lvwItemsTop then
1401 ItemsClick(self, lvwItemsTop, lvwItemsBottom, chkItemsTop, cboViewsTop, lstSelCopyTop, 'top')
1402 else
1403 ItemsClick(self, lvwItemsBottom, lvwItemsTop, chkItemsBottom, cboViewsBottom, lstSelCopyBottom, 'bottom');
1404 exit;
1405 end;
1406 aScrollBox.VertScrollBar.Visible := false;
1407 aScrollBox.HorzScrollBar.Visible := false;
1408 aChart.RemoveAllSeries; // this would leave bottom dateline visible on date change
1409 //chartDatelineTop.RemoveAllSeries; // do both
1410 //chartDatelineBottom.RemoveAllSeries; // do both
1411 lstNonNumeric.Items.Clear;
1412 if aCheckBox.Checked then
1413 MakeSeparate(aScrollBox, aListView, aRightPad, aSection)
1414 else
1415 begin
1416 MakeTogether(aScrollBox, aListView, aRightPad, aSection);
1417 end;
1418 ChangeStyle;
1419 pnlInfo.Font.Size := lblViewsTop.Font.Size;
1420 if ((lvwItemsTop.SelCount > MAX_ITEM_DISCLAIMER) and (not chkItemsTop.Checked))
1421 or ((lvwItemsBottom.SelCount > MAX_ITEM_DISCLAIMER) and (not chkItemsBottom.Checked)) then
1422 begin
1423 pnlInfo.Caption := TXT_DISCLAIMER;
1424 pnlInfo.Color := COLOR_WARNING;
1425 pnlInfo.Visible := true;
1426 end
1427 else
1428 pnlInfo.Visible := false;
1429 if btnChangeSettings.Tag > 0 then
1430 begin
1431 pnlInfo.Caption := TXT_WARNING;
1432 pnlInfo.Color := COLOR_WARNING;
1433 pnlInfo.Visible := true;
1434 end;
1435 //if copy(pnlInfo.Caption, 1, 7) = 'Warning' then
1436 if FWarning then
1437 pnlInfo.Visible := true;
1438 pnlHeader.Visible := pnlInfo.Visible;
1439 aScrollBox.VertScrollBar.Visible := true;
1440 aScrollBox.HorzScrollBar.Visible := false;
1441end;
1442
1443procedure TfrmGraphs.chkItemsTopClick(Sender: TObject);
1444begin
1445 Screen.Cursor := crHourGlass;
1446 DisplayData('top');
1447 if FFirstSwitch then // this code makes events appear better (on first click was not displaying bar)
1448 begin
1449 chartBaseMouseDown(chartDatelineTop, mbLeft, [], 1, 1);
1450 DisplayData('top');
1451 FFirstSwitch := false;
1452 end;
1453 Screen.Cursor := crDefault;
1454end;
1455
1456procedure TfrmGraphs.chkItemsBottomClick(Sender: TObject);
1457begin
1458 Screen.Cursor := crHourGlass;
1459 DisplayData('bottom');
1460 if FFirstSwitch then // this code makes events appear better (on first click was not displaying bar)
1461 begin
1462 chartBaseMouseDown(chartDatelineBottom, mbLeft, [], 1, 1);
1463 DisplayData('bottom');
1464 FFirstSwitch := false;
1465 end;
1466 Screen.Cursor := crDefault;
1467end;
1468
1469procedure TfrmGraphs.BottomAxis(aScrollBox: TScrollBox);
1470var
1471 i: integer;
1472 ChildControl: TControl;
1473begin
1474 for i := 0 to aScrollBox.ControlCount - 1 do
1475 begin
1476 ChildControl := aScrollBox.Controls[i];
1477 with (ChildControl as TChart).BottomAxis do
1478 begin
1479 Automatic := false;
1480 Minimum := 0;
1481 Maximum := chartDatelineTop.BottomAxis.Maximum;
1482 Minimum := chartDatelineTop.BottomAxis.Minimum;
1483 end;
1484 end;
1485end;
1486
1487procedure TfrmGraphs.AdjustTimeframe;
1488begin
1489 with FGraphSetting do
1490 begin
1491 if HighTime = 0 then exit; // no data to chart clear form ???
1492 chartDatelineTop.BottomAxis.Minimum := 0; // avoid possible error
1493 chartDatelineTop.BottomAxis.Maximum := HighTime;
1494 if LowTime < HighTime then
1495 chartDatelineTop.BottomAxis.Minimum := LowTime;
1496 chartDatelineBottom.BottomAxis.Minimum := 0; // avoid possible error
1497 chartDatelineBottom.BottomAxis.Maximum := HighTime;
1498 if HighTime > FMDateTimeToDateTime(FMStopDate) then
1499 chartDatelineTop.BottomAxis.Maximum := FMDateTimeToDateTime(FMStopDate);
1500 if LowTime < FMDateTimeToDateTime(FMStartDate) then
1501 chartDatelineTop.BottomAxis.Minimum := FMDateTimeToDateTime(FMStartDate); // *****
1502 end;
1503 BottomAxis(scrlTop);
1504 BottomAxis(scrlBottom);
1505end;
1506
1507procedure TfrmGraphs.ChartOnZoom(Sender: TObject);
1508var
1509 i: integer;
1510 padding: double;
1511 datehx: string;
1512 BigTime, SmallTime: TDateTime;
1513 ChildControl: TControl;
1514begin
1515 if not (Sender is TChart) then exit;
1516 if not FGraphSetting.VerticalZoom then
1517 begin
1518 padding := 0; //(FYMaxValue - FYMinValue) * ((100 - ZOOM_PERCENT) * 0.01);
1519 (Sender as TChart).LeftAxis.Maximum := BIG_NUMBER; // avoid min>max error
1520 (Sender as TChart).LeftAxis.Minimum := -BIG_NUMBER;
1521 (Sender as TChart).LeftAxis.Maximum := FYMaxValue + padding; //padding 0?
1522 (Sender as TChart).LeftAxis.Minimum := FYMinValue - padding; //padding 0?
1523 end;
1524 SmallTime := (Sender as TChart).BottomAxis.Minimum;
1525 BigTime := (Sender as TChart).BottomAxis.Maximum;
1526 if BigTime < SmallTime then BigTime := SmallTime; // avoid min>max error
1527 for i := 0 to scrlTop.ControlCount - 1 do
1528 begin
1529 ChildControl := scrlTop.Controls[i];
1530 SizeDates((ChildControl as TChart), SmallTime, BigTime);
1531 end;
1532 SizeDates(chartDatelineTop, SmallTime, BigTime);
1533 for i := 0 to scrlBottom.ControlCount - 1 do
1534 begin
1535 ChildControl := scrlBottom.Controls[i];
1536 SizeDates((ChildControl as TChart), SmallTime, BigTime);
1537 end;
1538 SizeDates(chartDatelineBottom, SmallTime, BigTime);
1539 if FMouseDown and (Sender as TChart).Zoomed then
1540 begin
1541 datehx := FloatToStr(SmallTime) + '^' + FloatToStr(BigTime);
1542 lstZoomHistory.Items.Add(datehx);
1543 mnuPopGraphZoomBack.Enabled := true;
1544 FMouseDown := false;
1545 ZoomUpdateinfo(SmallTime, BigTime);
1546 end;
1547end;
1548
1549procedure TfrmGraphs.ChartOnUndoZoom(Sender: TObject);
1550var
1551 i: integer;
1552 padding: double;
1553 BigTime, SmallTime: TDateTime;
1554 ChildControl: TControl;
1555begin
1556 if not (Sender is TChart) then exit;
1557 FRetainZoom := false;
1558 mnuPopGraphZoomBack.Enabled := false;
1559 lstZoomHistory.Items.Clear;
1560 if not FGraphSetting.VerticalZoom then
1561 begin
1562 padding := 0; //(FYMaxValue - FYMinValue) * ((100 - ZOOM_PERCENT) * 0.01);
1563 (Sender as TChart).LeftAxis.Maximum := BIG_NUMBER; // avoid min>max error
1564 (Sender as TChart).LeftAxis.Minimum := -BIG_NUMBER;
1565 (Sender as TChart).LeftAxis.Maximum := FYMaxValue + padding; //padding 0?
1566 (Sender as TChart).LeftAxis.Minimum := FYMinValue - padding; //padding 0?
1567 end;
1568 SmallTime := (Sender as TChart).BottomAxis.Minimum;
1569 BigTime := (Sender as TChart).BottomAxis.Maximum;
1570 if BigTime < SmallTime then BigTime := SmallTime; // avoid min>max error
1571 for i := 0 to scrlTop.ControlCount - 1 do
1572 begin
1573 ChildControl := scrlTop.Controls[i];
1574 SizeDates((ChildControl as TChart), SmallTime, BigTime);
1575 end;
1576 SizeDates(chartDatelineTop, SmallTime, BigTime);
1577 for i := 0 to scrlBottom.ControlCount - 1 do
1578 begin
1579 ChildControl := scrlBottom.Controls[i];
1580 SizeDates((ChildControl as TChart), SmallTime, BigTime);
1581 end;
1582 SizeDates(chartDatelineBottom, SmallTime, BigTime);
1583 if FMouseDown then
1584 begin
1585 FMouseDown := false;
1586 pnlInfo.Caption := '';
1587 pnlInfo.Color := COLOR_INFO;
1588 pnlInfo.Visible := false;
1589 pnlHeader.Visible := false;
1590 end;
1591end;
1592
1593procedure TfrmGraphs.SizeDates(aChart: TChart; aSmallTime, aBigTime: TDateTime);
1594var
1595 datediff, yeardiff: integer;
1596begin
1597 with aChart.BottomAxis do
1598 begin
1599 Automatic := false;
1600 Maximum := BIG_NUMBER; // avoid min>max error
1601 Minimum := -BIG_NUMBER;
1602 Minimum := aSmallTime;
1603 Maximum := aBigTime;
1604 Increment := DateTimeStep[dtOneMinute];
1605 datediff := DaysBetween(aBigTime, aSmallTime);
1606 yeardiff := datediff div 365;
1607 DateTimeFormat := '';
1608 Labels := true;
1609 if yeardiff > 0 then
1610 begin
1611 if (pnlScrollTopBase.Width div yeardiff) < DWIDTH_MDY then
1612 DateTimeFormat := DFORMAT_MYY;
1613 if (pnlScrollTopBase.Width div yeardiff) < DWIDTH_MYY then
1614 DateTimeFormat := DFORMAT_YY;
1615 if (pnlScrollTopBase.Width div yeardiff) < DWIDTH_YY then
1616 Labels := false;
1617 end;
1618 end;
1619 if datediff < 1 then
1620 begin
1621 if not aChart.Foot.Visible then
1622 begin
1623 aChart.Foot.Text.Clear;
1624 aChart.Foot.Text.Insert(0, FormatDateTime('mmm d, yyyy', aSmallTime));
1625 aChart.Foot.Font.Color := clBtnText;
1626 aChart.Foot.Visible := true;
1627 end;
1628 end
1629 else
1630 aChart.Foot.Visible := false;
1631end;
1632
1633procedure TfrmGraphs.MakeSeparate(aScrollBox: TScrollBox; aListView:
1634 TListView; aPadPanel: TPanel; section: string);
1635var
1636 acnt, bcnt, displayheight, displaynum, gcnt, graphtype, i, j, lcnt, ncnt, pcnt, vcnt: integer;
1637 aTitle, checkdata, filetype, high, low, specimen, specnum, typeitem, units: string;
1638 newchart: TChart;
1639 aGraphItem: TGraphItem;
1640begin
1641 FNonNumerics := false;
1642 if section = 'top' then pnlItemsTop.Tag := 0 else pnlItemsBottom.Tag := 0;
1643 while aScrollBox.ControlCount > 0 do
1644 aScrollBox.Controls[0].Free;
1645 aPadPanel.Visible := false;
1646 if FGraphSetting.Hints then //**************
1647 begin
1648 chartDatelineTop.OnMouseMove := chartBaseMouseMove;
1649 chartDatelineBottom.OnMouseMove := chartBaseMouseMove;
1650 end
1651 else
1652 begin
1653 chartDatelineTop.OnMouseMove := nil;
1654 chartDatelineBottom.OnMouseMove := nil;
1655 end;
1656 pcnt := 0; gcnt := 0; vcnt := 0; lcnt := 0; ncnt := 0; bcnt := 0; acnt := 0;
1657 for j := 0 to aListView.Items.Count - 1 do
1658 if aListView.Items[j].Selected then
1659 begin
1660 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
1661 filetype := UpperCase(Piece(aGraphItem.Values, '^', 1));
1662 typeitem := UpperCase(Piece(aGraphItem.Values, '^', 2));
1663 graphtype := GraphTypeNum(filetype); //*****strtointdef(Piece(aListBox.Items[j], '^', 2), 1);
1664 if (filetype = '63') and (lstData.Items.Count > 0) then
1665 begin
1666 checkdata := '';
1667 for i := 0 to lstData.Items.Count - 1 do
1668 begin
1669 checkdata := lstData.Items[i];
1670 if (Piece(checkdata, '^', 1) = '63') and (Piece(checkdata, '^', 2) = typeitem) then
1671 break;
1672 end;
1673 specnum := Piece(checkdata, '^', 7);
1674 specimen := Piece(checkdata, '^', 8);
1675 RefUnits(typeitem, specnum, low, high, units);
1676 units := LowerCase(units);
1677 if units = '' then units := ' ';
1678 end
1679 else
1680 begin
1681 specimen := ''; low := ''; high := ''; units := '';
1682 end;
1683 aTitle := filetype + '^' + typeitem + '^' + aListView.Items[j].Caption + '^' +
1684 specimen + '^' + low + '^' + high + '^' + units;
1685 newchart := TChart.Create(self);
1686 with newchart do
1687 begin
1688 Parent := aScrollBox;
1689 View3D := false;
1690 height := 170;
1691 Align := alBottom;
1692 Align := alTop;
1693 AllowPanning := pmNone;
1694 Legend.LegendStyle := lsSeries;
1695 Legend.ShadowSize := 1;
1696 Legend.Color := clCream;
1697 Legend.VertMargin := 0;
1698 Legend.Alignment := laTop;
1699 Legend.Visible := true;
1700 Gradient.EndColor := clGradientActiveCaption;
1701 //SetPiece(aTitle, '^', 3, 'zzzz: ' + Piece(aTitle, '^', 3)); // test prefix
1702 if (graphtype = 1) and (btnChangeSettings.Tag = 1) then
1703 LeftAxis.Title.Caption := 'StdDev'
1704 else if (graphtype = 1) and (btnChangeSettings.Tag = 2) then
1705 begin
1706 LeftAxis.Title.Caption := '1/' + units;
1707 SetPiece(aTitle, '^', 3, 'Inverse ' + Piece(aTitle, '^', 3));
1708 end
1709 else
1710 LeftAxis.Title.Caption := units;
1711 if graphtype <> 1 then
1712 begin
1713 LeftAxis.Visible := false;
1714 MarginLeft := round((50 / (pnlScrollTopBase.Width + 1)) * 100); // ************* marginleft is a %
1715 end;
1716 BottomAxis.ExactDateTime := true;
1717 BottomAxis.Increment := DateTimeStep[dtOneMinute];
1718 HideDates(newchart);
1719 BevelOuter := bvNone;
1720 OnZoom := ChartOnZoom;
1721 OnUndoZoom := ChartOnUndoZoom;
1722 OnClickSeries := chartBaseClickSeries;
1723 OnClickLegend := chartBaseClickLegend;
1724 OnDblClick := mnuPopGraphDetailsClick;
1725 OnMouseDown := chartBaseMouseDown;
1726 if FGraphSetting.Hints then //*****
1727 OnMouseMove := chartBaseMouseMove
1728 else
1729 OnMouseMove := nil;
1730 end;
1731 splGraphs.Tag := 1; // show ref ranges
1732 if graphtype = 4 then graphtype := 2; // change points to be bars
1733 case graphtype of
1734 1: MakeLineSeries(newchart, aTitle, filetype, lcnt, ncnt, false);
1735 2: MakeBarSeries(newchart, aTitle, filetype, bcnt);
1736 3: MakeVisitGanttSeries(newchart, aTitle, filetype, vcnt);
1737 4: MakePointSeries(newchart, aTitle, filetype, pcnt);
1738 5: MakeArrowSeries(newchart, aTitle, filetype, acnt);
1739 6: MakeGanttSeries(newchart, aTitle, filetype, gcnt);
1740 7: MakeAGanttSeries(newchart, aTitle, filetype, gcnt);
1741 8: MakeManyGanttSeries(newchart, aTitle, filetype, gcnt);
1742 9: MakeWeightedArrowSeries(newchart, aTitle, filetype, acnt);
1743 10: MakeWeightedGanttSeries(newchart, aTitle, filetype, gcnt);
1744 end;
1745 end;
1746 if section = 'top' then
1747 begin
1748 pnlDatelineTop.Align := alBottom;
1749 pnlDatelineTop.Height := 30;
1750 scrlTop.Align := alClient;
1751 pnlDatelineTop.Visible := false;
1752 end
1753 else
1754 begin
1755 pnlDatelineBottom.Align := alBottom;
1756 pnlDatelineBottom.Height := 30;
1757 scrlBottom.Align := alClient;
1758 pnlDatelineBottom.Visible := false;
1759 end;
1760 with aScrollBox do
1761 begin
1762 if ControlCount < FGraphSetting.MaxGraphs then //**** formating should be made for top & bottom
1763 displaynum := ControlCount
1764 else
1765 displaynum := FGraphSetting.MaxGraphs;
1766 if displaynum = 0 then
1767 displaynum := 3;
1768 if (Height div displaynum) < FGraphSetting.MinGraphHeight then
1769 displayheight := FGraphSetting.MinGraphHeight
1770 else
1771 displayheight := (Height div displaynum);
1772 for i := 0 to aScrollBox.ControlCount - 1 do
1773 Controls[i].height := displayheight;
1774 end;
1775 if (FGraphSetting.HighTime = FGraphSetting.LowTime)
1776 or (lcnt = 1) or (pcnt = 1) or (bcnt = 1) or (vcnt = 1) then
1777 begin
1778 FGraphSetting.HighTime := FGraphSetting.HighTime + 1;
1779 FGraphSetting.LowTime := FGraphSetting.LowTime - 1;
1780 end;
1781 AdjustTimeframe;
1782 if chartDatelineTop.Visible then chartDatelineTop.ZoomPercent(ZOOM_PERCENT);
1783 if chartDatelineBottom.Visible then chartDatelineBottom.ZoomPercent(ZOOM_PERCENT);
1784 if FNonNumerics then
1785 if section = 'top' then pnlItemsTop.Tag := 1
1786 else pnlItemsBottom.Tag := 1;
1787end;
1788
1789procedure TfrmGraphs.MakeTogether(aScrollBox: TScrollBox; aListView:
1790 TListView; aPadPanel: TPanel; section: string);
1791var
1792 anylines, nolines, onlylines, singlelabtest: boolean;
1793 acnt, bcnt, cnt, gcnt, graphtype, i, j, lcnt, ncnt, pcnt, vcnt: integer;
1794 portion: double;
1795 aTitle, checkdata, filetype, high, low, specimen, specnum, typeitem, units: string;
1796 newchart: TChart;
1797 aGraphItem: TGraphItem;
1798begin
1799 pcnt := 0; gcnt := 0; lcnt := 0; ncnt := 0; bcnt := 0; acnt := 0;
1800 onlylines := true;
1801 anylines := false;
1802 nolines := true;
1803 FNonNumerics := false;
1804 if section = 'top' then pnlItemsTop.Tag := 0 else pnlItemsBottom.Tag := 0;
1805 if FGraphSetting.Hints then //******
1806 begin
1807 chartDatelineTop.OnMouseMove := chartBaseMouseMove;
1808 chartDatelineBottom.OnMouseMove := chartBaseMouseMove;
1809 end
1810 else
1811 begin
1812 chartDatelineTop.OnMouseMove := nil;
1813 chartDatelineBottom.OnMouseMove := nil;
1814 end;
1815 for j := 0 to aListView.Items.Count - 1 do
1816 if aListView.Items[j].Selected then
1817 begin
1818 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
1819 filetype := UpperCase(Piece(aGraphItem.Values, '^', 1));
1820 typeitem := UpperCase(Piece(aGraphItem.Values, '^', 2));
1821 if aListView.SelCount = 1 then // one lab test - make separate
1822 begin
1823 if filetype = '63' then
1824 begin
1825 MakeSeparate(aScrollBox, aListView, aPadPanel, section);
1826 exit;
1827 end;
1828 end;
1829 graphtype := GraphTypeNum(filetype);
1830 case graphtype of
1831 1: lcnt := lcnt + 1;
1832 2: bcnt := bcnt + 1;
1833 3: vcnt := vcnt + 1;
1834 4: pcnt := pcnt + 1;
1835 5: acnt := acnt + 1;
1836 6: gcnt := gcnt + 1;
1837 7: gcnt := gcnt + 1;
1838 8: gcnt := gcnt + 1;
1839 9: acnt := acnt + 1;
1840 end;
1841 if graphtype = 1 then
1842 begin
1843 anylines := true;
1844 nolines := false;
1845 end
1846 else
1847 onlylines := false;
1848 end;
1849 if section = 'top' then
1850 chkItemsTop.Checked := false
1851 else
1852 chkItemsBottom.Checked := false;
1853 lstTempCheck.Items.Clear;
1854 while aScrollBox.ControlCount > 0 do
1855 aScrollBox.Controls[0].Free;
1856 newchart := TChart.Create(self); // whynot use base?
1857 with newchart do // if a single line graph do lab stuff (ref range, units) ****************************************
1858 begin
1859 Parent := aScrollBox;
1860 View3D := false;
1861 Chart3DPercent := 10;
1862 AllowPanning := pmNone;
1863 Align := alClient;
1864 Gradient.EndColor := clGradientActiveCaption;
1865 Legend.LegendStyle := lsSeries;
1866 Legend.ShadowSize := 1;
1867 Legend.Color := clCream;
1868 Legend.VertMargin := 0;
1869 Legend.Alignment := laTop;
1870 Legend.Visible := true;
1871 LeftAxis.Title.Caption := ' ';
1872 BottomAxis.ExactDateTime := true;
1873 BottomAxis.Increment := DateTimeStep[dtOneMinute];
1874 HideDates(newchart);
1875 BevelOuter := bvNone;
1876 OnZoom := ChartOnZoom;
1877 OnUndoZoom := ChartOnUndoZoom;
1878 OnClickSeries := chartBaseClickSeries;
1879 OnClickLegend := chartBaseClickLegend;
1880 OnDblClick := mnuPopGraphDetailsClick;
1881 OnMouseDown := chartBaseMouseDown;
1882 if FGraphSetting.Hints then //******
1883 OnMouseMove := chartBaseMouseMove
1884 else
1885 OnMouseMove := nil;
1886 Visible := false;
1887 end;
1888 aPadPanel.Visible := true;
1889 portion := PortionSize(lcnt, pcnt, gcnt, vcnt, bcnt, acnt);
1890 if section = 'top' then
1891 SizeTogether(onlylines, nolines, anylines, scrlTop, newchart,
1892 pnlDatelineTop, pnlScrollTopBase, portion)
1893 else
1894 SizeTogether(onlylines, nolines, anylines, scrlBottom, newchart,
1895 pnlDatelineBottom, pnlScrollBottomBase, portion);
1896 if btnChangeSettings.Tag = 1 then splGraphs.Tag := 1 // show ref ranges
1897 else splGraphs.Tag := 0;
1898
1899 if nolines then
1900 begin
1901 pcnt := 0; gcnt := 0; vcnt := 0; bcnt := 0; acnt := 0;
1902 for j := 0 to aListView.Items.Count - 1 do
1903 if aListView.Items[j].Selected then
1904 begin
1905 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
1906 filetype := Piece(aGraphItem.Values, '^', 1);
1907 typeitem := Piece(aGraphItem.Values, '^', 2);
1908 aTitle := filetype + '^' + typeitem + '^' + aListView.Items[j].Caption + '^';
1909 graphtype := GraphTypeNum(filetype);
1910 if section = 'top' then
1911 MakeDateline(section, aTitle, filetype, chartDatelineTop, graphtype, bcnt, pcnt, gcnt, vcnt, acnt)
1912 else
1913 MakeDateline(section, aTitle, filetype, chartDatelineBottom, graphtype, bcnt, pcnt, gcnt, vcnt, acnt);
1914 end;
1915 if section = 'top' then
1916 begin
1917 scrlTop.Align := alTop;
1918 scrlTop.Height := 1; //pnlScrollTopBase.Height div 4;
1919 pnlDatelineTop.Align := alClient;
1920 pnlDatelineTop.Visible := true;
1921 end
1922 else
1923 begin
1924 scrlBottom.Align := alTop;
1925 scrlBottom.Height := 1; //pnlScrollBottomBase.Height div 4;
1926 pnlDatelineBottom.Align := alClient;
1927 pnlDatelineBottom.Visible := true;
1928 end;
1929 end
1930 else if onlylines then
1931 begin
1932 lcnt := 0;
1933 for j := 0 to aListView.Items.Count - 1 do
1934 if aListView.Items[j].Selected then
1935 begin
1936 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
1937 filetype := Piece(aGraphItem.Values, '^', 1);
1938 typeitem := Piece(aGraphItem.Values, '^', 2);
1939 if (filetype = '63') and (lstData.Items.Count > 0) then //***********
1940 begin
1941 checkdata := '';
1942 for i := 0 to lstData.Items.Count - 1 do
1943 begin
1944 checkdata := lstData.Items[i];
1945 if (Piece(checkdata, '^', 1) = '63') and (Piece(checkdata, '^', 2) = typeitem) then
1946 break;
1947 end;
1948 specnum := Piece(checkdata, '^', 7);
1949 specimen := Piece(checkdata, '^', 8);
1950 RefUnits(typeitem, specnum, low, high, units);
1951 units := LowerCase(units);
1952 if units = '' then units := ' ';
1953 end
1954 else
1955 begin
1956 specimen := ''; low := ''; high := ''; units := '';
1957 end;
1958 aTitle := filetype + '^' + typeitem + '^' + aListView.Items[j].Caption + '^' +
1959 specimen + '^' + low + '^' + high + '^' + units;
1960 MakeLineSeries(newchart, aTitle, filetype, lcnt, ncnt, true)
1961 end;
1962 if section = 'top' then
1963 begin
1964 pnlDatelineTop.Align := alBottom;
1965 pnlDatelineTop.Height := 5;
1966 scrlTop.Align := alClient;
1967 pnlDatelineTop.Visible := false;
1968 end
1969 else
1970 begin
1971 pnlDatelineBottom.Align := alBottom;
1972 pnlDatelineBottom.Height := 5;
1973 scrlBottom.Align := alClient;
1974 pnlDatelineBottom.Visible := false;
1975 end;
1976 with newchart do
1977 begin
1978 if btnChangeSettings.Tag = 1 then
1979 LeftAxis.Title.Caption := 'StdDev';
1980 Visible := true;
1981 end;
1982 end
1983 else if anylines then
1984 begin
1985 pcnt := 0; gcnt := 0; vcnt := 0; lcnt := 0; ncnt := 0; bcnt := 0; acnt := 0;
1986 cnt := 0;
1987 for j := 0 to aListView.Items.Count - 1 do
1988 if aListView.Items[j].Selected then
1989 begin
1990 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
1991 filetype := Piece(aGraphItem.Values, '^', 1);
1992 if filetype = '120.5' then
1993 begin
1994 cnt := BIG_NUMBER;
1995 break;
1996 end;
1997 if filetype = '63' then
1998 cnt := cnt + 1;
1999 if cnt > 1 then
2000 break;
2001 end;
2002 singlelabtest := cnt = 1;
2003 for j := 0 to aListView.Items.Count - 1 do
2004 if aListView.Items[j].Selected then
2005 begin
2006 aGraphItem := TGraphItem(aListView.Items.Item[j].SubItems.Objects[3]);
2007 filetype := Piece(aGraphItem.Values, '^', 1);
2008 typeitem := Piece(aGraphItem.Values, '^', 2);
2009 if (filetype = '63') and (lstData.Items.Count > 0) then //***********
2010 begin
2011 checkdata := '';
2012 for i := 0 to lstData.Items.Count - 1 do
2013 begin
2014 checkdata := lstData.Items[i];
2015 if (Piece(checkdata, '^', 1) = '63') and (Piece(checkdata, '^', 2) = typeitem) then
2016 break;
2017 end;
2018 specnum := Piece(checkdata, '^', 7);
2019 specimen := Piece(checkdata, '^', 8);
2020 RefUnits(typeitem, specnum, low, high, units);
2021 units := LowerCase(units);
2022 if units = '' then units := ' ';
2023 end
2024 else
2025 begin
2026 specimen := ''; low := ''; high := ''; units := '';
2027 end;
2028 aTitle := filetype + '^' + typeitem + '^' + aListView.Items[j].Caption + '^' +
2029 specimen + '^' + low + '^' + high + '^' + units;
2030 graphtype := GraphTypeNum(filetype);
2031 if graphtype = 1 then
2032 begin
2033 if btnChangeSettings.Tag = 1 then
2034 newchart.LeftAxis.Title.Caption := 'StdDev'
2035 else
2036 newchart.LeftAxis.Title.Caption := units;
2037 if singlelabtest then
2038 splGraphs.Tag := 1
2039 else
2040 splGraphs.Tag := 0;
2041 MakeLineSeries(newchart, aTitle, filetype, lcnt, ncnt, true);
2042 end
2043 else if section = 'top' then
2044 MakeDateline(section, aTitle, filetype, chartDatelineTop, graphtype, bcnt, pcnt, gcnt, vcnt, acnt)
2045 else
2046 MakeDateline(section, aTitle, filetype, chartDatelineBottom, graphtype, bcnt, pcnt, gcnt, vcnt, acnt);
2047 end;
2048 if section = 'top' then
2049 begin
2050 scrlTop.Align := alTop;
2051 pnlDatelineTop.Align := alBottom;
2052 pnlDatelineTop.Height := pnlScrollTopBase.Height div 2;
2053 scrlTop.Align := alClient;
2054 pnlDatelineTop.Visible := true;
2055 end
2056 else
2057 begin
2058 scrlBottom.Align := alTop;
2059 pnlDatelineBottom.Align := alBottom;
2060 pnlDatelineBottom.Height := pnlScrollBottomBase.Height div 2;
2061 scrlBottom.Align := alClient;
2062 pnlDatelineBottom.Visible := true;
2063 end;
2064 with newchart do
2065 begin
2066 if btnChangeSettings.Tag = 1 then
2067 LeftAxis.Title.Caption := 'StdDev';
2068 Visible := true;
2069 end;
2070 end;
2071 if (FGraphSetting.HighTime = FGraphSetting.LowTime)
2072 or (lcnt = 1) or (pcnt = 1) or (bcnt = 1) or (acnt = 1) or (vcnt = 1) then
2073 begin
2074 FGraphSetting.HighTime := FGraphSetting.HighTime + 1;
2075 FGraphSetting.LowTime := FGraphSetting.LowTime - 1;
2076 chartDatelineTop.LeftAxis.Minimum := chartDatelineTop.LeftAxis.Minimum - 0.5;
2077 chartDatelineTop.LeftAxis.Maximum := chartDatelineTop.LeftAxis.Maximum + 0.5;
2078 chartDatelineBottom.LeftAxis.Minimum := chartDatelineBottom.LeftAxis.Minimum - 0.5;
2079 chartDatelineBottom.LeftAxis.Maximum := chartDatelineBottom.LeftAxis.Maximum + 0.5;
2080 end;
2081 AdjustTimeframe;
2082 if chartDatelineTop.Visible then chartDatelineTop.ZoomPercent(ZOOM_PERCENT);
2083 if chartDatelineBottom.Visible then chartDatelineBottom.ZoomPercent(ZOOM_PERCENT);
2084 if FNonNumerics then
2085 if section = 'top' then pnlItemsTop.Tag := 1
2086 else pnlItemsBottom.Tag := 1;
2087end;
2088
2089function TfrmGraphs.PortionSize(lcnt, pcnt, gcnt, vcnt, bcnt, acnt: integer): double;
2090var
2091 etotal, evalue, dvalue, value: double;
2092begin
2093 dvalue := (gcnt + vcnt + acnt);
2094 evalue := (pcnt + bcnt) / 2;
2095 etotal := dvalue + evalue;
2096 if etotal > 0 then
2097 begin
2098 value := lcnt / etotal;
2099 if value > 4 then Result := 0.2
2100 else if etotal < 5 then Result := 0.2
2101 else if value < 0.25 then Result := 0.8
2102 else if value < 0.4 then Result := 0.6
2103 else Result := 0.5;
2104 end
2105 else
2106 Result := 0;
2107end;
2108
2109procedure TfrmGraphs.MakeDateline(section, aTitle, aFileType: string; aChart: TChart; graphtype: integer;
2110 var bcnt, pcnt, gcnt, vcnt, acnt: integer);
2111begin
2112 aChart.LeftAxis.Automatic := true;
2113 aChart.LeftAxis.Visible := true;
2114 //if graphtype = 4 then graphtype := 2; // makes all points into bars
2115 case graphtype of
2116 2: MakeBarSeries(aChart, aTitle, aFileType, bcnt);
2117 3: MakeVisitGanttSeries(aChart, aTitle, aFileType, vcnt);
2118 4: MakePointSeries(aChart, aTitle, aFileType, pcnt);
2119 5: MakeArrowSeries(aChart, aTitle, aFileType, acnt);
2120 6: MakeGanttSeries(aChart, aTitle, aFileType, gcnt);
2121 7: MakeAGanttSeries(aChart, aTitle, aFileType, gcnt);
2122 8: MakeManyGanttSeries(aChart, aTitle, aFileType, gcnt);
2123 9: MakeWeightedArrowSeries(aChart, aTitle, aFileType, acnt);
2124 10: MakeWeightedGanttSeries(aChart, aTitle, aFileType, gcnt);
2125 end;
2126end;
2127
2128procedure TfrmGraphs.SizeTogether(onlylines, nolines, anylines: Boolean; aScroll: TScrollBox;
2129 aChart: TChart; aPanel, aPanelBase: TPanel; portion: Double);
2130begin
2131 if onlylines then //top &bottom
2132 begin
2133 aScroll.Align := alTop;
2134 aScroll.Height := 1;
2135 aChart.Visible := false;
2136 aPanel.Align := alClient;
2137 aPanel.Visible := true;
2138 end
2139 else if nolines then
2140 begin
2141 aPanel.Align := alBottom;
2142 aPanel.Height := 5;
2143 aScroll.Align := alClient;
2144 aPanel.Visible := false;
2145 if btnChangeSettings.Tag = 1 then
2146 aChart.LeftAxis.Title.Caption := 'StdDev';
2147 end
2148 else if anylines then
2149 begin
2150 aScroll.Align := alTop;
2151 aPanel.Align := alBottom;
2152 aPanel.Height := round(aPanelBase.Height * portion);
2153 if aPanel.Height < 60 then
2154 if aPanelBase.Height > 100 then aPanel.Height := 60; //***
2155 aScroll.Align := alClient;
2156 aPanel.Visible := true;
2157 if btnChangeSettings.Tag = 1 then
2158 aChart.LeftAxis.Title.Caption := 'StdDev';
2159 end;
2160end;
2161
2162function TfrmGraphs.Vfactor(aTitle: string): double; // returns first numbers in string
2163var
2164 firstnum: boolean;
2165 i: integer;
2166 vfactor: string;
2167begin
2168 vfactor := '';
2169 firstnum := false;
2170 for i := 0 to length(aTitle) - 1 do
2171 if IsDelimiter('1234567890.', aTitle, i) then
2172 begin
2173 vfactor := vfactor + aTitle[i];
2174 firstnum := true;
2175 end
2176 else
2177 if firstnum = true then break;
2178 Result := strtofloatdef(vfactor, 1);
2179end;
2180
2181function TfrmGraphs.NextColor(aCnt: integer): TColor;
2182begin
2183 case (aCnt mod NUM_COLORS) of
2184 1: Result := clRed;
2185 2: Result := clBlue;
2186 3: Result := clYellow;
2187 4: Result := clGreen;
2188 5: Result := clFuchsia;
2189 6: Result := clMoneyGreen;
2190 7: Result := clOlive;
2191 8: Result := clLime;
2192 9: Result := clMedGray;
2193 10: Result := clNavy;
2194 11: Result := clAqua;
2195 12: Result := clGray;
2196 13: Result := clSkyBlue;
2197 14: Result := clTeal;
2198 15: Result := clBlack;
2199 0: Result := clPurple;
2200 16: Result := clMaroon;
2201 17: Result := clCream;
2202 18: Result := clSilver;
2203 else
2204 Result := clWhite;
2205 end;
2206end;
2207
2208
2209procedure TfrmGraphs.mnuPopGraphSwapClick(Sender: TObject);
2210var
2211 tempcheck: boolean;
2212 bottomview, i, j, topview: integer;
2213 typeitem: string;
2214 aGraphItem: TGraphItem;
2215begin
2216 FFirstClick := true;
2217 if (lvwItemsTop.SelCount = 0) and (lvwItemsBottom.SelCount = 0) then exit;
2218 topview := cboViewsTop.ItemIndex;
2219 bottomview := cboViewsBottom.ItemIndex;
2220 HideGraphs(true);
2221 with chkDualViews do
2222 if not Checked then
2223 begin
2224 Checked := true;
2225 Click;
2226 end;
2227 tempcheck := chkItemsTop.Checked;
2228 chkItemsTop.Checked := chkItemsBottom.Checked;
2229 chkItemsBottom.Checked := tempcheck;
2230 pnlBottom.Height := pnlMain.Height - pnlBottom.Height;
2231 lstScratchSwap.Items.Clear;
2232 if topview < 1 then
2233 with lvwItemsTop do
2234 for i := 0 to Items.Count - 1 do
2235 if Items[i].Selected then
2236 begin
2237 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2238 lstScratchSwap.Items.Add(aGraphItem.Values);
2239 end;
2240 if bottomview > 0 then
2241 begin
2242 cboViewsTop.ItemIndex := bottomview;
2243 cboViewsTopChange(self);
2244 end
2245 else
2246 begin
2247 cboViewsTop.ItemIndex := -1;
2248 cboViewsTop.Text := '';
2249 lvwItemsTop.ClearSelection;
2250 with lvwItemsBottom do
2251 for i := 0 to Items.Count - 1 do
2252 if Items[i].Selected then
2253 begin
2254 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2255 typeitem := Pieces(aGraphItem.Values, '^', 1, 2);
2256 for j := 0 to lvwItemsTop.Items.Count - 1 do
2257 begin
2258 aGraphItem := TGraphItem(lvwItemsTop.Items[j].SubItems.Objects[3]);
2259 if typeitem = Pieces(aGraphItem.Values, '^', 1, 2) then
2260 begin
2261 lvwItemsTop.Items[j].Selected := true;
2262 break;
2263 end;
2264 end;
2265 end;
2266 lvwItemsTopClick(self);
2267 end;
2268 if topview > 0 then
2269 begin
2270 cboViewsBottom.ItemIndex := topview;
2271 cboViewsBottomChange(self);
2272 end
2273 else
2274 begin
2275 cboViewsBottom.ItemIndex := -1;
2276 cboViewsBottom.Text := '';
2277 lvwItemsBottom.ClearSelection;
2278 with lstScratchSwap do
2279 for i := 0 to Items.Count - 1 do
2280 for j := 0 to lvwItemsBottom.Items.Count - 1 do
2281 begin
2282 aGraphItem := TGraphItem(lvwItemsBottom.Items.Item[j].SubItems.Objects[3]);
2283 if aGraphItem.Values = Items[i] then
2284 begin
2285 lvwItemsBottom.Items[j].Selected := true;
2286 break;
2287 end;
2288 end;
2289 lvwItemsBottomClick(self);
2290 end;
2291 lstScratchSwap.Items.Clear;
2292 HideGraphs(false);
2293end;
2294
2295procedure TfrmGraphs.mnuPopGraphSplitClick(Sender: TObject);
2296var
2297 i: integer;
2298 typeitem, typenum: string;
2299 aGraphItem: TGraphItem;
2300begin
2301 FFirstClick := true;
2302 if (lvwItemsTop.SelCount = 0) and (lvwItemsBottom.SelCount = 0) then exit;
2303 HideGraphs(true);
2304 with chkDualViews do
2305 if not Checked then
2306 begin
2307 Checked := true;
2308 Click;
2309 end;
2310 with cboViewsTop do
2311 if ItemIndex > -1 then
2312 begin
2313 ItemIndex := -1;
2314 Text := '';
2315 end;
2316 with cboViewsBottom do
2317 if ItemIndex > -1 then
2318 begin
2319 ItemIndex := -1;
2320 Text := '';
2321 end;
2322 chkItemsTop.Checked := true;
2323 chkItemsBottom.Checked := false;
2324 pnlBottom.Height := pnlMain.Height - pnlBottom.Height;
2325 lstScratchSwap.Items.Clear;
2326 with lvwItemsTop do
2327 for i := 0 to Items.Count - 1 do
2328 if Items[i].Selected then
2329 begin
2330 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2331 typeitem := Pieces(aGraphItem.Values, '^', 1, 2);
2332 lstScratchSwap.Items.Add(typeitem);
2333 end;
2334 with lvwItemsBottom do
2335 for i := 0 to Items.Count - 1 do
2336 if Items[i].Selected then
2337 begin
2338 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2339 typeitem := Pieces(aGraphItem.Values, '^', 1, 2);
2340 lstScratchSwap.Items.Add(typeitem);
2341 end;
2342 lvwItemsTop.ClearSelection;
2343 lvwItemsBottom.ClearSelection;
2344 with lstScratchSwap do
2345 for i := 0 to Items.Count - 1 do
2346 begin
2347 typeitem := Items[i];
2348 typenum := Piece(typeitem, '^', 1);
2349 if (typenum = '63') or (typenum = '120.5') then
2350 SelectItem(lvwItemsTop, typeitem)
2351 else
2352 SelectItem(lvwItemsBottom, typeitem);
2353 end;
2354 lvwItemsTopClick(self);
2355 lvwItemsBottomClick(self);
2356 lstScratchSwap.Items.Clear;
2357 HideGraphs(false);
2358end;
2359
2360procedure TfrmGraphs.SelectItem(aListView: TListView; typeitem: string);
2361var
2362 i: integer;
2363 aGraphItem: TGraphItem;
2364begin
2365 with aListView do
2366 for i := 0 to Items.Count - 1 do
2367 begin
2368 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2369 if typeitem = Pieces(aGraphItem.Values, '^', 1, 2) then
2370 Items[i].Selected := true;
2371 end;
2372end;
2373
2374procedure TfrmGraphs.mnuPopGraphLinesClick(Sender: TObject);
2375begin
2376 with FGraphSetting do Lines := not Lines;
2377 ChangeStyle;
2378end;
2379
2380procedure TfrmGraphs.mnuPopGraph3DClick(Sender: TObject);
2381begin
2382 with FGraphSetting do View3D := not View3D;
2383 ChangeStyle;
2384end;
2385
2386procedure TfrmGraphs.mnuPopGraphValuesClick(Sender: TObject);
2387begin
2388 with FGraphSetting do Values := not Values;
2389 ChangeStyle;
2390end;
2391
2392procedure TfrmGraphs.mnuPopGraphSortClick(Sender: TObject);
2393begin
2394 with FGraphSetting do
2395 begin
2396 if SortColumn = 1 then SortColumn := 0
2397 else SortColumn := 1;
2398 mnuPopGraphSort.Checked := SortColumn = 1;
2399 if not FItemsSortedTop then
2400 begin
2401 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[0]);
2402 FItemsSortedTop := true;
2403 end;
2404 if not FItemsSortedBottom then
2405 begin
2406 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[0]);
2407 FItemsSortedBottom := true;
2408 end;
2409 if SortColumn > 0 then
2410 begin
2411 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[SortColumn]);
2412 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[SortColumn]);
2413 FItemsSortedTop := false;
2414 FItemsSortedBottom := false;
2415 end;
2416 end;
2417end;
2418
2419procedure TfrmGraphs.mnuPopGraphClearClick(Sender: TObject);
2420begin
2421 with FGraphSetting do
2422 begin
2423 ClearBackground := not ClearBackground;
2424 if ClearBackground then Gradient := false;
2425 end;
2426 ChangeStyle;
2427 // redisplay if nonnumericonly graph exists
2428 if pnlItemsTop.Tag = 1 then lvwItemsTopClick(self);
2429 if pnlItemsBottom.Tag = 1 then lvwItemsBottomClick(self);
2430end;
2431
2432procedure TfrmGraphs.mnuPopGraphHorizontalClick(Sender: TObject);
2433begin
2434 with FGraphSetting do
2435 begin
2436 HorizontalZoom := not HorizontalZoom;
2437 mnuPopGraphHorizontal.Checked := HorizontalZoom;
2438 if not HorizontalZoom then mnuPopGraphResetClick(self);
2439 end;
2440end;
2441
2442procedure TfrmGraphs.mnuPopGraphVerticalClick(Sender: TObject);
2443begin
2444 with FGraphSetting do
2445 begin
2446 VerticalZoom := not VerticalZoom;
2447 mnuPopGraphVertical.Checked := VerticalZoom;
2448 if not VerticalZoom then mnuPopGraphResetClick(self);
2449 end;
2450end;
2451
2452procedure TfrmGraphs.mnuPopGraphDatesClick(Sender: TObject);
2453begin
2454 with FGraphSetting do Dates := not Dates;
2455 ChangeStyle;
2456end;
2457
2458procedure TfrmGraphs.mnuPopGraphDualViewsClick(Sender: TObject);
2459begin
2460 chkDualViews.Checked := not chkDualViews.Checked;
2461 chkDualViewsClick(self);
2462end;
2463
2464procedure TfrmGraphs.mnuPopGraphSeparate1Click(Sender: TObject);
2465begin
2466 with mnuPopGraphSeparate1 do
2467 Checked := not Checked;
2468 with chkItemsTop do
2469 begin
2470 Checked := mnuPopGraphSeparate1.Checked;
2471 Click;
2472 end;
2473 with chkItemsBottom do
2474 begin
2475 Checked := mnuPopGraphSeparate1.Checked;
2476 Click;
2477 end;
2478end;
2479
2480procedure TfrmGraphs.mnuPopGraphGradientClick(Sender: TObject);
2481begin
2482 with FGraphSetting do
2483 begin
2484 Gradient := not Gradient;
2485 if Gradient then ClearBackground := false;
2486 end;
2487 ChangeStyle;
2488end;
2489
2490procedure TfrmGraphs.mnuPopGraphHintsClick(Sender: TObject);
2491begin
2492 with FGraphSetting do
2493 Hints := not Hints;
2494 ChangeStyle;
2495end;
2496
2497procedure TfrmGraphs.mnuPopGraphLegendClick(Sender: TObject);
2498begin
2499 with FGraphSetting do Legend := not Legend;
2500 ChangeStyle;
2501end;
2502
2503procedure TfrmGraphs.ChartStyle(aChart: TChart);
2504var
2505 j: integer;
2506begin
2507 with aChart do
2508 begin
2509 View3D := FGraphSetting.View3D;
2510 Chart3DPercent := 10;
2511 AllowZoom := FGraphSetting.HorizontalZoom;
2512 Gradient.Visible := FGraphSetting.Gradient;
2513 Legend.Visible := FGraphSetting.Legend;
2514 HideDates(aChart);
2515 pnlHeader.Visible := pnlInfo.Visible;
2516 if FGraphSetting.ClearBackground then
2517 begin
2518 Color := clWindow;
2519 Legend.Color := clWindow;
2520 pnlBlankTop.Color := clWindow;
2521 pnlBlankBottom.Color := clWindow;
2522 end
2523 else
2524 begin
2525 Color := clBtnFace;
2526 Legend.Color := clCream;
2527 pnlBlankTop.Color := clBtnFace;
2528 pnlBlankBottom.Color := clBtnFace;
2529 end;
2530 for j := 0 to SeriesCount - 1 do
2531 begin
2532 if Series[j] is TLineSeries then
2533 with (Series[j] as TLineSeries) do
2534 begin
2535 Marks.Visible := FGraphSetting.Values;
2536 LinePen.Visible := FGraphSetting.Lines;
2537 end;
2538 if Series[j] is TPointSeries then
2539 with (Series[j] as TPointSeries) do
2540 begin
2541 Marks.Visible := FGraphSetting.Values;
2542 LinePen.Visible := FGraphSetting.Lines;
2543 end;
2544 if Series[j] is TBarSeries then
2545 with (Series[j] as TBarSeries) do
2546 begin
2547 Marks.Visible := FGraphSetting.Values;
2548 end;
2549 if Series[j] is TArrowSeries then
2550 with (Series[j] as TArrowSeries) do
2551 begin
2552 Marks.Visible := FGraphSetting.Values;
2553 end;
2554 if Series[j] is TGanttSeries then
2555 with (Series[j] as TGanttSeries) do
2556 begin
2557 Marks.Visible := FGraphSetting.Values;
2558 LinePen.Visible := FGraphSetting.Lines;
2559 end;
2560 end;
2561 end;
2562end;
2563
2564procedure TfrmGraphs.ChangeStyle;
2565var
2566 i: integer;
2567 ChildControl: TControl;
2568 OriginalColor, ClearColor: TColor;
2569begin
2570 OriginalColor := pnlItemsTopInfo.Color;
2571 ClearColor := clWindow;
2572 for i := 0 to scrlTop.ControlCount - 1 do
2573 begin
2574 ChildControl := scrlTop.Controls[i];
2575 ChartStyle(ChildControl as TChart);
2576 end;
2577 for i := 0 to scrlBottom.ControlCount - 1 do
2578 begin
2579 ChildControl := scrlBottom.Controls[i];
2580 ChartStyle(ChildControl as TChart);
2581 end;
2582 if pnlDateLineTop.Visible then // not visible when separate graphs
2583 ChartStyle(chartDateLineTop);
2584 if pnlDateLineBottom.Visible then
2585 ChartStyle(chartDateLineBottom);
2586 if FGraphSetting.ClearBackground then
2587 begin
2588 chartDatelineTop.Color := ClearColor;
2589 chartDatelineTop.Legend.Color := ClearColor;
2590 pnlDatelineTopSpacer.Color := ClearColor;
2591 scrlTop.Color := ClearColor;
2592 pnlTopRightPad.Color := ClearColor;
2593 pnlScrollTopBase.Color := ClearColor;
2594 pnlBlankTop.Color := ClearColor;
2595 chartDatelineBottom.Color := ClearColor;
2596 chartDatelineBottom.Legend.Color := ClearColor;
2597 pnlDatelineBottomSpacer.Color := ClearColor;
2598 scrlBottom.Color := ClearColor;
2599 pnlBottomRightPad.Color := ClearColor;
2600 pnlScrollBottomBase.Color := ClearColor;
2601 pnlBlankBottom.Color := ClearColor;
2602 end
2603 else
2604 begin
2605 chartDatelineTop.Color := OriginalColor;
2606 chartDatelineTop.Legend.Color := clCream;
2607 pnlDatelineTopSpacer.Color := OriginalColor;
2608 scrlTop.Color := OriginalColor;
2609 pnlTopRightPad.Color := OriginalColor;
2610 pnlScrollTopBase.Color := OriginalColor;
2611 pnlBlankTop.Color := OriginalColor;
2612 chartDatelineBottom.Color := OriginalColor;
2613 chartDatelineBottom.Legend.Color := clCream;
2614 pnlDatelineBottomSpacer.Color := OriginalColor;
2615 scrlBottom.Color := OriginalColor;
2616 pnlBottomRightPad.Color := OriginalColor;
2617 pnlScrollBottomBase.Color := OriginalColor;
2618 pnlBlankBottom.Color := OriginalColor;
2619 end;
2620 mnuPopGraphLines.Checked := FGraphSetting.Lines;
2621 mnuPopGraph3D.Checked := FGraphSetting.View3D;
2622 mnuPopGraphValues.Checked := FGraphSetting.Values;
2623 mnuPopGraphDates.Checked := FGraphSetting.Dates;
2624 mnuPopGraphFixed.Checked := FGraphSetting.FixedDateRange;
2625 mnuPopGraphGradient.Checked := FGraphSetting.Gradient;
2626 mnuPopGraphHints.Checked := FGraphSetting.Hints;
2627 mnuPopGraphStayOnTop.Checked := FGraphSetting.StayOnTop;
2628 mnuPopGraphLegend.Checked := FGraphSetting.Legend;
2629 mnuPopGraphSort.Checked := FGraphSetting.SortColumn = 1;
2630 mnuPopGraphClear.Checked := FGraphSetting.ClearBackground;
2631 mnuPopGraphVertical.Checked := FGraphSetting.VerticalZoom;
2632 mnuPopGraphHorizontal.Checked := FGraphSetting.HorizontalZoom;
2633end;
2634
2635procedure TfrmGraphs.chartBaseClickSeries(Sender: TCustomChart; Series: TChartSeries;
2636 ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2637var
2638 dttm, seriestitle, textvalue, textvalue1, textvalue2, typename, typenum: string;
2639begin
2640 timHintPause.Enabled := false;
2641 InactivateHint;
2642 FGraphClick := Sender;
2643 FGraphSeries := Series;
2644 FGraphValueIndex := ValueIndex;
2645 chartDateLineTop.Tag := 1; // indicates a series click
2646 if (Series is TGanttSeries) then
2647 begin
2648 FDate1 := (Series as TGanttSeries).StartValues[ValueIndex];
2649 FDate2 := (Series as TGanttSeries).EndValues[ValueIndex];
2650 end
2651 else
2652 begin
2653 FDate1 := Series.XValue[ValueIndex];
2654 FDate2 := FDate1;
2655 end;
2656 seriestitle := Series.Title;
2657 if Button <> mbRight then
2658 begin
2659 textvalue := ValueText(Sender, Series, ValueIndex);
2660 dttm := Piece(textvalue, '^', 3);
2661 if copy(textvalue, length(textvalue) - 5, length(textvalue)) = ' 00:00' then
2662 dttm := Pieces(dttm, ' ', 1, 3);
2663 textvalue1 := Piece(textvalue, '^', 2) + ' ' + dttm;
2664 textvalue2 := Piece(textvalue, '^', 4) + ' ' + Piece(textvalue, '^', 5);
2665 typenum := trim(Piece(textvalue, '^', 1));
2666 typename := Piece(textvalue, '^', 2);
2667 AllTypeDate(typenum, typename, textvalue1, textvalue2, FDate1, FDate2);
2668 end
2669 else
2670 begin
2671 mnuPopGraphIsolate.Enabled := true;
2672 if pnlTop.Tag = 1 then
2673 mnuPopGraphIsolate.Caption := 'Move - ' + seriestitle + ' - from Top to Bottom'
2674 else
2675 mnuPopGraphIsolate.Caption := 'Move - ' + seriestitle + ' - from Bottom to Top';
2676 scrlTop.Hint := 'Details - for ' + seriestitle + ' for ' +
2677 FormatDateTime('mmm d, yyyy h:nn am/pm', FDate1);
2678 scrlTop.Tag := ValueIndex + 1;
2679 mnuPopGraphIsolate.Hint := seriestitle;
2680 mnuPopGraphRemove.Enabled := true;
2681 mnuPopGraphRemove.Caption := 'Remove - ' + seriestitle;
2682 mnuPopGraphDetails.Caption := 'Details - ' + seriestitle;
2683 end;
2684 FMouseDown := false;
2685end;
2686
2687procedure TfrmGraphs.AllTypeDate(aType, aTypeName, firstline, secondline: string; aDate, aDate2: double);
2688var
2689 i: integer;
2690 dttm, datax, datex1, datex2, fmdate1, fmdate2, newdata, newline, oldline, spacer, titlemsg: string;
2691 dt1, dt2, dtdata, dtdata1, dtdata2: double;
2692 tmpOtherList, templist: TStringList;
2693begin
2694 Screen.Cursor := crHourGlass;
2695 tmpOtherList := TStringList.Create;
2696 templist := TStringList.Create;
2697 datex1 := floattostr(DateTimeToFMDateTime(aDate));
2698 datex1 := Piece(datex1, '.', 1);
2699 if aDate <> aDate2 then
2700 datex2 := Piece(floattostr(DateTimeToFMDateTime(aDate2)), '.', 1) + '.23595959'
2701 else
2702 datex2 := datex1 + '.23595959';
2703 dt1 := strtofloatdef(datex1, BIG_NUMBER);
2704 dt2 := strtofloatdef(datex2, BIG_NUMBER);
2705 CheckToAddData(lvwItemsTop, 'top', aType); // if type is not loaded - load data
2706 for i := 0 to lstData.Items.Count - 1 do
2707 begin
2708 datax := lstData.Items[i];
2709 if Piece(datax, '^', 1) = aType then
2710 begin
2711 if (length(Piece(datax, '^', 4))> 0) then // date/times of episodes
2712 begin
2713 dtdata1 := strtofloatdef(Piece(datax, '^', 3), -1);
2714 fmdate1 := FormatFMDateTime('mm/dd/yy hh:nn', dtdata1);
2715 if copy(fmdate1, length(fmdate1) - 5, length(fmdate1)) = ' 00:00' then
2716 fmdate1 := copy(fmdate1, 1, length(fmdate1) - 5) + ' ';
2717 dtdata2 := strtofloatdef(Piece(datax, '^', 4), -1);
2718 fmdate2 := FormatFMDateTime('mm/dd/yy hh:nn', dtdata2);
2719 if copy(fmdate2, length(fmdate2) - 5, length(fmdate2)) = ' 00:00' then
2720 fmdate2 := copy(fmdate2, 1, length(fmdate2) - 5) + ' ';
2721 if (dtdata2 > dt1) and (dtdata1 < dt2) then
2722 begin
2723 newdata := Piece(datax, '^', 3) + '^' +
2724 Piece(datax, '^', 2) + '^' +
2725 fmdate1 + ' - ' +
2726 fmdate2 + '^' +
2727 ItemName(aType, Piece(datax, '^', 2)) + '^' +
2728 Piece(datax, '^', 5);
2729 tmpOtherList.Add(MixedCase(newdata));
2730 end;
2731 end
2732 else
2733 begin
2734 dtdata := strtofloatdef(Piece(datax, '^', 3), -1);
2735 if (dtdata >= dt1) and (dtdata < dt2) then
2736 begin
2737 if length(Piece(Piece(datax, '^', 3), '.', 2)) > 0 then
2738 dttm := FormatFMDateTime('mm/dd/yy hh:nn', dtdata)
2739 else
2740 dttm := FormatFMDateTime('mm/dd/yy', dtdata);
2741 newdata := Piece(datax, '^', 3) + '^' +
2742 Piece(datax, '^', 2) + '^' +
2743 Piece(datax, '^', 5) + '^' +
2744 dttm + '^' +
2745 ItemName(aType, Piece(datax, '^', 2));
2746 tmpOtherList.Add(MixedCase(newdata));
2747 end;
2748 end;
2749 end;
2750 end;
2751 with tmpOtherList do
2752 begin
2753 Sort;
2754 for i := Count - 1 downto 0 do
2755 begin
2756 newline := '';
2757 oldline := tmpOtherList[i];
2758 newline := Piece(oldline, '^', 4) + ' ' +
2759 Piece(oldline, '^', 5);
2760 spacer := Copy(BIG_SPACES, 1, 40 - length(newline));
2761 newline := newline + spacer + ' ' +
2762 Piece(oldline, '^', 3);
2763 templist.Add(newline);
2764 end;
2765 Clear;
2766 Assign(templist);
2767 if aDate <> aDate2 then
2768 titlemsg := aTypeName + ' occurences for ' + FormatDateTime('mmm d, yyyy', aDate) +
2769 ' - ' + FormatDateTime('mmm d, yyyy', aDate2)
2770 else
2771 titlemsg := aTypeName + ' occurences for ' + FormatDateTime('mmm d, yyyy', aDate);
2772 Insert(0, firstline);
2773 Insert(1, secondline);
2774 Insert(2, '');
2775 Insert(3, 'All ' + titlemsg + ':');
2776 Insert(4, '');
2777 Insert(0, TXT_REPORT_DISCLAIMER);
2778 Insert(1, '');
2779 ReportBox(tmpOtherList, titlemsg, true);
2780 end;
2781 tmpOtherList.Free;
2782 templist.Free;
2783 Screen.Cursor := crDefault;
2784end;
2785
2786
2787procedure TfrmGraphs.ItemDateRange(Sender: TCustomChart);
2788var
2789 bpnotdone, ok: boolean;
2790 i, j: integer;
2791 prevtype, results, seriestitle, seriestype, spacer, textvalue, typenum: string;
2792 tmpOtherList: TStringList;
2793begin
2794 Screen.Cursor := crHourGlass;
2795 prevtype := '';
2796 tmpOtherList := TStringList.Create;
2797 with tmpOtherList do
2798 begin
2799 Add('Date Range: ' + cboDateRange.Text);
2800 Add('Selected Items from ' +
2801 FormatDateTime('mm/dd/yy', FGraphSetting.LowTime) + ' to ' +
2802 FormatDateTime('mm/dd/yy', FGraphSetting.HighTime));
2803 Add('');
2804 end;
2805 bpnotdone := true;
2806 for i := 0 to Sender.SeriesCount - 1 do
2807 begin
2808 if Sender.Series[i].Count > 0 then
2809 begin
2810 textvalue := ValueText(Sender, Sender.Series[i], 0);
2811 seriestype := Piece(textvalue, '^', 2);
2812 if (seriestype <> '') and (seriestype <> prevtype) then
2813 begin
2814 tmpOtherList.Add(' ' + seriestype); // type
2815 prevtype := seriestype;
2816 end;
2817 end;
2818 ok := true;
2819 seriestitle := Sender.Series[i].Title;
2820 if seriestitle = 'Blood Pressure' then
2821 if bpnotdone = false then ok := false;
2822 if ok then
2823 begin
2824 for j := 0 to Sender.Series[i].Count - 1 do
2825 begin
2826 textvalue := ValueText(Sender, Sender.Series[i], j);
2827 seriestitle := Piece(textvalue, '^', 4);
2828 typenum := Piece(textvalue, '^', 1);
2829 if (typenum = '120.5') and (seriestitle = 'Blood Pressure') then bpnotdone := false;
2830 if length(typenum) > 0 then
2831 begin
2832 spacer := Copy(BIG_SPACES, 1, 30 - length(seriestitle));
2833 results := seriestitle + ': ' + //spacer +
2834 Piece(textvalue, '^', 5); //LowerCase(Piece(textvalue, '^', 5));
2835 spacer := Copy(BIG_SPACES, 1, 40 - length(results));
2836 results := results + ' ' + spacer + Piece(textvalue, '^', 6);
2837 if copy(results, length(results) - 5, length(results)) = ' 00:00' then
2838 results := copy(results, 1, length(results) - 5);
2839 tmpOtherList.Add(results); // item occurrence
2840 end;
2841 end;
2842 end;
2843 end; // same items are not being sorted by date
2844 if tmpOtherList.Count > 0 then
2845 begin
2846 tmpOtherList.Insert(0, TXT_REPORT_DISCLAIMER);
2847 tmpOtherList.Insert(1, '');
2848 ReportBox(tmpOtherList, 'Selected Items from Graph', true);
2849 end;
2850 tmpOtherList.Free;
2851 FMouseDown := false;
2852 Screen.Cursor := crDefault;
2853end;
2854
2855procedure TfrmGraphs.mnuPopGraphIsolateClick(Sender: TObject);
2856var
2857 i, j, selnum: integer;
2858 aSection, aOtherSection, typeitem: string;
2859 aGraphItem: TGraphItem;
2860 aListView, aOtherListView: TListView;
2861begin
2862 FFirstClick := true;
2863 cboViewsTop.ItemIndex := -1;
2864 cboViewsTop.Text := '';
2865 cboViewsBottom.ItemIndex := -1;
2866 cboViewsBottom.Text := '';
2867 if pnlTop.Tag = 1 then
2868 begin
2869 aListView := lvwItemsTop;
2870 aOtherListView := lvwItemsBottom;
2871 aSection := 'top';
2872 aOtherSection := 'bottom';
2873 end
2874 else
2875 begin
2876 aListView := lvwItemsBottom;
2877 aOtherListView := lvwItemsTop;
2878 aSection := 'bottom';
2879 aOtherSection := 'top';
2880 end;
2881 if aListView.SelCount = 0 then exit;
2882 if StripHotKey(mnuPopGraphIsolate.Caption) = ('Move all selections to ' + aOtherSection) then
2883 begin
2884 with aListView do
2885 for i := 0 to Items.Count - 1 do
2886 if Items[i].Selected then
2887 begin
2888 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]);
2889 typeitem := Pieces(aGraphItem.Values, '^', 1, 2);
2890 for j := 0 to aOtherListView.Items.Count - 1 do
2891 begin
2892 aGraphItem := TGraphItem(aOtherListView.Items.Item[j].SubItems.Objects[3]);
2893 if Pieces(aGraphItem.Values, '^', 1, 2) = typeitem then
2894 aOtherListView.Items[j].Selected := true;
2895 end;
2896 Items[i].Selected := false;
2897 end;
2898 with chkDualViews do
2899 if not Checked then
2900 begin
2901 Checked := true;
2902 Click;
2903 end;
2904 ChangeStyle;
2905 DisplayData(aSection);
2906 DisplayData(aOtherSection);
2907 end
2908 else
2909 begin
2910 ItemCheck(lvwItemsTop, mnuPopGraphIsolate.Hint, selnum, typeitem);
2911 if selnum = -1 then exit;
2912 for i := 0 to aOtherListView.Items.Count - 1 do
2913 begin
2914 aGraphItem := TGraphItem(aOtherListView.Items.Item[i].SubItems.Objects[3]);
2915 if Pieces(aGraphItem.Values, '^', 1, 2) = typeitem then
2916 aOtherListView.Items[i].Selected := true;
2917 end;
2918 aListView.Items[selnum].Selected := false;
2919 with chkDualViews do
2920 if not Checked then
2921 begin
2922 Checked := true;
2923 Click;
2924 end;
2925 ChangeStyle;
2926 DisplayData(aSection);
2927 DisplayData(aOtherSection);
2928 end;
2929 mnuPopGraphIsolate.Enabled := false;
2930end;
2931
2932procedure TFrmGraphs.ItemCheck(aListView: TListView; aItemName: string;
2933 var aNum: integer; var aTypeItem: string);
2934var
2935 i: integer;
2936 aGraphItem: TGraphItem;
2937begin
2938 aNum := -1;
2939 aTypeItem := '';
2940 with aListView do
2941 for i := 0 to Items.Count - 1 do
2942 if Items[i].Caption = aItemName then
2943 begin
2944 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]); //get file^ien match
2945 aNum := i;
2946 aTypeItem := Pieces(aGraphItem.Values, '^', 1, 2);
2947 break;
2948 end;
2949 if aNum = -1 then
2950 begin
2951 aItemName := ReverseString(aItemName);
2952 aItemName := Pieces(aItemName, '(', 2, DelimCount(aItemName, '(') + 1);
2953 aItemName := Copy(aItemName, 2, length(aItemName) - 1);
2954 aItemName := ReverseString(aItemName);
2955 with aListView do
2956 for i := 0 to Items.Count - 1 do
2957 if Items[i].Caption = aItemName then // match without (specimen)
2958 begin
2959 aGraphItem := TGraphItem(Items.Item[i].SubItems.Objects[3]); //get file^ien match
2960 aNum := i;
2961 aTypeItem := Pieces(aGraphItem.Values, '^', 1, 2);
2962 break;
2963 end;
2964 end;
2965end;
2966
2967procedure TfrmGraphs.chartBaseMouseDown(Sender: TObject; Button: TMouseButton;
2968 Shift: TShiftState; X, Y: Integer);
2969begin
2970 FHintStop := true;
2971 timHintPause.Enabled := false;
2972 InactivateHint;
2973 chartDatelineTop.Tag := 0; // not legend or series click
2974 scrlTop.Hint := '';
2975 scrlTop.Tag := 0;
2976 FYMinValue := (Sender as TChart).MinYValue((Sender as TChart).LeftAxis);
2977 FYMaxValue := (Sender as TChart).MaxYValue((Sender as TChart).LeftAxis);
2978 pnlTop.Tag := 1;
2979 if (Sender as TControl).Parent = pnlBottom then pnlTop.Tag := 0;
2980 if ((Sender as TControl).Parent as TControl) = pnlBottom then pnlTop.Tag := 0;
2981 if (((Sender as TControl).Parent as TControl).Parent as TControl).Parent = pnlBottom then pnlTop.Tag := 0;
2982 if pnlTop.Tag = 1 then
2983 begin
2984 mnuPopGraphIsolate.Caption := 'Move all selections to bottom';
2985 mnuPopGraphRemove.Caption := 'Remove all selections from top';
2986 end
2987 else
2988 begin
2989 mnuPopGraphIsolate.Caption := 'Move all selections to top';
2990 mnuPopGraphRemove.Caption := 'Remove all selections from bottom';
2991 end;
2992 If Button = mbLeft then
2993 FMouseDown := true;
2994end;
2995
2996procedure TfrmGraphs.mnuPopGraphStuffPopup(Sender: TObject);
2997begin
2998 if scrlTop.Tag = 0 then scrlTop.Hint := '';
2999 if (lvwItemsTop.SelCount = 0) and (lvwItemsBottom.SelCount = 0) then scrlTop.Hint := '';
3000 if scrlTop.Hint = '' then
3001 begin
3002 if Pieces(mnuPopGraphIsolate.Caption, ' ', 1, 3) = 'Move all selections' then
3003 mnuPopGraphIsolate.Enabled := true
3004 else
3005 begin
3006 mnuPopGraphIsolate.Caption := 'Move';
3007 mnuPopGraphIsolate.Enabled := false;
3008 end;
3009 if Pieces(mnuPopGraphRemove.Caption, ' ', 1, 3) = 'Remove all selections' then
3010 mnuPopGraphRemove.Enabled := true
3011 else
3012 begin
3013 mnuPopGraphRemove.Caption := 'Remove';
3014 mnuPopGraphRemove.Enabled := false;
3015 end;
3016 mnuPopGraphDetails.Caption := 'Details...';
3017 mnuPopGraphDetails.Enabled := (lvwItemsTop.SelCount > 0) or (lvwItemsBottom.SelCount > 0);
3018 end
3019 else
3020 begin
3021 mnuPopGraphIsolate.Enabled := true;
3022 mnuPopGraphRemove.Enabled := true;
3023 mnuPopGraphDetails.Enabled := true;
3024 end;
3025 mnuPopGraphSwap.Enabled := (lvwItemsTop.SelCount > 0) or (lvwItemsBottom.SelCount > 0);
3026 mnuPopGraphReset.Enabled := mnuPopGraphSwap.Enabled;
3027 mnuPopGraphCopy.Enabled := mnuPopGraphSwap.Enabled;
3028 mnuPopGraphPrint.Enabled := mnuPopGraphSwap.Enabled;
3029
3030 with pnlMain.Parent do
3031 if BorderWidth <> 1 then // only do on float Graph
3032 mnuPopGraphStayOnTop.Enabled :=false
3033 else
3034 mnuPopGraphStayOnTop.Enabled :=true;
3035end;
3036
3037procedure TfrmGraphs.mnuPopGraphDetailsClick(Sender: TObject);
3038var
3039 aGraphItem: TGraphItem;
3040 tmpList: TStringList;
3041 date1, date2: TFMDateTime;
3042 teststring, typeitem, textvalue, textvalue1, textvalue2, typenum, typename: string;
3043 i, selnum: integer;
3044begin
3045 if chartDatelineTop.Tag = 1 then // series
3046 begin
3047 ItemCheck(lvwItemsTop, mnuPopGraphIsolate.Hint, selnum, typeitem);
3048 if selnum < 0 then exit;
3049 if not HSAbbrev(Piece(typeitem, '^', 1)) then
3050 begin
3051 if (FGraphSeries is TGanttSeries) then
3052 begin
3053 FDate1 := (FGraphSeries as TGanttSeries).StartValues[FGraphValueIndex];
3054 FDate2 := (FGraphSeries as TGanttSeries).EndValues[FGraphValueIndex];
3055 end
3056 else
3057 begin
3058 FDate1 := FGraphSeries.XValue[FGraphValueIndex];
3059 FDate2 := FDate1;
3060 end;
3061 textvalue := ValueText(FGraphClick, FGraphSeries, FGraphValueIndex);
3062 textvalue1 := Piece(textvalue, '^', 2) + ' ' + Piece(textvalue, '^', 3);
3063 textvalue2 := Piece(textvalue, '^', 4) + ' ' + Piece(textvalue, '^', 5);
3064 typenum := trim(Piece(textvalue, '^', 1));
3065 typename := Piece(textvalue, '^', 2);
3066 AllTypeDate(typenum, typename, textvalue1, textvalue2, FDate1, FDate2);
3067 exit;
3068 end
3069 else
3070 OneDayTypeDetails(typeitem);
3071 end
3072 else // legend
3073 begin
3074 date1 := DateTimeToFMDateTime(FGraphSetting.HighTime);
3075 date2 := DateTimeToFMDateTime(FGraphSetting.LowTime);
3076 tmpList := TStringList.Create;
3077 if pnlTop.Tag = 1 then
3078 for i := 0 to lvwItemsTop.Items.Count - 1 do
3079 begin
3080 if lvwItemsTop.Items[i].Selected then
3081 begin
3082 aGraphItem := TGraphItem(lvwItemsTop.Items.Item[i].SubItems.Objects[3]); //get file^ien match
3083 teststring := aGraphItem.Values;
3084 tmpList.Add(teststring);
3085 end;
3086 end
3087 else
3088 for i := 0 to lvwItemsBottom.Items.Count - 1 do
3089 begin
3090 if lvwItemsBottom.Items[i].Selected then
3091 begin
3092 aGraphItem := TGraphItem(lvwItemsBottom.Items.Item[i].SubItems.Objects[3]); //get file^ien match
3093 teststring := aGraphItem.Values;
3094 tmpList.Add(teststring);
3095 end;
3096 end;
3097 if tmpList.Count > 0 then
3098 AllDetails(date1, date2, tmplist);
3099 tmpList.Free;
3100 end;
3101 FMouseDown := false;
3102end;
3103
3104procedure TfrmGraphs.AllDetails(aDate1, aDate2: TFMDateTime; aTempList: TStrings);
3105var
3106 TypeList: TStringList;
3107 i: integer;
3108 detailsok: boolean;
3109 testnum, teststring, testtype: string;
3110begin
3111 detailsok := true;
3112 TypeList := TStringList.Create;
3113 for i := 0 to aTempList.Count -1 do
3114 begin
3115 teststring := aTempList[i];
3116 testtype := Piece(teststring, '^', 1);
3117 if not HSAbbrev(testtype) then
3118 detailsok := false;
3119 if testtype = '63' then
3120 begin
3121 testnum := Piece(teststring, '^', 2);
3122 testnum := Piece(testnum, '.', 1);
3123 TypeList.Add('63^' + testnum);
3124 end
3125 else
3126 TypeList.Add(teststring);
3127 end;
3128 if detailsok then
3129 ReportBox(rpcDetailSelected(Patient.DFN, aDate1, aDate2, TypeList, true), 'Graph results on ' + Patient.Name, True)
3130 else
3131 ItemDateRange(FGraphClick);
3132 TypeList.Free;
3133end;
3134
3135procedure TfrmGraphs.OneDayTypeDetails(aTypeItem: string);
3136var
3137 strdate1, strdate2, titleitem, titletype: string;
3138 date1, date2: TFMDateTime;
3139 tmpList: TStringList;
3140begin
3141 tmpList := TStringList.Create;
3142 strdate1 := FormatDateTime('mm/dd/yyyy', FDate1);
3143 strdate2 := FormatDateTime('mm/dd/yyyy', FDate2);
3144 FDate1 := StrToDateTime(strdate1);
3145 FDate2 := StrToDateTime(strdate2);
3146 date1 := DateTimeToFMDateTime(FDate1 + 1);
3147 date2 := DateTimeToFMDateTime(FDate2);
3148 titletype := FileNameX(Piece(aTypeItem, '^', 1));
3149 titleitem := ItemName(Piece(aTypeItem, '^', 1), Piece(aTypeItem, '^', 2));
3150 rpcDetailDay(tmpList, Patient.DFN, date1, date2, aTypeItem, true);
3151 ReportBox(tmpList, titletype + ': ' + titleitem + ' on ' + Patient.Name + ' for ' + FormatFMDateTime('mmm d, yyyy', date1), True);
3152 tmpList.Free;
3153end;
3154
3155procedure TfrmGraphs.mnuPopGraphCopyClick(Sender: TObject);
3156var
3157 i: integer;
3158 StrForFooter, StrForHeader, aTitle, aWarning, aDateRange: String;
3159 aHeader: TStringList;
3160 wrdApp, wrdDoc: Variant;
3161 ChildControl: TControl;
3162begin
3163 try
3164 wrdApp := CreateOleObject('Word.Application');
3165 except
3166 raise Exception.Create('Cannot start MS Word!');
3167 end;
3168 Screen.Cursor := crHourGlass;
3169 aTitle := 'CPRS Graphing';
3170 aWarning := pnlInfo.Caption;
3171 aDateRange := 'Date Range: ' + cboDateRange.Text + ' Selected Items from ' +
3172 FormatDateTime('mm/dd/yy', FGraphSetting.LowTime) + ' to ' +
3173 FormatDateTime('mm/dd/yy', FGraphSetting.HighTime);
3174 aHeader := TStringList.Create;
3175 CreatePatientHeader(aHeader, aTitle, aWarning, aDateRange);
3176 StrForHeader := '';
3177 for i := 0 to aHeader.Count -1 do
3178 StrForHeader := StrForHeader + aHeader[i] + Chr(13);
3179 StrForFooter := aTitle + ' - *** WORK COPY ONLY ***' + Chr(13);
3180 wrdApp.Visible := False;
3181 wrdApp.Documents.Add;
3182 wrdDoc := wrdApp.Documents.Item(1);
3183 wrdDoc := wrdDoc.Sections.Item(1);
3184 wrdDoc := wrdDoc.Headers.Item(1).Range;
3185 wrdDoc.Font.Name := 'Courier New';
3186 wrdDoc.Font.Size := 9;
3187 wrdDoc.Text := StrForHeader;
3188 wrdDoc := wrdApp.Documents.Item(1);
3189 wrdDoc := wrdDoc.Sections.Item(1);
3190 wrdDoc := wrdDoc.Footers.Item(1);
3191 wrdDoc.Range.Font.Name := 'Courier New';
3192 wrdDoc.Range.Font.Size := 9;
3193 wrdDoc.Range.Text := StrForFooter;
3194 wrdDoc.PageNumbers.Add;
3195 wrdDoc := wrdApp.Documents.Item(1);
3196 wrdDoc.Range.Font.Name := 'Courier New';
3197 wrdDoc.Range.Font.Size := 9;
3198 wrdDoc.Range.Text := StrForHeader;
3199 wrdDoc.Range.InsertParagraphAfter;
3200 for i := 0 to scrlTop.ControlCount - 1 do // goes from top to bottom
3201 begin
3202 ChildControl := scrlTop.Controls[i];
3203 if (ChildControl as TChart).Visible then
3204 begin
3205 (ChildControl as TChart).CopyToClipboardBitmap;
3206 wrdDoc.Range.InsertParagraphAfter;
3207 wrdDoc.Paragraphs.Last.Range.Paste;
3208 end;
3209 end;
3210 if (chartDatelineTop.SeriesCount > 0) and (not chkItemsTop.Checked) then
3211 begin
3212 chartDatelineTop.CopyToClipboardBitmap;
3213 wrdDoc.Range.InsertParagraphAfter;
3214 wrdDoc.Paragraphs.Last.Range.Paste;
3215 end;
3216 wrdDoc.Range.InsertParagraphAfter;
3217 wrdDoc.Paragraphs.Last.Range.Text := ' ';
3218 for i := 0 to scrlBottom.ControlCount - 1 do
3219 begin
3220 ChildControl := scrlBottom.Controls[i];
3221 if (ChildControl as TChart).Visible then
3222 begin
3223 (ChildControl as TChart).CopyToClipboardBitmap;
3224 wrdDoc.Range.InsertParagraphAfter;
3225 wrdDoc.Paragraphs.Last.Range.Paste;
3226 end;
3227 end;
3228 if (chartDatelineBottom.SeriesCount > 0) and (chkDualViews.Checked)
3229 and (not chkItemsBottom.Checked) then
3230 begin
3231 chartDatelineBottom.CopyToClipboardBitmap;
3232 wrdDoc.Range.InsertParagraphAfter;
3233 wrdDoc.Paragraphs.Last.Range.Paste;
3234 end;
3235 wrdDoc.Range.WholeStory;
3236 wrdDoc.Range.Copy;
3237 wrdDoc.Close(false);
3238 wrdApp.DisplayAlerts := false;
3239 wrdApp.Quit;
3240 wrdApp := Unassigned; // releases variant
3241 aHeader.Free;
3242 Screen.Cursor := crDefault;
3243end;
3244
3245procedure TfrmGraphs.CreatePatientHeader(var HeaderList: TStringList; PageTitle, Warning, DateRange: string);
3246// this procedure modified from rReports
3247var
3248 tmpStr, tmpItem: string;
3249begin
3250 if Warning = TXT_INFO then Warning := ' ';
3251 with HeaderList do
3252 begin
3253 Add(' ');
3254 Add(StringOfChar(' ', (74 - Length(PageTitle)) div 2) + PageTitle);
3255 Add(' ');
3256 tmpStr := Patient.Name + ' ' + Patient.SSN;
3257 tmpItem := tmpStr + StringOfChar(' ', 39 - Length(tmpStr)) + Encounter.LocationName;
3258 tmpStr := FormatFMDateTime('mmm dd, yyyy', Patient.DOB) + ' (' + IntToStr(Patient.Age) + ')';
3259 tmpItem := tmpItem + StringOfChar(' ', 74 - (Length(tmpItem) + Length(tmpStr))) + tmpStr;
3260 Add(tmpItem);
3261 Add(StringOfChar('=', 74));
3262 Add('*** WORK COPY ONLY ***' + StringOfChar(' ', 24) + 'Printed: '
3263 + FormatFMDateTime('mmm dd, yyyy hh:nn', FMNow));
3264 Add(TXT_COPY_DISCLAIMER);
3265 Add(StringOfChar(' ', (74 - Length(DateRange)) div 2) + DateRange);
3266 Add(StringOfChar(' ', (74 - Length(Warning)) div 2) + Warning);
3267 Add(' ');
3268 end;
3269end;
3270
3271procedure TfrmGraphs.GetData(aString: string);
3272var
3273 i: integer;
3274 filenum, itemdata, itemid: string;
3275 aDate, aDate1: double;
3276begin
3277 lstTemp.Items.Clear;
3278 itemid := UpperCase(Pieces(aString, '^', 1, 2));
3279 with lstData do
3280 for i := Items.Count - 1 downto 0 do
3281 if itemid = UpperCase(Pieces(Items[i], '^', 1, 2)) then
3282 begin
3283 itemdata := Items[i];
3284 filenum := Piece(itemdata, '^', 1);
3285 if (filenum = '52') or (filenum = '55') or (filenum = '55NVA')
3286 or (filenum = '9999911') or (filenum = '405') or (filenum = '9000010') then
3287 begin
3288 aDate := strtofloat(FMCorrectedDate(Piece(itemdata, '^', 3)));
3289 aDate1 := strtofloat(FMCorrectedDate(Piece(itemdata, '^', 4)));
3290 if (aDate < FGraphSetting.FMStopDate) and (aDate > FGraphSetting.FMStartDate) then
3291 lstTemp.Items.Add(Items[i])
3292 else if (aDate < FGraphSetting.FMStopDate) and (aDate1 > FGraphSetting.FMStartDate) then
3293 lstTemp.Items.Add(Items[i])
3294 else if (aDate < FGraphSetting.FMStartDate) and (aDate1 > FGraphSetting.FMStopDate) then
3295 lstTemp.Items.Add(Items[i]);
3296 end
3297 else if Piece(itemdata, '^', 3) <> '' then
3298 begin
3299 aDate := strtofloat(FMCorrectedDate(Piece(itemdata, '^', 3)));
3300 if (aDate < FGraphSetting.FMStopDate) and (aDate > FGraphSetting.FMStartDate) then
3301 if Copy(itemdata, 1, 4) = '63MI' then
3302 lstTemp.Items.Add(Pieces(Items[i], '^', 1, 4))
3303 else if Copy(itemdata, 1, 4) = '63AP' then
3304 lstTemp.Items.Add(Pieces(Items[i], '^', 1, 4))
3305 //else lstTemp.Items.Add(Pieces(Items[i], '^', 1, 5)); // add in non micro, ap
3306 else lstTemp.Items.Add(Items[i]); // add in non micro, ap
3307 end;
3308 end;
3309end;
3310
3311function TfrmGraphs.FMToDateTime(FMDateTime: string): TDateTime;
3312var
3313 x, Year: string;
3314begin
3315 { Note: TDateTime cannot store month only or year only dates }
3316 x := FMDateTime + '0000000';
3317 if Length(x) > 12 then x := Copy(x, 1, 12);
3318 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x, 1, 7) + '.2359';
3319 Year := IntToStr(17 + StrToInt(Copy(x, 1, 1))) + Copy(x, 2, 2);
3320 x := Copy(x, 4, 2) + '/' + Copy(x, 6, 2) + '/' + Year + ' ' + Copy(x, 9, 2) + ':' + Copy(x, 11, 2);
3321 Result := StrToDateTime(x);
3322end;
3323
3324function TfrmGraphs.GraphTypeNum(aType: string): integer;
3325var
3326 i: integer;
3327begin
3328 Result := 4;
3329 if (aType = '52') or (aType = '55') or (aType = '55NVA') or (aType = '9999911') then
3330 if mnuMedsasgantt.Checked then Result := 8
3331 else if mnuMedsasganttvertheight.Checked then Result := 3
3332 else Result := 8
3333 else
3334 for i := 0 to lstAllTypes.Items.Count - 1 do
3335 if aType = Piece(lstAllTypes.Items[i], '^', 1) then
3336 begin
3337 Result := strtointdef(Piece(lstAllTypes.Items[i], '^', 3), 4);
3338 break;
3339 end;
3340end;
3341
3342function TfrmGraphs.HSAbbrev(aType: string): boolean;
3343var
3344 i: integer;
3345begin
3346 Result := false;
3347 for i := 0 to lstTypes.Items.Count - 1 do
3348 if Piece(lstTypes.Items[i], '^', 1) = aType then
3349 begin
3350 Result := length(Piece(lstTypes.Items[i], '^', 8)) > 0;
3351 break;
3352 end;
3353end;
3354
3355procedure TfrmGraphs.TempCheck(typeitem: string; var levelseq: double);
3356var
3357 done, previous: boolean;
3358 j: integer;
3359begin
3360 previous := false;
3361 done := false;
3362 j := 0;
3363 with lstTempCheck do
3364 while not done do
3365 begin
3366 if Items.Count = j then done := true
3367 else if Items[j] = typeitem then
3368 begin
3369 previous := true;
3370 levelseq := j + 1;
3371 done := true;
3372 end
3373 else j := j + 1;
3374 end;
3375 if not previous then
3376 begin
3377 lstTempCheck.Items.Add(UpperCase(typeitem));
3378 levelseq := lstTempCheck.Items.Count;
3379 end;
3380end;
3381
3382function TfrmGraphs.DCName(aDCien: string): string;
3383var
3384 i: integer;
3385begin
3386 if lstDrugClass.Items.Count < 1 then
3387 FastAssign(rpcClass('50.605'), lstDrugClass.Items);
3388 Result := '';
3389 for i := 0 to lstDrugClass.Items.Count - 1 do
3390 if Piece(lstDrugClass.Items[i], '^', 2) = aDCien then
3391 begin
3392 Result := 'Drug - ' + Piece(lstDrugClass.Items[i], '^', 3);
3393 break;
3394 end;
3395end;
3396
3397procedure TfrmGraphs.splItemsBottomMoved(Sender: TObject);
3398begin
3399 chkItemsBottom.Left := pnlItemsBottom.Width - chkItemsBottom.Width - 2;
3400 pnlItemsTop.Width := pnlItemsBottom.Width;
3401 chkItemsTop.Left := pnlItemsTop.Width - chkItemsTop.Width - 2;
3402end;
3403
3404procedure TfrmGraphs.splItemsTopMoved(Sender: TObject);
3405begin
3406 chkItemsTop.Left := pnlItemsTop.Width - chkItemsTop.Width - 2;
3407 pnlItemsBottom.Width := pnlItemsTop.Width;
3408 chkItemsBottom.Left := pnlItemsBottom.Width - chkItemsBottom.Width - 2;
3409end;
3410
3411procedure TfrmGraphs.cboDateRangeChange(Sender: TObject);
3412var
3413 datetag: integer;
3414 endofday: double;
3415 dateranges, manualstart, manualstop: string;
3416begin
3417 endofday := FMDateTimeOffsetBy(FMToday, 1);
3418 SelCopy(lvwItemsTop, lstSelCopyTop);
3419 SelCopy(lvwItemsBottom, lstSelCopyBottom);
3420 dateranges := '';
3421 if (cboDateRange.ItemID = 'S') then
3422 begin
3423 with calDateRange do
3424 begin
3425 if Execute then
3426 if Length(TextOfStart) > 0 then
3427 if Length(TextOfStop) > 0 then
3428 begin
3429 dateranges :=
3430 '^' + UpperCase(TextOfStart) + ' to ' + UpperCase(TextOfStop) +
3431 '^^^' + RelativeStart + ';' + RelativeStop +
3432 '^' + floattostr(FMDateStart) + '^' + floattostr(FMDateStop);
3433 cboDateRange.Items.Append(dateranges);
3434 cboDateRange.ItemIndex := cboDateRange.Items.Count - 1;
3435 end
3436 else
3437 cboDateRange.ItemIndex := -1
3438 else
3439 cboDateRange.ItemIndex := -1
3440 else
3441 cboDateRange.ItemIndex := -1;
3442 end;
3443 end;
3444 HideGraphs(true);
3445 datetag := cboDateRange.ItemIEN;
3446 with FGraphSetting do
3447 case datetag of
3448 0: begin
3449 if cboDateRange.ItemIndex > 8 then // selected date range
3450 begin
3451 if dateranges = '' then dateranges := cboDateRange.Items[cboDateRange.ItemIndex];
3452 manualstart := Piece(dateranges, '^' , 6);
3453 manualstop := Piece(dateranges, '^' , 7);
3454 if (manualstop <> '') and (length(Piece(manualstop, '.', 2)) = 0) then
3455 manualstop := manualstop + '.2359';
3456 FMStartDate := MakeFMDateTime(manualstart);
3457 FMStopDate := MakeFMDateTime(manualstop);
3458 if (manualstart <> '') and (length(Piece(manualstart, '.', 2)) = 0) then
3459 begin
3460 FMStartDate := FMDateTimeOffsetBy(FMStartDate, -1);
3461 manualstart := floattostr(FMStartDate) + '.2359';
3462 FMStartDate := MakeFMDateTime(manualstart);
3463 end;
3464 end;
3465 end;
3466 1: begin
3467 FMStartDate := FMToday;
3468 FMStopDate := endofday;
3469 end;
3470 2: begin
3471 FMStartDate := FMDateTimeOffsetBy(FMToday, -7);
3472 FMStopDate := endofday;
3473 end;
3474 3: begin
3475 FMStartDate := FMDateTimeOffsetBy(FMToday, -14);
3476 FMStopDate := endofday;
3477 end;
3478 4: begin
3479 FMStartDate := FMDateTimeOffsetBy(FMToday, -30);
3480 FMStopDate := endofday;
3481 end;
3482 5: begin
3483 FMStartDate := FMDateTimeOffsetBy(FMToday, -183);
3484 FMStopDate := endofday;
3485 end;
3486 6: begin
3487 FMStartDate := FMDateTimeOffsetBy(FMToday, -365);
3488 FMStopDate := endofday;
3489 end;
3490 7: begin
3491 FMStartDate := FMDateTimeOffsetBy(FMToday, -730);
3492 FMStopDate := endofday;
3493 end;
3494 8: begin
3495 FMStartDate := FM_START_DATE; // earliest recorded values
3496 FMStopDate := endofday;
3497 end;
3498 else
3499 begin
3500 if dateranges = '' then dateranges := cboDateRange.Items[cboDateRange.ItemIndex];
3501 manualstart := Piece(dateranges, '^' , 6);
3502 manualstop := Piece(dateranges, '^' , 7);
3503 if (manualstop <> '') and (length(Piece(manualstop, '.', 2)) = 0) then manualstop := manualstop + '.2359';
3504 FMStartDate := MakeFMDateTime(manualstart);
3505 FMStopDate := MakeFMDateTime(manualstop);
3506 if (manualstart <> '') and (length(Piece(manualstart, '.', 2)) = 0) then
3507 begin
3508 FMStartDate := FMDateTimeOffsetBy(FMStartDate, -1);
3509 manualstart := floattostr(FMStartDate) + '.2359';
3510 FMStartDate := MakeFMDateTime(manualstart);
3511 end;
3512 end;
3513 end;
3514 FilterListView(FGraphSetting.FMStartDate, FGraphSetting.FMStopDate);
3515 SelReset(lstSelCopyTop, lvwItemsTop);
3516 SelReset(lstSelCopyBottom, lvwItemsBottom);
3517 DisplayData('top');
3518 DisplayData('bottom');
3519 if cboViewsTop.ItemIndex > 1 then cboViewsTopChange(self);
3520 if cboViewsBottom.ItemIndex > 1 then cboViewsBottomChange(self);
3521 HideGraphs(false);
3522end;
3523
3524function TfrmGraphs.StdDev(value, high, low: double): double;
3525begin
3526 if high - low <> 0 then
3527 begin
3528 Result := (value - (low + ((high - low) / 2)))/((high - low) / 4);
3529 Result := RoundTo(Result, -2);
3530 end
3531 else
3532 Result := 0;
3533end;
3534
3535function TfrmGraphs.InvVal(value: double): double;
3536begin
3537 if value = 0 then value := 0.0001;
3538 Result := 1 / value;
3539 Result := RoundTo(Result, -2);
3540end;
3541
3542procedure TfrmGraphs.lvwItemsTopCompare(Sender: TObject; Item1,
3543 Item2: TListItem; Data: Integer; var Compare: Integer);
3544begin
3545 if not(Sender is TListView) then exit;
3546 if FsortAscending then
3547 begin
3548 if FSortCol = 0 then
3549 Compare := CompareStr(Item1.Caption, Item2.Caption)
3550 else
3551 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
3552 Item2.SubItems[FsortCol - 1]);
3553 end
3554 else
3555 begin
3556 if FSortCol = 0 then
3557 Compare := CompareStr(Item2.Caption, Item1.Caption)
3558 else
3559 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
3560 Item1.SubItems[FsortCol - 1]);
3561 end;
3562end;
3563
3564procedure TfrmGraphs.lvwItemsTopColumnClick(Sender: TObject;
3565 Column: TListColumn);
3566begin
3567 if FSortCol = Column.Index then
3568 FSortAscending := not FSortAscending
3569 else
3570 FSortAscending := true;
3571 FSortCol := Column.Index;
3572 (Sender as TListView).AlphaSort;
3573end;
3574
3575procedure TfrmGraphs.lvwItemsBottomCompare(Sender: TObject; Item1,
3576 Item2: TListItem; Data: Integer; var Compare: Integer);
3577begin
3578 if not(Sender is TListView) then exit;
3579 if FBSortAscending then
3580 begin
3581 if FBSortCol = 0 then
3582 Compare := CompareStr(Item1.Caption, Item2.Caption)
3583 else
3584 Compare := CompareStr(Item1.SubItems[FBSortCol - 1],
3585 Item2.SubItems[FBSortCol - 1]);
3586 end
3587 else
3588 begin
3589 if FBSortCol = 0 then
3590 Compare := CompareStr(Item2.Caption, Item1.Caption)
3591 else
3592 Compare := CompareStr(Item2.SubItems[FBSortCol - 1],
3593 Item1.SubItems[FBSortCol - 1]);
3594 end;
3595end;
3596
3597procedure TfrmGraphs.lvwItemsBottomColumnClick(Sender: TObject;
3598 Column: TListColumn);
3599begin
3600 if FBSortCol = Column.Index then
3601 FBSortAscending := not FBSortAscending
3602 else
3603 FBSortAscending := true;
3604 FBSortCol := Column.Index;
3605 (Sender as TListView).AlphaSort;
3606end;
3607
3608procedure TfrmGraphs.btnGraphSelectionsClick(Sender: TObject);
3609var
3610 actionOK, checkaction: boolean;
3611 counter, i, listnum: integer;
3612 profile, profilestring, section, selections, specnum, typeitem: string;
3613 aGraphItem: TGraphItem;
3614begin
3615 selections := '';
3616 for i := 0 to lvwItemsTop.Items.Count - 1 do
3617 if lvwItemsTop.Items[i].Selected then
3618 begin
3619 aGraphItem := TGraphItem(lvwItemsTop.Items.Item[i].SubItems.Objects[3]);
3620 typeitem := UpperCase(aGraphItem.Values);
3621 if Piece(typeitem, '^', 1) = '63' then
3622 begin
3623 specnum := Piece(Piece(typeitem, '^', 2), '.', 2);
3624 if length(specnum) > 0 then // mulispecimen
3625 if specnum = '1' then typeitem := Piece(typeitem, '.', 1)
3626 else typeitem := '';
3627 end;
3628 if length(typeitem) > 0 then
3629 selections := selections + Piece(typeitem, '^', 1) + '~' + Piece(typeitem, '^', 2) +'~|';
3630 end;
3631 checkaction := chkDualViews.Checked;
3632 actionOK := false;
3633 profile := '*';
3634 counter := cboViewsTop.Tag;
3635 // load lstItems with all patient items and pass to Define View ????
3636 DialogGraphProfiles(Font.Size, actionOK, checkaction, FGraphSetting,
3637 profile, profilestring, section, Patient.DFN, counter, selections);
3638 if (not actionOK) then exit;
3639 FillViews;
3640 if (section = 'niether') then exit;
3641 cboViewsTop.Tag := counter;
3642
3643 lstViews.Items.Add(profilestring);
3644 listnum := lstViews.Items.Count + 1;
3645 for i := 0 to lstViews.Items.Count - 1 do
3646 begin
3647 profilestring := lstViews.Items[i];
3648 cboViewsTop.Items.Insert(i + 2, profilestring);
3649 cboViewsBottom.Items.Insert(i + 2, profilestring);
3650 end;
3651 if (section = 'bottom') or (section = 'both') then
3652 lvwItemsBottom.Tag := listnum;
3653 if (section = 'top') or (section = 'both') then
3654 lvwItemsTop.Tag := listnum;
3655 ViewSelections;
3656end;
3657
3658procedure TfrmGraphs.ViewSelections;
3659var
3660 i: integer;
3661begin // uses lvwItems... Tag as index for view selection
3662 with lvwItemsBottom do
3663 begin
3664 if (Tag = 0) and (length(lvwItemsBottom.Hint) > 0) then
3665 begin
3666 for i := 0 to cboViewsBottom.Items.Count - 1 do
3667 begin
3668 showmessage(cboViewsBottom.Items[i]);
3669 if lvwItemsBottom.Hint = Piece(cboViewsBottom.Items[i], '^', 2) then
3670 begin
3671 Tag := i;
3672 break;
3673 end;
3674 end;
3675 end;
3676 if Tag > 0 then
3677 begin
3678 if not chkDualViews.Checked then
3679 begin
3680 chkDualViews.Checked := true;
3681 chkDualViewsClick(self);
3682 end;
3683 ClearSelection;
3684 cboViewsBottom.ItemIndex := Tag;
3685 Tag := 0;
3686 Hint := '';
3687 cboViewsBottomChange(self);
3688 end;
3689 end;
3690 with lvwItemsTop do
3691 begin
3692 if (Tag = 0) and (length(lvwItemsTop.Hint) > 0) then
3693 begin
3694 for i := 0 to cboViewsTop.Items.Count - 1 do
3695 begin
3696 if lvwItemsTop.Hint = Piece(cboViewsTop.Items[i], '^', 2) then
3697 begin
3698 Tag := i;
3699 break;
3700 end;
3701 end;
3702 end;
3703 if Tag > 0 then
3704 begin
3705 ClearSelection;
3706 cboViewsTop.ItemIndex := Tag;
3707 Tag := 0;
3708 Hint := '';
3709 cboViewsTopChange(self);
3710 end;
3711 end;
3712end;
3713
3714procedure TfrmGraphs.ItemsClick(Sender: TObject; aListView, aOtherListView: TListView;
3715 aCheckBox: TCheckBox; aComboBox: TORComboBox; aList: TListBox; aSection: string);
3716begin
3717 FRetainZoom := (lstZoomHistory.Count > 0);
3718 FWarning := false;
3719 Screen.Cursor := crHourGlass;
3720 HideGraphs(true);
3721 if Sender = aListView then
3722 begin
3723 aComboBox.ItemIndex := -1;
3724 aComboBox.Text := '';
3725 end;
3726 if (Sender is TListView) then // clear out selcopy list
3727 aList.Items.Clear;
3728 if aOtherListView.SelCount < 1 then
3729 begin
3730 FGraphSetting.HighTime := 0;
3731 FGraphSetting.LowTime := BIG_NUMBER;
3732 end
3733 else if (FBHighTime <> 0) and (aSection = 'top') then
3734 begin
3735 if FBHighTime < FTHighTime then FGraphSetting.HighTime := FBHighTime;
3736 if FBLowTime > FTLowTime then FGraphSetting.LowTime := FBLowTime;
3737 end
3738 else if (FTHighTime <> 0) and (aSection = 'bottom') then
3739 begin
3740 if FTHighTime < FBHighTime then FGraphSetting.HighTime := FTHighTime;
3741 if FTLowTime > FBLowTime then FGraphSetting.LowTime := FTLowTime;
3742 end;
3743 if aSection = 'top' then
3744 begin
3745 FTHighTime := 0;
3746 FTLowTime := BIG_NUMBER;
3747 end
3748 else if aSection = 'bottom' then
3749 begin
3750 FBHighTime := 0;
3751 FBLowTime := BIG_NUMBER;
3752 end;
3753 CheckToAddData(aListView, aSection, 'SELECT');
3754 DisplayData(aSection);
3755 if (aListView.SelCount = 1) and (aOtherListView.SelCount = 0) then
3756 begin
3757 lstZoomHistory.Items.Clear;
3758 FRetainZoom := false;
3759 mnuPopGraphZoomBack.Enabled := false;
3760 end
3761 else if FRetainZoom and (lstZoomHistory.Count > 0) then
3762 ZoomUpdate;
3763 HideGraphs(false);
3764 if FWarning then
3765 FWarning := false;
3766 Screen.Cursor := crDefault;
3767end;
3768
3769procedure TfrmGraphs.CheckToAddData(aListView: TListView; aSection, TypeToCheck: string);
3770var
3771 done, ok, previous, singletype: boolean;
3772 i, j: integer;
3773 itemname, typeitem: string;
3774 aGraphItem: TGraphItem;
3775begin
3776 TypeToCheck := UpperCase(TypeToCheck);
3777 if (TypeToCheck = 'SELECT') and (lvwItemsTop.SelCount = 0)
3778 and (lvwItemsBottom.SelCount = 0) then exit;
3779 singletype := length(Piece(TypeToCheck, '^', 2)) = 0;
3780 for i := 0 to aListView.Items.Count - 1 do
3781 begin
3782 ok := false;
3783 if (TypeToCheck = 'ALL') then ok := true;
3784 if (TypeToCheck = 'SELECT') and aListView.Items[i].Selected then ok := true;
3785 aGraphItem := TGraphItem(aListView.Items.Item[i].SubItems.Objects[3]);
3786 typeitem := UpperCase(Pieces(aGraphItem.Values, '^', 1, 2));
3787 if not ok then
3788 if TypeToCheck = typeitem then ok := true
3789 else if (TypeToCheck = Piece(typeitem, '^', 1)) and
3790 singletype then ok := true;
3791 if ok then
3792 begin
3793 previous := false;
3794 done := false;
3795 j := 0;
3796 with lstCheck do
3797 while not done do
3798 begin
3799 if Items.Count = j then done := true
3800 else if lstCheck.Items[j] = typeitem then
3801 begin
3802 previous := true;
3803 done := true;
3804 end
3805 else j := j + 1;
3806 end;
3807 if not previous then
3808 begin
3809 lstCheck.Items.Add(typeitem);
3810 itemname := aListView.Items[i].Caption;
3811 if Piece(typeitem, '^', 1) = '63' then
3812 LabData(typeitem, itemname, aSection)
3813 else
3814 lstData.Items.AddStrings(rpcGetItemData(typeitem, FMTimeStamp, Patient.DFN));
3815 end;
3816 end;
3817 end;
3818end;
3819
3820procedure TfrmGraphs.lvwItemsTopClick(Sender: TObject);
3821var
3822 i: integer;
3823begin
3824 FFirstClick := true;
3825 with FGraphSetting do
3826 if lvwItemsTop.SelCount > MaxSelect then
3827 begin
3828 pnlItemsTopInfo.Tag := 1;
3829 lvwItemsTop.ClearSelection;
3830 showmessage('Too many items to graph');
3831 for i := 0 to lstSelPrevTop.Items.Count - 1 do
3832 lvwItemsTop.Items[strtoint(lstSelPrevTop.Items[i])].Selected := true;
3833 pnlItemsTopInfo.Tag := 0;
3834 end
3835 else
3836 begin
3837 lstSelPrevTop.Clear;
3838 for i := 0 to lvwItemsTop.Items.Count - 1 do
3839 if lvwItemsTop.Items[i].Selected then lstSelPrevTop.Items.Add(inttostr(i));
3840 ItemsClick(Sender, lvwItemsTop, lvwItemsBottom, chkItemsTop, cboViewsTop, lstSelCopyTop, 'top');
3841 end;
3842end;
3843
3844procedure TfrmGraphs.lvwItemsBottomClick(Sender: TObject);
3845var
3846 i: integer;
3847begin
3848 FFirstClick := true;
3849 with FGraphSetting do
3850 if lvwItemsBottom.SelCount > MaxSelect then
3851 begin
3852 pnlItemsBottomInfo.Tag := 1;
3853 lvwItemsBottom.ClearSelection;
3854 showmessage('Too many items to graph');
3855 for i := 0 to lstSelPrevBottom.Items.Count - 1 do
3856 lvwItemsBottom.Items[strtoint(lstSelPrevBottom.Items[i])].Selected := true;
3857 pnlItemsBottomInfo.Tag := 0;
3858 end
3859 else
3860 begin
3861 lstSelPrevBottom.Clear;
3862 for i := 0 to lvwItemsBottom.Items.Count - 1 do
3863 if lvwItemsBottom.Items[i].Selected then lstSelPrevBottom.Items.Add(inttostr(i));
3864 ItemsClick(Sender, lvwItemsBottom, lvwItemsTop, chkItemsBottom, cboViewsBottom, lstSelCopyBottom, 'bottom');
3865 end;
3866end;
3867
3868procedure TfrmGraphs.SelCopy(aListView: TListView; aListBox: TListBox);
3869var
3870 i: integer;
3871 aGraphItem: TGraphItem;
3872begin
3873 if aListView.Items.Count > 0 then
3874 begin
3875 for i := 0 to aListView.Items.Count - 1 do
3876 if aListView.Items[i].Selected then
3877 begin
3878 aGraphItem := TGraphItem(aListView.Items.Item[i].SubItems.Objects[3]); //get file^ien match
3879 aListBox.Items.Add(aGraphItem.Values);
3880 end;
3881 end;
3882end;
3883
3884procedure TfrmGraphs.SelReset(aListbox: TListBox; aListView: TListView);
3885var
3886 i, j: integer;
3887 typeitem, itemtype: string;
3888 aGraphItem: TGraphItem;
3889begin
3890 for i := 0 to aListView.Items.Count - 1 do
3891 begin
3892 aGraphItem := TGraphItem(aListView.Items.Item[i].SubItems.Objects[3]); //get file^ien match
3893 typeitem := UpperCase(Pieces(aGraphItem.Values, '^', 1, 3));
3894 for j := 0 to aListBox.Items.Count - 1 do
3895 begin
3896 itemtype := UpperCase(Pieces(aListBox.Items[j], '^', 1, 3));
3897 if itemtype = typeitem then
3898 begin
3899 aListView.Items[i].Selected := true;
3900 break;
3901 end;
3902 end
3903 end;
3904end;
3905
3906procedure TfrmGraphs.ViewsChange(aListView: TListView; aComboBox: TORComboBox; aSection: string);
3907var
3908 Updated: boolean;
3909 aProfile: string;
3910begin
3911 timHintPause.Enabled := false;
3912 InactivateHint;
3913 if aComboBox.ItemIndex = -1 then exit; // or clear graph ***************************
3914 if aComboBox.ItemIndex = 0 then // <clear all selections>
3915 begin
3916 aComboBox.Text := '';
3917 aListView.ClearSelection;
3918 if aSection = 'top' then
3919 begin
3920 FTHighTime := 0;
3921 FTLowTime := BIG_NUMBER;
3922 end
3923 else
3924 begin
3925 FBHighTime := 0;
3926 FBLowTime := BIG_NUMBER;
3927 end;
3928 DisplayData(aSection);
3929 exit;
3930 end;
3931 if aComboBox.ItemIndex = 1 then // <make selections>
3932 begin
3933 btnGraphSelectionsClick(self);
3934 if aComboBox.ItemIndex = -1 then
3935 aComboBox.Text := '';
3936 exit;
3937 end; // view selected
3938 aListView.ClearSelection;
3939 Updated := false;
3940 aProfile := aComboBox.Items[aComboBox.ItemIndex];
3941 if (length(Piece(aProfile, '^', 3)) = 0) or (length(Piece(aProfile, '^', 1)) = 0) then //or <custom>
3942 CheckProfile(aProfile, Updated);
3943 aComboBox.Text := Piece(aProfile, '^', 2);
3944 if Updated then
3945 cboDateRangeChange(self);
3946 if aSection = 'top' then
3947 begin
3948 AssignProfile(aProfile, 'top');
3949 if not FItemsSortedTop then
3950 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[0]);
3951 if FGraphSetting.SortColumn > 0 then
3952 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[FGraphSetting.SortColumn]);
3953 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[2]);
3954 lvwItemsTopColumnClick(lvwItemsTop, lvwItemsTop.Column[2]);
3955 FItemsSortedTop := false;
3956 end
3957 else
3958 begin
3959 AssignProfile(aProfile, 'bottom');
3960 if not FItemsSortedBottom then
3961 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[0]);
3962 if FGraphSetting.SortColumn > 0 then
3963 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[FGraphSetting.SortColumn]);
3964 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[2]);
3965 lvwItemsBottomColumnClick(lvwItemsBottom, lvwItemsBottom.Column[2]);
3966 FItemsSortedBottom := false;
3967 end;
3968 aListView.ClearSelection;
3969 AutoSelect(aListView);
3970 DisplayData(aSection);
3971end;
3972
3973procedure TfrmGraphs.cboViewsTopChange(Sender: TObject);
3974begin
3975 ViewsChange(lvwItemsTop, cboViewsTop, 'top');
3976end;
3977
3978procedure TfrmGraphs.cboViewsBottomChange(Sender: TObject);
3979begin
3980 ViewsChange(lvwItemsBottom, cboViewsBottom, 'bottom');
3981end;
3982
3983procedure TfrmGraphs.AssignProfile(aProfile, aSection: string);
3984var
3985 profilename: string;
3986begin
3987 profilename := Piece(aProfile, '^', 2);
3988 aProfile := UpperCase(Piece(aProfile, '^', 3));
3989 if length(aProfile) = 0 then exit;
3990 if aSection = 'top' then
3991 SetProfile(aProfile, profilename, lvwItemsTop)
3992 else
3993 SetProfile(aProfile, profilename, lvwItemsBottom);
3994end;
3995
3996procedure TfrmGraphs.SetProfile(aProfile, aName: string; aListView: TListView);
3997var
3998 i, j: integer;
3999 dcnm, itemdrugclass, itempart, itempart1, itempart2, itemnums: string;
4000 itemstring, itemstring1, itemstringnums, profname: string;
4001 aGraphItem: TGraphItem;
4002begin
4003 if aProfile = '0' then
4004 for i := 0 to aListView.Items.Count - 1 do
4005 aListView.Items[i].SubItems[1] := ''
4006 else
4007 for i := 0 to aListView.Items.Count - 1 do
4008 begin
4009 profname := '';
4010 aGraphItem := TGraphItem(aListView.Items.Item[i].SubItems.Objects[3]); //get file^ien match
4011 itemstring := aGraphItem.Values;
4012 itemstring1 := UpperCase(Piece(itemstring, '^', 1));
4013 itemdrugclass := Piece(itemstring, '^', 6);
4014 itemstringnums := UpperCase(Pieces(itemstring, '^', 1, 2));
4015 for j := 1 to BIG_NUMBER do
4016 begin
4017 itempart := Piece(aProfile, '|', j);
4018 if itempart = '' then break;
4019 itempart1 := Piece(itempart, '~', 1);
4020 itempart2 := Piece(itempart, '~', 2);
4021 itemnums := itempart1 + '^' + itempart2;
4022 if (itempart1 = '50.605') and (length(itemdrugclass) > 0) then
4023 begin
4024 dcnm := DCName(itempart2);
4025 if dcnm = itemdrugclass then
4026 begin
4027 profname := aName;
4028 break;
4029 end;
4030 end
4031 else if itempart1 = '63' then
4032 begin
4033 if itemnums = Piece(itemstringnums, '.', 1) then
4034 begin
4035 profname := aName;
4036 break;
4037 end;
4038 end
4039 else
4040 begin
4041 if itemnums = itemstringnums then
4042 begin
4043 profname := aName;
4044 break;
4045 end;
4046 end;
4047 if (itempart1 = '0') and (itempart2 = itemstring1) then
4048 begin
4049 profname := aName;
4050 break;
4051 end
4052 else if (itempart1 = '0') and (length(Piece(itempart2, ';', 2)) > 0) then // subtypes
4053 if copy(itempart2, 1, length(itemstring1)) = Piece(itempart2, ';', 1) then
4054 if Piece(itempart2, ';', 2) = UpperCase(Piece(Piece(itemstring, '^', 2), ';', 2)) then
4055 begin
4056 profname := aName;
4057 break;
4058 end;
4059 end;
4060 aListView.Items[i].SubItems[1] := profname;
4061 end;
4062end;
4063
4064function TfrmGraphs.ExpandTax(profile: string): string;
4065var
4066 i: integer;
4067 itempart, itempart1, itempart2, newprofile: string;
4068 taxonomies: TStrings;
4069 expandedcodes: TStrings;
4070 taxonomycodes: TStrings;
4071begin // '811.2~123~|0~63~|' or '55~12~|0~811.2~|0~63~|'
4072 Result := profile;
4073 if Pos('811.2~', profile) = 0 then exit;
4074 taxonomies := TStringList.Create;
4075 expandedcodes := TStringList.Create;
4076 taxonomycodes := TStringList.Create;
4077 newprofile := '';
4078 for i := 1 to BIG_NUMBER do
4079 begin
4080 itempart := Piece(profile, '|', i);
4081 if length(itempart) = 0 then break;
4082 if Pos('811.2~', itempart) = 0 then
4083 newprofile := newprofile + '|'
4084 else
4085 taxonomies.Add(itempart);
4086 end;
4087 for i := 0 to taxonomies.Count -1 do
4088 begin
4089 itempart := taxonomies[i];
4090 if (Piece(itempart, '~', 1) = '0') and (Piece(itempart, '~', 2) = '811.2') then
4091 begin
4092 // this is Reminder Taxonomy <any> and would bring back a ton of codes
4093 //FastAssign(rpcTaxonomy(true, nil), expandedcodes);
4094 break;
4095 end
4096 else if Piece(itempart, '~', 1) = '811.2' then
4097 taxonomycodes.Add(Piece(itempart, '~', 2));
4098 end;
4099 if taxonomycodes.Count > 0 then
4100 FastAssign(rpcTaxonomy(false, taxonomycodes), expandedcodes);
4101 for i := 1 to expandedcodes.Count -1 do
4102 begin
4103 itempart := expandedcodes[i];
4104 itempart1 := Piece(itempart, ';', 1);
4105 itempart2 := Piece(itempart, ';', 2);
4106 newprofile := newprofile + itempart1 + '~' + itempart2 + '~|'
4107 end;
4108 Result := newprofile;
4109end;
4110
4111procedure TfrmGraphs.CheckProfile(var aProfile: string; var Updated: boolean);
4112var
4113 i, j: integer;
4114 itempart, itempart1, itempart2, profile, profilename, profiletype, xprofile: string;
4115begin
4116 profiletype := Piece(aProfile, '^', 1);
4117 profilename := Piece(aProfile, '^', 2);
4118 if profiletype = '-2' then
4119 FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '1', 0), lstTemp.Items)
4120 else if profiletype = '-1' then
4121 FastAssign(rpcGetGraphProfiles(UpperCase(profilename), '0', 0), lstTemp.Items);
4122 if profiletype <> '' then
4123 begin
4124 for i := 0 to lstTemp.Items.Count - 1 do
4125 aProfile := aProfile + lstTemp.Items[i];
4126 lstTemp.Items.Clear;
4127 end;
4128 Updated := false;
4129 profile := UpperCase(Piece(aProfile, '^', 3));
4130 xprofile := ExpandTax(profile);
4131 if xprofile <> profile then
4132 begin // taxonomies
4133 profile := xprofile;
4134 LoadDisplayCheck('45DX', Updated);
4135 LoadDisplayCheck('45OP', Updated);
4136 LoadDisplayCheck('9000010.07', Updated);
4137 LoadDisplayCheck('9000010.18', Updated);
4138 LoadDisplayCheck('9000011', Updated);
4139 //LoadDisplayCheck('9999911', Updated); // problems as durations not being used
4140 end;
4141 aProfile := Pieces(aProfile, '^', 1, 2) + '^' + profile;
4142 for j := 1 to BIG_NUMBER do
4143 begin
4144 itempart := Piece(profile, '|', j);
4145 if itempart = '' then break;
4146 itempart1 := Piece(itempart, '~', 1);
4147 itempart2 := Piece(itempart, '~', 2);
4148 if itempart1 = '0' then // <any> type
4149 LoadDisplayCheck(itempart2, Updated)
4150 else if itempart1 = '50.605' then // drug class
4151 begin
4152 LoadDisplayCheck('52', Updated);
4153 LoadDisplayCheck('55', Updated);
4154 //LoadDisplayCheck('55NVAE', Updated); // nonvameds as events are not being used
4155 LoadDisplayCheck('55NVA', Updated);
4156 LoadDisplayCheck('53.79', Updated);
4157 end
4158 else if itempart1 <> '0' then // all others
4159 LoadDisplayCheck(itempart1, Updated);
4160 end;
4161end;
4162
4163procedure TfrmGraphs.LoadDisplayCheck(typeofitem: string; var Updated: boolean);
4164begin
4165 if not TypeIsLoaded(typeofitem) then
4166 begin
4167 LoadType(typeofitem, '1');
4168 Updated := true;
4169 end;
4170 if not TypeIsDisplayed(typeofitem) then
4171 begin
4172 DisplayType(typeofitem, '1');
4173 Updated := true;
4174 end;
4175end;
4176
4177procedure TfrmGraphs.AutoSelect(aListView: TListView);
4178var
4179 counter, i: integer;
4180begin
4181 counter := 0;
4182 for i := 0 to aListView.Items.Count - 1 do
4183 begin
4184 if length(aListView.Items[i].SubItems[1]) > 0 then
4185 counter := counter + 1;
4186 end;
4187 if counter <= FGraphSetting.MaxSelect then
4188 for i := 0 to aListView.Items.Count - 1 do
4189 begin
4190 if length(aListView.Items[i].SubItems[1]) > 0 then
4191 aListView.Items[i].Selected := true;
4192 end
4193 else
4194 begin
4195 if aListView = lvwItemsTop then
4196 lvwItemsTop.ClearSelection
4197 else if aListView = lvwItemsBottom then
4198 lvwItemsBottom.ClearSelection;
4199 end;
4200 if aListView = lvwItemsTop then
4201 lvwItemsTopClick(self)
4202 else if aListView = lvwItemsBottom then
4203 lvwItemsBottomClick(self);
4204end;
4205
4206procedure TfrmGraphs.LabData(aItemType, aItemName, aSection: string);
4207var
4208 singlespec: boolean;
4209 i, oldlisting: integer;
4210 checkitem, checkstring, datastring, filename, itemnum, newitemname, newitemnum, newstring: string;
4211 spec1, spec2, spec3, spec4: string;
4212 aGraphItem: TGraphItem;
4213 aListItem: TListItem;
4214begin
4215 singlespec := true;
4216 spec1 := ''; spec2 := ''; spec3 := ''; spec4 := '';
4217 lstSpec1.Items.Clear; lstSpec2.Items.Clear; lstSpec3.Items.Clear; lstSpec4.Items.Clear;
4218 FastAssign(rpcGetItemData(aItemType, FMTimeStamp, Patient.DFN), lstScratchLab.Items);
4219 for i := 0 to lstScratchLab.Items.Count - 1 do
4220 begin
4221 datastring := lstScratchLab.Items[i];
4222 checkstring := Pieces(datastring, '^', 1, 2) + '^' + Pieces(datastring, '^', 7, 8);
4223 if length(spec1) = 0 then
4224 begin
4225 spec1 := checkstring;
4226 lstSpec1.Items.Add(datastring)
4227 end
4228 else if spec1 = checkstring then
4229 lstSpec1.Items.Add(datastring)
4230 else if length(spec2) = 0 then
4231 begin
4232 singlespec := false;
4233 spec2 := checkstring;
4234 lstSpec2.Items.Add(datastring)
4235 end
4236 else if spec2 = checkstring then
4237 lstSpec2.Items.Add(datastring)
4238 else if length(spec3) = 0 then
4239 begin
4240 spec3 := checkstring;
4241 lstSpec3.Items.Add(datastring)
4242 end
4243 else if spec3 = checkstring then
4244 lstSpec3.Items.Add(datastring)
4245 else
4246 begin
4247 spec4 := checkstring;
4248 lstSpec4.Items.Add(datastring)
4249 end;
4250 end;
4251 if singlespec then
4252 lstData.Items.AddStrings(lstScratchLab.Items)
4253 else
4254 begin
4255 lstMultiSpec.Items.Clear;
4256 itemnum := Piece(aItemType, '^', 2);
4257 if length(spec1) > 0 then
4258 begin
4259 newitemnum := itemnum + '.1';
4260 newitemname := aItemName + ' (' + LowerCase(Piece(spec1, '^', 4)) + ')';
4261 for i := 0 to lstItems.Items.Count - 1 do
4262 if aItemType = Pieces(lstItems.Items[i], '^', 1, 2) then
4263 begin
4264 newstring := lstItems.Items[i];
4265 lstItems.Items.Delete(i);
4266 break;
4267 end;
4268 for i := 0 to lstData.Items.Count - 1 do
4269 if aItemType = Pieces(lstData.Items[i], '^', 1, 2) then
4270 lstData.Items.Delete(i);
4271 ResetSpec(lstSpec1, itemnum, newitemnum, newitemname, newstring);
4272 end;
4273 if length(spec2) > 0 then
4274 begin
4275 newitemnum := itemnum + '.2';
4276 newitemname := aItemName + ' (' + LowerCase(Piece(spec2, '^', 4)) + ')';
4277 ResetSpec(lstSpec2, itemnum, newitemnum, newitemname, newstring);
4278 end;
4279 if length(spec3) > 0 then
4280 begin
4281 newitemnum := itemnum + '.3';
4282 newitemname := aItemName + ' (' + LowerCase(Piece(spec3, '^', 4)) + ')';
4283 ResetSpec(lstSpec3, itemnum, newitemnum, newitemname, newstring);
4284 end;
4285 if length(spec4) > 0 then
4286 begin
4287 newitemnum := itemnum + '.4';
4288 newitemname := aItemName + ' (other)'; // not specific after 3 specimens (from same time)
4289 ResetSpec(lstSpec4, itemnum, newitemnum, newitemname, newstring);
4290 end;
4291 oldlisting := 0;
4292 lvwItemsTop.SortType := stNone; // avoids out of bounds error
4293 for i := 0 to lvwItemsTop.Items.Count - 1 do
4294 begin
4295 aGraphItem := TGraphItem(lvwItemsTop.Items.Item[i].SubItems.Objects[3]); //get file^ien match
4296 checkitem := Pieces(aGraphItem.Values, '^', 1, 2);
4297 if aItemType = checkitem then
4298 begin
4299 oldlisting := i;
4300 lvwItemsTop.Items.Delete(i);
4301 break;
4302 end;
4303 end;
4304 filename := FileNameX('63');
4305 for i := 0 to lstMultiSpec.Items.Count - 1 do
4306 begin
4307 lstCheck.Items.Add(UpperCase(Pieces(lstMultiSpec.Items[i], '^', 1, 2)));
4308 if (FGraphSetting.FMStartDate = FM_START_DATE)
4309 or DateRangeMultiItems(FGraphSetting.FMStartDate, FGraphSetting.FMStopDate, Piece(lstMultiSpec.Items[i], '^', 2)) then
4310 begin
4311 with lvwItemsTop do
4312 aListItem := Items.Insert(oldlisting);
4313 aListItem.Caption := Piece(lstMultiSpec.Items[i], '^', 4);
4314 aListItem.SubItems.Add(filename);
4315 aListItem.SubItems.Add('');
4316 aListItem.SubItems.Add('');
4317 aGraphItem := TGraphItem.Create;
4318 aGraphItem.Values := lstMultiSpec.Items[i];
4319 aListItem.SubItems.AddObject('info object', aGraphItem);
4320 if aSection = 'top' then lvwItemsTop.Items[oldlisting].Selected := true;
4321 end;
4322 end;
4323 lvwItemsTop.SortType := stBoth;
4324 oldlisting := 0;
4325 lvwItemsBottom.SortType := stNone; // avoids out of bounds error
4326 for i := 0 to lvwItemsBottom.Items.Count - 1 do
4327 begin
4328 aGraphItem := TGraphItem(lvwItemsBottom.Items.Item[i].SubItems.Objects[3]); //get file^ien match
4329 checkitem := Pieces(aGraphItem.Values, '^', 1, 2);
4330 if aItemType = checkitem then
4331 begin
4332 oldlisting := i;
4333 lvwItemsBottom.Items.Delete(i);
4334 break;
4335 end;
4336 end;
4337 for i := 0 to lstMultiSpec.Items.Count - 1 do
4338 begin
4339 aListItem := lvwItemsBottom.Items.Insert(oldlisting);
4340 aListItem.Caption := Piece(lstMultiSpec.Items[i], '^', 4);
4341 aListItem.SubItems.Add(filename);
4342 aListItem.SubItems.Add('');
4343 aListItem.SubItems.Add('');
4344 aGraphItem := TGraphItem.Create;
4345 aGraphItem.Values := lstMultiSpec.Items[i];
4346 aListItem.SubItems.AddObject('info object', aGraphItem);
4347 if aSection = 'bottom' then lvwItemsBottom.Items[oldlisting].Selected := true;
4348 end;
4349 lvwItemsBottom.SortType := stBoth;
4350 end;
4351end;
4352
4353procedure TfrmGraphs.RefUnits(aItem, aSpec: string; var low, high, units: string);
4354var
4355 i: integer;
4356 item2: double;
4357 itemspec, specstring: string;
4358begin
4359 item2 := strtofloatdef(aItem, -BIG_NUMBER);
4360 if item2 <> -BIG_NUMBER then
4361 begin
4362 item2 := round(item2);
4363 aItem := floattostr(item2);
4364 end;
4365 itemspec := aItem + '^' + aSpec;
4366 for i := 0 to lstTestSpec.Items.Count - 1 do
4367 if itemspec = Pieces(lstTestSpec.Items[i], '^', 1, 2) then
4368 begin
4369 specstring := lstTestSpec.Items[i];
4370 low := Piece(specstring, '^', 3);
4371 high := Piece(specstring, '^', 4);
4372 units := Piece(specstring, '^', 8);
4373 if (Copy(low, 1, 3) = '$S(') then low := SelectRef(low);
4374 if (Copy(high, 1, 3) = '$S(') then high := SelectRef(high);
4375 break;
4376 end;
4377end;
4378
4379function TfrmGraphs.SelectRef(aRef: string): string;
4380// check ref range for AGE and SEX variables in $S statement
4381
4382 procedure CheckRef(selection: string; var value: string; var ok: boolean);
4383 var
4384 age: integer;
4385 part1, part2, part3: string;
4386 begin
4387 value := '';
4388 ok := false;
4389 if pos('$S', selection) > 0 then exit;
4390 if pos(':', selection) = 0 then exit;
4391 part1 := Piece(selection, ':', 1);
4392 part2 := Piece(selection, ':', 2);
4393 part3 := Piece(selection, ':', 3);
4394 if length(part1) = 0 then exit;
4395 if length(part2) = 0 then exit;
4396 if length(part3) <> 0 then exit;
4397 ok := true;
4398 value := part2;
4399 if part1 = '1' then exit;
4400 if copy(part1, 1, 4) = 'SEX=' then
4401 begin
4402 if (part1 = 'SEX="M"') and (Patient.Sex = 'M') then exit;
4403 if (part1 = 'SEX="F"') and (Patient.Sex = 'F') then exit; //?? check for '= '> '< ??
4404 value := '';
4405 end
4406 else if copy(part1, 1, 3) = 'AGE' then
4407 begin
4408 part3 := copy(part1, 5, length(part1));
4409 age := strtointdef(part3, BIG_NUMBER);
4410 if age <> BIG_NUMBER then
4411 begin
4412 part3 := copy(part1, 1, 4);
4413 if (part3 = 'AGE>') and (Patient.Age > age) then exit;
4414 if (part3 = 'AGE<') and (Patient.Age < age) then exit;
4415 if (part3 = 'AGE=') and (Patient.Age = age) then exit;
4416 end;
4417 value := '';
4418 end
4419 else
4420 value:= '';
4421 end;
4422
4423var
4424 ok: boolean;
4425 i: integer;
4426 selection, selections: string;
4427begin
4428 Result := '';
4429 if copy(aRef, length(aRef), 1) = ')' then
4430 begin
4431 selections := copy(aRef, 4, length(aRef) - 4);
4432 for i := 1 to BIG_NUMBER do
4433 begin
4434 selection := Piece(selections, ',', i);
4435 if selection = '' then break;
4436 ok := true;
4437 CheckRef(selection, Result, ok);
4438 if not ok then break;
4439 if length(Result) > 0 then break;
4440 end;
4441 end;
4442end;
4443
4444procedure TfrmGraphs.ResetSpec(aListBox: TListBox; aItemNum, aNewItemNum, aNewItemName, aNewString: string);
4445var //also add itemx
4446 i: integer;
4447 checkdate, newdate: double;
4448 newestdate, newstring: string;
4449begin
4450 lstTemp.Items.Clear;
4451 newdate := 0;
4452 for i := 0 to aListBox.Items.Count - 1 do
4453 begin
4454 newstring := aListBox.Items[i];
4455 newestdate := FMCorrectedDate(Piece(newstring, '^', 3));
4456 checkdate := strtofloatdef(newestdate, -BIG_NUMBER);
4457 if checkdate > newdate then newdate := checkdate;
4458 SetPiece(newstring, '^', 2, aNewItemNum);
4459 lstTemp.Items.Add(newstring);
4460 end;
4461 lstData.Items.AddStrings(lstTemp.Items);
4462 newestdate := floattostr(newdate);
4463 SetPiece(aNewString, '^', 2, aNewItemNum);
4464 SetPiece(aNewString, '^', 4, aNewItemName);
4465 SetPiece(aNewString, '^', 6, newestdate);
4466 lstItems.Items.Add(aNewString);
4467 lstMultiSpec.Items.Add(aNewString);
4468end;
4469
4470procedure TfrmGraphs.chartBaseClickLegend(Sender: TCustomChart;
4471 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
4472var
4473 seriestitle: string;
4474begin
4475 FGraphClick := Sender;
4476 chartDatelineTop.Tag := -1; // indicates a legend click
4477 if Button <> mbRight then
4478 ItemDateRange(Sender)
4479 else
4480 begin
4481 mnuPopGraphIsolate.Enabled := true;
4482 if pnlTop.Tag = 1 then
4483 begin
4484 if chkItemsTop.Checked then
4485 begin
4486 seriestitle := Sender.SeriesTitleLegend(0);
4487 scrlTop.Hint := 'Details - for ' + seriestitle;
4488 scrlTop.Tag := 1;
4489 mnuPopGraphIsolate.Caption := 'Move - ' + seriestitle + ' - from Top to Bottom';
4490 mnuPopGraphIsolate.Hint := seriestitle;
4491 mnuPopGraphRemove.Enabled := true;
4492 mnuPopGraphRemove.Caption := 'Remove - ' + seriestitle;
4493 mnuPopGraphDetails.Caption := 'Details - ' + seriestitle;
4494 end
4495 else
4496 begin
4497 mnuPopGraphIsolate.Caption := 'Move all selections to bottom';
4498 mnuPopGraphRemove.Caption := 'Remove all selections from top';
4499 end;
4500 end
4501 else
4502 begin
4503 if chkItemsBottom.Checked then
4504 begin
4505 seriestitle := Sender.SeriesTitleLegend(0);
4506 scrlTop.Hint := 'Details - for ' + seriestitle;
4507 scrlTop.Tag := 1;
4508 mnuPopGraphIsolate.Caption := 'Move - ' + seriestitle + ' - from Bottom to Top';
4509 mnuPopGraphIsolate.Hint := seriestitle;
4510 mnuPopGraphRemove.Enabled := true;
4511 mnuPopGraphRemove.Caption := 'Remove - ' + seriestitle;
4512 mnuPopGraphDetails.Caption := 'Details - ' + seriestitle;
4513 end
4514 else
4515 begin
4516 mnuPopGraphIsolate.Caption := 'Move all selections to top';
4517 mnuPopGraphRemove.Caption := 'Remove all selections from bottom';
4518 end;
4519 end;
4520 end;
4521end;
4522
4523function TfrmGraphs.BPValue(aDateTime: TDateTime): string;
4524var
4525 i: integer;
4526 fmdatetime: double;
4527 datastring, datecheck, fmstring: string;
4528begin
4529 Result := '';
4530 fmdatetime := datetimetofmdatetime(aDateTime);
4531 fmstring := floattostr(fmdatetime);
4532 for i := 0 to lstData.Items.Count - 1 do
4533 begin
4534 datastring := lstData.Items[i];
4535 if Pieces(datastring, '^', 1, 2) = '120.5^1' then //********** get item # for bp instead of 1
4536 begin
4537 datecheck := Piece(datastring, '^', 3);
4538 if length(Piece(datecheck, '.', 2)) > 0 then
4539 datecheck := Piece(datecheck, '.', 1) + '.' + copy(Piece(datecheck, '.', 2), 1, 4);
4540 if fmstring = datecheck then
4541 begin
4542 Result := Piece(datastring, '^', 5);
4543 break;
4544 end;
4545 end;
4546 end;
4547end;
4548
4549procedure TfrmGraphs.mnuMedsasganttClick(Sender: TObject);
4550begin
4551 (Sender as TMenuItem).Checked := true;
4552 lvwItemsTopClick(self);
4553 lvwItemsBottomClick(self);
4554end;
4555
4556procedure TfrmGraphs.mnuPopGraphResetClick(Sender: TObject);
4557begin
4558 FFirstClick := true;
4559 lstZoomHistory.Items.Clear;
4560 FRetainZoom := false;
4561 mnuPopGraphZoomBack.Enabled := false;
4562 lvwItemsTopClick(self);
4563end;
4564
4565procedure TfrmGraphs.serDatelineTopGetMarkText(Sender: TChartSeries;
4566 ValueIndex: Integer; var MarkText: String);
4567var
4568 cnt, i: integer;
4569 checktag, nonstring: string;
4570begin // ********* listing one series' values is ok but no multiple ???
4571 MarkText := Sender.Title;
4572 if Copy(MarkText, 1, 4) = 'Ref ' then
4573 MarkText := '';
4574 if Sender.Title = '(non-numeric)' then
4575 begin
4576 if Sender.Tag > 0 then
4577 begin
4578 checktag := inttostr(Sender.Tag);
4579 cnt := -1;
4580 for i := 0 to lstNonNumeric.Items.Count - 1 do
4581 begin
4582 nonstring := lstNonNumeric.Items[i];
4583 if checktag = Piece(nonstring, '^', 3) then
4584 begin
4585 cnt := cnt + 1;
4586 if cnt = ValueIndex then
4587 begin
4588 MarkText := Piece(nonstring, '^', 2);
4589 break;
4590 end;
4591 end;
4592 end;
4593 if MarkText = '(non-numeric)' then
4594 beep;
4595 end;
4596 end;
4597end;
4598
4599procedure TfrmGraphs.mnuPopGraphRemoveClick(Sender: TObject);
4600var
4601 i, selnum: integer;
4602 aSection, typeitem: string;
4603 aComboBox: TORComboBox;
4604 aListView: TListView;
4605begin
4606 FFirstClick := true;
4607 if pnlTop.Tag = 1 then
4608 begin
4609 aComboBox := cboViewsTop;
4610 aListView := lvwItemsTop;
4611 aSection := 'top';
4612 end
4613 else
4614 begin
4615 aComboBox := cboViewsBottom;
4616 aListView := lvwItemsBottom;
4617 aSection := 'bottom';
4618 end;
4619 aComboBox.ItemIndex := -1;
4620 aComboBox.Text := '';
4621 if aListView.SelCount = 0 then exit;
4622 if StripHotKey(mnuPopGraphRemove.Caption) = ('Remove all selections from ' + aSection) then
4623 begin
4624 with aListView do
4625 for i := 0 to Items.Count - 1 do
4626 if Items[i].Selected then
4627 begin
4628 Items[i].Selected := false;
4629 end;
4630 DisplayData('top');
4631 DisplayData('bottom');
4632 end
4633 else
4634 begin
4635 ItemCheck(aListView, mnuPopGraphIsolate.Hint, selnum, typeitem);
4636 if selnum = -1 then exit;
4637 aListView.Items[selnum].Selected := false;
4638 DisplayData('top');
4639 DisplayData('bottom');
4640 end;
4641 mnuPopGraphRemove.Enabled := false;
4642 mnuPopGraphResetClick(self);
4643end;
4644
4645procedure TfrmGraphs.mnuPopGraphTodayClick(Sender: TObject);
4646begin
4647 with dlgDate do
4648 begin
4649 FMDateTime := FMToday;
4650 if Execute then FMToday := FMDateTime;
4651 end;
4652end;
4653
4654procedure TfrmGraphs.BaseResize(aScrollBox: TScrollBox);
4655var
4656 displayheight, displaynum, i: integer;
4657begin
4658 ChartOnZoom(chartDatelineTop);
4659 with aScrollBox do
4660 begin
4661 if ControlCount < FGraphSetting.MaxGraphs then
4662 displaynum := ControlCount
4663 else
4664 displaynum := FGraphSetting.MaxGraphs;
4665 displayheight := FGraphSetting.MinGraphHeight;
4666 if displaynum > 0 then
4667 if (Height div displaynum) < FGraphSetting.MinGraphHeight then
4668 displayheight := FGraphSetting.MinGraphHeight
4669 else
4670 displayheight := (Height div displaynum);
4671 for i := 0 to aScrollBox.ControlCount - 1 do
4672 Controls[i].height := displayheight;
4673 end;
4674end;
4675
4676procedure TfrmGraphs.pnlScrollTopBaseResize(Sender: TObject);
4677begin
4678 ChartOnZoom(chartDatelineTop);
4679 BaseResize(scrlTop);
4680 BaseResize(scrlBottom);
4681end;
4682
4683procedure TfrmGraphs.NextPointerStyle(aSeries: TChartSeries; aSerCnt: integer);
4684var
4685 colors1, colors2, colors3, colors4, colors5, colors6: integer;
4686begin
4687 colors1 := NUM_COLORS + 1;
4688 colors2 := NUM_COLORS * 2 + 1;
4689 colors3 := NUM_COLORS * 3 + 1;
4690 colors4 := NUM_COLORS * 4 + 1;
4691 colors5 := NUM_COLORS * 5 + 1;
4692 colors6 := NUM_COLORS * 6 + 1;
4693 if aSeries is TLineSeries then
4694 begin
4695 with (aSeries as TLineSeries) do
4696 if aSerCnt < colors1 then
4697 Pointer.Style := psCircle
4698 else if aSerCnt < colors2 then
4699 Pointer.Style := psTriangle
4700 else if aSerCnt < colors3 then
4701 Pointer.Style := psRectangle
4702 else if aSerCnt < colors4 then
4703 Pointer.Style := psStar
4704 else if aSerCnt < colors5 then
4705 Pointer.Style := psDownTriangle
4706 else if aSerCnt < colors6 then
4707 Pointer.Style := psCross
4708 else
4709 Pointer.Style := psDiagCross;
4710 end
4711 else if aSeries is TBarSeries then
4712 begin
4713 with (aSeries as TBarSeries) do
4714 if aSerCnt < colors1 then
4715 BarStyle := bsPyramid
4716 else if aSerCnt < colors2 then
4717 BarStyle := bsInvPyramid
4718 else if aSerCnt < colors3 then
4719 BarStyle := bsArrow
4720 else if aSerCnt < colors4 then
4721 BarStyle := bsEllipse
4722 else
4723 BarStyle := bsRectangle;
4724 end
4725 else if aSeries is TPointSeries then
4726 begin
4727 with (aSeries as TPointSeries) do
4728 if aSerCnt < colors1 then
4729 Pointer.Style := psRectangle
4730 else if aSerCnt < colors2 then
4731 Pointer.Style := psTriangle
4732 else if aSerCnt < colors3 then
4733 Pointer.Style := psCircle
4734 else if aSerCnt < colors4 then
4735 Pointer.Style := psStar
4736 else if aSerCnt < colors5 then
4737 Pointer.Style := psDownTriangle
4738 else if aSerCnt < colors6 then
4739 Pointer.Style := psCross
4740 else
4741 Pointer.Style := psDiagCross;
4742 end;
4743end;
4744
4745function TfrmGraphs.FMCorrectedDate(fmtime: string): string;
4746begin
4747 if Copy(fmtime, 4, 4) = '0000' then Result := Copy(fmtime, 1, 3) + '0101'
4748 else if Copy(fmtime, 6, 2) = '00' then Result := Copy(fmtime, 1, 5) + '01'
4749 else Result := fmtime;
4750end;
4751
4752procedure TfrmGraphs.FixedDates(var adatetime, adatetime1: TDateTime);
4753begin
4754 if FGraphSetting.FMStartDate <> FM_START_DATE then
4755 begin // do not use when All Results
4756 adatetime := FMDateTimeToDateTime(FGraphSetting.FMStopDate);
4757 adatetime1 := FMDateTimeToDateTime(FGraphSetting.FMStartDate);
4758 FGraphSetting.HighTime := adatetime;
4759 FGraphSetting.LowTime := adatetime1;
4760 FTHighTime := adatetime;
4761 FTLowTime := adatetime1;
4762 FBHighTime := adatetime;
4763 FBLowTime := adatetime1;
4764 end;
4765end;
4766
4767procedure TfrmGraphs.HighLow(fmtime, fmtime1: string; aChart: TChart; var adatetime, adatetime1: TDateTime);
4768begin
4769 adatetime1 := 0;
4770 adatetime := FMToDateTime(fmtime);
4771 if adatetime > FGraphSetting.HighTime then FGraphSetting.HighTime := adatetime;
4772 if adatetime < FGraphSetting.LowTime then FGraphSetting.LowTime := adatetime;
4773 if aChart = chartDatelineTop then
4774 begin
4775 if adatetime > FTHighTime then FTHighTime := adatetime;
4776 if adatetime < FTLowTime then FTLowTime := adatetime;
4777 end
4778 else
4779 begin
4780 if adatetime > FBHighTime then FBHighTime := adatetime;
4781 if adatetime < FBLowTime then FBLowTime := adatetime;
4782 end;
4783 if fmtime1 <> '' then
4784 begin
4785 adatetime1 := FMToDateTime(fmtime1);
4786 if adatetime1 > FGraphSetting.HighTime then FGraphSetting.HighTime := adatetime1;
4787 if adatetime1 < FGraphSetting.LowTime then FGraphSetting.LowTime := adatetime1;
4788 if aChart = chartDatelineTop then
4789 begin
4790 if adatetime1 > FTHighTime then FTHighTime := adatetime1;
4791 if adatetime1 < FTLowTime then FTLowTime := adatetime1;
4792 end
4793 else
4794 begin
4795 if adatetime1 > FBHighTime then FBHighTime := adatetime1;
4796 if adatetime1 < FBLowTime then FBLowTime := adatetime1;
4797 end;
4798 end;
4799end;
4800
4801procedure TfrmGraphs.HideGraphs(action: boolean);
4802begin
4803 pnlTop.Color := chartDatelineTop.Color;
4804 pnlBottom.Color := chartDatelineTop.Color;
4805 if action then
4806 begin
4807 pnlScrollTopBase.Visible := false;
4808 pnlScrollBottomBase.Visible := false;
4809 end
4810 else
4811 begin
4812 pnlScrollTopBase.Visible := true;
4813 pnlScrollBottomBase.Visible := true;
4814 chartDatelineTop.Refresh;
4815 end;
4816end;
4817
4818//****************************************************************************
4819
4820procedure TfrmGraphs.MakeLineSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt, aNonCnt: integer; multiline: boolean);
4821
4822 procedure BorderValue(var bordervalue: double; value: double);
4823 begin
4824 if FGraphSetting.FixedDateRange then
4825 if bordervalue = -BIG_NUMBER then
4826 bordervalue := value;
4827 end;
4828
4829var
4830 estimate, firstcnt, i, noncnt: integer;
4831 value, fixeddatevalue, hi, highestvalue, highvalue, lo, nonvalue: double;
4832 checkdata, fmtime, itemvalue, valueD, valueM, valueS: string;
4833 high, low, specimen: string;
4834 adatetime, adatetime1: TDateTime;
4835 afixeddate, afixeddate1: TDateTime;
4836 ser1, ser2, ser3, serLow, serHigh: TLineSeries;
4837 serBlank, serPoint: TPointSeries;
4838begin
4839 fixeddatevalue := -BIG_NUMBER;
4840 highestvalue := aChart.MaxYValue(aChart.LeftAxis);
4841 if highestvalue < 1 then highestvalue := 1;
4842 firstcnt := lstNonNumeric.Items.Count;
4843 noncnt := firstcnt;
4844 aChart.LeftAxis.LabelsFont.Color := aChart.BottomAxis.LabelsFont.Color;
4845 aSerCnt := aSerCnt + 1;
4846 ser1 := TLineSeries.Create(aChart);
4847 ser2 := TLineSeries.Create(aChart);
4848 ser3 := TLineSeries.Create(aChart);
4849 serPoint := TPointSeries.Create(aChart);
4850 serBlank := TPointSeries.Create(aChart);
4851 serLow := TLineSeries.Create(aChart);
4852 serHigh := TLineSeries.Create(aChart);
4853 specimen := LowerCase(Piece(aTitle, '^', 4));
4854 low := Piece(aTitle, '^', 5); // collect non numeric - graph as events
4855 high := Piece(aTitle, '^', 6);
4856 lo := strtofloatdef(low, -BIG_NUMBER);
4857 hi := strtofloatdef(high, -BIG_NUMBER);
4858 serLow.Active := false;
4859 serHigh.Active := false;
4860 serPoint.Active := false;
4861 serBlank.Active := false;
4862 with ser1 do
4863 begin
4864 LinePen.Visible := FGraphSetting.Lines;
4865 ParentChart := aChart;
4866 Title := Piece(aTitle, '^', 3);
4867 if (length(specimen) > 0) and (not ansicontainsstr(Title, specimen)) then
4868 Title := Title + ' (' + specimen + ')';
4869 XValues.DateTime := True;
4870 NextPointerStyle(ser1, aSerCnt);
4871 Identifier := aFileType;
4872 Pointer.Visible := true;
4873 Pointer.InflateMargins := true;
4874 GetData(aTitle);
4875 ColorEachPoint := false;
4876 SeriesColor := NextColor(aSerCnt);
4877 Marks.BackColor := clInfoBk;
4878 if ser1.Title = 'Blood Pressure' then
4879 begin
4880 ser1.Title := 'Blood Pressure';
4881 with ser2 do
4882 begin
4883 ParentChart := aChart;
4884 Title := 'Blood Pressure';
4885 XValues.DateTime := true;
4886 Pointer.Style := ser1.Pointer.Style;
4887 ShowInLegend := false; //****
4888 Identifier := aFileType;
4889 Pointer.Visible := true;
4890 Pointer.InflateMargins := true;
4891 ColorEachPoint := false;
4892 SeriesColor := ser1.SeriesColor;
4893 Marks.BackColor := clInfoBk;
4894 Active := true;
4895 end;
4896 with ser3 do
4897 begin
4898 ParentChart := aChart;
4899 Title := 'Blood Pressure';
4900 XValues.DateTime := true;
4901 Pointer.Style := ser1.Pointer.Style;
4902 ShowInLegend := false; //****
4903 Identifier := aFileType;
4904 Pointer.Visible := true;
4905 Pointer.InflateMargins := true;
4906 ColorEachPoint := false;
4907 SeriesColor := ser1.SeriesColor;
4908 Marks.BackColor := clInfoBk;
4909 Active := false;
4910 end;
4911 end
4912 else
4913 begin
4914 ser2.Active := false;
4915 ser3.Active := false;
4916 end;
4917 highvalue := 0;
4918 with lstTemp do
4919 for i:= 0 to Items.Count - 1 do
4920 begin
4921 checkdata := lstTemp.Items[i];
4922 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
4923 if IsFMDateTime(fmtime) then
4924 begin
4925 HighLow(fmtime, '', aChart, adatetime, adatetime1);
4926 itemvalue := Piece(Items[i], '^', 5);
4927 itemvalue := trim(itemvalue);
4928 itemvalue := StringReplace(itemvalue, ',', '', [rfReplaceAll]);
4929 if ser1.Title = 'Blood Pressure' then
4930 begin
4931 valueS := Piece(itemvalue, '/', 1);
4932 valueD := Piece(itemvalue, '/', 2);
4933 valueM := Piece(itemvalue, '/', 3);
4934 value := strtofloatdef(valueS, -BIG_NUMBER);
4935 if value <> -BIG_NUMBER then
4936 ser1.AddXY(adatetime, value, '', clTeeColor);
4937 value := strtofloatdef(valueD, -BIG_NUMBER);
4938 if value <> -BIG_NUMBER then
4939 ser2.AddXY(adatetime, value, '', clTeeColor);
4940 value := strtofloatdef(valueM, -BIG_NUMBER);
4941 if value <> -BIG_NUMBER then
4942 begin
4943 ser3.AddXY(adatetime, value, '', clTeeColor);
4944 ser3.Active := true;
4945 end;
4946 BorderValue(fixeddatevalue, 100);
4947 end
4948 else
4949 begin
4950 value := strtofloatdef(itemvalue, -BIG_NUMBER);
4951 if value <> -BIG_NUMBER then
4952 begin
4953 if (btnChangeSettings.Tag = 1) and (hi <> -BIG_NUMBER) and (lo <> -BIG_NUMBER) then
4954 begin
4955 value := StdDev(value, hi, lo);
4956 ser1.AddXY(adatetime, value, '', clTeeColor);
4957 high := '2'; low := '-2';
4958 BorderValue(fixeddatevalue, 0);
4959 //splGraphs.Tag := 1; // show ref range
4960 end
4961 else if btnChangeSettings.Tag = 2 then
4962 begin
4963 value := InvVal(value);
4964 ser1.AddXY(adatetime, value, '', clTeeColor);
4965 high := '2'; low := '0';
4966 BorderValue(fixeddatevalue, 0);
4967 splGraphs.Tag := 0; // do not show ref range
4968 end
4969 else
4970 begin
4971 ser1.AddXY(adatetime, value, '', clTeeColor);
4972 if value > highvalue then
4973 highvalue := value;
4974 BorderValue(fixeddatevalue, value);
4975 end;
4976 end
4977 else
4978 begin
4979 noncnt := noncnt + 1;
4980 lstNonNumeric.Items.Add(floattostr(adatetime) + '^' +
4981 itemvalue + '^' + inttostr(aNonCnt + 1));
4982 end;
4983 end;
4984 end;
4985 end;
4986 if (length(low) > 0) and (splGraphs.Tag = 1) then
4987 begin
4988 with serLow do
4989 begin
4990 Active := true;
4991 ParentChart := aChart;
4992 XValues.DateTime := True;
4993 Pointer.Visible := false;
4994 Pointer.InflateMargins := true;
4995 OnGetMarkText := serDatelineTop.OnGetMarkText;
4996 ColorEachPoint := false;
4997 Title := 'Ref Low ' + low;
4998 Pointer.Style := psCircle;
4999 SeriesColor := ser1.SeriesColor; //clBtnShadow ; //clTeeColor;
5000 Marks.Visible := false;
5001 LinePen.Visible := true;
5002 LinePen.Width := 2;
5003 LinePen.Style := psDash; //does not show when width <> 1
5004 end;
5005 value := strtofloatdef(low, -BIG_NUMBER);
5006 if value <> -BIG_NUMBER then
5007 begin
5008 serLow.AddXY(IncDay(FGraphSetting.LowTime, -1), value, '', clTeeColor);
5009 serLow.AddXY(IncDay(FGraphSetting.HighTime, 1), value, '', clTeeColor);
5010 BorderValue(fixeddatevalue, value);
5011 end;
5012 end;
5013 if (length(high) > 0) and (splGraphs.Tag = 1) then
5014 begin
5015 with serHigh do
5016 begin
5017 Active := true;
5018 ParentChart := aChart;
5019 XValues.DateTime := True;
5020 Pointer.Visible := false;
5021 Pointer.InflateMargins := true;
5022 OnGetMarkText := serDatelineTop.OnGetMarkText;
5023 ColorEachPoint := false;
5024 Title := 'Ref High ' + high;
5025 Pointer.Style := psCircle;
5026 SeriesColor := ser1.SeriesColor; // clBtnShadow; //clTeeColor;
5027 Marks.Visible := false;
5028 LinePen.Visible := true;
5029 LinePen.Width := 2;
5030 LinePen.Style := psDash; //does not show when width <> 1
5031 end;
5032 value := strtofloatdef(high, -BIG_NUMBER);
5033 if value <> -BIG_NUMBER then
5034 begin
5035 serHigh.AddXY(IncDay(FGraphSetting.LowTime, -1), value, '', clTeeColor);
5036 serHigh.AddXY(IncDay(FGraphSetting.HighTime, 1), value, '', clTeeColor);
5037 BorderValue(fixeddatevalue, value);
5038 end;
5039 end;
5040 splGraphs.Tag := 0;
5041 if noncnt > firstcnt then
5042 begin
5043 if aChart.Height < 10 then estimate := pnlMain.Height div 2
5044 else estimate := aChart.Height;
5045 aNonCnt := aNonCnt + 1; // use nonnumeric count to offset position
5046 nonvalue := (aNonCnt * (10 / (estimate + 1)) * highestvalue);
5047 with serBlank do
5048 begin
5049 Active := true;
5050 ParentChart := aChart;
5051 XValues.DateTime := True;
5052 Pointer.Visible := true;
5053 Pointer.InflateMargins := true;
5054 OnGetMarkText := serDatelineTop.OnGetMarkText;
5055 ColorEachPoint := false;
5056 Title := '';
5057 Pointer.Style := psSmallDot;
5058 SeriesColor := aChart.Color;
5059 Marks.Visible := false;
5060 ShowInLegend := false;
5061 end;
5062 with serPoint do
5063 begin
5064 Active := true;
5065 ParentChart := aChart;
5066 XValues.DateTime := True;
5067 Pointer.Visible := true;
5068 Pointer.InflateMargins := true;
5069 OnGetMarkText := serDatelineTop.OnGetMarkText;
5070 ColorEachPoint := false;
5071 Title := '(non-numeric)';
5072 Hint := aTitle;
5073 Tag := aNonCnt;
5074 Pointer.Style := ser1.Pointer.Style;
5075 SeriesColor := ser1.SeriesColor;
5076 Marks.BackColor := clInfoBk;
5077 ShowInLegend := false;
5078 end;
5079 for i := 0 to lstNonNumeric.Items.Count - 1 do
5080 begin
5081 if Piece(lstNonNumeric.Items[i], '^',3) = inttostr(aNonCnt) then
5082 if highvalue = 0 then
5083 begin
5084 adatetime := strtofloatdef(Piece(lstNonNumeric.Items[i], '^', 1), -BIG_NUMBER);
5085 if adatetime <> -BIG_NUMBER then
5086 begin
5087 serBlank.Pointer.Pen.Visible := false;
5088 serBlank.AddXY(adatetime, 1, '', pnlScrollTopBase.Color);
5089 break;
5090 end;
5091 end;
5092 end;
5093 for i := 0 to lstNonNumeric.Items.Count - 1 do
5094 if Piece(lstNonNumeric.Items[i], '^',3) = inttostr(aNonCnt) then
5095 begin
5096 adatetime := strtofloatdef(Piece(lstNonNumeric.Items[i], '^', 1), -BIG_NUMBER);
5097 if adatetime <> -BIG_NUMBER then
5098 begin
5099 serPoint.Pointer.Pen.Visible := true;
5100 serPoint.AddXY(adatetime, nonvalue, '', ser1.SeriesColor);
5101 BorderValue(fixeddatevalue, nonvalue);
5102 end;
5103 end;
5104 if highvalue = 0 then
5105 begin
5106 aChart.LeftAxis.LabelsFont.Color := pnlScrollTopBase.Color;
5107 FNonNumerics := true;
5108 end;
5109 end;
5110 if ser1.Title = 'Pain' then
5111 begin
5112 if not serBlank.Active then
5113 with serBlank do
5114 begin
5115 Active := true;
5116 ParentChart := aChart;
5117 XValues.DateTime := True;
5118 Pointer.Visible := true;
5119 Pointer.InflateMargins := true;
5120 OnGetMarkText := serDatelineTop.OnGetMarkText;
5121 ColorEachPoint := false;
5122 Title := '';
5123 Pointer.Style := psSmallDot;
5124 SeriesColor := aChart.Color;
5125 Marks.Visible := false;
5126 ShowInLegend := false;
5127 end;
5128 serBlank.Pointer.Pen.Visible := false;
5129 serBlank.AddXY(IncDay(FGraphSetting.LowTime, -1), 0, '', pnlScrollTopBase.Color);
5130 serBlank.AddXY(IncDay(FGraphSetting.LowTime, -1), 10, '', pnlScrollTopBase.Color);
5131 end;
5132 if multiline then
5133 begin
5134 // do nothing for now
5135 end;
5136 if fixeddatevalue <> -BIG_NUMBER then
5137 begin
5138 if not serBlank.Active then
5139 with serBlank do
5140 begin
5141 Active := true;
5142 ParentChart := aChart;
5143 XValues.DateTime := True;
5144 Pointer.Visible := true;
5145 Pointer.InflateMargins := true;
5146 OnGetMarkText := serDatelineTop.OnGetMarkText;
5147 ColorEachPoint := false;
5148 Title := '';
5149 Pointer.Style := psSmallDot;
5150 SeriesColor := aChart.Color;
5151 Marks.Visible := false;
5152 ShowInLegend := false;
5153 end;
5154 FixedDates(afixeddate, afixeddate1);
5155 serBlank.Pointer.Pen.Visible := false;
5156 serBlank.AddXY(afixeddate, fixeddatevalue, '', aChart.Color);
5157 serBlank.AddXY(afixeddate1, fixeddatevalue, '', aChart.Color);
5158 end;
5159 GetHorizAxis.ExactDateTime := True;
5160 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5161 end;
5162end;
5163
5164procedure TfrmGraphs.MakePointSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5165var
5166 i: integer;
5167 value: double;
5168 fmtime: string;
5169 adatetime, adatetime1: TDateTime;
5170 ser1: TPointSeries;
5171begin
5172 aSerCnt := aSerCnt + 1;
5173 ser1 := TPointSeries.Create(aChart);
5174 with ser1 do
5175 begin
5176 ParentChart := aChart;
5177 Title := Piece(aTitle, '^', 3);
5178 OnGetMarkText := serDatelineTop.OnGetMarkText;
5179 XValues.DateTime := True;
5180 NextPointerStyle(ser1, aSerCnt);
5181 Pointer.VertSize := 10;
5182 Pointer.HorizSize := 2;
5183 Identifier := aFileType;
5184 Pointer.Visible := true;
5185 GetData(aTitle);
5186 ColorEachPoint := false;
5187 SeriesColor := NextColor(aSerCnt);
5188 Marks.BackColor := clInfoBk;
5189 with lstTemp do
5190 for i := 0 to lstTemp.Items.Count - 1 do
5191 begin
5192 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5193 if IsFMDateTime(fmtime) then
5194 begin
5195 HighLow(fmtime, '', aChart, adatetime, adatetime1);
5196 value := strtofloatdef(Piece(Items[i], '^', 5), -BIG_NUMBER);
5197 if value = -BIG_NUMBER then
5198 begin
5199 value := aSerCnt;
5200 TempCheck(Pieces(Items[i], '^', 1, 2), value);
5201 end;
5202 ser1.AddXY(adatetime, value, '', clTeeColor);
5203 end;
5204 end;
5205 GetHorizAxis.ExactDateTime := True;
5206 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5207 end;
5208end;
5209
5210procedure TfrmGraphs.MakeBarSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5211var
5212 i: integer;
5213 value: double;
5214 fmtime: string;
5215 adatetime, adatetime1: TDateTime;
5216 afixeddate, afixeddate1: TDateTime;
5217 ser1: TBarSeries;
5218 serBlank: TPointSeries;
5219begin
5220 aSerCnt := aSerCnt + 1;
5221 ser1 := TBarSeries.Create(aChart);
5222 serBlank := TPointSeries.Create(aChart);
5223 with serBlank do
5224 begin
5225 Active := true;
5226 ParentChart := aChart;
5227 XValues.DateTime := True;
5228 Pointer.Visible := true;
5229 Pointer.InflateMargins := false;
5230 ColorEachPoint := false;
5231 Title := '';
5232 Pointer.Style := psSmallDot;
5233 OnGetMarkText := serDatelineTop.OnGetMarkText;
5234 SeriesColor := aChart.Color;
5235 Marks.BackColor := clInfoBk;
5236 ShowInLegend := false;
5237 end;
5238 with ser1 do
5239 begin
5240 ParentChart := aChart;
5241 Title := Piece(aTitle, '^', 3);
5242 XValues.DateTime := True;
5243 YOrigin := 0;
5244 Identifier := aFileType;
5245 Marks.Visible := false;
5246 OnGetMarkText := serDatelineTop.OnGetMarkText;
5247 CustomBarWidth := 7;
5248 Marks.Style := smsLabel;
5249 GetData(aTitle);
5250 ColorEachPoint := false;
5251 SeriesColor := NextColor(aSerCnt);
5252 Marks.BackColor := clInfoBk;
5253 NextPointerStyle(ser1, aSerCnt);
5254 with lstTemp do
5255 for i:= 0 to Items.Count - 1 do
5256 begin
5257 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5258 if IsFMDateTime(fmtime) then
5259 begin
5260 HighLow(fmtime, '', aChart, adatetime, adatetime1);
5261 value := 25 - (aSerCnt mod NUM_COLORS);
5262 if FPrevEvent = copy(fmtime, 1, 10) then
5263 if copy((FPrevEvent + '00'), 1, 12) = copy(fmtime, 1, 12) then // same time occurrence
5264 begin
5265 pnlInfo.Caption := TXT_WARNING_SAME_TIME;
5266 pnlInfo.Color := COLOR_WARNING;
5267 pnlInfo.Visible := true;
5268 pnlHeader.Visible := true;
5269 FWarning := true;
5270 end;
5271 if value <> -BIG_NUMBER then
5272 ser1.AddXY(adatetime, value, '', clTeeColor);
5273 FPrevEvent := copy(fmtime, 1, 10);
5274 if i = 0 then
5275 begin
5276 serBlank.Pointer.Pen.Visible := false;
5277 serBlank.AddXY(adatetime, 100, '', aChart.Color);
5278 if FGraphSetting.FixedDateRange then
5279 begin
5280 FixedDates(afixeddate, afixeddate1);
5281 serBlank.AddXY(afixeddate, 100, '', aChart.Color);
5282 serBlank.AddXY(afixeddate1, 100, '', aChart.Color);
5283 end;
5284 end;
5285 end;
5286 end;
5287 GetHorizAxis.ExactDateTime := True;
5288 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5289 end;
5290end;
5291
5292procedure TfrmGraphs.MakeManyGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5293var
5294 i, value: integer;
5295 fmtime, fmtime1: string;
5296 adatetime, adatetime1: TDateTime;
5297 afixeddate, afixeddate1: TDateTime;
5298 gantt: TGanttSeries;
5299 serBlank: TPointSeries;
5300begin
5301 aSerCnt := aSerCnt + 1;
5302 gantt := TGanttSeries.Create(aChart);
5303 serBlank := TPointSeries.Create(aChart);
5304 with serBlank do
5305 begin
5306 Active := true;
5307 ParentChart := aChart;
5308 XValues.DateTime := True;
5309 Pointer.Visible := true;
5310 Pointer.InflateMargins := false;
5311 ColorEachPoint := false;
5312 Title := '';
5313 Pointer.Style := psSmallDot;
5314 OnGetMarkText := serDatelineTop.OnGetMarkText;
5315 SeriesColor := aChart.Color;
5316 Marks.BackColor := clInfoBk;
5317 ShowInLegend := false;
5318 end;
5319 with gantt do
5320 begin
5321 ParentChart := aChart;
5322 Title := Piece(aTitle, '^', 3);
5323 Marks.Style := smsLabel;
5324 OnGetMarkText := serDatelineTop.OnGetMarkText;
5325 if Piece(aTitle, '^', 1) = '55' then // make inpatient meds smaller to identify
5326 Pointer.VertSize := RX_HEIGHT_IN
5327 else if Piece(aTitle, '^', 1) = '55NVA' then // make nonva meds smaller to identify
5328 Pointer.VertSize := RX_HEIGHT_NVA
5329 else if Piece(aTitle, '^', 1) = '9999911' then // make problems smaller to identify
5330 Pointer.VertSize := PROB_HEIGHT
5331 else
5332 Pointer.VertSize := RX_HEIGHT_OUT;
5333 GetData(aTitle);
5334 ColorEachPoint := false;
5335 SeriesColor := NextColor(aSerCnt);
5336 Identifier := aFileType;
5337 Marks.BackColor := clInfoBk;
5338 value := round(((aSerCnt mod NUM_COLORS) / NUM_COLORS) * 80) + 20 + aSerCnt;
5339 if aFileType <> '9999911' then
5340 if aChart <> chartDatelineTop then
5341 if aChart <> chartDatelineBottom then
5342 value := value - 26;
5343 with lstTemp do
5344 for i := 0 to lstTemp.Items.Count - 1 do
5345 begin
5346 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5347 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5348 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5349 begin
5350 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5351 AddGantt(adatetime, adatetime1, value, '');
5352 if i = 0 then
5353 begin
5354 serBlank.Pointer.Pen.Visible := false;
5355 serBlank.AddXY(adatetime, 100, '', aChart.Color);
5356 if aFileType = '9999911' then
5357 serBlank.AddXY(adatetime, 0, '', aChart.Color);
5358 if FGraphSetting.FixedDateRange then
5359 begin
5360 FixedDates(afixeddate, afixeddate1);
5361 serBlank.AddXY(afixeddate, 100, '', aChart.Color);
5362 serBlank.AddXY(afixeddate1, 100, '', aChart.Color);
5363 end;
5364 end;
5365 end;
5366 end;
5367 GetHorizAxis.ExactDateTime := True;
5368 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5369 end;
5370end;
5371
5372procedure TfrmGraphs.MakeVisitGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5373var
5374 i: integer;
5375 value: double;
5376 fmtime, fmtime1: string;
5377 adatetime, adatetime1: TDateTime;
5378 afixeddate, afixeddate1: TDateTime;
5379 gantt: TGanttSeries;
5380 serBlank: TPointSeries;
5381begin
5382 aSerCnt := aSerCnt + 1;
5383 gantt := TGanttSeries.Create(aChart);
5384 serBlank := TPointSeries.Create(aChart);
5385 with serBlank do
5386 begin
5387 Active := true;
5388 ParentChart := aChart;
5389 XValues.DateTime := True;
5390 Pointer.Visible := true;
5391 Pointer.InflateMargins := false;
5392 ColorEachPoint := false;
5393 Title := '';
5394 Pointer.Style := psSmallDot;
5395 OnGetMarkText := serDatelineTop.OnGetMarkText;
5396 SeriesColor := aChart.Color;
5397 Marks.Visible := false;
5398 ShowInLegend := false;
5399 end;
5400 with gantt do
5401 begin
5402 ParentChart := aChart;
5403 Title := Piece(aTitle, '^', 3);
5404 Marks.Style := smsLabel;
5405 OnGetMarkText := serDatelineTop.OnGetMarkText;
5406 if Piece(aTitle, '^', 1) = '405' then // make admit smaller to identify
5407 Pointer.VertSize := NUM_COLORS + 3
5408 else if Piece(aTitle, '^', 1) = '9999911' then // make problems smaller to identify
5409 Pointer.VertSize := PROB_HEIGHT
5410 else
5411 Pointer.VertSize := NUM_COLORS + (aSerCnt mod NUM_COLORS) + 10;
5412 GetData(aTitle);
5413 ColorEachPoint := false;
5414 SeriesColor := NextColor(aSerCnt);
5415 Identifier := aFileType;
5416 Marks.BackColor := clInfoBk;
5417 value := aSerCnt div NUM_COLORS;
5418 with lstTemp do
5419 for i:= 0 to Items.Count - 1 do
5420 begin
5421 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5422 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5423 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5424 begin
5425 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5426 AddGantt(adatetime, adatetime1, value, '');
5427 if i = 0 then
5428 begin
5429 serBlank.Pointer.Pen.Visible := false;
5430 serBlank.AddXY(adatetime, 100, '', aChart.Color);
5431 if FGraphSetting.FixedDateRange then
5432 begin
5433 FixedDates(afixeddate, afixeddate1);
5434 serBlank.AddXY(afixeddate, 100, '', aChart.Color);
5435 serBlank.AddXY(afixeddate1, 100, '', aChart.Color);
5436 end;
5437 end;
5438 end;
5439 end;
5440 GetHorizAxis.ExactDateTime := True;
5441 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5442 end;
5443end;
5444
5445procedure TfrmGraphs.MakeWeightedGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5446var
5447 i: integer;
5448 value: double;
5449 fmtime, fmtime1: string;
5450 gantt: TGanttSeries;
5451 adatetime, adatetime1: TDateTime;
5452begin
5453 aSerCnt := aSerCnt + 1;
5454 gantt := TGanttSeries.Create(aChart);
5455 with gantt do
5456 begin
5457 ParentChart := aChart;
5458 Title := Piece(aTitle, '^', 3);
5459 Marks.Style := smsLabel;
5460 OnGetMarkText := serDatelineTop.OnGetMarkText;
5461 value := NUM_COLORS;
5462 GetData(aTitle);
5463 ColorEachPoint := false;
5464 SeriesColor := NextColor(aSerCnt);
5465 Identifier := aFileType;
5466 Marks.BackColor := clInfoBk;
5467 with lstTemp do
5468 for i:= 0 to Items.Count - 1 do
5469 begin
5470 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5471 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5472 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5473 begin
5474 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5475 value := Vfactor(Piece(aTitle, '^', 3));
5476 AddGantt(adatetime, adatetime1, 1, '');
5477 value := value + (value / 2);
5478 end;
5479 end;
5480 Pointer.VertSize := round(value);
5481 GetHorizAxis.ExactDateTime := True;
5482 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5483 end;
5484end;
5485
5486procedure TfrmGraphs.MakeArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5487var
5488 i: integer;
5489 value: double;
5490 fmtime, fmtime1: string;
5491 arrows: TArrowSeries;
5492 adatetime, adatetime1: TDateTime;
5493begin
5494 aSerCnt := aSerCnt + 1;
5495 arrows := TArrowSeries.Create(aChart);
5496 with arrows do
5497 begin
5498 ParentChart := aChart;
5499 Title := Piece(aTitle, '^', 3);
5500 Clear;
5501 ArrowWidth := 12;
5502 ArrowHeight := 9;
5503 StartXValues.DateTime := true;
5504 EndXValues.DateTime := true;
5505 Marks.Style := smsLabel;
5506 OnGetMarkText := serDatelineTop.OnGetMarkText;
5507 Pointer.Visible := false;
5508 Pointer.VertSize := 17; //pnlTop.Height; //******* for meds
5509 Pointer.HorizSize := 24;
5510 Pointer.InflateMargins := true;
5511 GetData(aTitle);
5512 ColorEachPoint := false;
5513 SeriesColor := NextColor(aSerCnt);
5514 Identifier := aFileType;
5515 Marks.BackColor := clInfoBk;
5516 with lstTemp do
5517 for i:= 0 to Items.Count - 1 do
5518 begin
5519 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5520 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5521 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5522 begin
5523 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5524 value := strtofloatdef(Piece(Items[i], '^', 5), -BIG_NUMBER);
5525 if value = -BIG_NUMBER then
5526 TempCheck(Pieces(Items[i], '^', 1, 2), value);
5527 AddArrow(adatetime, value, adatetime1, value, '', SeriesColor);
5528 end;
5529 end;
5530 GetHorizAxis.ExactDateTime := True;
5531 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5532 end;
5533end;
5534
5535procedure TfrmGraphs.MakeWeightedArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5536var
5537 i: integer;
5538 value: double;
5539 fmtime, fmtime1: string;
5540 adatetime, adatetime1: TDateTime;
5541 arrows: TArrowSeries;
5542begin
5543 aSerCnt := aSerCnt + 1;
5544 arrows := TArrowSeries.Create(aChart);
5545 with arrows do
5546 begin
5547 ParentChart := aChart;
5548 Title := Piece(aTitle, '^', 3);
5549 Clear;
5550 ArrowWidth := 12;
5551 ArrowHeight := 9;
5552 StartXValues.DateTime := true;
5553 EndXValues.DateTime := true;
5554 Marks.Style := smsLabel;
5555 OnGetMarkText := serDatelineTop.OnGetMarkText;
5556 Pointer.Visible := false;
5557 Pointer.VertSize := 17; //pnlTop.Height; //******* for meds
5558 Pointer.HorizSize := 24;
5559 Pointer.InflateMargins := true;
5560 GetData(aTitle);
5561 ColorEachPoint := false;
5562 SeriesColor := NextColor(aSerCnt);
5563 Identifier := aFileType;
5564 Marks.BackColor := clInfoBk;
5565 with lstTemp do
5566 for i:= 0 to Items.Count - 1 do
5567 begin
5568 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5569 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5570 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5571 begin
5572 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5573 value := strtofloatdef(Piece(Items[i], '^', 5), -BIG_NUMBER);
5574 if value = -BIG_NUMBER then
5575 TempCheck(Pieces(Items[i], '^', 1, 2), value);
5576 AddArrow(adatetime, value, adatetime1, value, '', SeriesColor);
5577 end;
5578 end;
5579 value := Vfactor(Piece(aTitle, '^', 3));
5580 if value < 1 then value := 1;
5581 Pointer.HorizSize := round(value);
5582 GetHorizAxis.ExactDateTime := True;
5583 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5584 end;
5585end;
5586
5587procedure TfrmGraphs.MakeGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5588var
5589 i: integer;
5590 value: double;
5591 fmtime, fmtime1: string;
5592 adatetime, adatetime1: TDateTime;
5593 gantt: TGanttSeries;
5594begin
5595 aSerCnt := aSerCnt + 1;
5596 gantt := TGanttSeries.Create(aChart);
5597 with gantt do
5598 begin
5599 ParentChart := aChart;
5600 Title := Piece(aTitle, '^', 3);
5601 Marks.Style := smsLabel;
5602 OnGetMarkText := serDatelineTop.OnGetMarkText;
5603 Pointer.VertSize := pnlTop.Height; //******* like vertical bars
5604 GetData(aTitle);
5605 ColorEachPoint := false;
5606 SeriesColor := NextColor(aSerCnt);
5607 Identifier := aFileType;
5608 Marks.BackColor := clInfoBk;
5609 with lstTemp do
5610 for i:= 0 to Items.Count - 1 do
5611 begin
5612 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5613 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5614 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5615 begin
5616 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5617 value := strtofloatdef(Piece(Items[i], '^', 5), -BIG_NUMBER);
5618 if value = -BIG_NUMBER then
5619 TempCheck(Pieces(Items[i], '^', 1, 2), value);
5620 AddGantt(adatetime, adatetime1, 1, '');
5621 end;
5622 end;
5623 GetHorizAxis.ExactDateTime := True;
5624 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5625 end;
5626end;
5627
5628procedure TfrmGraphs.MakeAGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer);
5629var
5630 i: integer;
5631 value: double;
5632 fmtime, fmtime1: string;
5633 gantt: TGanttSeries;
5634 adatetime, adatetime1: TDateTime;
5635begin
5636 aSerCnt := aSerCnt + 1;
5637 if aChart = chartDatelineTop then
5638 gantt := serDatelineTop
5639 else
5640 gantt := serDatelineBottom;
5641 with gantt do
5642 begin
5643 ParentChart := aChart;
5644 Active := true;
5645 Title := Piece(aTitle, '^', 3);
5646 Marks.Style := smsLabel;
5647 OnGetMarkText := serDatelineTop.OnGetMarkText;
5648 //Pointer.VertSize := pnlTop.Height; //******* for meds
5649 GetData(aTitle);
5650 Identifier := aFileType;
5651 ColorEachPoint := True;
5652 with lstTemp do
5653 for i:= 0 to Items.Count - 1 do
5654 begin
5655 fmtime := FMCorrectedDate(Piece(Items[i], '^', 3));
5656 fmtime1 := FMCorrectedDate(Piece(Items[i], '^', 4));
5657 if IsFMDateTime(fmtime) and IsFMDateTime(fmtime1) then
5658 begin
5659 HighLow(fmtime, fmtime1, aChart, adatetime, adatetime1);
5660 value := strtofloatdef(Piece(Items[i], '^', 5), -BIG_NUMBER);
5661 if value = -BIG_NUMBER then
5662 TempCheck(Pieces(Items[i], '^', 1, 2), value);
5663 AddGantt(adatetime, adatetime1, aSerCnt, '');
5664 end;
5665 end;
5666 GetHorizAxis.ExactDateTime := True;
5667 GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
5668 end;
5669end;
5670
5671procedure TfrmGraphs.splGraphsMoved(Sender: TObject);
5672begin
5673 if Sender = splGraphs then
5674 chkDualViews.Checked := pnlBottom.Height > 3;
5675end;
5676
5677function TfrmGraphs.ValueText(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer): string;
5678var // type#^typename^formatdate^itemname^result^date
5679 i, offset, SeriesNum, selnum: integer;
5680 dateend, datestart: double;
5681 astring, datecheck, filetype, fmdatecheck, item, otherdate, partitem: string;
5682 resultdate, results, seriestitle, typeitem, typename, typenum: string;
5683begin
5684 SeriesNum := -1;
5685 for i := 0 to Sender.SeriesCount -1 do
5686 if Sender.Series[i] = Series then
5687 begin
5688 SeriesNum := i;
5689 filetype := Sender.Series[i].Identifier;
5690 break;
5691 end;
5692 seriestitle := Sender.Series[SeriesNum].Title;
5693 if (seriestitle = '') and (SeriesNum < (Series.Count - 1)) then
5694 if Sender.Series[SeriesNum + 1].Title = '(non-numeric)' then
5695 begin
5696 SeriesNum := SeriesNum + 1;
5697 seriestitle := '(non-numeric)';
5698 end;
5699 Result := '';
5700 if seriestitle <> '(non-numeric)' then
5701 begin
5702 ItemCheck(lvwItemsTop, seriestitle, selnum, typeitem);
5703 typeitem := UpperCase(typeitem);
5704 end
5705 else
5706 begin
5707 selnum := 1;
5708 typeitem := '63';
5709 offset := 2; // 2 series before
5710 if (copy(Sender.Series[SeriesNum - offset].Title, 1, 4) = 'Ref ') then
5711 if SeriesNum - 4 > -1 then
5712 offset := 4 // if ref ranges
5713 else if SeriesNum - 3 > -1 then
5714 offset := 3; // if ref ranges
5715 seriestitle := Sender.Series[SeriesNum - offset].Title + ' ' + seriestitle;
5716 end;
5717 if selnum < 0 then
5718 begin
5719 Result := '^^^' + seriestitle;
5720 exit;
5721 end;
5722 typenum := Piece(typeitem, '^', 1);
5723 if (typenum <> filetype) and (filetype <> '') then
5724 begin
5725 typenum := filetype;
5726 typeitem := typenum + '^' + Piece(typeitem, '^', 2);
5727 end;
5728 if typenum = '55' then
5729 begin
5730 if Series is TGanttSeries then
5731 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_IN then
5732 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_NVA then
5733 typenum := '52'
5734 else typenum := '55NVA';
5735 end
5736 else if typenum = '55NVA' then
5737 begin
5738 if Series is TGanttSeries then
5739 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_NVA then
5740 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_OUT then
5741 typenum := '55'
5742 else typenum := '52';
5743 end
5744 else if typenum = '52' then
5745 begin
5746 if Series is TGanttSeries then
5747 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_OUT then
5748 if (Series as TGanttSeries).Pointer.VertSize <> RX_HEIGHT_NVA then
5749 typenum := '55'
5750 else typenum := '55NVA';
5751 end;
5752 typename := FileNameX(typenum);
5753 if ValueIndex < 0 then
5754 begin
5755 Result := typenum + '^' + typename + '^^' + seriestitle;
5756 exit;
5757 end;
5758 if Copy(typename, length(typename) - 2, 3) = 'ies' then
5759 typename := Copy(typename, 1, length(typename) - 3) + 'y'
5760 else if Copy(typename, length(typename), 1) = 's' then
5761 typename := Copy(typename, 1, length(typename) - 1);
5762 if (Series is TGanttSeries) then
5763 begin
5764 datestart := (Series as TGanttSeries).StartValues[ValueIndex];
5765 dateend := (Series as TGanttSeries).EndValues[ValueIndex];
5766 end
5767 else
5768 begin
5769 datestart := Series.XValue[ValueIndex];
5770 dateend := datestart;
5771 end;
5772 if datestart <> dateend then
5773 begin
5774 resultdate := FormatDateTime('mmm d, yyyy h:nn am/pm', datestart) +
5775 ' - ' + FormatDateTime('mmm d, yyyy h:nn am/pm', dateend);
5776 otherdate := FormatDateTime('mm/dd/yy hh:nn', datestart) +
5777 ' - ' + FormatDateTime('mm/dd/yy hh:nn', dateend);
5778 end
5779 else
5780 begin
5781 resultdate := FormatDateTime('mmm d, yyyy h:nn am/pm', datestart);
5782 otherdate := FormatDateTime('mm/dd/yy hh:nn', datestart);
5783 end;
5784 results := '';
5785 if typenum = '63' then
5786 begin
5787 if Series is TLineSeries then
5788 if (Series as TLineSeries).LinePen.Style = psDash then
5789 exit; // serHigh or serLow
5790 if Series is TPointSeries then
5791 if (Series as TPointSeries).Pointer.Style = psSmallDot then
5792 exit; // serBlank
5793 if copy(seriestitle, length(seriestitle) - 12, length(seriestitle)) = '(non-numeric)' then
5794 begin
5795 seriestitle := copy(seriestitle, 1, length(seriestitle) - 13);
5796 serDatelineTopGetMarkText(Sender.Series[SeriesNum], ValueIndex, results);
5797 end
5798 else
5799 results := floattostr(Series.YValue[ValueIndex]);
5800 end
5801 else if typenum <> '120.5' then
5802 begin
5803 item := Piece(typeitem, '^', 2);
5804 partitem := copy(item, 1, 4);
5805 //if (partitem = 'M;A;') then //or (partitem = 'M;T;') then tb antibiotic on 1st piece
5806 begin
5807 fmdatecheck := floattostr(DateTimeToFMDateTime(Series.XValue[ValueIndex]));
5808 for i := 0 to lstData.Items.Count - 1 do
5809 begin
5810 astring := lstData.Items[i];
5811 if item = Piece(astring, '^', 2) then
5812 begin
5813 datecheck := Piece(astring, '^', 3);
5814 if length(Piece(datecheck, '.', 2)) > 0 then
5815 datecheck := Piece(datecheck, '.', 1) + '.' + copy(Piece(datecheck, '.', 2), 1, 4);
5816 if datecheck = fmdatecheck then
5817 begin
5818 results := MixedCase(Piece(astring, '^', 5));
5819 break;
5820 end;
5821 end;
5822 end;
5823 end;
5824 end
5825 else if typenum = '120.5' then
5826 begin
5827 if seriestitle = 'Blood Pressure' then
5828 results := BPValue(Series.XValue[ValueIndex])
5829 else
5830 results := floattostr(Series.YValue[ValueIndex]);
5831 end;
5832 Result := typenum + ' ^' + typename + '^' + resultdate + '^' +
5833 seriestitle + '^' + results + '^' + otherdate;
5834end;
5835
5836procedure TfrmGraphs.chartBaseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
5837var
5838 ClickedLegend, ClickedValue, j: Integer;
5839 itemname: string;
5840 NewPt: TPoint;
5841begin
5842 //if not FGraphSetting.Hints then exit; //*****
5843 FX := x;
5844 FY := y;
5845 FActiveGraph := (Sender as TChart);
5846 NewPt := Mouse.CursorPos;
5847 ClickedValue := -1;
5848 ClickedLegend := -1;
5849 if FHintWinActive then exit;
5850 with FActiveGraph do
5851 begin
5852 for j := 0 to SeriesCount - 1 do
5853 with (Series[j] as TChartSeries) do
5854 begin
5855 itemname := Series[j].Title;
5856 if (Copy(itemname, 1, 7) <> 'Ref Low') and (Copy(itemname, 1, 8) <> 'Ref High') then
5857 begin
5858 ClickedValue := Clicked(FX, FY);
5859 if ClickedValue > -1 then break;
5860 ClickedLegend := Legend.Clicked(FX, FY);
5861 if ClickedLegend > -1 then break;
5862 end;
5863 end;
5864 if ClickedValue > -1 then
5865 begin
5866 FHintStop := false;
5867 Screen.Cursor := crHandPoint;
5868 timHintPause.Enabled := true;
5869 end
5870 else if ClickedLegend > -1 then
5871 begin
5872 timHintPause.Enabled := false;
5873 InactivateHint;
5874 Screen.Cursor := crHandPoint;
5875 end
5876 else
5877 begin
5878 timHintPause.Enabled := false;
5879 InactivateHint;
5880 Screen.Cursor := crDefault;
5881 end;
5882 end;
5883end;
5884
5885procedure TfrmGraphs.timHintPauseTimer(Sender: TObject);
5886var
5887 ClickedValue, j: Integer;
5888 dttm, itemname, textvalue: string;
5889 Rct: TRect;
5890begin
5891 with FActiveGraph do
5892 begin
5893 ClickedValue := -1;
5894 for j := 0 to SeriesCount - 1 do
5895 with (Series[j] as TChartSeries) do
5896 begin
5897 if FHintStop then break;
5898 ClickedValue := Clicked(FX, FY);
5899 if ClickedValue > -1 then break;
5900 end;
5901 if FHintStop then // stop when clicked
5902 begin
5903 timHintPause.Enabled := false;
5904 InactivateHint;
5905 FHintStop := false;
5906 exit;
5907 end;
5908 if (ClickedValue > -1) and ((FOnValue <> ClickedValue) or (FOnSeries <> j)) then
5909 begin // on a value but not the same value or series
5910 if FHintWinActive then
5911 InactivateHint;
5912 itemname := Series[j].Title;
5913 if Copy(itemname, 1, 7)= 'Ref Low' then exit;
5914 if Copy(itemname, 1, 8)= 'Ref High' then exit;
5915 FOnSeries := j;
5916 FOnValue := ClickedValue;
5917 textvalue := ValueText(FActiveGraph, Series[j], ClickedValue);
5918 dttm := Piece(textvalue, '^', 3);
5919 //if copy(textvalue, length(textvalue) - 5, length(textvalue)) = ' 00:00' then
5920 // dttm := Pieces(dttm, ' ', 1, 3);
5921 textvalue := Piece(textvalue, '^', 2) + ' ' + dttm +
5922 #13 + Piece(textvalue, '^', 4) + ' ' + Piece(textvalue, '^', 5);
5923 Rct := FHintWin.CalcHintRect(Screen.Width, textvalue, nil);
5924 OffsetRect(Rct, FX, FY + 20);
5925 Rct.Right := Rct.Right + 3;
5926 Rct.TopLeft := ClientToScreen(Rct.TopLeft);
5927 Rct.BottomRight := ClientToScreen(Rct.BottomRight);
5928 FHintWin.ActivateHint(Rct, textvalue);
5929 FHintWinActive := true;
5930 end
5931 else if (ClickedValue = -1) and ((FOnValue <> BIG_NUMBER) and (FOnSeries <> BIG_NUMBER)) then
5932 begin // not on a value anymore (used to be on a value and series)
5933 FOnSeries := BIG_NUMBER;
5934 FOnValue := BIG_NUMBER;
5935 timHintPause.Enabled := false;
5936 InactivateHint;
5937 end;
5938 end;
5939end;
5940
5941procedure TfrmGraphs.InactivateHint;
5942begin
5943 FHintWin.ReleaseHandle;
5944 FHintWinActive := false;
5945end;
5946
5947procedure TfrmGraphs.mnuPopGraphStayOnTopClick(Sender: TObject);
5948begin
5949 mnuPopGraphStayOnTop.Checked := not mnuPopGraphStayOnTop.Checked;
5950 if mnuPopGraphStayOnTop.Checked then
5951 begin
5952 MarkFormAsStayOnTop(Self, true);
5953 FGraphSetting.StayOnTop := true;
5954 end
5955 else
5956 begin
5957 MarkFormAsStayOnTop(Self, false);
5958 FGraphSetting.StayOnTop := false;
5959 end;
5960end;
5961
5962procedure TfrmGraphs.StayOnTop;
5963begin
5964 with pnlMain.Parent do
5965 if BorderWidth <> 1 then
5966 begin
5967 mnuPopGraphStayOnTop.Enabled :=false;
5968 mnuPopGraphStayOnTop.Checked := false;
5969 end
5970 else
5971 begin // only use on float Graph
5972 mnuPopGraphStayOnTop.Enabled :=true;
5973 mnuPopGraphStayOnTop.Checked := not FGraphSetting.StayOnTop;
5974 mnuPopGraphStayOnTopClick(self);
5975 end;
5976end;
5977
5978procedure TfrmGraphs.HideDates(aChart: TChart);
5979var
5980 hidedates: boolean;
5981begin
5982 with aChart do // dateline charts always have dates
5983 begin
5984 if (aChart = chartDatelineTop) then
5985 hidedates := false
5986 else if (aChart = chartDatelineBottom) then
5987 hidedates := false
5988 else
5989 hidedates := not FGraphSetting.Dates;
5990 if hidedates then
5991 begin
5992 MarginBottom := 0;
5993 BottomAxis.LabelsFont.Color := chartDatelineTop.Color;
5994 BottomAxis.LabelsSize := 1;
5995 LeftAxis.LabelsFont.Color := chartDatelineTop.LeftAxis.LabelsFont.Color;
5996 end
5997 else
5998 begin
5999 MarginBottom := chartDatelineTop.MarginBottom;
6000 BottomAxis.LabelsFont.Color := chartDatelineTop.BottomAxis.LabelsFont.Color;
6001 BottomAxis.LabelsSize := chartDatelineTop.BottomAxis.LabelsSize;
6002 LeftAxis.LabelsFont.Color := chartDatelineTop.LeftAxis.LabelsFont.Color;
6003 end;
6004 end;
6005end;
6006
6007procedure TfrmGraphs.mnuPopGraphZoomBackClick(Sender: TObject);
6008begin
6009 FFirstClick := true;
6010 with lstZoomHistory do
6011 begin
6012 Items.Delete(Count - 1);
6013 if Count = 0 then mnuPopGraphResetClick(self)
6014 else ZoomUpdate;
6015 end;
6016end;
6017
6018procedure TfrmGraphs.ZoomUpdate;
6019var
6020 lastzoom: string;
6021 BigTime, SmallTime: TDateTime;
6022begin
6023 lastzoom := lstZoomHistory.Items[lstZoomHistory.Count - 1];
6024 SmallTime := StrToFloat(Piece(lastzoom, '^', 1));
6025 BigTime := StrToFloat(Piece(lastzoom, '^', 2));
6026 ZoomTo(SmallTime, BigTime);
6027 ZoomUpdateInfo(SmallTime, BigTime);
6028end;
6029
6030procedure TfrmGraphs.ZoomUpdateInfo(SmallTime, BigTime: TDateTime);
6031begin
6032 pnlInfo.Caption := TXT_ZOOMED;
6033 pnlInfo.Color := COLOR_ZOOM;
6034 pnlInfo.Caption := pnlInfo.Caption + FormatDateTime('mmm d, yyyy h:nn am/pm', SmallTime);
6035 pnlInfo.Caption := pnlInfo.Caption + ' to ' + FormatDateTime('mmm d, yyyy h:nn am/pm', BigTime) + '.';
6036 pnlInfo.Visible := true;
6037 pnlHeader.Visible := true;
6038end;
6039
6040procedure TfrmGraphs.ZoomTo(SmallTime, BigTime: TDateTime);
6041var
6042 i: integer;
6043 ChildControl: TControl;
6044begin
6045 for i := 0 to scrlTop.ControlCount - 1 do
6046 begin
6047 ChildControl := scrlTop.Controls[i];
6048 SizeDates((ChildControl as TChart), SmallTime, BigTime);
6049 end;
6050 SizeDates(chartDatelineTop, SmallTime, BigTime);
6051 for i := 0 to scrlBottom.ControlCount - 1 do
6052 begin
6053 ChildControl := scrlBottom.Controls[i];
6054 SizeDates((ChildControl as TChart), SmallTime, BigTime);
6055 end;
6056 SizeDates(chartDatelineBottom, SmallTime, BigTime);
6057end;
6058
6059procedure TfrmGraphs.mnuPopGraphPrintClick(Sender: TObject);
6060var
6061 topflag: boolean;
6062 i, count: integer;
6063 StrForFooter, StrForHeader, aTitle, aWarning, aDateRange: String;
6064 aHeader: TStringList;
6065 wrdApp, wrdDoc, wrdPrintDlg: Variant;
6066 ChildControl: TControl;
6067begin
6068 topflag := mnuPopGraphStayOnTop.Checked and mnuPopGraphStayOnTop.Enabled;
6069 try
6070 wrdApp := CreateOleObject('Word.Application');
6071 except
6072 raise Exception.Create('Cannot start MS Word!');
6073 end;
6074 Screen.Cursor := crDefault;
6075 aTitle := 'CPRS Graphing';
6076 aWarning := pnlInfo.Caption;
6077 aDateRange := 'Date Range: ' + cboDateRange.Text + ' Selected Items from ' +
6078 FormatDateTime('mm/dd/yy', FGraphSetting.LowTime) + ' to ' +
6079 FormatDateTime('mm/dd/yy', FGraphSetting.HighTime);
6080 aHeader := TStringList.Create;
6081 CreatePatientHeader(aHeader, aTitle, aWarning, aDateRange);
6082 StrForHeader := '';
6083 for i := 0 to aHeader.Count -1 do
6084 StrForHeader := StrForHeader + aHeader[i] + Chr(13);
6085 StrForFooter := aTitle + ' - *** WORK COPY ONLY ***' + Chr(13);
6086 wrdApp.Visible := False;
6087 wrdApp.Documents.Add;
6088 wrdDoc := wrdApp.Documents.Item(1);
6089 wrdDoc := wrdDoc.Sections.Item(1);
6090 wrdDoc := wrdDoc.Headers.Item(1).Range;
6091 wrdDoc.Font.Name := 'Courier New';
6092 wrdDoc.Font.Size := 9;
6093 wrdDoc.Text := StrForHeader;
6094 wrdDoc := wrdApp.Documents.Item(1);
6095 wrdDoc := wrdDoc.Sections.Item(1);
6096 wrdDoc := wrdDoc.Footers.Item(1);
6097 wrdDoc.Range.Font.Name := 'Courier New';
6098 wrdDoc.Range.Font.Size := 9;
6099 wrdDoc.Range.Text := StrForFooter;
6100 wrdDoc.PageNumbers.Add;
6101 wrdDoc := wrdApp.Documents.Item(1);
6102 wrdDoc.Range.InsertParagraphAfter;
6103 for i := 0 to scrlTop.ControlCount - 1 do // goes from top to bottom
6104 begin
6105 ChildControl := scrlTop.Controls[i];
6106 if (ChildControl as TChart).Visible then
6107 begin
6108 (ChildControl as TChart).CopyToClipboardBitmap;
6109 wrdDoc.Range.InsertParagraphAfter;
6110 wrdDoc.Paragraphs.Last.Range.Paste;
6111 end;
6112 end;
6113 if (chartDatelineTop.SeriesCount > 0) and (not chkItemsTop.Checked) then
6114 begin
6115 chartDatelineTop.CopyToClipboardBitmap;
6116 wrdDoc.Range.InsertParagraphAfter;
6117 wrdDoc.Paragraphs.Last.Range.Paste;
6118 end;
6119 wrdDoc.Range.InsertParagraphAfter;
6120 wrdDoc.Paragraphs.Last.Range.Text := ' ';
6121 for i := 0 to scrlBottom.ControlCount - 1 do
6122 begin
6123 ChildControl := scrlBottom.Controls[i];
6124 if (ChildControl as TChart).Visible then
6125 begin
6126 (ChildControl as TChart).CopyToClipboardBitmap;
6127 wrdDoc.Range.InsertParagraphAfter;
6128 wrdDoc.Paragraphs.Last.Range.Paste;
6129 end;
6130 end;
6131 if (chartDatelineBottom.SeriesCount > 0) and (chkDualViews.Checked)
6132 and (not chkItemsBottom.Checked) then
6133 begin
6134 chartDatelineBottom.CopyToClipboardBitmap;
6135 wrdDoc.Range.InsertParagraphAfter;
6136 wrdDoc.Paragraphs.Last.Range.Paste;
6137 end;
6138 wrdPrintDlg := wrdApp.Dialogs.item(wdDialogFilePrint);
6139 Screen.Cursor := crDefault;
6140 Application.ProcessMessages;
6141 if topflag then
6142 mnuPopGraphStayOnTopClick(self);
6143 wrdPrintDlg.Show;
6144 wrdApp.Visible := false;
6145 Screen.Cursor := crHourGlass;
6146 Application.ProcessMessages;
6147 Sleep(5000);
6148 count := 0;
6149 while (wrdApp.Application.BackgroundPrintingStatus > 0) do
6150 begin
6151 Sleep(1000);
6152 Application.ProcessMessages;
6153 count := count + 1;
6154 if count > 3 then break;
6155 end;
6156 wrdApp.DisplayAlerts := false;
6157 wrdDoc.Close(false);
6158 wrdApp.Quit;
6159 wrdApp := Unassigned; // releases variant
6160 aHeader.Free;
6161 Application.ProcessMessages;
6162 if topflag then
6163 mnuPopGraphStayOnTopClick(self);
6164 Screen.Cursor := crDefault;
6165end;
6166
6167procedure TfrmGraphs.lvwItemsTopChange(Sender: TObject; Item: TListItem;
6168 Change: TItemChange);
6169begin
6170 if FArrowKeys and (lvwItemsTop.SelCount > 0) then
6171 begin
6172 if pnlItemsTopInfo.Tag <> 1 then
6173 lvwItemsTopClick(self);
6174 FArrowKeys := false;
6175 end;
6176end;
6177
6178procedure TfrmGraphs.lvwItemsBottomChange(Sender: TObject; Item: TListItem;
6179 Change: TItemChange);
6180begin
6181 if FArrowKeys and (lvwItemsBottom.SelCount > 0) then
6182 begin
6183 if pnlItemsBottomInfo.Tag <> 1 then
6184 lvwItemsBottomClick(self);
6185 FArrowKeys := false;
6186 end;
6187end;
6188
6189procedure TfrmGraphs.lvwItemsTopKeyDown(Sender: TObject; var Key: Word;
6190 Shift: TShiftState);
6191begin
6192 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then
6193 FArrowKeys := true;
6194end;
6195
6196procedure TfrmGraphs.testcount1Click(Sender: TObject);
6197
6198 function boxcount(aListBox: TListBox): string;
6199 var
6200 i, ccnt: integer;
6201 begin
6202 Result := '';
6203 ccnt := 0;
6204 for i := 0 to aListBox.Items.Count - 1 do
6205 ccnt := ccnt + length(aListBox.Items[i]);
6206 Result := inttostr(aListBox.Items.Count) + ';' + inttostr(ccnt);
6207 end;
6208
6209var
6210 i, lines, total: integer;
6211 aString: string;
6212begin
6213 lines := 0;
6214 total := 0;
6215 with pnlData do
6216 for i:= 0 to pnlData.ControlCount - 1 do
6217 if Controls[i] is TListBox then
6218 begin
6219 aString := boxcount(Controls[i] as TListBox);
6220 lines := lines + strtointdef(Piece(aString, ';', 1), 0);
6221 total := total + strtointdef(Piece(aString, ';', 2), 0);
6222 end;
6223 aString := boxcount(lstTypes) + '^' + boxcount(lstItems) + '^' + boxcount(lstData)
6224 + ' lines: ' + inttostr(lines) + ' total: ' + inttostr(total);
6225 showmessage(aString);
6226end;
6227
6228procedure TfrmGraphs.cboDateRangeDropDown(Sender: TObject);
6229begin
6230 if (Top + Height) > (Screen.Height - 100) then
6231 cboDateRange.DropDownCount := 3
6232 else
6233 cboDateRange.DropDownCount := 9;
6234end;
6235
6236procedure TfrmGraphs.mnuPopGraphFixedClick(Sender: TObject);
6237begin
6238 with FGraphSetting do FixedDateRange := not FixedDateRange;
6239 ChangeStyle;
6240end;
6241
6242//***************** these are used to fix dropdown when large fonts
6243
6244procedure TfrmGraphs.cboViewsTopDropDown(Sender: TObject);
6245begin
6246 cboViewsTop.Align := alNone;
6247end;
6248
6249procedure TfrmGraphs.cboViewsTopDropDownClose(Sender: TObject);
6250begin
6251 cboViewsTop.Align := alClient;
6252end;
6253
6254procedure TfrmGraphs.cboViewsBottomDropDown(Sender: TObject);
6255begin
6256 cboViewsBottom.Align := alNone;
6257end;
6258
6259procedure TfrmGraphs.cboViewsBottomDropDownClose(Sender: TObject);
6260begin
6261 cboViewsBottom.Align := alClient;
6262end;
6263
6264//*********************
6265
6266procedure TfrmGraphs.FormDestroy(Sender: TObject);
6267begin
6268 SetSize;
6269end;
6270
6271procedure TfrmGraphs.SetFontSize(FontSize: integer);
6272begin // for now, ignore changing chart font size
6273 with chartDatelineTop do
6274 begin
6275 LeftAxis.LabelsFont.Size := 8;
6276 BottomAxis.LabelsFont.Size := 8;
6277 Foot.Font.Size := 8;
6278 Legend.Font.Size := 8;
6279 Title.Font.Size := 8;
6280 end;
6281 with chartDatelineBottom do
6282 begin
6283 LeftAxis.LabelsFont.Size := 8;
6284 BottomAxis.LabelsFont.Size := 8;
6285 Foot.Font.Size := 8;
6286 Legend.Font.Size := 8;
6287 Title.Font.Size := 8;
6288 end;
6289end;
6290
6291procedure TfrmGraphs.lvwItemsTopEnter(Sender: TObject);
6292begin
6293 if lvwItemsTop.SelCount = 0 then
6294 if lvwItemsTop.Items.Count > 0 then
6295 lvwItemsTop.Items[0].Focused := true;
6296end;
6297
6298procedure TfrmGraphs.chkItemsBottomEnter(Sender: TObject);
6299begin
6300 if not chkDualViews.Checked then
6301 if pnlFooter.Visible then
6302 cboDateRange.SetFocus
6303 else
6304 SelectNext(ActiveControl as TWinControl, True, True);
6305end;
6306
6307procedure TfrmGraphs.cboViewsBottomEnter(Sender: TObject);
6308begin
6309 if not chkDualViews.Checked then
6310 SelectNext(ActiveControl as TWinControl, True, True);
6311end;
6312
6313procedure TfrmGraphs.lvwItemsBottomEnter(Sender: TObject);
6314begin
6315 if lvwItemsBottom.SelCount = 0 then
6316 if lvwItemsBottom.Items.Count > 0 then
6317 lvwItemsBottom.Items[0].Focused := true;
6318 if not chkDualViews.Checked then
6319 SelectNext(ActiveControl as TWinControl, True, True);
6320end;
6321
6322initialization
6323 CoInitialize (nil);
6324end.
Note: See TracBrowser for help on using the repository browser.