source: cprs/branches/foia-cprs/CPRS-Chart/fLabs.pas@ 459

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

Adding foia-cprs branch
File size: 74.8 KB
Line 
1unit fLabs;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Grids, Buttons, fLabTest,
8 fLabTests, fLabTestGroups, ORFn, TeeProcs, TeEngine, Chart, Series, Menus,
9 uConst, ORDtTmRng, OleCtrls, SHDocVw, Variants;
10
11type
12 TfrmLabs = class(TfrmHSplit)
13 lblHeading: TOROffsetLabel;
14 lstReports: TORListBox;
15 lstHeaders: TORListBox;
16 lstDates: TORListBox;
17 pnlHeader: TORAutoPanel;
18 pnlFooter: TORAutoPanel;
19 grdLab: TCaptionStringGrid;
20 pnlChart: TPanel;
21 memLab: TRichEdit;
22 lblSpecimen: TLabel;
23 lblSingleTest: TLabel;
24 lstTests: TORListBox;
25 lblFooter: TOROffsetLabel;
26 lblReports: TOROffsetLabel;
27 lblDates: TOROffsetLabel;
28 lblHeaders: TOROffsetLabel;
29 bvlHeader: TBevel;
30 pnlButtons: TORAutoPanel;
31 cmdNext: TButton;
32 cmdPrev: TButton;
33 cmdRecent: TButton;
34 cmdOld: TButton;
35 lblDateFloat: TLabel;
36 lblOld: TOROffsetLabel;
37 lblPrev: TOROffsetLabel;
38 lblNext: TOROffsetLabel;
39 lblRecent: TOROffsetLabel;
40 pnlOtherTests: TORAutoPanel;
41 cmdOtherTests: TButton;
42 chtChart: TChart;
43 serHigh: TLineSeries;
44 serLow: TLineSeries;
45 serTest: TLineSeries;
46 bvlOtherTests: TBevel;
47 lblMostRecent: TLabel;
48 lblDate: TLabel;
49 lblCollection: TLabel;
50 pnlWorksheet: TORAutoPanel;
51 chkValues: TCheckBox;
52 chk3D: TCheckBox;
53 ragHorV: TRadioGroup;
54 chkAbnormals: TCheckBox;
55 ragCorG: TRadioGroup;
56 lstTestGraph: TORListBox;
57 pnlGraph: TORAutoPanel;
58 chkGraph3D: TCheckBox;
59 chkGraphValues: TCheckBox;
60 lblGraphInfo: TLabel;
61 chkGraphZoom: TCheckBox;
62 PopupMenu1: TPopupMenu;
63 GotoTop1: TMenuItem;
64 GotoBottom1: TMenuItem;
65 FreezeText1: TMenuItem;
66 UnfreezeText1: TMenuItem;
67 Memo1: TMemo;
68 chkZoom: TCheckBox;
69 popChart: TPopupMenu;
70 popValues: TMenuItem;
71 pop3D: TMenuItem;
72 popZoom: TMenuItem;
73 N1: TMenuItem;
74 popCopy: TMenuItem;
75 popZoomBack: TMenuItem;
76 popDetails: TMenuItem;
77 N2: TMenuItem;
78 calLabRange: TORDateRangeDlg;
79 dlgWinPrint: TPrintDialog;
80 N3: TMenuItem;
81 popPrint: TMenuItem;
82 Timer1: TTimer;
83 TabControl1: TTabControl;
84 WebBrowser1: TWebBrowser;
85 procedure FormCreate(Sender: TObject);
86 procedure DisplayHeading;
87 procedure lstReportsClick(Sender: TObject);
88 procedure lstHeadersClick(Sender: TObject);
89 procedure lstDatesClick(Sender: TObject);
90 procedure cmdOtherTestsClick(Sender: TObject);
91 procedure FormDestroy(Sender: TObject);
92 procedure cmdNextClick(Sender: TObject);
93 procedure cmdPrevClick(Sender: TObject);
94 procedure cmdRecentClick(Sender: TObject);
95 procedure cmdOldClick(Sender: TObject);
96 procedure FormResize(Sender: TObject);
97 procedure pnlRightResize(Sender: TObject);
98 procedure chkValuesClick(Sender: TObject);
99 procedure chk3DClick(Sender: TObject);
100 procedure ragHorVClick(Sender: TObject);
101 procedure ragCorGClick(Sender: TObject);
102 procedure lstTestGraphClick(Sender: TObject);
103 procedure chkGraphValuesClick(Sender: TObject);
104 procedure chkGraph3DClick(Sender: TObject);
105 procedure chkGraphZoomClick(Sender: TObject);
106 procedure GotoTop1Click(Sender: TObject);
107 procedure GotoBottom1Click(Sender: TObject);
108 procedure FreezeText1Click(Sender: TObject);
109 procedure UnfreezeText1Click(Sender: TObject);
110 procedure PopupMenu1Popup(Sender: TObject);
111 procedure chkZoomClick(Sender: TObject);
112 procedure chtChartUndoZoom(Sender: TObject);
113 procedure popCopyClick(Sender: TObject);
114 procedure popChartPopup(Sender: TObject);
115 procedure popValuesClick(Sender: TObject);
116 procedure pop3DClick(Sender: TObject);
117 procedure popZoomClick(Sender: TObject);
118 procedure popZoomBackClick(Sender: TObject);
119 procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
120 Shift: TShiftState; X, Y: Integer);
121 procedure chtChartClickSeries(Sender: TCustomChart;
122 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
123 Shift: TShiftState; X, Y: Integer);
124 procedure chtChartClickLegend(Sender: TCustomChart;
125 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
126 procedure popDetailsClick(Sender: TObject);
127 procedure popPrintClick(Sender: TObject);
128 procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
129 procedure Timer1Timer(Sender: TObject);
130 procedure TabControl1Change(Sender: TObject);
131 procedure WebBrowser1DocumentComplete(Sender: TObject;
132 const pDisp: IDispatch; var URL: OleVariant);
133 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
134 Shift: TShiftState);
135 private
136 { Private declarations }
137 procedure AlignList;
138 procedure HGrid(griddata: TStrings);
139 procedure VGrid(griddata: TStrings);
140 procedure FillGrid(agrid: TStringGrid; aitems: TStrings);
141 procedure GridComments(aitems: TStrings);
142 procedure FillComments(amemo: TRichEdit; aitems:TStrings);
143 procedure GetInterimGrid(adatetime: TFMDateTime; direction: integer);
144 procedure WorksheetChart(test: string; aitems: TStrings);
145 procedure GetStartStop(var start, stop: string; aitems: TStrings);
146 procedure GraphChart(test: string; aitems: TStrings);
147 procedure GraphList(griddata: TStrings);
148 procedure ProcessNotifications;
149 procedure PrintLabGraph;
150 procedure GoRemote(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
151 ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
152 procedure ChkBrowser;
153 procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9: Boolean);
154 public
155 procedure ClearPtData; override;
156 function AllowContextChange(var WhyNot: string): Boolean; override;
157 procedure DisplayPage; override;
158 procedure SetFontSize(NewFontSize: Integer); override;
159 function FMToDateTime(FMDateTime: string): TDateTime;
160 procedure RequestPrint; override;
161
162end;
163
164var
165 frmLabs: TfrmLabs;
166 uPrevReportIndex, uFormat: integer;
167 uDate1, uDate2: Tdatetime;
168 tmpGrid: TStringList;
169 uLabLocalReportData: TStringList; //Storage for Local report data
170 uLabRemoteReportData: TStringList; //Storage for Remote lab query
171
172implementation
173
174uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers,
175 clipbrd, rReports, activex, mshtml, uAccessibleStringGrid;
176
177const
178 CT_LABS = 9; // ID for Labs tab used by frmFrame
179 TX_NOREPORT = 'No report is currently selected.';
180 TX_NOREPORT_CAP = 'No Report Selected';
181 ZOOM_PERCENT = 99; // padding for inflating margins
182 HTML_PRE = '<html><head><style>' + CRLF +
183 'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
184 '</style></head><body><pre>';
185 HTML_POST = CRLF + '</pre></body></html>';
186
187{$R *.DFM}
188
189var
190 uFrozen: Boolean;
191 uRemoteCount: Integer;
192 uHTMLDoc: string;
193 uReportType: string;
194 uReportRPC: string;
195 uHTMLPatient: ANSIstring;
196
197procedure TfrmLabs.RequestPrint;
198begin
199 with lstReports do
200 begin
201 if ItemIEN = 0 then InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
202 case ItemIen of
203 1: begin
204 InfoBox('Unable to print ''Most Recent'' report.', 'No Print Available', MB_OK);
205 end;
206 2: begin
207 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
208 end;
209 3: begin
210 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
211 end;
212 4: begin
213 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
214 end;
215 5: begin
216 InfoBox('Unable to print ''Worksheet'' report.', 'No Print Available', MB_OK);
217 end;
218 6: begin
219 if chtChart.Visible then PrintLabGraph;
220 end;
221 8: begin
222 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
223 end;
224 9: begin
225 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
226 end;
227 10: begin
228 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
229 end;
230 20: begin
231 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
232 end;
233 21: begin
234 PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
235 end;
236 end;
237 end;
238end;
239
240
241procedure TfrmLabs.FormCreate(Sender: TObject);
242begin
243 inherited;
244 PageID := CT_LABS;
245 grdLab.Color := ReadOnlyColor;
246 memLab.Color := ReadOnlyColor;
247 uFrozen := False;
248 uRemoteCount := 0;
249 tmpGrid := TStringList.Create;
250 uLabLocalReportData := TStringList.Create;
251 uLabRemoteReportData := TStringList.Create;
252 uPrevReportIndex := 0;
253 lstReports.ItemIndex := uPrevReportIndex;
254 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
255 lblSingleTest.Caption := '';
256 lblSpecimen.Caption := '';
257 SerTest.GetHorizAxis.ExactDateTime := true;
258 SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
259 TAccessibleStringGrid.WrapControl(grdLab);
260end;
261
262function TfrmLabs.AllowContextChange(var WhyNot: string): Boolean;
263var
264 i: integer;
265begin
266 Result := inherited AllowContextChange(WhyNot); // sets result = true
267 if Timer1.Enabled = true then
268 case BOOLCHAR[frmFrame.CCOWContextChanging] of
269 '1': begin
270 WhyNot := 'A remote data query in progress will be aborted.';
271 Result := False;
272 end;
273 '0': if WhyNot = 'COMMIT' then
274 begin
275 with RemoteSites.SiteList do for i := 0 to Count - 1 do
276 if TRemoteSite(Items[i]).Selected then
277 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
278 begin
279 TRemoteSite(Items[i]).ReportClear;
280 TRemoteSite(Items[i]).LabQueryStatus := '-1^Aborted';
281 TabControl1.OnChange(nil);
282 end;
283 Timer1.Enabled := false;
284 Result := True;
285 end;
286 end;
287end;
288
289procedure TfrmLabs.ClearPtData;
290begin
291 inherited ClearPtData;
292 Timer1.Enabled := False;
293 memLab.Lines.Clear;
294 uLabLocalReportData.Clear;
295 uLabRemoteReportData.Clear;
296 TabControl1.Tabs.Clear;
297 TabControl1.Visible := false;
298 with grdLab do
299 begin
300 RowCount := 1;
301 ColCount := 1;
302 Cells[0, 0] := '';
303 end;
304end;
305
306procedure TfrmLabs.DisplayPage;
307begin
308 inherited DisplayPage;
309 frmFrame.mnuFilePrint.Tag := CT_LABS;
310 frmFrame.mnuFilePrint.Enabled := True;
311 frmFrame.mnuFilePrintSetup.Enabled := True;
312 memLab.SelStart := 0;
313 uHTMLPatient := '<DIV align left>'
314 + '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
315 + '<TR valign="bottom" align="left">'
316 + '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
317 + '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
318 + '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
319 + '</TR></TABLE></DIV><HR>';
320 //the preferred method would be to use headers and footers
321 //so this is just an interim solution.
322 if InitPage then
323 begin
324 ListLabReports(lstReports.Items);
325 end;
326 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
327 begin
328 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
329 lstReports.ItemIndex := 0;
330 lstReportsClick(self);
331 end;
332 case CallingContext of
333 CC_INIT_PATIENT: if not InitPatient then
334 begin
335 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
336 lstReports.ItemIndex := 0;
337 lstReportsClick(self);
338 end;
339 CC_NOTIFICATION: ProcessNotifications;
340 end;
341end;
342
343procedure TfrmLabs.SetFontSize(NewFontSize: Integer);
344begin
345 inherited SetFontSize(NewFontSize);
346 FormResize(self);
347end;
348
349procedure TfrmLabs.DisplayHeading;
350begin
351 with lblHeading do
352 begin
353 Caption := 'Laboratory Results - ' + lstReports.DisplayText[lstReports.ItemIndex];
354 if lstDates.Visible then
355 Caption := Caption + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
356 end;
357end;
358
359procedure TfrmLabs.AlignList;
360begin
361 lblReports.Top := 0;
362 lstReports.Top := lblReports.Height;
363 lstDates.Height := pnlLeft.Height div 3 - (lblDates.Height div 2);
364 lstDates.Top := pnlLeft.Height - lstDates.Height;
365 lblDates.Top := lstDates.Top - lblDates.Height;
366 pnlOtherTests.Top := lblDates.Top - pnlOtherTests.Height;
367 lstHeaders.Height := pnlLeft.Height div 3 - (lblHeaders.Height * 3);
368 lstHeaders.Top := lblDates.Top - lstHeaders.Height;
369 lblHeaders.Top := lstHeaders.Top - lblHeaders.Height;
370 lstReports.Repaint;
371 lstDates.Repaint;
372 lstHeaders.Repaint;
373end;
374
375procedure TfrmLabs.lstReportsClick(Sender: TObject);
376var
377 i,iCat: integer;
378 Rpt: string;
379begin
380 inherited;
381 uRemoteCount := 0;
382 Timer1.Enabled := False;
383 Rpt := lstReports.Items[lstReports.ItemIndex];
384 uReportType := Piece(Rpt,'^',4);
385 uReportRPC := UpperCase(Piece(Rpt,'^',6));
386 if length(Piece(Rpt,'^',5)) > 0 then
387 iCat := StrToInt(Piece(Rpt,'^',5))
388 else
389 iCat := 0;
390 if uReportType = '' then uReportType := 'R';
391 StatusText('');
392 uLabLocalReportData.Clear;
393 uLabRemoteReportData.Clear;
394 lstHeaders.Clear;
395 TabControl1.Visible := false;
396 if Piece(Rpt,'^',3) = '1' then
397 if TabControl1.Tabs.Count > 1 then
398 TabControl1.Visible := true;
399 for i := 0 to RemoteSites.SiteList.Count - 1 do
400 TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
401 if uFrozen = True then memo1.visible := False;
402 case lstReports.ItemIEN of
403 1: begin // Most Recent
404 CommonComponentVisible(false,false,false,false,false,true,true,false,true);
405 pnlButtons.Visible := true;
406 pnlWorksheet.Visible := false;
407 pnlGraph.Visible := false;
408 memLab.Align := alBottom;
409 memLab.Height := pnlLeft.Height div 5;
410 grdLab.Align := alClient;
411 memLab.Clear;
412 if uReportType = 'H' then
413 begin
414 WebBrowser1.Navigate('about:blank');
415 WebBrowser1.Align := alBottom;
416 WebBrowser1.Height := pnlLeft.Height div 5;
417 WebBrowser1.Visible := true;
418 WebBrowser1.BringToFront;
419 memLab.Visible := false;
420 end
421 else
422 begin
423 WebBrowser1.Visible := false;
424 WebBrowser1.SendToBack;
425 memLab.Visible := true;
426 memLab.BringToFront;
427 end;
428 FormResize(self);
429 cmdRecentClick(self);
430 uPrevReportIndex := lstReports.ItemIndex;
431 end;
432 4: begin // Interim for Selected Tests
433 if uPrevReportIndex <> lstReports.ItemIndex then
434 begin
435 lstTests.Clear;
436 lblSpecimen.Caption := '';
437 end;
438 SelectTests(Font.Size);
439 if lstTests.Items.Count > 0 then
440 begin
441 CommonComponentVisible(false,false,true,true,true,false,false,false,true);
442 memLab.Clear;
443 chkBrowser;
444 FormResize(self);
445 RedrawActivate(memLab.Handle);
446 lstDatesClick(self);
447 cmdOtherTests.SetFocus;
448 cmdOtherTests.Default := true;
449 end
450 else uPrevReportIndex := lstReports.ItemIndex;
451 end;
452 5: begin // Worksheet
453 if uPrevReportIndex <> lstReports.ItemIndex then
454 begin
455 lstTests.Clear;
456 lblSpecimen.Caption := '';
457 end;
458 SelectTestGroups(Font.Size);
459 if lstTests.Items.Count > 0 then
460 begin
461 CommonComponentVisible(false,false,true,true,true,true,true,false,false);
462 chtChart.Visible := true;
463 memLab.Visible := false;
464 pnlButtons.Visible := false;
465 pnlWorksheet.Visible := true;
466 pnlGraph.Visible := false;
467 lstTestGraph.Width := 97;
468 ragCorG.ItemIndex := 0;
469 FormResize(self);
470 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
471 //chkZoom.Checked := false;
472 //chkZoomClick(self);
473 lstDatesClick(self);
474 cmdOtherTests.SetFocus;
475 cmdOtherTests.Default := true;
476 end
477 else uPrevReportIndex := lstReports.ItemIndex;
478 end;
479 6: begin // Graph
480 if uPrevReportIndex <> lstReports.ItemIndex then
481 begin
482 lblSingleTest.Caption := '';
483 lblSpecimen.Caption := '';
484 end;
485 SelectTest(Font.Size);
486 if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
487 begin
488 CommonComponentVisible(false,false,true,true,true,true,false,false,true);
489 pnlChart.Visible := true;
490 chtChart.Visible := true;
491 pnlButtons.Visible := false;
492 pnlWorksheet.Visible := false;
493 pnlGraph.Visible := true;
494 memLab.Height := pnlRight.Height div 5;
495 memLab.Clear;
496 if uReportType = 'H' then
497 begin
498 WebBrowser1.Visible := true;
499 WebBrowser1.Navigate('about:blank');
500 WebBrowser1.Height := pnlRight.Height div 5;
501 WebBrowser1.BringToFront;
502 memLab.Visible := false;
503 end
504 else
505 begin
506 WebBrowser1.Visible := false;
507 WebBrowser1.SendToBack;
508 memLab.Visible := true;
509 memLab.BringToFront;
510 end;
511 lstTestGraph.Items.Clear;
512 lstTestGraph.Width := 0;
513 FormResize(self);
514 RedrawActivate(memLab.Handle);
515 lblFooter.Caption := '';
516 chkGraphZoom.Checked := false;
517 chkGraphZoomClick(self);
518 chkGraph3DClick(self);
519 chkGraphValuesClick(self);
520 lstDatesClick(self);
521 cmdOtherTests.SetFocus;
522 cmdOtherTests.Default := true;
523 end
524 else uPrevReportIndex := lstReports.ItemIndex;
525 end;
526 else
527 begin
528 //added to deal with other reports from file 101.24
529 memLab.Clear;
530 chkBrowser;
531 FormResize(self);
532 memLab.Align := alClient;
533 case iCat of
534 {Categories of reports:
535 0:Fixed
536 1:Fixed w/Dates
537 2:Fixed w/Headers
538 3:Fixed w/Dates & Headers
539 4:Specialized
540 5:Graphic}
541
542 0: begin
543 CommonComponentVisible(false,false,false,false,false,false,false,false,false);
544 StatusText('Retrieving data...');
545 GoRemote(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
546 TabControl1.OnChange(nil);
547 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
548 if TabControl1.TabIndex < 1 then
549 QuickCopy(uLabLocalReportData,memLab);
550 RedrawActivate(memLab.Handle);
551 StatusText('');
552 memLab.Lines.Insert(0,' ');
553 memLab.Lines.Delete(0);
554 memLab.SelStart := 0;
555 if uReportType = 'R' then
556 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
557 else
558 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
559 if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
560 end;
561 1: begin
562 CommonComponentVisible(false,false,false,true,true,false,false,false,false);
563 memLab.Repaint;
564 lstDatesClick(self);
565 end;
566 2: begin
567 CommonComponentVisible(true,true,false,false,false,false,false,false,false);
568 lstHeaders.Clear;
569 StatusText('Retrieving data...');
570 GoRemote(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
571 TabControl1.OnChange(nil);
572 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
573 if uLabLocalReportData.Count > 0 then
574 begin
575 TabControl1.OnChange(nil);
576 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
577 end;
578 RedrawActivate(memLab.Handle);
579 StatusText('');
580 memLab.Lines.Insert(0,' ');
581 memLab.Lines.Delete(0);
582 if uReportType = 'R' then
583 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
584 else
585 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
586 if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
587 end;
588 3: begin
589 CommonComponentVisible(true,true,false,true,true,false,false,false,true);
590 lstDatesClick(self);
591 memLab.Lines.Insert(0,' ');
592 memLab.Lines.Delete(0);
593 end;
594 end;
595 end;
596 end;
597 uPrevReportIndex := lstReports.ItemIndex;
598 DisplayHeading;
599end;
600
601procedure TfrmLabs.lstHeadersClick(Sender: TObject);
602var
603 Current, Desired: integer;
604begin
605 inherited;
606 if uFrozen = True then memo1.visible := False;
607 Current := SendMessage(memLab.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
608 Desired := lstHeaders.ItemIEN;
609 SendMessage(memLab.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
610end;
611
612procedure TfrmLabs.lstDatesClick(Sender: TObject);
613var
614 tmpList: TStringList;
615 daysback: integer;
616 date1, date2: TFMDateTime;
617 today: TDateTime;
618 i: integer;
619 Rpt: string;
620begin
621 inherited;
622 uRemoteCount := 0;
623 if uFrozen = True then memo1.visible := False;
624 Screen.Cursor := crHourGlass;
625 DisplayHeading;
626 uHTMLDoc := '';
627 Rpt := lstReports.Items[lstReports.ItemIndex];
628 uReportRPC := UpperCase(Piece(Rpt,'^',6));
629 chkBrowser;
630 if (lstDates.ItemID = 'S') then
631 begin
632 with calLabRange do
633 begin
634 if Execute then
635 if Length(TextOfStart) > 0 then
636 if Length(TextOfStop) > 0 then
637 begin
638 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
639 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
640 DisplayHeading;
641 end
642 else
643 lstDates.ItemIndex := -1
644 else
645 lstDates.ItemIndex := -1
646 else
647 lstDates.ItemIndex := -1;
648 end;
649 end;
650 today := FMToDateTime(floattostr(FMToday));
651 if lstDates.ItemIEN > 0 then
652 begin
653 daysback := lstDates.ItemIEN;
654 date1 := FMToday;
655 If daysback = 1 then
656 date2 := DateTimeToFMDateTime(today)
657 Else
658 date2 := DateTimeToFMDateTime(today - daysback);
659 end
660 else
661 BeginEndDates(date1,date2,daysback);
662 date1 := date1 + 0.2359;
663 uHTMLDoc := '';
664 WebBrowser1.Navigate('about:blank');
665 case lstReports.ItemIEN of
666 21: begin // Cumulative
667 lstHeaders.Clear;
668 memLab.Clear;
669 uLabLocalReportData.Clear;
670 uLabRemoteReportData.Clear;
671 StatusText('Retrieving data for cumulative report...');
672 GoRemote(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
673 TabControl1.OnChange(nil);
674 Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
675 if uLabLocalReportData.Count > 0 then
676 begin
677 TabControl1.OnChange(nil);
678 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
679 end;
680 memLab.Lines.Insert(0,' ');
681 memLab.Lines.Delete(0);
682 end;
683 3: begin // Interim
684 memLab.Clear;
685 uLabLocalReportData.Clear;
686 uLabRemoteReportData.Clear;
687 StatusText('Retrieving data for interim report...');
688 GoRemote(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
689 TabControl1.OnChange(nil);
690 Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
691 if uLabLocalReportData.Count < 1 then
692 uLabLocalReportData.Add('<No results for this date range.>');
693 if TabControl1.TabIndex < 1 then
694 QuickCopy(uLabLocalReportData,memLab);
695 memLab.Lines.Insert(0,' ');
696 memLab.Lines.Delete(0);
697 memLab.SelStart := 0;
698 end;
699 4: begin // Interim for Selected Tests
700 memLab.Clear;
701 uLabLocalReportData.Clear;
702 uLabRemoteReportData.Clear;
703 try
704 StatusText('Retrieving data for selected tests...');
705 uLabLocalReportData.Assign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items));
706 if uLabLocalReportData.Count > 0 then
707 QuickCopy(uLabLocalReportData,memLab)
708 else
709 memLab.Lines.Add('<No results for selected tests in this date range.>');
710 memLab.SelStart := 0;
711 finally
712 //tmpList.Free;
713 end;
714 end;
715 5: begin // Worksheet
716 chtChart.BottomAxis.Automatic := true;
717 chkZoom.Checked := false;
718 //chkZoomClick(self);
719 chkAbnormals.Checked := false;
720 memLab.Clear;
721 uLabLocalReportData.Clear;
722 uLabRemoteReportData.Clear;
723 grdLab.Align := alClient;
724 StatusText('Retrieving data for worksheet...');
725 tmpGrid.Assign(Worksheet(Patient.DFN, date1, date2,
726 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items));
727 if ragHorV.ItemIndex = 0 then
728 HGrid(tmpGrid)
729 else
730 VGrid(tmpGrid);
731 GraphList(tmpGrid);
732 GridComments(tmpGrid);
733 ragCorGClick(self);
734 end;
735 6: begin // Graph
736 chtChart.BottomAxis.Automatic := true;
737 chkGraphZoom.Checked := false;
738 chkGraphZoomClick(self);
739 memLab.Clear;
740 uLabLocalReportData.Clear;
741 uLabRemoteReportData.Clear;
742 tmpList := TStringList.Create;
743 try
744 StatusText('Retrieving data for graph...');
745 tmpList.Assign(GetChart(Patient.DFN, date1, date2,
746 Piece(lblSpecimen.Caption, '^', 1),
747 Piece(lblSingleTest.Caption, '^', 1)));
748 if tmpList.Count > 1 then
749 begin
750 chtChart.Visible := true;
751 GraphChart(lblSingleTest.Caption, tmpList);
752 chtChart.ZoomPercent(ZOOM_PERCENT);
753 for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
754 do memLab.Lines.Add(tmpList[i]);
755 if memLab.Lines.Count < 2 then
756 memLab.Lines.Add('<No comments on specimens.>');
757 memLab.SelStart := 0;
758 end
759 else
760 begin
761 if Piece(lblSpecimen.Caption, '^', 1) = '0' then
762 pnlChart.Caption := '<No results can be graphed for ' +
763 Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.>'
764 else
765 pnlChart.Caption := '<No results can be graphed for ' +
766 Piece(lblSingleTest.Caption, '^', 2)
767 + ' (' + Piece(lblSpecimen.Caption, '^', 2) +
768 ') in this date range.>';
769 chtChart.Visible := false;
770 end;
771 finally
772 tmpList.Free;
773 end;
774 end;
775 9: begin // Micro
776 memLab.Clear;
777 uLabLocalReportData.Clear;
778 uLabRemoteReportData.Clear;
779 StatusText('Retrieving microbiology data...');
780 GoRemote(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
781 TabControl1.OnChange(nil);
782 Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
783 if uLabLocalReportData.Count < 1 then
784 uLabLocalReportData.Add('<No microbiology results for this date range.>');
785 if TabControl1.TabIndex < 1 then
786 QuickCopy(uLabLocalReportData,memLab);
787 memLab.Lines.Insert(0,' ');
788 memLab.Lines.Delete(0);
789 memLab.SelStart := 0;
790 end;
791 10: begin // Lab Status
792 memLab.Clear;
793 uLabLocalReportData.Clear;
794 uLabRemoteReportData.Clear;
795 StatusText('Retrieving lab status data...');
796 GoRemote(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
797 TabControl1.OnChange(nil);
798 Reports(uLabLocalReportData,Patient.DFN, '9', '', IntToStr(daysback),'',
799 date1, date2, uReportRPC);
800 if uLabLocalReportData.Count < 1 then
801 uLabLocalReportData.Add('<No laboratory orders for this date range.>');
802 if TabControl1.TabIndex < 1 then
803 QuickCopy(uLabLocalReportData,memLab);
804 memLab.Lines.Insert(0,' ');
805 memLab.Lines.Delete(0);
806 memLab.SelStart := 0;
807 end;
808 else begin //Anything Else
809 lstHeaders.Clear;
810 memLab.Clear;
811 uLabLocalReportData.Clear;
812 uLabRemoteReportData.Clear;
813 StatusText('Retrieving lab data...');
814 GoRemote(uLabRemoteReportData, StrToInt(Piece(Rpt,'^',1)), 1, '',
815 uReportRPC, '', IntToStr(daysback), '', date1, date2);
816 TabControl1.OnChange(nil);
817 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '',
818 IntToStr(daysback), '', date1, date2, uReportRPC);
819 if uLabLocalReportData.Count < 1 then
820 uLabLocalReportData.Add('<No data for this date range.>');
821 if TabControl1.TabIndex < 1 then
822 QuickCopy(uLabLocalReportData,memLab);
823 memLab.Lines.Insert(0,' ');
824 memLab.Lines.Delete(0);
825 memLab.SelStart := 0;
826 end;
827 end;
828 if uReportType = 'R' then
829 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
830 else
831 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
832 Screen.Cursor := crDefault;
833 StatusText('');
834end;
835
836procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject);
837begin
838 inherited;
839 lstReportsClick(self);
840end;
841
842procedure TfrmLabs.GraphList(griddata: TStrings);
843var
844 i, j: integer;
845 ok: boolean;
846 testname, testnum, testnum1, line: string;
847begin
848 lstTestGraph.Clear;
849 for i := 0 to lstTests.Items.Count - 1 do
850 begin
851 testnum := Piece(lstTests.Items[i], '^', 1);
852 testname := Piece(lstTests.Items[i], '^', 2);
853 ok := false;
854 for j := strtoint(Piece(griddata[0], '^', 4)) + 1 to strtointdef(Piece(griddata[0], '^', 5), 0) do
855 begin
856 testnum1 := Piece(griddata[j - 1], '^', 1);
857 if testnum1 = testnum then
858 begin
859 ok := true;
860 line := testnum + '^' + testname + ' (' + MixedCase(Piece(griddata[j - 1], '^', 2)) + ')^';
861 line := line + Pieces(griddata[j - 1], '^', 3, 6);
862 lstTestGraph.Items.Add(line);
863 end;
864 end;
865 if not ok then lstTestGraph.Items.Add(lstTests.Items[i]);
866 end;
867end;
868
869procedure TfrmLabs.HGrid(griddata: TStrings);
870var
871 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
872begin
873 offset := 0;
874 testcnt := strtoint(Piece(griddata[offset], '^', 1));
875 datecnt := strtoint(Piece(griddata[offset], '^', 2));
876 datacnt := strtoint(Piece(griddata[offset], '^', 3));
877 linecnt := testcnt + datecnt + datacnt;
878 if chkAbnormals.Checked and (linecnt > 0) then
879 begin
880 offset := linecnt + 1;
881 testcnt := strtoint(Piece(griddata[offset], '^', 1));
882 datecnt := strtoint(Piece(griddata[offset], '^', 2));
883 datacnt := strtoint(Piece(griddata[offset], '^', 3));
884 linecnt := testcnt + datecnt + datacnt;
885 end;
886 with grdLab do
887 begin
888 if testcnt = 0 then ColCount := 3 else ColCount := testcnt + 2;
889 if datecnt = 0 then RowCount := 2 else RowCount := datecnt + 1;
890 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 60);
891 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 80);
892 FixedCols := 2;
893 FixedRows := 1;
894 for y := 0 to RowCount - 1 do
895 for x := 0 to ColCount - 1 do
896 Cells[x, y] := '';
897 Cells[0, 0] := 'Date/Time';
898 Cells[1, 0] := 'Specimen';
899 for i := 1 to testcnt do
900 begin
901 Cells[i + 1, 0] := Piece(griddata[i + offset], '^', 3);
902 end;
903 if datecnt = 0 then
904 begin
905 Cells[0, 1] := 'no results';
906 for x := 1 to ColCount - 1 do
907 Cells[x, 1] := '';
908 end;
909 for i := testcnt + 1 to testcnt + datecnt do
910 begin
911 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
912 Cells[1, i - testcnt] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
913 end;
914 for i := testcnt + datecnt + 1 to linecnt do
915 begin
916 y := strtoint(Piece(griddata[i + offset], '^', 1));
917 x := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
918 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
919 end;
920 end;
921end;
922
923procedure TfrmLabs.VGrid(griddata: TStrings);
924var
925 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
926begin
927 offset := 0;
928 testcnt := strtoint(Piece(griddata[offset], '^', 1));
929 datecnt := strtoint(Piece(griddata[offset], '^', 2));
930 datacnt := strtoint(Piece(griddata[offset], '^', 3));
931 linecnt := testcnt + datecnt + datacnt;
932 if chkAbnormals.Checked and (linecnt > 0) then
933 begin
934 offset := linecnt + 1;
935 testcnt := strtoint(Piece(griddata[offset], '^', 1));
936 datecnt := strtoint(Piece(griddata[offset], '^', 2));
937 datacnt := strtoint(Piece(griddata[offset], '^', 3));
938 linecnt := testcnt + datecnt + datacnt;
939 end;
940 with grdLab do
941 begin
942 if datecnt = 0 then ColCount := 2 else ColCount := datecnt + 1;
943 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 2;
944 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 80);
945 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 60);
946 FixedCols := 1;
947 FixedRows := 2;
948 for y := 0 to RowCount - 1 do
949 for x := 0 to ColCount - 1 do
950 Cells[x, y] := '';
951 Cells[0, 0] := 'Date/Time';
952 Cells[0, 1] := 'Specimen';
953 for i := 1 to testcnt do
954 begin
955 Cells[0, i + 1] := Piece(griddata[i + offset], '^', 3);
956 end;
957 if datecnt = 0 then
958 begin
959 Cells[1, 0] := 'no results';
960 for x := 1 to RowCount - 1 do
961 Cells[x, 1] := '';
962 end;
963 for i := testcnt + 1 to testcnt + datecnt do
964 begin
965 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
966 Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4));
967 end;
968 for i := testcnt + datecnt + 1 to linecnt do
969 begin
970 x := strtoint(Piece(griddata[i + offset], '^', 1));
971 y := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
972 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
973 end;
974 end;
975end;
976
977procedure TfrmLabs.GridComments(aitems: TStrings);
978var
979 i, start: integer;
980begin
981 start := strtointdef(Piece(aitems[0], '^', 5), 1);
982 memLab.Clear;
983 uLabLocalReportData.Clear;
984 uLabRemoteReportData.Clear;
985 for i := start to aitems.Count - 1 do
986 memLab.Lines.Add(aitems[i]);
987 if (memLab.Lines.Count = 0) and (aitems.Count > 1) then
988 memLab.Lines.Add('<No comments on specimens.>');
989 memLab.SelStart := 0;
990end;
991
992procedure TfrmLabs.FormDestroy(Sender: TObject);
993begin
994 inherited;
995 tmpGrid.free;
996 uLabLocalReportData.Free;
997 uLabRemoteReportData.Free;
998 TAccessibleStringGrid.UnwrapControl(grdLab);
999end;
1000
1001procedure TfrmLabs.FillGrid(agrid: TStringGrid; aitems: TStrings);
1002var
1003 testcnt, x, y, i: integer;
1004begin
1005 testcnt := strtoint(Piece(aitems[0], '^', 1));
1006 with agrid do
1007 begin
1008 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 1;
1009 ColCount := 5;
1010 DefaultColWidth := agrid.Width div ColCount - 2;
1011 ColWidths[0] := agrid.Width div 4;
1012 ColWidths[4] := agrid.Width div 4;
1013 ColWidths[2] := agrid.Width div 9;
1014 ColWidths[3] := agrid.Width div 6;
1015 ColWidths[1] := agrid.Width - ColWidths[0] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 8;
1016 FixedCols := 0;
1017 FixedRows := 1;
1018 for y := 0 to RowCount - 1 do
1019 for x := 0 to ColCount - 1 do
1020 Cells[x, y] := '';
1021 Cells[0, 0] := 'Test';
1022 Cells[1, 0] := 'Result';
1023 Cells[2, 0] := 'Flag';
1024 Cells[3, 0] := 'Units';
1025 Cells[4, 0] := 'Ref Range';
1026 for i := 1 to testcnt do
1027 begin
1028 Cells[0, i] := Piece(aitems[i], '^', 2);
1029 Cells[1, i] := Piece(aitems[i], '^', 3);
1030 Cells[2, i] := Piece(aitems[i], '^', 4);
1031 Cells[3, i] := Piece(aitems[i], '^', 5);
1032 Cells[4, i] := Piece(aitems[i], '^', 6);
1033 end;
1034 end;
1035end;
1036
1037procedure TfrmLabs.FillComments(amemo: TRichEdit; aitems:TStrings);
1038var
1039 testcnt, i: integer;
1040 specimen, accession, provider: string;
1041begin
1042 amemo.Lines.Clear;
1043 specimen := Piece(aitems[0], '^', 5);
1044 accession := Piece(aitems[0], '^', 6);
1045 provider := Piece(aitems[0], '^', 7);
1046 amemo.Lines.Add('Specimen: ' + specimen + '; Accession: ' + accession + '; Provider: ' + provider);
1047 testcnt := strtoint(Piece(aitems[0], '^', 1));
1048 for i := testcnt + 1 to aitems.Count - 1 do
1049 amemo.Lines.Add(aitems[i]);
1050 amemo.SelStart := 0;
1051end;
1052
1053procedure TfrmLabs.GetInterimGrid(adatetime: TFMDateTime; direction: integer);
1054var
1055 tmpList: TStringList;
1056 nexton, prevon: boolean;
1057 newest, oldest: string;
1058begin
1059 tmpList := TStringList.Create;
1060 GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH
1061 nexton := true;
1062 prevon := true;
1063 try
1064 tmpList.Assign(InterimGrid(Patient.DFN, adatetime, direction, uFormat));
1065 if tmpList.Count > 0 then
1066 begin
1067 lblDateFloat.Caption := Piece(tmpList[0], '^', 3);
1068 uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1);
1069 if length(lblDateFloat.Caption) > 0 then
1070 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
1071 if length(lblDateFloat.Caption) < 1
1072 then
1073 begin
1074 lblDateFloat.Caption := FloatToStr(adatetime);
1075 nexton := false;
1076 end
1077 else
1078 begin
1079 nexton := lblDateFloat.Caption <> newest;
1080 prevon := lblDateFloat.Caption <> oldest;
1081 end;
1082 if (not nexton) and (uFormat = 3) then
1083 nexton := true;
1084 if (not prevon) and (uFormat = 2) then
1085 prevon := true;
1086 end
1087 else
1088 begin
1089 lblDateFloat.Caption := '';
1090 lblDate.Caption := '';
1091 end;
1092 cmdNext.Enabled := nexton;
1093 cmdRecent.Enabled := nexton;
1094 lblNext.Enabled := nexton;
1095 lblRecent.Enabled := nexton;
1096 cmdPrev.Enabled := prevon;
1097 cmdOld.Enabled := prevon;
1098 lblPrev.Enabled := prevon;
1099 lblOld.Enabled := prevon;
1100 if cmdOld.Enabled and cmdRecent.Enabled then
1101 lblMostRecent.Visible := false
1102 else
1103 begin
1104 lblMostRecent.Visible := true;
1105 if (not cmdOld.Enabled) and (not cmdRecent.Enabled) then
1106 lblMostRecent.Caption := 'No Lab Results'
1107 else if cmdOld.Enabled then
1108 lblMostRecent.Caption := 'Most Recent Lab Result'
1109 else
1110 lblMostRecent.Caption := 'Oldest Lab Result';
1111 end;
1112 if tmpList.Count > 0 then
1113 begin
1114 if Piece(tmpList[0], '^', 2) = 'CH' then
1115 begin
1116 FillGrid(grdLab, tmpList);
1117 FillComments(memLab, tmpList);
1118 memLab.Align := alBottom;
1119 memLab.Height := pnlLeft.Height div 5;
1120 grdLab.Align := alClient;
1121 grdLab.Visible := true;
1122 memLab.Visible := true;
1123 pnlFooter.Height := lblHeading.Height + 5;
1124 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1125 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
1126 lblFooter.Align := alTop;
1127 pnlFooter.Visible := true;
1128 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
1129 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
1130 memLab.Repaint;
1131 end;
1132 if Piece(tmpList[0], '^', 2) = 'MI' then
1133 begin
1134 tmpList.Delete(0);
1135 memLab.Lines.Assign(tmpList);
1136 memLab.SelStart := 0;
1137 grdLab.Visible := false;
1138 pnlFooter.Visible := false;
1139 memLab.Align := alClient;
1140 end;
1141 end
1142 else
1143 begin
1144 grdLab.Visible := false;
1145 pnlFooter.Visible := false;
1146 memLab.Align := alClient;
1147 end;
1148 finally
1149 tmpList.Free;
1150 end;
1151end;
1152
1153procedure TfrmLabs.cmdNextClick(Sender: TObject);
1154var
1155 HadFocus: boolean;
1156begin
1157 inherited;
1158 HadFocus := Screen.ActiveControl = cmdNext;
1159 StatusText('Retrieving next lab data...');
1160 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), -1);
1161 StatusText('');
1162 if HadFocus then begin
1163 if cmdNext.Enabled then cmdNext.SetFocus
1164 else if cmdPrev.Enabled then cmdPrev.SetFocus
1165 else lstReports.SetFocus;
1166 end;
1167end;
1168
1169procedure TfrmLabs.cmdPrevClick(Sender: TObject);
1170var
1171 HadFocus: boolean;
1172begin
1173 inherited;
1174 HadFocus := Screen.ActiveControl = cmdPrev;
1175 StatusText('Retrieving previous lab data...');
1176 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), 1);
1177 StatusText('');
1178 if HadFocus then begin
1179 if cmdPrev.Enabled then cmdPrev.SetFocus
1180 else if cmdNext.Enabled then cmdNext.SetFocus
1181 else lstReports.SetFocus;
1182 end;
1183end;
1184
1185procedure TfrmLabs.WorksheetChart(test: string; aitems: TStrings);
1186
1187function OkFloatValue(value: string): boolean;
1188var
1189 i, j: integer;
1190 first, second: string;
1191begin
1192 Result := false;
1193 i := strtointdef(value, -99999);
1194 if i <> -99999 then Result := true
1195 else if pos('.', Copy(Value, Pos('.', Value) + 1, Length(Value))) > 0 then Result := false
1196 else
1197 begin
1198 first := Piece(value, '.', 1);
1199 second := Piece(value, '.', 2);
1200 if length(second) > 0 then
1201 begin
1202 i := strtointdef(first, -99999);
1203 j := strtointdef(second, -99999);
1204 if (i <> -99999) and (j <> -99999) then Result := true;
1205 end
1206 else
1207 begin
1208 i :=strtointdef(first, -99999);
1209 if i <> -99999 then Result := true;
1210 end;
1211 end;
1212end;
1213
1214var
1215 datevalue, oldstart, oldend: TDateTime;
1216 labvalue: double;
1217 i, numtest, numcol, numvalues, valuecount: integer;
1218 high, low, start, stop, numspec, value, testcheck, units, specimen, testnum, testorder: string;
1219begin
1220 if chkZoom.Checked and chtChart.Visible then
1221 begin
1222 oldstart := chtChart.BottomAxis.Minimum;
1223 oldend := chtChart.BottomAxis.Maximum;
1224 chtChart.UndoZoom;
1225 chtChart.BottomAxis.Automatic := false;
1226 chtChart.BottomAxis.Minimum := oldstart;
1227 chtChart.BottomAxis.Maximum := oldend;
1228 end
1229 else
1230 begin
1231 chtChart.BottomAxis.Automatic := true;
1232 end;
1233 chtChart.Visible := true;
1234 valuecount := 0;
1235 testnum := Piece(test, '^', 1);
1236 specimen := Piece(test, '^', 3);
1237 units := Piece(test, '^', 4);
1238 low := Piece(test, '^', 5);
1239 high := Piece(test, '^', 6);
1240 numtest := strtoint(Piece(aitems[0], '^', 1));
1241 numcol := strtoint(Piece(aitems[0], '^', 2));
1242 numvalues := strtoint(Piece(aitems[0], '^', 3));
1243 serHigh.Clear; serLow.Clear; serTest.Clear;
1244 if numtest > 0 then
1245 begin
1246 for i := 1 to numtest do
1247 if testnum = Piece(aitems[i], '^', 2) then
1248 begin
1249 testorder := inttostr(i);
1250 break;
1251 end;
1252 GetStartStop(start, stop, aitems);
1253 if OKFloatValue(high) then
1254 begin
1255 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
1256 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
1257 end;
1258 if OKFloatValue(low) then
1259 begin
1260 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
1261 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
1262 end;
1263 numspec := Piece(specimen, '^', 1);
1264 chtChart.Legend.Color := grdLab.Color;
1265 chtChart.Title.Font.Size := MainFontSize;
1266 chtChart.LeftAxis.Title.Caption := units;
1267 serTest.Title := Piece(test, '^', 2);
1268 serHigh.Title := 'Ref High ' + high;
1269 serLow.Title := 'Ref Low ' + low;
1270 testcheck := testorder;
1271 for i := numtest + numcol + 1 to numtest + numcol + numvalues do
1272 if Piece(aitems[i], '^', 2) = testcheck then
1273 if Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 3) = numspec then
1274 begin
1275 value := Piece(aitems[i], '^', 3);
1276 if OkFloatValue(value) then
1277 begin
1278 labvalue := strtofloat(value);
1279 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
1280 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
1281 inc(valuecount);
1282 end;
1283 end;
1284 end;
1285 if valuecount = 0 then
1286 begin
1287 if length(Piece(specimen, '^', 2)) > 0 then
1288 pnlChart.Caption := '<No results can be graphed for ' + serTest.Title + ' in this date range.>'
1289 else
1290 pnlChart.Caption := '<No results can be graphed for ' + Piece(test, '^', 2) + ' in this date range.>';
1291 chtChart.Visible := false;
1292 end;
1293 if not chkZoom.Checked then
1294 begin
1295 chtChart.UndoZoom;
1296 chtChart.ZoomPercent(ZOOM_PERCENT);
1297 end;
1298end;
1299
1300procedure TfrmLabs.GetStartStop(var start, stop: string; aitems: TStrings);
1301var
1302 numtest, numcol: integer;
1303begin
1304 numtest := strtoint(Piece(aitems[0], '^', 1));
1305 numcol := strtoint(Piece(aitems[0], '^', 2));
1306 start := Piece(aitems[numtest + 1], '^', 2);
1307 stop := Piece(aitems[numtest + numcol], '^', 2);
1308end;
1309
1310procedure TfrmLabs.cmdRecentClick(Sender: TObject);
1311var
1312 HadFocus: boolean;
1313begin
1314 inherited;
1315 HadFocus := Screen.ActiveControl = cmdRecent;
1316 StatusText('Retrieving most recent lab data...');
1317 uFormat := 1;
1318 GetInterimGrid(FMToday + 0.2359, 1);
1319 StatusText('');
1320 if HadFocus and cmdPrev.Enabled then cmdPrev.SetFocus;
1321end;
1322
1323procedure TfrmLabs.cmdOldClick(Sender: TObject);
1324var
1325 HadFocus: boolean;
1326begin
1327 inherited;
1328 HadFocus := Screen.ActiveControl = cmdOld;
1329 StatusText('Retrieving oldest lab data...');
1330 uFormat := 1;
1331 GetInterimGrid(2700101, -1);
1332 if HadFocus and cmdNext.Enabled then cmdNext.SetFocus;
1333 StatusText('');
1334end;
1335
1336procedure TfrmLabs.FormResize(Sender: TObject);
1337begin
1338 inherited;
1339 AlignList;
1340 lblHeaders.Height := lblReports.Height;
1341 lblDates.Height := lblReports.Height;
1342 lblHeading.Height := lblReports.Height;
1343 pnlFooter.Height := lblReports.Height + 5;
1344 lblFooter.Height := lblReports.Height;
1345 case lstReports.ItemIEN of
1346 1: begin // Most Recent
1347 pnlHeader.Align := alTop;
1348 memLab.Height := pnlLeft.Height div 5;
1349 memLab.Top := pnlLeft.Height - pnlFooter.Height - memLab.Height;
1350 memLab.Align := alBottom;
1351 grdLab.Align := alClient;
1352 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
1353 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
1354 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1355 pnlFooter.Align := alBottom;
1356 memLab.Repaint;
1357 end;
1358 2: begin // Cumulative
1359 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1360 pnlFooter.Align := alBottom;
1361 lblFooter.Align := alTop;
1362 memLab.Align := alClient;
1363 memLab.Repaint;
1364 end;
1365 3: begin // Interim
1366 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1367 pnlFooter.Align := alBottom;
1368 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
1369 lblFooter.Align := alTop;
1370 memLab.Align := alClient;
1371 memLab.Repaint;
1372 end;
1373 4: begin // Interim for Selected Tests
1374 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1375 pnlFooter.Align := alBottom;
1376 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
1377 lblFooter.Align := alTop;
1378 memLab.Align := alClient;
1379 memLab.Repaint;
1380 end;
1381 5: begin // Worksheet
1382 pnlHeader.Align := alTop;
1383 grdLab.Align := alClient;
1384 ragCorGClick(self);
1385 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
1386 pnlFooter.Align := alBottom;
1387 end;
1388 6: begin // Graph
1389 memLab.Height := pnlLeft.Height div 4;
1390 memLab.Align := alBottom;
1391 pnlChart.Top := pnlHeader.Height;
1392 pnlChart.Align := alClient;
1393 memLab.Height := pnlLeft.Height div 4;
1394 memLab.Align := alBottom;
1395 memLab.Repaint;
1396 end;
1397 7: begin // Anatomic Path
1398 memLab.Repaint;
1399 end;
1400 8: begin // Blood Bank
1401 memLab.Repaint;
1402 end;
1403 9: begin // Microbiology
1404 memLab.Repaint;
1405 end;
1406 10: begin // Lab Status
1407 memLab.Repaint;
1408 end;
1409 end;
1410end;
1411
1412procedure TfrmLabs.pnlRightResize(Sender: TObject);
1413begin
1414 inherited;
1415 pnlRight.Refresh;
1416 lblFooter.Height := lblHeading.Height;
1417end;
1418
1419function TfrmLabs.FMToDateTime(FMDateTime: string): TDateTime;
1420var
1421 x, Year: string;
1422begin
1423 { Note: TDateTime cannot store month only or year only dates }
1424 x := FMDateTime + '0000000';
1425 if Length(x) > 12 then x := Copy(x, 1, 12);
1426 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
1427 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
1428 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
1429 Result := StrToDateTime(x);
1430end;
1431
1432procedure TfrmLabs.chkValuesClick(Sender: TObject);
1433begin
1434 inherited;
1435 serTest.Marks.Visible := chkValues.Checked;
1436end;
1437
1438procedure TfrmLabs.chk3DClick(Sender: TObject);
1439begin
1440 inherited;
1441 chtChart.View3D := chk3D.Checked;
1442end;
1443
1444procedure TfrmLabs.GraphChart(test: string; aitems: TStrings);
1445var
1446 datevalue: TDateTime;
1447 labvalue: double;
1448 i, numvalues: integer;
1449 high, low, start, stop, value, units, specimen: string;
1450begin
1451 numvalues := strtoint(Piece(aitems[0], '^', 1));
1452 specimen := Piece(aitems[0], '^', 2);
1453 high := Piece(aitems[0], '^', 3);
1454 low := Piece(aitems[0], '^', 4);
1455 units := Piece(aitems[0], '^', 5);
1456 if numvalues > 0 then
1457 begin
1458 start := Piece(aitems[1], '^', 1);
1459 stop := Piece(aitems[numvalues], '^', 1);
1460 chtChart.Legend.Color := grdLab.Color;
1461 serHigh.Clear; serLow.Clear; serTest.Clear;
1462 if high <> '' then
1463 begin
1464 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
1465 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
1466 end;
1467 if low <> '' then
1468 begin
1469 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
1470 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
1471 end;
1472 //chtChart.Title.Text.Strings[0] := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
1473 //chtChart.Title.Font.Size := 12;
1474 chtChart.LeftAxis.Title.Caption := units;
1475 serTest.Title := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
1476 serHigh.Title := 'Ref High ' + high;
1477 serLow.Title := 'Ref Low ' + low;
1478 for i := 1 to numvalues do
1479 begin
1480 value := Piece(aitems[i], '^', 2);
1481 labvalue := strtofloat(value);
1482 datevalue := FMToDateTime(Piece(aitems[i], '^', 1));
1483 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
1484 end;
1485 end;
1486end;
1487
1488procedure TfrmLabs.ragHorVClick(Sender: TObject);
1489begin
1490 inherited;
1491 if ragHorV.ItemIndex = 0 then HGrid(tmpGrid) else VGrid(tmpGrid);
1492end;
1493
1494procedure TfrmLabs.ragCorGClick(Sender: TObject);
1495begin
1496 inherited;
1497 if ragCorG.ItemIndex = 0 then // comments
1498 begin
1499 chkZoom.Enabled := false;
1500 chk3D.Enabled := false;
1501 chkValues.Enabled := false;
1502 pnlChart.Visible:= false;
1503 grdLab.Align := alNone;
1504 memLab.Height := pnlRight.Height div 6;
1505 memLab.Top := pnlRight.Height - pnlFooter.Height - memLab.Height;
1506 memLab.Align := alBottom;
1507 memLab.Visible := true;
1508 grdLab.Align := alClient;
1509 end
1510 else // graph
1511 begin
1512 chkZoom.Enabled := true;
1513 chk3D.Enabled := true;
1514 chkValues.Enabled := true;
1515 chk3DClick(self);
1516 chkValuesClick(self);
1517 memLab.Visible := false;
1518 grdLab.Align := alNone;
1519 //pnlChart.Height := pnlLeft.Height - pnlOtherTests.Top - pnlFooter.Height;
1520 //pnlChart.Top := pnlOtherTests.Top;
1521 pnlChart.Height := pnlRight.Height div 2;
1522 pnlChart.Top := pnlRight.Height - pnlFooter.Height - pnlChart.Height;
1523 pnlChart.Align := alBottom;
1524 pnlChart.Visible := true;
1525 grdLab.Align := alClient;
1526 if lstTestGraph.Items.Count > 0 then
1527 begin
1528 if lstTestGraph.ItemIndex < 0 then
1529 lstTestGraph.ItemIndex := 0;
1530 lstTestGraphClick(self);
1531 end;
1532 end;
1533end;
1534
1535procedure TfrmLabs.lstTestGraphClick(Sender: TObject);
1536begin
1537 inherited;
1538 WorksheetChart(lstTestGraph.Items[lstTestGraph.ItemIndex], tmpGrid);
1539end;
1540
1541
1542procedure TfrmLabs.chkGraphValuesClick(Sender: TObject);
1543begin
1544 inherited;
1545 serTest.Marks.Visible := chkGraphValues.Checked;
1546end;
1547
1548procedure TfrmLabs.chkGraph3DClick(Sender: TObject);
1549begin
1550 inherited;
1551 chtChart.View3D := chkGraph3D.Checked;
1552end;
1553
1554procedure TfrmLabs.chkGraphZoomClick(Sender: TObject);
1555begin
1556 inherited;
1557 chtChart.AllowZoom := chkGraphZoom.Checked;
1558 chtChart.AnimatedZoom := chkGraphZoom.Checked;
1559 lblGraphInfo.Caption := 'To Zoom, hold down the mouse button while dragging an area to be enlarged.';
1560 if chkGraphZoom.Checked then
1561 lblGraphInfo.Caption := lblGraphInfo.Caption + #13
1562 + 'To Zoom Back drag to the upper left. You can also use the actions on the right mouse button.';
1563 lblGraphInfo.Visible := chkGraphZoom.Checked;
1564 if not chkGraphZoom.Checked then chtChart.UndoZoom;
1565end;
1566
1567procedure TfrmLabs.GotoTop1Click(Sender: TObject);
1568begin
1569 inherited;
1570with memLab do
1571 begin
1572 SetFocus;
1573 SelStart :=0;
1574 SelLength :=0;
1575 end;
1576end;
1577
1578procedure TfrmLabs.GotoBottom1Click(Sender: TObject);
1579var
1580 I,CharCount : Integer;
1581begin
1582 Inherited;
1583 CharCount :=0;
1584 with memLab do
1585 begin
1586 for I := 0 to lines.count-1 do
1587 CharCount := CharCount + Length(Lines[I]) + 2;
1588 SetFocus;
1589 SelStart := CharCount;
1590 SelLength :=0;
1591 end;
1592end;
1593
1594procedure TfrmLabs.FreezeText1Click(Sender: TObject);
1595var
1596 Current, Desired : Longint;
1597 LineCount : Integer;
1598begin
1599 Inherited;
1600 If memLab.SelLength > 0 then begin
1601 Memo1.visible := true;
1602 Memo1.Text := memLab.SelText;
1603 If Memo1.Lines.Count <6 then
1604 LineCount := Memo1.Lines.Count + 1
1605 Else
1606 LineCount := 5;
1607 Memo1.Height := LineCount * frmLabs.Canvas.TextHeight(memLab.SelText);
1608 Current := SendMessage(memLab.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1609 Desired := SendMessage(memLab.handle, EM_LINEFROMCHAR,
1610 memLab.SelStart + memLab.SelLength ,0);
1611 SendMessage(memLab.Handle,EM_LINESCROLL, 0, Desired - Current);
1612 uFrozen := True;
1613 end;
1614end;
1615
1616procedure TfrmLabs.UnfreezeText1Click(Sender: TObject);
1617begin
1618 Inherited;
1619 If uFrozen = True Then begin
1620 uFrozen := False;
1621 UnFreezeText1.Enabled := False;
1622 Memo1.Visible := False;
1623 Memo1.Text := '';
1624 end;
1625end;
1626
1627procedure TfrmLabs.PopupMenu1Popup(Sender: TObject);
1628begin
1629 inherited;
1630 If Screen.ActiveControl.Name <> memLab.Name then
1631 begin
1632 memLab.SetFocus;
1633 memLab.SelStart := 0;
1634 end;
1635 If memLab.SelLength > 0 Then
1636 FreezeText1.Enabled := True
1637 Else
1638 FreezeText1.Enabled := False;
1639 If Memo1.Visible Then
1640 UnFreezeText1.Enabled := True;
1641 If memLab.SelStart > 0 then
1642 GotoTop1.Enabled := True
1643 Else
1644 GotoTop1.Enabled := False;
1645 If SendMessage(memLab.handle, EM_LINEFROMCHAR,
1646 memLab.SelStart,0) < memLab.Lines.Count then
1647 GotoBottom1.Enabled := True
1648 Else
1649 GotoBottom1.Enabled := False;
1650 case lstReports.ItemIEN of
1651 1: FreezeText1.Enabled := False;
1652 5: FreezeText1.Enabled := False;
1653 6: FreezeText1.Enabled := False;
1654 end;
1655end;
1656
1657procedure TfrmLabs.ProcessNotifications;
1658var
1659 //AlertDate, CurrentDate: TFMDateTime;
1660 OrderIFN: string;
1661begin
1662 {uNewest := '';
1663 uOldest := '';
1664 GetNewestOldest(Patient.DFN, uNewest, uOldest); }
1665 {AlertDate := Trunc(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3)));
1666 CurrentDate := FMToday;
1667 lstReports.ItemIndex := 2;
1668 if AlertDate = CurrentDate then
1669 begin
1670 lstDates.ItemIndex := 0;
1671 lstReports.ItemIndex := 0;
1672 end
1673 else if CurrentDate - AlertDate < 7 then lstDates.ItemIndex := 2
1674 else if CurrentDate - AlertDate < 14 then lstDates.ItemIndex := 3
1675 else if CurrentDate - AlertDate < 28 then lstDates.ItemIndex := 4
1676 else lstDates.ItemIndex := 5;
1677
1678 lstReportsClick(self); }
1679
1680 OrderIFN := Piece(Notifications.AlertData, '@', 1);
1681 if StrToIntDef(OrderIFN,0) > 0 then
1682 begin
1683 lstDates.ItemIndex := -1;
1684 lstReports.ItemIndex := -1;
1685 Memo1.Visible := false;
1686 lblHeaders.Visible := false;
1687 lstHeaders.Visible := false;
1688 pnlOtherTests.Visible := false;
1689 lblDates.Visible := true;
1690 lstDates.Visible := true;
1691 pnlHeader.Visible := false;
1692 grdLab.Visible := false;
1693 pnlChart.Visible := false;
1694 WebBrowser1.Visible := false;
1695 WebBrowser1.SendToBack;
1696 memLab.Visible := true;
1697 memLab.BringToFront;
1698 pnlFooter.Visible := true;
1699 memLab.Clear;
1700 uLabLocalReportData.Clear;
1701 uLabRemoteReportData.Clear;
1702 memLab.Align := alClient;
1703 FormResize(self);
1704 memLab.Lines.Assign(ResultOrder(OrderIFN));
1705 memLab.SelStart := 0;
1706 memLab.Repaint;
1707 lblHeading.Caption := Notifications.Text;
1708 end
1709 else
1710 begin
1711 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
1712 lstReports.ItemIndex := 0;
1713 lstReportsClick(self);
1714 end;
1715
1716 case Notifications.FollowUp of
1717 NF_LAB_RESULTS : Notifications.Delete;
1718 NF_ABNORMAL_LAB_RESULTS : Notifications.Delete;
1719 NF_SITE_FLAGGED_RESULTS : Notifications.Delete;
1720 NF_STAT_RESULTS : Notifications.Delete;
1721 NF_CRITICAL_LAB_RESULTS : Notifications.Delete;
1722 NF_LAB_THRESHOLD_EXCEEDED : Notifications.Delete;
1723 end;
1724end;
1725
1726procedure TfrmLabs.chkZoomClick(Sender: TObject);
1727begin
1728 inherited;
1729 chtChart.AllowZoom := chkZoom.Checked;
1730 chtChart.AnimatedZoom := chkZoom.Checked;
1731 if not chkZoom.Checked then
1732 begin
1733 chtChart.UndoZoom;
1734 chtChart.ZoomPercent(ZOOM_PERCENT);
1735 end;
1736end;
1737
1738procedure TfrmLabs.chtChartUndoZoom(Sender: TObject);
1739begin
1740 inherited;
1741 chtChart.BottomAxis.Automatic := true;
1742end;
1743
1744procedure TfrmLabs.popCopyClick(Sender: TObject);
1745begin
1746 inherited;
1747 chtChart.CopyToClipboardBitmap;
1748end;
1749
1750procedure TfrmLabs.popChartPopup(Sender: TObject);
1751begin
1752 inherited;
1753 if pnlWorksheet.Visible then
1754 begin
1755 popValues.Checked := chkValues.Checked;
1756 pop3D.Checked := chk3D.Checked;
1757 popZoom.Checked := chkZoom.Checked;
1758 end
1759 else
1760 begin
1761 popValues.Checked := chkGraphValues.Checked;
1762 pop3D.Checked := chkGraph3D.Checked;
1763 popZoom.Checked := chkGraphZoom.Checked;
1764 end;
1765 popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
1766 if chtChart.Hint <> '' then
1767 begin
1768 popDetails.Caption := chtChart.Hint;
1769 popDetails.Enabled := true;
1770 end
1771 else
1772 begin
1773 popDetails.Caption := 'Details';
1774 popDetails.Enabled := false;
1775 end;
1776end;
1777
1778procedure TfrmLabs.popValuesClick(Sender: TObject);
1779begin
1780 inherited;
1781 if pnlWorksheet.Visible then
1782 begin
1783 chkValues.Checked := not chkValues.Checked;
1784 chkValuesClick(self);
1785 end
1786 else
1787 begin
1788 chkGraphValues.Checked := not chkGraphValues.Checked;
1789 chkGraphValuesClick(self);
1790 end;
1791end;
1792
1793procedure TfrmLabs.pop3DClick(Sender: TObject);
1794begin
1795 inherited;
1796 if pnlWorksheet.Visible then
1797 begin
1798 chk3D.Checked := not chk3D.Checked;
1799 chk3DClick(self);
1800 end
1801 else
1802 begin
1803 chkGraph3D.Checked := not chkGraph3D.Checked;
1804 chkGraph3DClick(self);
1805 end;
1806end;
1807
1808procedure TfrmLabs.popZoomClick(Sender: TObject);
1809begin
1810 inherited;
1811 if pnlWorksheet.Visible then
1812 begin
1813 chkZoom.Checked := not chkZoom.Checked;
1814 chkZoomClick(self);
1815 end
1816 else
1817 begin
1818 chkGraphZoom.Checked := not chkGraphZoom.Checked;
1819 chkGraphZoomClick(self);
1820 end;
1821end;
1822
1823procedure TfrmLabs.popZoomBackClick(Sender: TObject);
1824begin
1825 inherited;
1826 chtChart.UndoZoom;
1827end;
1828
1829procedure TfrmLabs.chtChartMouseDown(Sender: TObject; Button: TMouseButton;
1830 Shift: TShiftState; X, Y: Integer);
1831begin
1832 inherited;
1833 chtChart.Hint := '';
1834 chtChart.Tag := 0;
1835end;
1836
1837procedure TfrmLabs.chtChartClickSeries(Sender: TCustomChart;
1838 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
1839 Shift: TShiftState; X, Y: Integer);
1840begin
1841 inherited;
1842 if Series = serHigh then exit;
1843 if Series = serLow then exit;
1844 uDate1 := Series.XValue[ValueIndex];
1845 uDate2 := uDate1;
1846 chtChart.Hint := 'Details - Lab results for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
1847 chtChart.Tag := ValueIndex + 1;
1848 if Button <> mbRight then popDetailsClick(self);
1849end;
1850
1851procedure TfrmLabs.chtChartClickLegend(Sender: TCustomChart;
1852 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1853begin
1854 inherited;
1855 chtChart.Hint := 'Details - for ' + Piece(serTest.Title, '(', 1) + '...';
1856 chtChart.Tag := 0;
1857 if Button <> mbRight then popDetailsClick(self);
1858end;
1859
1860procedure TfrmLabs.popDetailsClick(Sender: TObject);
1861var
1862 tmpList: TStringList;
1863 date1, date2: TFMDateTime;
1864 strdate1, strdate2: string;
1865begin
1866 inherited;
1867 Screen.Cursor := crHourGlass;
1868 if chtChart.Tag > 0 then
1869 begin
1870 tmpList := TStringList.Create;
1871 try
1872 strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
1873 strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
1874 uDate1 := StrToDateTime(strdate1);
1875 uDate2 := StrToDateTime(strdate2);
1876 date1 := DateTimeToFMDateTime(uDate1 + 1);
1877 date2 := DateTimeToFMDateTime(uDate2);
1878 StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
1879 Interim(tmpList, Patient.DFN, date1, date2,'ORWLRR INTERIM');
1880 ReportBox(tmpList, 'Lab results on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
1881 finally
1882 tmplist.Free;
1883 end;
1884 end
1885 else
1886 begin
1887 date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
1888 date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
1889 tmpList := TStringList.Create;
1890 try
1891 if lstTestGraph.ItemIndex > -1 then
1892 tmpList.Add(lstTestGraph.Items[lstTestGraph.ItemIndex])
1893 else
1894 tmpList.Add(Piece(lblSingleTest.Caption, '^', 1));
1895 StatusText('Retrieving data for ' + serTest.Title + '...');
1896 ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + 'results on ' + Patient.Name, True);
1897 finally
1898 tmpList.Free;
1899 end;
1900 end;
1901 Screen.Cursor := crDefault;
1902 StatusText('');
1903end;
1904
1905procedure TfrmLabs.popPrintClick(Sender: TObject);
1906begin
1907 inherited;
1908 if chtChart.Visible then PrintLabGraph;
1909end;
1910
1911procedure TfrmLabs.PrintLabGraph;
1912var
1913 GraphTitle: string;
1914begin
1915 inherited;
1916 GraphTitle := Piece(lblSingleTest.Caption, '^', 2);
1917 if (Length(lblSpecimen.Caption) > 2) then GraphTitle := GraphTitle + ' (' + Piece(lblSpecimen.Caption, '^', 2) + ')';
1918 GraphTitle := GraphTitle + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
1919 if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
1920end;
1921
1922procedure TfrmLabs.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
1923var
1924 datetemp: TFMDateTime;
1925 today, datetime1, datetime2: TDateTime;
1926 relativedate: string;
1927begin
1928 today := FMToDateTime(floattostr(FMToday));
1929 relativedate := Piece(lstDates.ItemID, ';', 1);
1930 relativedate := Piece(relativedate, '-', 2);
1931 ADaysBack := strtointdef(relativedate, 0);
1932 ADate1 := DateTimeToFMDateTime(today - ADaysBack);
1933 relativedate := Piece(lstDates.ItemID, ';', 2);
1934 if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
1935 begin
1936 relativedate := Piece(relativedate, '+', 2);
1937 ADaysBack := strtointdef(relativedate, 0);
1938 ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
1939 end
1940 else
1941 begin
1942 relativedate := Piece(relativedate, '-', 2);
1943 ADaysBack := strtointdef(relativedate, 0);
1944 ADate2 := DateTimeToFMDateTime(today - ADaysBack);
1945 end;
1946 datetime1 := FMDateTimeToDateTime(ADate1);
1947 datetime2 := FMDateTimeToDateTime(ADate2);
1948 if datetime1 < datetime2 then // reorder dates, if needed
1949 begin
1950 datetemp := ADate1;
1951 ADate1 := ADate2;
1952 ADate2 := datetemp
1953 end;
1954 ADate1 := ADate1 + 0.2359;
1955end;
1956
1957procedure TfrmLabs.Timer1Timer(Sender: TObject);
1958var
1959 i,j: integer;
1960 r0: String;
1961begin
1962 inherited;
1963 with RemoteSites.SiteList do
1964 begin
1965 for i := 0 to Count - 1 do
1966 if TRemoteSite(Items[i]).Selected then
1967 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
1968 begin
1969 r0 := GetRemoteStatus(TRemoteSite(Items[i]).LabRemoteHandle);
1970 TRemoteSite(Items[i]).LabQueryStatus := r0; //r0='1^Done' if no errors
1971 if piece(r0,'^',1) = '1' then
1972 begin
1973 RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery,
1974 TRemoteSite(Items[i]).LabRemoteHandle);
1975 GetRemoteData(TRemoteSite(Items[i]).LabData,
1976 TRemoteSite(Items[i]).LabRemoteHandle,Items[i]);
1977 TRemoteSite(Items[i]).LabRemoteHandle := '';
1978 TabControl1.OnChange(nil);
1979 end
1980 else
1981 begin
1982 uRemoteCount := uRemoteCount + 1;
1983 if uRemoteCount > 60 then //5 minute limit
1984 begin
1985 Timer1.Enabled := False;
1986 TRemoteSite(Items[i]).LabQueryStatus := '-1^Timed out';
1987 StatusText('');
1988 TabControl1.OnChange(nil);
1989 end
1990 else
1991 StatusText('Retrieving Lab data from '
1992 + TRemoteSite(Items[i]).SiteName + '...');
1993 end;
1994 Timer1.Interval := 5000;
1995 end;
1996 if Timer1.Enabled = True then
1997 begin
1998 j := 0;
1999 for i := 0 to Count -1 do
2000 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
2001 j := 1;
2002 if j = 0 then //Shutdown timer if all sites have been processed
2003 begin
2004 Timer1.Enabled := False;
2005 StatusText('');
2006 end;
2007 j := 0;
2008 for i := 0 to Count -1 do
2009 if TRemoteSite(Items[i]).Selected = true then
2010 j := 1;
2011 if j = 0 then //Shutdown timer if user has de-selected all sites
2012 begin
2013 Timer1.Enabled := False;
2014 StatusText('');
2015 TabControl1.OnChange(nil);
2016 end;
2017 end;
2018 end;
2019end;
2020
2021procedure TfrmLabs.GoRemote(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
2022 ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
2023var
2024 i,j: integer;
2025 LocalHandle, Report, Query: String;
2026begin
2027 { AReportID := 1 Generic report RemoteLabReports
2028 2 Cumulative RemoteLabCumulative
2029 3 Interim RemoteLabInterim
2030 4 Microbioloby RemoteLabMicro }
2031 with RemoteSites.SiteList do
2032 for i := 0 to Count - 1 do
2033 if TRemoteSite(Items[i]).Selected then
2034 begin
2035 TRemoteSite(Items[i]).LabClear;
2036 TRemoteSite(Items[i]).CurrentLabQuery := 'Lab' + Patient.DFN + ';' + Patient.ICN +
2037 '^' + IntToStr(AItem) + '^' + IntToStr(AReportID) + '^^' + ARpc + '^' + AHSType +
2038 '^' + ADaysBack + '^' + ASection + '^' + DateToStr(ADate1) + '^' + DateToStr(ADate2) + '^' +
2039 TRemoteSite(Items[i]).SiteID;
2040 LocalHandle := '';
2041 for j := 0 to RemoteReports.Count - 1 do
2042 begin
2043 Query := TRemoteSite(Items[i]).CurrentLabQuery;
2044 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
2045 if Report = Query then
2046 begin
2047 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
2048 break;
2049 end;
2050 end;
2051 if Length(LocalHandle) > 1 then
2052 with RemoteSites.SiteList do
2053 begin
2054 GetRemoteData(TRemoteSite(Items[i]).LabData,LocalHandle,Items[i]);
2055 TRemoteSite(Items[i]).LabRemoteHandle := '';
2056 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
2057 TabControl1.OnChange(nil);
2058 end
2059 else
2060 begin
2061 case AReportID of
2062 1: begin
2063 RemoteLabReports(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
2064 AHSType, ADaysBack, ASection, ADate1, ADate2,
2065 TRemoteSite(Items[i]).SiteID, ARpc);
2066 end;
2067 2: begin
2068 RemoteLabCumulative(Dest, Patient.DFN + ';' + Patient.ICN,
2069 StrToInt(Adaysback), Adate1, Adate2, TRemoteSite(Items[i]).SiteID,ARpc);
2070 end;
2071 3: begin
2072 RemoteLabInterim(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
2073 TRemoteSite(Items[i]).SiteID, ARpc);
2074 end;
2075 4: begin
2076 RemoteLabMicro(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
2077 TRemoteSite(Items[i]).SiteID, ARpc);
2078 end;
2079 else begin
2080 RemoteLab(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
2081 AHSType, ADaysBack, ASection, ADate1, ADate2,
2082 TRemoteSite(Items[i]).SiteID, ARpc);
2083 end;
2084 end;
2085 if Dest[0] = '' then
2086 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error'
2087 else
2088 begin
2089 TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
2090 TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
2091 Timer1.Enabled := True;
2092 StatusText('Retrieving reports from '
2093 + TRemoteSite(Items[i]).SiteName + '...');
2094 end;
2095 end;
2096 end;
2097end;
2098
2099procedure TfrmLabs.TabControl1Change(Sender: TObject);
2100var
2101 aStatus: string;
2102 hook: Boolean;
2103 i: integer;
2104begin
2105 inherited;
2106 memLab.Lines.Clear;
2107 lstHeaders.Items.Clear;
2108 with TabControl1 do
2109 begin
2110 memLab.Lines.BeginUpdate;
2111 if TabIndex > 0 then
2112 begin
2113 aStatus := TRemoteSite(Tabs.Objects[TabIndex]).LabQueryStatus;
2114 if aStatus = '1^Done' then
2115 begin
2116 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[0],'^',1) = '[HIDDEN TEXT]' then
2117 begin
2118 lstHeaders.Clear;
2119 hook := false;
2120 for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).LabData.Count - 1 do
2121 if hook = true then
2122 memLab.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i])
2123 else
2124 begin
2125 lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i]));
2126 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i],'^',1) = '[REPORT TEXT]' then
2127 hook := true;
2128 end;
2129 end
2130 else
2131 QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).LabData,memLab);
2132 memLab.Lines.Insert(0,' ');
2133 memLab.Lines.Delete(0);
2134 end;
2135 if Piece(aStatus,'^',1) = '-1' then
2136 memLab.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
2137 if Piece(aStatus,'^',1) = '0' then
2138 memLab.Lines.Add('Transmission in progress: ' + Piece(aStatus,'^',2));
2139 if Piece(aStatus,'^',1) = '' then
2140 memLab.Lines.Add('Select a report...');
2141 end
2142 else
2143 if uLabLocalReportData.Count > 0 then
2144 begin
2145 if Piece(uLabLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
2146 begin
2147 lstHeaders.Clear;
2148 hook := false;
2149 for i := 1 to uLabLocalReportData.Count - 1 do
2150 if hook = true then
2151 memLab.Lines.Add(uLabLocalReportData[i])
2152 else
2153 begin
2154 lstHeaders.Items.Add(MixedCase(uLabLocalReportData[i]));
2155 if Piece(uLabLocalReportData[i],'^',1) = '[REPORT TEXT]' then
2156 hook := true;
2157 end;
2158 end
2159 else
2160 QuickCopy(uLabLocalReportData,memLab);
2161 memLab.Lines.Insert(0,' ');
2162 memLab.Lines.Delete(0);
2163 end;
2164 memLab.SelStart := 0;
2165 memLab.Lines.EndUpdate;
2166 end;
2167end;
2168
2169procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject;
2170 const pDisp: IDispatch; var URL: OleVariant);
2171var
2172 WebDoc: IHtmlDocument2;
2173 v: variant;
2174begin
2175 inherited;
2176 if uHTMLDoc = '' then Exit;
2177 if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control
2178 if not Assigned(WebBrowser1.Document) then Exit;
2179 WebDoc := WebBrowser1.Document as IHtmlDocument2;
2180 v := VarArrayCreate([0, 0], varVariant);
2181 v[0] := uHTMLDoc;
2182 WebDoc.write(PSafeArray(TVarData(v).VArray));
2183 WebDoc.close;
2184 //uHTMLDoc := '';
2185end;
2186
2187procedure TfrmLabs.ChkBrowser;
2188begin
2189 if uReportType = 'H' then
2190 begin
2191 WebBrowser1.Visible := true;
2192 WebBrowser1.Navigate('about:blank');
2193 WebBrowser1.BringToFront;
2194 memLab.Visible := false;
2195 end
2196 else
2197 begin
2198 WebBrowser1.Visible := false;
2199 WebBrowser1.SendToBack;
2200 memLab.Visible := true;
2201 memLab.BringToFront;
2202 end;
2203end;
2204
2205procedure TfrmLabs.CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9: Boolean);
2206begin
2207 lstDates.Visible := false; // turned off to realign correctly
2208 lblDates.Visible := false;
2209 pnlOtherTests.Visible := false;
2210 lstHeaders.Visible := false;
2211 lblHeaders.Visible := false;
2212 lstDates.Visible := A5; // reordered to realign
2213 lblDates.Visible := A4;
2214 pnlOtherTests.Visible := A3;
2215 lstHeaders.Visible := A2;
2216 lblHeaders.Visible := A1;
2217 pnlHeader.Visible := A6;
2218 grdLab.Visible := A7;
2219 pnlChart.Visible := A8;
2220 pnlFooter.Visible := A9;
2221 if A4 and A1 and (lblDates.Top < lblHeaders.Top) then
2222 begin
2223 lblDates.Caption := 'Headings'; // swithes captions if not aligned
2224 lblHeaders.Caption := 'Date Range';
2225 end
2226 else
2227 begin
2228 lblDates.Caption := 'Date Range';
2229 lblHeaders.Caption := 'Headings';
2230 end;
2231 lstDates.Caption := lblDates.Caption;
2232 lstHeaders.Caption := lblHeaders.Caption;
2233end;
2234
2235procedure TfrmLabs.Memo1KeyUp(Sender: TObject; var Key: Word;
2236 Shift: TShiftState);
2237begin
2238 inherited;
2239 if (Key = VK_TAB) then
2240 begin
2241 if ssShift in Shift then
2242 begin
2243 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
2244 Key := 0;
2245 end
2246 else if ssCtrl in Shift then
2247 begin
2248 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
2249 Key := 0;
2250 end;
2251 end;
2252 if (key = VK_ESCAPE) then begin
2253 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
2254 key := 0;
2255 end;
2256end;
2257
2258end.
Note: See TracBrowser for help on using the repository browser.