source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fDiagnoses.pas@ 1156

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

Initial upload of TMG-CPRS 1.0.26.69

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