Module

fBAOptionsDiagnoses

Path

C:\CPRS\CPRS30\BA\fBAOptionsDiagnoses.pas

Last Modified

7/15/2014 3:26:34 PM

Initialization Code

initialization
  uAddToPDL := 0;
  uDeleteFromPDL := 0;

  Problems     := TStringList.Create;
  DxList       := TStringList.Create;
  ECFDiagnoses := TStringList.Create;
  uNewDxList   := TStringList.Create;
  tmplst       := TStringList.Create;
  newDxLst     := TStringList.Create;
  delDxLst     := TStringList.Create;

  Problems.Clear;
  DxList.Clear;
  ECFDiagnoses.Clear;
  uNewDxList.Clear;
  tmplst.Clear;
  newDxLst.Clear;
  delDxLst.Clear;

end.

Units Used in Interface

Name Comments
fAutoSz -
fPCELex -
rCore -
rPCE -
UBAConst -
UBACore -
UBAGlobals -
UBAMessages -
uCore -

Classes

Name Comments
TfrmBAOptionsDiagnoses -

Procedures

Name Owner Declaration Scope Comments
AddProblemsToDxList TfrmBAOptionsDiagnoses procedure AddProblemsToDxList; Private -
btnAddAllClick TfrmBAOptionsDiagnoses procedure btnAddAllClick(Sender: TObject); Public/Published -
btnAddClick TfrmBAOptionsDiagnoses procedure btnAddClick(Sender: TObject); Public/Published -
btnCancelClick TfrmBAOptionsDiagnoses procedure btnCancelClick(Sender: TObject); Public/Published -
btnDeleteClick TfrmBAOptionsDiagnoses procedure btnDeleteClick(Sender: TObject); Public/Published -
btnOKClick TfrmBAOptionsDiagnoses procedure btnOKClick(Sender: TObject); Public/Published -
btnOtherClick TfrmBAOptionsDiagnoses procedure btnOtherClick(Sender: TObject); Public/Published -
btnRemoveAllClick TfrmBAOptionsDiagnoses procedure btnRemoveAllClick(Sender: TObject); Public/Published -
Button1Click TfrmBAOptionsDiagnoses procedure Button1Click(Sender: TObject); Public/Published -
DialogOptionsDiagnoses - procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced -
FormActivate TfrmBAOptionsDiagnoses procedure FormActivate(Sender: TObject); Public/Published -
FormCreate TfrmBAOptionsDiagnoses procedure FormCreate(Sender: TObject); Public/Published -
FormResize TfrmBAOptionsDiagnoses procedure FormResize(Sender: TObject); Public/Published -
FormShow TfrmBAOptionsDiagnoses procedure FormShow(Sender: TObject); Public/Published -
hdrCntlDxSectionClick TfrmBAOptionsDiagnoses procedure hdrCntlDxSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
InactiveICDNotification TfrmBAOptionsDiagnoses procedure InactiveICDNotification; Private -
lbDiagnosisChange TfrmBAOptionsDiagnoses procedure lbDiagnosisChange(Sender: TObject); Public/Published -
lbDiagnosisClick TfrmBAOptionsDiagnoses procedure lbDiagnosisClick(Sender: TObject); Public/Published -
lbDiagnosisEnter TfrmBAOptionsDiagnoses procedure lbDiagnosisEnter(Sender: TObject); Public/Published -
lbPersonalDxClick TfrmBAOptionsDiagnoses procedure lbPersonalDxClick(Sender: TObject); Public/Published -
lbSectionsClick TfrmBAOptionsDiagnoses procedure lbSectionsClick(Sender: TObject); Public/Published -
lbSectionsEnter TfrmBAOptionsDiagnoses procedure lbSectionsEnter(Sender: TObject); Public/Published -
ListDiagnosesCodes TfrmBAOptionsDiagnoses procedure ListDiagnosesCodes(Section: String); Private -
ListDiagnosesSections TfrmBAOptionsDiagnoses procedure ListDiagnosesSections(Dest: TStrings); Private -
LoadEncounterDx TfrmBAOptionsDiagnoses procedure LoadEncounterDx; Private
Private declarations
load the major coding lists that are used by the encounter form for a given location
LoadPersonalDxList TfrmBAOptionsDiagnoses procedure LoadPersonalDxList; Public/Published -
SyncDxDeleteList TfrmBAOptionsDiagnoses procedure SyncDxDeleteList; Private -
SyncDxNewList TfrmBAOptionsDiagnoses procedure SyncDxNewList; Private -

