//kt -- Modified with SourceScanner on 8/8/2007 unit fODMedOut; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask, Menus, Buttons, DKLang; type TfrmODMedOut = class(TfrmODBase) lblMedication: TLabel; cboMedication: TORComboBox; lblDosage: TLabel; lblRoute: TLabel; cboRoute: TORComboBox; lblSchedule: TLabel; cboSchedule: TORComboBox; lblDispense: TLabel; cboDispense: TORComboBox; memComments: TMemo; cboPriority: TORComboBox; Bevel1: TBevel; cboMedAlt: TORComboBox; cboInstructions: TORComboBox; lblQuantity: TLabel; cboPickup: TORComboBox; lblPickup: TLabel; cboSC: TORComboBox; lblSC: TLabel; lblRefills: TLabel; txtQuantity: TCaptionEdit; lblComment: TLabel; lblPriority: TLabel; txtRefills: TCaptionEdit; spnRefills: TUpDown; cmdComplex: TButton; btnUnits: TSpeedButton; txtSIG: TCaptionEdit; lblSIG: TLabel; popUnits: TPopupMenu; memComplex: TMemo; procedure cboMedicationNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); procedure cboMedicationSelect(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ControlChange(Sender: TObject); procedure cboDispenseExit(Sender: TObject); procedure cboDispenseMouseClick(Sender: TObject); procedure cboSCEnter(Sender: TObject); procedure txtQuantityEnter(Sender: TObject); procedure btnUnitsClick(Sender: TObject); procedure cmdComplexClick(Sender: TObject); procedure memCommentsEnter(Sender: TObject); private //kt Begin Mod (change Consts to Vars) 8/8/2007 TX_NO_MED : string; //kt TX_NO_DOSE : string; //kt TX_NO_AMPER : string; //kt TX_NO_ROUTE : string; //kt TX_NF_ROUTE : string; //kt TX_NO_SCHED : string; //kt TX_NO_PICK : string; //kt TX_RNG_REFILL : string; //kt TX_SCH_QUOTE : string; //kt TX_SCH_MINUS : string; //kt TX_SCH_SPACE : string; //kt TX_SCH_LEN : string; //kt TX_SCH_PRN : string; //kt TX_SCH_ZERO : string; //kt TX_SCH_LSP : string; //kt TX_SCH_NS : string; //kt TX_OUTPT_IV : string; //kt TX_QTY_NV : string; //kt TX_QTY_MAIL : string; //kt //kt End Mod ------------------- { Private declarations } FLastDrug: Integer; FLastMedID: string; FDispenseMsg: string; FMedCombo: TORComboBox; procedure CheckFormAlt; procedure ResetOnMedChange; procedure SetAskSC; procedure SetAltCombo; procedure SetInstructions; procedure SetOnOISelect; procedure SetMaxRefills; procedure SetupNouns; procedure SetComplex; procedure SetSimple; procedure UnitClick(Sender: TObject); procedure SetupVars; //kt protected procedure InitDialog; override; procedure Validate(var AnErrMsg: string); override; public procedure SetupDialog(OrderAction: Integer; const ID: string); override; end; implementation {$R *.DFM} uses rOrders, rODBase, fODMedFA, fODMedComplex; const REFILLS_DFLT = '0'; REFILLS_MAX = 11; //TX_NO_MED = 'Medication must be entered.'; <-- original line. //kt 8/8/2007 //TX_NO_DOSE = 'Instructions must be entered.'; <-- original line. //kt 8/8/2007 //TX_NO_AMPER = 'Instructions may not contain the ampersand (&) character.'; <-- original line. //kt 8/8/2007 //TX_NO_ROUTE = 'Route must be entered.'; <-- original line. //kt 8/8/2007 //TX_NF_ROUTE = 'Route not found in the Medication Routes file.'; <-- original line. //kt 8/8/2007 //TX_NO_SCHED = 'Schedule must be entered.'; <-- original line. //kt 8/8/2007 //TX_NO_PICK = 'A method for picking up the medication must be entered.'; <-- original line. //kt 8/8/2007 //TX_RNG_REFILL = 'The number of refills must be in the range of 0 through '; <-- original line. //kt 8/8/2007 //TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.'; <-- original line. //kt 8/8/2007 //TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.'; <-- original line. //kt 8/8/2007 //TX_SCH_SPACE = 'Schedule must have only one space in it.'; <-- original line. //kt 8/8/2007 //TX_SCH_LEN = 'Schedule must be less than 70 characters.'; <-- original line. //kt 8/8/2007 //TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.'; <-- original line. //kt 8/8/2007 //TX_SCH_ZERO = 'Schedule cannot be Q0'; <-- original line. //kt 8/8/2007 //TX_SCH_LSP = 'Schedule may not have leading spaces.'; <-- original line. //kt 8/8/2007 //TX_SCH_NS = 'Unable to resolve non-standard schedule.'; <-- original line. //kt 8/8/2007 //TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.'; <-- original line. //kt 8/8/2007 //TX_QTY_NV = 'Unable to validate quantity.'; <-- original line. //kt 8/8/2007 //TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.'; <-- original line. //kt 8/8/2007 { TfrmODBase common methods } procedure TfrmODMedOut.SetupVars; //kt Added entire function to replace constant declarations 8/8/2007 begin TX_NO_MED := DKLangConstW('fODMedOut_Medication_must_be_enteredx'); TX_NO_DOSE := DKLangConstW('fODMedOut_Instructions_must_be_enteredx'); TX_NO_AMPER := DKLangConstW('fODMedOut_Instructions_may_not_contain_the_ampersand_xxx_characterx'); TX_NO_ROUTE := DKLangConstW('fODMedOut_Route_must_be_enteredx'); TX_NF_ROUTE := DKLangConstW('fODMedOut_Route_not_found_in_the_Medication_Routes_filex'); TX_NO_SCHED := DKLangConstW('fODMedOut_Schedule_must_be_enteredx'); TX_NO_PICK := DKLangConstW('fODMedOut_A_method_for_picking_up_the_medication_must_be_enteredx'); TX_RNG_REFILL := DKLangConstW('fODMedOut_The_number_of_refills_must_be_in_the_range_of_0_through'); TX_SCH_QUOTE := DKLangConstW('fODMedOut_Schedule_must_not_have_quotemarks_in_itx'); TX_SCH_MINUS := DKLangConstW('fODMedOut_Schedule_must_not_have_a_dash_at_the_beginningx'); TX_SCH_SPACE := DKLangConstW('fODMedOut_Schedule_must_have_only_one_space_in_itx'); TX_SCH_LEN := DKLangConstW('fODMedOut_Schedule_must_be_less_than_70_charactersx'); TX_SCH_PRN := DKLangConstW('fODMedOut_Schedule_cannot_include_PRN_x_use_Comments_to_enter_PRNx'); TX_SCH_ZERO := DKLangConstW('fODMedOut_Schedule_cannot_be_Q0'); TX_SCH_LSP := DKLangConstW('fODMedOut_Schedule_may_not_have_leading_spacesx'); TX_SCH_NS := DKLangConstW('fODMedOut_Unable_to_resolve_nonxstandard_schedulex'); TX_OUTPT_IV := DKLangConstW('fODMedOut_This_patient_has_not_been_admittedx__Only_IV_orders_may_be_enteredx'); TX_QTY_NV := DKLangConstW('fODMedOut_Unable_to_validate_quantityx'); TX_QTY_MAIL := DKLangConstW('fODMedOut_Quantity_for_mailed_items_must_be_a_whole_numberx'); end; procedure TfrmODMedOut.FormCreate(Sender: TObject); //const //TC_RESTRICT = 'Ordering Restrictions'; <-- original line. //kt 8/8/2007 var Restriction: string; TC_RESTRICT : string; begin TC_RESTRICT := DKLangConstW('fODMedOut_Ordering_Restrictions'); //kt added 8/8/2007 inherited; AllowQuickOrder := True; CheckAuthForMeds(Restriction); if Length(Restriction) > 0 then begin InfoBox(Restriction, TC_RESTRICT, MB_OK); Close; Exit; end; FillerID := 'PSO'; // does 'on Display' order check **KCM** //StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fODMedOut_Loading_Dialog_Definition')); //kt added 8/8/2007 Responses.Dialog := 'PSO OERR'; // loads formatting info //StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fODMedOut_Loading_Default_Values')); //kt added 8/8/2007 CtrlInits.LoadDefaults(ODForMedOut); // ODForMedOut returns TStrings with defaults InitDialog; //CtrlInits.SetControl(cboPickup, 'Pickup'); // do only once, so don't do in InitDialog <-- original line. //kt 8/8/2007 CtrlInits.SetControl(cboPickup, DKLangConstW('fODMedOut_Pickup')); //kt 8/8/2007 PreserveControl(cboPickup); end; procedure TfrmODMedOut.InitDialog; begin inherited; FLastDrug := 0; FLastMedID := ''; FDispenseMsg := ''; FMedCombo := cboMedication; // this must be before SetControl(cboMedication) with CtrlInits do begin // SetControl(cboMedication, 'ShortList'); <-- original line. //kt 8/8/2007 SetControl(cboMedication, DKLangConstW('fODMedOut_ShortList')); //kt added 8/8/2007 cboMedication.InsertSeparator; //SetControl(cboMedAlt, 'ShortList'); can't do this since it calls InitLongList // SetControl(cboSchedule, 'Schedules'); <-- original line. //kt 8/8/2007 SetControl(cboSchedule, DKLangConstW('fODMedOut_Schedules')); //kt added 8/8/2007 // SetControl(cboPriority, 'Priorities'); <-- original line. //kt 8/8/2007 SetControl(cboPriority, DKLangConstW('fODMedOut_Priorities')); //kt added 8/8/2007 //SetControl(cboPickup, 'Pickup'); // SetControl(cboSC, 'SCStatus'); <-- original line. //kt 8/8/2007 SetControl(cboSC, DKLangConstW('fODMedOut_SCStatus')); //kt added 8/8/2007 end; SetAskSC; //StatusText('Retrieving List of Medications'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fODMedOut_Retrieving_List_of_Medications')); //kt added 8/8/2007 cboMedAlt.Visible := False; cboMedication.Visible := True; cboMedication.InitLongList(''); ActiveControl := cboMedication; //SetFocusedControl(FMedCombo); SetSimple; StatusText(''); end; procedure TfrmODMedOut.SetupDialog(OrderAction: Integer; const ID: string); var AnInstr: string; begin inherited; if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1); if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do begin Changing := True; SetControl(cboMedication, 'ORDERABLE', 1); ResetOnMedChange; SetOnOISelect; SetAltCombo; //cboMedicationSelect(Self); SetControl(cboDispense, 'DRUG', 1); SetInstructions; SetControl(txtQuantity, 'QTY', 1); SetControl(txtRefills, 'REFILLS', 1); spnRefills.Position := StrToIntDef(txtRefills.Text, 0); SetControl(cboPickup, 'PICKUP', 1); SetControl(memComments, 'COMMENT', 1); SetControl(cboPriority, 'URGENCY', 1); { prevent the SIG from being part of the comments on pre-CPRS prescriptions } if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboInstructions.Text = '') then begin AnInstr := TextForOrder(ID); //'SIG: ' + memComments.Text; OrderMessage(AnInstr); lblSIG.Visible := True; txtSIG.Visible := True; txtSIG.Text := memComments.Text; memComments.Clear; end; { can't edit the orderable item for a med order that has been released } if (OrderAction = ORDER_EDIT) and OrderIsReleased(EditOrder) then FMedCombo.Enabled := False; Changing := False; ControlChange(Self); end; if OrderAction <> ORDER_EDIT then SetFocusedControl(FMedCombo); end; procedure TfrmODMedOut.Validate(var AnErrMsg: string); var Sched: Integer; RouteID, RouteAbbr: string; procedure SetError(const x: string); begin if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF; AnErrMsg := AnErrMsg + x; end; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if Length(cboMedAlt.Text) = 0 then SetError(TX_NO_MED); // if memComplex is Visible, then the dosage fields were validated in fMedComplex if memComplex.Visible = False then begin if Length(cboInstructions.Text) = 0 then SetError(TX_NO_DOSE); if Pos('&', cboInstructions.Text) > 0 then SetError(TX_NO_AMPER); if (Length(cboRoute.Text) = 0) and (not MedIsSupply(cboMedAlt.ItemIEN)) then SetError(TX_NO_ROUTE); if (Length(cboRoute.Text) > 0) and (cboRoute.ItemIndex < 0) then begin LookupRoute(cboRoute.Text, RouteID, RouteAbbr); if RouteID = '0' then SetError(TX_NF_ROUTE) else Responses.Update('ROUTE', 1, RouteID, RouteAbbr); end; if Length(cboSchedule.Text) = 0 then SetError(TX_NO_SCHED); end; if cboPickup.ItemID = '' then SetError(TX_NO_PICK); if StrToIntDef(txtRefills.Text, 99) > spnRefills.Max then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max)); with cboSchedule do if Length(Text) > 0 then begin Sched := ValidSchedule(Text); if Sched = -1 then begin if Pos('"', Text) > 0 then SetError(TX_SCH_QUOTE); if Copy(Text, 1, 1) = '-' then SetError(TX_SCH_MINUS); if Pos(' ', Copy(Text, Pos(' ', Text) + 1, 999)) > 0 then SetError(TX_SCH_SPACE); if Length(Text) > 70 then SetError(TX_SCH_LEN); if (Pos('P RN', Text) > 0) or (Pos('PR N', Text) > 0) then SetError(TX_SCH_PRN); if Pos('Q0', Text) > 0 then SetError(TX_SCH_ZERO); if TrimLeft(Text) <> Text then SetError(TX_SCH_LSP); end; if Sched = 0 then SetError(TX_SCH_NS); end; with txtQuantity do if Length(Text) > 0 then begin if not ValidQuantity(Text) then SetError(TX_QTY_NV); //if (cboPickup.ItemID = 'M') and (IntToStr(StrToIntDef(Text,-1)) <> Text) // then SetError(TX_QTY_MAIL); end; end; { cboMedication methods } procedure TfrmODMedOut.ResetOnMedChange; begin ClearControl(cboDispense); ClearControl(cboInstructions); btnUnits.Caption := ''; ResetControl(cboRoute); ResetControl(cboSchedule); ClearControl(txtQuantity); txtRefills.Text := REFILLS_DFLT; spnRefills.Max := REFILLS_MAX; ClearControl(memComments); ClearControl(memOrder); end; procedure TfrmODMedOut.SetAltCombo; begin with cboMedication do begin FMedCombo := cboMedAlt; // if cboMedAlt.Items.Count = 0 then CtrlInits.SetListOnly(cboMedAlt, 'ShortList'); <-- original line. //kt 8/8/2007 if cboMedAlt.Items.Count = 0 then CtrlInits.SetListOnly(cboMedAlt, DKLangConstW('fODMedOut_ShortList')); //kt added 8/8/2007 cboMedAlt.SetExactByIEN(ItemIEN, TrimRight(Piece(Text, '<', 1))); cboMedication.Visible := False; cboMedAlt.Visible := True; end; end; procedure TfrmODMedOut.SetOnOISelect; begin with CtrlInits do begin FLastMedID := FMedCombo.ItemID; LoadOrderItem(OIForMedOut(FMedCombo.ItemIEN)); // SetControl(cboDispense, 'Dispense'); <-- original line. //kt 8/8/2007 SetControl(cboDispense, DKLangConstW('fODMedOut_Dispense')); //kt added 8/8/2007 if cboDispense.Items.Count = 1 then cboDispense.ItemIndex := 0; // lblDosage.Caption := DefaultText('Verb'); <-- original line. //kt 8/8/2007 lblDosage.Caption := DefaultText(DKLangConstW('fODMedOut_Verb')); //kt added 8/8/2007 // if lblDosage.Caption = '' then lblDosage.Caption := 'Amount'; <-- original line. //kt 8/8/2007 if lblDosage.Caption = '' then lblDosage.Caption := DKLangConstW('fODMedOut_Amount'); //kt added 8/8/2007 // SetControl(cboInstructions, 'Instruct'); <-- original line. //kt 8/8/2007 SetControl(cboInstructions, DKLangConstW('fODMedOut_Instruct')); //kt added 8/8/2007 SetupNouns; // SetControl(cboRoute, 'Route'); <-- original line. //kt 8/8/2007 SetControl(cboRoute, DKLangConstW('fODMedOut_Route')); //kt added 8/8/2007 if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0; // if DefaultText('DefSched') <> '' then cboSchedule.SelectByID(DefaultText('DefSched')); <-- original line. //kt 8/8/2007 if DefaultText(DKLangConstW('fODMedOut_DefSched')) <> '' then cboSchedule.SelectByID(DefaultText(DKLangConstW('fODMedOut_DefSched'))); //kt added 8/8/2007 // OrderMessage(TextOf('Message')); <-- original line. //kt 8/8/2007 OrderMessage(TextOf(DKLangConstW('fODMedOut_Message'))); //kt added 8/8/2007 end; end; procedure TfrmODMedOut.cboMedicationNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); { retrieves a subset of inpatient medication orderable items } begin inherited; FMedCombo.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.O RX')); end; procedure TfrmODMedOut.cboMedicationSelect(Sender: TObject); { sets related controls whenever orderable item changes (MouseClick or Exit) } begin inherited; with FMedCombo do begin if ItemID <> FLastMedID then FLastMedID := ItemID else Exit; Changing := True; if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog ResetOnMedChange; if CharAt(ItemID, 1) = 'Q' then begin Responses.QuickOrder := ExtractInteger(ItemID); Responses.SetControl(FMedCombo, 'ORDERABLE', 1); end; if ItemIEN > 0 then SetOnOISelect; end; with Responses do if QuickOrder > 0 then begin SetControl(FMedCombo, 'ORDERABLE', 1); SetControl(cboDispense, 'DRUG', 1); SetInstructions; SetControl(txtQuantity, 'QTY', 1); SetControl(txtRefills, 'REFILLS', 1); spnRefills.Position := StrToIntDef(txtRefills.Text, 0); SetControl(cboPickup, 'PICKUP', 1); SetControl(memComments, 'COMMENT', 1); SetControl(cboPriority, 'URGENCY', 1); end; Changing := False; ControlChange(Self); if FMedCombo = cboMedication then SetAltCombo; // if the Dispense drug was stuffed - still do the checks (form alt, refills) if cboDispense.ItemIndex > -1 then cboDispenseMouseClick(Self); end; { cboDispense methods } procedure TfrmODMedOut.CheckFormAlt; var DrugName, OIName: string; Drug, OI: Integer; begin with cboDispense do if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 4) = 'NF') then begin SelectFormularyAlt(ItemIEN, Drug, OI, DrugName, OIName, PST_OUTPATIENT); if Drug > 0 then begin if FMedCombo.ItemIEN <> OI then begin FMedCombo.InitLongList(OIName); FMedCombo.SelectByIEN(OI); cboMedicationSelect(Self); end; cboDispense.SelectByIEN(Drug); end; {if FormAlt} end; {if ItemIndex} SetAskSC; // now check enabled for the service connected prompt end; procedure TfrmODMedOut.SetMaxRefills; begin with cboDispense do if (ItemIndex > -1) and (Length(Piece(Items[ItemIndex], U, 6)) > 0) then begin spnRefills.Max := StrToIntDef(Piece(Items[ItemIndex], U, 6), REFILLS_MAX); if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then begin txtRefills.Text := IntToStr(spnRefills.Max); spnRefills.Position := spnRefills.Max; end; end; end; procedure TfrmODMedOut.cboDispenseExit(Sender: TObject); var AMsg: string; begin inherited; SetMaxRefills; with cboDispense do begin if ItemIEN <> FLastDrug then CheckFormAlt; if ItemIEN > 0 then begin AMsg := DispenseMessage(ItemIEN) + CRLF; if memMessage.Text <> AMsg then OrderMessage(AMsg); end; FLastDrug := ItemIEN; end; end; procedure TfrmODMedOut.cboDispenseMouseClick(Sender: TObject); begin inherited; SetMaxRefills; with cboDispense do begin if ItemIEN <> FLastDrug then CheckFormAlt; if ItemIEN > 0 then OrderMessage(DispenseMessage(ItemIEN)); FLastDrug := ItemIEN; end; end; { dosage instructions } procedure TfrmODMedOut.SetupNouns; var AvailWidth, MaxWidth: Integer; begin //CtrlInits.SetPopupMenu(popUnits, UnitClick, 'Nouns'); <-- original line. //kt 8/8/2007 CtrlInits.SetPopupMenu(popUnits, UnitClick, DKLangConstW('fODMedOut_Nouns')); //kt added 8/8/2007 if popUnits.Items.Count > 0 then begin // Make sure cboInstructions is at least 40 pixels wide so it can show values // like "1/2". Allow for a 3 pixel space between the the Units button & Route. AvailWidth := (cboRoute.Left - 3) - (cboInstructions.Left + 40); MaxWidth := popUnits.Tag + 9; // allow 9 pixels for the down arrow & button border if MaxWidth > AvailWidth then MaxWidth := AvailWidth; btnUnits.Width := MaxWidth; btnUnits.Left := cboRoute.Left - MaxWidth - 3; cboInstructions.Width := btnUnits.Left - cboInstructions.Left; btnUnits.Caption := popUnits.Items[0].Caption; btnUnits.Visible := True; end else begin btnUnits.Visible := False; // Allow for a 6 pixel margin between the Instructions box & Route cboInstructions.Width := cboRoute.Left - cboInstructions.Left - 6; end; end; procedure TfrmODMedOut.btnUnitsClick(Sender: TObject); var APoint: TPoint; begin inherited; APoint := btnUnits.ClientToScreen(Point(0, btnUnits.Height)); popUnits.Popup(APoint.X, APoint.Y); end; procedure TfrmODMedOut.UnitClick(Sender: TObject); begin btnUnits.Caption := TMenuItem(Sender).Caption; end; procedure TfrmODMedOut.SetComplex; begin lblDosage.Visible := False;; lblRoute.Visible := False;; lblSchedule.Visible := False;; cboInstructions.Visible := False; btnUnits.Visible := False;; cboRoute.Visible := False; cboSchedule.Visible := False; memComplex.Visible := True; //cmdComplex.Caption := 'Change Dose...'; <-- original line. //kt 8/8/2007 cmdComplex.Caption := DKLangConstW('fODMedOut_Change_Dosexxx'); //kt added 8/8/2007 end; procedure TfrmODMedOut.SetSimple; begin memComplex.Visible := False; lblDosage.Visible := True;; lblRoute.Visible := True;; lblSchedule.Visible := True;; cboInstructions.Visible := True; btnUnits.Visible := (popUnits.Items.Count > 0) or (btnUnits.Caption <> ''); cboRoute.Visible := True; cboSchedule.Visible := True; //cmdComplex.Caption := 'Complex Dose...'; <-- original line. //kt 8/8/2007 cmdComplex.Caption := DKLangConstW('fODMedOut_Complex_Dosexxx'); //kt added 8/8/2007 end; procedure TfrmODMedOut.SetInstructions; var x: string; AnInstance: Integer; begin case Responses.InstanceCount('INSTR') of 0: begin cboInstructions.ItemIndex := -1; // there may still be a route & schedule (for copied orders) if Responses.EValueFor('MISC', 1) <> '' then btnUnits.Caption := Responses.EValueFor('MISC', 1); Responses.SetControl(cboRoute, 'ROUTE', 1); with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex]; Responses.SetControl(cboSchedule, 'SCHEDULE', 1); SetSimple; end; 1: begin AnInstance := Responses.NextInstance('INSTR', 0); Responses.SetControl(cboInstructions, 'INSTR', AnInstance); btnUnits.Caption := Responses.IValueFor('MISC', AnInstance); Responses.SetControl(cboRoute, 'ROUTE', AnInstance); with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex]; Responses.SetControl(cboSchedule, 'SCHEDULE', AnInstance); SetSimple; end; else begin memComplex.Clear; AnInstance := Responses.NextInstance('INSTR', 0); while AnInstance > 0 do begin x := Responses.EValueFor('INSTR', AnInstance); x := x + ' ' + Responses.EValueFor('MISC', AnInstance); x := x + ' ' + Responses.EValueFor('ROUTE', AnInstance); x := x + ' ' + Responses.EValueFor('SCHEDULE', AnInstance); if Length(Responses.EValueFor('DAYS', AnInstance)) > 0 // then x := x + ' ' + Responses.EValueFor('DAYS', AnInstance) + ' day(s)'; <-- original line. //kt 8/8/2007 then x := x + ' ' + Responses.EValueFor('DAYS', AnInstance) + DKLangConstW('fODMedOut_dayxsx'); //kt added 8/8/2007 memComplex.Lines.Add(x); AnInstance := Responses.NextInstance('INSTR', AnInstance); end; SetComplex; end; end; {case} memOrder.Text := Responses.OrderText; end; {if ExecuteComplexDose} procedure TfrmODMedOut.cmdComplexClick(Sender: TObject); begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if FMedCombo.ItemIEN = 0 then begin // InfoBox(TX_NO_MED, 'Error', MB_OK); <-- original line. //kt 8/8/2007 InfoBox(TX_NO_MED, DKLangConstW('fODMedOut_Error'), MB_OK); //kt added 8/8/2007 Exit; end; if ExecuteComplexDose(CtrlInits, Responses) then SetInstructions; end; { quantity } procedure TfrmODMedOut.txtQuantityEnter(Sender: TObject); begin inherited; with cboDispense do if ItemIEN > 0 then OrderMessage(QuantityMessage(ItemIEN)); end; { service connection } procedure TfrmODMedOut.SetAskSC; const SC_NO = 0; SC_YES = 1; begin if Patient.ServiceConnected and RequiresCopay(FLastDrug) then begin lblSC.Font.Color := clWindowText; cboSC.Enabled := True; cboSC.Color := clWindow; if Patient.SCPercent > 50 then cboSC.SelectByIEN(SC_YES) else cboSC.SelectByIEN(SC_NO); end else begin lblSC.Font.Color := clGrayText; cboSC.Enabled := False; cboSC.Color := clBtnFace; cboSC.ItemIndex := -1; end; end; procedure TfrmODMedOut.cboSCEnter(Sender: TObject); begin inherited; OrderMessage(RatedDisabilities); end; { comments } procedure TfrmODMedOut.memCommentsEnter(Sender: TObject); begin inherited; OrderMessage(''); // make sure Order Message disappears when in comments box end; { all controls } procedure TfrmODMedOut.ControlChange(Sender: TObject); begin inherited; if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills if Changing then Exit; if FMedCombo.ItemIEN = 0 then Exit; // prevent txtRefills from updating early with FMedCombo do if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Piece(Items[ItemIndex], U, 3)) else Responses.Update('ORDERABLE', 1, '', ''); with cboDispense do if ItemIEN > 0 then Responses.Update('DRUG', 1, ItemID, Piece(Items[ItemIndex], U, 2)) else Responses.Update('DRUG', 1, '', ''); if memComplex.Visible = False then begin with cboInstructions do Responses.Update('INSTR', 1, Text, Text); with btnUnits do if Visible then Responses.Update('MISC', 1, Caption, Caption); with cboRoute do if ItemIndex > -1 then Responses.Update('ROUTE', 1, ItemID, Piece(Items[ItemIndex], U, 3)) // abbreviation else Responses.Update('ROUTE', 1, Text, Text); with cboSchedule do Responses.Update('SCHEDULE', 1, Text, Text); end; with txtQuantity do Responses.Update('QTY', 1, Text, Text); with txtRefills do Responses.Update('REFILLS', 1, Text, Text); with cboPickup do Responses.Update('PICKUP', 1, ItemID, Text); with cboPriority do Responses.Update('URGENCY', 1, ItemID, Text); with memComments do Responses.Update('COMMENT', 1, TX_WPTYPE, Text); with cboSC do if Enabled then Responses.Update('SC', 1, ItemID, Text); memOrder.Text := Responses.OrderText; end; end.