VistA-cprs/CPRS-Chart/BA/fBAOptionsDiagnoses.pas

653 lines
18 KiB
Plaintext

unit fBAOptionsDiagnoses;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet,
UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst,
ComCtrls, VA508AccessibilityManager;
type
TfrmBAOptionsDiagnoses = class(TfrmAutoSz)
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Splitter2: TSplitter;
Splitter3: TSplitter;
pnlBottom: TPanel;
btnOther: TButton;
btnOK: TButton;
Panel3: TPanel;
lbSections: TORListBox;
Panel4: TPanel;
lbDiagnosis: TORListBox;
Panel5: TPanel;
lbPersonalDx: TORListBox;
pnlTop: TPanel;
Panel7: TPanel;
btnAdd: TBitBtn;
btnDelete: TBitBtn;
Splitter5: TSplitter;
Button1: TButton;
StaticText3: TStaticText;
hdrCntlDx: THeaderControl;
hdrCntlDxSections: THeaderControl;
hdrCntlDxAdd: THeaderControl;
procedure FormCreate(Sender: TObject);
procedure btnOtherClick(Sender: TObject);
procedure lbSectionsClick(Sender: TObject);
procedure lbSectionsEnter(Sender: TObject);
procedure lbDiagnosisClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure lbDiagnosisChange(Sender: TObject);
procedure lbPersonalDxClick(Sender: TObject);
procedure lbDiagnosisEnter(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
function IsDXInList(ADXCode: string):boolean;
procedure LoadPersonalDxList;
procedure btnRemoveAllClick(Sender: TObject);
procedure btnAddAllClick(Sender: TObject);
procedure hdrCntlDxSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
procedure LoadEncounterDx;
procedure ListDiagnosesSections(Dest: TStrings);
procedure AddProblemsToDxList;
procedure ListDiagnosesCodes(Section: String);
procedure InactiveICDNotification;
procedure SyncDxDeleteList;
procedure SyncDxNewList;
public
{ Public declarations }
end;
var
uAddToP : integer;
uDeleteFromPDL: integer;
uNewDxList : TStringList;
Problems : TStringList;
DxList : TStringList;
ECFDiagnoses : TStringList;
tmplst : TStringList;
newDxLst : TStringList;
delDxLst : TStringList;
inactiveCodes : integer;
procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
implementation
{$R *.dfm}
var
LastDFN : string;
LastLocation : integer;
FDxSection: string;
BADxCode: String;
procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
var
frmBAOptionsDiagnoses: TfrmBAOptionsDiagnoses;
begin
frmBAOptionsDiagnoses := TfrmBAOptionsDiagnoses.Create(Application);
actiontype := 0;
with frmBAOptionsDiagnoses do
begin
if (topvalue < 0) or (leftvalue < 0) then
Position := poScreenCenter
else
begin
Position := poDesigned;
Top := topvalue;
Left := leftvalue;
end;
ResizeAnchoredFormToFont(frmBAOptionsDiagnoses);
ShowModal;
end;
end;
procedure TfrmBAOptionsDiagnoses.FormCreate(Sender: TObject);
begin
inactiveCodes := 0;
LoadEncounterDx;
ListDiagnosesSections(lbSections.Items);
// lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
LoadPersonalDxList;
btnOK.Enabled := False;
hdrCntlDx.Sections[0].Width := lbPersonalDX.Width;
hdrCntlDxSections.Sections[0].Width := lbSections.Width;
hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width;
// lbPersonalDx.Sorted := false;
// lbPersonalDx.Sorted := True;
lbPersonalDX.Repaint;
end;
procedure TfrmBAOptionsDiagnoses.LoadEncounterDx;
{ load the major coding lists that are used by the encounter form for a given location }
var
i: integer;
TempList: TStringList;
EncDt: TFMDateTime;
begin
Caption := 'Personal Diagnoses List for ' + User.Name;
LastLocation := Encounter.Location;
EncDt := Trunc(FMToday);
//add problems to the top of diagnoses.
TempList := TstringList.Create;
DxList.clear;
tCallV(TempList,'ORWPCE DIAG', [LastLocation, EncDt]);
DxList.add(templist.strings[0]);
AddProblemsToDxList;
for i := 1 to (TempList.Count-1) do
begin
DxList.add(Templist.strings[i]);
end;
end;
procedure TfrmBAOptionsDiagnoses.ListDiagnosesSections(Dest: TStrings);
var
i: Integer;
x: string;
begin
for i := 0 to DxList.Count - 1 do if CharAt(DxList[i], 1) = U then
begin
x := Piece(DxList[i], U, 2);
if Length(x) = 0 then x := '<No Section Name>';
Dest.Add(IntToStr(i) + U + Piece(DxList[i], U, 2) + U + x);
end;
end;
procedure TfrmBAOptionsDiagnoses.ListDiagnosesCodes(Section: String);
var
i,j: integer;
a: string;
begin
lbDiagnosis.Clear;
a := '';
for i := 0 to DxList.Count-1 do
begin
a := DxList.Strings[i];
if Piece(DxList[i], U, 2) = (Piece(Section,U,2)) then
break;
end;
inc(i);
for j := i to DxList.Count-1 do
begin
if Piece(DxList[j], U, 0) = '' then
break
else
begin
a := Piece(DxList[j], U, 2) + '^' + Piece(DxList[j], U, 1);
if not UBACore.IsICD9CodeActive(Piece(a,U,2),'ICD',Encounter.DateTime) then
begin
a := a + ' ' + UBAConst.BA_INACTIVE_CODE;
inc(inactiveCodes);
end;
lbDiagnosis.Items.Add(a);
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.AddProblemsToDxList;
var
i : integer;
EncDt: TFMDateTime;
x : String;
begin
//Get problem list
EncDt := Trunc(FMToday);
LastDFN := Patient.DFN;
tCallV(Problems, 'ORWPCE ACTPROB', [Patient.DFN, EncDT]);
if Problems.Count > 0 then
begin
DxList.add('^Problem List Items');
for i := 1 to (Problems.count-1) do
begin
x :=(Piece(Problems.Strings[i],U,3) + U +
Piece(Problems.Strings[i],U,2));
// if (Piece(Problems.Strings[i],U,3) = '799.9') then continue; // DON'T INCLUDE 799.9 CODES
if (Piece(problems.Strings[i], U, 11) = '#') then
DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive
Piece(Problems.Strings[i],U,2) + U + '#')
else if (Piece(problems.Strings[i], U, 10) = '') then // no inactive date for code
DxList.add(Piece(Problems.Strings[i],U,3) + U +
Piece(Problems.Strings[i],U,2))
else if (Trunc(StrToFloat(Piece(Problems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt
DxList.add(Piece(Problems.Strings[i],U,3) + U +
Piece(Problems.Strings[i],U,2))
else
DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive
Piece(Problems.Strings[i],U,2) + U + '#');
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.btnOtherClick(Sender: TObject);
var
Match: string;
SelectedList : TStringList;
lexIEN: string;
begin
inherited;
BAPersonalDX := True;
SelectedList := TStringList.Create;
if Assigned (SelectedList) then SelectedList.Clear;
BADxCode := ''; //init
//Execute LEXICON
LexiconLookup(Match, LX_ICD);
if Match = '' then Exit;
if strLen(PChar(Piece(Match, U, 3)))> 0 then
lexIEN := Piece(Match, U, 3);
BADxCode := Piece(Match,U,2) + ' ' + Piece(Match, U, 1);
if IsDXInList(Piece(Match,U,1) ) then Exit; // eliminate duplicates
if UBACore.IsICD9CodeActive(Piece(Match,U,1),'ICD',Encounter.DateTime) then
begin
lbPersonalDx.Items.Add(BADxCode);
if strLen(PChar(lexIEN)) > 0 then
newDxLst.Add(Piece(Match,U,1) + U + lexIEN)
else
newDxLst.Add(Piece(Match,U,1));
end
else
InfoBox(BA_INACTIVE_ICD9_CODE_1 + BADxCode + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
lexIEN := '';
BAPersonalDX := False;
if newDxLst.Count > 0 then btnOK.Enabled := True;
end;
procedure TfrmBAOptionsDiagnoses.lbSectionsClick(Sender: TObject);
var i: integer;
begin
inherited;
for i := 0 to lbSections.Items.Count-1 do
begin
if(lbSections.Selected[i]) then
begin
ListDiagnosesCodes(lbSections.Items[i]);
FDXSection := lbSections.Items[i];
Break;
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.lbSectionsEnter(Sender: TObject);
begin
inherited;
lbSections.Selected[0] := true;
end;
procedure TfrmBAOptionsDiagnoses.lbDiagnosisClick(Sender: TObject);
var
i : integer;
newDxCodes: TStringList;
selectedCode: String;
begin
inherited;
newDxCodes := TStringList.Create;
newDxCodes.Clear;
for i := 0 to lbDiagnosis.Items.Count-1 do
begin
if(lbDiagnosis.Selected[i]) then
begin
selectedCode := Piece(lbDiagnosis.Items[i],U,2);
newDxCodes.Add(selectedCode);
end;
if newDxCodes.Count > 0 then
begin
rpcAddToPersonalDxList(User.DUZ,NewDxCodes);
NewDxCodes.Clear;
lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ);
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.btnCancelClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmBAOptionsDiagnoses.btnOKClick(Sender: TObject);
begin
inherited;
if delDxLst.Count > 0 then
begin
// delete selected dx's
rpcDeleteFromPersonalDxList(User.DUZ,delDxLst);
delDxLst.Clear;
end;
if newDxLst.Count > 0 then
begin
newDxLst.Sort;
newDxLst.Duplicates := dupIgnore;
// add selected dx's
rpcAddToPersonalDxList(User.DUZ,newDxLst);
newDxLst.Clear;
end;
Close;
end;
procedure TfrmBAOptionsDiagnoses.btnAddClick(Sender: TObject);
var
i : integer;
newDxCode: string;
begin
inherited;
for i := 0 to lbDiagnosis.Items.Count-1 do
begin
if(lbDiagnosis.Selected[i]) then
begin
newDxCode := Piece(lbDiagnosis.Items[i],U,2);
if (not IsDxInList(newDxCode) ) then
begin
if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then
begin
newDxLst.Add(newDxCode);
lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) )
end
else
InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
end;
end;
end;
btnAdd.Enabled := False;
lbDiagnosis.ClearSelection;
if newDxLst.Count > 0 then btnOK.Enabled := True;
end;
procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject);
var
i, c: integer;
begin
inherited;
SyncDxDeleteList;
SyncDxNewList;
// delete selected dx from listbox.
with lbPersonalDX do
begin
i := Items.Count - 1;
c := SelCount;
Items.BeginUpdate;
while (i >= 0) and (c > 0) do
begin
if Selected[i] = true then
begin
Dec(c);
Items.Delete(i);
end;
Dec(i);
end;
Items.EndUpdate;
end;
btnDelete.Enabled := False;
lbDiagnosis.ClearSelection;
if delDxLst.Count > 0 then btnOK.Enabled := True;
end;
procedure TfrmBAOptionsDiagnoses.lbDiagnosisChange(Sender: TObject);
begin
inherited;
if lbDiagnosis.Count = 0 then
btnAdd.Enabled := False
else
begin
if (lbDiagnosis.SelCount > 0) then
btnAdd.Enabled := True
else
btnAdd.Enabled := False;
end;
end;
procedure TfrmBAOptionsDiagnoses.lbPersonalDxClick(Sender: TObject);
var i : integer;
begin
inherited;
for i := 0 to lbPersonalDX.Count-1 do
begin
if(lbPersonalDX.Selected[i]) then
begin
btnDelete.Enabled := True;
break;
end
else
btnDelete.Enabled := False;
end;
end;
procedure TfrmBAOptionsDiagnoses.lbDiagnosisEnter(Sender: TObject);
begin
inherited;
if lbDiagnosis.Count > 0 then
lbDiagnosis.Selected[0] := true;
end;
procedure TfrmBAOptionsDiagnoses.FormShow(Sender: TObject);
begin
inherited;
if lbSections.Count > 0 then
ListDiagnosesCodes(lbSections.Items[0]);
lbSections.SetFocus;
end;
procedure TfrmBAOptionsDiagnoses.Button1Click(Sender: TObject);
begin
inherited;
newDxLst.Clear;
Close;
end;
procedure TfrmBAOptionsDiagnoses.InactiveICDNotification;
begin
if inactiveCodes > 0 then
begin
if (not BAFWarningShown) and (inactiveCodes > 0) then
begin
InfoBox('There are ' + IntToStr(inactiveCodes) + ' active problem(s) flagged with a "#" as having' + #13#10 +
'inactive ICD codes as of today''s date. Please correct these' + #13#10 +
'problems via the Problems Tab - Change" option.', 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK);
BAFWarningShown := True;
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.FormActivate(Sender: TObject);
begin
inherited;
InactiveICDNotification;
end;
function TfrmBAOptionsDiagnoses.IsDXInList(ADXCode: string):boolean;
var
i: integer;
//x,y: string;
begin
Result := False;
for i := 0 to lbPersonalDx.Count-1 do
if ADXCode = Piece(lbPersonalDx.Items[i],U,1) then
begin
Result := True;
Break;
end;
end;
procedure TfrmBAOptionsDiagnoses.LoadPersonalDxList;
var
i: integer;
dxList: TStringList;
inActiveDx: string;
begin
dxList := TStringList.Create;
dxList.Clear;
dxList := rpcGetPersonalDxList(User.DUZ);
if dxList.Count > 0 then
begin
for i := 0 to dxList.Count -1 do
begin
if not UBACore.IsICD9CodeActive(Piece(dxList.Strings[i],U,1),'ICD',Encounter.DateTime ) then
begin
inActiveDx := Piece(dxList.Strings[i],U,1) + ' ' + BA_INACTIVE_CODE + U + Piece(DxList.Strings[i],U,2);
lbPersonalDx.Items.Add(inActiveDx);
end
else
lbPersonalDx.Items.Add(dxList.Strings[i]);
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.btnRemoveAllClick(Sender: TObject);
var
i: integer;
delDxCode: string;
begin
inherited;
// save dx seleted for deletion, update file when ok is pressed
for i := 0 to lbPersonalDX.Count-1 do
begin
delDxCode := Piece(lbPersonalDX.Items[i],U,1);
delDxLst.Add(delDxCode);
end;
// delete selected dx from listbox.
with lbPersonalDX do
begin
i := Items.Count - 1;
Items.BeginUpdate;
while (i >= 0) do
begin
Items.Delete(i);
Dec(i);
end;
Items.EndUpdate;
end;
btnDelete.Enabled := False;
lbDiagnosis.ClearSelection;
if delDxLst.Count > 0 then btnOK.Enabled := True;
end;
procedure TfrmBAOptionsDiagnoses.btnAddAllClick(Sender: TObject);
var
i : integer;
newDxCode: string;
begin
inherited;
for i := 0 to lbDiagnosis.Items.Count-1 do
begin
newDxCode := Piece(lbDiagnosis.Items[i],U,2);
if (not IsDxInList(newDxCode) ) then
begin
if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then
begin
newDxLst.Add(newDxCode);
lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) )
end
else
InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
end;
end;
btnAdd.Enabled := False;
lbDiagnosis.ClearSelection;
if newDxLst.Count > 0 then btnOK.Enabled := True;
end;
procedure TfrmBAOptionsDiagnoses.hdrCntlDxSectionClick(
HeaderControl: THeaderControl; Section: THeaderSection);
begin
inherited;
lbPersonalDx.Sorted := false;
lbPersonalDx.Sorted := True;
lbPersonalDX.Repaint;
end;
procedure TfrmBAOptionsDiagnoses.FormResize(Sender: TObject);
begin
inherited;
hdrCntlDxSections.Sections[0].Width := lbSections.Width;
hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width;
hdrCntlDx.Sections[0].Width := lbPersonalDx.Width;
end;
procedure TfrmBAOptionsDiagnoses.SyncDxDeleteList;
var
i: integer;
delDxCode: string;
begin
// save dx selected for deletion, update file when ok is pressed
for i := 0 to lbPersonalDX.Count-1 do
begin
if(lbPersonalDX.Selected[i]) then
begin
delDxCode := Piece(lbPersonalDX.Items[i],U,1);
delDxLst.Add(delDxCode);
end;
end;
end;
procedure TfrmBAOptionsDiagnoses.SyncDxNewList;
var
i,j :integer;
begin
// remove diagnoses selected for deletion from newdxList;
for i := 0 to lbPersonalDX.Count-1 do
begin
if lbPersonalDX.Selected[i] then
begin
for j := 0 to newDxLst.Count-1 do
begin
if (Piece(lbPersonalDX.Items[i],U,1)) = (newDxLst.Strings[j]) then
begin
newDxLst.Delete(j);
Break;
end;
end;
end;
end;
end;
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.