source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fVitals.pas@ 1685

Last change on this file since 1685 was 830, checked in by Kevin Toppenberg, 14 years ago

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