source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Encounter/fDiagnoses.pas@ 1742

Last change on this file since 1742 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch

File size: 9.7 KB
Line 
1unit fDiagnoses;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
8 ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, VA508AccessibilityManager;
9
10type
11 TfrmDiagnoses = class(TfrmPCEBaseMain)
12 cmdDiagPrimary: TButton;
13 ckbDiagProb: TCheckBox;
14 procedure cmdDiagPrimaryClick(Sender: TObject);
15 procedure ckbDiagProbClicked(Sender: TObject);
16 procedure FormCreate(Sender: TObject);
17 procedure btnRemoveClick(Sender: TObject);
18 procedure FormResize(Sender: TObject); override;
19 procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
20 procedure btnOKClick(Sender: TObject); override;
21 procedure lbSectionClick(Sender: TObject);
22 procedure GetEncounterDiagnoses;
23 procedure lbSectionDrawItem(Control: TWinControl; Index: Integer;
24 Rect: TRect; State: TOwnerDrawState);
25 private
26 procedure EnsurePrimaryDiag;
27 function isProblem(diagnosis: TPCEDiag): Boolean;
28 function isEncounterDx(problem: string): Boolean;
29 protected
30 procedure UpdateNewItemStr(var x: string); override;
31 procedure UpdateControls; override;
32 public
33 end;
34
35const
36 TX_INACTIVE_CODE = 'The "#" character next to the code for this problem indicates that the problem' + #13#10 +
37 'references an ICD code that is not active as of the date of this encounter.' + #13#10 +
38 'Before you can select this problem, you must update the ICD code it contains' + #13#10 +
39 'via the Problems tab.';
40 TC_INACTIVE_CODE = 'Problem Contains Inactive Code';
41 TX_REDUNDANT_DX = 'The problem that you''ve selected is already included in the list of diagnoses' + #13#10 +
42 'for this encounter. No need to select it again...';
43 TC_REDUNDANT_DX = 'Redundant Diagnosis: ';
44
45var
46 frmDiagnoses: TfrmDiagnoses;
47 dxList : TStringList;
48
49implementation
50
51{$R *.DFM}
52
53uses
54 fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter;
55
56procedure TfrmDiagnoses.EnsurePrimaryDiag;
57var
58 i: Integer;
59 Primary: Boolean;
60
61begin
62 with lbGrid do
63 begin
64 Primary := False;
65 for i := 0 to Items.Count - 1 do
66 if TPCEDiag(Items.Objects[i]).Primary then
67 Primary := True;
68
69 if not Primary and (Items.Count > 0) then
70 begin
71 GridIndex := Items.Count - 1;//0; vhaispbellc CQ 15836
72 TPCEDiag(Items.Objects[Items.Count - 1]).Primary := True;
73 GridChanged;
74 end;
75 end;
76end;
77
78procedure TfrmDiagnoses.cmdDiagPrimaryClick(Sender: TObject);
79var
80 gi, i: Integer;
81 ADiagnosis: TPCEDiag;
82
83begin
84 inherited;
85 gi := GridIndex;
86 with lbGrid do for i := 0 to Items.Count - 1 do
87 begin
88 ADiagnosis := TPCEDiag(Items.Objects[i]);
89 ADiagnosis.Primary := (gi = i);
90 end;
91 GridChanged;
92end;
93
94procedure TfrmDiagnoses.ckbDiagProbClicked(Sender: TObject);
95var
96 i: integer;
97const
98 PL_ITEMS = 'Problem List Items';
99
100begin
101 inherited;
102 if(NotUpdating) then
103 begin
104 for i := 0 to lbGrid.Items.Count-1 do
105 if(lbGrid.Selected[i]) then
106 TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
107 (not isProblem(TPCEDiag(lbGrid.Items.Objects[i]))) and
108 (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
109 GridChanged;
110 end;
111end;
112
113procedure TfrmDiagnoses.FormCreate(Sender: TObject);
114begin
115 inherited;
116 FTabName := CT_DiagNm;
117 FPCEListCodesProc := ListDiagnosisCodes;
118 FPCEItemClass := TPCEDiag;
119 FPCECode := 'POV';
120 FSectionTabCount := 3;
121 FormResize(Self);
122end;
123
124procedure TfrmDiagnoses.btnRemoveClick(Sender: TObject);
125begin
126 inherited;
127 EnsurePrimaryDiag;
128end;
129
130procedure TfrmDiagnoses.UpdateNewItemStr(var x: string);
131begin
132 inherited;
133 if lbGrid.Items.Count = 0 then
134 x := x + U + '1'
135 else
136 x := x + U + '0';
137end;
138
139function TfrmDiagnoses.isProblem(diagnosis: TPCEDiag): Boolean;
140var
141 i: integer;
142 p, code, narr, sct: String;
143begin
144 result := false;
145 for i := 0 to FProblems.Count - 1 do
146 begin
147 p := FProblems[i];
148 code := piece(p, '^', 1);
149 narr := piece(p, '^', 2);
150 if (pos('SCT', narr) > 0) or (pos('SNOMED', narr) > 0) then
151 sct := piece(piece(piece(narr, ')', 1), '(', 2), ' ', 2)
152 else
153 sct := '';
154 narr := TrimRight(piece(narr, '(',1));
155 if pos(diagnosis.Code, code) > 0 then
156 begin
157 result := true;
158 break;
159 end
160 else if (sct <> '') and (pos(sct, diagnosis.Narrative) > 0) then
161 begin
162 result := true;
163 break;
164 end
165 else if pos(narr, diagnosis.Narrative) > 0 then
166 begin
167 result := true;
168 break;
169 end;
170 end;
171end;
172
173function TfrmDiagnoses.isEncounterDx(problem: string): Boolean;
174var
175 i: integer;
176 dx, code, narr, pCode, pNarrative, sct: String;
177
178function getSCT(narr: string): string;
179begin
180 if (pos('SNOMED CT ', narr) > 0) then
181 result := copy(narr, pos('SNOMED CT ', narr) + 10, length(narr))
182 else
183 result := '';
184end;
185
186begin
187 result := false;
188 pCode := piece(problem, U, 1);
189 pNarrative := piece(problem, U, 2);
190 for i := 0 to lbGrid.Items.Count - 1 do
191 begin
192 dx := lbGrid.Items[i];
193 narr := piece(dx, U, 3);
194 code := piece(piece(copy(narr, pos('ICD-9-CM', narr), length(narr)), ' ', 2), ')', 1);
195 sct := getSCT(piece(narr, ':', 1));
196 if pos(pCode, narr) > 0 then
197 begin
198 result := true;
199 break;
200 end
201 else if (sct <> '') and (pos(sct, pNarrative) > 0) then
202 begin
203 result := true;
204 break;
205 end
206 else if pos(narr, pNarrative) > 0 then
207 begin
208 result := true;
209 break;
210 end;
211 end;
212end;
213
214procedure TfrmDiagnoses.UpdateControls;
215var
216 i, j, k, PLItemCount: integer;
217 OK: boolean;
218const
219 PL_ITEMS = 'Problem List Items';
220begin
221 inherited;
222 if(NotUpdating) then
223 begin
224 BeginUpdate;
225 try
226 cmdDiagPrimary.Enabled := (lbGrid.SelCount = 1);
227 OK := (lbGrid.SelCount > 0);
228 PLItemCount := 0;
229 if OK then
230 for k := 0 to lbGrid.Items.Count - 1 do
231 begin
232 if (lbGrid.Selected[k]) then
233 begin
234 if (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) or isProblem(TPCEDiag(lbGrid.Items.Objects[k])) then
235 PLItemCount := PLItemCount + 1;
236 end;
237 end;
238 OK := OK and (PLItemCount < lbGrid.SelCount);
239 ckbDiagProb.Enabled := OK;
240 if(OK) then
241 begin
242 j := 0;
243 for i := 0 to lbGrid.Items.Count-1 do
244 begin
245 if(lbGrid.Selected[i]) and (TPCEDiag(lbGrid.Items.Objects[i]).AddProb) then
246 inc(j);
247 end;
248 if(j = 0) then
249 ckbDiagProb.Checked := FALSE
250 else
251 if(j < lbGrid.SelCount) then
252 ckbDiagProb.State := cbGrayed
253 else
254 ckbDiagProb.Checked := TRUE;
255 end
256 else
257 ckbDiagProb.Checked := FALSE;
258 finally
259 EndUpdate;
260 end;
261 end;
262end;
263
264procedure TfrmDiagnoses.FormResize(Sender: TObject);
265begin
266 inherited;
267 FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (10 * MainFontWidth) - ScrollBarWidth);
268 FSectionTabs[1] := -FSectionTabs[0]+2;
269 FSectionTabs[2] := -FSectionTabs[0]+4;
270 UpdateTabPos;
271end;
272
273procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject;
274 Index: Integer);
275begin
276 if (not FUpdatingGrid) and (lbxSection.Checked[Index]) then
277 begin
278 if (Piece(lbxSection.Items[Index], U, 5) = '#') then
279 begin
280 InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
281 lbxSection.Checked[Index] := False;
282 exit;
283 end
284 else if isEncounterDx(lbxSection.Items[Index]) then
285 begin
286 InfoBox(TX_REDUNDANT_DX, TC_REDUNDANT_DX + piece(lbxSection.Items[Index], '^',2),
287 MB_ICONWARNING or MB_OK);
288 lbxSection.Checked[Index] := False;
289 exit;
290 end;
291 end;
292 inherited;
293 EnsurePrimaryDiag;
294end;
295
296procedure TfrmDiagnoses.btnOKClick(Sender: TObject);
297begin
298 inherited;
299 if BILLING_AWARE then
300 GetEncounterDiagnoses;
301end;
302
303procedure TfrmDiagnoses.lbSectionClick(Sender: TObject);
304begin
305 inherited;
306//
307end;
308
309procedure TfrmDiagnoses.GetEncounterDiagnoses;
310var
311 i: integer;
312 dxCode, dxName: string;
313 ADiagnosis: TPCEItem;
314begin
315 inherited;
316 UBAGlobals.BAPCEDiagList.Clear;
317 with lbGrid do for i := 0 to Items.Count - 1 do
318 begin
319 ADiagnosis := TPCEDiag(Items.Objects[i]);
320 dxCode := ADiagnosis.Code;
321 dxName := ADiagnosis.Narrative;
322 if BAPCEDiagList.Count = 0 then
323 UBAGlobals.BAPCEDiagList.Add(U + DX_ENCOUNTER_LIST_TXT);
324 UBAGlobals.BAPCEDiagList.Add(dxCode + U + dxName);
325 end;
326end;
327
328
329procedure TfrmDiagnoses.lbSectionDrawItem(Control: TWinControl;
330 Index: Integer; Rect: TRect; State: TOwnerDrawState);
331begin
332 inherited;
333 if (control as TListbox).items[index] = DX_PROBLEM_LIST_TXT then
334 (Control as TListBox).Canvas.Font.Style := [fsBold]
335 else
336 if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then
337 (Control as TListBox).Canvas.Font.Style := [fsBold]
338 else
339 if (control as Tlistbox).items[index] = DX_TODAYS_DX_LIST_TXT then
340 (Control as TListBox).Canvas.Font.Style := [fsBold]
341 else
342 if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then
343 (Control as TListBox).Canvas.Font.Style := [fsBold]
344 else
345 (Control as TListBox).Canvas.Font.Style := [];
346
347 (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
348 TListBox).Items[Index]); {display the text }
349end;
350
351initialization
352 SpecifyFormIsNotADialog(TfrmDiagnoses);
353
354end.
Note: See TracBrowser for help on using the repository browser.