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

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

Upgrading to version 27
File size: 25.5 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;
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;
[830]184 if VitalsDLLHandle = 0 then
185 VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
[456]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;
[830]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
[456]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;
[830]347 FastAssign(VitalsGrid(Patient.DFN, date1, date2, 0, lstVitals.Items), tmpGrid);
[456]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.