source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fLabs.pas@ 1721

Last change on this file since 1721 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch
File size: 193.0 KB
RevLine 
[456]1unit fLabs;
2
[1693]3interface
[456]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,
[830]9 uConst, ORDtTmRng, OleCtrls, SHDocVw, Variants, StrUtils, fBase508Form,
10 VA508AccessibilityManager;
[456]11
12type
[830]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
[456]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;
[830]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;
[456]66 lblGraph: TLabel;
[830]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;
[1693]81 GoToTop1: TMenuItem;
82 GoToBottom1: TMenuItem;
83 FreezeText1: TMenuItem;
84 UnFreezeText1: TMenuItem;
[830]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;
[1693]106 TabControl1: TTabControl;
107 pnlRightTopHeaderTop: TPanel;
108 lblHeading: TOROffsetLabel;
[830]109 chkMaxFreq: TCheckBox;
[1693]110 lblTitle: TOROffsetLabel;
111 Label1: TLabel;
112 lblSample: TLabel;
113 Label2: TLabel;
[456]114 procedure FormCreate(Sender: TObject);
[830]115 procedure DisplayHeading(aRanges: string);
116 //procedure lstReportsClick(Sender: TObject);
[456]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);
[830]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);
[1693]193 procedure PopupMenu3Popup(Sender: TObject);
194 procedure grdLabTopLeftChanged(Sender: TObject);
[456]195 private
196 { Private declarations }
[830]197 SortIdx1, SortIdx2, SortIdx3: Integer;
198 grdLab508Manager : TGrdLab508Manager;
[456]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;
[830]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;
[1693]215 procedure HideTabControl;
[456]216 procedure ChkBrowser;
[830]217 procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
[456]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;
[830]225 //procedure ExtlstReportsClick(Sender: TObject; Ext: boolean);
[456]226
227end;
228
229var
230 frmLabs: TfrmLabs;
[830]231 uFormat: integer;
[1693]232 uPrevReportNode: TTreeNode;
[456]233 uDate1, uDate2: Tdatetime;
234 tmpGrid: TStringList;
235 uLabLocalReportData: TStringList; //Storage for Local report data
236 uLabRemoteReportData: TStringList; //Storage for Remote lab query
[830]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
[456]257
258implementation
259
[830]260uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers, fReportsPrint,
261 clipbrd, rReports, rGraphs, activex, mshtml, VA508AccessibilityRouter, uReports,
[1693]262 VAUtils;
[456]263
264const
[830]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;
[456]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;
[830]292 uEmptyImageList: TImageList;
293 uRptID: String;
294 uDirect: String;
295 ColumnToSort: Integer;
296 ColumnSortForward: Boolean;
[456]297
298procedure TfrmLabs.RequestPrint;
[830]299var
300 aID : integer;
[456]301begin
[830]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;
[456]311 end;
[830]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);
[456]390end;
391
392
393procedure TfrmLabs.FormCreate(Sender: TObject);
394var
395 aList: TStrings;
396begin
397 inherited;
[1693]398 LabRowObjects := TLabRowObject.Create;
[456]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;
[830]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;
[1693]417 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
[456]418 lblSingleTest.Caption := '';
419 lblSpecimen.Caption := '';
420 SerTest.GetHorizAxis.ExactDateTime := true;
421 SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
[830]422 grdLab508Manager := TGrdLab508Manager.Create;
423 amgrMain.ComponentManager[grdLab] := grdLab508Manager;
424 memo1.Visible := false;
[456]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;
[1693]483 HideTabControl;
[456]484 tmpGrid.Clear;
[830]485 lvReports.SmallImages := uEmptyImageList;
486 uLocalReportData.Clear;
487 uRemoteReportData.Clear;
[456]488 with grdLab do
489 begin
490 RowCount := 1;
491 ColCount := 1;
492 Cells[0, 0] := '';
493 end;
494end;
495
496procedure TfrmLabs.DisplayPage;
[830]497var
498 i: integer;
[1693]499 {OrigSelection: integer;
500 OrigDateIEN: Int64;
501 OrigDateItemID: Variant;
502 OrigReportCat: TTreeNode; }
[456]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>'
[1693]514 + '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
[456]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
[830]520 Splitter1.Visible := false;
521 pnlLeftBottom.Visible := false;
522 uColChange := '';
523 uMaxOcc := '';
524 LoadTreeView;
[456]525 end;
526 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
527 begin
[830]528 uColChange := '';
[1693]529 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
[830]530 tvReports.Selected := tvReports.Items.GetFirstNode;
531 tvReportsClick(self);
[456]532 end;
[830]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;
[456]562 case CallingContext of
563 CC_INIT_PATIENT: if not InitPatient then
564 begin
[1693]565 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
[830]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;
[456]582 end;
583 CC_NOTIFICATION: ProcessNotifications;
[1693]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; }
[456]630 end;
631end;
632
633procedure TfrmLabs.SetFontSize(NewFontSize: Integer);
634begin
635 inherited SetFontSize(NewFontSize);
636 FormResize(self);
637end;
638
[830]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;
[456]646begin
[830]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;
[1693]735 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
[830]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;
[1693]780 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
[830]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;
[1693]816 LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
[830]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
[456]835 begin
[830]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));
[1693]855 if DaysBack = '' then DaysBack := '7';
[830]856 if DaysBack = '0' then
857 aRanges := 'T' + ';T'
858 else
[1693]859 if Copy(aRanges, 2, 1) = 'T' then
860 aRanges := DaysBack + ';T'
861 else
862 aRanges := 'T-' + DaysBack + ';T';
[830]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;
[1693]888 if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DATA INCLUDED IN REPORT>>';
[830]889 Caption := x;
[456]890 end;
[830]891 lvReports.Caption := x;
[456]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;
[830]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;
[456]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;
[830]909 lstQualifier.Repaint;
[456]910end;
911
[830]912procedure TfrmLabs.LoadTreeView;
913var
914 i: integer;
915 currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
916 x: string;
917 addchild, addgrandchild, addgtgrandchild: boolean;
[456]918begin
[830]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;
[456]1007end;
1008
[830]1009{procedure TfrmLabs.lstReportsClick(Sender: TObject);
1010begin
1011 ExtlstReportsClick(Sender, false);
1012end; }
1013
1014{procedure TfrmLabs.ExtlstReportsClick(Sender: TObject; Ext: boolean);
[456]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
[830]1043 CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false);
[456]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;
[830]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;
[456]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
[830]1080 CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false);
[456]1081 memLab.Clear;
1082 chkBrowser;
1083 FormResize(self);
1084 RedrawActivate(memLab.Handle);
1085 lstDatesClick(self);
[830]1086 //lstQualifierClick(self);
[456]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
[830]1101 CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false);
[456]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);
[830]1113 //lstDatesClick(self);
1114 lstQualifierClick(self);
[456]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;
[830]1128 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
[456]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
[830]1147 CommonComponentVisible(false,false,true,true,true,true,false,false,true,false,false,false);
[456]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;
[830]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;
[456]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);
[830]1179 //lstDatesClick(self);
1180 lstQualifierClick(self);
[456]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
[830]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
[456]1203
1204 0: begin
[830]1205 CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false);
[456]1206 StatusText('Retrieving data...');
[830]1207 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
[456]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;
[830]1221 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
[456]1222 end;
1223 1: begin
[830]1224 CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false);
[456]1225 memLab.Repaint;
[830]1226 //lstDatesClick(self);
1227 lstQualifierClick(self);
[456]1228 end;
1229 2: begin
[830]1230 CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false);
[456]1231 lstHeaders.Clear;
1232 StatusText('Retrieving data...');
[830]1233 GoRemoteOld(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
[456]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;
[830]1249 //if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); **Browser Remove**
[456]1250 end;
1251 3: begin
[830]1252 CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false);
1253 //lstDatesClick(self);
1254 lstQualifierClick(self);
[456]1255 memLab.Lines.Insert(0,' ');
1256 memLab.Lines.Delete(0);
1257 end;
1258 end;
1259 end;
1260 end;
1261 uPrevReportIndex := lstReports.ItemIndex;
[830]1262 DisplayHeading('');
1263end; }
[456]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
[830]1276procedure TfrmLabs.lstQualifierClick(Sender: TObject);
1277 var
1278 MoreID: String; //Restores MaxOcc value
[1693]1279 aRemote, aHDR, aFHIE, aMax: string;
[830]1280 i: integer;
[456]1281 tmpList: TStringList;
1282 daysback: integer;
1283 date1, date2: TFMDateTime;
1284 today: TDateTime;
1285begin
1286 inherited;
[830]1287 if uFrozen = True then
1288 begin
1289 memo1.visible := False;
1290 memo1.TabStop := False;
1291 end;
[456]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);
[830]1302 DisplayHeading('');
[456]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;
[830]1325 MoreID := ';' + Piece(uQualifier,';',3);
1326 if chkMaxFreq.checked = true then
1327 begin
1328 MoreID := '';
1329 SetPiece(uQualifier,';',3,'');
1330 end;
[1693]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';
[830]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;
[456]1342 uHTMLDoc := '';
[830]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;
[1693]1434 LabRowObjects.Clear;
[830]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;
[1693]1465 LabRowObjects.Clear;
[830]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
[456]1502 21: begin // Cumulative
1503 lstHeaders.Clear;
1504 memLab.Clear;
1505 uLabLocalReportData.Clear;
1506 uLabRemoteReportData.Clear;
1507 StatusText('Retrieving data for cumulative report...');
[830]1508 GoRemoteOld(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
[456]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...');
[830]1524 GoRemoteOld(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
[456]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...');
[830]1541 FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData);
[456]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...');
[830]1561 FastAssign(Worksheet(Patient.DFN, date1, date2,
1562 Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid);
[456]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...');
[830]1583 FastAssign(GetChart(Patient.DFN, date1, date2,
[456]1584 Piece(lblSpecimen.Caption, '^', 1),
[830]1585 Piece(lblSingleTest.Caption, '^', 1)), tmpList);
[456]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...');
[830]1625 GoRemoteOld(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
[456]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...');
[830]1641 GoRemoteOld(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
[456]1642 TabControl1.OnChange(nil);
[830]1643 Reports(uLabLocalReportData,Patient.DFN, 'L:' + '9', '', IntToStr(daysback),'',
[456]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...');
[830]1659 GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
1660 //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2);
[456]1661 TabControl1.OnChange(nil);
[830]1662 Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '',
[456]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;
[830]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');
[1693]1690 end;
1691 }
[830]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...');
[1693]1761 GoRemoteOld(uLabRemoteReportData,21,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
[830]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...');
[1693]1778 GoRemoteOld(uLabRemoteReportData,3,3,'',uReportRPC,'','','',date1,date2);
[830]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...');
[1693]1883 GoRemoteOld(uLabRemoteReportData,4,4,'',uReportRPC,'','','',date1,date2);
[830]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;
[456]1931 if uReportType = 'R' then
1932 uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
1933 else
1934 uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
1935 Screen.Cursor := crDefault;
[830]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);
[456]1943 StatusText('');
1944end;
1945
1946procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject);
1947begin
1948 inherited;
[830]1949 tvReportsClick(self);
[456]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
[1693]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
[456]1993procedure TfrmLabs.HGrid(griddata: TStrings);
1994var
1995 testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
[830]1996 DisplayDateTime: string;
[456]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
[830]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 //------------------------------------------------------------------------------------------
[456]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;
[830]2067 DisplayDateTime: string;
[456]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
[830]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 //------------------------------------------------------------------------------------------
[1693]2123 Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
[456]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);
[830]2150var
2151 i: integer;
2152 aColChange: string;
[456]2153begin
2154 inherited;
[830]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;
[456]2165 tmpGrid.free;
2166 uLabLocalReportData.Free;
2167 uLabRemoteReportData.Free;
[830]2168 uTreeStrings.Free;
2169 uEmptyImageList.Free;
2170 uColumns.Free;
2171 uLocalReportData.Free;
2172 uRemoteReportData.Free;
[1693]2173 LabRowObjects.Free;
[456]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;
[1693]2184 ColCount := 6;
[456]2185 DefaultColWidth := agrid.Width div ColCount - 2;
[1693]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;
[456]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] := '';
[1693]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';
[456]2203 for i := 1 to testcnt do
2204 begin
[1693]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);
[456]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;
[1693]2236 newest, oldest, DisplayDate, aCollection, aSpecimen, aX: string;
2237 i,ix: integer;
[456]2238begin
2239 tmpList := TStringList.Create;
2240 GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH
2241 prevon := true;
[1693]2242 aCollection := '';
2243 aSpecimen := '';
2244 aX := '';
2245 lblSample.Caption := '';
2246 lblSample.Color := clBtnFace;
[456]2247 try
[830]2248 FastAssign(InterimGrid(Patient.DFN, adatetime, direction, uFormat), tmpList);
[456]2249 if tmpList.Count > 0 then
2250 begin
2251 lblDateFloat.Caption := Piece(tmpList[0], '^', 3);
2252 uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1);
[830]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 //------------------------------------------------------------------------------------------
[456]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;
[1693]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;
[456]2323 end
2324 else
2325 begin
2326 lblDateFloat.Caption := '';
2327 lblDate.Caption := '';
[1693]2328 nexton := false;
2329 prevon := false;
[456]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
[1693]2341 lblMostRecent.Caption := 'No Lab Data'
[456]2342 else if cmdOld.Enabled then
[1693]2343 lblMostRecent.Caption := 'Most Recent Lab Data'
[456]2344 else
[1693]2345 lblMostRecent.Caption := 'Oldest Lab Data';
[456]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);
[1693]2353 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 5);
2354 sptHorzRight.Top := pnlRightTop.Height;
2355 uScreenSplitLoc := sptHorzRight.Top;
[830]2356 pnlRightBottom.Height := pnlLeft.Height div 5;
[456]2357 memLab.Height := pnlLeft.Height div 5;
[830]2358 memLab.Lines.Insert(0,' ');
2359 memLab.Lines.Delete(0);
2360 memLab.SelStart := 0;
[456]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;
[830]2371 memLab.Align := alClient;
[456]2372 memLab.Repaint;
2373 end;
2374 if Piece(tmpList[0], '^', 2) = 'MI' then
2375 begin
2376 tmpList.Delete(0);
[830]2377 QuickCopy(tmpList, memLab);
[456]2378 memLab.SelStart := 0;
2379 grdLab.Visible := false;
2380 pnlFooter.Visible := false;
[830]2381 sptHorzRight.Visible := true;
[1693]2382 TabControl1.Visible := false;
2383 pnlRightTop.Height := pnlHeader.Height;
[830]2384 memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height + pnlHeader.Height);
2385 pnlRightTop.Visible := true;
[456]2386 memLab.Align := alClient;
[830]2387 memLab.Repaint;
[456]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
[830]2413 else tvReports.SetFocus;
[456]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
[830]2429 else tvReports.Setfocus;
[456]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
[1693]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
[456]2502 begin
[1693]2503 serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
2504 serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
[456]2505 end;
[1693]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
[456]2522 begin
[1693]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;
[456]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);
[830]2590//var
2591 //aID: integer;
[456]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;
[830]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
[456]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;
[830]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;
[456]2629 end;
[830]2630 21: begin // Cumulative
[456]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;
[830]2672 20: begin // Anatomic Path
[456]2673 memLab.Repaint;
2674 end;
[830]2675 2: begin // Blood Bank
[456]2676 memLab.Repaint;
2677 end;
2678 9: begin // Microbiology
2679 memLab.Repaint;
2680 end;
2681 10: begin // Lab Status
2682 memLab.Repaint;
2683 end;
[830]2684 end; }
[456]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;
[830]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;
[456]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;
[830]2794 pnlRightBottom.Visible := false;
2795 pnlRightTop.Align := alClient;
[456]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
[830]2816procedure TfrmLabs.Print1Click(Sender: TObject);
2817begin
2818 inherited;
2819 RequestPrint;
2820end;
[456]2821
[830]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];
[1693]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
[830]3090 begin
3091 aWPFlag := true;
[1693]3092 MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[j]).Name);
3093 FastAssign(TCellObject(LabRowObjects.ColumnList[j]).Data, aBasket);
[830]3094 for k := 0 to aBasket.Count - 1 do
[1693]3095 MemLab.Lines.Add(' ' + aBasket[k]);
[830]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;
[1693]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
[830]3111 begin
3112 aWPFlag := true;
[1693]3113 MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[i]).Name);
3114 FastAssign(TCellObject(LabRowObjects.ColumnList[i]).Data, aBasket);
[830]3115 for j := 0 to aBasket.Count - 1 do
[1693]3116 MemLab.Lines.Add(' ' + aBasket[j]);
[830]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
[456]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
[830]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
[456]3222procedure TfrmLabs.GotoTop1Click(Sender: TObject);
3223begin
3224 inherited;
[1693]3225 SendMessage(memLab.Handle, WM_VSCROLL, SB_TOP, 0);
3226 {GoToTop1.Enabled := false;
3227 GoToBottom1.Enabled := true; }
[456]3228end;
3229
3230procedure TfrmLabs.GotoBottom1Click(Sender: TObject);
3231begin
3232 Inherited;
[1693]3233 SendMessage(memLab.Handle, WM_VSCROLL, SB_BOTTOM, 0);
3234 {GoToTop1.Enabled := true;
3235 GoToBottom1.Enabled := false; }
[456]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
[1693]3271procedure TfrmLabs.PopupMenu3Popup(Sender: TObject);
[456]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;
[1693]3285 {If memLab.SelStart > 0 then
[456]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
[1693]3293 GotoBottom1.Enabled := False; }
[830]3294 {case lstReports.ItemIEN of
[456]3295 1: FreezeText1.Enabled := False;
3296 5: FreezeText1.Enabled := False;
3297 6: FreezeText1.Enabled := False;
[830]3298 end; }
[456]3299end;
3300
3301procedure TfrmLabs.ProcessNotifications;
3302var
3303 //AlertDate, CurrentDate: TFMDateTime;
3304 OrderIFN: string;
3305begin
3306 {uNewest := '';
[830]3307 uOldest := '';
[456]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
[1693]3327 //the following if condition & clause resolves CQ 16405 & 17076 - a mixture of two different patient's lab results in one display (TC).
[830]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;
[1693]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)
[456]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;
[830]3346 //WebBrowser1.Visible := false; **Browser Remove**
3347 //WebBrowser1.SendToBack; **Browser Remove**
[456]3348 memLab.Visible := true;
3349 memLab.BringToFront;
3350 pnlFooter.Visible := true;
3351 memLab.Clear;
3352 uLabLocalReportData.Clear;
3353 uLabRemoteReportData.Clear;
[830]3354 pnlRightTop.Height := 5;
[456]3355 memLab.Align := alClient;
3356 FormResize(self);
[830]3357 QuickCopy(ResultOrder(OrderIFN), memLab);
[456]3358 memLab.SelStart := 0;
3359 memLab.Repaint;
3360 lblHeading.Caption := Notifications.Text;
3361 end
3362 else
3363 begin
[1693]3364 if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4;
[830]3365 tvReports.Selected := tvReports.Items.GetFirstNode;
3366 tvReportsClick(self);
[456]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
[1693]3612 i,j,fail: integer;
[456]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
[1693]3620 begin
[456]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
[1693]3625 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2));
[456]3626 if piece(r0,'^',1) = '1' then
3627 begin
[1693]3628 GetRemoteData(TRemoteSite(Items[i]).LabData,
3629 TRemoteSite(Items[i]).LabRemoteHandle,Items[i]);
[456]3630 RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery,
3631 TRemoteSite(Items[i]).LabRemoteHandle);
3632 TRemoteSite(Items[i]).LabRemoteHandle := '';
3633 TabControl1.OnChange(nil);
[1693]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;
[456]3655 end
3656 else
3657 begin
3658 uRemoteCount := uRemoteCount + 1;
[1693]3659 if uRemoteCount > 90 then //~7 minute limit
[456]3660 begin
[1693]3661 TRemoteSite(Items[i]).LabRemoteHandle := '';
[456]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;
[1693]3671 Timer1.Interval := 10000;
[456]3672 end;
[1693]3673 end;
[456]3674 if Timer1.Enabled = True then
3675 begin
3676 j := 0;
3677 for i := 0 to Count -1 do
[1693]3678 begin
3679 if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
3680 begin
3681 j := 1;
3682 break;
3683 end;
3684 end;
[456]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
[1693]3693 begin
3694 j := 1;
3695 break;
3696 end;
[456]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
[830]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;
[1693]3712 aID, aHSTag, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
3713 CurrentNode: TTreeNode;
[830]3714begin
3715 inherited;
[1693]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;
[830]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;
[1693]3768 uLabRepID := aID;
[830]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;
[1693]3779 HideTabControl;
[830]3780 sptHorzRight.Visible := true;
3781 lvReports.Visible := false;
3782 if (aRemote = '1') or (aRemote = '2') then
3783 if not(uReportType = 'V') then
[1693]3784 ShowTabControl;
[830]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;
[1693]3862 LabRowObjects.Clear;
[830]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
[1693]3959 else
3960 begin
3961 uPrevReportNode := tvReports.Items.GetFirstNode;
3962 tvReports.Selected := uPrevReportNode;
3963 tvReportsClick(self);
3964 end;
[830]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);
[1693]3993 //lstDatesClick(self);
[830]3994 //lstQualifierClick(self);
3995 cmdOtherTests.SetFocus;
3996 cmdOtherTests.Default := true;
3997 uPrevReportNode := tvReports.Selected;
[1693]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);
[830]4008 if ScreenReaderSystemActive then
4009 grdLab.SetFocus;
4010 end
[1693]4011 else
4012 begin
4013 uPrevReportNode := tvReports.Items.GetFirstNode;
4014 tvReports.Selected := uPrevReportNode;
4015 tvReportsClick(self);
4016 end;
[830]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
[1693]4087 tvReports.Selected := uPrevReportNode;
[830]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;
[1693]4101 if ((aRemote = '1') or (aRemote = '2')) then
4102 ShowTabControl;
4103 pnlRightTopHeader.Align := alTop;
[830]4104 pnlRightTop.Align := alTop;
[1693]4105 TabControl1.Align := alTop;
[830]4106 pnlRightBottom.Align := alclient;
4107 sptHorzRight.Visible := true;
4108 pnlRightBottom.Visible := true;
4109 lvReports.Visible := false;
4110 memLab.Align := alClient;
[1693]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; }
[830]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...');
[1693]4140 GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0);
[830]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...');
[1693]4167 GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0);
[830]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;
[1693]4254 LabRowObjects.Clear;
[830]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
[1693]4344 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 2);
4345 sptHorzRight.top := pnlRightTop.Height;
4346 uScreenSplitLoc := sptHorzRight.Top;
[830]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);
[1693]4357 LabRowObjects.Clear;
[830]4358 memLab.Lines.Clear;
4359 lvReports.SmallImages := uEmptyImageList;
4360 lvReports.Items.Clear;
[1693]4361 memLab.Repaint;
[830]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;
[1693]4609 frmFrame.lstCIRNLocations.Checked[i+1] := true;
[830]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
[1693]4616 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
[830]4617 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
[1693]4618 TRemoteSite(Items[i]).LabRemoteHandle := '';
4619 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
[830]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
[1693]4631 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
[830]4632 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
[1693]4633 TRemoteSite(Items[i]).LabRemoteHandle := '';
4634 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
[830]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
[1693]4646 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
[830]4647 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
[1693]4648 TRemoteSite(Items[i]).LabRemoteHandle := '';
4649 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
[830]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]);
[1693]4678 TRemoteSite(Items[i]).LabRemoteHandle := '';
4679 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
[830]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 + '...');
[1693]4690 TRemoteSite(Items[i]).LabQueryStatus := '1^Direct Call';
[830]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
[1693]4695 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
[830]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);
[1693]4708 TRemoteSite(Items[i]).LabRemoteHandle := '';
4709 TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
[830]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
[1693]4722 TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
[830]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
[1693]4734 TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
4735 TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
[830]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,
[456]4747 ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
4748var
4749 i,j: integer;
[1693]4750 LocalHandle, Report, Query: String;
[456]4751begin
4752 { AReportID := 1 Generic report RemoteLabReports
4753 2 Cumulative RemoteLabCumulative
4754 3 Interim RemoteLabInterim
4755 4 Microbioloby RemoteLabMicro }
[1693]4756
[456]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;
[830]4769 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') then
4770 begin
[1693]4771 TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
[830]4772 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
4773 TabControl1.OnChange(nil);
4774 continue;
4775 end;
[456]4776 TRemoteSite(Items[i]).CurrentLabQuery := 'Lab' + Patient.DFN + ';' + Patient.ICN +
[1693]4777 '^' + 'L:' + IntToStr(AItem) + '^' + IntToStr(AReportID) + '^^' + ARpc + '^' + AHSType +
[456]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
[1693]4804 RemoteLabReports(Dest, Patient.DFN + ';' + Patient.ICN, 'L:' + IntToStr(AItem),
[456]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
[1693]4821 RemoteLab(Dest, Patient.DFN + ';' + Patient.ICN, 'L:' + IntToStr(AItem),
[456]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;
[1693]4851 if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then
4852 memLab.Lines.Clear;
[456]4853 lstHeaders.Items.Clear;
[1693]4854 if (length(piece(uHState,';',2)) = 0) then with TabControl1 do
[456]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
[1693]4868 memLab.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i])
[456]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
[1693]4884 memLab.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2));
[456]4885 if Piece(aStatus,'^',1) = '' then
[1693]4886 memLab.Lines.Add(uReportInstruction);
[456]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
[1693]4906 if tvReports.Selected.Text = 'Imaging (local only)' then
4907 memLab.Lines.clear
4908 else
4909 QuickCopy(uLabLocalReportData,memLab);
[456]4910 memLab.Lines.Insert(0,' ');
4911 memLab.Lines.Delete(0);
[1693]4912 end
4913 else
4914 memLab.Lines.Add(uReportInstruction);
[456]4915 memLab.SelStart := 0;
4916 memLab.Lines.EndUpdate;
4917 end;
4918end;
4919
[830]4920procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject; //**Browser Remove**
[456]4921 const pDisp: IDispatch; var URL: OleVariant);
4922var
[830]4923 //WebDoc: IHtmlDocument2; **Browser Remove**
[456]4924 v: variant;
4925begin
4926 inherited;
4927 if uHTMLDoc = '' then Exit;
[830]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**
[456]4931 v := VarArrayCreate([0, 0], varVariant);
4932 v[0] := uHTMLDoc;
[830]4933 //WebDoc.write(PSafeArray(TVarData(v).VArray)); **Browser Remove**
4934 //WebDoc.close; **Browser Remove**
[456]4935 //uHTMLDoc := '';
4936end;
4937
[830]4938procedure TfrmLabs.ChkBrowser; // **Browser Remove**
[456]4939begin
[830]4940 {if uReportType = 'H' then **Browser Remove**
[456]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;
[830]4950 WebBrowser1.SendToBack; }
[456]4951 memLab.Visible := true;
4952 memLab.BringToFront;
[830]4953 //end; }
[456]4954end;
4955
[830]4956procedure TfrmLabs.CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean);
[456]4957begin
[1693]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;
[456]4974 lstDates.Visible := false; // turned off to realign correctly
4975 lblDates.Visible := false;
[830]4976 lstQualifier.Visible := false;
4977 lblQualifier.Visible := false;
[456]4978 pnlOtherTests.Visible := false;
4979 lstHeaders.Visible := false;
4980 lblHeaders.Visible := false;
[830]4981 sptHorzRight.Visible := false;
4982 lblHeaders.Visible := A1;
4983 lstHeaders.Visible := A2;
4984 lblQualifier.Visible := A11;
4985 lstQualifier.Visible := A12;
4986 lblDates.Visible := A4;
[456]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;
[830]4993 lvReports.Visible := A10;
[1693]4994 sptHorzRight.Visible := true;
[456]4995 if A4 and A1 and (lblDates.Top < lblHeaders.Top) then
[830]4996 begin
[1693]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';
[830]5004 end;
[1693]5005 frmLabs.Realign;
[456]5006end;
5007
[830]5008procedure TfrmLabs.ShowTabControl;
5009begin
5010 if TabControl1.Tabs.Count > 1 then
5011 begin
5012 TabControl1.Visible := true;
5013 TabControl1.TabStop := true;
[1693]5014 pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height + TabControl1.Height;
[830]5015 end;
5016end;
5017
[1693]5018procedure TfrmLabs.HideTabControl;
5019begin
5020 TabControl1.Visible := false;
5021 TabControl1.TabStop := false;
5022 pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height;
5023end;
5024
[830]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;
[1693]5037 if NewSize < 5 then
5038 Newsize := 5;
[830]5039end;
5040
[456]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
[830]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
[456]5112end.
Note: See TracBrowser for help on using the repository browser.