| 1 | unit rGraphs;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses SysUtils, Classes, Controls, Forms, ORNet, ORFn, Graphics;
 | 
|---|
| 6 | 
 | 
|---|
| 7 | function rpcPublicEdit: Boolean;
 | 
|---|
| 8 | function rpcReportParams(ien: integer): String;
 | 
|---|
| 9 | 
 | 
|---|
| 10 | procedure FastAdd(source: TStrings; destination: TStrings);  // not used
 | 
|---|
| 11 | procedure FastAssign(source: TStrings; destination: TStrings);
 | 
|---|
| 12 |   // example: FastAssign(rpcDrugClass, lstDrugClass.Items)
 | 
|---|
| 13 | 
 | 
|---|
| 14 | function rpcClass(itemtype: string): TStrings;
 | 
|---|
| 15 | function rpcTaxonomy(alltax: boolean; taxonomies: TStrings): TStrings;
 | 
|---|
| 16 | procedure rpcDetailDay(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime;
 | 
|---|
| 17 |   ATypeItem: string; complete: boolean);  //*DFN*
 | 
|---|
| 18 | function rpcDetailSelected(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
 | 
|---|
| 19 |   tests: TStrings; complete: boolean): TStrings;  //*DFN*
 | 
|---|
| 20 | function rpcGetAllItems(const PatientDFN: string): TStrings;
 | 
|---|
| 21 | function rpcGetItems(typeitem: string; const PatientDFN: string): TStrings;
 | 
|---|
| 22 | function rpcGetItemData(itemdata, timestamp: string; const PatientDFN: string): TStrings;
 | 
|---|
| 23 | function rpcGetTypes(const PatientDFN: string; subtypes: boolean): TStrings;
 | 
|---|
| 24 | function rpcGetTestSpec: TStrings;
 | 
|---|
| 25 | 
 | 
|---|
| 26 | function rpcGetGraphDateRange(reportid: string): TStrings;
 | 
|---|
| 27 | function rpcGetGraphSettings: TStrings;
 | 
|---|
| 28 | procedure rpcSetGraphSettings(paramsetting, permission: string);
 | 
|---|
| 29 | function rpcGetGraphSizing: TStrings;
 | 
|---|
| 30 | procedure rpcSetGraphSizing(values: TStrings);
 | 
|---|
| 31 | 
 | 
|---|
| 32 | function rpcGetGraphProfiles(profiles, permission: string; ext: integer): TStrings;
 | 
|---|
| 33 | procedure rpcSetGraphProfile(paramname, permission: string; paramvalues: TStrings);
 | 
|---|
| 34 | procedure rpcDeleteGraphProfile(paramname, permission: string);
 | 
|---|
| 35 | 
 | 
|---|
| 36 | function rpcLookupItems(const filename, startfrom: string; direction: integer): TStrings;
 | 
|---|
| 37 | function rpcDateItem(oldestdate, newestdate: double; filenum: string; const PatientDFN: string): TStrings;
 | 
|---|
| 38 | procedure onoff(x: integer);
 | 
|---|
| 39 | 
 | 
|---|
| 40 | implementation
 | 
|---|
| 41 | 
 | 
|---|
| 42 | function rpcPublicEdit: Boolean;
 | 
|---|
| 43 | begin
 | 
|---|
| 44 |   onoff(1);
 | 
|---|
| 45 |   Result := sCallV('ORWGRPC PUBLIC', [nil]) = '1';
 | 
|---|
| 46 |   //Result := false;  //************* for testing turn on
 | 
|---|
| 47 |   onoff(0);
 | 
|---|
| 48 | end;
 | 
|---|
| 49 | 
 | 
|---|
| 50 | function rpcReportParams(ien: integer): String;
 | 
|---|
| 51 | begin
 | 
|---|
| 52 |   onoff(1);
 | 
|---|
| 53 |   Result := sCallV('ORWGRPC RPTPARAM', [ien]);
 | 
|---|
| 54 |   onoff(0);
 | 
|---|
| 55 | end;
 | 
|---|
| 56 | 
 | 
|---|
| 57 | procedure FastAssign(source: TStrings; destination: TStrings);
 | 
|---|
| 58 | var
 | 
|---|
| 59 |   ms: TMemoryStream;
 | 
|---|
| 60 | begin
 | 
|---|
| 61 |   destination.Clear;
 | 
