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

Last change on this file since 1742 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 193.0 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, fBase508Form,
10 VA508AccessibilityManager;
11
12type
13 TGrdLab508Manager = class(TVA508ComponentManager)
14 private
15 function GetTextToSpeak(sg: TCaptionStringGrid): String;
16 function ToBlankIfEmpty(aString : String) : String;
17 public
18 constructor Create; override;
19 function GetValue(Component: TWinControl): string; override;
20 function GetItem(Component: TWinControl): TObject; override;
21 end;
22
23 TfrmLabs = class(TfrmHSplit)
24 popChart: TPopupMenu;
25 popValues: TMenuItem;
26 pop3D: TMenuItem;
27 popZoom: TMenuItem;
28 N1: TMenuItem;
29 popCopy: TMenuItem;
30 popZoomBack: TMenuItem;
31 popDetails: TMenuItem;
32 N2: TMenuItem;
33 calLabRange: TORDateRangeDlg;
34 dlgWinPrint: TPrintDialog;
35 N3: TMenuItem;
36 popPrint: TMenuItem;
37 Timer1: TTimer;
38 pnlRightBottom: TPanel;
39 Memo1: TMemo;
40 memLab: TRichEdit;
41 pnlRightTop: TPanel;
42 bvlHeader: TBevel;
43 pnlHeader: TORAutoPanel;
44 lblDateFloat: TLabel;
45 pnlWorksheet: TORAutoPanel;
46 chkValues: TCheckBox;
47 chk3D: TCheckBox;
48 ragHorV: TRadioGroup;
49 chkAbnormals: TCheckBox;
50 ragCorG: TRadioGroup;
51 chkZoom: TCheckBox;
52 pnlGraph: TORAutoPanel;
53 lblGraphInfo: TLabel;
54 chkGraph3D: TCheckBox;
55 chkGraphValues: TCheckBox;
56 chkGraphZoom: TCheckBox;
57 pnlButtons: TORAutoPanel;
58 lblMostRecent: TLabel;
59 lblDate: TVA508StaticText;
60 cmdNext: TButton;
61 cmdPrev: TButton;
62 cmdRecent: TButton;
63 cmdOld: TButton;
64 grdLab: TCaptionStringGrid;
65 pnlChart: TPanel;
66 lblGraph: TLabel;
67 lstTestGraph: TORListBox;
68 chtChart: TChart;
69 serHigh: TLineSeries;
70 serLow: TLineSeries;
71 serTest: TLineSeries;
72 pnlRightTopHeader: TPanel;
73 PopupMenu2: TPopupMenu;
74 Print1: TMenuItem;
75 Copy1: TMenuItem;
76 SelectAll1: TMenuItem;
77 PopupMenu3: TPopupMenu;
78 Print2: TMenuItem;
79 Copy2: TMenuItem;
80 SelectAll2: TMenuItem;
81 GoToTop1: TMenuItem;
82 GoToBottom1: TMenuItem;
83 FreezeText1: TMenuItem;
84 UnFreezeText1: TMenuItem;
85 sptHorzRight: TSplitter;
86 pnlFooter: TORAutoPanel;
87 lblSpecimen: TLabel;
88 lblSingleTest: TLabel;
89 lblFooter: TOROffsetLabel;
90 lstTests: TORListBox;
91 lvReports: TCaptionListView;
92 pnlLefTop: TPanel;
93 lblReports: TOROffsetLabel;
94 tvReports: TORTreeView;
95 pnlLeftBottom: TPanel;
96 lstQualifier: TORListBox;
97 lblQualifier: TOROffsetLabel;
98 lblHeaders: TOROffsetLabel;
99 lstHeaders: TORListBox;
100 lblDates: TOROffsetLabel;
101 lstDates: TORListBox;
102 Splitter1: TSplitter;
103 pnlOtherTests: TORAutoPanel;
104 bvlOtherTests: TBevel;
105 cmdOtherTests: TButton;
106 TabControl1: TTabControl;
107 pnlRightTopHeaderTop: TPanel;
108 lblHeading: TOROffsetLabel;
109 chkMaxFreq: TCheckBox;
110 lblTitle: TOROffsetLabel;
111 Label1: TLabel;
112 lblSample: TLabel;
113 Label2: TLabel;
114 procedure FormCreate(Sender: TObject);
115 procedure DisplayHeading(aRanges: string);
116 //procedure lstReportsClick(Sender: TObject);
117 procedure lstHeadersClick(Sender: TObject);
118 procedure lstDatesClick(Sender: TObject);
119 procedure cmdOtherTestsClick(Sender: TObject);
120 procedure FormDestroy(Sender: TObject);
121 procedure cmdNextClick(Sender: TObject);
122 procedure cmdPrevClick(Sender: TObject);
123 procedure cmdRecentClick(Sender: TObject);
124 procedure cmdOldClick(Sender: TObject);
125 procedure FormResize(Sender: TObject);
126 procedure pnlRightResize(Sender: TObject);
127 procedure chkValuesClick(Sender: TObject);
128 procedure chk3DClick(Sender: TObject);
129 procedure ragHorVClick(Sender: TObject);
130 procedure ragCorGClick(Sender: TObject);
131 procedure lstTestGraphClick(Sender: TObject);
132 procedure chkGraphValuesClick(Sender: TObject);
133 procedure chkGraph3DClick(Sender: TObject);
134 procedure chkGraphZoomClick(Sender: TObject);
135 procedure GotoTop1Click(Sender: TObject);
136 procedure GotoBottom1Click(Sender: TObject);
137 procedure FreezeText1Click(Sender: TObject);
138 procedure UnfreezeText1Click(Sender: TObject);
139 procedure chkZoomClick(Sender: TObject);
140 procedure chtChartUndoZoom(Sender: TObject);
141 procedure popCopyClick(Sender: TObject);
142 procedure popChartPopup(Sender: TObject);
143 procedure popValuesClick(Sender: TObject);
144 procedure pop3DClick(Sender: TObject);
145 procedure popZoomClick(Sender: TObject);
146 procedure popZoomBackClick(Sender: TObject);
147 procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
148 Shift: TShiftState; X, Y: Integer);
149 procedure chtChartClickSeries(Sender: TCustomChart;
150 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
151 Shift: TShiftState; X, Y: Integer);
152 procedure chtChartClickLegend(Sender: TCustomChart;
153 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
154 procedure popDetailsClick(Sender: TObject);
155 procedure popPrintClick(Sender: TObject);
156 procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
157 procedure Timer1Timer(Sender: TObject);
158 procedure TabControl1Change(Sender: TObject);
159 procedure WebBrowser1DocumentComplete(Sender: TObject;
160 const pDisp: IDispatch; var URL: OleVariant);
161 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
162 Shift: TShiftState);
163 procedure UpdateRemoteStatus(aSiteID, aStatus: string);
164 procedure lblDateEnter(Sender: TObject);
165 procedure LoadTreeView;
166 procedure LoadListView(aReportData: TStringList);
167 procedure tvReportsClick(Sender: TObject);
168 procedure lstQualifierClick(Sender: TObject);
169 procedure tvReportsKeyDown(Sender: TObject; var Key: Word;
170 Shift: TShiftState);
171 procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
172 var AllowCollapse: Boolean);
173 procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode;
174 var AllowExpansion: Boolean);
175 procedure lvReportsKeyUp(Sender: TObject; var Key: Word;
176 Shift: TShiftState);
177 procedure SelectAll1Click(Sender: TObject);
178 procedure Print1Click(Sender: TObject);
179 procedure Copy1Click(Sender: TObject);
180 procedure Copy2Click(Sender: TObject);
181 procedure Print2Click(Sender: TObject);
182 procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem;
183 Data: Integer; var Compare: Integer);
184 procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn);
185 procedure lvReportsSelectItem(Sender: TObject; Item: TListItem;
186 Selected: Boolean);
187 procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
188 var Accept: Boolean);
189 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
190 var Accept: Boolean);
191 procedure SelectAll2Click(Sender: TObject);
192 procedure chkMaxFreqClick(Sender: TObject);
193 procedure PopupMenu3Popup(Sender: TObject);
194 procedure grdLabTopLeftChanged(Sender: TObject);
195 private
196 { Private declarations }
197 SortIdx1, SortIdx2, SortIdx3: Integer;
198 grdLab508Manager : TGrdLab508Manager;
199 procedure AlignList;
200 procedure HGrid(griddata: TStrings);
201 procedure VGrid(griddata: TStrings);
202 procedure FillGrid(agrid: TStringGrid; aitems: TStrings);
203 procedure GridComments(aitems: TStrings);
204 procedure FillComments(amemo: TRichEdit; aitems:TStrings);
205 procedure GetInterimGrid(adatetime: TFMDateTime; direction: integer);
206 procedure WorksheetChart(test: string; aitems: TStrings);
207 procedure GetStartStop(var start, stop: string; aitems: TStrings);
208 procedure GraphChart(test: string; aitems: TStrings);
209 procedure GraphList(griddata: TStrings);
210 procedure ProcessNotifications;
211 procedure PrintLabGraph;
212 procedure GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier, ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
213 procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
214 procedure ShowTabControl;
215 procedure HideTabControl;
216 procedure ChkBrowser;
217 procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
218 public
219 procedure ClearPtData; override;
220 function AllowContextChange(var WhyNot: string): Boolean; override;
221 procedure DisplayPage; override;
222 procedure SetFontSize(NewFontSize: Integer); override;
223 function FMToDateTime(FMDateTime: string): TDateTime;
224 procedure RequestPrint; override;
225 //procedure ExtlstReportsClick(Sender: TObject; Ext: boolean);
226
227end;
228
229var
230 frmLabs: TfrmLabs;
231 uFormat: integer;
232 uPrevReportNode: TTreeNode;
233 uDate1, uDate2: Tdatetime;
234 tmpGrid: TStringList;
235 uLabLocalReportData: TStringList; //Storage for Local report data
236 uLabRemoteReportData: TStringList; //Storage for Remote lab query
237 uUpdateStat: boolean; //flag turned on when remote status is being updated
238 uScreenSplitLoc: Integer; //location of user changed split - sptHorzRight Bar
239 uTreeStrings: TStrings;
240 uReportInstruction: String; //User Instructions
241 uColChange: string; //determines when column widths have changed
242 uQualifier: string;
243 uReportType: string;
244 uSortOrder: string;
245 uMaxOcc: string;
246 UpdatingLvReports: Boolean; //Currently updating lvReports
247 uColumns: TStringList;
248 uNewColumn: TListColumn;
249 uLocalReportData: TStringList; //Storage for Local report data
250 uRemoteReportData: TStringList; //Storage for status of Remote data
251 uQualifierType: Integer;
252 uHState: string;
253 uFirstSort: Integer;
254 uSecondSort: Integer;
255 uThirdSort: Integer;
256 ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected
257
258implementation
259
260uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers, fReportsPrint,
261 clipbrd, rReports, rGraphs, activex, mshtml, VA508AccessibilityRouter, uReports,
262 VAUtils;
263
264const
265 QT_OTHER = 0;
266 QT_MOSTRECENT = 1;
267 QT_DATERANGE = 2;
268 QT_IMAGING = 3;
269 QT_NUTR = 4;
270 QT_PROCEDURES = 19;
271 QT_SURGERY = 28;
272 QT_HSCOMPONENT = 5;
273 QT_HSWPCOMPONENT = 6;
274 CT_LABS = 9; // ID for Labs tab used by frmFrame
275 TX_NOREPORT = 'No report is currently selected.';
276 TX_NOREPORT_CAP = 'No Report Selected';
277 ZOOM_PERCENT = 99; // padding for inflating margins
278 HTML_PRE = '<html><head><style>' + CRLF +
279 'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
280 '</style></head><body><pre>';
281 HTML_POST = CRLF + '</pre></body></html>';
282
283{$R *.DFM}
284
285var
286 uFrozen: Boolean;
287 uGraphingActivated: Boolean;
288 uRemoteCount: Integer;
289 uHTMLDoc: string;
290 uReportRPC: string;
291 uHTMLPatient: ANSIstring;
292 uEmptyImageList: TImageList;
293 uRptID: String;
294 uDirect: String;
295 ColumnToSort: Integer;
296 ColumnSortForward: Boolean;
297
298procedure TfrmLabs.RequestPrint;
299var
300 aID : integer;
301begin
302 aID := 0;
303 if CharAt(uRPTID,2) =':' then
304 aID := strToInt(piece(uRPTID,':',1));
305 if (aID = 0) and (CharAt(uRPTID,3) =':') then
306 aID := StrToInt(piece(uRptID,':',1));
307 if uReportType = 'M' then
308 begin
309 InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
310 Exit;
311 end;
312 if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then
313 begin
314 if lvReports.Items.Count < 1 then
315 begin
316 InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK);
317 Exit;
318 end;
319 if lvReports.SelCount < 1 then
320 begin
321 InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK);
322 Exit;
323 end;
324 end;
325 {if (uReportType = 'G') and GraphFormActive then
326 with GraphForm do
327 begin
328 if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then
329 begin
330 InfoBox('There are no items graphed.', 'No Items to Print', MB_OK);
331 Exit;
332 end
333 else
334 begin
335 mnuPopGraphPrintClick(mnuPopGraphPrint);
336 Exit;
337 end;
338 end; }
339 if uQualifierType = QT_DATERANGE then
340 begin // = 2
341 if lstQualifier.ItemIndex < 0 then
342 begin
343 InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK);
344 end
345 else
346 PrintReports(uRptID, piece(uRemoteType,'^',4));
347 end
348 else
349 if uQualifierType = 0 then
350 begin
351 if aID = 0 then InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
352 case aID of
353 1: begin
354 InfoBox('Unable to print ''Most Recent'' report.', 'No Print Available', MB_OK);
355 end;
356 2: begin
357 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
358 end;
359 3: begin
360 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
361 end;
362 4: begin
363 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
364 end;
365 5: begin
366 InfoBox('Unable to print ''Worksheet'' report.', 'No Print Available', MB_OK);
367 end;
368 6: begin
369 if chtChart.Visible then PrintLabGraph;
370 end;
371 8: begin
372 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
373 end;
374 9: begin
375 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
376 end;
377 10: begin
378 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
379 end;
380 20: begin
381 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
382 end;
383 21: begin
384 PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN);
385 end;
386 end;
387 end
388 else
389 PrintLabs(uRptID, piece(uRemoteType,'^',4), lstDates.ItemIEN);
390end;
391
392
393procedure TfrmLabs.FormCreate(Sender: TObject);
394var
395 aList: TStrings;
396begin
397 inherited;
398 LabRowObjects := TLabRowObject.Create;
399 PageID := CT_LABS;
400 uFrozen := False;
401 aList := TStringList.Create;
402 FastAssign(rpcGetGraphSettings, aList);
403 uGraphingActivated := aList.Count > 0;
404 aList.Free;
405 uRemoteCount := 0;
406 tmpGrid := TStringList.Create;
407 uLabLocalReportData := TStringList.Create;
408 uLabRemoteReportData := TStringList.Create;
409 uColumns := TStringList.Create;
410 uTreeStrings := TStringList.Create;
411 uEmptyImageList := TImageList.Create(Self);
412 uEmptyImageList.Width := 0;
413 uLocalReportData := TStringList.Create;
414 uRemoteReportData := TStringList.Create;
415 uPrevReportNode := tvReports.Items.GetFirstNode;
416 tvReports.Selected := uPrevReportNode;
417 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
418 lblSingleTest.Caption := '';
419 lblSpecimen.Caption := '';
420 SerTest.GetHorizAxis.ExactDateTime := true;
421 SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
422 grdLab508Manager := TGrdLab508Manager.Create;
423 amgrMain.ComponentManager[grdLab] := grdLab508Manager;
424 memo1.Visible := false;
425end;
426
427procedure TfrmLabs.UpdateRemoteStatus(aSiteID, aStatus: string);
428var
429 j: integer;
430 s: string;
431 c: boolean;
432begin
433 if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame
434 uUpdateStat := true;
435 for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
436 begin
437 s := frmFrame.lstCIRNLocations.Items[j];
438 c := frmFrame.lstCIRNLocations.checked[j];
439 if piece(s, '^', 1) = aSiteID then
440 begin
441 frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
442 frmFrame.lstCIRNLocations.checked[j] := c;
443 end;
444 end;
445 uUpdateStat := false;
446end;
447
448function TfrmLabs.AllowContextChange(var WhyNot: string): Boolean;
449var
450 i: integer;
451begin
452 Result := inherited AllowContextChange(WhyNot); // sets result = true
453 if Timer1.Enabled = true then
454 case BOOLCHAR[frmFrame.CCOWContextChanging] of
455 '1': begin
456 WhyNot := 'A remote data query in progress will be aborted.';
457 Result := False;
458 end;
459 '0': if WhyNot = 'COMMIT' then
460 begin
461 with RemoteSites.SiteList do for i := 0 to Count - 1 do
462 if TRemoteSite(Items[i]).Selected then
463 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
464 begin
465 TRemoteSite(Items[i]).ReportClear;
466 TRemoteSite(Items[i]).LabQueryStatus := '-1^Aborted';
467 TabControl1.OnChange(nil);
468 end;
469 Timer1.Enabled := false;
470 Result := True;
471 end;
472 end;
473end;
474
475procedure TfrmLabs.ClearPtData;
476begin
477 inherited ClearPtData;
478 Timer1.Enabled := False;
479 memLab.Lines.Clear;
480 uLabLocalReportData.Clear;
481 uLabRemoteReportData.Clear;
482 TabControl1.Tabs.Clear;
483 HideTabControl;
484 tmpGrid.Clear;
485 lvReports.SmallImages := uEmptyImageList;
486 uLocalReportData.Clear;
487 uRemoteReportData.Clear;
488 with grdLab do
489 begin
490 RowCount := 1;
491 ColCount := 1;
492 Cells[0, 0] := '';
493 end;
494end;
495
496procedure TfrmLabs.DisplayPage;
497var
498 i: integer;
499 {OrigSelection: integer;
500 OrigDateIEN: Int64;
501 OrigDateItemID: Variant;
502 OrigReportCat: TTreeNode; }
503begin
504 inherited DisplayPage;
505 frmFrame.mnuFilePrint.Tag := CT_LABS;
506 frmFrame.mnuFilePrint.Enabled := True;
507 frmFrame.mnuFilePrintSetup.Enabled := True;
508 memLab.SelStart := 0;
509 uHTMLPatient := '<DIV align left>'
510 + '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
511 + '<TR valign="bottom" align="left">'
512 + '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
513 + '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
514 + '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
515 + '</TR></TABLE></DIV><HR>';
516 //the preferred method would be to use headers and footers
517 //so this is just an interim solution.
518 if InitPage then
519 begin
520 Splitter1.Visible := false;
521 pnlLeftBottom.Visible := false;
522 uColChange := '';
523 uMaxOcc := '';
524 LoadTreeView;
525 end;
526 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
527 begin
528 uColChange := '';
529 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
530 tvReports.Selected := tvReports.Items.GetFirstNode;
531 tvReportsClick(self);
532 end;
533 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
534 begin
535 uColChange := '';
536 lstQualifier.Clear;
537 //tvProcedures.Items.Clear;
538 //lblProcTypeMsg.Visible := FALSE;
539 lvReports.SmallImages := uEmptyImageList;
540 lvReports.Items.Clear;
541 lvReports.Columns.Clear;
542 lblTitle.Caption := '';
543 lvReports.Caption := '';
544 Splitter1.Visible := false;
545 pnlLeftBottom.Visible := false;
546 memLab.Parent := pnlRightBottom;
547 memLab.Align := alClient;
548 memLab.Clear;
549 uReportInstruction := '';
550 uLocalReportData.Clear;
551 for i := 0 to RemoteSites.SiteList.Count - 1 do
552 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
553 //pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
554 StatusText('');
555 with tvReports do
556 if Items.Count > 0 then
557 begin
558 tvReports.Selected := tvReports.Items.GetFirstNode;
559 tvReportsClick(self);
560 end;
561 end;
562 case CallingContext of
563 CC_INIT_PATIENT: if not InitPatient then
564 begin
565 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
566 tvReports.Selected := tvReports.Items.GetFirstNode;
567 tvReportsClick(self);
568 lvReports.SmallImages := uEmptyImageList;
569 lstQualifier.Clear;
570 //tvProcedures.Items.Clear;
571 //lblProcTypeMsg.Visible := FALSE;
572 lvReports.SmallImages := uEmptyImageList;
573 lvReports.Items.Clear;
574 Splitter1.Visible := false;
575 pnlLeftBottom.Visible := false;
576 with tvReports do
577 if Items.Count > 0 then
578 begin
579 tvReports.Selected := tvReports.Items.GetFirstNode;
580 tvReportsClick(self);
581 end;
582 end;
583 CC_NOTIFICATION: ProcessNotifications;
584
585 //This corrects the reload of the labs when switching back to the tab.
586 {This code was causing the processing of Lab notifications to display
587 the wrong set of labs for a given notification the 1st notification
588 after selecting/switching patients. Upon checking the problem that
589 this code was trying to solve, we found that the problem no longer
590 exists, which may be a result of subsequent changes for similar
591 issues found during development/testing of V28 (CQ 18267, 18268)
592 CC_CLICK: if not InitPatient then
593 begin
594 //Clear our local variables
595 OrigReportCat := nil;
596 OrigDateIEN := -1;
597 OrigSelection := -1;
598 OrigDateItemID := '';
599
600 //What was last selected before they switched tabs.
601 if tvReports.Selected <> nil then OrigReportCat := tvReports.Selected;
602 if lstDates.ItemIEN > 0 then OrigDateIEN := lstDates.ItemIEN;
603 if lvReports.Selected <> nil then OrigSelection := lvReports.Selected.Index;
604 if lstQualifier.ItemID <> '' then OrigDateItemID := lstQualifier.ItemID;
605
606 //Load the tree and select the last selected
607 if OrigReportCat <> nil then begin
608 tvReports.Select(OrigReportCat);
609 tvReportsClick(self);
610 end;
611
612 //Did they click on a date (lstDates box)
613 if OrigDateIEN > -1 then begin
614 lstDates.SelectByIEN(OrigDateIEN);
615 lstDatesClick(self);
616 end;
617
618 //Did they click on a date (lstQualifier)
619 if OrigDateItemID <> '' then begin
620 lstQualifier.SelectByID(OrigDateItemID);
621 lstQualifierClick(self);
622 end;
623
624 //Did they click on a lab
625 if OrigSelection > -1 then begin
626 lvReports.Selected := lvReports.Items[OrigSelection];
627 lvReportsSelectItem(self, lvReports.Selected, true);
628 end;
629 end; }
630 end;
631end;
632
633procedure TfrmLabs.SetFontSize(NewFontSize: Integer);
634begin
635 inherited SetFontSize(NewFontSize);
636 FormResize(self);
637end;
638
639procedure TfrmLabs.LoadListView(aReportData: TStringList);
640var
641 j,k,aErr: integer;
642 aTmpAray: TStringList;
643 aColCtr, aCurCol, aCurRow, aColID: integer;
644 x,y,z,c,aSite: string;
645 ListItem: TListItem;
646begin
647 aSite := '';
648 aErr := 0;
649 ListItem := nil;
650 case uQualifierType of
651 QT_HSCOMPONENT:
652 begin // = 5
653 if (length(piece(uHState,';',2)) > 0) then
654 begin
655 with lvReports do
656 begin
657 ViewStyle := vsReport;
658 for j := 0 to aReportData.Count - 1 do
659 begin
660 if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call
661 continue;
662 ListItem := Items.Add;
663 aSite := piece(aReportData[j],'^',1);
664 ListItem.Caption := piece(aSite,';',1);
665 for k := 2 to uColumns.Count do
666 begin
667 ListItem.SubItems.Add(piece(aReportData[j],'^',k));
668 end;
669 end;
670 if aReportData.Count = 0 then
671 begin
672 uReportInstruction := '<No Data Available>';
673 memLab.Lines.Clear;
674 memLab.Lines.Add(uReportInstruction);
675 end
676 else
677 memLab.Lines.Clear;
678 end;
679 end;
680 end;
681 QT_HSWPCOMPONENT:
682 begin // = 6
683 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
684 begin
685 aTmpAray := TStringList.Create;
686 aCurRow := 0;
687 aCurCol := 0;
688 aColCtr := 9;
689 aTmpAray.Clear;
690 with lvReports do
691 begin
692 for j := 0 to aReportData.Count - 1 do
693 begin
694 x := aReportData[j];
695 aColID := StrToIntDef(piece(x,'^',1),-1);
696 if aColID < 0 then //this is an error condition most likely an incompatible remote call
697 continue;
698 if aColID > (uColumns.Count - 1) then
699 begin
700 aErr := 1;
701 continue; //extract is out of sync with columns defined in 101.24
702 end;
703 if aColID < aColCtr then
704 begin
705 if aTmpAray.Count > 0 then
706 begin
707 if aColCtr = 1 then
708 begin
709 ListItem := Items.Add;
710 aSite := piece(aTmpAray[j],'^',1);
711 ListItem.Caption := piece(aSite,';',1);
712 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
713 end
714 else
715 begin
716 c := aTmpAray[0];
717 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
718 c := c + '...';
719 z := piece(c,'^',1);
720 y := copy(c, (pos('^', c)), 9999);
721 if pos('^',y) > 0 then
722 begin
723 while pos('^',y) > 0 do
724 begin
725 y := copy(y, (pos('^', y)+1), 9999);
726 z := z + '^' + y;
727 end;
728 ListItem.SubItems.Add(z);
729 end
730 else
731 begin
732 ListItem.SubItems.Add(y);
733 end;
734 end;
735 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
736 aTmpAray.Clear;
737 end;
738 aColCtr := 0;
739 aCurCol := aColID;
740 aCurRow := aCurRow + 1;
741 end
742 else
743 if aColID = aCurCol then
744 begin
745 z := '';
746 y := piece(x,'^',2);
747 if length(y) > 0 then z := y;
748 y := copy(x, (pos('^', x)+1), 9999);
749 if pos('^',y) > 0 then
750 begin
751 while pos('^',y) > 0 do
752 begin
753 y := copy(y, (pos('^', y)+1), 9999);
754 z := z + '^' + y;
755 end;
756 aTmpAray.Add(z);
757 end
758 else
759 begin
760 aTmpAray.Add(y);
761 end;
762 continue;
763 end;
764 if aTmpAray.Count > 0 then
765 begin
766 if aColCtr = 1 then
767 begin
768 ListItem := Items.Add;
769 aSite := piece(aTmpAray[0],'^',1);
770 ListItem.Caption := piece(aSite,';',1);
771 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
772 end
773 else
774 begin
775 c := aTmpAray[0];
776 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
777 c := c + '...';
778 ListItem.SubItems.Add(c);
779 end;
780 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
781 aTmpAray.Clear;
782 end;
783 aCurCol := aColID;
784 Inc(aColCtr);
785 y := '';
786 for k := 2 to 10 do
787 if length(piece(x,'^',k)) > 0 then
788 begin
789 if length(y) > 0 then y := y + '^' + piece(x,'^',k)
790 else y := y + piece(x,'^',k);
791 end;
792 aTmpAray.Add(y);
793 if aColCtr > 0 then
794 while aColCtr < aCurCol do
795 begin
796 ListItem.SubItems.Add('');
797 Inc(aColCtr);
798 end;
799 end;
800 if aTmpAray.Count > 0 then
801 begin
802 if aColCtr = 1 then
803 begin
804 ListItem := Items.Add;
805 aSite := piece(aTmpAray[0],'^',1);
806 ListItem.Caption := piece(aSite,';',1);
807 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
808 end
809 else
810 begin
811 c := aTmpAray[0];
812 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
813 c := c + '...';
814 ListItem.SubItems.Add(c);
815 end;
816 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
817 aTmpAray.Clear;
818 end;
819 end;
820 aTmpAray.Free;
821 end;
822 end;
823 end;
824 if aErr = 1 then
825 if User.HasKey('XUPROGMODE') then
826 ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
827end;
828
829procedure TfrmLabs.DisplayHeading(aRanges: string);
830var
831 x,x1,x2,y,z,DaysBack: string;
832 d1,d2: TFMDateTime;
833begin
834 with lblTitle do
835 begin
836 x := '';
837 if tvReports.Selected = nil then
838 tvReports.Selected := tvReports.Items.GetFirstNode;
839 if tvReports.Selected.Parent <> nil then
840 x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text
841 else
842 x := tvReports.Selected.Text;
843 x1 := '';
844 x2 := '';
845 if (uReportType <> 'M') and (not(uRptID = '1:MOST RECENT')) then
846 begin
847 if CharAt(aRanges, 1) = 'd' then
848 begin
849 if length(piece(aRanges,';',2)) > 0 then
850 begin
851 x2 := ' Max/site:' + piece(aRanges,';',2);
852 aRanges := piece(aRanges,';',1);
853 end;
854 DaysBack := Copy(aRanges, 2, Length(aRanges));
855 if DaysBack = '' then DaysBack := '7';
856 if DaysBack = '0' then
857 aRanges := 'T' + ';T'
858 else
859 if Copy(aRanges, 2, 1) = 'T' then
860 aRanges := DaysBack + ';T'
861 else
862 aRanges := 'T-' + DaysBack + ';T';
863 end;
864 if length(piece(aRanges,';',1)) > 0 then
865 begin
866 d1 := ValidDateTimeStr(piece(aRanges,';',1),'');
867 d2 := ValidDateTimeStr(piece(aRanges,';',2),'');
868 y := FormatFMDateTime('mmm dd,yyyy',d1);
869 if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
870 z := FormatFMDateTime('mmm dd,yyyy',d2);
871 x1 := ' [From: ' + y + ' to ' + z + ']';
872 end;
873 if length(piece(aRanges,';',3)) > 0 then
874 x2 := ' Max/site:' + piece(aRanges,';',3);
875 case uQualifierType of
876 QT_DATERANGE:
877 x := x + x1;
878 QT_HSCOMPONENT:
879 x := x + x1 + x2;
880 QT_HSWPCOMPONENT:
881 x := x + x1 + x2;
882 QT_IMAGING:
883 x := x + x1 + x2;
884 0:
885 x := x + x1;
886 end;
887 end;
888 if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DATA INCLUDED IN REPORT>>';
889 Caption := x;
890 end;
891 lvReports.Caption := x;
892end;
893
894procedure TfrmLabs.AlignList;
895begin
896 lblReports.Top := 0;
897 lstDates.Height := pnlLeft.Height div 3 - (lblDates.Height div 2);
898 lstDates.Top := pnlLeft.Height - lstDates.Height;
899 lblDates.Top := lstDates.Top - lblDates.Height;
900 lstQualifier.Height := pnlLeft.Height div 3 - (lblQualifier.Height div 2);
901 lstQualifier.Top := pnlLeft.Height - lstQualifier.Height;
902 lblQualifier.Top := lstQualifier.Top - lblQualifier.Height;
903 pnlOtherTests.Top := lblDates.Top - pnlOtherTests.Height;
904 lstHeaders.Height := pnlLeft.Height div 3 - (lblHeaders.Height * 3);
905 lstHeaders.Top := lblDates.Top - lstHeaders.Height;
906 lblHeaders.Top := lstHeaders.Top - lblHeaders.Height;
907 lstDates.Repaint;
908 lstHeaders.Repaint;
909 lstQualifier.Repaint;
910end;
911
912procedure TfrmLabs.LoadTreeView;
913var
914 i: integer;
915 currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
916 x: string;
917 addchild, addgrandchild, addgtgrandchild: boolean;
918begin
919 tvReports.Items.Clear;
920 memLab.Clear;
921 uHTMLDoc := '';
922 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
923 //tvProcedures.Items.Clear;
924 //lblProcTypeMsg.Visible := FALSE;
925 lvReports.SmallImages := uEmptyImageList;
926 lvReports.Items.Clear;
927 uTreeStrings.Clear;
928 //lblTitle.Caption := '';
929 lvReports.Caption := '';
930 ListLabReports(uTreeStrings);
931 addchild := false;
932 addgrandchild := false;
933 addgtgrandchild := false;
934 parentNode := nil;
935 grandParentNode := nil;
936 gtGrandParentNode := nil;
937 currentNode := nil;
938 for i := 0 to uTreeStrings.Count - 1 do
939 begin
940 x := uTreeStrings[i];
941 if UpperCase(Piece(x,'^',1))='[PARENT END]' then
942 begin
943 if addgtgrandchild = true then
944 begin
945 currentNode := gtgrandParentNode;
946 addgtgrandchild := false;
947 end
948 else
949 if addgrandchild = true then
950 begin
951 currentNode := grandParentNode;
952 addgrandchild := false;
953 end
954 else
955 begin
956 currentNode := parentNode;
957 addchild := false;
958 end;
959 continue;
960 end;
961 if UpperCase(Piece(x,'^',1))='[PARENT START]' then
962 begin
963 if addgtgrandchild = true then
964 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
965 else
966 if addgrandchild = true then
967 begin
968 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
969 addgtgrandchild := true;
970 gtgrandParentNode := currentNode;
971 end
972 else
973 if addchild = true then
974 begin
975 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
976 addgrandchild := true;
977 grandParentNode := currentNode;
978 end
979 else
980 begin
981 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
982 parentNode := currentNode;
983 addchild := true;
984 end;
985 end
986 else
987 if addchild = false then
988 begin
989 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x));
990 parentNode := currentNode;
991 end
992 else
993 begin
994 if addgtgrandchild = true then
995 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
996 else
997 if addgrandchild = true then
998 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
999 else
1000 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x));
1001 end;
1002 end;
1003 if tvReports.Items.Count > 0 then begin
1004 tvReports.Selected := tvReports.Items.GetFirstNode;
1005 tvReportsClick(self);
1006 end;
1007end;
1008
1009{procedure TfrmLabs.lstReportsClick(Sender: TObject);
1010begin
1011 ExtlstReportsClick(Sender, false);
1012end; }
1013
1014{procedure TfrmLabs.ExtlstReportsClick(Sender: TObject; Ext: boolean);
1015var
1016 i,iCat: integer;
1017 Rpt: string;
1018begin
1019 inherited;
1020 uRemoteCount := 0;
1021 Timer1.Enabled := False;
1022 Rpt := lstReports.Items[lstReports.ItemIndex];
1023 uReportType := Piece(Rpt,'^',4);
1024 uReportRPC := UpperCase(Piece(Rpt,'^',6));
1025 if length(Piece(Rpt,'^',5)) > 0 then
1026 iCat := StrToInt(Piece(Rpt,'^',5))
1027 else
1028 iCat := 0;
1029 if uReportType = '' then uReportType := 'R';
1030 StatusText('');
1031 uLabLocalReportData.Clear;
1032 uLabRemoteReportData.Clear;
1033 lstHeaders.Clear;
1034 TabControl1.Visible := false;
1035 if Piece(Rpt,'^',3) = '1' then
1036 if TabControl1.Tabs.Count > 1 then
1037 TabControl1.Visible := true;
1038 for i := 0 to RemoteSites.SiteList.Count - 1 do
1039 TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
1040 if uFrozen = True then memo1.visible := False;
1041 case lstReports.ItemIEN of
1042 1: begin // Most Recent
1043 CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false);
1044 pnlButtons.Visible := true;
1045 pnlWorksheet.Visible := false;
1046 pnlGraph.Visible := false;
1047 memLab.Align := alBottom;
1048 memLab.Height := pnlLeft.Height div 5;
1049 grdLab.Align := alClient;
1050 memLab.Clear;
1051 //if uReportType = 'H' then **Browser Remove**
1052 //begin
1053 //WebBrowser1.Navigate('about:blank');
1054 //WebBrowser1.Align := alBottom;
1055 //WebBrowser1.Height := pnlLeft.Height div 5;
1056 //WebBrowser1.Visible := true;
1057 //WebBrowser1.BringToFront;
1058 //memLab.Visible := false;
1059 //end
1060 //else
1061 //begin
1062 //WebBrowser1.Visible := false;
1063 //WebBrowser1.SendToBack;
1064 //memLab.Visible := true;
1065 //memLab.BringToFront;
1066 //end;
1067 FormResize(self);
1068 cmdRecentClick(self);
1069 uPrevReportIndex := lstReports.ItemIndex;
1070 end;
1071 4: begin // Interim for Selected Tests
1072 if uPrevReportIndex <> lstReports.ItemIndex then
1073 begin
1074 lstTests.Clear;
1075 lblSpecimen.Caption := '';
1076 end;
1077 if not Ext then SelectTests(Font.Size);
1078 if lstTests.Items.Count > 0 then
1079 begin
1080 CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false);
1081 memLab.Clear;
1082 chkBrowser;
1083 FormResize(self);
1084 RedrawActivate(memLab.Handle);
1085 lstDatesClick(self);
1086 //lstQualifierClick(self);
1087 if not Ext then cmdOtherTests.SetFocus;
1088 cmdOtherTests.Default := true;
1089 end
1090 else lstReports.ItemIndex := uPrevReportIndex;
1091 end;
1092 5: begin // Worksheet
1093 if uPrevReportIndex <> lstReports.ItemIndex then
1094 begin
1095 lstTests.Clear;
1096 lblSpecimen.Caption := '';
1097 end;
1098 if not Ext then SelectTestGroups(Font.Size);
1099 if lstTests.Items.Count > 0 then
1100 begin
1101 CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false);
1102 chtChart.Visible := true;
1103 memLab.Visible := false;
1104 pnlButtons.Visible := false;
1105 pnlWorksheet.Visible := true;
1106 pnlGraph.Visible := false;
1107 lstTestGraph.Width := 97;
1108 ragCorG.ItemIndex := 0;
1109 FormResize(self);
1110 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
1111 //chkZoom.Checked := false;
1112 //chkZoomClick(self);
1113 //lstDatesClick(self);
1114 lstQualifierClick(self);
1115 if not Ext then cmdOtherTests.SetFocus;
1116 cmdOtherTests.Default := true;
1117 end
1118 else lstReports.ItemIndex := uPrevReportIndex;
1119 end;
1120 6: begin // Graph
1121 // do if graphing is activiated
1122 if uGraphingActivated then
1123 begin
1124 memLab.Clear;
1125 chkBrowser;
1126 FormResize(self);
1127 memLab.Align := alClient;
1128 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
1129 RedrawActivate(memLab.Handle);
1130 StatusText('');
1131 memLab.Lines.Insert(0, ' ');
1132 memLab.Lines.Insert(1, 'Graphing activated');
1133 memLab.SelStart := 0;
1134 frmFrame.mnuToolsGraphingClick(self); // make it just lab tests ??
1135 //lstReports.ItemIndex := uPrevReportIndex;
1136 end
1137 else // otherwise, do lab graph
1138 begin
1139 if uPrevReportIndex <> lstReports.ItemIndex then
1140 begin
1141 lblSingleTest.Caption := '';
1142 lblSpecimen.Caption := '';
1143 end;
1144 if not Ext then SelectTest(Font.Size);
1145 if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
1146 begin
1147 CommonComponentVisible(false,false,true,true,true,true,false,false,true,false,false,false);
1148 pnlChart.Visible := true;
1149 chtChart.Visible := true;
1150 pnlButtons.Visible := false;
1151 pnlWorksheet.Visible := false;
1152 pnlGraph.Visible := true;
1153 memLab.Height := pnlRight.Height div 5;
1154 memLab.Clear;
1155 //if uReportType = 'H' then **Browser Remove**
1156 //begin
1157 //WebBrowser1.Visible := true;
1158 //WebBrowser1.Navigate('about:blank');
1159 //WebBrowser1.Height := pnlRight.Height div 5;
1160 //WebBrowser1.BringToFront;
1161 //memLab.Visible := false;
1162 //end
1163 //else
1164 //begin
1165 //WebBrowser1.Visible := false;
1166 //WebBrowser1.SendToBack;
1167 //memLab.Visible := true;
1168 //memLab.BringToFront;
1169 //end;
1170 lstTestGraph.Items.Clear;
1171 lstTestGraph.Width := 0;
1172 FormResize(self);
1173 RedrawActivate(memLab.Handle);
1174 lblFooter.Caption := '';
1175 chkGraphZoom.Checked := false;
1176 chkGraphZoomClick(self);
1177 chkGraph3DClick(self);
1178 chkGraphValuesClick(self);
1179 //lstDatesClick(self);
1180 lstQualifierClick(self);
1181 if not Ext then cmdOtherTests.SetFocus;
1182 cmdOtherTests.Default := true;
1183 end
1184 else
1185 lstReports.ItemIndex := uPrevReportIndex;
1186 end;
1187 end
1188 else // case
1189 begin
1190 //added to deal with other reports from file 101.24
1191 memLab.Clear;
1192 chkBrowser;
1193 FormResize(self);
1194 memLab.Align := alClient;
1195 case iCat of
1196 //Categories of reports:
1197 //0:Fixed
1198 //1:Fixed w/Dates
1199 //2:Fixed w/Headers
1200 //3:Fixed w/Dates & Headers
1201 //4:Specialized
1202 //5:Graphic
1203
1204 0: begin
1205 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
1206 StatusText('Retrieving data...');
1207 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
1208 TabControl1.OnChange(nil);
1209 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
1210 if TabControl1.TabIndex < 1 then
1211 QuickCopy(uLabLocalReportData,memLab);
1212 RedrawActivate(memLab.Handle);
1213 StatusText('');
1214 memLab.Lines.Insert(0,' ');
1215 memLab.Lines.Delete(0);
1216 memLab.SelStart := 0;
1217 if uReportType = 'R' then
1218 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1219 else
1220 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1221 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
1222 end;
1223 1: begin
1224 CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false);
1225 memLab.Repaint;
1226 //lstDatesClick(self);
1227 lstQualifierClick(self);
1228 end;
1229 2: begin
1230 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
1231 lstHeaders.Clear;
1232 StatusText('Retrieving data...');
1233 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
1234 TabControl1.OnChange(nil);
1235 Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
1236 if uLabLocalReportData.Count > 0 then
1237 begin
1238 TabControl1.OnChange(nil);
1239 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1240 end;
1241 RedrawActivate(memLab.Handle);
1242 StatusText('');
1243 memLab.Lines.Insert(0,' ');
1244 memLab.Lines.Delete(0);
1245 if uReportType = 'R' then
1246 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1247 else
1248 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1249 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
1250 end;
1251 3: begin
1252 CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false);
1253 //lstDatesClick(self);
1254 lstQualifierClick(self);
1255 memLab.Lines.Insert(0,' ');
1256 memLab.Lines.Delete(0);
1257 end;
1258 end;
1259 end;
1260 end;
1261 uPrevReportIndex := lstReports.ItemIndex;
1262 DisplayHeading('');
1263end; }
1264
1265procedure TfrmLabs.lstHeadersClick(Sender: TObject);
1266var
1267 Current, Desired: integer;
1268begin
1269 inherited;
1270 if uFrozen = True then memo1.visible := False;
1271 Current := SendMessage(memLab.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1272 Desired := lstHeaders.ItemIEN;
1273 SendMessage(memLab.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
1274end;
1275
1276procedure TfrmLabs.lstQualifierClick(Sender: TObject);
1277 var
1278 MoreID: String; //Restores MaxOcc value
1279 aRemote, aHDR, aFHIE, aMax: string;
1280 i: integer;
1281 tmpList: TStringList;
1282 daysback: integer;
1283 date1, date2: TFMDateTime;
1284 today: TDateTime;
1285begin
1286 inherited;
1287 if uFrozen = True then
1288 begin
1289 memo1.visible := False;
1290 memo1.TabStop := False;
1291 end;
1292 if (lstDates.ItemID = 'S') then
1293 begin
1294 with calLabRange do
1295 begin
1296 if Execute then
1297 if Length(TextOfStart) > 0 then
1298 if Length(TextOfStop) > 0 then
1299 begin
1300 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
1301 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1302 DisplayHeading('');
1303 end
1304 else
1305 lstDates.ItemIndex := -1
1306 else
1307 lstDates.ItemIndex := -1
1308 else
1309 lstDates.ItemIndex := -1;
1310 end;
1311 end;
1312 today := FMToDateTime(floattostr(FMToday));
1313 if lstDates.ItemIEN > 0 then
1314 begin
1315 daysback := lstDates.ItemIEN;
1316 date1 := FMToday;
1317 If daysback = 1 then
1318 date2 := DateTimeToFMDateTime(today)
1319 Else
1320 date2 := DateTimeToFMDateTime(today - daysback);
1321 end
1322 else
1323 BeginEndDates(date1,date2,daysback);
1324 date1 := date1 + 0.2359;
1325 MoreID := ';' + Piece(uQualifier,';',3);
1326 if chkMaxFreq.checked = true then
1327 begin
1328 MoreID := '';
1329 SetPiece(uQualifier,';',3,'');
1330 end;
1331 aMax := piece(uQualifier,';',3);
1332 if (CharAt(lstQualifier.ItemID,1) = 'd')
1333 and (length(aMax)>0)
1334 and (StrToInt(aMax)<101) then
1335 MoreID := ';101';
1336 aRemote := piece(uRemoteType,'^',1);
1337 aHDR := piece(uRemoteType,'^',7);
1338 aFHIE := piece(uRemoteType,'^',8);
1339 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1340 //tvProcedures.Items.Clear;
1341 //lblProcTypeMsg.Visible := FALSE;
1342 uHTMLDoc := '';
1343 {if uReportType = 'H' then **Browser Remove**
1344 begin
1345 WebBrowser1.Visible := true;
1346 WebBrowser1.TabStop := true;
1347 WebBrowser1.Navigate('about:blank');
1348 WebBrowser1.BringToFront;
1349 memLab.Visible := false;
1350 memLab.TabStop := false;
1351 end
1352 else
1353 begin
1354 WebBrowser1.Visible := false;
1355 WebBrowser1.TabStop := false; }
1356 memLab.Visible := true;
1357 memLab.TabStop := true;
1358 memLab.BringToFront;
1359 RedrawActivate(memLab.Handle);
1360 //end; }
1361 uLocalReportData.Clear;
1362 uRemoteReportData.Clear;
1363 for i := 0 to RemoteSites.SiteList.Count - 1 do
1364 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
1365 uRemoteCount := 0;
1366 if aHDR = '1' then
1367 DisplayHeading(lstQualifier.ItemID)
1368 else
1369 DisplayHeading(lstQualifier.ItemID + MoreID);
1370 if lstQualifier.ItemID = 'ds' then
1371 begin
1372 with calLabRange do
1373 if Not (Execute) then
1374 begin
1375 lstQualifier.ItemIndex := -1;
1376 Exit;
1377 end
1378 else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1379 begin
1380 if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1381 if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then
1382 begin
1383 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1384 + ' for this report.', 'No Report Generated',MB_OK);
1385 lstQualifier.ItemIndex := -1;
1386 exit;
1387 end;
1388 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1389 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1390 DisplayHeading(lstQualifier.ItemID + MoreID);
1391 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1392 end
1393 else
1394 begin
1395 lstQualifier.ItemIndex := -1;
1396 InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK);
1397 if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1398 begin
1399 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1400 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1401 DisplayHeading(lstQualifier.ItemID + MoreID);
1402 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1403 end
1404 else
1405 begin
1406 lstQualifier.ItemIndex := -1;
1407 InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK);
1408 exit;
1409 end;
1410 end;
1411 end;
1412 if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1413 if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then
1414 begin
1415 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1416 + ' for this report.', 'No Report Generated',MB_OK);
1417 lstQualifier.ItemIndex := -1;
1418 exit;
1419 end;
1420 Screen.Cursor := crHourGlass;
1421 uReportInstruction := #13#10 + 'Retrieving data...';
1422 memLab.Lines.Add(uReportInstruction);
1423 {if WebBrowser1.Visible = true then **Browser Remove**
1424 begin
1425 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
1426 WebBrowser1.Navigate('about:blank');
1427 end; }
1428 case uQualifierType of
1429 QT_HSCOMPONENT:
1430 begin // = 5
1431 lvReports.SmallImages := uEmptyImageList;
1432 lvReports.Items.Clear;
1433 memLab.Lines.Clear;
1434 LabRowObjects.Clear;
1435 if ((aRemote = '1') or (aRemote = '2')) then
1436 GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1437 if not(piece(uRemoteType, '^', 9) = '1') then
1438 if (length(piece(uHState,';',2)) > 0) then
1439 begin
1440 if not(aRemote = '2') then
1441 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1442 LoadListView(uLocalReportData);
1443 end
1444 else
1445 begin
1446 if ((aRemote = '1') or (aRemote = '2')) then
1447 ShowTabControl;
1448 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1449 if uLocalReportData.Count < 1 then
1450 begin
1451 uReportInstruction := '<No Report Available>';
1452 memLab.Lines.Add(uReportInstruction);
1453 end
1454 else
1455 begin
1456 QuickCopy(uLocalReportData,memLab);
1457 TabControl1.OnChange(nil);
1458 end;
1459 end;
1460 end;
1461 QT_HSWPCOMPONENT:
1462 begin // = 6
1463 lvReports.SmallImages := uEmptyImageList;
1464 lvReports.Items.Clear;
1465 LabRowObjects.Clear;
1466 memLab.Lines.Clear;
1467 if ((aRemote = '1') or (aRemote = '2')) then
1468 begin
1469 Screen.Cursor := crDefault;
1470 GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1471 end;
1472 if not(piece(uRemoteType, '^', 9) = '1') then
1473 if (length(piece(uHState,';',2)) > 0) then
1474 begin
1475 if not(aRemote = '2') then
1476 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1477 LoadListView(uLocalReportData);
1478 end
1479 else
1480 begin
1481 {if ((aRemote = '1') or (aRemote = '2')) then
1482 ShowTabControl;}
1483 if not (aRemote = '2') then
1484 begin
1485 LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1486 if uLocalReportData.Count < 1 then
1487 begin
1488 uReportInstruction := '<No Report Available>';
1489 memLab.Lines.Add(uReportInstruction);
1490 end
1491 else
1492 QuickCopy(uLocalReportData,memLab);
1493 end;
1494 end;
1495 end
1496 else
1497 begin
1498 Screen.Cursor := crDefault;
1499 //GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1500//**************************************************************************
1501case StrToInt(Piece(uRptID,':',1)) of
1502 21: begin // Cumulative
1503 lstHeaders.Clear;
1504 memLab.Clear;
1505 uLabLocalReportData.Clear;
1506 uLabRemoteReportData.Clear;
1507 StatusText('Retrieving data for cumulative report...');
1508 GoRemoteOld(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1509 TabControl1.OnChange(nil);
1510 Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
1511 if uLabLocalReportData.Count > 0 then
1512 begin
1513 TabControl1.OnChange(nil);
1514 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1515 end;
1516 memLab.Lines.Insert(0,' ');
1517 memLab.Lines.Delete(0);
1518 end;
1519 3: begin // Interim
1520 memLab.Clear;
1521 uLabLocalReportData.Clear;
1522 uLabRemoteReportData.Clear;
1523 StatusText('Retrieving data for interim report...');
1524 GoRemoteOld(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
1525 TabControl1.OnChange(nil);
1526 Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1527 if uLabLocalReportData.Count < 1 then
1528 uLabLocalReportData.Add('<No results for this date range.>');
1529 if TabControl1.TabIndex < 1 then
1530 QuickCopy(uLabLocalReportData,memLab);
1531 memLab.Lines.Insert(0,' ');
1532 memLab.Lines.Delete(0);
1533 memLab.SelStart := 0;
1534 end;
1535 4: begin // Interim for Selected Tests
1536 memLab.Clear;
1537 uLabLocalReportData.Clear;
1538 uLabRemoteReportData.Clear;
1539 try
1540 StatusText('Retrieving data for selected tests...');
1541 FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData);
1542 if uLabLocalReportData.Count > 0 then
1543 QuickCopy(uLabLocalReportData,memLab)
1544 else
1545 memLab.Lines.Add('<No results for selected tests in this date range.>');
1546 memLab.SelStart := 0;
1547 finally
1548 //tmpList.Free;
1549 end;
1550 end;
1551 5: begin // Worksheet
1552 chtChart.BottomAxis.Automatic := true;
1553 chkZoom.Checked := false;
1554 //chkZoomClick(self);
1555 chkAbnormals.Checked := false;
1556 memLab.Clear;
1557 uLabLocalReportData.Clear;
1558 uLabRemoteReportData.Clear;
1559 grdLab.Align := alClient;
1560 StatusText('Retrieving data for worksheet...');
1561 FastAssign(Worksheet(Patient.DFN, date1, date2,
1562 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid);
1563 if ragHorV.ItemIndex = 0 then
1564 HGrid(tmpGrid)
1565 else
1566 VGrid(tmpGrid);
1567 GraphList(tmpGrid);
1568 GridComments(tmpGrid);
1569 ragCorGClick(self);
1570 end;
1571 6: begin // Graph
1572 if not uGraphingActivated then
1573 begin
1574 chtChart.BottomAxis.Automatic := true;
1575 chkGraphZoom.Checked := false;
1576 chkGraphZoomClick(self);
1577 memLab.Clear;
1578 uLabLocalReportData.Clear;
1579 uLabRemoteReportData.Clear;
1580 tmpList := TStringList.Create;
1581 try
1582 StatusText('Retrieving data for graph...');
1583 FastAssign(GetChart(Patient.DFN, date1, date2,
1584 Piece(lblSpecimen.Caption, '^', 1),
1585 Piece(lblSingleTest.Caption, '^', 1)), tmpList);
1586 if tmpList.Count > 1 then
1587 begin
1588 chtChart.Visible := true;
1589 GraphChart(lblSingleTest.Caption, tmpList);
1590 chtChart.ZoomPercent(ZOOM_PERCENT);
1591 for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
1592 do memLab.Lines.Add(tmpList[i]);
1593 if memLab.Lines.Count < 2 then
1594 memLab.Lines.Add('<No comments on specimens.>');
1595 memLab.SelStart := 0;
1596 lblGraph.Visible := false;
1597 end
1598 else
1599 begin
1600 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
1601 lblGraph.Top := 2;
1602 lblGraph.Visible := true;
1603 if Piece(lblSpecimen.Caption, '^', 1) = '0' then
1604 pnlChart.Caption := '<No results can be graphed for ' +
1605 Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.> '
1606 + 'Results may be available, but cannot be graphed. Please try an alternate view.'
1607 else
1608 pnlChart.Caption := '<No results can be graphed for ' +
1609 Piece(lblSingleTest.Caption, '^', 2)
1610 + ' (' + Piece(lblSpecimen.Caption, '^', 2) +
1611 ') in this date range.> '
1612 + 'Results may be available, but cannot be graphed. Please try an alternate view.';
1613 chtChart.Visible := false;
1614 end;
1615 finally
1616 tmpList.Free;
1617 end;
1618 end;
1619 end;
1620 9: begin // Micro
1621 memLab.Clear;
1622 uLabLocalReportData.Clear;
1623 uLabRemoteReportData.Clear;
1624 StatusText('Retrieving microbiology data...');
1625 GoRemoteOld(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
1626 TabControl1.OnChange(nil);
1627 Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1628 if uLabLocalReportData.Count < 1 then
1629 uLabLocalReportData.Add('<No microbiology results for this date range.>');
1630 if TabControl1.TabIndex < 1 then
1631 QuickCopy(uLabLocalReportData,memLab);
1632 memLab.Lines.Insert(0,' ');
1633 memLab.Lines.Delete(0);
1634 memLab.SelStart := 0;
1635 end;
1636 10: begin // Lab Status
1637 memLab.Clear;
1638 uLabLocalReportData.Clear;
1639 uLabRemoteReportData.Clear;
1640 StatusText('Retrieving lab status data...');
1641 GoRemoteOld(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1642 TabControl1.OnChange(nil);
1643 Reports(uLabLocalReportData,Patient.DFN, 'L:' + '9', '', IntToStr(daysback),'',
1644 date1, date2, uReportRPC);
1645 if uLabLocalReportData.Count < 1 then
1646 uLabLocalReportData.Add('<No laboratory orders for this date range.>');
1647 if TabControl1.TabIndex < 1 then
1648 QuickCopy(uLabLocalReportData,memLab);
1649 memLab.Lines.Insert(0,' ');
1650 memLab.Lines.Delete(0);
1651 memLab.SelStart := 0;
1652 end;
1653 else begin //Anything Else
1654 lstHeaders.Clear;
1655 memLab.Clear;
1656 uLabLocalReportData.Clear;
1657 uLabRemoteReportData.Clear;
1658 StatusText('Retrieving lab data...');
1659 GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1660 //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1661 TabControl1.OnChange(nil);
1662 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '',
1663 IntToStr(daysback), '', date1, date2, uReportRPC);
1664 if uLabLocalReportData.Count < 1 then
1665 uLabLocalReportData.Add('<No data for this date range.>');
1666 if TabControl1.TabIndex < 1 then
1667 QuickCopy(uLabLocalReportData,memLab);
1668 memLab.Lines.Insert(0,' ');
1669 memLab.Lines.Delete(0);
1670 memLab.SelStart := 0;
1671 end;
1672 end;
1673//**************************************************************************
1674 {LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1675 if TabControl1.TabIndex < 1 then
1676 QuickCopy(uLocalReportData,memLab); }
1677 end;
1678 end;
1679 Screen.Cursor := crDefault;
1680 StatusText('');
1681 memLab.Lines.Insert(0,' ');
1682 memLab.Lines.Delete(0);
1683 {if WebBrowser1.Visible = true then **Browser Remove**
1684 begin
1685 if uReportType = 'R' then
1686 uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
1687 else
1688 uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
1689 WebBrowser1.Navigate('about:blank');
1690 end;
1691 }
1692end;
1693
1694procedure TfrmLabs.lblDateEnter(Sender: TObject);
1695begin
1696 inherited;
1697 amgrMain.AccessText[lblDate] := 'Date Collected '+lblDate.Caption;
1698end;
1699
1700procedure TfrmLabs.lstDatesClick(Sender: TObject);
1701var
1702 tmpList: TStringList;
1703 daysback: integer;
1704 date1, date2: TFMDateTime;
1705 today: TDateTime;
1706 i: integer;
1707 x,x1,x2,aID: string;
1708begin
1709 inherited;
1710 uRemoteCount := 0;
1711 if uFrozen = True then memo1.visible := False;
1712 Screen.Cursor := crHourGlass;
1713 DisplayHeading('');
1714 uHTMLDoc := '';
1715 //Rpt := lstReports.Items[lstReports.ItemIndex];
1716 //uReportRPC := UpperCase(Piece(Rpt,'^',6));
1717 chkBrowser;
1718 if (lstDates.ItemID = 'S') then
1719 begin
1720 with calLabRange do
1721 begin
1722 if Execute then
1723 if Length(TextOfStart) > 0 then
1724 if Length(TextOfStop) > 0 then
1725 begin
1726 lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
1727 RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1728 DisplayHeading('');
1729 end
1730 else
1731 lstDates.ItemIndex := -1
1732 else
1733 lstDates.ItemIndex := -1
1734 else
1735 lstDates.ItemIndex := -1;
1736 end;
1737 end;
1738 today := FMToDateTime(floattostr(FMToday));
1739 if lstDates.ItemIEN > 0 then
1740 begin
1741 daysback := lstDates.ItemIEN;
1742 date1 := FMToday;
1743 If daysback = 1 then
1744 date2 := DateTimeToFMDateTime(today)
1745 Else
1746 date2 := DateTimeToFMDateTime(today - daysback);
1747 end
1748 else
1749 BeginEndDates(date1,date2,daysback);
1750 date1 := date1 + 0.2359;
1751 uHTMLDoc := '';
1752 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
1753 aID := piece(uRptID,':',1);
1754 if aID = '21' then
1755 begin // Cumulative
1756 lstHeaders.Clear;
1757 memLab.Clear;
1758 uLabLocalReportData.Clear;
1759 uLabRemoteReportData.Clear;
1760 StatusText('Retrieving data for cumulative report...');
1761 GoRemoteOld(uLabRemoteReportData,21,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1762 TabControl1.OnChange(nil);
1763 Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
1764 if uLabLocalReportData.Count > 0 then
1765 begin
1766 TabControl1.OnChange(nil);
1767 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
1768 end;
1769 memLab.Lines.Insert(0,' ');
1770 memLab.Lines.Delete(0);
1771 end
1772 else if aID = '3' then
1773 begin // Interim
1774 memLab.Clear;
1775 uLabLocalReportData.Clear;
1776 uLabRemoteReportData.Clear;
1777 StatusText('Retrieving data for interim report...');
1778 GoRemoteOld(uLabRemoteReportData,3,3,'',uReportRPC,'','','',date1,date2);
1779 TabControl1.OnChange(nil);
1780 Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1781 if uLabLocalReportData.Count < 1 then
1782 uLabLocalReportData.Add('<No results for this date range.>');
1783 if TabControl1.TabIndex < 1 then
1784 QuickCopy(uLabLocalReportData,memLab);
1785 memLab.Lines.Insert(0,' ');
1786 memLab.Lines.Delete(0);
1787 memLab.SelStart := 0;
1788 end
1789 else if aID = '4' then
1790 begin // Interim for Selected Tests
1791 memLab.Clear;
1792 uLabLocalReportData.Clear;
1793 uLabRemoteReportData.Clear;
1794 try
1795 StatusText('Retrieving data for selected tests...');
1796 FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData);
1797 if uLabLocalReportData.Count > 0 then
1798 QuickCopy(uLabLocalReportData,memLab)
1799 else
1800 memLab.Lines.Add('<No results for selected tests in this date range.>');
1801 memLab.SelStart := 0;
1802 finally
1803 //tmpList.Free;
1804 end;
1805 end
1806 else if aID = '5' then
1807 begin // Worksheet
1808 chtChart.BottomAxis.Automatic := true;
1809 chkZoom.Checked := false;
1810 //chkZoomClick(self);
1811 chkAbnormals.Checked := false;
1812 memLab.Clear;
1813 uLabLocalReportData.Clear;
1814 uLabRemoteReportData.Clear;
1815 grdLab.Align := alClient;
1816 StatusText('Retrieving data for worksheet...');
1817 FastAssign(Worksheet(Patient.DFN, date1, date2,
1818 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid);
1819 if ragHorV.ItemIndex = 0 then
1820 HGrid(tmpGrid)
1821 else
1822 VGrid(tmpGrid);
1823 GraphList(tmpGrid);
1824 GridComments(tmpGrid);
1825 ragCorGClick(self);
1826 end
1827 else if aID = '6' then
1828 begin // Graph
1829 if not uGraphingActivated then
1830 begin
1831 chtChart.BottomAxis.Automatic := true;
1832 chkGraphZoom.Checked := false;
1833 chkGraphZoomClick(self);
1834 memLab.Clear;
1835 uLabLocalReportData.Clear;
1836 uLabRemoteReportData.Clear;
1837 tmpList := TStringList.Create;
1838 try
1839 StatusText('Retrieving data for graph...');
1840 FastAssign(GetChart(Patient.DFN, date1, date2,
1841 Piece(lblSpecimen.Caption, '^', 1),
1842 Piece(lblSingleTest.Caption, '^', 1)), tmpList);
1843 if tmpList.Count > 1 then
1844 begin
1845 chtChart.Visible := true;
1846 GraphChart(lblSingleTest.Caption, tmpList);
1847 chtChart.ZoomPercent(ZOOM_PERCENT);
1848 for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
1849 do memLab.Lines.Add(tmpList[i]);
1850 if memLab.Lines.Count < 2 then
1851 memLab.Lines.Add('<No comments on specimens.>');
1852 memLab.SelStart := 0;
1853 lblGraph.Visible := false;
1854 end
1855 else
1856 begin
1857 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
1858 lblGraph.Top := 2;
1859 lblGraph.Visible := true;
1860 if Piece(lblSpecimen.Caption, '^', 1) = '0' then
1861 pnlChart.Caption := '<No results can be graphed for ' +
1862 Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.> '
1863 + 'Results may be available, but cannot be graphed. Please try an alternate view.'
1864 else
1865 pnlChart.Caption := '<No results can be graphed for ' +
1866 Piece(lblSingleTest.Caption, '^', 2)
1867 + ' (' + Piece(lblSpecimen.Caption, '^', 2) +
1868 ') in this date range.> '
1869 + 'Results may be available, but cannot be graphed. Please try an alternate view.';
1870 chtChart.Visible := false;
1871 end;
1872 finally
1873 tmpList.Free;
1874 end;
1875 end;
1876 end
1877 else if aID = '9' then
1878 begin // Micro
1879 memLab.Clear;
1880 uLabLocalReportData.Clear;
1881 uLabRemoteReportData.Clear;
1882 StatusText('Retrieving microbiology data...');
1883 GoRemoteOld(uLabRemoteReportData,4,4,'',uReportRPC,'','','',date1,date2);
1884 TabControl1.OnChange(nil);
1885 Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
1886 if uLabLocalReportData.Count < 1 then
1887 uLabLocalReportData.Add('<No microbiology results for this date range.>');
1888 if TabControl1.TabIndex < 1 then
1889 QuickCopy(uLabLocalReportData,memLab);
1890 memLab.Lines.Insert(0,' ');
1891 memLab.Lines.Delete(0);
1892 memLab.SelStart := 0;
1893 end
1894 else if aID = '10' then
1895 begin // Lab Status
1896 memLab.Clear;
1897 uLabLocalReportData.Clear;
1898 uLabRemoteReportData.Clear;
1899 StatusText('Retrieving lab status data...');
1900 GoRemoteOld(uLabRemoteReportData,10,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
1901 TabControl1.OnChange(nil);
1902 Reports(uLabLocalReportData,Patient.DFN, 'L:10', '', IntToStr(daysback),'',
1903 date1, date2, uReportRPC);
1904 if uLabLocalReportData.Count < 1 then
1905 uLabLocalReportData.Add('<No laboratory orders for this date range.>');
1906 if TabControl1.TabIndex < 1 then
1907 QuickCopy(uLabLocalReportData,memLab);
1908 memLab.Lines.Insert(0,' ');
1909 memLab.Lines.Delete(0);
1910 memLab.SelStart := 0;
1911 end
1912 else begin //Anything Else
1913 lstHeaders.Clear;
1914 memLab.Clear;
1915 uLabLocalReportData.Clear;
1916 uLabRemoteReportData.Clear;
1917 StatusText('Retrieving lab data...');
1918 //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1919 GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1920 TabControl1.OnChange(nil);
1921 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '',
1922 IntToStr(daysback), '', date1, date2, uReportRPC);
1923 if uLabLocalReportData.Count < 1 then
1924 uLabLocalReportData.Add('<No data for this date range.>');
1925 if TabControl1.TabIndex < 1 then
1926 QuickCopy(uLabLocalReportData,memLab);
1927 memLab.Lines.Insert(0,' ');
1928 memLab.Lines.Delete(0);
1929 memLab.SelStart := 0;
1930 end;
1931 if uReportType = 'R' then
1932 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1933 else
1934 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1935 Screen.Cursor := crDefault;
1936 x := lstDates.DisplayText[lstDates.ItemIndex];
1937 x1 := piece(x,' ',1);
1938 x2 := piece(x,' ',2);
1939 if not(uRptID = '1:MOST RECENT') and (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then
1940 DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2))
1941 else
1942 DisplayHeading('d' + lstDates.ItemID);
1943 StatusText('');
1944end;
1945
1946procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject);
1947begin
1948 inherited;
1949 tvReportsClick(self);
1950end;
1951
1952procedure TfrmLabs.GraphList(griddata: TStrings);
1953var
1954 i, j: integer;
1955 ok: boolean;
1956 testname, testnum, testnum1, line: string;
1957begin
1958 lstTestGraph.Clear;
1959 for i := 0 to lstTests.Items.Count - 1 do
1960 begin
1961 testnum := Piece(lstTests.Items[i], '^', 1);
1962 testname := Piece(lstTests.Items[i], '^', 2);
1963 ok := false;
1964 for j := strtoint(Piece(griddata[0], '^', 4)) + 1 to strtointdef(Piece(griddata[0], '^', 5), 0) do
1965 begin
1966 testnum1 := Piece(griddata[j - 1], '^', 1);
1967 if testnum1 = testnum then
1968 begin
1969 ok := true;
1970 line := testnum + '^' + testname + ' (' + MixedCase(Piece(griddata[j - 1], '^', 2)) + ')^';
1971 line := line + Pieces(griddata[j - 1], '^', 3, 6);
1972 lstTestGraph.Items.Add(line);
1973 end;
1974 end;
1975 if not ok then lstTestGraph.Items.Add(lstTests.Items[i]);
1976 end;
1977end;
1978
1979procedure TfrmLabs.grdLabTopLeftChanged(Sender: TObject);
1980var
1981 i: integer;
1982begin
1983 inherited;
1984 if piece(uRptID,':',1) ='1' then
1985 begin
1986 for i := 2 to grdLab.RowCount do
1987 grdLab.Cells[0,i] := '';
1988 if not(grdLab.TopRow = 1) then
1989 grdLab.Cells[0,grdLab.TopRow] := lblDate.Caption;
1990 end;
1991end;
1992
1993procedure TfrmLabs.HGrid(griddata: TStrings);
1994var
1995 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
1996 DisplayDateTime: string;
1997begin
1998 offset := 0;
1999 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2000 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2001 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2002 linecnt := testcnt + datecnt + datacnt;
2003 if chkAbnormals.Checked and (linecnt > 0) then
2004 begin
2005 offset := linecnt + 1;
2006 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2007 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2008 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2009 linecnt := testcnt + datecnt + datacnt;
2010 end;
2011 with grdLab do
2012 begin
2013 if testcnt = 0 then ColCount := 3 else ColCount := testcnt + 2;
2014 if datecnt = 0 then RowCount := 2 else RowCount := datecnt + 1;
2015 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 60);
2016 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 80);
2017 FixedCols := 2;
2018 FixedRows := 1;
2019 for y := 0 to RowCount - 1 do
2020 for x := 0 to ColCount - 1 do
2021 Cells[x, y] := '';
2022 Cells[0, 0] := 'Date/Time';
2023 Cells[1, 0] := 'Specimen';
2024 for i := 1 to testcnt do
2025 begin
2026 Cells[i + 1, 0] := Piece(griddata[i + offset], '^', 3);
2027 end;
2028 if datecnt = 0 then
2029 begin
2030 Cells[0, 1] := 'no results';
2031 for x := 1 to ColCount - 1 do
2032 Cells[x, 1] := '';
2033 end;
2034 for i := testcnt + 1 to testcnt + datecnt do
2035 begin
2036 //------------------------------------------------------------------------------------------
2037 //v27.2 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present
2038 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
2039 begin
2040 DisplayDateTime := Piece(griddata[i + offset], '^', 2);
2041 if length(DisplayDateTime) > 7 then
2042 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime))
2043 else if length(DisplayDateTime) > 0 then
2044 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime))
2045 else
2046 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2047 end
2048 else // If no lab patch in const "PSI_05_118", continue as is
2049 begin
2050 Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2051 end;
2052 //------------------------------------------------------------------------------------------
2053 Cells[1, i - testcnt] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
2054 end;
2055 for i := testcnt + datecnt + 1 to linecnt do
2056 begin
2057 y := strtoint(Piece(griddata[i + offset], '^', 1));
2058 x := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
2059 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
2060 end;
2061 end;
2062end;
2063
2064procedure TfrmLabs.VGrid(griddata: TStrings);
2065var
2066 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
2067 DisplayDateTime: string;
2068begin
2069 offset := 0;
2070 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2071 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2072 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2073 linecnt := testcnt + datecnt + datacnt;
2074 if chkAbnormals.Checked and (linecnt > 0) then
2075 begin
2076 offset := linecnt + 1;
2077 testcnt := strtoint(Piece(griddata[offset], '^', 1));
2078 datecnt := strtoint(Piece(griddata[offset], '^', 2));
2079 datacnt := strtoint(Piece(griddata[offset], '^', 3));
2080 linecnt := testcnt + datecnt + datacnt;
2081 end;
2082 with grdLab do
2083 begin
2084 if datecnt = 0 then ColCount := 2 else ColCount := datecnt + 1;
2085 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 2;
2086 DefaultColWidth := ResizeWidth( BaseFont, MainFont, 80);
2087 ColWidths[0] := ResizeWidth( BaseFont, MainFont, 60);
2088 FixedCols := 1;
2089 FixedRows := 2;
2090 for y := 0 to RowCount - 1 do
2091 for x := 0 to ColCount - 1 do
2092 Cells[x, y] := '';
2093 Cells[0, 0] := 'Date/Time';
2094 Cells[0, 1] := 'Specimen';
2095 for i := 1 to testcnt do
2096 begin
2097 Cells[0, i + 1] := Piece(griddata[i + offset], '^', 3);
2098 end;
2099 if datecnt = 0 then
2100 begin
2101 Cells[1, 0] := 'no results';
2102 for x := 1 to RowCount - 1 do
2103 Cells[x, 1] := '';
2104 end;
2105 for i := testcnt + 1 to testcnt + datecnt do
2106 begin
2107 //------------------------------------------------------------------------------------------
2108 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
2109 begin
2110 DisplayDateTime := Piece(griddata[i + offset], '^', 2);
2111 if length(DisplayDateTime) > 7 then
2112 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime))
2113 else if length(DisplayDateTime) > 0 then
2114 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime))
2115 else
2116 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2117 end
2118 else // If no lab patch in const "PSI_05_118", continue as is
2119 begin
2120 Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
2121 end;
2122 //------------------------------------------------------------------------------------------
2123 Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
2124 end;
2125 for i := testcnt + datecnt + 1 to linecnt do
2126 begin
2127 x := strtoint(Piece(griddata[i + offset], '^', 1));
2128 y := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
2129 Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
2130 end;
2131 end;
2132end;
2133
2134procedure TfrmLabs.GridComments(aitems: TStrings);
2135var
2136 i, start: integer;
2137begin
2138 start := strtointdef(Piece(aitems[0], '^', 5), 1);
2139 memLab.Clear;
2140 uLabLocalReportData.Clear;
2141 uLabRemoteReportData.Clear;
2142 for i := start to aitems.Count - 1 do
2143 memLab.Lines.Add(aitems[i]);
2144 if (memLab.Lines.Count = 0) and (aitems.Count > 1) then
2145 memLab.Lines.Add('<No comments on specimens.>');
2146 memLab.SelStart := 0;
2147end;
2148
2149procedure TfrmLabs.FormDestroy(Sender: TObject);
2150var
2151 i: integer;
2152 aColChange: string;
2153begin
2154 inherited;
2155 if length(uColChange) > 0 then
2156 begin
2157 aColChange := '';
2158 for i := 0 to lvReports.Columns.Count - 1 do
2159 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
2160 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
2161 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
2162 uColChange := '';
2163 end;
2164 RemoteQueryAbortAll;
2165 tmpGrid.free;
2166 uLabLocalReportData.Free;
2167 uLabRemoteReportData.Free;
2168 uTreeStrings.Free;
2169 uEmptyImageList.Free;
2170 uColumns.Free;
2171 uLocalReportData.Free;
2172 uRemoteReportData.Free;
2173 LabRowObjects.Free;
2174end;
2175
2176procedure TfrmLabs.FillGrid(agrid: TStringGrid; aitems: TStrings);
2177var
2178 testcnt, x, y, i: integer;
2179begin
2180 testcnt := strtoint(Piece(aitems[0], '^', 1));
2181 with agrid do
2182 begin
2183 if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 1;
2184 ColCount := 6;
2185 DefaultColWidth := agrid.Width div ColCount - 2;
2186 ColWidths[0] := 120; //agrid.Width div 6;
2187 ColWidths[1] := agrid.Width div 4; //5
2188 ColWidths[5] := agrid.Width div 7; //5
2189 ColWidths[3] := agrid.Width div 14;//12
2190 ColWidths[4] := agrid.Width div 12;//9
2191 ColWidths[2] := agrid.Width div 5; //agrid.Width - ColWidths[0] - ColWidths[1] - ColWidths[3] - ColWidths[4] - 8;
2192 FixedCols := 0;
2193 FixedRows := 1;
2194 for y := 0 to RowCount - 1 do
2195 for x := 0 to ColCount - 1 do
2196 Cells[x, y] := '';
2197 Cells[0, 0] := 'Collection Date/Time';
2198 Cells[1, 0] := 'Test';
2199 Cells[2, 0] := 'Result / Status';
2200 Cells[3, 0] := 'Flag';
2201 Cells[4, 0] := 'Units';
2202 Cells[5, 0] := 'Ref Range';
2203 for i := 1 to testcnt do
2204 begin
2205 if i = 1 then Cells[0, i] := lblDate.Caption
2206 else Cells[0, i] := '';
2207 Cells[1, i] := Piece(aitems[i], '^', 2);
2208 Cells[2, i] := Piece(aitems[i], '^', 3);
2209 Cells[3, i] := Piece(aitems[i], '^', 4);
2210 Cells[4, i] := Piece(aitems[i], '^', 5);
2211 Cells[5, i] := Piece(aitems[i], '^', 6);
2212 end;
2213 end;
2214end;
2215
2216procedure TfrmLabs.FillComments(amemo: TRichEdit; aitems:TStrings);
2217var
2218 testcnt, i: integer;
2219 specimen, accession, provider: string;
2220begin
2221 amemo.Lines.Clear;
2222 specimen := Piece(aitems[0], '^', 5);
2223 accession := Piece(aitems[0], '^', 6);
2224 provider := Piece(aitems[0], '^', 7);
2225 amemo.Lines.Add('Specimen: ' + specimen + '; Accession: ' + accession + '; Provider: ' + provider);
2226 testcnt := strtoint(Piece(aitems[0], '^', 1));
2227 for i := testcnt + 1 to aitems.Count - 1 do
2228 amemo.Lines.Add(aitems[i]);
2229 amemo.SelStart := 0;
2230end;
2231
2232procedure TfrmLabs.GetInterimGrid(adatetime: TFMDateTime; direction: integer);
2233var
2234 tmpList: TStringList;
2235 nexton, prevon: boolean;
2236 newest, oldest, DisplayDate, aCollection, aSpecimen, aX: string;
2237 i,ix: integer;
2238begin
2239 tmpList := TStringList.Create;
2240 GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH
2241 prevon := true;
2242 aCollection := '';
2243 aSpecimen := '';
2244 aX := '';
2245 lblSample.Caption := '';
2246 lblSample.Color := clBtnFace;
2247 try
2248 FastAssign(InterimGrid(Patient.DFN, adatetime, direction, uFormat), tmpList);
2249 if tmpList.Count > 0 then
2250 begin
2251 lblDateFloat.Caption := Piece(tmpList[0], '^', 3);
2252 uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1);
2253 //------------------------------------------------------------------------------------------
2254 //v27.1 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present
2255 if LabPatchInstalled then // Requires lab patch in const "PSI_05_118"
2256 begin
2257 DisplayDate := Piece(tmpList[0], '^', 3);
2258 if length(DisplayDate) > 7 then
2259 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(DisplayDate))
2260 else if length(DisplayDate) > 0 then
2261 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY', strtofloat(DisplayDate))
2262 else
2263 if length(lblDateFloat.Caption) > 0 then
2264 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
2265 end
2266 else // If no lab patch in const "PSI_05_118", continue as is
2267 begin
2268 if length(lblDateFloat.Caption) > 0 then
2269 lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
2270 end;
2271 //------------------------------------------------------------------------------------------
2272 if length(lblDateFloat.Caption) < 1
2273 then
2274 begin
2275 lblDateFloat.Caption := FloatToStr(adatetime);
2276 nexton := false;
2277 end
2278 else
2279 begin
2280 nexton := lblDateFloat.Caption <> newest;
2281 prevon := lblDateFloat.Caption <> oldest;
2282 end;
2283 if (not nexton) and (uFormat = 3) then
2284 nexton := true;
2285 if (not prevon) and (uFormat = 2) then
2286 prevon := true;
2287 if Piece(tmpList[0], '^', 2) = 'CH' then
2288 begin
2289 lblSample.Caption := 'Specimen: ' + Piece(tmpList[0], '^', 5);
2290 lblSample.Color := clWindow;
2291 end;
2292 if Piece(tmpList[0], '^', 2) = 'MI' then
2293 begin
2294 for i := 0 to tmpList.Count - 1 do
2295 begin
2296 if i > 5 then break;
2297 if ansiContainsStr(tmpList[i],'Collection sample:') then
2298 begin
2299 ix := 0;
2300 if length(piece(tmpList[i], ':',2)) > 0 then
2301 begin
2302 ix := Length(piece(tmpList[i], ':',2));
2303 if ix > 15 then ix := ix - 15;
2304 end;
2305 aCollection := ' Sample: ' + LeftStr(piece(tmpList[i], ':',2),ix);
2306 end;
2307 end;
2308 for i := 0 to tmpList.Count - 1 do
2309 begin
2310 if i > 5 then break;
2311 if ansiContainsStr(tmpList[i],'Site/Specimen:') then
2312 begin
2313 aSpecimen := 'Specimen: ' + piece(tmpList[i], ':', 2);
2314 end;
2315 end;
2316 aX := aSpecimen + aCollection;
2317 if Length(aX) > 0 then
2318 begin
2319 lblSample.Caption := aX;
2320 lblSample.Color := clWindow;
2321 end;
2322 end;
2323 end
2324 else
2325 begin
2326 lblDateFloat.Caption := '';
2327 lblDate.Caption := '';
2328 nexton := false;
2329 prevon := false;
2330 end;
2331 cmdNext.Enabled := nexton;
2332 cmdRecent.Enabled := nexton;
2333 cmdPrev.Enabled := prevon;
2334 cmdOld.Enabled := prevon;
2335 if cmdOld.Enabled and cmdRecent.Enabled then
2336 lblMostRecent.Visible := false
2337 else
2338 begin
2339 lblMostRecent.Visible := true;
2340 if (not cmdOld.Enabled) and (not cmdRecent.Enabled) then
2341 lblMostRecent.Caption := 'No Lab Data'
2342 else if cmdOld.Enabled then
2343 lblMostRecent.Caption := 'Most Recent Lab Data'
2344 else
2345 lblMostRecent.Caption := 'Oldest Lab Data';
2346 end;
2347 if tmpList.Count > 0 then
2348 begin
2349 if Piece(tmpList[0], '^', 2) = 'CH' then
2350 begin
2351 FillGrid(grdLab, tmpList);
2352 FillComments(memLab, tmpList);
2353 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 5);
2354 sptHorzRight.Top := pnlRightTop.Height;
2355 uScreenSplitLoc := sptHorzRight.Top;
2356 pnlRightBottom.Height := pnlLeft.Height div 5;
2357 memLab.Height := pnlLeft.Height div 5;
2358 memLab.Lines.Insert(0,' ');
2359 memLab.Lines.Delete(0);
2360 memLab.SelStart := 0;
2361 grdLab.Align := alClient;
2362 grdLab.Visible := true;
2363 memLab.Visible := true;
2364 pnlFooter.Height := lblHeading.Height + 5;
2365 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2366 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2367 lblFooter.Align := alTop;
2368 pnlFooter.Visible := true;
2369 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
2370 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
2371 memLab.Align := alClient;
2372 memLab.Repaint;
2373 end;
2374 if Piece(tmpList[0], '^', 2) = 'MI' then
2375 begin
2376 tmpList.Delete(0);
2377 QuickCopy(tmpList, memLab);
2378 memLab.SelStart := 0;
2379 grdLab.Visible := false;
2380 pnlFooter.Visible := false;
2381 sptHorzRight.Visible := true;
2382 TabControl1.Visible := false;
2383 pnlRightTop.Height := pnlHeader.Height;
2384 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height + pnlHeader.Height);
2385 pnlRightTop.Visible := true;
2386 memLab.Align := alClient;
2387 memLab.Repaint;
2388 end;
2389 end
2390 else
2391 begin
2392 grdLab.Visible := false;
2393 pnlFooter.Visible := false;
2394 memLab.Align := alClient;
2395 end;
2396 finally
2397 tmpList.Free;
2398 end;
2399end;
2400
2401procedure TfrmLabs.cmdNextClick(Sender: TObject);
2402var
2403 HadFocus: boolean;
2404begin
2405 inherited;
2406 HadFocus := Screen.ActiveControl = cmdNext;
2407 StatusText('Retrieving next lab data...');
2408 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), -1);
2409 StatusText('');
2410 if HadFocus then begin
2411 if cmdNext.Enabled then cmdNext.SetFocus
2412 else if cmdPrev.Enabled then cmdPrev.SetFocus
2413 else tvReports.SetFocus;
2414 end;
2415end;
2416
2417procedure TfrmLabs.cmdPrevClick(Sender: TObject);
2418var
2419 HadFocus: boolean;
2420begin
2421 inherited;
2422 HadFocus := Screen.ActiveControl = cmdPrev;
2423 StatusText('Retrieving previous lab data...');
2424 if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), 1);
2425 StatusText('');
2426 if HadFocus then begin
2427 if cmdPrev.Enabled then cmdPrev.SetFocus
2428 else if cmdNext.Enabled then cmdNext.SetFocus
2429 else tvReports.Setfocus;
2430 end;
2431end;
2432
2433procedure TfrmLabs.WorksheetChart(test: string; aitems: TStrings);
2434
2435function OkFloatValue(value: string): boolean;
2436var
2437 i, j: integer;
2438 first, second: string;
2439begin
2440 Result := false;
2441 i := strtointdef(value, -99999);
2442 if i <> -99999 then Result := true
2443 else if pos('.', Copy(Value, Pos('.', Value) + 1, Length(Value))) > 0 then Result := false
2444 else
2445 begin
2446 first := Piece(value, '.', 1);
2447 second := Piece(value, '.', 2);
2448 if length(second) > 0 then
2449 begin
2450 i := strtointdef(first, -99999);
2451 j := strtointdef(second, -99999);
2452 if (i <> -99999) and (j <> -99999) then Result := true;
2453 end
2454 else
2455 begin
2456 i :=strtointdef(first, -99999);
2457 if i <> -99999 then Result := true;
2458 end;
2459 end;
2460end;
2461
2462var
2463 datevalue, oldstart, oldend: TDateTime;
2464 labvalue: double;
2465 i, numtest, numcol, numvalues, valuecount: integer;
2466 high, low, start, stop, numspec, value, testcheck, units, specimen, testnum, testorder: string;
2467begin
2468 if chkZoom.Checked and chtChart.Visible then
2469 begin
2470 oldstart := chtChart.BottomAxis.Minimum;
2471 oldend := chtChart.BottomAxis.Maximum;
2472 chtChart.UndoZoom;
2473 chtChart.BottomAxis.Automatic := false;
2474 chtChart.BottomAxis.Minimum := oldstart;
2475 chtChart.BottomAxis.Maximum := oldend;
2476 end
2477 else
2478 begin
2479 chtChart.BottomAxis.Automatic := true;
2480 end;
2481 chtChart.Visible := true;
2482 valuecount := 0;
2483 testnum := Piece(test, '^', 1);
2484 specimen := Piece(test, '^', 3);
2485 units := Piece(test, '^', 4);
2486 low := Piece(test, '^', 5);
2487 high := Piece(test, '^', 6);
2488 numtest := strtoint(Piece(aitems[0], '^', 1));
2489 numcol := strtoint(Piece(aitems[0], '^', 2));
2490 numvalues := strtoint(Piece(aitems[0], '^', 3));
2491 serHigh.Clear; serLow.Clear; serTest.Clear;
2492 if numtest > 0 then
2493 begin
2494 for i := 1 to numtest do
2495 if testnum = Piece(aitems[i], '^', 2) then
2496 begin
2497 testorder := inttostr(i);
2498 break;
2499 end;
2500 GetStartStop(start, stop, aitems);
2501 if OKFloatValue(high) then
2502 begin
2503 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
2504 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
2505 end;
2506 if OKFloatValue(low) then
2507 begin
2508 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
2509 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
2510 end;
2511 numspec := Piece(specimen, '^', 1);
2512 chtChart.Legend.Color := grdLab.Color;
2513 chtChart.Title.Font.Size := MainFontSize;
2514 chtChart.LeftAxis.Title.Caption := units;
2515 serTest.Title := Piece(test, '^', 2);
2516 serHigh.Title := 'Ref High ' + high;
2517 serLow.Title := 'Ref Low ' + low;
2518 testcheck := testorder;
2519 for i := numtest + numcol + 1 to numtest + numcol + numvalues do
2520 if Piece(aitems[i], '^', 2) = testcheck then
2521 if Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 3) = numspec then
2522 begin
2523 value := Piece(aitems[i], '^', 3);
2524 if OkFloatValue(value) then
2525 begin
2526 labvalue := strtofloat(value);
2527 datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
2528 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
2529 inc(valuecount);
2530 end;
2531 end;
2532 end;
2533 if valuecount = 0 then
2534 begin
2535 lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
2536 lblGraph.Top := 2;
2537 lblGraph.Visible := true;
2538 if length(Piece(specimen, '^', 2)) > 0 then
2539 pnlChart.Caption := '<No results can be graphed for ' + serTest.Title + ' in this date range.> '
2540 else
2541 pnlChart.Caption := '<No results can be graphed for ' + Piece(test, '^', 2) + ' in this date range.>';
2542 chtChart.Visible := false;
2543 end
2544 else
2545 lblGraph.Visible := false;
2546 if not chkZoom.Checked then
2547 begin
2548 chtChart.UndoZoom;
2549 chtChart.ZoomPercent(ZOOM_PERCENT);
2550 end;
2551end;
2552
2553procedure TfrmLabs.GetStartStop(var start, stop: string; aitems: TStrings);
2554var
2555 numtest, numcol: integer;
2556begin
2557 numtest := strtoint(Piece(aitems[0], '^', 1));
2558 numcol := strtoint(Piece(aitems[0], '^', 2));
2559 start := Piece(aitems[numtest + 1], '^', 2);
2560 stop := Piece(aitems[numtest + numcol], '^', 2);
2561end;
2562
2563procedure TfrmLabs.cmdRecentClick(Sender: TObject);
2564var
2565 HadFocus: boolean;
2566begin
2567 inherited;
2568 HadFocus := Screen.ActiveControl = cmdRecent;
2569 StatusText('Retrieving most recent lab data...');
2570 uFormat := 1;
2571 GetInterimGrid(FMToday + 0.2359, 1);
2572 StatusText('');
2573 if HadFocus and cmdPrev.Enabled then cmdPrev.SetFocus;
2574end;
2575
2576procedure TfrmLabs.cmdOldClick(Sender: TObject);
2577var
2578 HadFocus: boolean;
2579begin
2580 inherited;
2581 HadFocus := Screen.ActiveControl = cmdOld;
2582 StatusText('Retrieving oldest lab data...');
2583 uFormat := 1;
2584 GetInterimGrid(2700101, -1);
2585 if HadFocus and cmdNext.Enabled then cmdNext.SetFocus;
2586 StatusText('');
2587end;
2588
2589procedure TfrmLabs.FormResize(Sender: TObject);
2590//var
2591 //aID: integer;
2592begin
2593 inherited;
2594 AlignList;
2595 lblHeaders.Height := lblReports.Height;
2596 lblDates.Height := lblReports.Height;
2597 lblHeading.Height := lblReports.Height;
2598 pnlFooter.Height := lblReports.Height + 5;
2599 lblFooter.Height := lblReports.Height;
2600 {aID := 0;
2601 if CharAt(uRPTID,2) =':' then
2602 aID := StrToInt(piece(uRptID,':',1));
2603 if (aID = 0) and (CharAt(uRPTID,3) =':') then
2604 aID := StrToInt(piece(uRptID,':',1)); }
2605 {case lstReports.ItemIEN of }
2606 {case aID of
2607 1: begin // Most Recent
2608 pnlHeader.Align := alTop;
2609 memLab.Height := pnlLeft.Height div 5;
2610 memLab.Top := pnlLeft.Height - pnlFooter.Height - memLab.Height;
2611 memLab.Align := alBottom;
2612 grdLab.Align := alClient;
2613 if tmpGrid.Count > 0 then HGrid(tmpGrid);
2614 if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
2615 grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
2616 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2617 pnlFooter.Align := alBottom;
2618 memLab.Repaint;
2619 pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5);
2620 //*pnlRightTop.Visible := true;
2621 //*pnlButtons.Visible := true;
2622 //*pnlWorksheet.Visible := false;
2623 //*pnlGraph.Visible := false;
2624 //memLab.Align := alBottom;
2625 sptHorzRight.Visible := true;
2626 pnlRightBottom.Height := pnlLeft.Height div 5;
2627 //memLab.Height := pnlLeft.Height div 5;
2628 //grdLab.Align := alClient;
2629 end;
2630 21: begin // Cumulative
2631 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2632 pnlFooter.Align := alBottom;
2633 lblFooter.Align := alTop;
2634 memLab.Align := alClient;
2635 memLab.Repaint;
2636 end;
2637 3: begin // Interim
2638 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2639 pnlFooter.Align := alBottom;
2640 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2641 lblFooter.Align := alTop;
2642 memLab.Align := alClient;
2643 memLab.Repaint;
2644 end;
2645 4: begin // Interim for Selected Tests
2646 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2647 pnlFooter.Align := alBottom;
2648 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
2649 lblFooter.Align := alTop;
2650 memLab.Align := alClient;
2651 memLab.Repaint;
2652 end;
2653 5: begin // Worksheet
2654 pnlHeader.Align := alTop;
2655 grdLab.Align := alClient;
2656 ragCorGClick(self);
2657 pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
2658 pnlFooter.Align := alBottom;
2659 end;
2660 6: begin // Graph
2661 if not uGraphingActivated then
2662 begin
2663 memLab.Height := pnlLeft.Height div 4;
2664 memLab.Align := alBottom;
2665 pnlChart.Top := pnlHeader.Height;
2666 pnlChart.Align := alClient;
2667 memLab.Height := pnlLeft.Height div 4;
2668 memLab.Align := alBottom;
2669 memLab.Repaint;
2670 end;
2671 end;
2672 20: begin // Anatomic Path
2673 memLab.Repaint;
2674 end;
2675 2: begin // Blood Bank
2676 memLab.Repaint;
2677 end;
2678 9: begin // Microbiology
2679 memLab.Repaint;
2680 end;
2681 10: begin // Lab Status
2682 memLab.Repaint;
2683 end;
2684 end; }
2685end;
2686
2687procedure TfrmLabs.pnlRightResize(Sender: TObject);
2688begin
2689 inherited;
2690 pnlRight.Refresh;
2691 lblFooter.Height := lblHeading.Height;
2692end;
2693
2694function TfrmLabs.FMToDateTime(FMDateTime: string): TDateTime;
2695var
2696 x, Year: string;
2697begin
2698 { Note: TDateTime cannot store month only or year only dates }
2699 x := FMDateTime + '0000000';
2700 if Length(x) > 12 then x := Copy(x, 1, 12);
2701 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
2702 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
2703 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
2704 Result := StrToDateTime(x);
2705end;
2706
2707procedure TfrmLabs.chkValuesClick(Sender: TObject);
2708begin
2709 inherited;
2710 serTest.Marks.Visible := chkValues.Checked;
2711end;
2712
2713procedure TfrmLabs.chk3DClick(Sender: TObject);
2714begin
2715 inherited;
2716 chtChart.View3D := chk3D.Checked;
2717end;
2718
2719procedure TfrmLabs.GraphChart(test: string; aitems: TStrings);
2720var
2721 datevalue: TDateTime;
2722 labvalue: double;
2723 i, numvalues: integer;
2724 high, low, start, stop, value, units, specimen: string;
2725begin
2726 numvalues := strtoint(Piece(aitems[0], '^', 1));
2727 specimen := Piece(aitems[0], '^', 2);
2728 high := Piece(aitems[0], '^', 3);
2729 low := Piece(aitems[0], '^', 4);
2730 units := Piece(aitems[0], '^', 5);
2731 if numvalues > 0 then
2732 begin
2733 start := Piece(aitems[1], '^', 1);
2734 stop := Piece(aitems[numvalues], '^', 1);
2735 chtChart.Legend.Color := grdLab.Color;
2736 serHigh.Clear; serLow.Clear; serTest.Clear;
2737 if high <> '' then
2738 begin
2739 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
2740 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
2741 end;
2742 if low <> '' then
2743 begin
2744 serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
2745 serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
2746 end;
2747 //chtChart.Title.Text.Strings[0] := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
2748 //chtChart.Title.Font.Size := 12;
2749 chtChart.LeftAxis.Title.Caption := units;
2750 serTest.Title := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
2751 serHigh.Title := 'Ref High ' + high;
2752 serLow.Title := 'Ref Low ' + low;
2753 for i := 1 to numvalues do
2754 begin
2755 value := Piece(aitems[i], '^', 2);
2756 labvalue := strtofloat(value);
2757 datevalue := FMToDateTime(Piece(aitems[i], '^', 1));
2758 serTest.AddXY(datevalue, labvalue, '', clTeeColor);
2759 end;
2760 end;
2761end;
2762
2763procedure TfrmLabs.ragHorVClick(Sender: TObject);
2764begin
2765 inherited;
2766 if ragHorV.ItemIndex = 0 then HGrid(tmpGrid) else VGrid(tmpGrid);
2767end;
2768
2769procedure TfrmLabs.ragCorGClick(Sender: TObject);
2770begin
2771 inherited;
2772 if ragCorG.ItemIndex = 0 then // comments
2773 begin
2774 chkZoom.Enabled := false;
2775 chk3D.Enabled := false;
2776 chkValues.Enabled := false;
2777 pnlChart.Visible:= false;
2778 pnlRightTop.Align := alTop;
2779 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 6);
2780 pnlRightBottom.Visible := true;
2781 pnlRightBottom.Align := alClient;
2782 memLab.Align := alClient;
2783 memLab.Visible := true;
2784 grdLab.Align := alClient;
2785 end
2786 else // graph
2787 begin
2788 chkZoom.Enabled := true;
2789 chk3D.Enabled := true;
2790 chkValues.Enabled := true;
2791 chk3DClick(self);
2792 chkValuesClick(self);
2793 memLab.Visible := false;
2794 pnlRightBottom.Visible := false;
2795 pnlRightTop.Align := alClient;
2796 pnlChart.Height := pnlRight.Height div 2;
2797 pnlChart.Top := pnlRight.Height - pnlFooter.Height - pnlChart.Height;
2798 pnlChart.Align := alBottom;
2799 pnlChart.Visible := true;
2800 grdLab.Align := alClient;
2801 if lstTestGraph.Items.Count > 0 then
2802 begin
2803 if lstTestGraph.ItemIndex < 0 then
2804 lstTestGraph.ItemIndex := 0;
2805 lstTestGraphClick(self);
2806 end;
2807 end;
2808end;
2809
2810procedure TfrmLabs.lstTestGraphClick(Sender: TObject);
2811begin
2812 inherited;
2813 WorksheetChart(lstTestGraph.Items[lstTestGraph.ItemIndex], tmpGrid);
2814end;
2815
2816procedure TfrmLabs.Print1Click(Sender: TObject);
2817begin
2818 inherited;
2819 RequestPrint;
2820end;
2821
2822procedure TfrmLabs.Copy1Click(Sender: TObject);
2823var
2824 i,j: integer;
2825 line: string;
2826 ListItem: TListItem;
2827 aText: String;
2828begin
2829 inherited;
2830 ClipBoard;
2831 aText := '';
2832 for i := 0 to lvReports.Items.Count - 1 do
2833 if lvReports.Items[i].Selected then
2834 begin
2835 ListItem := lvReports.Items[i];
2836 line := '';
2837 for j := 1 to lvReports.Columns.Count - 1 do
2838 begin
2839 if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then
2840 line := line + ' ' + ListItem.SubItems[j-1];
2841 end;
2842 if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then
2843 line := ListItem.Caption + ' ' + line;
2844 if length(aText) > 0 then
2845 aText := aText + CRLF + line
2846 else aText := line;
2847 end;
2848 ClipBoard.Clear;
2849 ClipBoard.AsText := aText;
2850end;
2851
2852procedure TfrmLabs.Copy2Click(Sender: TObject);
2853begin
2854 inherited;
2855 memLab.CopyToClipboard;
2856end;
2857
2858procedure TfrmLabs.Print2Click(Sender: TObject);
2859begin
2860 inherited;
2861 RequestPrint;
2862end;
2863
2864procedure TfrmLabs.lvReportsColumnClick(Sender: TObject;
2865 Column: TListColumn);
2866var
2867 ClickedColumn: Integer;
2868 a1, a2: integer;
2869 s,s1,s2: string;
2870begin
2871 inherited;
2872 a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1;
2873 a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1;
2874 ClickedColumn := Column.Index;
2875 ColumnToSort := Column.Index;
2876 SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0);
2877 SortIdx2 := 0;
2878 SortIdx3 := 0;
2879 if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0);
2880 if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0);
2881 if a1 = ColumnToSort then
2882 begin
2883 SortIdx2 := SortIdx3;
2884 SortIdx3 := 0;
2885 end;
2886 if a2 = ColumnToSort then
2887 SortIdx3 := 0;
2888 if ClickedColumn = ColumnToSort then
2889 ColumnSortForward := not ColumnSortForward
2890 else
2891 ColumnSortForward := true;
2892 ColumnToSort := ClickedColumn;
2893 uFirstSort := ColumnToSort;
2894 uSecondSort := a1;
2895 uThirdSort := a2;
2896 lvReports.Hint := '';
2897 if ColumnSortForward = true then
2898 s := 'Sorted forward'
2899 else
2900 s := 'Sorted reverse';
2901 s1 := piece(uColumns[uFirstSort],'^',1);
2902 s2 := '';
2903 if length(piece(s1,' ',2)) > 0 then
2904 s2 := pieces(s1,' ',2,99);
2905 if length(s2) > 0 then s2 := StripSpace(s2);
2906 s := s + ' by ' + piece(s1,' ',1) + ' ' + s2;
2907 if (a1 <> uFirstSort) and (a1 > -1) then
2908 begin
2909 s1 := piece(uColumns[a1], '^', 1);
2910 s2 := '';
2911 if length(piece(s1,' ',2)) > 0 then
2912 s2 := pieces(s1,' ',2,99);
2913 if length(s2) > 0 then s2 := StripSpace(s2);
2914 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2915 end;
2916 if (a2 <> uFirstSort) and (a2 > -1) then
2917 begin
2918 s1 := piece(uColumns[a2], '^', 1);
2919 s2 := '';
2920 if length(piece(s1,' ',2)) > 0 then
2921 s2 := pieces(s1,' ',2,99);
2922 if length(s2) > 0 then s2 := StripSpace(s2);
2923 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2924 end;
2925 lvReports.Hint := s;
2926 lvReports.CustomSort(nil, 0);
2927end;
2928
2929procedure TfrmLabs.lvReportsCompare(Sender: TObject; Item1,
2930 Item2: TListItem; Data: Integer; var Compare: Integer);
2931
2932 function CompareValues(Col: Integer): integer;
2933 var
2934 ix: Integer;
2935 s1, s2: string;
2936 v1, v2: extended;
2937 d1, d2: TFMDateTime;
2938 begin
2939 inherited;
2940 if ColumnToSort = 0 then
2941 Result := CompareText(Item1.Caption,Item2.Caption)
2942 else
2943 begin
2944 ix := ColumnToSort - 1;
2945 case Col of
2946 0: //strings
2947 begin
2948 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2949 s1 := Item1.SubItems[ix]
2950 else
2951 s1 := '0';
2952 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2953 s2 := Item2.SubItems[ix]
2954 else
2955 s2 := '0';
2956 Result := CompareText(s1,s2);
2957 end;
2958
2959 1: //integers
2960 begin
2961 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2962 s1 := Item1.SubItems[ix]
2963 else
2964 s1 := '0';
2965 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2966 s2 := Item2.SubItems[ix]
2967 else
2968 s2 := '0';
2969 IsValidNumber(s1, v1);
2970 IsValidNumber(s2, v2);
2971 if v1 > v2 then
2972 Result := 1
2973 else
2974 if v1 < v2 then
2975 Result := -1
2976 else
2977 Result := 0;
2978 end;
2979
2980 2: //date/times
2981 begin
2982 if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then
2983 s1 := Item1.SubItems[ix]
2984 else
2985 s1 := '1/1/1700';
2986 if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then
2987 s2 := Item2.SubItems[ix]
2988 else
2989 s2 := '1/1/1700';
2990 d1 := StringToFMDateTime(s1);
2991 d2 := StringToFMDateTime(s2);
2992 if d1 > d2 then
2993 Result := 1
2994 else
2995 if d1 < d2 then
2996 Result := -1
2997 else
2998 Result := 0;
2999 end;
3000 else
3001 Result := 0; // to make the compiler happy
3002 end;
3003 end;
3004 end;
3005begin
3006 ColumnToSort := uFirstSort;
3007 Compare := CompareValues(SortIdx1);
3008 if Compare = 0 then
3009 begin
3010 if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then
3011 begin
3012 ColumnToSort := uSecondSort;
3013 Compare := CompareValues(SortIdx2);
3014 end;
3015 if Compare = 0 then
3016 if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then
3017 begin
3018 ColumnToSort := uThirdSort;
3019 Compare := CompareValues(SortIdx3);
3020 end;
3021 end;
3022 if not ColumnSortForward then Compare := -Compare;
3023end;
3024
3025procedure TfrmLabs.lvReportsKeyUp(Sender: TObject; var Key: Word;
3026 Shift: TShiftState);
3027begin
3028 inherited;
3029 if (Key = 67) and (ssCtrl in Shift) then
3030 Copy1Click(Self);
3031 if (Key = 65) and (ssCtrl in Shift) then
3032 SelectAll1Click(Self);
3033end;
3034
3035procedure TfrmLabs.lvReportsSelectItem(Sender: TObject; Item: TListItem;
3036 Selected: Boolean);
3037var
3038 aID, aSID: string;
3039 i,j,k: integer;
3040 aBasket: TStringList;
3041 aWPFlag: Boolean;
3042 x, HasImages: string;
3043
3044begin
3045 inherited;
3046 if not selected then Exit;
3047 aBasket := TStringList.Create;
3048 uLocalReportData.Clear;
3049 aWPFlag := false;
3050 with lvReports do
3051 begin
3052 aID := Item.SubItems[0];
3053 case uQualifierType of
3054 QT_OTHER:
3055 begin // = 0
3056
3057 end;
3058 QT_DATERANGE:
3059 begin // = 2
3060
3061 end;
3062 QT_IMAGING:
3063 begin // = 3
3064
3065 end;
3066 QT_NUTR:
3067 begin // = 4
3068
3069 end;
3070 QT_HSWPCOMPONENT:
3071 begin // = 6
3072 if lvReports.SelCount < 3 then
3073 begin
3074 memLab.Lines.Clear;
3075 ulvSelectOn := false;
3076 end;
3077 aBasket.Clear;
3078 if (SelCount = 2) and (ulvSelectOn = false) then
3079 begin
3080 ulvSelectOn := true;
3081 for i := 0 to Items.Count - 1 do
3082 if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then
3083 begin
3084 aSID := Items[i].SubItems[0];
3085 for j := 0 to LabRowObjects.ColumnList.Count - 1 do
3086 if piece(aSID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[j]).Handle,':',1) then
3087 if Item.Caption = (piece(TCellObject(LabRowObjects.ColumnList[j]).Site,';',1)) then
3088 if (TCellObject(LabRowObjects.ColumnList[j]).Data.Count > 0) and
3089 (TCellObject(LabRowObjects.ColumnList[j]).Include = '1') then
3090 begin
3091 aWPFlag := true;
3092 MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[j]).Name);
3093 FastAssign(TCellObject(LabRowObjects.ColumnList[j]).Data, aBasket);
3094 for k := 0 to aBasket.Count - 1 do
3095 MemLab.Lines.Add(' ' + aBasket[k]);
3096 end;
3097 if aWPFlag = true then
3098 begin
3099 memLab.Lines.Add('Facility: ' + Item.Caption);
3100 memLab.Lines.Add('===============================================================================');
3101 end;
3102 end;
3103 end;
3104 aBasket.Clear;
3105 aWPFlag := false;
3106 for i := 0 to LabRowObjects.ColumnList.Count - 1 do
3107 if piece(aID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[i]).Handle,':',1) then
3108 if Item.Caption = (piece(TCellObject(LabRowObjects.ColumnList[i]).Site,';',1)) then
3109 if (TCellObject(LabRowObjects.ColumnList[i]).Data.Count > 0) and
3110 (TCellObject(LabRowObjects.ColumnList[i]).Include = '1') then
3111 begin
3112 aWPFlag := true;
3113 MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[i]).Name);
3114 FastAssign(TCellObject(LabRowObjects.ColumnList[i]).Data, aBasket);
3115 for j := 0 to aBasket.Count - 1 do
3116 MemLab.Lines.Add(' ' + aBasket[j]);
3117 end;
3118 if aWPFlag = true then
3119 begin
3120 memLab.Lines.Add('Facility: ' + Item.Caption);
3121 memLab.Lines.Add('===============================================================================');
3122 end;
3123 if uRptID = 'OR_R18:IMAGING' then
3124 begin
3125 if (Item.SubItems.Count > 8) then //has id, may have case (?)
3126 begin
3127 x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption;
3128 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3129 NotifyOtherApps(NAE_REPORT, x);
3130 end
3131 else if (Item.SubItems.Count > 4) then
3132 begin
3133 x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption;
3134 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3135 NotifyOtherApps(NAE_REPORT, x);
3136 end
3137 else if Item.SubItemImages[1] = IMG_1_IMAGE then
3138 begin
3139 memLab.Lines.Insert(0,'<Imaging links not active at this site>');
3140 memLab.Lines.Insert(1,' ');
3141 end;
3142 end;
3143 if uRptID = 'OR_PN:PROGRESS NOTES' then
3144 if (Item.SubItems.Count > 7) then
3145 begin
3146 if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0';
3147 x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption;
3148 SetPiece(x, U, 10, HasImages);
3149 NotifyOtherApps(NAE_REPORT, x);
3150 end;
3151 end;
3152 QT_PROCEDURES:
3153 begin // = 19
3154
3155 end;
3156 QT_SURGERY:
3157 begin // = 28
3158
3159 end;
3160 end;
3161 memLab.Lines.Insert(0,' ');
3162 memLab.Lines.Delete(0);
3163 end;
3164 aBasket.Free;
3165end;
3166
3167procedure TfrmLabs.SelectAll1Click(Sender: TObject);
3168var
3169 i: integer;
3170begin
3171 inherited;
3172 for i := 0 to lvReports.Items.Count - 1 do
3173 lvReports.Items[i].Selected := true;
3174end;
3175
3176procedure TfrmLabs.SelectAll2Click(Sender: TObject);
3177begin
3178 inherited;
3179 memLab.SelectAll;
3180end;
3181
3182procedure TfrmLabs.chkGraphValuesClick(Sender: TObject);
3183begin
3184 inherited;
3185 serTest.Marks.Visible := chkGraphValues.Checked;
3186end;
3187
3188procedure TfrmLabs.chkGraph3DClick(Sender: TObject);
3189begin
3190 inherited;
3191 chtChart.View3D := chkGraph3D.Checked;
3192end;
3193
3194procedure TfrmLabs.chkGraphZoomClick(Sender: TObject);
3195begin
3196 inherited;
3197 chtChart.AllowZoom := chkGraphZoom.Checked;
3198 chtChart.AnimatedZoom := chkGraphZoom.Checked;
3199 lblGraphInfo.Caption := 'To Zoom, hold down the mouse button while dragging an area to be enlarged.';
3200 if chkGraphZoom.Checked then
3201 lblGraphInfo.Caption := lblGraphInfo.Caption + #13
3202 + 'To Zoom Back drag to the upper left. You can also use the actions on the right mouse button.';
3203 lblGraphInfo.Visible := chkGraphZoom.Checked;
3204 if not chkGraphZoom.Checked then chtChart.UndoZoom;
3205end;
3206
3207procedure TfrmLabs.chkMaxFreqClick(Sender: TObject);
3208begin
3209 inherited;
3210 if chkMaxFreq.Checked = true then
3211 begin
3212 uMaxOcc := piece(uQualifier, ';', 3);
3213 SetPiece(uQualifier, ';', 3, '');
3214 end
3215 else
3216 begin
3217 SetPiece(uQualifier, ';', 3, uMaxOcc);
3218 end;
3219 tvReportsClick(self);
3220end;
3221
3222procedure TfrmLabs.GotoTop1Click(Sender: TObject);
3223begin
3224 inherited;
3225 SendMessage(memLab.Handle, WM_VSCROLL, SB_TOP, 0);
3226 {GoToTop1.Enabled := false;
3227 GoToBottom1.Enabled := true; }
3228end;
3229
3230procedure TfrmLabs.GotoBottom1Click(Sender: TObject);
3231begin
3232 Inherited;
3233 SendMessage(memLab.Handle, WM_VSCROLL, SB_BOTTOM, 0);
3234 {GoToTop1.Enabled := true;
3235 GoToBottom1.Enabled := false; }
3236end;
3237
3238procedure TfrmLabs.FreezeText1Click(Sender: TObject);
3239var
3240 Current, Desired : Longint;
3241 LineCount : Integer;
3242begin
3243 Inherited;
3244 If memLab.SelLength > 0 then begin
3245 Memo1.visible := true;
3246 Memo1.Text := memLab.SelText;
3247 If Memo1.Lines.Count <6 then
3248 LineCount := Memo1.Lines.Count + 1
3249 Else
3250 LineCount := 5;
3251 Memo1.Height := LineCount * frmLabs.Canvas.TextHeight(memLab.SelText);
3252 Current := SendMessage(memLab.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
3253 Desired := SendMessage(memLab.handle, EM_LINEFROMCHAR,
3254 memLab.SelStart + memLab.SelLength ,0);
3255 SendMessage(memLab.Handle,EM_LINESCROLL, 0, Desired - Current);
3256 uFrozen := True;
3257 end;
3258end;
3259
3260procedure TfrmLabs.UnfreezeText1Click(Sender: TObject);
3261begin
3262 Inherited;
3263 If uFrozen = True Then begin
3264 uFrozen := False;
3265 UnFreezeText1.Enabled := False;
3266 Memo1.Visible := False;
3267 Memo1.Text := '';
3268 end;
3269end;
3270
3271procedure TfrmLabs.PopupMenu3Popup(Sender: TObject);
3272begin
3273 inherited;
3274 If Screen.ActiveControl.Name <> memLab.Name then
3275 begin
3276 memLab.SetFocus;
3277 memLab.SelStart := 0;
3278 end;
3279 If memLab.SelLength > 0 Then
3280 FreezeText1.Enabled := True
3281 Else
3282 FreezeText1.Enabled := False;
3283 If Memo1.Visible Then
3284 UnFreezeText1.Enabled := True;
3285 {If memLab.SelStart > 0 then
3286 GotoTop1.Enabled := True
3287 Else
3288 GotoTop1.Enabled := False;
3289 If SendMessage(memLab.handle, EM_LINEFROMCHAR,
3290 memLab.SelStart,0) < memLab.Lines.Count then
3291 GotoBottom1.Enabled := True
3292 Else
3293 GotoBottom1.Enabled := False; }
3294 {case lstReports.ItemIEN of
3295 1: FreezeText1.Enabled := False;
3296 5: FreezeText1.Enabled := False;
3297 6: FreezeText1.Enabled := False;
3298 end; }
3299end;
3300
3301procedure TfrmLabs.ProcessNotifications;
3302var
3303 //AlertDate, CurrentDate: TFMDateTime;
3304 OrderIFN: string;
3305begin
3306 {uNewest := '';
3307 uOldest := '';
3308 GetNewestOldest(Patient.DFN, uNewest, uOldest); }
3309 {AlertDate := Trunc(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3)));
3310 CurrentDate := FMToday;
3311 lstReports.ItemIndex := 2;
3312 if AlertDate = CurrentDate then
3313 begin
3314 lstDates.ItemIndex := 0;
3315 lstReports.ItemIndex := 0;
3316 end
3317 else if CurrentDate - AlertDate < 7 then lstDates.ItemIndex := 2
3318 else if CurrentDate - AlertDate < 14 then lstDates.ItemIndex := 3
3319 else if CurrentDate - AlertDate < 28 then lstDates.ItemIndex := 4
3320 else lstDates.ItemIndex := 5;
3321
3322 lstReportsClick(self); }
3323
3324 OrderIFN := Piece(Notifications.AlertData, '@', 1);
3325 if StrToIntDef(OrderIFN,0) > 0 then
3326 begin
3327 //the following if condition & clause resolves CQ 16405 & 17076 - a mixture of two different patient's lab results in one display (TC).
3328 if (AnsiContainsStr(tvReports.Selected.Text, 'Microbiology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Anatomic Pathology'))
3329 or (AnsiContainsStr(tvReports.Selected.Text, 'Cytology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Electron Microscopy'))
3330 or (AnsiContainsStr(tvReports.Selected.Text, 'Surgical Pathology')) and (lvReports.Visible = TRUE) then
3331 begin
3332 lvReports.Visible := FALSE;
3333 end;
3334 tvReports.Selected := tvReports.TopItem; //moved here to fix the conflicting lab results caption header that is displayed with the alert message text.
3335 DisplayHeading(''); //fixes part B of CQ #17548 - CPRS v28.1 (TC)
3336 lstDates.ItemIndex := -1;
3337 Memo1.Visible := false;
3338 lblHeaders.Visible := false;
3339 lstHeaders.Visible := false;
3340 pnlOtherTests.Visible := false;
3341 lblDates.Visible := true;
3342 lstDates.Visible := true;
3343 pnlHeader.Visible := false;
3344 grdLab.Visible := false;
3345 pnlChart.Visible := false;
3346 //WebBrowser1.Visible := false; **Browser Remove**
3347 //WebBrowser1.SendToBack; **Browser Remove**
3348 memLab.Visible := true;
3349 memLab.BringToFront;
3350 pnlFooter.Visible := true;
3351 memLab.Clear;
3352 uLabLocalReportData.Clear;
3353 uLabRemoteReportData.Clear;
3354 pnlRightTop.Height := 5;
3355 memLab.Align := alClient;
3356 FormResize(self);
3357 QuickCopy(ResultOrder(OrderIFN), memLab);
3358 memLab.SelStart := 0;
3359 memLab.Repaint;
3360 lblHeading.Caption := Notifications.Text;
3361 end
3362 else
3363 begin
3364 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
3365 tvReports.Selected := tvReports.Items.GetFirstNode;
3366 tvReportsClick(self);
3367 end;
3368
3369 case Notifications.FollowUp of
3370 NF_LAB_RESULTS : Notifications.Delete;
3371 NF_ABNORMAL_LAB_RESULTS : Notifications.Delete;
3372 NF_SITE_FLAGGED_RESULTS : Notifications.Delete;
3373 NF_STAT_RESULTS : Notifications.Delete;
3374 NF_CRITICAL_LAB_RESULTS : Notifications.Delete;
3375 NF_LAB_THRESHOLD_EXCEEDED : Notifications.Delete;
3376 end;
3377end;
3378
3379procedure TfrmLabs.chkZoomClick(Sender: TObject);
3380begin
3381 inherited;
3382 chtChart.AllowZoom := chkZoom.Checked;
3383 chtChart.AnimatedZoom := chkZoom.Checked;
3384 if not chkZoom.Checked then
3385 begin
3386 chtChart.UndoZoom;
3387 chtChart.ZoomPercent(ZOOM_PERCENT);
3388 end;
3389end;
3390
3391procedure TfrmLabs.chtChartUndoZoom(Sender: TObject);
3392begin
3393 inherited;
3394 chtChart.BottomAxis.Automatic := true;
3395end;
3396
3397procedure TfrmLabs.popCopyClick(Sender: TObject);
3398begin
3399 inherited;
3400 chtChart.CopyToClipboardBitmap;
3401end;
3402
3403procedure TfrmLabs.popChartPopup(Sender: TObject);
3404begin
3405 inherited;
3406 if pnlWorksheet.Visible then
3407 begin
3408 popValues.Checked := chkValues.Checked;
3409 pop3D.Checked := chk3D.Checked;
3410 popZoom.Checked := chkZoom.Checked;
3411 end
3412 else
3413 begin
3414 popValues.Checked := chkGraphValues.Checked;
3415 pop3D.Checked := chkGraph3D.Checked;
3416 popZoom.Checked := chkGraphZoom.Checked;
3417 end;
3418 popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
3419 if chtChart.Hint <> '' then
3420 begin
3421 popDetails.Caption := chtChart.Hint;
3422 popDetails.Enabled := true;
3423 end
3424 else
3425 begin
3426 popDetails.Caption := 'Details';
3427 popDetails.Enabled := false;
3428 end;
3429end;
3430
3431procedure TfrmLabs.popValuesClick(Sender: TObject);
3432begin
3433 inherited;
3434 if pnlWorksheet.Visible then
3435 begin
3436 chkValues.Checked := not chkValues.Checked;
3437 chkValuesClick(self);
3438 end
3439 else
3440 begin
3441 chkGraphValues.Checked := not chkGraphValues.Checked;
3442 chkGraphValuesClick(self);
3443 end;
3444end;
3445
3446procedure TfrmLabs.pop3DClick(Sender: TObject);
3447begin
3448 inherited;
3449 if pnlWorksheet.Visible then
3450 begin
3451 chk3D.Checked := not chk3D.Checked;
3452 chk3DClick(self);
3453 end
3454 else
3455 begin
3456 chkGraph3D.Checked := not chkGraph3D.Checked;
3457 chkGraph3DClick(self);
3458 end;
3459end;
3460
3461procedure TfrmLabs.popZoomClick(Sender: TObject);
3462begin
3463 inherited;
3464 if pnlWorksheet.Visible then
3465 begin
3466 chkZoom.Checked := not chkZoom.Checked;
3467 chkZoomClick(self);
3468 end
3469 else
3470 begin
3471 chkGraphZoom.Checked := not chkGraphZoom.Checked;
3472 chkGraphZoomClick(self);
3473 end;
3474end;
3475
3476procedure TfrmLabs.popZoomBackClick(Sender: TObject);
3477begin
3478 inherited;
3479 chtChart.UndoZoom;
3480end;
3481
3482procedure TfrmLabs.chtChartMouseDown(Sender: TObject; Button: TMouseButton;
3483 Shift: TShiftState; X, Y: Integer);
3484begin
3485 inherited;
3486 chtChart.Hint := '';
3487 chtChart.Tag := 0;
3488end;
3489
3490procedure TfrmLabs.chtChartClickSeries(Sender: TCustomChart;
3491 Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
3492 Shift: TShiftState; X, Y: Integer);
3493begin
3494 inherited;
3495 if Series = serHigh then exit;
3496 if Series = serLow then exit;
3497 uDate1 := Series.XValue[ValueIndex];
3498 uDate2 := uDate1;
3499 chtChart.Hint := 'Details - Lab results for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
3500 chtChart.Tag := ValueIndex + 1;
3501 if Button <> mbRight then popDetailsClick(self);
3502end;
3503
3504procedure TfrmLabs.chtChartClickLegend(Sender: TCustomChart;
3505 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3506begin
3507 inherited;
3508 chtChart.Hint := 'Details - for ' + Piece(serTest.Title, '(', 1) + '...';
3509 chtChart.Tag := 0;
3510 if Button <> mbRight then popDetailsClick(self);
3511end;
3512
3513procedure TfrmLabs.popDetailsClick(Sender: TObject);
3514var
3515 tmpList: TStringList;
3516 date1, date2: TFMDateTime;
3517 strdate1, strdate2: string;
3518begin
3519 inherited;
3520 Screen.Cursor := crHourGlass;
3521 if chtChart.Tag > 0 then
3522 begin
3523 tmpList := TStringList.Create;
3524 try
3525 strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
3526 strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
3527 uDate1 := StrToDateTime(strdate1);
3528 uDate2 := StrToDateTime(strdate2);
3529 date1 := DateTimeToFMDateTime(uDate1 + 1);
3530 date2 := DateTimeToFMDateTime(uDate2);
3531 StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
3532 Interim(tmpList, Patient.DFN, date1, date2,'ORWLRR INTERIM');
3533 ReportBox(tmpList, 'Lab results on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
3534 finally
3535 tmplist.Free;
3536 end;
3537 end
3538 else
3539 begin
3540 date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
3541 date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
3542 tmpList := TStringList.Create;
3543 try
3544 if lstTestGraph.ItemIndex > -1 then
3545 tmpList.Add(lstTestGraph.Items[lstTestGraph.ItemIndex])
3546 else
3547 tmpList.Add(Piece(lblSingleTest.Caption, '^', 1));
3548 StatusText('Retrieving data for ' + serTest.Title + '...');
3549 ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + 'results on ' + Patient.Name, True);
3550 finally
3551 tmpList.Free;
3552 end;
3553 end;
3554 Screen.Cursor := crDefault;
3555 StatusText('');
3556end;
3557
3558procedure TfrmLabs.popPrintClick(Sender: TObject);
3559begin
3560 inherited;
3561 if chtChart.Visible then PrintLabGraph;
3562end;
3563
3564procedure TfrmLabs.PrintLabGraph;
3565var
3566 GraphTitle: string;
3567begin
3568 inherited;
3569 GraphTitle := Piece(lblSingleTest.Caption, '^', 2);
3570 if (Length(lblSpecimen.Caption) > 2) then GraphTitle := GraphTitle + ' (' + Piece(lblSpecimen.Caption, '^', 2) + ')';
3571 GraphTitle := GraphTitle + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
3572 if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
3573end;
3574
3575procedure TfrmLabs.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
3576var
3577 datetemp: TFMDateTime;
3578 today, datetime1, datetime2: TDateTime;
3579 relativedate: string;
3580begin
3581 today := FMToDateTime(floattostr(FMToday));
3582 relativedate := Piece(lstDates.ItemID, ';', 1);
3583 relativedate := Piece(relativedate, '-', 2);
3584 ADaysBack := strtointdef(relativedate, 0);
3585 ADate1 := DateTimeToFMDateTime(today - ADaysBack);
3586 relativedate := Piece(lstDates.ItemID, ';', 2);
3587 if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
3588 begin
3589 relativedate := Piece(relativedate, '+', 2);
3590 ADaysBack := strtointdef(relativedate, 0);
3591 ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
3592 end
3593 else
3594 begin
3595 relativedate := Piece(relativedate, '-', 2);
3596 ADaysBack := strtointdef(relativedate, 0);
3597 ADate2 := DateTimeToFMDateTime(today - ADaysBack);
3598 end;
3599 datetime1 := FMDateTimeToDateTime(ADate1);
3600 datetime2 := FMDateTimeToDateTime(ADate2);
3601 if datetime1 < datetime2 then // reorder dates, if needed
3602 begin
3603 datetemp := ADate1;
3604 ADate1 := ADate2;
3605 ADate2 := datetemp
3606 end;
3607 ADate1 := ADate1 + 0.2359;
3608end;
3609
3610procedure TfrmLabs.Timer1Timer(Sender: TObject);
3611var
3612 i,j,fail: integer;
3613 r0: String;
3614begin
3615 inherited;
3616 with RemoteSites.SiteList do
3617 begin
3618 for i := 0 to Count - 1 do
3619 if TRemoteSite(Items[i]).Selected then
3620 begin
3621 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
3622 begin
3623 r0 := GetRemoteStatus(TRemoteSite(Items[i]).LabRemoteHandle);
3624 TRemoteSite(Items[i]).LabQueryStatus := r0; //r0='1^Done' if no errors
3625 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2));
3626 if piece(r0,'^',1) = '1' then
3627 begin
3628 GetRemoteData(TRemoteSite(Items[i]).LabData,
3629 TRemoteSite(Items[i]).LabRemoteHandle,Items[i]);
3630 RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery,
3631 TRemoteSite(Items[i]).LabRemoteHandle);
3632 TRemoteSite(Items[i]).LabRemoteHandle := '';
3633 TabControl1.OnChange(nil);
3634 if (length(piece(uHState,';',2)) > 0) then
3635 begin
3636 uRemoteReportData.Clear;
3637 QuickCopy(TRemoteSite(Items[i]).LabData,uRemoteReportData);
3638 fail := 0;
3639 if uRemoteReportData.Count > 0 then
3640 begin
3641 if uRemoteReportData[0] = 'Report not available at this time.' then
3642 begin
3643 fail := 1;
3644 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available');
3645 end;
3646 if piece(uRemoteReportData[0],'^',1) = '-1' then
3647 begin
3648 fail := 1;
3649 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure');
3650 end;
3651 if fail = 0 then
3652 LoadListView(uRemoteReportData);
3653 end;
3654 end;
3655 end
3656 else
3657 begin
3658 uRemoteCount := uRemoteCount + 1;
3659 if uRemoteCount > 90 then //~7 minute limit
3660 begin
3661 TRemoteSite(Items[i]).LabRemoteHandle := '';
3662 TRemoteSite(Items[i]).LabQueryStatus := '-1^Timed out';
3663 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Timed out');
3664 StatusText('');
3665 TabControl1.OnChange(nil);
3666 end
3667 else
3668 StatusText('Retrieving Lab data from '
3669 + TRemoteSite(Items[i]).SiteName + '...');
3670 end;
3671 Timer1.Interval := 10000;
3672 end;
3673 end;
3674 if Timer1.Enabled = True then
3675 begin
3676 j := 0;
3677 for i := 0 to Count -1 do
3678 begin
3679 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
3680 begin
3681 j := 1;
3682 break;
3683 end;
3684 end;
3685 if j = 0 then //Shutdown timer if all sites have been processed
3686 begin
3687 Timer1.Enabled := False;
3688 StatusText('');
3689 end;
3690 j := 0;
3691 for i := 0 to Count -1 do
3692 if TRemoteSite(Items[i]).Selected = true then
3693 begin
3694 j := 1;
3695 break;
3696 end;
3697 if j = 0 then //Shutdown timer if user has de-selected all sites
3698 begin
3699 Timer1.Enabled := False;
3700 StatusText('');
3701 TabControl1.OnChange(nil);
3702 end;
3703 end;
3704 end;
3705end;
3706
3707procedure TfrmLabs.tvReportsClick(Sender: TObject);
3708var
3709 i: integer;
3710 aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x, x1, x2: string;
3711 aIFN, aOldID: integer;
3712 aID, aHSTag, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
3713 CurrentNode: TTreeNode;
3714begin
3715 inherited;
3716 if (Length(lblHeading.Caption) > 0) and (Length(frmFrame.stsArea.Panels.Items[1].Text) > 0) then
3717 begin //ProcessNotfications post-cleanup and clearing of notification message text
3718 lblHeading.Caption := ''; //in the header and status bar display when clicking to view lab results.
3719 frmFrame.stsArea.Panels.Items[1].Text := '';
3720 end;
3721 lvReports.Hint := 'To sort, click on column headers|';
3722 tvReports.TopItem := tvReports.Selected;
3723 uRemoteCount := 0;
3724 uReportInstruction := '';
3725 aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading;
3726 aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote;
3727 aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType;
3728 aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
3729 aID := PReportTreeObject(tvReports.Selected.Data)^.ID;
3730 aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName;
3731 aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag;
3732 aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category;
3733 aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder;
3734 aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack;
3735 aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0);
3736 aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct;
3737 aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR;
3738 aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE;
3739 aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
3740 aStartTime := Piece(aQualifier,';',1);
3741 aStopTime := Piece(aQualifier,';',2);
3742 aMax := Piece(aQualifier,';',3);
3743 aRptCode := Piece(aQualifier,';',4);
3744 aQualifierID:= '';
3745 lstQualifier.ItemIndex := -1;
3746 if length(uColChange) > 0 then
3747 begin
3748 aColChange := '';
3749 for i := 0 to lvReports.Columns.Count - 1 do
3750 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
3751 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
3752 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
3753 uColChange := '';
3754 end;
3755 if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then
3756 begin
3757 aReportType := 'R';
3758 aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID));
3759 aID := '1';
3760 aRPC := 'ORWRP REPORT TEXT';
3761 aHSTag := '';
3762 end;
3763 uLabLocalReportData.Clear;
3764 uLabRemoteReportData.Clear;
3765 if aReportType = '' then aReportType := 'R';
3766 uReportRPC := aRPC;
3767 uRptID := aID;
3768 uLabRepID := aID;
3769 uDirect := aDirect;
3770 uReportType := aReportType;
3771 uQualifier := aQualifier;
3772 uSortOrder := aSortOrder;
3773 uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
3774 pnlRightTop.Height := lblTitle.Height; // see below
3775 RedrawSuspend(tvReports.Handle);
3776 RedrawSuspend(memLab.Handle);
3777 uHState := aHSTag;
3778 Timer1.Enabled := False;
3779 HideTabControl;
3780 sptHorzRight.Visible := true;
3781 lvReports.Visible := false;
3782 if (aRemote = '1') or (aRemote = '2') then
3783 if not(uReportType = 'V') then
3784 ShowTabControl;
3785 StatusText('');
3786 uHTMLDoc := '';
3787 //WebBrowser1.Navigate('about:blank'); **Browser Remove**
3788 memLab.Lines.Clear;
3789 memLab.Parent := pnlRightBottom;
3790 memLab.Align := alClient;
3791 lvReports.SmallImages := uEmptyImageList;
3792 lvReports.Items.Clear;
3793 lvReports.Columns.Clear;
3794 DisplayHeading('');
3795 if uReportType = 'H' then
3796 begin
3797 lvReports.Visible := false;
3798 pnlRightBottom.Visible := true;
3799 {WebBrowser1.Visible := true; **Browser Remove**
3800 WebBrowser1.TabStop := true;
3801 WebBrowser1.Navigate('about:blank');
3802 WebBrowser1.BringToFront; }
3803 memLab.Visible := false;
3804 memLab.TabStop := false;
3805 end
3806 else
3807 if uReportType = 'V' then
3808 begin
3809 with lvReports do
3810 begin
3811 RedrawSuspend(lvReports.Handle);
3812 Columns.BeginUpdate;
3813 ViewStyle := vsReport;
3814 ColumnHeaders(uColumns, IntToStr(aIFN));
3815 for i := 0 to uColumns.Count -1 do
3816 begin
3817 uNewColumn := Columns.Add;
3818 uNewColumn.Caption := piece(uColumns.Strings[i],'^',1);
3819 if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^';
3820 if piece(uColumns.Strings[i],'^',2) = '1' then
3821 begin
3822 uNewColumn.Width := 0;
3823 uColChange := uColChange + '0,';
3824 end
3825 else
3826 if length(piece(uColumns.Strings[i],'^',10)) > 0 then
3827 begin
3828 uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ',';
3829 uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10))
3830 end
3831 else
3832 uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text
3833 if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then
3834 uNewColumn.Width := 0;
3835 end;
3836 Columns.EndUpdate;
3837 RedrawActivate(lvReports.Handle);
3838 end;
3839 lvReports.Visible := true;
3840 sptHorzRight.Visible := true;
3841 //WebBrowser1.Visible := false; **Browser Remove**
3842 //WebBrowser1.TabStop := false; **Browser Remove**
3843 pnlRightBottom.Visible := true;
3844 memLab.Visible := true;
3845 memLab.TabStop := true;
3846 memLab.BringToFront;
3847 RedrawActivate(memLab.Handle);
3848 end
3849 else
3850 begin
3851 lvReports.Visible := true;
3852 sptHorzRight.Visible := false;
3853 //WebBrowser1.Visible := false; **Browser Remove**
3854 //WebBrowser1.TabStop := false; **Browser Remove**
3855 pnlRightBottom.Visible := True;
3856 memLab.Visible := true;
3857 memLab.TabStop := true;
3858 memLab.BringToFront;
3859 RedrawActivate(memLab.Handle);
3860 end;
3861 uLocalReportData.Clear;
3862 LabRowObjects.Clear;
3863 uRemoteReportData.Clear;
3864 lstHeaders.Visible := false;
3865 lstHeaders.TabStop := false;
3866 lblHeaders.Visible := false;
3867 lstHeaders.Clear;
3868 for i := 0 to RemoteSites.SiteList.Count - 1 do
3869 TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
3870 if uFrozen = True then
3871 begin
3872 memo1.visible := False;
3873 memo1.TabStop := False;
3874 end;
3875 Screen.Cursor := crHourGlass;
3876 if aReportType = 'M' then
3877 begin
3878 pnlLeftBottom.Visible := false;
3879 splitter1.Visible := false;
3880 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
3881 memLab.Clear;
3882 chkBrowser;
3883 pnlHeader.Visible := false;
3884 sptHorzRight.Visible := true;
3885 lvReports.Visible := false;
3886 pnlRighttop.Height := lblHeading.Height;
3887 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height);
3888 pnlRightTop.Visible := true;
3889 memLab.Align := alClient;
3890 FormResize(self);
3891 end
3892 else
3893 begin
3894 uQualifierType := StrToIntDef(aRptCode,0);
3895 case uQualifierType of
3896 QT_OTHER:
3897 begin // = 0
3898 memLab.Lines.Clear;
3899 If aID = '1:MOST RECENT' then
3900 begin
3901 CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false);
3902 pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5);
3903 pnlRightTop.Visible := true;
3904 pnlButtons.Visible := true;
3905 pnlWorksheet.Visible := false;
3906 pnlGraph.Visible := false;
3907 memLab.Align := alBottom;
3908 pnlRightTop.Align := alTop;
3909 pnlRightBottom.Align := alclient;
3910 sptHorzRight.Visible := true;
3911 pnlRightBottom.Visible := true;
3912 pnlRightBottom.Height := pnlLeft.Height div 5;
3913 memLab.Height := pnlLeft.Height div 5;
3914 grdLab.Align := alTop;
3915 memLab.Clear;
3916 {if uReportType = 'H' then **Browser Remove**
3917 begin
3918 WebBrowser1.Navigate('about:blank');
3919 WebBrowser1.Align := alBottom;
3920 WebBrowser1.Height := pnlLeft.Height div 5;
3921 WebBrowser1.Visible := true;
3922 WebBrowser1.BringToFront;
3923 memLab.Visible := false;
3924 end
3925 else
3926 begin
3927 WebBrowser1.Visible := false;
3928 WebBrowser1.SendToBack; }
3929 memLab.Visible := true;
3930 memLab.BringToFront;
3931 //end; }
3932 FormResize(self);
3933 cmdRecentClick(self);
3934 uPrevReportNode := tvReports.Selected;
3935 end
3936 else if aID = '4:SELECTED TESTS BY DATE' then
3937 begin // Interim for Selected Tests
3938 if uPrevReportNode <> tvReports.Selected then
3939 begin
3940 lstTests.Clear;
3941 lblSpecimen.Caption := '';
3942 end;
3943 SelectTests(Font.Size);
3944 if lstTests.Items.Count > 0 then
3945 begin
3946 CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false);
3947 pnlRighttop.Height := lblHeading.Height + lblTitle.Height;
3948 pnlRightTop.Visible := false;
3949 memLab.Clear;
3950 chkBrowser;
3951 FormResize(self);
3952 RedrawActivate(memLab.Handle);
3953 lstDatesClick(self);
3954 //lstQualifierClick(self);
3955 cmdOtherTests.SetFocus;
3956 cmdOtherTests.Default := true;
3957 uPrevReportNode := tvReports.Selected;
3958 end
3959 else
3960 begin
3961 uPrevReportNode := tvReports.Items.GetFirstNode;
3962 tvReports.Selected := uPrevReportNode;
3963 tvReportsClick(self);
3964 end;
3965 end
3966 else if aID = '5:WORKSHEET' then
3967 begin // Worksheet
3968 if uPrevReportNode <> tvReports.Selected then
3969 begin
3970 lstTests.Clear;
3971 lblSpecimen.Caption := '';
3972 end;
3973 SelectTestGroups(Font.Size);
3974 if lstTests.Items.Count > 0 then
3975 begin
3976 CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false);
3977 pnlRighttop.Height := pnlRight.Height - (pnlRight.Height div 4);
3978 pnlRightTop.Visible := true;
3979 pnlHeader.Align := alTop;
3980 pnlChart.Align := alTop;
3981 sptHorzRight.Visible := true;
3982 chtChart.Visible := true;
3983 memLab.Visible := false;
3984 pnlButtons.Visible := false;
3985 pnlWorksheet.Visible := true;
3986 pnlGraph.Visible := false;
3987 lstTestGraph.Width := 97;
3988 ragCorG.ItemIndex := 0;
3989 FormResize(self);
3990 lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
3991 //chkZoom.Checked := false;
3992 //chkZoomClick(self);
3993 //lstDatesClick(self);
3994 //lstQualifierClick(self);
3995 cmdOtherTests.SetFocus;
3996 cmdOtherTests.Default := true;
3997 uPrevReportNode := tvReports.Selected;
3998 if lstDates.ItemIndex = -1 then
3999 if Patient.Inpatient then lstDates.ItemIndex := 2
4000 else lstDates.ItemIndex := 4;
4001 //for i := 1 to lstDates.Count - 1 do //Sets default date range to next item > 1 Month (which should be 6 months)
4002 //if strToInt(piece(lstDates.Items[i],'^',1)) > 31 then
4003 //begin
4004 //lstDates.ItemIndex := i;
4005 //break;
4006 //end;
4007 lstDatesClick(self);
4008 if ScreenReaderSystemActive then
4009 grdLab.SetFocus;
4010 end
4011 else
4012 begin
4013 uPrevReportNode := tvReports.Items.GetFirstNode;
4014 tvReports.Selected := uPrevReportNode;
4015 tvReportsClick(self);
4016 end;
4017 end
4018
4019 else if aID = '6:GRAPH' then
4020 begin // Graph
4021 // do if graphing is activiated
4022 if uGraphingActivated then
4023 begin
4024 memLab.Clear;
4025 chkBrowser;
4026 FormResize(self);
4027 memLab.Align := alClient;
4028 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
4029 pnlRightTop.Visible := false;
4030 RedrawActivate(memLab.Handle);
4031 StatusText('');
4032 memLab.Lines.Insert(0, ' ');
4033 memLab.Lines.Insert(1, 'Graphing activated');
4034 memLab.SelStart := 0;
4035 frmFrame.mnuToolsGraphingClick(self); // make it just lab tests ??
4036 //tvReports.Selected := uPrevReportNode;
4037 end
4038 else // otherwise, do lab graph
4039 begin
4040 if uPrevReportNode <> tvReports.Selected then
4041 begin
4042 lblSingleTest.Caption := '';
4043 lblSpecimen.Caption := '';
4044 end;
4045 SelectTest(Font.Size);
4046 if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
4047 begin
4048 CommonComponentVisible(false,false,true,true,true,true,false,false,true,false,false,false);
4049 pnlChart.Visible := true;
4050 chtChart.Visible := true;
4051 pnlButtons.Visible := false;
4052 pnlWorksheet.Visible := false;
4053 pnlGraph.Visible := true;
4054 memLab.Height := pnlRight.Height div 5;
4055 memLab.Clear;
4056 {if uReportType = 'H' then **Browser Remove**
4057 begin
4058 WebBrowser1.Visible := true;
4059 WebBrowser1.Navigate('about:blank');
4060 WebBrowser1.Height := pnlRight.Height div 5;
4061 WebBrowser1.BringToFront;
4062 memLab.Visible := false;
4063 end
4064 else
4065 begin
4066 WebBrowser1.Visible := false;
4067 WebBrowser1.SendToBack; }
4068 memLab.Visible := true;
4069 memLab.BringToFront;
4070 //end; }
4071 lstTestGraph.Items.Clear;
4072 lstTestGraph.Width := 0;
4073 FormResize(self);
4074 RedrawActivate(memLab.Handle);
4075 lblFooter.Caption := '';
4076 chkGraphZoom.Checked := false;
4077 chkGraphZoomClick(self);
4078 chkGraph3DClick(self);
4079 chkGraphValuesClick(self);
4080 lstDatesClick(self);
4081 //lstQualifierClick(self);
4082 cmdOtherTests.SetFocus;
4083 cmdOtherTests.Default := true;
4084 uPrevReportNode := tvReports.Selected;
4085 end
4086 else
4087 tvReports.Selected := uPrevReportNode;
4088 end;
4089 end
4090
4091 else if (aID = '9:MICROBIOLOGY') or (aID = '20:ANATOMIC PATHOLOGY') or (aID = '2:BLOOD BANK') or (aID = '10:LAB STATUS') or (aID = '3:ALL TESTS BY DATE') or (aID = '21:CUMULATIVE') or (aID = '27:AUTOPSY') then
4092 begin
4093 //added to deal with other reports from file 101.24
4094 memLab.Clear;
4095 chkBrowser;
4096 pnlHeader.Visible := false;
4097 pnlRightTop.Visible := false;
4098 pnlRightBottom.Visible := false;
4099 sptHorzRight.Visible := false;
4100 pnlRightTop.Height := lblHeading.Height;
4101 if ((aRemote = '1') or (aRemote = '2')) then
4102 ShowTabControl;
4103 pnlRightTopHeader.Align := alTop;
4104 pnlRightTop.Align := alTop;
4105 TabControl1.Align := alTop;
4106 pnlRightBottom.Align := alclient;
4107 sptHorzRight.Visible := true;
4108 pnlRightBottom.Visible := true;
4109 lvReports.Visible := false;
4110 memLab.Align := alClient;
4111 if lstDates.ItemIndex = -1 then
4112 if Patient.Inpatient then lstDates.ItemIndex := 2
4113 else lstDates.ItemIndex := 4;
4114 {for i := 1 to lstDates.Count - 1 do //Sets default date range to next item > 1 Month (which should be 6 months)
4115 if strToInt(piece(lstDates.Items[i],'^',1)) > 31 then
4116 begin
4117 lstDates.ItemIndex := i;
4118 break;
4119 end; }
4120 FormResize(self);
4121 aOldID := 1;
4122 if aID = '9:MICROBIOLOGY' then aOldID := 4;
4123 //if aID = '20:ANATOMIC PATHOLOGY' then AOldID := 8;
4124 if aID = '2:BLOOD BANK' then AOldID := 9;
4125 if aID = '10:LAB STATUS' then AOldID := 10;
4126 if aID = '3:ALL TESTS BY DATE' then AOldID := 3;
4127 if aID = '21:CUMULATIVE' then AOldID := 2;
4128 case StrToInt(aCategory) of
4129 {Categories of reports:
4130 0:Fixed
4131 1:Fixed w/Dates
4132 2:Fixed w/Headers
4133 3:Fixed w/Dates & Headers
4134 4:Specialized
4135 5:Graphic}
4136
4137 0: begin
4138 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
4139 StatusText('Retrieving data...');
4140 GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0);
4141 //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4142 TabControl1.OnChange(nil);
4143 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(aID,':',1), '0', '9999', '1', 0, 0, uReportRPC);
4144 if TabControl1.TabIndex < 1 then
4145 QuickCopy(uLabLocalReportData,memLab);
4146 RedrawActivate(memLab.Handle);
4147 StatusText('');
4148 memLab.Lines.Insert(0,' ');
4149 memLab.Lines.Delete(0);
4150 memLab.SelStart := 0;
4151 if uReportType = 'R' then
4152 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
4153 else
4154 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
4155 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
4156 end;
4157 1: begin
4158 CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false);
4159 memLab.Repaint;
4160 lstDatesClick(self);
4161 //lstQualifierClick(self);
4162 end;
4163 2: begin
4164 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
4165 lstHeaders.Clear;
4166 StatusText('Retrieving data...');
4167 GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0);
4168 //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4169 TabControl1.OnChange(nil);
4170 Reports(uLabLocalReportData,Patient.DFN, Piece(aID,':',1), '0', '9999', '1', 0, 0, uReportRPC);
4171 if uLabLocalReportData.Count > 0 then
4172 begin
4173 TabControl1.OnChange(nil);
4174 if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
4175 end;
4176 RedrawActivate(memLab.Handle);
4177 StatusText('');
4178 memLab.Lines.Insert(0,' ');
4179 memLab.Lines.Delete(0);
4180 if uReportType = 'R' then
4181 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
4182 else
4183 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
4184 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
4185 end;
4186 3: begin
4187 CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false);
4188 lstDatesClick(self);
4189 //lstQualifierClick(self);
4190 memLab.Lines.Insert(0,' ');
4191 memLab.Lines.Delete(0);
4192 end;
4193 end;
4194 uPrevReportNode := tvReports.Selected;
4195 end
4196
4197 //else if aID = '20:ANATOMIC PATHOLOGY' then
4198
4199 //else if aID = '2:BLOOD BANK' then
4200
4201 //else if aID = '10:LAB STATUS' then
4202
4203
4204 else
4205 begin
4206 pnlLeftBottom.Visible := false;
4207 splitter1.Visible := false;
4208 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
4209 pnlRightTop.Visible := true;
4210 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4211 GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4212 uReportInstruction := #13#10 + 'Retrieving data...';
4213 TabControl1.OnChange(nil);
4214 if not(piece(uRemoteType, '^', 9) = '1') then
4215 LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState);
4216 QuickCopy(uLocalReportData, memLab);
4217 if uLocalReportData.Count > 0 then
4218 TabControl1.OnChange(nil);
4219 StatusText('');
4220 uPrevReportNode := tvReports.Selected;
4221 end;
4222 end;
4223 QT_DATERANGE:
4224 begin // = 2
4225
4226 ListReportDateRanges(lstQualifier.Items);
4227 if lstQualifier.ItemID = '' then
4228 begin
4229 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4230 lvReports.SmallImages := uEmptyImageList;
4231 lvReports.Items.Clear;
4232 lstQualifierClick(self);
4233 end
4234 else
4235 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4236
4237 lblQualifier.Caption := 'Date Range';
4238 pnlLeftBottom.Visible := true;
4239 splitter1.Visible := true;
4240 uPrevReportNode := tvReports.Selected;
4241 end;
4242 QT_HSCOMPONENT:
4243 begin // = 5
4244 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 4);
4245 pnlLeftBottom.Visible := false;
4246 splitter1.Visible := false;
4247 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4248 uReportInstruction := #13#10 + 'Retrieving data...';
4249 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,true,true);
4250 pnlRightTop.Visible := true;
4251 lvReports.Visible := true;
4252 lvReports.SmallImages := uEmptyImageList;
4253 lvReports.Items.Clear;
4254 LabRowObjects.Clear;
4255 memLab.Lines.Clear;
4256 if (length(piece(aHSTag,';',2)) > 0) then
4257 begin
4258 if aCategory <> '0' then
4259 begin
4260 ListReportDateRanges(lstQualifier.Items);
4261 aQualifierID := lstQualifier.ItemID;
4262 if aQualifierID = '' then
4263 begin
4264 if aHDR = '1' then
4265 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4266 else
4267 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4268 lstQualifierClick(self);
4269 end
4270 else
4271 begin
4272 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4273 if aHDR = '1' then
4274 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4275 else
4276 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4277 lstQualifierClick(self);
4278 end;
4279 lblQualifier.Caption := 'Date Range';
4280 pnlLeftBottom.Visible := true;
4281 splitter1.Visible := true;
4282 end
4283 else
4284 begin
4285 if not (aRemote = '2' ) then
4286 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4287 if not(piece(uRemoteType, '^', 9) = '1') then
4288 begin
4289 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4290 LoadListView(uLocalReportData);
4291 end;
4292 end;
4293 end
4294 else
4295 begin
4296 if (aRemote = '1') or (aRemote = '2') then
4297 if TabControl1.Tabs.Count > 1 then
4298 ShowTabControl;
4299 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4300 if not(piece(uRemoteType, '^', 9) = '1') then
4301 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4302 if uLocalReportData.Count < 1 then
4303 uReportInstruction := '<No Report Available>'
4304 else
4305 begin
4306 if TabControl1.TabIndex < 1 then
4307 QuickCopy(uLocalReportData,memLab);
4308 end;
4309 TabControl1.OnChange(nil);
4310 if aCategory <> '0' then
4311 begin
4312 ListReportDateRanges(lstQualifier.Items);
4313 if lstQualifier.ItemID = '' then
4314 begin
4315 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4316 lstQualifierClick(self);
4317 end
4318 else
4319 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4320
4321 lblQualifier.Caption := 'Date Range';
4322 pnlLeftBottom.Visible := true;
4323 splitter1.Visible := true;
4324 end
4325 else
4326 begin
4327 if uLocalReportData.Count < 1 then
4328 begin
4329 uReportInstruction := '<No Report Available>';
4330 memLab.Lines.Add(uReportInstruction);
4331 end
4332 else
4333 begin
4334 QuickCopy(uLocalReportData,memLab);
4335 TabControl1.OnChange(nil);
4336 end;
4337 end;
4338 end;
4339 StatusText('');
4340 uPrevReportNode := tvReports.Selected;
4341 end;
4342 QT_HSWPCOMPONENT:
4343 begin // = 6
4344 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 2);
4345 sptHorzRight.top := pnlRightTop.Height;
4346 uScreenSplitLoc := sptHorzRight.Top;
4347 pnlLeftBottom.Visible := false;
4348 splitter1.Visible := false;
4349 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4350 uReportInstruction := #13#10 + 'Retrieving data...';
4351 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
4352 pnlRightTop.Visible := true;
4353 lvReports.Visible := true;
4354 sptHorzRight.Visible := true;
4355 memLab.Visible := true;
4356 TabControl1.OnChange(nil);
4357 LabRowObjects.Clear;
4358 memLab.Lines.Clear;
4359 lvReports.SmallImages := uEmptyImageList;
4360 lvReports.Items.Clear;
4361 memLab.Repaint;
4362 if (length(piece(aHSTag,';',2)) > 0) then
4363 begin
4364 if aCategory <> '0' then
4365 begin
4366 ListReportDateRanges(lstQualifier.Items);
4367 aQualifierID := lstQualifier.ItemID;
4368 if aQualifierID = '' then
4369 begin
4370 if aHDR = '1' then
4371 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4372 else
4373 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4374 lstQualifierClick(self);
4375 end
4376 else
4377 begin
4378 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4379 if aHDR = '1' then
4380 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
4381 else
4382 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4383 lstQualifierClick(self);
4384 end;
4385 lblQualifier.Caption := 'Date Range';
4386 CommonComponentVisible(false,false,false,false,false,false,false,false,false,true,true,true);
4387 pnlLeftBottom.Visible := true;
4388 splitter1.Visible := true;
4389 end
4390 else
4391 begin
4392 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4393 if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
4394 begin
4395 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4396 LoadListView(uLocalReportData);
4397 end;
4398 end;
4399 end
4400 else
4401 begin
4402 if (aRemote = '1') or (aRemote = '2') then
4403 ShowTabControl;
4404 GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
4405 if not(piece(uRemoteType, '^', 9) = '1') then
4406 LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState);
4407 if uLocalReportData.Count < 1 then
4408 uReportInstruction := '<No Report Available>'
4409 else
4410 begin
4411 if TabControl1.TabIndex < 1 then
4412 QuickCopy(uLocalReportData,memLab);
4413 end;
4414 TabControl1.OnChange(nil);
4415 if aCategory <> '0' then
4416 begin
4417
4418 ListReportDateRanges(lstQualifier.Items);
4419 if lstQualifier.ItemID = '' then
4420 begin
4421 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4422 lstQualifierClick(self);
4423 end
4424 else
4425 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
4426
4427 lblQualifier.Caption := 'Date Range';
4428 pnlLeftBottom.Visible := true;
4429 splitter1.Visible := true;
4430 end
4431 else
4432 begin
4433 LoadListView(uLocalReportData);
4434 end;
4435 end;
4436 StatusText('');
4437 uPrevReportNode := tvReports.Selected;
4438 end;
4439 else
4440 begin // = ?
4441 uQualifierType := QT_OTHER;
4442 pnlLeftBottom.Visible := false;
4443 splitter1.Visible := false;
4444 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
4445 GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
4446 uReportInstruction := #13#10 + 'Retrieving data...';
4447 TabControl1.OnChange(nil);
4448 //LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState);
4449 if not(piece(uRemoteType, '^', 9) = '1') then
4450 LoadReportText(uLocalReportData, 'L:' + aID, '', aRPC, uHState);
4451 if uLocalReportData.Count < 1 then
4452 uReportInstruction := '<No Report Available>'
4453 else
4454 begin
4455 if TabControl1.TabIndex < 1 then
4456 QuickCopy(uLocalReportData,memLab);
4457 end;
4458 TabControl1.OnChange(nil);
4459 StatusText('');
4460 uPrevReportNode := tvReports.Selected;
4461 end;
4462 lstQualifier.Caption := lblQualifier.Caption;
4463 end;
4464 end;
4465 if lstQualifier.ItemIndex > -1 then
4466 begin
4467 if not (aHDR = '1') then
4468 if aCategory <> '0' then
4469 DisplayHeading(uQualifier)
4470 else
4471 DisplayHeading('');
4472 end
4473 else
4474 begin
4475 if not (aHDR = '1') then
4476 if aCategory <> '0' then
4477 begin
4478 //lstDatesClick(self);
4479 x := lstDates.DisplayText[lstDates.ItemIndex];
4480 x1 := piece(x,' ',1);
4481 x2 := piece(x,' ',2);
4482 if (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then
4483 DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2))
4484 else
4485 DisplayHeading('d' + lstDates.ItemID);
4486 end
4487 else
4488 DisplayHeading('');
4489 end;
4490
4491 SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
4492 RedrawActivate(tvReports.Handle);
4493
4494 memLab.Visible := true;
4495 memLab.TabStop := true;
4496 memLab.BringToFront;
4497 RedrawActivate(memLab.Handle);
4498
4499 {if WebBrowser1.Visible = true then **Browser Remove**
4500 begin
4501 WebBrowser1.Navigate('about:blank');
4502 WebBrowser1.BringToFront;
4503 end }
4504 {else if not GraphFormActive then
4505 begin
4506 memLab.Visible := true;
4507 memLab.TabStop := true;
4508 memLab.BringToFront;
4509 RedrawActivate(memLab.Handle);
4510 end}
4511 //else **Browser Remove**
4512 //begin **Browser Remove**
4513 {GraphPanel(true);
4514 with GraphForm do
4515 begin
4516 lstDateRange.Items := cboDateRange.Items;
4517 lstDateRange.ItemIndex := cboDateRange.ItemIndex;
4518 ViewSelections;
4519 BringToFront;
4520 end; }
4521 //end; **Browser Remove**
4522 lvReports.Columns.BeginUpdate;
4523 lvReports.Columns.EndUpdate;
4524 Screen.Cursor := crDefault;
4525end;
4526
4527procedure TfrmLabs.tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
4528 var AllowCollapse: Boolean);
4529begin
4530 inherited;
4531 tvReports.Selected := Node;
4532end;
4533
4534procedure TfrmLabs.tvReportsExpanding(Sender: TObject; Node: TTreeNode;
4535 var AllowExpansion: Boolean);
4536begin
4537 inherited;
4538 tvReports.Selected := Node;
4539end;
4540
4541procedure TfrmLabs.tvReportsKeyDown(Sender: TObject; var Key: Word;
4542 Shift: TShiftState);
4543begin
4544 inherited;
4545 case Key of
4546 VK_LBUTTON, VK_RETURN, VK_SPACE:
4547 begin
4548 tvReportsClick(Sender);
4549 Key := 0;
4550 end;
4551 end;
4552end;
4553
4554procedure TfrmLabs.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
4555var
4556 i, j: integer;
4557 LocalHandle, Query, Report, Seq: string;
4558 HSType, DaysBack, ExamID, MaxOcc: string;
4559 Alpha, Omega, Trans: double;
4560begin
4561 HSType := '';
4562 DaysBack := '';
4563 ExamID := '';
4564 Alpha := 0;
4565 Omega := 0;
4566 Seq := '';
4567 if AHDR = '1' then
4568 begin
4569 if HDRActive = '0' then
4570 begin
4571 InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK);
4572 Exit;
4573 end;
4574 InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
4575 if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
4576 AQualifier := 'T-50000;T+50000;99999';
4577 if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
4578 AQualifier := 'T-50000;T+50000;99999';
4579 end;
4580 if CharAt(AQualifier, 1) = 'd' then
4581 begin
4582 DaysBack := Copy(AQualifier, 2, Length(AQualifier));
4583 AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3));
4584 DaysBack := '';
4585 end;
4586 if CharAt(AQualifier, 1) = 'T' then
4587 begin
4588 if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T');
4589 if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T')
4590 then SetPiece(AQualifier,';',2,'T+1');
4591 Alpha := StrToFMDateTime(Piece(AQualifier,';',1));
4592 Omega := StrToFMDateTime(Piece(AQualifier,';',2));
4593 if Alpha > Omega then
4594 begin
4595 Trans := Omega;
4596 Omega := Alpha;
4597 Alpha := Trans;
4598 end;
4599 MaxOcc := Piece(AQualifier,';',3);
4600 SetPiece(AHSTag,';',4,MaxOcc);
4601 end;
4602 if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier));
4603 if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier));
4604 with RemoteSites.SiteList do for i := 0 to Count - 1 do
4605 begin
4606 if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4607 begin
4608 TRemoteSite(Items[i]).Selected := true;
4609 frmFrame.lstCIRNLocations.Checked[i+1] := true;
4610 end;
4611 if TRemoteSite(Items[i]).Selected then
4612 begin
4613 TRemoteSite(Items[i]).ReportClear;
4614 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then
4615 begin
4616 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4617 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4618 TRemoteSite(Items[i]).LabRemoteHandle := '';
4619 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4620 if uQualifierType = 6 then seq := '1^';
4621 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4622 if uQualifierType = 6 then seq := '2^';
4623 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data Included> - Use "HDR Reports" menu for HDR Data.');
4624 TabControl1.OnChange(nil);
4625 if (length(piece(uHState,';',2)) > 0) then
4626 LoadListView(TRemoteSite(Items[i]).Data);
4627 continue;
4628 end;
4629 if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4630 begin
4631 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4632 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4633 TRemoteSite(Items[i]).LabRemoteHandle := '';
4634 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4635 if uQualifierType = 6 then seq := '1^';
4636 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4637 if uQualifierType = 6 then seq := '2^';
4638 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data> This site is not a source for HDR Data.');
4639 TabControl1.OnChange(nil);
4640 if (length(piece(uHState,';',2)) > 0) then
4641 LoadListView(TRemoteSite(Items[i]).Data);
4642 continue;
4643 end;
4644 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then
4645 begin
4646 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4647 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4648 TRemoteSite(Items[i]).LabRemoteHandle := '';
4649 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4650 if uQualifierType = 6 then seq := '1^';
4651 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4652 if uQualifierType = 6 then seq := '2^';
4653 TRemoteSite(Items[i]).Data.Add(seq + '<No DOD Data> - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.');
4654 TabControl1.OnChange(nil);
4655 if (length(piece(uHState,';',2)) > 0) then
4656 LoadListView(TRemoteSite(Items[i]).Data);
4657 continue;
4658 end;
4659 TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';'
4660 + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType +
4661 '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' +
4662 FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR;
4663 LocalHandle := '';
4664 Query := TRemoteSite(Items[i]).CurrentReportQuery;
4665 for j := 0 to RemoteReports.Count - 1 do
4666 begin
4667 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
4668 if Report = Query then
4669 begin
4670 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
4671 break;
4672 end;
4673 end;
4674 if Length(LocalHandle) > 1 then
4675 with RemoteSites.SiteList do
4676 begin
4677 GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]);
4678 TRemoteSite(Items[i]).LabRemoteHandle := '';
4679 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4680 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4681 TabControl1.OnChange(nil);
4682 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
4683 LoadListView(TRemoteSite(Items[i]).Data);
4684 end
4685 else
4686 begin
4687 if uDirect = '1' then
4688 begin
4689 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
4690 TRemoteSite(Items[i]).LabQueryStatus := '1^Direct Call';
4691 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call');
4692 DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
4693 if Copy(Dest[0],1,2) = '-1' then
4694 begin
4695 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
4696 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
4697 if uQualifierType = 6 then seq := '1^';
4698 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4699 if uQualifierType = 6 then seq := '2^';
4700 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
4701 TabControl1.OnChange(nil);
4702 if (length(piece(uHState,';',2)) > 0) then
4703 LoadListView(TRemoteSite(Items[i]).Data);
4704 end
4705 else
4706 begin
4707 QuickCopy(Dest,TRemoteSite(Items[i]).Data);
4708 TRemoteSite(Items[i]).LabRemoteHandle := '';
4709 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4710 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4711 TabControl1.OnChange(nil);
4712 if (length(piece(uHState,';',2)) > 0) then
4713 LoadListView(TRemoteSite(Items[i]).Data);
4714 end;
4715 StatusText('');
4716 end
4717 else
4718 begin
4719 RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
4720 if Dest[0] = '' then
4721 begin
4722 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
4723 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
4724 if uQualifierType = 6 then seq := '1^';
4725 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
4726 if uQualifierType = 6 then seq := '2^';
4727 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
4728 TabControl1.OnChange(nil);
4729 if (length(piece(uHState,';',2)) > 0) then
4730 LoadListView(TRemoteSite(Items[i]).Data);
4731 end
4732 else
4733 begin
4734 TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
4735 TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
4736 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization');
4737 Timer1.Enabled := True;
4738 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
4739 end;
4740 end;
4741 end;
4742 end;
4743 end;
4744end;
4745
4746procedure TfrmLabs.GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
4747 ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
4748var
4749 i,j: integer;
4750 LocalHandle, Report, Query: String;
4751begin
4752 { AReportID := 1 Generic report RemoteLabReports
4753 2 Cumulative RemoteLabCumulative
4754 3 Interim RemoteLabInterim
4755 4 Microbioloby RemoteLabMicro }
4756
4757 with RemoteSites.SiteList do
4758 for i := 0 to Count - 1 do
4759 if TRemoteSite(Items[i]).Selected then
4760 begin
4761 TRemoteSite(Items[i]).LabClear;
4762 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
4763 begin
4764 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4765 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4766 TabControl1.OnChange(nil);
4767 continue;
4768 end;
4769 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') then
4770 begin
4771 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
4772 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4773 TabControl1.OnChange(nil);
4774 continue;
4775 end;
4776 TRemoteSite(Items[i]).CurrentLabQuery := 'Lab' + Patient.DFN + ';' + Patient.ICN +
4777 '^' + 'L:' + IntToStr(AItem) + '^' + IntToStr(AReportID) + '^^' + ARpc + '^' + AHSType +
4778 '^' + ADaysBack + '^' + ASection + '^' + DateToStr(ADate1) + '^' + DateToStr(ADate2) + '^' +
4779 TRemoteSite(Items[i]).SiteID;
4780 LocalHandle := '';
4781 for j := 0 to RemoteReports.Count - 1 do
4782 begin
4783 Query := TRemoteSite(Items[i]).CurrentLabQuery;
4784 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
4785 if Report = Query then
4786 begin
4787 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
4788 break;
4789 end;
4790 end;
4791 if Length(LocalHandle) > 1 then
4792 with RemoteSites.SiteList do
4793 begin
4794 GetRemoteData(TRemoteSite(Items[i]).LabData,LocalHandle,Items[i]);
4795 TRemoteSite(Items[i]).LabRemoteHandle := '';
4796 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
4797 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
4798 TabControl1.OnChange(nil);
4799 end
4800 else
4801 begin
4802 case AReportID of
4803 1: begin
4804 RemoteLabReports(Dest, Patient.DFN + ';' + Patient.ICN, 'L:' + IntToStr(AItem),
4805 AHSType, ADaysBack, ASection, ADate1, ADate2,
4806 TRemoteSite(Items[i]).SiteID, ARpc);
4807 end;
4808 2: begin
4809 RemoteLabCumulative(Dest, Patient.DFN + ';' + Patient.ICN,
4810 StrToInt(Adaysback), Adate1, Adate2, TRemoteSite(Items[i]).SiteID,ARpc);
4811 end;
4812 3: begin
4813 RemoteLabInterim(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
4814 TRemoteSite(Items[i]).SiteID, ARpc);
4815 end;
4816 4: begin
4817 RemoteLabMicro(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
4818 TRemoteSite(Items[i]).SiteID, ARpc);
4819 end;
4820 else begin
4821 RemoteLab(Dest, Patient.DFN + ';' + Patient.ICN, 'L:' + IntToStr(AItem),
4822 AHSType, ADaysBack, ASection, ADate1, ADate2,
4823 TRemoteSite(Items[i]).SiteID, ARpc);
4824 end;
4825 end;
4826 if Dest[0] = '' then
4827 begin
4828 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
4829 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Communication error');
4830 end
4831 else
4832 begin
4833 TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
4834 TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
4835 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Initialization');
4836 Timer1.Enabled := True;
4837 StatusText('Retrieving reports from '
4838 + TRemoteSite(Items[i]).SiteName + '...');
4839 end;
4840 end;
4841 end;
4842end;
4843
4844procedure TfrmLabs.TabControl1Change(Sender: TObject);
4845var
4846 aStatus: string;
4847 hook: Boolean;
4848 i: integer;
4849begin
4850 inherited;
4851 if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then
4852 memLab.Lines.Clear;
4853 lstHeaders.Items.Clear;
4854 if (length(piece(uHState,';',2)) = 0) then with TabControl1 do
4855 begin
4856 memLab.Lines.BeginUpdate;
4857 if TabIndex > 0 then
4858 begin
4859 aStatus := TRemoteSite(Tabs.Objects[TabIndex]).LabQueryStatus;
4860 if aStatus = '1^Done' then
4861 begin
4862 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[0],'^',1) = '[HIDDEN TEXT]' then
4863 begin
4864 lstHeaders.Clear;
4865 hook := false;
4866 for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).LabData.Count - 1 do
4867 if hook = true then
4868 memLab.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i])
4869 else
4870 begin
4871 lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i]));
4872 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i],'^',1) = '[REPORT TEXT]' then
4873 hook := true;
4874 end;
4875 end
4876 else
4877 QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).LabData,memLab);
4878 memLab.Lines.Insert(0,' ');
4879 memLab.Lines.Delete(0);
4880 end;
4881 if Piece(aStatus,'^',1) = '-1' then
4882 memLab.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
4883 if Piece(aStatus,'^',1) = '0' then
4884 memLab.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2));
4885 if Piece(aStatus,'^',1) = '' then
4886 memLab.Lines.Add(uReportInstruction);
4887 end
4888 else
4889 if uLabLocalReportData.Count > 0 then
4890 begin
4891 if Piece(uLabLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
4892 begin
4893 lstHeaders.Clear;
4894 hook := false;
4895 for i := 1 to uLabLocalReportData.Count - 1 do
4896 if hook = true then
4897 memLab.Lines.Add(uLabLocalReportData[i])
4898 else
4899 begin
4900 lstHeaders.Items.Add(MixedCase(uLabLocalReportData[i]));
4901 if Piece(uLabLocalReportData[i],'^',1) = '[REPORT TEXT]' then
4902 hook := true;
4903 end;
4904 end
4905 else
4906 if tvReports.Selected.Text = 'Imaging (local only)' then
4907 memLab.Lines.clear
4908 else
4909 QuickCopy(uLabLocalReportData,memLab);
4910 memLab.Lines.Insert(0,' ');
4911 memLab.Lines.Delete(0);
4912 end
4913 else
4914 memLab.Lines.Add(uReportInstruction);
4915 memLab.SelStart := 0;
4916 memLab.Lines.EndUpdate;
4917 end;
4918end;
4919
4920procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject; //**Browser Remove**
4921 const pDisp: IDispatch; var URL: OleVariant);
4922var
4923 //WebDoc: IHtmlDocument2; **Browser Remove**
4924 v: variant;
4925begin
4926 inherited;
4927 if uHTMLDoc = '' then Exit;
4928 if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memLab control
4929 //if not Assigned(WebBrowser1.Document) then Exit; **Browser Remove**
4930 //WebDoc := WebBrowser1.Document as IHtmlDocument2; **Browser Remove**
4931 v := VarArrayCreate([0, 0], varVariant);
4932 v[0] := uHTMLDoc;
4933 //WebDoc.write(PSafeArray(TVarData(v).VArray)); **Browser Remove**
4934 //WebDoc.close; **Browser Remove**
4935 //uHTMLDoc := '';
4936end;
4937
4938procedure TfrmLabs.ChkBrowser; // **Browser Remove**
4939begin
4940 {if uReportType = 'H' then **Browser Remove**
4941 begin
4942 WebBrowser1.Visible := true;
4943 WebBrowser1.Navigate('about:blank');
4944 WebBrowser1.BringToFront;
4945 memLab.Visible := false;
4946 end
4947 else
4948 begin
4949 WebBrowser1.Visible := false;
4950 WebBrowser1.SendToBack; }
4951 memLab.Visible := true;
4952 memLab.BringToFront;
4953 //end; }
4954end;
4955
4956procedure TfrmLabs.CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
4957begin
4958 //Clear the last date selection
4959 //if not A4 then lstDates.ItemIndex := -1;
4960 lstDates.Caption := lblDates.Caption;
4961 lstHeaders.Caption := lblHeaders.Caption;
4962 if A4 or A2 or A12 then
4963 begin
4964 pnlLefTop.Height := (frmLabs.Height div 2);
4965 pnlLeftBottom.Visible := true;
4966 Splitter1.Visible := true;
4967 end
4968 else
4969 begin
4970 pnlLefTop.Height := frmLabs.Height;
4971 pnlLeftBottom.Visible := false;
4972 Splitter1.Visible := false;
4973 end;
4974 lstDates.Visible := false; // turned off to realign correctly
4975 lblDates.Visible := false;
4976 lstQualifier.Visible := false;
4977 lblQualifier.Visible := false;
4978 pnlOtherTests.Visible := false;
4979 lstHeaders.Visible := false;
4980 lblHeaders.Visible := false;
4981 sptHorzRight.Visible := false;
4982 lblHeaders.Visible := A1;
4983 lstHeaders.Visible := A2;
4984 lblQualifier.Visible := A11;
4985 lstQualifier.Visible := A12;
4986 lblDates.Visible := A4;
4987 lstDates.Visible := A5; // reordered to realign
4988 pnlOtherTests.Visible := A3;
4989 pnlHeader.Visible := A6;
4990 grdLab.Visible := A7;
4991 pnlChart.Visible := A8;
4992 pnlFooter.Visible := A9;
4993 lvReports.Visible := A10;
4994 sptHorzRight.Visible := true;
4995 if A4 and A1 and (lblDates.Top < lblHeaders.Top) then
4996 begin
4997 lblDates.Caption := 'Headings'; // swithes captions if not aligned
4998 lblHeaders.Caption := 'Date Range';
4999 end
5000 else
5001 begin
5002 lblDates.Caption := 'Date Range';
5003 lblHeaders.Caption := 'Headings';
5004 end;
5005 frmLabs.Realign;
5006end;
5007
5008procedure TfrmLabs.ShowTabControl;
5009begin
5010 if TabControl1.Tabs.Count > 1 then
5011 begin
5012 TabControl1.Visible := true;
5013 TabControl1.TabStop := true;
5014 pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height + TabControl1.Height;
5015 end;
5016end;
5017
5018procedure TfrmLabs.HideTabControl;
5019begin
5020 TabControl1.Visible := false;
5021 TabControl1.TabStop := false;
5022 pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height;
5023end;
5024
5025procedure TfrmLabs.Splitter1CanResize(Sender: TObject; var NewSize: Integer;
5026 var Accept: Boolean);
5027begin
5028 inherited;
5029 if NewSize < 150 then
5030 Newsize := 150;
5031end;
5032
5033procedure TfrmLabs.sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
5034 var Accept: Boolean);
5035begin
5036 inherited;
5037 if NewSize < 5 then
5038 Newsize := 5;
5039end;
5040
5041procedure TfrmLabs.Memo1KeyUp(Sender: TObject; var Key: Word;
5042 Shift: TShiftState);
5043begin
5044 inherited;
5045 if (Key = VK_TAB) then
5046 begin
5047 if ssShift in Shift then
5048 begin
5049 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
5050 Key := 0;
5051 end
5052 else if ssCtrl in Shift then
5053 begin
5054 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
5055 Key := 0;
5056 end;
5057 end;
5058 if (key = VK_ESCAPE) then begin
5059 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
5060 key := 0;
5061 end;
5062end;
5063
5064{ TGrdLab508Manager }
5065
5066constructor TGrdLab508Manager.Create;
5067begin
5068 inherited Create([mtValue, mtItemChange]);
5069end;
5070
5071function TGrdLab508Manager.GetItem(Component: TWinControl): TObject;
5072var
5073 sg : TCaptionStringGrid;
5074begin
5075 sg := TCaptionStringGrid(Component);
5076 Result := TObject(sg.Selection.Top + sg.Selection.Left);
5077end;
5078
5079function TGrdLab508Manager.GetTextToSpeak(sg: TCaptionStringGrid): String;
5080var
5081 textToSpeak : String;
5082 CurrRowStrings,HeaderStrings : TStrings;
5083 i : integer;
5084begin
5085 textToSpeak := '';
5086 HeaderStrings := sg.Rows[0];
5087 CurrRowStrings := sg.Rows[sg.Selection.Top];
5088 for i := 0 to CurrRowStrings.Count - 1 do begin
5089 textToSpeak := TextToSpeak + ', ' + HeaderStrings[i] + ', ' + ToBlankIfEmpty(CurrRowStrings[i]);
5090 end;
5091 Result := textToSpeak;
5092end;
5093
5094function TGrdLab508Manager.GetValue(Component: TWinControl): string;
5095var
5096 sg : TCaptionStringGrid;
5097begin
5098 sg := TCaptionStringGrid(Component);
5099 Result := GetTextToSpeak(sg);
5100end;
5101
5102function TGrdLab508Manager.ToBlankIfEmpty(aString: String): String;
5103begin
5104 Result := aString;
5105 if aString = '' then
5106 Result := 'blank';
5107end;
5108
5109initialization
5110 SpecifyFormIsNotADialog(TfrmLabs);
5111
5112end.
Note: See TracBrowser for help on using the repository browser.