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

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

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