source: cprs/branches/tmg-cprs/CPRS-Chart/rGraphs.pas@ 710

Last change on this file since 710 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

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