source: cprs/trunk/CPRS-Chart/Orders/fODChangeUnreleasedRenew.pas@ 1424

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

Upgrade to version 27

File size: 4.5 KB
Line 
1unit fODChangeUnreleasedRenew;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders,
8 VA508AccessibilityManager;
9
10type
11 TfrmODChangeUnreleasedRenew = class(TFrmAutoSz)
12 memOrder: TCaptionMemo;
13 Panel1: TPanel;
14 btnOK: TButton;
15 btnCancel: TButton;
16 Panel2: TPanel;
17 edtRefill: TCaptionEdit;
18 lblRefill: TLabel;
19 lblPickUp: TLabel;
20 cboPickup: TORComboBox;
21 Panel3: TPanel;
22 Label1: TLabel;
23 Label2: TLabel;
24 txtStart: TORDateBox;
25 txtStop: TORDateBox;
26 procedure FormCreate(Sender: TObject);
27 procedure btnCancelClick(Sender: TObject);
28 procedure btnOKClick(Sender: TObject);
29 private
30 OKPressed: boolean;
31 FCategory: integer;
32 public
33 { Public declarations }
34 end;
35
36procedure ExecuteChangeRenewedOrder(const AnID: string; var param1, param2: string; Category: integer);
37
38implementation
39
40{$R *.dfm}
41const
42 TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
43 TC_ERR_REFILL = 'Refills';
44 TC_INVALID_DATE = 'Unable to interpret date/time entry.';
45 TX_BAD_START = 'The start date is not valid.';
46 TX_BAD_STOP = 'The stop date is not valid.';
47 TX_STOPSTART = 'The stop date must be after the start date.';
48
49procedure ExecuteChangeRenewedOrder(const AnID: string; var param1, param2: string; Category: integer);
50var
51 frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew;
52 theText: string;
53 tmpRefills: integer;
54begin
55 tmpRefills := 0;
56 theText := Trim(RetrieveOrderText(AnID));
57 if Pos('>> RENEW', UpperCase(theText)) = 1 then Delete(theText,1,length('>> RENEW'))
58 else if Pos('RENEW',UpperCase(theText))= 1 then Delete(theText,1,length('RENEW'));
59 frmODChangeUnreleasedRenew := TfrmODChangeUnreleasedRenew.Create(Application);
60 try
61 frmODChangeUnreleasedRenew.FCategory := Category;
62 ResizeFormToFont(TForm(frmODChangeUnreleasedRenew));
63 if Category = 0 then
64 begin
65 frmODChangeUnreleasedRenew.Panel3.Visible := False;
66 tmpRefills := StrToIntDef(param1,0);
67 frmODChangeUnreleasedRenew.edtRefill.Text := param1;
68 frmODChangeUnreleasedRenew.cboPickup.SelectByID(param2);
69 frmODChangeUnreleasedRenew.memOrder.SetTextBuf(PChar(theText));
70 end
71 else if Category = 1 then
72 begin
73 frmODChangeUnreleasedRenew.Panel2.Visible := false;
74 frmODChangeUnreleasedRenew.txtStart.Text := param1;
75 frmODChangeUnreleasedRenew.txtStop.Text := param2;
76 frmODChangeUnreleasedRenew.memOrder.SetTextBuf(PChar(theText));
77 end;
78 frmODChangeUnreleasedRenew.ShowModal;
79 if frmODChangeUnreleasedRenew.OKPressed then
80 begin
81 if Category = 0 then
82 begin
83 tmpRefills := StrToIntDef(frmODChangeUnreleasedRenew.edtRefill.Text, tmpRefills);
84 param1 := IntToStr(tmpRefills);
85 param2 := frmODChangeUnreleasedRenew.cboPickup.ItemID;
86 end
87 else if Category = 1 then
88 begin
89 param1 := frmODChangeUnreleasedRenew.txtStart.Text;
90 param2 := frmODChangeUnreleasedRenew.txtStop.Text;
91 end;
92 end;
93 finally
94 frmODChangeUnreleasedRenew.Release;
95 end;
96end;
97
98procedure TfrmODChangeUnreleasedRenew.FormCreate(Sender: TObject);
99begin
100 inherited;
101 OKPressed := False;
102 with cboPickup.Items do
103 begin
104 Add('W^at Window');
105 Add('M^by Mail');
106 Add('C^in Clinic');
107 end;
108end;
109
110procedure TfrmODChangeUnreleasedRenew.btnCancelClick(Sender: TObject);
111begin
112 inherited;
113 Close;
114end;
115
116procedure TfrmODChangeUnreleasedRenew.btnOKClick(Sender: TObject);
117var
118 NumRefills: Integer;
119 x, ErrMsg: string;
120begin
121 inherited;
122 if panel2.Visible then
123 begin
124 NumRefills := StrToIntDef(edtRefill.Text, -1);
125 if (NumRefills < 0) or (NumRefills > 11) then
126 begin
127 InfoBox(TX_ERR_REFILL, TC_ERR_REFILL, MB_OK);
128 Exit;
129 end;
130 end
131 else if panel3.Visible then
132 begin
133 ErrMsg := '';
134 txtStart.Validate(x);
135 if Length(x) > 0 then ErrMsg := ErrMsg + TX_BAD_START + CRLF;
136 with txtStop do
137 begin
138 Validate(x);
139 if Length(x) > 0 then ErrMsg := ErrMsg + TX_BAD_STOP + CRLF;
140 if (Length(Text) > 0) and (FMDateTime <= txtStart.FMDateTime)
141 then ErrMsg := ErrMsg + TX_STOPSTART;
142 end;
143 if Length(ErrMsg) > 0 then
144 begin
145 InfoBox(ErrMsg, TC_INVALID_DATE, MB_OK);
146 Exit;
147 end;
148 end;
149 OKPressed := True;
150 Close;
151end;
152
153end.
Note: See TracBrowser for help on using the repository browser.