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