1 | unit rMisc;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses SysUtils, Windows, Classes, Forms, Controls, ComCtrls, Grids, ORFn, ORNet;
|
---|
6 |
|
---|
7 | const
|
---|
8 | MAX_TOOLITEMS = 30;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TToolItem = record
|
---|
12 | Caption: string;
|
---|
13 | Action: string;
|
---|
14 | end;
|
---|
15 |
|
---|
16 | TToolItemList = array[0..MAX_TOOLITEMS] of TToolItem;
|
---|
17 |
|
---|
18 | {An Object of this Class is Created to Hold the Sizes of Controls(Forms)
|
---|
19 | while the app is running, thus reducing calls to RPCs SAVESIZ and LOADSIZ}
|
---|
20 | TSizeHolder = class(TObject)
|
---|
21 | private
|
---|
22 | FSizeList,FNameList: TStringList;
|
---|
23 | public
|
---|
24 | constructor Create;
|
---|
25 | destructor Destroy; override;
|
---|
26 | function GetSize(AName: String): String;
|
---|
27 | procedure SetSize(AName,ASize: String);
|
---|
28 | procedure AddSizesToStrList(theList: TStringList);
|
---|
29 | end;
|
---|
30 |
|
---|
31 | function DetailPrimaryCare(const DFN: string): TStrings; //*DFN*
|
---|
32 | procedure GetToolMenu(var ToolItems: TToolItemList; var OverLimit: boolean);
|
---|
33 | procedure ListSymbolTable(Dest: TStrings);
|
---|
34 | function MScalar(const x: string): string;
|
---|
35 | procedure SetShareNode(const DFN: string; AHandle: HWND); //*DFN*
|
---|
36 | function ServerHasPatch(const x: string): Boolean;
|
---|
37 | function ServerVersion(const Option, VerClient: string): string;
|
---|
38 | function PackageVersion(const Namespace: string): string;
|
---|
39 |
|
---|
40 | procedure SaveUserBounds(AControl: TControl);
|
---|
41 | procedure SaveUserSizes(SizingList: TStringList);
|
---|
42 | procedure SetFormPosition(AForm: TForm);
|
---|
43 | procedure SetUserBounds(var AControl: TControl);
|
---|
44 | procedure SetUserBounds2(AName: string; var v1, v2, v3, v4: integer);
|
---|
45 | procedure SetUserWidths(var AControl: TControl);
|
---|
46 | procedure SetUserColumns(var AControl: TControl);
|
---|
47 | function StrUserBounds(AControl: TControl): string;
|
---|
48 | function StrUserBounds2(AName: string; v1, v2, v3, v4: integer): string;
|
---|
49 | function StrUserWidth(AControl: TControl): string;
|
---|
50 | function StrUserColumns(AControl: TControl): string;
|
---|
51 | function UserFontSize: integer;
|
---|
52 | procedure SaveUserFontSize( FontSize: integer);
|
---|
53 |
|
---|
54 | var
|
---|
55 | SizeHolder : TSizeHolder;
|
---|
56 |
|
---|
57 | implementation
|
---|
58 |
|
---|
59 | uses TRPCB, fOrders, math;
|
---|
60 |
|
---|
61 | var
|
---|
62 | uBounds, uWidths, uColumns: TStringList;
|
---|
63 |
|
---|
64 | function DetailPrimaryCare(const DFN: string): TStrings; //*DFN*
|
---|
65 | begin
|
---|
66 | CallV('ORWPT1 PCDETAIL', [DFN]);
|
---|
67 | Result := RPCBrokerV.Results;
|
---|
68 | end;
|
---|
69 |
|
---|
70 | procedure GetToolMenu(var ToolItems: TToolItemList; var OverLimit: boolean);
|
---|
71 | var
|
---|
72 | i: Integer;
|
---|
73 | x: string;
|
---|
74 | LoopIndex: integer;
|
---|
75 | begin
|
---|
76 | for i := 0 to MAX_TOOLITEMS do with ToolItems[i] do
|
---|
77 | begin
|
---|
78 | Caption := '';
|
---|
79 | Action := '';
|
---|
80 | end;
|
---|
81 | CallV('ORWU TOOLMENU', [nil]);
|
---|
82 | OverLimit := (MAX_TOOLITEMS < RPCBrokerV.Results.Count - 1);
|
---|
83 | LoopIndex := Min(MAX_TOOLITEMS, RPCBrokerV.Results.Count - 1);
|
---|
84 | with RPCBrokerV do for i := 0 to LoopIndex do with ToolItems[i] do
|
---|
85 | begin
|
---|
86 | x := Piece(Results[i], U, 1);
|
---|
87 | Caption := Piece(x, '=', 1);
|
---|
88 | Action := Copy(x, Pos('=', x) + 1, Length(x));
|
---|
89 | end;
|
---|
90 | end;
|
---|
91 |
|
---|
92 | procedure ListSymbolTable(Dest: TStrings);
|
---|
93 | var
|
---|
94 | i: Integer;
|
---|
95 | x: string;
|
---|
96 | begin
|
---|
97 | Dest.Clear;
|
---|
98 | CallV('ORWUX SYMTAB', [nil]);
|
---|
99 | i := 0;
|
---|
100 | with RPCBrokerV.Results do while i < Count do
|
---|
101 | begin
|
---|
102 | x := Strings[i] + '=';
|
---|
103 | Inc(i);
|
---|
104 | if i < Count then x := x + Strings[i];
|
---|
105 | Dest.Add(x);
|
---|
106 | Inc(i);
|
---|
107 | end;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | function MScalar(const x: string): string;
|
---|
111 | begin
|
---|
112 | with RPCBrokerV do
|
---|
113 | begin
|
---|
114 | ClearParameters := True;
|
---|
115 | RemoteProcedure := 'XWB GET VARIABLE VALUE';
|
---|
116 | Param[0].Value := x;
|
---|
117 | Param[0].PType := reference;
|
---|
118 | CallBroker;
|
---|
119 | Result := Results[0];
|
---|
120 | end;
|
---|
121 | end;
|
---|
122 |
|
---|
123 | function ServerHasPatch(const x: string): Boolean;
|
---|
124 | begin
|
---|
125 | Result := sCallV('ORWU PATCH', [x]) = '1';
|
---|
126 | end;
|
---|
127 |
|
---|
128 | function ServerVersion(const Option, VerClient: string): string;
|
---|
129 | begin
|
---|
130 | Result := sCallV('ORWU VERSRV', [Option, VerClient]);
|
---|
131 | end;
|
---|
132 |
|
---|
133 | function PackageVersion(const Namespace: string): string;
|
---|
134 | begin
|
---|
135 | Result := sCallV('ORWU VERSION', [Namespace]);
|
---|
136 | end;
|
---|
137 |
|
---|
138 | function UserFontSize: integer;
|
---|
139 | begin
|
---|
140 | Result := StrToIntDef(sCallV('ORWCH LDFONT', [nil]),8);
|
---|
141 | If Result = 24 then Result := 18; // CQ #12322 removed 24 pt font
|
---|
142 | end;
|
---|
143 |
|
---|
144 | procedure LoadSizes;
|
---|
145 | var
|
---|
146 | i, p: Integer;
|
---|
147 | begin
|
---|
148 | uBounds := TStringList.Create;
|
---|
149 | uWidths := TStringList.Create;
|
---|
150 | uColumns := TStringList.Create;
|
---|
151 | CallV('ORWCH LOADALL', [nil]);
|
---|
152 | with RPCBrokerV do
|
---|
153 | begin
|
---|
154 | for i := 0 to Results.Count - 1 do // change '^' to '='
|
---|
155 | begin
|
---|
156 | p := Pos(U, Results[i]);
|
---|
157 | if p > 0 then Results[i] := Copy(Results[i], 1, p - 1) + '=' +
|
---|
158 | Copy(Results[i], p + 1, Length(Results[i]));
|
---|
159 | end;
|
---|
160 | ExtractItems(uBounds, RPCBrokerV.Results, 'Bounds');
|
---|
161 | ExtractItems(uWidths, RPCBrokerV.Results, 'Widths');
|
---|
162 | ExtractItems(uColumns, RPCBrokerV.Results, 'Columns');
|
---|
163 | end;
|
---|
164 | end;
|
---|
165 |
|
---|
166 | procedure SetShareNode(const DFN: string; AHandle: HWND); //*DFN*
|
---|
167 | begin
|
---|
168 | // sets node that allows other apps to see which patient is currently selected
|
---|
169 | sCallV('ORWPT SHARE', [DottedIPStr, IntToHex(AHandle, 8), DFN]);
|
---|
170 | end;
|
---|
171 |
|
---|
172 | procedure SetUserBounds(var AControl: TControl);
|
---|
173 | var
|
---|
174 | x: string;
|
---|
175 | begin
|
---|
176 | if uBounds = nil then LoadSizes;
|
---|
177 | x := AControl.Name;
|
---|
178 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
179 | x := uBounds.Values[x];
|
---|
180 | if (x = '0,0,0,0') and (AControl is TForm)
|
---|
181 | then TForm(AControl).WindowState := wsMaximized
|
---|
182 | else
|
---|
183 | begin
|
---|
184 | AControl.Left := HigherOf(StrToIntDef(Piece(x, ',', 1), AControl.Left), 0);
|
---|
185 | AControl.Top := HigherOf(StrToIntDef(Piece(x, ',', 2), AControl.Top), 0);
|
---|
186 | if Assigned( AControl.Parent ) then
|
---|
187 | begin
|
---|
188 | AControl.Width := LowerOf(StrToIntDef(Piece(x, ',', 3), AControl.Width), AControl.Parent.Width - AControl.Left);
|
---|
189 | AControl.Height := LowerOf(StrToIntDef(Piece(x, ',', 4), AControl.Height), AControl.Parent.Height - AControl.Top);
|
---|
190 | end
|
---|
191 | else
|
---|
192 | begin
|
---|
193 | AControl.Width := StrToIntDef(Piece(x, ',', 3), AControl.Width);
|
---|
194 | AControl.Height := StrToIntDef(Piece(x, ',', 4), AControl.Height);
|
---|
195 | end;
|
---|
196 | end;
|
---|
197 | //if (x = '0,0,' + IntToStr(Screen.Width) + ',' + IntToStr(Screen.Height)) and
|
---|
198 | // (AControl is TForm) then TForm(AControl).WindowState := wsMaximized;
|
---|
199 | end;
|
---|
200 |
|
---|
201 | procedure SetUserBounds2(AName: string; var v1, v2, v3, v4: integer);
|
---|
202 | var
|
---|
203 | x: string;
|
---|
204 | begin
|
---|
205 | if uBounds = nil then LoadSizes;
|
---|
206 | x := uBounds.Values[AName];
|
---|
207 | v1 := StrToIntDef(Piece(x, ',', 1), 0);
|
---|
208 | v2 := StrToIntDef(Piece(x, ',', 2), 0);
|
---|
209 | v3 := StrToIntDef(Piece(x, ',', 3), 0);
|
---|
210 | v4 := StrToIntDef(Piece(x, ',', 4), 0);
|
---|
211 | end;
|
---|
212 |
|
---|
213 |
|
---|
214 | procedure SetUserWidths(var AControl: TControl);
|
---|
215 | var
|
---|
216 | x: string;
|
---|
217 | begin
|
---|
218 | if uWidths = nil then LoadSizes;
|
---|
219 | x := AControl.Name;
|
---|
220 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
221 | x := uWidths.Values[x];
|
---|
222 | if Assigned (AControl.Parent) then
|
---|
223 | AControl.Width := LowerOf(StrToIntDef(x, AControl.Width), AControl.Parent.Width - AControl.Left)
|
---|
224 | else
|
---|
225 | AControl.Width := StrToIntDef(x, AControl.Width);
|
---|
226 | end;
|
---|
227 |
|
---|
228 | procedure SetUserColumns(var AControl: TControl);
|
---|
229 | var
|
---|
230 | x: string;
|
---|
231 | i, AWidth: Integer;
|
---|
232 | couldSet: boolean;
|
---|
233 | begin
|
---|
234 | couldSet := False;
|
---|
235 | if uColumns = nil then LoadSizes;
|
---|
236 | x := AControl.Name;
|
---|
237 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
238 | if AnsiCompareText(x,'frmOrders.hdrOrders')=0 then
|
---|
239 | couldSet := True;
|
---|
240 | x := uColumns.Values[x];
|
---|
241 | if AControl is THeaderControl then with THeaderControl(AControl) do
|
---|
242 | for i := 0 to Sections.Count - 1 do
|
---|
243 | begin
|
---|
244 | //Make sure all of the colmumns fit, even if it means scrunching the last ones.
|
---|
245 | AWidth := LowerOf(StrToIntDef(Piece(x, ',', i + 1), 0), HigherOf(ClientWidth - (Sections.Count - i)*5 - Sections.Items[i].Left, 5));
|
---|
246 | if AWidth > 0 then Sections.Items[i].Width := AWidth;
|
---|
247 | if couldSet and (i=0) and (AWidth>0) then
|
---|
248 | frmOrders.EvtColWidth := AWidth;
|
---|
249 | end;
|
---|
250 | if AControl is TCustomGrid then {nothing for now};
|
---|
251 | end;
|
---|
252 |
|
---|
253 | procedure SaveUserBounds(AControl: TControl);
|
---|
254 | var
|
---|
255 | x: string;
|
---|
256 | begin
|
---|
257 | if (AControl is TForm) and (TForm(AControl).WindowState = wsMaximized) then
|
---|
258 | x := '0,0,0,0'
|
---|
259 | else
|
---|
260 | with AControl do
|
---|
261 | x := IntToStr(Left) + ',' + IntToStr(Top) + ',' +
|
---|
262 | IntToStr(Width) + ',' + IntToStr(Height);
|
---|
263 | // CallV('ORWCH SAVESIZ', [AControl.Name, x]);
|
---|
264 | SizeHolder.SetSize(AControl.Name, x);
|
---|
265 | end;
|
---|
266 |
|
---|
267 | procedure SaveUserSizes(SizingList: TStringList);
|
---|
268 | begin
|
---|
269 | CallV('ORWCH SAVEALL', [SizingList]);
|
---|
270 | end;
|
---|
271 |
|
---|
272 | procedure SaveUserFontSize( FontSize: integer);
|
---|
273 | begin
|
---|
274 | CallV('ORWCH SAVFONT', [IntToStr(FontSize)]);
|
---|
275 | end;
|
---|
276 |
|
---|
277 | procedure SetFormPosition(AForm: TForm);
|
---|
278 | var
|
---|
279 | x: string;
|
---|
280 | Rect: TRect;
|
---|
281 | begin
|
---|
282 | // x := sCallV('ORWCH LOADSIZ', [AForm.Name]);
|
---|
283 | x := SizeHolder.GetSize(AForm.Name);
|
---|
284 | if x = '' then Exit; // allow default bounds to be passed in, else screen center?
|
---|
285 | if (x = '0,0,0,0') then
|
---|
286 | AForm.WindowState := wsMaximized
|
---|
287 | else
|
---|
288 | begin
|
---|
289 | AForm.SetBounds(StrToIntDef(Piece(x, ',', 1), AForm.Left),
|
---|
290 | StrToIntDef(Piece(x, ',', 2), AForm.Top),
|
---|
291 | StrToIntDef(Piece(x, ',', 3), AForm.Width),
|
---|
292 | StrToIntDef(Piece(x, ',', 4), AForm.Height));
|
---|
293 | Rect := AForm.BoundsRect;
|
---|
294 | ForceInsideWorkArea(Rect);
|
---|
295 | AForm.BoundsRect := Rect;
|
---|
296 | end;
|
---|
297 | end;
|
---|
298 |
|
---|
299 | function StrUserBounds(AControl: TControl): string;
|
---|
300 | var
|
---|
301 | x: string;
|
---|
302 | begin
|
---|
303 | x := AControl.Name;
|
---|
304 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
305 | with AControl do Result := 'B' + U + x + U + IntToStr(Left) + ',' + IntToStr(Top) + ',' +
|
---|
306 | IntToStr(Width) + ',' + IntToStr(Height);
|
---|
307 | if (AControl is TForm) and (TForm(AControl).WindowState = wsMaximized)
|
---|
308 | then Result := 'B' + U + x + U + '0,0,0,0';
|
---|
309 | end;
|
---|
310 |
|
---|
311 | function StrUserBounds2(AName: string; v1, v2, v3, v4: integer): string;
|
---|
312 | begin
|
---|
313 | Result := 'B' + U + AName + U + IntToStr(v1) + ',' + IntToStr(v2) + ',' +
|
---|
314 | IntToStr(v3) + ',' + IntToStr(v4);
|
---|
315 | end;
|
---|
316 |
|
---|
317 | function StrUserWidth(AControl: TControl): string;
|
---|
318 | var
|
---|
319 | x: string;
|
---|
320 | begin
|
---|
321 | x := AControl.Name;
|
---|
322 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
323 | with AControl do Result := 'W' + U + x + U + IntToStr(Width);
|
---|
324 | end;
|
---|
325 |
|
---|
326 | function StrUserColumns(AControl: TControl): string;
|
---|
327 | var
|
---|
328 | x: string;
|
---|
329 | i: Integer;
|
---|
330 | shouldSave: boolean;
|
---|
331 | begin
|
---|
332 | shouldSave := False;
|
---|
333 | x := AControl.Name;
|
---|
334 | if not (AControl is TForm) and (Assigned(AControl.Owner)) then x := AControl.Owner.Name + '.' + x;
|
---|
335 | if AnsiCompareText(x,'frmOrders.hdrOrders') = 0 then
|
---|
336 | shouldSave := True;
|
---|
337 | Result := 'C' + U + x + U;
|
---|
338 | if AControl is THeaderControl then with THeaderControl(AControl) do
|
---|
339 | for i := 0 to Sections.Count - 1 do
|
---|
340 | begin
|
---|
341 | if shouldSave and (i = 0) then
|
---|
342 | Result := Result + IntToStr(frmOrders.EvtColWidth) + ','
|
---|
343 | else
|
---|
344 | Result := Result + IntToStr(Sections.Items[i].Width) + ',';
|
---|
345 | end;
|
---|
346 | if AControl is TCustomGrid then {nothing for now};
|
---|
347 | if CharAt(Result, Length(Result)) = ',' then Result := Copy(Result, 1, Length(Result) - 1);
|
---|
348 | end;
|
---|
349 |
|
---|
350 | { TSizeHolder }
|
---|
351 |
|
---|
352 | procedure TSizeHolder.AddSizesToStrList(theList: TStringList);
|
---|
353 | {Adds all the Sizes in the TSizeHolder Object to theList String list parameter}
|
---|
354 | var
|
---|
355 | i: integer;
|
---|
356 | begin
|
---|
357 | for i := 0 to FNameList.Count-1 do begin
|
---|
358 | if Piece(FNameList[i],U,1) = 'C' then
|
---|
359 | theList.Add(FNameList[i] + U + FSizeList[i])
|
---|
360 | else
|
---|
361 | theList.Add('B' + U + FNameList[i] + U + FSizeList[i]);
|
---|
362 | end;
|
---|
363 | end;
|
---|
364 |
|
---|
365 | constructor TSizeHolder.Create;
|
---|
366 | begin
|
---|
367 | inherited;
|
---|
368 | FNameList := TStringList.Create;
|
---|
369 | FSizeList := TStringList.Create;
|
---|
370 | end;
|
---|
371 |
|
---|
372 |
|
---|
373 | destructor TSizeHolder.Destroy;
|
---|
374 | begin
|
---|
375 | FNameList.Free;
|
---|
376 | FSizeList.Free;
|
---|
377 | inherited;
|
---|
378 | end;
|
---|
379 |
|
---|
380 | function TSizeHolder.GetSize(AName: String): String;
|
---|
381 | {Fuctions returns a String of the Size(s) Of the Name parameter passed,
|
---|
382 | if the Size(s) are already loaded into the object it will return those,
|
---|
383 | otherwise it will make the apropriate RPC call to LOADSIZ}
|
---|
384 | var
|
---|
385 | rSizeVal: String; //return Size value
|
---|
386 | nameIndex: integer;
|
---|
387 | begin
|
---|
388 | rSizeVal := '';
|
---|
389 | nameIndex := FNameList.IndexOf(AName);
|
---|
390 | if nameIndex = -1 then //Currently Not in the NameList
|
---|
391 | begin
|
---|
392 | rSizeVal := sCallV('ORWCH LOADSIZ', [AName]);
|
---|
393 | if rSizeVal <> '' then
|
---|
394 | begin
|
---|
395 | FNameList.Add(AName);
|
---|
396 | FSizeList.Add(rSizeVal);
|
---|
397 | end;
|
---|
398 | end
|
---|
399 | else //Currently is in the NameList
|
---|
400 | rSizeVal := FSizeList[nameIndex];
|
---|
401 | if (rSizeVal = '') and (Piece(AName,U,1) = 'C') then begin
|
---|
402 | if not Assigned(uColumns) then LoadSizes;
|
---|
403 | rSizeVal := uColumns.Values[Piece(AName,U,2)];
|
---|
404 | end;
|
---|
405 | result := rSizeVal;
|
---|
406 | end;
|
---|
407 |
|
---|
408 | procedure TSizeHolder.SetSize(AName, ASize: String);
|
---|
409 | {Store the Size(s) Of the ASize parameter passed, Associate it with the AName
|
---|
410 | Parameter. This only stores the sizes in the objects member variables.
|
---|
411 | to Store on the MUMPS Database call SendSizesToDB()}
|
---|
412 | var
|
---|
413 | nameIndex: integer;
|
---|
414 | begin
|
---|
415 | nameIndex := FNameList.IndexOf(AName);
|
---|
416 | if nameIndex = -1 then //Currently Not in the NameList
|
---|
417 | begin
|
---|
418 | FNameList.Add(AName);
|
---|
419 | FSizeList.Add(ASize);
|
---|
420 | end
|
---|
421 | else //Currently is in the NameList
|
---|
422 | FSizeList[nameIndex] := ASize;
|
---|
423 | end;
|
---|
424 |
|
---|
425 | initialization
|
---|
426 | // nothing for now
|
---|
427 |
|
---|
428 | finalization
|
---|
429 | if uBounds <> nil then uBounds.Free;
|
---|
430 | if uWidths <> nil then uWidths.Free;
|
---|
431 | if uColumns <> nil then uColumns.Free;
|
---|
432 |
|
---|
433 | end.
|
---|