source: cprs/trunk/CPRS-Chart/fRenewOutMed.pas@ 1320

Last change on this file since 1320 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 2.3 KB
RevLine 
[456]1unit fRenewOutMed;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[830]7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, Mask, ORCtrls, ExtCtrls, fBase508Form,
8 VA508AccessibilityManager;
[456]9
10type
[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
28function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
29 AnOrder: TOrder): Boolean;
30
31implementation
32
33{$R *.DFM}
34
35const
36 TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
37 TC_ERR_REFILL = 'Refills';
38
39function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
40 AnOrder: TOrder): Boolean;
41var
42 frmRenewOutMed: TfrmRenewOutMed;
43begin
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;
61end;
62
63procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
64begin
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;
73end;
74
75procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
76var
77 NumRefills: Integer;
78begin
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;
88end;
89
90procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
91begin
92 inherited;
93 Close;
94end;
95
96end.
Note: See TracBrowser for help on using the repository browser.