//kt -- Modified with SourceScanner on 8/8/2007 unit fOptionsDays; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, fOptions, ComCtrls, OrFn, ORCtrls, DKLang; type TfrmOptionsDays = class(TForm) pnlBottom: TPanel; btnOK: TButton; btnCancel: TButton; bvlTop: TBevel; bvlMiddle: TBevel; txtLabInpatient: TCaptionEdit; spnLabInpatient: TUpDown; txtLabOutpatient: TCaptionEdit; spnLabOutpatient: TUpDown; txtVisitStart: TCaptionEdit; spnVisitStart: TUpDown; txtVisitStop: TCaptionEdit; spnVisitStop: TUpDown; lblVisit: TStaticText; lblVisitStop: TLabel; lblVisitStart: TLabel; lblLabOutpatient: TLabel; lblLabInpatient: TLabel; lblLab: TStaticText; lblVisitValue: TMemo; lblLabValue: TMemo; btnLabDefaults: TButton; btnVisitDefaults: TButton; bvlBottom: TBevel; DKLanguageController1: TDKLanguageController; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure spnVisitStartClick(Sender: TObject; Button: TUDBtnType); procedure spnVisitStopClick(Sender: TObject; Button: TUDBtnType); procedure spnLabInpatientClick(Sender: TObject; Button: TUDBtnType); procedure spnLabOutpatientClick(Sender: TObject; Button: TUDBtnType); procedure txtLabInpatientKeyPress(Sender: TObject; var Key: Char); procedure btnLabDefaultsClick(Sender: TObject); procedure btnVisitDefaultsClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure txtLabInpatientChange(Sender: TObject); procedure txtLabInpatientExit(Sender: TObject); procedure txtLabOutpatientChange(Sender: TObject); procedure txtLabOutpatientExit(Sender: TObject); procedure txtVisitStartExit(Sender: TObject); procedure txtVisitStartKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure txtVisitStopExit(Sender: TObject); procedure txtVisitStopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure txtVisitStartKeyPress(Sender: TObject; var Key: Char); procedure txtVisitStopKeyPress(Sender: TObject; var Key: Char); private { Private declarations } FStartEntered: boolean; FStopEntered: boolean; procedure AdjustVisitLabel; procedure AdjustLabLabel; public { Public declarations } end; var frmOptionsDays: TfrmOptionsDays; procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); implementation uses rOptions, uOptions; {$R *.DFM} procedure DialogOptionsDays(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); // create the form and make it modal, return an action var frmOptionsDays: TfrmOptionsDays; begin frmOptionsDays := TfrmOptionsDays.Create(Application); actiontype := 0; try with frmOptionsDays do begin if (topvalue < 0) or (leftvalue < 0) then Position := poScreenCenter else begin Position := poDesigned; Top := topvalue; Left := leftvalue; end; ResizeAnchoredFormToFont(frmOptionsDays); ShowModal; actiontype := btnOK.Tag; end; finally frmOptionsDays.Release; end; end; procedure TfrmOptionsDays.FormCreate(Sender: TObject); begin FStartEntered := false; FStopEntered := false; end; procedure TfrmOptionsDays.FormShow(Sender: TObject); //get lab defaults, personal values, visit defaults, personal values //tags for textboxes hold setting, tags on spinbuttons hold default, //tag of 1 on buttons indicate system default being used var labin, labout, visitstart, visitstop: integer; labindef, laboutdef, visitstartdef, visitstopdef: integer; begin rpcGetLabDays(labindef, laboutdef); rpcGetLabUserDays(labin, labout); rpcGetApptDays(visitstartdef, visitstopdef); rpcGetApptUserDays(visitstart, visitstop); txtLabInpatient.Text := inttostr(-labin); txtLabInpatient.Tag := labin; txtLabOutpatient.Text := inttostr(-labout); txtLabOutpatient.Tag := labout; txtVisitStart.Tag := visitstart - 1; txtVisitStop.Tag := visitstop - 1; spnLabInpatient.Tag := labindef; spnLabOutpatient.Tag := laboutdef; spnVisitStart.Tag := visitstartdef; spnVisitStop.Tag := visitstopdef; spnLabInpatientClick(self, btNext); spnLabOutpatientClick(self, btNext); spnVisitStartClick(self, btNext); spnVisitStopClick(self, btNext); txtLabInpatient.SetFocus; end; procedure TfrmOptionsDays.spnVisitStartClick(Sender: TObject; Button: TUDBtnType); var tagnum: integer; begin with txtVisitStart do begin if FStartEntered then begin if Hint = '' then Hint := 'T'; tagnum := RelativeDate(Hint); if tagnum = INVALID_DAYS then begin Text := Hint; beep; // InfoBox('Start Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsDays_Start_Date_entry_was_invalid'), DKLangConstW('fOptionsDays_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 ShowDisplay(txtVisitStart); FStartEntered := false; exit; end else begin DateLimits(DAYS_LIMIT, tagnum); if tagnum <> INVALID_DAYS then Tag := tagnum; end; end; SetFocus; if Button = btNext then tagnum := Tag + 1 else tagnum := Tag - 1; Text := Hint; DateLimits(DAYS_LIMIT, tagnum); if tagnum <> INVALID_DAYS then Tag := tagnum; ShowDisplay(txtVisitStart); end; btnVisitDefaults.Tag := 0; AdjustVisitLabel; FStartEntered := false; end; procedure TfrmOptionsDays.spnVisitStopClick(Sender: TObject; Button: TUDBtnType); var tagnum: integer; begin with txtVisitStop do begin if FStopEntered then begin if Hint = '' then Hint := 'T'; tagnum := RelativeDate(Hint); if tagnum = INVALID_DAYS then begin Text := Hint; beep; // InfoBox('Stop Date entry was invalid', 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsDays_Stop_Date_entry_was_invalid'), DKLangConstW('fOptionsDays_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 ShowDisplay(txtVisitStop); FStopEntered := false; exit; end else begin DateLimits(DAYS_LIMIT, tagnum); if tagnum = INVALID_DAYS then begin Text := Hint; ShowDisplay(txtVisitStop); FStopEntered := false; exit; end; end; end; SetFocus; if Button = btNext then tagnum := Tag + 1 else tagnum := Tag - 1; Text := Hint; DateLimits(DAYS_LIMIT, tagnum); if tagnum <> INVALID_DAYS then Tag := tagnum; ShowDisplay(txtVisitStop); end; btnVisitDefaults.Tag := 0; AdjustVisitLabel; FStopEntered := false; end; procedure TfrmOptionsDays.spnLabInpatientClick(Sender: TObject; Button: TUDBtnType); begin txtLabInpatient.SetFocus; txtLabInpatient.Tag := strtointdef(txtLabInpatient.Text, 0); btnLabDefaults.Tag := 0; AdjustLabLabel; end; procedure TfrmOptionsDays.spnLabOutpatientClick(Sender: TObject; Button: TUDBtnType); begin txtLabOutpatient.SetFocus; txtLabOutpatient.Tag := strtointdef(txtLabOutpatient.Text, 0); btnLabDefaults.Tag := 0; AdjustLabLabel; end; procedure TfrmOptionsDays.txtLabInpatientKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then begin Perform(WM_NextDlgCtl, 0, 0); exit; end; if not (Key in ['0'..'9', #8]) then begin Key := #0; beep; end; end; procedure TfrmOptionsDays.btnLabDefaultsClick(Sender: TObject); begin txtLabInpatient.Text := inttostr(spnLabInpatient.Tag); spnLabInpatientClick(self, btNext); txtLabOutpatient.Text := inttostr(spnLabOutpatient.Tag); spnLabOutpatientClick(self, btNext); btnLabDefaults.Tag := 1; end; procedure TfrmOptionsDays.btnVisitDefaultsClick(Sender: TObject); begin txtVisitStart.Tag := spnVisitStart.Tag - 1; spnVisitStartClick(self, btNext); txtVisitStop.Tag := spnVisitStop.Tag - 1; spnVisitStopClick(self, btNext); btnVisitDefaults.Tag := 1; end; procedure TfrmOptionsDays.AdjustVisitLabel; var start, stop: string; begin start := txtVisitStart.Text; stop := txtVisitStop.Text; //if start <> 'Today' then start := start + ' days'; <-- original line. //kt 8/8/2007 if start <> DKLangConstW('fOptionsDays_Today') then start := start + DKLangConstW('fOptionsDays_days'); //kt added 8/8/2007 //if stop <> 'Today' then stop := stop + ' days'; <-- original line. //kt 8/8/2007 if stop <> DKLangConstW('fOptionsDays_Today') then stop := stop + DKLangConstW('fOptionsDays_days'); //kt added 8/8/2007 //lblVisitValue.Text := 'Appointments and visits will be displayed on the cover sheet ' <-- original line. //kt 8/8/2007 lblVisitValue.Text := DKLangConstW('fOptionsDays_Appointments_and_visits_will_be_displayed_on_the_cover_sheet') //kt added 8/8/2007 // + 'from ' + start + ' to ' + stop + '.' <-- original line. //kt 8/8/2007 + DKLangConstW('fOptionsDays_from')+' ' + start + DKLangConstW('fOptionsDays_to') + stop + '.' //kt added 8/8/2007 end; procedure TfrmOptionsDays.AdjustLabLabel; begin //lblLabValue.Text := 'Lab results will be displayed on the cover sheet ' <-- original line. //kt 8/8/2007 lblLabValue.Text := DKLangConstW('fOptionsDays_Lab_results_will_be_displayed_on_the_cover_sheet') //kt added 8/8/2007 // + 'back ' + txtLabInpatient.Text + ' days for inpatients and ' <-- original line. //kt 8/8/2007 + DKLangConstW('fOptionsDays_back')+' ' + txtLabInpatient.Text + DKLangConstW('fOptionsDays_days_for_inpatients_and') //kt added 8/8/2007 // + txtLabOutpatient.Text + ' days for outpatients.'; <-- original line. //kt 8/8/2007 + txtLabOutpatient.Text + DKLangConstW('fOptionsDays_days_for_outpatientsx'); //kt added 8/8/2007 end; procedure TfrmOptionsDays.btnOKClick(Sender: TObject); begin rpcSetDays(txtLabInpatient.Tag, txtLabOutpatient.Tag, txtVisitStart.Tag, txtVisitStop.Tag); end; procedure TfrmOptionsDays.txtLabInpatientChange(Sender: TObject); var maxvalue: integer; begin maxvalue := spnLabInpatient.Max; with txtLabInpatient do begin if strtointdef(Text, maxvalue) > maxvalue then begin beep; // InfoBox('Number must be < ' + inttostr(maxvalue), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsDays_Number_must_be_x')+' ' + inttostr(maxvalue), DKLangConstW('fOptionsDays_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 if strtointdef(Text, 0) > maxvalue then Text := inttostr(maxvalue); end; end; spnLabInpatientClick(self, btNext); end; procedure TfrmOptionsDays.txtLabInpatientExit(Sender: TObject); begin with txtLabInpatient do begin if Text = '' then begin Text := '0'; spnLabInpatientClick(self, btNext); end else if (Copy(Text, 1, 1) = '0') and (length(Text) > 1) then begin Text := inttostr(strtointdef(Text, 0)); spnLabInpatientClick(self, btNext); end; end; end; procedure TfrmOptionsDays.txtLabOutpatientChange(Sender: TObject); var maxvalue: integer; begin maxvalue := spnLabOutpatient.Max; with txtLabOutpatient do begin if strtointdef(Text, maxvalue) > maxvalue then begin beep; // InfoBox('Number must be < ' + inttostr(maxvalue), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsDays_Number_must_be_x') + inttostr(maxvalue), DKLangConstW('fOptionsDays_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 if strtointdef(Text, 0) > maxvalue then Text := inttostr(maxvalue); end; end; spnLabOutpatientClick(self, btNext); end; procedure TfrmOptionsDays.txtLabOutpatientExit(Sender: TObject); begin with txtLabOutpatient do begin if Text = '' then begin Text := '0'; spnLabOutpatientClick(self, btNext); end else if (Copy(Text, 1, 1) = '0') and (length(Text) > 1) then begin Text := inttostr(strtointdef(Text, 0)); spnLabOutpatientClick(self, btNext); end; end; end; procedure TfrmOptionsDays.txtVisitStartExit(Sender: TObject); begin with txtVisitStart do if Text = '' then begin Text := 'T-1'; Hint := 'T-1'; spnVisitStartClick(self, btNext); end; TextExit(txtVisitStart, FStartEntered, DAYS_LIMIT); AdjustVisitLabel; end; procedure TfrmOptionsDays.txtVisitStartKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin txtVisitStart.Hint := txtVisitStart.Text; // put text in hint since text not available to spin FStartEntered := true; end; procedure TfrmOptionsDays.txtVisitStopExit(Sender: TObject); begin with txtVisitStop do if Text = '' then begin Text := 'T-1'; Hint := 'T-1'; spnVisitStopClick(self, btNext); end; TextExit(txtVisitStop, FStopEntered, DAYS_LIMIT); AdjustVisitLabel; end; procedure TfrmOptionsDays.txtVisitStopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin txtVisitStop.Hint := txtVisitStop.Text; // put text in hint since text not available to spin FStopEntered := true; end; procedure TfrmOptionsDays.txtVisitStartKeyPress(Sender: TObject; var Key: Char); begin if key = #13 then begin FStartEntered := true; Perform(WM_NextDlgCtl, 0, 0); end; end; procedure TfrmOptionsDays.txtVisitStopKeyPress(Sender: TObject; var Key: Char); begin if key = #13 then begin FStopEntered := true; Perform(WM_NextDlgCtl, 0, 0); end; end; end.