| 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. | 
|---|