source: cprs/branches/foia-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas@ 459

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

Adding foia-cprs branch

File size: 17.0 KB
Line 
1unit fBAOptionsDiagnoses;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet,
8 UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst,
9 ComCtrls;
10
11type
12 TfrmBAOptionsDiagnoses = class(TfrmAutoSz)
13 Panel1: TPanel;
14 Panel2: TPanel;
15 Splitter1: TSplitter;
16 Splitter2: TSplitter;
17 Splitter3: TSplitter;
18 pnlBottom: TPanel;
19 btnOther: TButton;
20 btnOK: TButton;
21 Panel3: TPanel;
22 lbSections: TORListBox;
23 Panel4: TPanel;
24 lbDiagnosis: TORListBox;
25 Panel5: TPanel;
26 lbPersonalDx: TORListBox;
27 pnlTop: TPanel;
28 Panel7: TPanel;
29 btnAdd: TBitBtn;
30 btnDelete: TBitBtn;
31 Splitter4: TSplitter;
32 Splitter5: TSplitter;
33 Button1: TButton;
34 StaticText3: TStaticText;
35 hdrCntlDx: THeaderControl;
36 hdrCntlDxSections: THeaderControl;
37 hdrCntlDxAdd: THeaderControl;
38 procedure FormCreate(Sender: TObject);
39 procedure btnOtherClick(Sender: TObject);
40 procedure lbSectionsClick(Sender: TObject);
41 procedure lbSectionsEnter(Sender: TObject);
42 procedure lbDiagnosisClick(Sender: TObject);
43 procedure btnCancelClick(Sender: TObject);
44 procedure btnOKClick(Sender: TObject);
45 procedure btnAddClick(Sender: TObject);
46 procedure btnDeleteClick(Sender: TObject);
47 procedure lbDiagnosisChange(Sender: TObject);
48 procedure lbPersonalDxClick(Sender: TObject);
49 procedure lbDiagnosisEnter(Sender: TObject);
50 procedure FormShow(Sender: TObject);
51 procedure Button1Click(Sender: TObject);
52 procedure FormActivate(Sender: TObject);
53 function IsDXInList(ADXCode: string):boolean;
54 procedure LoadPersonalDxList;
55 procedure btnRemoveAllClick(Sender: TObject);
56 procedure btnAddAllClick(Sender: TObject);
57 procedure hdrCntlDxSectionClick(HeaderControl: THeaderControl;
58 Section: THeaderSection);
59 procedure FormResize(Sender: TObject);
60 private
61 { Private declarations }
62 procedure LoadEncounterDx;
63 procedure ListDiagnosesSections(Dest: TStrings);
64 procedure AddProblemsToDxList;
65 procedure ListDiagnosesCodes(Section: String);
66 procedure InactiveICDNotification;
67
68 public
69 { Public declarations }
70 end;
71
72var
73
74 uAddToP : integer;
75 uDeleteFromPDL: integer;
76 uNewDxList : TStringList;
77 Problems : TStringList;
78 DxList : TStringList;
79 ECFDiagnoses : TStringList;
80 tmplst : TStringList;
81 newDxLst : TStringList;
82 delDxLst : TStringList;
83 inactiveCodes : integer;
84
85procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
86
87implementation
88
89{$R *.dfm}
90
91var
92
93 LastDFN : string;
94 LastLocation : integer;
95 FDxSection: string;
96 BADxCode: String;
97
98procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
99var
100 frmBAOptionsDiagnoses: TfrmBAOptionsDiagnoses;
101 begin
102 frmBAOptionsDiagnoses := TfrmBAOptionsDiagnoses.Create(Application);
103 actiontype := 0;
104 with frmBAOptionsDiagnoses do
105 begin
106 if (topvalue < 0) or (leftvalue < 0) then
107 Position := poScreenCenter
108 else
109 begin
110 Position := poDesigned;
111 Top := topvalue;
112 Left := leftvalue;
113 end;
114 ResizeAnchoredFormToFont(frmBAOptionsDiagnoses);
115 ShowModal;
116 end;
117
118end;
119
120procedure TfrmBAOptionsDiagnoses.FormCreate(Sender: TObject);
121begin
122 inactiveCodes := 0;
123 LoadEncounterDx;
124 ListDiagnosesSections(lbSections.Items);
125 lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
126 btnOK.Enabled := False;
127 hdrCntlDx.Sections[0].Width := lbPersonalDX.Width;
128 hdrCntlDxSections.Sections[0].Width := lbSections.Width;
129 hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width;
130 lbPersonalDx.Sorted := false;
131 lbPersonalDx.Sorted := True;
132 lbPersonalDX.Repaint;
133end;
134
135
136procedure TfrmBAOptionsDiagnoses.LoadEncounterDx;
137{ load the major coding lists that are used by the encounter form for a given location }
138var
139 i: integer;
140 TempList: TStringList;
141 EncDt: TFMDateTime;
142begin
143 Caption := 'Personal Diagnoses List for ' + User.Name;
144 LastLocation := Encounter.Location;
145 EncDt := Trunc(FMToday);
146 //add problems to the top of diagnoses.
147 TempList := TstringList.Create;
148 DxList.clear;
149 tCallV(TempList,'ORWPCE DIAG', [LastLocation, EncDt]);
150 DxList.add(templist.strings[0]);
151 AddProblemsToDxList;
152 for i := 1 to (TempList.Count-1) do
153 begin
154 DxList.add(Templist.strings[i]);
155 end;
156end;
157
158procedure TfrmBAOptionsDiagnoses.ListDiagnosesSections(Dest: TStrings);
159var
160 i: Integer;
161 x: string;
162begin
163 for i := 0 to DxList.Count - 1 do if CharAt(DxList[i], 1) = U then
164 begin
165 x := Piece(DxList[i], U, 2);
166 if Length(x) = 0 then x := '<No Section Name>';
167 Dest.Add(IntToStr(i) + U + Piece(DxList[i], U, 2) + U + x);
168 end;
169end;
170
171procedure TfrmBAOptionsDiagnoses.ListDiagnosesCodes(Section: String);
172var
173i,j: integer;
174a: string;
175begin
176 lbDiagnosis.Clear;
177 a := '';
178 for i := 0 to DxList.Count-1 do
179 begin
180 a := DxList.Strings[i];
181 if Piece(DxList[i], U, 2) = (Piece(Section,U,2)) then
182 break;
183 end;
184 inc(i);
185 for j := i to DxList.Count-1 do
186 begin
187 if Piece(DxList[j], U, 0) = '' then
188 break
189 else
190 begin
191 a := Piece(DxList[j], U, 2) + '^' + Piece(DxList[j], U, 1);
192 if not UBACore.IsICD9CodeActive(Piece(a,U,2),'ICD',Encounter.DateTime) then
193 begin
194 a := a + ' ' + UBAConst.BA_INACTIVE_CODE;
195 inc(inactiveCodes);
196 end;
197 lbDiagnosis.Items.Add(a);
198 end;
199 end;
200end;
201
202procedure TfrmBAOptionsDiagnoses.AddProblemsToDxList;
203var
204 i : integer;
205 EncDt: TFMDateTime;
206 x : String;
207begin
208 //Get problem list
209 EncDt := Trunc(FMToday);
210 LastDFN := Patient.DFN;
211 tCallV(Problems, 'ORWPCE ACTPROB', [Patient.DFN, EncDT]);
212 if Problems.Count > 0 then
213 begin
214 DxList.add('^Problem List Items');
215 for i := 1 to (Problems.count-1) do
216 begin
217 x :=(Piece(Problems.Strings[i],U,3) + U +
218 Piece(Problems.Strings[i],U,2));
219 // if (Piece(Problems.Strings[i],U,3) = '799.9') then continue; // DON'T INCLUDE 799.9 CODES
220
221 if (Piece(problems.Strings[i], U, 11) = '#') then
222 DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive
223 Piece(Problems.Strings[i],U,2) + U + '#')
224 else if (Piece(problems.Strings[i], U, 10) = '') then // no inactive date for code
225 DxList.add(Piece(Problems.Strings[i],U,3) + U +
226 Piece(Problems.Strings[i],U,2))
227 else if (Trunc(StrToFloat(Piece(Problems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt
228 DxList.add(Piece(Problems.Strings[i],U,3) + U +
229 Piece(Problems.Strings[i],U,2))
230 else
231 DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive
232 Piece(Problems.Strings[i],U,2) + U + '#');
233 end;
234 end;
235end;
236
237procedure TfrmBAOptionsDiagnoses.btnOtherClick(Sender: TObject);
238 var
239 Match: string;
240 SelectedList : TStringList;
241 lexIEN: string;
242begin
243 inherited;
244 BAPersonalDX := True;
245 SelectedList := TStringList.Create;
246 if Assigned (SelectedList) then SelectedList.Clear;
247 BADxCode := ''; //init
248 //Execute LEXICON
249 LexiconLookup(Match, LX_ICD);
250 if Match = '' then Exit;
251 if strLen(PChar(Piece(Match, U, 3)))> 0 then
252 lexIEN := Piece(Match, U, 3);
253
254 BADxCode := Piece(Match,U,2) + ' ' + Piece(Match, U, 1);
255 if IsDXInList(Piece(Match,U,1) ) then Exit; // eliminate duplicates
256 if UBACore.IsICD9CodeActive(Piece(Match,U,1),'ICD',Encounter.DateTime) then
257 begin
258 lbPersonalDx.Items.Add(BADxCode);
259 if strLen(PChar(lexIEN)) > 0 then
260 newDxLst.Add(Piece(Match,U,1) + U + lexIEN)
261 else
262 newDxLst.Add(Piece(Match,U,1));
263 end
264 else
265 InfoBox(BA_INACTIVE_ICD9_CODE_1 + BADxCode + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
266
267 lexIEN := '';
268 BAPersonalDX := False;
269 if newDxLst.Count > 0 then btnOK.Enabled := True;
270end;
271
272procedure TfrmBAOptionsDiagnoses.lbSectionsClick(Sender: TObject);
273var i: integer;
274begin
275 inherited;
276for i := 0 to lbSections.Items.Count-1 do
277begin
278 if(lbSections.Selected[i]) then
279 begin
280 ListDiagnosesCodes(lbSections.Items[i]);
281 FDXSection := lbSections.Items[i];
282 Break;
283 end;
284 end;
285end;
286
287procedure TfrmBAOptionsDiagnoses.lbSectionsEnter(Sender: TObject);
288begin
289 inherited;
290 lbSections.Selected[0] := true;
291end;
292
293procedure TfrmBAOptionsDiagnoses.lbDiagnosisClick(Sender: TObject);
294var
295 i : integer;
296 newDxCodes: TStringList;
297 selectedCode: String;
298begin
299 inherited;
300 newDxCodes := TStringList.Create;
301 newDxCodes.Clear;
302 for i := 0 to lbDiagnosis.Items.Count-1 do
303 begin
304 if(lbDiagnosis.Selected[i]) then
305 begin
306 selectedCode := Piece(lbDiagnosis.Items[i],U,2);
307 newDxCodes.Add(selectedCode);
308 end;
309 if newDxCodes.Count > 0 then
310 begin
311 rpcAddToPersonalDxList(User.DUZ,NewDxCodes);
312 NewDxCodes.Clear;
313 lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
314 end;
315 end;
316end;
317
318procedure TfrmBAOptionsDiagnoses.btnCancelClick(Sender: TObject);
319begin
320 inherited;
321 Close;
322end;
323
324procedure TfrmBAOptionsDiagnoses.btnOKClick(Sender: TObject);
325begin
326 inherited;
327 if delDxLst.Count > 0 then
328 begin
329 // delete selected dx's
330 rpcDeleteFromPersonalDxList(User.DUZ,delDxLst);
331 delDxLst.Clear;
332 end;
333
334 if newDxLst.Count > 0 then
335 begin
336 newDxLst.Sort;
337 newDxLst.Duplicates := dupIgnore;
338 // add selected dx's
339 rpcAddToPersonalDxList(User.DUZ,newDxLst);
340 newDxLst.Clear;
341 end;
342 Close;
343end;
344
345procedure TfrmBAOptionsDiagnoses.btnAddClick(Sender: TObject);
346var
347 i : integer;
348 newDxCode: string;
349
350begin
351 inherited;
352 for i := 0 to lbDiagnosis.Items.Count-1 do
353 begin
354 if(lbDiagnosis.Selected[i]) then
355 begin
356 newDxCode := Piece(lbDiagnosis.Items[i],U,2);
357 if (not IsDxInList(newDxCode) ) then
358 begin
359 if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then
360 begin
361 newDxLst.Add(newDxCode);
362 lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) )
363 end
364 else
365 InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
366 end;
367 end;
368 end;
369 btnAdd.Enabled := False;
370 lbDiagnosis.ClearSelection;
371 if newDxLst.Count > 0 then btnOK.Enabled := True;
372end;
373
374procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject);
375var
376 delDxCode: string;
377 i, c: integer;
378begin
379 inherited;
380 // save dx seleted for deletion, update file when ok is pressed
381 for i := 0 to lbPersonalDX.Count-1 do
382 begin
383 if(lbPersonalDX.Selected[i]) then
384 begin
385 delDxCode := Piece(lbPersonalDX.Items[i],U,1);
386 delDxLst.Add(delDxCode);
387 end;
388 end;
389
390 // delete selected dx from listbox.
391 with lbPersonalDX do
392 begin
393 i := Items.Count - 1;
394 c := SelCount;
395 Items.BeginUpdate;
396 while (i >= 0) and (c > 0) do
397 begin
398 if Selected[i] = true then
399 begin
400 Dec(c);
401 Items.Delete(i);
402 end;
403 Dec(i);
404 end;
405 Items.EndUpdate;
406 end;
407
408 btnDelete.Enabled := False;
409 lbDiagnosis.ClearSelection;
410 if delDxLst.Count > 0 then btnOK.Enabled := True;
411end;
412
413procedure TfrmBAOptionsDiagnoses.lbDiagnosisChange(Sender: TObject);
414begin
415 inherited;
416 if lbDiagnosis.Count = 0 then
417 btnAdd.Enabled := False
418 else
419 begin
420 if (lbDiagnosis.SelCount > 0) then
421 btnAdd.Enabled := True
422 else
423 btnAdd.Enabled := False;
424 end;
425end;
426
427procedure TfrmBAOptionsDiagnoses.lbPersonalDxClick(Sender: TObject);
428var i : integer;
429begin
430 inherited;
431 for i := 0 to lbPersonalDX.Count-1 do
432 begin
433 if(lbPersonalDX.Selected[i]) then
434 begin
435 btnDelete.Enabled := True;
436 break;
437 end
438 else
439 btnDelete.Enabled := False;
440 end;
441end;
442
443procedure TfrmBAOptionsDiagnoses.lbDiagnosisEnter(Sender: TObject);
444begin
445 inherited;
446if lbDiagnosis.Count > 0 then
447 lbDiagnosis.Selected[0] := true;
448end;
449
450procedure TfrmBAOptionsDiagnoses.FormShow(Sender: TObject);
451begin
452 inherited;
453 if lbSections.Count > 0 then
454 ListDiagnosesCodes(lbSections.Items[0]);
455 lbSections.SetFocus;
456end;
457
458procedure TfrmBAOptionsDiagnoses.Button1Click(Sender: TObject);
459begin
460 inherited;
461 newDxLst.Clear;
462 Close;
463end;
464
465procedure TfrmBAOptionsDiagnoses.InactiveICDNotification;
466begin
467 if inactiveCodes > 0 then
468 begin
469 if (not BAFWarningShown) and (inactiveCodes > 0) then
470 begin
471 InfoBox('There are ' + IntToStr(inactiveCodes) + ' active problem(s) flagged with a "#" as having' + #13#10 +
472 'inactive ICD codes as of today''s date. Please correct these' + #13#10 +
473 'problems via the Problems Tab - Change" option.', 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK);
474 BAFWarningShown := True;
475 end;
476 end;
477end;
478
479
480procedure TfrmBAOptionsDiagnoses.FormActivate(Sender: TObject);
481begin
482 inherited;
483 InactiveICDNotification;
484end;
485
486function TfrmBAOptionsDiagnoses.IsDXInList(ADXCode: string):boolean;
487var
488 i: integer;
489 //x,y: string;
490begin
491 Result := False;
492 for i := 0 to lbPersonalDx.Count-1 do
493 if ADXCode = Piece(lbPersonalDx.Items[i],U,1) then
494 begin
495 Result := True;
496 Break;
497 end;
498end;
499
500
501procedure TfrmBAOptionsDiagnoses.LoadPersonalDxList;
502var
503 i: integer;
504 dxList: TStringList;
505 inActiveDx: string;
506begin
507 dxList := TStringList.Create;
508 dxList.Clear;
509 dxList := rpcGetPersonalDxList(User.DUZ);
510 if dxList.Count > 0 then
511 begin
512 for i := 0 to dxList.Count -1 do
513 begin
514 if not UBACore.IsICD9CodeActive(Piece(dxList.Strings[i],U,1),'ICD',Encounter.DateTime ) then
515 begin
516 inActiveDx := Piece(dxList.Strings[i],U,1) + ' ' + BA_INACTIVE_CODE + U + Piece(DxList.Strings[i],U,2);
517 lbPersonalDx.Items.Add(inActiveDx);
518 end
519 else
520 lbPersonalDx.Items.Add(dxList.Strings[i]);
521 end;
522 end;
523end;
524
525procedure TfrmBAOptionsDiagnoses.btnRemoveAllClick(Sender: TObject);
526var
527 i: integer;
528 delDxCode: string;
529begin
530 inherited;
531 // save dx seleted for deletion, update file when ok is pressed
532 for i := 0 to lbPersonalDX.Count-1 do
533 begin
534 delDxCode := Piece(lbPersonalDX.Items[i],U,1);
535 delDxLst.Add(delDxCode);
536 end;
537
538
539 // delete selected dx from listbox.
540 with lbPersonalDX do
541 begin
542 i := Items.Count - 1;
543 Items.BeginUpdate;
544 while (i >= 0) do
545 begin
546 Items.Delete(i);
547 Dec(i);
548 end;
549 Items.EndUpdate;
550 end;
551
552 btnDelete.Enabled := False;
553 lbDiagnosis.ClearSelection;
554 if delDxLst.Count > 0 then btnOK.Enabled := True;
555end;
556
557procedure TfrmBAOptionsDiagnoses.btnAddAllClick(Sender: TObject);
558var
559 i : integer;
560 newDxCode: string;
561
562begin
563 inherited;
564 for i := 0 to lbDiagnosis.Items.Count-1 do
565 begin
566 newDxCode := Piece(lbDiagnosis.Items[i],U,2);
567 if (not IsDxInList(newDxCode) ) then
568 begin
569 if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then
570 begin
571 newDxLst.Add(newDxCode);
572 lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) )
573 end
574 else
575 InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
576 end;
577 end;
578 btnAdd.Enabled := False;
579 lbDiagnosis.ClearSelection;
580 if newDxLst.Count > 0 then btnOK.Enabled := True;
581
582end;
583
584procedure TfrmBAOptionsDiagnoses.hdrCntlDxSectionClick(
585 HeaderControl: THeaderControl; Section: THeaderSection);
586begin
587 inherited;
588 lbPersonalDx.Sorted := false;
589 lbPersonalDx.Sorted := True;
590 lbPersonalDX.Repaint;
591end;
592
593procedure TfrmBAOptionsDiagnoses.FormResize(Sender: TObject);
594begin
595 inherited;
596 hdrCntlDxSections.Sections[0].Width := lbSections.Width;
597 hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width;
598 hdrCntlDx.Sections[0].Width := lbPersonalDx.Width;
599end;
600
601initialization
602 uAddToPDL := 0;
603 uDeleteFromPDL := 0;
604
605 Problems := TStringList.Create;
606 DxList := TStringList.Create;
607 ECFDiagnoses := TStringList.Create;
608 uNewDxList := TStringList.Create;
609 tmplst := TStringList.Create;
610 newDxLst := TStringList.Create;
611 delDxLst := TStringList.Create;
612
613 Problems.Clear;
614 DxList.Clear;
615 ECFDiagnoses.Clear;
616 uNewDxList.Clear;
617 tmplst.Clear;
618 newDxLst.Clear;
619 delDxLst.Clear;
620
621end.
Note: See TracBrowser for help on using the repository browser.