close Warning: Can't use blame annotator: 
svn blame failed on cprs/branches/tmg-cprs/CPRS-Chart/fLabs.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/branches/tmg-cprs/CPRS-Chart/fLabs.pas@ 1156

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

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