| 1 | unit rLabs;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses SysUtils, Classes, ORNet, ORFn;
|
|---|
| 6 |
|
|---|
| 7 | function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 8 | function Specimens(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 9 | function AllTests(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 10 | function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 11 | function Users(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 12 | function TestGroups(user: int64): TStrings;
|
|---|
| 13 | function ATest(test: integer): TStrings;
|
|---|
| 14 | function ATestGroup(testgroup: Integer; user: int64): TStrings;
|
|---|
| 15 | procedure UTGAdd(tests: TStrings);
|
|---|
| 16 | procedure UTGReplace(tests: TStrings; testgroup: integer);
|
|---|
| 17 | procedure UTGDelete(testgroup: integer);
|
|---|
| 18 | procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
|
|---|
| 19 | procedure Cumulative(Dest: TStrings; const PatientDFN: string;
|
|---|
| 20 | daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string);
|
|---|
| 21 | procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
|
|---|
| 22 | daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 23 | procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 24 | procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
|
|---|
| 25 | ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 26 | procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1,
|
|---|
| 27 | ADate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 28 | procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
|
|---|
| 29 | ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 30 | function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
|---|
| 31 | tests: TStrings): TStrings; //*DFN*
|
|---|
| 32 | function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime;
|
|---|
| 33 | direction, format: integer): TStrings; //*DFN*
|
|---|
| 34 | function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
|---|
| 35 | spec: string; tests: TStrings): TStrings; //*DFN*
|
|---|
| 36 | procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
|---|
| 37 | ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 38 | procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
|---|
| 39 | ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 40 | procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
|---|
| 41 | ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 42 | procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
|
|---|
| 43 | function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
|
|---|
| 44 | spec, test: string): TStrings; //*DFN*
|
|---|
| 45 | procedure PrintLabsToDevice(AReport, ADaysBack: Integer;
|
|---|
| 46 | const PatientDFN, ADevice: string; ATests: TStrings;
|
|---|
| 47 | var ErrMsg: string; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
|
|---|
| 48 | function GetFormattedLabReport(AReport, ADaysBack: Integer; const PatientDFN: string;
|
|---|
| 49 | ATests: TStrings; ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string): TStrings;
|
|---|
| 50 | function TestInfo(Test: String): TStrings;
|
|---|
| 51 |
|
|---|
| 52 | implementation
|
|---|
| 53 |
|
|---|
| 54 | uses rCore, uCore, graphics;
|
|---|
| 55 |
|
|---|
| 56 | function AtomicTests(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 57 | begin
|
|---|
| 58 | CallV('ORWLRR ATOMICS', [StartFrom, Direction]);
|
|---|
| 59 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 60 | Result := RPCBrokerV.Results;
|
|---|
| 61 | end;
|
|---|
| 62 |
|
|---|
| 63 | function Specimens(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 64 | begin
|
|---|
| 65 | CallV('ORWLRR SPEC', [StartFrom, Direction]);
|
|---|
| 66 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 67 | Result := RPCBrokerV.Results;
|
|---|
| 68 | end;
|
|---|
| 69 |
|
|---|
| 70 | function AllTests(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 71 | begin
|
|---|
| 72 | CallV('ORWLRR ALLTESTS', [StartFrom, Direction]);
|
|---|
| 73 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 74 | Result := RPCBrokerV.Results;
|
|---|
| 75 | end;
|
|---|
| 76 |
|
|---|
| 77 | function ChemTest(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 78 | begin
|
|---|
| 79 | CallV('ORWLRR CHEMTEST', [StartFrom, Direction]);
|
|---|
| 80 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 81 | Result := RPCBrokerV.Results;
|
|---|
| 82 | end;
|
|---|
| 83 |
|
|---|
| 84 | function Users(const StartFrom: string; Direction: Integer): TStrings;
|
|---|
| 85 | begin
|
|---|
| 86 | CallV('ORWLRR USERS', [StartFrom, Direction]);
|
|---|
| 87 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 88 | Result := RPCBrokerV.Results;
|
|---|
| 89 | end;
|
|---|
| 90 |
|
|---|
| 91 | function TestGroups(user: int64): TStrings;
|
|---|
| 92 | begin
|
|---|
| 93 | CallV('ORWLRR TG', [user]);
|
|---|
| 94 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 95 | Result := RPCBrokerV.Results;
|
|---|
| 96 | end;
|
|---|
| 97 |
|
|---|
| 98 | function ATest(test: integer): TStrings;
|
|---|
| 99 | begin
|
|---|
| 100 | CallV('ORWLRR ATESTS', [test]);
|
|---|
| 101 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 102 | Result := RPCBrokerV.Results;
|
|---|
| 103 | end;
|
|---|
| 104 |
|
|---|
| 105 | function ATestGroup(testgroup: Integer; user: int64): TStrings;
|
|---|
| 106 | begin
|
|---|
| 107 | CallV('ORWLRR ATG', [testgroup, user]);
|
|---|
| 108 | MixedCaseList(RPCBrokerV.Results);
|
|---|
| 109 | Result := RPCBrokerV.Results;
|
|---|
| 110 | end;
|
|---|
| 111 |
|
|---|
| 112 | procedure UTGAdd(tests: TStrings);
|
|---|
| 113 | begin
|
|---|
| 114 | CallV('ORWLRR UTGA', [tests]);
|
|---|
| 115 | end;
|
|---|
| 116 |
|
|---|
| 117 | procedure UTGReplace(tests: TStrings; testgroup: integer);
|
|---|
| 118 | begin
|
|---|
| 119 | CallV('ORWLRR UTGR', [tests, testgroup]);
|
|---|
| 120 | end;
|
|---|
| 121 |
|
|---|
| 122 | procedure UTGDelete(testgroup: integer);
|
|---|
| 123 | begin
|
|---|
| 124 | CallV('ORWLRR UTGD', [testgroup]);
|
|---|
| 125 | end;
|
|---|
| 126 |
|
|---|
| 127 | procedure SpecimenDefaults(var blood, urine, serum, plasma: string);
|
|---|
| 128 | begin
|
|---|
| 129 | CallV('ORWLRR PARAM', [nil]);
|
|---|
| 130 | blood := Piece(RPCBrokerV.Results[0], '^', 1);
|
|---|
| 131 | urine := Piece(RPCBrokerV.Results[0], '^', 2);
|
|---|
| 132 | serum := Piece(RPCBrokerV.Results[0], '^', 3);
|
|---|
| 133 | plasma := Piece(RPCBrokerV.Results[0], '^', 4);
|
|---|
| 134 | end;
|
|---|
| 135 |
|
|---|
| 136 | procedure Cumulative(Dest: TStrings; const PatientDFN: string; daysback: integer; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 137 | begin
|
|---|
| 138 | if Length(ARpc) > 0 then
|
|---|
| 139 | begin
|
|---|
| 140 | CallV(ARpc, [PatientDFN, daysback, ADate1, ADate2]);
|
|---|
| 141 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 142 | end
|
|---|
| 143 | else
|
|---|
| 144 | begin
|
|---|
| 145 | Dest.Add('RPC is missing from report definition (file 101.24).');
|
|---|
| 146 | Dest.Add('Please contact Technical Support.');
|
|---|
| 147 | end;
|
|---|
| 148 | end;
|
|---|
| 149 |
|
|---|
| 150 | procedure RemoteLabCumulative(Dest: TStrings; const PatientDFN: string;
|
|---|
| 151 | daysback: integer; ADate1, ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 152 | begin
|
|---|
| 153 | CallV('XWB REMOTE RPC', [ASite, ARemoteRPC, 0, PatientDFN, daysback, Adate1, Adate2]);
|
|---|
| 154 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 155 | end;
|
|---|
| 156 |
|
|---|
| 157 | procedure Interim(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 158 | begin
|
|---|
| 159 | if Length(ARpc) > 0 then
|
|---|
| 160 | begin
|
|---|
| 161 | CallV(ARpc, [PatientDFN, ADate1, ADate2]);
|
|---|
| 162 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 163 | end
|
|---|
| 164 | else
|
|---|
| 165 | begin
|
|---|
| 166 | Dest.Add('RPC is missing from report definition (file 101.24).');
|
|---|
| 167 | Dest.Add('Please contact Technical Support.');
|
|---|
| 168 | end;
|
|---|
| 169 | end;
|
|---|
| 170 |
|
|---|
| 171 | procedure RemoteLabInterim(Dest: TStrings; const PatientDFN: string; ADate1,
|
|---|
| 172 | ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 173 | begin
|
|---|
| 174 | CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
|
|---|
| 175 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 176 | end;
|
|---|
| 177 |
|
|---|
| 178 | procedure Micro(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 179 | begin
|
|---|
| 180 | if Length(ARpc) > 0 then
|
|---|
| 181 | begin
|
|---|
| 182 | CallV(ARpc, [PatientDFN, ADate1, ADate2]);
|
|---|
| 183 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 184 | end
|
|---|
| 185 | else
|
|---|
| 186 | begin
|
|---|
| 187 | Dest.Add('RPC is missing from report definition (file 101.24).');
|
|---|
| 188 | Dest.Add('Please contact Technical Support.');
|
|---|
| 189 | end;
|
|---|
| 190 | end;
|
|---|
| 191 |
|
|---|
| 192 | procedure RemoteLabMicro(Dest: TStrings; const PatientDFN: string; ADate1,
|
|---|
| 193 | ADate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 194 | begin
|
|---|
| 195 | CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN, Adate1, Adate2]);
|
|---|
| 196 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 197 | end;
|
|---|
| 198 |
|
|---|
| 199 | function InterimSelect(const PatientDFN: string; ADate1, ADate2: TFMDateTime; tests: TStrings): TStrings; //*DFN*
|
|---|
| 200 | begin
|
|---|
| 201 | CallV('ORWLRR INTERIMS', [PatientDFN, ADate1, ADate2, tests]);
|
|---|
| 202 | Result := RPCBrokerV.Results;
|
|---|
| 203 | end;
|
|---|
| 204 |
|
|---|
| 205 | function InterimGrid(const PatientDFN: string; ADate1: TFMDateTime; direction, format: integer): TStrings; //*DFN*
|
|---|
| 206 | begin
|
|---|
| 207 | CallV('ORWLRR INTERIMG', [PatientDFN, ADate1, direction, format]);
|
|---|
| 208 | Result := RPCBrokerV.Results;
|
|---|
| 209 | end;
|
|---|
| 210 |
|
|---|
| 211 | function Worksheet(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec: string; tests: TStrings): TStrings; //*DFN*
|
|---|
| 212 | begin
|
|---|
| 213 | CallV('ORWLRR GRID', [PatientDFN, ADate1, ADate2, spec, tests]);
|
|---|
| 214 | Result := RPCBrokerV.Results;
|
|---|
| 215 | end;
|
|---|
| 216 |
|
|---|
| 217 | procedure Reports(Dest: TStrings; const PatientDFN: string; reportid, hstype, ADate, section: string; Adate1, Adate2: TFMDateTime; ARpc: string); //*DFN*
|
|---|
| 218 | begin
|
|---|
| 219 | if Length(ARpc) > 0 then
|
|---|
| 220 | begin
|
|---|
| 221 | CallV(ARpc, [PatientDFN, reportid, hstype, ADate, section, Adate2, Adate1]);
|
|---|
| 222 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 223 | end
|
|---|
| 224 | else
|
|---|
| 225 | begin
|
|---|
| 226 | Dest.Add('RPC is missing from report definition (file 101.24).');
|
|---|
| 227 | Dest.Add('Please contact Technical Support.');
|
|---|
| 228 | end;
|
|---|
| 229 | end;
|
|---|
| 230 |
|
|---|
| 231 | procedure RemoteLabReports(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
|---|
| 232 | ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 233 | begin
|
|---|
| 234 | CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
|
|---|
| 235 | reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
|
|---|
| 236 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 237 | end;
|
|---|
| 238 |
|
|---|
| 239 | procedure RemoteLab(Dest: TStrings; const PatientDFN: string; reportid, hstype,
|
|---|
| 240 | ADate, section: string; Adate1, Adate2: TFMDateTime; ASite, ARemoteRPC: String);
|
|---|
| 241 | begin
|
|---|
| 242 | CallV('XWB REMOTE RPC',[ASite, ARemoteRPC, 0, PatientDFN,
|
|---|
| 243 | reportid + ';1', hstype, ADate, section, Adate2, Adate1]);
|
|---|
| 244 | QuickCopy(RPCBrokerV.Results,Dest);
|
|---|
| 245 | end;
|
|---|
| 246 |
|
|---|
| 247 | procedure GetNewestOldest(const PatientDFN: string; var newest, oldest: string); //*DFN*
|
|---|
| 248 | begin
|
|---|
| 249 | CallV('ORWLRR NEWOLD', [PatientDFN]);
|
|---|
| 250 | newest := Piece(RPCBrokerV.Results[0], '^', 1);
|
|---|
| 251 | oldest := Piece(RPCBrokerV.Results[0], '^', 2);
|
|---|
| 252 | end;
|
|---|
| 253 |
|
|---|
| 254 | function GetChart(const PatientDFN: string; ADate1, ADate2: TFMDateTime; spec, test: string): TStrings; //*DFN*
|
|---|
| 255 | begin
|
|---|
| 256 | CallV('ORWLRR CHART', [PatientDFN, ADate1, ADate2, spec, test]);
|
|---|
| 257 | Result := RPCBrokerV.Results;
|
|---|
| 258 | end;
|
|---|
| 259 |
|
|---|
| 260 | procedure PrintLabsToDevice(AReport, ADaysBack: Integer;
|
|---|
| 261 | const PatientDFN, ADevice: string; ATests: TStrings; var ErrMsg: string;
|
|---|
| 262 | ADate1, ADate2: TFMDateTime; ARemoteSiteID, ARemoteQuery: string);
|
|---|
| 263 | { prints a report on the selected device }
|
|---|
| 264 | var
|
|---|
| 265 | j: integer;
|
|---|
| 266 | RemoteHandle,Report: string;
|
|---|
| 267 | aHandles: TStringlist;
|
|---|
| 268 | begin
|
|---|
| 269 | aHandles := TStringList.Create;
|
|---|
| 270 | if Length(ARemoteSiteID) > 0 then
|
|---|
| 271 | begin
|
|---|
| 272 | RemoteHandle := '';
|
|---|
| 273 | for j := 0 to RemoteReports.Count - 1 do
|
|---|
| 274 | begin
|
|---|
| 275 | Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
|
|---|
| 276 | if Report = ARemoteQuery then
|
|---|
| 277 | begin
|
|---|
| 278 | RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
|
|---|
| 279 | + '^' + Pieces(Report,'^',9,10);
|
|---|
| 280 | break;
|
|---|
| 281 | end;
|
|---|
| 282 | end;
|
|---|
| 283 | if Length(RemoteHandle) > 1 then
|
|---|
| 284 | with RemoteSites.SiteList do
|
|---|
| 285 | aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
|
|---|
| 286 | end;
|
|---|
| 287 | if aHandles.Count > 0 then
|
|---|
| 288 | begin
|
|---|
| 289 | ErrMsg := sCallV('ORWRP PRINT LAB REMOTE',[ADevice, PatientDFN, AReport, aHandles]);
|
|---|
| 290 | if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
|
|---|
| 291 | end
|
|---|
| 292 | else
|
|---|
| 293 | begin
|
|---|
| 294 | ErrMsg := sCallV('ORWRP PRINT LAB REPORTS',[ADevice, PatientDFN, AReport,
|
|---|
| 295 | ADaysBack, ATests, ADate2, ADate1]);
|
|---|
| 296 | if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
|
|---|
| 297 | end;
|
|---|
| 298 | aHandles.Clear;
|
|---|
| 299 | aHandles.Free;
|
|---|
| 300 | end;
|
|---|
| 301 |
|
|---|
| 302 | function GetFormattedLabReport(AReport, ADaysBack: Integer;
|
|---|
| 303 | const PatientDFN: string; ATests: TStrings; ADate1, ADate2: TFMDateTime;
|
|---|
| 304 | ARemoteSiteID, ARemoteQuery: string): TStrings;
|
|---|
| 305 | { prints a report on the selected Windows device }
|
|---|
| 306 | var
|
|---|
| 307 | j: integer;
|
|---|
| 308 | RemoteHandle,Report: string;
|
|---|
| 309 | aHandles: TStringlist;
|
|---|
| 310 | begin
|
|---|
| 311 | aHandles := TStringList.Create;
|
|---|
| 312 | if Length(ARemoteSiteID) > 0 then
|
|---|
| 313 | begin
|
|---|
| 314 | RemoteHandle := '';
|
|---|
| 315 | for j := 0 to RemoteReports.Count - 1 do
|
|---|
| 316 | begin
|
|---|
| 317 | Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
|
|---|
| 318 | if Report = ARemoteQuery then
|
|---|
| 319 | begin
|
|---|
| 320 | RemoteHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle
|
|---|
| 321 | + '^' + Pieces(Report,'^',9,10);
|
|---|
| 322 | break;
|
|---|
| 323 | end;
|
|---|
| 324 | end;
|
|---|
| 325 | if Length(RemoteHandle) > 1 then
|
|---|
| 326 | with RemoteSites.SiteList do
|
|---|
| 327 | aHandles.Add(ARemoteSiteID + '^' + RemoteHandle);
|
|---|
| 328 | end;
|
|---|
| 329 | if aHandles.Count > 0 then
|
|---|
| 330 | begin
|
|---|
| 331 | CallV('ORWRP PRINT WINDOWS LAB REMOTE',[PatientDFN, AReport, aHandles]);
|
|---|
| 332 | Result := RPCBrokerV.Results;
|
|---|
| 333 | end
|
|---|
| 334 | else
|
|---|
| 335 | begin
|
|---|
| 336 | CallV('ORWRP WINPRINT LAB REPORTS',[PatientDFN, AReport, ADaysBack, ATests,
|
|---|
| 337 | ADate2, ADate1]);
|
|---|
| 338 | Result := RPCBrokerV.Results;
|
|---|
| 339 | end;
|
|---|
| 340 | aHandles.Clear;
|
|---|
| 341 | aHandles.Free;
|
|---|
| 342 | end;
|
|---|
| 343 |
|
|---|
| 344 | function TestInfo(Test: String): TStrings;
|
|---|
| 345 | begin
|
|---|
| 346 | CallV('ORWLRR INFO',[Test]);
|
|---|
| 347 | Result := RPCBrokerV.Results;
|
|---|
| 348 | end;
|
|---|
| 349 |
|
|---|
| 350 | end.
|
|---|
