source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODChangeUnreleasedRenew.pas@ 1806

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

Adding foia-cprs branch

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