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

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

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