1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
2 | unit fVisitType;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
8 | fPCEBase, StdCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn, rCore,
|
---|
9 | ComCtrls, mVisitRelated, DKLang;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TfrmVisitType = class(TfrmPCEBase)
|
---|
13 | lblVType: TLabel;
|
---|
14 | lblSCDisplay: TLabel;
|
---|
15 | lblVTypeSection: TLabel;
|
---|
16 | memSCDisplay: TCaptionMemo;
|
---|
17 | lbProviders: TORListBox;
|
---|
18 | lblCurrentProv: TLabel;
|
---|
19 | cboPtProvider: TORComboBox;
|
---|
20 | lblProvider: TLabel;
|
---|
21 | btnAdd: TButton;
|
---|
22 | btnDelete: TButton;
|
---|
23 | btnPrimary: TButton;
|
---|
24 | fraVisitRelated: TfraVisitRelated;
|
---|
25 | lstVTypeSection: TORListBox;
|
---|
26 | lbxVisits: TORListBox;
|
---|
27 | lbMods: TORListBox;
|
---|
28 | lblMod: TLabel;
|
---|
29 | pnlMain: TPanel;
|
---|
30 | pnlLeft: TPanel;
|
---|
31 | splLeft: TSplitter;
|
---|
32 | procedure lstVTypeSectionClick(Sender: TObject);
|
---|
33 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
---|
34 | procedure FormCreate(Sender: TObject);
|
---|
35 | procedure btnAddClick(Sender: TObject);
|
---|
36 | procedure btnDeleteClick(Sender: TObject);
|
---|
37 | procedure btnPrimaryClick(Sender: TObject);
|
---|
38 | procedure cboPtProviderDblClick(Sender: TObject);
|
---|
39 | procedure cboPtProviderChange(Sender: TObject);
|
---|
40 | procedure cboPtProviderNeedData(Sender: TObject;
|
---|
41 | const StartFrom: String; Direction, InsertAt: Integer);
|
---|
42 | procedure lbProvidersChange(Sender: TObject);
|
---|
43 | procedure lbProvidersDblClick(Sender: TObject);
|
---|
44 | procedure FormResize(Sender: TObject);
|
---|
45 | procedure lbxVisitsClickCheck(Sender: TObject; Index: Integer);
|
---|
46 | procedure splLeftMoved(Sender: TObject);
|
---|
47 | procedure splRightMoved(Sender: TObject);
|
---|
48 | procedure lbModsClickCheck(Sender: TObject; Index: Integer);
|
---|
49 | procedure lbxVisitsClick(Sender: TObject);
|
---|
50 | protected
|
---|
51 | FSplitterMove: boolean;
|
---|
52 | procedure ShowModifiers;
|
---|
53 | procedure CheckModifiers;
|
---|
54 | private
|
---|
55 | FChecking: boolean;
|
---|
56 | FCheckingMods: boolean;
|
---|
57 | FLastCPTCodes: string;
|
---|
58 | FLastMods: string;
|
---|
59 | procedure RefreshProviders;
|
---|
60 | procedure UpdateProviderButtons;
|
---|
61 | public
|
---|
62 | procedure MatchVType;
|
---|
63 | end;
|
---|
64 |
|
---|
65 | var
|
---|
66 | frmVisitType: TfrmVisitType;
|
---|
67 | USCchecked:boolean = false;
|
---|
68 | // PriProv: Int64;
|
---|
69 | PriProv: Int64;
|
---|
70 |
|
---|
71 | const
|
---|
72 | LBCheckWidthSpace = 18;
|
---|
73 |
|
---|
74 | implementation
|
---|
75 |
|
---|
76 | {$R *.DFM}
|
---|
77 |
|
---|
78 | uses
|
---|
79 | fEncounterFrame, uCore, uConst;
|
---|
80 |
|
---|
81 | const
|
---|
82 | FN_NEW_PERSON = 200;
|
---|
83 |
|
---|
84 | procedure TfrmVisitType.MatchVType;
|
---|
85 | var
|
---|
86 | i: Integer;
|
---|
87 | Found: Boolean;
|
---|
88 | begin
|
---|
89 | with uVisitType do
|
---|
90 | begin
|
---|
91 | if Code = '' then Exit;
|
---|
92 | Found := False;
|
---|
93 | with lstVTypeSection do for i := 0 to Items.Count - 1 do
|
---|
94 | if Piece(Items[i], U, 2) = Category then
|
---|
95 | begin
|
---|
96 | ItemIndex := i;
|
---|
97 | lstVTypeSectionClick(Self);
|
---|
98 | Found := True;
|
---|
99 | break;
|
---|
100 | end;
|
---|
101 | if Found then for i := 0 to lbxVisits.Items.Count - 1 do
|
---|
102 | if Pieces(lbxVisits.Items[i], U, 1, 2) = Code + U + Narrative then
|
---|
103 | begin
|
---|
104 | lbxVisits.ItemIndex := i;
|
---|
105 | FChecking := TRUE;
|
---|
106 | try
|
---|
107 | lbxVisits.Checked[i] := True;
|
---|
108 | lbxVisitsClickCheck(Self, i);
|
---|
109 | finally
|
---|
110 | FChecking := FALSE;
|
---|
111 | end;
|
---|
112 | end;
|
---|
113 | end;
|
---|
114 | end;
|
---|
115 |
|
---|
116 | procedure TfrmVisitType.lstVTypeSectionClick(Sender: TObject);
|
---|
117 | var
|
---|
118 | i: Integer;
|
---|
119 | begin
|
---|
120 | inherited;
|
---|
121 | ListVisitTypeCodes(lbxVisits.Items, lstVTypeSection.ItemIEN);
|
---|
122 | with uVisitType do for i := 0 to lbxVisits.Items.Count - 1 do
|
---|
123 | begin
|
---|
124 | if ((uVisitType <> nil) and (Pieces(lbxVisits.Items[i], U, 1, 2) = Code + U + Narrative)) then
|
---|
125 | begin
|
---|
126 | FChecking := TRUE;
|
---|
127 | try
|
---|
128 | lbxVisits.Checked[i] := True;
|
---|
129 | lbxVisits.ItemIndex := i;
|
---|
130 | finally
|
---|
131 | FChecking := FALSE;
|
---|
132 | end;
|
---|
133 | end;
|
---|
134 | end;
|
---|
135 | lbxVisitsClick(Self);
|
---|
136 | end;
|
---|
137 |
|
---|
138 | procedure TfrmVisitType.FormCloseQuery(Sender: TObject;
|
---|
139 | var CanClose: Boolean);
|
---|
140 | begin
|
---|
141 | inherited;
|
---|
142 | //process before closing
|
---|
143 |
|
---|
144 | end;
|
---|
145 |
|
---|
146 | (*function ExposureAnswered: Boolean;
|
---|
147 | begin
|
---|
148 | result := false;
|
---|
149 | //if SC answered set result = true
|
---|
150 | end;*)
|
---|
151 |
|
---|
152 |
|
---|
153 | procedure TfrmVisitType.RefreshProviders;
|
---|
154 | var
|
---|
155 | i: integer;
|
---|
156 | ProvData: TPCEProviderRec;
|
---|
157 | ProvEntry: string;
|
---|
158 |
|
---|
159 | begin
|
---|
160 | lbProviders.Clear;
|
---|
161 | for i := 0 to uProviders.count-1 do
|
---|
162 | begin
|
---|
163 | ProvData := uProviders[i];
|
---|
164 | ProvEntry := IntToStr(ProvData.IEN) + U + ProvData.Name;
|
---|
165 | if(ProvData.Primary) then
|
---|
166 | // ProvEntry := ProvEntry + ' (Primary)'; <-- original line. //kt 8/8/2007
|
---|
167 | ProvEntry := ProvEntry + DKLangConstW('fVisitType_xPrimaryx'); //kt added 8/8/2007
|
---|
168 | lbProviders.Items.Add(ProvEntry);
|
---|
169 | end;
|
---|
170 | UpdateProviderButtons;
|
---|
171 | end;
|
---|
172 |
|
---|
173 | procedure TfrmVisitType.FormCreate(Sender: TObject);
|
---|
174 | var
|
---|
175 | AIEN: Int64;
|
---|
176 |
|
---|
177 | begin
|
---|
178 | inherited;
|
---|
179 | FTabName := CT_VisitNm;
|
---|
180 | FSectionTabCount := 2;
|
---|
181 | FormResize(Self);
|
---|
182 | AIEN := uProviders.PendingIEN(TRUE);
|
---|
183 | if(AIEN = 0) then
|
---|
184 | begin
|
---|
185 | AIEN := uProviders.PendingIEN(FALSE);
|
---|
186 | if(AIEN = 0) then
|
---|
187 | begin
|
---|
188 | cboPtProvider.InitLongList(User.Name);
|
---|
189 | AIEN := User.DUZ;
|
---|
190 | end
|
---|
191 | else
|
---|
192 | cboPtProvider.InitLongList(uProviders.PendingName(FALSE));
|
---|
193 | cboPtProvider.SelectByIEN(AIEN);
|
---|
194 | end
|
---|
195 | else
|
---|
196 | begin
|
---|
197 | cboPtProvider.InitLongList(uProviders.PendingName(TRUE));
|
---|
198 | cboPtProvider.SelectByIEN(AIEN);
|
---|
199 | end;
|
---|
200 | RefreshProviders;
|
---|
201 | FLastMods := uEncPCEData.VisitType.Modifiers;
|
---|
202 | end;
|
---|
203 |
|
---|
204 | (*procedure TfrmVisitType.SynchEncounterProvider;
|
---|
205 | // add the Encounter.Provider if this note is for the current encounter
|
---|
206 | var
|
---|
207 | ProviderFound, PrimaryFound: Boolean;
|
---|
208 | i: Integer;
|
---|
209 | AProvider: TPCEProvider;
|
---|
210 | begin
|
---|
211 | if (FloatToStrF(uEncPCEData.DateTime, ffFixed, 15, 4) = // compensate rounding errors
|
---|
212 | FloatToStrF(Encounter.DateTime, ffFixed, 15, 4)) and
|
---|
213 | (uEncPCEData.Location = Encounter.Location) and
|
---|
214 | (Encounter.Provider > 0) then
|
---|
215 | begin
|
---|
216 | ProviderFound := False;
|
---|
217 | PrimaryFound := False;
|
---|
218 | for i := 0 to ProviderLst.Count - 1 do
|
---|
219 | begin
|
---|
220 | AProvider := TPCEProvider(ProviderLst.Items[i]);
|
---|
221 | if AProvider.IEN = Encounter.Provider then ProviderFound := True;
|
---|
222 | if AProvider.Primary = '1' then PrimaryFound := True;
|
---|
223 | end;
|
---|
224 | if not ProviderFound then
|
---|
225 | begin
|
---|
226 | AProvider := TPCEProvider.Create;
|
---|
227 | AProvider.IEN := Encounter.Provider;
|
---|
228 | AProvider.Name := ExternalName(Encounter.Provider, FN_NEW_PERSON);
|
---|
229 | if not PrimaryFound then
|
---|
230 | begin
|
---|
231 | AProvider.Primary := '1';
|
---|
232 | uProvider := Encounter.Provider;
|
---|
233 | end
|
---|
234 | else AProvider.Primary := '0';
|
---|
235 | AProvider.Delete := False;
|
---|
236 | ProviderLst.Add(AProvider);
|
---|
237 | end;
|
---|
238 | end;
|
---|
239 | end;
|
---|
240 | *)
|
---|
241 |
|
---|
242 | procedure TfrmVisitType.UpdateProviderButtons;
|
---|
243 | var
|
---|
244 | ok: boolean;
|
---|
245 |
|
---|
246 | begin
|
---|
247 | ok := (lbProviders.ItemIndex >= 0);
|
---|
248 | btnDelete.Enabled := ok;
|
---|
249 | btnPrimary.Enabled := ok;
|
---|
250 | btnAdd.Enabled := (cboPtProvider.ItemIEN <> 0);
|
---|
251 | end;
|
---|
252 |
|
---|
253 | procedure TfrmVisitType.btnAddClick(Sender: TObject);
|
---|
254 | begin
|
---|
255 | inherited;
|
---|
256 | uProviders.AddProvider(IntToStr(cboPTProvider.ItemIEN), cboPTProvider.Text, FALSE);
|
---|
257 | RefreshProviders;
|
---|
258 | lbProviders.SelectByIEN(cboPTProvider.ItemIEN);
|
---|
259 | end;
|
---|
260 |
|
---|
261 | procedure TfrmVisitType.btnDeleteClick(Sender: TObject);
|
---|
262 | var
|
---|
263 | idx: integer;
|
---|
264 |
|
---|
265 | begin
|
---|
266 | inherited;
|
---|
267 | If lbProviders.ItemIndex = -1 then exit;
|
---|
268 | idx := uProviders.IndexOfProvider(lbProviders.ItemID);
|
---|
269 | if(idx >= 0) then
|
---|
270 | uProviders.Delete(idx);
|
---|
271 | RefreshProviders;
|
---|
272 | end;
|
---|
273 |
|
---|
274 | procedure TfrmVisitType.btnPrimaryClick(Sender: TObject);
|
---|
275 | var
|
---|
276 | idx: integer;
|
---|
277 | AIEN: Int64;
|
---|
278 |
|
---|
279 | begin
|
---|
280 | inherited;
|
---|
281 | if lbProviders.ItemIndex = -1 then exit;
|
---|
282 | AIEN := lbProviders.ItemIEN;
|
---|
283 | idx := uProviders.IndexOfProvider(IntToStr(AIEN));
|
---|
284 | if(idx >= 0) then
|
---|
285 | uProviders.PrimaryIdx := idx;
|
---|
286 | RefreshProviders;
|
---|
287 | lbProviders.SelectByIEN(AIEN);
|
---|
288 | end;
|
---|
289 |
|
---|
290 | procedure TfrmVisitType.cboPtProviderDblClick(Sender: TObject);
|
---|
291 | begin
|
---|
292 | inherited;
|
---|
293 | btnAddClick(Sender);
|
---|
294 | end;
|
---|
295 |
|
---|
296 | procedure TfrmVisitType.cboPtProviderChange(Sender: TObject);
|
---|
297 | begin
|
---|
298 | inherited;
|
---|
299 | UpdateProviderButtons;
|
---|
300 | end;
|
---|
301 |
|
---|
302 | procedure TfrmVisitType.cboPtProviderNeedData(Sender: TObject;
|
---|
303 | const StartFrom: String; Direction, InsertAt: Integer);
|
---|
304 | begin
|
---|
305 | inherited;
|
---|
306 | if(uEncPCEData.VisitCategory = 'E') then
|
---|
307 | cboPtProvider.ForDataUse(SubSetOfPersons(StartFrom, Direction))
|
---|
308 | else
|
---|
309 | cboPtProvider.ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction,
|
---|
310 | FloatToStr(uEncPCEData.PersonClassDate)));
|
---|
311 | end;
|
---|
312 |
|
---|
313 | procedure TfrmVisitType.lbProvidersChange(Sender: TObject);
|
---|
314 | begin
|
---|
315 | inherited;
|
---|
316 | UpdateProviderButtons;
|
---|
317 | end;
|
---|
318 |
|
---|
319 | procedure TfrmVisitType.lbProvidersDblClick(Sender: TObject);
|
---|
320 | begin
|
---|
321 | inherited;
|
---|
322 | btnDeleteClick(Sender);
|
---|
323 | end;
|
---|
324 |
|
---|
325 | procedure TfrmVisitType.FormResize(Sender: TObject);
|
---|
326 | var
|
---|
327 | v, i: integer;
|
---|
328 | s: string;
|
---|
329 | begin
|
---|
330 | if FSplitterMove then
|
---|
331 | FSplitterMove := FALSE
|
---|
332 | else
|
---|
333 | begin
|
---|
334 | inherited;
|
---|
335 | FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth);
|
---|
336 | FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth);
|
---|
337 | if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2;
|
---|
338 | lbxVisits.TabPositions := SectionString;
|
---|
339 | v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth);
|
---|
340 | s := '';
|
---|
341 | for i := 1 to 20 do
|
---|
342 | begin
|
---|
343 | if s <> '' then s := s + ',';
|
---|
344 | s := s + inttostr(v);
|
---|
345 | if(v<0) then
|
---|
346 | dec(v,32)
|
---|
347 | else
|
---|
348 | inc(v,32);
|
---|
349 | end;
|
---|
350 | lbMods.TabPositions := s;
|
---|
351 | end;
|
---|
352 | end;
|
---|
353 |
|
---|
354 | procedure TfrmVisitType.lbxVisitsClickCheck(Sender: TObject;
|
---|
355 | Index: Integer);
|
---|
356 | var
|
---|
357 | i: Integer;
|
---|
358 | x, CurCategory: string;
|
---|
359 | begin
|
---|
360 | inherited;
|
---|
361 | if FChecking or FClosing then exit;
|
---|
362 | for i := 0 to lbxVisits.Items.Count - 1 do
|
---|
363 | if i <> lbxVisits.ItemIndex then
|
---|
364 | begin
|
---|
365 | FChecking := TRUE;
|
---|
366 | try
|
---|
367 | uVisitType.Modifiers := '';
|
---|
368 | lbxVisits.Checked[i] := False;
|
---|
369 | finally
|
---|
370 | FChecking := FALSE;
|
---|
371 | end;
|
---|
372 | end;
|
---|
373 | if lbxVisits.Checked[lbxVisits.ItemIndex] then with uVisitType do
|
---|
374 | begin
|
---|
375 | with lstVTypeSection do CurCategory := Piece(Items[ItemIndex], U, 2);
|
---|
376 | x := Pieces(lbxVisits.Items[lbxVisits.ItemIndex], U, 1, 2);
|
---|
377 | x := 'CPT' + U + Piece(x, U, 1) + U + CurCategory + U + Piece(x, U, 2) + U + '1' + U
|
---|
378 | + IntToStr(uProviders.PrimaryIEN);
|
---|
379 | // + IntToStr(uProvider);
|
---|
380 | uVisitType.SetFromString(x);
|
---|
381 | end
|
---|
382 | else
|
---|
383 | begin
|
---|
384 | uVisitType.Clear;
|
---|
385 | //with lstVTypeSection do CurCategory := Piece(Items[ItemIndex], U, 2);
|
---|
386 | end;
|
---|
387 | end;
|
---|
388 |
|
---|
389 | procedure TfrmVisitType.ShowModifiers;
|
---|
390 | const
|
---|
391 | //ModTxt = 'Modifiers'; <-- original line. //kt 8/8/2007
|
---|
392 | //ForTxt = ' for '; <-- original line. //kt 8/8/2007
|
---|
393 | Spaces = ' ';
|
---|
394 |
|
---|
395 | var
|
---|
396 | TopIdx: integer;
|
---|
397 | // Needed,
|
---|
398 | Codes, VstName, Hint, Msg: string;
|
---|
399 | ModTxt : string; //kt
|
---|
400 | ForTxt : string; //kt
|
---|
401 |
|
---|
402 | begin
|
---|
403 | ModTxt := DKLangConstW('fVisitType_Modifiers'); //kt added 8/8/2007
|
---|
404 | ForTxt := DKLangConstW('fVisitType_for'); //kt added 8/8/2007
|
---|
405 | Codes := '';
|
---|
406 | VstName := '';
|
---|
407 | Hint := '';
|
---|
408 | if(Codes = '') and (lbxVisits.ItemIndex >= 0) then
|
---|
409 | begin
|
---|
410 | Codes := piece(lbxVisits.Items[lbxVisits.ItemIndex],U,1) + U;
|
---|
411 | VstName := piece(lbxVisits.Items[lbxVisits.ItemIndex],U,2);
|
---|
412 | Hint := VstName;
|
---|
413 | // Needed := piece(lbxVisit.Items[lbxVisit.ItemIndex],U,4); Don't show expired codes!
|
---|
414 | end;
|
---|
415 | msg := ModTxt;
|
---|
416 | if(VstName <> '') then
|
---|
417 | msg := msg + ForTxt;
|
---|
418 | lblMod.Caption := msg + VstName;
|
---|
419 | lbMods.Caption := lblMod.Caption;
|
---|
420 | if(pos(CRLF,Hint)>0) then
|
---|
421 | Hint := ':' + CRLF + Spaces + Hint;
|
---|
422 | lblMod.Hint := msg + Hint;
|
---|
423 |
|
---|
424 | if(FLastCPTCodes = Codes) then
|
---|
425 | TopIdx := lbMods.TopIndex
|
---|
426 | else
|
---|
427 | begin
|
---|
428 | TopIdx := 0;
|
---|
429 | FLastCPTCodes := Codes;
|
---|
430 | end;
|
---|
431 | ListCPTModifiers(lbMods.Items, Codes, ''); // Needed);
|
---|
432 | lbMods.TopIndex := TopIdx;
|
---|
433 | CheckModifiers;
|
---|
434 | end;
|
---|
435 |
|
---|
436 | procedure TfrmVisitType.CheckModifiers;
|
---|
437 | var
|
---|
438 | i, idx, cnt, mcnt: integer;
|
---|
439 | Code, Mods: string;
|
---|
440 | state: TCheckBoxState;
|
---|
441 |
|
---|
442 | begin
|
---|
443 | if lbMods.Items.Count < 1 then exit;
|
---|
444 | FCheckingMods := TRUE;
|
---|
445 | try
|
---|
446 | cnt := 0;
|
---|
447 | Mods := ';';
|
---|
448 | if uVisitType.Modifiers <> '' then
|
---|
449 | begin
|
---|
450 | inc(cnt);
|
---|
451 | Mods := Mods + uVisitType.Modifiers;
|
---|
452 | end;
|
---|
453 | if(cnt = 0) and (lbxVisits.ItemIndex >= 0) then
|
---|
454 | begin
|
---|
455 | Mods := ';' + UpdateVisitTypeModifierList(lbxVisits.Items, lbxVisits.ItemIndex);
|
---|
456 | lbxVisits.Checked[lbxVisits.ItemIndex] := True;
|
---|
457 | cnt := 1;
|
---|
458 | end;
|
---|
459 | for i := 0 to lbMods.Items.Count-1 do
|
---|
460 | begin
|
---|
461 | state := cbUnchecked;
|
---|
462 | if(cnt > 0) then
|
---|
463 | begin
|
---|
464 | Code := ';' + piece(lbMods.Items[i], U, 1) + ';';
|
---|
465 | mcnt := 0;
|
---|
466 | repeat
|
---|
467 | idx := pos(Code, Mods);
|
---|
468 | if(idx > 0) then
|
---|
469 | begin
|
---|
470 | inc(mcnt);
|
---|
471 | delete(Mods, idx, length(Code) - 1);
|
---|
472 | end;
|
---|
473 | until (idx = 0);
|
---|
474 | if mcnt >= cnt then
|
---|
475 | State := cbChecked
|
---|
476 | else
|
---|
477 | if(mcnt > 0) then
|
---|
478 | State := cbGrayed;
|
---|
479 | end;
|
---|
480 | lbMods.CheckedState[i] := state;
|
---|
481 | end;
|
---|
482 | finally
|
---|
483 | FCheckingMods := FALSE;
|
---|
484 | end;
|
---|
485 | end;
|
---|
486 |
|
---|
487 | procedure TfrmVisitType.splLeftMoved(Sender: TObject);
|
---|
488 | begin
|
---|
489 | inherited;
|
---|
490 | lblVType.Left := lbxVisits.Left + pnlMain.Left;
|
---|
491 | FSplitterMove := TRUE;
|
---|
492 | FormResize(Sender);
|
---|
493 | end;
|
---|
494 |
|
---|
495 | procedure TfrmVisitType.splRightMoved(Sender: TObject);
|
---|
496 | begin
|
---|
497 | inherited;
|
---|
498 | lblMod.Left := lbMods.Left + pnlMain.Left;
|
---|
499 | FSplitterMove := TRUE;
|
---|
500 | FormResize(Sender);
|
---|
501 | end;
|
---|
502 |
|
---|
503 | procedure TfrmVisitType.lbModsClickCheck(Sender: TObject; Index: Integer);
|
---|
504 | var
|
---|
505 | idx: integer;
|
---|
506 | ModIEN: string;
|
---|
507 | Add: boolean;
|
---|
508 | begin
|
---|
509 | if FCheckingMods or (Index < 0) then exit;
|
---|
510 | Add := (lbMods.Checked[Index]);
|
---|
511 | ModIEN := piece(lbMods.Items[Index],U,1) + ';';
|
---|
512 | idx := pos(';' + ModIEN, ';' + uVisitType.Modifiers);
|
---|
513 | if(idx > 0) then
|
---|
514 | begin
|
---|
515 | if not Add then
|
---|
516 | begin
|
---|
517 | delete(uVisitType.Modifiers, idx, length(ModIEN));
|
---|
518 | end;
|
---|
519 | end
|
---|
520 | else
|
---|
521 | begin
|
---|
522 | if Add then
|
---|
523 | begin
|
---|
524 | uVisitType.Modifiers := uVisitType.Modifiers + ModIEN;
|
---|
525 | end;
|
---|
526 | end;
|
---|
527 | end;
|
---|
528 |
|
---|
529 | procedure TfrmVisitType.lbxVisitsClick(Sender: TObject);
|
---|
530 | begin
|
---|
531 | inherited;
|
---|
532 | ShowModifiers;
|
---|
533 | end;
|
---|
534 |
|
---|
535 | initialization
|
---|
536 | //frmVisitType.CreateProviderList;
|
---|
537 |
|
---|
538 | finalization
|
---|
539 | //frmVisitType.FreeProviderList;
|
---|
540 |
|
---|
541 | end.
|
---|