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