Context Navigation

fGraphs.pas@ 1780

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

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

Context Navigation

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

Download in other formats: