source: cprs/trunk/CPRS-Chart/Encounter/fVisitType.pas@ 1000

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

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