source: cprs/branches/foia-cprs/CPRS-Chart/Orders/uODBase.pas@ 1568

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

Uploading from OR_30_258

File size: 4.8 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 = '');
25
26implementation
27
28uses
29 dShared, Windows, rTemplates;
30
31var
32 uOrderEventType: Char;
33 uOrderEventID: Integer;
34 uOrderEventName: string;
35 uOrderFormID: Integer;
36 uFillerAppID: TStringList;
37 uKeyVarList: TStringList;
38
39{ Order Checking }
40
41function AddFillerAppID(const AnID: string): Boolean;
42begin
43 Result := False;
44 if uFillerAppID.IndexOf(AnID) < 0 then
45 begin
46 Result := True;
47 uFillerAppID.Add(AnID);
48 end;
49end;
50
51procedure ClearFillerAppList;
52begin
53 uFillerAppID.Clear;
54end;
55
56{ Ordering Environment }
57
58procedure SetOrderFormIDOnCreate(AFormID: Integer);
59begin
60 uOrderFormID := AFormID;
61end;
62
63function OrderFormIDOnCreate: Integer;
64begin
65 Result := uOrderFormID;
66end;
67
68procedure SetOrderEventTypeOnCreate(AType: Char);
69begin
70 uOrderEventType := AType;
71end;
72
73function OrderEventTypeOnCreate: Char;
74begin
75 Result := uOrderEventType;
76end;
77
78procedure SetOrderEventIDOnCreate(AnEvtID: Integer);
79begin
80 uOrderEventID := AnEvtID;
81end;
82
83procedure SetOrderEventNameOnCreate(AnEvtNm: string);
84begin
85 uOrderEventName := AnEvtNm;
86end;
87
88function OrderEventNameOnCreate: string;
89begin
90 Result := uOrderEventName;
91end;
92
93function OrderEventIDOnCreate: integer;
94begin
95 Result := uOrderEventID;
96end;
97
98function GetKeyVars: string;
99begin
100 Result := '';
101 with uKeyVarList do if Count > 0 then Result := Strings[Count - 1];
102end;
103
104procedure PopKeyVars(NumLevels: Integer = 1);
105begin
106 with uKeyVarList do while (NumLevels > 0) and (Count > 0) do
107 begin
108 Delete(Count - 1);
109 Dec(NumLevels);
110 end;
111end;
112
113procedure PushKeyVars(const NewVals: string);
114var
115 i: Integer;
116 x: string;
117begin
118 if uKeyVarList.Count > 0 then x := uKeyVarList[uKeyVarList.Count - 1] else x := '';
119 for i := 1 to MAX_KEYVARS do
120 if Piece(NewVals, U, i) <> '' then SetPiece(x, U, i, Piece(NewVals, U, i));
121 uKeyVarList.Add(x);
122end;
123
124procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
125var
126 ObjList: TStringList;
127 Err: TStringList;
128 i, j, k, oLen: integer;
129 obj, ObjTxt: string;
130const
131 CRDelim = #13;
132 TC_BOILER_ERR = 'Order Boilerplate Object Error';
133 TX_BOILER_ERR = 'Contact IRM and inform them about this error.' + CRLF +
134 'Make sure you give them the name of the quick' + CRLF +
135 'order that you are processing.' ;
136begin
137 ObjList := TStringList.Create;
138 try
139 Err := nil;
140 if(not dmodShared.BoilerplateOK(Txt, CRDelim, ObjList, Err)) and (assigned(Err)) then
141 begin
142 try
143 Err.Add(CRLF + TX_BOILER_ERR);
144 InfoBox(Err.Text, TC_BOILER_ERR, MB_OK + MB_ICONERROR);
145 finally
146 Err.Free;
147 end;
148 end;
149 if(ObjList.Count > 0) then
150 begin
151 ContainsObjects := True;
152 GetTemplateText(ObjList);
153 i := 0;
154 while (i < ObjList.Count) do
155 begin
156 if(pos(ObjMarker, ObjList[i]) = 1) then
157 begin
158 obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
159 if(obj = '') then break;
160 j := i + 1;
161 while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
162 inc(j);
163 if((j - i) > 2) then
164 begin
165 ObjTxt := '';
166 for k := i+1 to j-1 do
167 ObjTxt := ObjTxt + #13 + ObjList[k];
168 end
169 else
170 ObjTxt := ObjList[i+1];
171 i := j;
172 obj := '|' + obj + '|';
173 oLen := length(obj);
174 repeat
175 j := pos(obj, Txt);
176 if(j > 0) then
177 begin
178 delete(Txt, j, OLen);
179 insert(ObjTxt, Txt, j);
180 end;
181 until(j = 0);
182 end
183 else
184 inc(i);
185 end
186 end;
187 finally
188 ObjList.Free;
189 end;
190end;
191
192initialization
193 uOrderEventType := #0;
194 uOrderFormID := 0;
195 uOrderEventName := '';
196 uFillerAppID := TStringList.Create;
197 uKeyVarList := TStringList.Create;
198
199finalization
200 uFillerAppID.Free;
201 uKeyVarList.Free;
202
203end.
Note: See TracBrowser for help on using the repository browser.