Functions

Name Owner Declaration Scope Comments
IsDXInList TfrmBAOptionsDiagnoses function IsDXInList(ADXCode: string):boolean; Public/Published X,y: string;

Global Variables

Name Type Declaration Comments
BADxCode UnicodeString BADxCode: String; -
delDxLst TStringList delDxLst : TStringList; -
DxList TStringList DxList : TStringList; -
ECFDiagnoses TStringList ECFDiagnoses : TStringList; -
FDxSection UnicodeString FDxSection: string; -
inactiveCodes Integer inactiveCodes : integer; -
LastDFN UnicodeString LastDFN : string; -
LastLocation Integer LastLocation : integer; -
newDxLst TStringList newDxLst : TStringList; -
Problems TStringList Problems : TStringList; -
tmplst TStringList tmplst : TStringList; -
uAddToP Integer uAddToP : integer; -
uDeleteFromPDL Integer uDeleteFromPDL: integer; -
uNewDxList TStringList uNewDxList : TStringList; -


Module Source

1     unit fBAOptionsDiagnoses;
2     
3     interface
4     
5     uses
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, VA508AccessibilityManager;
10    
11    type
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    
73    var
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    
86    procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
87    
88    implementation
89    
90    {$R *.dfm}
91    
92    var
93    
94      LastDFN      : string;
95      LastLocation : integer;
96      FDxSection: string;
97      BADxCode: String;
98    
99    procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
100   var
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   
119   end;
120   
121   procedure TfrmBAOptionsDiagnoses.FormCreate(Sender: TObject);
122   begin
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;
135   end;
136   
137   
138   procedure  TfrmBAOptionsDiagnoses.LoadEncounterDx;
139   { load the major coding lists that are used by the encounter form for a given location }
140   var
141     i: integer;
142     TempList: TStringList;
143     EncDt: TFMDateTime;
144   begin
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;
158   end;
159   
160   procedure  TfrmBAOptionsDiagnoses.ListDiagnosesSections(Dest: TStrings);
161   var
162     i: Integer;
163     x: string;
164   begin
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;
171   end;
172   
173   procedure TfrmBAOptionsDiagnoses.ListDiagnosesCodes(Section: String);
174   var
175   i,j: integer;
176   a: string;
177   begin
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;
202   end;
203   
204   procedure TfrmBAOptionsDiagnoses.AddProblemsToDxList;
205   var
206     i : integer;
207     EncDt: TFMDateTime;
208     x : String;
209   begin
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;
237   end;
238   
239   procedure  TfrmBAOptionsDiagnoses.btnOtherClick(Sender: TObject);
240    var
241     Match: string;
242     SelectedList : TStringList;
243     lexIEN: string;
244   begin
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;
272   end;
273   
274   procedure TfrmBAOptionsDiagnoses.lbSectionsClick(Sender: TObject);
275   var i: integer;
276   begin
277    inherited;
278   for i := 0 to lbSections.Items.Count-1 do
279   begin
280       if(lbSections.Selected[i]) then
281       begin
282          ListDiagnosesCodes(lbSections.Items[i]);
283          FDXSection := lbSections.Items[i];
284          Break;
285       end;
286    end;
287   end;
288   
289   procedure TfrmBAOptionsDiagnoses.lbSectionsEnter(Sender: TObject);
290   begin
291     inherited;
292      lbSections.Selected[0] := true;
293   end;
294   
295   procedure TfrmBAOptionsDiagnoses.lbDiagnosisClick(Sender: TObject);
296   var
297    i : integer;
298     newDxCodes: TStringList;
299     selectedCode: String;
300   begin
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;
318   end;
319   
320   procedure TfrmBAOptionsDiagnoses.btnCancelClick(Sender: TObject);
321   begin
322     inherited;
323           Close;
324   end;
325   
326   procedure TfrmBAOptionsDiagnoses.btnOKClick(Sender: TObject);
327   begin
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;
345   end;
346   
347   procedure TfrmBAOptionsDiagnoses.btnAddClick(Sender: TObject);
348   var
349    i : integer;
350     newDxCode: string;
351   
352   begin
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;
374   end;
375   
376   procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject);
377   var
378      i, c: integer;
379   begin
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;
404   end;
405   
406   procedure TfrmBAOptionsDiagnoses.lbDiagnosisChange(Sender: TObject);
407   begin
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;
418   end;
419   
420   procedure TfrmBAOptionsDiagnoses.lbPersonalDxClick(Sender: TObject);
421   var i : integer;
422   begin
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;
434   end;
435   
436   procedure TfrmBAOptionsDiagnoses.lbDiagnosisEnter(Sender: TObject);
437   begin
438     inherited;
439   if lbDiagnosis.Count > 0 then
440        lbDiagnosis.Selected[0] := true;
441   end;
442   
443   procedure TfrmBAOptionsDiagnoses.FormShow(Sender: TObject);
444   begin
445     inherited;
446      if lbSections.Count > 0 then
447         ListDiagnosesCodes(lbSections.Items[0]);
448      lbSections.SetFocus;
449   end;
450   
451   procedure TfrmBAOptionsDiagnoses.Button1Click(Sender: TObject);
452   begin
453     inherited;
454      newDxLst.Clear;
455      Close;
456   end;
457   
458   procedure TfrmBAOptionsDiagnoses.InactiveICDNotification;
459   begin
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;
470   end;
471   
472   
473   procedure TfrmBAOptionsDiagnoses.FormActivate(Sender: TObject);
474   begin
475     inherited;
476     InactiveICDNotification;
477   end;
478   
479   function  TfrmBAOptionsDiagnoses.IsDXInList(ADXCode: string):boolean;
480   var
481    i: integer;
482    //x,y: string;
483   begin
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;
491   end;
492   
493   
494   procedure TfrmBAOptionsDiagnoses.LoadPersonalDxList;
495   var
496    i: integer;
497    dxList: TStringList;
498    inActiveDx: string;
499   begin
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;
516   end;
517   
518   procedure TfrmBAOptionsDiagnoses.btnRemoveAllClick(Sender: TObject);
519   var
520     i: integer;
521     delDxCode: string;
522   begin
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;
548   end;
549   
550   procedure TfrmBAOptionsDiagnoses.btnAddAllClick(Sender: TObject);
551   var
552    i : integer;
553     newDxCode: string;
554   
555   begin
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   
575   end;
576   
577   procedure TfrmBAOptionsDiagnoses.hdrCntlDxSectionClick(
578     HeaderControl: THeaderControl; Section: THeaderSection);
579   begin
580     inherited;
581     lbPersonalDx.Sorted := false;
582     lbPersonalDx.Sorted := True;
583     lbPersonalDX.Repaint;
584   end;
585   
586   procedure TfrmBAOptionsDiagnoses.FormResize(Sender: TObject);
587   begin
588     inherited;
589     hdrCntlDxSections.Sections[0].Width := lbSections.Width;
590     hdrCntlDxAdd.Sections[0].Width :=  lbDiagnosis.Width;
591     hdrCntlDx.Sections[0].Width := lbPersonalDx.Width;
592   end;
593   
594   procedure TfrmBAOptionsDiagnoses.SyncDxDeleteList;
595   var
596    i: integer;
597    delDxCode: string;
598   begin
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;
608   end;
609   
610   procedure TfrmBAOptionsDiagnoses.SyncDxNewList;
611   var
612   i,j :integer;
613   begin
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;
629   end;
630   
631   
632   initialization
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   
652   end.

Module Calls (2 levels)


fBAOptionsDiagnoses
 ├fAutoSz
 │ └fBase508Form
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├rCore...
 ├UBAGlobals
 │ ├uConst
 │ ├rOrders...
 │ ├fBALocalDiagnoses
 │ ├fOrdersSign
 │ ├fReview
 │ ├uCore...
 │ ├rCore...
 │ ├UBAConst
 │ └UBACore
 ├fPCELex
 │ ├uCore...
 │ ├fBase508Form...
 │ ├mTreeGrid
 │ ├rPCE
 │ ├uProbs
 │ ├rProbs
 │ └UBAGlobals...
 ├rPCE...
 ├UBACore...
 ├UBAMessages
 └UBAConst

Module Called-By (2 levels)


fBAOptionsDiagnoses
         fOptions┘ 
         fFrame┘