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

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

Upgrading to version 27

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