unit fReports; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Menus, uConst, ORDtTmRng, OleCtrls, SHDocVw, Buttons, ClipBrd, rECS, Variants, StrUtils; type TfrmReports = class(TfrmHSplit) PopupMenu1: TPopupMenu; GotoTop1: TMenuItem; GotoBottom1: TMenuItem; FreezeText1: TMenuItem; UnFreezeText1: TMenuItem; calApptRng: TORDateRangeDlg; Timer1: TTimer; pnlLefTop: TPanel; lblTypes: TOROffsetLabel; Splitter1: TSplitter; pnlLeftBottom: TPanel; lblQualifier: TOROffsetLabel; lblHeaders: TLabel; lstHeaders: TORListBox; lstQualifier: TORListBox; pnlRightTop: TPanel; pnlRightBottom: TPanel; pnlRightMiddle: TPanel; lblTitle: TOROffsetLabel; TabControl1: TTabControl; lvReports: TCaptionListView; Memo1: TMemo; WebBrowser1: TWebBrowser; memText: TRichEdit; sptHorzRight: TSplitter; tvReports: TORTreeView; PopupMenu2: TPopupMenu; Print1: TMenuItem; Copy1: TMenuItem; Print2: TMenuItem; Copy2: TMenuItem; SelectAll1: TMenuItem; SelectAll2: TMenuItem; pnlProcedures: TPanel; lblProcedures: TOROffsetLabel; tvProcedures: TORTreeView; lblProcTypeMsg: TOROffsetLabel; pnlViews: TORAutoPanel; chkDualViews: TCheckBox; btnChangeView: TORAlignButton; btnGraphSelections: TORAlignButton; lblDateRange: TLabel; lstDateRange: TORListBox; pnlTopViews: TPanel; procedure lstQualifierClick(Sender: TObject); procedure GotoTop1Click(Sender: TObject); procedure GotoBottom1Click(Sender: TObject); procedure FreezeText1Click(Sender: TObject); procedure UnFreezeText1Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure FormCreate(Sender: TObject); procedure DisplayHeading(aRanges: string); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure TabControl1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string); procedure lstHeadersClick(Sender: TObject); procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure lstQualifierDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure tvReportsClick(Sender: TObject); procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn); procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure LoadListView(aReportData: TStringList); procedure LoadTreeView; procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure Print1Click(Sender: TObject); procedure Copy1Click(Sender: TObject); procedure Copy2Click(Sender: TObject); procedure Print2Click(Sender: TObject); procedure UpdateRemoteStatus(aSiteID, aStatus: string); procedure lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SelectAll1Click(Sender: TObject); procedure SelectAll2Click(Sender: TObject); procedure tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode); procedure tvProceduresCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure tvProceduresExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure tvProceduresClick(Sender: TObject); procedure tvProceduresChange(Sender: TObject; Node: TTreeNode); procedure tvProceduresKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure chkDualViewsClick(Sender: TObject); procedure btnChangeViewClick(Sender: TObject); procedure btnGraphSelectionsClick(Sender: TObject); procedure lstDateRangeClick(Sender: TObject); procedure sptHorzMoved(Sender: TObject); private SortIdx1, SortIdx2, SortIdx3: Integer; procedure ProcessNotifications; procedure ShowTabControl; procedure Graph(reportien: integer); procedure GraphPanel(active: boolean); public procedure ClearPtData; override; function AllowContextChange(var WhyNot: string): Boolean; override; procedure DisplayPage; override; procedure SetFontSize(NewFontSize: Integer); override; procedure RequestPrint; override; end; var frmReports: TfrmReports; uHSComponents: TStringList; //components selected //segment^OccuranceLimit^TimeLimit^Header... //^(value of uComponents...) uHSAll: TStringList; //List of all displayable Health Summaries uLocalReportData: TStringList; //Storage for Local report data uRemoteReportData: TStringList; //Storage for status of Remote data uReportInstruction: String; //User Instructions uNewColumn: TListColumn; uListItem: TListItem; uColumns: TStringList; uTreeStrings: TStrings; uMaxOcc: string; uHState: string; uQualifier: string; uReportType: string; uSortOrder: string; uQualifierType: Integer; uFirstSort: Integer; uSecondSort: Integer; uThirdSort: Integer; uColChange: string; //determines when column widths have changed uUpdateStat: boolean; //flag turned on when remote status is being updated ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected uListState: Integer; //Checked state of list of Adhoc components Checked: Abbreviation, UnChecked: Name uECSReport: TECSReport; //Event Capture Report, initiated in fFrame when Click Event Capture under Tools UpdatingLvReports: Boolean; //Currently updating lvReports UpdatingTvProcedures: Boolean; //Currently updating tvProcedures implementation {$R *.DFM} uses ORFn, rCore, rReports, fFrame, uCore, uReports, fReportsPrint, fReportsAdhocComponent1, activex, mshtml, dShared, fGraphs, rGraphs; //***** const CT_REPORTS =10; // ID for REPORTS tab used by frmFrame QT_OTHER = 0; QT_HSTYPE = 1; QT_DATERANGE = 2; QT_IMAGING = 3; QT_NUTR = 4; QT_PROCEDURES = 19; QT_SURGERY = 28; QT_HSCOMPONENT = 5; QT_HSWPCOMPONENT = 6; TX_NOREPORT = 'No report is currently selected.'; TX_NOREPORT_CAP = 'No Report Selected'; HTML_PRE = '
';
  HTML_POST = CRLF + '
'; var uRemoteCount: Integer; uFrozen: Boolean; uHTMLDoc: string; uReportRPC: string; uHTMLPatient: ANSIstring; uRptID: String; uDirect: String; uEmptyImageList: TImageList; ColumnToSort: Integer; ColumnSortForward: Boolean; GraphForm: TfrmGraphs; GraphFormActive: boolean; procedure TfrmReports.ClearPtData; begin inherited ClearPtData; Timer1.Enabled := False; memText.Clear; tvProcedures.Items.Clear; lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; uLocalReportData.Clear; uRemoteReportData.Clear; TabControl1.Tabs.Clear; TabControl1.Visible := false; TabControl1.TabStop := false; if (GraphForm <> nil) and GraphFormActive then with GraphForm do begin GraphForm.SendToBack; Initialize; DisplayData('top'); DisplayData('bottom'); lstCheck.Items.Clear; GraphFormActive := false; end; begin end; end; procedure TfrmReports.Graph(reportien: integer); begin if GraphForm = nil then begin GraphForm := TfrmGraphs.Create(self); try with GraphForm do begin if btnClose.Tag = 1 then Exit; Parent := pnlRight; Align := alClient; pnlFooter.Tag := 1; //suppresses bottom of graph form pnlBottom.Height := 1; pnlMain.BevelInner := bvLowered; pnlMain.BevelOuter := bvRaised; pnlMain.Tag := reportien; Initialize; ResizeAnchoredFormToFont(GraphForm); Show; DisplayData('top'); DisplayData('bottom'); lstCheck.Items.Clear; GraphPanel(true); lstTypes.Hint := Patient.DFN; BringToFront; end; finally if GraphForm.btnClose.Tag = 1 then begin GraphFormActive := false; GraphForm.Free; GraphForm := nil; end else GraphFormActive := true; end; end else if GraphForm.btnClose.Tag = 1 then Exit else if GraphFormActive and (GraphForm.lstTypes.Hint = Patient.DFN) then begin // displaying same patient if Tag <> reportien then with GraphForm do begin // new report pnlMain.Tag := reportien; Initialize; //DisplayData('top'); //DisplayData('bottom'); lstCheck.Items.Clear; GraphPanel(true); BringToFront; end; //no action end else if GraphForm.lstTypes.Hint = Patient.DFN then begin // same patient, bring back graph GraphPanel(true); BringToFront; GraphFormActive := true; end else with GraphForm do begin // new patient pnlMain.Tag := reportien; Initialize; DisplayData('top'); DisplayData('bottom'); lstCheck.Items.Clear; lstTypes.Hint := Patient.DFN; GraphPanel(true); BringToFront; GraphFormActive := true; end; end; procedure TfrmReports.GraphPanel(active: boolean); var aQualifier, aStartTime, aStopTime: string; begin if active then begin pnlLeftBottom.Height := pnlLeft.Height div 2; pnlViews.Height := pnlLeftBottom.Height; if pnlLeft.Height < 200 then pnlTopViews.Height := 3 else pnlTopViews.Height := 80; lblQualifier.Visible := false; lstQualifier.Visible := false; pnlViews.Visible := true; if lstDateRange.Tag = 0 then begin lstDateRange.Tag := 1; aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier; aStartTime := Piece(aQualifier,';',1); aStopTime := Piece(aQualifier,';',2); GraphForm.cboDateRange.Items.Add( '^' + aStartTime + ' to ' + aStopTime +'^^^' + aStartTime + ';' + aStopTime + '^' + floattostr(strtofmdatetime(aStartTime)) + '^' + floattostr(strtofmdatetime(aStopTime))); lstDateRange.Items := GraphForm.cboDateRange.Items; //lstDateRange.ItemIndex := lstDateRange.Items.Count - 1; lstDateRange.ItemIndex := lstDateRange.Items.Count - 2; //set to all results till fixed lstDateRangeClick(self); end; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin lblQualifier.Visible := true; lstQualifier.Visible := true; pnlViews.Visible := false; pnlLeftBottom.Height := lblHeaders.Height + lblQualifier.Height + 90; end; end; function TfrmReports.AllowContextChange(var WhyNot: string): Boolean; var i: integer; begin Result := inherited AllowContextChange(WhyNot); // sets result = true if Timer1.Enabled = true then case BOOLCHAR[frmFrame.CCOWContextChanging] of '1': begin WhyNot := 'A remote data query in progress will be aborted.'; Result := False; end; '0': if WhyNot = 'COMMIT' then begin with RemoteSites.SiteList do for i := 0 to Count - 1 do if TRemoteSite(Items[i]).Selected then if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then begin TRemoteSite(Items[i]).ReportClear; TRemoteSite(Items[i]).QueryStatus := '-1^Aborted'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Query Aborted'); end; Timer1.Enabled := false; Result := True; end; end; end; procedure TfrmReports.RequestPrint; begin if uReportType = 'M' then begin InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK); Exit; end; if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then begin if lvReports.Items.Count < 1 then begin InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK); Exit; end; if lvReports.SelCount < 1 then begin InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK); Exit; end; end; if (uReportType = 'G') and GraphFormActive then with GraphForm do begin if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then begin InfoBox('There are no items graphed.', 'No Items to Print', MB_OK); Exit; end else begin mnuPopGraphPrintClick(mnuPopGraphPrint); Exit; end; end; if uQualifierType = QT_DATERANGE then begin // = 2 if lstQualifier.ItemIndex < 0 then begin InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK); end else PrintReports(uRptID, piece(uRemoteType,'^',4)); end else PrintReports(uRptID, piece(uRemoteType,'^',4)); end; procedure TfrmReports.DisplayPage; var i: integer; begin inherited DisplayPage; frmFrame.mnuFilePrint.Tag := CT_REPORTS; frmFrame.mnuFilePrint.Enabled := True; frmFrame.mnuFilePrintSetup.Enabled := True; uUpdateStat := false; ulvSelectOn := false; uListState := GetAdhocLookup(); memText.SelStart := 0; FormShow(self); uHTMLPatient := '
' + '' + '' + '' + '' + '' + '
Patient: ' + Patient.Name + '' + Patient.SSN + 'Age: ' + IntToStr(Patient.Age) + '
'; //the preferred method would be to use headers and footers //so this is just an interim solution. if not GraphFormActive then pnlLeftBottom.Visible := False; if InitPage then begin Splitter1.Visible := false; pnlLeftBottom.Visible := false; uMaxOcc := ''; uColChange := ''; LoadTreeView; end; if InitPatient and not (CallingContext = CC_NOTIFICATION) then begin lstQualifier.Clear; tvProcedures.Items.Clear; lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lvReports.Columns.Clear; lblTitle.Caption := ''; lvReports.Caption := ''; Splitter1.Visible := false; pnlLeftBottom.Visible := false; memText.Parent := pnlRightBottom; memText.Align := alClient; memText.Clear; uReportInstruction := ''; uLocalReportData.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear; pnlRightTop.Height := lblTitle.Height + TabControl1.Height; StatusText(''); with tvReports do if Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; end; end; case CallingContext of CC_INIT_PATIENT: if not InitPatient then begin lstQualifier.Clear; tvProcedures.Items.Clear; lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; Splitter1.Visible := false; pnlLeftBottom.Visible := false; with tvReports do if Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; end; end; CC_NOTIFICATION: ProcessNotifications; end; end; procedure TfrmReports.UpdateRemoteStatus(aSiteID, aStatus: string); var j: integer; s: string; c: boolean; begin if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame uUpdateStat := true; for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do begin s := frmFrame.lstCIRNLocations.Items[j]; c := frmFrame.lstCIRNLocations.checked[j]; if piece(s, '^', 1) = aSiteID then begin frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus; frmFrame.lstCIRNLocations.checked[j] := c; end; end; uUpdateStat := false; end; procedure TfrmReports.LoadTreeView; var i,j: integer; currentNode, parentNode, grandParentNode: TTreeNode; x: string; addchild, addgrandchild: boolean; begin tvReports.Items.Clear; memText.Clear; uHTMLDoc := ''; WebBrowser1.Navigate('about:blank'); tvProcedures.Items.Clear; lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; uTreeStrings.Clear; lblTitle.Caption := ''; lvReports.Caption := ''; ListReports(uTreeStrings); addchild := false; addgrandchild := false; parentNode := nil; grandParentNode := nil; currentNode := nil; for i := 0 to uTreeStrings.Count - 1 do begin x := uTreeStrings[i]; if UpperCase(Piece(x,'^',1))='[PARENT END]' then begin if addgrandchild = true then begin currentNode := grandParentNode; addgrandchild := false; end else begin currentNode := parentNode; addchild := false; end; continue; end; if UpperCase(Piece(x,'^',1))='[PARENT START]' then begin if addgrandchild = true then currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,15))) else if addchild = true then begin currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,15))); addgrandchild := true; grandParentNode := currentNode; end else begin currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,15))); parentNode := currentNode; addchild := true; end; end else if addchild = false then begin currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x)); parentNode := currentNode; end else begin if addgrandchild = true then currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x)) else currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x)); end; end; for i := 0 to tvReports.Items.Count - 1 do if Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4) = '1' then begin HealthSummaryCheck(uHSAll,'1'); for j := 0 to uHSAll.Count - 1 do tvReports.Items.AddChildObject(tvReports.Items[i],Piece(uHSAll[j],'^',2),MakeReportTreeObject(uHSAll[j])); end; if tvReports.Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); end; end; procedure TfrmReports.SetFontSize(NewFontSize: Integer); begin inherited SetFontSize(NewFontSize); memText.Font.Size := NewFontSize; end; procedure TfrmReports.LoadListView(aReportData: TStringList); var i,j,k,aErr: integer; aTmpAray: TStringList; aColCtr, aCurCol, aCurRow, aColID: integer; x,y,z,c,aSite: string; ListItem: TListItem; begin aSite := ''; aErr := 0; ListItem := nil; case uQualifierType of QT_HSCOMPONENT: begin // = 5 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then begin with lvReports do begin ViewStyle := vsReport; for j := 0 to aReportData.Count - 1 do begin if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call continue; ListItem := Items.Add; aSite := piece(aReportData[j],'^',1); ListItem.Caption := piece(aSite,';',1); for k := 2 to uColumns.Count do begin ListItem.SubItems.Add(piece(aReportData[j],'^',k)); end; end; if aReportData.Count = 0 then begin uReportInstruction := ''; memText.Lines.Clear; memText.Lines.Add(uReportInstruction); end else memText.Lines.Clear; end; end; end; QT_HSWPCOMPONENT: begin // = 6 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then begin aTmpAray := TStringList.Create; aCurRow := 0; aCurCol := 0; aColCtr := 9; aTmpAray.Clear; with lvReports do begin for j := 0 to aReportData.Count - 1 do begin x := aReportData[j]; aColID := StrToIntDef(piece(x,'^',1),-1); if aColID < 0 then //this is an error condition most likely an incompatible remote call continue; if aColID > (uColumns.Count - 1) then begin aErr := 1; continue; //extract is out of sync with columns defined in 101.24 end; if aColID < aColCtr then begin if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[j],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; z := piece(c,'^',1); y := copy(c, (pos('^', c)), 9999); if pos('^',y) > 0 then begin while pos('^',y) > 0 do begin y := copy(y, (pos('^', y)+1), 9999); z := z + '^' + y; end; ListItem.SubItems.Add(z); end else begin ListItem.SubItems.Add(y); end; end; RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; aColCtr := 0; aCurCol := aColID; aCurRow := aCurRow + 1; end else if aColID = aCurCol then begin z := ''; y := piece(x,'^',2); if length(y) > 0 then z := y; y := copy(x, (pos('^', x)+1), 9999); if pos('^',y) > 0 then begin while pos('^',y) > 0 do begin y := copy(y, (pos('^', y)+1), 9999); z := z + '^' + y; end; aTmpAray.Add(z); end else begin aTmpAray.Add(y); end; continue; end; if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[0],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; ListItem.SubItems.Add(c); end; RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; aCurCol := aColID; Inc(aColCtr); y := ''; for k := 2 to 10 do if length(piece(x,'^',k)) > 0 then begin if length(y) > 0 then y := y + '^' + piece(x,'^',k) else y := y + piece(x,'^',k); end; aTmpAray.Add(y); if aColCtr > 0 then while aColCtr < aCurCol do begin ListItem.SubItems.Add(''); Inc(aColCtr); end; end; if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[0],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; ListItem.SubItems.Add(c); end; RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; end; aTmpAray.Free; end; if uRptID = 'OR_R18:IMAGING' then with lvReports do //set image indicator for "Imaging" report begin SmallImages := dmodShared.imgImages; for i := 0 to Items.Count - 1 do if Items[i].SubItems[7] = 'Y' then Items[i].SubItemImages[1] := IMG_1_IMAGE else Items[i].SubItemImages[1] := IMG_NO_IMAGES; end else lvReports.SmallImages := uEmptyImageList; if uRptID = 'OR_PN:PROGRESS NOTES' then with lvReports do //set image indicator for "Progress Notes" report begin SmallImages := dmodShared.imgImages; for i := 0 to Items.Count - 1 do if StrToInt(Items[i].SubItems[7]) > 0 then Items[i].SubItemImages[2] := IMG_1_IMAGE else Items[i].SubItemImages[2] := IMG_NO_IMAGES; end else lvReports.SmallImages := uEmptyImageList; end; end; if aErr = 1 then if User.HasKey('XUPROGMODE') then ShowMessage('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine'); end; procedure TfrmReports.lstQualifierClick(Sender: TObject); var MoreID: String; //Restores MaxOcc value aRemote, aHDR: string; i: integer; begin inherited; if uFrozen = True then begin memo1.visible := False; memo1.TabStop := False; end; MoreID := ';' + Piece(uQualifier,';',3); aRemote := piece(uRemoteType,'^',1); aHDR := piece(uRemoteType,'^',7); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); uHSComponents.Clear; uHSAll.Clear; tvProcedures.Items.Clear; lblProcTypeMsg.Visible := FALSE; uHTMLDoc := ''; if uReportType = 'H' then begin WebBrowser1.Visible := true; WebBrowser1.TabStop := true; WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; memText.Visible := false; memText.TabStop := false; end else begin WebBrowser1.Visible := false; WebBrowser1.TabStop := false; memText.Visible := true; memText.TabStop := true; memText.BringToFront; RedrawActivate(memText.Handle); end; uLocalReportData.Clear; uRemoteReportData.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear; uRemoteCount := 0; if aHDR = '1' then DisplayHeading(lstQualifier.ItemID) else DisplayHeading(lstQualifier.ItemID + MoreID); if lstQualifier.ItemID = 'ds' then begin with calApptRng do if Not (Execute) then begin lstQualifier.ItemIndex := -1; Exit; end else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then begin if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then begin InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6) + ' for this report.', 'No Report Generated',MB_OK); lstQualifier.ItemIndex := -1; exit; end; lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); DisplayHeading(lstQualifier.ItemID + MoreID); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); end else begin lstQualifier.ItemIndex := -1; InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK); if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); DisplayHeading(lstQualifier.ItemID + MoreID); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); end else begin lstQualifier.ItemIndex := -1; InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK); exit; end; end; end; if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then begin InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6) + ' for this report.', 'No Report Generated',MB_OK); lstQualifier.ItemIndex := -1; exit; end; StatusText('Retrieving ' + lblTitle.Caption + '...'); Screen.Cursor := crHourGlass; uReportInstruction := #13#10 + 'Retrieving data...'; memText.Lines.Add(uReportInstruction); if WebBrowser1.Visible = true then begin uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; WebBrowser1.Navigate('about:blank'); end; case uQualifierType of QT_HSCOMPONENT: begin // = 5 lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; memText.Lines.Clear; RowObjects.Clear; if ((aRemote = '1') or (aRemote = '2')) then GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR); if (length(piece(uHState,';',2)) > 0) then begin if not(aRemote = '2') then LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); LoadListView(uLocalReportData); end else begin if ((aRemote = '1') or (aRemote = '2')) then ShowTabControl; pnlRightMiddle.Visible := false; LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memText.Lines.Add(uReportInstruction); end else begin QuickCopy(uLocalReportData,memText); TabControl1.OnChange(nil); end; end; end; QT_HSWPCOMPONENT: begin // = 6 lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; RowObjects.Clear; memText.Lines.Clear; if ((aRemote = '1') or (aRemote = '2')) then begin Screen.Cursor := crDefault; GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR); end; if (length(piece(uHState,';',2)) > 0) then begin if not(aRemote = '2') then LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); LoadListView(uLocalReportData); end else begin if ((aRemote = '1') or (aRemote = '2')) then ShowTabControl; pnlRightMiddle.Visible := false; if not (aRemote = '2') then begin LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memText.Lines.Add(uReportInstruction); end else QuickCopy(uLocalReportData,memText); end; end; end else begin Screen.Cursor := crDefault; GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR); if Pos('ECS',Piece(uRptID,':',1))>0 then begin if Pos('OR_ECS1',uRptID)>0 then uECSReport.ReportHandle := 'ECPCER'; if Pos('OR_ECS2',uRptID)>0 then uECSReport.ReportHandle := 'ECPAT'; uECSReport.ReportType := 'D'; if uECSReport.ReportHandle = 'ECPAT' then begin if InfoBox('Would you like the procedure reason be included in the report?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then uECSReport.NeedReason := 'Y' else uECSReport.NeedReason := 'N'; end; FormatECSDate(lstQualifier.ItemID, uECSReport); LoadECSReportText(uLocalReportData, uECSReport); end else LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memText); end; end; Screen.Cursor := crDefault; StatusText(''); memText.Lines.Insert(0,' '); memText.Lines.Delete(0); if WebBrowser1.Visible = true then begin if uReportType = 'R' then uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST else uHTMLDoc := uHTMLPatient + uLocalReportData.Text; WebBrowser1.Navigate('about:blank'); end; end; procedure TfrmReports.GotoTop1Click(Sender: TObject); var Current, Desired : Longint; begin inherited; with memText do begin SetFocus; SelStart :=0; SelLength :=0; Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0); Desired := SendMessage(memText.handle, EM_LINEFROMCHAR, memText.SelStart + memText.SelLength ,0) - 1; SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current); end; end; procedure TfrmReports.GotoBottom1Click(Sender: TObject); var Current, Desired : Longint; I,LineCount : Integer; begin Inherited; LineCount :=0; with memText do begin for I := 0 to lines.count-1 do LineCount := LineCount + Length(Lines[I]) + 2; SetFocus; SelStart := LineCount; SelLength :=0; end; Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0); Desired := SendMessage(memText.handle, EM_LINEFROMCHAR, memText.SelStart + memText.SelLength ,0); SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current - 5); end; procedure TfrmReports.FreezeText1Click(Sender: TObject); var Current, Desired : Longint; LineCount : Integer; begin Inherited; If memText.SelLength > 0 then begin Memo1.visible := true; Memo1.TabStop := true; Memo1.Text := memText.SelText; If Memo1.Lines.Count <6 then LineCount := Memo1.Lines.Count + 1 Else LineCount := 5; Memo1.Height := LineCount * frmReports.Canvas.TextHeight(memText.SelText); Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0); Desired := SendMessage(memText.handle, EM_LINEFROMCHAR, memText.SelStart + memText.SelLength ,0); SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current); uFrozen := True; end; end; procedure TfrmReports.UnFreezeText1Click(Sender: TObject); begin Inherited; If uFrozen = True Then begin uFrozen := False; UnFreezeText1.Enabled := False; Memo1.Visible := False; Memo1.TabStop := False; Memo1.Text := ''; end; end; procedure TfrmReports.PopupMenu1Popup(Sender: TObject); begin inherited; If Screen.ActiveControl.Name <> memText.Name then begin memText.SetFocus; memText.SelStart := 0; end; If memText.SelLength > 0 Then FreezeText1.Enabled := True Else FreezeText1.Enabled := False; If Memo1.Visible Then UnFreezeText1.Enabled := True; If memText.SelStart > 0 then GotoTop1.Enabled := True Else GotoTop1.Enabled := False; If SendMessage(memText.handle, EM_LINEFROMCHAR, memText.SelStart,0) < memText.Lines.Count then GotoBottom1.Enabled := True Else GotoBottom1.Enabled := False; end; procedure TfrmReports.FormCreate(Sender: TObject); begin inherited; PageID := CT_REPORTS; memText.Color := ReadOnlyColor; uFrozen := False; uHSComponents := TStringList.Create; uHSAll := TStringList.Create; uLocalReportData := TStringList.Create; uRemoteReportData := TStringList.Create; uColumns := TStringList.Create; uTreeStrings := TStringList.Create; uEmptyImageList := TImageList.Create(Self); uEmptyImageList.Width := 0; RowObjects := TRowObject.Create; uRemoteCount := 0; GraphFormActive := false; end; procedure TfrmReports.ProcessNotifications; var i: integer; SelectID: string; Found: boolean; ListItem: TListItem; begin Found := False; with tvReports do begin for i := 0 to Items.Count -1 do if StrToIntDef(Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4),0) = QT_IMAGING then begin Found := True; break; end; end; if not Found then exit; // no imaging entry in treeview would result in error below, and loss of alert case Notifications.Followup of NF_IMAGING_RESULTS, NF_ABNORMAL_IMAGING_RESULTS, NF_IMAGING_RESULTS_AMENDED: begin tvReports.Selected := tvReports.Items[i]; SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) + '-' + Piece(Notifications.AlertData, '~', 2); if tvReports.Selected <> tvReports.Items[i] then tvReports.Selected := tvReports.Items[i]; end; NF_IMAGING_REQUEST_CHANGED: begin tvReports.Selected := tvReports.Items[i]; SelectID := 'i' + Piece(Notifications.AlertData, '/', 2) + '-' + Piece(Notifications.AlertData, '/', 3); if tvReports.Selected <> tvReports.Items[i] then tvReports.Selected := tvReports.Items[i]; end; NF_STAT_RESULTS : begin tvReports.Selected := tvReports.Items[i]; SelectID := 'i' + Piece(Notifications.AlertData, '~', 2) + '-' + Piece(Piece(Notifications.AlertData, '~', 3), '@', 1); if tvReports.Selected <> tvReports.Items[i] then tvReports.Selected := tvReports.Items[i]; end; else with tvReports do if Items.Count > 0 then Selected := Items[0]; end; if tvReports.Selected <> nil then begin tvReportsClick(Self); for i := 0 to lvReports.Items.Count - 1 do begin ListItem := lvReports.Items[i]; if ListItem.Subitems[0] = SelectID then begin lvReports.Selected := lvReports.Items[i]; break; end; end; Notifications.Delete; end; end; procedure TfrmReports.DisplayHeading(aRanges: string); var x,x1,x2,y,z,DaysBack: string; d1,d2: TFMDateTime; begin with lblTitle do begin x := ''; if tvReports.Selected = nil then tvReports.Selected := tvReports.Items.GetFirstNode; if tvReports.Selected.Parent <> nil then x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text else x := tvReports.Selected.Text; x1 := ''; x2 := ''; if uReportType <> 'M' then begin if CharAt(aRanges, 1) = 'd' then begin if length(piece(aRanges,';',2)) > 0 then begin x2 := ' Max/site:' + piece(aRanges,';',2); aRanges := piece(aRanges,';',1); end; DaysBack := Copy(aRanges, 2, Length(aRanges)); if DaysBack = '0' then aRanges := 'T' + ';T' else aRanges := 'T-' + DaysBack + ';T'; end; if length(piece(aRanges,';',1)) > 0 then begin d1 := ValidDateTimeStr(piece(aRanges,';',1),''); d2 := ValidDateTimeStr(piece(aRanges,';',2),''); y := FormatFMDateTime('mmm dd,yyyy',d1); z := FormatFMDateTime('mmm dd,yyyy',d2); x1 := ' [From: ' + y + ' to ' + z + ']'; end; if length(piece(aRanges,';',3)) > 0 then x2 := ' Max/site:' + piece(aRanges,';',3); case uQualifierType of QT_DATERANGE: x := x + x1; QT_HSCOMPONENT: x := x + x1 + x2; QT_HSWPCOMPONENT: x := x + x1 + x2; QT_IMAGING: x := x + x1 + x2; end; end; Caption := x; end; lvReports.Caption := x; end; procedure TfrmReports.FormShow(Sender: TObject); begin inherited; if RemoteSites.SiteList.Count > 0 then begin case uQualifierType of QT_HSWPCOMPONENT:; QT_HSCOMPONENT:; QT_IMAGING:; QT_PROCEDURES:; QT_NUTR:; else ShowTabControl; end; end; end; procedure TfrmReports.Timer1Timer(Sender: TObject); var i,j,fail: integer; r0,aSite: String; aHDR, aID, aRet: String; begin inherited; with RemoteSites.SiteList do begin for i := 0 to Count - 1 do if TRemoteSite(Items[i]).Selected then begin if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then begin r0 := GetRemoteStatus(TRemoteSite(Items[i]).RemoteHandle); aSite := TRemoteSite(Items[i]).SiteName; TRemoteSite(Items[i]).QueryStatus := r0; //r0='1^Done' if no errors UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2)); if piece(r0,'^',1) = '1' then begin aHDR := piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 13); aID := piece(piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 2),':',1); if aHDR = '1' then begin ModifyHDRData(aRet, TRemoteSite(Items[i]).RemoteHandle ,aID); end; GetRemoteData(TRemoteSite(Items[i]).Data, TRemoteSite(Items[i]).RemoteHandle,Items[i]); RemoteReports.Add(TRemoteSite(Items[i]).CurrentReportQuery, TRemoteSite(Items[i]).RemoteHandle); TRemoteSite(Items[i]).RemoteHandle := ''; TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then begin uRemoteReportData.Clear; QuickCopy(TRemoteSite(Items[i]).Data,uRemoteReportData); fail := 0; if uRemoteReportData.Count > 0 then begin if uRemoteReportData[0] = 'Report not available at this time.' then begin fail := 1; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available'); end; if piece(uRemoteReportData[0],'^',1) = '-1' then begin fail := 1; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure'); end; if fail = 0 then LoadListView(uRemoteReportData); end; end; end else begin uRemoteCount := uRemoteCount + 1; if uRemoteCount > 90 then begin TRemoteSite(Items[i]).RemoteHandle := ''; TRemoteSite(Items[i]).QueryStatus := '-1^Timed out'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Timed out'); StatusText(''); TabControl1.OnChange(nil); end else StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...'); end; Timer1.Interval := 10000; end; end; if Timer1.Enabled = True then begin j := 0; for i := 0 to Count -1 do begin if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then begin j := 1; break; end; end; if j = 0 then //Shutdown timer if all sites have been processed begin Timer1.Enabled := False; StatusText(''); end; j := 0; for i := 0 to Count -1 do if TRemoteSite(Items[i]).Selected = true then begin j := 1; break; end; if j = 0 then //Shutdown timer if user has de-selected all sites begin Timer1.Enabled := False; StatusText(''); TabControl1.OnChange(nil); end; end; end; end; procedure TfrmReports.TabControl1Change(Sender: TObject); var aStatus,aSite: string; hook: Boolean; i: integer; begin inherited; if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then memText.Lines.Clear; lstHeaders.Items.Clear; uHTMLDoc := ''; if WebBrowser1.visible = true then WebBrowser1.Navigate('about:blank'); if (length(piece(uHState,';',2)) = 0) then with TabControl1 do begin memText.Lines.BeginUpdate; if TabIndex > 0 then begin aStatus := TRemoteSite(Tabs.Objects[TabIndex]).QueryStatus; aSite := TRemoteSite(Tabs.Objects[TabIndex]).SiteName; if aStatus = '1^Done' then begin if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[0],'^',1) = '[HIDDEN TEXT]' then begin lstHeaders.Clear; hook := false; for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).Data.Count - 1 do if hook = true then memText.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).Data[i]) else begin lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).Data[i])); if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[i],'^',1) = '[REPORT TEXT]' then hook := true; end; end else QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).Data,memText); memText.Lines.Insert(0,' '); memText.Lines.Delete(0); end; if Piece(aStatus,'^',1) = '-1' then begin memText.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2)); end; if Piece(aStatus,'^',1) = '0' then memText.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2)); if Piece(aStatus,'^',1) = '' then memText.Lines.Add(uReportInstruction); end else if uLocalReportData.Count > 0 then begin if Piece(uLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then begin lstHeaders.Clear; hook := false; for i := 1 to uLocalReportData.Count - 1 do if hook = true then memText.Lines.Add(uLocalReportData[i]) else begin lstHeaders.Items.Add(MixedCase(uLocalReportData[i])); if Piece(uLocalReportData[i],'^',1) = '[REPORT TEXT]' then hook := true; end; end else if tvReports.Selected.Text = 'Imaging (local only)' then memText.Lines.clear else QuickCopy(uLocalReportData,memText); memText.Lines.Insert(0,' '); memText.Lines.Delete(0); end else memText.Lines.Add(uReportInstruction); if WebBrowser1.Visible = true then begin if uReportType = 'R' then uHTMLDoc := HTML_PRE + memText.Lines.Text + HTML_POST else uHTMLDoc := uHTMLPatient + memText.Lines.Text; WebBrowser1.Navigate('about:blank'); end; memText.Lines.EndUpdate; end; end; procedure TfrmReports.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string); var i, j: integer; LocalHandle, Query, Report: string; HSType, DaysBack, ExamID, MaxOcc: string; Alpha, Omega, Trans: double; begin HSType := ''; DaysBack := ''; ExamID := ''; Alpha := 0; Omega := 0; if UseVistaWeb then begin if AHDR = '1' then InfoBox('You must use VistaWeb to view this report. To use RDV Classic, change your default setting.', 'Use VistaWeb for HDR data', MB_OK); Exit; end; if AHDR = '1' then begin if HDRActive = '0' then begin InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK); Exit; end; if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then AQualifier := 'T-75000;T+75000;99999'; if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then AQualifier := 'T-75000;T+75000;99999'; end; if CharAt(AQualifier, 1) = 'd' then begin DaysBack := Copy(AQualifier, 2, Length(AQualifier)); AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3)); DaysBack := ''; end; if CharAt(AQualifier, 1) = 'T' then begin if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T'); if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T') then SetPiece(AQualifier,';',2,'T+1'); Alpha := StrToFMDateTime(Piece(AQualifier,';',1)); Omega := StrToFMDateTime(Piece(AQualifier,';',2)); if Alpha > Omega then begin Trans := Omega; Omega := Alpha; Alpha := Trans; end; MaxOcc := Piece(AQualifier,';',3); SetPiece(AHSTag,';',4,MaxOcc); end; if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier)); if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier)); with RemoteSites.SiteList do for i := 0 to Count - 1 do begin if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then begin TRemoteSite(Items[i]).Selected := true; frmFrame.lstCIRNLocations.Checked[i+2] := true; end; if TRemoteSite(Items[i]).Selected then begin TRemoteSite(Items[i]).ReportClear; if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then begin TRemoteSite(Items[i]).QueryStatus := '1^Not Included'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED'); TabControl1.OnChange(nil); continue; end; if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then begin TRemoteSite(Items[i]).QueryStatus := '1^Not Included'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED'); TabControl1.OnChange(nil); continue; end; TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';' + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType + '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' + FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR; LocalHandle := ''; Query := TRemoteSite(Items[i]).CurrentReportQuery; for j := 0 to RemoteReports.Count - 1 do begin Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report; if Report = Query then begin LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle; break; end; end; if Length(LocalHandle) > 1 then with RemoteSites.SiteList do begin GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]); TRemoteSite(Items[i]).RemoteHandle := ''; TRemoteSite(Items[i]).QueryStatus := '1^Done'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then LoadListView(TRemoteSite(Items[i]).Data); end else begin if uDirect = '1' then begin StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...'); TRemoteSite(Items[i]).QueryStatus := '1^Direct Call'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call'); DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag); if Copy(Dest[0],1,2) = '-1' then begin TRemoteSite(Items[i]).QueryStatus := '-1^Communication error'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error'); end else begin QuickCopy(Dest,TRemoteSite(Items[i]).Data); TRemoteSite(Items[i]).RemoteHandle := ''; TRemoteSite(Items[i]).QueryStatus := '1^Done'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); end; StatusText(''); end else begin RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag); if Dest[0] = '' then begin TRemoteSite(Items[i]).QueryStatus := '-1^Communication error'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error'); end else begin TRemoteSite(Items[i]).RemoteHandle := Dest[0]; TRemoteSite(Items[i]).QueryStatus := '0^initialization...'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization'); Timer1.Enabled := True; StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...'); end; end; end; end; end; end; procedure TfrmReports.FormDestroy(Sender: TObject); var i: integer; aColChange: string; begin inherited; if length(uColChange) > 0 then begin aColChange := ''; for i := 0 to lvReports.Columns.Count - 1 do aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ','; if aColChange <> piece(uColchange,'^',2) then SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange); uColChange := ''; end; RemoteQueryAbortAll; RowObjects.Free; uHSComponents.Free; uHSAll.Free; uLocalReportData.Free; uRemoteReportData.Free; uColumns.Free; uTreeStrings.Free; uEmptyImageList.Free; uECSReport.Free; if GraphForm <> nil then GraphForm.Release; end; procedure TfrmReports.lstHeadersClick(Sender: TObject); var Current, Desired: integer; begin inherited; if uFrozen = True then begin memo1.visible := False; memo1.TabStop := False; end; Current := SendMessage(memText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0); Desired := lstHeaders.ItemIEN; SendMessage(memText.Handle, EM_LINESCROLL, 0, Desired - Current - 1); end; procedure TfrmReports.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmReports.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var WebDoc: IHtmlDocument2; v: variant; begin inherited; if uHTMLDoc = '' then Exit; if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control if not Assigned(WebBrowser1.Document) then Exit; WebDoc := WebBrowser1.Document as IHtmlDocument2; v := VarArrayCreate([0, 0], varVariant); v[0] := uHTMLDoc; WebDoc.write(PSafeArray(TVarData(v).VArray)); WebDoc.close; //uHTMLDoc := ''; end; procedure TfrmReports.sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmReports.lstQualifierDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var x: string; AnImage: TBitMap; const STD_DATE = 'MMM DD,YY@HH:NN'; begin inherited; AnImage := TBitMap.Create; try with (Control as TORListBox).Canvas do { draw on control canvas, not on the form } begin x := (Control as TORListBox).Items[Index]; FillRect(Rect); { clear the rectangle } if uQualifierType = QT_IMAGING then // moved position of assignment in all case branches begin AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1'); if Piece(x, U, 4) = 'Y' then begin BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height), AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag} end; TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2)); TextOut(Rect.Left + AnImage.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3)); end else begin TextOut(Rect.Left, Rect.Top, Piece(x, U, 2)); TextOut(Rect.Left + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3)); end; end; finally AnImage.Free; end; end; procedure TfrmReports.tvReportsClick(Sender: TObject); var i,j: integer; ListItem: TListItem; aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x: string; aIFN: integer; aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aQualifierID: string; CurrentParentNode, CurrentNode: TTreeNode; begin inherited; lvReports.Hint := 'To sort, click on column headers|'; tvReports.TopItem := tvReports.Selected; uRemoteCount := 0; uReportInstruction := ''; aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading; aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote; aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType; aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier; aID := PReportTreeObject(tvReports.Selected.Data)^.ID; aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName; aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag; aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category; aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder; aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack; aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0); aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct; aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR; aStartTime := Piece(aQualifier,';',1); aStopTime := Piece(aQualifier,';',2); aMax := Piece(aQualifier,';',3); aRptCode := Piece(aQualifier,';',4); aQualifierID:= ''; if length(uColChange) > 0 then begin aColChange := ''; for i := 0 to lvReports.Columns.Count - 1 do aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ','; if aColChange <> piece(uColchange,'^',2) then SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange); uColChange := ''; end; if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then begin aReportType := 'R'; aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID)); aID := '1'; aRPC := 'ORWRP REPORT TEXT'; aHSTag := ''; end; if aReportType = '' then aReportType := 'R'; uReportRPC := aRPC; uRptID := aID; uDirect := aDirect; uReportType := aReportType; uQualifier := aQualifier; uSortOrder := aSortOrder; uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR; pnlRightTop.Height := lblTitle.Height; // see below RedrawSuspend(tvReports.Handle); RedrawSuspend(memText.Handle); uHState := aHSTag; Timer1.Enabled := False; TabControl1.Visible := false; TabControl1.TabStop := false; sptHorzRight.Visible := false; lblProcTypeMsg.Visible := FALSE; pnlRightMiddle.Visible := false; pnlProcedures.Visible := FALSE; if (aRemote = '1') or (aRemote = '2') then if not(uReportType = 'V') then if TabControl1.Tabs.Count > 1 then begin TabControl1.Visible := true; TabControl1.TabStop := true; pnlRightTop.Height := lblTitle.Height + TabControl1.Height; end; StatusText(''); uHTMLDoc := ''; WebBrowser1.Navigate('about:blank'); memText.Lines.Clear; memText.Parent := pnlRightBottom; memText.Align := alClient; UpdatingLvReports := TRUE; {lw added} tvProcedures.Items.Clear; UpdatingLvReports := FALSE; {lw added} lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lvReports.Columns.Clear; uHSComponents.Clear; DisplayHeading(''); if uReportType = 'H' then begin pnlRightMiddle.Visible := false; pnlRightBottom.Visible := true; WebBrowser1.Visible := true; WebBrowser1.TabStop := true; WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; memText.Visible := false; memText.TabStop := false; end else if uReportType = 'V' then begin with lvReports do begin RedrawSuspend(lvReports.Handle); Items.BeginUpdate; ViewStyle := vsReport; ColumnHeaders(uColumns, IntToStr(aIFN)); for i := 0 to uColumns.Count -1 do begin uNewColumn := Columns.Add; uNewColumn.Caption := piece(uColumns.Strings[i],'^',1); if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^'; if piece(uColumns.Strings[i],'^',2) = '1' then begin uNewColumn.Width := 0; uColChange := uColChange + '0,'; end else if length(piece(uColumns.Strings[i],'^',10)) > 0 then begin uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ','; uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10)) end else uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then uNewColumn.Width := 0; end; Items.EndUpdate; RedrawActivate(lvReports.Handle); end; pnlRightMiddle.Visible := true; sptHorzRight.Visible := true; WebBrowser1.Visible := false; WebBrowser1.TabStop := false; pnlRightBottom.Visible := true; memText.Visible := true; memText.TabStop := true; memText.BringToFront; RedrawActivate(memText.Handle); end else begin pnlRightMiddle.Visible := false; sptHorzRight.Visible := false; WebBrowser1.Visible := false; WebBrowser1.TabStop := false; pnlRightBottom.Visible := True; memText.Visible := true; memText.TabStop := true; memText.BringToFront; RedrawActivate(memText.Handle); end; uLocalReportData.Clear; RowObjects.Clear; uRemoteReportData.Clear; lstHeaders.Visible := false; lstHeaders.TabStop := false; lblHeaders.Visible := false; lstHeaders.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear; if uFrozen = True then begin memo1.visible := False; memo1.TabStop := False; end; Screen.Cursor := crHourGlass; if (GraphForm <> nil) and (aReportType <> 'G') then begin GraphForm.SendToBack; GraphPanel(false); GraphFormActive := false; end; if aReportType = 'G' then Graph(aIFN) else if aReportType = 'M' then begin pnlLeftBottom.Visible := false; splitter1.Visible := false; end else begin uQualifierType := StrToIntDef(aRptCode,0); case uQualifierType of QT_OTHER: begin // = 0 memText.Lines.Clear; If copy(aRptCode,1,2) = 'h0' then //HS Adhoc begin if TabControl1.TabIndex > 0 then begin InfoBox('Adhoc report is not available for remote sites', 'Information', MB_OK); TabControl1.TabIndex := 0; end; with RemoteSites.SiteList do for j := 0 to Count - 1 do begin TRemoteSite(RemoteSites.SiteList[j]).ReportClear; TRemoteSite(RemoteSites.SiteList[j]).LabClear; end; uHTMLDoc := ''; if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); ExecuteAdhoc1; //Calls Adhoc form if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memText); if WebBrowser1.Visible = true then begin if uReportType = 'R' then uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST else uHTMLDoc := uHTMLPatient + uLocalReportData.Text; WebBrowser1.Navigate('about:blank'); end; end; TabControl1.OnChange(nil); end else begin pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR); uReportInstruction := #13#10 + 'Retrieving data...'; TabControl1.OnChange(nil); LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState); memText.Lines.Assign(uLocalReportData); if uLocalReportData.Count > 0 then TabControl1.OnChange(nil); StatusText(''); end; end; QT_HSTYPE: begin // = 1 pnlLeftBottom.Visible := false; splitter1.Visible := false; end; QT_DATERANGE: begin // = 2 ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end; QT_IMAGING: begin // = 3 pnlLeftBottom.Visible := false; splitter1.Visible := false; ListImagingExams(uLocalReportData); aRadParam := ImagingParams; uQualifier := StringReplace(aRadParam, '^', ';', [rfReplaceAll]); with lvReports do begin RedrawSuspend(lvReports.Handle); Items.BeginUpdate; ViewStyle := vsReport; SmallImages := dmodShared.imgImages; CurrentParentNode := nil; CurrentNode := nil; for i := 0 to uLocalReportData.Count - 1 do begin ListItem := Items.Add; ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1); if uColumns.Count > 1 then begin for j := 2 to uColumns.Count do ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j)); // if pieces are (added to/removed from) return string, PLEASE UPDATE THIS!! (RV) if Piece(uLocalReportData[i], U, 9) = 'Y' then ListItem.SubItemImages[1] := IMG_1_IMAGE else ListItem.SubItemImages[1] := IMG_NO_IMAGES; end; LoadProceduresTreeView(uLocalReportData[i], CurrentParentNode, CurrentNode); if CurrentNode <> nil then PProcTreeObj(CurrentNode.Data)^.Associate := lvReports.Items.IndexOf(ListItem); end; if tvProcedures.Items.Count > 0 then tvProcedures.Selected := tvProcedures.Items.GetFirstNode; lblProcTypeMsg.Visible := TRUE; pnlRightTop.Height := lblTitle.Height + lblProcTypeMsg.Height; pnlLeftBottom.Visible := FALSE; pnlProcedures.Visible := TRUE; Splitter1.Visible := True; if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0; Items.EndUpdate; RedrawActivate(lvReports.Handle); tvProcedures.TopItem := tvProcedures.Selected; end; if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0; if uLocalReportData.Count > 0 then x := #13#10 + 'Select an imaging exam...' else x := #13#10 + 'No imaging reports found...'; uReportInstruction := PChar(x); memText.Lines.Add(uReportInstruction); if WebBrowser1.Visible = true then begin uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; WebBrowser1.Navigate('about:blank'); end; end; QT_NUTR: begin // = 4 lblQualifier.Caption := 'Nutritional Assessments'; pnlLeftBottom.Visible := false; splitter1.Visible := false; ListNutrAssessments(uLocalReportData); with lvReports do begin RedrawSuspend(lvReports.Handle); Items.BeginUpdate; ViewStyle := vsReport; for i := 0 to uLocalReportData.Count - 1 do begin ListItem := Items.Add; ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1); if uColumns.Count > 1 then for j := 2 to uColumns.Count do ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j)); end; if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0; Items.EndUpdate; RedrawActivate(lvReports.Handle); end; if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0; if uLocalReportData.Count > 0 then x := #13#10 + 'Select an assessment date...' else x := #13#10 + 'No nutritional assessments found...'; uReportInstruction := PChar(x); memText.Lines.Add(uReportInstruction); if WebBrowser1.Visible = true then begin uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; WebBrowser1.Navigate('about:blank'); end; end; QT_HSCOMPONENT: begin // = 5 pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2); pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); uReportInstruction := #13#10 + 'Retrieving data...'; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; RowObjects.Clear; memText.Lines.Clear; if (length(piece(aHSTag,';',2)) > 0) then begin if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); aQualifierID := lstQualifier.ItemID; if aQualifierID = '' then begin if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-75000' + ';' + 'T+75000' + '^' + 'T-75000' + ' to ' + 'T+75000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else begin GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-75000' + ';' + 'T+75000' + '^' + 'T-75000' + ' to ' + 'T+75000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); end; lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin if not (aRemote = '2' ) then GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); begin LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState); LoadListView(uLocalReportData); end; end; end else begin if (aRemote = '1') or (aRemote = '2') then if TabControl1.Tabs.Count > 1 then ShowTabControl; sptHorzRight.Visible := false; pnlRightMiddle.Visible := false; GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memText); end; TabControl1.OnChange(nil); if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memText.Lines.Add(uReportInstruction); end else begin QuickCopy(uLocalReportData,memText); TabControl1.OnChange(nil); end; end; end; StatusText(''); end; QT_HSWPCOMPONENT: begin // = 6 pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2); pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); uReportInstruction := #13#10 + 'Retrieving data...'; TabControl1.OnChange(nil); RowObjects.Clear; memText.Lines.Clear; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; if (length(piece(aHSTag,';',2)) > 0) then begin if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); aQualifierID := lstQualifier.ItemID; if aQualifierID = '' then begin if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-75000' + ';' + 'T+75000' + '^' + 'T-75000' + ' to ' + 'T+75000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else begin GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-75000' + ';' + 'T+75000' + '^' + 'T-75000' + ' to ' + 'T+75000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); end; lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); if not (aRemote = '2' ) then begin LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState); LoadListView(uLocalReportData); end; end; end else begin if (aRemote = '1') or (aRemote = '2') then ShowTabControl; sptHorzRight.Visible := false; pnlRightMiddle.Visible := false; GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR); LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memText); end; TabControl1.OnChange(nil); if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin LoadListView(uLocalReportData); end; end; StatusText(''); end; QT_PROCEDURES: begin // = 19 pnlLeftBottom.Visible := false; splitter1.Visible := false; ListProcedures(uLocalReportData); with lvReports do begin RedrawSuspend(lvReports.Handle); Items.BeginUpdate; ViewStyle := vsReport; for i := 0 to uLocalReportData.Count - 1 do begin ListItem := Items.Add; ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1); if uColumns.Count > 1 then for j := 2 to uColumns.Count do ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j)); end; if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0; Items.EndUpdate; RedrawActivate(lvReports.Handle); end; if uLocalReportData.Count > 0 then x := #13#10 + 'Select a procedure...' else x := #13#10 + 'No procedures found...'; uReportInstruction := PChar(x); if WebBrowser1.Visible = true then begin uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; WebBrowser1.Navigate('about:blank'); end; if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); end; QT_SURGERY: begin // = 28 pnlLeftBottom.Visible := false; splitter1.Visible := false; ListSurgeryReports(uLocalReportData); with lvReports do begin RedrawSuspend(lvReports.Handle); Items.BeginUpdate; ViewStyle := vsReport; for i := 0 to uLocalReportData.Count - 1 do begin ListItem := Items.Add; ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1); if uColumns.Count > 1 then for j := 2 to uColumns.Count do ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j)); end; if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0; Items.EndUpdate; RedrawActivate(lvReports.Handle); end; if uLocalReportData.Count > 0 then x := #13#10 + 'Select a surgery case...' else x := #13#10 + 'No surgery cases found...'; uReportInstruction := PChar(x); memText.Lines.Add(uReportInstruction); uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank'); end; else begin // = ? uQualifierType := QT_OTHER; pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR); uReportInstruction := #13#10 + 'Retrieving data...'; TabControl1.OnChange(nil); LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState); LoadReportText(uLocalReportData, aID, '', aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memText); end; TabControl1.OnChange(nil); StatusText(''); end; lstQualifier.Caption := lblQualifier.Caption; end; end; if not (aHDR = '1') then if aCategory <> '0' then DisplayHeading(uQualifier) else DisplayHeading(''); SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0); RedrawActivate(tvReports.Handle); if WebBrowser1.Visible = true then begin WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; end else if not GraphFormActive then begin memText.Visible := true; memText.TabStop := true; memText.BringToFront; RedrawActivate(memText.Handle); end else begin GraphPanel(true); with GraphForm do begin lstDateRange.Items := cboDateRange.Items; lstDateRange.ItemIndex := cboDateRange.ItemIndex; ViewSelections; BringToFront; end; end; Screen.Cursor := crDefault; end; procedure TfrmReports.lvReportsColumnClick(Sender: TObject; Column: TListColumn); var ClickedColumn: Integer; a1, a2: integer; s,s1,s2: string; begin inherited; a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1; a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1; ClickedColumn := Column.Index; ColumnToSort := Column.Index; SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0); SortIdx2 := 0; SortIdx3 := 0; if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0); if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0); if a1 = ColumnToSort then begin SortIdx2 := SortIdx3; SortIdx3 := 0; end; if a2 = ColumnToSort then SortIdx3 := 0; if ClickedColumn = ColumnToSort then ColumnSortForward := not ColumnSortForward else ColumnSortForward := true; ColumnToSort := ClickedColumn; uFirstSort := ColumnToSort; uSecondSort := a1; uThirdSort := a2; lvReports.Hint := ''; if ColumnSortForward = true then s := 'Sorted forward' else s := 'Sorted reverse'; s1 := piece(uColumns[uFirstSort],'^',1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' by ' + piece(s1,' ',1) + ' ' + s2; if (a1 <> uFirstSort) and (a1 > -1) then begin s1 := piece(uColumns[a1], '^', 1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2; end; if (a2 <> uFirstSort) and (a2 > -1) then begin s1 := piece(uColumns[a2], '^', 1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2; end; lvReports.Hint := s; lvReports.CustomSort(nil, 0); end; procedure TfrmReports.lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); function CompareValues(Col: Integer): integer; var ix: Integer; s1, s2: string; v1, v2: extended; d1, d2: TFMDateTime; begin inherited; if ColumnToSort = 0 then Result := CompareText(Item1.Caption,Item2.Caption) else begin ix := ColumnToSort - 1; case Col of 0: //strings begin if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '0'; if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '0'; Result := CompareText(s1,s2); end; 1: //integers begin if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '0'; if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '0'; IsValidNumber(s1, v1); IsValidNumber(s2, v2); if v1 > v2 then Result := 1 else if v1 < v2 then Result := -1 else Result := 0; end; 2: //date/times begin if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '1/1/1700'; if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '1/1/1700'; d1 := StringToFMDateTime(s1); d2 := StringToFMDateTime(s2); if d1 > d2 then Result := 1 else if d1 < d2 then Result := -1 else Result := 0; end; else Result := 0; // to make the compiler happy end; end; end; begin ColumnToSort := uFirstSort; Compare := CompareValues(SortIdx1); if Compare = 0 then begin if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then begin ColumnToSort := uSecondSort; Compare := CompareValues(SortIdx2); end; if Compare = 0 then if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then begin ColumnToSort := uThirdSort; Compare := CompareValues(SortIdx3); end; end; if not ColumnSortForward then Compare := -Compare; end; procedure TfrmReports.lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var aID, aMoreID, aSID: string; i,j,k: integer; aBasket: TStringList; aWPFlag: Boolean; begin inherited; if not selected then Exit; aBasket := TStringList.Create; uLocalReportData.Clear; aWPFlag := false; with lvReports do begin aID := Item.SubItems[0]; case uQualifierType of QT_OTHER: begin // = 0 end; QT_HSTYPE: begin // = 1 aMoreID := ';' + Item.SubItems[2]; end; QT_DATERANGE: begin // = 2 end; QT_IMAGING: begin // = 3 if lvReports.SelCount = 1 then begin memText.Lines.Clear; if not UpdatingTvProcedures then begin UpdatingLvReports := TRUE; for i := 0 to (tvProcedures.Items.Count - 1) do if PProcTreeObj(tvProcedures.Items[i].Data)^.ExamDtTm = Item.SubItems[0] then if PProcTreeObj(tvProcedures.Items[i].Data)^.ProcedureName = Item.SubItems[2] then begin if tvProcedures.Items[i].Parent <> nil then begin tvProcedures.Items[i].Parent.Expanded := True; if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '1' then lblProcTypeMsg.Caption := 'Descendent Procedure' else if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '2' then lblProcTypeMsg.Caption := 'Descendent Procedure with shared report'; end else lblProcTypeMsg.Caption := 'Standalone (single) procedure'; tvProcedures.Items[i].Selected := TRUE; end; UpdatingLvReports := False; end; end else if not UpdatingTvProcedures then tvProcedures.Selected := nil; if MemText.Lines.Count > 0 then memText.Lines.Add('==============================================================================='); aMoreID := '#' + Item.SubItems[5]; SetPiece(uRemoteType,'^',5,aID + aMoreID); LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, ''); for i := 0 to uLocalReportData.Count - 1 do MemText.Lines.Add(uLocalReportData[i]); if Item.SubItems.Count > 5 then NotifyOtherApps(NAE_REPORT, 'RA^' + aID + U + Item.SubItems[5]) else NotifyOtherApps(NAE_REPORT, 'RA^' + aID); end; QT_NUTR: begin // = 4 if lvReports.SelCount = 1 then memText.Lines.Clear; if MemText.Lines.Count > 0 then memText.Lines.Add('==============================================================================='); SetPiece(uRemoteType,'^',5,aID); LoadReportText(uLocalReportData, uRptID, aID, uReportRPC, ''); for i := 0 to uLocalReportData.Count - 1 do MemText.Lines.Add(uLocalReportData[i]); end; QT_HSWPCOMPONENT: begin // = 6 if lvReports.SelCount < 3 then begin memText.Lines.Clear; ulvSelectOn := false; end; aBasket.Clear; if (SelCount = 2) and (ulvSelectOn = false) then begin ulvSelectOn := true; for i := 0 to Items.Count - 1 do if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then begin aSID := Items[i].SubItems[0]; for j := 0 to RowObjects.ColumnList.Count - 1 do if piece(aSID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then if (TCellObject(RowObjects.ColumnList[j]).Data.Count > 0) and (TCellObject(RowObjects.ColumnList[j]).Include = '1') then begin aWPFlag := true; MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name); aBasket.Assign(TCellObject(RowObjects.ColumnList[j]).Data); for k := 0 to aBasket.Count - 1 do MemText.Lines.Add(' ' + aBasket[k]); end; if aWPFlag = true then begin memText.Lines.Add('Facility: ' + Item.Caption); memText.Lines.Add('==============================================================================='); end; end; end; aBasket.Clear; aWPFlag := false; for i := 0 to RowObjects.ColumnList.Count - 1 do if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[i]).Handle,':',1) then if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[i]).Site,';',1)) then if (TCellObject(RowObjects.ColumnList[i]).Data.Count > 0) and (TCellObject(RowObjects.ColumnList[i]).Include = '1') then begin aWPFlag := true; MemText.Lines.Add(TCellObject(RowObjects.ColumnList[i]).Name); aBasket.Assign(TCellObject(RowObjects.ColumnList[i]).Data); for j := 0 to aBasket.Count - 1 do MemText.Lines.Add(' ' + aBasket[j]); end; if aWPFlag = true then begin memText.Lines.Add('Facility: ' + Item.Caption); memText.Lines.Add('==============================================================================='); end; if uRptID = 'OR_R18:IMAGING' then if (Item.SubItems.Count > 4) and (Item.SubItems.Count > 8) then NotifyOtherApps(NAE_REPORT, 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption) else if Item.SubItems.Count > 8 then NotifyOtherApps(NAE_REPORT, 'RA^' + Item.SubItems[8] + U + U + Item.Caption) else if Item.SubItemImages[1] = 1 then begin memText.Lines.Insert(0,''); memText.Lines.Insert(1,' '); end; if uRptID = 'OR_PN:PROGRESS NOTES' then if (Item.SubItems.Count > 7) then NotifyOtherApps(NAE_REPORT, 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption); end; QT_PROCEDURES: begin // = 19 if lvReports.SelCount = 1 then memText.Lines.Clear; if MemText.Lines.Count > 0 then memText.Lines.Add('==============================================================================='); SetPiece(uRemoteType,'^',5,aID); LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, ''); for i := 0 to uLocalReportData.Count - 1 do MemText.Lines.Add(uLocalReportData[i]); end; QT_SURGERY: begin // = 28 if lvReports.SelCount = 1 then memText.Lines.Clear; if MemText.Lines.Count > 0 then memText.Lines.Add('==============================================================================='); SetPiece(uRemoteType,'^',5,aID); LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, ''); for i := 0 to uLocalReportData.Count - 1 do MemText.Lines.Add(uLocalReportData[i]); NotifyOtherApps(NAE_REPORT, 'SUR^' + aID); end; end; memText.Lines.Insert(0,' '); memText.Lines.Delete(0); end; aBasket.Free; end; procedure TfrmReports.tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmReports.tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmReports.Print1Click(Sender: TObject); begin inherited; RequestPrint; end; procedure TfrmReports.Copy1Click(Sender: TObject); var i,j: integer; line: string; ListItem: TListItem; aText: String; begin inherited; ClipBoard; aText := ''; for i := 0 to lvReports.Items.Count - 1 do if lvReports.Items[i].Selected then begin ListItem := lvReports.Items[i]; line := ''; for j := 1 to lvReports.Columns.Count - 1 do begin if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then line := line + ' ' + ListItem.SubItems[j-1]; end; if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then line := ListItem.Caption + ' ' + line; if length(aText) > 0 then aText := aText + CRLF + line else aText := line; end; ClipBoard.Clear; ClipBoard.AsText := aText; end; procedure TfrmReports.Copy2Click(Sender: TObject); begin inherited; memText.CopyToClipboard; end; procedure TfrmReports.Print2Click(Sender: TObject); begin inherited; RequestPrint; end; procedure TfrmReports.lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = 67) and (ssCtrl in Shift) then Copy1Click(Self); if (Key = 65) and (ssCtrl in Shift) then SelectAll1Click(Self); end; procedure TfrmReports.SelectAll1Click(Sender: TObject); var i: integer; begin inherited; for i := 0 to lvReports.Items.Count - 1 do lvReports.Items[i].Selected := true; end; procedure TfrmReports.SelectAll2Click(Sender: TObject); begin inherited; memText.SelectAll; end; procedure TfrmReports.tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; case Key of VK_LBUTTON, VK_RETURN, VK_SPACE: begin tvReportsClick(Sender); Key := 0; end; end; end; procedure TfrmReports.ShowTabControl; begin if TabControl1.Tabs.Count > 1 then begin TabControl1.Visible := true; TabControl1.TabStop := true; pnlRightTop.Height := lblTitle.Height + TabControl1.Height; end; end; procedure TfrmReports.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = VK_TAB) then begin if ssShift in Shift then begin FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control Key := 0; end else if ssCtrl in Shift then begin FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control Key := 0; end; end; if (key = VK_ESCAPE) then begin FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control key := 0; end; end; procedure TfrmReports.LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode); var PTO, PTO2: PProcTreeObj; begin PTO := MakeProcedureTreeObject(x); PTO2 := MakeProcedureTreeObject(x); PTO2.ProcedureName := ''; if PTO^.ParentName = '' then begin // New stand-alone CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO^.ProcedureName,PTO); CurrentNode := CurrentParentNode; end else if (CurrentParentNode <> nil) and (PTO^.ParentName = PProcTreeObj(CurrentParentNode.Data)^.ParentName) then // another child for same parent CurrentNode := tvProcedures.Items.AddChildObject(CurrentParentNode,PTO^.ProcedureName,PTO) else begin //New child and parent CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO2^.ParentName,PTO2); CurrentNode := tvProcedures.Items.AddChildObjectFirst(CurrentParentNode,PTO^.ProcedureName,PTO); end; end; procedure TfrmReports.tvProceduresCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmReports.tvProceduresExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmReports.tvProceduresClick(Sender: TObject); var Associate: Integer; SelNode: TTreeNode; begin inherited; SelNode := TTreeView(Sender).Selected; if not assigned(SelNode) then Exit; Associate := PProcTreeObj(SelNode.Data)^.Associate; lvReports.Selected := nil; if PProcTreeObj(SelNode.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone begin memText.Lines.Clear; lvReports.Selected := lvReports.Items[Associate]; if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then lblProcTypeMsg.Caption := 'Descendent Procedure' else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then lblProcTypeMsg.Caption := 'Descendent Procedure with shared report'; end else //if it is a parent with descendents if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then //printset = shared report lblProcTypeMsg.Caption := 'Descendent Procedures with shared report' else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then //examset - individual reports begin memText.Lines.Clear; lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports'; memText.Lines.Add('Descendent Procedures - Select to view individual reports...') end; end; procedure TfrmReports.tvProceduresChange(Sender: TObject; Node: TTreeNode); var Associate, i: Integer; FirstChild: TTreeNode; aID, aMoreID: string; begin inherited; if UpdatingLvReports or not assigned(Node) then Exit; UpdatingTVProcedures := TRUE; Associate := PProcTreeObj(Node.Data)^.Associate; lvReports.Selected := nil; if PProcTreeObj(Node.Data)^.ProcedureName <> '' then //if it is a descendent or a stand-alone if (Associate >= 0) and (Associate < (lvReports.Items.Count)) then // if valid associate in lvReports if lvReports.Items[Associate].Selected = FALSE then // if not already selected begin lvReports.Selected := lvReports.Items[Associate]; if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then begin lblProcTypeMsg.Caption := 'Descendent Procedure'; end else if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then lblProcTypeMsg.Caption := 'Descendent Procedures with shared report' else if PProcTreeObj(Node.Data)^.MemberOfSet = '' then lblProcTypeMsg.Caption := 'Standalone (single) procedure'; end; UpdatingTvProcedures := FALSE; if PProcTreeObj(Node.Data)^.ProcedureName = '' then //Parent with descendents if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then //printset = shared report begin lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'; FirstChild := Node.GetFirstChild; Associate := PProcTreeObj(FirstChild.Data)^.Associate; aID := lvReports.Items[Associate].SubItems[0]; aMoreID := '#' + lvReports.Items[Associate].SubItems[5]; SetPiece(uRemoteType,'^',5,aID + aMoreID); uLocalReportData.Clear; MemText.Lines.Clear; LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, ''); for i := 0 to uLocalReportData.Count - 1 do MemText.Lines.Add(uLocalReportData[i]); memText.SelStart := 0; if lvReports.Items[Associate].SubItems.Count > 5 then NotifyOtherApps(NAE_REPORT, 'RA^' + aID + U + lvReports.Items[Associate].SubItems[5]) else NotifyOtherApps(NAE_REPORT, 'RA^' + aID); end else if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then //examset - individual reports begin memText.Lines.Clear; lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports'; memText.Lines.Add('Descendent Procedures - Select to view individual reports...'); end; end; procedure TfrmReports.tvProceduresKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; case Key of VK_LBUTTON, VK_RETURN, VK_SPACE: begin tvReportsClick(Sender); Key := 0; end; end; end; procedure TfrmReports.chkDualViewsClick(Sender: TObject); begin inherited; if (GraphForm <> nil) and GraphFormActive then GraphForm.chkDualViews.Checked := chkDualViews.Checked; end; procedure TfrmReports.btnChangeViewClick(Sender: TObject); begin inherited; if (GraphForm <> nil) and GraphFormActive then begin GraphForm.btnChangeSettingsClick(GraphForm); chkDualViews.Checked := GraphForm.chkDualViews.Checked; end; end; procedure TfrmReports.btnGraphSelectionsClick(Sender: TObject); begin inherited; if (GraphForm <> nil) and GraphFormActive then begin GraphForm.btnGraphSelectionsClick(GraphForm); chkDualViews.Checked := GraphForm.chkDualViews.Checked; end; end; procedure TfrmReports.lstDateRangeClick(Sender: TObject); begin inherited; if (GraphForm <> nil) then begin GraphForm.cboDateRange.ItemIndex := lstDateRange.ItemIndex; GraphForm.cboDateRangeChange(self); lstDateRange.Items.Assign(GraphForm.cboDateRange.Items); lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex; //Exit; end; end; procedure TfrmReports.sptHorzMoved(Sender: TObject); begin inherited; pnlTopViews.Height := 80; end; end.