source: cprs/trunk/CPRS-Chart/fLabs.pas@ 790

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

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