//kt -- Modified with SourceScanner on 9/15/2007 unit fMeds; {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fPage, StdCtrls, Menus, ORCtrls, ORFn, ExtCtrls, ComCtrls, rOrders, uConst, rMeds, ORNet, DKLang; type TChildOD = class public ChildID: string; ParentID: string; constructor Create; end; TfrmMeds = class(TfrmPage) mnuMeds: TMainMenu; mnuView: TMenuItem; mnuViewChart: TMenuItem; mnuChartReports: TMenuItem; mnuChartLabs: TMenuItem; mnuChartDCSumm: TMenuItem; mnuChartCslts: TMenuItem; mnuChartNotes: TMenuItem; mnuChartOrders: TMenuItem; mnuChartMeds: TMenuItem; mnuChartProbs: TMenuItem; mnuChartCover: TMenuItem; mnuAct: TMenuItem; mnuActNew: TMenuItem; Z1: TMenuItem; mnuActChange: TMenuItem; mnuActDC: TMenuItem; mnuActHold: TMenuItem; mnuActRenew: TMenuItem; Z2: TMenuItem; mnuViewActive: TMenuItem; mnuViewExpiring: TMenuItem; Z3: TMenuItem; mnuViewSortClass: TMenuItem; mnuViewSortName: TMenuItem; Z4: TMenuItem; mnuViewDetail: TMenuItem; popMed: TPopupMenu; popMedDetails: TMenuItem; N1: TMenuItem; popMedChange: TMenuItem; popMedDC: TMenuItem; popMedRenew: TMenuItem; N2: TMenuItem; popMedNew: TMenuItem; mnuActCopy: TMenuItem; mnuActRefill: TMenuItem; mnuActTransfer: TMenuItem; popMedRefill: TMenuItem; mnuChartSurgery: TMenuItem; mnuViewHistory: TMenuItem; popMedHistory: TMenuItem; pnlBottom: TORAutoPanel; splitBottom: TSplitter; pnlMedIn: TPanel; lstMedsIn: TCaptionListBox; hdrMedsIn: THeaderControl; pnlNonVA: TPanel; lstMedsNonVA: TCaptionListBox; hdrMedsNonVA: THeaderControl; splitTop: TSplitter; pnlTop: TORAutoPanel; lstMedsOut: TCaptionListBox; hdrMedsOut: THeaderControl; mnuViewInformation: TMenuItem; mnuViewDemo: TMenuItem; mnuViewVisits: TMenuItem; mnuViewPrimaryCare: TMenuItem; mnuViewMyHealtheVet: TMenuItem; mnuInsurance: TMenuItem; mnuViewFlags: TMenuItem; mnuViewReminders: TMenuItem; mnuViewRemoteData: TMenuItem; mnuViewPostings: TMenuItem; mnuOptimizeFields: TMenuItem; procedure mnuChartTabClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); procedure lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure mnuViewDetailClick(Sender: TObject); procedure lstMedsExit(Sender: TObject); procedure lstMedsDblClick(Sender: TObject); procedure lstMedsInClick(Sender: TObject); procedure lstMedsOutClick(Sender: TObject); procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); procedure hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); procedure mnuActDCClick(Sender: TObject); procedure mnuActHoldClick(Sender: TObject); procedure mnuActRenewClick(Sender: TObject); procedure mnuActChangeClick(Sender: TObject); procedure mnuActCopyClick(Sender: TObject); procedure mnuActNewClick(Sender: TObject); procedure mnuActRefillClick(Sender: TObject); procedure mnuActClick(Sender: TObject); procedure mnuViewHistoryClick(Sender: TObject); procedure popMedPopup(Sender: TObject); procedure mnuViewClick(Sender: TObject); procedure lstMedsNonVAClick(Sender: TObject); procedure lstMedsNonVADblClick(Sender: TObject); procedure lstMedsNonVAExit(Sender: TObject); procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection); procedure FormResize(Sender: TObject); procedure hdrMedsOutResize(Sender: TObject); procedure hdrMedsNonVAResize(Sender: TObject); procedure hdrMedsInResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure splitBottomMoved(Sender: TObject); procedure splitTopMoved(Sender: TObject); procedure hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //procedure ActivateDeactiveRenew(AListBox: TListBox); procedure ViewInfo(Sender: TObject); procedure mnuViewInformationClick(Sender: TObject); procedure mnuOptimizeFieldsClick(Sender: TObject); procedure hdrMedsOutSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); procedure hdrMedsNonVASectionClick(HeaderControl: THeaderControl; Section: THeaderSection); procedure hdrMedsInSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); private FIterating: Boolean; FActionOnMedsTab: Boolean; FParentComplexOrderID: string; uMedListIn: TList; uMedListOut: TList; uMedListNonVA: TList; uPendingChanges: TStringList; uDGrp: array[0..6] of Integer; uPharmacyOrdersIn: TStringList; uPharmacyOrdersOut: TStringList; uNonVAOrdersOut: TStringList; ChildODList: TStringList; function ListSelected(const ErrMsg: string): TListBox; procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string); procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = ''); procedure SynchListToOrders(AListBox: TListBox; AList: TList); function GetActionText(const AMed: TMedListRec): string; function GetInstructText(const AMed: TMedListRec; var Detail: string): string; function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string; function GetPlainText(Control: TWinControl; Index: integer): string; function GetHeader(Control: TWinControl): THeaderControl; function GetMedList(Control: TWinControl): TList; function GetPharmacyOrders(Control: TWinControl): TStringList; function PatientStatusChanged: boolean; procedure ClearChildODList; public procedure RefreshMedLists; procedure ClearPtData; override; procedure DisplayPage; override; procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; procedure SetFontSize( FontSize: integer); override; property ActionOnMedsTab: boolean read FActionOnMedsTab; property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID; procedure InitfMedsSize; procedure SetSectionWidths(Sender: TObject); function GetTotalSectionsWidth(Sender: TObject) : integer; function CheckMedStatus(ActiveList: TListBox): boolean; end; type arOrigOutPtSecWidths = array[0..6] of integer; //CQ7586 arOrigInPtSecWidths = array[0..4] of integer; //CQ7586 arOrigNonVASecWidths = array[0..3] of integer; //CQ7586 var frmMeds: TfrmMeds; // LargePanelPortion: Integer; // SmallPanelPortion: integer; OrigOutPtSecWidths: arOrigOutPtSecWidths; //CQ7586 OrigInPtSecWidths : arOrigInPtSecWidths; //CQ7586 OrigNonVASecWidths: arOrigNonVASecWidths; //CQ7586 MedOutSize: double; s: string; LargePanelSize: integer; SmallPanelSize : integer; MedNonVAPanelSize: integer; totalHeight: integer; resizedTotalHeight: integer; resizedMedOutPanelHeight: Extended; resizedNonVAPanelHeight: Extended; resizedMedInPanelHeight: Extended; splitterTop: TSplitter; splitterBottom: TSplitter; oldFont: integer; //CQ9182 implementation uses uCore, rCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold, fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase, StrUtils, fActivateDeactivate; {$R *.DFM} const SMALL_PANEL = 20; LARGE_PANEL = 60; COL_MEDNAME = 1; DG_OUT = 0; DG_IN = 1; DG_UD = 2; DG_IV = 3; DG_TPN = 4; DG_NVA = 5; DG_IMO = 6; FMT_INDENT = 12; TAG_OUTPT = 1; TAG_INPT = 2; TAG_NONVA = 3; //TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF + <-- original line. //kt 9/15/2007 // 'you wish to take action on.'; <-- original line. //kt 9/15/2007 //TC_NOSEL = 'No Orders Selected'; <-- original line. //kt 9/15/2007 //TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_DC = 'Unable to Discontinue'; <-- original line. //kt 9/15/2007 //TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_RENEW = 'Unable to Renew Order'; <-- original line. //kt 9/15/2007 //TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_HOLD = 'Unable to Hold'; <-- original line. //kt 9/15/2007 //TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_COPY = 'Unable to Copy Order'; <-- original line. //kt 9/15/2007 //TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_CHANGE = 'Unable to Change Order'; <-- original line. //kt 9/15/2007 //TX_NO_REFILL = CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 9/15/2007 //TC_NO_REFILL = 'Unable to Refill Order'; <-- original line. //kt 9/15/2007 MEDS_SPLIT_FORM = 'frmMedsSplit'; { TPage common methods --------------------------------------------------------------------- } var TX_NOSEL : string; //kt TC_NOSEL : string; //kt TX_NO_DC : string; //kt TC_NO_DC : string; //kt TX_NO_RENEW : string; //kt TC_NO_RENEW : string; //kt TX_NO_HOLD : string; //kt TC_NO_HOLD : string; //kt TX_NO_COPY : string; //kt TC_NO_COPY : string; //kt TX_NO_CHANGE : string; //kt TC_NO_CHANGE : string; //kt TX_NO_REFILL : string; //kt TC_NO_REFILL : string; //kt procedure SetupVars; //kt Added entire function to replace constant declarations 9/15/2007 begin TX_NOSEL := DKLangConstW('fMeds_No_orders_are_highlightedx__Highlight_the_orders') + CRLF + DKLangConstW('fMeds_you_wish_to_take_action_onx'); TC_NOSEL := DKLangConstW('fMeds_No_Orders_Selected'); TX_NO_DC := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_discontinuedx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_DC := DKLangConstW('fMeds_Unable_to_Discontinue'); TX_NO_RENEW := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_changedx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_RENEW := DKLangConstW('fMeds_Unable_to_Renew_Order'); TX_NO_HOLD := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_placed_on_holdx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_HOLD := DKLangConstW('fMeds_Unable_to_Hold'); TX_NO_COPY := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_copiedx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_COPY := DKLangConstW('fMeds_Unable_to_Copy_Order'); TX_NO_CHANGE := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_changedx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_CHANGE := DKLangConstW('fMeds_Unable_to_Change_Order'); TX_NO_REFILL := CRLF + CRLF + DKLangConstW('fMeds_x_cannot_be_refilledx') + CRLF + CRLF + DKLangConstW('fMeds_Reasonx'); TC_NO_REFILL := DKLangConstW('fMeds_Unable_to_Refill_Order'); end; procedure TfrmMeds.ClearPtData; begin inherited ClearPtData; ClearChildODList; lstMedsIn.Clear; lstMedsOut.Clear; lstMedsNonVA.Clear; ClearMedList(uMedListIn); ClearMedList(uMedListOut); ClearMedList(uMedListNonVA); uPendingChanges.Clear; uPharmacyOrdersIn.Clear; uPharmacyOrdersOut.Clear; uMedListNonVA.Clear; totalHeight := 0; end; procedure TfrmMeds.DisplayPage; const RATIO_SMALL = 0.13; //0.1866; begin inherited DisplayPage; frmFrame.ShowHideChartTabMenus(mnuViewChart); if InitPage and User.NoOrdering then begin mnuAct.Enabled := False; popMedChange.Enabled := False; popMedDC.Enabled := False; popMedRenew.Enabled := False; popMedNew.Enabled := False; end; //Swap Inpatient/Outpatient list display positions depending in inpatient/outpatient status if InitPage and User.DisableHold then mnuActHold.Visible := False; if Patient.Inpatient then begin splitBottom.Align := alNone; hdrMedsIn.Align := alNone; lstMedsIn.Align := alNone; lstMedsIn.Parent := pnlTop; lstMedsIn.Align := alClient; lstMedsOut.Parent := pnlMedIn; hdrMedsIn.Parent := pnlTop; hdrMedsIn.Align := alTop; hdrMedsOut.Parent := pnlMedIn; splitBottom.Align := alBottom; lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small. lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small end else begin splitBottom.Align := alNone; hdrMedsIn.Align := alNone; lstMedsIn.Parent := pnlMedIn; lstMedsOut.Parent := pnlTop; lstMedsOut.Align := alClient; hdrMedsIn.Parent := pnlMedIn; hdrMedsIn.Align := alTop; hdrMedsOut.Parent := pnlTop; splitBottom.Align := alBottom; lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small. lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small end; RefreshMedLists; end; procedure TfrmMeds.mnuChartTabClick(Sender: TObject); begin inherited; frmFrame.mnuChartTabClick(Sender); end; procedure TfrmMeds.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); var AMedList: TList; AStringList: TStringList; NewMedRec: TMedListRec; i, idx, Match: Integer; j: integer; AChildList: TStringlist; CplxOrderID: string; procedure SetCurrentOrderID; var i: Integer; AMedRec: TMedListRec; begin with AMedList do for i := 0 to Count - 1 do begin AMedRec := TMedListRec(AMedList[i]); if Piece(AMedRec.OrderID, ';', 1) = Piece(AnOrder.ActionOn, ';', 1) then begin end; end; end; function IndexForCurrentID(const AnID: string): Integer; var i: Integer; begin Result := -1; for i := 0 to uPendingChanges.Count - 1 do if Piece(uPendingChanges[i], U, 2) = AnID then Result := i; if Result < 0 then for i := 0 to uPendingChanges.Count - 1 do if Piece(uPendingChanges[i], '=', 1) = Piece(AnID, ';', 1) then Result := i; end; begin AMedList := nil; if AnOrder <> nil then begin //AGP Change 26.24 CQ 7150 fixes the problem with non-va meds initially showing up in the inpatient section if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut; If uDGrp[DG_NVA] = AnOrder.DGroup then AMedList := uMedListNonVA; if (AMedList <> uMedListOut) and (AMedList <> uMedListNonVA) then for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn; end; case OrderAction of ORDER_NEW: { sent by accept order on new order } if AMedList <> nil then begin // check this out carefully!! NewMedRec := TMedListRec.Create; NewMedRec.OrderID := AnOrder.ID; NewMedRec.Instruct := AnOrder.Text; NewMedRec.Inpatient := AMedList = uMedListIn; AMedList.Insert(0, NewMedRec); if AMedList = uMedListIn then begin lstMedsIn.Items.Insert(0, GetPlainText(lstMedsIn,0)); uPharmacyOrdersIn.Insert(0, U + AnOrder.ID); end else begin if AMedList = uMedListOut then begin lstMedsOut.Items.Insert(0, GetPlainText(lstMedsOut,0)); uPharmacyOrdersOut.Insert(0, U + AnOrder.ID); end else begin if AMedList = uMedListNonVA then begin lstMedsNonVA.Items.Insert(0, GetPlainText(lstMedsNonVA,0)); uNonVAOrdersOut.Insert(0, U + AnOrder.ID); end; end; end; uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + '=NW^' + AnOrder.ID); end; ORDER_DC: { sent by a diet to cancel a tubefeeding - do nothing }; ORDER_EDIT: { sent by accept on edit order } if AMedList <> nil then begin Match := IndexForCurrentID(AnOrder.EditOf); if Match < 0 { add a new pending change if there is no existing change that matches EditOf } then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName) { leave 1st piece (original ID) intact, while changing text & current ID } else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName; end; ORDER_ACT: { sent by DC, Hold, & Renew actions } if AMedList <> nil then begin if Piece(AnOrder.ActionOn, '=', 2) = 'CA' then begin // cancel action, remove from PendingChanges for idx := uPendingChanges.Count-1 downto 0 do begin Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1)); if Match > -1 then uPendingChanges.Delete(Match); end; end else if Piece(AnOrder.ActionOn, '=', 2) = 'DL' then begin // delete action, show as deleted (set OrderID's to 0 so not confused with next order) Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1)); if Match > -1 then uPendingChanges[Match] := '0=DL'; if AMedList = uMedListIn then AStringList := uPharmacyOrdersIn else if AMedList = uMedListOut then AStringList := uPharmacyOrdersOut else AStringList := uNonVAOrdersOut; with AStringList do for i := 0 to Count - 1 do if (U + Piece(AnOrder.ActionOn, '=', 1)) = Strings[i] then Strings[i] := '^0'; Match := -1; with AMedList do for i := 0 to Count - 1 do if TMedListRec(Items[i]).OrderID = Piece(AnOrder.ActionOn, '=', 1) then Match := i; if Match > -1 then TMedListRec(AMedList.Items[Match]).OrderID := '0'; end else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName); end; {if AMedList} ORDER_CPLXRN: begin AChildList := TStringList.Create; CplxOrderID := Piece(AnOrder.ActionOn,'=',1); GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList); if AMedList = uMedListIn then with AMedList do begin for i := Count-1 downto 0 do begin for j := 0 to AChildList.Count - 1 do begin if (TMedListRec(Items[i]).OrderID = AChildList[j]) then begin { Delete(i); Break;} if not IsFirstDoseNowOrder(TMedListRec(Items[i]).OrderID) then begin uPendingChanges.Add(Piece(TMedListRec(Items[i]).OrderID, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID); Break; end; end; end; end; end; AChildList.Clear; AChildList.Free; end; ORDER_SIGN: { sent by fReview, fOrderSign when orders signed, AnOrder=nil} begin // ** only if tab has been visited? uPendingChanges.Clear; RefreshMedLists; end; end; {case} end; procedure TfrmMeds.SetFontSize( FontSize: integer); begin inherited SetFontSize(FontSize); mnuOptimizeFieldsClick(self); if Patient.DFN <> '' then RefreshMedLists; end; { Form events ------------------------------------------------------------------------------ } procedure TfrmMeds.FormCreate(Sender: TObject); var medsSplitFnd : boolean; retList : TStringList; i: integer; x: string; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; PageID := CT_MEDS; lstMedsIn.Color := ReadOnlyColor; lstMedsOut.Color := ReadOnlyColor; uMedListIn := TList.Create; uMedListOut := TList.Create; uMedListNonVA := TList.Create; uPendingChanges := TStringList.Create; uDGrp[DG_OUT] := DGroupIEN('O RX'); uDGrp[DG_IN] := DGroupIEN('I RX'); uDGrp[DG_UD] := DGroupIEN('UD RX'); uDGrp[DG_IV] := DGroupIEN('IV RX'); uDGrp[DG_TPN] := DGroupIEN('TPN'); uDGrp[DG_NVA] := DGroupIEN('NV RX'); uDGrp[DG_IMO] := DGroupIEN('C RX'); uPharmacyOrdersIn := TStringList.Create; uPharmacyOrdersOut := TStringList.Create; uNonVAOrdersOut := TStringList.Create; FActionOnMedsTab := False; FParentComplexOrderID := ''; ChildODList := TStringList.Create; //DETECT 1st TIME USER. //If first time user (medSplitFound=false), then manually set panel heights. //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings. medsSplitFnd := FALSE; if Assigned(frmMeds) then begin retList := TStringList.Create; tCallV(retList, 'ORWCH LOADALL', [nil]); for i := 0 to retList.Count-1 do begin x := retList.strings[i]; if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then begin medsSplitFnd := False;//TRUE; Break; end; end; if not medsSplitFnd then begin pnlBottom.Height := frmMeds.Height div 2; pnlMedIn.Height := pnlBottom.Height div 2; end; end; //CQ9622 if hdrMedsIn.Sections[1].Width < 100 then begin hdrMedsIn.Sections[1].Width := 100; hdrMedsIn.Refresh; end; if hdrMedsNonVA.Sections[1].Width < 100 then begin hdrMedsNonVA.Sections[1].Width := 100; lstMedsNonVA.Refresh; end; if hdrMedsOut.Sections[1].Width < 100 then begin hdrMedsOut.Sections[1].Width := 100; hdrMedsOut.Refresh; end; //end CQ9622 end; procedure TfrmMeds.FormDestroy(Sender: TObject); begin inherited; ClearChildODList; ClearMedList(uMedListIn); ClearMedList(uMedListOut); ClearMedList(uMedListNonVA); uMedListIn.Free; uMedListOut.Free; uMedListNonVA.Free; uPendingChanges.Free; uPharmacyOrdersIn.Free; uPharmacyOrdersOut.Free; uNonVAOrdersOut.Free; ChildODList.Free; end; { View menu events ------------------------------------------------------------------------- } procedure TfrmMeds.mnuViewDetailClick(Sender: TObject); var AnID, ATitle, AnOrder: string; AListBox: TListBox; i,j,idx: Integer; tmpList: TStringList; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; tmpList := TStringList.Create; try idx := 0; AListBox := ListSelected(TX_NOSEL); if AListBox = nil then Exit // else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details' <-- original line. //kt 9/15/2007 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_Outpatient_Medication_Details') //kt added 9/15/2007 // else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Details' <-- original line. //kt 9/15/2007 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_Non_VA_Medication_Details') //kt added 9/15/2007 // else ATitle := 'Inpatient Medication Details'; <-- original line. //kt 9/15/2007 else ATitle := DKLangConstW('fMeds_Inpatient_Medication_Details'); //kt added 9/15/2007 FIterating := True; with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then begin AnID := Piece(Strings[i], U, 1); if AnID <> '' then begin tmpList.Assign(DetailMedLM(AnID)); end; AnOrder := Piece(Strings[i], U, 2); if AnOrder <> '' then begin tmpList.Add(''); tmpList.Add(StringOfChar('=', 74)); tmpList.Add(''); tmpList.AddStrings(MedAdminHistory(AnOrder)); end; if CheckOrderGroup(AnOrder)=1 then // if it's UD group begin for j := 0 to tmpList.Count - 1 do begin if Pos('PICK UP',UpperCase(tmpList[j]))>0 then begin idx := j; Break; end; end; if idx > 0 then tmpList.Delete(idx); end; if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True); if frmFrame.CCOWDrivedChange then Exit; end; FIterating := False; ResetSelectedForList(AListBox); AListBox.SetFocus; finally tmpList.Free; end; end; procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject); var ATitle, AnOrder: string; AListBox: TListBox; i: Integer; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; AListBox := ListSelected(TX_NOSEL); if AListBox = nil then Exit //else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History' <-- original line. //kt 9/15/2007 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_Outpatient_Medication_Administration_History') //kt added 9/15/2007 //else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History' <-- original line. //kt 9/15/2007 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_Non_VA_Medication_Documentation_History') //kt added 9/15/2007 //else ATitle := 'Inpatient Medication Administration History'; <-- original line. //kt 9/15/2007 else ATitle := DKLangConstW('fMeds_Inpatient_Medication_Administration_History'); //kt added 9/15/2007 FIterating := True; with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then begin AnOrder := Piece(Strings[i], U, 2); if AnOrder <> '' then ReportBox(MedAdminHistory(AnOrder), ATitle, True); end; FIterating := False; ResetSelectedForList(AListBox); AListBox.SetFocus; end; { Listbox events --------------------------------------------------------------------------- } procedure TfrmMeds.RefreshMedLists; var i: Integer; AMed: TMedListRec; begin lstMedsIn.Clear; lstMedsOut.Clear; lstMedsNonVA.Clear; //StatusText('Retrieving active medications...'); <-- original line. //kt 9/15/2007 StatusText(DKLangConstW('fMeds_Retrieving_active_medicationsxxx')); //kt added 9/15/2007 LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA); uPharmacyOrdersIn.Clear; uPharmacyOrdersOut.Clear; uNonVAOrdersOut.Clear; with uMedListIn do for i := 0 to Count - 1 do begin AMed := TMedListRec(Items[i]); uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID); lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed); end; with uMedListNonVA do for i := 0 to Count - 1 do begin AMed := TMedListRec(Items[i]); uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID); lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed); end; with uMedListOut do for i := 0 to Count - 1 do begin AMed := TMedListRec(Items[i]); uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID); lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed); end; StatusText(''); end; function TfrmMeds.GetActionText(const AMed: TMedListRec): string; var AnAction: string; Abbreviation: string; begin AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)]; Abbreviation := Piece(AnAction, U, 1); result := ''; if Length(Abbreviation) > 0 then begin // if CharAt(Abbreviation, 1) = 'X' then result := 'Change' <-- original line. //kt 9/15/2007 if CharAt(Abbreviation, 1) = 'X' then result := DKLangConstW('fMeds_Change') //kt added 9/15/2007 // else if Abbreviation = 'NW' then result := 'New' <-- original line. //kt 9/15/2007 else if Abbreviation = 'NW' then result := DKLangConstW('fMeds_New') //kt added 9/15/2007 // else if Abbreviation = 'RN' then result := 'Renew' <-- original line. //kt 9/15/2007 else if Abbreviation = 'RN' then result := DKLangConstW('fMeds_Renew') //kt added 9/15/2007 // else if Abbreviation = 'RF' then result := 'Refill' <-- original line. //kt 9/15/2007 else if Abbreviation = 'RF' then result := DKLangConstW('fMeds_Refill') //kt added 9/15/2007 // else if Abbreviation = 'HD' then result := 'Hold' <-- original line. //kt 9/15/2007 else if Abbreviation = 'HD' then result := DKLangConstW('fMeds_Hold') //kt added 9/15/2007 // else if Abbreviation = 'DL' then result := 'Deleted' <-- original line. //kt 9/15/2007 else if Abbreviation = 'DL' then result := DKLangConstW('fMeds_Deleted') //kt added 9/15/2007 else if Abbreviation = 'DC' then result := 'DC' else result := Abbreviation; end; end; function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string; var AnAction: string; Indent: integer; begin AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)]; result := AMed.Instruct; // replace pharmacy text with order text if this is a change if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3); //if AMed.IVFluid then Indent := Pos(#10 + 'in ', result) else Indent := Pos(#13, result); <-- original line. //kt 9/15/2007 if AMed.IVFluid then Indent := Pos(#10 + DKLangConstW('fMeds_in'), result) else Indent := Pos(#13, result); //kt added 9/15/2007 if Indent > 0 then begin if AMed.IVFluid then begin Detail := Copy(result, Indent + 1, Length(result)); result := Copy(result, 1, Indent - 1); end else begin Detail := Copy(result, Indent + 2, Length(result)); result := Copy(result, 1, Indent - 1); end; end; end; function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string; begin result := ''; Detail := ''; //if AMed.Status = 'Suspended' then AMed.Status := 'Active/Susp'; //HDS00007547 PSI-03-033 Interim Solution. <-- original line. //kt 9/15/2007 if AMed.Status = DKLangConstW('fMeds_Suspended') then AMed.Status := DKLangConstW('fMeds_ActivexSusp'); //HDS00007547 PSI-03-033 Interim Solution. //kt added 9/15/2007 case Column of 0: result := GetActionText(AMed); 1: result := GetInstructText(AMed, Detail); // 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate); <-- original line. //kt 9/15/2007 2: result := FormatFMDateTime(DKLangConstW('fMeds_mmxddxyy'), AMed.StopDate); //kt added 9/15/2007 3: result := AMed.Status; 4: begin if AMed.Inpatient then result := MixedCase(AMed.Location) else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill); end; 5: result := AMed.Refills; else end; end; function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string; var AMed: TMedListRec; AHeader: THeaderControl; i: integer; x, y: string; begin Result := ''; AMed := TMedListRec(GetMedList(Control)[Index]); AHeader := GetHeader(Control); for i := 0 to AHeader.Sections.Count-1 do begin x := GetListText(AMed, i, y); if (x <> '') or (y <> '') then Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF; end; Result := Trim(Result); end; function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl; begin case Control.Tag of TAG_OUTPT: result := hdrMedsOut; TAG_NONVA: result := hdrMedsNonVA; TAG_INPT: result := hdrMedsIn; else result := nil; end; end; function TFrmMeds.GetMedList(Control: TWinControl): TList; begin case Control.Tag of TAG_OUTPT: result := uMedListOut; TAG_NONVA: result := uMedListNonVA; TAG_INPT: result := uMedListIn; else result := nil; end; end; function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList; begin case Control.Tag of TAG_OUTPT: result := uPharmacyOrdersOut; TAG_NONVA: result := uNonVAOrdersOut; TAG_INPT: result := uPharmacyOrdersIn; else result := nil; end; end; procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); var NewHeight, RecRight: Integer; AMed: TMedListRec; AHeader: THeaderControl; AMedList: TList; ARect: TRect; x, y, AnAction: string; begin inherited; NewHeight := AHeight; AHeader := GetHeader(Control); AMedList := GetMedList(Control); with Control as TListBox do if Index < Items.Count then begin AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet if AMed <> nil then begin ARect := ItemRect(Index); ARect.Left := AHeader.Sections[0].Width + 2; ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6; AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)]; if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold]; x := GetInstructText( AMed, y); RecRight := ARect.Right; NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect); if(length(y)>0) then begin ARect.Left := AHeader.Sections[0].Width + FMT_INDENT; ARect.Right := RecRight; // Draw Text alters ARect. inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect)); end; if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM* if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM* end; {if AMed} end; {if Index} AHeight := NewHeight; end; procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var ReturnHt: Integer; x, y, AnAction: string; AMed: TMedListRec; AMedList: TList; AHeader: THeaderControl; ARect: TRect; i: integer; RectLeft: integer; begin inherited; AHeader := GetHeader(Control); AMedList := GetMedList(Control); ListGridDrawLines(TListBox(Control), AHeader, Index, State); with Control as TListBox do if Index < Items.Count then begin AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet if AMed <> nil then begin AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)]; if Length(AnAction) > 0 then begin Canvas.Font.Style := [fsBold]; //AGP Change 26.29 CQ #8188 Fix for highlighted new meds displaying blue font with a blue background. if odSelected in State then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; //Canvas.FillRect(ARect); Canvas.Font.Color := clWhite; end; if (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) and (Canvas.Font.Color <> clWhite) then Canvas.Font.Color := clBlue; if (Length(Piece(AnAction,'^',4)) > 0) then AMed.Location := Piece(AnAction,'^',4); end; RectLeft := 0; for i := 0 to AHeader.Sections.Count -1 do begin x := GetListText(AMed, i, y); if Length(y) > 0 then begin ARect := ItemRect(Index); ARect.Left := RectLeft + 2; ARect.Right := (ARect.Left + AHeader.Sections[i].Width - 6); //if ((ARect.Right - ARect.Left) < 100) then //ARect.Right := ARect.Right + (100 - (ARect.Left + AHeader.Sections[i].Width - 6)); ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); ARect.Left := RectLeft + FMT_INDENT; ARect.Top := ARect.Top + ReturnHt; DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); end else ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1); Inc(RectLeft, AHeader.Sections[i].Width); end; end; {if AMed} end; {if Index} end; procedure TfrmMeds.lstMedsExit(Sender: TObject); begin inherited; if not FIterating then ResetSelectedForList(TListBox(Sender)); end; procedure TfrmMeds.lstMedsDblClick(Sender: TObject); begin inherited; mnuViewDetailClick(Self); end; procedure TfrmMeds.lstMedsInClick(Sender: TObject); var i: integer; begin inherited; if PatientStatusChanged then exit; with lstMedsOut do for i := 0 to Items.Count -1 do Selected[i] := false; with lstMedsNonVA do for i := 0 to Items.Count - 1 do Selected[i] := FALSE; end; procedure TfrmMeds.lstMedsOutClick(Sender: TObject); var i: integer; begin inherited; if PatientStatusChanged then exit; with lstMedsIn do for i := 0 to Items.Count -1 do Selected[i] := false; with lstMedsNonVA do for i := 0 to Items.Count -1 do Selected[i] := false; end; procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; RedrawSuspend(Self.Handle); with lstMedsOut do begin IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the IntegralHeight := not IntegralHeight; // listbox window to be recreated end; RedrawActivate(Self.Handle); lstMedsOut.Invalidate; Refresh; end; procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; RedrawSuspend(Self.Handle); with lstMedsIn do begin IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the IntegralHeight := not IntegralHeight; // listbox window to be recreated end; RedrawActivate(Self.Handle); lstMedsIn.Invalidate; Refresh; end; { Action menu events ---------------------------------------------------------------------- } procedure TfrmMeds.mnuActClick(Sender: TObject); begin inherited; if PatientStatusChanged then exit; if lstMedsOut.SelCount > 0 then begin // mnuActTransfer.Caption := 'Transfer to Inpatient...'; <-- original line. //kt 9/15/2007 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_Inpatientxxx'); //kt added 9/15/2007 mnuActTransfer.Enabled := True; end else if lstMedsIn.SelCount > 0 then begin // mnuActTransfer.Caption := 'Transfer to Outpatient...'; <-- original line. //kt 9/15/2007 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_Outpatientxxx'); //kt added 9/15/2007 mnuActTransfer.Enabled := True; end else begin // mnuActTransfer.Caption := 'Transfer to...'; <-- original line. //kt 9/15/2007 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_toxxx'); //kt added 9/15/2007 mnuActTransfer.Enabled := False; end; end; procedure TfrmMeds.mnuActDCClick(Sender: TObject); { discontinue/cancel/delete the selected med orders as appropriate for each order } { similar to action on fOrders} var ActiveList: TListBox; SelectedList: TList; DelEvt: boolean; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; DelEvt := False; ActiveList := ListSelected(TX_NOSEL); if ActiveList = nil then Exit; SelectedList := TList.Create; try FIterating := True; if AuthorizedUser and EncounterPresent and LockedForOrdering then begin ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC); //ActivateDeactiveRenew(ActiveList); AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE MakeSelectedList(ActiveList, SelectedList); if ExecuteDCOrders(SelectedList,DelEvt) then begin ResetSelectedForList(ActiveList); SynchListToOrders(ActiveList, SelectedList); end; if DelEvt then frmFrame.mnuFileRefreshClick(Self); end; finally FIterating := False; SelectedList.Free; UnlockIfAble; end; end; procedure TfrmMeds.mnuActHoldClick(Sender: TObject); { hold the selected med orders as appropriate for each order } { similar to action on fOrders} var ActiveList: TListBox; SelectedList: TList; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; ActiveList := ListSelected(TX_NOSEL); if ActiveList = nil then Exit; SelectedList := TList.Create; if CheckMedStatus(ActiveList) = True then Exit; try FIterating := True; if AuthorizedUser and EncounterPresent and LockedForOrdering then begin ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD); MakeSelectedList(ActiveList, SelectedList); if ExecuteHoldOrders(SelectedList) then begin AddSelectedToChanges(SelectedList); ResetSelectedForList(ActiveList); SynchListToOrders(ActiveList, SelectedList); end; end; finally ActiveList.SetFocus; FIterating := False; SelectedList.Free; UnlockIfAble; end; end; procedure TfrmMeds.mnuActRenewClick(Sender: TObject); { renew the selected med orders as appropriate for each order } { similar to action on fOrders} var ActiveList: TListBox; SelectedList: TList; ParntOrder : TOrder; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; ActiveList := ListSelected(TX_NOSEL); if ActiveList = nil then Exit; SelectedList := TList.Create; try FIterating := True; if CheckMedStatus(ActiveList) = True then Exit; if AuthorizedUser and EncounterPresent and LockedForOrdering then begin ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW); MakeSelectedList(ActiveList, SelectedList); if Length(FParentComplexOrderID)>0 then begin ParntOrder := GetOrderByIFN(FParentComplexOrderID); if CharAt(ParntOrder.Text,1)='+' then ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text)); // if Pos('First Dose NOW',ParntOrder.Text)>1 then <-- original line. //kt 9/15/2007 if Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text)>1 then //kt added 9/15/2007 // Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW')); <-- original line. //kt 9/15/2007 Delete(ParntOrder.text, Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text), Length(DKLangConstW('fMeds_First_Dose_NOW'))); //kt added 9/15/2007 SelectedList.Add(ParntOrder); FParentComplexOrderID := ''; end; if ExecuteRenewOrders(SelectedList) then begin AddSelectedToChanges(SelectedList); ResetSelectedForList(ActiveList); SynchListToOrders(ActiveList, SelectedList); end; end; finally ActiveList.SetFocus; FIterating := False; SelectedList.Free; UnlockIfAble; end; end; procedure TfrmMeds.mnuActChangeClick(Sender: TObject); { loop thru selected med orders, present ordering dialog for each with defaults to selected order } { similar to action on fOrders} var i: Integer; ActiveList: TListBox; SelectedList: TList; ChangeIFNList: TStringList; DelayEvent: TOrderDelayEvent; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; if not EncounterPresentEDO then Exit; ActiveList := ListSelected(TX_NOSEL); if ActiveList = nil then Exit; DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders DelayEvent.Specialty := 0; DelayEvent.Effective := 0; DelayEvent.EventIFN := 0; SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly ChangeIFNList := TStringList.Create; try FIterating := true; if CheckMedStatus(ActiveList) = True then Exit; ValidateSelected(ActiveList, OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE); MakeSelectedList(Activelist, SelectedList); with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID); if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then ChangeOrders(ChangeIFNList, DelayEvent); SynchListToOrders(ActiveList, SelectedList); // rehighlights Activelist.SetFocus; finally SelectedList.Free; ChangeIFNList.Free; end; end; procedure TfrmMeds.mnuActCopyClick(Sender: TObject); { loop thru selected med orders, present ordering dialog for each with defaults to selected order } { similar to action on fOrders} //const //CP_TXT = 'copied'; <-- original line. //kt 9/15/2007 //XF_TXT = 'transfered'; <-- original line. //kt 9/15/2007 var i: Integer; LimitEvent: Char; ActiveList: TListBox; SelectedList: TList; CopyIFNList: TStringList; TempEvent,DelayEvent: TOrderDelayEvent; ActName, radTxt,thePtEvtID, AuthErr: string; IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean; CP_TXT : string; //kt XF_TXT : string; //kt begin SetupVars; //kt added 9/15/2007 to replace constants with vars. CP_TXT := DKLangConstW('fMeds_copied'); //kt added 9/15/2007 XF_TXT := DKLangConstW('fMeds_transfered'); //kt added 9/15/2007 inherited; AuthErr := ''; ActName := ''; if not EncounterPresentEDO then Exit; CheckAuthForMeds(AuthErr); if (Length(AuthErr)>0) then begin ShowMessage(AuthErr); if not EncounterPresent then Exit; end; if not FActionOnMedsTab then FActionOnMedsTab := True; DelayEvent.EventType := #0; DelayEvent.EventIFN := 0; DelayEvent.EventName := ''; DelayEvent.Specialty := 0; DelayEvent.Effective := 0; DelayEvent.PtEventIFN := 0; DelayEvent.TheParent := TParentEvent.Create; DelayEvent.IsNewEvent := False; TempEvent := DelayEvent; DoesDestEvtOccur := False; ActiveList := ListSelected(TX_NOSEL); if CheckMedStatus(ActiveList) = True then Exit; if ActiveList = nil then Exit; NewOrderCreated := False; if frmOrders.lstSheets.ItemIndex >= 0 then begin frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(Application); end; LimitEvent := #0; //if TComponent(Sender).Name = 'mnuActTransfer' then <-- original line. //kt 9/15/2007 if TComponent(Sender).Name = DKLangConstW('fMeds_mnuActTransfer') then //kt added 9/15/2007 begin // ActName := 'Transfer'; <-- original line. //kt 9/15/2007 ActName := DKLangConstW('fMeds_Transfer'); //kt added 9/15/2007 IsTransferAction := True; radTxt := XF_TXT; if ActiveList = lstMedsOut then begin if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A'; XferOutToInOnMeds := True; end; if ActiveList = lstMedsIn then begin if Patient.Inpatient then LimitEvent := 'D' else begin LimitEvent := 'C'; XfInToOutNow := True; end; XferOutToInOnMeds := False; end; end else radTxt := CP_TXT; SelectedList := TList.Create; // temporary until able to create CopyIFNList directly CopyIFNList := TStringList.Create; try MakeSelectedList(Activelist, SelectedList, ActName); // {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then <-- original line. //kt 9/15/2007 {if (CopyIFNList.Count = 0) and (ActName = DKLangConstW('fMeds_Transfer')) then //kt added 9/15/2007 Exit;} with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID); if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then begin IsNewEvent := False; if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then begin if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then XferOutToInOnMeds := True; TempEvent.PtEventIFN := DelayEvent.PtEventIFN; TempEvent.EventName := DelayEvent.EventName; if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then begin DelayEvent.EventType := 'C'; DelayEvent.PtEventIFN := 0; DelayEvent.EventName := ''; DelayEvent.EventIFN := 0; DelayEvent.TheParent := TParentEvent.Create; DoesDestEvtOccur := True; needVerify := false; CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify); if XferOutToInOnMeds then XferOutToInOnMeds := False; if frmOrders <> nil then frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName); Exit; end; if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then begin needVerify := False; uAutoAC := True; end else begin needVerify := True; uAutoAC := False; end; if LimitEvent = #0 then begin if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then NewOrderCreated := True; if ImmdCopyAct then ImmdCopyAct := False; end else begin if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then NewOrderCreated := True; end; if XferOutToInOnMeds then XferOutToInOnMeds := False; if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0); if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then begin if PtEvtEmpty(ThePtEvtID) then begin DeletePtEvent(ThePtEvtID); frmOrders.ChangesUpdate(ThePtEvtID); frmOrders.EventDefaultOrder := ''; frmOrders.InitOrderSheetsForEvtDelay; if frmOrders.lstSheets.ItemIndex <> 0 then frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(Self); end; end; end; end; SynchListToOrders(ActiveList, SelectedList); // rehighlights if IsTransferAction then IsTransferAction := False; if XferOuttoInOnMeds then XferOuttoInOnMeds := False; if XfInToOutNow then XfInToOutNow := False; frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True); finally ActiveList.SetFocus; FActionOnMedsTab := False; uAutoAC := False; SelectedList.Free; CopyIFNList.Free; end; end; procedure TfrmMeds.mnuActNewClick(Sender: TObject); { new med orders dependent on order dialog for inpatient or outpatient } { similar to lstWriteClick on fOrders} var DialogInfo: string; DelayEvent: TOrderDelayEvent; begin inherited; DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders DelayEvent.Specialty := 0; DelayEvent.EventIFN := 0; DelayEvent.Effective := 0; frmOrders.DontCheck := True; frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(self); frmOrders.DontCheck := False; if not ReadyForNewOrder(DelayEvent) then Exit; frmOrders.DontCheck := True; frmOrders.lstSheets.ItemIndex := 0; frmOrders.lstSheetsClick(self); frmOrders.DontCheck := False; { get appropriate form, create the dialog form and show it } DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup case CharAt(Piece(DialogInfo, ';', 4), 1) of 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0); 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0); 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0); 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0); //else InfoBox('Unsupported dialog type', 'Error', MB_OK); <-- original line. //kt 9/15/2007 else InfoBox(DKLangConstW('fMeds_Unsupported_dialog_type'), DKLangConstW('fMeds_Error'), MB_OK); //kt added 9/15/2007 end; {case} end; procedure TfrmMeds.mnuActRefillClick(Sender: TObject); { for selected orders, present refill dialog } var ActiveList: TListBox; SelectedList: TList; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. inherited; ActiveList := ListSelected(TX_NOSEL); if ActiveList = nil then Exit; SelectedList := TList.Create; if CheckMedStatus(ActiveList) = True then Exit; try FIterating := True; if AuthorizedUser and EncounterPresent and LockedForOrdering then begin ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL); MakeSelectedList(ActiveList, SelectedList); if ExecuteRefillOrders(SelectedList) then begin ResetSelectedForList(ActiveList); SynchListToOrders(ActiveList, SelectedList); end; end; finally ActiveList.SetFocus; FIterating := False; SelectedList.Free; UnlockIfAble; end; end; { Action utilities --------------------------------------------------------------------------- } function TfrmMeds.ListSelected(const ErrMsg: string): TListBox; { return selected listbox - inpatient or outpatient } begin SetupVars; //kt added 9/15/2007 to replace constants with vars. Result := nil; if lstMedsOut.SelCount > 0 then Result := lstMedsOut else if lstMedsIn.SelCount > 0 then Result := lstMedsIn else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA; if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK); end; procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string); { loop to validate action on each selected med order, deselect if not valid } var i: Integer; OrderText, CurID: string; ErrMsg, AParentID: string; CheckedList,SomePharmacyOrders: TStringList; ChildOrder: TChildOD; begin CheckedList := TStringList.Create; SomePharmacyOrders := GetPharmacyOrders(AListBox); with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then begin if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then begin Selected[i] := False; // MessageDlg('You cannot renew inpatient medication orders from a clinic location for selected patient.', mtWarning, [mbOK], 0); <-- original line. //kt 9/15/2007 MessageDlg(DKLangConstW('fMeds_You_cannot_renew_inpatient_medication_orders_from_a_clinic_location_for_selected_patientx'), mtWarning, [mbOK], 0); //kt added 9/15/2007 end; CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)]; if Length(CurID) > 0 then CurID := Piece(CurID, U, 2) else CurID := Piece(SomePharmacyOrders[i], U, 2); ValidateOrderAction(CurID, AnAction, ErrMsg); if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then begin InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; Continue; end; AParentID := ''; if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then Selected[i] := False; if Length(AParentID)>0 then begin if ChildODList.IndexOf(CurID)< 0 then begin ChildOrder := TChildOD.Create; ChildOrder.ChildID := CurId; ChildOrder.ParentID := AParentID; ChildODList.AddObject(CurID, ChildOrder); end; end; if Length(ErrMsg) > 0 then begin OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2)); InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; end; if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False; end; end; procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string); { make a list of selected med orders } var i,idx: Integer; AnOrder: TOrder; CurID,x: string; SomePharmacyOrders: TStringList; TempList: TStringList; begin SomePharmacyOrders := GetPharmacyOrders(AListBox); TempList := TStringList.Create; AList.Clear; with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then begin CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)]; if Length(CurID) > 0 then CurID := Piece(CurID, U, 2) else CurID := Piece(SomePharmacyOrders[i], U, 2); AnOrder := GetOrderByIFN(CurID); // if ActName = 'Transfer' then //imo <-- original line. //kt 9/15/2007 if ActName = DKLangConstW('fMeds_Transfer') then //imo //kt added 9/15/2007 begin if (AnOrder.DGroup = ClinDisp) then //imo begin // x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transfered'; <-- original line. //kt 9/15/2007 x := AnOrder.Text + #13#10 + DKLangConstW('fMeds_Clinic_medication_orders_can_not_be_transfered'); //kt added 9/15/2007 // if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then <-- original line. //kt 9/15/2007 if ShowMsgOn(Length(x) > 0, x, DKLangConstW('fMeds_Unable_to_transferx')) then //kt added 9/15/2007 begin AListBox.Selected[i] := False; Continue; end end; end; idx := ChildODList.IndexOf(AnOrder.ID); if idx > - 1 then AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID; if TempList.IndexOf(AnOrder.ID)= -1 then begin AList.Add(AnOrder); TempList.Add(AnOrder.ID); end; end; TempList.Clear; end; procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList); begin AListBox.Invalidate; end; procedure TfrmMeds.popMedPopup(Sender: TObject); begin inherited; if PatientStatusChanged then exit; end; procedure TfrmMeds.mnuViewClick(Sender: TObject); begin inherited; if PatientStatusChanged then exit; end; procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject); var i: integer; begin inherited; if PatientStatusChanged then exit; with lstMedsIn do for i := 0 to Items.Count -1 do Selected[i] := false; with lstMedsOut do for i := 0 to Items.Count -1 do Selected[i] := false; end; procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject); begin inherited; mnuViewDetailClick(Self); end; procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject); begin inherited; if not FIterating then ResetSelectedForList(TListBox(Sender)); end; procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; RedrawSuspend(Self.Handle); with lstMedsNonVA do begin IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the IntegralHeight := not IntegralHeight; // listbox window to be recreated end; RedrawActivate(Self.Handle); lstMedsNonVA.Invalidate; Refresh; end; function FontChanged : boolean; //CQ9182: SEE ALSO procedure TfrmFrame.mnuFontSizeClick() begin Result := false; if Assigned(frmMeds) then begin if fMeds.oldFont = 0 then Result := False else if (fMeds.oldFont <> MainFontSize) then Result := true; end; end; procedure TfrmMeds.FormResize(Sender: TObject); var maxPanelHeight: integer; begin inherited; if Assigned(frmMeds) then begin //CQ9522 v26.51 Make sure all three panels are visible regardless of font size if Assigned(self.Parent) then begin if self.Height > parent.ClientHeight then self.Height := parent.ClientHeight; maxPanelHeight := round((parent.ClientHeight-20)/3); if pnlTop.Height + pnlBottom.Height > parent.ClientHeight then begin pnlBottom.Height := maxPanelHeight*2; pnlTop.Height := maxPanelHeight; end; end; //assigned(self.parent) end; end; { TChildOD } constructor TChildOD.Create; begin ChildID := ''; ParentID := ''; end; procedure TfrmMeds.hdrMedsOutResize(Sender: TObject); begin inherited; with hdrMedsOut do begin Height := TextHeightByFont(Font.Handle, Sections[0].Text); Invalidate; end; end; procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject); begin inherited; with hdrMedsNonVA do begin Height := TextHeightByFont(Font.Handle, Sections[0].Text); Invalidate; end; end; procedure TfrmMeds.hdrMedsInResize(Sender: TObject); begin inherited; with hdrMedsIn do begin Height := TextHeightByFont(Font.Handle, Sections[0].Text); Invalidate; end; end; procedure TfrmMeds.FormShow(Sender: TObject); begin inherited; frmMeds.FormResize(Sender); end; procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; frmMeds.FormResize(Sender); end; procedure TfrmMeds.splitBottomMoved(Sender: TObject); begin inherited; splitBottom.Height := 5; end; procedure TfrmMeds.splitTopMoved(Sender: TObject); begin inherited; splitTop.Height := 5; end; procedure TfrmMeds.InitfMedsSize; var retList : TStringList; strSizeFlds,x: string; i: integer; medsSplitFnd : boolean; panelBottom, panelMedIn : integer; begin SetupVars; //kt added 9/15/2007 to replace constants with vars. //CQ3229 //DETECT 1st TIME USER. //If first time user (medSplitFound=false), then manually set panel heights. //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings. medsSplitFnd := FALSE; if Assigned(frmMeds) then begin retList := TStringList.Create; tCallV(retList, 'ORWCH LOADALL', [nil]); for i := 0 to retList.Count-1 do begin x := retList.strings[i]; if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then begin medsSplitFnd := TRUE; Break; end; end; if not medsSplitFnd then begin pnlBottom.Height := frmMeds.Height div 2; pnlMedIn.Height := pnlBottom.Height div 2; panelBottom := pnlBottom.Height; panelMedIn := pnlMedIn.Height; strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0'; CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]); end; end; end; function TfrmMeds.PatientStatusChanged: boolean; //const //msgTxt1 = 'Patient status was changed from '; <-- original line. //kt 9/15/2007 //msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.'; <-- original line. //kt 9/15/2007 //GE CQ9537 - Change message text //msgTxt3 = 'Patient has been admitted.'; <-- original line. //kt 9/15/2007 //msgTxt4 = CRLF +'You will be prompted to sign your orders. Any new orders subsequently' + <-- original line. //kt 9/15/2007 // CRLF + 'entered and signed will be directed to the inpatient staff.'; <-- original line. //kt 9/15/2007 var PtSelect: TPtSelect; IsInpatientNow: boolean; ptSts: string; msgTxt1 : string; //kt msgTxt2 : string; //kt msgTxt3 : string; //kt msgTxt4 : string; //kt begin msgTxt1 := DKLangConstW('fMeds_Patient_status_was_changed_from'); //kt added 9/15/2007 msgTxt2 := DKLangConstW('fMeds_CPRS_needs_to_refresh_patient_information_to_display_patient_latest_recordx'); //kt added 9/15/2007 //GE CQ9537 - Change message text msgTxt3 := DKLangConstW('fMeds_Patient_has_been_admittedx'); //kt added 9/15/2007 msgTxt4 := CRLF +DKLangConstW('fMeds_You_will_be_prompted_to_sign_your_ordersx__Any_new_orders_subsequently') + //kt added 9/15/2007 CRLF + DKLangConstW('fMeds_entered_and_signed_will_be_directed_to_the_inpatient_staffx'); //kt added 9/15/2007 result := False; SelectPatient(Patient.DFN, PtSelect); IsInpatientNow := Length(PtSelect.Location) > 0; //GE CQ9537 - Change message text if Patient.Inpatient <> IsInpatientNow then begin if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0); // if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.'; <-- original line. //kt 9/15/2007 if Patient.Inpatient then ptSts := DKLangConstW('fMeds_Inpatient_to_Outpatientx'); //kt added 9/15/2007 MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0); frmFrame.mnuFileRefreshClick(Application); Result := True; end; end; function TfrmMeds.GetTotalSectionsWidth(Sender: TObject) : integer; //CQ7586 //Return stored values of column widths var i: integer; begin Result := 0; if (Sender as THeaderControl).Name = 'hdrMedsOut' then for i := 0 to hdrMedsOut.Sections.Count - 1 do Result := Result + hdrMedsOut.Sections[i].Width; if (Sender as THeaderControl).Name = 'hdrMedsIn' then for i := 0 to hdrMedsIn.Sections.Count - 1 do Result := Result + hdrMedsIn.Sections[i].Width; if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then for i := 0 to hdrMedsNonVA.Sections.Count - 1 do Result := Result + hdrMedsNonVA.Sections[i].Width; end; procedure TfrmMeds.SetSectionWidths(Sender: TObject); //CQ7586 //Copy values of column widths into array variables. var i: integer; begin if (Sender as THeaderControl).Name = 'hdrMedsOut' then for i := 0 to hdrMedsOut.Sections.Count - 1 do OrigOutPtSecWidths[i] := hdrMedsOut.Sections[i].Width; if (Sender as THeaderControl).Name = 'hdrMedsIn' then for i := 0 to hdrMedsIn.Sections.Count - 1 do OrigInPtSecWidths[i] := hdrMedsIn.Sections[i].Width; if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then for i := 0 to hdrMedsNonVA.Sections.Count - 1 do OrigNonVASecWidths[i] := hdrMedsNonVA.Sections[i].Width; end; procedure TfrmMeds.hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Self.SetSectionWidths(Sender); //CQ7586 end; procedure TfrmMeds.hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Self.SetSectionWidths(Sender); //CQ7586 end; procedure TfrmMeds.hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; Self.SetSectionWidths(Sender); //CQ7586 end; procedure TfrmMeds.hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //CQ7586 var i: integer; totalSectionsWidth, originalwidth: integer; begin inherited; totalSectionsWidth := Self.GetTotalSectionsWidth(Sender); if totalSectionsWidth > lstMedsOut.Width - 5 then //could used any of the three list boxes here, since all are same width begin originalwidth := 0; for i := 0 to hdrMedsOut.Sections.Count - 1 do originalwidth := originalwidth + OrigOutPtSecWidths[i]; if originalwidth < totalSectionsWidth then begin for i := 0 to hdrMedsOut.Sections.Count - 1 do hdrMedsOut.Sections[i].Width := OrigOutPtSecWidths[i]; lstMedsOut.Invalidate; end; end; //CQ9622 if hdrMedsOut.Sections[1].Width < 100 then begin hdrMedsOut.Sections[1].Width := 100; lstMedsOut.Refresh; end; //end CQ9622 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize end; procedure TfrmMeds.hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //CQ7586 var i: integer; totalSectionsWidth, originalwidth: integer; begin inherited; totalSectionsWidth := Self.GetTotalSectionsWidth(Sender); if totalSectionsWidth > lstMedsNonVA.Width - 5 then //could used any of the three list boxes here, since all are same width begin originalwidth := 0; for i := 0 to hdrMedsNonVA.Sections.Count - 1 do originalwidth := originalwidth + OrigNonVASecWidths[i]; if originalwidth < totalSectionsWidth then begin for i := 0 to hdrMedsNonVA.Sections.Count - 1 do hdrMedsNonVA.Sections[i].Width := OrigNonVASecWidths[i]; lstMedsNonVA.Invalidate; end; end; //CQ9622 if hdrMedsNonVA.Sections[1].Width < 100 then begin hdrMedsNonVA.Sections[1].Width := 100; lstMedsNonVA.Refresh; end; //end CQ9622 pnlNonVA.Height := pnlNonVA.Height - 1; // forces autopanel resize pnlNonVA.Height := pnlNonVA.Height + 1; // forces autopanel resize end; procedure TfrmMeds.hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //CQ7586 var i: integer; totalSectionsWidth, originalwidth: integer; begin inherited; totalSectionsWidth := Self.GetTotalSectionsWidth(Sender); if totalSectionsWidth > lstMedsIn.Width - 5 then //could used any of the three list boxes here, since all are same width begin originalwidth := 0; for i := 0 to hdrMedsIn.Sections.Count - 1 do originalwidth := originalwidth + OrigInPtSecWidths[i]; if originalwidth < totalSectionsWidth then begin for i := 0 to hdrMedsIn.Sections.Count - 1 do hdrMedsIn.Sections[i].Width := OrigInPtSecWidths[i]; lstMedsIn.Invalidate; end; end; //CQ9622 if hdrMedsIn.Sections[1].Width < 100 then begin hdrMedsIn.Sections[1].Width := 100; lstMedsIn.Refresh; end; //end CQ9622 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize end; procedure TfrmMeds.ClearChildODList; var i: integer; begin for i := 0 to ChildODList.count-1 do if(assigned(ChildODList.Objects[i])) then ChildODList.Objects[i].Free; ChildODList.Clear; end; function TfrmMeds.CheckMedStatus(ActiveList: TListBox): boolean; var i: integer; tmpList: TStringList; Str: string; AMed: TMedListRec; AMedList: TList; begin result := False; tmpList:= TStringList.Create; if TMedListRec = nil then exit; AMedList := GetMedList(ActiveList); for i := 0 to ActiveList.Count - 1 do if ActiveList.Selected[i] then begin AMed := TMedListRec(AMedList[i]); str := Amed.PharmID + U + AMed.Status; tmpList.Add(Str); end; if tmpList <> nil then begin Result := GetMedStatus(tmpList); tmpList.Free; end; if Result = True then begin // MessageDlg('The Medication status has change.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct medication status', mtWarning, [mbOK], 0); <-- original line. //kt 9/15/2007 MessageDlg(DKLangConstW('fMeds_The_Medication_status_has_changex') + #13#10#13 + DKLangConstW('fMeds_CPRS_needs_to_refresh_patient_information_to_display_the_correct_medication_status'), mtWarning, [mbOK], 0); //kt added 9/15/2007 frmFrame.mnuFileRefreshClick(Application); end; end; (*procedure TfrmMeds.ActivateDeactiveRenew(AListBox: TListBox); var i: Integer; CurID: string; SomePharmacyOrders: TStringList; tmpArr: TStringList; begin tmpArr := TStringList.Create; SomePharmacyOrders := GetPharmacyOrders(AListBox); with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then begin CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)]; if Length(CurID) > 0 then CurID := Piece(CurID, U, 2) else CurID := Piece(SomePharmacyOrders[i], U, 2); tmpArr.Add(curID); end; if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr, AListBox); end; *) procedure TfrmMeds.ViewInfo(Sender: TObject); begin inherited; frmFrame.ViewInfo(Sender); end; procedure TfrmMeds.mnuViewInformationClick(Sender: TObject); begin inherited; mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled; mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled; mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled; mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No'); mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No'); mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled; mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled; mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled; mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled; end; procedure TfrmMeds.mnuOptimizeFieldsClick(Sender: TObject); var totalSectionsWidth, unit1, unit2, unit8: integer; begin totalSectionsWidth := pnlTop.Width - 5; if totalSectionsWidth < 16 then exit; unit1 := (totalSectionsWidth div 16) - 1; unit2 := unit1 * 2; unit8 := unit1 * 8; with hdrMedsNonVA do begin Sections[0].Width := unit1; Sections[1].Width := unit8; Sections[2].Width := unit2; Sections[3].Width := unit2; end; hdrMedsNonVASectionResize(hdrMedsNonVA, hdrMedsNonVA.Sections[0]); hdrMedsNonVA.Repaint; with hdrMedsIn do begin Sections[0].Width := unit1; Sections[1].Width := unit8; Sections[2].Width := unit2; Sections[3].Width := unit2; Sections[4].Width := unit2; end; hdrMedsInSectionResize(hdrMedsIn, hdrMedsIn.Sections[0]); hdrMedsIn.Repaint; with hdrMedsOut do begin Sections[0].Width := unit1; Sections[1].Width := unit8; Sections[2].Width := unit2; Sections[3].Width := unit2; Sections[4].Width := unit2; Sections[5].Width := unit1; end; hdrMedsOutSectionResize(hdrMedsOut, hdrMedsOut.Sections[0]); hdrMedsOut.Repaint; end; procedure TfrmMeds.hdrMedsOutSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; //if Section = hdrMedsOut.Sections[1] then mnuOptimizeFieldsClick(self); end; procedure TfrmMeds.hdrMedsNonVASectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; //if Section = hdrMedsNonVA.Sections[1] then mnuOptimizeFieldsClick(self); end; procedure TfrmMeds.hdrMedsInSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; //if Section = hdrMedsIn.Sections[1] then mnuOptimizeFieldsClick(self); end; end.