|---|
| 62 |   ms := TMemoryStream.Create;
 | 
|---|
| 63 |   try
 | 
|---|
| 64 |     source.SaveToStream(ms);
 | 
|---|
| 65 |     ms.Seek(0, soFromBeginning);
 | 
|---|
| 66 |     destination.LoadFromStream(ms);
 | 
|---|
| 67 |   finally
 | 
|---|
| 68 |     ms.Free;
 | 
|---|
| 69 |   end;
 | 
|---|
| 70 | end;
 | 
|---|
| 71 | 
 | 
|---|
| 72 | procedure FastAdd(source: TStrings; destination: TStrings);
 | 
|---|
| 73 | var
 | 
|---|
| 74 |   ms: TMemoryStream;
 | 
|---|
| 75 | begin
 | 
|---|
| 76 |   destination.Clear;
 | 
|---|
| 77 |   ms := TMemoryStream.Create;
 | 
|---|
| 78 |   try
 | 
|---|
| 79 |     destination.SaveToStream(ms);
 | 
|---|
| 80 |     ms.Seek(soFromEnd, 0);
 | 
|---|
| 81 |     source.SaveToStream(ms);
 | 
|---|
| 82 |     ms.Seek(0, soFromBeginning);
 | 
|---|
| 83 |     destination.LoadFromStream(ms);
 | 
|---|
| 84 |   finally
 | 
|---|
| 85 |     ms.Free;
 | 
|---|
| 86 |   end;
 | 
|---|
| 87 | end;
 | 
|---|
| 88 | 
 | 
|---|
| 89 | procedure rpcDetailDay(Dest: TStrings; const PatientDFN: string; ADate1, ADate2: TFMDateTime;
 | 
|---|
| 90 |   ATypeItem: string; complete: boolean);  //*DFN*
 | 
|---|
| 91 | var
 | 
|---|
| 92 |   includecomplete: string;
 | 
|---|
| 93 | begin
 | 
|---|
| 94 |   if complete then includecomplete := '1' else includecomplete := '0';
 | 
|---|
| 95 |   onoff(1);
 | 
|---|
| 96 |   CallV('ORWGRPC DETAILS', [PatientDFN, ADate1, ADate2, ATypeItem, includecomplete]);
 | 
|---|
| 97 |   onoff(0);
 | 
|---|
| 98 |   QuickCopy(RPCBrokerV.Results, Dest);
 | 
|---|
| 99 | end;
 | 
|---|
| 100 | 
 | 
|---|
| 101 | function rpcDetailSelected(const PatientDFN: string; ADate1, ADate2: TFMDateTime;
 | 
|---|
| 102 |   tests: TStrings; complete: boolean): TStrings;  //*DFN*
 | 
|---|
| 103 | var
 | 
|---|
| 104 |   includecomplete: string;
 | 
|---|
| 105 | begin
 | 
|---|
| 106 |   if complete then includecomplete := '1' else includecomplete := '0';
 | 
|---|
| 107 |   onoff(1);
 | 
|---|
| 108 |   CallV('ORWGRPC DETAIL', [PatientDFN, ADate1, ADate2, tests, includecomplete]);
 | 
|---|
| 109 |   onoff(0);
 | 
|---|
| 110 |   Result := RPCBrokerV.Results;
 | 
|---|
| 111 | end;
 | 
|---|
| 112 | 
 | 
|---|
| 113 | function rpcGetAllItems(const PatientDFN: string): TStrings;
 | 
|---|
| 114 | begin
 | 
|---|
| 115 |   onoff(1);
 | 
|---|
| 116 |   CallV('ORWGRPC ALLITEMS', [PatientDFN]);
 | 
|---|
| 117 |   onoff(0);
 | 
|---|
| 118 |   MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 119 |   Result := RPCBrokerV.Results;
 | 
|---|
| 120 | end;
 | 
|---|
| 121 | 
 | 
|---|
| 122 | function rpcGetTypes(const PatientDFN: string; subtypes: boolean): TStrings;
 | 
|---|
| 123 | var
 | 
|---|
| 124 |   includesubtypes: string;
 | 
|---|
| 125 | begin
 | 
|---|
| 126 |   if subtypes then includesubtypes := '1' else includesubtypes := '0';
 | 
|---|
| 127 |   onoff(1);
 | 
