unit fODMeds; {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm, Menus, XUDIGSIGSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs; const UM_DELAYCLICK = 11037; // temporary for listview click event type TfrmODMeds = class(TfrmODBase) txtMed: TEdit; pnlMeds: TPanel; btnSelect: TButton; pnlFields: TPanel; lstQuick: TCaptionListView; sptSelect: TSplitter; lstAll: TCaptionListView; dlgStart: TORDateTimeDlg; cboXDosage: TORComboBox; cboXRoute: TORComboBox; pnlXDuration: TPanel; timCheckChanges: TTimer; popDuration: TPopupMenu; popDays: TMenuItem; popBlank: TMenuItem; hours1: TMenuItem; minutes1: TMenuItem; months1: TMenuItem; weeks1: TMenuItem; pnlXSchedule: TPanel; cboXSchedule: TORComboBox; chkXPRN: TCheckBox; txtXDuration: TCaptionEdit; spnXDuration: TUpDown; pnlXDurationButton: TKeyClickPanel; btnXDuration: TSpeedButton; pnlTop: TPanel; lblRoute: TLabel; lblSchedule: TLabel; grdDoses: TCaptionStringGrid; lblGuideline: TStaticText; tabDose: TTabControl; cboDosage: TORComboBox; cboRoute: TORComboBox; cboSchedule: TORComboBox; chkPRN: TCheckBox; btnXInsert: TButton; btnXRemove: TButton; pnlBottom: TPanel; lblComment: TLabel; lblDays: TLabel; lblQuantity: TLabel; lblRefills: TLabel; lblPriority: TLabel; chkDoseNow: TCheckBox; memComment: TCaptionMemo; lblQtyMsg: TStaticText; txtSupply: TCaptionEdit; spnSupply: TUpDown; txtQuantity: TCaptionEdit; spnQuantity: TUpDown; txtRefills: TCaptionEdit; spnRefills: TUpDown; grpPickup: TGroupBox; radPickWindow: TRadioButton; radPickMail: TRadioButton; radPickClinic: TRadioButton; cboPriority: TORComboBox; stcPI: TStaticText; chkPtInstruct: TCheckBox; memPI: TMemo; Image1: TImage; memDrugMsg: TMemo; txtNSS: TLabel; pnlXAdminTime: TPanel; cboXSequence: TORComboBox; lblAdminSch: TMemo; lblAdminTime: TVA508StaticText; procedure FormCreate(Sender: TObject); procedure btnSelectClick(Sender: TObject); procedure tabDoseChange(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure txtMedKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure txtMedKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure txtMedChange(Sender: TObject); procedure txtMedExit(Sender: TObject); procedure ListViewEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); procedure ListViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ListViewResize(Sender: TObject); procedure lstQuickData(Sender: TObject; Item: TListItem); procedure lstQuickDataHint(Sender: TObject; StartIndex, EndIndex: Integer); procedure lstAllDataHint(Sender: TObject; StartIndex, EndIndex: Integer); procedure lstAllData(Sender: TObject; Item: TListItem); procedure lblGuidelineClick(Sender: TObject); procedure ListViewClick(Sender: TObject); procedure cboScheduleChange(Sender: TObject); procedure cboRouteChange(Sender: TObject); procedure ControlChange(Sender: TObject); procedure cboDosageClick(Sender: TObject); procedure cboDosageChange(Sender: TObject); procedure cboScheduleClick(Sender: TObject); procedure txtSupplyChange(Sender: TObject); procedure txtQuantityChange(Sender: TObject); procedure cboRouteExit(Sender: TObject); procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure grdDosesKeyPress(Sender: TObject; var Key: Char); procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure cboXDosageClick(Sender: TObject); procedure cboXDosageExit(Sender: TObject); procedure cboXRouteClick(Sender: TObject); procedure cboXRouteExit(Sender: TObject); procedure cboXScheduleClick(Sender: TObject); procedure pnlXDurationEnter(Sender: TObject); procedure pnlXDurationExit(Sender: TObject); procedure txtXDurationChange(Sender: TObject); procedure cboXDosageEnter(Sender: TObject); procedure cboXDosageChange(Sender: TObject); procedure cboXRouteChange(Sender: TObject); procedure cboXScheduleChange(Sender: TObject); procedure grdDosesExit(Sender: TObject); procedure ListViewEnter(Sender: TObject); procedure timCheckChangesTimer(Sender: TObject); procedure popDurationClick(Sender: TObject); procedure cmdAcceptClick(Sender: TObject); procedure btnXInsertClick(Sender: TObject); procedure btnXRemoveClick(Sender: TObject); procedure pnlXScheduleEnter(Sender: TObject); procedure pnlXScheduleExit(Sender: TObject); procedure chkPtInstructClick(Sender: TObject); procedure pnlFieldsResize(Sender: TObject); procedure chkDoseNowClick(Sender: TObject); procedure cboDosageExit(Sender: TObject); procedure chkXPRNClick(Sender: TObject); procedure memCommentClick(Sender: TObject); procedure btnXDurationClick(Sender: TObject); procedure chkPRNClick(Sender: TObject); procedure grdDosesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure grdDosesEnter(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure cboXRouteEnter(Sender: TObject); procedure pnlMessageEnter(Sender: TObject); procedure pnlMessageExit(Sender: TObject); procedure memMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure memPIClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure memPIKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure txtNSSClick(Sender: TObject); procedure cboScheduleEnter(Sender: TObject); procedure FormShow(Sender: TObject); procedure cboScheduleExit(Sender: TObject); procedure cboXScheduleExit(Sender: TObject); procedure cboDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure cboXDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure txtSupplyClick(Sender: TObject); procedure txtQuantityClick(Sender: TObject); procedure txtRefillsClick(Sender: TObject); procedure WMClose(var Msg : TWMClose); message WM_CLOSE; procedure cboXScheduleEnter(Sender: TObject); procedure pnlXAdminTimeClick(Sender: TObject); procedure cboXSequenceChange(Sender: TObject); procedure cboXSequence1Exit(Sender: TObject); procedure cboXSequenceExit(Sender: TObject); procedure cboXSequenceEnter(Sender: TObject); procedure txtRefillsChange(Sender: TObject); //procedure btnNSSClick(Sender: TObject); private FCloseCalled : Boolean; FScheduleChanged : Boolean; {selection} FMedCache: TObjectList; FCacheIEN: Integer; FQuickList: Integer; FQuickItems: TStringList; FChangePending: Boolean; FKeyTimerActive: Boolean; FActiveMedList: TListView; FRowHeight: Integer; FFromSelf: Boolean; {edit} FAllDoses: TStringList; FAllDrugs: TStringList; FGuideline: TStringList; FLastUnits: string; FLastSchedule: string; FLastDuration: string; FLastInstruct: string; FLastDispDrug: string; FLastQuantity: Double; FLastSupply: Integer; FLastPickup: string; FSIGVerb: string; FSIGPrep: string; FDropColumn: Integer; FDrugID: string; FInptDlg: Boolean; FUpdated: Boolean; FSuppressMsg: Boolean; FPtInstruct: string; FAltChecked: Boolean; FOutptIV: Boolean; FQOQuantity: Double; FQODosage: string; FNoZERO: boolean; FIsQuickOrder: boolean; FDisabledDefaultButton: TButton; FDisabledCancelButton: TButton; FShrinked: boolean; FShrinkDrugMsg: boolean; FResizedAlready: boolean; FQOInitial: boolean; FOrigiMsgDisp: boolean; FNSSOther: boolean; {selection} FShowPnlXScheduleOk : boolean; FRemoveText : Boolean; FSmplPRNChkd: Boolean; {Admin Time} FAdminTimeLbl: string; FMedName: String; FNSSAdminTime: string; FNSSScheduleType: string; FAdminTimeText: string; //FOriginalAdminTime: string; //FOriginalScheduleIndex: integer; FOrderAction: integer; JAWSON: boolean; procedure ChangeDelayed; function FindQuickOrder(const x: string): Integer; function isUniqueQuickOrder(iText: string): Boolean; function GetCacheChunkIndex(idx: integer): integer; procedure LoadMedCache(First, Last: Integer); procedure ScrollToVisible(AListView: TListView); procedure StartKeyTimer; procedure StopKeyTimer; procedure WMTimer(var Message: TWMTimer); message WM_TIMER; {edit} procedure ResetOnMedChange; procedure ResetOnTabChange; procedure SetControlsInpatient; procedure SetControlsOutpatient; procedure SetOnMedSelect; procedure SetOnQuickOrder; procedure SetVisibleCommentRows( Rows: integer ); procedure ShowMedSelect; procedure ShowMedFields; procedure ShowControlsSimple; procedure ShowControlsComplex; procedure SetDosage(const x: string); procedure SetPickup(const x: string); procedure SetSchedule(const x: string); procedure CheckFormAltDose(DispDrug: Integer); function DurationToDays: Integer; function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string; function FieldsForDose(ARow: Integer): string; function FieldsForDrug(const DrugID: string): string; function FindCommonDrug(DoseList: TStringList): string; function FindDoseFields(const Drug, ADose: string): string; function InpatientSig: string; function OutpatientSig: string; procedure UpdateRelated(DelayUpdate: Boolean = TRUE); procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer); procedure UpdateStartExpires(const CurSchedule: string); procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean); procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; var CurSupply: Integer; var CurQuantity: double); procedure UpdateDurationControls( FreeText: boolean); function DisableDefaultButton(Control: TWinControl): boolean; function DisableCancelButton(Control: TWinControl): boolean; procedure RestoreDefaultButton; procedure RestoreCancelButton; function ValueOf(FieldID: Integer; ARow: Integer = -1): string; function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string; function ValFor(FieldID, ARow: Integer): string; function TextDosage(ADosage: string): string; //NSS function CreateOtherScheduel: string; function CreateOtherScheduelComplex: string; procedure ShowEditor(ACol, ARow: Integer; AChar: Char); procedure DropLastSequence(ASign: integer = 0); procedure DispOrderMessage(const AMessage: string); procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK; procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT; procedure UMShowNSSBuilder(var Message: TMessage); message UM_NSSOTHER; function IfIsIMODialog: boolean; procedure ValidateInpatientSchedule(ScheduleCombo: TORComboBox); // function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518 function IsSupplyAndOutPatient : boolean; function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer; procedure DisplayDoseNow(Status: boolean); function lblAdminSchGetText: string; procedure lblAdminSchSetText(str: string); protected procedure Loaded; override; procedure InitDialog; override; procedure Validate(var AnErrMsg: string); override; procedure updateSig; override; public ARow1: integer; procedure SetupDialog(OrderAction: Integer; const ID: string); override; procedure CheckDecimal(var AStr: string); property MedName: string read FMedName write FMedName; property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime; property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType; end; var frmODMeds: TfrmODMeds; crypto: IXuDigSigS; implementation {$R *.DFM} uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA, uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter; const {grid columns for complex dosing} COL_SELECT = 0; COL_DOSAGE = 1; COL_ROUTE = 2; COL_SCHEDULE = 3; COL_DURATION = 4; COL_ADMINTIME = 5; COL_SEQUENCE = 6; COL_CHKXPRN = 7; VAL_DOSAGE = 10; VAL_ROUTE = 20; VAL_SCHEDULE = 30; VAL_DURATION = 40; VAL_ADMINTIME = 50; VAL_SEQUENCE = 60; VAL_CHKXPRN = 70; TAB = #9; {field identifiers} FLD_LOCALDOSE = 1; FLD_STRENGTH = 2; FLD_DRUG_ID = 3; FLD_DRUG_NM = 4; FLD_DOSEFLDS = 5; FLD_UNITNOUN = 6; FLD_TOTALDOSE = 7; FLD_DOSETEXT = 8; FLD_INSTRUCT = 10; FLD_DOSEUNIT = 11; FLD_ROUTE_ID = 15; FLD_ROUTE_NM = 16; FLD_ROUTE_AB = 17; FLD_ROUTE_EX = 18; FLD_SCHEDULE = 20; FLD_SCHED_EX = 21; FLD_SCHED_TYP = 22; FLD_DURATION = 30; FLD_SEQUENCE = 31; FLD_MISC_FLDS = 50; FLD_SUPPLY = 51; FLD_QUANTITY = 52; FLD_REFILLS = 53; FLD_PICKUP = 55; FLD_QTYDISP = 56; FLD_SC = 58; FLD_PRIOR_ID = 60; FLD_PRIOR_NM = 61; FLD_START_ID = 70; FLD_START_NM = 71; FLD_EXPIRE = 72; FLD_ANDTHEN = 73; FLD_NOW_ID = 75; FLD_NOW_NM = 76; FLD_COMMENT = 80; FLD_PTINSTR = 85; {dosage type tab index values} TI_DOSE = 0; TI_RATE = 99; TI_COMPLEX = 1; {misc constants} TIMER_ID = 6902; // arbitrary number TIMER_DELAY = 500; // 500 millisecond delay TIMER_FROM_DAYS = 1; TIMER_FROM_QTY = 2; MED_CACHE_CHUNK_SIZE = 100; {text constants} TX_ADMIN = 'Requested Start: '; TX_TAKE = ''; TX_NO_DEA = 'Provider must have a DEA# or VA# to order this medication'; TC_NO_DEA = 'DEA# Required'; TX_NO_MED = 'Medication must be selected.'; TX_NO_SEQ = 'Missing one or more conjunction.'; TX_NO_DOSE = 'Dosage must be entered.'; TX_DOSE_NUM = 'Dosage may not be numeric only'; TX_DOSE_LEN = 'Dosage may not exceed 60 characters'; TX_NO_ROUTE = 'Route must be entered.'; TX_NF_ROUTE = 'Route not found in the Medication Routes file.'; TX_NO_SCHED = 'Schedule must be entered.'; TX_NO_PICK = 'A method for picking up the medication must be entered.'; TX_RNG_REFILL = 'The number of refills must be in the range of 0 through '; TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.'; TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.'; TX_SCH_SPACE = 'Schedule must have only one space in it.'; TX_SCH_LEN = 'Schedule must be less than 70 characters.'; TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.'; TX_SCH_ZERO = 'Schedule cannot be Q0'; TX_SCH_LSP = 'Schedule may not have leading spaces.'; TX_SCH_NS = 'Unable to resolve non-standard schedule.'; TX_MAX_STOP = 'The maximum expiration for this order is '; TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.'; TX_QTY_NV = 'Unable to validate quantity.'; TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.'; TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.'; TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.'; TX_SUPPLY_NINT= 'Days Supply is an invalid number.'; TC_RESTRICT = 'Ordering Restrictions'; TC_GUIDELINE = 'Restrictions/Guidelines'; TX_QTY_PRE = '>> Quantity Dispensed: '; TX_QTY_POST = ' <<'; { procedures inherited from fODBase --------------------------------------------------------- } procedure TfrmODMeds.FormCreate(Sender: TObject); var ListCount: Integer; x: string; begin frmFrame.pnlVisit.Enabled := false; AutoSizeDisabled := True; inherited; FAdminTimeText := ''; btnXDuration.Align := alClient; AllowQuickOrder := True; FSmplPRNChkd := False; // GE CQ7585 CheckAuthForMeds(x); if Length(x) > 0 then begin InfoBox(x, TC_RESTRICT, MB_OK); Close; Exit; end; if DlgFormID = OD_MEDINPT then FInptDlg := TRUE; if DlgFormID = OD_MEDOUTPT then FInptDlg := FALSE; if DlgFormID = OD_MEDNONVA then FInptDlg := FALSE; if DlgFormID = OD_MEDS then FInptDlg := OrderForInpatient; if XfInToOutNow then FInptDlg := False; if XferOuttoInOnMeds then FInptDlg := True; if ImmdCopyAct and isUDGroup and (Patient.Inpatient) then FInptDlg := True; if ImmdcopyAct and (not isUDGroup) then FInptDlg := False; if FInptDlg then FillerID := 'PSI' else FillerID := 'PSO'; FGuideline := TStringList.Create; FAllDoses := TStringList.Create; FAllDrugs := TStringList.Create; StatusText('Loading Dialog Definition'); if DlgFormID = OD_MEDINPT then Responses.Dialog := 'PSJ OR PAT OE' else if DlgFormID = OD_MEDOUTPT then Responses.Dialog := 'PSO OERR' else if DlgFormID = OD_MEDNONVA then Responses.Dialog := 'PSH OERR' else Responses.Dialog := 'PS MEDS'; // loads formatting info {if not FInptDlg then } Responses.SetPromptFormat('INSTR', '@'); StatusText('Loading Schedules'); //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items) //else LoadSchedules(cboSchedule.Items, FInptDlg); LoadSchedules(cboSchedule.Items, FInptDlg); StatusText(''); if FInptDlg then SetControlsInpatient else SetControlsOutpatient; CtrlInits.SetControl(cboPriority, 'Priority'); FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1'; FOrigiMsgDisp := FSuppressMsg; InitDialog; isIMO := IfisIMODialog; if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then FAdminTimeText := 'Not defined for Clinic Locations'; if FInptDlg then begin txtNss.Visible := True; //cboSchedule.ListItemsOnly := True; //cboXSchedule.ListItemsOnly := True; end; with grdDoses do begin ColWidths[0] := 8; // select ColWidths[1] := 160; // dosage ColWidths[2] := 82; // route ColWidths[3] := 102; // schedule ColWidths[4] := 70; // duration if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then begin ColWidths[5] := 102; // administration times ColWidths[6] := 58; // and/then end else ColWidths[5] := 0; ColWidths[6] := 58; Cells[1, 0] := 'Dosage'; Cells[2, 0] := 'Route'; Cells[3, 0] := 'Schedule'; Cells[4, 0] := 'Duration (optional)'; Cells[5, 0] := 'Admin. Times'; Cells[6, 0] := 'then/and'; end; // medication selection FRowHeight := MainFontHeight + 1; //IsIMO := IfIsIMODialog; //IMO if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order. if FInptDlg then x := 'UD RX' else if (not FInptDlg) and (DlgFormID = OD_MEDNONVA) then x := 'NV RX' else x := 'O RX'; if FInptDlg and (not OrderForInpatient) and (not IsIMO) then //IMO begin FOutptIV := TRUE; x := 'IVM RX'; end; if self.EvtID > 0 then FAdminTimeText := 'To Be Determined'; ListForOrderable(FCacheIEN, ListCount, x); lstAll.Items.Count := ListCount; FMedCache := TObjectList.Create; FQuickItems := TStringList.Create; ListForQuickOrders(FQuickList, ListCount, x); if ListCount > 0 then begin lstQuick.Items.Count := ListCount; SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0); FActiveMedList := lstQuick; end else begin lstQuick.Items.Count := 1; ListCount := 1; FQuickItems.Add('0^(No quick orders available)'); FActiveMedList := lstAll; end; // set the height based on user parameter here with lstQuick do if ListCount < VisibleRowCount then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6; pnlFields.Height := memOrder.Top - 4 - pnlFields.Top; FNoZero := False; FShrinked := False; FShrinkDrugMsg := False; FResizedAlready := False; FShowPnlXScheduleOk := True; FRemoveText := True; JAWSON := True; if ScreenReaderActive = false then begin lblAdminTime.TabStop := false; lblAdminSch.TabStop := false; memOrder.TabStop := false; JAWSON := false; end; end; procedure TfrmODMeds.FormDestroy(Sender: TObject); begin {selection} FQuickItems.Free; FMedCache.Free; {edit} FGuideline.Free; FAllDoses.Free; FAllDrugs.Free; frmFrame.pnlVisit.Enabled := true; inherited; end; procedure TfrmODMeds.InitDialog; { Executed each time dialog is reset after pressing accept. Clears controls & responses } begin inherited; FLastPickup := ValueOf(FLD_PICKUP); Changing := True; ResetOnMedChange; txtMed.Text := ''; txtMed.Tag := 0; lstQuick.Selected := nil; lstAll.Selected := nil; if Visible then ShowMedSelect; Changing := False; FIsQuickOrder := False; FQOQuantity := 0 ; FQODosage := ''; FQOInitial := False; FNSSOther := False; end; procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string); var AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string; ix: integer; LocChange: boolean; AResponse: TResponse; begin inherited; FOrderAction := OrderAction; if self.EvtID > 0 then DisplayDoseNow(false); if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX'); if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then begin OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID)); CheckExistingPI(OrderID, FPtInstruct); end; //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true //this is not the best approach but this should fix the problem with order edit losing the quantity value. if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then begin FIsQuickOrder := True; FQOInitial := True; end else begin FIsQuickOrder := False; FQOInitial := False; end; if lblDays.Visible then SetVisibleCommentRows(2) else SetVisibleCommentRows(4); if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1); if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then begin Changing := True; txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0); if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit; if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and ((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit; (* if (OrderAction = ORDER_QUICK) then begin tempAltIEN := GetQOAltOI; if tempAltIEN > 0 then txtMed.Tag := tempAltIEN; end; *) SetOnMedSelect; // set up for this medication SetOnQuickOrder; // insert quick order responses ShowMedFields; if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder) then btnSelect.Enabled := False; if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (self.EvtID <= 0) then //nss begin if NSSchedule then begin for ix := 0 to Responses.TheList.Count - 1 do begin if TResponse(Responses.TheList[ix]).promptid = 'SCHEDULE' then begin nsSch := TResponse(Responses.theList[ix]).EVALUE; if length(nsSch) > 0 then begin SetSchedule(nsSch); {cboSchedule.SelectByID(nsSch); if cboSchedule.ItemIndex < 0 then begin cboSchedule.Items.Add(nsSch); cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(nsSch); end;} end; end; end; end; end; //nss //if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then begin TempOrder := Piece(id,';',1); TempOrder := Copy(tempOrder, 2, Length(tempOrder)); LocChange := DifferentOrderLocations(tempOrder, Patient.Location); if LocChange = false then begin AResponse := Responses.FindResponseByName('ADMIN', 1); if AResponse <> nil then AdminTime := AResponse.EValue; if self.cboSchedule.ItemIndex > -1 then begin tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex]; SetPiece(tempSchString,U,4,AdminTime); self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; end; if self.tabDose.TabIndex = TI_COMPLEX then begin if self.cboXSchedule.ItemIndex > -1 then begin tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex]; SetPiece(tempSchString,U,4,AdminTime); self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString; end; end; AResponse := Responses.FindResponseByName('SCHTYPE', 1); if AResponse <> nil then tempSchType := AResponse.EValue; if self.cboSchedule.ItemIndex > -1 then begin if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then self.chkPRN.Checked := True else begin tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex]; SetPiece(tempSchString,U,3,tempSchType); self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString; end; end; if self.tabDose.TabIndex = TI_COMPLEX then begin if self.cboXSchedule.ItemIndex > -1 then begin if (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then self.chkXPRN.Checked := True else begin tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex]; SetPiece(tempSchString,U,3,tempSchType); self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString; end; end; end; end; if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then lblAdminSchSetText(''); if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText); end; if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or (XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change Changing := False; if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and (self.cboSchedule.ItemIndex > -1) then UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1)); end; { prevent the SIG from being part of the comments on pre-CPRS prescriptions } if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then begin OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID)); AnInstr := TextForOrder(OrderID); pnlMessage.TabOrder := 0; DispOrderMessage(AnInstr); if OrderAction = ORDER_COPY then AnInstr := 'Copy: ' + AnInstr else AnInstr := 'Change: ' + AnInstr; Text := AnsiReplaceText(AnInstr,CRLF,''); Caption := Text; memComment.Clear; // sometimes the sig is in the comment end; ControlChange(Self); if Self.IsSupply then btnSelect.Enabled := False; end; procedure TfrmODMeds.Validate(var AnErrMsg: string); var i,ie,code, curSupply, tempRefills: Integer; curDispDrug, tmpError, temp, x: string; procedure SetError(const x: string); begin if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF; AnErrMsg := AnErrMsg + x; end; procedure ValidateDosage(const x: string); begin if Length(x) = 0 then SetError(TX_NO_DOSE); end; procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer); var RouteID, RouteAbbr: string; begin //if order does not have route, and is not a supply order, // and is not an outpaitent order, then display error text to require route if (Length(x) = 0) and (Not IsSupplyAndOutPatient) then begin if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467 SetError(TX_NO_ROUTE); end; if (Length(x) > 0) and NeedLookup then begin LookupRoute(x, RouteID, RouteAbbr); if RouteID = '0' then begin if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467 SetError(TX_NF_ROUTE); end else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr); end; end; procedure ValidateSchedule(const x: string; AnInstance: Integer); const SCH_BAD = 0; SCH_NO_RTN = -1; var ValidLevel: Integer; ARoute, ADrug, tmpX: string; begin ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance); ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance); tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x); if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED) else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug) then SetError(TX_NO_SCHED); if Length(tmpX) > 0 then begin if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O'); if ValidLevel = SCH_NO_RTN then begin if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE); if Copy(tmpX, 1, 1) = '-' then SetError(TX_SCH_MINUS); if Pos(' ', Copy(tmpX, Pos(' ', tmpX) + 1, 999)) > 0 then SetError(TX_SCH_SPACE); if Length(tmpX) > 70 then SetError(TX_SCH_LEN); if (Pos('P RN', tmpX) > 0) or (Pos('PR N', tmpX) > 0) then SetError(TX_SCH_PRN); if Pos('Q0', tmpX) > 0 then SetError(TX_SCH_ZERO); if TrimLeft(tmpX) <> tmpX then SetError(TX_SCH_LSP); end; if ValidLevel = SCH_BAD then SetError(TX_SCH_NS); end; end; begin inherited; ControlChange(Self); // make sure everything is updated if txtMed.Tag = 0 then SetError(TX_NO_MED); if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE); if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".'); i := Responses.NextInstance('INSTR', 0); while i > 0 do begin if (ValueOfResponse(FLD_DRUG_ID, i) = '') then begin if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then begin SetError(TX_DOSE_NUM); if tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus; //CQ: 7467 end; if Length(Responses.IValueFor('INSTR', i)) > 60 then begin SetError(TX_DOSE_LEN); cboDosage.SetFocus; //CQ: 7467 end; end; ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i); ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i); i := Responses.NextInstance('INSTR', i); end; if self.tabDose.TabIndex = TI_DOSE then begin if (LeftStr(cboDosage.Text,1)='.') then begin SetError('Dosage must have a leading numeric value'); Exit; end; end; //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069 if self.tabDose.TabIndex = TI_COMPLEX then begin for i := 1 to self.grdDoses.RowCount do begin temp := ValFor(COL_DOSAGE, i); if (LeftStr(temp,1) = '.') then begin SetError('All dosage must have a leading numeric value'); Exit; end; if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then begin SetError(TX_NO_SEQ); Exit; end; end; end; if not FInptDlg then // outpatient stuff begin if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK); temp := Responses.IValueFor('REFILLS', 1); for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then begin SetError('Refills can only be a number'); Exit; end; tempRefills := StrToIntDef(temp, 0); if (spnRefills.Max > 0) and (tempRefills > 0) then begin i := Responses.NextInstance('DOSE', 0); while i > 0 do begin x := ValueOfResponse(FLD_DRUG_ID, i); CurDispDrug := CurDispDrug + x + U; i := Responses.NextInstance('DOSE', i); end; CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0); UpdateRefills(CurDispDrug, CurSupply); end; if tempRefills > spnRefills.Max then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max)); with txtQuantity do begin if not ValidQuantity(Responses.IValueFor('QTY', 1)) then SetError(TX_QTY_NV); (* else begin Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0)); if Quantity <> '' then SetError(Quantity); end; *) end; with txtSupply do begin txtSupply.Text := Trim(txtSupply.Text); Val( txtSupply.Text, ie, code); if (code <> 0) and (ie = 0)then begin SetError(TX_SUPPLY_NINT); Exit; end; if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM); if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1) then SetError(TX_SUPPLY_LIM1); //Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1))); //if Supply <> '' then SetError(Supply); end; tmpError := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0)); if tmpError <> '' then SetError(tmpError) else ClearMaxData; end; end; procedure TfrmODMeds.SetVisibleCommentRows( Rows: integer); begin memComment.Height := (Abs(Font.Height)+2)*Rows+8; end; procedure TfrmODMeds.SetControlsInpatient; begin FillerID := 'PSI'; CtrlInits.LoadDefaults(ODForMedsIn); lblPriority.Top := pnlFields.Height - cboPriority.Height - lblPriority.Height - 1; cboPriority.Top := pnlFields.Height - cboPriority.Height; lblDays.Visible := False; txtSupply.Visible := False; spnSupply.Visible := False; lblQuantity.Visible := False; txtQuantity.Visible := False; spnQuantity.Visible := False; lblQtyMsg.Visible := False; lblRefills.Visible := False; txtRefills.Visible := False; spnRefills.Visible := False; grpPickup.Visible := False; lblPriority.Visible := True; cboPriority.Visible := True; chkDoseNow.Visible := True; lblAdminTime.Visible := True; lblAdminSch.Visible := True; lblAdminSch.Hint := AdminTimeHelpText; if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except')); end; procedure TfrmODMeds.SetControlsOutpatient; begin FillerID := 'PSO'; CtrlInits.LoadDefaults(ODForMedsOut); lblPriority.Top := lblQuantity.Top; cboPriority.Top := txtQuantity.Top; lblDays.Visible := True; txtSupply.Visible := True; spnSupply.Visible := True; lblQuantity.Visible := True; txtQuantity.Visible := True; //if IsClozapineOrder = True then txtQuantity.Enabled := false; spnQuantity.Visible := True; lblQtyMsg.Visible := True; lblRefills.Visible := True; txtRefills.Visible := True; spnRefills.Visible := True; grpPickup.Visible := True; lblPriority.Visible := True; cboPriority.Visible := True; chkDoseNow.Visible := False; lblAdminTime.Visible := False; lblAdminSch.Visible := False; if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except'); end; { Navigate medication selection lists ------------------------------------------------------- } { txtMed methods (including timers) } procedure TfrmODMeds.WMTimer(var Message: TWMTimer); begin inherited; if (Message.TimerID = TIMER_ID) then begin StopKeyTimer; ChangeDelayed; end; end; procedure TfrmODMeds.StartKeyTimer; { start (or restart) a timer (done on keyup to delay before calling OnKeyPause) } var ATimerID: Integer; begin StopKeyTimer; ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil); FKeyTimerActive := ATimerID > 0; // if can't get a timer, just call the event immediately F if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0); end; procedure TfrmODMeds.StopKeyTimer; { stop the timer (done whenever a key is pressed or the combobox no longer has focus) } begin if FKeyTimerActive then begin KillTimer(Handle, TIMER_ID); FKeyTimerActive := False; end; end; function TfrmODMeds.FindQuickOrder(const x: string): Integer; var i: Integer; begin Result := -1; if x = '' then Exit; for i := 0 to Pred(FQuickItems.Count) do begin if (Result > -1) or (FQuickItems[i] = '') then Break; if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i; end; end; procedure TfrmODMeds.txtMedKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i: Integer; x: string; begin if txtMed.ReadOnly then // v27.50 - RV - CQ #15365 begin if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then // navigation begin Key := 0; Exit; end; end else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then // navigation begin FActiveMedList.Perform(WM_KEYDOWN, Key, 0); FFromSelf := True; //txtMed.Text := FActiveMedList.Selected.Caption; txtMed.SelectAll; FFromSelf := False; Key := 0; end else if Key = VK_BACK then begin FFromSelf := True; x := txtMed.Text; i := txtMed.SelStart; if i > 1 then Delete(x, i + 1, Length(x)) else x := ''; txtMed.Text := x; if i > 1 then txtMed.SelStart := i; FFromSelf := False; end else {StartKeyTimer}; end; procedure TfrmODMeds.txtMedKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365 if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer; end; procedure TfrmODMeds.txtMedChange(Sender: TObject); begin if FFromSelf then Exit; FChangePending := True; end; procedure TfrmODMeds.ScrollToVisible(AListView: TListView); var Offset: Integer; SelRect: TRect; begin AListView.Selected.MakeVisible(FALSE); SelRect := AListView.Selected.DisplayRect(drBounds); FRowHeight := SelRect.Bottom - SelRect.Top; Offset := AListView.Selected.Index - AListView.TopItem.Index; Application.ProcessMessages; if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight)); Application.ProcessMessages; end; procedure TfrmODMeds.ChangeDelayed; var QuickIndex, AllIndex: Integer; NewText, OldText, UserText: string; UniqueText: Boolean; begin FRemoveText := False; UniqueText := False; FChangePending := False; if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit; // don't lookup null // lookup item in appropriate list box NewText := ''; UserText := Copy(txtMed.Text, 1, txtMed.SelStart); QuickIndex := FindQuickOrder(UserText); // look in quick list first AllIndex := IndexOfOrderable(FCacheIEN, UserText); // but always synch the full list if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup if AllIndex > -1 then begin lstAll.Selected := lstAll.Items[AllIndex]; FActiveMedList := lstAll; end; if QuickIndex > -1 then begin try lstQuick.Selected := lstQuick.Items[QuickIndex]; lstQuick.ItemFocused := lstQuick.Selected; NewText := lstQuick.Selected.Caption; FActiveMedList := lstQuick; //Search Quick List for Uniqueness UniqueText := isUniqueQuickOrder(UserText); except //doing nothing short term solution related to 117 end; end else if AllIndex > -1 then begin lstAll.Selected := lstAll.Items[AllIndex]; lstAll.ItemFocused := lstAll.Selected; NewText := lstAll.Selected.Caption; lstQuick.Selected := nil; FActiveMedList := lstAll; //List is alphabetical, So compare next Item in list to establish uniqueness. if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then UniqueText := True; end else begin lstQuick.Selected := nil; lstAll.Selected := nil; FActiveMedList := lstAll; NewText := txtMed.Text; end; if (AllIndex > -1) and (QuickIndex > -1) then //Not Unique Between Lists UniqueText := False; FFromSelf := True; {AutoSelection is only based upon uniquely matching characters. Several CQs have been resolved relating to this issue: See CQ: 7326 - Auto complete does not work correctly if user has quick orders in Medication list 7328 - PSI-05-016: TAM-0205-31170 Med Error due to pre-populated med screen 6715 PSI-04-044 Orders: NJH-0804-20315 Physician unable to enter medication order } if UniqueText then begin OldText := Copy(txtMed.Text, 1, txtMed.SelStart); txtMed.Text := NewText; //txtMed.SelStart := Length(OldText); // v24.14 RV txtMed.SelStart := Length(UserText); // v24.14 RV txtMed.SelLength := Length(NewText); end else begin txtMed.Text := UserText; txtMed.SelStart := Length(txtMed.Text); end; FFromSelf := False; if lstAll.Selected <> nil then ScrollToVisible(lstAll); if lstQuick.Selected <> nil then ScrollToVisible(lstQuick); if Not UniqueText then begin lstQuick.ItemIndex := -1; lstAll.ItemIndex := -1; end; FRemoveText := True; end; procedure TfrmODMeds.txtMedExit(Sender: TObject); begin StopKeyTimer; if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365 if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed; end; { lstAll & lstQuick methods } procedure TfrmODMeds.ListViewEnter(Sender: TObject); begin inherited; FActiveMedList := TListView(Sender); with Sender as TListView do begin if Selected = nil then Selected := TopItem; if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil; ItemFocused := Selected; //ScrollToVisible(TListView(Sender)); end; end; procedure TfrmODMeds.ListViewClick(Sender: TObject); begin inherited; btnSelect.Visible := True; btnSelect.Enabled := True; //txtMed.Text := FActiveMedList.Selected.Caption; PostMessage(Handle, UM_DELAYCLICK, 0, 0); end; procedure TfrmODMeds.UMDelayClick(var Message: TMessage); begin btnSelectClick(Self); end; procedure TfrmODMeds.ListViewEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); begin AllowEdit := FALSE; end; procedure TfrmODMeds.ListViewKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin //This code emulates combo-box behavior on the quick view and all meds view. //I think this is a really bad idea because it cannot automatically be undone. //Example: pull up a valid medication. Press change button. Press tab. Valid //medication is gone, replaced by first quick order entry. Not good behavior //when tabbing through page. //If we are going to use an edit box to play combo box, I emphatically suggest //that we use a different edit box. (* with Sender as TListView do begin if txtMed.Text = Selected.Caption then Exit; // for tabs, arrows, etc. FFromSelf := True; txtMed.Text := Selected.Caption; txtMed.SelectAll; FFromSelf := False; Key := 0; end; *) end; procedure TfrmODMeds.ListViewResize(Sender: TObject); begin with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20; end; { lstAll Methods (lstAll is TListView) } procedure TfrmODMeds.Loaded; begin inherited; if ScreenReaderSystemActive then tabDose.TabStop := TRUE; end; // Cache is a list of 100 string lists, starting at idx 0 procedure TfrmODMeds.LoadMedCache(First, Last: Integer); var firstChunk, lastchunk, i: integer; list: TStringList; firstMed, LastMed: integer; begin firstChunk := GetCacheChunkIndex(First); lastChunk := GetCacheChunkIndex(Last); for i := firstChunk to lastChunk do begin if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then begin while FMedCache.Count <= i do FMedCache.add(nil); list := TStringList.Create; FMedCache[i] := list; firstMed := i * MED_CACHE_CHUNK_SIZE; LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1; if LastMed >= lstAll.Items.Count then LastMed := lstAll.Items.Count - 1; SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed); end; end; end; procedure TfrmODMeds.lstAllData(Sender: TObject; Item: TListItem); var x: string; chunk: integer; list: TStringList; begin LoadMedCache(Item.Index, Item.Index); chunk := GetCacheChunkIndex(Item.Index); list := TStringList(FMedCache[chunk]); x := list[Item.Index mod MED_CACHE_CHUNK_SIZE]; Item.Caption := Piece(x, U, 2); Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); end; procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex, EndIndex: Integer); begin LoadMedCache(StartIndex, EndIndex); end; { lstQuick methods (lstQuick is TListView) } procedure TfrmODMeds.lstQuickData(Sender: TObject; Item: TListItem); var x: string; begin { try if FQuickItems[Item.Index] = '' then SubsetOfQuickOrders(FQuickItems, FQuickList, Item.Index, Item.Index);} x := FQuickItems[Item.Index]; Item.Caption := Piece(x, U, 2); Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0)); { except // doing nothing end;} end; procedure TfrmODMeds.lstQuickDataHint(Sender: TObject; StartIndex, EndIndex: Integer); begin end; { Medication is now selected ---------------------------------------------------------------- } procedure TfrmODMeds.btnSelectClick(Sender: TObject); var MedIEN: Integer; //MedName: string; QOQuantityStr: string; ErrMsg, Temp: string; begin inherited; QOQuantityStr := ''; btnSelect.SetFocus; // let the exit events finish self.MedName := ''; if pnlMeds.Visible then // display the medication fields begin Changing := True; ResetOnMedChange; if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then // quick order begin ErrMsg := ''; FIsQuickOrder := True; FQOInitial := True; Responses.QuickOrder := Integer(lstQuick.Selected.Data); txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0); if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit; if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit; IsActivateOI(ErrMsg, txtMed.Tag); if Length(ErrMsg)>0 then begin //btnSelect.Visible := False; btnSelect.Enabled := False; ShowMsg(ErrMsg); Exit; end; if DEACheckFailed(txtMed.Tag, FInptDlg) then begin //btnSelect.Visible := False; btnSelect.Enabled := False; InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); txtMed.Tag := 0; txtMed.SetFocus; Exit; end; if txtMed.Tag = 0 then begin //btnSelect.Visible := False; btnSelect.Enabled := False; txtMed.SetFocus; Exit; end; (* temp := self.MedName; tempIEN := txtMed.Tag; QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder)); if QOIEN > 0 then begin CheckFormularyOI(tempIEN, temp, FInptDlg); if tempIEN <> txtMed.Tag then begin txtMed.Tag := tempIEN; txtMed.Text := temp; end; end; *) FAltChecked := True; ; SetOnMedSelect; // set up for this medication SetOnQuickOrder; // insert quick order responses if Length(txtQuantity.Text)>0 then QOQuantityStr := txtQuantity.Text; ShowMedFields; if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false; if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then txtQuantity.Text := QOQuantityStr; end else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item begin MedIEN := Integer(lstAll.Selected.Data); self.MedName := lstAll.Selected.Caption; if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit; if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit; txtMed.Tag := MedIEN; ErrMsg := ''; IsActivateOI(ErrMsg, txtMed.Tag); if Length(ErrMsg)>0 then begin //btnSelect.Visible := False; btnSelect.Enabled := False; ShowMsg(ErrMsg); Exit; end; if DEACheckFailed(txtMed.Tag, FInptDlg) then begin //btnSelect.Visible := False; btnSelect.Enabled := False; InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK); txtMed.Tag := 0; txtMed.SetFocus; Exit; end; if Pos(' NF', self.MedName) > 0 then begin temp := self.MedName; CheckFormularyOI(MedIEN, temp, FInptDlg); FAltChecked := True; end; if MedIEN <> txtMed.Tag then begin txtMed.Tag := MedIEN; temp := self.MedName; self.MedName := txtMed.Text; txtMed.Text := Temp; end; SetOnMedSelect; ShowMedFields; end else // no selection begin //btnSelect.Visible := False; btnSelect.Enabled := False; MessageBeep(0); //btnSelect.Visible := False; btnSelect.Enabled := False; Exit; end; UpdateRelated(False); Changing := False; ControlChange(Self); end else ShowMedSelect; // show the selection fields FNoZERO := False; end; procedure TfrmODMeds.ResetOnMedChange; var i: Integer; begin Responses.Clear; // clear dialog controls individually, since they are on panels with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear; cboDosage.Items.Clear; cboDosage.Text := ''; cboRoute.Items.Clear; cboRoute.Text := ''; cboRoute.Hint := cboRoute.Text; cboSchedule.ItemIndex := -1; cboSchedule.Text := ''; // leave items intact chkPRN.Checked := False; memComment.Lines.Clear; txtSupply.Text := ''; txtQuantity.Text := ''; txtRefills.Text := '0'; lblQtyMsg.Caption := ''; lblQuantity.Caption := 'Quantity'; chkDoseNow.Checked := FALSE; lblAdminTime.Caption := ''; chkPtInstruct.Checked := False; chkPtInstruct.Visible := False; memPI.Visible := False; stcPI.Visible := False; image1.Visible := False; memDrugMsg.Visible := False; FLastUnits := ''; FLastSchedule := ''; FLastDuration := ''; FLastInstruct := ''; FLastDispDrug := '-1'; FLastQuantity := 0; FLastSupply := 0; FAltChecked := False; FPtInstruct := ''; end; procedure TfrmODMeds.ResetOnTabChange; var i: Integer; begin with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear; Responses.Clear('STRENGTH'); Responses.Clear('NAME'); Responses.Clear('INSTR'); Responses.Clear('DOSE'); Responses.Clear('DRUG'); Responses.Clear('DAYS'); Responses.Clear('ROUTE'); Responses.Clear('SCHEDULE'); Responses.Clear('START', 1); Responses.Clear('SIG'); Responses.Clear('SUPPLY'); Responses.Clear('QTY'); cboDosage.ItemIndex := -1; cboDosage.Text := ''; cboRoute.ItemIndex := -1; cboRoute.Text := ''; cboSchedule.ItemIndex := -1; cboSchedule.Text := ''; // leave items intact if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText(''); txtSupply.Text := ''; txtSupply.Tag := 0; txtQuantity.Text := ''; txtQuantity.Tag := 0; lblQtyMsg.Caption := ''; lblQuantity.Caption := 'Quantity'; FSmplPRNChkd := chkPRN.Checked; // GE CQ7585 chkPRN.Checked := False; FLastUnits := ''; FLastSchedule := ''; FLastDuration := ''; FLastInstruct := ''; FLastDispDrug := ''; FDrugID := ''; end; procedure TfrmODMeds.SetOnMedSelect; var i,j: Integer; temp,x: string; QOPiUnChk: boolean; PKIEnviron: boolean; AResponse: TResponse; begin // clear controls? cboDosage.Tag := -1; txtSupply.Tag := 0; txtQuantity.Tag := 0; spnQuantity.Tag := 0; QOPiUnChk := False; PKIEnviron := False; if GetPKISite then PKIEnviron := True; with CtrlInits do begin // set up CtrlInits for orderable item LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron)); // set up lists & initial values based on orderable item SetControl(txtMed, 'Medication'); if (self.MedName <> '') then begin if (txtMed.Text <> self.MedName) then begin temp := self.MedName; self.MedName := txtMed.Text; txtMed.Text := temp; end else MedName := ''; end; SetControl(cboDosage, 'Dosage'); SetControl(cboRoute, 'Route'); if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0; cboRouteChange(Self); x := DefaultText('Schedule'); //AGP Change 27.72 trying to centralized the schedule setting code AResponse := Responses.FindResponseByName('SCHEDULE',1); if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue; SetSchedule(x); (* if x <> '' then begin cboSchedule.SelectByID(x); if cboSchedule.ItemIndex > -1 then AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4); if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN') then begin self.chkPRN.Checked := true; x := Copy(x,1,(Length(x)-3)); if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1)) end; cboSchedule.Text := x; end; *) if Length(ValueOf(FLD_QTYDISP))>10 then begin lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...'; lblQuantity.Hint := ValueOf(FLD_QTYDISP); end; FAllDoses.Text := TextOf('AllDoses'); FAllDrugs.Text := TextOf('Dispense'); FGuideline.Text := TextOf('Guideline'); case FGuideline.Count of 0: lblGuideline.Visible := False; 1: begin lblGuideline.Caption := FGuideline[0]; lblGuideline.Visible := TRUE; end; else begin lblGuideline.Caption := 'Display Restrictions/Guidelines'; lblGuideline.Visible := TRUE; end; end; if FInptDlg then begin if not FResizedAlready then begin pnlBottom.Height := pnlBottom.Height - lblDays.Height - txtSupply.Height - stcPi.Height - memPi.Height + 6; FResizedAlready := True; end; pnlTop.Height := pnlFields.Height - pnlBottom.Height; chkDoseNow.Top := memComment.Top + memComment.Height + 1; lblPriority.Top := memcomment.Top + memComment.Height + 1; cboPriority.Top := lblPriority.Top + lblPriority.Height; lblAdminSch.Left := chkDoseNow.Left; lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1; lblAdminSch.Height := (MainFontHeight * 3) + 3; lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5; lblAdminTime.Left := lblAdminSch.Left; lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1; if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('') else begin if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText) else self.lblAdminSch.Visible := False; end; end else begin DEASig := ''; if GetPKISite then DEASig := DefaultText('DEASchedule'); FSIGVerb := DefaultText('Verb'); if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE; FSIGPrep := DefaultText('Preposition'); if FLastPickup <> '' then SetPickup(FLastPickup) else SetPickup(DefaultText('Pickup')); SetControl(txtRefills, 'Refills'); for j := 0 to Responses.TheList.Count - 1 do begin if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then QOPiUnChk := True; end; //if Length(FPtInstruct) = 0 then if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr'); for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' '; FPtInstruct := TrimRight(FPtInstruct); if Length(FPtInstruct) > 0 then begin //chkPtInstruct.Caption := FPtInstruct; if memPI.Lines.Count > 0 then memPI.Lines.Clear; memPI.Lines.Add(FPtInstruct); chkPtInstruct.Visible := True; chkPtInstruct.Checked := True; stcPI.Visible := True; memPI.Visible := True; if FShrinked then begin pnlBottom.Height := pnlBottom.Height + memPi.Height + stcPI.Height + 2; FShrinked := False; end; if QOPiUnChk then chkPtInstruct.Checked := False; end else begin chkPtInstruct.Visible := False; chkPtInstruct.Checked := False; stcPI.Visible := False; memPI.Visible := False; if not FShrinked then begin pnlBottom.Height := pnlBottom.Height - stcPI.Height - memPI.Height - 2; FShrinked := True; end; end; end; pnlMessage.TabOrder := cboDosage.TabOrder + 1; DispOrderMessage(TextOf('Message')); end; end; procedure TfrmODMeds.SetOnQuickOrder; var AResponse: TResponse; x,LocRoute,TempSch,DispGrp: string; i, DispDrug: Integer; begin // txtMed already set by SetOnMedSelect with Responses do begin if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose begin grdDoses.RowCount := HigherOf(InstanceCount('INSTR')+2, 4); i := Responses.NextInstance('INSTR', 0); while i > 0 do begin SetDosage(IValueFor('INSTR', i)); with cboDosage do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality grdDoses.Cells[COL_DOSAGE, i] := x; SetControl(cboRoute, 'ROUTE', i); with cboRoute do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; grdDoses.Cells[COL_ROUTE, i] := x; if FIsQuickOrder then TempSch := cboSchedule.Text; SetSchedule(IValueFor('SCHEDULE', i)); if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then begin cboSchedule.SelectByID(TempSch); cboSchedule.Text := TempSch; end; if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1; x := cboSchedule.Text; if chkPRN.Checked then x := x + ' PRN'; with cboSchedule do if ItemIndex > -1 then x := x + TAB + Items[ItemIndex]; grdDoses.Cells[COL_SCHEDULE, i] := x; if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1'; grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i); if FInptDlg then begin if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i) else if cboSchedule.ItemIndex > -1 then grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4) else grdDoses.Cells[COL_ADMINTIME, i] := ''; if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined'; if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText; end; if IValueFor('CONJ', i) = 'A' then x := 'AND' else if IValueFor('CONJ', i) = 'T' then x := 'THEN' else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT' else x := ''; grdDoses.Cells[COL_SEQUENCE, i] := x; i := Responses.NextInstance('INSTR', i); end; {while} end else // single dose begin if FIsQuickOrder then begin FQODosage := IValueFor('INSTR', 1); SetDosage(FQODosage); TempSch := cboSchedule.Text; end else SetDosage(IValueFor('INSTR', 1)); SetControl(cboRoute, 'ROUTE', 1); SetSchedule(IValueFor('SCHEDULE', 1)); if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then begin cboSchedule.SelectByID(TempSch); cboSchedule.Text := TempSch; end; if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1; if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder) then FNSSOther := True; DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0); if Length(ValueOf(FLD_QTYDISP))>10 then begin lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...'; lblQuantity.Hint := ValueOf(FLD_QTYDISP); end; if DispDrug > 0 then begin DispOrderMessage(DispenseMessage(DispDrug)); x := QuantityMessage(DispDrug); end; if Length(x) > 0 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST else lblQtyMsg.Caption := ''; end; SetControl(memComment , 'COMMENT', 1); SetControl(cboPriority, 'URGENCY', 1); if FInptDlg then begin SetControl(chkDoseNow, 'NOW', 1); chkDoseNowClick(Self); end else begin SetControl(txtSupply, 'SUPPLY', 1); txtSupply.Text := Trim(txtSupply.Text); spnSupply.Position := StrToIntDef(txtSupply.Text, 0); { setting .Tag=1 was commented out because xfer & change were not auto-calculating } //if spnSupply.Position <> 0 then txtSupply.Tag := 1; if Length(IValueFor('QTY',1))>0 then begin FQOQuantity := StrToFloat(IValueFor('QTY',1)); txtQuantity.Text := FloatToStr(FQOQuantity); end; SetControl(txtQuantity, 'QTY', 1); SetControl(txtRefills, 'REFILLS', 1); spnRefills.Position := StrToIntDef(txtRefills.Text, 0); AResponse := Responses.FindResponseByName('PICKUP', 1); if AResponse <> nil then SetPickup(AResponse.IValue); if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then begin if not QOHasRouteDefined(Responses.QuickOrder) then begin LocRoute := GetPickupForLocation(IntToStr(Encounter.Location)); SetPickup(LocRoute); end; end; DispGrp := NameOfDGroup(Responses.DisplayGroup); if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then begin LocRoute := GetPickupForLocation(IntToStr(Encounter.Location)); SetPickup(LocRoute); end; if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup); // AResponse := Responses.FindResponseByName('SC', 1); Responses.FindResponseByName('SC', 1); end; {if FInptDlg..else} end; {with} if FInptDlg then begin x := ValueOfResponse(FLD_SCHEDULE, 1); if Length(x) > 0 then UpdateStartExpires(x); end; end; procedure TfrmODMeds.ShowMedSelect; begin txtMed.SelStart := Length(txtMed.Text); ChangeDelayed; // synch the listboxes with display pnlFields.Enabled := False; pnlFields.Visible := False; pnlMeds.Enabled := True; pnlMeds.Visible := True; pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top; if btnSelect.Caption = 'Change' then begin btnSelect.Caption := 'OK'; //btnSelect.Visible := false; btnSelect.Enabled := false; end; btnSelect.Top := memOrder.Top; btnSelect.Anchors := [akRight, akBottom]; btnSelect.BringToFront; cmdAccept.Visible := False; cmdAccept.Default := False; btnSelect.Default := True; cmdAccept.Left := cmdQuit.Left; cmdAccept.Top := MemOrder.Top; btnSelect.TabOrder := cmdAccept.TabOrder; cmdAccept.TabStop := False; txtMed.Width := grdDoses.Width; txtMed.Font.Color := clWindowText; txtMed.Color := clWindow; txtMed.ReadOnly := False; txtMed.SelectAll; txtMed.SetFocus; FDrugID := ''; //ShowOrderMessage( False ); end; procedure TfrmODMeds.ShowMedFields; begin pnlMeds.Enabled := False; pnlMeds.Visible := False; pnlFields.Enabled := True; pnlFields.Visible := True; pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top; btnSelect.Caption := 'Change'; btnSelect.Visible := True; btnSelect.Enabled := True; btnSelect.Top := txtMed.Top; btnSelect.Anchors := [akRight, akTop]; btnSelect.Default := False; cmdAccept.Visible := True; cmdAccept.Default := True; cmdAccept.Left := cmdQuit.Left; cmdAccept.Top := MemOrder.Top; btnSelect.TabOrder := txtMed.TabOrder + 1; cmdAccept.TabStop := True; txtMed.Width := memOrder.Width; txtMed.Font.Color := clInfoText; txtMed.Color := clInfoBk; txtMed.ReadOnly := True; if (Responses.InstanceCount('INSTR') > 1) or (Responses.InstanceCount('DAYS') > 0) then ShowControlsComplex else ShowControlsSimple; end; procedure TfrmODMeds.ShowControlsSimple; //var //dosagetxt: string; begin //Commented out, no longer using CharsNeedMatch Property { NumCharsForMatch := 0; for i := 0 to cboDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece begin dosagetxt := Piece(cboDosage.Items[i],'^',5); if Length(dosagetxt) < 1 then break; if NumCharsForMatch = 0 then NumCharsForMatch := Length(dosagetxt); if (NumCharsForMatch > Length(dosagetxt)) then NumCharsForMatch := Length(dosagetxt); end; if NumCharsForMatch > 1 then cboDosage.CharsNeedMatch := NumCharsForMatch - 1; if NumCharsForMatch > 5 then cboDosage.CharsNeedMatch := 5;} tabDose.TabIndex := TI_DOSE; grdDoses.Visible := False; btnXInsert.Visible := False; btnXRemove.Visible := False; cboDosage.Visible := True; lblRoute.Visible := True; cboRoute.Visible := True; lblSchedule.Visible := True; cboSchedule.Visible := True; if FInptDlg = True then lblAdminSch.Visible := True else lblAdminSch.Visible := false; chkPRN.Visible := True; ActiveControl := cboDosage; end; procedure TfrmODMeds.ShowControlsComplex; procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); //AGP Changes 26.12 PSI-04-63 var cnt,i,index: integer; node,text: string; begin if (CompSch = false) or not (FInptDlg)then begin DestCombo.Items.Clear; FastAssign(SrcCombo.Items, DestCombo.Items); DestCombo.ItemIndex := SrcCombo.ItemIndex; DestCombo.Text := Piece(SrcCombo.Text, TAB, 1); end; if (CompSch = true) and (FInptDlg) then // AGP Changes 26.12 PSI-04-63 begin //AGP change 26.34 CQ 7201,6902 fix the problem with one time schedule still showing for inpatient complex orders DestCombo.ItemIndex := -1; Text := SrcCombo.Text; index := SrcCombo.ItemIndex; cnt := 0; for i := 0 to SrcCombo.Items.Count - 1 do begin node := SrcCombo.Items.Strings[i]; if piece(node,U,3) <> 'O' then begin DestCombo.Items.Add(SrcCombo.Items.Strings[i]); if Piece(node,U,1) = text then DestCombo.ItemIndex := index - cnt; end else cnt := cnt+1; end; if (index = -1) and (Text <> '') then begin for I := 0 to DestCombo.Items.Count - 1 do if Piece(DestCombo.Items.Strings[i],U,1) = Text then begin DestCombo.ItemIndex := i; DestCombo.Text := Text; Exit; end; end; end; end; //var //dosagetxt: string; begin tabDose.TabIndex := TI_COMPLEX; MoveCombo(cboDosage, cboXDosage); MoveCombo(cboRoute, cboXRoute); MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063 grdDoses.Visible := True; btnXInsert.Visible := True; btnXRemove.Visible := True; cboDosage.Visible := False; lblRoute.Visible := False; cboRoute.Visible := False; lblSchedule.Visible := False; cboSchedule.Visible := False; chkPRN.Visible := False; FDropColumn := -1; pnlFieldsResize(Self); ActiveControl := grdDoses; //Commented out, no longer using CharsNeedMatch Property { NumCharsForMatch := 0; for i := 0 to cboXDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece begin dosagetxt := Piece(cboXDosage.Items[i],'^',5); if Length(dosagetxt) < 1 then break; if NumCharsForMatch = 0 then NumCharsForMatch := Length(dosagetxt); if (NumCharsForMatch > Length(dosagetxt)) then NumCharsForMatch := Length(dosagetxt); end; if NumCharsForMatch > 1 then cboXDosage.CharsNeedMatch := NumCharsForMatch - 1; if NumCharsForMatch > 5 then cboDosage.CharsNeedMatch := 5;} end; procedure TfrmODMeds.SetDosage(const x: string); var i, DoseIndex: Integer; begin DoseIndex := -1; with cboDosage do begin ItemIndex := -1; for i := 0 to Pred(Items.Count) do if Piece(Items[i], U, 5) = x then begin DoseIndex := i; Break; end; if DoseIndex <0 then Text := x (* if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = False) then Text := '' else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = True) then Text := x *) else ItemIndex := DoseIndex; end; end; procedure TfrmODMeds.SetPickup(const x: string); begin radPickClinic.Checked := FALSE; radPickMail.Checked := FALSE; radPickWindow.Checked := FALSE; case CharAt(x, 1) of 'C': radPickClinic.Checked := TRUE; 'M': radPickMail.Checked := TRUE; 'W': radPickWindow.Checked := TRUE; else {leave all unchecked} end; end; procedure TfrmODMeds.SetSchedule(const x: string); var NonPRNPart,tempSch, tempText: string; begin //AGP Change 27.72 if schedule matches why goes through and reprocess the same info? if cboSchedule.ItemIndex > -1 then begin tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1); if tempText = x then exit; if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then begin NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); if nonPRNPart = tempText then exit; end; end; cboSchedule.ItemIndex := -1; if chkPRN.Checked = True then chkPRN.Checked := False; cboSchedule.SelectByID(x); if cboSchedule.ItemIndex > -1 then exit; // if cboSchedule.ItemIndex < 0 then //begin //if NSSchedule then //begin // cboSchedule.Text := ''; //end if FInptDlg then begin if (Pos('@', x) > 0) then begin tempSch := Piece(x, '@', 2); cboSchedule.SelectByID(tempSch); if cboSchedule.ItemIndex > -1 then begin tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex]; cboSchedule.Items.Add(tempSch); cboSchedule.Text := (Piece(tempSch,U,1)); cboSchedule.SelectByID(Piece(tempSch,u,1)); EXIT; end; if Pos('PRN', tempSch) > 0 then begin NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1)); cboSchedule.SelectByID(NonPRNPart); if cboSchedule.ItemIndex > -1 then begin tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex]; cboSchedule.Items.Add(tempSch); cboSchedule.Text := (Piece(tempSch,U,1)); cboSchedule.SelectByID(Piece(tempSch,u,1)); chkPRN.Checked := True; EXIT; end else begin NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); chkPRN.Checked := true; tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2); cboSchedule.Items.Add(tempSch); cboSchedule.SelectByID(Piece(tempSch, U, 1)); EXIT; end; end; cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2)); cboSchedule.Text := x; cboSchedule.SelectByID(x); EXIT; end else if Pos('PRN', x) > 0 then begin NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); chkPRN.Checked := True; cboSchedule.SelectByID(NonPRNPart); if cboSchedule.ItemIndex > -1 then EXIT; end; end else if Pos('PRN', x) > 0 then begin NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); chkPRN.Checked := True; cboSchedule.SelectByID(NonPRNPart); if cboSchedule.ItemIndex > -1 then EXIT; cboSchedule.Items.Add(NonPRNPart); cboSchedule.Text := NonPRNPart; cboSchedule.SelectByID(NonPRNPart); EXIT; end; cboSchedule.Items.Add(x); cboSchedule.Text := x; cboSchedule.SelectByID(x); end; { Medication edit --------------------------------------------------------------------------- } procedure TfrmODMeds.tabDoseChange(Sender: TObject); var //text,x, tmpsch: string; text, tmpAdmin, x: string; reset: integer; begin inherited; reset := 0; //AGP change for CQ 6521 added warning message //AGP Change for CQ 7508 added tab information //GE Change warning message functionality show only cq 7590 // when tab changes from complex to simple. //AGP Change for CQ 7834 and 7832 change text and added check to see if some values have been completed in row 1 if (tabDose.TabIndex = 0) and ((ValFor(COL_DOSAGE, 1)<>'') or (ValFor(COL_SCHEDULE, 1)<>'') or (ValFor(COL_DURATION, 1)<>'') or (ValFor(COL_SEQUENCE, 1)<>'')) then begin text := 'By switching to the Dosage Tab, ' ; if (InfoBox(text +'you will lose all data on this screen. Click “OK” to continue or “Cancel”','Warning',MB_OKCANCEL)=IDCANCEL) then begin if tabDose.TabIndex = 1 then tabDose.TabIndex := 0 else tabDose.TabIndex := 1; reset := 1; end; end; case tabDose.TabIndex of TI_DOSE: begin cboXSchedule.Clear; // Added to Fix CQ: 9603 cboXDosage.Clear; // clean up responses? FSuppressMsg := FOrigiMsgDisp; ShowControlsSimple; if reset = 0 then ResetOnTabChange; txtNss.Left := lblSchedule.Left + lblSchedule.Width + 2; if (FInptDlg) then txtNss.Visible := True else txtNss.Visible := False; cboXRoute.Hide; // Added to Fix CQ: 7640 ControlChange(Self); end; TI_RATE: begin // for future use... end; TI_COMPLEX: begin FSuppressMsg := FOrigiMsgDisp; if reset = 1 then exit; (* AGP Change admin wrap 27.73 tmpAdmin := Piece(self.lblAdminSch.text, ':', 2); tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *) tmpAdmin := lblAdminSchGetText; if FAdminTimeText <> '' then begin tmpAdmin := FAdminTimeText; if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False; end; ShowControlsComplex; ResetOnTabChange; txtNss.Left := grdDoses.Left + grdDoses.ColWidths[0] + grdDoses.ColWidths[1] + grdDoses.ColWidths[2] + 3; txtNss.Visible := False; x := cboXDosage.Text + TAB; if LeftStr(x,1) = '.' then x := ''; with cboXDosage do if ItemIndex > -1 then x := x + Items[ItemIndex]; grdDoses.Cells[COL_DOSAGE, 1] := x; x := cboXRoute.Text + TAB; with cboXRoute do if ItemIndex > -1 then x := x + Items[ItemIndex]; grdDoses.Cells[COL_ROUTE, 1] := x; x := cboXSchedule.Text + TAB; with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex]; grdDoses.Cells[COL_SCHEDULE, 1] := x; //AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected. if FSmplPRNChkd then begin pnlXSchedule.Tag := 1; self.chkXPRN.Checked := True; end; if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1)); ControlChange(Self); end; {TI_COMPLEX} end; {case} if ScreenReaderSystemActive then GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab'); end; function TfrmODMeds.lblAdminSchGetText: string; var tempstr: string; i: integer; begin result := ''; if self.lblAdminSch.Text = '' then exit; tempstr := ''; if self.lblAdminSch.Lines.Count > 1 then begin for i := 0 to self.lblAdminSch.Lines.Count - 1 do tempstr := tempStr + self.lblAdminSch.Lines.Strings[i]; end else if self.lblAdminSch.Lines.Count = 1 then begin tempstr := self.lblAdminSch.Text; end; Result := Piece(tempStr,':',2); Result := Copy(Result,2,Length(Result)); end; procedure TfrmODMeds.lblAdminSchSetText(str: string); var cutoff: integer; begin cutoff := lblAdminSch.width div MainFontWidth; if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF + Copy(str, cutoff + 1, Length(str)) else self.lblAdminSch.Text := str; end; procedure TfrmODMeds.lblGuidelineClick(Sender: TObject); var TextStrings: TStringList; begin inherited; TextStrings := TStringList.Create; try TextStrings.Text := FGuideline.Text; ReportBox(TextStrings, TC_GUIDELINE, TRUE); finally TextStrings.Free; end; //if FGuideline.Count > 0 then InfoBox(FGuideline.Text, 'Restrictions/Guidelines', MB_OK); end; { cboDosage ------------------------------------- } procedure TfrmODMeds.CheckFormAltDose(DispDrug: Integer); var OI: Integer; OIName: string; begin if FAltChecked or (DispDrug = 0) then Exit; OI := txtMed.Tag; OIName := txtMed.Text; CheckFormularyDose(DispDrug, OI, OIName, FInptDlg); if OI <> txtMed.Tag then begin ResetOnMedChange; txtMed.Tag := OI; txtMed.Text := OIName; SetOnMedSelect; end; end; procedure TfrmODMeds.cboDosageClick(Sender: TObject); var DispDrug: Integer; x: string; begin inherited; if FSuppressMsg then begin if PnlMessage.Visible = true then begin memMessage.SendToBack; PnlMessage.Visible := False; end; end; UpdateRelated(False); DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0); if DispDrug > 0 then begin if not FSuppressMsg then begin DispOrderMessage(DispenseMessage(DispDrug)); end; x := QuantityMessage(DispDrug); end else x := ''; if Length(ValueOf(FLD_QTYDISP))>10 then begin lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...'; lblQuantity.Hint := ValueOf(FLD_QTYDISP); end else begin lblQuantity.Caption := ValueOf(FLD_QTYDISP); lblQuantity.Hint := ''; end; if Length(x) > 0 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST else lblQtyMsg.Caption := ''; with cboDosage do if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF') then CheckFormAltDose(DispDrug); end; procedure TfrmODMeds.cboDosageChange(Sender: TObject); var temp1,temp2: string; Count: integer; begin inherited; Count := Pos(U,cboDosage.Text); if Count > 0 then begin temp1 := copy(cboDosage.Text,0,count-1); temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text)); infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK); cboDosage.Text := temp1 + temp2; end; UpdateRelated; end; procedure TfrmODMeds.cboDosageExit(Sender: TObject); var str: string; begin inherited; str := cboDosage.Text; if (length(cboDosage.Text)<1) then cboDosage.ItemIndex := -1; (* Probably not needed here since this on validation check on accept if (LeftStr(cboDosage.Text,1)='.') then begin infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK); if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus; Exit; end; *) if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and (Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5) <> Piece(cboDosage.Text,tab,1)) then begin cboDosage.ItemIndex := -1; cboDosage.Text := Piece(str, tab, 1); UpdateRelated(false); end; if ActiveControl = memMessage then begin memMessage.SendToBack; PnlMessage.Visible := False; Exit; end; if ActiveControl = memComment then begin if PnlMessage.Visible = true then begin memMessage.SendToBack; PnlMessage.Visible := False; end; end else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then begin if PnlMessage.Visible = true then begin memMessage.SendToBack; PnlMessage.Visible := False; end; //cboDosageClick(Self); end; end; { cboRoute -------------------------------------- } procedure TfrmODMeds.cboRouteChange(Sender: TObject); begin inherited; with cboRoute do if ItemIndex > -1 then begin if Piece(Items[ItemIndex], U, 5) = '1' then tabDose.Tabs[0] := 'Dosage / Rate' else tabDose.Tabs[0] := 'Dosage'; end; cboDosage.Caption := tabDose.Tabs[0]; if Sender <> Self then ControlChange(Sender); end; procedure TfrmODMeds.cboRouteExit(Sender: TObject); begin if Trim(cboRoute.Text) = '' then cboRoute.ItemIndex := -1; // ValidateRoute(cboRoute); Removed based on Site feeback. See CQ: 7518 inherited; end; { cboSchedule ----------------------------------- } procedure TfrmODMeds.cboScheduleClick(Sender: TObject); var othSch: string; idx : integer; begin inherited; if (FInptDlg) and (cboSchedule.Text = 'OTHER') then begin othSch := CreateOtherScheduel; if length(trim(othSch)) > 1 then begin othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime; cboSchedule.Items.Add(othSch); idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1)); cboSchedule.ItemIndex := idx; end; end else begin NSSAdminTime := ''; FNSSScheduleType := ''; end; UpdateRelated(False); end; procedure TfrmODMeds.cboScheduleChange(Sender: TObject); var othSch: string; idx : integer; begin inherited; if (FInptDlg) and (cboSchedule.Text = 'OTHER') then begin othSch := CreateOtherScheduel; if length(trim(othSch)) > 1 then begin cboSchedule.Items.Add(othSch); idx := cboSchedule.Items.IndexOf(OthSch); cboSchedule.ItemIndex := idx; end; end; FScheduleChanged := true; UpdateRelated; end; { Duration ----------------------------- } procedure TfrmODMeds.UpdateDurationControls( FreeText: boolean); begin if FreeText then begin pnlXDurationButton.Width := 8; pnlXDurationButton.Align := alRight; spnXDuration.Visible := False; txtXduration.Align := alClient; end else begin txtXduration.Align := alNone; txtXduration.Width := pnlXDuration.Width - (pnlXDuration.Width div 2) - spnXDuration.Width + 2; pnlXDurationButton.Width := pnlXDuration.Width div 2; pnlXDurationButton.Align := alRight; spnXDuration.Visible := True; spnXDuration.AlignButton := udRight; end; end; procedure TfrmODMeds.popDurationClick(Sender: TObject); var x: string; begin inherited; with TMenuItem(Sender) do begin if Tag > 0 then begin x := LowerCase(Caption); //Make sure duration is integer txtXDuration.Text := IntToStr(StrToIntDef(txtXDuration.Text,0)); UpdateDurationControls(False); end else begin x := ''; txtXDuration.Text := ''; UpdateDurationControls(True); end; end; btnXDuration.Caption := x; txtXDurationChange(Sender); ControlChange(Sender); end; { txtSupply, txtQuantity -------------------------- } procedure TfrmODMeds.txtSupplyChange(Sender: TObject); begin inherited; if Changing then Exit; if not Showing then Exit; if FNoZERO = False then FNoZERO := True; // if value = 0, change probably caused by the spin button if txtSupply.Text <> '0' then txtSupply.Tag := 1; UpdateRelated; end; procedure TfrmODMeds.txtQuantityChange(Sender: TObject); begin inherited; if Changing then Exit; if not Showing then begin if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then begin Changing := True; txtQuantity.Text := FloattoStr(FLastQuantity); Changing := False; end; Exit; end; if FNoZERO = False then FNoZERO := True; // if value = 0, change probably caused by the spin button if txtQuantity.Text <> '0' then txtQuantity.Tag := 1; UpdateRelated; end; { values changing } function TfrmODMeds.OutpatientSig: string; var Dose, Route, Schedule, Duration, x: string; i: Integer; begin case tabDose.TabIndex of TI_DOSE: begin if ValueOf(FLD_TOTALDOSE) = '' then Dose := ValueOf(FLD_LOCALDOSE) else Dose := ValueOf(FLD_UNITNOUN); CheckDecimal(Dose); Route := ValueOf(FLD_ROUTE_EX); if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route; if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM); Schedule := ValueOf(FLD_SCHED_EX); (* Schedule := Piece(Temp,U,1); if Piece(Temp,U,3) = '1' then Schedule := Schedule + ' AS NEEDED'; if UpperCase(Copy(Schedule, Length(Schedule) - 18, Length(Schedule))) = 'AS NEEDED AS NEEDED' then Schedule := Copy(Schedule, 1, Length(Schedule) - 10); *) if Length(Schedule) = 0 then begin Schedule := ValueOf(FLD_SCHEDULE); if RightStr(Schedule,3) = 'PRN' then begin Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then Schedule := Copy(Schedule,1,Length(Schedule)-1); Schedule := Schedule + ' AS NEEDED' end; end; Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule; end; TI_COMPLEX: begin with grdDoses do for i := 1 to Pred(RowCount) do begin if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue; if FDrugID = '' then begin Dose := ValueOf(FLD_DOSETEXT, i); CheckDecimal(Dose); end else begin if ValueOf(FLD_TOTALDOSE, i) = '' then Dose := ValueOf(FLD_LOCALDOSE, i) else Dose := ValueOf(FLD_UNITNOUN, i); CheckDecimal(Dose); end; Route := ValueOf(FLD_ROUTE_EX, i); if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route; if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM, i); Schedule := ValueOf(FLD_SCHED_EX, i); //if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i); if Length(Schedule) = 0 then begin Schedule := ValueOf(FLD_SCHEDULE); if RightStr(Schedule,3) = 'PRN' then begin Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then Schedule := Copy(Schedule,1,Length(Schedule)-1); Schedule := Schedule + ' AS NEEDED' end; end; Duration := ValueOf(FLD_DURATION, i); if Length(Duration) > 0 then Duration := 'FOR ' + Duration; x := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration; if i > 1 then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x else Result := x; end; {with grdDoses} end; {TI__COMPLEX} end; {case} end; function TfrmODMeds.InpatientSig: string; var Dose, Route, Schedule, Duration, x: string; i: Integer; begin case tabDose.TabIndex of TI_DOSE: begin Dose := ValueOf(FLD_LOCALDOSE); CheckDecimal(Dose); Route := ValueOf(FLD_ROUTE_AB); if Route = '' then Route := ValueOf(FLD_ROUTE_NM); Schedule := ValueOf(FLD_SCHEDULE); Result := Dose + ' ' + Route + ' ' + Schedule; end; TI_COMPLEX: begin with grdDoses do for i := 1 to Pred(RowCount) do begin if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue; if FDrugID = '' then Dose := ValueOf(FLD_DOSETEXT, i) else Dose := ValueOf(FLD_LOCALDOSE, i); CheckDecimal(Dose); Route := ValueOf(FLD_ROUTE_AB, i); if Route = '' then Route := ValueOf(FLD_ROUTE_NM, i); Schedule := ValueOf(FLD_SCHEDULE, i); Duration := ValueOf(FLD_DURATION, i); if Length(Duration) > 0 then Duration := 'FOR ' + Duration; x := Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration; if i > 1 then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x else Result := x; end; {with grdDoses} end; {TI__COMPLEX} end; {case} end; function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string; var i, DrugIndex: Integer; UnitsPerDose, Strength: Extended; Units, Noun, AName: string; begin DrugIndex := -1; for i := 0 to Pred(FAllDrugs.Count) do if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then begin DrugIndex := i; Break; end; Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0); Units := Piece(FAllDrugs[DrugIndex], U, 3); AName := Piece(FAllDrugs[DrugIndex], U, 4); if FAllDoses.Count > 0 then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4) else Noun := ''; if Strength > 0 then UnitsPerDose := ExtractFloat(ADose) / Strength else UnitsPerDose := 0; if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S') then Noun := Noun + 'S'; Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose) + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&' + Units; if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U + Result + U + ADose; Result := UpperCase(Result); end; function TfrmODMeds.FieldsForDrug(const DrugID: string): string; var i, DrugIndex: Integer; begin Result := ''; DrugIndex := -1; for i := 0 to Pred(FAllDrugs.Count) do begin if AnsiSameText(Piece(FAllDrugs[i], U, 1), DrugID) then DrugIndex := i; end; if DrugIndex > -1 then Result := FAllDrugs[DrugIndex]; end; function TfrmODMeds.FieldsForDose(ARow: Integer): string; var i: Integer; DoseDrug: string; begin Result := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4); //AGP CHANGE 26.33 change for Remedy ticket 87476 fix for quick orders for complex //inpatient orders not displaying the correct unit dose in Pharmacy //if (not FInptDlg) and (Length(FDrugID) > 0) then if Length(FDrugID) > 0 then begin Result := ''; DoseDrug := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 5); if DoseDrug = '' then DoseDrug := Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 1); DoseDrug := DoseDrug + U + FDrugID; for i := 0 to Pred(FAllDoses.Count) do begin if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then begin Result := Piece(FAllDoses[i], U, 3); Break; end; {if AnsiSameText} end; {for i} if Result = '' then Result := ConstructedDoseFields(Piece(DoseDrug, U, 1)); end; end; function TfrmODMeds.FindDoseFields(const Drug, ADose: string): string; var i: Integer; x: string; begin Result := ''; x := ADose + U + Drug + U; for i := 0 to Pred(FAllDoses.Count) do begin if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then begin Result := Piece(FAllDoses[i], U, 3); Break; end; end; end; function TfrmODMeds.FindCommonDrug(DoseList: TStringList): string; // DoseList[n] = DoseText ^ Dispense Drug Pointer var i, j, UnitIndex: Integer; DrugStrength, DoseValue, UnitsPerDose: Extended; DrugOK, PossibleDoses, SplitTab: Boolean; ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string; FoundDrugs: TStringList; procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended); var i, DrugIndex: Integer; CurUnits: Extended; begin DrugIndex := -1; for i := 0 to Pred(FoundDrugs.Count) do if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i; if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else begin CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0); if UnitsPerDose > CurUnits then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose); end; end; procedure KillDrug(const ADrug: string); var i, DrugIndex: Integer; begin DrugIndex := -1; for i := 0 to Pred(FoundDrugs.Count) do if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i; if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex); end; begin Result := ''; if FInptDlg then // inpatient dialog begin DrugOK := True; for i := 0 to Pred(DoseList.Count) do begin ADrug := Piece(DoseList[i], U, 2); if ADrug = '' then DrugOK := False; if Result = '' then Result := ADrug; if not AnsiSameText(ADrug, Result) then DrugOK := False; if not DrugOK then Break; end; if not DrugOK then Result :=''; end else // outpatient dialog begin // check the dose combinations for each dispense drug FoundDrugs := TStringList.Create; try if FAllDoses.Count > 0 then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0 else PossibleDoses := False; for i := 0 to Pred(FAllDrugs.Count) do begin ADrug := Piece(FAllDrugs[i], U, 1); DrugOK := True; DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0); DrugUnits := Piece(FAllDrugs[i], U, 3); SplitTab := Piece(FAllDrugs[i], U, 5) = '1'; for j := 0 to Pred(DoseList.Count) do begin ADose:= Piece(DoseList[j], U, 1); DoseFields := FindDoseFields(ADrug, ADose); // get the idnode for the dose/drug combination if not PossibleDoses then begin if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0); end else begin DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0); if DoseValue = 0 then DoseValue := ExtractFloat(ADose); UnitsPerDose := DoseValue / DrugStrength; if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5)) then SaveDrug(ADrug, UnitsPerDose) else DrugOK := False; // make sure this dose is using the same units as the drug if DoseFields = '' then begin for UnitIndex := 1 to Length(ADose) do if not (ADose[UnitIndex] in ['0'..'9','.']) then Break; DoseUnits := Copy(ADose, UnitIndex, Length(ADose)); end else DoseUnits := Piece(DoseFields, '&', 2); if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False; end; if not DrugOK then begin KillDrug(ADrug); Break; end; {if not DrugOK} end; {with..for j} end; {for i} if FoundDrugs.Count > 0 then begin if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else begin UnitsPerDose := 99999999; for i := 0 to Pred(FoundDrugs.Count) do begin if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then begin Result := Piece(FoundDrugs[i], U, 1); UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999); end; {if StrToFloatDef} end; {for i..FoundDrugs} end; {if not..else PossibleDoses} end; {if FoundDrugs} finally FoundDrugs.Free; end; {try} end; {if..else FInptDlg} end; {FindCommonDrug} procedure TfrmODMeds.ControlChange(Sender: TObject); var x,ADose,AUnit,ADosageText: string; i, LastDose: Integer; DoseList: TStringList; begin inherited; if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills if Changing then Exit; if txtMed.Tag = 0 then Exit; ADose := ''; AUnit := ''; ADosageText := ''; FUpdated := FALSE; Responses.Clear; if self.MedName = '' then Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text) else Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), self.MedName); DoseList := TStringList.Create; case tabDose.TabIndex of TI_DOSE: begin if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then begin // try to resolve freetext dose and add it as a new item to the combobox ADosageText := cboDosage.Text; ADose := Piece(ADosageText,' ',1); Delete(ADosageText,1,Length(ADose)+1); ADosageText := ADose + Trim(ADosageText); DoseList.Add(ADosageText); FDrugID := FindCommonDrug(DoseList); if FDrugID <> '' then begin if ExtractFloat(cboDosage.Text) > 0 then begin x := ConstructedDoseFields(cboDosage.Text, TRUE); FDrugID := ''; with cboDosage do ItemIndex := cboDosage.Items.Add(x); end; end; end; x := ValueOf(FLD_DOSETEXT); Responses.Update('INSTR', 1, x, x); x := ValueOf(FLD_DRUG_ID); Responses.Update('DRUG', 1, x, ''); x := ValueOf(FLD_DOSEFLDS); Responses.Update('DOSE', 1, x, ''); x := ValueOf(FLD_STRENGTH); // if outpt or inpt order with no total dose (i.e., topical) if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '') then Responses.Update('STRENGTH', 1, x, x); // if no strength for dosage, use dispense drug name if Length(x) = 0 then begin x := ValueOf(FLD_DRUG_NM); if Length(x) > 0 then Responses.Update('NAME', 1, x, x); end; x := ValueOf(FLD_ROUTE_AB); if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM); if Length(ValueOf(FLD_ROUTE_ID)) > 0 then Responses.Update('ROUTE', 1, ValueOf(FLD_ROUTE_ID), x) else Responses.Update('ROUTE', 1, '', x); x := ValueOf(FLD_SCHEDULE); Responses.Update('SCHEDULE', 1, x, x); if FInptDlg then begin (* AGP Change Admin Time Wrap 27.73 x := Piece(self.lblAdminSch.text,':',2); x := Copy(x,2,Length(x)); *) x := lblAdminSchGetText; if FAdminTimeText <> '' then x := ''; if x = 'Not Defined' then x := ''; Responses.Update('ADMIN',1,x,x); X := Valueof(FLD_SCHED_TYP); if self.chkPRN.Checked = true then x := 'P'; Responses.Update('SCHTYPE',1,x,x); end; end; TI_COMPLEX: begin //if txtNss.Visible then txtNss.Visible := False; with grdDoses do for i := 1 to Pred(RowCount) do begin x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 2), U, 5); if x = '' then x := Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 1); if x = '' then Continue; x := x + U + Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], U, 4), '&', 6); DoseList.Add(x); end; FDrugID := FindCommonDrug(DoseList); if FDrugID <> '' then // common drug found begin x := ValueOf(FLD_STRENGTH, 1); if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE, 1) = '') then Responses.Update('STRENGTH', 1, x, x); // if no strength, use dispense drug if Length(x) = 0 then begin x := ValueOf(FLD_DRUG_NM, 1); if Length(x) > 0 then Responses.Update('NAME', 1, x, x); end; Responses.Update('DRUG', 1, FDrugID, ''); end; {if FDrugID} LastDose := 0; with grdDoses do for i := 1 to Pred(RowCount) do if Length(ValueOf(FLD_DOSETEXT, i)) > 0 then LastDose := i; with grdDoses do for i := 1 to Pred(RowCount) do begin if Length(ValueOf(FLD_DOSETEXT, i)) = 0 then Continue; x := ValueOf(FLD_DOSETEXT, i); Responses.Update('INSTR', i, x, x); x := ValueOf(FLD_DOSEFLDS, i); Responses.Update('DOSE', i, x, ''); x := ValueOf(FLD_ROUTE_AB, i); if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM, i); if Length(ValueOf(FLD_ROUTE_ID, i)) > 0 then Responses.Update('ROUTE', i, ValueOf(FLD_ROUTE_ID, i), x) else Responses.Update('ROUTE', i, '', x); x := ValueOf(FLD_SCHEDULE, i); Responses.Update('SCHEDULE', i, x, x); if FSmplPRNChkd then // GE CQ7585 Carry PRN checked from simple to complex tab begin pnlXSchedule.Tag := 1; chkXPRN.Checked := True; //cboXScheduleClick(Self);// force onclick to fire when complex tab is entered FSmplPRNChkd := False; end; x := ValueOf(FLD_DURATION, i); Responses.Update('DAYS', i, UpperCase(x), x); if FInptDlg then begin x := ValFor(VAL_ADMINTIME,i); if FAdminTimeText <> '' then x := ''; if x = 'Not Defined' then x := ''; Responses.Update('ADMIN',i,x,x); x := Valueof(FLD_SCHED_TYP, i); if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P'; Responses.Update('SCHTYPE', i, x, x); end; x := ValueOf(FLD_SEQUENCE, i); if Uppercase(x) = 'THEN' then x := 'T' else if Uppercase(x) = 'AND' then x := 'A' else if Uppercase(x) = 'EXCEPT' then x := 'X' else x := ''; if i = LastDose then x := ''; // no conjunction for last dose Responses.Update('CONJ', i, x, x); end; {with grdDoses} end; {TI_COMPLEX} end; {case TabDose.TabIndex} DoseList.Free; Responses.Update('URGENCY', 1, ValueOf(FLD_PRIOR_ID), ''); Responses.Update('COMMENT', 1, TX_WPTYPE, ValueOf(FLD_COMMENT)); if FInptDlg then // inpatient orders begin Responses.Update('NOW', 1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM)); x := InpatientSig; Responses.Update('SIG', 1, TX_WPTYPE, x); end else // outpatient orders begin x := ValueOf(FLD_SUPPLY); Responses.Update('SUPPLY', 1, x, x); x := ValueOf(FLD_QUANTITY); Responses.Update('QTY', 1, x, x); x := ValueOf(FLD_REFILLS); Responses.Update('REFILLS', 1, x, x); x := ValueOf(FLD_SC); Responses.Update('SC', 1, x, ''); x := ValueOf(FLD_PICKUP); Responses.Update('PICKUP', 1, x, ''); x := ValueOf(FLD_PTINSTR); Responses.Update('PI', 1, TX_WPTYPE, x); x := ''; x := OutpatientSig; Responses.Update('SIG', 1, TX_WPTYPE, x); end; memOrder.Text := Responses.OrderText; end; { complex dose ------------------------------------------------------------------------------ } { General Functions - get & set cell values} function TfrmODMeds.ValFor(FieldID, ARow: Integer): string; { Contents of grid cells (Only the first tab piece for each cell is drawn) Dosage DosageFields RouteText IEN^RouteName^Abbreviation Schedule (nothing) Duration Duration^Units } begin Result := ''; if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit; with grdDoses do case FieldID of COL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 1); COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1); COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); VAL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 2); VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2); VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); VAL_ADMINTIME : Result := Piece(Cells[COL_ADMINTIME, ARow], TAB, 1); VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); VAL_CHKXPRN : Result := Cells[COL_CHKXPRN, ARow]; end; end; procedure FindInCombo(const x: string; AComboBox: TORComboBox); begin AComboBox.SetTextAutoComplete(x); end; (* procedure TfrmODMeds.DurationToDays; var i, DoseHours, TotalHours: Integer; AllRows: Boolean; Days: Extended; x: string; begin Exit; // don't try to figure out days supply from duration for now if txtSupply.Tag = 1 then Exit; AllRows := True; with grdDoses do for i := 1 to Pred(RowCount) do if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0) then AllRows := False; if not AllRows then Exit; Changing := True; TotalHours := 0; with grdDoses do for i := 1 to Pred(RowCount) do if Length(ValFor(COL_DOSAGE, i)) > 0 then begin x := ValFor(VAL_DURATION, i); if Piece(x, U, 2) = 'D' then DoseHours := ExtractInteger(x) * 24 else DoseHours := ExtractInteger(x); TotalHours := TotalHours + DoseHours; end; Days := TotalHours / 24; if Days > Int(Days) then Days := Days + 1; txtSupply.Text := IntToStr(Trunc(Days)); //timDayQty.Tag := TIMER_FROM_DAYS; //timDayQtyTimer(Self); Changing := False; end; *) function TfrmODMeds.DurationToDays: Integer; var i, DoseMinutes, AndMinutes, TotalMinutes: Integer; AllRows: Boolean; Days: Extended; x: string; begin Result := 0; // make sure a duration exists for all rows with a dose AllRows := True; with grdDoses do for i := 1 to Pred(RowCount) do if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0) then AllRows := False; if not AllRows then Exit; AndMinutes := 0; TotalMinutes := 0; with grdDoses do for i := 1 to Pred(RowCount) do if Length(ValFor(COL_DOSAGE, i)) > 0 then begin x := ValFor(VAL_DURATION, i); DoseMinutes := 0; if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200; if Piece(x, ' ', 2) = 'WEEKS' then DoseMinutes := ExtractInteger(x) * 10080; if Piece(x, ' ', 2) = 'DAYS' then DoseMinutes := ExtractInteger(x) * 1440; if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60; if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x); // Determine how TotalMinutes should be calculated based on conjunction if ValFor(COL_SEQUENCE, i) <> 'AND' then // 'THEN', 'EXCEPT', or '' begin if AndMinutes = 0 then TotalMinutes := TotalMinutes + DoseMinutes; if AndMinutes > 0 then begin if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes; TotalMinutes := TotalMinutes + AndMinutes; AndMinutes := 0; end; if ValFor(COL_SEQUENCE, i) = 'EXCEPT' then break; //quit out of For Loop to stop counting TotalMinutes end; if (ValFor(COL_SEQUENCE, i) = 'AND') then if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes; end; if AndMinutes > 0 then TotalMinutes := TotalMinutes + AndMinutes; Days := TotalMinutes / 1440; if Days > Int(Days) then Days := Days + 1; Result := Trunc(Days); end; procedure TfrmODMeds.pnlFieldsResize(Sender: TObject); const REL_DOSAGE = 0.38; REL_ROUTE = 0.17; REL_SCHEDULE = 0.19; REL_DURATION = 0.16; REL_ANDTHEN = 0.10; REL_ADMINTIME = 0.16; var i, ht, RowCountShowing: Integer; ColControl: TWinControl; begin inherited; with grdDoses do begin i := grdDoses.Width - 12; // 12 = 4 pixel margin + 8 pixel column 0 i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then begin ColWidths[1] := Round(REL_DOSAGE * i); // dosage ColWidths[2] := Round(REL_ROUTE * i); // route ColWidths[3] := Round(REL_SCHEDULE * i); // schedule ColWidths[4] := Round(REL_DURATION * i); // duration ColWidths[5] := Round(0 * i); // administration time grdDoses.TabStops[5] := False; ColWidths[6] := Round(REL_ANDTHEN * i); // and/then end else begin ColWidths[1] := Round(0.35 * i); // dosage ColWidths[2] := Round(0.10 * i); // route ColWidths[3] := Round(0.19 * i); // schedule ColWidths[4] := Round(0.12 * i); // duration ColWidths[5] := Round(0.16 * i); // administration time grdDoses.TabStops[5] := True; ColWidths[6] := Round(0.08 * i); // and/then end; // adjust height of grid to not show partial rows ht := pnlBottom.Top - Top - 6; ht := ht div (DefaultRowHeight+1); ht := ht * (DefaultRowHeight+1); Inc(ht, 3); Height := ht; // Move a column control if it is showing ColControl := nil; case grdDoses.Col of COL_DOSAGE:ColControl := cboXDosage; COL_ROUTE:ColControl := cboXRoute; COL_SCHEDULE:ColControl := pnlXSchedule; COL_DURATION:ColControl := pnlXDuration; COL_ADMINTIME:ColControl := pnlXAdminTime; COL_SEQUENCE:ColControl := cboXSequence; end; {case} if assigned(ColControl) and ColControl.Showing then begin RowCountShowing := (Height - 25) div (DefaultRowHeight+1); if (grdDoses.Row <= RowCountShowing) then ShowEditor(grdDoses.col, grdDoses.row, #0) else ColControl.Hide; end; end; end; procedure TfrmODMeds.grdDosesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ACol, ARow: Integer; begin inherited; grdDoses.MouseToCell(X, Y, ACol, ARow); if (ARow < 0) or (ACol < 0) then Exit; if ACol > COL_SELECT then ShowEditor(ACol, ARow, #0) else begin grdDoses.Col := COL_DOSAGE; grdDoses.Row := ARow; end; if grdDoses.Col <> COL_DOSAGE then DropLastSequence; end; procedure TfrmODMeds.grdDosesKeyPress(Sender: TObject; var Key: Char); begin inherited; if Key in [#32..#127] then ShowEditor(grdDoses.Col, grdDoses.Row, Key); if grdDoses.Col <> COL_DOSAGE then DropLastSequence; end; procedure TfrmODMeds.grdDosesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; case FDropColumn of COL_DOSAGE: with cboXDosage do if Items.Count > 0 then DroppedDown := True; COL_ROUTE: with cboXRoute do if Items.Count > 0 then DroppedDown := True; COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True; COL_SEQUENCE: with cboXSequence do if Items.Count > 0 then DroppedDown := True; end; FDropColumn := -1; end; procedure TfrmODMeds.grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin inherited; grdDoses.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Piece(grdDoses.Cells[ACol, ARow], TAB, 1)); end; procedure TfrmODMeds.grdDosesExit(Sender: TObject); begin inherited; UpdateRelated(FALSE); RestoreDefaultButton; RestoreCancelButton; end; procedure TfrmODMeds.ShowEditor(ACol, ARow: Integer; AChar: Char); var x,tmpText: string; procedure PlaceControl(AControl: TWinControl); var ARect: TRect; begin with AControl do begin ARect := grdDoses.CellRect(ACol, ARow); SetBounds(ARect.Left + grdDoses.Left + 1, ARect.Top + grdDoses.Top + 1, ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1); Tag := ARow; BringToFront; Show; SetFocus; end; end; procedure SynchCombo(ACombo: TORComboBox; const ItemText, EditText: string); var i: Integer; begin ACombo.ItemIndex := -1; for i := 0 to Pred(ACombo.Items.Count) do if ACombo.Items[i] = ItemText then ACombo.ItemIndex := i; if ACombo.ItemIndex < 0 then ACombo.Text := EditText; end; begin inherited; txtNSS.Visible := False; //Make space just select editor. This blows up as soon as some joker makes a //dosage starting with a space. if AChar = ' ' then AChar := #0; if ARow = 0 then Exit; // header row // require initial instruction entry when in last row with grdDoses do if {(ARow = Pred(RowCount)) and} (ACol > COL_DOSAGE) and (ValFor(COL_DOSAGE, ARow) = '') then Exit; // require that initial instructions for rows get entered from top to bottom //(this does not include behaivor of row insertion button.) if (ACol = COL_DOSAGE) and (ARow > 1) and (ValFor(COL_DOSAGE, ARow-1) = '') then Exit; // display appropriate editor for row & column case ACol of COL_DOSAGE: begin // default route & schedule to previous row if (ARow > 1) then begin if (grdDoses.Cells[COL_ROUTE, ARow] = '') and (grdDoses.Cells[COL_SCHEDULE, ARow] = '') then begin grdDoses.Cells[COL_ROUTE, ARow] := grdDoses.Cells[COL_ROUTE, Pred(ARow)]; { don't default schedule - recommended by Martin Lowe } //grdDoses.Cells[COL_SCHEDULE, ARow] := grdDoses.Cells[COL_SCHEDULE, Pred(ARow)]; end; //AGP Change 26.45 remove auto-populate of the sequence field {* if grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] = '' then begin if StrToIntDef(Piece(grdDoses.Cells[COL_DURATION, Pred(ARow)], ' ', 1), 0) > 0 then grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'THEN' else grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'AND'; end; *} end; // set appropriate value for cboDosage SynchCombo(cboXDosage, ValFor(VAL_DOSAGE, ARow), ValFor(COL_DOSAGE, ARow)); PlaceControl(cboXDosage); FDropColumn := COL_DOSAGE; if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DOSAGE); end; COL_ROUTE: begin // set appropriate value for cboRoute SynchCombo(cboXRoute, ValFor(VAL_ROUTE, ARow), ValFor(COL_ROUTE, ARow)); PlaceControl(cboXRoute); FDropColumn := COL_ROUTE; if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_ROUTE); end; COL_SCHEDULE: begin // set appropriate value for cboSchedule if FInptDlg then txtNSS.Visible := True; x := Piece(grdDoses.Cells[COL_SCHEDULE, ARow], TAB, 1); Changing := TRUE; if ValFor(VAL_CHKXPRN,Arow)='1' then chkXPRN.Checked := true else chkXPRN.Checked := False; if Pos('PRN',x)>0 then begin cboXSchedule.SelectByID(x); if cboXSchedule.ItemIndex <0 then begin x := Trim(Copy(x, 1, Pos('PRN', x) - 1)); chkXPRN.Checked := true; end; end; if Length(x) > 0 then begin cboXSchedule.SelectByID(x); cboXSchedule.Text := x; end else cboXSchedule.ItemIndex := -1; (* if Pos('PRN', x) > 0 then begin NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1)); cboXSchedule.SelectByID(NonPRNPart); if cboXSchedule.ItemIndex > -1 then chkXPRN.Checked := True else begin chkXPRN.Checked := False; cboXSchedule.SelectByID(x); if cboXSchedule.ItemIndex < 0 then cboXSchedule.Text := x; end; end; *) Changing := FALSE; cboXSequence.Tag := ARow; PlaceControl(pnlXSchedule); FDropColumn := COL_SCHEDULE; if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE); end; COL_DURATION: begin // set appropriate value for pnlDuration x := ValFor(VAL_DURATION, ARow); Changing := TRUE; txtXDuration.Text := Piece(x, ' ', 1); x := Piece(x, ' ', 2); if Length(x) > 0 then btnXDuration.Caption := LowerCase(x) else begin txtXDuration.Text := '0'; btnXDuration.Caption := 'days'; end; tmpText := txtXDuration.Text; //Fix for CQ: 8107 - Kloogy but works. UpdateDurationControls(False); Changing := FALSE; pnlXDuration.Tag := ARow; PlaceControl(pnlXDuration); txtXDuration.SetFocus; ARow1 := ARow; txtXDuration.Text := tmpText; //Fix for CQ: 8107 - Kloogy but works. if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DURATION); end; COL_SEQUENCE: begin SynchCombo(cboXSequence, ValFor(VAL_SEQUENCE, ARow), ValFor(COL_SEQUENCE, ARow)); cboXSequence.Tag := ARow; ARow1 := ARow; PlaceControl(cboXSequence); FDropColumn := COL_SEQUENCE; if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SEQUENCE); end; COL_ADMINTIME: BEGIN pnlXAdminTime.OnClick(pnlXAdminTime); end; end; {case ACol} end; procedure TfrmODMeds.UMDelayEvent(var Message: TMessage); { after focusing events are completed for a combobox, set the key the user typed } begin case Message.LParam of COL_DOSAGE : FindInCombo(Chr(Message.WParam), cboXDosage); COL_ROUTE : FindInCombo(Chr(Message.WParam), cboXRoute); COL_SCHEDULE : FindInCombo(Chr(Message.WParam), cboXSchedule); COL_DURATION : begin txtXDuration.Text := Chr(Message.WParam); txtXDuration.SelStart := 1; end; COL_SEQUENCE : FindInCombo(Chr(Message.WParam), cboXSequence); end; end; procedure TfrmODMeds.cboXDosageEnter(Sender: TObject); begin inherited; // if this was the last row, create a new last row if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.cboXDosageChange(Sender: TObject); var temp1,temp2: string; count: integer; begin inherited; if not Changing and (cboXDosage.ItemIndex < 0) then begin Count := Pos(U,cboXDosage.Text); if Count > 0 then begin temp1 := copy(cboXDosage.Text,0,count-1); temp2 := copy(cboXDosage.Text,count+1,Length(cboXDosage.text)); infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK); cboXDosage.Text := temp1 + temp2; end; grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text; UpdateRelated; end; end; procedure TfrmODMeds.cboXDosageClick(Sender: TObject); var DispDrug: Integer; x: string; begin inherited; if FSuppressMsg then begin if PnlMessage.Visible = true then begin memMessage.SendToBack; PnlMessage.Visible := False; end; end; with cboXDosage do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := x; UpdateRelated(FALSE); DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, cboXDosage.Tag), 0); if DispDrug > 0 then begin if not FSuppressMsg then begin DispOrderMessage(DispenseMessage(DispDrug)); FSuppressMsg := False; end; x := QuantityMessage(DispDrug); end else x := ''; if Length(x) > 0 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST else lblQtyMsg.Caption := ''; end; procedure TfrmODMeds.cboXDosageExit(Sender: TObject); var //tempTag: integer; str: string; begin inherited; if cboXDosage.Showing then begin cboXDosageClick(Self); str := cboXDosage.Text; //tempTag := cboXDosage.Tag; //cboXDosage.Tag := -1; cboXDosage.Hide; UpdateRelated; RestoreDefaultButton; RestoreCancelButton; (*Probably not needed here since on validation check on accept if (LeftStr(cboXDosage.Text,1)='.') and (self.tabDose.TabIndex = TI_COMPLEX) then begin infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK); //cboXDosage.Tag := tempTag; cboXDosage.Show; cboXDosage.SetFocus; Exit; end; *) if (length(cboxdosage.Text)>0) and (cboxDosage.ItemIndex > -1) and (Piece(cboxDosage.Items.Strings[cboxDosage.ItemIndex],U,5) <> Piece(cboxDosage.Text,'#',1)) then begin cboXDosage.ItemIndex := -1; cboXDosage.Text := Piece(str, '#', 1); self.grdDoses.Cells[COL_DOSAGE,self.grdDoses.row] := cboXDosage.Text; UpdateRelated(false); end; if (pnlMessage.Visible) and (memMessage.TabStop) then begin pnlMessage.Parent := grdDoses.Parent; pnlMessage.TabOrder := grdDoses.TabOrder; ActiveControl := memMessage; end else if grdDoses.Showing then ActiveControl := grdDoses else ActiveControl := cboDosage; end else cmdQuit.Click; end; procedure TfrmODMeds.cboXRouteChange(Sender: TObject); begin inherited; //Commented out to fix CQ: 7280 // if cboXRoute.Text = '' then cboXRoute.ItemIndex := -1; if not Changing and (cboXRoute.ItemIndex < 0) then begin grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := cboXRoute.Text; ControlChange(Self); end; end; procedure TfrmODMeds.cboXRouteClick(Sender: TObject); var x: string; begin inherited; with cboXRoute do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := x; ControlChange(Self); end; procedure TfrmODMeds.cboXRouteExit(Sender: TObject); begin inherited; //Removed based on Site feeback. See CQ: 7518 { if Not ValidateRoute(cboXRoute) then Exit; } if Trim(cboXRoute.Text) = '' then begin cboXRoute.ItemIndex := -1; Exit; end; cboXRouteClick(Self); cboXRoute.Tag := -1; cboXRoute.Hide; RestoreDefaultButton; RestoreCancelButton; if (pnlMessage.Visible) and (memMessage.TabStop) then begin pnlMessage.Parent := grdDoses.Parent; pnlMessage.TabOrder := grdDoses.TabOrder; ActiveControl := memMessage; end else if grdDoses.Showing then ActiveControl := grdDoses else ActiveControl := cboDosage; end; procedure TfrmODMeds.pnlXScheduleEnter(Sender: TObject); begin inherited; cboXSchedule.SetFocus; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.cboXScheduleChange(Sender: TObject); var othSch, x: string; idx : integer; begin inherited; //Commented out to fix CQ: 7280 // if cboXSchedule.Text = '' then cboXSchedule.ItemIndex := -1; if not Changing {and (cboXSchedule.ItemIndex < 0)} then begin if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then begin cboXSchedule.SelectByID('OTHER'); othSch := CreateOtherScheduelComplex; if length(trim(othSch)) > 1 then begin othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime; cboXSchedule.Items.Add(othSch); idx := cboXSchedule.Items.IndexOf(Piece(OthSch, U, 1)); cboXSchedule.ItemIndex := idx; end; end; if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row; //if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row; with cboXSchedule do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x; self.cboSchedule.Text := x; //AGP Start Expired uncommented out the line if FInptDlg then UpdateStartExpires(Piece(x, tab, 1)); UpdateRelated; end; end; procedure TfrmODMeds.cboXScheduleClick(Sender: TObject); var PRN,x: string; begin inherited; //agp change CQ 11015 if (chkXPRN.Checked) then PRN := ' PRN' else PRN := ''; with cboXSchedule do begin if RightStr(Text,3) = 'PRN' then PRN := ''; if ItemIndex > -1 then x := Text + PRN + TAB + Items[ItemIndex] else x := Text + PRN; end; (* with cboXSchedule do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text; *) grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x; //AGP Start Expired uncommented out the line UpdateStartExpires(Piece(x, tab, 1)); UpdateRelated; end; procedure TfrmODMeds.chkXPRNClick(Sender: TObject); var check: string; begin inherited; if self.chkXPRN.Checked = True then check := '1' else check := '0'; self.grdDoses.Cells[COL_CHKXPRN, self.grdDoses.Row] := check; if not Changing then cboXScheduleClick(Self); end; procedure TfrmODMeds.pnlXScheduleExit(Sender: TObject); begin inherited; if Not FShowPnlXScheduleOk then //Added for CQ: 7370 Exit; cboXScheduleClick(Self); pnlXSchedule.Tag := -1; pnlXSchedule.Hide; UpdateRelated; RestoreDefaultButton; RestoreCancelButton; if (pnlMessage.Visible) and (memMessage.TabStop) then begin pnlMessage.Parent := grdDoses.Parent; pnlMessage.TabOrder := grdDoses.TabOrder; ActiveControl := memMessage; end else if grdDoses.Showing then ActiveControl := grdDoses else ActiveControl := cboDosage; //AGP Start Expired commented out the line //updateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); end; procedure TfrmODMeds.pnlXAdminTimeClick(Sender: TObject); var Str: string; begin inherited; if not FInptDlg then Exit; str := 'The Administration Times for this dose are: ' + CRLF + CRLF + VALFOR(VAL_ADMINTIME,grddoses.Row); str := str + CRLF + CRLF + AdminTimeHelpText; infoBox(str,'Administration Time Information',MB_OK); end; procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject); begin inherited; txtXDuration.SetFocus; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.txtXDurationChange(Sender: TObject); var I, Code: Integer; OrgValue: string; begin inherited; if Changing then Exit; if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then begin Val(txtXDuration.Text, I, Code); UpdateDurationControls(Code <> 0); //Commented out the "and" to resolve CQ: 7557 if (Code <> 0) {and (I=0)} then begin ShowMsg('Please use numeric characters only.'); with txtXDuration do begin Text := IntToStr(I); SelStart := Length(Text); end; Exit; btnXDuration.Width := 8; btnXDuration.Align := alRight; spnXDuration.Visible := False; txtXduration.Align := alClient; PopDuration.Items.Tag := 0; btnXDuration.Caption := ''; end; {AGP change 26.19 for PSI-05-018 cq #7322 else if PopDuration.Items.Tag = 0 then begin PopDuration.Items.Tag := 3; //Days selection btnXDuration.Caption := 'days'; end; } grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text + ' ' + Uppercase(btnXDuration.Caption); end else //AGP CHANGE ORDER begin if not(FInptDlg) then grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := ''; OrgValue := ValFor(COL_DURATION, pnlxDuration.tag); //if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and ((ValFor(COL_SEQUENCE, ARow1) = 'THEN') and (FInptDlg)) then //AGP CHANGE ORDER //AGP change 26.33 Then/And conjunction requiring a duration to include outpatient orders also if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and (ValFor(COL_SEQUENCE, ARow1) = 'THEN') then //AGP CHANGE ORDER begin if (InfoBox('A duration is required when using "Then" as a sequence.'+CRLF+'"Then" will be remove from the sequence field if you continue'+ CRLF+'Click "OK" to continue or click "Cancel"','Duration Warning', MB_OKCANCEL)=1) then begin grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := ''; cboXSequence.Tag := ARow1; grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := ''; cboXSequence.Text := ''; cboXSequence.ItemIndex := -1; end else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := OrgValue; end else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text; end; // end; ControlChange(Self); UpdateRelated; end; procedure TfrmODMeds.pnlXDurationExit(Sender: TObject); begin inherited; pnlXDuration.Tag := -1; pnlXDuration.Hide; UpdateRelated; RestoreDefaultButton; RestoreCancelButton; if (pnlMessage.Visible) and (memMessage.TabStop) then begin pnlMessage.Parent := grdDoses.Parent; pnlMessage.TabOrder := grdDoses.TabOrder; ActiveControl := memMessage; end else if grdDoses.Showing then ActiveControl := grdDoses else ActiveControl := cboDosage; end; procedure TfrmODMeds.btnXInsertClick(Sender: TObject); var i: Integer; x1, x2: string; begin inherited; grdDoses.SetFocus; // make sure exit events for editors fire with grdDoses do begin if Row < 1 then Exit; x1 := grdDoses.Cells[COL_ROUTE, Row]; x2 := grdDoses.Cells[COL_SCHEDULE, Row]; RowCount := RowCount + 1; { move rows down } for i := Pred(RowCount) downto Succ(Row) do Rows[i] := Rows[i-1]; Rows[Row].Clear; Cells[COL_ROUTE, Row] := x1; Cells[COL_SCHEDULE, Row] := x2; Col := COL_DOSAGE; ShowEditor(COL_DOSAGE, Row, #0); end; DropLastSequence; end; procedure TfrmODMeds.btnXRemoveClick(Sender: TObject); var i: Integer; begin inherited; grdDoses.SetFocus; // make sure exit events for editors fire with grdDoses do if (Row > 0) and (RowCount > 2) then begin { move rows up } for i := Row to RowCount - 2 do Rows[i] := Rows[i+1]; RowCount := RowCount - 1; Rows[RowCount].Clear; end; DropLastSequence; ControlChange(Self); end; function TfrmODMeds.ValueOf(FieldID: Integer; ARow: Integer = -1): string; var x: string; { Contents of cboDosage DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills Contents of grid cells (Only the first tab piece for each cell is drawn) Dosage DosageFields RouteText IEN^RouteName^Abbreviation Schedule (nothing) Duration Duration^Units } // the following functions were created to get rid of a compile warning saying the // return value may be undefined - too much branching logic in the case statements // for the compiler to handle function GetSingleDoseSchedule: string; begin Result := UpperCase(Trim(cboSchedule.Text)); if chkPRN.Checked then Result := Result + ' PRN'; if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then Result := Copy(Result, 1, Length(Result) - 4); end; function GetSingleDoseScheduleEX: string; begin Result := ''; with cboSchedule do begin if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); (* if (Length(Result)=0) and (ItemIndex > -1) then begin Result := Piece(Items[ItemIndex], U, 1); if Piece(Items[ItemIndex], U, 3) = 'P' then begin if RightStr(Result,3) = 'PRN' then begin Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then Result := Copy(Result,1,Length(Result)-1); end; Result := Result + ' AS NEEDED'; end; end; end; *) if RightStr(Result,3) = 'PRN' then begin Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then Result := Copy(Result,1,Length(Result)-1); Result := Result + ' AS NEEDED' end; if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED'; if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then Result := Copy(Result, 1, Length(Result) - 10); if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then begin Result := Copy(Result, 1, Length(Result) - 13); if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED' else Result := Result + ' AS NEEDED'; end; end; end; function GetComplexDoseSchedule: string; begin with grdDoses do begin Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1); if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN'; if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then Result := Copy(Result, 1, Length(Result) - 4); end; end; function GetComplexDoseScheduleEX: string; begin with grdDoses do begin (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2); if Result = '' then //Added for CQ: 7639 begin Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); if RightStr(Result,4) = ' PRN' then Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN end; if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <> Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0) then Result := Result + ' AS NEEDED'; end;*) Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2); if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1); if RightStr(Result,3) = 'PRN' then begin Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then Result := Copy(Result,1,Length(Result)-1); Result := Result + ' AS NEEDED'; end; if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED'; if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then Result := Copy(Result, 1, Length(Result) - 10); if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then begin Result := Copy(Result, 1, Length(Result) - 13); if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED' else Result := Result + ' AS NEEDED'; end; end; end; begin Result := ''; if ARow < 0 then // use single dose controls begin case FieldID of FLD_DOSETEXT : with cboDosage do if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5)) else Result := Uppercase(Text); FLD_LOCALDOSE : with cboDosage do if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5) else Result := Uppercase(Text); FLD_STRENGTH : with cboDosage do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2); FLD_DRUG_ID : with cboDosage do if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6); FLD_DRUG_NM : with cboDosage do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1); FLD_DOSEFLDS : with cboDosage do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4); FLD_TOTALDOSE : with cboDosage do if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1); FLD_UNITNOUN : with cboDosage do if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' ' + Piece(Piece(Items[ItemIndex], U, 4), '&', 4); FLD_ROUTE_ID : with cboRoute do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1); FLD_ROUTE_NM : with cboRoute do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2) else Result := Text; FLD_ROUTE_AB : with cboRoute do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3); FLD_ROUTE_EX : with cboRoute do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4); FLD_SCHEDULE : begin Result := GetSingleDoseSchedule; end; FLD_SCHED_EX : begin Result := GetSingleDoseScheduleEX; end; FLD_SCHED_TYP : with cboSchedule do if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3); FLD_QTYDISP : with cboDosage do begin if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8); if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8); if Result <> '' then Result := 'Qty (' + Result + ')' else Result := 'Quantity'; end; end; {case FieldID} // use complex dose controls end else begin if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit; if Length(FDrugID) > 0 then x := FieldsForDose(ARow) else x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4); with grdDoses do case FieldID of FLD_DOSETEXT : Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1)); FLD_LOCALDOSE : begin if (Length(x) > 0) and (Length(FDrugID) > 0) then Result := Piece(x, '&', 5) else Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1)); end; FLD_STRENGTH : Result := Piece(x, '&', 7) + Piece(x, '&', 8); FLD_DRUG_ID : Result := Piece(x, '&', 6); FLD_DRUG_NM : Result := Piece(FieldsForDrug(Piece(x, '&', 6)), U, 4); FLD_DOSEFLDS : Result := x; FLD_TOTALDOSE : Result := Piece(x, '&', 1); FLD_UNITNOUN : Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4); FLD_ROUTE_ID : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 1); FLD_ROUTE_NM : begin Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 2); if Result = '' then Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1); end; FLD_ROUTE_AB : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 3); FLD_ROUTE_EX : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4); FLD_SCHEDULE : begin Result := GetComplexDoseSchedule; end; FLD_SCHED_EX : begin Result := GetComplexDoseScheduleEX; end; FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3); FLD_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1); FLD_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1); end; {case FieldID} end; {if ARow} if FieldID > FLD_MISC_FLDS then // still need to process 'non-sig' fields begin case FieldID of FLD_SUPPLY : Result := Trim(txtSupply.Text); FLD_QUANTITY : begin if Pos(',', txtQuantity.Text)>0 then Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2) else Result := Trim(txtQuantity.Text); end; FLD_REFILLS : Result := txtRefills.Text; FLD_PICKUP : if radPickWindow.Checked then Result := 'W' else if radPickMail.Checked then Result := 'M' else if radPickClinic.Checked then Result := 'C' else Result := ''; FLD_PRIOR_ID : Result := cboPriority.ItemID; FLD_PRIOR_NM : Result := cboPriority.Text; FLD_COMMENT : Result := memComment.Text; FLD_NOW_ID : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1' else Result := ''; FLD_NOW_NM : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := ''; FLD_PTINSTR : if chkPtInstruct.Visible and chkPtInstruct.Checked then Result := FPtInstruct else Result := ' '; end; {case FieldID} end; {if FieldID} end; function TfrmODMeds.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string; var x: string; begin case FieldID of FLD_SCHEDULE : Result := Responses.IValueFor('SCHEDULE', AnInstance); FLD_UNITNOUN : begin x := Responses.IValueFor('DOSE', AnInstance); Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4); end; FLD_DOSEUNIT : begin x := Responses.IValueFor('DOSE', AnInstance); Result := Piece(x, '&', 3); end; FLD_DRUG_ID : Result := Responses.IValueFor('DRUG', AnInstance); FLD_INSTRUCT : Result := Responses.IValueFor('INSTR', AnInstance); FLD_SUPPLY : Result := Responses.IValueFor('SUPPLY', AnInstance); FLD_QUANTITY : Result := Responses.IValueFor('QTY', AnInstance); FLD_ROUTE_ID : Result := Responses.IValueFor('ROUTE', AnInstance); FLD_EXPIRE : Result := Responses.IValueFor('DAYS', AnInstance); FLD_ANDTHEN : Result := Responses.IValueFor('CONJ', AnInstance); end; end; procedure TfrmODMeds.UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean); var ADrug: string; Checked: boolean; tmpSupply: integer; begin Checked := false; if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> '')) or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or ((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial)) then begin Checked := True; ADrug := Piece(CurDispDrug, U, 1); CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule); if CurSupply > 0 then begin spnSupply.Position := CurSupply; if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then txtSupply.Text := IntToStr(CurSupply); if (FIsQuickOrder) and (FQOInitial) and (IsClozapineOrder = false) then begin if StrToFloatDef(txtSupply.Text,0) > 0 then begin Exit; end; end; CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); if CurQuantity >= 0 then begin //spnQuantity.Position := CurQuantity; if txtQuantity.Text <> '' then txtQuantity.Text := FloatToStr(CurQuantity); if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) then txtQuantity.Text := FloatToStr(CurQuantity); end; SkipQtyCheck := TRUE; end; if FQOInitial = true then FQOInitial := False; end; if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then begin ADrug := Piece(CurDispDrug, U, 1); tmpSupply := DefaultDays(ADrug, CurUnits, CurSchedule); if (tmpSupply > 0) and (CurSupply > tmpSupply) then begin CurSupply := tmpSupply; spnSupply.Position := CurSupply; if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then txtSupply.Text := IntToStr(CurSupply); end; CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); if CurQuantity >= 0 then begin //spnQuantity.Position := CurQuantity; if (txtQuantity.Text <> '') and (CurQuantity > 0) then txtQuantity.Text := FloatToStr(CurQuantity); if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) and (CurQuantity > 0) then txtQuantity.Text := FloatToStr(CurQuantity); end; end; end; procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string; var CurSupply: Integer; var CurQuantity: double); const UPD_NONE = 0; UPD_QUANTITY = 1; UPD_SUPPLY = 2; UPD_COMPLEX = 3; UPD_BOTH = 4; var UpdateControl, NewSupply: Integer; ADrug: string; SaveChanging: Boolean; tmpQuty: Double; begin tmpQuty := 0; if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then begin // set days supply based on durations NewSupply := DurationToDays; if NewSupply > 0 then begin SaveChanging := Changing; Changing := TRUE; txtSupply.Text := IntToStr(NewSupply); CurSupply := NewSupply; Changing := SaveChanging; end; end; // exit if not enough fields to calculation supply or quantity if (CurQuantity = 0) and (CurSupply = 0) then Exit; // exit if nothing has changed if (CurUnits = FLastUnits) and (CurSchedule = FLastSchedule) and (CurDuration = FLastDuration) and (CurQuantity = FLastQuantity) and (CurSupply = FLastSupply) then Exit; // exit if supply & quantity have both been directly edited if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit; // figure out which control to update UpdateControl := UPD_NONE; if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) and (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) and Changing then UpdateControl := UPD_BOTH else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY; if (UpdateControl = UPD_NONE) and ((CurUnits <> FLastUnits) or (CurSchedule <> FLastSchedule)) then begin if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY; end; ADrug := Piece(CurDispDrug, U, 1); // just use the first dispense drug (for clozapine chk) case UpdateControl of UPD_QUANTITY : begin if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then begin FQOInitial := False; Exit; end; if FIsQuickOrder and (CurQuantity > 0) then tmpQuty := CurQuantity; CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); if (tmpQuty > 0) and (CurQuantity <= 0) then begin txtQuantity.Text := FloatToStr(tmpQuty); CurQuantity := tmpQuty; end else if (CurQuantity >= 0) then txtQuantity.Text := FloatToStr(CurQuantity); end; UPD_SUPPLY : begin CurSupply := QtyToDays(CurQuantity, CurUnits, CurSchedule, CurDuration, ADrug); if CurSupply > 0 then txtSupply.Text := IntToStr(CurSupply); end; UPD_BOTH : begin txtSupply.Text := IntToStr(CurSupply); tmpQuty := 0; if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then begin FQOInitial := False; Exit; end; if FIsQuickOrder and (CurQuantity > 0) then tmpQuty := CurQuantity; CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug); if (tmpQuty > 0) and (CurQuantity <= 0) then begin txtQuantity.Text := FloatToStr(tmpQuty); CurQuantity := tmpQuty; end else if CurQuantity >= 0 then txtQuantity.Text := FloatToStr(CurQuantity); end; end; if UpdateControl > UPD_NONE then FUpdated := True; end; procedure TfrmODMeds.updateSig; begin inherited; if self.tabDose.TabIndex = TI_DOSE then self.cboDosage.OnExit(cboDosage); if self.tabDose.TabIndex = TI_COMPLEX then self.cboxDosage.OnExit(cboxDosage); end; procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string); var CompSch, CompDose, LastSch, ShowText, Duration, ASchedule, TempSch, schType, Admin, tempAdmin: string; AdminTime: TFMDateTime; j, r, Interval, PrnPos, SchID: Integer; EndCheck, rowCheck, DoseNow: boolean; begin if not FInptDlg then Exit; if Length(CurSchedule)=0 then Exit; ASchedule := Trim(CurSchedule); DoseNow := True; if self.EvtID > 0 then DoseNow := false; if (Pos('^',ASchedule)>0) then begin PrnPos := Pos('PRN',ASchedule); if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then Delete(ASchedule, PrnPos-1, 4); end; if (FAdminTimeText = '') and (self.EvtID > 0) then FAdminTimeText := 'To Be Determined'; AdminTime := 0; ASchedule := Trim(ASchedule); //AGP Change for CQ 9906 EndCheck := False; lastSch := ''; if self.tabDose.TabIndex = TI_COMPLEX then begin tempSch := ASchedule; ASchedule := ''; for r := 1 to self.grdDoses.RowCount-1 do begin CompSch := valFor(VAL_SCHEDULE,r); CompDose := valFor(VAL_DOSAGE,r); RowCheck := valFor(VAL_CHKXPRN,r)='1'; if (RowCheck = True) then begin if EndCheck = false then AdminTime := -1; if FAdminTimeText = '' then self.grdDoses.cells[COL_ADMINTIME, r] := '' else Self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText; end else begin if CompSch <> '' then begin //cboXSchedule.Items.IndexOfName(CompSch); //cboXSchedule.SelectByID(CompSch); SchID := -1; for j := 0 to cboXSchedule.Items.Count - 1 do begin if Piece(cboXSchedule.Items.Strings[j], U, 1) = CompSch then begin schID := j; break; end; end; //if cboXSchedule.ItemIndex > -1 then if SchID > -1 then begin //SchID := cboXSchedule.ItemIndex; if (Piece(self.cboXSchedule.Items.Strings[SchID],U,1) = CompSch) then begin SchType := Piece(self.cboXSchedule.Items.Strings[SchID],U,3); if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') then self.grdDoses.Cells[COL_ADMINTIME, r] := '' else if FAdminTimeText <> '' then self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText else begin self.grdDoses.Cells[COL_ADMINTIME, r] := Piece(self.cboXSchedule.Items.Strings[SchID],U,4); if self.grdDoses.Cells[COL_ADMINTIME, r] = '' then self.grdDoses.Cells[COL_ADMINTIME, r] := 'Not Defined'; end; if CompDose <> '' then begin lastSch := CompSch; if (EndCheck = False) and ((SchType = 'P') or (SchType = 'O')) then AdminTime := -1 //else Aschedule := ';' + CompSch; end; end; end; end; end; if ((valFor(VAL_SEQUENCE,r) = 'AND') or (valFor(VAL_SEQUENCE,r) = '')) and (AdminTime > -1) and (EndCheck = false) then begin //if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch; if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch; if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch; end else if ValFor(VAL_SEQUENCE, r) = 'THEN' then begin // if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch; if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch; if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch; EndCheck := True; end end; end; if self.tabDose.TabIndex = TI_DOSE then begin if LeftStr(ASchedule, 1) = ';' then tempSch := Piece(ASchedule, ';', 2) else tempSch := ASchedule; if self.chkPRN.Checked = True then begin AdminTime := -1; lblAdminSchSetText(''); if (cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3) = 'O') then DoseNow := false; end else begin //cboSchedule.SelectByID(tempSch); SchID := -1; for j := 0 to cboSchedule.Items.Count - 1 do begin if Piece(cboSchedule.Items.Strings[j], U, 1) = tempSch then begin schID := j; break; end; end; if schID > -1 then begin SchType := Piece(self.cboSchedule.Items.Strings[schID], U, 3); if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then begin lblAdminSchSetText(''); if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then AdminTime := -1; if SchType = 'O' then DoseNow := false; end else begin if FAdminTimeText <> '' then tempAdmin := 'Admin. Time: ' + FAdminTimeText else begin if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then tempAdmin := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4) else tempAdmin := 'Admin. Time: Not Defined'; end; lblAdminSchSetText(tempAdmin); (* if FAdminTimeText <> '' then self.lblAdminSch.text := 'Admin. Time: ' + FAdminTimeText else begin if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then self.lblAdminSch.text := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4) else self.lblAdminSch.text := 'Admin. Time: Not Defined'; end; *) end; end; end; end; if (Length(ASchedule)>0) and (AdminTime > -1) then begin if LeftStr(Aschedule, 1) <> ';' then ASchedule := ';'+ASchedule; Admin := ''; if (self.lblAdminSch.visible = True) and (self.lblAdminSch.text <> '') and (self.tabDose.TabIndex = TI_DOSE) then begin //AGP Change Admin Time Wrap 27.73 //Admin := Copy(self.lblAdminSch.text, 14, (Length(self.lblAdminSch.text)-1)); Admin := lblAdminSchGetText; if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := ''; end else if self.tabDose.TabIndex = TI_COMPLEX then begin Admin := Self.grdDoses.Cells[COL_ADMINTIME, 1]; if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := ''; end; LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration, Admin); end; if AdminTime > 0 then begin ShowText := 'Expected First Dose: '; Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday)); case Interval of 0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime); 1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime); else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime); end; if (Pos('PRN',Piece(CurSchedule,'^',1))>0) and ((pnlXSchedule.Tag = 1) or chkPrn.Checked ) then begin if lblAdmintime.visible then begin lblAdmintime.Caption := ''; FAdminTimeLbl := lblAdminTime.Caption; end; end else lblAdminTime.Caption := ShowText; FAdminTimeLbl := lblAdminTime.Caption; end else lblAdminTime.Caption := ''; if (lblAdminTime.Caption <> '') and (lblAdminTime.Visible = True) and (JAWSON = true) then lblAdminTime.TabStop := true else lblAdminTime.TabStop := false; if (lblAdminSch.text <> '') and (lblAdminSch.Visible = True) and (JAWSON = true) then lblAdminSch.TabStop := true else lblAdminSch.TabStop := false; DisplayDoseNow(DoseNow); end; procedure TfrmODMeds.UpdateRefills(const CurDispDrug: string; CurSupply: Integer); begin if EvtForPassDischarge = 'D' then spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, True) else spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D'); if (StrToIntDef(txtRefills.Text, 0) > spnRefills.Max) then begin txtRefills.Text := IntToStr(spnRefills.Max); spnRefills.Position := spnRefills.Max; FUpdated := True; end; end; procedure TfrmODMeds.UpdateRelated(DelayUpdate: Boolean = TRUE); begin timCheckChanges.Enabled := False; // turn off timer if DelayUpdate then timCheckChanges.Enabled := True // restart timer else timCheckChangesTimer(Self); // otherwise call directly end; procedure TfrmODMeds.timCheckChangesTimer(Sender: TObject); const UPD_NONE = 0; UPD_QUANTITY = 1; UPD_SUPPLY = 2; var CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string; CurScheduleIN, CurScheduleOut: string; CurSupply, i, pNum, j: Integer; CurQuantity: double; LackQtyInfo, SaveChanging: Boolean; begin inherited; timCheckChanges.Enabled := False; ControlChange(Self); SaveChanging := Changing; Changing := TRUE; // don't allow Exit procedure so Changing gets reset appropriately CurUnits := ''; CurSchedule := ''; CurDuration := ''; LackQtyInfo := False; i := Responses.NextInstance('DOSE', 0); while i > 0 do begin x := ValueOfResponse(FLD_DOSEUNIT, i); if (x = '') and (not FIsQuickOrder) then LackQtyInfo := TRUE //StrToIntDef(x, 0) = 0 else if (x = '') and FIsQuickOrder and (Length(txtQuantity.Text)>0) then LackQtyInfo := false; CurUnits := CurUnits + x + U; x := ValueOfResponse(FLD_SCHEDULE, i); if Length(x) = 0 then LackQtyInfo := TRUE; CurScheduleOut := CurScheduleOut + x + U; x1 := ValueOf(FLD_SEQUENCE,i); if Length(x1)>0 then begin X1 := CharAt(X1,1); CurScheduleIn := CurScheduleIn + x1 + ';' + x + U; end else CurScheduleIn := CurScheduleIn + ';' + x + U; x := ValueOfResponse(FLD_EXPIRE, i); CurDuration := CurDuration + x + '~'; x := ValueOfResponse(FLD_ANDTHEN, i); CurDuration := CurDuration + x + U; x := ValueOfResponse(FLD_DRUG_ID, i); CurDispDrug := CurDispDrug + x + U; x := ValueOfResponse(FLD_INSTRUCT, i); CurInstruct := CurInstruct + x + U; //AGP CHANGE 26.19 FOR CQ 7465 i := Responses.NextInstance('DOSE', i); end; pNum := 1; while Length( Piece(CurScheduleIn,U,pNum)) > 0 do pNum := pNum + 1; if Length(Piece(CurScheduleIn,U,pNum)) < 1 then for j := 1 to pNum - 1 do begin if j = pNum -1 then TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2) else TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U end; CurScheduleIn := TmpSchedule; CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0); CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0); //CurRefill := StrToIntDef(ValueOfResponse(FLD_REFILLS) , 0); if FInptDlg then begin CurSchedule := CurScheduleIn; if Pos('^',CurSchedule)>0 then begin if Pos('PRN',Piece(CurSchedule,'^',1))>0 then if lblAdminTime.Visible then lblAdminTime.Caption := ''; end; if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule); //AGP remove this code for CQ 11772 (*if (ValueOf(FLD_SCHED_TYP) = 'O') or (Responses.EventType in ['A','D','T','M','O']) or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then begin if (chkDoseNow.Checked) and (chkDoseNow.Visible) then begin chkDoseNowClick(Self); chkDoseNow.Checked := False; end; chkDoseNow.Visible := False; lblAdminTime.Visible := False; end else begin chkDoseNow.Visible := TRUE; lblAdminTime.Visible := not chkDoseNow.Checked; end; *) if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False; end; if not FInptDlg then begin CurSchedule := CurScheduleOut; if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity, LackQtyInfo); if LackQtyInfo then begin if FScheduleChanged then txtQuantity.Text := '0'; end else UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity); // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug); if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then UpdateRefills(CurDispDrug, CurSupply); end; FLastUnits := CurUnits; FLastSchedule := CurSchedule; FLastDuration := CurDuration; FLastInstruct := CurInstruct; FLastDispDrug := CurDispDrug; FLastQuantity := CurQuantity; FLastSupply := CurSupply; if (not FNoZERO) and (txtQuantity.Text = '') and (FLastQuantity = 0) then txtQuantity.Text := FloatToStr(FLastQuantity); if (not FNoZERO) and (txtSupply.Text = '') and (FLastSupply = 0) then txtSupply.Text := IntToStr(FLastSupply); if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage) then cboDosage.Text := Piece(cboDosage.Text, TAB, 1); Changing := SaveChanging; if FUpdated then ControlChange(Self); FScheduleChanged := false; end; procedure TfrmODMeds.cmdAcceptClick(Sender: TObject); var i: integer; begin if (FInptDlg) and (cboSchedule.Text = 'OTHER') then begin cboScheduleClick(Self); Exit; end; //AGP Change for 26.45 PSI-04-069 if self.tabDose.TabIndex = 1 then begin for i := 2 to self.grdDoses.RowCount do begin if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then begin infoBox('To be able to complete a complex order every row except for the last row must have a conjunction defined. ' + CRLF + CRLF + 'Verify that all rows have a conjunction defined.','Sequence Error',MB_OK); Exit; end; //text := Self.cboXDosage.Items.Strings[i]; end; end; if FInptDlg and (not FOutptIV) then DisplayGroup := DisplayGroupByName('UD RX') else DisplayGroup := DisplayGroupByName('O RX'); (* if (Not FInptDlg) then begin if (ValidateDaySupplyandQuantity(strtoInt(txtSupply.Text), strtoInt(txtQuantity.text)) = false) then Exit else ClearMaxData; end; *) //if (Not FInptDlg) and (ValidateMaxQuantity(strtoInt(txtQuantity.Text)) = false) then Exit; //timCheckChangesTimer(Self); DropLastSequence; cmdAccept.SetFocus; inherited; (*if self.Responses.Cancel = true then begin self.Destroy; exit; end; *) end; procedure TfrmODMeds.chkPtInstructClick(Sender: TObject); begin inherited; ControlChange(Self); end; procedure TfrmODMeds.chkDoseNowClick(Sender: TObject); const T = '"'; T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "'; T2 = #13#13'The first order''s administrative schedule is "'; T3 = #13'The second order''s administrative schedule is "'; T4 = #13#13'Do you want to continue?'; T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"'; T2A = ' in addition to the one you are placing for the same medication "'; var medNm: string; theSch: string; begin inherited; if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then begin medNm := txtMed.Text; theSch := cboSchedule.Text; if length(theSch)>0 then begin //if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then begin chkDoseNow.Checked := False; Exit; end; end else begin if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then begin chkDoseNow.Checked := False; Exit; end; end; end; lblAdminTime.Visible := not chkDoseNow.Checked; if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked then begin if (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF + 'Please adjust the duration of the first row, if necessary.', 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then begin chkDoseNow.Checked := False; Exit; end; end; ControlChange(Self); end; procedure TfrmODMeds.CheckDecimal(var AStr: string); var DUName,UnitNum,tempStr: string; ToWord: string; ie,code: integer; begin ToWord := ''; tempStr := AStr; UnitNum := Piece(AStr,' ',1); DUName := Copy(tempStr,Length(UnitNum)+1,Length(tempStr)); DUName := Trim(DUName); if CharAt(UnitNum,1)='.' then begin if CharAt(UnitNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then begin UnitNum := '0' + UnitNum; AStr := '0' + AStr; end; end; if ((Pos('TABLET',upperCase(DUName))= 0)) and ( Pos('DROP',upperCase(DUName))= 0 )then Exit; if (Length(UnitNum)>0) and (Length(DUName)>0) then begin if CharAt(UnitNum,1) <> '0' then begin Val(UnitNum, ie, code); if (code <> 0) and (ie=0) then Exit; end; AStr := TextDosage(UnitNum) + ' ' + DUName; end; end; procedure TfrmODMeds.DropLastSequence(ASign: integer); const TXT_CONJUNCTIONWARNING = 'is not associated with the comment field, and has been deleted.'; var i :integer; StrConjunc: string; begin for i := 1 to grdDoses.RowCount - 1 do begin if (i = 1) and (grdDoses.Cells[COL_DOSAGE,i] = '' ) then Exit else if (i>1) and (grdDoses.Cells[COL_DOSAGE,i] = '') and (grdDoses.Cells[COL_ROUTE,i] = '') then begin if Length(grdDoses.Cells[COL_SEQUENCE, i-1])>0 then begin StrConjunc := grdDoses.Cells[COL_SEQUENCE, i-1]; if ASign = 1 then begin if InfoBox('The "' + StrConjunc + '" ' + TXT_CONJUNCTIONWARNING, 'Warning', MB_OK or MB_ICONWARNING) = IDOK then begin grdDoses.Cells[COL_SEQUENCE, i-1] := ''; ActiveControl := memOrder; end end else begin grdDoses.Cells[COL_SEQUENCE, i-1] := ''; end; end; Exit; end; end; end; procedure TfrmODMeds.memCommentClick(Sender: TObject); var theSign : integer; begin inherited; theSign := 1; DropLastSequence(theSign); end; procedure TfrmODMeds.btnXDurationClick(Sender: TObject); var APoint: TPoint; begin inherited; with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height)); popDuration.Popup(APoint.X, APoint.Y); end; procedure TfrmODMeds.chkPRNClick(Sender: TObject); var tempSch: string; PRNPos: integer; begin inherited; //GE CQ 7552 if chkPRN.Checked then begin lblAdminTime.Caption := ''; PrnPos := Pos('PRN',cboSchedule.Text); if (PrnPos < 1) then UpdateStartExpires(cboSchedule.Text + ' PRN'); end else begin if Length(Trim(cboSchedule.Text))>0 then begin tempSch := ';'+Trim(cboSchedule.Text); UpdateStartExpires(tempSch); end; //lblAdminTime.Caption := FAdminTimeLbl; if txtQuantity.visible then cboScheduleClick(Self); end; ControlChange(Self); end; procedure TfrmODMeds.grdDosesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; case Key of // VK_RETURN: //moved to form key press VK_RIGHT: begin if (not FInptDlg) and (self.grdDoses.Col = COL_DURATION) then begin self.grdDoses.Col := COL_SEQUENCE; Key := 0; end; end; VK_LEFT: begin if (not FInptDlg) and (self.grdDoses.Col = COL_SEQUENCE) then begin self.grdDoses.Col := COL_DURATION; Key := 0; end; end; VK_ESCAPE: begin ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control Key := 0; end; VK_INSERT: begin btnXInsertClick(self); Key := 0; end; VK_DELETE: begin btnXRemoveClick(self); Key := 0; end; VK_TAB: begin if ssShift in Shift then begin ActiveControl := tabDose; //Previeous control Key := 0; end else if ssCtrl in Shift then begin ActiveControl := memComment; Key := 0; end; end; end; end; procedure TfrmODMeds.grdDosesEnter(Sender: TObject); begin inherited; DisableDefaultButton(self); DisableCancelButton(self); end; function TfrmODMeds.DisableCancelButton(Control: TWinControl): boolean; var i: integer; begin if (Control is TButton) and TButton(Control).Cancel then begin result := True; FDisabledCancelButton := TButton(Control); TButton(Control).Cancel := False; end else begin result := False; for i := 0 to Control.ControlCount-1 do if (Control.Controls[i] is TWinControl) then if DisableCancelButton(TWinControl(Control.Controls[i])) then begin result := True; break; end; end; end; function TfrmODMeds.DisableDefaultButton(Control: TWinControl): boolean; var i: integer; begin if (Control is TButton) and TButton(Control).Default then begin result := True; FDisabledDefaultButton := TButton(Control); TButton(Control).Default := False; end else begin result := False; for i := 0 to Control.ControlCount-1 do if (Control.Controls[i] is TWinControl) then if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin result := True; break; end; end; end; procedure TfrmODMeds.RestoreCancelButton; begin if Assigned(FDisabledCancelButton) then begin FDisabledCancelButton.Cancel := True; FDisabledCancelButton := nil; end; end; procedure TfrmODMeds.RestoreDefaultButton; begin if Assigned(FDisabledDefaultButton) then begin FDisabledDefaultButton.Default := True; FDisabledDefaultButton := nil; end; end; procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char); begin (* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then begin ShowEditor(grdDoses.Col, grdDoses.Row, #0); Key := #0; //Don't let the base class turn it into a forward tab! end *) //else if (Key = #13) and (ActiveControl = txtMed) then Key := #0; //Don't let the base class turn it into a forward tab! end; procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = VK_TAB) and (ssCtrl in Shift) and (ActiveControl <> grdDoses) then begin //Back-tab works the same as forward-tab because there are only two tabs. tabDose.TabIndex := (tabDose.TabIndex + 1) mod tabDose.Tabs.Count; Key := 0; tabDoseChange(tabDose); end; end; procedure TfrmODMeds.cboXRouteEnter(Sender: TObject); begin inherited; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.pnlMessageEnter(Sender: TObject); begin inherited; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.pnlMessageExit(Sender: TObject); begin inherited; RestoreDefaultButton; RestoreCancelButton; end; procedure TfrmODMeds.memMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = VK_RETURN) or (Key = VK_ESCAPE) then begin Perform(WM_NEXTDLGCTL, 0, 0); Key := 0; end; end; procedure TfrmODMeds.memPIClick(Sender: TObject); begin inherited; ShowMsg('The patient instruction field may not be edited.'); chkPtInstruct.SetFocus; end; procedure TfrmODMeds.FormResize(Sender: TObject); var aftHeight: integer; tempAdmin: string; begin inherited; pnlFields.Height := memOrder.Top - 4 - pnlFields.Top; aftHeight := pnlFields.Top + pnlFields.Height + memOrder.Height; if aftHeight > Height then Height := aftHeight; if pnlMessage.Visible then pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8; tempAdmin := lblAdminSchGetText; if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin); end; procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; ShowMsg('The patient instruction field may not be edited.'); chkPtInstruct.SetFocus; end; function TfrmODMeds.TextDosage(ADosage: string): string; var intS, fltS: string; iNum: integer; fNum: double; begin intS := ''; fltS := ''; Result := intS + fltS; try begin iNum := StrToIntDef(Piece(ADosage,'.',1),0); fNum := StrToFloatDef('0.'+Piece(ADosage,'.',2),0); if fNum = 0.5 then fltS := 'ONE-HALF'; if ( fNum >= 0.3 ) and ( fNum <= 0.4 ) then fltS := 'ONE-THIRD'; if fNum = 0.25 then fltS := 'ONE-FOURTH'; if ( fNum >= 0.6 ) and ( fNum <= 0.7 ) then fltS := 'TWO-THIRDS'; if fNum = 0.75 then fltS := 'THREE-FOURTHS'; if iNum = 1 then intS := 'ONE'; if iNum = 2 then intS := 'TWO'; if iNum = 3 then intS := 'THREE'; if iNum = 4 then intS := 'FOUR'; if iNum = 5 then intS := 'FIVE'; if iNum = 6 then intS := 'SIX'; if iNum = 7 then intS := 'SEVEN'; if iNum = 8 then intS := 'EIGHT'; if iNum = 9 then intS := 'NINE'; if iNum = 10 then intS := 'TEN'; if Length(intS) > 0 then begin if Length(fltS)>1 then fltS :=' AND ' + fltS; end; Result := intS + fltS; if Result = '' then Result := ADosage; end except on EConvertError do Result := ''; end; end; function TfrmODMeds.CreateOtherScheduel: string; //NSS var aSchedule: string; begin aSchedule := ''; if not ShowOtherSchedule(aSchedule) then begin cboSchedule.ItemIndex := -1; cboSchedule.Text := ''; end else begin Result := Piece(aSchedule,U,1); NSSAdminTime := Piece(aschedule,u,2); NSSScheduleType := Piece(aSchedule, U, 3); if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText; end; end; function TfrmODMeds.IfIsIMODialog: boolean; var IsInptDlg, IsIMOLocation: boolean; Td: TFMDateTime; begin result := False; IsInptDlg := False; Td := FMToday; if DlgFormID = MedsInDlgFormId then IsInptDlg := TRUE; IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN); if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then result := True; end; procedure TfrmODMeds.lstChange(Sender: TObject; Item: TListItem; Change: TItemChange); begin inherited; btnSelect.Enabled := (lstAll.ItemIndex > -1) or ((lstQuick.ItemIndex > -1) and (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and (Integer(lstQuick.Selected.Data) > 0)) ; if (btnSelect.Enabled) and (FOrderAction = ORDER_EDIT) then btnSelect.Enabled := false; if (btnSelect.Enabled) and (FRemoveText) then txtMed.Text := ''; end; procedure TfrmODMeds.DisplayDoseNow(Status: boolean); begin if not FinptDlg then Status := False; if Status = false then begin if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false; self.chkDoseNow.Visible := false; end; if status = true then self.chkDoseNow.Visible := true; end; procedure TfrmODMeds.DispOrderMessage(const AMessage: string); begin if ContainsVisibleChar(AMessage) then begin image1.Visible := True; memDrugMsg.Visible := True; image1.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK); memDrugMsg.Lines.Clear; memDrugMsg.Lines.SetText(PChar(AMessage)); if fShrinkDrugMsg then begin pnlBottom.Height := pnlBottom.Height + memDrugMsg.Height + 2; fShrinkDrugMsg := False; end; end else begin image1.Visible := False; memDrugMsg.Visible := False; if not fShrinkDrugMsg then begin pnlBottom.Height := pnlBottom.Height - memDrugMsg.Height - 2; fShrinkDrugMsg := True; end; end; end; procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction); begin if FCloseCalled then Exit; //Temporary Hack: Close is called 2x for some reason & errors out FCloseCalled := true; FResizedAlready := False; inherited; end; function TfrmODMeds.CreateOtherScheduelComplex: string; var aSchedule: string; begin aSchedule := ''; if not ShowOtherSchedule(aSchedule) then begin cboXSchedule.ItemIndex := -1; cboXSchedule.Text := ''; end else begin Result := Piece(aSchedule,U,1); NSSAdminTime := Piece(aschedule,u,2); NSSScheduleType := Piece(ASchedule, U, 3); if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText; end; end; procedure TfrmODMeds.txtNSSClick(Sender: TObject); begin inherited; if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list' + ' to create a day-of-week schedule.' + #13#10 + 'Click OK to launch schedule builder', mtInformation, [mbOK, mbCancel],0) = mrOK then begin if (tabDose.TabIndex = TI_DOSE) then begin cboSchedule.SelectByID('OTHER'); cboScheduleClick(Self); end; if (tabDose.TabIndex = TI_COMPLEX) then begin cboXSchedule.SelectByID('OTHER'); CBOXScheduleChange(Self); end; end; end; procedure TfrmODMeds.cboScheduleEnter(Sender: TObject); begin inherited; if (FInptDlg) and (cboSchedule.Text = 'OTHER') then cboScheduleClick(Self); end; procedure TfrmODMeds.FormShow(Sender: TObject); begin FCloseCalled := false; inherited; if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then PostMessage(Handle, UM_NSSOTHER, 0, 0); //I was using btnSelect.Top for the following, but it gets moved around Constraints.MinHeight := Constraints.MinHeight + ((Self.Height - cmdQuit.Top) * 2); end; procedure TfrmODMeds.UMShowNSSBuilder(var Message: TMessage); begin Sleep(1000); cboScheduleClick(Self); end; procedure TfrmODMeds.cboScheduleExit(Sender: TObject); begin inherited; if Trim(cboSchedule.Text) = '' then cboSchedule.ItemIndex := -1; ValidateInpatientSchedule(cboSchedule); end; procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox); var tmpIndex : Integer; begin {CQ: 6690 - Orders - autopopulation of schedule field - overtyping only 1 character CQ: 7280 - PTM 32-34, 42 Meds: NJH-0205-20901 MED DIALOG DROPPING FIRST LETTER (schedule)} //CQ 7575 Schedule coming across lower-case, change all schedules to Upper-Case. if (Length(ScheduleCombo.Text) > 0) then ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text)); {if user entered schedule verify it is in list} if ScheduleCombo.ItemIndex < 0 then // CQ: 7397 begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text); if tmpIndex > -1 then ScheduleCombo.ItemIndex := tmpIndex; end; if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then begin FShowPnlXScheduleOk := False; //Added for CQ: 7370 Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+ 'If you would like to create a Day-of-Week schedule please'+ ' select ''OTHER'' from the list.', 'Incorrect Schedule.'); FShowPnlXScheduleOk := True; //Added for CQ: 7370 if ScheduleCombo.CanFocus then ScheduleCombo.SetFocus; ScheduleCombo.SelStart := Length(ScheduleCombo.Text); end; end; //Removed based on Site feeback. See CQ: 7518 (*function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean; begin {CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window} Result := True; if (Length(RouteCombo.Text) > 0) and (RouteCombo.ItemIndex < 0) and (Not IsSupplyAndOutPatient) then begin Application.MessageBox('Please select a correct route from the list.', 'Incorrect Route.'); if RouteCombo.CanFocus then RouteCombo.SetFocus; RouteCombo.SelStart := Length(RouteCombo.Text); Result := False; end; end;*) function TfrmODMeds.isUniqueQuickOrder(iText: string): Boolean; var counter,i: Integer; begin counter := 0; Result := False; if iText = '' then Exit; for i := 0 to FQuickItems.Count-1 do if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then Inc(counter); //Found a Match Result := counter = 1; end; function TfrmODMeds.IsSupplyAndOutPatient: boolean; begin {CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window} Result := False; if (MedIsSupply(txtMed.Tag)) and (not FInptDlg) then Result := True; end; // CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule. function TfrmODMeds.GetCacheChunkIndex(idx: integer): integer; begin Result := idx div MED_CACHE_CHUNK_SIZE; end; function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer; var i: integer; begin result := -1; for i := 0 to SchedCombo.items.Count-1 do begin if pSchedule = SchedCombo.DisplayText[i] then begin result := i; // match found break; end; end; end; procedure TfrmODMeds.cboXScheduleExit(Sender: TObject); begin inherited; {CQ: 7344 - Inconsistency with Schedule box: Allows free-text entry for Complex orders, doesn't for simple orders } ValidateInpatientSchedule(cboXSchedule); end; procedure TfrmODMeds.cboXSequenceChange(Sender: TObject); var x: string; begin inherited; x := cboXSequence.Text; if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then begin InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+ 'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK); x := ''; end; cboXSequence.text := x; cboXSequence.ItemIndex := cboXSequence.Items.IndexOf(x); grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(x); //AGP Start Expire add line UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); ControlChange(Sender); end; procedure TfrmODMeds.cboXSequenceEnter(Sender: TObject); begin inherited; DisableDefaultButton(self); DisableCancelButton(self); end; procedure TfrmODMeds.cboXSequenceExit(Sender: TObject); begin inherited; grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(cboXSequence.Text); if ActiveControl = grdDoses then begin //This next condition seldom occurs, since entering the dosage on the last // row adds another row if grdDoses.Row = grdDoses.RowCount - 1 then grdDoses.RowCount := grdDoses.RowCount + 1; end; cboXSequence.Tag := -1; cboXSequence.Hide; RestoreDefaultButton; RestoreCancelButton; if (pnlMessage.Visible) and (memMessage.TabStop) then begin pnlMessage.Parent := grdDoses.Parent; pnlMessage.TabOrder := grdDoses.TabOrder; ActiveControl := memMessage; end else if grdDoses.Showing then ActiveControl := grdDoses else ActiveControl := cboDosage; //AGP Start Expire commented out line //UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row)); end; procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject); begin inherited; cboxSequence.Hide; end; procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; //Fix for CQ: 7545 if cboDosage.ItemIndex > -1 then cboDosageClick(Sender) else UpdateRelated; end; procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; //Fix for CQ: 7545 if cboXDosage.ItemIndex > -1 then cboXDosageClick(Sender) else begin grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text; UpdateRelated; end; end; procedure TfrmODMeds.txtSupplyClick(Sender: TObject); begin inherited; Self.txtSupply.SelectAll; end; procedure TfrmODMeds.txtQuantityClick(Sender: TObject); begin inherited; self.txtQuantity.SelectAll; end; procedure TfrmODMeds.txtRefillsChange(Sender: TObject); begin inherited; ControlChange(sender); end; procedure TfrmODMeds.txtRefillsClick(Sender: TObject); begin inherited; self.txtRefills.SelectAll; end; procedure TfrmODMeds.WMClose(var Msg: TWMClose); begin if self <> nil then begin if (self.tabDose.TabIndex = TI_Dose) then begin if Trim(cboSchedule.Text) = '' then cboSchedule.ItemIndex := -1; ValidateInpatientSchedule(cboSchedule); if self.cboSchedule.Focused = true then exit; end; if (self.tabDose.TabIndex = TI_Complex) then begin ValidateInpatientSchedule(cboXSchedule); if self.cboXSchedule.Focused = true then exit; end; end; inherited end; procedure TfrmODMeds.cboXScheduleEnter(Sender: TObject); begin inherited; //agp Change CQ 10719 self.chkXPRN.OnClick(self.chkXPRN); end; end.