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