Module

fPCEBaseMain

Path

C:\CPRS\CPRS30\Encounter\fPCEBaseMain.pas

Last Modified

8/5/2014 10:18:06 AM

Comments

Warning: The tab order has been changed in the OnExit event of several controls.
 To change the tab order of lbSection, lbxSection, and btnOther you must do it programatically.

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmPCEBaseMain);

end.

Open Todo-items for fPCEBaseMain (1)

Text Category Owner Priority Status
Uncomment these lines to prevent acceptance of existing inactive DX codes. Code Set Versioning Rich V. - Open

Units Used in Interface

Name Comments
fPCEBaseGrid -
rPCE -
uPCE -

Units Used in Implementation

Name Comments
fBase508Form -
fEncounterFrame -
fHFSearch -
fPCELex -
fPCEOther -
UBAConst -

Classes

Name Comments
TfrmPCEBaseMain -
TLBSectionManager -

Procedures

Name Owner Declaration Scope Comments
AllowTabChange TfrmPCEBaseMain procedure AllowTabChange(var AllowChange: boolean); override; Public -
BeginUpdate TfrmPCEBaseMain procedure BeginUpdate; Protected -
btnOtherClick TfrmPCEBaseMain procedure btnOtherClick(Sender: TObject); Public/Published
Procedure TfrmPCEBaseMain.UpdateNewItem(APCEItem: TPCEItem);
begin
end;
btnOtherExit TfrmPCEBaseMain procedure btnOtherExit(Sender: TObject); Public/Published -
btnRemoveClick TfrmPCEBaseMain procedure btnRemoveClick(Sender: TObject); Public/Published -
btnSelectAllClick TfrmPCEBaseMain procedure btnSelectAllClick(Sender: TObject); Public/Published -
CheckOffEntries TfrmPCEBaseMain procedure CheckOffEntries; Protected TODO -oRich V. -cCode Set Versioning : Uncomment these lines to prevent acceptance of existing inactive DX codes.
clbListClick TfrmPCEBaseMain procedure clbListClick(Sender: TObject); Public/Published -
clbListMouseDown TfrmPCEBaseMain procedure clbListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
edtCommentChange TfrmPCEBaseMain procedure edtCommentChange(Sender: TObject); Public/Published -
edtCommentExit TfrmPCEBaseMain procedure edtCommentExit(Sender: TObject); Public/Published -
edtCommentKeyPress TfrmPCEBaseMain procedure edtCommentKeyPress(Sender: TObject; var Key: Char); Public/Published -
EndUpdate TfrmPCEBaseMain procedure EndUpdate; Protected -
FormCreate TfrmPCEBaseMain procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmPCEBaseMain procedure FormDestroy(Sender: TObject); Public/Published -
FormResize TfrmPCEBaseMain procedure FormResize(Sender: TObject); virtual; Public/Published -
GridChanged TfrmPCEBaseMain procedure GridChanged; virtual; Protected Procedure UpdateNewItem(APCEItem: TPCEItem); virtual;
InitTab TfrmPCEBaseMain procedure InitTab(ACopyProc: TCopyItemsMethod; AListProc: TListSectionsProc); Public -
lbGridExit TfrmPCEBaseMain procedure lbGridExit(Sender: TObject); Public/Published -
lbGridSelect TfrmPCEBaseMain procedure lbGridSelect(Sender: TObject); Public/Published -
lbSectionClick TfrmPCEBaseMain procedure lbSectionClick(Sender: TObject); Public/Published -
lbSectionExit TfrmPCEBaseMain procedure lbSectionExit(Sender: TObject); Public/Published -
lbxSectionClickCheck TfrmPCEBaseMain procedure lbxSectionClickCheck(Sender: TObject; Index: Integer); Public/Published -
lbxSectionExit TfrmPCEBaseMain procedure lbxSectionExit(Sender: TObject); Public/Published -
splLeftMoved TfrmPCEBaseMain procedure splLeftMoved(Sender: TObject); Public/Published -
Sync2Grid TfrmPCEBaseMain procedure Sync2Grid; Protected -
Sync2Section TfrmPCEBaseMain procedure Sync2Section; Protected -
UpdateControls TfrmPCEBaseMain procedure UpdateControls; override; Protected -
UpdateNewItemStr TfrmPCEBaseMain procedure UpdateNewItemStr(var x: string); virtual; Protected -
UpdateTabPos TfrmPCEBaseMain procedure UpdateTabPos; Protected -

Functions

Name Owner Declaration Scope Comments
GetCat TfrmPCEBaseMain function GetCat: string; Protected -
GetItemInstructions TLBSectionManager function GetItemInstructions(Component: TWinControl): string; override; Public TLBSectionManager
GetState TLBSectionManager function GetState(Component: TWinControl): string; override; Public -
NotUpdating TfrmPCEBaseMain function NotUpdating: boolean; Protected -

Global Variables

Name Type Declaration Comments
frmPCEBaseMain TfrmPCEBaseMain frmPCEBaseMain: TfrmPCEBaseMain; -

Constants

Name Declaration Scope Comments
LBCheckWidthSpace 18 Interfaced -


Module Source

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

Module Calls (2 levels)


fPCEBaseMain
 ├fPCEBaseGrid
 │ └fPCEBase
 ├rPCE
 │ ├uPCE
 │ ├UBACore
 │ ├rCore
 │ ├uCore
 │ ├uConst
 │ ├fEncounterFrame
 │ ├UBAGlobals
 │ └UBAConst
 ├uPCE...
 ├fPCELex
 │ ├uCore...
 │ ├fBase508Form
 │ ├mTreeGrid
 │ ├rPCE...
 │ ├uProbs
 │ ├rProbs
 │ └UBAGlobals...
 ├fPCEOther
 │ ├fAutoSz
 │ ├rPCE...
 │ └fEncounterFrame...
 ├fEncounterFrame...
 ├fHFSearch
 │ ├fAutoSz...
 │ ├rPCE...
 │ └fEncounterFrame...
 ├fBase508Form...
 └UBAConst

Module Called-By (2 levels)


          fPCEBaseMain
          fDiagnoses┤ 
   fEncounterFrame┘ │ 
          fProcedure┤ 
fEncounterFrame...┘ │ 
       fImmunization┤ 
fEncounterFrame...┘ │ 
           fSkinTest┤ 
fEncounterFrame...┘ │ 
          fPatientEd┤ 
fEncounterFrame...┘ │ 
       fHealthFactor┤ 
fEncounterFrame...┘ │ 
               fExam┘ 
fEncounterFrame...┘