source: cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas@ 1800

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

Upgrade to version 27

File size: 4.2 KB
Line 
1unit fConsultAlertTo;
2
3interface
4
5uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
6 Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
7
8type
9 TfrmConsultAlertsTo = class(TfrmBase508Form)
10 cmdOK: TButton;
11 cmdCancel: TButton;
12 cboSrcList: TORComboBox;
13 DstList: TORListBox;
14 SrcLabel: TLabel;
15 DstLabel: TLabel;
16 pnlBase: TORAutoPanel;
17 btnAdd: TButton;
18 btnRemove: TButton;
19 procedure cboSrcListNeedData(Sender: TObject; const StartFrom: String;
20 Direction, InsertAt: Integer);
21 procedure cmdOKClick(Sender: TObject);
22 procedure cmdCancelClick(Sender: TObject);
23 //procedure cboSrcListdblClick(Sender: TObject);
24 procedure cboSrcListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
25 procedure DstListClick(Sender: TObject);
26 procedure cboSrcListMouseClick(Sender: TObject);
27 private
28 FActionType: integer;
29 FRecipients: string ;
30 FChanged: Boolean;
31 end;
32
33TRecipientList = record
34 Changed: Boolean;
35 Recipients: string ;
36 end;
37
38procedure SelectRecipients(FontSize: Integer; ActionType: integer; var RecipientList: TRecipientList) ;
39
40implementation
41
42{$R *.DFM}
43
44uses rConsults, rCore, uCore, uConsults, fConsults;
45
46const
47 TX_RCPT_TEXT = 'Select recipients or press Cancel.';
48 TX_RCPT_CAP = 'No Recipients Selected';
49 TX_REQ_TEXT = 'The requesting provider is always included in this type of alert';
50 TX_REQ_CAP = 'Cannot Remove Recipient';
51
52procedure SelectRecipients(FontSize: Integer; ActionType: integer; var RecipientList: TRecipientList) ;
53{ displays recipients select form for consults and returns a record of the selection }
54var
55 frmConsultAlertsTo: TfrmConsultAlertsTo;
56begin
57 frmConsultAlertsTo := TfrmConsultAlertsTo.Create(Application);
58 try
59 ResizeAnchoredFormToFont(frmConsultAlertsTo);
60 with frmConsultAlertsTo do
61 begin
62 FActionType := ActionType;
63 FChanged := False;
64 cboSrcList.InitLongList('');
65(* cboSrcList.InitLongList(ConsultRec.SendingProviderName);
66 cboSrcList.SelectByIEN(ConsultRec.SendingProvider);
67 cboSrcListMouseClick(cboSrcList) ;*)
68 ShowModal;
69 with RecipientList do
70 begin
71 Recipients := Recipients + FRecipients ;
72 Changed := FChanged ;
73 end ;
74 end; {with frmConsultAlertsTo}
75 finally
76 frmConsultAlertsTo.Release;
77 end;
78end;
79
80procedure TfrmConsultAlertsTo.cboSrcListNeedData(Sender: TObject;
81 const StartFrom: String; Direction, InsertAt: Integer);
82begin
83 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
84end;
85
86procedure TfrmConsultAlertsTo.cmdCancelClick(Sender: TObject);
87begin
88 Close;
89end;
90
91procedure TfrmConsultAlertsTo.cmdOKClick(Sender: TObject);
92var
93 i: integer ;
94begin
95 if DstList.Items.Count = 0 then
96 begin
97 InfoBox(TX_RCPT_TEXT, TX_RCPT_CAP, MB_OK or MB_ICONWARNING);
98 FChanged := False ;
99 Exit;
100 end;
101 FChanged := True;
102 for i := 0 to DstList.Items.Count-1 do
103 FRecipients := Piece(DstList.Items[i],u,1) + ';' + FRecipients;
104 Close;
105end;
106
107(*procedure TfrmConsultAlertsTo.cboSrcListdblClick(Sender: TObject);
108begin
109 if cboSrcList.ItemIndex = -1 then exit ;
110 if DstList.SelectByID(cboSrcList.ItemID) = -1 then
111 DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
112end;*)
113
114procedure TfrmConsultAlertsTo.DstListClick(Sender: TObject);
115begin
116 if DstList.ItemIndex = -1 then exit ;
117(* if (DstList.ItemIEN = ConsultRec.SendingProvider) and
118 ((FActionType = CN_ACT_SIGFIND) or (FActionType = CN_ACT_ADMIN_COMPLETE)) then
119 begin
120 InfoBox(TX_REQ_TEXT, TX_REQ_CAP, MB_OK or MB_ICONWARNING);
121 exit ;
122 end ;*)
123 DstList.Items.Delete(DstList.ItemIndex) ;
124end;
125
126procedure TfrmConsultAlertsTo.cboSrcListKeyDown(Sender: TObject; var Key: Word;
127 Shift: TShiftState);
128begin
129 if Key = VK_RETURN then cboSrcListMouseClick(Self);
130end;
131
132procedure TfrmConsultAlertsTo.cboSrcListMouseClick(Sender: TObject);
133begin
134 if cboSrcList.ItemIndex = -1 then exit ;
135 if DstList.SelectByID(cboSrcList.ItemID) = -1 then
136 DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
137end;
138
139end.
Note: See TracBrowser for help on using the repository browser.