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

Last change on this file since 1000 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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