//kt -- Modified with SourceScanner on 8/7/2007 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, fNotePrt, DKLang; //kt added this line. type TfrmReview = class(TForm) 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; DKLanguageController1: TDKLanguageController; TMGAutoPrintCKBox: TCheckBox; 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 fraCoPayLabel23Enter(Sender: TObject); procedure fraCoPayLabel23Exit(Sender: TObject); procedure lstReviewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 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: TORStaticText); // 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; const SP_NONE = 0; SP_CLERK = 1; SP_NURSE = 2; SP_SIGN = 3; //TXT_ENCNT = 'Outpatient Encounter'; <-- original line. //kt 8/7/2007 //TXT_NOVISIT = 'Visit Type: < None Selected >'; <-- original line. //kt 8/7/2007 //TXT_NODIAG = 'Diagnosis: < None Selected >'; <-- original line. //kt 8/7/2007 //TXT_NOPROC = 'Procedures: none'; <-- original line. //kt 8/7/2007 //TXT_DOCS = 'Documents'; <-- original line. //kt 8/7/2007 //TXT_ORDERS = 'Orders'; <-- original line. //kt 8/7/2007 TXT_BLANK = ' '; //TX_INVAL_MSG = 'Not a valid electronic signature code. Enter a valid code or press Cancel.'; <-- original line. //kt 8/7/2007 //TX_INVAL_CAP = 'Unrecognized Signature Code'; <-- original line. //kt 8/7/2007 //TX_ES_REQ = 'Enter your electronic signature to release these orders.'; <-- original line. //kt 8/7/2007 //TC_ES_REQ = 'Electronic Signature'; <-- original line. //kt 8/7/2007 //TX_NO_REL = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/7/2007 //TC_NO_REL = 'Unable to Release Orders'; <-- original line. //kt 8/7/2007 //TC_NO_DX = 'Incomplete Diagnosis Entry'; <-- original line. //kt 8/7/2007 //TX_NO_DX = 'A Diagnosis must be selected prior to signing any of the following order types:' <-- original line. //kt 8/7/2007 // + CRLF + 'Outpatient Lab,Radiology, Outpatient Medications, Prosthetics.'; <-- original line. //kt 8/7/2007 DONT_SIGN = 'Don''t Sign'; //kt var TXT_ENCNT : string; //kt TXT_NOVISIT : string; //kt TXT_NODIAG : string; //kt TXT_NOPROC : string; //kt TXT_DOCS : string; //kt TXT_ORDERS : string; //kt TX_INVAL_MSG : string; //kt TX_INVAL_CAP : string; //kt TX_ES_REQ : string; //kt TC_ES_REQ : string; //kt TX_NO_REL : string; //kt TC_NO_REL : string; //kt TC_NO_DX : string; //kt TX_NO_DX : string; //kt procedure SetupVars; //kt Added entire function to replace constant declarations 8/7/2007 begin TXT_ENCNT := DKLangConstW('fReview_Outpatient_Encounter'); TXT_NOVISIT := DKLangConstW('fReview_Visit_Typex_x_None_Selected_x'); TXT_NODIAG := DKLangConstW('fReview_Diagnosisx_x_None_Selected_x'); TXT_NOPROC := DKLangConstW('fReview_Proceduresx_none'); TXT_DOCS := DKLangConstW('fReview_Documents'); TXT_ORDERS := DKLangConstW('fReview_Orders'); TX_INVAL_MSG := DKLangConstW('fReview_Not_a_valid_electronic_signature_codex__Enter_a_valid_code_or_press_Cancelx'); TX_INVAL_CAP := DKLangConstW('fReview_Unrecognized_Signature_Code'); TX_ES_REQ := DKLangConstW('fReview_Enter_your_electronic_signature_to_release_these_ordersx'); TC_ES_REQ := DKLangConstW('fReview_Electronic_Signature'); TX_NO_REL := CRLF + CRLF + DKLangConstW('fReview_x_cannot_be_released_to_the_servicexsxx') + CRLF + CRLF + DKLangConstW('fReview_Reasonx'); TC_NO_REL := DKLangConstW('fReview_Unable_to_Release_Orders'); TC_NO_DX := DKLangConstW('fReview_Incomplete_Diagnosis_Entry'); TX_NO_DX := DKLangConstW('fReview_A_Diagnosis_must_be_selected_prior_to_signing_any_of_the_following_order_typesx') + CRLF + DKLangConstW('fReview_Outpatient_LabxRadiologyx_Outpatient_Medicationsx_Prostheticsx'); end; procedure TfrmReview.SetCheckBoxStatus(thisOrderID: string); { - Set the current CI checkboxes status } begin SetupVars; //kt added 8/7/2007 to replace constants with vars. 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 '; <-- original line. //kt 8/7/2007 var TX_FORM_CAPTION : string; //kt begin TX_FORM_CAPTION := DKLangConstW('fReview_Review_x_Sign_Changes'); //kt added 8/7/2007 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 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: string; 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]); <-- original line. //kt 8/7/2007 AddHeader(DKLangConstW('fReview_Outpatient_Encounter') + PCEGrp[GrpIndex]); //kt added 8/7/2007 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'); <-- original line. //kt 8/7/2007 AddHeader(DKLangConstW('fReview_Documents')); //kt added 8/7/2007 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 with Changes do if Orders.Count > 0 then begin for GrpIndex := 0 to OrderGrp.Count - 1 do begin if (GrpIndex > 0 ) and (AnsiCompareText(PrevGrpName,OrderGrp[GrpIndex])=0) then Continue; // AddHeader('Orders - ' + OrderGrp[GrpIndex]); <-- original line. //kt 8/7/2007 AddHeader(DKLangConstW('fReview_Orders_x') + OrderGrp[GrpIndex]); //kt added 8/7/2007 {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] then begin lbIdx := AddItem(ChangeItem); SigItems.Add(CH_ORD, ChangeItem.ID, lbIdx); end; end; AddHeader(' '); PrevGrpName := OrderGrp[GrpIndex]; 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'; <-- original line. //kt 8/7/2007 lblSig.Caption := DKLangConstW('fReview_Documents_x_Orders'); //kt added 8/7/2007 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' <-- original line. //kt 8/7/2007 lblSig.Caption := DKLangConstW('fReview_These_orders_will_be_held_until_signed') //kt added 8/7/2007 else // lblSig.Caption := 'Signature will be Applied to Checked Items'; <-- original line. //kt 8/7/2007 lblSig.Caption := DKLangConstW('fReview_Signature_will_be_Applied_to_Checked_Items'); //kt added 8/7/2007 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: TRect; i: integer; tempID: string; thisRec: UBAGlobals.TBADxRecord; {Begin BillingAware} str: string; {End BillingAware} begin inherited; 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 := clSilver; //Canvas.Brush.Color := 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, 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 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); if BILLING_AWARE then begin //Dx Column lines Canvas.Pen.Color := 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; 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. ^ DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], 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 := clBlue ; DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , arRect[Index], 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 := clBlue ; DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE) , arRect[Index], 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, x) else if (ARect.Left > 0 ) and ( Length(x)>0 ) then begin Canvas.Pen.Color := clSilver; Canvas.MoveTo(0, ARect.Bottom-1); Canvas.LineTo(ARect.Right, ARect.Bottom-1); DrawText(Canvas.handle, PChar(x), Length(x), ARect, 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); var HasDocToSign, ShowAutoPrint : boolean; //kt i : integer; //kt begin //kt --- Begin Mod --- ShowAutoPrint := false; //kt Only show when button caption = 'Sign' HasDocToSign := false; for i := 0 to lstReview.Items.Count - 1 do begin if lstReview.Items.Objects[i] = nil then continue; if (TChangeItem(lstReview.Items.Objects[i]).ItemType = CH_DOC) and (lstReview.Checked[i]) then begin HasDocToSign := true; break; end; end; //kt --- End Mod --- if(not pnlSignature.Visible) then begin cmdOK.Caption := 'OK'; end else begin if Length(txtESCode.Text) > 0 then begin cmdOK.Caption := 'Sign'; if HasDocToSign then ShowAutoPrint := true; //kt end else begin //kt if FCouldSign then cmdOK.Caption := 'Don''t Sign' else cmdOK.Caption := 'OK'; if FCouldSign then begin //cmdOK.Caption := DONT_SIGN cmdOK.Caption := DKLangConstW('fReview_Donxxt_Sign') end else begin cmdOK.Caption := 'OK'; //kt added 8/7/2007 end; { Original Line 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'; <-- original line. //kt 8/7/2007 if FCouldSign then cmdOK.Caption := DKLangConstW('fReview_Donxxt_Sign') else cmdOK.Caption := 'OK'; //kt added 8/7/2007 } end; end; TMGAutoPrintCKBox.Visible := ShowAutoPrint; //kt end; procedure TfrmReview.cmdOKClick(Sender: TObject); { validate the electronic signature & call SaveSignItem for the encounter } //const //TX_NOSIGN = 'Save items without signing?'; <-- original line. //kt 8/7/2007 //TC_NOSIGN = 'No Signature Entered'; <-- original line. //kt 8/7/2007 //TX_SAVERR1 = 'The error, '; <-- original line. //kt 8/7/2007 //TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF; <-- original line. //kt 8/7/2007 //TC_SAVERR = 'Error Saving Order'; <-- original line. //kt 8/7/2007 var i, idx, AType, PrintLoc, theSts: Integer; SigSts, RelSts, Nature: Char; ESCode, AnID, AnErrMsg: string; ChangeItem: TChangeItem; OrderList: TStringList; SaveCoPay: boolean; DigSigErr, DigStoreErr, CryptoChecked: Boolean; SigData, SigUser, SigDrugSch, SigDEA: string; cSignature, cHashData, cCrlUrl, cErr: string; cProvDUZ: Int64; TX_NOSIGN : string; //kt TC_NOSIGN : string; //kt TX_SAVERR1 : string; //kt TX_SAVERR2 : string; //kt TC_SAVERR : string; //kt 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 SetupVars; //kt added 8/7/2007 to replace constants with vars. TX_NOSIGN := DKLangConstW('fReview_Save_items_without_signingx'); //kt added 8/7/2007 TC_NOSIGN := DKLangConstW('fReview_No_Signature_Entered'); //kt added 8/7/2007 TX_SAVERR1 := DKLangConstW('fReview_The_errorx'); //kt added 8/7/2007 TX_SAVERR2 := DKLangConstW('fReview_x_occurred_while_trying_to_savex') + CRLF + CRLF; //kt added 8/7/2007 TC_SAVERR := DKLangConstW('fReview_Error_Saving_Order'); //kt added 8/7/2007 ESCode := ''; SaveCoPay := FALSE; PrintLoc := 0; 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; DigSigErr := True; CryptoChecked := 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...'); <-- original line. //kt 8/7/2007 StatusText(DKLangConstW('fReview_Validating_Releasexxx')); //kt added 8/7/2007 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'); <-- original line. //kt 8/7/2007 StatusText(DKLangConstW('fReview_Retrieving_DIGITAL_SIGNATURE')); //kt added 8/7/2007 SigDrugSch := GetDrugSchedule(ChangeItem.ID); SigData := SetExternalText(ChangeItem.ID,SigDrugSch,User.DUZ); if Length(SigData) < 1 then begin // ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server'); <-- original line. //kt 8/7/2007 ShowMessage(ChangeItem.Text + CRLF + CRLF + DKLangConstW('fReview_Digital_Signature_failed_with_reasonx_Unable_to_get_required_data_from_server')); //kt added 8/7/2007 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 ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2)); DigStoreErr := true; end; except on E: Exception do begin // ShowMessage(ChangeItem.Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message); <-- original line. //kt 8/7/2007 ShowMessage(ChangeItem.Text + CRLF + CRLF + DKLangConstW('fReview_Crypto_raised_an_errorx')+ E.Message); //kt added 8/7/2007 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 ShowMessage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + ChangeItem.Text + CRLF + CRLF + // 'This Schedule II medication cannot be electronically entered without a Digital Signature. ' + <-- original line. //kt 8/7/2007 DKLangConstW('fReview_This_Schedule_II_medication_cannot_be_electronically_entered_without_a_Digital_Signaturex') + //kt added 8/7/2007 // 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.'); <-- original line. //kt 8/7/2007 CRLF + DKLangConstW('fReview_Please_discontinuexcancel_this_order_and_create_a_hand_written_order_for_manual_processingx_or_digitally_sign_the_order_at_a_PKIxenabled_workstationx')); //kt added 8/7/2007 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) <-- original line. //kt 8/7/2007 if (ChangeItem.GroupName = DKLangConstW('fReview_Other_Unsigned')) and (SigSts = SS_UNSIGNED) and (RelSts = RS_HOLD) //kt added 8/7/2007 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 <-- original line. //kt 8/7/2007 else if (cmdOK.Caption = DKLangConstW('fReview_Donxxt_Sign')) and (OrderList.IndexOf(ChangeItem.ID + U + SigSts + U + RelSts + U + Nature) < 0) then //kt added 8/7/2007 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 <-- original line. //kt 8/7/2007 if (cmdOk.Caption = DKLangConstW('fReview_Donxxt_Sign')) then //kt added 8/7/2007 SaveCoPay := TRUE else begin if BILLING_AWARE then // InfoBox(TX_Order_Error, 'Review/Sign Orders', MB_OK) <-- original line. //kt 8/7/2007 InfoBox(TX_Order_Error, DKLangConstW('fReview_ReviewxSign_Orders'), MB_OK) //kt added 8/7/2007 else // InfoBox(TC_Order_Error, 'Review/Sign Orders', MB_OK); <-- original line. //kt 8/7/2007 InfoBox(TC_Order_Error, DKLangConstW('fReview_ReviewxSign_Orders'), MB_OK); //kt added 8/7/2007 Exit; end end else SaveCoPay := TRUE; end else SaveCoPay := TRUE; {Begin BillingAware} if BILLING_AWARE then begin // if (cmdOk.Caption = 'Sign') then <-- original line. //kt 8/7/2007 if (cmdOk.Caption = DKLangConstW('fReview_Sign')) then //kt added 8/7/2007 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 ExecuteSessionOrderChecks(OrderList); // any cancelled orders will be removed from OrderList // StatusText('Sending Orders to Service(s)...'); <-- original line. //kt 8/7/2007 StatusText(DKLangConstW('fReview_Sending_Orders_to_Servicexsxxxx')); //kt added 8/7/2007 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 <-- original line. //kt 8/7/2007 if (cmdOk.Caption = DKLangConstW('fReview_Sign')) or (cmdOK.Caption = 'OK') and (not frmFrame.TimedOut) then //kt added 8/7/2007 begin if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then frmClinicWardMeds.ClinicOrWardLocation(OrderList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc) else if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then frmClinicWardMeds.ClinicOrWardLocation(OrderList, Encounter.Location,Encounter.LocationName, PrintLoc); 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 InfoBox(TX_SAVERR1 + Piece(OrderList[i], U, 4) + TX_SAVERR2 + ChangeItem.Text, TC_SAVERR, MB_OK); 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; 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); 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 begin //kt frmNotes.SaveSignItem(ChangeItem.ID, ESCode); {--- Begin K. Toppenberg's modificaton //kt --} //put back in later //if TMGAutoPrintCKBox.Checked then begin // PrintNote(StrToInt(ChangeItem.ID), ChangeItem.Text); //end; if TMGAutoPrintCKBox.Visible and TMGAutoPrintCKBox.Checked then begin PrintNote(StrToInt(ChangeItem.ID), ChangeItem.Text); end; {--- End K. Toppenberg's modificaton //kt --} end 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 := True; 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); 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}ShowMessage('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}ShowMessage('EListError in fReview.buDiagnosisClick()');{$endif} raise; end; end; numSelected := CountSelectedOrders(UBAConst.F_REVIEW); if numSelected = 0 then begin ShowMessage(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}ShowMessage('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 <-- original line. //kt 8/7/2007 - Copy contents of the DKLangConstW('fReview_source') order for copy/paste operation //kt added 8/7/2007 } var i : byte; numSelected: byte; thisChangeItem: TChangeItem; begin try if BILLING_AWARE then begin Paste1.Enabled := true; numSelected := GetNumberOfSelectedOrders; if numSelected > 1 then begin // ShowMessage('Only 1 order at a time may be selected for ''Copying'''); <-- original line. //kt 8/7/2007 ShowMessage(DKLangConstW('fReview_Only_1_order_at_a_time_may_be_selected_for_xxCopyingxx')); //kt added 8/7/2007 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 ShowMessage(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}ShowMessage('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 ShowMessage(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}ShowMessage('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}ShowMessage('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 numOrderItems: integer; begin //INITIALIZATIONS Paste1.Enabled := false; fReview.srcOrderID := ''; fReview.srcDx := ''; //begin BillingAware if BILLING_AWARE then frmReview.lstReview.Multiselect := true; //end BillingAware 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 currentlySelectedItem := frmReview.lstReview.ItemIndex; //CQ5063 case Key of 67,99: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c 86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v 79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o 82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r 69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e 77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m 72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //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: TORStaticText); // 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; if FRVTFHintWindowActive then begin with fraCoPay do begin //Abbreviated captions Label23.ShowHint := false; StaticText1.ShowHint := false; Label17.ShowHint := false; Label15.ShowHint := false; Label13.ShowHint := false; Label11.ShowHint := false; lblHNC.ShowHint := false; //Long captions staticText4.ShowHint := false; Label17.ShowHint := false; Label18.ShowHint := false; Label15.ShowHint := false; Label16.ShowHint := false; Label13.ShowHint := false; Label14.ShowHint := false; Label11.ShowHint := false; Label12.ShowHint := false; lblHNC.ShowHint := false; lblHNC2.ShowHint := false; end; end else begin with fraCoPay do begin //Abbreviated captions Label23.ShowHint := true; StaticText1.ShowHint := true; Label17.ShowHint := true; Label15.ShowHint := true; Label13.ShowHint := true; Label11.ShowHint := true; lblHNC.ShowHint := true; //Long captions staticText4.ShowHint := true; Label17.ShowHint := true; Label18.ShowHint := true; Label15.ShowHint := true; Label16.ShowHint := true; Label13.ShowHint := true; Label14.ShowHint := true; Label11.ShowHint := true; Label12.ShowHint := true; lblHNC.ShowHint := true; lblHNC2.ShowHint := true; end; end; FRVTFHintWindow.ActivateHint(hrect, pHintText); FRVTFHintWindowActive := True; end; procedure TfrmReview.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // IF BILLING_AWARE then if FRVTFHintWindowActive then begin FRVTFHintWindow.ReleaseHandle; FRVTFHintWindowActive := False; end; 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 if FRVTFHintWindowActive then begin with fraCoPay do begin //Abbreviated captions Label23.ShowHint := false; StaticText1.ShowHint := false; Label17.ShowHint := false; Label15.ShowHint := false; Label13.ShowHint := false; Label11.ShowHint := false; lblHNC.ShowHint := false; //Long captions Label24.ShowHint := false; staticText4.ShowHint := false; Label17.ShowHint := false; Label18.ShowHint := false; Label15.ShowHint := false; Label16.ShowHint := false; Label13.ShowHint := false; Label14.ShowHint := false; Label11.ShowHint := false; Label12.ShowHint := false; lblHNC.ShowHint := false; lblHNC2.ShowHint := false; end; end else begin with fraCoPay do begin //Abbreviated captions Label23.ShowHint := true; StaticText1.ShowHint := true; Label17.ShowHint := true; Label15.ShowHint := true; Label13.ShowHint := true; Label11.ShowHint := true; lblHNC.ShowHint := true; //Long captions Label24.ShowHint := true; staticText4.ShowHint := true; Label17.ShowHint := true; Label18.ShowHint := true; Label15.ShowHint := true; Label16.ShowHint := true; Label13.ShowHint := true; Label14.ShowHint := true; Label11.ShowHint := true; Label12.ShowHint := true; lblHNC.ShowHint := true; lblHNC2.ShowHint := true; end; end; end; procedure TfrmReview.FormClose(Sender: TObject; var Action: TCloseAction); begin if FRVTFHintWindowActive then begin FRVTFhintWindow.ReleaseHandle ; FRVTFHintWindowActive := False ; with fraCopay do begin Label24.ShowHint := false; staticText4.ShowHint := false; Label18.ShowHint := false; Label16.ShowHint := false; Label14.ShowHint := false; Label12.ShowHint := false; lblHNC2.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 BillingAware} end; procedure TfrmReview.fraCoPayLabel23Enter(Sender: TObject); begin (Sender as TORStaticText).Font.Style := [fsBold]; end; procedure TfrmReview.fraCoPayLabel23Exit(Sender: TObject); begin (Sender as TORStaticText).Font.Style := []; 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; <-- original line. //kt 8/7/2007 fReview.frmReview.lstReview.Items[i] := DKLangConstW('fReview_Not_Checked')+TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).Text; //kt added 8/7/2007 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; var ListStateOn : longbool; Success: longbool; begin //Determine if a screen reader is currently being used. Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0); if Success and ListStateOn then SetItemTextToState; end; end.