source: cprs/trunk/CPRS-Chart/fVitals.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28
File size: 25.1 KB
RevLine 
[456]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,
[830]38 StdCtrls, ORCtrls, TeEngine, Series, TeeProcs, Chart, ExtCtrls, Grids,Buttons,
39 ORNet, ORFn, uConst, Menus, ORDtTmRng, fBase508Form, ComCtrls, uVitals, VAUtils,
40 VA508AccessibilityManager;
[456]41
42type
[830]43 TfrmVitals = class(TfrmBase508Form)
[456]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
[830]130uses fCover, uCore, rCore, fVit, fFrame, fEncnt, fVisit, fRptBox, rReports, uInit;
[456]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;
[1679]172 GMV_FName: String;
173
[456]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';
[1679]182 LoadVitalsDLL;
[456]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
[1679]199 MessageDLG('Can''t find library '+VitalsDLLName+'.',mtError,[mbok],0);
[456]200 @VLPtVitals := nil;
[1679]201 UnloadVitalsDLL;
[456]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;
[830]338 FastAssign(VitalsGrid(Patient.DFN, date1, date2, 0, lstVitals.Items), tmpGrid);
[456]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.