source: cprs/trunk/CPRS-Chart/Orders/uODBase.pas

Last change on this file was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 8.7 KB
Line 
1unit uODBase;
2
3interface
4
5uses
6 Classes, ORFn, uConst;
7
8{ Order Checking }
9function AddFillerAppID(const AnID: string): Boolean;
10procedure ClearFillerAppList;
11
12{ Ordering Environment }
13procedure SetOrderFormIDOnCreate(AFormID: Integer);
14function OrderFormIDOnCreate: Integer;
15procedure SetOrderEventTypeOnCreate(AType: Char);
16function OrderEventTypeOnCreate: Char;
17procedure SetOrderEventIDOnCreate(AnEvtID: integer);
18function OrderEventIDOnCreate: integer;
19procedure SetOrderEventNameOnCreate(AnEvtNm: string);
20function OrderEventNameOnCreate: string;
21function GetKeyVars: string;
22procedure PopKeyVars(NumLevels: Integer = 1);
23procedure PushKeyVars(const NewVals: string);
24procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
25procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
26 var CancelText: string; Sender: TObject);
27
28implementation
29
30uses
31 dShared, Windows, rTemplates, SysUtils, StdCtrls, fOrders, rOrders;
32
33var
34 uOrderEventType: Char;
35 uOrderEventID: Integer;
36 uOrderEventName: string;
37 uOrderFormID: Integer;
38 uFillerAppID: TStringList;
39 uKeyVarList: TStringList;
40
41{ Order Checking }
42
43function AddFillerAppID(const AnID: string): Boolean;
44begin
45 Result := False;
46 if uFillerAppID.IndexOf(AnID) < 0 then
47 begin
48 Result := True;
49 uFillerAppID.Add(AnID);
50 end;
51end;
52
53procedure ClearFillerAppList;
54begin
55 uFillerAppID.Clear;
56end;
57
58{ Ordering Environment }
59
60procedure SetOrderFormIDOnCreate(AFormID: Integer);
61begin
62 uOrderFormID := AFormID;
63end;
64
65function OrderFormIDOnCreate: Integer;
66begin
67 Result := uOrderFormID;
68end;
69
70procedure SetOrderEventTypeOnCreate(AType: Char);
71begin
72 uOrderEventType := AType;
73end;
74
75function OrderEventTypeOnCreate: Char;
76begin
77 Result := uOrderEventType;
78end;
79
80procedure SetOrderEventIDOnCreate(AnEvtID: Integer);
81begin
82 uOrderEventID := AnEvtID;
83end;
84
85procedure SetOrderEventNameOnCreate(AnEvtNm: string);
86begin
87 uOrderEventName := AnEvtNm;
88end;
89
90function OrderEventNameOnCreate: string;
91begin
92 Result := uOrderEventName;
93end;
94
95function OrderEventIDOnCreate: integer;
96begin
97 Result := uOrderEventID;
98end;
99
100function GetKeyVars: string;
101begin
102 Result := '';
103 with uKeyVarList do if Count > 0 then Result := Strings[Count - 1];
104end;
105
106procedure PopKeyVars(NumLevels: Integer = 1);
107begin
108 with uKeyVarList do while (NumLevels > 0) and (Count > 0) do
109 begin
110 Delete(Count - 1);
111 Dec(NumLevels);
112 end;
113end;
114
115procedure PushKeyVars(const NewVals: string);
116var
117 i: Integer;
118 x: string;
119begin
120 if uKeyVarList.Count > 0 then x := uKeyVarList[uKeyVarList.Count - 1] else x := '';
121 for i := 1 to MAX_KEYVARS do
122 if Piece(NewVals, U, i) <> '' then SetPiece(x, U, i, Piece(NewVals, U, i));
123 uKeyVarList.Add(x);
124end;
125
126procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
127var
128 ObjList: TStringList;
129 Err: TStringList;
130 i, j, k, oLen: integer;
131 obj, ObjTxt: string;
132const
133 CRDelim = #13;
134 TC_BOILER_ERR = 'Order Boilerplate Object Error';
135 TX_BOILER_ERR = 'Contact IRM and inform them about this error.' + CRLF +
136 'Make sure you give them the name of the quick' + CRLF +
137 'order that you are processing.' ;
138begin
139 ObjList := TStringList.Create;
140 try
141 Err := nil;
142 if(not dmodShared.BoilerplateOK(Txt, CRDelim, ObjList, Err)) and (assigned(Err)) then
143 begin
144 try
145 Err.Add(CRLF + TX_BOILER_ERR);
146 InfoBox(Err.Text, TC_BOILER_ERR, MB_OK + MB_ICONERROR);
147 finally
148 Err.Free;
149 end;
150 end;
151 if(ObjList.Count > 0) then
152 begin
153 ContainsObjects := True;
154 GetTemplateText(ObjList);
155 i := 0;
156 while (i < ObjList.Count) do
157 begin
158 if(pos(ObjMarker, ObjList[i]) = 1) then
159 begin
160 obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
161 if(obj = '') then break;
162 j := i + 1;
163 while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
164 inc(j);
165 if((j - i) > 2) then
166 begin
167 ObjTxt := '';
168 for k := i+1 to j-1 do
169 ObjTxt := ObjTxt + #13 + ObjList[k];
170 end
171 else
172 ObjTxt := ObjList[i+1];
173 i := j;
174 obj := '|' + obj + '|';
175 oLen := length(obj);
176 repeat
177 j := pos(obj, Txt);
178 if(j > 0) then
179 begin
180 delete(Txt, j, OLen);
181 insert(ObjTxt, Txt, j);
182 end;
183 until(j = 0);
184 end
185 else
186 inc(i);
187 end
188 end;
189 finally
190 ObjList.Free;
191 end;
192end;
193
194// Check for diet orders that will be auto-DCd on release because of start/stop overlaps.
195// Moved here for visibility because it also needs to be checked on an auto-accept order.
196procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
197 var CancelText: string; Sender: TObject);
198const
199 TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
200 'you specify a start date for when the new diet should replace the current' + CRLF +
201 'diet:' + CRLF + CRLF;
202 TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
203 TX_CX_DELAYED1 = 'There are other delayed diet orders for this release event:';
204 TX_CX_DELAYED2 = 'This new diet order may cancel and replace those other diets' + CRLF +
205 'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
206
207 '1. Specify an expiration date/time for this order that will' + CRLF +
208 ' be prior to the start date/time of those other orders; or' + CRLF + CRLF +
209
210 '2. Specify a later start date/time for this order for when you' + CRLF +
211 ' would like it to cancel and replace those other orders.';
212
213var
214 i: integer;
215 AStringList: TStringList;
216 AList: TList;
217 x, PtEvtIFN, PtEvtName: string;
218 //AResponse: TResponse;
219begin
220 if EvtID = 0 then // check current and future released diets
221 begin
222 x := CurrentText;
223 if Piece(x, #13, 1) <> 'Current Diet: ' then
224 begin
225 AStringList := TStringList.Create;
226 try
227 AStringList.Text := x;
228 CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
229 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
230 if AStringList.Count > 1 then
231 begin
232 CancelText := CancelText + CRLF + CRLF +
233 TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
234 + #9 + Copy(AStringList[1], 22, 99) + CRLF;
235 if AStringList.Count > 2 then
236 for i := 2 to AStringList.Count - 1 do
237 CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
238 end;
239 finally
240 AStringList.Free;
241 end;
242 end;
243 end
244 else if Sender is TButton then // delayed orders code here - on accept only
245 begin
246 //AResponse := Responses.FindResponseByName('STOP', 1);
247 //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
248 AList := TList.Create;
249 try
250 PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
251 PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
252 LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
253 for i := AList.Count - 1 downto 0 do
254 begin
255 if TOrder(Alist.Items[i]).DGroup <> DispGrp then
256 begin
257 TOrder(AList.Items[i]).Free;
258 AList.Delete(i);
259 end;
260 end;
261 if AList.Count > 0 then
262 begin
263 x := '';
264 RetrieveOrderFields(AList, 0, 0);
265 CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName;
266 for i := 0 to AList.Count - 1 do
267 with TOrder(AList.Items[i]) do
268 begin
269 x := x + #9 + Text + CRLF;
270(* if StartTime <> '' then
271 x := #9 + x + 'Start: ' + StartTime + CRLF
272 else
273 x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
274 end;
275 CancelText := CancelText + CRLF + CRLF + x;
276 CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
277 end;
278 finally
279 with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
280 AList.Free;
281 end;
282 end;
283end;
284
285
286initialization
287 uOrderEventType := #0;
288 uOrderFormID := 0;
289 uOrderEventName := '';
290 uFillerAppID := TStringList.Create;
291 uKeyVarList := TStringList.Create;
292
293finalization
294 uFillerAppID.Free;
295 uKeyVarList.Free;
296
297end.
Note: See TracBrowser for help on using the repository browser.