source: cprs/branches/foia-cprs/CPRS-Chart/fRenewOutMed.pas@ 711

Last change on this file since 711 was 460, checked in by Kevin Toppenberg, 16 years ago

Uploading from OR_30_258

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