iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-cprs/CPRS-Chart/fReview.pas

2255 lines
81 KiB
Plaintext
Raw Blame History

unit fReview;
{.$define debug}
interface
uses
UBAGlobals,
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, checklst, uConst, ExtCtrls, uCore, mCoPayDesc, XUDIGSIGSC_TLB,
ORCtrls, Menus, UBACore, ORClasses,fBase508Form, fPrintLocation,
VA508AccessibilityManager;
type
TfrmReview = class(TfrmBase508Form)
cmdOK: TButton;
cmdCancel: TButton;
lstReview: TCaptionCheckListBox;
pnlOrderAction: TPanel;
radSignChart: TRadioButton;
pnlSignature: TPanel;
txtESCode: TCaptionEdit;
lblESCode: TLabel;
Label1: TStaticText;
radHoldSign: TRadioButton;
grpRelease: TGroupBox;
radVerbal: TRadioButton;
radPhone: TRadioButton;
radPolicy: TRadioButton;
radRelease: TRadioButton;
fraCoPay: TfraCoPayDesc;
laDiagnosis: TLabel;
gbxDxLookup: TGroupBox;
buDiagnosis: TButton;
poBACopyPaste: TPopupMenu;
Copy1: TMenuItem;
Paste1: TMenuItem;
Diagnosis1: TMenuItem;
Exit1: TMenuItem;
lblSig: TStaticText;
procedure FormCreate(Sender: TObject);
procedure lstReviewDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure cmdOKClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure lstReviewClickCheck(Sender: TObject);
procedure radReleaseClick(Sender: TObject);
procedure txtESCodeChange(Sender: TObject);
procedure lstReviewMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer);
procedure FormDestroy(Sender: TObject);
procedure lstReviewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure buDiagnosisClick(Sender: TObject);
procedure lstReviewClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure lstReviewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Copy1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure ClearDiagnoses1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure fraCoPayLabel24MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure lstReviewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
FOKPressed: Boolean;
FShowPanel: Integer;
FSilent: Boolean;
FCouldSign: Boolean;
FLastHintItem: integer;
FOldHintPause: integer;
FOldHintHidePause: integer;
FShrunk: boolean;
FIsEvtChange: boolean;
procedure AddHeader(s: string);
function AddItem(ChangeItem: TChangeItem): integer;
procedure BuildList(FullList: boolean);
procedure BuildFullList;
procedure BuildSignList;
procedure CleanupChangesList(Sender: TObject; ChangeItem: TChangeItem); {**RV**}
function ItemsAreChecked: Boolean;
function SignRequiredForAny(FullList: boolean): Boolean;
procedure AdjustSignatureTop( HeightAdjustment: integer);
function IsSignatureRequired:boolean;
function GetNumberOfSelectedOrders : byte;
procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
procedure SetItemTextToState;
procedure FormatListForScreenReader;
public
procedure SetCheckBoxStatus(thisOrderID: string);
function GetCheckBoxStatus(sourceOrderID : string) : string; overload;
function GetCheckBoxStatus(gridItemIndex : smallint) : string; overload;
function GetNonNilItemCount : integer; //CQ5172
end;
function ReviewChanges(TimedOut: Boolean; IsEvtChange: boolean = False): Boolean;
var
{Begin BillingAware}
frmReview: TfrmReview; //Originally declared locally in function ReviewChanges()
DxRect: TRect;
{End BillingAware}
{Begin BillingAware}
TFactorMemo: TCaptionMemo;
chkBoxStatus: string;
srcOrderID: string;
targetOrderID: string;
tempStrList: TStringList;
srcDx: string;
tempOrderList: TStringList;
copyOrderID: string;
srcIndex: integer;
CopyBuffer: TBADxRecord;
FRVTFHintWindowActive: boolean;
FRVTFHintWindow: THintWindow;
{End BillingAware}
crypto: IXuDigSigS;
currentlySelectedItem: integer; //CQ5063
currentItems: TStringList; //CQ5063
implementation
{$R *.DFM}
uses ORFn, rCore, fNotes, fConsults, fOrders, rOrders, Hash, fDCSumm, fOCSession, uOrders,
fSignItem, fOrdersPrint, fLkUpLocation, fFrame, uSignItems, fSurgery,
fBALocalDiagnoses, UBAConst, UBAMessages, fOrdersSign, fClinicWardMeds,
rODLab, fRptBox, VAUtils;
const
SP_NONE = 0;
SP_CLERK = 1;
SP_NURSE = 2;
SP_SIGN = 3;
TXT_ENCNT = 'Outpatient Encounter';
TXT_NOVISIT = 'Visit Type: < None Selected >';
TXT_NODIAG = 'Diagnosis: < None Selected >';
TXT_NOPROC = 'Procedures: none';
TXT_DOCS = 'Documents';
TXT_ORDERS = 'Orders';
TXT_BLANK = ' ';
TX_INVAL_MSG = 'Not a valid electronic signature code. Enter a valid code or press Cancel.';
TX_INVAL_CAP = 'Unrecognized Signature Code';
TX_ES_REQ = 'Enter your electronic signature to release these orders.';
TC_ES_REQ = 'Electronic Signature';
TX_NO_REL = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ';
TC_NO_REL = 'Unable to Release Orders';
TC_NO_DX = 'Incomplete Diagnosis Entry';
TX_NO_DX = 'A Diagnosis must be selected prior to signing any of the following order types:'
+ CRLF + 'Outpatient Lab,Radiology, Outpatient Medications, Prosthetics.';
procedure TfrmReview.SetCheckBoxStatus(thisOrderID: string);
{
- Set the current CI checkboxes status
}
begin
if BILLING_AWARE then
begin
uSignItems.uSigItems.SetSigItems(lstReview, thisOrderID);
end;
end;
function TfrmReview.GetCheckBoxStatus(gridItemIndex: smallint) : string;
{
- Obtain checkbox status for selected order - BY ORDER ID
}
var
itemsList: TStringList;
i: smallint;
begin
Result := '';
itemsList := TStringList.Create;
itemsList.Clear;
itemsList := uSigItems.GetSigItems; //Get FItems list
if BILLING_AWARE then
begin
for i := 0 to itemsList.Count-1 do
begin
//thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
if i = gridItemIndex then //compare to order ID of source order
begin
Result := Piece(itemsList[i],U,4); //return TF status'
Break;
end;
end;
end;
end;
function TfrmReview.GetCheckBoxStatus(sourceOrderID: string) : string; //PASS IN ORDER ID - NOT GRID INDEX
{
- Obtain checkbox status for selected order - BY ORDER ID
}
var
itemsList: TStringList;
i: smallint;
thisOrderID: string;
begin
Result := '';
itemsList := TStringList.Create;
itemsList.Clear;
itemsList := uSigItems.GetSigItems; //Get FItems list
if BILLING_AWARE then
begin
for i := 0 to itemsList.Count-1 do
begin
thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
if thisOrderID = sourceOrderID then //compare to order ID of source order
begin
Result := Piece(itemsList[i],U,4); //return TF status'
Break;
end;
end;
end;
end;
function TfrmReview.GetNumberOfSelectedOrders : byte;
{
- Return the number of orders in clstOrders that are currently selected.
}
var
i: integer;
numSelected: byte;
begin
result := 0;
if BILLING_AWARE then
begin
numSelected := 0;
for i := 1 to frmReview.lstReview.Items.Count-1 do
if (frmReview.lstReview.Selected[i]) then
Inc(numSelected);
Result := numSelected;
end;
end;
function ReviewChanges(TimedOut: Boolean; IsEvtChange: boolean = False): Boolean;
{ display changes made to chart for this encounter, allow changes to be saved, signed, etc. }
var
i: integer;
begin
Result := True;
if Changes.Count = 0 then Exit;
frmReview := TfrmReview.Create(Application);
try
Changes.OnRemove := frmReview.CleanupChangesList; {**RV**}
frmReview.FIsEvtChange := IsEvtChange;
ResizeAnchoredFormToFont(frmReview);
if TimedOut and (Changes.Count > 0) then
begin
frmReview.FSilent := True;
frmReview.BuildFullList;
with frmReview.lstReview do for i := 0 to Items.Count - 1 do
Checked[i] := False;
frmReview.cmdOKClick(frmReview);
Result := True;
end
// if user not timed out, execute as before
else
begin
if ((uCore.User.OrderRole = OR_NURSE) or (uCore.User.OrderRole = OR_CLERK)) and Changes.CanSign then
begin
frmReview.FCouldSign := True;
frmReview.BuildSignList; // ok will remove from changes, exit leaves altogether
frmReview.ShowModal;
Result := frmReview.FOKPressed;
end;
if Result and (Changes.Count > 0) then
begin
frmReview.FCouldSign := Changes.CanSign;
frmReview.BuildFullList;
if BILLING_AWARE then
// build list of orders that are not billable based on package type
UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList);
frmReview.ShowModal;
Result := frmReview.FOKPressed;
end;
end;
finally
Changes.OnRemove := nil; {**RV**}
frmReview.Release;
end;
end;
procedure TfrmReview.FormCreate(Sender: TObject);
const
TX_FORM_CAPTION = 'Review / Sign Changes ';
begin
FOKPressed := False;
FSilent := False;
FLastHintItem := -1;
Self.Caption := TX_FORM_CAPTION + '(' + Patient.Name + ' - ' + Patient.SSN + ')';
FOldHintPause := Application.HintPause;
Application.HintPause := 250;
FOldHintHidePause := Application.HintHidePause;
Application.HintHidePause := 30000;
{Begin BillingAware}
if BILLING_AWARE then
begin
lstReview.Height := 220;
lstReview.Top := (gbxdxLookup.top + 65);
gbxDxLookup.Visible := TRUE;
lblsig.Top := (gbxdxLookup.Top + 48);
laDiagnosis.Top := Lblsig.Top;
laDiagnosis.Left := 270;
laDiagnosis.Visible := TRUE;
rectIndex := 0;
end;
{End BillingAware}
end;
procedure TfrmReview.AddHeader(s: string);
{ add header to review list, object is left nil }
begin
lstReview.Items.AddObject(s, nil);
end;
function TfrmReview.AddItem(ChangeItem: TChangeItem): integer;
{ add a single review item to the list with its associated TChangeItem object }
begin
Result := lstReview.Items.AddObject(ChangeItem.Text, ChangeItem);
//Begin BillingAware
if BILLING_AWARE then
begin
UBAGlobals.ChangeItemOrderNum := ChangeItem.ID; // GE 2/21/2006 removed "Copy(ChangeItem.ID,0,8)" issue when sites have order number > 8 digits
// HDS00005025
if ChangeItem.ItemType = CH_DOC then // documents are not orderable, code is necessary
UBAGlobals.ChangeItemOrderNum := '0'; // document id can be same as order id, orderid = 0 will be nonbillable
tempOrderList.Add(UBAGlobals.ChangeItemOrderNum);
end;
//end BillingAware
case ChangeItem.SignState of
CH_SIGN_YES: lstReview.Checked[Result] := True;
CH_SIGN_NO: lstReview.Checked[Result] := False;
CH_SIGN_NA: lstReview.State[Result] := cbGrayed;
end;
//hds00006047
// this will override the signstate from above for all non-va med orders... no signature required.
if ChangeItem.GroupName = '' then
begin
//if StrPos(PChar(ChangeItem.Text),PChar(NonVAMedTxt)) <> nil then
if ChangeItem.OrderDG = NONVAMEDGROUP then
lstReview.State[Result] := cbGrayed;
end;
//hds00006047
end;
procedure TfrmReview.AdjustSignatureTop( HeightAdjustment: integer);
//This has been added to support correct anchoring for the lstReview list.
begin
Height := Height + HeightAdjustment;
lblSig.Top := lblSig.Top + HeightAdjustment;
lstReview.Top := lstReview.Top + HeightAdjustment;
lstReview.Height := lstReview.Height - HeightAdjustment;
//for 24 pt font, we need to make sure that lstreview is resized before the main form is.
end;
function TfrmReview.IsSignatureRequired:boolean;
var
i: integer;
begin
Result := FALSE;
with lstReview.items do for i := 0 to Pred(Count) do
begin
if frmReview.lstReview.Checked[i] then
begin
//CQ4790
if TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]) = nil then
Continue;
//end CQ4790
if (TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).SIGNSTATE) <> CH_SIGN_NA then
Result := TRUE;
end;
end;
end;
procedure TfrmReview.BuildList(FullList: boolean);
var
GrpIndex, ChgIndex, lbIdx: Integer;
ChangeItem: TChangeItem;
LabelHeight: integer;
PrevGrpName, temp: string;
displayHeader, displaySpacer, otherUserOrders: boolean;
begin
tempOrderList := TStringList.Create;
tempOrderList.Clear;
PrevGrpName := '';
lstReview.Clear; // ok to clear without freeing objects since they're part of Changes
if(FullList) then
begin
SigItems.ResetOrders;
with Changes do
if PCE.Count > 0 then
begin
for GrpIndex := 0 to PCEGrp.Count - 1 do
begin
AddHeader('Outpatient Encounter ' + PCEGrp[GrpIndex]);
for ChgIndex := 0 to PCE.Count - 1 do
begin
ChangeItem := PCE[ChgIndex];
if ChangeItem.GroupName = PCEGrp[GrpIndex] then AddItem(ChangeItem);
end;
AddHeader(' ');
end;
end; {if PCE}
end;
with Changes do
if Documents.Count > 0 then
begin
AddHeader('Documents');
for ChgIndex := 0 to Documents.Count - 1 do
begin
ChangeItem := Documents[ChgIndex];
if(FullList or (ChangeItem.SignState <> CH_SIGN_NA)) then
AddItem(ChangeItem);
end;
if(FullList) then
AddHeader(' ');
end; {if Documents}
if(FullList) then
begin
//otherUserOrders := False;
displaySpacer := False;
with Changes do
if Orders.Count > 0 then
begin
OrderGrp.Sorted := True;
otherUserOrders := False;
for GrpIndex := 0 to OrderGrp.Count - 1 do
begin
displayHeader := True;
if (GrpIndex > 0 ) and (AnsiCompareText(PrevGrpName,OrderGrp[GrpIndex])=0) then
Continue;
if OrderGrp[GrpIndex] = '' then Temp := 'My Unsigned Orders - This Session'
else if OrderGrp[GrpIndex] = 'Other Unsigned' then Temp := 'My Unsigned Orders - Previous Sessions'
else Temp := 'Orders - ' + OrderGrp[GrpIndex];
//AddHeader('Orders - ' + Temp);
{billing aware}
if BILLING_AWARE then
begin
UBACore.rpcBuildSCIEList(Orders); // build list of orders and Billable Status
UBACore.CompleteUnsignedBillingInfo(rpcGetUnsignedOrdersBillingData(OrderListSCEI) );
end;
{billing aware}
for ChgIndex := 0 to Orders.Count - 1 do
begin
ChangeItem := Orders[ChgIndex];
if (ChangeItem.GroupName = OrderGrp[GrpIndex]) and ((ChangeItem.User = 0) or (ChangeItem.User = User.DUZ)) then
begin
if displayHeader = True then
begin
AddHeader(Temp);
displayHeader := False;
displaySpacer := True;
end;
lbIdx := AddItem(ChangeItem);
SigItems.Add(CH_ORD, ChangeItem.ID, lbIdx);
end
else if ((ChangeItem.User > 0) and (ChangeItem.User <> User.DUZ)) then
otherUserOrders := True;
end;
if displayHeader = False then AddHeader(' ');
PrevGrpName := OrderGrp[GrpIndex];
end;
//AGP fix for CQ 10073
if otherUserOrders = True then
begin
if displaySpacer = True then AddHeader(' ');
AddHeader('Others'' Unsigned Orders Orders - All Sessions');
for ChgIndex := 0 to Orders.Count - 1 do
begin
ChangeItem := Orders[ChgIndex];
if (ChangeItem.GroupName = 'Other Unsigned') and ((ChangeItem.User >0) and (ChangeItem.User <> User.DUZ)) then
begin
lbIdx := AddItem(ChangeItem);
SigItems.Add(CH_ORD, ChangeItem.ID, lbIdx);
end;
end;
end;
end; {if Orders}
// determine the appropriate panel to display
case User.OrderRole of
OR_CLERK: FShowPanel := SP_CLERK;
OR_NURSE: FShowPanel := SP_NURSE;
OR_PHYSICIAN: FShowPanel := SP_SIGN;
OR_STUDENT: if Changes.CanSign then FShowPanel := SP_SIGN else FShowPanel := SP_NONE;
else FShowPanel := SP_NONE;
end; {case User}
end
else
FShowPanel := SP_SIGN;
case FShowPanel of
SP_CLERK: begin
pnlSignature.Visible := False;
//pnlOrderAction.Visible := True;
pnlOrderAction.Visible := SignRequiredForAny(FullList);
end;
SP_NURSE: begin
pnlSignature.Visible := False;
radRelease.Visible := True;
grpRelease.Visible := True;
pnlOrderAction.Visible := SignRequiredForAny(FullList);
end;
SP_SIGN: begin
pnlOrderAction.Visible := False;
pnlSignature.Visible := ItemsAreChecked;
end;
else begin // SP_NONE
pnlOrderAction.Visible := False;
pnlSignature.Visible := False;
end;
end; {case FShowPanel}
pnlSignature.Visible := ItemsAreChecked;
txtESCodeChange(Self);
if pnlOrderAction.Visible then
begin
lblSig.Caption := 'Documents / Orders';
if FShowPanel = SP_NURSE then
begin
if GetUserParam('OR SIGNATURE DEFAULT ACTION') = 'OC'
then radHoldSign.Checked := True
else radRelease.Checked := True;
end;
if (radHoldSign.Checked) and (GetUserParam('OR SIGNED ON CHART') = '1')
then radSignChart.Checked := True;
if radRelease.Checked then radReleaseClick(Self);
end {if pnlOrderAction}
else
begin
if (User.OrderRole = OR_STUDENT) or (User.OrderRole = OR_NOKEY) or (User.OrderRole = OR_BADKEYS) then
lblSig.Caption := 'These orders will be held until signed'
else
lblSig.Caption := 'Signature will be Applied to Checked Items';
end;
//Make sure there is enough width for the buttons and lblSig
//begin BillingAware
if BILLING_AWARE then
begin
LabelHeight := lstReview.Top - fraCoPay.Height;
AdjustSignatureTop( ResizeHeight( BaseFont, MainFont, LabelHeight) - LabelHeight);
end;
//end BillingAware
if (FullList and SigItems.UpdateListBox(lstReview)) then
begin
fraCoPay.Visible := TRUE;
//begin BillingAware
if BILLING_AWARE then frmReview.gbxDxLookup.Visible := TRUE;
//end BillingAware
if(FShrunk) then
begin
FShrunk := FALSE;
AdjustSignatureTop( fraCoPay.Height + 9);
end;
end
else
begin
fraCoPay.Visible := FALSE;
//begin BillingAware
if BILLING_AWARE then frmReview.gbxDxLookup.Visible := FALSE;
//end BillingAware
if(not FShrunk) then
begin
FShrunk := TRUE;
AdjustSignatureTop(-fraCoPay.Height - 9);
end;
end;
end; {BuildFullList}
procedure TfrmReview.BuildFullList;
begin
BuildList(TRUE);
end;
procedure TfrmReview.BuildSignList;
begin
BuildList(FALSE);
end;
function TfrmReview.ItemsAreChecked: Boolean;
{ return true if any items in the Review List are checked for applying signature }
var
i: Integer;
begin
Result := False;
with lstReview do for i := 0 to Items.Count - 1 do if Checked[i] then
begin
Result := True;
break;
end;
end;
function TfrmReview.SignRequiredForAny(FullList: boolean): Boolean;
var
i: Integer;
tmpOrders: TStringList;
ChangeItem: TChangeItem;
begin
Result := True;
if Changes.Documents.Count > 0 then Exit;
if(FullList) then
begin
// if Changes.PCE.Count > 0 then Exit; *** JM - you don't sign encounter informaiton ***
tmpOrders := TStringList.Create;
try
for i := 0 to Pred(Changes.Orders.Count) do
begin
ChangeItem := Changes.Orders[i];
tmpOrders.Add(ChangeItem.ID);
end;
Result := AnyOrdersRequireSignature(tmpOrders);
finally
FreeAndNil(tmpOrders);
end;
end
else
Result := FALSE;
end;
procedure TfrmReview.lstReviewClickCheck(Sender: TObject);
{ prevent grayed checkboxes from being changed to anything else }
var
ChangeItem: TChangeItem;
procedure updateAllChilds(CheckedStatus: boolean; ParentOrderId: string);
var
idx: integer;
AChangeItem: TChangeItem;
begin
for idx := 0 to lstReview.Items.Count - 1 do
begin
AChangeItem := TChangeItem(lstReview.Items.Objects[idx]);
if Assigned(AChangeItem) and (AChangeItem.ParentID = ParentOrderId) then
if lstReview.Checked[idx] <> CheckedStatus then
begin
lstReview.Checked[idx] := CheckedStatus;
SigItems.EnableSettings(idx, lstReview.checked[Idx]);
end;
end;
end;
begin
with lstReview do
begin
ChangeItem := TChangeItem(Items.Objects[ItemIndex]);
if ItemIndex > 0 then
begin
if (ChangeItem <> nil) then
begin
if (ChangeItem.SignState = CH_SIGN_NA) then State[ItemIndex] := cbGrayed
else
begin
SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
if Length(ChangeItem.ParentID) > 0 then
updateAllChilds(checked[ItemIndex], ChangeItem.ParentID);
end;
end;
end;
pnlSignature.Visible := IsSignatureRequired;
end;
end;
procedure TfrmReview.lstReviewDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
{ outdent the header items (thus hiding the checkbox) }
var
x: string;
ARect, TextRecord: TRect;
i, dy: integer;
tempID: string;
thisRec: UBAGlobals.TBADxRecord;
{Begin BillingAware}
str: string;
{End BillingAware}
procedure UpdateTextRecord(r: TRect);
begin
TextRecord := r;
inc(TextRecord.Top, dy);
dec(TextRecord.Bottom, dy);
end;
begin
inherited;
dy := SIG_ITEM_VERTICAL_PAD div 2;
x := '';
ARect := Rect;
if BILLING_AWARE then
begin
ARect.Right := ARect.Right - 50;
with lstReview do
begin
if Items.Objects[Index] = nil then
ARect.Left := 0;
Canvas.Pen.Color := Get508CompliantColor(clSilver);
//Canvas.Brush.Color := Get508CompliantColor(clLime);
Canvas.FillRect(ARect);
if Index < Items.Count then
begin
x := Trim(FilteredString(Items[Index]));
if (ARect.Left = 0) and ( Length(x)>0 ) then
Canvas.TextOut(ARect.Left + 2, ARect.Top + dy, x)
else
if (ARect.Left > 0 ) and ( Length(x)>0 ) then
begin
//ARect.Right below controls the right-hand side of the Dx Column
//Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
//two rectangles overlap each other.
if BILLING_AWARE then
begin
arRect[Index] := Classes.Rect(ARect.Right+2, ARect.Top, ARect.Right + 108, ARect.Bottom);
Canvas.FillRect(arRect[Index]);
end;
//Draw ORDER TEXT
UpdateTextRecord(ARect);
DrawText(Canvas.handle, PChar(x), Length(x), TextRecord, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
if BILLING_AWARE then
begin
//Dx Column lines
Canvas.Pen.Color := Get508CompliantColor(clSilver);
Canvas.MoveTo(DxRect.Left-1, ARect.Top);
Canvas.LineTo(DxRect.Left-1, ARect.Bottom);
//Adjust position of 'Diagnosis' column label for font size
laDiagnosis.Left := DxRect.Left + 14;
if uSignItems.GetAllBtnLeftPos > 0 then
laDiagnosis.left := uSignItems.GetAllBtnLeftPos - (laDiagnosis.Width +5);
laDiagnosis.Top := lblSig.Top;
//Assign DxRect for drawing Dx column and Dx string
DxRect.Left := ARect.Right + 1;
DxRect.Top := ARect.Top;
DxRect.Right := DxRect.Left + 80;
DxRect.Bottom := ARect.Bottom;
//Display all saved Dx's
for i := 0 to lstReview.Items.Count-1 do
//for i := 1 to uSignItems.uSigItems.GetSigItems.Count - 1 do
with TOrder(lstReview.Items[i]) do
begin
// HDS00005025
if TChangeItem(lstReview.Items.Objects[Index]).ITEMTYPE = CH_DOC then
tempID := '0' // if document id is equal to valid order id identify billable orders
else
tempID := TChangeItem(lstReview.Items.Objects[Index]).ID;
// HDS00005025
//WORKS FOR MULTIPLE Dx
if Assigned(UBAGlobals.tempDxList) then
if UBAGlobals.tempDxNodeExists(tempID) then
begin
thisRec := TBADxRecord.Create;
UBAGlobals.GetBADxListForOrder(thisRec, tempID);
str := Piece(thisRec.FBADxCode, '^', 1); // Display Dx text only - not the ICD-9 code
str := Piece(str, ':', 1); //in case has : vs. ^
UpdateTextRecord(arRect[Index]);
DrawText(Canvas.handle, PChar(str), Length(str), TextRecord, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
if (Not UBACore.IsOrderBillable(tempID)) then// and
// (Not UBAGlobals.tempDxNodeExists(tempID) ) then // if consult is non cidc but requires dx, show it.
begin
Canvas.Font.Color := Get508CompliantColor(clBlue);
UpdateTextRecord(arRect[Index]);
DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , TextRecord, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
end;
end
else
begin
//Determine if order is billable. If NOT billable then insert NA in Dx field
if Not UBACore.IsOrderBillable(tempID) then
begin
Canvas.Font.Color := Get508CompliantColor(clBlue);
UpdateTextRecord(arRect[Index]);
DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , TextRecord, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
end;
end;
end;
end;
end; //if
end; //if
end; //with
end
else
begin
with lstReview do
begin
if Items.Objects[Index] = nil then
ARect.Left := 0;
Canvas.FillRect(ARect);
if Index < Items.Count then
begin
x := Trim(FilteredString(Items[Index]));
if (ARect.Left = 0) and ( Length(x) > 0 ) then
Canvas.TextOut(ARect.Left + 2, ARect.Top + dy, x)
else
if (ARect.Left > 0 ) and ( Length(x)>0 ) then
begin
Canvas.Pen.Color := Get508CompliantColor(clSilver);
Canvas.MoveTo(0, ARect.Bottom-1);
Canvas.LineTo(ARect.Right, ARect.Bottom-1);
UpdateTextRecord(ARect);
DrawText(Canvas.handle, PChar(x), Length(x), TextRecord, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
end;
end;
end;
end;
end;
procedure TfrmReview.radReleaseClick(Sender: TObject);
begin
if not grpRelease.Visible then Exit;
if radRelease.Checked then
begin
radVerbal.Enabled := True;
radPhone.Enabled := True;
radPolicy.Enabled := True;
if Encounter.Provider = User.DUZ
then radPolicy.Checked := True
else radVerbal.Checked := True;
end else
begin
radVerbal.Enabled := False;
radPhone.Enabled := False;
radPolicy.Enabled := False;
radVerbal.Checked := False;
radPhone.Checked := False;
radPolicy.Checked := False;
end;
end;
procedure TfrmReview.txtESCodeChange(Sender: TObject);
begin
if(not pnlSignature.Visible) then
cmdOK.Caption := 'OK'
else
begin
if Length(txtESCode.Text) > 0 then cmdOK.Caption := 'Sign' else
begin
if FCouldSign then cmdOK.Caption := 'Don''t Sign' else cmdOK.Caption := 'OK';
end;
end;
end;
procedure TfrmReview.cmdOKClick(Sender: TObject);
{ validate the electronic signature & call SaveSignItem for the encounter }
const
TX_NOSIGN = 'Save items without signing?';
TC_NOSIGN = 'No Signature Entered';
TX_SAVERR1 = 'The error, ';
TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
TC_SAVERR = 'Error Saving Order';
var
i, idx, AType, PrintLoc, theSts, wardIEN: Integer;
SigSts, RelSts, Nature: Char;
ESCode, AnID, AnErrMsg: string;
ChangeItem, TempChangeItem: TChangeItem;
OrderList, OrderPrintList: TStringList;
SaveCoPay: boolean;
DigSigErr, DigStoreErr, CryptoChecked, displayEncSwitch: Boolean;
SigData, SigUser, SigDrugSch, SigDEA: string;
cSignature, cHashData, cCrlUrl, cErr, WardName, ASvc: string;
cProvDUZ: Int64;
AList, ClinicList, DCList, WardList: TStringList;
IsOk, ContainsIMOOrders, DoNotPrint : Boolean;
EncLocName, EncLocText: string;
EncLocIEN: integer;
EncDT: TFMDateTime;
EncVC: Char;
function OrdersSignedOrReleased: Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to Pred(OrderList.Count) do
begin
if Pos('R', Piece(OrderList[i], U, 2)) > 0 then Result := True;
if Pos('S', Piece(OrderList[i], U, 2)) > 0 then Result := True;
if Result then Break;
end;
end;
function OrdersToBeSignedOrReleased: Boolean;
var
i: Integer;
s,x: string;
begin
Result := FALSE;
for i := 0 to Pred(OrderList.Count) do
begin
s := Piece(OrderList[i], U, 2);
x := s[1];
if ((s <> '') and (s[1] in [SS_ONCHART, SS_ESIGNED, SS_NOTREQD])) or
(Piece(OrderList[i], U, 3) = RS_RELEASE) then
begin
Result := TRUE;
Break;
end;
end;
end;
begin
IsOk := True;
ESCode := '';
SaveCoPay := FALSE;
PrintLoc := 0;
EncLocIEN := 0;
DoNotPrint := False;
if BILLING_AWARE then
begin
if Assigned(UBAGlobals.UnsignedOrders) then
UBAGlobals.UnsignedOrders.Clear;
end;
if pnlSignature.Visible then
begin
ESCode := txtESCode.Text;
if ItemsAreChecked and (Length(ESCode) > 0) and (not ValidESCode(ESCode)) then
begin
InfoBox(TX_INVAL_MSG, TX_INVAL_CAP, MB_OK);
txtESCode.SetFocus;
txtESCode.SelectAll;
Exit;
end;
if Length(ESCode) > 0 then ESCode := Encrypt(ESCode);
end; {if pnlSignature}
if not frmFrame.Closing then
begin
{ save/sign orders }
OrderList := TStringList.Create;
OrderPrintList := TStringList.create;
ClinicList := TStringList.Create;
WardList := TStringList.Create;
DigSigErr := True;
CryptoChecked := False;
ContainsIMOOrders := False;
try
Nature := NO_PROVIDER;
case User.OrderRole of
OR_NOKEY, OR_CLERK, OR_NURSE, OR_STUDENT:
begin
SigSts := SS_UNSIGNED; // default to med student values
RelSts := RS_HOLD;
Nature := NO_WRITTEN;
if User.OrderRole in [OR_CLERK, OR_NURSE] then
begin
if radSignChart.Checked then SigSts := SS_ONCHART else SigSts := SS_UNSIGNED;
if radRelease.Checked or radSignChart.Checked
then RelSts := RS_RELEASE
else RelSts := RS_HOLD;
if radSignChart.Checked or radHoldSign.Checked then Nature := NO_WRITTEN
else if radVerbal.Checked then Nature := NO_VERBAL
else if radPhone.Checked then Nature := NO_PHONE
else if radPolicy.Checked then Nature := NO_POLICY
else Nature := NO_WRITTEN;
if not pnlOrderAction.Visible then // if no orders require a signature
begin
RelSts := RS_RELEASE;
Nature := NO_PROVIDER;
SigSts := SS_NOTREQD;
end;
// the following was added due to patch OR*3.0*86
if RelSts = RS_RELEASE then
begin
StatusText('Validating Release...');
AnErrMsg := '';
for i := 0 to lstReview.Items.Count - 1 do
begin
ChangeItem := TChangeItem(lstReview.Items.Objects[i]);
if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) then
begin
ValidateOrderActionNature(ChangeItem.ID, OA_RELEASE, Nature, AnErrMsg);
if Length(AnErrMsg) > 0 then
begin
if IsInvalidActionWarning(ChangeItem.Text, ChangeItem.ID) then Break;
InfoBox(ChangeItem.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
Break;
end; {if Length(AnErrMsg)}
end; {if ChangeItem=CH_ORD}
end; {for}
StatusText('');
if Length(AnErrMsg) > 0 then Exit;
end; {if RelSts}
// the following supports the change to allow nurses to sign policy orders
if FSilent then RelSts := RS_HOLD;
if (RelSts = RS_RELEASE) and pnlOrderAction.Visible then
begin
SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
if ESCode = '' then Exit;
if Nature = NO_POLICY then SigSts := SS_ESIGNED;
end;
end; {if..ORCLERK, OR_NURSE}
with lstReview do for i := 0 to Items.Count - 1 do
begin
ChangeItem := TChangeItem(Items.Objects[i]);
if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) and (not radSignChart.Checked) then
begin
OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
if BILLING_AWARE then
if not (User.DUZ = 0) and PersonHasKey(User.DUZ, 'PROVIDER') then
UBACore.SaveUnsignedOrders(ChangeItem.ID+ '1' + GetCheckBoxStatus(ChangeItem.ID) )
end
else if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) and (radSignChart.Checked) then
OrderList.Add(ChangeItem.ID + U + SS_ONCHART + U + RS_RELEASE + U + NO_WRITTEN);
end; {with lstReview}
end; {OR_NOKEY, OR_CLERK, OR_NURSE, OR_STUDENT}
OR_PHYSICIAN:
begin
Nature := NO_PROVIDER;
with lstReview do for i := 0 to Items.Count - 1 do
begin
DigStoreErr := false;
ChangeItem := TChangeItem(Items.Objects[i]);
if (ChangeItem <> nil) and (ChangeItem.ItemType = CH_ORD) then
begin
case State[i] of
cbChecked: if Length(ESCode) > 0 then
begin
SigSts := SS_ESIGNED;
RelSts := RS_RELEASE;
if (OrderRequiresDigitalSignature(ChangeItem.ID)) and (CryptoChecked = false)
and GetPKISite and GetPKIUse then
begin
Cryptochecked := true;
try //PKI object creation
crypto := CoXuDigSigS.Create;
crypto.GetCSP;
StatusText(crypto.Reason);
DigSigErr := False;
except
on E: Exception do
begin
DigSigErr := True;
end;
end;
end;
if (DigSigErr = false) and (OrderRequiresDigitalSignature(ChangeItem.ID))
and (SigItems.OK2SaveSettings) then
begin
StatusText('Retrieving DIGITAL SIGNATURE');
SigDrugSch := GetDrugSchedule(ChangeItem.ID);
SigData := SetExternalText(ChangeItem.ID,SigDrugSch,User.DUZ);
if Length(SigData) < 1 then
begin
ShowMsg(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
DigStoreErr := true;
end;
SigUser := piece(SigData,'^',18);
SigDEA := piece(SigData,'^',20);
cProvDUZ := User.DUZ;
if DigStoreErr = false then
try
crypto.Reset;
crypto.DEAsig := true;
crypto.UsrName := SigUser;
crypto.DrugSch := SigDrugSch;
crypto.UsrNumber := SigDEA;
crypto.DataBuffer := SigData;
if crypto.Signdata = true then
begin
cSignature := crypto.Signature;
cHashData := crypto.HashValue;
cCrlUrl := crypto.CrlUrl;
end
else
begin
ShowMsg(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
DigStoreErr := true;
end;
except
on E: Exception do
begin
ShowMsg(ChangeItem.Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
DigStoreErr := true;
end;
end; //except
if DigStoreErr = true then //PKI
//NoOp
else
begin
cErr := '';
StoreDigitalSig(ChangeItem.ID, cHashData, cProvDUZ, cSignature, cCrlUrl, cErr);
if cErr = '' then
OrderList.Add(ChangeItem.ID + U + SS_DIGSIG + U + RS_RELEASE + U + Nature);
end;
end
else
begin
if GetPKISite and (OrderRequiresDigitalSignature(ChangeItem.ID)) then
begin
ShowMsg('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + ChangeItem.Text + CRLF + CRLF +
'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
CRLF + 'Please discontinue/cancel this order and create a hand written order for manual processing, or digitally sign the order at a PKI-enabled workstation.');
end
else
OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
end;
end else
begin
if BILLING_AWARE then
UBACore.SaveUnsignedOrders(ChangeItem.ID+ '1' + GetCheckBoxStatus(ChangeItem.ID) );
SigSts := SS_UNSIGNED;
RelSts := RS_HOLD;
end;
cbGrayed: if OrderRequiresSignature(ChangeItem.ID) then
begin
SigSts := SS_UNSIGNED;
RelSts := RS_HOLD;
end else
begin
SigSts := SS_NOTREQD;
RelSts := RS_RELEASE;
end;
else begin // (cbUnchecked)
SigSts := SS_UNSIGNED;
RelSts := RS_HOLD;
end;
end; {case State}
if (ChangeItem.GroupName = 'Other Unsigned') and (SigSts = SS_UNSIGNED) and (RelSts = RS_HOLD)
then //NoOp - don't add unsigned orders from outside session to the list
else
begin
if not(State[i] = cbChecked) and (OrderList.IndexOf(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature) < 0) then
OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature)
else if (cmdOK.Caption = 'Don''t Sign') and (OrderList.IndexOf(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature) < 0) then
OrderList.Add(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature);
end;
end; {if ItemType}
end; {with lstReview}
end; {OR_PHYSICIAN}
end; {case User.OrderRole}
if BILLING_AWARE then
if UBAGLobals.UnsignedOrders.Count > 0 then
UBACore.BuildSaveUnsignedList(uBAGLobals.UnsignedOrders);
// if true BA data in not mandatory.
if not IsUserNurseProvider(User.DUZ) then
begin
if OrdersToBeSignedOrReleased then
begin
if (not SigItems.OK2SaveSettings) then
begin
if (cmdOk.Caption = 'Don''t Sign') then
SaveCoPay := TRUE
else
begin
InfoBox(TX_Order_Error, 'Review/Sign Orders', MB_OK);
Exit;
end
end
else
SaveCoPay := TRUE;
end
else
SaveCoPay := TRUE;
{Begin BillingAware}
if BILLING_AWARE then
begin
if (cmdOk.Caption = 'Sign') then
begin
if Not UBACore.BADxEntered then
begin
InfoBox(TX_NO_DX, TC_NO_DX, MB_OK);
Exit;
end;
end;
{End BillingAware}
end;
end;
{release & print orders}
// test for LockedForOrdering is to make sure patient is locked if pulling in all unsigned
if (User.OrderRole in [OR_NOKEY..OR_STUDENT]) and (OrderList.Count > 0) and LockedForOrdering then
begin
IsOk := ExecuteSessionOrderChecks(OrderList); // any cancelled orders will be removed from OrderList
StatusText('Sending Orders to Service(s)...');
if OrderList.Count > 0 then
begin
//hds7591 Clinic/Ward movement. Nurse orders
if (cmdOk.Caption = 'Sign') or (cmdOK.Caption = 'OK') and (not frmFrame.TimedOut) then
begin
if ((Patient.Inpatient = false) and (frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN))) or
((Patient.Inpatient = True) and (Encounter.Location <> Patient.Location)) or
((Patient.Inpatient = True) and (Encounter.Location = Patient.Location) and
(encounter.Location <> uCore.TempEncounterLoc) and (uCore.TempEncounterLoc <> 0)) then
//or ((frmFrame.DoNotChangeEncWindow = true) and (encounter.Location = uCore.TempOutEncounterLoc)) then
begin
if Encounter.Location <> Patient.Location then
begin
EncLocName := Encounter.LocationName;
EncLocIEN := Encounter.Location;
EncLocText := Encounter.LocationText;
EncDT := Encounter.DateTime;
EncVC := Encounter.VisitCategory;
end
else
begin
EncLocName := UCore.TempEncounterLocName;
EncLocIEN := UCore.TempEncounterLoc;
EncLocText := uCore.TempEncounterText;
EncDT := uCore.TempEncounterDateTime;
EncVC := uCore.TempEncounterVistCat;
end;
if frmFrame.mnuFile.Tag = 0 then displayEncSwitch := false
else displayEncSwitch := true;
(*displayEncSwitch := False;
if (frmFrame.mnuFile.Items[frmFrame.mnuFile.menuIndex].Caption = 'Refresh Patient &Information') or
(frmFrame.mnuFile.Items[frmFrame.mnuFile.menuIndex].Caption = '&Review/Sign Changes...') then
displayEncSwitch := True; *)
DCList := TStringList.Create;
for i := 0 to lstReview.Items.Count-1 do
begin
if (lstReview.Checked[i] = false) and (lstReview.State[i] <> cbGrayed) then continue;
TempChangeItem := TChangeItem(lstReview.Items.Objects[i]);
if TempChangeItem.DCOrder = True then
begin
DCList.Add(tempChangeItem.ID);
continue;
end;
if TempChangeItem.OrderDG = NONVAMEDGROUP then continue;
if TempChangeItem.OrderDG = 'Clinic Orders' then ContainsIMOORders := true;
if (tempChangeItem.OrderDG = '') then continue;
if tempChangeItem.Delay = True then continue;
OrderPrintList.Add(tempChangeItem.ID + ':' + tempChangeItem.Text);
end;
if OrderPrintList.Count > 0 then
frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
WardList, wardIEN, wardName, ContainsIMOOrders, displayEncSwitch)
else
begin
frmPrintLocation.SwitchEncounterLoction(EncLocIEN, EncLocName, EncLocText, EncDT, EncVC);
fframe.frmFrame.OrderPrintForm := True;
DoNotPrint := True;
end;
if DCList.Count > 0 then
begin
for i := 0 to DCList.Count - 1 do
WardList.Add(DCList.Strings[i]);
if (WardIEN = 0) and (WardName = '') then
CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
end;
if DCList <> nil then DCList.Free;
end;
end;
if (cmdOk.Caption = 'Don''t Sign') and (not frmFrame.TimedOut) then
begin
if ((Patient.Inpatient = false) and (frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN))) or
((Patient.Inpatient = True) and (Encounter.Location <> Patient.Location)) or
((Patient.Inpatient = True) and (Encounter.Location = Patient.Location) and
(encounter.Location <> uCore.TempEncounterLoc) and (uCore.TempEncounterLoc <> 0)) then
//or ((frmFrame.DoNotChangeEncWindow = true) and (encounter.Location = uCore.TempOutEncounterLoc)) then
begin
if Encounter.Location <> Patient.Location then
begin
EncLocName := Encounter.LocationName;
EncLocIEN := Encounter.Location;
EncLocText := Encounter.LocationText;
EncDT := Encounter.DateTime;
EncVC := Encounter.VisitCategory;
end
else
begin
EncLocName := UCore.TempEncounterLocName;
EncLocIEN := UCore.TempEncounterLoc;
EncLocText := uCore.TempEncounterText;
EncDT := uCore.TempEncounterDateTime;
EncVC := uCore.TempEncounterVistCat;
end;
frmPrintLocation.SwitchEncounterLoction(EncLocIEN, EncLocName, EncLocText, EncDT, EncVC);
fframe.frmFrame.OrderPrintForm := True;
end;
end;
uCore.TempEncounterLoc := 0;
uCore.TempEncounterLocName := '';
end;
//hds7591 Clinic/Ward movement.
if SaveCoPay then
SigItems.SaveSettings; // Save CoPay FIRST
SendOrders(OrderList, ESCode); {*KCM*}
with OrderList do for i := 0 to Count - 1 do
begin
if Pos('E', Piece(OrderList[i], U, 2)) > 0 then
begin
ChangeItem := Changes.Locate(CH_ORD, Piece(OrderList[i], U, 1));
if not FSilent then
begin
if Piece(OrderList[i],U,4) = 'Invalid Pharmacy order number' then
InfoBox(TX_SAVERR1 + Piece(OrderList[i], U, 4) + TX_SAVERR2 + ChangeItem.Text + CRLF + CRLF +
'The changes to this order have not been saved. You must contact Pharmacy to complete any action on this order.',
TC_SAVERR, MB_OK)
else
InfoBox(TX_SAVERR1 + Piece(OrderList[i], U, 4) + TX_SAVERR2 + ChangeItem.Text,
TC_SAVERR, MB_OK);
end;
end;
if Pos('R', Piece(OrderList[i], U, 2)) > 0 then
NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(OrderList[i], U, 1));
end;
if OrdersSignedOrReleased and (not FSilent) then
begin
for idx := OrderList.Count - 1 downto 0 do
begin
if Pos('E', Piece(OrderList[idx], U, 2)) > 0 then
begin
OrderList.Delete(idx);
Continue;
end;
theSts := GetOrderStatus(Piece(OrderList[idx],U,1));
if theSts = 10 then OrderList.Delete(idx); //signed delayed order should not be printed.
end;
// CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
AList := TStringList.Create;
try
CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrderList);
if AList.Text <> '' then
ReportBox(AList, 'Changed Orders', TRUE);
finally
AList.Free;
end;
if (ClinicList.Count > 0) or (WardList.Count > 0) then
PrintOrdersOnSignReleaseMult(OrderList, CLinicList, WardList, Nature, EncLocIEN, WardIEN, EncLocName, wardName)
else if DoNotPrint = false then PrintOrdersOnSignRelease(OrderList, Nature, PrintLoc);
end;
StatusText('');
UpdateUnsignedOrderAlerts(Patient.DFN);
with Notifications do
if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
UpdateExpiringMedAlerts(Patient.DFN);
UpdateUnverifiedMedAlerts(Patient.DFN);
UpdateUnverifiedOrderAlerts(Patient.DFN);
SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
end; {if User.OrderRole}
finally
FreeAndNil(OrderList);
FreeAndNil(OrderPrintList);
FreeAndNil(ClinicList);
FreeAndNil(WardList);
end;
crypto := nil;
end;
{ save/sign documents }
//with lstReview do for i := 0 to Items.Count - 1 do
with lstReview do for i := 0 to Items.Count - 1 do
begin
ChangeItem := TChangeItem(Items.Objects[i]);
if ChangeItem <> nil then with ChangeItem do
case ItemType of
CH_DOC: if Checked[i]
then frmNotes.SaveSignItem(ChangeItem.ID, ESCode)
else frmNotes.SaveSignItem(ChangeItem.ID, '');
CH_CON: if Checked[i]
then frmConsults.SaveSignItem(ChangeItem.ID, ESCode)
else frmConsults.SaveSignItem(ChangeItem.ID, '');
CH_SUM: if Checked[i]
then frmDCSumm.SaveSignItem(ChangeItem.ID, ESCode)
else frmDCSumm.SaveSignItem(ChangeItem.ID, '');
CH_SUR: if Assigned(frmSurgery) then
begin
if Checked[i]
then frmSurgery.SaveSignItem(ChangeItem.ID, ESCode)
else frmSurgery.SaveSignItem(ChangeItem.ID, '');
end;
end; {case}
end; {with lstReview}
if frmFrame.Closing then exit;
// clear all the items that were on the list (but not all in Changes)
with lstReview do for i := Items.Count - 1 downto 0 do
begin
if (not Assigned(Items.Objects[i])) then continue; {**RV**}
ChangeItem := TChangeItem(Items.Objects[i]);
if ChangeItem <> nil then
begin
AnID := ChangeItem.ID;
AType := ChangeItem.ItemType;
Changes.Remove(AType, AnID);
end;
end;
UnlockIfAble;
FOKPressed := IsOk;
Close;
end;
procedure TfrmReview.CleanupChangesList(Sender: TObject; ChangeItem: TChangeItem);
{Added for v15.3 - called by Changes.Remove, but only if fReview in progress}
var
i: integer;
begin
with lstReview do
begin
i := Items.IndexOfObject(ChangeItem);
if i > -1 then
begin
TChangeItem(Items.Objects[i]).Free;
Items.Objects[i] := nil;
end;
end;
end;
procedure TfrmReview.cmdCancelClick(Sender: TObject);
{ cancelled - do nothing }
begin
Inherited;
Close;
end;
procedure TfrmReview.lstReviewMeasureItem(Control: TWinControl;
Index: Integer; var AHeight: Integer);
var
x:string;
ARect: TRect;
begin
inherited;
AHeight := SigItemHeight;
with lstReview do if Index < Items.Count then
begin
ARect := ItemRect(Index);
Canvas.FillRect(ARect);
x := FilteredString(Items[Index]);
AHeight := WrappedTextHeightByFont( lstReview.Canvas, Font, x, ARect) + SIG_ITEM_VERTICAL_PAD;
if AHeight > 255 then AHeight := 255;
//-------------------
{Bug fix-HDS00001627}
//if AHeight < 13 then AHeight := 13; {ORIG}
if AHeight < 13 then AHeight := 15;
//-------------------
end;
end;
procedure TfrmReview.FormDestroy(Sender: TObject);
begin
Application.HintPause := FOldHintPause;
Application.HintHidePause := FOldHintHidePause;
end;
procedure TfrmReview.lstReviewMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
Itm: integer;
{Begin BillingAware}
tempRec: UBAGlobals.TBADxRecord;
i: smallint;
thisOrderID: string;
{End BillingAware}
begin
inherited;
Itm := lstReview.ItemAtPos(Point(X, Y), TRUE);
if (Itm >= 0) then
begin
if (Itm <> FLastHintItem) then
begin
Application.CancelHint;
//ORIG lstReview.Hint := TrimRight(lstReview.Items[Itm]);
{Begin BillingAware}
if BILLING_AWARE then
begin
if frmFrame.TimedOut then Exit;
//Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
if Assigned(frmReview) then
if Assigned(fReview.frmReview.lstReview.Items.Objects[Itm]) then
thisOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[Itm]).ID;
if UBAGlobals.tempDxNodeExists(thisOrderID) then
begin
if Assigned(tempDxList) then
try
for i := 0 to (tempDxList.Count - 1) do
begin
tempRec := TBADxRecord(tempDxList.Items[i]);
if Assigned(tempRec) then
if (tempRec.FOrderID = thisOrderID) then
begin
with tempRec do
begin
FBADxCode := StringReplace(tempRec.FBADxCode,'^',':',[rfReplaceAll]);
FBASecDx1 := StringReplace(tempRec.FBASecDx1,'^',':',[rfReplaceAll]);
FBASecDx2 := StringReplace(tempRec.FBASecDx2,'^',':',[rfReplaceAll]);;
FBASecDx3 := StringReplace(tempRec.FBASecDx3,'^',':',[rfReplaceAll]);
end;
lstReview.Hint := TrimRight(lstReview.Items[Itm] + #13 +
tempRec.FBADxCode + #13 + tempRec.FBASecDx1 + #13 + tempRec.FBASecDx2 + #13 + tempRec.FBASecDx3);
end
end //for
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.lstReviewMouseMove()');{$endif}
raise;
end;
end;
end
else
lstReview.Hint := TrimRight(lstReview.Items[Itm]);
end;
{End BillingAware}
FLastHintItem := Itm;
Application.ActivateHint(Point(X, Y));
end;
end
else
begin
lstReview.Hint := '';
FLastHintItem := -1;
Application.CancelHint;
end;
end;
procedure TfrmReview.buDiagnosisClick(Sender: TObject);
{Begin BillingAware}
var
i: smallint;
thisOrderID: string;
match: boolean;
allBlank: boolean;
numSelected: smallint;
tmpOrderIDList: TStringList;
thisChangeItem: TChangeItem;
{End BillingAware}
begin
{Begin BillingAware}
try
if BILLING_AWARE then
begin
//Prevent user from attempting to process first row - It is not an order!
//if lstReview.ItemIndex = 0 then
//Exit;
tmpOrderIDList := TStringList.Create;
if Assigned(tmpOrderIDList) then tmpOrderIDList.Clear;
BAtmpOrderList.Clear;
UBAGlobals.PLFactorsIndexes.Clear;
match := false;
allBlank := false;
try
// User has selected no orders to sign
for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
begin
if (fReview.frmReview.lstReview.Selected[i]) then
//*********************************
begin //Access Violation fix
thisChangeItem := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]);
if thisChangeItem = nil then
begin
fReview.frmReview.lstReview.Selected[i] := false;
Continue;
end;
//*********************************
thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
{BAV25 Code} //Used to pass selected orders to Lookup DX form
BAtmpOrderList.Add(TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).TEXT);
tmpOrderIDList.Add(thisOrderID);
chkBoxStatus := GetCheckBoxStatus(thisOrderID);
UBAGlobals.PLFactorsIndexes.Add(IntToStr(i)+ U + chkBoxStatus);
{BAV25 Code}
// Test for blank Dx on current grid item
if Not (tempDxNodeExists(thisOrderID)) then
if Assigned(UBAGlobals.GlobalDxRec) then
InitializeNewDxRec(UBAGlobals.globalDxRec);
begin
if (tempDxNodeExists(thisOrderID) ) then
if not Assigned(UBAGlobals.globalDxRec) then
begin
UBAGlobals.globalDxRec := UBAGlobals.TBADxRecord.Create;
InitializeNewDxRec(UBAGlobals.globalDxRec);
GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
end
else
GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
end
end; //if
end; //for
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.buDiagnosisClick()');{$endif}
raise;
end;
end;
numSelected := CountSelectedOrders(UBAConst.F_REVIEW);
if numSelected = 0 then
begin
ShowMsg(UBAMessages.BA_NO_ORDERS_SELECTED);
Exit;
end
else
if numSelected = 1 then
match := true;
if (UBAGlobals.CompareOrderDx(UBAConst.F_REVIEW)) then
match := true;
if UBAGlobals.AllSelectedDxBlank(UBAConst.F_REVIEW) then
allBlank := true;
if ((match and allBlank) or (match and (not allBlank))) then // All selected are blank or matching-not-blank
begin
frmBALocalDiagnoses.Enter(UBAConst.F_REVIEW, tmpOrderIDList);
end
else
begin
//Warning message
//If 'Yes' on warning message then open localDiagnosis
if (not allBlank) then
if MessageDlg(UBAMessages.BA_CONFIRM_DX_OVERWRITE, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if Assigned(UBAGlobals.globalDxRec) then
InitializeNewDxRec(UBAGlobals.globalDxRec);
//frmBALocalDiagnoses.Enter(UBAConst.F_REVIEW, tmpOrderIDList);
frmBALocalDiagnoses := TfrmBALocalDiagnoses.Create(frmReview);
frmBALocalDiagnoses.ShowModal;
frmBALocalDiagnoses.Release;
end;
end;
// TFactors come from FBALocalDiagnoses(Problem List Dx's Only).
if Length(UBAGlobals.TFactors) > 0 then
begin
UBACore.SetTreatmentFactors(UBAGlobals.TFactors);
SigItems.DisplayPlTreatmentFactors;
end;
{End BillingAware}
if pnlSignature.Visible then
txtESCode.SetFocus;
end;
finally
if Assigned(tmpOrderIDList) then FreeAndNil(tmpOrderIDList);
end;
end;
procedure TfrmReview.lstReviewClick(Sender: TObject);
//If grid item is an order-able item, then enable the Diagnosis button
// else disable the Diagnosis button.
{Begin BillingAware}
var
thisChangeItem: TChangeItem;
i: smallint;
thisOrderList: TStringList;
{End BillingAware}
begin
thisOrderList := TStringList.Create;
{Begin BillingAware}
if BILLING_AWARE then
begin
if lstReview.Items.Count > 1 then
Copy1.Enabled := True
else
Copy1.Enabled := False;
try
for i := 0 to lstReview.Items.Count - 1 do
begin
if lstReview.Selected[i] then
begin
thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
//Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
if thisChangeItem = nil then
begin
buDiagnosis.Enabled := false;
Copy1.Enabled := false;
Paste1.Enabled := false;
Diagnosis1.Enabled := false;
Exit;
end;
if (thisChangeItem <> nil) then
begin
thisOrderList.Clear;
thisOrderList.Add(thisChangeItem.ID);
// Returns True if All selected orders are N/A, Order selected are NON CIDC or DC'd
if uBACore.IsAllOrdersNA(thisOrderList) then
begin
Diagnosis1.Enabled := false;
buDiagnosis.Enabled := false;
end
else
begin
Diagnosis1.Enabled := true;
buDiagnosis.Enabled := true;
end
end
else
begin
buDiagnosis.Enabled := false;
Diagnosis1.Enabled := False;
Break;
end;
end;
end;
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.lstReviewClick()');{$endif}
raise;
end;
end;
{End BillingAware}
end;
if Assigned(thisOrderList) then thisOrderList.Free;
end;
procedure TfrmReview.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TfrmReview.lstReviewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{
- Open copy/paste popup menu.
}
var
ClientPoint: TPoint;
ScreenPoint: TPoint;
thisChangeItem: TChangeItem;
i: integer;
begin
if not BILLING_AWARE then lstReview.PopupMenu := nil;
if BILLING_AWARE then
begin
if Button = mbRight then //Right-click to open copy/paste popup menu
begin
//CQ3325
if frmReview.lstReview.Items.Count = 3 then
begin
Copy1.Enabled := false;
Paste1.Enabled := false
end
else
begin
Copy1.Enabled := true;
//Paste1.Enabled := true; //commented out for CQ6225
end;
//End CQ3325
//CQ HDS00002954 Fix
if Button = mbRight then
//Disallow copying of a grid HEADER item
for i := 0 to lstReview.Items.Count - 1 do
if lstReview.Selected[i] then
begin
thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
if thisChangeItem = nil then
begin
lstReview.Selected[i] := false;
Copy1.Enabled := false;
Paste1.Enabled := false;
Exit;
end;
end;
if not frmReview.lstReview.Selected[lstReview.ItemIndex] then
(Sender as TCheckListBox).Selected[lstReview.ItemIndex] := true;
ClientPoint.X := X;
ClientPoint.Y := Y;
ScreenPoint := lstReview.ClientToScreen(ClientPoint);
poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
end;
end;
end;
procedure TfrmReview.Copy1Click(Sender: TObject);
{
- Copy contents of the 'source' order for copy/paste operation
}
var
i : byte;
numSelected: byte;
thisChangeItem: TChangeItem;
begin
try
if BILLING_AWARE then
begin
Paste1.Enabled := true;
numSelected := GetNumberOfSelectedOrders;
if numSelected > 1 then
begin
ShowMsg('Only 1 order at a time may be selected for ''Copying''');
Exit;
end;
for i := 1 to frmReview.lstReview.Items.Count-1 do
if (frmReview.lstReview.Selected[i]) then
begin
thisChangeItem := TChangeItem.Create;
thisChangeItem := nil;
thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
//Skip this one if it's a "header" on the grid
if (thisChangeItem = nil) then //or (thisChangeItem.ItemType <> CH_ORD)) then
begin
if Assigned(thisChangeItem) then FreeAndNil(thisChangeItem);
Exit;
end;
fReview.srcOrderID := TChangeItem(frmReview.lstReview.Items.Objects[i]).ID;
//Copy source order to COPY BUFFER and add it to the Dx List
CopyBuffer := TBADxRecord.Create;
InitializeNewDxRec(CopyBuffer);
GetBADxListForOrder(CopyBuffer, fReview.srcOrderID);
fReview.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
UBAGlobals.tempDxList.Add(CopyBuffer);
//***********************************************************************
if Not UBACore.IsOrderBillable(fReview.srcOrderID) then
begin
ShowMsg(BA_NA_COPY_DISALLOWED);
//Continue;
fReview.srcOrderID := '';
Exit;
end;
//***********************************************************************
fReview.srcIndex := lstReview.ItemIndex;
fReview.chkBoxStatus := GetCheckBoxStatus(fReview.srcOrderID);
Break;
end;
end; //if BILLING_AWARE
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.Copy1Click()');{$endif}
raise
end;
end;
end;
procedure TfrmReview.Paste1Click(Sender: TObject);
{
- Populate 'target' orders of a copy/paste operation with contents of 'source' order
}
var
i: byte;
thisChangeItem: TChangeItem;
newRec: TBADxRecord;
begin
if BILLING_AWARE then
begin
if not Assigned(fReview.CopyBuffer) then //CQ5414
fReview.CopyBuffer := TBADxRecord.Create; //CQ5414
try
for i := 1 to lstReview.Count - 1 do
begin
if (frmReview.lstReview.Selected[i]) then
begin
thisChangeItem := TChangeItem(lstReview.Items.Objects[i]);
//Skip this one if it's a "header" on the grid
if (thisChangeItem = nil) then
Continue;
if (fReview.frmReview.lstReview.Selected[i]) then
begin
fReview.targetOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
if fReview.targetOrderID = fReview.srcOrderID then //disallow copying an order to itself
Continue
else
begin
fReview.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
//***************************************************************
if (NOT UBACore.IsOrderBillable(fReview.targetOrderID) ) then
begin
ShowMsg(BA_NA_PASTE_DISALLOWED);
fReview.targetOrderID := '';
Continue;
end;
//***************************************************************
newRec := TBADxRecord.Create;
with newRec do
begin
FOrderID := fReview.targetOrderID;
FBADxCode := CopyBuffer.FBADxCode;
FBASecDx1 := CopyBuffer.FBASecDx1;
FBASecDx2 := CopyBuffer.FBASecDx2;
FBASecDx3 := CopyBuffer.FBASecDx3;
end;
tempDxList.Add(newRec);
CopyTFCIToTargetOrder(fReview.targetOrderID, fReview.chkBoxStatus);
SetCheckBoxStatus(fReview.targetOrderID); //calls uSignItems.SetSigItems()
end; //else
end; //if
end //if
else
Continue
end; //for
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.Paste1Click()');{$endif}
raise;
end;
end;
end; //if BILLING_AWARE
lstReview.Refresh; //Update grid to show pasted Dx/TF/CI
end;
procedure TfrmReview.ClearDiagnoses1Click(Sender: TObject);
var
selectedOrderIDList: TStringList;
i:integer;
begin
selectedOrderIDList := TStringList.Create;
selectedOrderIDList.Clear;
try
for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
begin
if (fReview.frmReview.lstReview.Selected[i]) then
selectedOrderIDList.Add(TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID);
end;
except
on EListError do
begin
{$ifdef debug}Show508Message('EListError in fReview.ClearDiagnoses1Click()');{$endif}
raise;
end;
end;
UBACore.ClearSelectedOrderDiagnoses(selectedOrderIDList);
end;
function TfrmReview.GetNonNilItemCount : integer;
//CQ5172
var
i: integer;
thisItem: TChangeItem;
howMany: integer;
begin
howMany := 0;
for i := 0 to lstReview.Items.Count-1 do
begin
thisItem := TChangeItem(lstReview.Items.Objects[i]);
if thisItem <> nil then
Inc(howMany);
end;
Result := howMany;
end;
procedure TfrmReview.FormShow(Sender: TObject);
var
BottomEdge, numOrderItems: integer;
begin
if pnlSignature.Visible then
BottomEdge := pnlSignature.Top
else
if pnlOrderAction.Visible then
BottomEdge := pnlOrderAction.Top
else
BottomEdge := cmdOK.Top;
dec(BottomEdge, 4);
if (lstReview.Top + lstReview.Height) > BottomEdge then
lstReview.Height := BottomEdge - lstReview.Top;
//INITIALIZATIONS
Paste1.Enabled := false;
fReview.srcOrderID := '';
fReview.srcDx := '';
if BILLING_AWARE then
frmReview.lstReview.Multiselect := true;
FormatListForScreenReader;
//CQ5172
numOrderItems := GetNonNilItemCount;
if BILLING_AWARE then
begin
if (numOrderItems = 1) then
begin
lstReview.Selected[0] := false;
buDiagnosis.Enabled := True;
Diagnosis1.Enabled := True;
lstReview.Selected[1] := true;
// ** if number of orders is 1 and order is billable select order and disable diagnosis button
if NOT UBACore.IsOrderBillable(TChangeItem(frmReview.lstReview.Items.Objects[1]).ID) then
begin
buDiagnosis.Enabled := False;
Diagnosis1.Enabled := False;
lstReview.Selected[1] := false;
end
else
if Piece(TChangeItem(frmReview.lstReview.Items.Objects[1]).ID,';',2) = DISCONTINUED_ORDER then
begin
buDiagnosis.Enabled := False;
Diagnosis1.Enabled :=False ;
end;
end
else
lstReview.Selected[0] := false;
//end CQ5172
end;
end;
procedure TfrmReview.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
j: integer; //CQ5054
begin
inherited;
currentlySelectedItem := frmReview.lstReview.ItemIndex; //CQ5063
case Key of
67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.lblSC2); //C,c
86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.lblCV2); //V,v
79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.lblAO2); //O,o
82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.lblIR2); //R,r
65,97: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.lblSWAC2); //A,a
77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.lblMST2); //M,m
78,110: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //N,n
72,104: if (ssALT in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSHAD,fraCopay.lblSHAD2); // H,h
//CQ5054
83,115: if (ssAlt in Shift) then
begin
for j := 0 to lstReview.Items.Count-1 do
lstReview.Selected[j] := false;
lstReview.Selected[1] := true;
lstReview.SetFocus;
end;
09:
if FRVTFhintWindowActive then
begin
FRVTFHintWindow.ReleaseHandle;
FRVTFHintWindowActive := False;
end;
//end CQ5054
end;
end;
procedure TfrmReview.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
//CQ5063
if Key = VK_SPACE then
begin
if lstReview.Focused then //CQ6657
begin
lstReview.Selected[lstReview.Items.Count-1] := false;
lstReview.Selected[currentlySelectedItem] := true;
end;
end;
//end CQ5063
end;
//BILLING AWARE Procedure
procedure TfrmReview.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
var
HRect: TRect;
thisRect: TRect;
x,y: integer;
begin
if FRVTFhintWindowActive then
begin
FRVTFHintWindow.ReleaseHandle;
FRVTFHintWindowActive := False;
end;
FRVTFHintWindow := THintWindow.Create(frmReview); //(frmReview);
FRVTFHintWindow.Color := clInfoBk;
GetWindowRect(pCompName.Handle,thisRect);
x := thisRect.Left;
y := thisRect.Top;
hrect := FRVTFHintWindow.CalcHintRect(Screen.Width, pHintText,nil);
hrect.Left := hrect.Left + X;
hrect.Right := hrect.Right + X;
hrect.Top := hrect.Top + Y;
hrect.Bottom := hrect.Bottom + Y;
fraCoPay.LabelCaptionsOn(not FRVTFHintWindowActive);
FRVTFHintWindow.ActivateHint(hrect, pHintText);
FRVTFHintWindowActive := True;
end;
procedure TfrmReview.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FRVTFHintWindowActive then
begin
FRVTFHintWindow.ReleaseHandle;
FRVTFHintWindowActive := False;
end;
end;
procedure TfrmReview.FormResize(Sender: TObject);
begin
inherited;
lstReview.Invalidate;
end;
procedure TfrmReview.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FRVTFHintWindowActive then
begin
FRVTFHintWindow.ReleaseHandle;
FRVTFHintWindowActive := False;
Application.ProcessMessages;
end;
end;
procedure TfrmReview.fraCoPayLabel24MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
fraCoPay.LabelCaptionsOn(not FRVTFHintWindowActive);
end;
procedure TfrmReview.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if FRVTFHintWindowActive then
begin
FRVTFhintWindow.ReleaseHandle ;
FRVTFHintWindowActive := False ;
with fraCopay do
begin
//Long captions
lblSC.ShowHint := false;
lblCV.ShowHint := false;
lblAO.ShowHint := false;
lblIR.ShowHint := false;
lblSWAC.ShowHint := false;
lblHNC.ShowHint := false;
lblHNC2.ShowHint := false;
lblSHAD2.ShowHint := false;
end;
end;
// HDS00005143 - if cidc master sw is on and BANurseConsultOrders.Count > 0 then
// save those orders with selected DX enteries. Resulting in dx populated for provider.
if rpcGetBAMasterSwStatus then
begin
if BANurseConsultOrders.Count > 0 then
begin
rpcSaveNurseConsultOrder(BANurseConsultOrders);
BANurseConsultOrders.Clear;
end;
end;
end;
procedure TfrmReview.SetItemTextToState;
var
i : integer;
begin
if fReview.frmReview.lstReview.Count < 1 then Exit;
for i := 0 to fReview.frmReview.lstReview.Count-1 do
if fReview.frmReview.lstReview.Items.Objects[i] <> nil then //Not a Group Title
begin
if fReview.frmReview.lstReview.Items.Objects[i] is TChangeItem then
if fReview.frmReview.lstReview.Checked[i] then
fReview.frmReview.lstReview.Items[i] := 'Checked '+TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).Text
else
fReview.frmReview.lstReview.Items[i] := 'Not Checked '+TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).Text;
end;
if fReview.frmReview.lstReview.ItemIndex >= 0 then
fReview.frmReview.lstReview.Selected[fReview.frmReview.lstReview.ItemIndex] := True;
end;
procedure TfrmReview.lstReviewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_Space) then
FormatListForScreenReader
end;
procedure TfrmReview.FormatListForScreenReader;
begin
if ScreenReaderActive then
SetItemTextToState;
end;
end.
Reference in New Issue View Git Blame Copy Permalink