[830] | 1 | unit fGraphData;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
| 7 | Dialogs, StdCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
|
---|
| 8 |
|
---|
| 9 | type
|
---|
| 10 | TfrmGraphData = class(TfrmBase508Form)
|
---|
| 11 | lblCurrent: TLabel;
|
---|
| 12 | lblInfo: TLabel;
|
---|
| 13 | lblInfoCurrent: TLabel;
|
---|
| 14 | lblInfoPersonal: TLabel;
|
---|
| 15 | lblInfoPublic: TLabel;
|
---|
| 16 | lblPersonal: TLabel;
|
---|
| 17 | lblPublic: TLabel;
|
---|
| 18 | pnlData: TPanel;
|
---|
| 19 | pnlInfo: TPanel;
|
---|
| 20 | btnData: TButton;
|
---|
| 21 | btnRefresh: TButton;
|
---|
| 22 | btnTesting: TButton;
|
---|
| 23 | memTesting: TMemo;
|
---|
| 24 |
|
---|
| 25 | procedure FormCreate(Sender: TObject);
|
---|
| 26 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 27 | procedure FormDestroy(Sender: TObject);
|
---|
| 28 |
|
---|
| 29 | procedure btnDataClick(Sender: TObject);
|
---|
| 30 | procedure btnRefreshClick(Sender: TObject);
|
---|
| 31 | procedure btnTestingClick(Sender: TObject);
|
---|
| 32 | private
|
---|
| 33 | procedure ClearMemos;
|
---|
| 34 | procedure FillMemos;
|
---|
| 35 | procedure MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
---|
| 36 | public
|
---|
| 37 | procedure ClearGtsl;
|
---|
| 38 | procedure ClearPtData;
|
---|
| 39 | procedure FreeGtsl;
|
---|
| 40 | procedure MakeGtsl;
|
---|
| 41 | procedure MakeUserSettings;
|
---|
| 42 | procedure MakeGraphActivity;
|
---|
| 43 |
|
---|
| 44 | function AllowContextChange(var WhyNot: string): Boolean;
|
---|
| 45 | end;
|
---|
| 46 |
|
---|
| 47 | var
|
---|
| 48 | frmGraphData: TfrmGraphData;
|
---|
| 49 | GtslData: TStringList;
|
---|
| 50 | GtslItems: TStringList;
|
---|
| 51 | GtslTypes: TStringList;
|
---|
| 52 | GtslAllTypes: TStringList;
|
---|
| 53 | GtslAllViews: TStringList;
|
---|
| 54 | GtslTestSpec: TStringList;
|
---|
| 55 | GtslDrugClass: TStringList;
|
---|
| 56 | GtslViews: TStringList;
|
---|
| 57 | GtslCheck: TStringList;
|
---|
| 58 | GtslNonNum: TStringList;
|
---|
| 59 | GtslNonNumDates: TStringList;
|
---|
| 60 | GtslScratchSwap: TStringList;
|
---|
| 61 | GtslScratchTemp: TStringList;
|
---|
| 62 | GtslScratchLab: TStringList;
|
---|
| 63 | GtslSpec1: TStringList;
|
---|
| 64 | GtslSpec2: TStringList;
|
---|
| 65 | GtslSpec3: TStringList;
|
---|
| 66 | GtslSpec4: TStringList;
|
---|
| 67 | GtslMultiSpec: TStringList;
|
---|
| 68 | GtslTempCheck: TStringList;
|
---|
| 69 | GtslTemp: TStringList;
|
---|
| 70 | GtslSelCopyTop: TStringList;
|
---|
| 71 | GtslSelCopyBottom: TStringList;
|
---|
| 72 | GtslZoomHistoryFloat: TStringList;
|
---|
| 73 | GtslZoomHistoryReport: TStringList;
|
---|
| 74 | GtslSelPrevTopFloat: TStringList;
|
---|
| 75 | GtslSelPrevTopReport: TStringList;
|
---|
| 76 | GtslSelPrevBottomFloat: TStringList;
|
---|
| 77 | GtslSelPrevBottomReport: TStringList;
|
---|
| 78 | GtslViewPersonal: TStringList;
|
---|
| 79 | GtslViewPublic: TStringList;
|
---|
| 80 | GtslLabGroup: TStringList;
|
---|
| 81 |
|
---|
| 82 | //procedure GraphDataForm; // perhaps use this to create only when displayed??
|
---|
| 83 |
|
---|
| 84 | procedure GraphDataOnUser;
|
---|
| 85 | procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
---|
| 86 |
|
---|
| 87 | function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
---|
| 88 | function GetCurrentSetting: string;
|
---|
| 89 | function GetDefaultInpatientDate: string;
|
---|
| 90 | function GetDefaultOutpatientDate: string;
|
---|
| 91 | function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
---|
| 92 | function GetGraphStatus: string;
|
---|
| 93 | function GetOldDFN: string;
|
---|
| 94 | function GetPersonalSetting: string;
|
---|
| 95 | function GetPublicSetting: string;
|
---|
| 96 | function GraphPublicEditor: boolean;
|
---|
| 97 | function GraphTurboOn: boolean;
|
---|
| 98 | procedure SetCurrentSetting(aString: string);
|
---|
| 99 | procedure SetDefaultInpatientDate(aString: string);
|
---|
| 100 | procedure SetDefaultOutpatientDate(aString: string);
|
---|
| 101 | procedure SetGraphStatus(aString: string);
|
---|
| 102 | procedure SetOldDFN(aString: string);
|
---|
| 103 | procedure SetPersonalSetting(aString: string);
|
---|
| 104 | procedure SetPublicSetting(aString: string);
|
---|
| 105 |
|
---|
| 106 | implementation
|
---|
| 107 |
|
---|
| 108 | {$R *.dfm}
|
---|
| 109 |
|
---|
| 110 | uses
|
---|
| 111 | uCore, rGraphs, uGraphs;
|
---|
| 112 |
|
---|
| 113 | var
|
---|
| 114 | FGraphActivity: TGraphActivity;
|
---|
| 115 |
|
---|
| 116 | {procedure GraphDataForm; // not used - perhaps with separate object for data
|
---|
| 117 | var
|
---|
| 118 | frmGraphData: TfrmGraphData;
|
---|
| 119 | begin
|
---|
| 120 | frmGraphData := TfrmGraphData.Create(Application);
|
---|
| 121 | try
|
---|
| 122 | with frmGraphData do
|
---|
| 123 | begin
|
---|
| 124 | ResizeAnchoredFormToFont(frmGraphData);
|
---|
| 125 | ShowModal;
|
---|
| 126 | end;
|
---|
| 127 | finally
|
---|
| 128 | frmGraphData.Release;
|
---|
| 129 | end;
|
---|
| 130 | end;}
|
---|
| 131 |
|
---|
| 132 | procedure TfrmGraphData.FormCreate(Sender: TObject);
|
---|
| 133 | begin // called from fFrame after user signon
|
---|
| 134 | if GtslData <> nil then
|
---|
| 135 | exit; // only create one time
|
---|
| 136 | MakeGraphActivity;
|
---|
| 137 | MakeUserSettings;
|
---|
| 138 | MakeGtsl;
|
---|
| 139 | end;
|
---|
| 140 |
|
---|
| 141 | procedure TfrmGraphData.MakeGraphActivity;
|
---|
| 142 | begin
|
---|
| 143 | FGraphActivity := TGraphActivity.Create;
|
---|
| 144 | with FGraphActivity do
|
---|
| 145 | begin
|
---|
| 146 | CurrentSetting := '';
|
---|
| 147 | DefaultInpatientDate := '';
|
---|
| 148 | DefaultOutpatientDate := '';
|
---|
| 149 | OldDFN := '';
|
---|
| 150 | PublicSetting := '';
|
---|
| 151 | PersonalSetting := '';
|
---|
| 152 | PublicEditor := false;
|
---|
| 153 | Status := '';
|
---|
| 154 | TurboOn := true;
|
---|
| 155 | Cache := true;
|
---|
| 156 | end;
|
---|
| 157 | end;
|
---|
| 158 |
|
---|
| 159 | procedure TfrmGraphData.MakeUserSettings;
|
---|
| 160 | var
|
---|
| 161 | setting, turbo: string;
|
---|
| 162 | aList: TStrings;
|
---|
| 163 | begin
|
---|
| 164 | aList := TStringList.Create;
|
---|
| 165 | FastAssign(rpcGetGraphSettings, aList);
|
---|
| 166 | if aList.Count > 0 then
|
---|
| 167 | begin
|
---|
| 168 | setting := aList[0];
|
---|
| 169 | FGraphActivity.PublicSetting := aList[1];
|
---|
| 170 | FGraphActivity.Cache := not (Piece(aList[2], '^', 1) = '-1');
|
---|
| 171 | if length(setting) > 0 then
|
---|
| 172 | begin // maxselectmax - system max selection limit
|
---|
| 173 | SetPiece(setting, '|', 8, Piece(FGraphActivity.PublicSetting, '|', 8));
|
---|
| 174 | turbo := Piece(FGraphActivity.PublicSetting, '|', 6);
|
---|
| 175 | if (turbo = '0') or (not FGraphActivity.Cache) then // deactivate users if public turbo (6th piece) is off
|
---|
| 176 | begin
|
---|
| 177 | SetPiece(setting, '|', 6, '0');
|
---|
| 178 | FGraphActivity.TurboOn := false;
|
---|
| 179 | end
|
---|
| 180 | else
|
---|
| 181 | FGraphActivity.TurboOn := true;
|
---|
| 182 | FGraphActivity.PersonalSetting := setting;
|
---|
| 183 | end
|
---|
| 184 | else
|
---|
| 185 | FGraphActivity.PersonalSetting := FGraphActivity.PublicSetting;
|
---|
| 186 | FGraphActivity.CurrentSetting := FGraphActivity.PersonalSetting;
|
---|
| 187 | FGraphActivity.DefaultInpatientDate := Piece(FGraphActivity.PersonalSetting, '|', 10);
|
---|
| 188 | FGraphActivity.DefaultOutpatientDate := Piece(FGraphActivity.PersonalSetting, '|', 9);
|
---|
| 189 | FGraphActivity.PublicEditor := rpcPublicEdit; // use this as PublicEdit permission for user
|
---|
| 190 | end;
|
---|
| 191 | FreeAndNil(aList);
|
---|
| 192 | end;
|
---|
| 193 |
|
---|
| 194 | procedure GraphDataOnUser;
|
---|
| 195 | var // called from fFrame after this form is created
|
---|
| 196 | i: integer; // gets static info
|
---|
| 197 | dfntype, listline: string;
|
---|
| 198 | begin
|
---|
| 199 | if GtslData = nil then
|
---|
| 200 | exit; // do not setup if graphing is off
|
---|
| 201 | FastAssign(rpcGetTypes('0', false), GtslAllTypes);
|
---|
| 202 | for i := 0 to GtslAllTypes.Count - 1 do // uppercase all filetypes
|
---|
| 203 | begin
|
---|
| 204 | listline := GtslAllTypes[i];
|
---|
| 205 | dfntype := UpperCase(Piece(listline, '^', 1));
|
---|
| 206 | SetPiece(listline, '^', 1, dfntype);
|
---|
| 207 | GtslAllTypes[i] := listline;
|
---|
| 208 | end;
|
---|
| 209 | FastAssign(rpcGetTestSpec, GtslTestSpec);
|
---|
| 210 | FastAssign(rpcGetViews(VIEW_PUBLIC, 0), GtslAllViews);
|
---|
| 211 | FastAddStrings(rpcGetViews(VIEW_PERSONAL, User.DUZ), GtslAllViews);
|
---|
| 212 | FastAddStrings(rpcGetViews(VIEW_LABS, User.DUZ), GtslAllViews);
|
---|
| 213 | end;
|
---|
| 214 |
|
---|
| 215 | procedure TfrmGraphData.ClearPtData;
|
---|
| 216 | var // called when patient is selected
|
---|
| 217 | oldDFN, faststatus: string;
|
---|
| 218 | begin
|
---|
| 219 | inherited;
|
---|
| 220 | if FGraphActivity.CurrentSetting = '' then
|
---|
| 221 | exit; // if graphing is turned off, don't process
|
---|
| 222 | ClearMemos;
|
---|
| 223 | ClearGtsl;
|
---|
| 224 | oldDFN := FGraphActivity.OldDFN; // cleanup any previous patient cache
|
---|
| 225 | FastAssign(rpcGetTypes(Patient.DFN, false), GtslTypes);
|
---|
| 226 | faststatus := rpcFastTask(Patient.DFN, oldDFN);
|
---|
| 227 | FGraphActivity.Cache := (faststatus = '1');
|
---|
| 228 | FGraphActivity.OldDFN := Patient.DFN;
|
---|
| 229 | end;
|
---|
| 230 |
|
---|
| 231 | procedure GraphDataOnPatient(var allitems, alldata: boolean);
|
---|
| 232 | begin
|
---|
| 233 | // need to call this when patient is selected
|
---|
| 234 | end;
|
---|
| 235 |
|
---|
| 236 | function TfrmGraphData.AllowContextChange(var WhyNot: string): Boolean;
|
---|
| 237 | begin
|
---|
| 238 | Result := true; // perhaps add logic in the future
|
---|
| 239 | end;
|
---|
| 240 |
|
---|
| 241 | //----------------------------- Gtsl* are tstringlists used to hold data - global in scope
|
---|
| 242 |
|
---|
| 243 | procedure TfrmGraphData.MakeGtsl;
|
---|
| 244 | begin
|
---|
| 245 | GtslData := TStringList.Create;
|
---|
| 246 | GtslItems := TStringList.Create;
|
---|
| 247 | GtslTypes := TStringList.Create;
|
---|
| 248 | GtslAllTypes := TStringList.Create;
|
---|
| 249 | GtslAllViews := TStringList.Create;
|
---|
| 250 | GtslTestSpec := TStringList.Create;
|
---|
| 251 | GtslDrugClass := TStringList.Create;
|
---|
| 252 | GtslViews := TStringList.Create;
|
---|
| 253 | GtslCheck := TStringList.Create;
|
---|
| 254 | GtslNonNum := TStringList.Create;
|
---|
| 255 | GtslNonNumDates := TStringList.Create;
|
---|
| 256 | GtslScratchSwap := TStringList.Create;
|
---|
| 257 | GtslScratchTemp := TStringList.Create;
|
---|
| 258 | GtslScratchLab := TStringList.Create;
|
---|
| 259 | GtslSpec1 := TStringList.Create;
|
---|
| 260 | GtslSpec2 := TStringList.Create;
|
---|
| 261 | GtslSpec3 := TStringList.Create;
|
---|
| 262 | GtslSpec4 := TStringList.Create;
|
---|
| 263 | GtslMultiSpec := TStringList.Create;
|
---|
| 264 | GtslTempCheck := TStringList.Create;
|
---|
| 265 | GtslTemp := TStringList.Create;
|
---|
| 266 | GtslSelCopyTop := TStringList.Create;
|
---|
| 267 | GtslSelCopyBottom := TStringList.Create;
|
---|
| 268 | GtslZoomHistoryFloat := TStringList.Create;
|
---|
| 269 | GtslZoomHistoryReport := TStringList.Create;
|
---|
| 270 | GtslSelPrevTopFloat := TStringList.Create;
|
---|
| 271 | GtslSelPrevTopReport := TStringList.Create;
|
---|
| 272 | GtslSelPrevBottomFloat := TStringList.Create;
|
---|
| 273 | GtslSelPrevBottomReport := TStringList.Create;
|
---|
| 274 | GtslViewPersonal := TStringList.Create;
|
---|
| 275 | GtslViewPublic := TStringList.Create;
|
---|
| 276 | GtslLabGroup := TStringList.Create;
|
---|
| 277 | end;
|
---|
| 278 |
|
---|
| 279 | procedure TfrmGraphData.ClearGtsl;
|
---|
| 280 | begin
|
---|
| 281 | if GtslData = nil then exit;
|
---|
| 282 | //GtslAllTypes.Clear; // these types are not patient specific
|
---|
| 283 | //GtslTestSpec.Clear;
|
---|
| 284 | //GtslAllViews.Clear;
|
---|
| 285 | GtslData.Clear;
|
---|
| 286 | GtslItems.Clear;
|
---|
| 287 | GtslTypes.Clear;
|
---|
| 288 | GtslDrugClass.Clear;
|
---|
| 289 | GtslViews.Clear;
|
---|
| 290 | GtslCheck.Clear;
|
---|
| 291 | GtslNonNum.Clear;
|
---|
| 292 | GtslNonNumDates.Clear;
|
---|
| 293 | GtslScratchSwap.Clear;
|
---|
| 294 | GtslScratchTemp.Clear;
|
---|
| 295 | GtslScratchLab.Clear;
|
---|
| 296 | GtslSpec1.Clear;
|
---|
| 297 | GtslSpec2.Clear;
|
---|
| 298 | GtslSpec3.Clear;
|
---|
| 299 | GtslSpec4.Clear;
|
---|
| 300 | GtslMultiSpec.Clear;
|
---|
| 301 | GtslTempCheck.Clear;
|
---|
| 302 | GtslTemp.Clear;
|
---|
| 303 | GtslSelCopyTop.Clear;
|
---|
| 304 | GtslSelCopyBottom.Clear;
|
---|
| 305 | GtslZoomHistoryFloat.Clear;
|
---|
| 306 | GtslZoomHistoryReport.Clear;
|
---|
| 307 | GtslSelPrevTopFloat.Clear;
|
---|
| 308 | GtslSelPrevTopReport.Clear;
|
---|
| 309 | GtslSelPrevBottomFloat.Clear;
|
---|
| 310 | GtslSelPrevBottomReport.Clear;
|
---|
| 311 | GtslViewPersonal.Clear;
|
---|
| 312 | GtslViewPublic.Clear;
|
---|
| 313 | GtslLabGroup.Clear;
|
---|
| 314 | end;
|
---|
| 315 |
|
---|
| 316 | procedure TfrmGraphData.FreeGtsl;
|
---|
| 317 | begin
|
---|
| 318 | FreeAndNil(GtslData);
|
---|
| 319 | FreeAndNil(GtslItems);
|
---|
| 320 | FreeAndNil(GtslTypes);
|
---|
| 321 | FreeAndNil(GtslAllTypes);
|
---|
| 322 | FreeAndNil(GtslAllViews);
|
---|
| 323 | FreeAndNil(GtslTestSpec);
|
---|
| 324 | FreeAndNil(GtslDrugClass);
|
---|
| 325 | FreeAndNil(GtslNonNum);
|
---|
| 326 | FreeAndNil(GtslNonNumDates);
|
---|
| 327 | FreeAndNil(GtslScratchSwap);
|
---|
| 328 | FreeAndNil(GtslScratchTemp);
|
---|
| 329 | FreeAndNil(GtslScratchLab);
|
---|
| 330 | FreeAndNil(GtslSpec1);
|
---|
| 331 | FreeAndNil(GtslSpec2);
|
---|
| 332 | FreeAndNil(GtslSpec3);
|
---|
| 333 | FreeAndNil(GtslSpec4);
|
---|
| 334 | FreeAndNil(GtslMultiSpec);
|
---|
| 335 | FreeAndNil(GtslTempCheck);
|
---|
| 336 | FreeAndNil(GtslSelCopyTop);
|
---|
| 337 | FreeAndNil(GtslSelCopyBottom);
|
---|
| 338 | FreeAndNil(GtslZoomHistoryFloat);
|
---|
| 339 | FreeAndNil(GtslZoomHistoryReport);
|
---|
| 340 | FreeAndNil(GtslSelPrevTopFloat);
|
---|
| 341 | FreeAndNil(GtslSelPrevTopReport);
|
---|
| 342 | FreeAndNil(GtslSelPrevBottomFloat);
|
---|
| 343 | FreeAndNil(GtslSelPrevBottomReport);
|
---|
| 344 | FreeAndNil(GtslViewPersonal);
|
---|
| 345 | FreeAndNil(GtslViewPublic);
|
---|
| 346 | FreeAndNil(GtslLabGroup);
|
---|
| 347 | end;
|
---|
| 348 |
|
---|
| 349 | //----------------------------- displays when testing
|
---|
| 350 |
|
---|
| 351 | procedure TfrmGraphData.btnDataClick(Sender: TObject);
|
---|
| 352 | var
|
---|
| 353 | left, top, width, height: integer;
|
---|
| 354 | begin
|
---|
| 355 | height := pnlData.Height div 8;
|
---|
| 356 | height := height - lblInfo.Height;
|
---|
| 357 | top := lblInfo.Height;
|
---|
| 358 | left := 1;
|
---|
| 359 | width := pnlData.Width - 2;
|
---|
| 360 | MakeMemos('GtslData', GtslData, 1, left, top, width, height);
|
---|
| 361 | top := top + height + lblInfo.Height;
|
---|
| 362 | MakeMemos('GtslItems', GtslItems, 2, left, top, width, height);
|
---|
| 363 | top := top + height + lblInfo.Height;
|
---|
| 364 | MakeMemos('GtslTypes', GtslTypes, 3, left, top, width, height);
|
---|
| 365 | width := width div 6;
|
---|
| 366 | top := top + height + lblInfo.Height;
|
---|
| 367 | left := 1;
|
---|
| 368 | MakeMemos('GtslAllTypes', GtslAllTypes, 4, left, top, width, height);
|
---|
| 369 | left := left + width;
|
---|
| 370 | MakeMemos('GtslTestSpec', GtslTestSpec, 5, left, top, width, height);
|
---|
| 371 | left := left + width;
|
---|
| 372 | MakeMemos('GtslDrugClass', GtslDrugClass, 6, left, top, width, height);
|
---|
| 373 | left := left + width;
|
---|
| 374 | MakeMemos('GtslViews', GtslViews, 7, left, top, width, height);
|
---|
| 375 | left := left + width;
|
---|
| 376 | MakeMemos('GtslCheck', GtslCheck, 8, left, top, width, height);
|
---|
| 377 | left := left + width;
|
---|
| 378 | MakeMemos('GtslNonNum', GtslNonNum, 9, left, top, width, height);
|
---|
| 379 | top := top + height + lblInfo.Height;
|
---|
| 380 | left := 1;
|
---|
| 381 | MakeMemos('GtslNonNumDates', GtslNonNumDates, 10, left, top, width, height);
|
---|
| 382 | left := left + width;
|
---|
| 383 | MakeMemos('GtslScratchSwap', GtslScratchSwap, 11, left, top, width, height);
|
---|
| 384 | left := left + width;
|
---|
| 385 | MakeMemos('GtslScratchTemp', GtslScratchTemp, 12, left, top, width, height);
|
---|
| 386 | left := left + width;
|
---|
| 387 | MakeMemos('GtslScratchLab', GtslScratchLab, 13, left, top, width, height);
|
---|
| 388 | left := left + width;
|
---|
| 389 | MakeMemos('GtslSpec1', GtslSpec1, 14, left, top, width, height);
|
---|
| 390 | left := left + width;
|
---|
| 391 | MakeMemos('GtslSpec2', GtslSpec2, 15, left, top, width, height);
|
---|
| 392 | top := top + height + lblInfo.Height;
|
---|
| 393 | left := 1;
|
---|
| 394 | MakeMemos('GtslSpec3', GtslSpec3, 16, left, top, width, height);
|
---|
| 395 | left := left + width;
|
---|
| 396 | MakeMemos('GtslSpec4', GtslSpec4, 17, left, top, width, height);
|
---|
| 397 | left := left + width;
|
---|
| 398 | MakeMemos('GtslMultiSpec', GtslMultiSpec, 18, left, top, width, height);
|
---|
| 399 | left := left + width;
|
---|
| 400 | MakeMemos('GtslTempCheck', GtslTempCheck, 19, left, top, width, height);
|
---|
| 401 | left := left + width;
|
---|
| 402 | MakeMemos('GtslTemp', GtslTemp, 20, left, top, width, height);
|
---|
| 403 | left := left + width;
|
---|
| 404 | MakeMemos('GtslSelCopyTop', GtslSelCopyTop, 21, left, top, width, height);
|
---|
| 405 | top := top + height + lblInfo.Height;
|
---|
| 406 | left := 1;
|
---|
| 407 | MakeMemos('GtslSelCopyBottom', GtslSelCopyBottom, 22, left, top, width, height);
|
---|
| 408 | left := left + width;
|
---|
| 409 | MakeMemos('GtslZoomHistoryFloat', GtslZoomHistoryFloat, 23, left, top, width, height);
|
---|
| 410 | left := left + width;
|
---|
| 411 | MakeMemos('GtslZoomHistoryReport', GtslZoomHistoryReport, 24, left, top, width, height);
|
---|
| 412 | left := left + width;
|
---|
| 413 | MakeMemos('GtslSelPrevTopFloat', GtslSelPrevTopFloat, 25, left, top, width, height);
|
---|
| 414 | left := left + width;
|
---|
| 415 | MakeMemos('GtslSelPrevTopReport', GtslSelPrevTopReport, 26, left, top, width, height);
|
---|
| 416 | left := left + width;
|
---|
| 417 | MakeMemos('GtslSelPrevBottomFloat', GtslSelPrevBottomFloat, 27, left, top, width, height);
|
---|
| 418 | top := top + height + lblInfo.Height;
|
---|
| 419 | left := 1;
|
---|
| 420 | MakeMemos('GtslSelPrevBottomReport', GtslSelPrevBottomReport, 28, left, top, width, height);
|
---|
| 421 | left := left + width;
|
---|
| 422 | MakeMemos('GtslViewPersonal', GtslViewPersonal, 29, left, top, width, height);
|
---|
| 423 | left := left + width;
|
---|
| 424 | MakeMemos('GtslViewPublic', GtslViewPublic, 30, left, top, width, height);
|
---|
| 425 | left := left + width;
|
---|
| 426 | MakeMemos('GtslLabGroup', GtslLabGroup, 31, left, top, width, height);
|
---|
| 427 | left := left + width;
|
---|
| 428 | MakeMemos('GtslAllViews', GtslAllViews, 32, left, top, width, height);
|
---|
| 429 | btnData.Enabled := false;
|
---|
| 430 | btnRefresh.Enabled := true;
|
---|
| 431 | lblCurrent.Caption := FGraphActivity.CurrentSetting;
|
---|
| 432 | lblPersonal.Caption := FGraphActivity.PersonalSetting;
|
---|
| 433 | lblPublic.Caption := FGraphActivity.PublicSetting;
|
---|
| 434 | end;
|
---|
| 435 |
|
---|
| 436 | procedure TfrmGraphData.btnRefreshClick(Sender: TObject);
|
---|
| 437 | begin
|
---|
| 438 | ClearMemos;
|
---|
| 439 | FillMemos;
|
---|
| 440 | end;
|
---|
| 441 |
|
---|
| 442 | procedure TfrmGraphData.btnTestingClick(Sender: TObject);
|
---|
| 443 | begin
|
---|
| 444 | FastAssign(rpcTesting, memTesting.Lines);
|
---|
| 445 | end;
|
---|
| 446 |
|
---|
| 447 | procedure TfrmGraphData.MakeMemos(aName: string; aList: TStrings; aTag, left, top, width, height: integer);
|
---|
| 448 | var
|
---|
| 449 | aMemo: TMemo;
|
---|
| 450 | aLabel: TLabel;
|
---|
| 451 | begin
|
---|
| 452 | aMemo := TMemo.Create(self);
|
---|
| 453 | aMemo.Parent := pnlData;
|
---|
| 454 | aMemo.Name := 'mem' + aName;
|
---|
| 455 | aMemo.Tag := aTag;
|
---|
| 456 | aMemo.Left := left; aMemo.Top := top; aMemo.Width := width; aMemo.Height := height;
|
---|
| 457 | aMemo.ScrollBars := ssVertical;
|
---|
| 458 | aMemo.WordWrap := false;
|
---|
| 459 | FastAssign(aList, aMemo.Lines);
|
---|
| 460 | aLabel := TLabel.Create(self);
|
---|
| 461 | aLabel.Parent := pnlData;
|
---|
| 462 | aLabel.Caption := aName + ' (' + inttostr(aList.Count) + ')';
|
---|
| 463 | aLabel.Left := left; aLabel.Top := top - lblInfo.Height; aLabel.Width := width; aLabel.Height := lblInfo.height;
|
---|
| 464 | end;
|
---|
| 465 |
|
---|
| 466 | procedure TfrmGraphData.ClearMemos;
|
---|
| 467 | var
|
---|
| 468 | i: integer;
|
---|
| 469 | ChildControl: TControl;
|
---|
| 470 | begin
|
---|
| 471 | for i := 0 to pnlData.ControlCount - 1 do
|
---|
| 472 | begin
|
---|
| 473 | ChildControl := pnlData.Controls[i];
|
---|
| 474 | if ChildControl is TMemo then
|
---|
| 475 | (ChildControl as TMemo).Clear;
|
---|
| 476 | end;
|
---|
| 477 | end;
|
---|
| 478 |
|
---|
| 479 | procedure TfrmGraphData.FillMemos;
|
---|
| 480 | var
|
---|
| 481 | i: integer;
|
---|
| 482 | aMemo: TMemo;
|
---|
| 483 | ChildControl: TControl;
|
---|
| 484 | begin
|
---|
| 485 | for i := 0 to pnlData.ControlCount - 1 do
|
---|
| 486 | begin
|
---|
| 487 | ChildControl := pnlData.Controls[i];
|
---|
| 488 | if ChildControl is TMemo then
|
---|
| 489 | begin
|
---|
| 490 | aMemo := (ChildControl as TMemo);
|
---|
| 491 | case aMemo.Tag of
|
---|
| 492 | 1: FastAssign(GtslData, aMemo.Lines);
|
---|
| 493 | 2: FastAssign(GtslItems, aMemo.Lines);
|
---|
| 494 | 3: FastAssign(GtslTypes, aMemo.Lines);
|
---|
| 495 | 4: FastAssign(GtslAllTypes, aMemo.Lines);
|
---|
| 496 | 5: FastAssign(GtslTestSpec, aMemo.Lines);
|
---|
| 497 | 6: FastAssign(GtslDrugClass, aMemo.Lines);
|
---|
| 498 | 7: FastAssign(GtslViews, aMemo.Lines);
|
---|
| 499 | 8: FastAssign(GtslCheck, aMemo.Lines);
|
---|
| 500 | 9: FastAssign(GtslNonNum, aMemo.Lines);
|
---|
| 501 | 10: FastAssign(GtslNonNumDates, aMemo.Lines);
|
---|
| 502 | 11: FastAssign(GtslScratchSwap, aMemo.Lines);
|
---|
| 503 | 12: FastAssign(GtslScratchTemp, aMemo.Lines);
|
---|
| 504 | 13: FastAssign(GtslScratchLab, aMemo.Lines);
|
---|
| 505 | 14: FastAssign(GtslSpec1, aMemo.Lines);
|
---|
| 506 | 15: FastAssign(GtslSpec2, aMemo.Lines);
|
---|
| 507 | 16: FastAssign(GtslSpec3, aMemo.Lines);
|
---|
| 508 | 17: FastAssign(GtslSpec4, aMemo.Lines);
|
---|
| 509 | 18: FastAssign(GtslMultiSpec, aMemo.Lines);
|
---|
| 510 | 19: FastAssign(GtslTempCheck, aMemo.Lines);
|
---|
| 511 | 20: FastAssign(GtslTemp, aMemo.Lines);
|
---|
| 512 | 21: FastAssign(GtslSelCopyTop, aMemo.Lines);
|
---|
| 513 | 22: FastAssign(GtslSelCopyBottom, aMemo.Lines);
|
---|
| 514 | 23: FastAssign(GtslZoomHistoryFloat, aMemo.Lines);
|
---|
| 515 | 24: FastAssign(GtslZoomHistoryReport, aMemo.Lines);
|
---|
| 516 | 25: FastAssign(GtslSelPrevTopFloat, aMemo.Lines);
|
---|
| 517 | 26: FastAssign(GtslSelPrevTopReport, aMemo.Lines);
|
---|
| 518 | 27: FastAssign(GtslSelPrevBottomFloat, aMemo.Lines);
|
---|
| 519 | 28: FastAssign(GtslSelPrevBottomReport, aMemo.Lines);
|
---|
| 520 | 29: FastAssign(GtslViewPersonal, aMemo.Lines);
|
---|
| 521 | 30: FastAssign(GtslViewPublic, aMemo.Lines);
|
---|
| 522 | 31: FastAssign(GtslLabGroup, aMemo.Lines);
|
---|
| 523 | 32: FastAssign(GtslAllViews, aMemo.Lines);
|
---|
| 524 | end;
|
---|
| 525 | end;
|
---|
| 526 | end;
|
---|
| 527 | end;
|
---|
| 528 |
|
---|
| 529 | //---------------------------------------------------
|
---|
| 530 |
|
---|
| 531 | function GetCurrentSetting: string;
|
---|
| 532 | begin
|
---|
| 533 | Result := FGraphActivity.CurrentSetting;
|
---|
| 534 | end;
|
---|
| 535 |
|
---|
| 536 | function GetDefaultInpatientDate: string;
|
---|
| 537 | begin
|
---|
| 538 | Result := FGraphActivity.DefaultInpatientDate;
|
---|
| 539 | end;
|
---|
| 540 |
|
---|
| 541 | function GetDefaultOutpatientDate: string;
|
---|
| 542 | begin
|
---|
| 543 | Result := FGraphActivity.DefaultOutpatientDate;
|
---|
| 544 | end;
|
---|
| 545 |
|
---|
| 546 | function GetGraphProfiles(profiles, permission: string; ext: integer; userx: int64): TStrings;
|
---|
| 547 | var // temporary fix - converting definitions in GtslAllViews to rpc format
|
---|
| 548 | allviews, fulltext: boolean;
|
---|
| 549 | i: integer;
|
---|
| 550 | vtype, aline, avtype, avc, avnum, aname, atype, aitem, partsnum, bigline: string;
|
---|
| 551 | //auser: string;
|
---|
| 552 | begin
|
---|
| 553 | if (userx > 0) and (userx <> User.DUZ) then
|
---|
| 554 | Result := rpcGetGraphProfiles(profiles, permission, ext, userx)
|
---|
| 555 | else
|
---|
| 556 | begin
|
---|
| 557 | profiles := UpperCase(profiles);
|
---|
| 558 | if permission = '1' then vtype := '-2'
|
---|
| 559 | else vtype := '-1';
|
---|
| 560 | allviews := (profiles = '1');
|
---|
| 561 | fulltext := (ext = 1);
|
---|
| 562 | partsnum := '0';
|
---|
| 563 | bigline := '';
|
---|
| 564 | GtslScratchTemp.Clear;
|
---|
| 565 | for i := 0 to GtslAllViews.Count - 1 do
|
---|
| 566 | begin
|
---|
| 567 | aline := GtslAllViews[i];
|
---|
| 568 | avtype := Piece(aline, '^', 1);
|
---|
| 569 | avc := Piece(aline, '^', 2);
|
---|
| 570 | avnum := Piece(aline, '^', 3);
|
---|
| 571 | aname := UpperCase(Piece(aline, '^', 4));
|
---|
| 572 | atype := UpperCase(Piece(aline, '^', 5));
|
---|
| 573 | aitem := Piece(aline, '^', 6);
|
---|
| 574 | //auser := Piece(aline, '^', 7);
|
---|
| 575 | if partsnum <> '0' then
|
---|
| 576 | begin //AddLine(ext, aname, atype, aitem);
|
---|
| 577 | if (avc = 'C') and (partsnum = avnum) then
|
---|
| 578 | begin
|
---|
| 579 | if ext <> 1 then
|
---|
| 580 | begin
|
---|
| 581 | if aitem = '0' then bigline := bigline + '0~' + atype + '~|'
|
---|
| 582 | else bigline := bigline + atype + '~' + aitem + '~|'
|
---|
| 583 | end
|
---|
| 584 | else
|
---|
| 585 | begin
|
---|
| 586 | if aitem = '0' then
|
---|
| 587 | GtslScratchTemp.Add('0^' + atype + '^' + aname)
|
---|
| 588 | else
|
---|
| 589 | GtslScratchTemp.Add(atype + '^' + aitem + '^' + aname)
|
---|
| 590 | end;
|
---|
| 591 | end
|
---|
| 592 | else
|
---|
| 593 | begin
|
---|
| 594 | break;
|
---|
| 595 | end;
|
---|
| 596 | end
|
---|
| 597 | else
|
---|
| 598 | if avtype = vtype then
|
---|
| 599 | begin
|
---|
| 600 | if allviews and (avc = 'V') then
|
---|
| 601 | begin
|
---|
| 602 | GtslScratchTemp.Add(aname);
|
---|
| 603 | end
|
---|
| 604 | else if (avc = 'V') and (aname = profiles) then
|
---|
| 605 | partsnum := avnum;
|
---|
| 606 | end;
|
---|
| 607 | end;
|
---|
| 608 | if length(bigline) > 0 then
|
---|
| 609 | GtslScratchTemp.Add(bigline);
|
---|
| 610 | if allviews or fulltext then
|
---|
| 611 | MixedCaseList(GtslScratchTemp);
|
---|
| 612 | Result := GtslScratchTemp;
|
---|
| 613 | end;
|
---|
| 614 | end;
|
---|
| 615 |
|
---|
| 616 | function GetATestGroup(testgroup: Integer; userx: int64): TStrings;
|
---|
| 617 | var // temporary fix - converting definitions in GtslAllViews to rpc format
|
---|
| 618 | i: integer;
|
---|
| 619 | aline, avtype, avc, avnum, aname, aitem, partsnum: string;
|
---|
| 620 | //atype, auser: string;
|
---|
| 621 | begin
|
---|
| 622 | if (userx > 0) and (userx <> User.DUZ) then
|
---|
| 623 | Result := rpcATestGroup(testgroup, userx)
|
---|
| 624 | else
|
---|
| 625 | begin
|
---|
| 626 | partsnum := '0';
|
---|
| 627 | GtslScratchTemp.Clear;
|
---|
| 628 | for i := 0 to GtslAllViews.Count - 1 do
|
---|
| 629 | begin
|
---|
| 630 | aline := GtslAllViews[i];
|
---|
| 631 | avtype := Piece(aline, '^', 1);
|
---|
| 632 | avc := Piece(aline, '^', 2);
|
---|
| 633 | avnum := Piece(aline, '^', 3);
|
---|
| 634 | aname := Piece(aline, '^', 4);
|
---|
| 635 | //atype := UpperCase(Piece(aline, '^', 5));
|
---|
| 636 | aitem := Piece(aline, '^', 6);
|
---|
| 637 | //auser := Piece(aline, '^', 7);
|
---|
| 638 | if avtype = VIEW_LABS then
|
---|
| 639 | begin
|
---|
| 640 | if (avc = 'V') and (partsnum <> '0') then
|
---|
| 641 | break;
|
---|
| 642 | if (avc = 'C') and (partsnum = avnum) then
|
---|
| 643 | GtslScratchTemp.Add(aitem + '^' + aname)
|
---|
| 644 | else if (avc = 'V')
|
---|
| 645 | and (testgroup = strtointdef(Piece(aname, ')', 1), BIG_NUMBER)) then
|
---|
| 646 | partsnum := avnum;
|
---|
| 647 | end;
|
---|
| 648 | end;
|
---|
| 649 | //MixedCaseList(GtslScratchTemp);
|
---|
| 650 | Result := GtslScratchTemp;
|
---|
| 651 | end;
|
---|
| 652 | end;
|
---|
| 653 |
|
---|
| 654 | function GetGraphStatus: string;
|
---|
| 655 | begin
|
---|
| 656 | Result := FGraphActivity.Status;
|
---|
| 657 | end;
|
---|
| 658 |
|
---|
| 659 | function GetOldDFN: string;
|
---|
| 660 | begin
|
---|
| 661 | Result := FGraphActivity.OldDFN;
|
---|
| 662 | end;
|
---|
| 663 |
|
---|
| 664 | function GetPersonalSetting: string;
|
---|
| 665 | begin
|
---|
| 666 | Result := FGraphActivity.PersonalSetting;
|
---|
| 667 | end;
|
---|
| 668 |
|
---|
| 669 | function GetPublicSetting: string;
|
---|
| 670 | begin
|
---|
| 671 | Result := FGraphActivity.PublicSetting;
|
---|
| 672 | end;
|
---|
| 673 |
|
---|
| 674 | function GraphPublicEditor: boolean;
|
---|
| 675 | begin
|
---|
| 676 | Result := FGraphActivity.PublicEditor;
|
---|
| 677 | end;
|
---|
| 678 |
|
---|
| 679 | function GraphTurboOn: boolean;
|
---|
| 680 | begin
|
---|
| 681 | Result := (FGraphActivity.TurboOn and FGraphActivity.Cache);
|
---|
| 682 | end;
|
---|
| 683 |
|
---|
| 684 | procedure SetCurrentSetting(aString: string);
|
---|
| 685 | begin
|
---|
| 686 | FGraphActivity.CurrentSetting := aString;
|
---|
| 687 | end;
|
---|
| 688 |
|
---|
| 689 | procedure SetDefaultInpatientDate(aString: string);
|
---|
| 690 | begin
|
---|
| 691 | FGraphActivity.DefaultInpatientDate := aString;
|
---|
| 692 | end;
|
---|
| 693 |
|
---|
| 694 | procedure SetDefaultOutpatientDate(aString: string);
|
---|
| 695 | begin
|
---|
| 696 | FGraphActivity.DefaultOutpatientDate := aString;
|
---|
| 697 | end;
|
---|
| 698 |
|
---|
| 699 | procedure SetGraphStatus(aString: string);
|
---|
| 700 | begin
|
---|
| 701 | FGraphActivity.Status := aString;
|
---|
| 702 | end;
|
---|
| 703 |
|
---|
| 704 | procedure SetOldDFN(aString: string);
|
---|
| 705 | begin
|
---|
| 706 | FGraphActivity.OldDFN := aString;
|
---|
| 707 | end;
|
---|
| 708 |
|
---|
| 709 | procedure SetPersonalSetting(aString: string);
|
---|
| 710 | begin
|
---|
| 711 | FGraphActivity.PersonalSetting := aString;
|
---|
| 712 | end;
|
---|
| 713 |
|
---|
| 714 | procedure SetPublicSetting(aString: string);
|
---|
| 715 | begin
|
---|
| 716 | FGraphActivity.PublicSetting := aString;
|
---|
| 717 | end;
|
---|
| 718 | //---------------------------------------------------
|
---|
| 719 |
|
---|
| 720 | procedure TfrmGraphData.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 721 | var
|
---|
| 722 | faststatus: string;
|
---|
| 723 | begin
|
---|
| 724 | if FGraphActivity.Cache then
|
---|
| 725 | begin
|
---|
| 726 | faststatus := rpcFastTask('0', Patient.DFN); // cleanup patient cache
|
---|
| 727 | if faststatus = '-1' then
|
---|
| 728 | FGraphActivity.Cache := false;
|
---|
| 729 | end;
|
---|
| 730 | end;
|
---|
| 731 |
|
---|
| 732 | procedure TfrmGraphData.FormDestroy(Sender: TObject);
|
---|
| 733 | begin
|
---|
| 734 | FreeGtsl;
|
---|
| 735 | end;
|
---|
| 736 |
|
---|
| 737 | end.
|
---|