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

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

Upgrade to version 27

File size: 2.8 KB
Line 
1unit fOrderFlag;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
8
9type
10 TfrmFlagOrder = class(TfrmAutoSz)
11 Label1: TLabel;
12 cmdOK: TButton;
13 cmdCancel: TButton;
14 memOrder: TMemo;
15 lblAlertRecipient: TLabel;
16 cboAlertRecipient: TORComboBox;
17 cboFlagReason: TORComboBox;
18 procedure FormCreate(Sender: TObject);
19 procedure cmdOKClick(Sender: TObject);
20 procedure cmdCancelClick(Sender: TObject);
21 procedure cboOnExit(Sender: TObject);
22 procedure cboAlertRecipientNeedData(Sender: TObject;
23 const StartFrom: String; Direction, InsertAt: Integer);
24 private
25 OKPressed: Boolean;
26 end;
27
28function ExecuteFlagOrder(AnOrder: TOrder): Boolean;
29
30implementation
31
32{$R *.DFM}
33
34uses uCore, rCore;
35
36var AlertRecip: Int64;
37
38function ExecuteFlagOrder(AnOrder: TOrder): Boolean;
39var
40 frmFlagOrder: TfrmFlagOrder;
41begin
42 Result := False;
43 frmFlagOrder := TfrmFlagOrder.Create(Application);
44 try
45 ResizeFormToFont(TForm(frmFlagOrder));
46 //AlertRecip := User.DUZ;
47 with frmFlagOrder do
48 begin
49 memOrder.SetTextBuf(PChar(AnOrder.Text));
50 ShowModal;
51 if OKPressed then
52 begin
53 FlagOrder(AnOrder, cboFlagReason.Text, AlertRecip);
54 Result := True;
55 end;
56 end;
57 finally
58 frmFlagOrder.Release;
59 AlertRecip := 0;
60 end;
61end;
62
63procedure TfrmFlagOrder.FormCreate(Sender: TObject);
64var
65 tmpList: TStringList;
66begin
67 inherited;
68 OKPressed := False;
69 tmpList := TStringList.Create;
70 try
71 GetUserListParam(tmpList, 'OR FLAGGED ORD REASONS');
72 FastAssign(tmpList, cboFlagReason.Items);
73 finally
74 tmpList.Free;
75 end;
76 cboAlertRecipient.InitLongList('');
77 //cboAlertRecipient.SelectByIEN(User.DUZ);
78end;
79
80procedure TfrmFlagOrder.cmdOKClick(Sender: TObject);
81const
82 TX_REASON_REQ = 'A reason must be entered to flag an order.';
83 TC_REASON_REQ = 'Reason Required';
84begin
85 inherited;
86 if cboFlagReason.Text = '' then
87 //if txtReason.Text = '' then
88 begin
89 InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);
90 Exit;
91 end;
92 cmdOK.SetFocus;
93 OKPressed := True;
94 Close;
95end;
96
97procedure TfrmFlagOrder.cmdCancelClick(Sender: TObject);
98begin
99 inherited;
100 Close;
101end;
102
103procedure TfrmFlagOrder.cboOnExit(Sender: TObject);
104begin
105 with cboAlertRecipient do
106 if (ItemIndex = -1) or (Text = '') then
107 begin
108 AlertRecip := -1;
109 ItemIndex := -1;
110 Text := '';
111 end
112 else
113 begin
114 AlertRecip := ItemIEN;
115 end;
116end;
117
118procedure TfrmFlagOrder.cboAlertRecipientNeedData(Sender: TObject;
119 const StartFrom: String; Direction, InsertAt: Integer);
120begin
121 cboAlertRecipient.ForDataUse(SubSetOfPersons(StartFrom, Direction));
122end;
123
124end.
Note: See TracBrowser for help on using the repository browser.