source: cprs/branches/foia-cprs/CPRS-Chart/fVitals.pas@ 459

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

Adding foia-cprs branch
File size: 23.8 KB
Line 
1{Modifications
2Date: 4/1/98 RAB/ISL
3Description: Added procedure SelectVital(FontSize:integer; idx: integer)
4 To be able to pass the row index into the form. This will enable the vital
5 entry form to open the apropriate line on this form (If this screen is opened
6 by the vital entry screen)
7
8Date: 4/9/98 RAB/ISL
9Descriotion: Added button and click event to call vital entry screen.
10
11Date: 4/9/98 RAB/ISL
12Descriotion: if Idx passed into procedure SelectVital is '99' then the botton to
13 call the vital entry screen will be disabled.
14
15Date: 4/23/98
16By: Robert Bott
17Description: Set position of form to poScreenCenter.
18Date: 4/23/98
19By: Robert Bott
20Description: Forced an update after returning from vital entry form.
21
22//Modifed: 6/23/98
23//By: Robert Bott
24//Location: ISL
25//Description of Mod:
26// Moved code that verifies valid provider and visit from fvit into fVitals.
27// now found in procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
28// formerly in procedure TfrmVit.FormActivate(Sender: TObject);
29
30}
31
32unit fVitals;
33
34interface
35
36uses
37 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
38 StdCtrls, ORCtrls, TeEngine, Series, TeeProcs, Chart, ExtCtrls, Grids,
39 Buttons, ORNet, ORFn, uConst, Menus, ORDtTmRng; {*KCM*}
40
41type
42 TfrmVitals = class(TForm)
43 pnlTop: TPanel;
44 chtChart: TChart;
45 serTest: TLineSeries;
46 pnlLeft: TORAutoPanel;
47 lstDates: TORListBox;
48 pnlBottom: TPanel;
49 grdVitals: TCaptionStringGrid;
50 pnlButtons: TPanel;
51 lstVitals: TCaptionListBox;
52 serTestX: TLineSeries;
53 serTime: TPointSeries;
54 lblNoResults: TStaticText;
55 serTestY: TLineSeries;
56 pnlLeftClient: TORAutoPanel;
57 chkValues: TCheckBox;
58 chk3D: TCheckBox;
59 chkZoom: TCheckBox;
60 pnlEnterVitals: TPanel;
61 btnEnterVitals: TButton;
62 popChart: TPopupMenu;
63 popValues: TMenuItem;
64 pop3D: TMenuItem;
65 popZoom: TMenuItem;
66 popZoomBack: TMenuItem;
67 N1: TMenuItem;
68 popCopy: TMenuItem;
69 N2: TMenuItem;
70 popDetails: TMenuItem;
71 calVitalsRange: TORDateRangeDlg;
72 N3: TMenuItem;
73 popPrint: TMenuItem;
74 dlgWinPrint: TPrintDialog;
75 procedure lstDatesClick(Sender: TObject);
76 procedure FormCreate(Sender: TObject);
77 procedure FormDestroy(Sender: TObject);
78 procedure lstVitalsClick(Sender: TObject);
79 procedure grdVitalsSelectCell(Sender: TObject; Col, Row: Integer;
80 var CanSelect: Boolean);
81 procedure chkZoomClick(Sender: TObject);
82 procedure chk3DClick(Sender: TObject);
83 procedure chkValuesClick(Sender: TObject);
84 procedure FormShow(Sender: TObject);
85 procedure pnlEnterVitalsResize(Sender: TObject);
86 procedure btnEnterVitalsClick(Sender: TObject);
87 procedure chtChartUndoZoom(Sender: TObject);
88 procedure popValuesClick(Sender: TObject);
89 procedure pop3DClick(Sender: TObject);
90 procedure popZoomClick(Sender: TObject);
91 procedure popZoomBackClick(Sender: TObject);
92 procedure popCopyClick(Sender: TObject);
93 procedure popDetailsClick(Sender: TObject);
94 procedure chtChartClickSeries(Sender: TCustomChart;
95 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
96 Shift: TShiftState; X, Y: Integer);
97 procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
98 Shift: TShiftState; X, Y: Integer);
99 procedure chtChartClickLegend(Sender: TCustomChart;
100 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
101 procedure popChartPopup(Sender: TObject);
102 procedure popPrintClick(Sender: TObject);
103 procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
104 procedure FormKeyUp(Sender: TObject; var Key: Word;
105 Shift: TShiftState);
106 private
107 { Private declarations }
108 procedure VGrid(griddata: TStrings);
109 procedure WorksheetChart(test: string; aitems: TStrings);
110 procedure GetStartStop(var start, stop: string; aitems: TStrings);
111 public
112 { Public declarations }
113 function FMToDateTime(FMDateTime: string): TDateTime;
114 end;
115
116var
117 frmVitals: TfrmVitals;
118 tmpGrid: TStringList;
119 uDate1, uDate2: Tdatetime;
120
121procedure SelectVital(FontSize:integer; idx: integer);
122procedure SelectVitals(FontSize: Integer);
123function VitalsGrid(const patient: string; date1, date2: TFMDateTime; restrictdates: integer; tests: TStrings): TStrings; //*DFN*
124function VitalsMemo(const patient: string; date1, date2: TFMDateTime; tests: TStrings): TStrings; //*DFN*
125
126implementation
127
128uses fCover, uCore, rCore, fVit, fFrame, fEncnt, fVisit, fRptBox, rReports,
129 uAccessibleStringGrid;
130
131const
132 ZOOM_PERCENT = 99; // padding for inflating margins
133
134{$R *.DFM}
135
136
137procedure SelectVital(FontSize:integer; idx: integer);
138var
139 frmVitals: TfrmVitals;
140begin
141 frmVitals := TfrmVitals.Create(Application);
142 try
143 ResizeAnchoredFormToFont(frmVitals);
144 with frmVitals do
145 begin
146 if idx <= lstvitals.items.count then lstVitals.ItemIndex := idx
147 else lstVitals.ItemIndex := 0;
148
149 if idx = 99 then
150 btnEnterVitals.enabled := False;
151 ShowModal;
152 end;
153
154 finally
155 frmVitals.Release;
156 end;
157end;
158
159
160procedure SelectVitals(FontSize: Integer);
161var
162 frmVitals: TfrmVitals;
163 firstchar: string;
164 i: integer;
165begin
166 frmVitals := TfrmVitals.Create(Application);
167 try
168 ResizeAnchoredFormToFont(frmVitals);
169 with frmVitals do
170 begin
171 with frmCover do
172 for i := ComponentCount - 1 downto 0 do
173 begin
174 if Components[i] is TORListBox then
175 begin
176 case Components[i].Tag of
177 70:
178 if (Components[i] as TORListBox).ItemIndex > -1 then
179 begin
180 // changed to look at 2 chars so pain & pulse not confused {*KCM*}
181 firstchar := UpperCase(Copy(Piece((Components[i] as TORListBox).Items[(Components[i] as TORListBox).ItemIndex], '^', 2), 1, 2));
182 if firstchar = 'T' then
183 lstVitals.ItemIndex := 0
184 else if firstchar = 'P' then
185 lstVitals.ItemIndex := 1
186 else if firstchar = 'R' then
187 lstVitals.ItemIndex := 2
188 else if firstchar = 'BP' then
189 lstVitals.ItemIndex := 3
190 else if firstchar = 'HT' then
191 lstVitals.ItemIndex := 4
192 else if firstchar = 'WT' then
193 lstVitals.ItemIndex := 5
194 else if firstchar = 'PN' then
195 lstVitals.ItemIndex := 6;
196 end
197 else
198 begin
199 firstchar := '';
200 lstVitals.ItemIndex := 0;
201 end;
202 end;
203 end;
204 end;
205 ShowModal;
206 end;
207 finally
208 frmVitals.Release;
209 end;
210end;
211
212procedure TfrmVitals.VGrid(griddata: TStrings);
213var
214 testcnt, datecnt, datacnt, linecnt, x, y, i: integer;
215begin
216 testcnt := strtoint(Piece(griddata[0], '^', 1));
217 datecnt := strtoint(Piece(griddata[0], '^', 2));
218 datacnt := strtoint(Piece(griddata[0], '^', 3));
219 linecnt := testcnt + datecnt + datacnt;
220 with grdVitals do
221 begin
222 if datecnt = 0 then ColCount := 1 else ColCount := datecnt;
223 if testcnt = 0 then RowCount := 2 else RowCount := testcnt + 1;
224 DefaultColWidth := 80;
225 FixedCols := 0;
226 FixedRows := 1;
227 for y := 0 to RowCount - 1 do
228 for x := 0 to ColCount - 1 do
229 Cells[x, y] := '';
230 if datecnt = 0 then
231 begin
232 Cells[1, 0] := 'no results';
233 for x := 1 to RowCount - 1 do
234 Cells[x, 1] := '';
235 end;
236 for i := testcnt + 1 to testcnt + datecnt do
237 begin
238 Cells[i - testcnt - 1, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i], '^', 2)));
239 end;
240 for i := testcnt + datecnt + 1 to linecnt do
241 begin
242 x := strtoint(Piece(griddata[i], '^', 1));
243 y := strtoint(Piece(griddata[i], '^', 2));
244 Cells[x - 1, y] := Piece(griddata[i], '^', 3);
245 end;
246 end;
247end;
248
249function VitalsGrid(const patient: string; date1, date2: TFMDateTime; restrictdates: integer; tests: TStrings): TStrings; //*DFN*
250begin
251 CallV('ORQQVI1 GRID', [patient, date1, date2, restrictdates, tests]);
252 Result := RPCBrokerV.Results;
253end;
254
255function VitalsMemo(const patient: string; date1, date2: TFMDateTime; tests: TStrings): TStrings; //*DFN*
256begin
257 CallV('ORQQVI1 DETAIL', [patient, date1, date2, 0, tests]);
258 Result := RPCBrokerV.Results;
259end;
260
261procedure TfrmVitals.lstDatesClick(Sender: TObject);
262var
263 daysback, vindex: integer;
264 date1, date2: TFMDateTime;
265 today: TDateTime;
266begin
267 if (lstDates.ItemID = 'S') then
268 begin
269 with calVitalsRange do
270 begin
271 if Execute then
272 begin
273 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
274 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
275 end
276 else
277 lstDates.ItemIndex := -1;
278 end;
279 end;
280 today := FMToDateTime(floattostr(FMToday));
281 if lstDates.ItemIEN > 0 then
282 begin
283 daysback := lstDates.ItemIEN;
284 date1 := FMToday + 0.2359;
285 If daysback = 1 then
286 date2 := DateTimeToFMDateTime(today)
287 Else
288 date2 := DateTimeToFMDateTime(today - daysback);
289 end
290 else
291 BeginEndDates(date1,date2,daysback);
292 //date1 := date1 + 0.2359;
293 tmpGrid.Assign(VitalsGrid(Patient.DFN, date1, date2, 0, lstVitals.Items));
294 vindex := lstVitals.ItemIndex;
295 VGrid(tmpGrid);
296 lstVitals.ItemIndex := vindex;
297 lstVitalsClick(self);
298 chtChart.BottomAxis.Automatic := true; //***********
299 chkZoom.Checked := false;
300 chtChart.UndoZoom;
301 if lstVitals.ItemIndex > -1 then
302 begin
303 WorksheetChart(inttostr(lstVitals.ItemIndex + 1), tmpGrid);
304 if (serTest.Count > 1) and not chkZoom.Checked then
305 begin
306 chtChart.UndoZoom;
307 chtChart.ZoomPercent(ZOOM_PERCENT);
308 end;
309 end;
310end;
311
312procedure TfrmVitals.FormCreate(Sender: TObject);
313begin
314 grdVitals.Color := ReadOnlyColor;
315 tmpGrid := TStringList.Create;
316 if Patient.Inpatient then lstDates.ItemIndex := 1 else lstDates.ItemIndex := 4;
317 SerTest.GetHorizAxis.ExactDateTime := true;
318 SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
319 TAccessibleStringGrid.WrapControl(grdVitals);
320end;
321
322procedure TfrmVitals.FormDestroy(Sender: TObject);
323begin
324 tmpGrid.free;
325 TAccessibleStringGrid.UnwrapControl(grdVitals);
326end;
327
328function TfrmVitals.FMToDateTime(FMDateTime: string): TDateTime;
329var
330 x, Year: string;
331begin
332 { Note: TDateTime cannot store month only or year only dates }
333 x := FMDateTime + '0000000';
334 if Length(x) > 12 then x := Copy(x, 1, 12);
335 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
336 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
337 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
338 Result := StrToDateTime(x);
339end;
340
341procedure TfrmVitals.lstVitalsClick(Sender: TObject);
342begin
343 with grdVitals do
344 begin
345 Row := lstVitals.ItemIndex + 1;
346 Col := grdVitals.ColCount - 1;
347 end;
348end;
349
350procedure TfrmVitals.WorksheetChart(test: string; aitems: TStrings);
351
352function OkFloatValue(value: string): boolean;
353var
354 i, j: integer;
355 first, second: string;
356begin
357 Result := false;
358 i := strtointdef(value, -99999);
359 if i <> -99999 then Result := true
360 else if pos(Pieces(value, '.', 2, 3), '.') > 0 then Result := false
361 else
362 begin
363 first := Piece(value, '.', 1);
364 second := Piece(value, '.', 2);
365 if length(second) > 0 then
366 begin
367 i := strtointdef(first, -99999);
368 j := strtointdef(second, -99999);
369 if (i <> -99999) and (j <> -99999) then Result := true;
370 end
371 else
372 begin
373 i :=strtointdef(first, -99999);
374 if i <> -99999 then Result := true;
375 end;
376 end;
377end;
378
379var
380 datevalue, oldstart, oldend: TDateTime;
381 labvalue, labvalue1, labvalue2, labvalue3: double;
382 i, numtest, numcol, numvalues, valuecount: integer;
383 high, start, stop, value, value1, value2, value3, testcheck, units, testname, testnum, testorder: string;
384begin
385
386
387 valuecount := 0;
388 testnum := Piece(test, '^', 1);
389 testname := lstVitals.Items[strtoint(testnum) - 1];
390 numtest := strtoint(Piece(aitems[0], '^', 1));
391 numcol := strtoint(Piece(aitems[0], '^', 2));
392 numvalues := strtoint(Piece(aitems[0], '^', 3));
393 if numvalues = 0 then
394 chtChart.Visible := false
395 else
396 begin
397 chtChart.Visible := true;
398 serTest.Clear; serTestX.Clear; serTime.Clear;
399 if numtest > 0 then
400 begin
401 for i := 1 to numtest do
402 if testnum = Piece(aitems[i], '^', 1) then
403 begin
404 testorder := inttostr(i);
405 break;
406 end;
407 GetStartStop(start, stop, aitems);
408 chtChart.Legend.Color := grdVitals.Color;
409 chtChart.Title.Font.Size := MainFontSize;
410 chtChart.LeftAxis.Title.Caption := units;
411 serTest.Title := Piece(test, '^', 2);
412 testcheck := testorder;
413 high := '0';
414 if testname = 'Blood Pressure' then
415 begin
416 serTestY.Active := false;
417 for i := numtest + numcol + 1 to numtest + numcol + numvalues do
418 if Piece(aitems[i], '^', 2) = testcheck then
419 begin
420 serTestX.Active := true;
421 serTestX.Marks.Visible := chkValues.Checked;
422 serTestY.Marks.Visible := chkValues.Checked;
423 value := Piece(aitems[i], '^', 3);
424 value1 := Piece(value, '/', 1);
425 value2 := Piece(value, '/', 2);
426 value3 := Piece(value, '/', 3);
427 if OkFloatValue(value1) and OKFloatValue(value2) then
428 begin
429 high := value1;
430 labvalue1 := strtofloat(value1);
431 labvalue2 := strtofloat(value2);
432 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
433 serTest.AddXY(datevalue, labvalue1, '', clTeeColor);
434 serTestX.AddXY(datevalue, labvalue2, '', clTeeColor);
435 inc(valuecount);
436 if OKFloatValue(value3) then
437 begin
438 labvalue3 := strtofloat(value3);
439 serTestY.AddXY(datevalue, labvalue3, '', clTeeColor);
440 serTestY.Active := true;
441 end;
442 end;
443 end;
444 serTest.Title := 'Systolic';
445 serTestX.Title := 'Diastolic';
446 end // blood pressure
447 else
448 begin
449 for i := numtest + numcol + 1 to numtest + numcol + numvalues do
450 if Piece(aitems[i], '^', 2) = testcheck then
451 begin
452 serTestX.Active := false;
453 serTestY.Active := false;
454 value := Piece(aitems[i], '^', 3);
455 if OkFloatValue(value) then
456 begin
457 high := value;
458 labvalue := strtofloat(value);
459 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
460 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
461 inc(valuecount);
462 end;
463 end;
464 serTest.Title := lstVitals.Items[lstVitals.ItemIndex];
465 end; // not blood pressure
466 serTime.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
467 serTime.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
468 end; // numtest > 0
469 if chkZoom.Checked and chtChart.Visible then
470 begin
471 oldstart := chtChart.BottomAxis.Minimum;
472 oldend := chtChart.BottomAxis.Maximum;
473 chtChart.UndoZoom;
474 chtChart.BottomAxis.Automatic := false;
475 chtChart.BottomAxis.Minimum := oldstart;
476 chtChart.BottomAxis.Maximum := oldend;
477 end
478 else
479 begin
480 chtChart.BottomAxis.Automatic := true;
481 end;
482 if valuecount = 0 then chtChart.Visible := false;
483 end; // numvalues not 0
484end;
485
486procedure TfrmVitals.GetStartStop(var start, stop: string; aitems: TStrings);
487var
488 numtest, numcol: integer;
489begin
490 numtest := strtoint(Piece(aitems[0], '^', 1));
491 numcol := strtoint(Piece(aitems[0], '^', 2));
492 start := Piece(aitems[numtest + 1], '^', 2);
493 stop := Piece(aitems[numtest + numcol], '^', 2);
494end;
495
496procedure TfrmVitals.grdVitalsSelectCell(Sender: TObject; Col,
497 Row: Integer; var CanSelect: Boolean);
498begin
499 lstVitals.ItemIndex := Row - 1;
500 if lstVitals.ItemIndex > -1 then
501 begin
502 WorksheetChart(inttostr(lstVitals.ItemIndex + 1), tmpGrid);
503 if (serTest.Count > 1) and not chkZoom.Checked then
504 begin
505 chtChart.UndoZoom;
506 chtChart.ZoomPercent(ZOOM_PERCENT);
507 end;
508 end;
509end;
510
511procedure TfrmVitals.chkZoomClick(Sender: TObject);
512begin
513 chtChart.AllowZoom := chkZoom.Checked;
514 chtChart.AnimatedZoom := chkZoom.Checked;
515 if not chkZoom.Checked then
516 begin
517 chtChart.UndoZoom;
518 if serTest.Count > 1 then chtChart.ZoomPercent(ZOOM_PERCENT);
519 end;
520end;
521
522procedure TfrmVitals.chk3DClick(Sender: TObject);
523begin
524 chtChart.View3D := chk3D.Checked;
525end;
526
527procedure TfrmVitals.chkValuesClick(Sender: TObject);
528begin
529 serTest.Marks.Visible := chkValues.Checked;
530 if serTestX.Active then serTestX.Marks.Visible := chkValues.Checked;
531 if serTestY.Active then serTestY.Marks.Visible := chkValues.Checked;
532end;
533
534procedure TfrmVitals.FormShow(Sender: TObject);
535begin
536 lstDatesClick(self);
537end;
538
539
540
541
542procedure TfrmVitals.pnlEnterVitalsResize(Sender: TObject);
543begin
544 btnEnterVitals.top := pnlEnterVitals.top;
545 btnEnterVitals.left := pnlEnterVitals.left;
546 btnEnterVitals.height := pnlEnterVitals.height;
547 btnEnterVitals.width := pnlEnterVitals.width;
548end;
549
550procedure TfrmVitals.btnEnterVitalsClick(Sender: TObject);
551begin
552 If Encounter.location > 0.0 then //if it has been assigned.
553 uVitalLocation := Encounter.Location
554 else
555 begin
556 //assign location
557 if Encounter.NeedVisit then
558 begin
559 UpdateVisit(Font.Size);
560 frmFrame.DisplayEncounterText;
561 end;
562 if Encounter.NeedVisit and (not frmFrame.CCOWDrivedChange) then
563 begin
564 InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
565 exit; {RAB 6/23/98}
566 end
567 else
568 uVitalLocation := Encounter.Location;
569 end;
570
571 if (not encounter.needvisit) then
572 try
573 Application.CreateForm(TfrmVit, frmVit);
574 frmvit.showmodal;
575 //refresh vital info
576 lstDatesClick(self);
577 finally
578 frmvit.release;
579 end;
580end;
581
582procedure TfrmVitals.chtChartUndoZoom(Sender: TObject);
583begin
584 chtChart.BottomAxis.Automatic := true;
585end;
586
587procedure TfrmVitals.popValuesClick(Sender: TObject);
588begin
589 chkValues.Checked := not chkValues.Checked;
590 chkValuesClick(self);
591end;
592
593procedure TfrmVitals.pop3DClick(Sender: TObject);
594begin
595 chk3D.Checked := not chk3D.Checked;
596 chk3DClick(self);
597end;
598
599procedure TfrmVitals.popZoomClick(Sender: TObject);
600begin
601 chkZoom.Checked := not chkZoom.Checked;
602 chkZoomClick(self);
603end;
604
605procedure TfrmVitals.popZoomBackClick(Sender: TObject);
606begin
607 chtChart.UndoZoom;
608end;
609
610procedure TfrmVitals.popCopyClick(Sender: TObject);
611begin
612 chtChart.CopyToClipboardBitmap;
613end;
614
615procedure TfrmVitals.popDetailsClick(Sender: TObject);
616var
617 tmpList: TStringList;
618 date1, date2: TFMDateTime;
619 strdate1, strdate2: string;
620begin
621 inherited;
622 Screen.Cursor := crHourGlass;
623 if chtChart.Tag > 0 then
624 begin
625 strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
626 strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
627 uDate1 := StrToDateTime(strdate1);
628 uDate2 := StrToDateTime(strdate2);
629 date1 := DateTimeToFMDateTime(uDate1 + 1);
630 date2 := DateTimeToFMDateTime(uDate2);
631 StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
632 ReportBox(VitalsMemo(Patient.DFN, date1, date2, lstVitals.Items), 'Vitals on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
633 end
634 else
635 begin
636 date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
637 date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
638 tmpList := TStringList.Create;
639 try
640 tmpList.Add(lstVitals.Items[lstVitals.ItemIndex]);
641 if serTest.Title = 'Systolic' then
642 StatusText('Retrieving data for Blood Pressure...')
643 else
644 StatusText('Retrieving data for ' + serTest.Title + '...');
645 ReportBox(VitalsMemo(Patient.DFN, date1, date2, tmpList), serTest.Title + ' results on ' + Patient.Name, True);
646 finally
647 tmpList.Free;
648 end;
649 end;
650 Screen.Cursor := crDefault;
651 StatusText('');
652end;
653
654procedure TfrmVitals.chtChartClickSeries(Sender: TCustomChart;
655 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
656 Shift: TShiftState; X, Y: Integer);
657begin
658 uDate1 := Series.XValue[ValueIndex];
659 uDate2 := uDate1;
660 chtChart.Hint := 'Details - Vitals for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
661 chtChart.Tag := ValueIndex + 1;
662 if Button <> mbRight then popDetailsClick(self);
663end;
664
665procedure TfrmVitals.chtChartMouseDown(Sender: TObject;
666 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
667begin
668 chtChart.Hint := '';
669 chtChart.Tag := 0;
670end;
671
672procedure TfrmVitals.chtChartClickLegend(Sender: TCustomChart;
673 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
674begin
675 if serTest.Title = 'Systolic' then
676 chtChart.Hint := 'Details - for Blood Pressure...'
677 else
678 chtChart.Hint := 'Details - for ' + serTest.Title + '...';
679 chtChart.Tag := 0;
680 if Button <> mbRight then popDetailsClick(self);
681end;
682
683procedure TfrmVitals.popChartPopup(Sender: TObject);
684begin
685 popValues.Checked := chkValues.Checked;
686 pop3D.Checked := chk3D.Checked;
687 popZoom.Checked := chkZoom.Checked;
688 popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
689 if chtChart.Hint <> '' then
690 begin
691 popDetails.Caption := chtChart.Hint;
692 popDetails.Enabled := true;
693 end
694 else
695 begin
696 popDetails.Caption := 'Details...';
697 popDetails.Enabled := false;
698 end;
699end;
700
701procedure TfrmVitals.popPrintClick(Sender: TObject);
702var
703 GraphTitle: string;
704begin
705 GraphTitle := lstVitals.Items[lstVitals.ItemIndex] +
706 ' - ' +
707 lstDates.DisplayText[lstDates.ItemIndex];
708 if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
709end;
710
711procedure TfrmVitals.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
712var
713 datetemp: TFMDateTime;
714 today, datetime1, datetime2: TDateTime;
715 relativedate: string;
716begin
717 today := FMToDateTime(floattostr(FMToday));
718 relativedate := Piece(lstDates.ItemID, ';', 1);
719 relativedate := Piece(relativedate, '-', 2);
720 ADaysBack := strtointdef(relativedate, 0);
721 ADate1 := DateTimeToFMDateTime(today - ADaysBack);
722 relativedate := Piece(lstDates.ItemID, ';', 2);
723 if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
724 begin
725 relativedate := Piece(relativedate, '+', 2);
726 ADaysBack := strtointdef(relativedate, 0);
727 ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
728 end
729 else
730 begin
731 relativedate := Piece(relativedate, '-', 2);
732 ADaysBack := strtointdef(relativedate, 0);
733 ADate2 := DateTimeToFMDateTime(today - ADaysBack);
734 end;
735 datetime1 := FMDateTimeToDateTime(ADate1);
736 datetime2 := FMDateTimeToDateTime(ADate2);
737 if datetime1 < datetime2 then // reorder dates, if needed
738 begin
739 datetemp := ADate1;
740 ADate1 := ADate2;
741 ADate2 := datetemp
742 end;
743 ADate1 := ADate1 + 0.2359;
744end;
745
746procedure TfrmVitals.FormKeyUp(Sender: TObject; var Key: Word;
747 Shift: TShiftState);
748begin
749 if Key = VK_ESCAPE then
750 begin
751 Key := 0;
752 Close;
753 end;
754end;
755
756end.
Note: See TracBrowser for help on using the repository browser.