source: cprs/trunk/CPRS-Chart/fReports.pas@ 1003

Last change on this file since 1003 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27
File size: 128.3 KB
Line 
1unit fReports;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Menus, uConst, ORDtTmRng,
8 OleCtrls, SHDocVw, Buttons, ClipBrd, rECS, Variants, StrUtils, fBase508Form,
9 VA508AccessibilityManager, VA508ImageListLabeler;
10
11type
12 TfrmReports = class(TfrmHSplit)
13 PopupMenu1: TPopupMenu;
14 GotoTop1: TMenuItem;
15 GotoBottom1: TMenuItem;
16 FreezeText1: TMenuItem;
17 UnFreezeText1: TMenuItem;
18 calApptRng: TORDateRangeDlg;
19 Timer1: TTimer;
20 pnlLefTop: TPanel;
21 lblTypes: TOROffsetLabel;
22 Splitter1: TSplitter;
23 pnlLeftBottom: TPanel;
24 lblQualifier: TOROffsetLabel;
25 lblHeaders: TLabel;
26 lstHeaders: TORListBox;
27 lstQualifier: TORListBox;
28 pnlRightTop: TPanel;
29 pnlRightBottom: TPanel;
30 pnlRightMiddle: TPanel;
31 TabControl1: TTabControl;
32 lvReports: TCaptionListView;
33 Memo1: TMemo;
34 WebBrowser1: TWebBrowser;
35 memText: TRichEdit;
36 sptHorzRight: TSplitter;
37 tvReports: TORTreeView;
38 PopupMenu2: TPopupMenu;
39 Print1: TMenuItem;
40 Copy1: TMenuItem;
41 Print2: TMenuItem;
42 Copy2: TMenuItem;
43 SelectAll1: TMenuItem;
44 SelectAll2: TMenuItem;
45 pnlProcedures: TPanel;
46 lblProcedures: TOROffsetLabel;
47 tvProcedures: TORTreeView;
48 lblProcTypeMsg: TOROffsetLabel;
49 pnlViews: TORAutoPanel;
50 chkDualViews: TCheckBox;
51 btnChangeView: TORAlignButton;
52 btnGraphSelections: TORAlignButton;
53 lblDateRange: TLabel;
54 lstDateRange: TORListBox;
55 pnlTopViews: TPanel;
56 pnlTopRtLabel: TPanel;
57 lblTitle: TOROffsetLabel;
58 chkMaxFreq: TCheckBox;
59 imgLblImages: TVA508ImageListLabeler;
60 procedure lstQualifierClick(Sender: TObject);
61 procedure GotoTop1Click(Sender: TObject);
62 procedure GotoBottom1Click(Sender: TObject);
63 procedure FreezeText1Click(Sender: TObject);
64 procedure UnFreezeText1Click(Sender: TObject);
65 procedure PopupMenu1Popup(Sender: TObject);
66 procedure FormCreate(Sender: TObject);
67 procedure DisplayHeading(aRanges: string);
68 procedure FormShow(Sender: TObject);
69 procedure Timer1Timer(Sender: TObject);
70 procedure TabControl1Change(Sender: TObject);
71 procedure FormDestroy(Sender: TObject);
72 procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
73 procedure lstHeadersClick(Sender: TObject);
74 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
75 var Accept: Boolean);
76 procedure WebBrowser1DocumentComplete(Sender: TObject;
77 const pDisp: IDispatch; var URL: OleVariant);
78 procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
79 var Accept: Boolean);
80 procedure lstQualifierDrawItem(Control: TWinControl; Index: Integer;
81 Rect: TRect; State: TOwnerDrawState);
82 procedure tvReportsClick(Sender: TObject);
83 procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn);
84 procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem;
85 Data: Integer; var Compare: Integer);
86 procedure lvReportsSelectItem(Sender: TObject; Item: TListItem;
87 Selected: Boolean);
88 procedure LoadListView(aReportData: TStringList);
89 procedure LoadTreeView;
90 procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode;
91 var AllowExpansion: Boolean);
92 procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
93 var AllowCollapse: Boolean);
94 procedure Print1Click(Sender: TObject);
95 procedure Copy1Click(Sender: TObject);
96 procedure Copy2Click(Sender: TObject);
97 procedure Print2Click(Sender: TObject);
98 procedure UpdateRemoteStatus(aSiteID, aStatus: string);
99 procedure lvReportsKeyUp(Sender: TObject; var Key: Word;
100 Shift: TShiftState);
101 procedure SelectAll1Click(Sender: TObject);
102 procedure SelectAll2Click(Sender: TObject);
103 procedure tvReportsKeyDown(Sender: TObject; var Key: Word;
104 Shift: TShiftState);
105 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
106 Shift: TShiftState);
107 procedure LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode;
108 var CurrentNode: TTreeNode);
109 procedure tvProceduresCollapsing(Sender: TObject; Node: TTreeNode;
110 var AllowCollapse: Boolean);
111 procedure tvProceduresExpanding(Sender: TObject; Node: TTreeNode;
112 var AllowExpansion: Boolean);
113 procedure tvProceduresClick(Sender: TObject);
114 procedure tvProceduresChange(Sender: TObject; Node: TTreeNode);
115 procedure tvProceduresKeyDown(Sender: TObject; var Key: Word;
116 Shift: TShiftState);
117 procedure chkDualViewsClick(Sender: TObject);
118 procedure btnChangeViewClick(Sender: TObject);
119 procedure btnGraphSelectionsClick(Sender: TObject);
120 procedure lstDateRangeClick(Sender: TObject);
121 procedure sptHorzMoved(Sender: TObject);
122 procedure chkMaxFreqClick(Sender: TObject);
123
124 private
125 SortIdx1, SortIdx2, SortIdx3: Integer;
126 procedure ProcessNotifications;
127 procedure ShowTabControl;
128 procedure Graph(reportien: integer);
129 procedure GraphPanel(active: boolean);
130 public
131 procedure ClearPtData; override;
132 function AllowContextChange(var WhyNot: string): Boolean; override;
133 procedure DisplayPage; override;
134 procedure SetFontSize(NewFontSize: Integer); override;
135 procedure RequestPrint; override;
136 end;
137
138var
139 frmReports: TfrmReports;
140 uHSComponents: TStringList; //components selected
141 //segment^OccuranceLimit^TimeLimit^Header...
142 //^(value of uComponents...)
143 uHSAll: TStringList; //List of all displayable Health Summaries
144 uLocalReportData: TStringList; //Storage for Local report data
145 uRemoteReportData: TStringList; //Storage for status of Remote data
146 uReportInstruction: String; //User Instructions
147 uNewColumn: TListColumn;
148 uListItem: TListItem;
149 uColumns: TStringList;
150 uTreeStrings: TStrings;
151 uMaxOcc: string;
152 uHState: string;
153 uQualifier: string;
154 uReportType: string;
155 uSortOrder: string;
156 uQualifierType: Integer;
157 uFirstSort: Integer;
158 uSecondSort: Integer;
159 uThirdSort: Integer;
160 uColChange: string; //determines when column widths have changed
161 uUpdateStat: boolean; //flag turned on when remote status is being updated
162 ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected
163 uListState: Integer; //Checked state of list of Adhoc components Checked: Abbreviation, UnChecked: Name
164 uECSReport: TECSReport; //Event Capture Report, initiated in fFrame when Click Event Capture under Tools
165 UpdatingLvReports: Boolean; //Currently updating lvReports
166 UpdatingTvProcedures: Boolean; //Currently updating tvProcedures
167
168implementation
169
170{$R *.DFM}
171
172uses ORFn, rCore, rReports, fFrame, uCore, uReports, fReportsPrint,
173 fReportsAdhocComponent1, activex, mshtml, dShared, fGraphs, fGraphData, rGraphs,
174 VA508AccessibilityRouter, VAUtils
175 { TODO -oRV -cWVEHR Long Age : Changed to use long age }
176 , rWVEHR;
177
178const
179 CT_REPORTS =10; // ID for REPORTS tab used by frmFrame
180 QT_OTHER = 0;
181 QT_HSTYPE = 1;
182 QT_DATERANGE = 2;
183 QT_IMAGING = 3;
184 QT_NUTR = 4;
185 QT_PROCEDURES = 19;
186 QT_SURGERY = 28;
187 QT_HSCOMPONENT = 5;
188 QT_HSWPCOMPONENT = 6;
189 TX_NOREPORT = 'No report is currently selected.';
190 TX_NOREPORT_CAP = 'No Report Selected';
191 HTML_PRE = '<html><head><style>' + CRLF +
192 'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
193 '</style></head><body><pre>';
194 HTML_POST = CRLF + '</pre></body></html>';
195
196var
197 uRemoteCount: Integer;
198 uFrozen: Boolean;
199 uHTMLDoc: string;
200 uReportRPC: string;
201 uHTMLPatient: ANSIstring;
202 uRptID: String;
203 uDirect: String;
204 uEmptyImageList: TImageList;
205 ColumnToSort: Integer;
206 ColumnSortForward: Boolean;
207 GraphForm: TfrmGraphs;
208 GraphFormActive: boolean;
209
210procedure TfrmReports.ClearPtData;
211begin
212 inherited ClearPtData;
213 Timer1.Enabled := False;
214 memText.Clear;
215 tvProcedures.Items.Clear;
216 lblProcTypeMsg.Visible := FALSE;
217 lvReports.SmallImages := uEmptyImageList;
218 imgLblImages.ComponentImageListChanged;
219 lvReports.Items.Clear;
220 uLocalReportData.Clear;
221 uRemoteReportData.Clear;
222 TabControl1.Tabs.Clear;
223 TabControl1.Visible := false;
224 TabControl1.TabStop := false;
225 lstDateRange.Tag := 0; // used to reset date default on graph
226 if (GraphForm <> nil) and GraphFormActive then
227 with GraphForm do
228 begin
229 GraphForm.SendToBack;
230 Initialize;
231 DisplayData('top');
232 DisplayData('bottom');
233 GtslCheck.Clear;
234 GraphFormActive := false;
235 end;
236 begin
237 end;
238end;
239
240procedure TfrmReports.Graph(reportien: integer);
241begin
242 if GraphForm = nil then
243 begin
244 GraphForm := TfrmGraphs.Create(self);
245 try
246 with GraphForm do
247 begin
248 if btnClose.Tag = 1 then
249 Exit;
250 Parent := pnlRight;
251 Align := alClient;
252 pnlFooter.Tag := 1; //suppresses bottom of graph form
253 pnlBottom.Height := 1;
254 pnlMain.BevelInner := bvLowered;
255 pnlMain.BevelOuter := bvRaised;
256 pnlMain.Tag := reportien;
257 Initialize;
258 ResizeAnchoredFormToFont(GraphForm);
259 Show;
260 DisplayData('top');
261 DisplayData('bottom');
262 GtslCheck.Clear;
263 GraphPanel(true);
264 frmGraphData.pnlData.Hint := Patient.DFN;
265 BringToFront;
266 end;
267 finally
268 if GraphForm.btnClose.Tag = 1 then
269 begin
270 GraphFormActive := false;
271 GraphForm.Free;
272 GraphForm := nil;
273 end
274 else
275 GraphFormActive := true;
276 end;
277 end
278 else if GraphForm.btnClose.Tag = 1 then
279 Exit
280 else
281 begin
282 with GraphForm do
283 if pnlMain.Tag <> reportien then
284 begin // different report
285 pnlMain.Tag := reportien;
286 Initialize;
287 GtslCheck.Clear;
288 GraphPanel(true);
289 BringToFront;
290 end;
291 end;
292end;
293
294procedure TfrmReports.GraphPanel(active: boolean);
295var
296 adddaterange: boolean;
297 i: integer;
298 aQualifier, aStartTime, aStopTime, aNewLine: string;
299begin
300 if active then
301 begin
302 pnlLeftBottom.Height := pnlLeft.Height div 2;
303 pnlViews.Height := pnlLeftBottom.Height;
304 if pnlLeft.Height < 200 then
305 pnlTopViews.Height := 3
306 else
307 pnlTopViews.Height := 80;
308 lblQualifier.Visible := false;
309 lstQualifier.Visible := false;
310 pnlViews.Visible := true;
311 if lstDateRange.Tag = 0 then
312 begin
313 lstDateRange.Tag := 1;
314 aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
315 aStartTime := Piece(aQualifier,';',1);
316 aStopTime := Piece(aQualifier,';',2);
317 adddaterange := true;
318 aNewLine := '^' + aStartTime + ' to ' + aStopTime +'^^^' + aStartTime + ';' + aStopTime +
319 '^' + floattostr(strtofmdatetime(aStartTime)) + '^' + floattostr(strtofmdatetime(aStopTime));
320 for i := 0 to GraphForm.cboDateRange.Items.Count - 1 do
321 if GraphForm.cboDateRange.Items[i] = aNewLine then
322 begin
323 adddaterange := false;
324 break;
325 end;
326 if adddaterange then GraphForm.cboDateRange.Items.Add(aNewLine);
327 lstDateRange.Items := GraphForm.cboDateRange.Items;
328 GraphForm.DateDefaults;
329 lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
330 //lstDateRange.ItemIndex := lstDateRange.Items.Count - 1;
331 //lstDateRange.ItemIndex := lstDateRange.Items.Count - 2; //set to all results till fixed
332 lstDateRangeClick(self);
333 end;
334 pnlLeftBottom.Visible := true;
335 splitter1.Visible := true;
336 end
337 else
338 begin
339 lblQualifier.Visible := true;
340 lstQualifier.Visible := true;
341 pnlViews.Visible := false;
342 pnlLeftBottom.Height := lblHeaders.Height + lblQualifier.Height + 90;
343 end;
344end;
345
346function TfrmReports.AllowContextChange(var WhyNot: string): Boolean;
347var
348 i: integer;
349begin
350 Result := inherited AllowContextChange(WhyNot); // sets result = true
351 if Timer1.Enabled = true then
352 case BOOLCHAR[frmFrame.CCOWContextChanging] of
353 '1': begin
354 WhyNot := 'A remote data query in progress will be aborted.';
355 Result := False;
356 end;
357 '0': if WhyNot = 'COMMIT' then
358 begin
359 with RemoteSites.SiteList do for i := 0 to Count - 1 do
360 if TRemoteSite(Items[i]).Selected then
361 if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
362 begin
363 TRemoteSite(Items[i]).ReportClear;
364 TRemoteSite(Items[i]).QueryStatus := '-1^Aborted';
365 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Query Aborted');
366 end;
367 Timer1.Enabled := false;
368 Result := True;
369 end;
370 end;
371end;
372
373procedure TfrmReports.RequestPrint;
374begin
375 if uReportType = 'M' then
376 begin
377 InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
378 Exit;
379 end;
380 if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then
381 begin
382 if lvReports.Items.Count < 1 then
383 begin
384 InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK);
385 Exit;
386 end;
387 if lvReports.SelCount < 1 then
388 begin
389 InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK);
390 Exit;
391 end;
392 end;
393 if (uReportType = 'G') and GraphFormActive then
394 with GraphForm do
395 begin
396 if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then
397 begin
398 InfoBox('There are no items graphed.', 'No Items to Print', MB_OK);
399 Exit;
400 end
401 else
402 begin
403 mnuPopGraphPrintClick(mnuPopGraphPrint);
404 Exit;
405 end;
406 end;
407 if uQualifierType = QT_DATERANGE then
408 begin // = 2
409 if lstQualifier.ItemIndex < 0 then
410 begin
411 InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK);
412 end
413 else
414 PrintReports(uRptID, piece(uRemoteType,'^',4));
415 end
416 else
417 PrintReports(uRptID, piece(uRemoteType,'^',4));
418end;
419
420procedure TfrmReports.DisplayPage;
421var
422 i: integer;
423begin
424 inherited DisplayPage;
425 frmFrame.mnuFilePrint.Tag := CT_REPORTS;
426 frmFrame.mnuFilePrint.Enabled := True;
427 frmFrame.mnuFilePrintSetup.Enabled := True;
428 uUpdateStat := false;
429 ulvSelectOn := false;
430 uListState := GetAdhocLookup();
431 memText.SelStart := 0;
432 FormShow(self);
433 uHTMLPatient := '<DIV align left>'
434 + '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
435 + '<TR valign="bottom" align="left">'
436 + '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
437 + '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
438{ TODO -oRV -cWVEHR Long Age : Changed to use long age }
439 //+ '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
440 + '<TD nowrap><B>Age: ' + GetPatientBriefAge(Patient.DFN) + '</B></TD>'
441{}
442 + '</TR></TABLE></DIV><HR>';
443 //the preferred method would be to use headers and footers
444 //so this is just an interim solution.
445 if not GraphFormActive then
446 pnlLeftBottom.Visible := False;
447 if InitPage then
448 begin
449 Splitter1.Visible := false;
450 pnlLeftBottom.Visible := false;
451 uMaxOcc := '';
452 uColChange := '';
453 LoadTreeView;
454 end;
455 if InitPatient and not (CallingContext = CC_NOTIFICATION) then
456 begin
457 uColChange := '';
458 lstQualifier.Clear;
459 tvProcedures.Items.Clear;
460 lblProcTypeMsg.Visible := FALSE;
461 lvReports.SmallImages := uEmptyImageList;
462 imgLblImages.ComponentImageListChanged;
463 lvReports.Items.Clear;
464 lvReports.Columns.Clear;
465 lblTitle.Caption := '';
466 lvReports.Caption := '';
467 Splitter1.Visible := false;
468 pnlLeftBottom.Visible := false;
469 memText.Parent := pnlRightBottom;
470 memText.Align := alClient;
471 memText.Clear;
472 uReportInstruction := '';
473 uLocalReportData.Clear;
474 for i := 0 to RemoteSites.SiteList.Count - 1 do
475 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
476 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
477 StatusText('');
478 with tvReports do
479 if Items.Count > 0 then
480 begin
481 tvReports.Selected := tvReports.Items.GetFirstNode;
482 tvReportsClick(self);
483 end;
484 end;
485 case CallingContext of
486 CC_INIT_PATIENT: if not InitPatient then
487 begin
488 uColChange := '';
489 lstQualifier.Clear;
490 tvProcedures.Items.Clear;
491 lblProcTypeMsg.Visible := FALSE;
492 lvReports.SmallImages := uEmptyImageList;
493 imgLblImages.ComponentImageListChanged;
494 lvReports.Items.Clear;
495 Splitter1.Visible := false;
496 pnlLeftBottom.Visible := false;
497 with tvReports do
498 if Items.Count > 0 then
499 begin
500 tvReports.Selected := tvReports.Items.GetFirstNode;
501 tvReportsClick(self);
502 end;
503 end;
504 CC_NOTIFICATION: ProcessNotifications;
505 end;
506end;
507
508procedure TfrmReports.UpdateRemoteStatus(aSiteID, aStatus: string);
509var
510 j: integer;
511 s: string;
512 c: boolean;
513begin
514 if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame
515 uUpdateStat := true;
516 for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
517 begin
518 s := frmFrame.lstCIRNLocations.Items[j];
519 c := frmFrame.lstCIRNLocations.checked[j];
520 if piece(s, '^', 1) = aSiteID then
521 begin
522 frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
523 frmFrame.lstCIRNLocations.checked[j] := c;
524 end;
525 end;
526 uUpdateStat := false;
527end;
528
529procedure TfrmReports.LoadTreeView;
530var
531 i,j: integer;
532 currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
533 x: string;
534 addchild, addgrandchild, addgtgrandchild: boolean;
535begin
536 tvReports.Items.Clear;
537 memText.Clear;
538 uHTMLDoc := '';
539 WebBrowser1.Navigate('about:blank');
540 tvProcedures.Items.Clear;
541 lblProcTypeMsg.Visible := FALSE;
542 lvReports.SmallImages := uEmptyImageList;
543 imgLblImages.ComponentImageListChanged;
544 lvReports.Items.Clear;
545 uTreeStrings.Clear;
546 lblTitle.Caption := '';
547 lvReports.Caption := '';
548 ListReports(uTreeStrings);
549 addchild := false;
550 addgrandchild := false;
551 addgtgrandchild := false;
552 parentNode := nil;
553 grandParentNode := nil;
554 gtGrandParentNode := nil;
555 currentNode := nil;
556 for i := 0 to uTreeStrings.Count - 1 do
557 begin
558 x := uTreeStrings[i];
559 if UpperCase(Piece(x,'^',1))='[PARENT END]' then
560 begin
561 if addgtgrandchild = true then
562 begin
563 currentNode := gtgrandParentNode;
564 addgtgrandchild := false;
565 end
566 else
567 if addgrandchild = true then
568 begin
569 currentNode := grandParentNode;
570 addgrandchild := false;
571 end
572 else
573 begin
574 currentNode := parentNode;
575 addchild := false;
576 end;
577 continue;
578 end;
579 if UpperCase(Piece(x,'^',1))='[PARENT START]' then
580 begin
581 if addgtgrandchild = true then
582 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
583 else
584 if addgrandchild = true then
585 begin
586 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
587 addgtgrandchild := true;
588 gtgrandParentNode := currentNode;
589 end
590 else
591 if addchild = true then
592 begin
593 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
594 addgrandchild := true;
595 grandParentNode := currentNode;
596 end
597 else
598 begin
599 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
600 parentNode := currentNode;
601 addchild := true;
602 end;
603 end
604 else
605 if addchild = false then
606 begin
607 currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x));
608 parentNode := currentNode;
609 end
610 else
611 begin
612 if addgtgrandchild = true then
613 currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
614 else
615 if addgrandchild = true then
616 currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
617 else
618 currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x));
619 end;
620 end;
621 for i := 0 to tvReports.Items.Count - 1 do
622 if Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4) = '1' then
623 begin
624 HealthSummaryCheck(uHSAll,'1');
625 for j := 0 to uHSAll.Count - 1 do
626 tvReports.Items.AddChildObject(tvReports.Items[i],Piece(uHSAll[j],'^',2),MakeReportTreeObject(uHSAll[j]));
627 end;
628 if tvReports.Items.Count > 0 then begin
629 tvReports.Selected := tvReports.Items.GetFirstNode;
630 tvReportsClick(self);
631 end;
632end;
633
634procedure TfrmReports.SetFontSize(NewFontSize: Integer);
635var
636 pnlRightMiddlePct: Real;
637 frmReportsHeight, pnlRightHeight: Integer;
638
639begin
640 pnlRightMiddlePct := (pnlRightMiddle.Height / (pnlRight.Height - (sptHorzRight.Height + pnlRightTop.Height)));
641 pnlRightMiddle.Constraints.MaxHeight := 20;
642 inherited SetFontSize(NewFontSize);
643 memText.Font.Size := NewFontSize;
644 frmReportsHeight := frmFrame.pnlPatientSelectedHeight - (frmFrame.pnlToolbar.Height + frmFrame.stsArea.Height + frmFrame.tabPage.Height + 2);
645 pnlRightHeight := frmReportsHeight - shpPageBottom.Height;
646 pnlRightMiddle.Constraints.MaxHeight := 0;
647 pnlRightMiddle.Height := (Round((pnlRightHeight - (sptHorzRight.Height + pnlRightTop.Height)) * pnlRightMiddlePct) - 14);
648 if frmFrame.Height <> frmFrame.frmFrameHeight then
649 begin
650 pnlRight.Height := pnlRightHeight;
651 frmReports.Height := frmReportsHeight;
652 frmFrame.Height := frmFrame.frmFrameHeight;
653 end;
654end;
655
656procedure TfrmReports.LoadListView(aReportData: TStringList);
657var
658 i,j,k,aErr: integer;
659 aTmpAray: TStringList;
660 aColCtr, aCurCol, aCurRow, aColID: integer;
661 x,y,z,c,aSite: string;
662 ListItem: TListItem;
663begin
664 aSite := '';
665 aErr := 0;
666 ListItem := nil;
667 case uQualifierType of
668 QT_HSCOMPONENT:
669 begin // = 5
670 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
671 begin
672 with lvReports do
673 begin
674 ViewStyle := vsReport;
675 for j := 0 to aReportData.Count - 1 do
676 begin
677 if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call
678 continue;
679 ListItem := Items.Add;
680 aSite := piece(aReportData[j],'^',1);
681 ListItem.Caption := piece(aSite,';',1);
682 for k := 2 to uColumns.Count do
683 begin
684 ListItem.SubItems.Add(piece(aReportData[j],'^',k));
685 end;
686 end;
687 if aReportData.Count = 0 then
688 begin
689 uReportInstruction := '<No Data Available>';
690 memText.Lines.Clear;
691 memText.Lines.Add(uReportInstruction);
692 end
693 else
694 memText.Lines.Clear;
695 end;
696 end;
697 end;
698 QT_HSWPCOMPONENT:
699 begin // = 6
700 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
701 begin
702 aTmpAray := TStringList.Create;
703 aCurRow := 0;
704 aCurCol := 0;
705 aColCtr := 9;
706 aTmpAray.Clear;
707 with lvReports do
708 begin
709 for j := 0 to aReportData.Count - 1 do
710 begin
711 x := aReportData[j];
712 aColID := StrToIntDef(piece(x,'^',1),-1);
713 if aColID < 0 then //this is an error condition most likely an incompatible remote call
714 continue;
715 if aColID > (uColumns.Count - 1) then
716 begin
717 aErr := 1;
718 continue; //extract is out of sync with columns defined in 101.24
719 end;
720 if aColID < aColCtr then
721 begin
722 if aTmpAray.Count > 0 then
723 begin
724 if aColCtr = 1 then
725 begin
726 ListItem := Items.Add;
727 aSite := piece(aTmpAray[j],'^',1);
728 ListItem.Caption := piece(aSite,';',1);
729 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
730 end
731 else
732 begin
733 c := aTmpAray[0];
734 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
735 c := c + '...';
736 z := piece(c,'^',1);
737 y := copy(c, (pos('^', c)), 9999);
738 if pos('^',y) > 0 then
739 begin
740 while pos('^',y) > 0 do
741 begin
742 y := copy(y, (pos('^', y)+1), 9999);
743 z := z + '^' + y;
744 end;
745 ListItem.SubItems.Add(z);
746 end
747 else
748 begin
749 ListItem.SubItems.Add(y);
750 end;
751 end;
752 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
753 aTmpAray.Clear;
754 end;
755 aColCtr := 0;
756 aCurCol := aColID;
757 aCurRow := aCurRow + 1;
758 end
759 else
760 if aColID = aCurCol then
761 begin
762 z := '';
763 y := piece(x,'^',2);
764 if length(y) > 0 then z := y;
765 y := copy(x, (pos('^', x)+1), 9999);
766 if pos('^',y) > 0 then
767 begin
768 while pos('^',y) > 0 do
769 begin
770 y := copy(y, (pos('^', y)+1), 9999);
771 z := z + '^' + y;
772 end;
773 aTmpAray.Add(z);
774 end
775 else
776 begin
777 aTmpAray.Add(y);
778 end;
779 continue;
780 end;
781 if aTmpAray.Count > 0 then
782 begin
783 if aColCtr = 1 then
784 begin
785 ListItem := Items.Add;
786 aSite := piece(aTmpAray[0],'^',1);
787 ListItem.Caption := piece(aSite,';',1);
788 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
789 end
790 else
791 begin
792 c := aTmpAray[0];
793 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
794 c := c + '...';
795 ListItem.SubItems.Add(c);
796 end;
797 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
798 aTmpAray.Clear;
799 end;
800 aCurCol := aColID;
801 Inc(aColCtr);
802 y := '';
803 for k := 2 to 10 do
804 if length(piece(x,'^',k)) > 0 then
805 begin
806 if length(y) > 0 then y := y + '^' + piece(x,'^',k)
807 else y := y + piece(x,'^',k);
808 end;
809 aTmpAray.Add(y);
810 if aColCtr > 0 then
811 while aColCtr < aCurCol do
812 begin
813 ListItem.SubItems.Add('');
814 Inc(aColCtr);
815 end;
816 end;
817 if aTmpAray.Count > 0 then
818 begin
819 if aColCtr = 1 then
820 begin
821 ListItem := Items.Add;
822 aSite := piece(aTmpAray[0],'^',1);
823 ListItem.Caption := piece(aSite,';',1);
824 ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
825 end
826 else
827 begin
828 c := aTmpAray[0];
829 if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
830 c := c + '...';
831 ListItem.SubItems.Add(c);
832 end;
833 RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
834 aTmpAray.Clear;
835 end;
836 end;
837 aTmpAray.Free;
838 end;
839 if uRptID = 'OR_R18:IMAGING' then with lvReports do //set image indicator for "Imaging" report
840 begin
841 SmallImages := dmodShared.imgImages;
842 imgLblImages.ComponentImageListChanged;
843 for i := 0 to Items.Count - 1 do
844 if (Items[i].SubItems.Count > 7) and (Items[i].SubItems[7] = 'Y') then
845 Items[i].SubItemImages[1] := IMG_1_IMAGE
846 else
847 Items[i].SubItemImages[1] := IMG_NO_IMAGES;
848 end
849 else //lvReports.SmallImages := uEmptyImageList;
850 if uRptID = 'OR_PN:PROGRESS NOTES' then with lvReports do //set image indicator for "Progress Notes" report
851 begin
852 SmallImages := dmodShared.imgImages;
853 imgLblImages.ComponentImageListChanged;
854 for i := 0 to Items.Count - 1 do
855 if (Items[i].SubItems.Count > 7) and (StrToInt(Items[i].SubItems[7]) > 0) then
856 Items[i].SubItemImages[2] := IMG_1_IMAGE
857 else
858 Items[i].SubItemImages[2] := IMG_NO_IMAGES;
859 end
860 else begin
861 lvReports.SmallImages := uEmptyImageList;
862 imgLblImages.ComponentImageListChanged;
863 end;
864 end;
865 end;
866 if aErr = 1 then
867 if User.HasKey('XUPROGMODE') then
868 ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
869end;
870
871procedure TfrmReports.lstQualifierClick(Sender: TObject);
872var
873 MoreID: String; //Restores MaxOcc value
874 aRemote, aHDR, aFHIE: string;
875 i: integer;
876begin
877 inherited;
878 if uFrozen = True then
879 begin
880 memo1.visible := False;
881 memo1.TabStop := False;
882 end;
883 MoreID := ';' + Piece(uQualifier,';',3);
884 if chkMaxFreq.checked = true then
885 begin
886 MoreID := '';
887 SetPiece(uQualifier,';',3,'');
888 end;
889 aRemote := piece(uRemoteType,'^',1);
890 aHDR := piece(uRemoteType,'^',7);
891 aFHIE := piece(uRemoteType,'^',8);
892 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
893 uHSComponents.Clear;
894 uHSAll.Clear;
895 tvProcedures.Items.Clear;
896 lblProcTypeMsg.Visible := FALSE;
897 uHTMLDoc := '';
898 if uReportType = 'H' then
899 begin
900 WebBrowser1.Visible := true;
901 WebBrowser1.TabStop := true;
902 WebBrowser1.Navigate('about:blank');
903 WebBrowser1.BringToFront;
904 memText.Visible := false;
905 memText.TabStop := false;
906 end
907 else
908 begin
909 WebBrowser1.Visible := false;
910 WebBrowser1.TabStop := false;
911 memText.Visible := true;
912 memText.TabStop := true;
913 memText.BringToFront;
914 RedrawActivate(memText.Handle);
915 end;
916 uLocalReportData.Clear;
917 uRemoteReportData.Clear;
918 for i := 0 to RemoteSites.SiteList.Count - 1 do
919 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
920 uRemoteCount := 0;
921 if aHDR = '1' then
922 DisplayHeading(lstQualifier.ItemID)
923 else
924 DisplayHeading(lstQualifier.ItemID + MoreID);
925 if lstQualifier.ItemID = 'ds' then
926 begin
927 with calApptRng do
928 if Not (Execute) then
929 begin
930 lstQualifier.ItemIndex := -1;
931 Exit;
932 end
933 else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
934 begin
935 if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
936 if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then
937 begin
938 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
939 + ' for this report.', 'No Report Generated',MB_OK);
940 lstQualifier.ItemIndex := -1;
941 exit;
942 end;
943 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
944 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
945 DisplayHeading(lstQualifier.ItemID + MoreID);
946 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
947 end
948 else
949 begin
950 lstQualifier.ItemIndex := -1;
951 InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK);
952 if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
953 begin
954 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
955 ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
956 DisplayHeading(lstQualifier.ItemID + MoreID);
957 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
958 end
959 else
960 begin
961 lstQualifier.ItemIndex := -1;
962 InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK);
963 exit;
964 end;
965 end;
966 end;
967 if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
968 if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then
969 begin
970 InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
971 + ' for this report.', 'No Report Generated',MB_OK);
972 lstQualifier.ItemIndex := -1;
973 exit;
974 end;
975 StatusText('Retrieving ' + lblTitle.Caption + '...');
976 Screen.Cursor := crHourGlass;
977 uReportInstruction := #13#10 + 'Retrieving data...';
978 memText.Lines.Add(uReportInstruction);
979 if WebBrowser1.Visible = true then
980 begin
981 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
982 WebBrowser1.Navigate('about:blank');
983 end;
984 case uQualifierType of
985 QT_HSCOMPONENT:
986 begin // = 5
987 lvReports.SmallImages := uEmptyImageList;
988 imgLblImages.ComponentImageListChanged;
989 lvReports.Items.Clear;
990 memText.Lines.Clear;
991 RowObjects.Clear;
992 if ((aRemote = '1') or (aRemote = '2')) then
993 GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
994 if not(piece(uRemoteType, '^', 9) = '1') then
995 if (length(piece(uHState,';',2)) > 0) then
996 begin
997 if not(aRemote = '2') then
998 LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
999 LoadListView(uLocalReportData);
1000 end
1001 else
1002 begin
1003 if ((aRemote = '1') or (aRemote = '2')) then
1004 ShowTabControl;
1005 pnlRightMiddle.Visible := false;
1006 LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1007 if uLocalReportData.Count < 1 then
1008 begin
1009 uReportInstruction := '<No Report Available>';
1010 memText.Lines.Add(uReportInstruction);
1011 end
1012 else
1013 begin
1014 QuickCopy(uLocalReportData,memText);
1015 TabControl1.OnChange(nil);
1016 end;
1017 end;
1018 end;
1019 QT_HSWPCOMPONENT:
1020 begin // = 6
1021 lvReports.SmallImages := uEmptyImageList;
1022 imgLblImages.ComponentImageListChanged;
1023 lvReports.Items.Clear;
1024 RowObjects.Clear;
1025 memText.Lines.Clear;
1026 if ((aRemote = '1') or (aRemote = '2')) then
1027 begin
1028 Screen.Cursor := crDefault;
1029 GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1030 end;
1031 if not(piece(uRemoteType, '^', 9) = '1') then
1032 if (length(piece(uHState,';',2)) > 0) then
1033 begin
1034 if not(aRemote = '2') then
1035 LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1036 LoadListView(uLocalReportData);
1037 end
1038 else
1039 begin
1040 if ((aRemote = '1') or (aRemote = '2')) then
1041 ShowTabControl;
1042 pnlRightMiddle.Visible := false;
1043 if not (aRemote = '2') then
1044 begin
1045 LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1046 if uLocalReportData.Count < 1 then
1047 begin
1048 uReportInstruction := '<No Report Available>';
1049 memText.Lines.Add(uReportInstruction);
1050 end
1051 else
1052 QuickCopy(uLocalReportData,memText);
1053 end;
1054 end;
1055 end
1056 else
1057 begin
1058 Screen.Cursor := crDefault;
1059 GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1060 if Pos('ECS',Piece(uRptID,':',1))>0 then
1061 begin
1062 if Pos('OR_ECS1',uRptID)>0 then
1063 uECSReport.ReportHandle := 'ECPCER';
1064 if Pos('OR_ECS2',uRptID)>0 then
1065 uECSReport.ReportHandle := 'ECPAT';
1066 uECSReport.ReportType := 'D';
1067 if uECSReport.ReportHandle = 'ECPAT' then
1068 begin
1069 if InfoBox('Would you like the procedure reason be included in the report?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
1070 uECSReport.NeedReason := 'Y'
1071 else
1072 uECSReport.NeedReason := 'N';
1073 end;
1074 FormatECSDate(lstQualifier.ItemID, uECSReport);
1075 LoadECSReportText(uLocalReportData, uECSReport);
1076 end else
1077 if not(piece(uRemoteType, '^', 9) = '1') then
1078 LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1079 if not(piece(uRemoteType, '^', 9) = '1') then
1080 if TabControl1.TabIndex < 1 then
1081 QuickCopy(uLocalReportData,memText);
1082 end;
1083 end;
1084 Screen.Cursor := crDefault;
1085 StatusText('');
1086 memText.Lines.Insert(0,' ');
1087 memText.Lines.Delete(0);
1088 if WebBrowser1.Visible = true then
1089 begin
1090 if uReportType = 'R' then
1091 uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
1092 else
1093 uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
1094 WebBrowser1.Navigate('about:blank');
1095 end;
1096end;
1097
1098procedure TfrmReports.GotoTop1Click(Sender: TObject);
1099var
1100 Current, Desired : Longint;
1101begin
1102 inherited;
1103 with memText do
1104 begin
1105 SetFocus;
1106 SelStart :=0;
1107 SelLength :=0;
1108 Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1109 Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
1110 memText.SelStart + memText.SelLength ,0) - 1;
1111 SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current);
1112 end;
1113end;
1114
1115procedure TfrmReports.GotoBottom1Click(Sender: TObject);
1116var
1117 Current, Desired : Longint;
1118 I,LineCount : Integer;
1119begin
1120 Inherited;
1121 LineCount :=0;
1122 with memText do
1123 begin
1124 for I := 0 to lines.count-1 do
1125 LineCount := LineCount + Length(Lines[I]) + 2;
1126 SetFocus;
1127 SelStart := LineCount;
1128 SelLength :=0;
1129 end;
1130 Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1131 Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
1132 memText.SelStart + memText.SelLength ,0);
1133 SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current - 5);
1134end;
1135
1136procedure TfrmReports.FreezeText1Click(Sender: TObject);
1137var
1138 Current, Desired : Longint;
1139 LineCount : Integer;
1140begin
1141 Inherited;
1142 If memText.SelLength > 0 then begin
1143 Memo1.visible := true;
1144 Memo1.TabStop := true;
1145 Memo1.Text := memText.SelText;
1146 If Memo1.Lines.Count <6 then
1147 LineCount := Memo1.Lines.Count + 1
1148 Else
1149 LineCount := 5;
1150 Memo1.Height := LineCount * frmReports.Canvas.TextHeight(memText.SelText);
1151 Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1152 Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
1153 memText.SelStart + memText.SelLength ,0);
1154 SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current);
1155 uFrozen := True;
1156 end;
1157end;
1158
1159procedure TfrmReports.UnFreezeText1Click(Sender: TObject);
1160begin
1161 Inherited;
1162 If uFrozen = True Then begin
1163 uFrozen := False;
1164 UnFreezeText1.Enabled := False;
1165 Memo1.Visible := False;
1166 Memo1.TabStop := False;
1167 Memo1.Text := '';
1168 end;
1169end;
1170
1171procedure TfrmReports.PopupMenu1Popup(Sender: TObject);
1172begin
1173 inherited;
1174 If Screen.ActiveControl.Name <> memText.Name then
1175 begin
1176 memText.SetFocus;
1177 memText.SelStart := 0;
1178 end;
1179 If memText.SelLength > 0 Then
1180 FreezeText1.Enabled := True
1181 Else
1182 FreezeText1.Enabled := False;
1183 If Memo1.Visible Then
1184 UnFreezeText1.Enabled := True;
1185 If memText.SelStart > 0 then
1186 GotoTop1.Enabled := True
1187 Else
1188 GotoTop1.Enabled := False;
1189 If SendMessage(memText.handle, EM_LINEFROMCHAR,
1190 memText.SelStart,0) < memText.Lines.Count then
1191 GotoBottom1.Enabled := True
1192 Else
1193 GotoBottom1.Enabled := False;
1194end;
1195
1196procedure TfrmReports.FormCreate(Sender: TObject);
1197begin
1198 inherited;
1199 PageID := CT_REPORTS;
1200 uFrozen := False;
1201 uHSComponents := TStringList.Create;
1202 uHSAll := TStringList.Create;
1203 uLocalReportData := TStringList.Create;
1204 uRemoteReportData := TStringList.Create;
1205 uColumns := TStringList.Create;
1206 uTreeStrings := TStringList.Create;
1207 uEmptyImageList := TImageList.Create(Self);
1208 uEmptyImageList.Width := 0;
1209 RowObjects := TRowObject.Create;
1210 uRemoteCount := 0;
1211 GraphFormActive := false;
1212end;
1213
1214procedure TfrmReports.ProcessNotifications;
1215var
1216 j, AnIndex, IDColumn: integer;
1217 SelectID: string;
1218 ListItem: TListItem;
1219 tmpRptID: string;
1220
1221 function FindReport(QualType: integer; var AnIndex: integer): boolean; overload;
1222 var
1223 Found: boolean;
1224 i: integer;
1225 begin
1226 Found := False;
1227 with tvReports do
1228 begin
1229 for i := 0 to Items.Count -1 do
1230 if StrToIntDef(Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4),0) = QualType then
1231 begin
1232 Found := True;
1233 break;
1234 end;
1235 end;
1236 Result := Found ;
1237 AnIndex := i;
1238 end;
1239
1240 function FindReport(ReportID: string; var AnIndex: integer): boolean; overload;
1241 var
1242 Found: boolean;
1243 i: integer;
1244 begin
1245 Found := False;
1246 with tvReports do
1247 begin
1248 for i := 0 to Items.Count -1 do
1249 if Piece(PReportTreeObject(tvReports.Items[i].Data)^.ID, ':', 1) = ReportID then
1250 begin
1251 Found := True;
1252 break;
1253 end;
1254 end;
1255 Result := Found ;
1256 AnIndex := i;
1257 end;
1258
1259begin
1260 IDColumn := 0;
1261 case Notifications.Followup of
1262 NF_IMAGING_RESULTS, NF_ABNORMAL_IMAGING_RESULTS, NF_IMAGING_RESULTS_AMENDED:
1263 begin
1264 if not FindReport(QT_IMAGING, AnIndex) then exit;
1265 tvReports.Selected := tvReports.Items[AnIndex];
1266 SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
1267 '-' + Piece(Notifications.AlertData, '~', 2);
1268 IDColumn := 0;
1269 if tvReports.Selected <> tvReports.Items[AnIndex] then
1270 tvReports.Selected := tvReports.Items[AnIndex];
1271 end;
1272 NF_IMAGING_REQUEST_CHANGED:
1273 begin
1274 if not FindReport(QT_IMAGING, AnIndex) then exit;
1275 tvReports.Selected := tvReports.Items[AnIndex];
1276 SelectID := 'i' + Piece(Notifications.AlertData, '/', 2) +
1277 '-' + Piece(Notifications.AlertData, '/', 3);
1278 IDColumn := 0;
1279 if tvReports.Selected <> tvReports.Items[AnIndex] then
1280 tvReports.Selected := tvReports.Items[AnIndex];
1281 end;
1282 NF_STAT_RESULTS :
1283 begin
1284 if not FindReport(QT_IMAGING, AnIndex) then exit;
1285 tvReports.Selected := tvReports.Items[AnIndex];
1286 SelectID := 'i' + Piece(Notifications.AlertData, '~', 2) +
1287 '-' + Piece(Piece(Notifications.AlertData, '~', 3), '@', 1);
1288 IDColumn := 0;
1289 if tvReports.Selected <> tvReports.Items[AnIndex] then
1290 tvReports.Selected := tvReports.Items[AnIndex];
1291 end;
1292 NF_MAMMOGRAM_RESULTS :
1293 begin
1294 if not FindReport('OR_R18', AnIndex) then exit;
1295 tvReports.Selected := tvReports.Items[AnIndex];
1296 SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
1297 '-' + Piece(Notifications.AlertData, '~', 2);
1298 IDColumn := 8;
1299 if tvReports.Selected <> tvReports.Items[AnIndex] then
1300 tvReports.Selected := tvReports.Items[AnIndex];
1301 end;
1302 NF_ANATOMIC_PATHOLOGY_RESULTS :
1303 //OR_SP^Surgical Pathology
1304 //OR_CY^Cytology
1305 //OR_EM^Electron Microscopy
1306 //OR_AU^Autopsy
1307 begin
1308 if Notifications.AlertData = '^1^^^0^0^0' then //code snippet to handle the processing of v26 AP alerts in a v27 environment.
1309 begin
1310 if pnlRightMiddle.Visible then pnlRightMiddle.Visible := FALSE;
1311 InfoBox('This alert was generated in a v26 environment as an informational alert and'
1312 + CRLF + 'therefore cannot be processed as an action alert in a v27 environment.',
1313 'Unable to Process as Action Alert', MB_OK or MB_ICONWARNING);
1314 memText.Text := 'Unable to Process as an Action Alert. In order to view the associated Anatomic Pathology report, please manually'
1315 + CRLF + 'locate the appropriate report under the Anatomic Pathology section (also found under Laboratory, Clinical Reports).';
1316 Notifications.Delete;
1317 exit;
1318 end;
1319 tmpRptID := Piece(Notifications.AlertData, U, 1);
1320 //if tmpRptID = 'CY' then tmpRptID := 'APR';
1321 //if tmpRptID = 'EM' then tmpRptID := 'APR';
1322 //if tmpRptID = 'SP' then tmpRptID := 'APR';
1323 if not FindReport('OR_' + tmpRptID, AnIndex) then exit;
1324 tvReports.Selected := tvReports.Items[AnIndex];
1325 SelectID := Piece(Notifications.AlertData, U, 2);
1326 if (tmpRptID = 'CY') or (tmpRptID = 'EM') or (tmpRptID = 'SP') then
1327 IDColumn := 3;
1328 //if tmpRptID = 'APR' then IDColumn := 3
1329 //else if tmpRptID = 'SP' then IDColumn := 3
1330 //else if tmpRptID = 'EM' then IDColumn := 3
1331 //else if tmpRptID = 'CY' then IDColumn := 3 ;
1332 if tvReports.Selected <> tvReports.Items[AnIndex] then
1333 tvReports.Selected := tvReports.Items[AnIndex];
1334 end;
1335 NF_PAP_SMEAR_RESULTS :
1336 begin
1337 if not FindReport('OR_CY', AnIndex) then exit;
1338 tvReports.Selected := tvReports.Items[AnIndex];
1339 SelectID := Piece(Notifications.AlertData, U, 2);
1340 IDColumn := 3;
1341 if tvReports.Selected <> tvReports.Items[AnIndex] then
1342 tvReports.Selected := tvReports.Items[AnIndex];
1343 end;
1344 else with tvReports do if Items.Count > 0 then Selected := Items[0];
1345 end;
1346 if tvReports.Selected <> nil then
1347 begin
1348 tvReportsClick(Self);
1349 Application.ProcessMessages;
1350 for j := 0 to lvReports.Items.Count - 1 do
1351 begin
1352 ListItem := lvReports.Items[j];
1353 if ListItem.Subitems[IDColumn] = SelectID then
1354 begin
1355 lvReports.Selected := lvReports.Items[j];
1356 break;
1357 end;
1358 end;
1359 Notifications.Delete;
1360 end;
1361end;
1362
1363procedure TfrmReports.DisplayHeading(aRanges: string);
1364var
1365 x,x1,x2,y,z,DaysBack: string;
1366 d1,d2: TFMDateTime;
1367begin
1368 with lblTitle do
1369 begin
1370 x := '';
1371 if tvReports.Selected = nil then
1372 tvReports.Selected := tvReports.Items.GetFirstNode;
1373 if tvReports.Selected.Parent <> nil then
1374 x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text
1375 else
1376 x := tvReports.Selected.Text;
1377 x1 := '';
1378 x2 := '';
1379 if uReportType <> 'M' then
1380 begin
1381 if CharAt(aRanges, 1) = 'd' then
1382 begin
1383 if length(piece(aRanges,';',2)) > 0 then
1384 begin
1385 x2 := ' Max/site:' + piece(aRanges,';',2);
1386 aRanges := piece(aRanges,';',1);
1387 end;
1388 DaysBack := Copy(aRanges, 2, Length(aRanges));
1389 if DaysBack = '0' then
1390 aRanges := 'T' + ';T'
1391 else
1392 aRanges := 'T-' + DaysBack + ';T';
1393 end;
1394 if length(piece(aRanges,';',1)) > 0 then
1395 if uReportType <> 'G' then // graphs don't display date ranges here
1396 begin
1397 d1 := ValidDateTimeStr(piece(aRanges,';',1),'');
1398 d2 := ValidDateTimeStr(piece(aRanges,';',2),'');
1399 y := FormatFMDateTime('mmm dd,yyyy',d1);
1400 if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
1401 z := FormatFMDateTime('mmm dd,yyyy',d2);
1402 x1 := ' [From: ' + y + ' to ' + z + ']';
1403 end;
1404 if length(piece(aRanges,';',3)) > 0 then
1405 x2 := ' Max/site:' + piece(aRanges,';',3);
1406 case uQualifierType of
1407 QT_DATERANGE:
1408 x := x + x1;
1409 QT_HSCOMPONENT:
1410 x := x + x1 + x2;
1411 QT_HSWPCOMPONENT:
1412 x := x + x1 + x2;
1413 QT_IMAGING:
1414 x := x + x1 + x2;
1415 end;
1416 end;
1417 if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DOD DATA INCLUDED IN REPORT>>';
1418 Caption := x;
1419 end;
1420 lvReports.Caption := x;
1421end;
1422
1423procedure TfrmReports.FormShow(Sender: TObject);
1424begin
1425 inherited;
1426 if RemoteSites.SiteList.Count > 0 then
1427 begin
1428 case uQualifierType of
1429 QT_HSWPCOMPONENT:;
1430 QT_HSCOMPONENT:;
1431 QT_IMAGING:;
1432 QT_PROCEDURES:;
1433 QT_NUTR:;
1434 else
1435 ShowTabControl;
1436 end;
1437 end;
1438end;
1439
1440procedure TfrmReports.Timer1Timer(Sender: TObject);
1441var
1442 i,j,fail: integer;
1443 r0,aSite: String;
1444 aHDR, aID, aRet: String;
1445begin
1446 inherited;
1447 with RemoteSites.SiteList do
1448 begin
1449 for i := 0 to Count - 1 do
1450 if TRemoteSite(Items[i]).Selected then
1451 begin
1452 if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
1453 begin
1454 r0 := GetRemoteStatus(TRemoteSite(Items[i]).RemoteHandle);
1455 aSite := TRemoteSite(Items[i]).SiteName;
1456 TRemoteSite(Items[i]).QueryStatus := r0; //r0='1^Done' if no errors
1457 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2));
1458 if piece(r0,'^',1) = '1' then
1459 begin
1460 aHDR := piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 13);
1461 aID := piece(piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 2),':',1);
1462 if aHDR = '1' then
1463 begin
1464 ModifyHDRData(aRet, TRemoteSite(Items[i]).RemoteHandle ,aID);
1465 end;
1466 GetRemoteData(TRemoteSite(Items[i]).Data, TRemoteSite(Items[i]).RemoteHandle,Items[i]);
1467 RemoteReports.Add(TRemoteSite(Items[i]).CurrentReportQuery,
1468 TRemoteSite(Items[i]).RemoteHandle);
1469 TRemoteSite(Items[i]).RemoteHandle := '';
1470 TabControl1.OnChange(nil);
1471 if (length(piece(uHState,';',2)) > 0) then
1472 begin
1473 uRemoteReportData.Clear;
1474 QuickCopy(TRemoteSite(Items[i]).Data,uRemoteReportData);
1475 fail := 0;
1476 if uRemoteReportData.Count > 0 then
1477 begin
1478 if uRemoteReportData[0] = 'Report not available at this time.' then
1479 begin
1480 fail := 1;
1481 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available');
1482 end;
1483 if piece(uRemoteReportData[0],'^',1) = '-1' then
1484 begin
1485 fail := 1;
1486 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure');
1487 end;
1488 if fail = 0 then
1489 LoadListView(uRemoteReportData);
1490 end;
1491 end;
1492 end
1493 else
1494 begin
1495 uRemoteCount := uRemoteCount + 1;
1496 if uRemoteCount > 90 then
1497 begin
1498 TRemoteSite(Items[i]).RemoteHandle := '';
1499 TRemoteSite(Items[i]).QueryStatus := '-1^Timed out';
1500 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Timed out');
1501 StatusText('');
1502 TabControl1.OnChange(nil);
1503 end
1504 else
1505 StatusText('Retrieving reports from '
1506 + TRemoteSite(Items[i]).SiteName + '...');
1507 end;
1508 Timer1.Interval := 10000;
1509 end;
1510 end;
1511 if Timer1.Enabled = True then
1512 begin
1513 j := 0;
1514 for i := 0 to Count -1 do
1515 begin
1516 if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
1517 begin
1518 j := 1;
1519 break;
1520 end;
1521 end;
1522 if j = 0 then //Shutdown timer if all sites have been processed
1523 begin
1524 Timer1.Enabled := False;
1525 StatusText('');
1526 end;
1527 j := 0;
1528 for i := 0 to Count -1 do
1529 if TRemoteSite(Items[i]).Selected = true then
1530 begin
1531 j := 1;
1532 break;
1533 end;
1534 if j = 0 then //Shutdown timer if user has de-selected all sites
1535 begin
1536 Timer1.Enabled := False;
1537 StatusText('');
1538 TabControl1.OnChange(nil);
1539 end;
1540 end;
1541 end;
1542end;
1543
1544procedure TfrmReports.TabControl1Change(Sender: TObject);
1545var
1546 aStatus,aSite: string;
1547 hook: Boolean;
1548 i: integer;
1549begin
1550 inherited;
1551 if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then
1552 memText.Lines.Clear;
1553 lstHeaders.Items.Clear;
1554 uHTMLDoc := '';
1555 if WebBrowser1.visible = true then WebBrowser1.Navigate('about:blank');
1556 if (length(piece(uHState,';',2)) = 0) then with TabControl1 do
1557 begin
1558 memText.Lines.BeginUpdate;
1559 if TabIndex > 0 then
1560 begin
1561 aStatus := TRemoteSite(Tabs.Objects[TabIndex]).QueryStatus;
1562 aSite := TRemoteSite(Tabs.Objects[TabIndex]).SiteName;
1563 if aStatus = '1^Done' then
1564 begin
1565 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[0],'^',1) = '[HIDDEN TEXT]' then
1566 begin
1567 lstHeaders.Clear;
1568 hook := false;
1569 for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).Data.Count - 1 do
1570 if hook = true then
1571 memText.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).Data[i])
1572 else
1573 begin
1574 lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).Data[i]));
1575 if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[i],'^',1) = '[REPORT TEXT]' then
1576 hook := true;
1577 end;
1578 end
1579 else
1580 QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).Data,memText);
1581 memText.Lines.Insert(0,' ');
1582 memText.Lines.Delete(0);
1583 end;
1584 if Piece(aStatus,'^',1) = '-1' then
1585 begin
1586 memText.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
1587 end;
1588 if Piece(aStatus,'^',1) = '0' then
1589 memText.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2));
1590 if Piece(aStatus,'^',1) = '' then
1591 memText.Lines.Add(uReportInstruction);
1592 end
1593 else
1594 if uLocalReportData.Count > 0 then
1595 begin
1596 if Piece(uLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
1597 begin
1598 lstHeaders.Clear;
1599 hook := false;
1600 for i := 1 to uLocalReportData.Count - 1 do
1601 if hook = true then
1602 memText.Lines.Add(uLocalReportData[i])
1603 else
1604 begin
1605 lstHeaders.Items.Add(MixedCase(uLocalReportData[i]));
1606 if Piece(uLocalReportData[i],'^',1) = '[REPORT TEXT]' then
1607 hook := true;
1608 end;
1609 end
1610 else
1611 if tvReports.Selected.Text = 'Imaging (local only)' then
1612 memText.Lines.clear
1613 else
1614 QuickCopy(uLocalReportData,memText);
1615 memText.Lines.Insert(0,' ');
1616 memText.Lines.Delete(0);
1617 end
1618 else
1619 memText.Lines.Add(uReportInstruction);
1620 if WebBrowser1.Visible = true then
1621 begin
1622 if uReportType = 'R' then
1623 uHTMLDoc := HTML_PRE + memText.Lines.Text + HTML_POST
1624 else
1625 uHTMLDoc := uHTMLPatient + memText.Lines.Text;
1626 WebBrowser1.Navigate('about:blank');
1627 end;
1628 memText.Lines.EndUpdate;
1629 end;
1630end;
1631
1632procedure TfrmReports.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
1633var
1634 i, j: integer;
1635 LocalHandle, Query, Report, Seq: string;
1636 HSType, DaysBack, ExamID, MaxOcc: string;
1637 Alpha, Omega, Trans: double;
1638begin
1639 HSType := '';
1640 DaysBack := '';
1641 ExamID := '';
1642 Alpha := 0;
1643 Omega := 0;
1644 Seq := '';
1645 if AHDR = '1' then
1646 begin
1647 if HDRActive = '0' then
1648 begin
1649 InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK);
1650 Exit;
1651 end;
1652 InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
1653 if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
1654 AQualifier := 'T-50000;T+50000;99999';
1655 if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
1656 AQualifier := 'T-50000;T+50000;99999';
1657 end;
1658 if CharAt(AQualifier, 1) = 'd' then
1659 begin
1660 DaysBack := Copy(AQualifier, 2, Length(AQualifier));
1661 AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3));
1662 DaysBack := '';
1663 end;
1664 if CharAt(AQualifier, 1) = 'T' then
1665 begin
1666 if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T');
1667 if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T')
1668 then SetPiece(AQualifier,';',2,'T+1');
1669 Alpha := StrToFMDateTime(Piece(AQualifier,';',1));
1670 Omega := StrToFMDateTime(Piece(AQualifier,';',2));
1671 if Alpha > Omega then
1672 begin
1673 Trans := Omega;
1674 Omega := Alpha;
1675 Alpha := Trans;
1676 end;
1677 MaxOcc := Piece(AQualifier,';',3);
1678 SetPiece(AHSTag,';',4,MaxOcc);
1679 end;
1680 if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier));
1681 if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier));
1682 with RemoteSites.SiteList do for i := 0 to Count - 1 do
1683 begin
1684 if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
1685 begin
1686 TRemoteSite(Items[i]).Selected := true;
1687 frmFrame.lstCIRNLocations.Checked[i+2] := true;
1688 end;
1689 if TRemoteSite(Items[i]).Selected then
1690 begin
1691 TRemoteSite(Items[i]).ReportClear;
1692 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then
1693 begin
1694 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1695 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1696 TRemoteSite(Items[i]).RemoteHandle := '';
1697 TRemoteSite(Items[i]).QueryStatus := '1^Done';
1698 if uQualifierType = 6 then seq := '1^';
1699 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1700 if uQualifierType = 6 then seq := '2^';
1701 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data Included> - Use "HDR Reports" menu for HDR Data.');
1702 TabControl1.OnChange(nil);
1703 if (length(piece(uHState,';',2)) > 0) then
1704 LoadListView(TRemoteSite(Items[i]).Data);
1705 continue;
1706 end;
1707 if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
1708 begin
1709 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1710 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1711 TRemoteSite(Items[i]).RemoteHandle := '';
1712 TRemoteSite(Items[i]).QueryStatus := '1^Done';
1713 if uQualifierType = 6 then seq := '1^';
1714 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1715 if uQualifierType = 6 then seq := '2^';
1716 TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data> This site is not a source for HDR Data.');
1717 TabControl1.OnChange(nil);
1718 if (length(piece(uHState,';',2)) > 0) then
1719 LoadListView(TRemoteSite(Items[i]).Data);
1720 continue;
1721 end;
1722 if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then
1723 begin
1724 TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1725 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1726 TRemoteSite(Items[i]).RemoteHandle := '';
1727 TRemoteSite(Items[i]).QueryStatus := '1^Done';
1728 if uQualifierType = 6 then seq := '1^';
1729 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1730 if uQualifierType = 6 then seq := '2^';
1731 TRemoteSite(Items[i]).Data.Add(seq + '<No DOD Data> - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.');
1732 TabControl1.OnChange(nil);
1733 if (length(piece(uHState,';',2)) > 0) then
1734 LoadListView(TRemoteSite(Items[i]).Data);
1735 continue;
1736 end;
1737 TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';'
1738 + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType +
1739 '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' +
1740 FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR;
1741 LocalHandle := '';
1742 Query := TRemoteSite(Items[i]).CurrentReportQuery;
1743 for j := 0 to RemoteReports.Count - 1 do
1744 begin
1745 Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
1746 if Report = Query then
1747 begin
1748 LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
1749 break;
1750 end;
1751 end;
1752 if Length(LocalHandle) > 1 then
1753 with RemoteSites.SiteList do
1754 begin
1755 GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]);
1756 TRemoteSite(Items[i]).RemoteHandle := '';
1757 TRemoteSite(Items[i]).QueryStatus := '1^Done';
1758 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
1759 TabControl1.OnChange(nil);
1760 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
1761 LoadListView(TRemoteSite(Items[i]).Data);
1762 end
1763 else
1764 begin
1765 if uDirect = '1' then
1766 begin
1767 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
1768 TRemoteSite(Items[i]).QueryStatus := '1^Direct Call';
1769 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call');
1770 DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
1771 if Copy(Dest[0],1,2) = '-1' then
1772 begin
1773 TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
1774 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
1775 if uQualifierType = 6 then seq := '1^';
1776 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1777 if uQualifierType = 6 then seq := '2^';
1778 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
1779 TabControl1.OnChange(nil);
1780 if (length(piece(uHState,';',2)) > 0) then
1781 LoadListView(TRemoteSite(Items[i]).Data);
1782 end
1783 else
1784 begin
1785 QuickCopy(Dest,TRemoteSite(Items[i]).Data);
1786 TRemoteSite(Items[i]).RemoteHandle := '';
1787 TRemoteSite(Items[i]).QueryStatus := '1^Done';
1788 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
1789 TabControl1.OnChange(nil);
1790 if (length(piece(uHState,';',2)) > 0) then
1791 LoadListView(TRemoteSite(Items[i]).Data);
1792 end;
1793 StatusText('');
1794 end
1795 else
1796 begin
1797 RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
1798 if Dest[0] = '' then
1799 begin
1800 TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
1801 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
1802 if uQualifierType = 6 then seq := '1^';
1803 TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1804 if uQualifierType = 6 then seq := '2^';
1805 TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
1806 TabControl1.OnChange(nil);
1807 if (length(piece(uHState,';',2)) > 0) then
1808 LoadListView(TRemoteSite(Items[i]).Data);
1809 end
1810 else
1811 begin
1812 TRemoteSite(Items[i]).RemoteHandle := Dest[0];
1813 TRemoteSite(Items[i]).QueryStatus := '0^initialization...';
1814 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization');
1815 Timer1.Enabled := True;
1816 StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
1817 end;
1818 end;
1819 end;
1820 end;
1821 end;
1822end;
1823
1824procedure TfrmReports.FormDestroy(Sender: TObject);
1825var
1826 i: integer;
1827 aColChange: string;
1828begin
1829 inherited;
1830 if length(uColChange) > 0 then
1831 begin
1832 aColChange := '';
1833 for i := 0 to lvReports.Columns.Count - 1 do
1834 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
1835 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
1836 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
1837 uColChange := '';
1838 end;
1839 RemoteQueryAbortAll;
1840 RowObjects.Free;
1841 uHSComponents.Free;
1842 uHSAll.Free;
1843 uLocalReportData.Free;
1844 uRemoteReportData.Free;
1845 uColumns.Free;
1846 uTreeStrings.Free;
1847 uEmptyImageList.Free;
1848 uECSReport.Free;
1849 if GraphForm <> nil then GraphForm.Release;
1850end;
1851
1852procedure TfrmReports.lstHeadersClick(Sender: TObject);
1853var
1854 Current, Desired: integer;
1855begin
1856 inherited;
1857 if uFrozen = True then
1858 begin
1859 memo1.visible := False;
1860 memo1.TabStop := False;
1861 end;
1862 Current := SendMessage(memText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1863 Desired := lstHeaders.ItemIEN;
1864 SendMessage(memText.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
1865end;
1866
1867procedure TfrmReports.Splitter1CanResize(Sender: TObject;
1868 var NewSize: Integer; var Accept: Boolean);
1869begin
1870 inherited;
1871 if NewSize < 50 then
1872 Newsize := 50;
1873end;
1874
1875procedure TfrmReports.WebBrowser1DocumentComplete(Sender: TObject;
1876 const pDisp: IDispatch; var URL: OleVariant);
1877var
1878 WebDoc: IHtmlDocument2;
1879 v: variant;
1880begin
1881 inherited;
1882 if uHTMLDoc = '' then Exit;
1883 if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control
1884 if not Assigned(WebBrowser1.Document) then Exit;
1885 WebDoc := WebBrowser1.Document as IHtmlDocument2;
1886 v := VarArrayCreate([0, 0], varVariant);
1887 v[0] := uHTMLDoc;
1888 WebDoc.write(PSafeArray(TVarData(v).VArray));
1889 WebDoc.close;
1890 //uHTMLDoc := '';
1891end;
1892
1893procedure TfrmReports.sptHorzRightCanResize(Sender: TObject;
1894 var NewSize: Integer; var Accept: Boolean);
1895begin
1896 inherited;
1897 if NewSize < 50 then
1898 Newsize := 50;
1899end;
1900
1901procedure TfrmReports.lstQualifierDrawItem(Control: TWinControl;
1902 Index: Integer; Rect: TRect; State: TOwnerDrawState);
1903var
1904 x: string;
1905 AnImage: TBitMap;
1906const
1907 STD_DATE = 'MMM DD,YY@HH:NN';
1908begin
1909 inherited;
1910 AnImage := TBitMap.Create;
1911 try
1912 with (Control as TORListBox).Canvas do { draw on control canvas, not on the form }
1913 begin
1914 x := (Control as TORListBox).Items[Index];
1915 FillRect(Rect); { clear the rectangle }
1916 if uQualifierType = QT_IMAGING then // moved position of assignment in all case branches
1917 begin
1918 AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
1919 if Piece(x, U, 4) = 'Y' then
1920 begin
1921 BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height),
1922 AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag}
1923 end;
1924 TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2));
1925 TextOut(Rect.Left + AnImage.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
1926 end
1927 else
1928 begin
1929 TextOut(Rect.Left, Rect.Top, Piece(x, U, 2));
1930 TextOut(Rect.Left + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
1931 end;
1932 end;
1933 finally
1934 AnImage.Free;
1935 end;
1936end;
1937
1938procedure TfrmReports.tvReportsClick(Sender: TObject);
1939var
1940 i,j: integer;
1941 ListItem: TListItem;
1942 aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x: string;
1943 aIFN: integer;
1944 aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
1945 CurrentParentNode, CurrentNode: TTreeNode;
1946begin
1947 inherited;
1948 lvReports.Hint := 'To sort, click on column headers|';
1949 tvReports.TopItem := tvReports.Selected;
1950 uRemoteCount := 0;
1951 uReportInstruction := '';
1952 aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading;
1953 aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote;
1954 aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType;
1955 aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
1956 aID := PReportTreeObject(tvReports.Selected.Data)^.ID;
1957 aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName;
1958 aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag;
1959 aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category;
1960 aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder;
1961 aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack;
1962 aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0);
1963 aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct;
1964 aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR;
1965 aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE;
1966 aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
1967 aStartTime := Piece(aQualifier,';',1);
1968 aStopTime := Piece(aQualifier,';',2);
1969 aMax := Piece(aQualifier,';',3);
1970 aRptCode := Piece(aQualifier,';',4);
1971 aQualifierID:= '';
1972 if length(uColChange) > 0 then
1973 begin
1974 aColChange := '';
1975 for i := 0 to lvReports.Columns.Count - 1 do
1976 aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
1977 if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
1978 SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
1979 uColChange := '';
1980 end;
1981 if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then
1982 begin
1983 aReportType := 'R';
1984 aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID));
1985 aID := '1';
1986 aRPC := 'ORWRP REPORT TEXT';
1987 aHSTag := '';
1988 end;
1989 if aReportType = '' then aReportType := 'R';
1990 uReportRPC := aRPC;
1991 uRptID := aID;
1992 uDirect := aDirect;
1993 uReportType := aReportType;
1994 uQualifier := aQualifier;
1995 uSortOrder := aSortOrder;
1996 uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
1997 pnlRightTop.Height := lblTitle.Height; // see below
1998 RedrawSuspend(tvReports.Handle);
1999 RedrawSuspend(memText.Handle);
2000 uHState := aHSTag;
2001 Timer1.Enabled := False;
2002 TabControl1.Visible := false;
2003 TabControl1.TabStop := false;
2004 sptHorzRight.Visible := false;
2005 lblProcTypeMsg.Visible := FALSE;
2006 pnlRightMiddle.Visible := false;
2007 pnlProcedures.Visible := FALSE;
2008 if (aRemote = '1') or (aRemote = '2') then
2009 if not(uReportType = 'V') then
2010 if TabControl1.Tabs.Count > 1 then
2011 begin
2012 TabControl1.Visible := true;
2013 TabControl1.TabStop := true;
2014 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
2015 end;
2016 StatusText('');
2017 uHTMLDoc := '';
2018 WebBrowser1.Navigate('about:blank');
2019 memText.Lines.Clear;
2020 memText.Parent := pnlRightBottom;
2021 memText.Align := alClient;
2022 UpdatingLvReports := TRUE; {lw added}
2023 tvProcedures.Items.Clear;
2024 UpdatingLvReports := FALSE; {lw added}
2025 lblProcTypeMsg.Visible := FALSE;
2026 lvReports.SmallImages := uEmptyImageList;
2027 imgLblImages.ComponentImageListChanged;
2028 lvReports.Items.Clear;
2029 lvReports.Columns.Clear;
2030 uHSComponents.Clear;
2031 DisplayHeading('');
2032 if uReportType = 'H' then
2033 begin
2034 pnlRightMiddle.Visible := false;
2035 pnlRightBottom.Visible := true;
2036 WebBrowser1.Visible := true;
2037 WebBrowser1.TabStop := true;
2038 WebBrowser1.Navigate('about:blank');
2039 WebBrowser1.BringToFront;
2040 memText.Visible := false;
2041 memText.TabStop := false;
2042 end
2043 else
2044 if uReportType = 'V' then
2045 begin
2046 with lvReports do
2047 begin
2048 Columns.BeginUpdate;
2049 ViewStyle := vsReport;
2050 ColumnHeaders(uColumns, IntToStr(aIFN));
2051 for i := 0 to uColumns.Count -1 do
2052 begin
2053 uNewColumn := Columns.Add;
2054 uNewColumn.Caption := piece(uColumns.Strings[i],'^',1);
2055 if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^';
2056 if piece(uColumns.Strings[i],'^',2) = '1' then
2057 begin
2058 uNewColumn.Width := 0;
2059 uColChange := uColChange + '0,';
2060 end
2061 else
2062 if length(piece(uColumns.Strings[i],'^',10)) > 0 then
2063 begin
2064 uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ',';
2065 uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10))
2066 end
2067 else
2068 uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text
2069 if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then
2070 uNewColumn.Width := 0;
2071 end;
2072 Columns.EndUpdate;
2073 end;
2074 pnlRightMiddle.Visible := true;
2075 sptHorzRight.Visible := true;
2076 WebBrowser1.Visible := false;
2077 WebBrowser1.TabStop := false;
2078 pnlRightBottom.Visible := true;
2079 memText.Visible := true;
2080 memText.TabStop := true;
2081 memText.BringToFront;
2082 end
2083 else
2084 begin
2085 pnlRightMiddle.Visible := false;
2086 sptHorzRight.Visible := false;
2087 WebBrowser1.Visible := false;
2088 WebBrowser1.TabStop := false;
2089 pnlRightBottom.Visible := True;
2090 memText.Visible := true;
2091 memText.TabStop := true;
2092 memText.BringToFront;
2093 end;
2094 uLocalReportData.Clear;
2095 RowObjects.Clear;
2096 uRemoteReportData.Clear;
2097 lstHeaders.Visible := false;
2098 lstHeaders.TabStop := false;
2099 lblHeaders.Visible := false;
2100 lstHeaders.Clear;
2101 for i := 0 to RemoteSites.SiteList.Count - 1 do
2102 TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
2103 if uFrozen = True then
2104 begin
2105 memo1.visible := False;
2106 memo1.TabStop := False;
2107 end;
2108 Screen.Cursor := crHourGlass;
2109 if (GraphForm <> nil) and (aReportType <> 'G') then
2110 begin
2111 GraphForm.SendToBack;
2112 GraphPanel(false);
2113 GraphFormActive := false;
2114 end;
2115 if aReportType = 'G' then
2116 Graph(aIFN)
2117 else
2118 if aReportType = 'M' then
2119 begin
2120 pnlLeftBottom.Visible := false;
2121 splitter1.Visible := false;
2122 end
2123 else
2124 begin
2125 uQualifierType := StrToIntDef(aRptCode,0);
2126 case uQualifierType of
2127 QT_OTHER:
2128 begin // = 0
2129 memText.Lines.Clear;
2130 If copy(aRptCode,1,2) = 'h0' then //HS Adhoc
2131 begin
2132 if TabControl1.TabIndex > 0 then
2133 begin
2134 InfoBox('Adhoc report is not available for remote sites',
2135 'Information', MB_OK);
2136 TabControl1.TabIndex := 0;
2137 end;
2138 with RemoteSites.SiteList do
2139 for j := 0 to Count - 1 do
2140 begin
2141 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2142 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2143 end;
2144 uHTMLDoc := '';
2145 if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
2146 ExecuteAdhoc1; //Calls Adhoc form
2147 if uLocalReportData.Count < 1 then
2148 uReportInstruction := '<No Report Available>'
2149 else
2150 begin
2151 if TabControl1.TabIndex < 1 then
2152 QuickCopy(uLocalReportData,memText);
2153 if WebBrowser1.Visible = true then
2154 begin
2155 if uReportType = 'R' then
2156 uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
2157 else
2158 uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
2159 WebBrowser1.Navigate('about:blank');
2160 end;
2161 end;
2162 TabControl1.OnChange(nil);
2163 end
2164 else
2165 begin
2166 pnlLeftBottom.Visible := false;
2167 splitter1.Visible := false;
2168 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2169 GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2170 uReportInstruction := #13#10 + 'Retrieving data...';
2171 TabControl1.OnChange(nil);
2172 if not(piece(uRemoteType, '^', 9) = '1') then
2173 begin
2174 LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2175 QuickCopy(uLocalReportData, memText);
2176 end;
2177 if uLocalReportData.Count > 0 then
2178 TabControl1.OnChange(nil);
2179 StatusText('');
2180 end;
2181 end;
2182 QT_HSTYPE:
2183 begin // = 1
2184 pnlLeftBottom.Visible := false;
2185 splitter1.Visible := false;
2186 end;
2187 QT_DATERANGE:
2188 begin // = 2
2189
2190 ListReportDateRanges(lstQualifier.Items);
2191 if lstQualifier.ItemID = '' then
2192 begin
2193 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2194 lvReports.SmallImages := uEmptyImageList;
2195 imgLblImages.ComponentImageListChanged;
2196 lvReports.Items.Clear;
2197 lstQualifierClick(self);
2198 end
2199 else
2200 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2201
2202 lblQualifier.Caption := 'Date Range';
2203 pnlLeftBottom.Visible := true;
2204 splitter1.Visible := true;
2205 end;
2206 QT_IMAGING:
2207 begin // = 3
2208 pnlLeftBottom.Visible := false;
2209 splitter1.Visible := false;
2210 ListImagingExams(uLocalReportData);
2211 aRadParam := ImagingParams;
2212 uQualifier := StringReplace(aRadParam, '^', ';', [rfReplaceAll]);
2213 with lvReports do
2214 begin
2215 Items.BeginUpdate;
2216 ViewStyle := vsReport;
2217 SmallImages := dmodShared.imgImages;
2218 imgLblImages.ComponentImageListChanged;
2219 CurrentParentNode := nil;
2220 CurrentNode := nil;
2221 for i := 0 to uLocalReportData.Count - 1 do
2222 begin
2223 ListItem := Items.Add;
2224 ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2225 if uColumns.Count > 1 then
2226 begin
2227 for j := 2 to uColumns.Count do
2228 ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2229 // if pieces are (added to/removed from) return string, PLEASE UPDATE THIS!! (RV)
2230 if Piece(uLocalReportData[i], U, 9) = 'Y' then
2231 ListItem.SubItemImages[1] := IMG_1_IMAGE
2232 else
2233 ListItem.SubItemImages[1] := IMG_NO_IMAGES;
2234 end;
2235 LoadProceduresTreeView(uLocalReportData[i], CurrentParentNode, CurrentNode);
2236 if CurrentNode <> nil then
2237 PProcTreeObj(CurrentNode.Data)^.Associate := lvReports.Items.IndexOf(ListItem);
2238 end;
2239 if tvProcedures.Items.Count > 0 then
2240 tvProcedures.Selected := tvProcedures.Items.GetFirstNode;
2241 lblProcTypeMsg.Visible := TRUE;
2242 pnlRightTop.Height := lblTitle.Height + lblProcTypeMsg.Height;
2243 pnlLeftBottom.Visible := FALSE;
2244 pnlProcedures.Visible := TRUE;
2245 Splitter1.Visible := True;
2246 if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2247 Items.EndUpdate;
2248 tvProcedures.TopItem := tvProcedures.Selected;
2249 end;
2250 if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
2251 if uLocalReportData.Count > 0
2252 then x := #13#10 + 'Select an imaging exam...'
2253 else x := #13#10 + 'No imaging reports found...';
2254 uReportInstruction := PChar(x);
2255 memText.Lines.Add(uReportInstruction);
2256 if WebBrowser1.Visible = true then
2257 begin
2258 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2259 WebBrowser1.Navigate('about:blank');
2260 end;
2261 end;
2262 QT_NUTR:
2263 begin // = 4
2264 lblQualifier.Caption := 'Nutritional Assessments';
2265 pnlLeftBottom.Visible := false;
2266 splitter1.Visible := false;
2267 ListNutrAssessments(uLocalReportData);
2268 with lvReports do
2269 begin
2270 Items.BeginUpdate;
2271 ViewStyle := vsReport;
2272 for i := 0 to uLocalReportData.Count - 1 do
2273 begin
2274 ListItem := Items.Add;
2275 ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2276 if uColumns.Count > 1 then
2277 for j := 2 to uColumns.Count do
2278 ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2279 end;
2280 if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2281 Items.EndUpdate;
2282 end;
2283 if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
2284 if uLocalReportData.Count > 0
2285 then x := #13#10 + 'Select an assessment date...'
2286 else x := #13#10 + 'No nutritional assessments found...';
2287 uReportInstruction := PChar(x);
2288 memText.Lines.Add(uReportInstruction);
2289 if WebBrowser1.Visible = true then
2290 begin
2291 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2292 WebBrowser1.Navigate('about:blank');
2293 end;
2294 end;
2295 QT_HSCOMPONENT:
2296 begin // = 5
2297 if Notifications.AlertData <> '' then
2298 pnlRightMiddle.Height := 75
2299 else
2300 pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
2301 pnlLeftBottom.Visible := false;
2302 splitter1.Visible := false;
2303 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2304 uReportInstruction := #13#10 + 'Retrieving data...';
2305 lvReports.SmallImages := uEmptyImageList;
2306 imgLblImages.ComponentImageListChanged;
2307 lvReports.Items.Clear;
2308 RowObjects.Clear;
2309 memText.Lines.Clear;
2310 if (length(piece(aHSTag,';',2)) > 0) then
2311 begin
2312 if aCategory <> '0' then
2313 begin
2314 ListReportDateRanges(lstQualifier.Items);
2315 aQualifierID := lstQualifier.ItemID;
2316 if aQualifierID = '' then
2317 begin
2318 if aHDR = '1' then
2319 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2320 else
2321 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2322 lstQualifierClick(self);
2323 end
2324 else
2325 begin
2326 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2327 if aHDR = '1' then
2328 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2329 else
2330 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2331 lstQualifierClick(self);
2332 end;
2333 lblQualifier.Caption := 'Date Range';
2334 pnlLeftBottom.Visible := true;
2335 splitter1.Visible := true;
2336 end
2337 else
2338 begin
2339 if not (aRemote = '2' ) then
2340 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2341 if not(piece(uRemoteType, '^', 9) = '1') then
2342 begin
2343 LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2344 LoadListView(uLocalReportData);
2345 end;
2346 end;
2347 end
2348 else
2349 begin
2350 if (aRemote = '1') or (aRemote = '2') then
2351 if TabControl1.Tabs.Count > 1 then
2352 ShowTabControl;
2353 sptHorzRight.Visible := false;
2354 pnlRightMiddle.Visible := false;
2355 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2356 if not(piece(uRemoteType, '^', 9) = '1') then
2357 LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2358 if uLocalReportData.Count < 1 then
2359 uReportInstruction := '<No Report Available>'
2360 else
2361 begin
2362 if TabControl1.TabIndex < 1 then
2363 QuickCopy(uLocalReportData,memText);
2364 end;
2365 TabControl1.OnChange(nil);
2366 if aCategory <> '0' then
2367 begin
2368 ListReportDateRanges(lstQualifier.Items);
2369 if lstQualifier.ItemID = '' then
2370 begin
2371 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2372 lstQualifierClick(self);
2373 end
2374 else
2375 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2376
2377 lblQualifier.Caption := 'Date Range';
2378 pnlLeftBottom.Visible := true;
2379 splitter1.Visible := true;
2380 end
2381 else
2382 begin
2383 if uLocalReportData.Count < 1 then
2384 begin
2385 uReportInstruction := '<No Report Available>';
2386 memText.Lines.Add(uReportInstruction);
2387 end
2388 else
2389 begin
2390 QuickCopy(uLocalReportData,memText);
2391 TabControl1.OnChange(nil);
2392 end;
2393 end;
2394 end;
2395 StatusText('');
2396 end;
2397 QT_HSWPCOMPONENT:
2398 begin // = 6
2399 if Notifications.AlertData <> '' then
2400 pnlRightMiddle.Height := 75
2401 else
2402 pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
2403 pnlLeftBottom.Visible := false;
2404 splitter1.Visible := false;
2405 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2406 uReportInstruction := #13#10 + 'Retrieving data...';
2407 TabControl1.OnChange(nil);
2408 RowObjects.Clear;
2409 memText.Lines.Clear;
2410 lvReports.SmallImages := uEmptyImageList;
2411 imgLblImages.ComponentImageListChanged;
2412 lvReports.Items.Clear;
2413 if (length(piece(aHSTag,';',2)) > 0) then
2414 begin
2415 if aCategory <> '0' then
2416 begin
2417 ListReportDateRanges(lstQualifier.Items);
2418 aQualifierID := lstQualifier.ItemID;
2419 if aQualifierID = '' then
2420 begin
2421 if aHDR = '1' then
2422 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2423 else
2424 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2425 lstQualifierClick(self);
2426 end
2427 else
2428 begin
2429 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2430 if aHDR = '1' then
2431 lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2432 else
2433 if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2434 lstQualifierClick(self);
2435 end;
2436 lblQualifier.Caption := 'Date Range';
2437 pnlLeftBottom.Visible := true;
2438 splitter1.Visible := true;
2439 end
2440 else
2441 begin
2442 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2443 if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
2444 begin
2445 LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2446 LoadListView(uLocalReportData);
2447 end;
2448 end;
2449 end
2450 else
2451 begin
2452 if (aRemote = '1') or (aRemote = '2') then
2453 ShowTabControl;
2454 sptHorzRight.Visible := false;
2455 pnlRightMiddle.Visible := false;
2456 GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2457 if not(piece(uRemoteType, '^', 9) = '1') then
2458 LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2459 if uLocalReportData.Count < 1 then
2460 uReportInstruction := '<No Report Available>'
2461 else
2462 begin
2463 if TabControl1.TabIndex < 1 then
2464 QuickCopy(uLocalReportData,memText);
2465 end;
2466 TabControl1.OnChange(nil);
2467 if aCategory <> '0' then
2468 begin
2469
2470 ListReportDateRanges(lstQualifier.Items);
2471 if lstQualifier.ItemID = '' then
2472 begin
2473 lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2474 lstQualifierClick(self);
2475 end
2476 else
2477 lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2478
2479 lblQualifier.Caption := 'Date Range';
2480 pnlLeftBottom.Visible := true;
2481 splitter1.Visible := true;
2482 end
2483 else
2484 begin
2485 LoadListView(uLocalReportData);
2486 end;
2487 end;
2488 StatusText('');
2489 end;
2490 QT_PROCEDURES:
2491 begin // = 19
2492 pnlLeftBottom.Visible := false;
2493 splitter1.Visible := false;
2494 ListProcedures(uLocalReportData);
2495 with lvReports do
2496 begin
2497 Items.BeginUpdate;
2498 ViewStyle := vsReport;
2499 for i := 0 to uLocalReportData.Count - 1 do
2500 begin
2501 ListItem := Items.Add;
2502 ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2503 if uColumns.Count > 1 then
2504 for j := 2 to uColumns.Count do
2505 ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2506 end;
2507 if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2508 Items.EndUpdate;
2509 end;
2510 if uLocalReportData.Count > 0
2511 then x := #13#10 + 'Select a procedure...'
2512 else x := #13#10 + 'No procedures found...';
2513 uReportInstruction := PChar(x);
2514 if WebBrowser1.Visible = true then
2515 begin
2516 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2517 WebBrowser1.Navigate('about:blank');
2518 end;
2519 if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
2520 end;
2521 QT_SURGERY:
2522 begin // = 28
2523 pnlLeftBottom.Visible := false;
2524 splitter1.Visible := false;
2525 ListSurgeryReports(uLocalReportData);
2526 with lvReports do
2527 begin
2528 Items.BeginUpdate;
2529 ViewStyle := vsReport;
2530 for i := 0 to uLocalReportData.Count - 1 do
2531 begin
2532 ListItem := Items.Add;
2533 ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2534 if uColumns.Count > 1 then
2535 for j := 2 to uColumns.Count do
2536 ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2537 end;
2538 if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2539 Items.EndUpdate;
2540 end;
2541 if uLocalReportData.Count > 0
2542 then x := #13#10 + 'Select a surgery case...'
2543 else x := #13#10 + 'No surgery cases found...';
2544 uReportInstruction := PChar(x);
2545 memText.Lines.Add(uReportInstruction);
2546 uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2547 if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
2548 end;
2549 else
2550 begin // = ?
2551 uQualifierType := QT_OTHER;
2552 pnlLeftBottom.Visible := false;
2553 splitter1.Visible := false;
2554 StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2555 GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2556 uReportInstruction := #13#10 + 'Retrieving data...';
2557 TabControl1.OnChange(nil);
2558 //LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2559 if not(piece(uRemoteType, '^', 9) = '1') then
2560 LoadReportText(uLocalReportData, aID, '', aRPC, uHState);
2561 if uLocalReportData.Count < 1 then
2562 uReportInstruction := '<No Report Available>'
2563 else
2564 begin
2565 if TabControl1.TabIndex < 1 then
2566 QuickCopy(uLocalReportData,memText);
2567 end;
2568 TabControl1.OnChange(nil);
2569 StatusText('');
2570 end;
2571 lstQualifier.Caption := lblQualifier.Caption;
2572 end;
2573 end;
2574 if not (aHDR = '1') then
2575 if aCategory <> '0' then
2576 DisplayHeading(uQualifier)
2577 else
2578 DisplayHeading('');
2579
2580 SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
2581 RedrawActivate(tvReports.Handle);
2582 RedrawActivate(memText.Handle);
2583 if WebBrowser1.Visible = true then
2584 begin
2585 WebBrowser1.Navigate('about:blank');
2586 WebBrowser1.BringToFront;
2587 end
2588 else if not GraphFormActive then
2589 begin
2590 memText.Visible := true;
2591 memText.TabStop := true;
2592 memText.BringToFront;
2593 end
2594 else
2595 begin
2596 GraphPanel(true);
2597 with GraphForm do
2598 begin
2599 lstDateRange.Items := cboDateRange.Items;
2600 lstDateRange.ItemIndex := cboDateRange.ItemIndex;
2601 ViewSelections;
2602 BringToFront;
2603 end;
2604 end;
2605 lvReports.Columns.BeginUpdate;
2606 lvReports.Columns.EndUpdate;
2607 Screen.Cursor := crDefault;
2608end;
2609
2610procedure TfrmReports.lvReportsColumnClick(Sender: TObject;
2611 Column: TListColumn);
2612var
2613 ClickedColumn: Integer;
2614 a1, a2: integer;
2615 s,s1,s2: string;
2616begin
2617 inherited;
2618 a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1;
2619 a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1;
2620 ClickedColumn := Column.Index;
2621 ColumnToSort := Column.Index;
2622 SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0);
2623 SortIdx2 := 0;
2624 SortIdx3 := 0;
2625 if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0);
2626 if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0);
2627 if a1 = ColumnToSort then
2628 begin
2629 SortIdx2 := SortIdx3;
2630 SortIdx3 := 0;
2631 end;
2632 if a2 = ColumnToSort then
2633 SortIdx3 := 0;
2634 if ClickedColumn = ColumnToSort then
2635 ColumnSortForward := not ColumnSortForward
2636 else
2637 ColumnSortForward := true;
2638 ColumnToSort := ClickedColumn;
2639 uFirstSort := ColumnToSort;
2640 uSecondSort := a1;
2641 uThirdSort := a2;
2642 lvReports.Hint := '';
2643 if ColumnSortForward = true then
2644 s := 'Sorted forward'
2645 else
2646 s := 'Sorted reverse';
2647 s1 := piece(uColumns[uFirstSort],'^',1);
2648 s2 := '';
2649 if length(piece(s1,' ',2)) > 0 then
2650 s2 := pieces(s1,' ',2,99);
2651 if length(s2) > 0 then s2 := StripSpace(s2);
2652 s := s + ' by ' + piece(s1,' ',1) + ' ' + s2;
2653 if (a1 <> uFirstSort) and (a1 > -1) then
2654 begin
2655 s1 := piece(uColumns[a1], '^', 1);
2656 s2 := '';
2657 if length(piece(s1,' ',2)) > 0 then
2658 s2 := pieces(s1,' ',2,99);
2659 if length(s2) > 0 then s2 := StripSpace(s2);
2660 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2661 end;
2662 if (a2 <> uFirstSort) and (a2 > -1) then
2663 begin
2664 s1 := piece(uColumns[a2], '^', 1);
2665 s2 := '';
2666 if length(piece(s1,' ',2)) > 0 then
2667 s2 := pieces(s1,' ',2,99);
2668 if length(s2) > 0 then s2 := StripSpace(s2);
2669 s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2;
2670 end;
2671 lvReports.Hint := s;
2672 lvReports.CustomSort(nil, 0);
2673end;
2674
2675procedure TfrmReports.lvReportsCompare(Sender: TObject; Item1,
2676 Item2: TListItem; Data: Integer; var Compare: Integer);
2677
2678 function CompareValues(Col: Integer): integer;
2679 var
2680 ix: Integer;
2681 s1, s2: string;
2682 v1, v2: extended;
2683 d1, d2: TFMDateTime;
2684 begin
2685 inherited;
2686 if ColumnToSort = 0 then
2687 Result := CompareText(Item1.Caption,Item2.Caption)
2688 else
2689 begin
2690 ix := ColumnToSort - 1;
2691 case Col of
2692 0: //strings
2693 begin
2694 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2695 s1 := Item1.SubItems[ix]
2696 else
2697 s1 := '0';
2698 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2699 s2 := Item2.SubItems[ix]
2700 else
2701 s2 := '0';
2702 Result := CompareText(s1,s2);
2703 end;
2704
2705 1: //integers
2706 begin
2707 if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2708 s1 := Item1.SubItems[ix]
2709 else
2710 s1 := '0';
2711 if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2712 s2 := Item2.SubItems[ix]
2713 else
2714 s2 := '0';
2715 IsValidNumber(s1, v1);
2716 IsValidNumber(s2, v2);
2717 if v1 > v2 then
2718 Result := 1
2719 else
2720 if v1 < v2 then
2721 Result := -1
2722 else
2723 Result := 0;
2724 end;
2725
2726 2: //date/times
2727 begin
2728 if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then
2729 s1 := Item1.SubItems[ix]
2730 else
2731 s1 := '1/1/1700';
2732 if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then
2733 s2 := Item2.SubItems[ix]
2734 else
2735 s2 := '1/1/1700';
2736 d1 := StringToFMDateTime(s1);
2737 d2 := StringToFMDateTime(s2);
2738 if d1 > d2 then
2739 Result := 1
2740 else
2741 if d1 < d2 then
2742 Result := -1
2743 else
2744 Result := 0;
2745 end;
2746 else
2747 Result := 0; // to make the compiler happy
2748 end;
2749 end;
2750 end;
2751begin
2752 ColumnToSort := uFirstSort;
2753 Compare := CompareValues(SortIdx1);
2754 if Compare = 0 then
2755 begin
2756 if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then
2757 begin
2758 ColumnToSort := uSecondSort;
2759 Compare := CompareValues(SortIdx2);
2760 end;
2761 if Compare = 0 then
2762 if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then
2763 begin
2764 ColumnToSort := uThirdSort;
2765 Compare := CompareValues(SortIdx3);
2766 end;
2767 end;
2768 if not ColumnSortForward then Compare := -Compare;
2769end;
2770
2771procedure TfrmReports.lvReportsSelectItem(Sender: TObject; Item: TListItem;
2772 Selected: Boolean);
2773var
2774 aID, aMoreID, aSID: string;
2775 i,j,k: integer;
2776 aBasket: TStringList;
2777 aWPFlag: Boolean;
2778 x, HasImages: string;
2779
2780begin
2781 inherited;
2782 if not selected then Exit;
2783 aBasket := TStringList.Create;
2784 uLocalReportData.Clear;
2785 aWPFlag := false;
2786 with lvReports do
2787 begin
2788 aID := Item.SubItems[0];
2789 case uQualifierType of
2790 QT_OTHER:
2791 begin // = 0
2792
2793 end;
2794 QT_HSTYPE:
2795 begin // = 1
2796 aMoreID := ';' + Item.SubItems[2];
2797 end;
2798 QT_DATERANGE:
2799 begin // = 2
2800
2801 end;
2802 QT_IMAGING:
2803 begin // = 3
2804 if lvReports.SelCount = 1 then
2805 begin
2806 memText.Lines.Clear;
2807 if not UpdatingTvProcedures then
2808 begin
2809 UpdatingLvReports := TRUE;
2810 for i := 0 to (tvProcedures.Items.Count - 1) do
2811 if PProcTreeObj(tvProcedures.Items[i].Data)^.ExamDtTm = Item.SubItems[0] then
2812 if PProcTreeObj(tvProcedures.Items[i].Data)^.ProcedureName = Item.SubItems[2] then
2813 begin
2814 if tvProcedures.Items[i].Parent <> nil then
2815 begin
2816 tvProcedures.Items[i].Parent.Expanded := True;
2817 if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '1' then
2818 lblProcTypeMsg.Caption := 'Descendent Procedure'
2819 else if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '2' then
2820 lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
2821 end
2822 else
2823 lblProcTypeMsg.Caption := 'Standalone (single) procedure';
2824 tvProcedures.Items[i].Selected := TRUE;
2825 end;
2826 UpdatingLvReports := False;
2827 end;
2828 end
2829 else
2830 if not UpdatingTvProcedures then
2831 tvProcedures.Selected := nil;
2832
2833 if MemText.Lines.Count > 0 then
2834 memText.Lines.Add('===============================================================================');
2835 aMoreID := '#' + Item.SubItems[5];
2836 SetPiece(uRemoteType,'^',5,aID + aMoreID);
2837 if not(piece(uRemoteType, '^', 9) = '1') then
2838 begin
2839 LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
2840 for i := 0 to uLocalReportData.Count - 1 do
2841 MemText.Lines.Add(uLocalReportData[i]);
2842 if Item.SubItems.Count > 5 then
2843 x := 'RA^' + aID + U + Item.SubItems[5]
2844 else
2845 x := 'RA^' + aID;
2846 HasImages := BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE];
2847 SetPiece(x, U, 10, HasImages);
2848 NotifyOtherApps(NAE_REPORT, x);
2849 end;
2850 end;
2851 QT_NUTR:
2852 begin // = 4
2853 if lvReports.SelCount = 1 then
2854 memText.Lines.Clear;
2855 if MemText.Lines.Count > 0 then
2856 memText.Lines.Add('===============================================================================');
2857 SetPiece(uRemoteType,'^',5,aID);
2858 if not(piece(uRemoteType, '^', 9) = '1') then
2859 begin
2860 LoadReportText(uLocalReportData, uRptID, aID, uReportRPC, '');
2861 for i := 0 to uLocalReportData.Count - 1 do
2862 MemText.Lines.Add(uLocalReportData[i]);
2863 end;
2864 end;
2865 QT_HSWPCOMPONENT:
2866 begin // = 6
2867 if lvReports.SelCount < 3 then
2868 begin
2869 memText.Lines.Clear;
2870 ulvSelectOn := false;
2871 end;
2872 aBasket.Clear;
2873 if (SelCount = 2) and (ulvSelectOn = false) then
2874 begin
2875 ulvSelectOn := true;
2876 for i := 0 to Items.Count - 1 do
2877 if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then
2878 begin
2879 aSID := Items[i].SubItems[0];
2880 for j := 0 to RowObjects.ColumnList.Count - 1 do
2881 if piece(aSID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
2882 if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
2883 if (TCellObject(RowObjects.ColumnList[j]).Data.Count > 0) and
2884 (TCellObject(RowObjects.ColumnList[j]).Include = '1') then
2885 begin
2886 aWPFlag := true;
2887 MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
2888 FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket);
2889 for k := 0 to aBasket.Count - 1 do
2890 MemText.Lines.Add(' ' + aBasket[k]);
2891 end;
2892 if aWPFlag = true then
2893 begin
2894 memText.Lines.Add('Facility: ' + Item.Caption);
2895 memText.Lines.Add('===============================================================================');
2896 end;
2897 end;
2898 end;
2899 aBasket.Clear;
2900 aWPFlag := false;
2901 for i := 0 to RowObjects.ColumnList.Count - 1 do
2902 if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[i]).Handle,':',1) then
2903 if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[i]).Site,';',1)) then
2904 if (TCellObject(RowObjects.ColumnList[i]).Data.Count > 0) and
2905 (TCellObject(RowObjects.ColumnList[i]).Include = '1') then
2906 begin
2907 aWPFlag := true;
2908 MemText.Lines.Add(TCellObject(RowObjects.ColumnList[i]).Name);
2909 FastAssign(TCellObject(RowObjects.ColumnList[i]).Data, aBasket);
2910 for j := 0 to aBasket.Count - 1 do
2911 MemText.Lines.Add(' ' + aBasket[j]);
2912 end;
2913 if aWPFlag = true then
2914 begin
2915 memText.Lines.Add('Facility: ' + Item.Caption);
2916 memText.Lines.Add('===============================================================================');
2917 end;
2918 if uRptID = 'OR_R18:IMAGING' then
2919 begin
2920 if (Item.SubItems.Count > 8) then //has id, may have case (?)
2921 begin
2922 x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption;
2923 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
2924 NotifyOtherApps(NAE_REPORT, x);
2925 end
2926 else if (Item.SubItems.Count > 4) then
2927 begin
2928 x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption;
2929 SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
2930 NotifyOtherApps(NAE_REPORT, x);
2931 end
2932 else if Item.SubItemImages[1] = IMG_1_IMAGE then
2933 begin
2934 memText.Lines.Insert(0,'<Imaging links not active at this site>');
2935 memText.Lines.Insert(1,' ');
2936 end;
2937 end;
2938 if uRptID = 'OR_PN:PROGRESS NOTES' then
2939 if (Item.SubItems.Count > 7) then
2940 begin
2941 if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0';
2942 x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption;
2943 SetPiece(x, U, 10, HasImages);
2944 NotifyOtherApps(NAE_REPORT, x);
2945 end;
2946 end;
2947 QT_PROCEDURES:
2948 begin // = 19
2949 if lvReports.SelCount = 1 then
2950 memText.Lines.Clear;
2951 if MemText.Lines.Count > 0 then
2952 memText.Lines.Add('===============================================================================');
2953 SetPiece(uRemoteType,'^',5,aID);
2954 if not(piece(uRemoteType, '^', 9) = '1') then
2955 begin
2956 LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
2957 for i := 0 to uLocalReportData.Count - 1 do
2958 MemText.Lines.Add(uLocalReportData[i]);
2959 end;
2960 end;
2961 QT_SURGERY:
2962 begin // = 28
2963 if lvReports.SelCount = 1 then
2964 memText.Lines.Clear;
2965 if MemText.Lines.Count > 0 then
2966 memText.Lines.Add('===============================================================================');
2967 SetPiece(uRemoteType,'^',5,aID);
2968 if not(piece(uRemoteType, '^', 9) = '1') then
2969 begin
2970 LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
2971 for i := 0 to uLocalReportData.Count - 1 do
2972 MemText.Lines.Add(uLocalReportData[i]);
2973 NotifyOtherApps(NAE_REPORT, 'SUR^' + aID);
2974 end;
2975 end;
2976 end;
2977 memText.Lines.Insert(0,' ');
2978 memText.Lines.Delete(0);
2979 end;
2980 aBasket.Free;
2981end;
2982
2983procedure TfrmReports.tvReportsExpanding(Sender: TObject; Node: TTreeNode;
2984 var AllowExpansion: Boolean);
2985begin
2986 inherited;
2987 tvReports.Selected := Node;
2988end;
2989
2990procedure TfrmReports.tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
2991 var AllowCollapse: Boolean);
2992begin
2993 inherited;
2994 tvReports.Selected := Node;
2995end;
2996
2997
2998procedure TfrmReports.Print1Click(Sender: TObject);
2999begin
3000 inherited;
3001 RequestPrint;
3002end;
3003
3004procedure TfrmReports.Copy1Click(Sender: TObject);
3005var
3006 i,j: integer;
3007 line: string;
3008 ListItem: TListItem;
3009 aText: String;
3010begin
3011 inherited;
3012 ClipBoard;
3013 aText := '';
3014 for i := 0 to lvReports.Items.Count - 1 do
3015 if lvReports.Items[i].Selected then
3016 begin
3017 ListItem := lvReports.Items[i];
3018 line := '';
3019 for j := 1 to lvReports.Columns.Count - 1 do
3020 begin
3021 if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then
3022 line := line + ' ' + ListItem.SubItems[j-1];
3023 end;
3024 if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then
3025 line := ListItem.Caption + ' ' + line;
3026 if length(aText) > 0 then
3027 aText := aText + CRLF + line
3028 else aText := line;
3029 end;
3030 ClipBoard.Clear;
3031 ClipBoard.AsText := aText;
3032end;
3033
3034procedure TfrmReports.Copy2Click(Sender: TObject);
3035begin
3036 inherited;
3037 memText.CopyToClipboard;
3038end;
3039
3040procedure TfrmReports.Print2Click(Sender: TObject);
3041begin
3042 inherited;
3043 RequestPrint;
3044end;
3045
3046procedure TfrmReports.lvReportsKeyUp(Sender: TObject; var Key: Word;
3047 Shift: TShiftState);
3048begin
3049 inherited;
3050 if (Key = 67) and (ssCtrl in Shift) then
3051 Copy1Click(Self);
3052 if (Key = 65) and (ssCtrl in Shift) then
3053 SelectAll1Click(Self);
3054end;
3055
3056procedure TfrmReports.SelectAll1Click(Sender: TObject);
3057var
3058 i: integer;
3059begin
3060 inherited;
3061 for i := 0 to lvReports.Items.Count - 1 do
3062 lvReports.Items[i].Selected := true;
3063end;
3064
3065procedure TfrmReports.SelectAll2Click(Sender: TObject);
3066begin
3067 inherited;
3068 memText.SelectAll;
3069end;
3070
3071
3072procedure TfrmReports.tvReportsKeyDown(Sender: TObject; var Key: Word;
3073 Shift: TShiftState);
3074begin
3075 inherited;
3076 case Key of
3077 VK_LBUTTON, VK_RETURN, VK_SPACE:
3078 begin
3079 tvReportsClick(Sender);
3080 Key := 0;
3081 end;
3082 end;
3083end;
3084
3085procedure TfrmReports.ShowTabControl;
3086begin
3087 if TabControl1.Tabs.Count > 1 then
3088 begin
3089 TabControl1.Visible := true;
3090 TabControl1.TabStop := true;
3091 pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3092 end;
3093end;
3094
3095procedure TfrmReports.Memo1KeyUp(Sender: TObject; var Key: Word;
3096 Shift: TShiftState);
3097begin
3098 inherited;
3099 if (Key = VK_TAB) then
3100 begin
3101 if ssShift in Shift then
3102 begin
3103 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3104 Key := 0;
3105 end
3106 else if ssCtrl in Shift then
3107 begin
3108 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
3109 Key := 0;
3110 end;
3111 end;
3112 if (key = VK_ESCAPE) then begin
3113 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3114 key := 0;
3115 end;
3116end;
3117
3118procedure TfrmReports.LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode);
3119var
3120 PTO, PTO2: PProcTreeObj;
3121
3122begin
3123 PTO := MakeProcedureTreeObject(x);
3124 PTO2 := MakeProcedureTreeObject(x);
3125 PTO2.ProcedureName := '';
3126 if PTO^.ParentName = '' then
3127 begin // New stand-alone
3128 CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO^.ProcedureName,PTO);
3129 CurrentNode := CurrentParentNode;
3130 end
3131 else
3132 if (CurrentParentNode <> nil) and (PTO^.ParentName = PProcTreeObj(CurrentParentNode.Data)^.ParentName) then
3133 // another child for same parent
3134 CurrentNode := tvProcedures.Items.AddChildObject(CurrentParentNode,PTO^.ProcedureName,PTO)
3135 else
3136 begin //New child and parent
3137 CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO2^.ParentName,PTO2);
3138 CurrentNode := tvProcedures.Items.AddChildObjectFirst(CurrentParentNode,PTO^.ProcedureName,PTO);
3139 end;
3140end;
3141
3142procedure TfrmReports.tvProceduresCollapsing(Sender: TObject;
3143 Node: TTreeNode; var AllowCollapse: Boolean);
3144begin
3145 inherited;
3146 tvReports.Selected := Node;
3147end;
3148
3149procedure TfrmReports.tvProceduresExpanding(Sender: TObject;
3150 Node: TTreeNode; var AllowExpansion: Boolean);
3151begin
3152 inherited;
3153 tvReports.Selected := Node;
3154end;
3155
3156procedure TfrmReports.tvProceduresClick(Sender: TObject);
3157var
3158 Associate: Integer;
3159 SelNode: TTreeNode;
3160begin
3161 inherited;
3162 SelNode := TTreeView(Sender).Selected;
3163 if not assigned(SelNode) then Exit;
3164 Associate := PProcTreeObj(SelNode.Data)^.Associate;
3165 lvReports.Selected := nil;
3166 if PProcTreeObj(SelNode.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone
3167 begin
3168 memText.Lines.Clear;
3169 lvReports.Selected := lvReports.Items[Associate];
3170 if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then
3171 lblProcTypeMsg.Caption := 'Descendent Procedure'
3172 else
3173 if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then
3174 lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
3175 end
3176 else //if it is a parent with descendents
3177 if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then //printset = shared report
3178 lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
3179 else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then //examset - individual reports
3180 begin
3181 memText.Lines.Clear;
3182 lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
3183 memText.Lines.Add('Descendent Procedures - Select to view individual reports...')
3184 end;
3185end;
3186
3187procedure TfrmReports.tvProceduresChange(Sender: TObject; Node: TTreeNode);
3188var
3189 Associate, i: Integer;
3190 FirstChild: TTreeNode;
3191 aID, aMoreID: string;
3192 x, HasImages: string;
3193begin
3194 inherited;
3195 if UpdatingLvReports or not assigned(Node) then Exit;
3196 UpdatingTVProcedures := TRUE;
3197 Associate := PProcTreeObj(Node.Data)^.Associate;
3198 lvReports.Selected := nil;
3199 if PProcTreeObj(Node.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone
3200 if (Associate >= 0) and (Associate < (lvReports.Items.Count)) then // if valid associate in lvReports
3201 if lvReports.Items[Associate].Selected = FALSE then // if not already selected
3202 begin
3203 lvReports.Selected := lvReports.Items[Associate];
3204 if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then
3205 begin
3206 lblProcTypeMsg.Caption := 'Descendent Procedure';
3207 end
3208 else if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then
3209 lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
3210 else if PProcTreeObj(Node.Data)^.MemberOfSet = '' then
3211 lblProcTypeMsg.Caption := 'Standalone (single) procedure';
3212 end;
3213 UpdatingTvProcedures := FALSE;
3214
3215 if PProcTreeObj(Node.Data)^.ProcedureName = '' then //Parent with descendents
3216 if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then //printset = shared report
3217 begin
3218 lblProcTypeMsg.Caption := 'Descendent Procedures with shared report';
3219 FirstChild := Node.GetFirstChild;
3220 Associate := PProcTreeObj(FirstChild.Data)^.Associate;
3221 aID := lvReports.Items[Associate].SubItems[0];
3222 aMoreID := '#' + lvReports.Items[Associate].SubItems[5];
3223 SetPiece(uRemoteType,'^',5,aID + aMoreID);
3224 uLocalReportData.Clear;
3225 MemText.Lines.Clear;
3226 if not(piece(uRemoteType, '^', 9) = '1') then
3227 begin
3228 LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
3229 for i := 0 to uLocalReportData.Count - 1 do
3230 MemText.Lines.Add(uLocalReportData[i]);
3231 memText.SelStart := 0;
3232 if lvReports.Items[Associate].SubItems.Count > 5 then
3233 x := 'RA^' + aID + U + lvReports.Items[Associate].SubItems[5]
3234 else
3235 x := 'RA^' + aID;
3236 HasImages := BOOLCHAR[lvReports.Items[Associate].SubItemImages[1] = IMG_1_IMAGE];
3237 SetPiece(x, U, 10, HasImages);
3238 NotifyOtherApps(NAE_REPORT, x);
3239 end;
3240 end
3241 else if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then //examset - individual reports
3242 begin
3243 memText.Lines.Clear;
3244 lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
3245 memText.Lines.Add('Descendent Procedures - Select to view individual reports...');
3246 end;
3247end;
3248
3249procedure TfrmReports.tvProceduresKeyDown(Sender: TObject; var Key: Word;
3250 Shift: TShiftState);
3251begin
3252 inherited;
3253 case Key of
3254 VK_LBUTTON, VK_RETURN, VK_SPACE:
3255 begin
3256 tvReportsClick(Sender);
3257 Key := 0;
3258 end;
3259 end;
3260
3261end;
3262
3263procedure TfrmReports.chkDualViewsClick(Sender: TObject);
3264begin
3265 inherited;
3266 if (GraphForm <> nil) and GraphFormActive then
3267 GraphForm.chkDualViews.Checked := chkDualViews.Checked;
3268end;
3269
3270procedure TfrmReports.chkMaxFreqClick(Sender: TObject);
3271begin
3272 inherited;
3273 if chkMaxFreq.Checked = true then
3274 begin
3275 uMaxOcc := piece(uQualifier, ';', 3);
3276 SetPiece(uQualifier, ';', 3, '');
3277 end
3278 else
3279 begin
3280 SetPiece(uQualifier, ';', 3, uMaxOcc);
3281 end;
3282 tvReportsClick(self);
3283end;
3284
3285procedure TfrmReports.btnChangeViewClick(Sender: TObject);
3286begin
3287 inherited;
3288 if (GraphForm <> nil) and GraphFormActive then
3289 begin
3290 GraphForm.btnChangeSettingsClick(GraphForm);
3291 chkDualViews.Checked := GraphForm.chkDualViews.Checked;
3292 end;
3293end;
3294
3295procedure TfrmReports.btnGraphSelectionsClick(Sender: TObject);
3296begin
3297 inherited;
3298 if (GraphForm <> nil) and GraphFormActive then
3299 begin
3300 GraphForm.btnGraphSelectionsClick(GraphForm);
3301 chkDualViews.Checked := GraphForm.chkDualViews.Checked;
3302 end;
3303end;
3304
3305procedure TfrmReports.lstDateRangeClick(Sender: TObject);
3306begin
3307 inherited;
3308 if (GraphForm <> nil) then
3309 begin
3310 GraphForm.cboDateRange.ItemIndex := lstDateRange.ItemIndex;
3311 GraphForm.cboDateRangeChange(self);
3312 FastAssign(GraphForm.cboDateRange.Items, lstDateRange.Items);
3313 lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
3314 //Exit;
3315 end;
3316
3317end;
3318
3319procedure TfrmReports.sptHorzMoved(Sender: TObject);
3320begin
3321 inherited;
3322 pnlTopViews.Height := 80;
3323end;
3324
3325initialization
3326 SpecifyFormIsNotADialog(TfrmReports);
3327
3328end.
Note: See TracBrowser for help on using the repository browser.