source: cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas@ 1718

Last change on this file since 1718 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 16.4 KB
Line 
1unit fPCEBaseMain;
2{Warning: The tab order has been changed in the OnExit event of several controls.
3 To change the tab order of lbSection, lbxSection, and btnOther you must do it programatically.}
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 fPCEBaseGrid, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, rPCE, uPCE,
10 CheckLst, ORFn, VA508AccessibilityManager;
11
12type
13 TCopyItemsMethod = procedure(Dest: TStrings) of object;
14 TListSectionsProc = procedure(Dest: TStrings);
15
16 TfrmPCEBaseMain = class(TfrmPCEBaseGrid)
17 lbSection: TORListBox;
18 edtComment: TCaptionEdit;
19 lblSection: TLabel;
20 lblList: TLabel;
21 lblComment: TLabel;
22 btnRemove: TButton;
23 btnOther: TButton;
24 bvlMain: TBevel;
25 btnSelectAll: TButton;
26 lbxSection: TORListBox;
27 pnlMain: TPanel;
28 pnlLeft: TPanel;
29 splLeft: TSplitter;
30 procedure lbSectionClick(Sender: TObject);
31 procedure btnOtherClick(Sender: TObject);
32 procedure edtCommentExit(Sender: TObject);
33 procedure edtCommentChange(Sender: TObject);
34 procedure btnRemoveClick(Sender: TObject);
35 procedure clbListClick(Sender: TObject);
36 procedure lbGridSelect(Sender: TObject);
37 procedure FormDestroy(Sender: TObject);
38 procedure btnSelectAllClick(Sender: TObject);
39 procedure FormResize(Sender: TObject); virtual;
40 procedure clbListMouseDown(Sender: TObject; Button: TMouseButton;
41 Shift: TShiftState; X, Y: Integer);
42 procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
43 procedure splLeftMoved(Sender: TObject);
44 procedure edtCommentKeyPress(Sender: TObject; var Key: Char);
45 procedure lbSectionExit(Sender: TObject);
46 procedure btnOtherExit(Sender: TObject);
47 procedure lbxSectionExit(Sender: TObject);
48 procedure lbGridExit(Sender: TObject);
49 procedure FormCreate(Sender: TObject);
50 private
51 FCommentItem: integer;
52 FCommentChanged: boolean;
53 FUpdateCount: integer;
54 FSectionPopulated: boolean;
55 //FUpdatingGrid: boolean; moved to 'protected' so frmDiagnoses can see it (RV)
56 protected
57 FUpdatingGrid: boolean;
58 FPCEListCodesProc: TPCEListCodesProc;
59 FPCEItemClass: TPCEItemClass;
60 FPCECode: string;
61 FSplitterMove: boolean;
62 FProblems: TStringList;
63 function GetCat: string;
64 procedure UpdateNewItemStr(var x: string); virtual;
65// procedure UpdateNewItem(APCEItem: TPCEItem); virtual;
66 procedure GridChanged; virtual;
67 procedure UpdateControls; override;
68 procedure BeginUpdate;
69 procedure EndUpdate;
70 function NotUpdating: boolean;
71 procedure CheckOffEntries;
72 procedure UpdateTabPos;
73 procedure Sync2Grid;
74 procedure Sync2Section;
75 public
76 procedure AllowTabChange(var AllowChange: boolean); override;
77 procedure InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc);
78 end;
79
80var
81 frmPCEBaseMain: TfrmPCEBaseMain;
82
83const
84 LBCheckWidthSpace = 18;
85
86implementation
87
88uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter,
89 ORCtrlsVA508Compatibility, fBase508Form, UBAConst;
90
91{$R *.DFM}
92
93type
94 TLBSectionManager = class(TORListBox508Manager)
95 public
96 function GetItemInstructions(Component: TWinControl): string; override;
97 function GetState(Component: TWinControl): string; override;
98 end;
99
100procedure TfrmPCEBaseMain.lbSectionClick(Sender: TObject);
101begin
102 inherited;
103 ClearGrid;
104 FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN);
105 CheckOffEntries;
106 FSectionPopulated := TRUE;
107 if (lbSection.Items.Count > 0) then
108 lblList.Caption := StringReplace(lbSection.DisplayText[lbSection.ItemIndex],
109 '&', '&&', [rfReplaceAll] );
110 if (lbSection.DisplayText[lbSection.ItemIndex] = DX_PROBLEM_LIST_TXT) then
111 FastAssign(lbxSection.Items, FProblems);
112end;
113
114procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject);
115begin
116 inherited;
117 if TabIsPressed then
118 if lbxSection.CanFocus then
119 lbxSection.SetFocus;
120end;
121
122procedure TfrmPCEBaseMain.UpdateNewItemStr(var x: string);
123begin
124end;
125
126procedure TfrmPCEBaseMain.GridChanged;
127var
128 i: integer;
129 tmpList: TStringList;
130begin
131 tmpList := TStringList.Create;
132 BeginUpdate;
133 try
134 SaveGridSelected;
135 FastAssign(lbGrid.Items, tmpList);
136 for i := 0 to lbGrid.Items.Count-1 do
137 begin
138 //lbGrid.Items[i] := TPCEItem(lbGrid.Items.Objects[i]).ItemStr; v22.5 - RV
139 tmpList[i] := TPCEItem(lbGrid.Items.Objects[i]).ItemStr;
140 tmpList.Objects[i] := lbGrid.Items.Objects[i];
141 end;
142 //FastAssign(tmpList,lbGrid.Items); //cq: 13228 Causin a/v errors.
143 lbGrid.Items.Assign(tmpList); //cq: 13228
144 RestoreGridSelected;
145 SyncGridData;
146 finally
147 EndUpdate;
148 tmpList.Free;
149 end;
150 UpdateControls;
151end;
152
153//procedure TfrmPCEBaseMain.UpdateNewItem(APCEItem: TPCEItem);
154//begin
155//end;
156
157procedure TfrmPCEBaseMain.btnOtherClick(Sender: TObject);
158var
159 x, Code: string;
160 APCEItem: TPCEItem;
161 SrchCode: integer;
162begin
163 inherited;
164 ClearGrid;
165 SrchCode := (Sender as TButton).Tag;
166 if(SrchCode <= LX_Threshold) then
167 LexiconLookup(Code, SrchCode)
168 else
169 if(SrchCode = PCE_HF) then
170 HFLookup(Code)
171 else
172 OtherLookup(Code, SrchCode);
173 btnOther.SetFocus;
174 if Code <> '' then
175 begin
176 x := FPCECode + U + Piece(Code, U, 1) + U + U + Piece(Code, U, 2);
177 if FPCEItemClass = TPCEProc then
178 SetPiece(x, U, pnumProvider, IntToStr(uProviders.PCEProvider));
179 UpdateNewItemStr(x);
180 APCEItem := FPCEItemClass.Create;
181 APCEItem.SetFromString(x);
182// UpdateNewItem(APCEItem);
183 GridIndex := lbGrid.Items.AddObject(APCEItem.ItemStr, APCEItem);
184 SyncGridData;
185 end;
186 UpdateControls;
187end;
188
189procedure TfrmPCEBaseMain.btnOtherExit(Sender: TObject);
190begin
191 inherited;
192 if TabIsPressed then begin
193 if lbGrid.CanFocus then
194 lbGrid.SetFocus
195 end
196 else if ShiftTabIsPressed then
197 if lbxSection.CanFocus then
198 lbxSection.SetFocus;
199end;
200
201procedure TfrmPCEBaseMain.edtCommentExit(Sender: TObject);
202begin
203 inherited;
204 if(FCommentChanged) then
205 begin
206 FCommentChanged := FALSE;
207 if(FCommentItem >= 0) then
208 TPCEItem(lbGrid.Items.Objects[FCommentItem]).Comment := edtComment.text;
209 end;
210end;
211
212procedure TfrmPCEBaseMain.AllowTabChange(var AllowChange: boolean);
213begin
214 edtCommentExit(Self);
215end;
216
217procedure TfrmPCEBaseMain.edtCommentChange(Sender: TObject);
218begin
219 inherited;
220 FCommentItem := GridIndex;
221 FCommentChanged := TRUE;
222end;
223
224procedure TfrmPCEBaseMain.btnRemoveClick(Sender: TObject);
225var
226 i, j: Integer;
227 APCEItem: TPCEItem;
228 CurCategory: string;
229
230begin
231 inherited;
232 FUpdatingGrid := TRUE;
233 try
234 for i := lbGrid.Items.Count-1 downto 0 do if(lbGrid.Selected[i]) then
235 begin
236 CurCategory := GetCat;
237 APCEItem := TPCEDiag(lbGrid.Items.Objects[i]);
238 if APCEItem.Category = CurCategory then
239 begin
240 with APCEItem do for j := 0 to lbxSection.Items.Count - 1 do
241 if ORFn.Pieces(lbxSection.Items[j], U, 1, 2) = Code + U + Narrative then
242 lbxSection.Checked[j] := False;
243 end;
244 APCEItem.Free;
245 lbGrid.Items.Delete(i);
246 end;
247 ClearGrid;
248 finally
249 FUpdatingGrid := FALSE;
250 end;
251end;
252
253procedure TfrmPCEBaseMain.UpdateControls;
254var
255 CommentOK: boolean;
256
257begin
258 btnSelectAll.Enabled := (lbGrid.Items.Count > 0);
259 btnRemove.Enabled := (lbGrid.SelCount > 0);
260 if(NotUpdating) then
261 begin
262 BeginUpdate;
263 try
264 inherited;
265 CommentOK := (lbGrid.SelCount = 1);
266 lblComment.Enabled := CommentOK;
267 edtComment.Enabled := CommentOK;
268 if(CommentOK) then
269 edtComment.Text := TPCEItem(lbGrid.Items.Objects[GridIndex]).Comment
270 else
271 edtComment.Text := '';
272 finally
273 EndUpdate;
274 end;
275 end;
276end;
277
278procedure TfrmPCEBaseMain.clbListClick(Sender: TObject);
279begin
280 inherited;
281// with clbList do
282// if(ItemIndex >= 0) and (not(Checked[ItemIndex])) then
283// ClearGrid;
284end;
285
286procedure TfrmPCEBaseMain.lbGridExit(Sender: TObject);
287begin
288 inherited;
289 if ShiftTabIsPressed then
290 if btnOther.CanFocus then
291 btnOther.SetFocus;
292end;
293
294procedure TfrmPCEBaseMain.lbGridSelect(Sender: TObject);
295begin
296 inherited;
297// clbList.ItemIndex := -1;
298 UpdateControls;
299end;
300
301procedure TfrmPCEBaseMain.FormCreate(Sender: TObject);
302begin
303 inherited FormCreate(Sender);
304 FProblems := TStringList.Create;
305 lbxSection.HideSelection := TRUE;
306 amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create;
307end;
308
309procedure TfrmPCEBaseMain.FormDestroy(Sender: TObject);
310begin
311 inherited;
312 FProblems.Free;
313end;
314
315procedure TfrmPCEBaseMain.InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc);
316begin
317 AListProc(lbSection.Items);
318 ACopyProc(lbGrid.Items);
319 lbSection.ItemIndex := 0;
320 lbSectionClick(lbSection);
321 ClearGrid;
322 GridChanged;
323// CheckOffEntries;
324end;
325
326procedure TfrmPCEBaseMain.BeginUpdate;
327begin
328 inc(FUpdateCount);
329end;
330
331procedure TfrmPCEBaseMain.EndUpdate;
332begin
333 if(FUpdateCount > 0) then
334 dec(FUpdateCount);
335end;
336
337function TfrmPCEBaseMain.NotUpdating: boolean;
338begin
339 Result := (FUpdateCount = 0);
340end;
341
342procedure TfrmPCEBaseMain.CheckOffEntries;
343{ TODO -oRich V. -cCode Set Versioning : Uncomment these lines to prevent acceptance of existing inactive DX codes. }
344(*const
345 TX_INACTIVE_ICD_CODE1 = 'The diagnosis of "';
346 TX_INACTIVE_ICD_CODE2 = '" entered for this encounter' + #13#10 + 'contains an inactive ICD code of "';
347 TX_INACTIVE_ICD_CODE3 = '" as of the encounter date, and will be removed.' + #13#10#13#10 +
348 'Please select another diagnosis.';
349 TC_INACTIVE_ICD_CODE = 'Diagnosis Contains Inactive Code';*)
350var
351 i, j: Integer;
352 CurCategory, CodeNarr: string;
353 APCEItem: TPCEItem;
354begin
355 FUpdatingGrid := TRUE;
356 try
357 if(lbSection.Items.Count < 1) then exit;
358 CurCategory := GetCat;
359 for i := lbGrid.Items.Count - 1 downto 0 do
360 begin
361 APCEItem := TPCEItem(lbGrid.Items.Objects[i]);
362 if APCEItem.Category = CurCategory then
363 begin
364 CodeNarr := APCEItem.Code + U + APCEItem.Narrative;
365 for j := 0 to lbxSection.Items.Count - 1 do
366 if ORFn.Pieces(lbxSection.Items[j], U, 1, 2) = CodeNarr then
367 begin
368{ TODO -oRich V. -cCode Set Versioning : Uncomment these lines to prevent acceptance of existing inactive DX codes. }
369(* if (CurCategory = 'Problem List Items') and (Piece(lbxSection.Items[j], U, 5) = '#') then
370 begin
371 InfoBox(TX_INACTIVE_ICD_CODE1 + APCEItem.Narrative + TX_INACTIVE_ICD_CODE2 +
372 APCEItem.Code + TX_INACTIVE_ICD_CODE3, TC_INACTIVE_ICD_CODE, MB_ICONWARNING or MB_OK);
373 lbxSection.Checked[j] := False;
374 APCEItem.Free;
375 lbGrid.Items.Delete(i);
376 end
377 else*)
378 lbxSection.Checked[j] := True;
379 end;
380 end;
381 end;
382 finally
383 FUpdatingGrid := FALSE;
384 end;
385end;
386
387procedure TfrmPCEBaseMain.btnSelectAllClick(Sender: TObject);
388var
389 i: integer;
390
391begin
392 inherited;
393 BeginUpdate;
394 try
395 for i := 0 to lbGrid.Items.Count-1 do
396 lbGrid.Selected[i] := TRUE;
397 finally
398 EndUpdate;
399 end;
400 UpdateControls;
401end;
402
403procedure TfrmPCEBaseMain.FormResize(Sender: TObject);
404begin
405 if FSplitterMove then
406 FSplitterMove := FALSE
407 else
408 inherited;
409end;
410
411procedure TfrmPCEBaseMain.clbListMouseDown(Sender: TObject;
412 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
413begin
414 inherited;
415// if(Button <> mbLeft) then
416// clbList.Itemindex := clbList.itemAtPos(Point(X,Y), TRUE);
417end;
418
419function TfrmPCEBaseMain.GetCat: string;
420begin
421 Result := '';
422 if(lbSection.Items.Count > 0) and (lbSection.ItemIndex >= 0) then
423 Result := Piece(lbSection.Items[lbSection.ItemIndex], U, 2);
424end;
425
426procedure TfrmPCEBaseMain.lbxSectionClickCheck(Sender: TObject;
427 Index: Integer);
428var
429 i, j: Integer;
430 x, x0, CodeCatNarr: string;
431 APCEItem: TPCEItem;
432 Found, DoSync: boolean;
433
434begin
435 inherited;
436 if FUpdatingGrid or FClosing then exit;
437 DoSync := FALSE;
438 x0 := GetCat;
439 for i := 0 to lbxSection.Items.Count-1 do
440 begin
441 x := x0 + U + ORFn.Pieces(lbxSection.Items[i], U, 1, 2);
442 CodeCatNarr := Piece(x, U, 2) + U + Piece(x, U, 1) + U + Piece(x, U, 3);
443 Found := FALSE;
444 for j := lbGrid.Items.Count - 1 downto 0 do
445 begin
446 APCEItem := TPCEItem(lbGrid.Items.Objects[j]);
447 with APCEItem do if CodeCatNarr = Code + U + Category + U + Narrative then
448 begin
449 Found := TRUE;
450 if(lbxSection.Checked[i]) then break;
451 APCEItem.Free;
452 lbGrid.Items.Delete(j);
453 end;
454 end;
455 if(lbxSection.Checked[i] and (not Found)) then
456 begin
457 x := FPCECode + U + CodeCatNarr;
458 if FPCEItemClass = TPCEProc then
459 SetPiece(x, U, pnumProvider, IntToStr(uProviders.PCEProvider));
460 UpdateNewItemStr(x);
461 APCEItem := FPCEItemClass.Create;
462 APCEItem.SetFromString(x);
463 GridIndex := lbGrid.Items.AddObject(APCEItem.ItemStr, APCEItem);
464 DoSync := TRUE;
465 end;
466 end;
467 if(DoSync) then
468 SyncGridData;
469 UpdateControls;
470end;
471
472procedure TfrmPCEBaseMain.lbxSectionExit(Sender: TObject);
473begin
474 inherited;
475 if TabIsPressed then begin
476 if btnOther.CanFocus then
477 btnOther.SetFocus
478 end
479 else if ShiftTabIsPressed then
480 if lbSection.CanFocus then
481 lbSection.SetFocus;
482end;
483
484procedure TfrmPCEBaseMain.UpdateTabPos;
485begin
486 lbxSection.TabPositions := SectionString;
487end;
488
489procedure TfrmPCEBaseMain.splLeftMoved(Sender: TObject);
490begin
491 inherited;
492 lblList.Left := lbxSection.Left + pnlMain.Left;
493 FSplitterMove := TRUE;
494 FormResize(Sender);
495end;
496
497procedure TfrmPCEBaseMain.Sync2Grid;
498var
499 i, idx, cnt, NewIdx: Integer;
500 CodeNarr: string;
501 APCEItem: TPCEItem;
502
503begin
504 if(FUpdatingGrid or FClosing) then exit;
505 FUpdatingGrid := TRUE;
506 try
507 cnt := 0;
508 idx := -1;
509 for i := 0 to lbGrid.Items.Count - 1 do
510 begin
511 if(lbGrid.Selected[i]) then
512 begin
513 if(idx < 0) then idx := i;
514 inc(cnt);
515 if(cnt > 1) then break;
516 end;
517 end;
518 NewIdx := -1;
519 if(cnt = 1) then
520 begin
521 APCEItem := TPCEItem(lbGrid.Items.Objects[idx]);
522 if APCEItem.Category = GetCat then
523 begin
524 CodeNarr := APCEItem.Code + U + APCEItem.Narrative;
525 for i := 0 to lbxSection.Items.Count - 1 do
526 begin
527 if Pieces(lbxSection.Items[i], U, 1, 2) = CodeNarr then
528 begin
529 NewIdx := i;
530 break;
531 end;
532 end;
533 end;
534 end;
535 lbxSection.ItemIndex := NewIdx;
536 finally
537 FUpdatingGrid := FALSE;
538 end;
539end;
540
541procedure TfrmPCEBaseMain.Sync2Section;
542var
543 i, idx: Integer;
544 ACode: string;
545
546begin
547 if(FUpdatingGrid or FClosing) then exit;
548 FUpdatingGrid := TRUE;
549 try
550 idx := lbxSection.ItemIndex;
551 if(idx >= 0) then
552 ACode := GetCat + U + Pieces(lbxSection.Items[idx], U, 1, 2)
553 else
554 ACode := '~@^~@^@~';
555 for i := 0 to lbGrid.Items.Count - 1 do
556 begin
557 with TPCEItem(lbGrid.Items.Objects[i]) do
558 lbGrid.Selected[i] := (ACode = (Category + U + Code + U + Narrative));
559 end;
560 finally
561 FUpdatingGrid := FALSE;
562 end;
563end;
564
565procedure TfrmPCEBaseMain.edtCommentKeyPress(Sender: TObject;
566 var Key: Char);
567begin
568 inherited;
569 if (Key = '?') and
570 ((edtComment.Text = '') or (edtComment.SelStart = 0)) then
571 Key := #0;
572end;
573
574{ TLBSectionManager }
575
576function TLBSectionManager.GetItemInstructions(Component: TWinControl): string;
577var
578 lb : TORListBox;
579 idx: integer;
580begin
581 lb := TORListBox(Component);
582 idx := lb.ItemIndex;
583 if (idx >= 0) and lb.Selected[idx] then
584 Result := 'Press space bar to populate ' +
585 TfrmPCEBaseMain(Component.Owner).FTabName + ' section'
586 else
587 result := inherited GetItemInstructions(Component);
588end;
589
590function TLBSectionManager.GetState(Component: TWinControl): string;
591var
592 frm: TfrmPCEBaseMain;
593begin
594 Result := '';
595 frm := TfrmPCEBaseMain(Component.Owner);
596 if frm.FSectionPopulated then
597 begin
598 frm.FSectionPopulated := FALSE;
599 Result := frm.FTabName + ' section populated with ' +
600 inttostr(frm.lbxSection.Count) + ' items';
601 end;
602end;
603
604initialization
605 SpecifyFormIsNotADialog(TfrmPCEBaseMain);
606
607end.
Note: See TracBrowser for help on using the repository browser.