Context Navigation

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

Last change on this file since 924 was 830, checked in by Kevin Toppenberg, 14 years ago
Upgrading to version 27
File size: 232.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: