//kt -- Modified with SourceScanner on 8/20/2007 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, DKLang; 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 //kt Begin Mod (change Consts to Vars) 8/20/2007 TX_NOREPORT : string; //kt TX_NOREPORT_CAP : string; //kt //kt End Mod ------------------- SortIdx1, SortIdx2, SortIdx3: Integer; procedure ProcessNotifications; procedure ShowTabControl; procedure Graph(reportien: integer); procedure GraphPanel(active: boolean); procedure SetupVars; //kt 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.'; <-- original line. //kt 8/20/2007 //TX_NOREPORT_CAP = 'No Report Selected'; <-- original line. //kt 8/20/2007 HTML_PRE = '
';
  HTML_POST = CRLF + '
'; procedure TfrmReports.SetupVars; //kt Added entire function to replace constant declarations 8/20/2007 begin SetupVars; //kt added 8/20/2007 to replace constants with vars. TX_NOREPORT := DKLangConstW('fReports_No_report_is_currently_selectedx'); TX_NOREPORT_CAP := DKLangConstW('fReports_No_Report_Selected'); end; 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.'; <-- original line. //kt 8/20/2007 WhyNot := DKLangConstW('fReports_A_remote_data_query_in_progress_will_be_abortedx'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 TRemoteSite(Items[i]).QueryStatus := '-1^'+DKLangConstW('fReports_Aborted'); //kt added 8/20/2007 // UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Query Aborted'); <-- original line. //kt 8/20/2007 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, DKLangConstW('fReports_Query_Aborted')); //kt added 8/20/2007 end; Timer1.Enabled := false; Result := True; end; end; end; procedure TfrmReports.RequestPrint; begin SetupVars; //kt added 8/20/2007 to replace constants with vars. 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_There_are_no_items_to_be_printedx'), DKLangConstW('fReports_No_Items_to_Print'), MB_OK); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_Please_select_one_or_more_items_from_the_list_to_be_printedx'), DKLangConstW('fReports_No_Items_Selected'), MB_OK); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_There_are_no_items_graphedx'), DKLangConstW('fReports_No_Items_to_Print'), MB_OK); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_Please_select_from_one_of_the_Date_Range_items_before_printing'), DKLangConstW('fReports_Incomplete_Information'), MB_OK); //kt added 8/20/2007 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 := ''; <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Data_Availablex'); //kt added 8/20/2007 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'); <-- original line. //kt 8/20/2007 ShowMessage(DKLangConstW('fReports_Programmer_messagex_One_or_more_Column_IDxxs_in_file_101x24_do_not_match_IDxxs_coded_in_extract_routine')); //kt added 8/20/2007 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) <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_The_Date_Range_selected_is_greater_than_the') + CRLF + DKLangConstW('fReports_Maximum_Days_Allowed_of') + piece(uRemoteType,'^',6) //kt added 8/20/2007 // + ' for this report.', 'No Report Generated',MB_OK); <-- original line. //kt 8/20/2007 + DKLangConstW('fReports_for_this_reportx'), DKLangConstW('fReports_No_Report_Generated'),MB_OK); //kt added 8/20/2007 lstQualifier.ItemIndex := -1; exit; end; lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + // ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); <-- original line. //kt 8/20/2007 ';' + RelativeStop + U + TextOfStart + DKLangConstW('fReports_to') + TextOfStop); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_Invalid_Date_Range_enteredx_Please_try_again'),DKLangConstW('fReports_Invalid_Datextime_entry'),MB_OK); //kt added 8/20/2007 if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + // ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); <-- original line. //kt 8/20/2007 ';' + RelativeStop + U + TextOfStart + DKLangConstW('fReports_to') + TextOfStop); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_No_Report_Generatedx'),DKLangConstW('fReports_Invalid_Datextime_entry'),MB_OK); //kt added 8/20/2007 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) <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_The_Date_Range_selected_is_greater_than_the') + CRLF + DKLangConstW('fReports_Maximum_Days_Allowed_of') + piece(uRemoteType,'^',6) //kt added 8/20/2007 // + ' for this report.', 'No Report Generated',MB_OK); <-- original line. //kt 8/20/2007 + DKLangConstW('fReports_for_this_reportx'), DKLangConstW('fReports_No_Report_Generated'),MB_OK); //kt added 8/20/2007 lstQualifier.ItemIndex := -1; exit; end; //StatusText('Retrieving ' + lblTitle.Caption + '...'); <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving') + lblTitle.Caption + DKLangConstW('fReports_xxx')); //kt added 8/20/2007 Screen.Cursor := crHourGlass; //uReportInstruction := #13#10 + 'Retrieving data...'; <-- original line. //kt 8/20/2007 uReportInstruction := #13#10 + DKLangConstW('fReports_Retrieving_dataxxx'); //kt added 8/20/2007 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 := ''; <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex'); //kt added 8/20/2007 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 := ''; <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex'); //kt added 8/20/2007 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 <-- original line. //kt 8/20/2007 if InfoBox(DKLangConstW('fReports_Would_you_like_the_procedure_reason_be_included_in_the_reportx'), DKLangConstW('fReports_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES then //kt added 8/20/2007 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'); <-- original line. //kt 8/20/2007 WebBrowser1.Navigate(DKLangConstW('fReports_aboutxblank')); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 x2 := DKLangConstW('fReports_Maxxsitex') + piece(aRanges,';',2); //kt added 8/20/2007 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 + ']'; <-- original line. //kt 8/20/2007 x1 := DKLangConstW('fReports_xFromx') + ' ' + y + DKLangConstW('fReports_to') + z + ']'; //kt added 8/20/2007 end; if length(piece(aRanges,';',3)) > 0 then // x2 := ' Max/site:' + piece(aRanges,';',3); <-- original line. //kt 8/20/2007 x2 := DKLangConstW('fReports_Maxxsitex') + piece(aRanges,';',3); //kt added 8/20/2007 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 <-- original line. //kt 8/20/2007 if uRemoteReportData[0] = DKLangConstW('fReports_Report_not_available_at_this_timex') then //kt added 8/20/2007 begin fail := 1; // UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available'); <-- original line. //kt 8/20/2007 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,DKLangConstW('fReports_Report_not_available')); //kt added 8/20/2007 end; if piece(uRemoteReportData[0],'^',1) = '-1' then begin fail := 1; // UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure'); <-- original line. //kt 8/20/2007 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,DKLangConstW('fReports_Communication_failure')); //kt added 8/20/2007 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'); <-- original line. //kt 8/20/2007 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,DKLangConstW('fReports_Timed_out')); //kt added 8/20/2007 StatusText(''); TabControl1.OnChange(nil); end else // StatusText('Retrieving reports from ' <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving_reports_from') //kt added 8/20/2007 + 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)); <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Remote_data_transmission_errorx') + Piece(aStatus,'^',2)); //kt added 8/20/2007 end; if Piece(aStatus,'^',1) = '0' then // memText.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2)); <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Retrieving_dataxxx') + Piece(aStatus,'^',2)); //kt added 8/20/2007 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 <-- original line. //kt 8/20/2007 if tvReports.Selected.Text = DKLangConstW('fReports_Imaging_xlocal_onlyx') then //kt added 8/20/2007 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.', <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_You_must_use_VistaWeb_to_view_this_reportx_To_use_RDV_Classicx_change_your_default_settingx'), //kt added 8/20/2007 // 'Use VistaWeb for HDR data', MB_OK); <-- original line. //kt 8/20/2007 DKLangConstW('fReports_Use_VistaWeb_for_HDR_data'), MB_OK); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_The_HDR_is_currently_inactivex') + CRLF + DKLangConstW('fReports_Unable_to_retrieve_HDR_data_at_this_timex'), DKLangConstW('fReports_HDR_Error'), MB_OK); //kt added 8/20/2007 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|'; <-- original line. //kt 8/20/2007 lvReports.Hint := DKLangConstW('fReports_To_sortx_click_on_column_headersx'); //kt added 8/20/2007 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', <-- original line. //kt 8/20/2007 InfoBox(DKLangConstW('fReports_Adhoc_report_is_not_available_for_remote_sites'), //kt added 8/20/2007 // 'Information', MB_OK); <-- original line. //kt 8/20/2007 DKLangConstW('fReports_Information'), MB_OK); //kt added 8/20/2007 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 := '' <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex') //kt added 8/20/2007 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'); <-- original line. //kt 8/20/2007 WebBrowser1.Navigate(DKLangConstW('fReports_aboutxblank')); //kt added 8/20/2007 end; end; TabControl1.OnChange(nil); end else begin pnlLeftBottom.Visible := false; splitter1.Visible := false; // StatusText('Retrieving ' + tvReports.Selected.Text + '...'); <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving') + tvReports.Selected.Text + DKLangConstW('fReports_xxx')); //kt added 8/20/2007 GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR); // uReportInstruction := #13#10 + 'Retrieving data...'; <-- original line. //kt 8/20/2007 uReportInstruction := #13#10 + DKLangConstW('fReports_Retrieving_dataxxx'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Date_Range'); //kt added 8/20/2007 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...' <-- original line. //kt 8/20/2007 then x := #13#10 + DKLangConstW('fReports_Select_an_imaging_examxxx') //kt added 8/20/2007 // else x := #13#10 + 'No imaging reports found...'; <-- original line. //kt 8/20/2007 else x := #13#10 + DKLangConstW('fReports_No_imaging_reports_foundxxx'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Nutritional_Assessments'); //kt added 8/20/2007 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...' <-- original line. //kt 8/20/2007 then x := #13#10 + DKLangConstW('fReports_Select_an_assessment_datexxx') //kt added 8/20/2007 // else x := #13#10 + 'No nutritional assessments found...'; <-- original line. //kt 8/20/2007 else x := #13#10 + DKLangConstW('fReports_No_nutritional_assessments_foundxxx'); //kt added 8/20/2007 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 + '...'); <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving') + tvReports.Selected.Text + DKLangConstW('fReports_xxx')); //kt added 8/20/2007 // uReportInstruction := #13#10 + 'Retrieving data...'; <-- original line. //kt 8/20/2007 uReportInstruction := #13#10 + DKLangConstW('fReports_Retrieving_dataxxx'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Date_Range'); //kt added 8/20/2007 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 := '' <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex') //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Date_Range'); //kt added 8/20/2007 pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin if uLocalReportData.Count < 1 then begin // uReportInstruction := ''; <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex'); //kt added 8/20/2007 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 + '...'); <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving') + tvReports.Selected.Text + DKLangConstW('fReports_xxx')); //kt added 8/20/2007 // uReportInstruction := #13#10 + 'Retrieving data...'; <-- original line. //kt 8/20/2007 uReportInstruction := #13#10 + DKLangConstW('fReports_Retrieving_dataxxx'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Date_Range'); //kt added 8/20/2007 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 := '' <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex') //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblQualifier.Caption := DKLangConstW('fReports_Date_Range'); //kt added 8/20/2007 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...' <-- original line. //kt 8/20/2007 then x := #13#10 + DKLangConstW('fReports_Select_a_procedurexxx') //kt added 8/20/2007 // else x := #13#10 + 'No procedures found...'; <-- original line. //kt 8/20/2007 else x := #13#10 + DKLangConstW('fReports_No_procedures_foundxxx'); //kt added 8/20/2007 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...' <-- original line. //kt 8/20/2007 then x := #13#10 + DKLangConstW('fReports_Select_a_surgery_casexxx') //kt added 8/20/2007 // else x := #13#10 + 'No surgery cases found...'; <-- original line. //kt 8/20/2007 else x := #13#10 + DKLangConstW('fReports_No_surgery_cases_foundxxx'); //kt added 8/20/2007 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 + '...'); <-- original line. //kt 8/20/2007 StatusText(DKLangConstW('fReports_Retrieving') + tvReports.Selected.Text + DKLangConstW('fReports_xxx')); //kt added 8/20/2007 GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR); // uReportInstruction := #13#10 + 'Retrieving data...'; <-- original line. //kt 8/20/2007 uReportInstruction := #13#10 + DKLangConstW('fReports_Retrieving_dataxxx'); //kt added 8/20/2007 TabControl1.OnChange(nil); LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState); LoadReportText(uLocalReportData, aID, '', aRPC, uHState); if uLocalReportData.Count < 1 then // uReportInstruction := '' <-- original line. //kt 8/20/2007 uReportInstruction := DKLangConstW('fReports_xNo_Report_Availablex') //kt added 8/20/2007 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' <-- original line. //kt 8/20/2007 s := DKLangConstW('fReports_Sorted_forward') //kt added 8/20/2007 else // s := 'Sorted reverse'; <-- original line. //kt 8/20/2007 s := DKLangConstW('fReports_Sorted_reverse'); //kt added 8/20/2007 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; <-- original line. //kt 8/20/2007 s := s + DKLangConstW('fReports_by') + piece(s1,' ',1) + ' ' + s2; //kt added 8/20/2007 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; <-- original line. //kt 8/20/2007 s := s + DKLangConstW('fReports_then_by') + piece(s1,' ',1) + ' ' + s2; //kt added 8/20/2007 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; <-- original line. //kt 8/20/2007 s := s + DKLangConstW('fReports_then_by') + piece(s1,' ',1) + ' ' + s2; //kt added 8/20/2007 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' <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedure') //kt added 8/20/2007 else if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '2' then // lblProcTypeMsg.Caption := 'Descendent Procedure with shared report'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedure_with_shared_report'); //kt added 8/20/2007 end else // lblProcTypeMsg.Caption := 'Standalone (single) procedure'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Standalone_xsinglex_procedure'); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Facilityx') + Item.Caption); //kt added 8/20/2007 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); <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Facilityx') + Item.Caption); //kt added 8/20/2007 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,''); <-- original line. //kt 8/20/2007 memText.Lines.Insert(0,DKLangConstW('fReports_xImaging_links_not_active_at_this_sitex')); //kt added 8/20/2007 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' <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedure') //kt added 8/20/2007 else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then // lblProcTypeMsg.Caption := 'Descendent Procedure with shared report'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedure_with_shared_report'); //kt added 8/20/2007 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' <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedures_with_shared_report') //kt added 8/20/2007 else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then //examset - individual reports begin memText.Lines.Clear; // lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedures_x_Select_to_view_individual_reports'); //kt added 8/20/2007 // memText.Lines.Add('Descendent Procedures - Select to view individual reports...') <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Descendent_Procedures_x_Select_to_view_individual_reportsxxx')) //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedure'); //kt added 8/20/2007 end else if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then // lblProcTypeMsg.Caption := 'Descendent Procedures with shared report' <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedures_with_shared_report') //kt added 8/20/2007 else if PProcTreeObj(Node.Data)^.MemberOfSet = '' then // lblProcTypeMsg.Caption := 'Standalone (single) procedure'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Standalone_xsinglex_procedure'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedures_with_shared_report'); //kt added 8/20/2007 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'; <-- original line. //kt 8/20/2007 lblProcTypeMsg.Caption := DKLangConstW('fReports_Descendent_Procedures_x_Select_to_view_individual_reports'); //kt added 8/20/2007 // memText.Lines.Add('Descendent Procedures - Select to view individual reports...'); <-- original line. //kt 8/20/2007 memText.Lines.Add(DKLangConstW('fReports_Descendent_Procedures_x_Select_to_view_individual_reportsxxx')); //kt added 8/20/2007 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.