source: cprs/branches/foia-cprs/CPRS-Chart/fReports.pas@ 1687

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

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