|---|
| 128 |   CallV('ORWGRPC TYPES', [PatientDFN, includesubtypes]);
 | 
|---|
| 129 |   onoff(0);
 | 
|---|
| 130 |   MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 131 |   Result := RPCBrokerV.Results;
 | 
|---|
| 132 | end;
 | 
|---|
| 133 | 
 | 
|---|
| 134 | function rpcGetItems(typeitem: string; const PatientDFN: string): TStrings;
 | 
|---|
| 135 | begin
 | 
|---|
| 136 |   onoff(1);
 | 
|---|
| 137 |   CallV('ORWGRPC ITEMS', [PatientDFN, typeitem]);
 | 
|---|
| 138 |   onoff(0);
 | 
|---|
| 139 |   MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 140 |   Result := RPCBrokerV.Results;
 | 
|---|
| 141 | end;
 | 
|---|
| 142 | 
 | 
|---|
| 143 | function rpcClass(itemtype: string): TStrings;
 | 
|---|
| 144 | begin
 | 
|---|
| 145 |   onoff(1);
 | 
|---|
| 146 |   CallV('ORWGRPC CLASS', [itemtype]);
 | 
|---|
| 147 |   onoff(0);
 | 
|---|
| 148 |   MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 149 |   Result := RPCBrokerV.Results;
 | 
|---|
| 150 | end;
 | 
|---|
| 151 | 
 | 
|---|
| 152 | function rpcTaxonomy(alltax: boolean; taxonomies: TStrings): TStrings;
 | 
|---|
| 153 | var
 | 
|---|
| 154 |   getall: string;
 | 
|---|
| 155 | begin
 | 
|---|
| 156 |   if alltax then getall := '1' else getall := '0';
 | 
|---|
| 157 |   onoff(1);
 | 
|---|
| 158 |   CallV('ORWGRPC TAX', [getall, taxonomies]);
 | 
|---|
| 159 |   onoff(0);
 | 
|---|
| 160 |   Result := RPCBrokerV.Results;
 | 
|---|
| 161 | end;
 | 
|---|
| 162 | 
 | 
|---|
| 163 | function rpcGetItemData(itemdata, timestamp: string; const PatientDFN: string): TStrings;
 | 
|---|
| 164 | begin
 | 
|---|
| 165 |   onoff(1);
 | 
|---|
| 166 |   CallV('ORWGRPC ITEMDATA', [itemdata, timestamp, PatientDFN]);
 | 
|---|
| 167 |   onoff(0);
 | 
|---|
| 168 |   Result := RPCBrokerV.Results;
 | 
|---|
| 169 | end;
 | 
|---|
| 170 | 
 | 
|---|
| 171 | function rpcGetGraphDateRange(reportid: string): TStrings;
 | 
|---|
| 172 | begin
 | 
|---|
| 173 |   onoff(1);
 | 
|---|
| 174 |   CallV('ORWGRPC GETDATES', [reportid]);
 | 
|---|
| 175 |   onoff(0);
 | 
|---|
| 176 |   Result := RPCBrokerV.Results;
 | 
|---|
| 177 | end;
 | 
|---|
| 178 | 
 | 
|---|
| 179 | function rpcGetGraphSettings: TStrings;
 | 
|---|
| 180 | begin
 | 
|---|
| 181 |   onoff(1);
 | 
|---|
| 182 |   CallV('ORWGRPC GETPREF', [nil]);
 | 
|---|
| 183 |   onoff(0);
 | 
|---|
| 184 |   Result := RPCBrokerV.Results;
 | 
|---|
| 185 | end;
 | 
|---|
| 186 | 
 | 
|---|
| 187 | procedure rpcSetGraphSettings(paramsetting, permission: string);
 | 
|---|
| 188 | begin
 | 
|---|
| 189 |   onoff(1);
 | 
|---|
| 190 |   CallV('ORWGRPC SETPREF', [paramsetting, permission]);
 | 
|---|
| 191 |   onoff(0);
 | 
|---|
| 192 | end;
 | 
|---|
| 193 | 
 | 
|---|
| 194 | function rpcGetGraphSizing: TStrings;
 | 
|---|
| 195 | begin
 | 
|---|
| 196 |   onoff(1);
 | 
|---|
| 197 |   CallV('ORWGRPC GETSIZE', [nil]);
 | 
|---|
| 198 |   onoff(0);
 | 
|---|
| 199 |   Result := RPCBrokerV.Results;
 | 
