source: cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.pas@ 1094

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

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