source: cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.pas@ 485

Last change on this file since 485 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 7.0 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;
9
10type
11 TfrmDiagnoses = class(TfrmPCEBaseMain)
12 cmdDiagPrimary: TButton;
13 ckbDiagProb: TCheckBox;
14 lblAdd2PL: TLabel;
15 procedure cmdDiagPrimaryClick(Sender: TObject);
16 procedure ckbDiagProbClicked(Sender: TObject);
17 procedure FormCreate(Sender: TObject);
18 procedure btnRemoveClick(Sender: TObject);
19 procedure FormResize(Sender: TObject); override;
20 procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
21 procedure btnOKClick(Sender: TObject); override;
22 procedure lbSectionClick(Sender: TObject);
23 procedure GetEncounterDiagnoses;
24 procedure lbSectionDrawItem(Control: TWinControl; Index: Integer;
25 Rect: TRect; State: TOwnerDrawState);
26 private
27 procedure EnsurePrimaryDiag;
28
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
42var
43 frmDiagnoses: TfrmDiagnoses;
44 dxList : TStringList;
45
46implementation
47
48{$R *.DFM}
49
50uses
51 fEncounterFrame, uConst, UBACore;
52
53procedure TfrmDiagnoses.EnsurePrimaryDiag;
54var
55 i: Integer;
56 Primary: Boolean;
57
58begin
59 with lbGrid do
60 begin
61 Primary := False;
62 for i := 0 to Items.Count - 1 do
63 if TPCEDiag(Items.Objects[i]).Primary then
64 Primary := True;
65
66 if not Primary and (Items.Count > 0) then
67 begin
68 GridIndex := 0;
69 TPCEDiag(Items.Objects[0]).Primary := True;
70 GridChanged;
71 end;
72 end;
73end;
74
75procedure TfrmDiagnoses.cmdDiagPrimaryClick(Sender: TObject);
76var
77 gi, i: Integer;
78 ADiagnosis: TPCEDiag;
79
80begin
81 inherited;
82 gi := GridIndex;
83 with lbGrid do for i := 0 to Items.Count - 1 do
84 begin
85 ADiagnosis := TPCEDiag(Items.Objects[i]);
86 ADiagnosis.Primary := (gi = i);
87 end;
88 GridChanged;
89end;
90
91procedure TfrmDiagnoses.ckbDiagProbClicked(Sender: TObject);
92var
93 i: integer;
94const
95 PL_ITEMS = 'Problem List Items';
96
97begin
98 inherited;
99 if(NotUpdating) then
100 begin
101 for i := 0 to lbGrid.Items.Count-1 do
102 if(lbGrid.Selected[i]) then
103 TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
104 (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
105 GridChanged;
106 end;
107end;
108
109procedure TfrmDiagnoses.FormCreate(Sender: TObject);
110begin
111 inherited;
112 FTabName := CT_DiagNm;
113 FPCEListCodesProc := ListDiagnosisCodes;
114 FPCEItemClass := TPCEDiag;
115 FPCECode := 'POV';
116 FSectionTabCount := 3;
117 FormResize(Self);
118end;
119
120procedure TfrmDiagnoses.btnRemoveClick(Sender: TObject);
121begin
122 inherited;
123 EnsurePrimaryDiag;
124end;
125
126procedure TfrmDiagnoses.UpdateNewItemStr(var x: string);
127begin
128 inherited;
129 if lbGrid.Items.Count = 0 then
130 x := x + U + '1'
131 else
132 x := x + U + '0';
133end;
134
135procedure TfrmDiagnoses.UpdateControls;
136var
137 i, j, k, PLItemCount: integer;
138 OK: boolean;
139const
140 PL_ITEMS = 'Problem List Items';
141begin
142 inherited;
143 if(NotUpdating) then
144 begin
145 BeginUpdate;
146 try
147 cmdDiagPrimary.Enabled := (lbGrid.SelCount = 1);
148 OK := (lbGrid.SelCount > 0);
149 PLItemCount := 0;
150 if OK then
151 for k := 0 to lbGrid.Items.Count - 1 do
152 if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then
153 PLItemCount := PLItemCount + 1;
154 OK := OK and (PLItemCount < lbGrid.SelCount);
155 lblAdd2PL.Enabled := OK;
156 ckbDiagProb.Enabled := OK;
157 if(OK) then
158 begin
159 j := 0;
160 for i := 0 to lbGrid.Items.Count-1 do
161 begin
162 if(lbGrid.Selected[i]) and (TPCEDiag(lbGrid.Items.Objects[i]).AddProb) then
163 inc(j);
164 end;
165 if(j = 0) then
166 ckbDiagProb.Checked := FALSE
167 else
168 if(j < lbGrid.SelCount) then
169 ckbDiagProb.State := cbGrayed
170 else
171 ckbDiagProb.Checked := TRUE;
172 end
173 else
174 ckbDiagProb.Checked := FALSE;
175 finally
176 EndUpdate;
177 end;
178 end;
179end;
180
181procedure TfrmDiagnoses.FormResize(Sender: TObject);
182begin
183 inherited;
184 FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
185 FSectionTabs[1] := -FSectionTabs[0]+2;
186 FSectionTabs[2] := -FSectionTabs[0]+4;
187 UpdateTabPos;
188end;
189
190procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject;
191 Index: Integer);
192begin
193 if not FUpdatingGrid then
194 if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then
195 begin
196 InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
197 lbxSection.Checked[Index] := False;
198 exit;
199 end;
200 inherited;
201 EnsurePrimaryDiag;
202end;
203
204procedure TfrmDiagnoses.btnOKClick(Sender: TObject);
205begin
206 inherited;
207 if BILLING_AWARE then
208 GetEncounterDiagnoses;
209end;
210
211procedure TfrmDiagnoses.lbSectionClick(Sender: TObject);
212begin
213 inherited;
214//
215end;
216
217procedure TfrmDiagnoses.GetEncounterDiagnoses;
218var
219 i: integer;
220 dxCode, dxName: string;
221 ADiagnosis: TPCEItem;
222begin
223 inherited;
224 UBAGlobals.BAPCEDiagList.Clear;
225 with lbGrid do for i := 0 to Items.Count - 1 do
226 begin
227 ADiagnosis := TPCEDiag(Items.Objects[i]);
228 dxCode := ADiagnosis.Code;
229 dxName := ADiagnosis.Narrative;
230 if BAPCEDiagList.Count = 0 then
231 UBAGlobals.BAPCEDiagList.Add(U + DX_ENCOUNTER_LIST_TXT);
232 UBAGlobals.BAPCEDiagList.Add(dxCode + U + dxName);
233 end;
234end;
235
236
237procedure TfrmDiagnoses.lbSectionDrawItem(Control: TWinControl;
238 Index: Integer; Rect: TRect; State: TOwnerDrawState);
239begin
240 inherited;
241 if (control as TListbox).items[index] = DX_PROBLEM_LIST_TXT then
242 (Control as TListBox).Canvas.Font.Style := [fsBold]
243 else
244 if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then
245 (Control as TListBox).Canvas.Font.Style := [fsBold]
246 else
247 if (control as Tlistbox).items[index] = DX_TODAYS_DX_LIST_TXT then
248 (Control as TListBox).Canvas.Font.Style := [fsBold]
249 else
250 if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then
251 (Control as TListBox).Canvas.Font.Style := [fsBold]
252 else
253 (Control as TListBox).Canvas.Font.Style := [];
254
255 (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
256 TListBox).Items[Index]); {display the text }
257end;
258
259end.
Note: See TracBrowser for help on using the repository browser.