|---|
| 200 | end;
 | 
|---|
| 201 | 
 | 
|---|
| 202 | procedure rpcSetGraphSizing(values: TStrings);
 | 
|---|
| 203 | begin
 | 
|---|
| 204 |   onoff(1);
 | 
|---|
| 205 |   CallV('ORWGRPC SETSIZE', [values]);
 | 
|---|
| 206 |   onoff(0);
 | 
|---|
| 207 | end;
 | 
|---|
| 208 | 
 | 
|---|
| 209 | function rpcGetGraphProfiles(profiles, permission: string; ext: integer): TStrings;
 | 
|---|
| 210 | begin
 | 
|---|
| 211 |   onoff(1);
 | 
|---|
| 212 |   CallV('ORWGRPC GETVIEWS', [profiles, permission, ext]);
 | 
|---|
| 213 |   onoff(0);
 | 
|---|
| 214 |   if (profiles = '1') or (ext = 1) then MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 215 |   Result := RPCBrokerV.Results;
 | 
|---|
| 216 | end;
 | 
|---|
| 217 | 
 | 
|---|
| 218 | procedure rpcSetGraphProfile(paramname, permission: string; paramvalues: TStrings);
 | 
|---|
| 219 | begin
 | 
|---|
| 220 |   onoff(1);
 | 
|---|
| 221 |   CallV('ORWGRPC SETVIEWS', [paramname, permission, paramvalues]);
 | 
|---|
| 222 |   onoff(0);
 | 
|---|
| 223 | end;
 | 
|---|
| 224 | 
 | 
|---|
| 225 | procedure rpcDeleteGraphProfile(paramname, permission: string);
 | 
|---|
| 226 | begin
 | 
|---|
| 227 |   onoff(1);
 | 
|---|
| 228 |   CallV('ORWGRPC DELVIEWS', [paramname, permission]);
 | 
|---|
| 229 |   onoff(0);
 | 
|---|
| 230 | end;
 | 
|---|
| 231 | 
 | 
|---|
| 232 | function rpcGetTestSpec: TStrings;
 | 
|---|
| 233 | begin
 | 
|---|
| 234 |   onoff(1);
 | 
|---|
| 235 |   CallV('ORWGRPC TESTSPEC', []);
 | 
|---|
| 236 |   onoff(0);
 | 
|---|
| 237 |   Result := RPCBrokerV.Results;
 | 
|---|
| 238 | end;
 | 
|---|
| 239 | 
 | 
|---|
| 240 | function rpcLookupItems(const filename, StartFrom: string; Direction: integer): TStrings;
 | 
|---|
| 241 | begin
 | 
|---|
| 242 |   onoff(1);
 | 
|---|
| 243 |   CallV('ORWGRPC LOOKUP', [filename, StartFrom, Direction]);
 | 
|---|
| 244 |   onoff(0);
 | 
|---|
| 245 |   MixedCaseList(RPCBrokerV.Results);
 | 
|---|
| 246 |   Result := RPCBrokerV.Results;
 | 
|---|
| 247 | end;
 | 
|---|
| 248 | 
 | 
|---|
| 249 | function rpcDateItem(oldestdate, newestdate: double; filenum: string; const PatientDFN: string): TStrings;
 | 
|---|
| 250 | begin
 | 
|---|
| 251 |   onoff(1);
 | 
|---|
| 252 |   CallV('ORWGRPC DATEITEM', [oldestdate, newestdate, filenum, PatientDFN]);
 | 
|---|
| 253 |   onoff(0);
 | 
|---|
| 254 |   Result := RPCBrokerV.Results;
 | 
|---|
| 255 | end;
 | 
|---|
| 256 | 
 | 
|---|
| 257 | procedure onoff(x: integer);
 | 
|---|
| 258 | begin
 | 
|---|
| 259 |   if x = 1 then
 | 
|---|
| 260 |   begin
 | 
|---|
| 261 |     //Screen.Cursor := crHourGlass;
 | 
|---|
| 262 |   end
 | 
|---|
| 263 |   else
 | 
|---|
| 264 |   begin
 | 
|---|
| 265 |     //Screen.Cursor := crDefault;
 | 
|---|
| 266 |   end;
 | 
|---|
| 267 | end;
 | 
|---|
| 268 | 
 | 
|---|
| 269 | end.
 | 
|---|