Module

fProbs

Path

C:\CPRS\CPRS30\fProbs.pas

Last Modified

7/15/2014 3:26:38 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmProblems);

end.

Units Used in Interface

Name Comments
fBase508Form -
fHSplit -
fProbEdt -
uConst -
uCore -
uProbs -

Units Used in Implementation

Name Comments
fCover -
fEncnt -
fFrame -
fProbCmt -
fProbflt -
fProbLex -
fReports -
fReportsPrint -
fRptBox -
rCore -
rCover -
rPCE -
rProbs -

Classes

Name Comments
TfrmProblems -

Procedures

Name Owner Declaration Scope Comments
AddProblem TfrmProblems procedure AddProblem; Public -
ApplyViewFilters TfrmProblems procedure ApplyViewFilters; Private Procedure TfrmProblems.UMPLFilter(var Message:TMessage);
bbCancelClick TfrmProblems procedure bbCancelClick(Sender: TObject); Public/Published -
bbNewProbExit TfrmProblems procedure bbNewProbExit(Sender: TObject); Public/Published -
bbOtherProbClick TfrmProblems procedure bbOtherProbClick(Sender: TObject); Public/Published -
ClearGrid TfrmProblems procedure ClearGrid; Public -
ClearPtData TfrmProblems procedure ClearPtData; override; Public -
DisplayPage TfrmProblems procedure DisplayPage; override; Public -
EditProblem TfrmProblems procedure EditProblem(const why:char); Public -
edProbEntKeyPress TfrmProblems procedure edProbEntKeyPress(Sender: TObject; var Key: Char); Public/Published -
FormCreate TfrmProblems procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmProblems procedure FormDestroy(Sender: TObject); Public/Published -
FormHide TfrmProblems procedure FormHide(Sender: TObject); Public/Published -
FormMouseMove TfrmProblems procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Public/Published -
FormShow TfrmProblems procedure FormShow(Sender: TObject); Public/Published -
frmFramePnlPatientExit TfrmProblems procedure frmFramePnlPatientExit(Sender: TObject); Private -
GetRowCount TfrmProblems procedure GetRowCount; Private -
HeaderControlMouseDown TfrmProblems procedure HeaderControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
HeaderControlMouseUp TfrmProblems procedure HeaderControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
HeaderControlSectionClick TfrmProblems procedure HeaderControlSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
HeaderControlSectionResize TfrmProblems procedure HeaderControlSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
LoadPatientParams TfrmProblems procedure LoadPatientParams(AList:TstringList); Public -
LoadPatientProblems TfrmProblems procedure LoadPatientProblems(AList:TstringList;const status:char;init:boolean); Public SCCond, tmpSCstr: string;
LoadProblems TfrmProblems procedure LoadProblems; Public -
LoadUserCats TfrmProblems procedure LoadUserCats(AList:Tstringlist); Public -
LoadUserParams TfrmProblems procedure LoadUserParams(Alist:TstringList); Public -
LoadUserProbs TfrmProblems procedure LoadUserProbs(AList:TstringList); Public -
lstCatPickClick TfrmProblems procedure lstCatPickClick(Sender: TObject); Public/Published ------------------------ pdr - Problem list gadget event methods ------------
lstProbActsClick TfrmProblems procedure lstProbActsClick(Sender: TObject); Public/Published -
lstProbPickClick TfrmProblems procedure lstProbPickClick(Sender: TObject); Public/Published -
lstProbPickDblClick TfrmProblems procedure lstProbPickDblClick(Sender: TObject); Public/Published -
lstViewClick TfrmProblems procedure lstViewClick(Sender: TObject); Public/Published -
lstViewExit TfrmProblems procedure lstViewExit(Sender: TObject); Public/Published
Tab Order tricks.  Need to change
  lstView

  bbNewProb
  bbOtherProb
  bbCancel

  pnlProbDlg
  wgProbData

to
  lstView

  pnlProbDlg
  wgProbData

  bbNewProb
  bbOtherProb
  bbCancel
mnuChartTabClick TfrmProblems procedure mnuChartTabClick(Sender: TObject); Public/Published -
mnuOptimizeFieldsClick TfrmProblems procedure mnuOptimizeFieldsClick(Sender: TObject); Public/Published -
mnuViewCommentsClick TfrmProblems procedure mnuViewCommentsClick(Sender: TObject); Public/Published -
mnuViewInformationClick TfrmProblems procedure mnuViewInformationClick(Sender: TObject); Public/Published -
mnuViewRestoreDefaultClick TfrmProblems procedure mnuViewRestoreDefaultClick(Sender: TObject); Public/Published -
mnuViewSaveClick TfrmProblems procedure mnuViewSaveClick(Sender: TObject); Public/Published -
NoRowSelected TfrmProblems procedure NoRowSelected; Public -
pnlProbEntResize TfrmProblems procedure pnlProbEntResize(Sender: TObject); Public/Published
Var
  i:integer;
pnlRightExit TfrmProblems procedure pnlRightExit(Sender: TObject); Public/Published -
pnlRightResize TfrmProblems procedure pnlRightResize(Sender:TObject); Public/Published -
RefreshList TfrmProblems procedure RefreshList; Private -
RequestPrint TfrmProblems procedure RequestPrint; override; Public -
RestoreProblem TfrmProblems procedure RestoreProblem; Public -
ReverseList - procedure ReverseList(Alist:TstringList); Local SCCond, tmpSCstr: string;
RowSelected TfrmProblems procedure RowSelected; Public -
SetFontSize TfrmProblems procedure SetFontSize( NewFontSize: integer); override; Public -
SetGridPieces TfrmProblems procedure SetGridPieces(Pieces: string); Private -
setSectionWidths TfrmProblems procedure setSectionWidths; Public/Published -
ShowPnlView TfrmProblems procedure ShowPnlView(); Private -
sptHorzMoved TfrmProblems procedure sptHorzMoved(Sender: TObject); Public/Published -
UMCloseProblem TfrmProblems procedure UMCloseProblem(var Message:TMessage); message UM_CLOSEPROBLEM; {pdr} Private Pdr
UMPLLexicon TfrmProblems procedure UMPLLexicon(var Message:TMessage); message UM_PLLEX; {pdr} Private
Procedure UMPLFilter(var Message:TMessage); message UM_PLFILTER; {pdr}

pdr
UpdateProblem TfrmProblems procedure UpdateProblem(const why:char;Line: string;AllProblemsIndex:integer); Public -
ViewInfo TfrmProblems procedure ViewInfo(Sender: TObject); Public/Published -
wgProbDataClick TfrmProblems procedure wgProbDataClick(Sender: TObject); Public/Published -
wgProbDataDblClick TfrmProblems procedure wgProbDataDblClick(Sender: TObject); Public/Published -
wgProbDataDrawItem TfrmProblems procedure wgProbDataDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
wgProbDataMeasureItem TfrmProblems procedure wgProbDataMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); Public/Published -

Functions

Name Owner Declaration Scope Comments
AllowContextChange TfrmProblems function AllowContextChange(var WhyNot: string): Boolean; override; Public -
EncounterPresent - function EncounterPresent: Boolean; Interfaced Make sure a location and provider are selected, returns false if not
getTotalSectionsWidth TfrmProblems function getTotalSectionsWidth : integer; Public/Published -
HighlightDuplicate TfrmProblems function HighlightDuplicate( NewProb: string; const Msg: string; DlgType: TMsgDlgType; Action: string): boolean; Public -
MString TfrmProblems function MString( index: integer): string; Private -
PlainText TfrmProblems function PlainText( MString: string): string; Private -

Global Variables

Name Type Declaration Comments
dlgProbs TfrmdlgProb dlgProbs:TfrmdlgProb; -
frmProblems TfrmProblems frmProblems: TfrmProblems; -
gFixedWidth Integer gFixedWidth: Integer; -
gFontHeight Integer gFontHeight: Integer; -
gFontWidth Integer gFontWidth: Integer; -
origWidths origWidths: arOrigSecWidths; -

Constants

Name Declaration Scope Comments
CT_PROBLEMS 2 Interfaced -
GridColWidths Array[0..15] of integer =(0, 5, -1, 9, 9, 0, 12, 12, 12, 0, 0, 0, 0, 0, 0, 0) Interfaced
GridColWidths[i] = 0 for columns that are always hidden
 GridColWidths[i] = -1 for one (and only one) adjustable column
RPT_PROBLIST 21 Interfaced -
TC_ADD_REMOVED 'Unable to add' Interfaced -
TC_INACTIVE_CODE 'Inactive Code' Interfaced -
TC_INACTIVE_ICODE 'Inactive ICD code' Interfaced -
TC_INACTIVE_SCODE 'Inactive SNOMED CT code' Interfaced -
TC_NO_PATIENT 'No patient is selected' Interfaced -
TC_PROV_LOC 'Incomplete Information' Interfaced -
TX_ADD_REMOVED 'Cannot add to the "Removed Problem List"' Interfaced -
TX_INACTIVE_CODE_V 'references an inactive ICD code, and must be updated' + #13#10 + Interfaced -
TX_INACTIVE_ICODE 'This problem references an inactive ICD code,' + #13#10 + Interfaced -
TX_INACTIVE_SCODE 'This problem references an inactive SNOMED CT code,' + #13#10 + Interfaced -
TX_INVALID_PATIENT 'Problem list is unavailable: Patient DFN is undefined.' Interfaced -
TX_PROV_LOC 'A provider and location must be selected before' + #13#10 + Interfaced -


Module Source

1     unit fProbs;
2     {$O-}
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fHSplit, StdCtrls, ExtCtrls, Menus, ORCtrls, Buttons, uProbs,
8       Grids, Vawrgrid, ORfn, uCore, fProbEdt, uConst, ComCtrls,
9       VA508AccessibilityManager, VAUtils, fBase508Form;
10    
11    type
12      TfrmProblems = class(TfrmHSplit)
13        mnuProbs: TMainMenu;
14        mnuView: TMenuItem;
15        mnuViewChart: TMenuItem;
16        mnuChartCover: TMenuItem;
17        mnuChartProbs: TMenuItem;
18        mnuChartMeds: TMenuItem;
19        mnuChartOrders: TMenuItem;
20        mnuChartNotes: TMenuItem;
21        mnuChartCslts: TMenuItem;
22        mnuChartDCSumm: TMenuItem;
23        mnuChartLabs: TMenuItem;
24        mnuChartReports: TMenuItem;
25        mnuAct: TMenuItem;
26        mnuActNew: TMenuItem;
27        Z3: TMenuItem;
28        mnuActChange: TMenuItem;
29        mnuActInactivate: TMenuItem;
30        mnuActRemove: TMenuItem;
31        mnuActVerify: TMenuItem;
32        Z4: TMenuItem;
33        mnuActAnnotate: TMenuItem;
34        Z1: TMenuItem;
35        mnuViewActive: TMenuItem;
36        mnuViewBoth: TMenuItem;
37        popProb: TPopupMenu;
38        popChange: TMenuItem;
39        popInactivate: TMenuItem;
40        popRestore: TMenuItem;
41        popRemove: TMenuItem;
42        popVerify: TMenuItem;
43        N36: TMenuItem;
44        popAnnotate: TMenuItem;
45        N37: TMenuItem;
46        pnlProbList: TORAutoPanel;
47        pnlProbCats: TPanel;
48        lblProbCats: TLabel;
49        lstCatPick: TORListBox;
50        pnlProbEnt: TPanel;
51        pnlProbDlg: TPanel;
52        wgProbData: TCaptionListBox;
53        mnuViewInactive: TMenuItem;
54        mnuViewRemoved: TMenuItem;
55        N1: TMenuItem;
56        mnuActRestore: TMenuItem;
57        mnuViewFilters: TMenuItem;
58        N2: TMenuItem;
59        lblProbList: TOROffsetLabel;
60        pnlView: TPanel;
61        N3: TMenuItem;
62        popViewDetails: TMenuItem;
63        lstView: TORListBox;
64        lblView: TOROffsetLabel;
65        N4: TMenuItem;
66        mnuActDetails: TMenuItem;
67        bbNewProb: TORAlignButton;
68        lblProbEnt: TLabel;
69        mnuViewSave: TMenuItem;
70        mnuViewRestoreDefault: TMenuItem;
71        mnuViewComments: TMenuItem;
72        sptProbPanel: TSplitter;
73        pnlButtons: TPanel;
74        bbOtherProb: TORAlignButton;
75        bbCancel: TORAlignButton;
76        pnlProbs: TPanel;
77        lblProblems: TLabel;
78        lstProbPick: TORListBox;
79        edProbEnt: TCaptionEdit;
80        mnuChartSurgery: TMenuItem;
81        HeaderControl: THeaderControl;
82        mnuViewInformation: TMenuItem;
83        mnuViewDemo: TMenuItem;
84        mnuViewVisits: TMenuItem;
85        mnuViewPrimaryCare: TMenuItem;
86        mnuViewMyHealtheVet: TMenuItem;
87        mnuInsurance: TMenuItem;
88        mnuViewFlags: TMenuItem;
89        mnuViewReminders: TMenuItem;
90        mnuViewRemoteData: TMenuItem;
91        mnuViewPostings: TMenuItem;
92        mnuOptimizeFields: TMenuItem;
93        procedure mnuChartTabClick(Sender: TObject);
94        procedure lstProbPickClick(Sender: TObject);
95        procedure lstProbPickDblClick(Sender: TObject);
96        procedure lstCatPickClick(Sender: TObject);
97        procedure lstProbActsClick(Sender: TObject);
98        procedure pnlRightResize(Sender:TObject);
99        procedure pnlProbEntResize(Sender: TObject);
100       procedure wgProbDataClick(Sender: TObject);
101       procedure wgProbDataDblClick(Sender: TObject);
102       procedure edProbEntKeyPress(Sender: TObject; var Key: Char);
103       procedure bbOtherProbClick(Sender: TObject);
104       procedure FormCreate(Sender: TObject);
105       procedure bbCancelClick(Sender: TObject);
106       procedure lstViewClick(Sender: TObject);
107       procedure FormDestroy(Sender: TObject);
108       procedure mnuViewSaveClick(Sender: TObject);
109       procedure mnuViewRestoreDefaultClick(Sender: TObject);
110       procedure mnuViewCommentsClick(Sender: TObject);
111       procedure wgProbDataMeasureItem(Control: TWinControl; Index: Integer;
112         var Height: Integer);
113       procedure wgProbDataDrawItem(Control: TWinControl; Index: Integer;
114         Rect: TRect; State: TOwnerDrawState);
115       procedure HeaderControlSectionResize(HeaderControl: THeaderControl;
116         Section: THeaderSection);
117       procedure lstViewExit(Sender: TObject);
118       procedure FormShow(Sender: TObject);
119       procedure FormHide(Sender: TObject);
120       procedure pnlRightExit(Sender: TObject);
121       procedure bbNewProbExit(Sender: TObject);
122       procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
123         Y: Integer);
124       procedure ViewInfo(Sender: TObject);
125       procedure mnuViewInformationClick(Sender: TObject);
126       procedure mnuOptimizeFieldsClick(Sender: TObject);
127       procedure HeaderControlSectionClick(HeaderControl: THeaderControl;
128         Section: THeaderSection);
129       procedure HeaderControlMouseUp(Sender: TObject; Button: TMouseButton;
130         Shift: TShiftState; X, Y: Integer);
131       procedure HeaderControlMouseDown(Sender: TObject; Button: TMouseButton;
132         Shift: TShiftState; X, Y: Integer);
133       function getTotalSectionsWidth : integer;
134       procedure setSectionWidths;
135       procedure sptHorzMoved(Sender: TObject);
136     private
137       FContextString: string;
138       FFilterString: string;
139       FI10Active: Boolean;
140       FAllProblems: TStringList;      //Unfiltered list of problems
141       FProblemsVisible: TStringList;  //Parallels FAllProblems.  "Y" for visible
142       FItemData: TStringList;  //Parallels Grid.  String representation of integer indexes into FAllProblems
143       // FProblemsVisible[FItemData[i]] = 'Y'
144       FWarningShown: boolean;
145       FOldFramePnlPatientExit: TNotifyEvent;
146       FMousing: TDateTime;
147       FSilent: boolean;
148       procedure frmFramePnlPatientExit(Sender: TObject);
149       procedure UMCloseProblem(var Message:TMessage); message UM_CLOSEPROBLEM; {pdr}
150       procedure ApplyViewFilters;
151   //    procedure UMPLFilter(var Message:TMessage); message UM_PLFILTER; {pdr}
152       procedure UMPLLexicon(var Message:TMessage); message UM_PLLEX; {pdr}
153       procedure GetRowCount;
154       procedure RefreshList;
155       procedure SetGridPieces(Pieces: string);
156       procedure ShowPnlView();
157       function PlainText( MString: string): string;
158       function MString( index: integer): string;
159     public
160       function  AllowContextChange(var WhyNot: string): Boolean; override;
161       procedure LoadProblems;
162       procedure LoadUserCats(AList:Tstringlist);
163       procedure LoadUserProbs(AList:TstringList);
164       procedure AddProblem;
165       procedure EditProblem(const why:char);
166       procedure LoadPatientParams(AList:TstringList);
167       procedure LoadUserParams(Alist:TstringList);
168       procedure UpdateProblem(const why:char;Line: string;AllProblemsIndex:integer);
169       procedure RestoreProblem;
170       procedure LoadPatientProblems(AList:TstringList;const status:char;init:boolean);
171       procedure ClearPtData; override;
172       procedure DisplayPage; override;
173       procedure NoRowSelected;
174       procedure RowSelected;
175       procedure ClearGrid;
176       procedure RequestPrint; override;
177       procedure SetFontSize( NewFontSize: integer); override;
178       function HighlightDuplicate( NewProb: string; const Msg: string;
179         DlgType: TMsgDlgType; Action: string): boolean;
180       property Silent: Boolean read FSilent write FSilent;
181     end;
182   
183     function EncounterPresent: Boolean;
184   
185   const
186     TX_PROV_LOC        = 'A provider and location must be selected before' +  #13#10 +
187                          'entering or making any change to a problem.';
188     TC_PROV_LOC        = 'Incomplete Information';
189     TX_INVALID_PATIENT = 'Problem list is unavailable:  Patient DFN is undefined.';
190     TC_NO_PATIENT      = 'No patient is selected';
191     TX_INACTIVE_CODE_V = 'references an inactive ICD code, and must be updated'  + #13#10 +
192                          'using the ''Change'' option before it can be verified.';
193     TC_INACTIVE_CODE   = 'Inactive Code';  
194     TX_INACTIVE_ICODE  = 'This problem references an inactive ICD code,' + #13#10 +
195                          'and must be updated using the ''Change'' option.';
196     TC_INACTIVE_ICODE  = 'Inactive ICD code';
197     TX_INACTIVE_SCODE  = 'This problem references an inactive SNOMED CT code,' + #13#10 +
198                          'and must be updated using the ''Change'' option.';
199     TC_INACTIVE_SCODE  = 'Inactive SNOMED CT code';
200     TX_ADD_REMOVED     = 'Cannot add to the "Removed Problem List"';
201     TC_ADD_REMOVED     = 'Unable to add';
202   
203     RPT_PROBLIST  = 21;
204     CT_PROBLEMS   = 2;
205   
206     // GridColWidths[i] = 0 for columns that are always hidden
207     // GridColWidths[i] = -1 for one (and only one) adjustable column
208     GridColWidths: Array[0..15] of integer =(0, 5, -1, 9, 9, 0, 12, 12, 12, 0, 0, 0, 0, 0, 0, 0);
209   
210     type
211     arOrigSecWidths = array[0..15] of integer;
212   
213   var
214     frmProblems: TfrmProblems;
215     dlgProbs:TfrmdlgProb;
216     gFontHeight: Integer;
217     gFontWidth: Integer;
218     gFixedWidth: Integer;
219     origWidths: arOrigSecWidths;
220   
221   implementation
222   
223   uses fFrame, fProbflt, fProbLex, rProbs, rCover, fCover, fRptBox, rCore,
224        fProbCmt, fEncnt, fReportsPrint, fReports, rPCE, DateUtils, VA2006Utils,
225        VA508AccessibilityRouter;
226   
227   {$R *.DFM}
228   
229   function TfrmProblems.AllowContextChange(var WhyNot: string): Boolean;
230   begin
231     Result := inherited AllowContextChange(WhyNot);  // sets result = true
232     //if dlgProbs <> nil then Result := dlgProbs.OkToQuit;
233     //if dlgProbs <> nil then dlgProbs.bbQuitClick(Self);
234     //need to check here and set to false if quit was cancelled or true if accepted
235   
236     if dlgProbs <> nil then
237       case BOOLCHAR[frmFrame.CCOWContextChanging] of
238       '1': begin
239              WhyNot := 'Changes to current problem will be discarded.';
240              Result := False;
241            end;
242       '0': begin
243              if WhyNot = 'COMMIT' then
244                begin
245                  FSilent := True;
246                  dlgProbs.Silent := True;
247                  dlgProbs.bbQuitClick(Self);
248                end
249              else
250                begin
251                  dlgProbs.bbQuitClick(Self);
252                  Result := dlgProbs.CanQuit;
253                end;
254            end;
255       end;
256   end;
257   
258   procedure TfrmProblems.ClearPtData;
259   begin
260     inherited ClearPtData;
261     ClearGrid;
262     lblProbList.Caption := '';
263     wgProbData.Caption := lblProbList.Caption;
264     FWarningShown := False;
265   end;
266   
267   procedure TfrmProblems.DisplayPage;
268   begin
269     inherited DisplayPage;
270     frmFrame.ShowHideChartTabMenus(mnuViewChart);
271     frmFrame.mnuFilePrint.Tag := CT_PROBLEMS;
272     frmFrame.mnuFilePrint.Enabled := True;
273     frmFrame.mnuFilePrintSetup.Enabled := True;
274     if InitPatient then
275       begin
276         FWarningShown := False;
277         if PLUser <> nil then
278           begin
279             PLUser.Destroy;
280             PLUser := nil;
281           end;
282         //ClearPtData;
283         ShowPnlView;
284         pnlButtons.SendToBack;
285         pnlButtons.Hide;
286         LoadProblems ;
287       end;
288     //CQ #11529: 508 PL tab - defaults the focus to the New Problem button ONLY upon switching to the Probs tab.  {TC}
289     if TabCtrlClicked and (ChangingTab = CT_PROBLEMS) then ProbTabClicked := True;
290     if (bbNewProb.CanFocus) and (not pnlButtons.Visible) and ((not PTSwitchRefresh) or ProbTabClicked) then bbNewProb.SetFocus;
291     if PTSwitchRefresh then PTSwitchRefresh := False;
292     if TabCtrlClicked then TabCtrlClicked := False;
293     if ProbTabClicked then ProbTabClicked := False;
294   end;
295   
296   procedure TfrmProblems.mnuChartTabClick(Sender: TObject);
297   begin
298     inherited;
299     frmFrame.mnuChartTabClick(Sender);
300   end;
301   
302   {------------------------ pdr - Problem list gadget event methods ------------}
303   procedure TfrmProblems.lstCatPickClick(Sender: TObject);
304   var
305     AList:TStringList;
306   begin
307     AList:=TStringList.create;
308     try
309       LoadUserProbs(AList);
310     finally
311       AList.free;
312     end;
313   end;
314   
315   procedure TfrmProblems.lstProbActsClick(Sender: TObject);
316   var
317     act, i, j: integer;
318     Alist: TstringList;
319     cmt, ProblemIFN, ut, x, line, comments: string ;
320     ProbRec: TProbRec ;
321     ContextString, FilterString: string;
322     FilterChanged: boolean;
323     AllProblemsIndex: integer;
324   begin
325     if PLPt = nil then
326     begin
327       InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
328       Exit;
329     end;
330     act := TComponent(Sender).tag ;
331     if act = 0 then exit;
332      // make sure a visit (time & location) is available before creating the problem
333     case act of
334       100: {add new problem}
335         begin
336           if PlUser.usViewAct = 'R' then
337             begin
338               InfoBox(TX_ADD_REMOVED, TC_ADD_REMOVED, MB_ICONINFORMATION or MB_OK);
339               exit;
340             end;
341           if not EncounterPresent then exit;
342           PLProblem := '';
343           AList := TStringList.Create;
344           pProviderID := Encounter.Provider;
345           pProviderName := Encounter.ProviderName ;
346           try
347             if pnlView.Visible then
348               begin
349                 pnlView.SendToBack;
350                 pnlProbCats.Show;
351                 pnlProbCats.BringToFront;
352                 pnlButtons.Visible := True;
353                 if PLUser.usUseLexicon then
354                   begin
355                     lblProbCats.Visible := True;
356                     lstCatPick.Visible  := True;
357                     lblProblems.Visible := True;
358                     lstProbPick.Visible := True;
359                     lstCatPick.Clear ;
360                     LoadUserCats(AList);
361                     bbOtherProb.Visible := True;
362                     pnlProbList.Visible := True;
363                     lstCatPick.TabStop := True;
364                     lstProbPick.TabStop := True;
365                     lstView.TabStop := False;
366                     bbNewProb.TabStop := False;
367                     pnlProbList.BringToFront ;
368                     pnlProbCats.ClientHeight := (pnlProbList.ClientHeight - pnlButtons.ClientHeight) div 2;
369                     pnlProbEnt.Visible  := False;
370                     pnlProbEnt.SendToBack;
371                     if (lstCatPick.Items.Count = 1) then
372                       if Piece(lstCatPick.Items[0], U, 1) = '-1' then
373                         bbOtherProbClick(Self);
374                   end
375                 else
376                   begin
377                     bbOtherProb.Visible := False;
378                     edProbEnt.Visible := True;
379                     lblProbEnt.Visible := True;
380                     pnlProbEnt.Visible  := True;
381                     pnlProbEnt.BringToFront;
382                     pnlProbList.Visible := False;
383                     lstCatPick.TabStop := False;
384                     lstProbPick.TabStop := False;
385                     lstView.TabStop := True;
386                     bbNewProb.TabStop := True;
387                     pnlProbList.SendToBack ;
388                     edProbEnt.text      := '';
389                     if pnlProbEnt.Visible then edProbEnt.SetFocus;
390                   end;
391               end
392             else
393               begin
394                 if (lstProbPick.itemindex < 0) and (edProbEnt.text = '') then
395                   InfoBox('Select a Problem to add from lists' + #13#10 + ' on left or enter a new one ',
396                     'Information', MB_OK or MB_ICONINFORMATION)
397                 else
398                   begin
399                     AddProblem;
400                     lstProbPick.itemindex := -1;
401                   end;
402               end ;
403           finally
404             AList.Free;
405           end;
406         end;
407       200: {Inactivate}
408         begin
409           if PlUser.usViewAct = 'R' then
410             begin
411               InfoBox('Cannot inactivate a problem on the "Removed Problem List"',
412                 'Information', MB_OK or MB_ICONINFORMATION);
413               exit;
414             end;
415           if (wgProbData.ItemIndex < 0) or (Piece(MString(wgProbData.itemindex), U, 3) = '') then
416             InfoBox('Select a patient problem from the grid on right',
417               'Information', MB_OK or MB_ICONINFORMATION)
418           else
419             begin
420               if not EncounterPresent then exit;
421               pProviderID := Encounter.Provider;
422               pProviderName := Encounter.ProviderName ;
423               AllProblemsIndex := 0;
424               repeat
425                 begin
426                   if wgProbData.Selected[AllProblemsIndex] then
427                     begin
428                       Line := FAllProblems[AllProblemsIndex];
429                       if CharAt(Piece(Line, U, 2), 1) = 'A' then
430                         UpdateProblem('I',Line,AllProblemsIndex)
431                       else
432                         InfoBox('Problem "' + Trim(UpperCase(Piece(Piece(Line, U, 3), #13, 1))) + '" is already inactive.',
433                         'Problem not updated', MB_ICONINFORMATION or MB_OK);
434                     end;
435                   inc(AllProblemsIndex);
436                 end;
437               until AllProblemsIndex >= wgProbData.Count;
438               RefreshList;
439             end;
440           if (PlUser.usViewAct='A') then
441             begin
442               AList := TStringList.Create ;
443               LoadPatientProblems(Alist,'A',False) ;
444               NoRowSelected ;
445             end;
446           RefreshList;
447         end;
448       250: {Verify}
449         begin
450           if not PLuser.usVerifyTranscribed then exit ;
451           if PlUser.usViewAct = 'R' then
452             begin
453               InfoBox('Cannot verify a problem on the "Removed Problem List"',
454                 'Information', MB_OK or MB_ICONINFORMATION);
455               exit;
456             end;
457           if (wgProbData.ItemIndex < 0) or (Piece(MString(wgProbData.ItemIndex), U, 3) = '') then
458             InfoBox('Select a patient problem from the grid on right',
459               'Information', MB_OK or MB_ICONINFORMATION)
460           else
461             begin
462               if not EncounterPresent then exit;
463               pProviderID := Encounter.Provider;
464               pProviderName := Encounter.ProviderName ;
465               AllProblemsIndex := 0;
466               repeat
467                 begin
468                   if wgProbData.Selected[AllProblemsIndex] then
469                     begin
470                       Line := FAllProblems[AllProblemsIndex];
471                       if Pos('#',Piece(Line, U, 2)) > 0 then
472                         InfoBox('Problem "' + Trim(UpperCase(Piece(Piece(Line, U, 3), #13, 1))) + '" ' + #13#10 +
473                         TX_INACTIVE_CODE_V, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK)
474                       else if Pos('(u)',Piece(Line, U, 2)) = 0 then
475                         InfoBox('Problem "' + Trim(UpperCase(Piece(Piece(Line, U, 3), #13, 1))) + '" is already verified.',
476                         'Problem not updated', MB_ICONINFORMATION or MB_OK)
477                       else
478                         UpdateProblem('V',Line,AllProblemsIndex);
479                     end;
480                   inc(AllProblemsIndex);
481                 end;
482               until AllProblemsIndex >= wgProbData.Count;
483               RefreshList;
484               mnuActVerify.Enabled := False;
485               popVerify.Enabled := False;
486             end;
487         end;
488       300: {detail}
489         with wgProbData do
490           begin
491             if ItemIndex < 0 then
492               InfoBox('Select a problem from the grid for Detail Display',
493                 'Information', MB_OK or MB_ICONINFORMATION)
494             else if StrToIntDef(Piece(MString(ItemIndex), U, 1),0)>0 then
495               ReportBox(DetailProblem(StrToInt(Piece(MString(ItemIndex), U, 1))),
496                 Piece(Piece(MString(ItemIndex), U, 3), #13, 1), True);
497           end;
498       400: {edit}
499         begin
500           if PlUser.usViewAct = 'R' then
501             begin
502               InfoBox('Cannot select a problem to edit from the "Removed Problem List"',
503                 'Information', MB_OK or MB_ICONINFORMATION);
504               exit;
505             end;
506           if wgProbData.ItemIndex < 0 then
507             InfoBox('Select a problem from the grid to Edit', 'Information', MB_OK or MB_ICONINFORMATION)
508           else
509             begin
510               if not EncounterPresent then exit;
511               pProviderID := Encounter.Provider;
512               pProviderName := Encounter.ProviderName ;
513               EditProblem('E');
514             end
515         end;
516       500: {Remove}
517         begin
518           if not PlUser.usPrimeUser then exit ;
519           if PlUser.usViewAct = 'R' then
520             begin
521               InfoBox('Cannot remove from the "Removed Problem List"' +#13#10 + 'Use "Restore Problem"',
522                 'Information', MB_OK or MB_ICONINFORMATION);
523               exit;
524             end;
525           if wgProbData.ItemIndex < 0 then
526             InfoBox('Select a problem from the grid to remove', 'Information', MB_OK or MB_ICONINFORMATION)
527           else
528             begin
529               if not EncounterPresent then exit;
530               pProviderID := Encounter.Provider;
531               pProviderName := Encounter.ProviderName ;
532               EditProblem('R');
533             end;
534         end;
535       550: {Restore}
536         begin
537           if not PlUser.usPrimeUser then exit ;
538           if PlUser.usViewAct <> 'R' then
539             begin
540               InfoBox('View the Removed Problems Display, and select a record to restore.',
541                 'Information', MB_OK or MB_ICONINFORMATION);
542               exit;
543             end;
544          if wgProbData.ItemIndex < 0 then
545            InfoBox('Select a problem to restore from the grid on right', 'Information', MB_OK or MB_ICONINFORMATION)
546          else
547            begin
548              if not EncounterPresent then exit;
549              pProviderID := Encounter.Provider;
550              pProviderName := Encounter.ProviderName ;
551              RestoreProblem;
552            end;
553         end;
554       600: {Add Comment}
555         begin
556           if PlUser.usViewAct = 'R' then
557             begin
558               InfoBox('Cannot add a comment to a removed problem', 'Information', MB_OK or MB_ICONINFORMATION);
559               exit;
560             end;
561           if wgProbData.ItemIndex < 0 then
562             InfoBox('Select a problem to annotate from the grid on right', 'Information', MB_OK or MB_ICONINFORMATION)
563           else
564             begin
565               if not EncounterPresent then exit;
566               pProviderID := Encounter.Provider;
567               pProviderName := Encounter.ProviderName ;
568               AList := TStringList.Create;
569               ProblemIFN := Piece(MString(wgProbData.ItemIndex), U, 1);
570               FastAssign(EditLoad(ProblemIFN, pProviderID, PLPt.ptVAMC), AList) ;
571               if Alist.count = 0 then
572                 begin
573                   InfoBox('No Data on Host for problem ' + ProblemIFN, 'Information', MB_OK or MB_ICONINFORMATION);
574                   close;
575                   exit;
576                 end;
577               ProbRec:=TProbRec.Create(Alist); {create a problem object}
578               try
579                 ProbRec.PIFN := ProblemIFN;
580                 if ProbRec.CmtIsXHTML then
581                   begin
582                     InfoBox(ProbRec.CmtNoEditReason, 'Unable to add new comment', MB_ICONWARNING or MB_OK);
583                     exit;
584                   end ;
585                 cmt := NewComment ;
586                 if (StrToInt(Piece(cmt, U, 1)) > 0) and (Piece(cmt, U, 3) <> '') then
587                   begin
588                     ProbRec.AddNewComment(Piece(cmt, U, 3));
589                     ut := '';
590                     If PLUser.usPrimeUser then ut := '1';
591                     FastAssign(EditSave(ProblemIFN, pProviderID, PLPt.ptVAMC, ut, ProbRec.FilerObject, ''), AList);
592                     LoadPatientProblems(AList, PlUser.usViewAct[1], True);
593                   end ;
594               finally
595                 Alist.Free ;
596                 ProbRec.Free ;
597               end ;
598             end ;
599         end;
600       700: {Active only}
601         begin
602           Alist := TstringList.create;
603           try
604             PlUser.usViewAct := 'A';
605             LoadPatientProblems(Alist, 'A', False);
606             SetPiece(FContextString, ';', 3, 'A');
607             GetRowCount;
608           finally
609             Alist.free;
610           end;
611         end;
612       800: {inactive Only}
613         begin
614           Alist := TstringList.create;
615           try
616             PlUser.usViewAct := 'I';
617             LoadPatientProblems(Alist, 'I', False);
618             SetPiece(FContextString, ';', 3, 'I');
619             GetRowCount;
620           finally
621             Alist.free;
622           end;
623         end;
624       900: {all problems display}
625         begin
626           Alist := TstringList.create;
627           try
628             PlUser.usViewAct := 'B';
629             LoadPatientProblems(Alist, 'B', False);
630             SetPiece(FContextString, ';', 3, 'B');
631             GetRowCount;
632           finally
633             Alist.free;
634           end;
635         end;
636       950: {Removed Problems Display}
637         begin
638           Alist := TstringList.create;
639           try
640             PlUser.usViewAct := 'R';
641             LoadPatientProblems(Alist, 'R', False);
642             SetPiece(FContextString, ';', 3, 'R');
643             GetRowCount;
644           finally
645             Alist.free;
646           end;
647         end;
648       975: {Select viewing filters}
649         begin
650           lstView.ItemIndex := -1;
651           ContextString := '^;;' + PLUser.usViewAct[1] + ';' + PLUser.usViewComments;
652           GetViewFilters(Font.Size, PLFilters, ContextString, FilterString, FilterChanged);
653           if not FilterChanged then exit;
654           FContextString := ContextString;
655           FFilterString := FilterString;
656           if (Piece(ContextString, ';', 3) <> PLUser.usViewAct[1]) then
657             begin
658               AList := TStringList.Create;
659               try
660                 PLUser.usViewAct := Piece(ContextString, ';', 3);
661                 LoadPatientProblems(Alist, PLUser.usViewAct[1], False);
662               finally
663                 AList.Free;
664               end;
665             end;
666           if (Piece(ContextString, ';', 4) <> PLUser.usViewComments) then with FAllProblems do
667             begin
668               for i := 0 to Count - 1 do
669                 begin
670                   if Objects[i] = nil then continue;
671                   x := Piece(Piece(Strings[i], U, 3), #13, 1);
672                   if Piece(ContextString, ';', 4) = '1' then
673                     begin
674                       comments := '';
675                       for j := 0 to TStringList(Objects[i]).Count - 1 do
676                         comments := comments + '         ' + TStringList(Objects[i]).Strings[j] + #13#10;
677                         //comments := comments + '   CMT:  ' + TStringList(Items.Objects[i]).Strings[j] + #13#10;
678                       line := Strings[i];
679                       SetPiece(line, U, 3, x + #13#10 + comments);
680                       Strings[i] := line;
681                       mnuViewComments.Checked := True;
682                     end
683                   else
684                     begin
685                       line := Strings[i];
686                       SetPiece(line, U, 3, x);
687                       Strings[i] := line;
688                       mnuViewComments.Checked := False;
689                     end;
690                 end;
691               RefreshList;
692               PLUser.usViewComments := Piece(ContextString, ';', 4);
693             end;
694           pnlRightResize(Self);
695         end ;
696     end;
697   end;
698   
699   procedure TfrmProblems.lstProbPickClick(Sender: TObject);
700   begin
701     if PlUser.usViewAct = 'R' then exit;
702     pProviderID := Encounter.Provider ;
703     AddProblem;
704     TListBox(sender).itemindex := -1;
705   end;
706   
707   procedure TfrmProblems.pnlProbEntResize(Sender: TObject);
708   (*var
709     i:integer;*)
710   begin
711   (*  for i := 0 to pred(twincontrol(sender).controlcount) do
712       begin
713         twincontrol(sender).controls[i].width := twincontrol(sender).width - 4;
714         twincontrol(sender).controls[i].left := 2;
715       end;*)
716   end;
717   
718   procedure TfrmProblems.wgProbDataClick(Sender: TObject);
719   var
720     S: string;
721   begin
722     pnlRight.font.color := self.font.color;
723     S := MString(wgProbData.ItemIndex);
724     //pnlRight.caption := Piece(Piece(S, U , 3), #13, 1); //fixes part (b) of CQ #15531: 508 Problems Tab [CPRS v28.1] {TC}
725     if (Piece(S, U, 1) = '') or
726        (Pos('No data available',  Piece(S, U, 2)) > 0) or
727        (Pos('No problems found.', Piece(S, U, 2)) > 0)
728      then NoRowSelected else RowSelected ;
729   end;
730   
731   procedure TfrmProblems.wgProbDataDblClick(Sender: TObject);
732   begin
733     lstProbActsClick(mnuActDetails);
734   end;
735   
736   procedure TfrmProblems.lstProbPickDblClick(Sender: TObject);
737   begin
738     if PlUser.usViewAct = 'R' then exit;
739     pProviderID := Encounter.Provider ;
740     AddProblem;
741     TListBox(sender).itemindex := -1;
742   end;
743   
744   procedure TfrmProblems.edProbEntKeyPress(Sender: TObject; var Key: Char);
745   begin
746     if key=#13 then lstProbPickDblClick(sender);
747   end;
748   
749   procedure TfrmProblems.bbOtherProbClick(Sender: TObject);
750   var
751     frmPLLex: TfrmPLLex;
752   begin
753     if not PLUser.usUseLexicon then exit; {don't allow lookup}
754     frmPLLex := TfrmPLLex.Create(Application);
755     try
756       frmPLLex.showmodal;
757     finally
758       frmPLLex.Free;
759     end;
760   end;
761   
762   procedure TfrmProblems.UMCloseProblem(var Message:TMessage);
763   begin
764     pnlView.BringToFront ;
765     ShowPnlView;
766     bbCancel.Enabled := True ;
767     bbOtherProb.enabled := true; {restore lexicon access}
768     pnlButtons.Visible := False;
769     pnlButtons.SendToBack;
770     pnlProbEnt.Visible :=  (not PLUser.usUseLexicon) ;
771     if PLuser.usViewAct = 'A' then
772       pnlRight.caption := ACTIVE_LIST_CAP
773     else if PLuser.usViewAct = 'I' then
774       pnlRight.caption := INACTIVE_LIST_CAP
775     else if PLuser.usViewAct = 'B' then
776       pnlRight.caption := BOTH_LIST_CAP
777     else if PLuser.usViewAct = 'R' then
778       pnlRight.caption := REMOVED_LIST_CAP
779     else
780       begin
781         PlUser.usViewAct := 'A';
782         pnlRight.caption := ACTIVE_LIST_CAP;
783       end;
784     if dlgProbs <> nil then dlgProbs:=nil;
785   end;
786   
787   //procedure TfrmProblems.UMPLFilter(var Message:TMessage);
788   procedure TfrmProblems.ApplyViewFilters;
789   var
790     i: integer;
791     wantnulls: boolean;
792   begin
793     {the following escape is necessitated by change in default row height which
794      corrupts display of hidden rows in wgProbData. Since the default rowheight
795      is changed with each change in screen size, this gets called once before
796      PLFilters is created}
797     if PLFilters = nil then exit; {not initialized}
798     {show all rows}
799     wantnulls := (PLFilters.ProviderList.indexof('-1') > -1);
800     for i := 0 to pred(FProblemsVisible.count) do FProblemsVisible[i] := 'Y';
801   
802     {filter for provider}
803     if PLFilters.ProviderList.Count > 0 then
804       if PLFilters.ProviderList[0] <> '0' then { 0 signifies all }
805         for i := 0 to pred(FAllProblems.count) do
806           if Piece(FAllProblems[i], U, 1) <> '' then {don't want to disappear empty rows}
807             if (PLFilters.ProviderList.indexof(Piece(FAllProblems[i], U, 10)) < 0) or
808                ((Piece(FAllProblems[i], U, 10) = '') and (not wantnulls)) then
809               FProblemsVisible[i] := 'N';
810   
811     if PLUser.usCurrentView = PL_UF_VIEW then exit; {Bail out - no filtering by Loc}
812   
813     {conditionally filter for clinic(s) - may be multiple selected}
814     if PLUser.usCurrentView = PL_OP_VIEW then
815       begin
816         wantnulls := (PLFilters.ClinicList.indexof('-1') > -1);
817         if PLFilters.ClinicList.Count = 0 then exit;
818         if PLFilters.ClinicList[0] <> '0' then { 0 signifies all }
819           for i := 0 to pred(FAllProblems.count) do
820             if (Piece(FAllProblems[i], U, 1) <> '') and          {don't want to disappear empty rows}
821                (FProblemsVisible[i] = 'Y') then                          {don't want if already filtered}
822               begin
823                 if (Piece(FAllProblems[i], U ,11) <> '') and       {clinic not on user list}
824                          (PLFilters.ClinicList.indexof(Piece(FAllProblems[i], U, 11)) < 0) then
825                   FProblemsVisible[i] := 'N'
826                 else if ((Piece(FAllProblems[i], U, 11) = '') and (not wantnulls)) then {no clinic recorded}
827                   FProblemsVisible[i] := 'N';
828               end;
829       end
830     else
831     {conditionally filter for service - may be multiple selected}
832       begin
833         wantnulls := (PLFilters.ServiceList.indexof('-1') > -1);
834         if PLFilters.ServiceList.Count = 0 then exit;
835         if PLFilters.ServiceList[0] <> '0' then { 0 signifies all }
836           for i := 0 to pred(FAllProblems.count) do
837             if (Piece(FAllProblems[i], U, 1) <> '') and        {don't want to disappear empty rows}
838               (FProblemsVisible[i] = 'Y') then                         {don't want if already filtered}
839               begin
840                 if (Piece(FAllProblems[i], U, 12) <> '') and              {Service not on user list}
841                         (PLFilters.ServiceList.indexof(Piece(FAllProblems[i], U, 12)) < 0) then
842                   FProblemsVisible[i] := 'N'
843                 else if (Piece(FAllProblems[i], U, 12) = '') and (not wantnulls) then               {no Service recorded}
844                   FProblemsVisible[i] := 'N';
845               end;
846       end;
847   end;
848   
849   procedure TfrmProblems.GetRowCount;
850   var
851     ShownProbs, TotalProbs: integer;
852   begin
853     if (wgProbData.Items.Count > 0) and (Piece(wgProbData.Items[0], U, 1) <> '') then
854       ShownProbs := wgProbData.Items.Count
855     else
856       ShownProbs := 0;
857   
858     if (FAllProblems.Count > 0) and (Piece(FAllProblems[0], U, 1) <> '') then
859       TotalProbs := FAllProblems.Count
860     else
861       TotalProbs := 0;
862       
863     case PLUser.usViewAct[1] of
864       'A': lblProbList.Caption := ACTIVE_LIST_CAP ;
865       'I': lblProbList.Caption := INACTIVE_LIST_CAP ;
866       'B': lblProbList.Caption := BOTH_LIST_CAP ;
867       'R': lblProbList.Caption := REMOVED_LIST_CAP ;
868     end;
869     lblProbList.Caption := lblProbList.Caption + '   (' + IntToStr(ShownProbs) + ' of ' + IntToStr(TotalProbs) + ')';
870     wgProbData.Caption := lblProbList.Caption;
871   end;
872   
873   
874   procedure TfrmProblems.UMPLLexicon(var Message:TMessage);
875   begin
876     if PLProblem = '' then exit; {shouldn't happen but...}
877     if dlgProbs = nil then AddProblem;
878   end;
879   
880   procedure TfrmProblems.SetGridPieces( Pieces: string);
881   var
882     i, AdjustCol, cxUsed: Integer;
883     PieceSet: set of 0..High(GridColWidths);
884     x: string;
885   begin
886     PieceSet := [];
887     x := Pieces;
888     while x <> '' do begin
889       PieceSet := PieceSet + [StrToIntDef(Piece(x, ',', 1), 1)-1];
890       if Pos(',', x) = 0 then
891         break;
892       x := Copy(x, Pos(',',x)+1, Length(x));
893     end;
894     AdjustCol := 0;
895     cxUsed := 0;
896     for i := 0 to High(GridColWidths) do
897       if i in PieceSet then
898       begin
899         if GridColWidths[i] > -1 then
900         begin
901           if GridColWidths[i] > 0 then
902           begin
903             HeaderControl.Sections[i].MaxWidth := 10000;
904             HeaderControl.Sections[i].Width := ForChars(GridColWidths[i], gFontWidth);
905             cxUsed := cxUsed + HeaderControl.Sections[i].Width;
906           end
907           else
908           begin
909             HeaderControl.Sections[i].Width := 0;
910             HeaderControl.Sections[i].MaxWidth := 0;
911           end;
912         end
913         else
914           AdjustCol := i;
915       end
916       else
917       begin
918         HeaderControl.Sections[i].Width := 0;
919         HeaderControl.Sections[i].MaxWidth := 0;
920       end;
921     HeaderControl.Sections[AdjustCol].AutoSize := True;
922     HeaderControl.Sections[AdjustCol].Width := HeaderControl.Width - cxUsed;
923     //mnuOptimizeFieldsClick(self);       //******** test making compression, proportional, or no spacing on resize
924   end;
925   
926   procedure TfrmProblems.pnlRightResize(Sender: TObject);
927   begin
928     if PLUser = nil then exit;
929     if PLUser.usCurrentView = PL_IP_VIEW then
930       SetGridPieces('2,3,4,5,8,9')
931     else if PLUser.usCurrentView = PL_OP_VIEW then
932       SetGridPieces('2,3,4,5,7');
933     {have to do this to recover hidden rows}
934     ApplyViewFilters;
935     RefreshList;
936     GetRowCount;
937     //PostMessage(frmProblems.Handle, UM_PLFILTER,0,0);
938   end;
939   
940   procedure TfrmProblems.FormCreate(Sender: TObject);
941   begin
942     inherited;
943   //  FixHeaderControlDelphi2006Bug(HeaderControl);
944     FAllProblems := TStringList.Create;
945     FProblemsVisible := TStringList.Create;
946     FItemData := TStringList.Create;
947     PageID := CT_PROBLEMS;
948     GetFontInfo(Canvas.Handle, gFontWidth, gFontHeight);
949     FI10Active := (Piece(Encounter.GetICDVersion, U, 1) <> 'ICD');
950   end;
951   
952   procedure TfrmProblems.LoadUserParams(Alist:TstringList);
953   var
954     i: integer;
955   begin
956     FastAssign(InitUser(User.DUZ), AList) ;
957     //FastAssign(InitUser(Encounter.Provider), AList) ;
958     PLUser := TPLUserParams.Create(Alist);
959     FContextString := PLUser.usDefaultContext;
960     FFilterString :=  PLUser.usDefaultView + '/';
961     if PLFilters <> nil then
962       begin
963         if PLUser.usDefaultView = 'C' then with PLFilters.ClinicList do
964             for i := 0 to Count - 1 do
965               if Piece(Strings[i], U, 1) <> '-1' then
966                 FFilterString := FFilterString + Piece(Strings[i], U, 1) + '/';
967         if PLUser.usDefaultView = 'S' then with PLFilters.ServiceList do
968             for i := 0 to Count - 1 do
969               if Piece(Strings[i], U, 1) <> '-1' then
970                 FFilterString := FFilterString + Piece(Strings[i], U, 1) + '/';
971       end;
972     mnuViewComments.Checked := (PLUser.usViewComments = '1');
973     if PLUser.usTesting then
974       InfoBox('WARNING - Test User Parameters in Effect', 'Warning', MB_OK or MB_ICONWARNING);
975     pnlRightResize(Self);
976   end;
977   
978   procedure TfrmProblems.LoadPatientParams(AList:TstringList);
979   begin
980     FastAssign(InitPt(Patient.DFN), AList) ;
981     PLPt := TPLPt.Create(Alist);
982   end;
983   
984   procedure TfrmProblems.ClearGrid;
985   var
986     i:integer;
987   begin
988     with FAllProblems do for i := 0 to Count - 1 do
989       if Objects[i] <> nil then
990         begin
991           TStringList(Objects[i]).Free;
992           Objects[i] := nil;
993         end;
994     wgprobdata.Clear;
995     FAllProblems.Clear;
996     FProblemsVisible.Clear;
997   end;
998   
999   
1000  procedure TfrmProblems.LoadPatientProblems(AList:TStringList; const Status:char; init:boolean);
1001  var {init should only be true when initializing a list for a new patient}
1002    x, line, ver, prio, comments, cs: String;
1003    i, j, inactI, inactS: Integer;
1004    st: char;
1005    CmtList: TStringList;
1006    DateOfInterest: TFMDateTime;
1007    //SCCond, tmpSCstr: string;
1008  
1009    procedure ReverseList(Alist:TstringList);
1010    var
1011      i,j:integer;
1012    begin
1013      i:=0;
1014      j:=pred(Alist.count);
1015      while i<j do
1016        begin
1017          alist.exchange(i,j);
1018          inc(i);
1019          dec(j);
1020        end;
1021    end;
1022  
1023  begin  {Body}
1024    FI10Active := (Piece(Encounter.GetICDVersion, U, 1) <> 'ICD');
1025    CmtList := TStringList.Create;
1026    if PLFilters=nil then {create view filter lists}
1027      PLFilters:=TPLFilters.create;
1028    try
1029      ClearGrid;
1030      inactI := 0;
1031      inactS := 0;
1032      if PLPt = nil then
1033        begin
1034          InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
1035          AList.Clear;
1036          AList.Add('No data available');
1037        end
1038      else
1039        begin
1040          st:=status;
1041          if st= '' then st := 'A'; {default to active list}
1042          if Patient.Inpatient then   //CQ 21793
1043            DateOfInterest := FMNow
1044          else
1045            DateOfInterest := Encounter.DateTime;
1046          FastAssign(ProblemList(Patient.DFN, st, DateOfInterest), AList);
1047        end;
1048      if Status = 'R' then
1049        SetGridPieces('3,4,5,7,8,9')
1050      else
1051        SetGridPieces('2,3,4,5,7,8,9');
1052      if Alist.count > 1 then Alist.delete(0); {get rid of first element - it is a list count}
1053      SortByPiece(AList, u, 6); { Sort by FM date/time }
1054      SetListFMDateTime('MMM dd yyyy',AList, u, 6);      { Change FM date to MM/DD/YY  }
1055      SetListFMDateTime('MMM dd yyyy',AList, u, 5);      { Change FM date to MM/DD/YY  }
1056      if PLUser.usReverseChronDisplay then {reverse chron order if required}
1057        ReverseList(Alist);
1058      {populate the grid}
1059      if ((Alist.Count = 1) and (pos('No data available', Alist[0]) > 0))then
1060        begin
1061          FAllProblems.Add('^^No problems found.');
1062          FProblemsVisible.Add('Y');
1063          RefreshList;
1064          Alist.Clear ;
1065          NoRowSelected;
1066          exit ;
1067        end ;
1068      for i := 0 to pred(Alist.count) do
1069      begin
1070        FAllProblems.Add('');
1071        FProblemsVisible.Add('Y');
1072        comments := '';
1073        CmtList.Clear;
1074        x := AList[i];
1075        if (Piece(x, U, 18) = '#') and CharInSet(CharAt(UpperCase(Status), 1), ['A', 'B', 'I', 'R']) and (not FI10Active) then
1076          begin
1077            ver := '#';      // inactive ICD code flag takes precedence over unverified flag
1078            if (Piece(x, U, 2) = 'A') then inactI := inactI + 1;
1079          end
1080        else if (Piece(x, U, 18) = '$') and CharInSet(CharAt(UpperCase(Status), 1), ['A', 'B', 'I', 'R']) then
1081          begin
1082            ver := '#';      // inactive SNOMED CT code flag takes precedence over unverified flag
1083            if (Piece(x, U, 2) = 'A') then inactS := inactS + 1;
1084          end
1085        else if (PlUSer.usVerifyTranscribed) and
1086                (Piece(x, U, 9) = 'T') then
1087          ver := '(u)'
1088        else
1089          ver := '   ';
1090        if Piece(x, U, 14) = 'A' then prio   := ' * ' else prio   := '   ' ;
1091        Line := '';
1092        SetPiece(Line, U, 2, Piece(x, U, 2) + prio + ver);
1093        if Piece(x, U, 15) = '1' then  //problem has comments
1094          begin
1095            FastAssign(GetProblemComments(Piece(x, U, 1)), CmtList);
1096            if FAllProblems.Objects[i] = nil then FAllProblems.Objects[i]:= TStringList.Create;
1097            FastAssign(CmtList, TStringList(FAllProblems.Objects[i]));
1098          end;
1099  
1100        SetPiece(Line, U, 3, Piece(x, U, 3));
1101  
1102        if Piece(x, U, 19) <> '' then
1103        begin
1104          if Piece(x, U, 20) = 'ICD' then
1105            cs := 'ICD-9-CM'
1106          else if Piece(x, U, 20) = '10D' then
1107            cs := 'ICD-10-CM'
1108          else
1109            cs := Piece(x, U, 20);
1110          SetPiece(Line, U, 3, Piece(Line, U, 3) + #13#10 + cs + ' Text: ' + MixedCase(Piece(x, U, 19)));
1111        end;
1112        if PLUser.usViewComments = '1' then
1113          begin
1114            for j := 0 to CmtList.Count-1 do
1115              comments := comments + '         ' + CmtList.Strings[j] + #13#10;
1116            SetPiece(Line, U, 3, Piece(Line, U, 3) + #13#10 + comments);
1117          end;
1118        SetPiece(Line, U, 4, Trim(Piece(x, U, 5)));                        {onset date}
1119        SetPiece(Line, U, 5, Trim(Piece(x, U, 6)));                        {last updated}
1120        SetPiece(Line, U, 7, MixedCase(Piece(Piece(x, U, 10), ';', 2)));   {location name}
1121        SetPiece(Line, U, 8, MixedCase(Piece(Piece(x, U, 12), ';', 2)));   {provider name}
1122        SetPiece(Line, U, 9, MixedCase(Piece(Piece(x, U, 13), ';', 2)));   {service name}
1123        {hidden cells}
1124        SetPiece(Line, U, 1, Piece(x, U, 1));                              {problem IEN}
1125        SetPiece(Line, U, 6, Piece(x, U, 7));                              {service connected status}
1126        SetPiece(Line, U, 11, Piece(Piece(x, U, 10), ';', 1));              {location IEN}
1127        SetPiece(Line, U, 13, Piece(x, U, 11));                             {loc type}
1128        SetPiece(Line, U, 10, Piece(Piece(x, U, 12), ';', 1));              {responsible provider IEN}
1129        SetPiece(Line, U, 12, Piece(Piece(x, U, 13), ';', 1));              {service IEN}
1130        SetPiece(Line, U, 14, Piece(x, U, 4));                              {code}
1131        SetPiece(Line, U, 15, Piece(x, U, 17));                             {Service-connected conditions}
1132        SetPiece(Line, U, 16, Piece(x, U, 18));                             {# = inactive ICD code stored with problem}
1133        FAllProblems[i] := Line;
1134      end;
1135      Alist.clear;
1136      if not init then
1137        SetViewFilters(Alist)
1138      else
1139        InitViewFilters(Alist);
1140      ApplyViewFilters;
1141      RefreshList;
1142      lstProbPick.ItemIndex := -1;
1143      if (ProbRec <> nil) and (ProbRec.PIFN <> '') then
1144        begin
1145          for i := 0 to wgProbData.Items.count-1 do
1146            if (Piece(MString(i), U, 1) = ProbRec.PIFN) then
1147               wgProbData.ItemIndex := i ;
1148          wgProbDataClick(Self);
1149        end
1150      else
1151        wgProbData.ItemIndex := -1;
1152      if (wgProbData.Items.Count > 0) and (wgProbData.ItemIndex > -1) then
1153        RowSelected
1154      else
1155        NoRowSelected;
1156      pnlRightResize(Self);
1157      if (not FWarningShown) and (inactI > 0) and (inactS > 0) and CharInSet(CharAt(UpperCase(Status), 1), ['A', 'B']) then
1158        begin
1159         InfoBox('There are ' + IntToStr(inactI) + ' active problem(s) flagged with a "#" as having ' +
1160                 'inactive ICD codes as of the Encounter date. There are also ' + IntToStr(inactS) +
1161                 ' active problem(s) flagged with a "#" as having inactive SNOMED CT codes as of ' +
1162                 'the Encounter date. You may correct these problems using the "Change" option.',
1163                 'Inactive ICD & SNOMED CT Codes Found', MB_ICONWARNING or MB_OK);
1164         FWarningShown := True;
1165        end
1166      else if (not FWarningShown) and (inactI > 0) and CharInSet(CharAt(UpperCase(Status), 1), ['A', 'B']) then
1167        begin
1168         InfoBox('There are ' + IntToStr(inactI) + ' active problem(s) flagged with a "#" as having ' +
1169                 'inactive ICD codes as of the Encounter date. You may correct these problems using the "Change" option.',
1170                 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK);
1171         FWarningShown := True;
1172        end
1173      else if (not FWarningShown) and (inactS > 0) and CharInSet(CharAt(UpperCase(Status), 1), ['A', 'B']) then
1174        begin
1175         InfoBox('There are ' + IntToStr(inactS) + ' active problem(s) flagged with a "#" as having ' +
1176                 'inactive SNOMED CT codes as of the Encounter date. You may correct these problems ' +
1177                 'using the "Change" option.', 'Inactive SNOMED CT Codes Found', MB_ICONWARNING or MB_OK);
1178         FWarningShown := True;
1179        end;
1180    finally
1181      CmtList.Free;
1182    end;
1183  end;
1184  
1185  procedure TfrmProblems.LoadUserCats(AList:TStringList);
1186  begin
1187    if not PLUser.usUseLexicon then exit; {Bail out if not to use lexicon}
1188    Alist.clear;
1189    FastAssign(UserProblemCategories(Encounter.Provider,Encounter.Location), AList) ;
1190    if Alist.count = 0 then
1191      begin
1192        lstCatPick.Items.Add('-1^None defined - use OTHER') ;
1193        lstProbPick.Visible := False ;
1194        lblProblems.Visible := False ;
1195        exit ;
1196      end ;
1197    FastAssign(AList, lstCatPick.Items);
1198    lstCatPick.itemindex := 0;
1199    lstCatPickClick(frmProblems);
1200  end;
1201  
1202  procedure TfrmProblems.LoadUserProbs(AList:TStringList);
1203  var
1204    catien: string;
1205  begin
1206    if not PLUser.usUseLexicon then exit; {Bail out if not to use lexicon}
1207    if lstCatPick.itemindex < 0 then exit; {bail out}
1208    Alist.clear;
1209    catien := IntToStr(lstCatPick.itemIEN);
1210    FastAssign(UserProblemList(catien), AList) ;
1211    {File 125.12, Each line contains: PROBLEM^DISPLAY TEXT^CODE^CODE IFN }
1212    {code ifn is derived}
1213    FastAssign(Alist, lstProbPick.Items);
1214  end;
1215  
1216  procedure TfrmProblems.LoadProblems;
1217  var
1218    AList: TStringList;
1219    i: integer;
1220  begin
1221    pProviderID := 0;
1222    AList := TStringList.Create;
1223    try
1224      lstView.ItemIndex := -1;
1225      StatusText('Retrieving problem list...') ;
1226      if (PLUser = nil) or InitPatient then LoadUserParams(Alist);
1227      Alist.clear;
1228      if Patient.DFN <> '' then LoadPatientParams(Alist);
1229      Alist.clear;
1230      LoadPatientProblems(AList, PlUser.usViewAct[1], True); {initialize patient list}
1231      lstView.ItemIndex := -1;
1232      AList.clear;
1233      lstCatPick.Clear ;
1234      LoadUserCats(AList);
1235      {SET APPLICATION DEFAULTS}
1236      if (not PLUser.usPrimeUser) then
1237        begin {activities available to GMPLUSER only}
1238          mnuActRestore.enabled := False;
1239          mnuActRemove.enabled:=false;
1240          mnuViewRemoved.Enabled := False;
1241          popRemove.enabled:=false;
1242          popRestore.enabled := False;
1243          i := lstView.Items.IndexOf('Removed');
1244          if i > -1 then lstView.Items.Delete(i);
1245          mnuActVerify.enabled:=false;
1246          popVerify.enabled:=false;
1247        end;
1248      if (not PLUser.usVerifyTranscribed) then
1249        begin
1250          mnuActVerify.enabled:=false;
1251          popVerify.enabled:=false;
1252        end;
1253    finally
1254      AList.Free;
1255      StatusText('') ;
1256    end;
1257  end;
1258  
1259  function TfrmProblems.HighlightDuplicate( NewProb: string; const Msg: string;
1260    DlgType: TMsgDlgType; Action: string): boolean;
1261  var
1262    dup: string;
1263    exprList, icdList, textList: TstringList;
1264    cmpp, i, exprPos, icdPos, textPos: integer;
1265    collapserow: boolean;
1266  begin
1267    Result := False;
1268    cmpp := -1;
1269    if Piece(newprob, U, 1) = '' then
1270      dup := CheckForDuplicateProblem('1', Piece(newprob, U, 2))
1271    else
1272      dup := CheckForDuplicateProblem(Piece(newprob,U,1), Piece(newprob, U, 2));
1273  
1274    if (Piece(dup, U, 1) <> '0') then
1275      // if adding, check all existing problems for duplicates
1276      // if changing, exclude curent problem from duplicate check
1277      if (Action = 'ADD') or ((Action = 'CHANGE') and (Piece(dup, U, 1) <> ProbRec.PIFN)) then
1278        begin
1279          if (Piece(dup, U, 2) <> PLUser.usViewAct) and (PLUser.usViewAct <> 'B') then
1280            begin
1281              lstView.SelectByID(Piece(dup, U, 2));
1282              lstViewClick(Self);
1283            end;
1284          exprList := TStringList.Create;
1285          icdList := TStringList.Create;
1286          textList := TStringList.create;
1287          try {find and highlight duplicate problem - match problem text minus trailing '*'}
1288            for i := 0 to FAllProblems.Count - 1 do
1289            begin
1290              exprList.Add(TrimRight(Piece(FAllProblems[i], U, 1)));
1291              icdList.Add(TrimRight(Piece(FAllProblems[i], U, 14)));
1292              textList.Add(TrimRight(Piece(Piece(Piece(Piece(FAllProblems[i], U, 3), #13, 1), '*', 1),'(', 1)));
1293            end;
1294            exprPos := exprList.IndexOf(TrimRight(Piece(dup, U, 1)));
1295            icdPos  := icdList.IndexOf(TrimRight(Piece(newprob, U, 3)));
1296            textPos := textList.indexof(TrimRight(Piece(Piece(Piece(newprob, U, 2), '*', 1),'(', 1)));
1297            if exprPos > -1 then
1298              cmpp := exprPos
1299            else if icdPos > -1 then
1300              cmpp := icdPos
1301            else if textPos > -1 then
1302              cmpp := textPos;
1303          finally
1304            textList.free;
1305          end;
1306          if cmpp > -1 then
1307            begin
1308              collapserow:= (FProblemsVisible[cmpp] <> 'Y');
1309              if CollapseRow then
1310                wgProbData.Items.Insert(0, FAllProblems[cmpp]);
1311              //translate from FAllProblems index to wgProbData index
1312              for i := 0 to wgProbData.Items.Count - 1 do
1313              begin
1314                if StrToInt(FItemData[i]) = cmpp then with wgProbData do
1315                begin
1316                  TopIndex := i;
1317                  ItemIndex := i;
1318                  Selected[i] := True;
1319                  //break;
1320                end
1321                else if wgProbData.Selected[i] = True then
1322                  wgProbData.Selected[i] := False;
1323              end;
1324              case DlgType of
1325                mtInformation:
1326                  InfoBox(Msg, 'Information', MB_OK or MB_ICONINFORMATION);
1327                mtConfirmation:
1328                  Result := InfoBox(Msg, 'Confirmation', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES;
1329              end;
1330              if collapserow then wgProbData.Items.Delete(0);
1331            end;
1332        end;
1333  end;
1334  
1335  procedure TfrmProblems.AddProblem;
1336  const
1337    TX799 = '799.9';
1338  var
1339    newprob: string;
1340  begin
1341    if (PLPt.ptDead<>'') then {Check for dead patient}
1342      if InfoBox('This Patient has been deceased since ' + PLPt.ptDead + #13#10 +
1343      '        Proceed with problem addition?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDNO then
1344        exit; {bail out - if don't want to add to dead}
1345    {problems are in the form of: ien^.01^icd^icdifn , although only the .01 is required}
1346    if PLProblem <> '' then
1347      begin
1348        newProb:=PLProblem;
1349        PLProblem:='';
1350      end
1351    else if edProbEnt.text<>'' then
1352      begin
1353        newprob:= u + edProbEnt.text + u + TX799 + u; {free text problem entry from editbox}
1354        edProbEnt.Visible := False;
1355        lblProbEnt.Visible := False;
1356        edProbEnt.Text := '';
1357      end
1358    else if lstProbPick.itemindex > -1 then {problem selected from user list}
1359      {Each line contains: PROBLEM^DISPLAY TEXT^CODE^CODE IFN^SNOMED CT CONCEPT^SNOMED CT DESIGNATION }
1360      newprob:=lstProbPick.Items[lstProbPick.itemindex];
1361    if NewProb='' then exit; {should never happen}
1362    bbCancel.Enabled := False ;
1363    bbOtherProb.enabled:=false; {don't let them invoke lexicon till add completed}
1364  
1365    //  =============  new duplicate checking code  ===================
1366    if HighlightDuplicate(NewProb, 'This problem looks similar to the highlighted problem'
1367                   + #13#10 + '        Proceed?', mtConfirmation, 'ADD') then
1368    begin
1369      bbCancel.Enabled := True ;
1370      bbOtherProb.enabled:=true; {don't let them invoke lexicon till add completed}
1371      exit; {bail out - if don't want dups}
1372    end ;
1373  //============================== End new code =========================
1374    if ProbRec = nil then
1375      begin
1376        pnlRight.Caption := lblProbList.caption ;
1377        lblProbList.caption:='Add Problem';
1378        wgProbData.Caption := lblProbList.Caption;
1379        pnlProbDlg.Visible := True;
1380        pnlProbDlg.BringToFront ;
1381        dlgProbs:=TfrmdlgProb.Create(pnlProbDlg);
1382        dlgProbs.HorzScrollBar.Range := dlgProbs.ClientWidth;
1383        dlgProbs.VertScrollBar.Range := dlgProbs.ClientHeight;
1384        dlgProbs.parent:=pnlProbDlg;
1385        dlgProbs.Align := alClient ;
1386        dlgProbs.Reason:='A';
1387        dlgProbs.SubjProb:=newprob;
1388        dlgProbs.show;
1389        PostMessage(dlgProbs.Handle, UM_TAKEFOCUS, 0, 0);
1390        wgProbData.TabStop := False; //fixes part (c) of CQ #15531: 508 Problems tab [CPRS v28.1] {TC}.
1391        //prevents the selected problem or last entered problem from the PL captionlistbox
1392        //underneath pnlProbDlg to be focused & read by Jaws
1393      end
1394    else
1395      InfoBox('Current Add/Edit/Display activity must be completed' + #13#10 +
1396        'before another record may be added',
1397        'Information', MB_OK or MB_ICONINFORMATION);
1398  end;
1399  
1400  procedure TfrmProblems.EditProblem(const why: char);
1401  var
1402    prob: string;
1403    reas: string;
1404  begin
1405    prob := Piece(MString(wgProbData.ItemIndex), U, 1);
1406    if (prob <> '') and (ProbRec = nil) then
1407      begin
1408        StatusText('Retrieving selected problem...') ;
1409        bbCancel.Enabled := False ;
1410        bbOtherProb.enabled := false; {don't let them invoke lexicon till edit completed}
1411        case why of
1412          'E','e','C','c' : reas := 'Edit Problem';
1413          'D','d'         : reas := 'Display Problem';
1414          'R','r'         : reas := 'Remove Problem';
1415        end;
1416        pnlRight.Caption   := lblProbList.caption ;
1417        lblProbList.caption     := reas;
1418        wgProbData.Caption := lblProbList.Caption;
1419        pnlProbDlg.Visible := True;
1420        pnlProbDlg.BringToFront ;
1421        //prevents JAWS from reading the top item in the wgProbData caption listbox when hidden from view.
1422        pnlProbDlg.SetFocus;
1423        dlgProbs           := TfrmdlgProb.Create(pnlProbDlg);
1424        dlgProbs.HorzScrollBar.Range := dlgProbs.ClientWidth;
1425        dlgProbs.VertScrollBar.Range := dlgProbs.ClientHeight;
1426        dlgProbs.parent    := pnlProbDlg;
1427        dlgProbs.Align     := alClient ;
1428        dlgProbs.Reason    := why;
1429        with wgProbData do dlgProbs.subjProb:=prob + u + Trim(Piece(Piece(Piece(MString(itemindex), U, 3), #13, 1), '(', 1)) + u + Piece(MString(itemindex), U, 14);
1430        StatusText('') ;
1431        dlgProbs.Show;
1432        PostMessage(dlgProbs.Handle, UM_TAKEFOCUS, 0, 0);
1433        wgProbData.TabStop := False;  //fixes part (c) of CQ #15531: 508 Problems tab [CPRS v28.1] {TC}.
1434        //prevents the selected problem or last entered problem from the PL captionlistbox
1435        //underneath pnlProbDlg to be focused & read by Jaws
1436      end
1437    else
1438      begin
1439        case why of
1440          'E','e','C','c' : reas := 'Edited';
1441          'D','d'         : reas := 'Displayed';
1442          'R','r'         : reas := 'Removed';
1443        end;
1444        InfoBox('Current Add/Edit/Display activity must be completed' + #13#10 +
1445          'before another record may be ' + reas,
1446          'Information', MB_OK or MB_ICONINFORMATION);
1447      end;
1448  end;
1449  
1450  procedure TfrmProblems.UpdateProblem(const why:char; Line: string; AllProblemsIndex: integer);
1451  var
1452    Alist: TstringList;
1453    DateOfInterest: TFMDateTime;
1454    SvcCat: Char;
1455    ProblemIFN: string;
1456    sv: string;
1457  begin
1458    alist := TstringList.create;
1459    try
1460      problemIFN := Piece(Line, U, 1);
1461      {get the basic info - could shortcut, but try this for now}
1462      FastAssign(EditLoad(ProblemIFN, pProviderID, PLPt.ptVAMC), AList) ;
1463      probRec := TProbRec.Create(Alist);
1464      probRec.PIFN := problemIFN;
1465      ProbRec.RespProvider.DHCPtoKeyVal(inttostr(Encounter.Provider) + u + Encounter.ProviderName);   {REV - V13}
1466      SvcCat := Encounter.VisitCategory;
1467      if (SvcCat = 'E') or (SvcCat = 'H') then
1468        DateOfInterest := FMNow
1469      else
1470        DateOfInterest := Encounter.DateTime;
1471      Alist.clear;
1472      case why of
1473        'I': begin
1474               ProbRec.status := 'I';
1475               {assume resolution date now with this option. user should do full edit otherwise}
1476               ProbRec.DateResStr := 'T';
1477               Probrec.DateModStr := 'T';
1478               FastAssign(ProblemUpdate(ProbRec.AltFilerObject), AList) ;
1479             end;
1480        'V': begin
1481              if not IsActiveICDCode(ProbRec.Diagnosis.extern, DateOfInterest) then
1482                begin
1483                  InfoBox(TX_INACTIVE_ICODE, TC_INACTIVE_ICODE, MB_ICONWARNING or MB_OK);
1484                  exit;
1485                end
1486              else if (ProbRec.SCTConcept.extern <> '') and not IsActiveSCTCode(ProbRec.SCTConcept.extern, DateOfInterest) then
1487                begin
1488                  InfoBox(TX_INACTIVE_SCODE, TC_INACTIVE_SCODE, MB_ICONWARNING or MB_OK);
1489                  exit;
1490                end;
1491               Probrec.condition := 'P';
1492               Probrec.DateModStr := 'T';
1493               FastAssign(ProblemVerify(ProbRec.PIFN), AList) ;
1494             end;
1495      end;
1496  
1497      if Alist.count<1 then {show error message}
1498        InfoBox('Unable to update record ', 'Information', MB_OK or MB_ICONINFORMATION)
1499      else if Alist[0]<'1' then
1500        InfoBox('Unable to update record: ' + #13#10 + ' ' + Alist[1] + ' (' + Probrec.PIFN + ')',
1501          'Information', MB_OK or MB_ICONINFORMATION)
1502      {show inactivated problem}
1503      else if (why='I') then
1504        begin
1505          if (PlUser.usViewAct='A') then
1506            FProblemsVisible[AllProblemsIndex] := 'N'
1507          else
1508          begin
1509            SetPiece(line, U, 2, 'I');
1510            FAllProblems[AllProblemsIndex] := line;
1511          end;
1512        end
1513      else if (why='V') then {show verified problem}
1514        begin
1515          sv := Piece(Line, U, 2);
1516          SetPiece(line, U, 2, Copy(sv,1,4)); //remove (u)
1517          FAllProblems[AllProblemsIndex] := line;
1518        end;
1519    finally
1520      Changes.RefreshCoverPL := True;
1521      alist.free;
1522      ProbRec.free;
1523      ProbRec := nil;
1524    end;
1525  end;
1526  
1527  procedure TfrmProblems.RestoreProblem;
1528  const
1529    TC_RESTORE_EDIT = 'Unable to restore';
1530    TX_RESTORE_EDIT = 'This problem references an inactive ICD code,' + #13#10 +
1531                      'and must be updated using the ''Change'' option' + #13#10 +
1532                      'before it can be restored.' + #13#10 + #13#10 +
1533                      'Would you like to edit this problem?';
1534  var
1535    Alist:TstringList;
1536    AProbRec: TProbRec;
1537    ProblemIFN: string;
1538    DateOfInterest: TFMDateTime;
1539    SvcCat: Char;
1540  begin
1541    Alist := TStringList.create;
1542    ProblemIFN := Piece(MString(wgProbData.ItemIndex), U, 1);
1543    FastAssign(EditLoad(ProblemIFN, pProviderID, PLPt.ptVAMC), AList) ;
1544    AProbRec:=TProbRec.Create(Alist); {create a problem object}
1545    SvcCat := Encounter.VisitCategory;
1546    if (SvcCat = 'E') or (SvcCat = 'H') then
1547      DateOfInterest := FMNow
1548    else
1549      DateOfInterest := Encounter.DateTime;
1550    try
1551      if not IsActiveICDCode(AProbRec.Diagnosis.extern, DateOfInterest) then
1552        begin
1553          if InfoBox(TX_RESTORE_EDIT, TC_RESTORE_EDIT, MB_YESNO or MB_ICONWARNING) = IDYES then
1554          begin
1555            AProbRec.Status := 'A';
1556            EditProblem('C');
1557          end
1558          else
1559            Exit;
1560        end
1561      else
1562        begin
1563          FastAssign(ProblemReplace(ProblemIFN), Alist) ;
1564          if Alist[0] <> '1' then
1565            InfoBox('Unable to restore the problem record: ' + #13#10 + ' (' + AProbrec.PIFN + ')',
1566              'Information', MB_OK or MB_ICONINFORMATION)
1567          else
1568            LoadPatientProblems(AList, 'R', False);
1569          GetRowCount;
1570        end;
1571    finally
1572      Changes.RefreshCoverPL := True;
1573      AList.free;
1574      AProbRec.Free;
1575    end;
1576  end;
1577  
1578  procedure TfrmProblems.NoRowSelected;
1579  begin
1580    mnuActDetails.enabled    := false;
1581    mnuActChange.enabled     := false;
1582    mnuActVerify.enabled     := false;
1583    mnuActInactivate.enabled := false;
1584    mnuActRestore.enabled    := false;
1585    mnuActRemove.enabled     := false;
1586    mnuActAnnotate.enabled   := false;
1587    popChange.enabled        := false;
1588    popVerify.enabled        := false;
1589    popInactivate.enabled    := false;
1590    popRestore.enabled       := false;
1591    popRemove.enabled        := false;
1592    popAnnotate.enabled      := false;
1593    popViewDetails.enabled   := False;
1594  end ;
1595  
1596  procedure TfrmProblems.RowSelected;
1597  var
1598   AnyUnver, AnyAct: integer;
1599   i: integer;
1600  begin
1601    if wgProbData.SelCount > 1 then
1602      begin
1603        mnuActDetails.enabled    := false;
1604        mnuActChange.enabled     := false;
1605        mnuActRestore.enabled    := false;
1606        mnuActRemove.enabled     := false;
1607        mnuActAnnotate.enabled   := false;
1608        popChange.enabled        := false;
1609        popRestore.enabled       := false;
1610        popRemove.enabled        := false;
1611        popAnnotate.enabled      := false;
1612        popViewDetails.enabled   := false;
1613        AnyUnver := 0;
1614        AnyAct := 0;
1615        for i := 0 to wgProbData.Count - 1 do
1616         begin
1617          if wgProbData.Selected[i] and (Copy(Piece(MString(i), U, 2),5,3)='(u)') then
1618            AnyUnver := AnyUnVer + 1;
1619          if wgProbData.Selected[i] and (Copy(Piece(MString(i), U, 2),1,1) = 'A') then
1620            AnyAct := AnyAct + 1;
1621         end;
1622        mnuActVerify.enabled     := PLUser.usVerifyTranscribed and
1623                                    PLUser.usPrimeUser and (AnyUnver > 0);
1624        popVerify.enabled        := PLUser.usVerifyTranscribed and
1625                                    PLUser.usPrimeUser and (AnyUnver > 0);
1626        mnuActInactivate.enabled := (AnyAct > 0);
1627        popInactivate.enabled    := (AnyAct > 0);
1628      end
1629    else
1630      begin
1631        mnuActDetails.enabled    := true;
1632        mnuActChange.enabled     := true;
1633        mnuActRestore.enabled    := PLUser.usPrimeUser;
1634        mnuActRemove.enabled     := PLUser.usPrimeUser;
1635        mnuActAnnotate.enabled   := true;
1636        popChange.enabled        := true;
1637        popRestore.enabled       := PLUser.usPrimeUser;
1638        popRemove.enabled        := PLUser.usPrimeUser;
1639        popAnnotate.enabled      := true;
1640        popViewDetails.enabled   := true ;
1641        mnuActVerify.enabled     := PLUser.usVerifyTranscribed and
1642                                    PLUser.usPrimeUser and
1643                                    (Copy(Piece(MString(wgProbData.ItemIndex), U, 2),5,3)='(u)') ;
1644        popVerify.enabled        := PLUser.usVerifyTranscribed and
1645                                    PLUser.usPrimeUser and
1646                                    (Copy(Piece(MString(wgProbData.ItemIndex), U, 2),5,3)='(u)') ;
1647        mnuActInactivate.enabled := Copy(Piece(MString(wgProbData.ItemIndex), U, 2),1,1) = 'A' ;
1648        popInactivate.enabled    := Copy(Piece(MString(wgProbData.ItemIndex), U, 2),1,1) = 'A' ;
1649      end;
1650  
1651    //Disable menu actions for REMOVED problems list display
1652    if PLUser.usViewAct = 'R' then
1653      begin
1654        mnuActAnnotate.Enabled   := False;
1655        mnuActChange.Enabled     := False;
1656        mnuActInactivate.Enabled := False;
1657        mnuActRemove.Enabled     := False;
1658        mnuActVerify.Enabled     := False;
1659        popAnnotate.Enabled      := False;
1660        popChange.Enabled        := False;
1661        popInactivate.Enabled    := False;
1662        popRemove.Enabled        := False;
1663        popVerify.Enabled        := False;
1664      end;
1665  end ;
1666  
1667  procedure TfrmProblems.bbCancelClick(Sender: TObject);
1668  begin
1669    inherited;
1670    //Hide Panels
1671    pnlButtons.Hide;
1672    pnlButtons.SendToBack;
1673    pnlProbCats.Hide;
1674    pnlProbCats.SendToBack;
1675  
1676    //Show pnlView & Add Back to tab Order
1677    ShowPnlView;
1678    //shift focus to another ctrl so the Cancel btn does not get read twice by JAWS,
1679    //once upon tabbing to the btn & 2nd after it is selected/clicked (focus remained on btn)
1680    lstView.SetFocus;
1681  end;
1682  
1683  procedure TfrmProblems.lstViewClick(Sender: TObject);
1684  begin
1685    inherited;
1686    case lstView.ItemIndex of
1687      0:  tag := 700 ;      {Active}
1688      1:  tag := 800 ;      {Inactive}
1689      2:  tag := 900 ;      {Both}
1690      3:  tag := 950 ;      {Removed}
1691  {       4:  tag := 975 ;      {Filters...}
1692    end ;
1693    lstProbActsClick(Self) ;
1694    mnuOptimizeFieldsClick(self);
1695  end;
1696  
1697  function EncounterPresent: Boolean;
1698  { make sure a location and provider are selected, returns false if not }
1699  begin
1700    Result := True;
1701    if (Encounter.Provider = 0) or (Encounter.Location = 0) then
1702    begin
1703      UpdateEncounter(NPF_ALL);  {*KCM*}
1704      frmFrame.DisplayEncounterText;
1705    end;
1706    if (Encounter.Provider = 0) or (Encounter.Location = 0) then
1707    begin
1708      if not frmFrame.CCOWDrivedChange then
1709        InfoBox(TX_PROV_LOC, TC_PROV_LOC, MB_OK or MB_ICONWARNING);  {!!!}
1710      Result := False;
1711    end;
1712  end;
1713  
1714  procedure TfrmProblems.FormDestroy(Sender: TObject);
1715  begin
1716    ClearGrid;
1717    FItemData.Free;
1718    FAllProblems.Free;
1719    FProblemsVisible.Free;
1720    inherited;
1721  end;
1722  
1723  procedure TfrmProblems.mnuViewSaveClick(Sender: TObject);
1724  begin
1725    inherited;
1726    if PLPt = nil then
1727      begin
1728        InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
1729        Exit;
1730      end;
1731    if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
1732      begin
1733        with PLUser do
1734          begin
1735            usDefaultContext := FContextString;
1736            usDefaultView    := Piece(FFilterString, '/', 1);
1737          end;
1738        SaveViewPreferences(FFilterString + U + FContextString);
1739      end;
1740  end;
1741  
1742  procedure TfrmProblems.mnuViewRestoreDefaultClick(Sender: TObject);
1743  begin
1744    inherited;
1745    if PLPt = nil then
1746      begin
1747        InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
1748        Exit;
1749      end;
1750    if PLFilters <> nil then
1751      begin
1752        PLFilters.Destroy;
1753        PLFilters := nil;
1754      end;
1755    if PLUser <> nil then
1756      begin
1757        PLUser.Destroy;
1758        PLUser := nil;
1759      end;
1760    if ScreenReaderActive then
1761       GetScreenReader.Speak('Returning to default view.');
1762    ShowPnlView;
1763    LoadProblems ;
1764  end;
1765  
1766  procedure TfrmProblems.mnuViewCommentsClick(Sender: TObject);
1767  var
1768    x, line, comments: string;
1769    i, j: integer;
1770  begin
1771    inherited;
1772    if PLPt = nil then
1773      begin
1774        InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
1775        Exit;
1776      end;
1777    mnuViewComments.Checked := not mnuViewComments.Checked;
1778    SetPiece(FContextString, ';', 4, BOOLCHAR[mnuViewComments.Checked]);
1779    PLUser.usViewComments := BOOLCHAR[mnuViewComments.Checked];
1780    with FAllProblems do
1781      begin
1782        for i := 0 to Count - 1 do
1783          begin
1784            if Objects[i] = nil then continue;
1785            x := Piece(Piece(Strings[i], U, 3), #13, 1);
1786            if PLUser.usViewComments = '1' then
1787              begin
1788                comments := '';
1789                for j := 0 to TStringList(Objects[i]).Count - 1 do
1790                  comments := comments + '         ' + TStringList(Objects[i]).Strings[j] + #13#10;
1791                  //comments := comments + '   CMT:  ' + TStringList(Items.Objects[i]).Strings[j] + #13#10;
1792                Line := Strings[i];
1793                SetPiece(Line, U, 3, x + #13#10 + comments);
1794                Strings[i] := Line;
1795              end
1796            else
1797            begin
1798              Line := Strings[i];
1799              SetPiece(Line, U, 3, x);
1800              Strings[i] := Line;
1801            end;
1802          end;
1803      end;
1804    RefreshList;
1805  end;
1806  
1807  procedure TfrmProblems.RequestPrint;
1808  begin
1809    inherited;
1810    if PLPt = nil then
1811      begin
1812        InfoBox(TX_INVALID_PATIENT, TC_NO_PATIENT, MB_OK or MB_ICONWARNING);
1813        Exit;
1814      end;
1815    uReportType := '';
1816    PrintReports(IntToStr(RPT_PROBLIST), 'Problem List')
1817  end;
1818  
1819  procedure TfrmProblems.SetFontSize( NewFontSize: integer);
1820  var
1821    OldParent: TWinControl;
1822  begin
1823    OldParent := nil;
1824    if Assigned(dlgProbs) then begin
1825      OldParent := dlgProbs.Parent;
1826      dlgProbs.Parent := nil;
1827    end;
1828    try
1829      {These labels are hidden in an ORAutoPanel, so have to be sized manually}
1830      lblProbCats.Height := ResizeHeight( Font, MainFont, lblProbCats.Height);
1831      lblProblems.Height := ResizeHeight( Font, MainFont, lblProblems.Height);
1832      inherited SetFontSize( NewFontSize);
1833    finally
1834      if Assigned(dlgProbs) then
1835        dlgProbs.Parent := OldParent;
1836    end;
1837    if Assigned(dlgProbs) then
1838      dlgProbs.SetFontSize( MainFontSize);
1839    mnuOptimizeFieldsClick(self);
1840  end;
1841  
1842  procedure TfrmProblems.RefreshList;
1843  var
1844    i: integer;
1845  begin
1846    RedrawSuspend(wgProbData.Handle);
1847    wgProbData.Clear;
1848    FItemData.Clear;
1849    for i := 0 to FAllProblems.Count-1 do
1850      if FProblemsVisible[i] = 'Y' then begin
1851        FItemData.Add(IntToStr(i));
1852        if Piece(FAllProblems[i], U, 1) <> '' then
1853          wgProbData.Items.Add(PlainText(FAllProblems[i]))
1854        else
1855          wgProbData.Items.Add(FAllProblems[i]);
1856      end;
1857    wgProbData.Invalidate;
1858    RedrawActivate(wgProbData.Handle);
1859  end;
1860  
1861  procedure TfrmProblems.wgProbDataMeasureItem(Control: TWinControl;
1862    Index: Integer; var Height: Integer);
1863  var
1864    ARect: TRect;
1865    x: string;
1866    NewHeight: Integer;
1867  begin
1868    inherited;
1869    NewHeight := Height;
1870    with wgProbData do if Index < Items.Count then
1871    begin
1872      ARect := ItemRect(Index);
1873      ARect.Left  := HeaderControl.Sections[0].Width + HeaderControl.Sections[1].Width + 2;
1874      ARect.Right := ARect.Left + HeaderControl.Sections[2].Width - 6;
1875      x := Piece(MString(Index), U, 3);
1876      NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
1877      if NewHeight > 255 then NewHeight := 255;   // windows appears to only look at 8 bits *KCM*
1878      if NewHeight <  13 then NewHeight := 13;    // show at least one line                 *KCM*
1879    end; {if Index}
1880    Height := NewHeight;
1881  end;
1882  
1883  procedure TfrmProblems.wgProbDataDrawItem(Control: TWinControl;
1884    Index: Integer; Rect: TRect; State: TOwnerDrawState);
1885  var
1886    i: integer;
1887  begin
1888    inherited;
1889    with wgProbData do if Index < Items.Count then
1890    begin
1891      ListGridDrawLines(wgProbData, HeaderControl, Index, State);
1892      for i := 0 to HeaderControl.Sections.Count -1 do
1893        ListGridDrawCell(wgProbData, HeaderControl, Index, i, Piece(MString(Index),U,i+1), i = 2);
1894    end; {if Index}
1895  end;
1896  
1897  function TfrmProblems.PlainText(MString: string): string;
1898  var
1899    i: integer;
1900  begin
1901    result := '';
1902    with HeaderControl do
1903      for i := 0 to Sections.Count -1 do
1904        if Sections[i].MaxWidth > 0 then
1905          if Trim(Piece(MString, U, i+1)) <> '' then
1906            result := result + Sections[i].Text + ': ' + Piece(MString, U, i+1) + CRLF;
1907  end;
1908  
1909  function TfrmProblems.MString(index: integer): string;
1910  begin
1911    if index = -1 then
1912      result := ''
1913    else
1914      result := FAllProblems[StrToInt(FItemData[index])];
1915  end;
1916  
1917  procedure TfrmProblems.HeaderControlSectionResize(
1918    HeaderControl: THeaderControl; Section: THeaderSection);
1919  begin
1920    inherited;
1921    wgProbData.Invalidate;
1922    {FEvtColWidth := HeaderControl.Sections[0].Width;     //code from fOrders
1923    RedrawSuspend(Self.Handle);
1924    //RedrawOrderList;
1925    RedrawActivate(Self.Handle);
1926    wgProbData.Invalidate;
1927    pnlRight.Refresh;
1928    pnlLeft.Refresh; }
1929  end;
1930  
1931  {Tab Order tricks.  Need to change
1932    lstView
1933  
1934    bbNewProb
1935    bbOtherProb
1936    bbCancel
1937  
1938    pnlProbDlg
1939    wgProbData
1940  
1941  to
1942    lstView
1943  
1944    pnlProbDlg
1945    wgProbData
1946  
1947    bbNewProb
1948    bbOtherProb
1949    bbCancel
1950  }
1951  
1952  procedure TFrmProblems.lstViewExit(Sender: TObject);
1953  begin
1954    inherited;
1955    if IncSecond(FMousing,1) < Now  then
1956    begin
1957      if (Screen.ActiveControl = bbNewProb) or
1958          (Screen.ActiveControl = bbOtherProb) or
1959          (Screen.ActiveControl = bbCancel) then
1960        FindNextControl( bbCancel, True, True, False).SetFocus;
1961    end;
1962    FMousing := 0;
1963  end;
1964  
1965  procedure TFrmProblems.pnlRightExit(Sender: TObject);
1966  begin
1967    inherited;
1968    if IncSecond(FMousing,1) < Now then
1969    begin
1970      if (Screen.ActiveControl = frmFrame.pnlPatient) then
1971      begin
1972        if lstView.Visible then
1973          FindNextControl( lstView, True, True, False).SetFocus
1974        else
1975          FindNextControl( edProbEnt, True, True, False).SetFocus
1976      end
1977      else
1978      if (Screen.ActiveControl = bbNewProb) or
1979          (Screen.ActiveControl = bbOtherProb) or
1980          (Screen.ActiveControl = bbCancel) then
1981      begin
1982        if bbNewProb.Visible then
1983          FindNextControl( bbNewProb, False, True, False).SetFocus
1984        else
1985          FindNextControl( bbOtherProb, False, True, False).SetFocus;
1986      end;
1987    end;
1988    FMousing := 0;
1989  end;
1990  
1991  procedure TFrmProblems.bbNewProbExit(Sender: TObject);
1992  begin
1993    inherited;
1994    if IncSecond(FMousing,1) < Now then
1995    begin
1996      if (Screen.ActiveControl = pnlProbDlg) or
1997          (Screen.ActiveControl = wgProbData) then
1998        frmFrame.pnlPatient.SetFocus
1999      else
2000      if (Screen.ActiveControl = lstView) or
2001          (Screen.ActiveControl = lstCatPick) then
2002        FindNextControl( frmFrame.pnlPatient, False, True, False).SetFocus;
2003    end;
2004    FMousing := 0;
2005  end;
2006  
2007  procedure TFrmProblems.frmFramePnlPatientExit(Sender: TObject);
2008  begin
2009    FOldFramePnlPatientExit(Sender);
2010    inherited;
2011    if IncSecond(FMousing,1) < Now then
2012    begin
2013      if (Screen.ActiveControl = pnlProbDlg) or
2014          (Screen.ActiveControl = wgProbData) then
2015        FindNextControl( pnlProbDlg, False, True, False).SetFocus;
2016    end;
2017    FMousing := 0;
2018  end;
2019  
2020  procedure TFrmProblems.FormHide(Sender: TObject);
2021  begin
2022    inherited;
2023    frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit;
2024  end;
2025  
2026  procedure TFrmProblems.FormShow(Sender: TObject);
2027  begin
2028    inherited;
2029    FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit;
2030    frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit;
2031    RequestNTRT := False;
2032    NTRTComment := '';
2033    if Changes.RefreshProblemList then
2034    begin
2035      LoadProblems;
2036      Changes.RefreshProblemList := False;
2037    end;
2038  end;
2039  
2040  procedure TfrmProblems.FormMouseMove(Sender: TObject; Shift: TShiftState;
2041    X, Y: Integer);
2042  begin
2043    inherited;
2044    FMousing := Now;
2045  end;
2046  
2047  procedure TfrmProblems.ShowPnlView;
2048  begin
2049    pnlView.BringToFront;
2050    pnlView.Show;
2051    lstView.TabStop := true;
2052    bbNewProb.TabStop := true;
2053  end;
2054  
2055  procedure TfrmProblems.ViewInfo(Sender: TObject);
2056  begin
2057    inherited;
2058    frmFrame.ViewInfo(Sender);
2059  end;
2060  
2061  procedure TfrmProblems.mnuViewInformationClick(Sender: TObject);
2062  begin
2063    inherited;
2064    mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
2065    mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
2066    mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
2067    mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
2068    mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
2069    mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
2070    mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
2071    mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
2072    mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
2073  end;
2074  
2075  procedure TfrmProblems.mnuOptimizeFieldsClick(Sender: TObject);
2076  var
2077    totalSectionsWidth, unitvalue: integer;
2078  begin
2079    totalSectionsWidth := pnlRight.Width - 3;
2080    if totalSectionsWidth < 16 then exit;
2081    unitvalue := round(totalSectionsWidth / 16);
2082    with HeaderControl do
2083    begin
2084      if Sections[1].Width > 0 then Sections[1].Width := unitvalue;
2085      Sections[2].Width := pnlRight.Width - (unitvalue * 11) - 5;
2086      Sections[3].Width := unitvalue * 2;
2087      Sections[4].Width := unitvalue * 2;
2088      if Sections[6].Width > 0 then Sections[6].Width := unitvalue;
2089      if Sections[7].Width > 0 then Sections[7].Width := unitvalue * 2;
2090      if Sections[8].Width > 0 then Sections[8].Width := unitvalue * 2;
2091      if Sections[15].Width > 0 then Sections[15].Width := unitvalue;
2092    end;
2093    HeaderControlSectionResize(HeaderControl, HeaderControl.Sections[0]);
2094    HeaderControl.Repaint;
2095  end;
2096  
2097  procedure TfrmProblems.HeaderControlSectionClick(
2098    HeaderControl: THeaderControl; Section: THeaderSection);
2099  begin
2100    inherited;
2101    //if Section = HeaderControl.Sections[1] then
2102      mnuOptimizeFieldsClick(self);
2103  end;
2104  
2105  procedure TfrmProblems.HeaderControlMouseUp(Sender: TObject;
2106    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2107  var
2108    i: integer;
2109    totalSectionsWidth, originalwidth: integer;
2110  begin
2111    inherited;
2112    totalSectionsWidth := getTotalSectionsWidth;
2113    if totalSectionsWidth > wgProbData.Width - 5 then
2114    begin
2115      originalwidth := 0;
2116      for i := 0 to HeaderControl.Sections.Count - 1 do
2117        originalwidth := originalwidth + origWidths[i];
2118      if originalwidth < totalSectionsWidth then
2119      begin
2120        for i := 0 to HeaderControl.Sections.Count - 1 do
2121          HeaderControl.Sections[i].Width := origWidths[i];
2122        wgProbData.Invalidate;
2123      end;
2124    end;
2125  end;
2126  
2127  function TfrmProblems.getTotalSectionsWidth : integer;
2128  var
2129    i: integer;
2130  begin
2131    Result := 0;
2132    for i := 0 to HeaderControl.Sections.Count - 1 do
2133       Result := Result + HeaderControl.Sections[i].Width;
2134  end;
2135  
2136  procedure TfrmProblems.HeaderControlMouseDown(Sender: TObject;
2137    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2138  begin
2139    inherited;
2140    setSectionWidths;
2141  end;
2142  
2143  procedure TfrmProblems.setSectionWidths;
2144  var
2145    i: integer;
2146  begin
2147    for i := 0 to 15 do
2148       origWidths[i] := HeaderControl.Sections[i].Width;
2149  end;
2150  
2151  procedure TfrmProblems.sptHorzMoved(Sender: TObject);
2152  begin
2153    inherited;
2154    mnuOptimizeFieldsClick(self);
2155  end;
2156  
2157  initialization
2158    SpecifyFormIsNotADialog(TfrmProblems);
2159  
2160  end.

Module Calls (2 levels)


fProbs
 ├fHSplit
 │ └fPage
 ├uProbs
 │ ├uConst
 │ ├rCore
 │ └uCore
 ├uCore...
 ├fProbEdt
 │ ├uCore...
 │ ├uConst
 │ ├fBase508Form
 │ ├uProbs...
 │ ├fProbs...
 │ ├rProbs
 │ ├rCore...
 │ ├rOrders
 │ ├fProbCmt
 │ ├fProbLex
 │ ├rPCE
 │ └uInit
 ├uConst
 ├fBase508Form...
 ├fFrame
 │ ├fPage...
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form...
 │ ├XuDsigS
 │ ├rCore...
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs...
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders...
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore...
 │ ├fAbout
 │ ├fReview
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit...
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOrdersSign
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├fProbflt
 │ ├uProbs...
 │ ├fBase508Form...
 │ ├fProbs...
 │ ├rProbs...
 │ └rCore...
 ├fProbLex...
 ├rProbs...
 ├rCover
 │ ├uConst
 │ ├fFrame...
 │ ├uCore...
 │ ├rMeds
 │ └uReminders...
 ├fRptBox...
 ├rCore...
 ├fProbCmt...
 ├fEncnt...
 ├fReportsPrint
 │ ├rECS...
 │ ├fBase508Form...
 │ ├rCore...
 │ ├uCore...
 │ ├fReports...
 │ ├rReports...
 │ ├uReports
 │ └fFrame...
 ├fReports...
 └rPCE...

Module Called-By (2 levels)


                     fProbs
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
              fProbs...┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
                 fProbEdt┤ 
              fProbs...┘ │ 
                 fProbflt┤ 
              fProbs...┘ │ 
                 fProbLex┘ 
              fProbs...┤   
            fProbEdt...┘