| [460] | 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. | 
|---|