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

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

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