[456] | 1 | unit fRenewOutMed;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
[830] | 7 | fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, Mask, ORCtrls, ExtCtrls, fBase508Form,
|
---|
| 8 | VA508AccessibilityManager;
|
---|
[456] | 9 |
|
---|
| 10 | type
|
---|
[830] | 11 | TfrmRenewOutMed = class(TfrmBase508Form)
|
---|
[456] | 12 | memOrder: TCaptionMemo;
|
---|
| 13 | pnlButtons: TPanel;
|
---|
| 14 | cmdOK: TButton;
|
---|
| 15 | cmdCancel: TButton;
|
---|
| 16 | pnlMiddle: TPanel;
|
---|
| 17 | cboPickup: TORComboBox;
|
---|
| 18 | lblPickup: TLabel;
|
---|
| 19 | txtRefills: TCaptionEdit;
|
---|
| 20 | lblRefills: TLabel;
|
---|
| 21 | procedure FormCreate(Sender: TObject);
|
---|
| 22 | procedure cmdOKClick(Sender: TObject);
|
---|
| 23 | procedure cmdCancelClick(Sender: TObject);
|
---|
| 24 | private
|
---|
| 25 | OKPressed: Boolean;
|
---|
| 26 | end;
|
---|
| 27 |
|
---|
| 28 | function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
|
---|
| 29 | AnOrder: TOrder): Boolean;
|
---|
| 30 |
|
---|
| 31 | implementation
|
---|
| 32 |
|
---|
| 33 | {$R *.DFM}
|
---|
| 34 |
|
---|
| 35 | const
|
---|
| 36 | TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
|
---|
| 37 | TC_ERR_REFILL = 'Refills';
|
---|
| 38 |
|
---|
| 39 | function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
|
---|
| 40 | AnOrder: TOrder): Boolean;
|
---|
| 41 | var
|
---|
| 42 | frmRenewOutMed: TfrmRenewOutMed;
|
---|
| 43 | begin
|
---|
| 44 | Result := False;
|
---|
| 45 | frmRenewOutMed := TfrmRenewOutMed.Create(Application);
|
---|
| 46 | try
|
---|
| 47 | ResizeFormToFont(TForm(frmRenewOutMed));
|
---|
| 48 | frmRenewOutMed.memOrder.SetTextBuf(PChar(AnOrder.Text));
|
---|
| 49 | frmRenewOutMed.txtRefills.Text := IntToStr(Refills);
|
---|
| 50 | frmRenewOutMed.cboPickup.SelectByID(Pickup);
|
---|
| 51 | frmRenewOutMed.ShowModal;
|
---|
| 52 | if frmRenewOutMed.OKPressed then
|
---|
| 53 | begin
|
---|
| 54 | Result := True;
|
---|
| 55 | Refills := StrToIntDef(frmRenewOutMed.txtRefills.Text, Refills);
|
---|
| 56 | Pickup := frmRenewOutMed.cboPickup.ItemID;
|
---|
| 57 | end;
|
---|
| 58 | finally
|
---|
| 59 | frmRenewOutMed.Release;
|
---|
| 60 | end;
|
---|
| 61 | end;
|
---|
| 62 |
|
---|
| 63 | procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
|
---|
| 64 | begin
|
---|
| 65 | inherited;
|
---|
| 66 | OKPressed := False;
|
---|
| 67 | with cboPickup.Items do
|
---|
| 68 | begin
|
---|
| 69 | Add('W^at Window');
|
---|
| 70 | Add('M^by Mail');
|
---|
| 71 | Add('C^in Clinic');
|
---|
| 72 | end;
|
---|
| 73 | end;
|
---|
| 74 |
|
---|
| 75 | procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
|
---|
| 76 | var
|
---|
| 77 | NumRefills: Integer;
|
---|
| 78 | begin
|
---|
| 79 | inherited;
|
---|
| 80 | NumRefills := StrToIntDef(txtRefills.Text, -1);
|
---|
| 81 | if (NumRefills < 0) or (NumRefills > 11) then
|
---|
| 82 | begin
|
---|
| 83 | InfoBox(TX_ERR_REFILL, TC_ERR_REFILL, MB_OK);
|
---|
| 84 | Exit;
|
---|
| 85 | end;
|
---|
| 86 | OKPressed := True;
|
---|
| 87 | Close;
|
---|
| 88 | end;
|
---|
| 89 |
|
---|
| 90 | procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
|
---|
| 91 | begin
|
---|
| 92 | inherited;
|
---|
| 93 | Close;
|
---|
| 94 | end;
|
---|
| 95 |
|
---|
| 96 | end.
|
---|