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

Last change on this file since 1689 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28

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