unit fGraphs; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ORCtrls, Menus, TeeProcs, TeEngine, Series, Chart, Math, ComCtrls, GanttCh, ClipBrd, StrUtils, ORFn, ORDtTmRng, DateUtils, Printers, OleServer, Variants, Word97, Word2000, ArrowCha, ORDtTm, uGraphs; type TfrmGraphs = class(TForm) btnChangeSettings: TButton; btnClose: TButton; btnGraphSelections: TButton; bvlBottomLeft: TBevel; bvlBottomRight: TBevel; bvlTopLeft: TBevel; bvlTopRight: TBevel; calDateRange: TORDateRangeDlg; cboDateRange: TORComboBox; chartBase: TChart; chartDatelineBottom: TChart; chartDatelineTop: TChart; chkDualViews: TCheckBox; chkItemsBottom: TCheckBox; chkItemsTop: TCheckBox; dlgDate: TORDateTimeDlg; lblDateRange: TLabel; lblViewsBottom: TOROffsetLabel; lblViewsTop: TOROffsetLabel; lstAllTypes: TListBox; lstCheck: TListBox; lstData: TListBox; lstDrugClass: TListBox; lstItems: TListBox; lstItemsTemp: TListBox; lstMultiSpec: TListBox; lstNonNumeric: TListBox; lstScratchLab: TListBox; lstScratchSwap: TListBox; lstScratchTemp: TListBox; lstSelCopyBottom: TListBox; lstSelCopyTop: TListBox; lstSpec1: TListBox; lstSpec2: TListBox; lstSpec3: TListBox; lstSpec4: TListBox; lstTemp: TListBox; lstTempCheck: TListBox; lstTestSpec: TListBox; lstTypes: TListBox; lstViews: TListBox; lstZoomHistory: TListBox; lvwItemsBottom: TListView; lvwItemsTop: TListView; mnumedsasgantt: TMenuItem; mnumedsasganttvertheight: TMenuItem; mnuPopGraph3D: TMenuItem; mnuPopGraphClear: TMenuItem; mnuPopGraphCopy: TMenuItem; mnuPopGraphDates: TMenuItem; mnuPopGraphDefineViews: TMenuItem; mnuPopGraphDetails: TMenuItem; mnuPopGraphDualViews: TMenuItem; mnuPopGraphGradient: TMenuItem; mnuPopGraphFixed: TMenuItem; mnuPopGraphHints: TMenuItem; mnuPopGraphHorizontal: TMenuItem; mnuPopGraphIsolate: TMenuItem; mnuPopGraphLegend: TMenuItem; mnuPopGraphLines: TMenuItem; mnuPopGraphPrint: TMenuItem; mnuPopGraphRemove: TMenuItem; mnuPopGraphReset: TMenuItem; mnuPopGraphSeparate1: TMenuItem; mnuPopGraphSort: TMenuItem; mnuPopGraphSplit: TMenuItem; mnuPopGraphStayOnTop: TMenuItem; mnuPopGraphStuff: TPopupMenu; mnuPopGraphSwap: TMenuItem; mnuPopGraphToday: TMenuItem; mnuPopGraphValues: TMenuItem; mnuPopGraphVertical: TMenuItem; mnuPopGraphZoomBack: TMenuItem; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; pnlBlankBottom: TPanel; pnlBlankTop: TPanel; pnlBottom: TPanel; pnlBottomRightPad: TPanel; pnlData: TPanel; pnlDatelineBottom: TPanel; pnlDatelineBottomSpacer: TORAutoPanel; pnlDatelineTop: TPanel; pnlDatelineTopSpacer: TORAutoPanel; pnlFooter: TPanel; pnlHeader: TPanel; pnlInfo: TORAutoPanel; pnlItemsBottom: TPanel; pnlItemsBottomInfo: TPanel; pnlItemsTop: TPanel; pnlItemsTopInfo: TPanel; pnlMain: TPanel; pnlScrollBottomBase: TPanel; pnlScrollTopBase: TPanel; pnlTemp: TPanel; pnlTop: TPanel; pnlTopRightPad: TPanel; scrlBottom: TScrollBox; scrlTop: TScrollBox; serDatelineBottom: TGanttSeries; serDatelineTop: TGanttSeries; splGraphs: TSplitter; splItemsBottom: TSplitter; splItemsTop: TSplitter; timHintPause: TTimer; lstSelPrevTop: TListBox; lstSelPrevBottom: TListBox; lstComp: TListBox; pnlViewsTopSpacer: TPanel; cboViewsTop: TORComboBox; pnlViewsTopSpacerRight: TPanel; pnlViewsBottomSpacer: TPanel; cboViewsBottom: TORComboBox; pnlViewsBottomSpacerRight: TPanel; testcount1: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btnCloseClick(Sender: TObject); procedure btnChangeSettingsClick(Sender: TObject); procedure btnGraphSelectionsClick(Sender: TObject); procedure chkDualViewsClick(Sender: TObject); procedure chkItemsTopClick(Sender: TObject); procedure chkItemsBottomClick(Sender: TObject); procedure mnuMedsasganttClick(Sender: TObject); procedure mnuPopGraph3DClick(Sender: TObject); procedure mnuPopGraphClearClick(Sender: TObject); procedure mnuPopGraphCopyClick(Sender: TObject); procedure mnuPopGraphDatesClick(Sender: TObject); procedure mnuPopGraphDetailsClick(Sender: TObject); procedure mnuPopGraphDualViewsClick(Sender: TObject); procedure mnuPopGraphFixedClick(Sender: TObject); procedure mnuPopGraphGradientClick(Sender: TObject); procedure mnuPopGraphHintsClick(Sender: TObject); procedure mnuPopGraphIsolateClick(Sender: TObject); procedure mnuPopGraphLegendClick(Sender: TObject); procedure mnuPopGraphLinesClick(Sender: TObject); procedure mnuPopGraphPrintClick(Sender: TObject); procedure mnuPopGraphRemoveClick(Sender: TObject); procedure mnuPopGraphResetClick(Sender: TObject); procedure mnuPopGraphSeparate1Click(Sender: TObject); procedure mnuPopGraphStayOnTopClick(Sender: TObject); procedure mnuPopGraphSortClick(Sender: TObject); procedure mnuPopGraphSplitClick(Sender: TObject); procedure mnuPopGraphStuffPopup(Sender: TObject); procedure mnuPopGraphSwapClick(Sender: TObject); procedure mnuPopGraphTodayClick(Sender: TObject); procedure mnuPopGraphValuesClick(Sender: TObject); procedure mnuPopGraphHorizontalClick(Sender: TObject); procedure mnuPopGraphVerticalClick(Sender: TObject); procedure mnuPopGraphZoomBackClick(Sender: TObject); procedure splGraphsMoved(Sender: TObject); procedure splItemsBottomMoved(Sender: TObject); procedure splItemsTopMoved(Sender: TObject); procedure GetSize; procedure SetSize; procedure lvwItemsBottomClick(Sender: TObject); procedure lvwItemsBottomColumnClick(Sender: TObject; Column: TListColumn); procedure lvwItemsBottomCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvwItemsTopClick(Sender: TObject); procedure lvwItemsTopColumnClick(Sender: TObject; Column: TListColumn); procedure lvwItemsTopCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure cboDateRangeChange(Sender: TObject); procedure cboViewsBottomChange(Sender: TObject); procedure cboViewsTopChange(Sender: TObject); procedure pnlScrollTopBaseResize(Sender: TObject); procedure chartBaseClickLegend(Sender: TCustomChart; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure chartBaseClickSeries(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure chartBaseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure chartBaseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure serDatelineTopGetMarkText(Sender: TChartSeries; ValueIndex: Integer; var MarkText: String); procedure ChartOnUndoZoom(Sender: TObject); procedure ChartOnZoom(Sender: TObject); procedure DisplayData(aSection: string); procedure HideDates(aChart: TChart); procedure SourcesDefault; procedure StayOnTop; procedure timHintPauseTimer(Sender: TObject); procedure ZoomUpdate; procedure ZoomUpdateInfo(SmallTime, BigTime: TDateTime); procedure ZoomTo(SmallTime, BigTime: TDateTime); procedure lvwItemsTopChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure lvwItemsTopKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lvwItemsBottomChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure testcount1Click(Sender: TObject); procedure cboDateRangeDropDown(Sender: TObject); procedure cboViewsTopDropDown(Sender: TObject); procedure cboViewsTopDropDownClose(Sender: TObject); procedure cboViewsBottomDropDown(Sender: TObject); procedure cboViewsBottomDropDownClose(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure lvwItemsTopEnter(Sender: TObject); procedure lvwItemsBottomEnter(Sender: TObject); procedure chkItemsBottomEnter(Sender: TObject); procedure cboViewsBottomEnter(Sender: TObject); private { Private declarations } FBSortAscending: boolean; FBSortCol: integer; FDate1: Double; FDate2: Double; FSortAscending: boolean; FSortCol: integer; FActiveGraph: TChart; FArrowKeys: boolean; FBHighTime, FBLowTime: Double; FCreate: boolean; FFirstClick: boolean; FFirstSwitch: boolean; FGraphClick: TCustomChart; FGraphSeries: TChartSeries; FGraphValueIndex: integer; FGraphSetting: TGraphSetting; FGraphType: char; FItemsSortedTop: boolean; FItemsSortedBottom: boolean; FMouseDown: boolean; FMTimestamp: string; FMToday: TFMDateTime; FMyProfiles, FProfiles: TStringList; FNonNumerics: boolean; // used with pnlItemsTop.Tag & pnlItemsBottom.Tag FOnLegend: integer; FOnSeries: integer; FOnValue: integer; FPrevEvent: string; FRetainZoom: boolean; FSources: TStrings; FSourcesDefault: TStrings; FTHighTime, FTLowTime: Double; FWarning: boolean; FX, FY: integer; FYMinValue: Double; FYMaxValue: Double; procedure AdjustTimeframe; procedure AllTypeDate(aType, aTypeName, firstline, secondline: string; aDate, aDate2: double); procedure AllDetails(aDate1, aDate2: TFMDateTime; aTempList: TStrings); procedure AssignProfile(aProfile, aSection: string); procedure AutoSelect(aListView: TListView); procedure BaseResize(aScrollBox: TScrollBox); procedure BottomAxis(aScrollBox: TScrollBox); procedure ChangeStyle; procedure ChartStyle(aChart: TChart); procedure CheckProfile(var aProfile: string; var Updated: boolean); procedure CheckToAddData(aListView: TListView; aSection, TypeToCheck: string); procedure CreatePatientHeader(var HeaderList: TStringList; PageTitle, Warning, DateRange: string); procedure DateRangeItems(oldestdate, newestdate: double; filenum: string); procedure UpdateView(filename, filenum, itemnum, aString: string; aListView: TListView); procedure DisplayType(itemtype, displayed: string); procedure FillViews; procedure FilterListView(oldestdate, newestdate: double); procedure FixedDates(var adatetime, adatetime1: TDateTime); procedure GetData(aString: string); procedure HideGraphs(action: boolean); procedure HighLow(fmtime, fmtime1: string; aChart: TChart; var adatetime, adatetime1: TDateTime); procedure InactivateHint; procedure ItemCheck(aListView: TListView; aItemName: string; var aNum: integer; var aTypeItem: string); procedure ItemsClick(Sender: TObject; aListView, aOtherListView: TListView; aCheckBox: TCheckBox; aComboBox: TORComboBox; aList: TListBox; aSection: string); procedure ItemDateRange(Sender: TCustomChart); procedure LabData(aItemType, aItemName, aSection: string); procedure LoadDateRange; procedure LoadDisplayCheck(typeofitem: string; var updated: boolean); procedure LoadType(itemtype, displayed: string); procedure NextPointerStyle(aSeries: TChartSeries; aSerCnt: integer); procedure OneDayTypeDetails(aTypeItem: string); procedure RefUnits(aItem, aSpec: string; var low, high, units: string); procedure ResetSpec(aListBox: TListBox; aItemNum, aNewItemNum, aNewItemName, aNewString: string); procedure TempCheck(typeitem: string; var levelseq: double); procedure SelCopy(aListView: TListView; aListBox: TListBox); procedure SelReset(aListbox: TListBox; aListView: TListView); procedure SelectItem(aListView: TListView; typeitem: string); procedure SetProfile(aProfile, aName: string; aListView: TListView); procedure SizeDates(aChart: TChart; aSmallTime, aBigTime: TDateTime); procedure SizeTogether(onlylines, nolines, anylines: Boolean; aScroll: TScrollBox; aChart: TChart; aPanel, aPanelBase: TPanel; portion: Double); procedure ViewsChange(aListView: TListView; aComboBox: TORComboBox; aSection: string); procedure MakeDateline(section, aTitle, aFileType: string; aChart: TChart; graphtype: integer; var bcnt, pcnt, gcnt, vcnt, acnt: integer); procedure MakeSeparate(aScrollBox: TScrollBox; aListView: TListView; aPadPanel: TPanel; section: string); procedure MakeTogether(aScrollBox: TScrollBox; aListView: TListView; aPadPanel: TPanel; section: string); procedure MakeAGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeBarSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeLineSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt, aNonCnt: integer; multiline: boolean); procedure MakeManyGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); // good one procedure MakePointSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeVisitGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeWeightedArrowSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); procedure MakeWeightedGanttSeries(aChart: TChart; aTitle, aFileType: string; var aSerCnt: integer); function BPValue(aDateTime: TDateTime): string; function DateRangeMultiItems(aOldDate, aNewDate: double; aMultiItem: string): boolean; function DCName(aDCien: string): string; function ExpandTax(profile: string): string; function FileNameX(filenum: string): string; function FMCorrectedDate(fmtime: string): string; function GraphTypeNum(aType: string): integer; function HSAbbrev(aType: string): boolean; function InvVal(value: double): double; function ItemName(filenum, itemnum: string): string; function NextColor(aCnt: integer): TColor; function PortionSize(lcnt, pcnt, gcnt, vcnt, bcnt, acnt: integer): double; function SelectRef(aRef: string): string; function StdDev(value, high, low: double): double; function TypeIsDisplayed(itemtype: string): boolean; function TypeIsLoaded(itemtype: string): boolean; function Vfactor(aTitle: string): double; function ValueText(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer): string; public { Public declarations } procedure InitialData; procedure Initialize; procedure InitialRetain; procedure LoadListView(aList: TStrings); procedure SourceContext; procedure ViewSelections; procedure SetFontSize(FontSize: integer); function FMToDateTime(FMDateTime: string): TDateTime; end; var frmGraphs: TfrmGraphs; FHintWin: THintWindow; FHintWinActive: boolean; FHintStop: boolean; implementation uses fGraphSettings, fGraphProfiles, rGraphs, ComObj, ActiveX, ShellAPI, fFrame, uCore, rCore, fRptBox, fReports, uFormMonitor; {$R *.DFM} type TGraphItem = class public Values: string; end; procedure TfrmGraphs.FormCreate(Sender: TObject); var i: integer; dfntype, listline, settings, settings1, t1, t2: string; aList: TStrings; begin FMToday := DateTimeToFMDateTime(Date); FHintWinActive := false; FHintStop := false; FNonNumerics := false; FMouseDown := false; FItemsSortedTop := false; FItemsSortedBottom := false; FRetainZoom := false; FFirstClick := true; FArrowKeys := false; FCreate := true; FGraphType := Char(32); aList := TStringList.Create; FastAssign(rpcGetGraphSettings, aList); btnClose.Tag := 0; if aList.Count < 1 then begin Screen.Cursor := crDefault; showmessage('CPRS is not configured for graphing.'); btnClose.Tag := 1; FreeAndNil(aList); Close; Exit; end; t1 := aList[0]; t2 := aList[1]; // hint are current, t1 are personal, t2 public settings if length(frmFrame.mnuToolsGraphing.Hint) > 0 then settings := frmFrame.mnuToolsGraphing.Hint else if length(t1) > 0 then settings := t1 else settings := t2; SetPiece(settings, '|', 8, Piece(t2, '|', 8)); //?????????? frmFrame.mnuToolsGraphing.Hint := settings; settings1 := Piece(settings, '|', 1); FSources := TStringList.Create; FSourcesDefault := TStringList.Create; FMyProfiles := TStringList.Create; FProfiles := TStringList.Create; FYMinValue := 0; FYMaxValue := 0; FTHighTime := 0; FTLowTime := BIG_NUMBER; FBHighTime := 0; FBLowTime := BIG_NUMBER; pnlInfo.Caption := TXT_INFO; FOnLegend := BIG_NUMBER; FOnSeries := BIG_NUMBER; FOnValue := BIG_NUMBER; FHintWin := THintWindow.Create(self); FHintWin.Color := clInfoBk; FHintWin.Canvas.Font.Color := clInfoBk; FX := 0; FY :=0; FastAssign(rpcGetTypes('0', false), lstAllTypes.Items); for i := 0 to lstAllTypes.Items.Count - 1 do begin listline := lstAllTypes.Items[i]; dfntype := UpperCase(Piece(listline, '^', 1)); SetPiece(listline, '^', 1, dfntype); lstAllTypes.Items[i] := listline; end; FGraphSetting := GraphSettingsInit(settings); for i := 0 to BIG_NUMBER do begin dfntype := Piece(settings1, ';', i); if length(dfntype) = 0 then break; listline := dfntype + '^' + FileNameX(dfntype) + '^1'; FSources.Add(listline); FSourcesDefault.Add(listline); end; serDatelineTop.Active := false; serDatelineBottom.Active := false; chartDatelineTop.Gradient.EndColor := clGradientActiveCaption; chartDatelineTop.Gradient.StartColor := clWindow; chartDatelineBottom.Gradient.EndColor := clGradientActiveCaption; chartDatelineBottom.Gradient.StartColor := clWindow; LoadDateRange; chkItemsTop.Checked := true; chkItemsBottom.Checked := true; FastAssign(rpcGetTestSpec, lstTestSpec.Items); FillViews; FreeAndNil(aList); end; procedure TfrmGraphs.SourcesDefault; var i: integer; dfntype, listline, settings, settings1, t1, t2: string; aList: TStrings; begin aList := TStringList.Create; FastAssign(rpcGetGraphSettings, aList); t1 := aList[0]; t2 := aList[1]; // t1 are personal, t2 public settings if length(frmFrame.mnuToolsGraphing.Hint) > 0 then settings := frmFrame.mnuToolsGraphing.Hint else if length(t1) > 0 then settings := t1 else settings := t2; SetPiece(settings, '|', 8, Piece(t2, '|', 8)); settings1 := Piece(settings, '|', 1); FGraphSetting := GraphSettingsInit(settings); for i := 0 to BIG_NUMBER do begin dfntype := Piece(settings1, ';', i); if length(dfntype) = 0 then break; listline := dfntype + '^' + FileNameX(dfntype) + '^1'; FSourcesDefault.Add(listline); end; FreeAndNil(aList); end; procedure TfrmGraphs.Initialize; var i: integer; rptview1, rptview2, rptviews: string; begin InitialData; SourceContext; LoadListView(lstItems.Items); if pnlMain.Tag > 0 then begin rptviews := MixedCase(rpcReportParams(pnlMain.Tag)); if length(rptviews) > 1 then begin rptview1 := Piece(rptviews, '^', 1); rptview2 := Piece(rptviews, '^', 2); if length(rptview1) > 0 then begin for i := 0 to cboViewsTop.Items.Count - 1 do if Piece(cboViewsTop.Items[i], '^', 2) = rptview1 then begin cboViewsTop.ItemIndex := i; break; end; end; if length(rptview2) > 0 then begin chkDualViews.Checked := true; chkDualViewsClick(self); for i := 0 to cboViewsBottom.Items.Count - 1 do if Piece(cboViewsBottom.Items[i], '^', 2) = rptview2 then begin cboViewsBottom.ItemIndex := i; break; end; end; end; end; if cboViewsTop.ItemIndex > -1 then cboViewsTopChange(self) else lvwItemsTopClick(self); if cboViewsBottom.ItemIndex > -1 then cboViewsbottomChange(self) else lvwItemsBottomClick(self); if pnlMain.Tag > 0 then begin pnlMain.Tag := 0; cboDateRangeChange(self); if cboViewsTop.ItemIndex > -1 then cboViewsTopChange(self) else lvwItemsTopClick(self); if cboViewsBottom.ItemIndex > -1 then cboViewsbottomChange(self) else lvwItemsBottomClick(self); end; end; procedure TfrmGraphs.InitialRetain; //var //i: integer; begin {// allview=false fullview=false noview=true go thru items if selected if view noview=false else allview=false else if view allview=false fullview=false noview=false else // if noview // if allview // if fullview // else //partial view // //} end; procedure TfrmGraphs.FillViews; var i: integer; begin with cboViewsTop do begin Items.Clear; Sorted := false; lstTemp.Sorted := true; FastAssign(rpcGetGraphProfiles('1', '0', 0), lstTemp.Items); if lstTemp.Items.Count > 0 then begin for i := 0 to lstTemp.Items.Count - 1 do Items.Add('-1^' + lstTemp.Items[i] + '^'); end; FastAssign(rpcGetGraphProfiles('1', '1', 0), lstTemp.Items); if lstTemp.Items.Count > 0 then begin Items.Add(LLS_LINE); for i := 0 to lstTemp.Items.Count - 1 do Items.Add('-2^' + lstTemp.Items[i] + '^'); end; Items.Insert(0, '^^0'); Items.Insert(1, '^