source: cprs/branches/tmg-cprs/CPRS-Chart/fGraphs.pas@ 1099

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

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