source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fRenewOutMed.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 2.9 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, fBase508Form,
8 VA508AccessibilityManager, VA508AccessibilityRouter;
9
10type
11 TfrmRenewOutMed = class(TfrmBase508Form)
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 VA508ComponentAccessibility1: TVA508ComponentAccessibility;
22 procedure FormCreate(Sender: TObject);
23 procedure cmdOKClick(Sender: TObject);
24 procedure cmdCancelClick(Sender: TObject);
25 procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
26 var Text: string);
27 procedure FormShow(Sender: TObject);
28 private
29 OKPressed: Boolean;
30 end;
31
32function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
33 AnOrder: TOrder): Boolean;
34
35implementation
36
37{$R *.DFM}
38
39const
40 TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
41 TC_ERR_REFILL = 'Refills';
42
43function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
44 AnOrder: TOrder): Boolean;
45var
46 frmRenewOutMed: TfrmRenewOutMed;
47begin
48 Result := False;
49 frmRenewOutMed := TfrmRenewOutMed.Create(Application);
50 try
51 ResizeFormToFont(TForm(frmRenewOutMed));
52 frmRenewOutMed.memOrder.SetTextBuf(PChar(AnOrder.Text));
53 frmRenewOutMed.txtRefills.Text := IntToStr(Refills);
54 frmRenewOutMed.cboPickup.SelectByID(Pickup);
55 frmRenewOutMed.ShowModal;
56 if frmRenewOutMed.OKPressed then
57 begin
58 Result := True;
59 Refills := StrToIntDef(frmRenewOutMed.txtRefills.Text, Refills);
60 Pickup := frmRenewOutMed.cboPickup.ItemID;
61 end;
62 finally
63 frmRenewOutMed.Release;
64 end;
65end;
66
67procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
68begin
69 inherited;
70 OKPressed := False;
71 with cboPickup.Items do
72 begin
73 Add('W^at Window');
74 Add('M^by Mail');
75 Add('C^in Clinic');
76 end;
77end;
78
79procedure TfrmRenewOutMed.FormShow(Sender: TObject);
80begin
81 inherited;
82 if ScreenReaderSystemActive then
83 begin
84 memOrder.TabStop := true;
85 memOrder.SetFocus;
86 end;
87end;
88
89procedure TfrmRenewOutMed.VA508ComponentAccessibility1StateQuery(
90 Sender: TObject; var Text: string);
91begin
92 inherited;
93 Text := memOrder.Text;
94end;
95
96procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
97var
98 NumRefills: Integer;
99begin
100 inherited;
101 NumRefills := StrToIntDef(txtRefills.Text, -1);
102 if (NumRefills < 0) or (NumRefills > 11) then
103 begin
104 InfoBox(TX_ERR_REFILL, TC_ERR_REFILL, MB_OK);
105 Exit;
106 end;
107 OKPressed := True;
108 Close;
109end;
110
111procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
112begin
113 inherited;
114 Close;
115end;
116
117end.
Note: See TracBrowser for help on using the repository browser.