unit fDiagnoses; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn, ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, VA508AccessibilityManager; type TfrmDiagnoses = class(TfrmPCEBaseMain) cmdDiagPrimary: TButton; ckbDiagProb: TCheckBox; procedure cmdDiagPrimaryClick(Sender: TObject); procedure ckbDiagProbClicked(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnRemoveClick(Sender: TObject); procedure FormResize(Sender: TObject); override; procedure lbxSectionClickCheck(Sender: TObject; Index: Integer); procedure btnOKClick(Sender: TObject); override; procedure lbSectionClick(Sender: TObject); procedure GetEncounterDiagnoses; procedure lbSectionDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); private procedure EnsurePrimaryDiag; protected procedure UpdateNewItemStr(var x: string); override; procedure UpdateControls; override; public end; const TX_INACTIVE_CODE = 'The "#" character next to the code for this problem indicates that the problem' + #13#10 + 'references an ICD code that is not active as of the date of this encounter.' + #13#10 + 'Before you can select this problem, you must update the ICD code it contains' + #13#10 + 'via the Problems tab.'; TC_INACTIVE_CODE = 'Problem Contains Inactive Code'; var frmDiagnoses: TfrmDiagnoses; dxList : TStringList; implementation {$R *.DFM} uses fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter; procedure TfrmDiagnoses.EnsurePrimaryDiag; var i: Integer; Primary: Boolean; begin with lbGrid do begin Primary := False; for i := 0 to Items.Count - 1 do if TPCEDiag(Items.Objects[i]).Primary then Primary := True; if not Primary and (Items.Count > 0) then begin GridIndex := 0; TPCEDiag(Items.Objects[0]).Primary := True; GridChanged; end; end; end; procedure TfrmDiagnoses.cmdDiagPrimaryClick(Sender: TObject); var gi, i: Integer; ADiagnosis: TPCEDiag; begin inherited; gi := GridIndex; with lbGrid do for i := 0 to Items.Count - 1 do begin ADiagnosis := TPCEDiag(Items.Objects[i]); ADiagnosis.Primary := (gi = i); end; GridChanged; end; procedure TfrmDiagnoses.ckbDiagProbClicked(Sender: TObject); var i: integer; const PL_ITEMS = 'Problem List Items'; begin inherited; if(NotUpdating) then begin for i := 0 to lbGrid.Items.Count-1 do if(lbGrid.Selected[i]) then TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS); GridChanged; end; end; procedure TfrmDiagnoses.FormCreate(Sender: TObject); begin inherited; FTabName := CT_DiagNm; FPCEListCodesProc := ListDiagnosisCodes; FPCEItemClass := TPCEDiag; FPCECode := 'POV'; FSectionTabCount := 3; FormResize(Self); end; procedure TfrmDiagnoses.btnRemoveClick(Sender: TObject); begin inherited; EnsurePrimaryDiag; end; procedure TfrmDiagnoses.UpdateNewItemStr(var x: string); begin inherited; if lbGrid.Items.Count = 0 then x := x + U + '1' else x := x + U + '0'; end; procedure TfrmDiagnoses.UpdateControls; var i, j, k, PLItemCount: integer; OK: boolean; const PL_ITEMS = 'Problem List Items'; begin inherited; if(NotUpdating) then begin BeginUpdate; try cmdDiagPrimary.Enabled := (lbGrid.SelCount = 1); OK := (lbGrid.SelCount > 0); PLItemCount := 0; if OK then for k := 0 to lbGrid.Items.Count - 1 do if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then PLItemCount := PLItemCount + 1; OK := OK and (PLItemCount < lbGrid.SelCount); ckbDiagProb.Enabled := OK; if(OK) then begin j := 0; for i := 0 to lbGrid.Items.Count-1 do begin if(lbGrid.Selected[i]) and (TPCEDiag(lbGrid.Items.Objects[i]).AddProb) then inc(j); end; if(j = 0) then ckbDiagProb.Checked := FALSE else if(j < lbGrid.SelCount) then ckbDiagProb.State := cbGrayed else ckbDiagProb.Checked := TRUE; end else ckbDiagProb.Checked := FALSE; finally EndUpdate; end; end; end; procedure TfrmDiagnoses.FormResize(Sender: TObject); begin inherited; if lbxSection.width = 0 then Exit; FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth); FSectionTabs[1] := -FSectionTabs[0]+2; FSectionTabs[2] := -FSectionTabs[0]+4; UpdateTabPos; end; procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject; Index: Integer); begin if not FUpdatingGrid then if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then begin InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK); lbxSection.Checked[Index] := False; exit; end; inherited; EnsurePrimaryDiag; end; procedure TfrmDiagnoses.btnOKClick(Sender: TObject); begin inherited; if BILLING_AWARE then GetEncounterDiagnoses; end; procedure TfrmDiagnoses.lbSectionClick(Sender: TObject); begin inherited; // end; procedure TfrmDiagnoses.GetEncounterDiagnoses; var i: integer; dxCode, dxName: string; ADiagnosis: TPCEItem; begin inherited; UBAGlobals.BAPCEDiagList.Clear; with lbGrid do for i := 0 to Items.Count - 1 do begin ADiagnosis := TPCEDiag(Items.Objects[i]); dxCode := ADiagnosis.Code; dxName := ADiagnosis.Narrative; if BAPCEDiagList.Count = 0 then UBAGlobals.BAPCEDiagList.Add(U + DX_ENCOUNTER_LIST_TXT); UBAGlobals.BAPCEDiagList.Add(dxCode + U + dxName); end; end; procedure TfrmDiagnoses.lbSectionDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin inherited; if (control as TListbox).items[index] = DX_PROBLEM_LIST_TXT then (Control as TListBox).Canvas.Font.Style := [fsBold] else if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then (Control as TListBox).Canvas.Font.Style := [fsBold] else if (control as Tlistbox).items[index] = DX_TODAYS_DX_LIST_TXT then (Control as TListBox).Canvas.Font.Style := [fsBold] else if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then (Control as TListBox).Canvas.Font.Style := [fsBold] else (Control as TListBox).Canvas.Font.Style := []; (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as TListBox).Items[Index]); {display the text } end; initialization SpecifyFormIsNotADialog(TfrmDiagnoses); end.