712 lines
23 KiB
Plaintext
712 lines
23 KiB
Plaintext
unit fGraphData;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
|
|
|
|
type
|
|
TfrmGraphData = class(TfrmBase508Form)
|
|
lblCurrent: TLabel;
|
|
lblInfo: TLabel;
|
|
lblInfoCurrent: TLabel;
|
|
lblInfoPersonal: TLabel;
|
|
lblInfoPublic: TLabel;
|
|
lblPersonal: TLabel;
|
|
lblPublic: TLabel;
|
|
pnlData: TPanel;
|
|
pnlInfo: TPanel;
|
|
btnData: TButton;
|
|
btnRefresh: TButton;
|
|
btnTesting: TButton;
|
|
memTesting: TMemo;
|
|
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormDestroy(Sender: TObject);
|
|
|
|
procedure btnDataClick(Sender: TObject);
|
|
procedure btnRefreshClick(Sender: TObject);
|
|
procedure btnTestingClick(Sender: TObject);
|
|
private
|
|
procedure ClearMemos;
|
|
procedure FillMemos;
|
|
procedure MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
|
public
|
|
procedure ClearGtsl;
|
|
procedure ClearPtData;
|
|
procedure FreeGtsl;
|
|
procedure MakeGtsl;
|
|
procedure MakeUserSettings;
|
|
procedure MakeGraphActivity;
|
|
|
|
function AllowContextChange(var WhyNot: string): Boolean;
|
|
end;
|
|
|
|
var
|
|
frmGraphData: TfrmGraphData;
|
|
GtslData: TStringList;
|
|
GtslItems: TStringList;
|
|
GtslTypes: TStringList;
|
|
GtslAllTypes: TStringList;
|
|
GtslAllViews: TStringList;
|
|
GtslTestSpec: TStringList;
|
|
GtslDrugClass: TStringList;
|
|
GtslViews: TStringList;
|
|
GtslCheck: TStringList;
|
|
GtslNonNum: TStringList;
|
|
GtslNonNumDates: TStringList;
|
|
GtslScratchSwap: TStringList;
|
|
GtslScratchTemp: TStringList;
|
|
GtslScratchLab: TStringList;
|
|
GtslSpec1: TStringList;
|
|
GtslSpec2: TStringList;
|
|
GtslSpec3: TStringList;
|
|
GtslSpec4: TStringList;
|
|
GtslMultiSpec: TStringList;
|
|
GtslTempCheck: TStringList;
|
|
GtslTemp: TStringList;
|
|
GtslSelCopyTop: TStringList;
|
|
GtslSelCopyBottom: TStringList;
|
|
GtslZoomHistoryFloat: TStringList;
|
|
GtslZoomHistoryReport: TStringList;
|
|
GtslSelPrevTopFloat: TStringList;
|
|
GtslSelPrevTopReport: TStringList;
|
|
GtslSelPrevBottomFloat: TStringList;
|
|
GtslSelPrevBottomReport: TStringList;
|
|
GtslViewPersonal: TStringList;
|
|
GtslViewPublic: TStringList;
|
|
GtslLabGroup: TStringList;
|
|
|
|
//procedure GraphDataForm; // perhaps use this to create only when displayed??
|
|
|
|
procedure GraphDataOnUser;
|
|
procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
|
|
|
function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
|
function GetCurrentSetting: string;
|
|
function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
|
function GetGraphStatus: string;
|
|
function GetOldDFN: string;
|
|
function GetPersonalSetting: string;
|
|
function GetPublicSetting: string;
|
|
function GraphPublicEditor: boolean;
|
|
function GraphTurboOn: boolean;
|
|
procedure SetCurrentSetting(aString: string);
|
|
procedure SetGraphStatus(aString: string);
|
|
procedure SetOldDFN(aString: string);
|
|
procedure SetPersonalSetting(aString: string);
|
|
procedure SetPublicSetting(aString: string);
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
uCore, rGraphs, uGraphs;
|
|
|
|
var
|
|
FGraphActivity: TGraphActivity;
|
|
|
|
{procedure GraphDataForm; // not used - perhaps with separate object for data
|
|
var
|
|
frmGraphData: TfrmGraphData;
|
|
begin
|
|
frmGraphData := TfrmGraphData.Create(Application);
|
|
try
|
|
with frmGraphData do
|
|
begin
|
|
ResizeAnchoredFormToFont(frmGraphData);
|
|
ShowModal;
|
|
end;
|
|
finally
|
|
frmGraphData.Release;
|
|
end;
|
|
end;}
|
|
|
|
procedure TfrmGraphData.FormCreate(Sender: TObject);
|
|
begin // called from fFrame after user signon
|
|
if GtslData <> nil then
|
|
exit; // only create one time
|
|
MakeGraphActivity;
|
|
MakeUserSettings;
|
|
MakeGtsl;
|
|
end;
|
|
|
|
procedure TfrmGraphData.MakeGraphActivity;
|
|
begin
|
|
FGraphActivity := TGraphActivity.Create;
|
|
with FGraphActivity do
|
|
begin
|
|
CurrentSetting := '';
|
|
OldDFN := '';
|
|
PublicSetting := '';
|
|
PersonalSetting := '';
|
|
PublicEditor := false;
|
|
Status := '';
|
|
TurboOn := true;
|
|
Cache := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmGraphData.MakeUserSettings;
|
|
var
|
|
setting, turbo: string;
|
|
aList: TStrings;
|
|
begin
|
|
aList := TStringList.Create;
|
|
FastAssign(rpcGetGraphSettings, aList);
|
|
if aList.Count > 0 then
|
|
begin
|
|
setting := aList[0];
|
|
FGraphActivity.PublicSetting := aList[1];
|
|
FGraphActivity.Cache := not (Piece(aList[2], '^', 1) = '-1');
|
|
if length(setting) > 0 then
|
|
begin // maxselectmax - system max selection limit
|
|
SetPiece(setting, '|', 8, Piece(FGraphActivity.PublicSetting, '|', 8));
|
|
turbo := Piece(FGraphActivity.PublicSetting, '|', 6);
|
|
if (turbo = '0') or (not FGraphActivity.Cache) then // deactivate users if public turbo (6th piece) is off
|
|
begin
|
|
SetPiece(setting, '|', 6, '0');
|
|
FGraphActivity.TurboOn := false;
|
|
end
|
|
else
|
|
FGraphActivity.TurboOn := true;
|
|
FGraphActivity.PersonalSetting := setting;
|
|
end
|
|
else
|
|
FGraphActivity.PersonalSetting := FGraphActivity.PublicSetting;
|
|
FGraphActivity.CurrentSetting := FGraphActivity.PersonalSetting;
|
|
FGraphActivity.PublicEditor := rpcPublicEdit; // use this as PublicEdit permission for user
|
|
end;
|
|
FreeAndNil(aList);
|
|
end;
|
|
|
|
procedure GraphDataOnUser;
|
|
var // called from fFrame after this form is created
|
|
i: integer; // gets static info
|
|
dfntype, listline: string;
|
|
begin
|
|
if GtslData = nil then
|
|
exit; // do not setup if graphing is off
|
|
FastAssign(rpcGetTypes('0', false), GtslAllTypes);
|
|
for i := 0 to GtslAllTypes.Count - 1 do // uppercase all filetypes
|
|
begin
|
|
listline := GtslAllTypes[i];
|
|
dfntype := UpperCase(Piece(listline, '^', 1));
|
|
SetPiece(listline, '^', 1, dfntype);
|
|
GtslAllTypes[i] := listline;
|
|
end;
|
|
FastAssign(rpcGetTestSpec, GtslTestSpec);
|
|
FastAssign(rpcGetViews(VIEW_PUBLIC, 0), GtslAllViews);
|
|
FastAddStrings(rpcGetViews(VIEW_PERSONAL, User.DUZ), GtslAllViews);
|
|
FastAddStrings(rpcGetViews(VIEW_LABS, User.DUZ), GtslAllViews);
|
|
end;
|
|
|
|
procedure TfrmGraphData.ClearPtData;
|
|
var // called when patient is selected
|
|
oldDFN, faststatus: string;
|
|
begin
|
|
inherited;
|
|
if FGraphActivity.CurrentSetting = '' then
|
|
exit; // if graphing is turned off, don't process
|
|
ClearMemos;
|
|
ClearGtsl;
|
|
pnlData.Hint := '';
|
|
oldDFN := FGraphActivity.OldDFN; // cleanup any previous patient cache
|
|
FastAssign(rpcGetTypes(Patient.DFN, false), GtslTypes);
|
|
faststatus := rpcFastTask(Patient.DFN, oldDFN);
|
|
FGraphActivity.Cache := (faststatus = '1');
|
|
FGraphActivity.OldDFN := Patient.DFN;
|
|
end;
|
|
|
|
procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
|
begin
|
|
// need to call this when patient is selected
|
|
end;
|
|
|
|
function TfrmGraphData.AllowContextChange(var WhyNot: string): Boolean;
|
|
begin
|
|
Result := true; // perhaps add logic in the future
|
|
end;
|
|
|
|
//----------------------------- Gtsl* are tstringlists used to hold data - global in scope
|
|
|
|
procedure TfrmGraphData.MakeGtsl;
|
|
begin
|
|
GtslData := TStringList.Create;
|
|
GtslItems := TStringList.Create;
|
|
GtslTypes := TStringList.Create;
|
|
GtslAllTypes := TStringList.Create;
|
|
GtslAllViews := TStringList.Create;
|
|
GtslTestSpec := TStringList.Create;
|
|
GtslDrugClass := TStringList.Create;
|
|
GtslViews := TStringList.Create;
|
|
GtslCheck := TStringList.Create;
|
|
GtslNonNum := TStringList.Create;
|
|
GtslNonNumDates := TStringList.Create;
|
|
GtslScratchSwap := TStringList.Create;
|
|
GtslScratchTemp := TStringList.Create;
|
|
GtslScratchLab := TStringList.Create;
|
|
GtslSpec1 := TStringList.Create;
|
|
GtslSpec2 := TStringList.Create;
|
|
GtslSpec3 := TStringList.Create;
|
|
GtslSpec4 := TStringList.Create;
|
|
GtslMultiSpec := TStringList.Create;
|
|
GtslTempCheck := TStringList.Create;
|
|
GtslTemp := TStringList.Create;
|
|
GtslSelCopyTop := TStringList.Create;
|
|
GtslSelCopyBottom := TStringList.Create;
|
|
GtslZoomHistoryFloat := TStringList.Create;
|
|
GtslZoomHistoryReport := TStringList.Create;
|
|
GtslSelPrevTopFloat := TStringList.Create;
|
|
GtslSelPrevTopReport := TStringList.Create;
|
|
GtslSelPrevBottomFloat := TStringList.Create;
|
|
GtslSelPrevBottomReport := TStringList.Create;
|
|
GtslViewPersonal := TStringList.Create;
|
|
GtslViewPublic := TStringList.Create;
|
|
GtslLabGroup := TStringList.Create;
|
|
end;
|
|
|
|
procedure TfrmGraphData.ClearGtsl;
|
|
begin
|
|
if GtslData = nil then exit;
|
|
//GtslAllTypes.Clear; // these types are not patient specific
|
|
//GtslTestSpec.Clear;
|
|
//GtslAllViews.Clear;
|
|
GtslData.Clear;
|
|
GtslItems.Clear;
|
|
GtslTypes.Clear;
|
|
GtslDrugClass.Clear;
|
|
GtslViews.Clear;
|
|
GtslCheck.Clear;
|
|
GtslNonNum.Clear;
|
|
GtslNonNumDates.Clear;
|
|
GtslScratchSwap.Clear;
|
|
GtslScratchTemp.Clear;
|
|
GtslScratchLab.Clear;
|
|
GtslSpec1.Clear;
|
|
GtslSpec2.Clear;
|
|
GtslSpec3.Clear;
|
|
GtslSpec4.Clear;
|
|
GtslMultiSpec.Clear;
|
|
GtslTempCheck.Clear;
|
|
GtslTemp.Clear;
|
|
GtslSelCopyTop.Clear;
|
|
GtslSelCopyBottom.Clear;
|
|
GtslZoomHistoryFloat.Clear;
|
|
GtslZoomHistoryReport.Clear;
|
|
GtslSelPrevTopFloat.Clear;
|
|
GtslSelPrevTopReport.Clear;
|
|
GtslSelPrevBottomFloat.Clear;
|
|
GtslSelPrevBottomReport.Clear;
|
|
GtslViewPersonal.Clear;
|
|
GtslViewPublic.Clear;
|
|
GtslLabGroup.Clear;
|
|
end;
|
|
|
|
procedure TfrmGraphData.FreeGtsl;
|
|
begin
|
|
FreeAndNil(GtslData);
|
|
FreeAndNil(GtslItems);
|
|
FreeAndNil(GtslTypes);
|
|
FreeAndNil(GtslAllTypes);
|
|
FreeAndNil(GtslAllViews);
|
|
FreeAndNil(GtslTestSpec);
|
|
FreeAndNil(GtslDrugClass);
|
|
FreeAndNil(GtslNonNum);
|
|
FreeAndNil(GtslNonNumDates);
|
|
FreeAndNil(GtslScratchSwap);
|
|
FreeAndNil(GtslScratchTemp);
|
|
FreeAndNil(GtslScratchLab);
|
|
FreeAndNil(GtslSpec1);
|
|
FreeAndNil(GtslSpec2);
|
|
FreeAndNil(GtslSpec3);
|
|
FreeAndNil(GtslSpec4);
|
|
FreeAndNil(GtslMultiSpec);
|
|
FreeAndNil(GtslTempCheck);
|
|
FreeAndNil(GtslSelCopyTop);
|
|
FreeAndNil(GtslSelCopyBottom);
|
|
FreeAndNil(GtslZoomHistoryFloat);
|
|
FreeAndNil(GtslZoomHistoryReport);
|
|
FreeAndNil(GtslSelPrevTopFloat);
|
|
FreeAndNil(GtslSelPrevTopReport);
|
|
FreeAndNil(GtslSelPrevBottomFloat);
|
|
FreeAndNil(GtslSelPrevBottomReport);
|
|
FreeAndNil(GtslViewPersonal);
|
|
FreeAndNil(GtslViewPublic);
|
|
FreeAndNil(GtslLabGroup);
|
|
end;
|
|
|
|
//----------------------------- displays when testing
|
|
|
|
procedure TfrmGraphData.btnDataClick(Sender: TObject);
|
|
var
|
|
left, top, width, height: integer;
|
|
begin
|
|
height := pnlData.Height div 8;
|
|
height := height - lblInfo.Height;
|
|
top := lblInfo.Height;
|
|
left := 1;
|
|
width := pnlData.Width - 2;
|
|
MakeMemos('GtslData', GtslData, 1, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
MakeMemos('GtslItems', GtslItems, 2, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
MakeMemos('GtslTypes', GtslTypes, 3, left, top, width, height);
|
|
width := width div 6;
|
|
top := top + height + lblInfo.Height;
|
|
left := 1;
|
|
MakeMemos('GtslAllTypes', GtslAllTypes, 4, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslTestSpec', GtslTestSpec, 5, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslDrugClass', GtslDrugClass, 6, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslViews', GtslViews, 7, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslCheck', GtslCheck, 8, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslNonNum', GtslNonNum, 9, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
left := 1;
|
|
MakeMemos('GtslNonNumDates', GtslNonNumDates, 10, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslScratchSwap', GtslScratchSwap, 11, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslScratchTemp', GtslScratchTemp, 12, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslScratchLab', GtslScratchLab, 13, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSpec1', GtslSpec1, 14, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSpec2', GtslSpec2, 15, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
left := 1;
|
|
MakeMemos('GtslSpec3', GtslSpec3, 16, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSpec4', GtslSpec4, 17, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslMultiSpec', GtslMultiSpec, 18, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslTempCheck', GtslTempCheck, 19, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslTemp', GtslTemp, 20, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSelCopyTop', GtslSelCopyTop, 21, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
left := 1;
|
|
MakeMemos('GtslSelCopyBottom', GtslSelCopyBottom, 22, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslZoomHistoryFloat', GtslZoomHistoryFloat, 23, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslZoomHistoryReport', GtslZoomHistoryReport, 24, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSelPrevTopFloat', GtslSelPrevTopFloat, 25, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSelPrevTopReport', GtslSelPrevTopReport, 26, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslSelPrevBottomFloat', GtslSelPrevBottomFloat, 27, left, top, width, height);
|
|
top := top + height + lblInfo.Height;
|
|
left := 1;
|
|
MakeMemos('GtslSelPrevBottomReport', GtslSelPrevBottomReport, 28, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslViewPersonal', GtslViewPersonal, 29, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslViewPublic', GtslViewPublic, 30, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslLabGroup', GtslLabGroup, 31, left, top, width, height);
|
|
left := left + width;
|
|
MakeMemos('GtslAllViews', GtslAllViews, 32, left, top, width, height);
|
|
btnData.Enabled := false;
|
|
btnRefresh.Enabled := true;
|
|
lblCurrent.Caption := FGraphActivity.CurrentSetting;
|
|
lblPersonal.Caption := FGraphActivity.PersonalSetting;
|
|
lblPublic.Caption := FGraphActivity.PublicSetting;
|
|
end;
|
|
|
|
procedure TfrmGraphData.btnRefreshClick(Sender: TObject);
|
|
begin
|
|
frmGraphData.WindowState := wsMaximized;
|
|
ClearMemos;
|
|
FillMemos;
|
|
end;
|
|
|
|
procedure TfrmGraphData.btnTestingClick(Sender: TObject);
|
|
begin
|
|
FastAssign(rpcTesting, memTesting.Lines);
|
|
end;
|
|
|
|
procedure TfrmGraphData.MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
|
var
|
|
aMemo: TMemo;
|
|
aLabel: TLabel;
|
|
begin
|
|
aMemo := TMemo.Create(self);
|
|
aMemo.Parent := pnlData;
|
|
aMemo.Name := 'mem' + aName;
|
|
aMemo.Tag := aTag;
|
|
aMemo.Left := left; aMemo.Top := top; aMemo.Width := width; aMemo.Height := height;
|
|
aMemo.ScrollBars := ssVertical;
|
|
aMemo.WordWrap := false;
|
|
FastAssign(aList, aMemo.Lines);
|
|
aLabel := TLabel.Create(self);
|
|
aLabel.Parent := pnlData;
|
|
aLabel.Caption := aName + ' (' + inttostr(aList.Count) + ')';
|
|
aLabel.Left := left; aLabel.Top := top - lblInfo.Height; aLabel.Width := width; aLabel.Height := lblInfo.height;
|
|
end;
|
|
|
|
procedure TfrmGraphData.ClearMemos;
|
|
var
|
|
i: integer;
|
|
ChildControl: TControl;
|
|
begin
|
|
for i := 0 to pnlData.ControlCount - 1 do
|
|
begin
|
|
ChildControl := pnlData.Controls[i];
|
|
if ChildControl is TMemo then
|
|
(ChildControl as TMemo).Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmGraphData.FillMemos;
|
|
var
|
|
i: integer;
|
|
aMemo: TMemo;
|
|
ChildControl: TControl;
|
|
begin
|
|
for i := 0 to pnlData.ControlCount - 1 do
|
|
begin
|
|
ChildControl := pnlData.Controls[i];
|
|
if ChildControl is TMemo then
|
|
begin
|
|
aMemo := (ChildControl as TMemo);
|
|
case aMemo.Tag of
|
|
1: FastAssign(GtslData, aMemo.Lines);
|
|
2: FastAssign(GtslItems, aMemo.Lines);
|
|
3: FastAssign(GtslTypes, aMemo.Lines);
|
|
4: FastAssign(GtslAllTypes, aMemo.Lines);
|
|
5: FastAssign(GtslTestSpec, aMemo.Lines);
|
|
6: FastAssign(GtslDrugClass, aMemo.Lines);
|
|
7: FastAssign(GtslViews, aMemo.Lines);
|
|
8: FastAssign(GtslCheck, aMemo.Lines);
|
|
9: FastAssign(GtslNonNum, aMemo.Lines);
|
|
10: FastAssign(GtslNonNumDates, aMemo.Lines);
|
|
11: FastAssign(GtslScratchSwap, aMemo.Lines);
|
|
12: FastAssign(GtslScratchTemp, aMemo.Lines);
|
|
13: FastAssign(GtslScratchLab, aMemo.Lines);
|
|
14: FastAssign(GtslSpec1, aMemo.Lines);
|
|
15: FastAssign(GtslSpec2, aMemo.Lines);
|
|
16: FastAssign(GtslSpec3, aMemo.Lines);
|
|
17: FastAssign(GtslSpec4, aMemo.Lines);
|
|
18: FastAssign(GtslMultiSpec, aMemo.Lines);
|
|
19: FastAssign(GtslTempCheck, aMemo.Lines);
|
|
20: FastAssign(GtslTemp, aMemo.Lines);
|
|
21: FastAssign(GtslSelCopyTop, aMemo.Lines);
|
|
22: FastAssign(GtslSelCopyBottom, aMemo.Lines);
|
|
23: FastAssign(GtslZoomHistoryFloat, aMemo.Lines);
|
|
24: FastAssign(GtslZoomHistoryReport, aMemo.Lines);
|
|
25: FastAssign(GtslSelPrevTopFloat, aMemo.Lines);
|
|
26: FastAssign(GtslSelPrevTopReport, aMemo.Lines);
|
|
27: FastAssign(GtslSelPrevBottomFloat, aMemo.Lines);
|
|
28: FastAssign(GtslSelPrevBottomReport, aMemo.Lines);
|
|
29: FastAssign(GtslViewPersonal, aMemo.Lines);
|
|
30: FastAssign(GtslViewPublic, aMemo.Lines);
|
|
31: FastAssign(GtslLabGroup, aMemo.Lines);
|
|
32: FastAssign(GtslAllViews, aMemo.Lines);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//---------------------------------------------------
|
|
|
|
function GetCurrentSetting: string;
|
|
begin
|
|
Result := FGraphActivity.CurrentSetting;
|
|
end;
|
|
|
|
function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
|
var // temporary fix - converting definitions in GtslAllViews to rpc format
|
|
allviews, fulltext: boolean;
|
|
i: integer;
|
|
vtype, aline, avtype, avc, avnum, aname, atype, aitem, partsnum, bigline: string;
|
|
//auser: string;
|
|
begin
|
|
if (userx > 0) and (userx <> User.DUZ) then
|
|
Result := rpcGetGraphProfiles(profiles, permission, ext, userx)
|
|
else
|
|
begin
|
|
profiles := UpperCase(profiles);
|
|
if permission = '1' then vtype := '-2'
|
|
else vtype := '-1';
|
|
allviews := (profiles = '1');
|
|
fulltext := (ext = 1);
|
|
partsnum := '0';
|
|
bigline := '';
|
|
GtslScratchTemp.Clear;
|
|
for i := 0 to GtslAllViews.Count - 1 do
|
|
begin
|
|
aline := GtslAllViews[i];
|
|
avtype := Piece(aline, '^', 1);
|
|
avc := Piece(aline, '^', 2);
|
|
avnum := Piece(aline, '^', 3);
|
|
aname := UpperCase(Piece(aline, '^', 4));
|
|
atype := UpperCase(Piece(aline, '^', 5));
|
|
aitem := Piece(aline, '^', 6);
|
|
//auser := Piece(aline, '^', 7);
|
|
if partsnum <> '0' then
|
|
begin //AddLine(ext, aname, atype, aitem);
|
|
if (avc = 'C') and (partsnum = avnum) then
|
|
begin
|
|
if ext <> 1 then
|
|
begin
|
|
if aitem = '0' then bigline := bigline + '0~' + atype + '~|'
|
|
else bigline := bigline + atype + '~' + aitem + '~|'
|
|
end
|
|
else
|
|
begin
|
|
if aitem = '0' then
|
|
GtslScratchTemp.Add('0^' + atype + '^' + aname)
|
|
else
|
|
GtslScratchTemp.Add(atype + '^' + aitem + '^' + aname)
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if length(bigline) > 0 then
|
|
GtslScratchTemp.Add(bigline);
|
|
break;
|
|
end;
|
|
end
|
|
else
|
|
if avtype = vtype then
|
|
begin
|
|
if allviews and (avc = 'V') then
|
|
begin
|
|
GtslScratchTemp.Add(aname);
|
|
end
|
|
else if (avc = 'V') and (aname = profiles) then
|
|
partsnum := avnum;
|
|
end;
|
|
end;
|
|
if allviews or fulltext then
|
|
MixedCaseList(GtslScratchTemp);
|
|
Result := GtslScratchTemp;
|
|
end;
|
|
end;
|
|
|
|
function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
|
var // temporary fix - converting definitions in GtslAllViews to rpc format
|
|
i: integer;
|
|
aline, avtype, avc, avnum, aname, aitem, partsnum: string;
|
|
//atype, auser: string;
|
|
begin
|
|
if (userx > 0) and (userx <> User.DUZ) then
|
|
Result := rpcATestGroup(testgroup, userx)
|
|
else
|
|
begin
|
|
partsnum := '0';
|
|
GtslScratchTemp.Clear;
|
|
for i := 0 to GtslAllViews.Count - 1 do
|
|
begin
|
|
aline := GtslAllViews[i];
|
|
avtype := Piece(aline, '^', 1);
|
|
avc := Piece(aline, '^', 2);
|
|
avnum := Piece(aline, '^', 3);
|
|
aname := Piece(aline, '^', 4);
|
|
//atype := UpperCase(Piece(aline, '^', 5));
|
|
aitem := Piece(aline, '^', 6);
|
|
//auser := Piece(aline, '^', 7);
|
|
if avtype = VIEW_LABS then
|
|
begin
|
|
if (avc = 'V') and (partsnum <> '0') then
|
|
break;
|
|
if (avc = 'C') and (partsnum = avnum) then
|
|
GtslScratchTemp.Add(aitem + '^' + aname)
|
|
else if (avc = 'V')
|
|
and (testgroup = strtointdef(Piece(aname, ')', 1), BIG_NUMBER)) then
|
|
partsnum := avnum;
|
|
end;
|
|
end;
|
|
//MixedCaseList(GtslScratchTemp);
|
|
Result := GtslScratchTemp;
|
|
end;
|
|
end;
|
|
|
|
function GetGraphStatus: string;
|
|
begin
|
|
Result := FGraphActivity.Status;
|
|
end;
|
|
|
|
function GetOldDFN: string;
|
|
begin
|
|
Result := FGraphActivity.OldDFN;
|
|
end;
|
|
|
|
function GetPersonalSetting: string;
|
|
begin
|
|
Result := FGraphActivity.PersonalSetting;
|
|
end;
|
|
|
|
function GetPublicSetting: string;
|
|
begin
|
|
Result := FGraphActivity.PublicSetting;
|
|
end;
|
|
|
|
function GraphPublicEditor: boolean;
|
|
begin
|
|
Result := FGraphActivity.PublicEditor;
|
|
end;
|
|
|
|
function GraphTurboOn: boolean;
|
|
begin
|
|
Result := (FGraphActivity.TurboOn and FGraphActivity.Cache);
|
|
end;
|
|
|
|
procedure SetCurrentSetting(aString: string);
|
|
begin
|
|
FGraphActivity.CurrentSetting := aString;
|
|
end;
|
|
|
|
procedure SetGraphStatus(aString: string);
|
|
begin
|
|
FGraphActivity.Status := aString;
|
|
end;
|
|
|
|
procedure SetOldDFN(aString: string);
|
|
begin
|
|
FGraphActivity.OldDFN := aString;
|
|
end;
|
|
|
|
procedure SetPersonalSetting(aString: string);
|
|
begin
|
|
FGraphActivity.PersonalSetting := aString;
|
|
end;
|
|
|
|
procedure SetPublicSetting(aString: string);
|
|
begin
|
|
FGraphActivity.PublicSetting := aString;
|
|
end;
|
|
//---------------------------------------------------
|
|
|
|
procedure TfrmGraphData.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
var
|
|
faststatus: string;
|
|
begin
|
|
if FGraphActivity.Cache then
|
|
begin
|
|
faststatus := rpcFastTask('0', Patient.DFN); // cleanup patient cache
|
|
if faststatus = '-1' then
|
|
FGraphActivity.Cache := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmGraphData.FormDestroy(Sender: TObject);
|
|
begin
|
|
FreeGtsl;
|
|
end;
|
|
|
|
end.
|