source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsultAlertTo.pas@ 454

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.1 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/26/2007
2unit fConsultAlertTo;
3
4interface
5
6uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
7 Buttons, ORCtrls, ORfn, ExtCtrls, DKLang;
8
9type
10 TfrmConsultAlertsTo = class(TForm)
11 cmdOK: TButton;
12 cmdCancel: TButton;
13 cboSrcList: TORComboBox;
14 DstList: TORListBox;
15 SrcLabel: TLabel;
16 DstLabel: TLabel;
17 pnlBase: TORAutoPanel;
18 DKLanguageController1: TDKLanguageController;
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
46//const
47//TX_RCPT_TEXT = 'Select recipients or press Cancel.'; <-- original line. //kt 8/26/2007
48//TX_RCPT_CAP = 'No Recipients Selected'; <-- original line. //kt 8/26/2007
49//TX_REQ_TEXT = 'The requesting provider is always included in this type of alert'; <-- original line. //kt 8/26/2007
50//TX_REQ_CAP = 'Cannot Remove Recipient'; <-- original line. //kt 8/26/2007
51
52var
53 TX_RCPT_TEXT : string; //kt
54 TX_RCPT_CAP : string; //kt
55 TX_REQ_TEXT : string; //kt
56 TX_REQ_CAP : string; //kt
57
58procedure SetupVars;
59//kt Added entire function to replace constant declarations 8/26/2007
60begin
61 TX_RCPT_TEXT := DKLangConstW('fConsultAlertTo_Select_recipients_or_press_Cancelx');
62 TX_RCPT_CAP := DKLangConstW('fConsultAlertTo_No_Recipients_Selected');
63 TX_REQ_TEXT := DKLangConstW('fConsultAlertTo_The_requesting_provider_is_always_included_in_this_type_of_alert');
64 TX_REQ_CAP := DKLangConstW('fConsultAlertTo_Cannot_Remove_Recipient');
65end;
66
67procedure SelectRecipients(FontSize: Integer; ActionType: integer; var RecipientList: TRecipientList) ;
68{ displays recipients select form for consults and returns a record of the selection }
69var
70 frmConsultAlertsTo: TfrmConsultAlertsTo;
71begin
72 frmConsultAlertsTo := TfrmConsultAlertsTo.Create(Application);
73 try
74 ResizeAnchoredFormToFont(frmConsultAlertsTo);
75 with frmConsultAlertsTo do
76 begin
77 FActionType := ActionType;
78 FChanged := False;
79 cboSrcList.InitLongList('');
80(* cboSrcList.InitLongList(ConsultRec.SendingProviderName);
81 cboSrcList.SelectByIEN(ConsultRec.SendingProvider);
82 cboSrcListMouseClick(cboSrcList) ;*)
83 ShowModal;
84 with RecipientList do
85 begin
86 Recipients := Recipients + FRecipients ;
87 Changed := FChanged ;
88 end ;
89 end; {with frmConsultAlertsTo}
90 finally
91 frmConsultAlertsTo.Release;
92 end;
93end;
94
95procedure TfrmConsultAlertsTo.cboSrcListNeedData(Sender: TObject;
96 const StartFrom: String; Direction, InsertAt: Integer);
97begin
98 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
99end;
100
101procedure TfrmConsultAlertsTo.cmdCancelClick(Sender: TObject);
102begin
103 Close;
104end;
105
106procedure TfrmConsultAlertsTo.cmdOKClick(Sender: TObject);
107var
108 i: integer ;
109begin
110 SetupVars; //kt added 8/26/2007 to replace constants with vars.
111 if DstList.Items.Count = 0 then
112 begin
113 InfoBox(TX_RCPT_TEXT, TX_RCPT_CAP, MB_OK or MB_ICONWARNING);
114 FChanged := False ;
115 Exit;
116 end;
117 FChanged := True;
118 for i := 0 to DstList.Items.Count-1 do
119 FRecipients := Piece(DstList.Items[i],u,1) + ';' + FRecipients;
120 Close;
121end;
122
123(*procedure TfrmConsultAlertsTo.cboSrcListdblClick(Sender: TObject);
124begin
125 if cboSrcList.ItemIndex = -1 then exit ;
126 if DstList.SelectByID(cboSrcList.ItemID) = -1 then
127 DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
128end;*)
129
130procedure TfrmConsultAlertsTo.DstListClick(Sender: TObject);
131begin
132 SetupVars; //kt added 8/26/2007 to replace constants with vars.
133 if DstList.ItemIndex = -1 then exit ;
134(* if (DstList.ItemIEN = ConsultRec.SendingProvider) and
135 ((FActionType = CN_ACT_SIGFIND) or (FActionType = CN_ACT_ADMIN_COMPLETE)) then
136 begin
137 InfoBox(TX_REQ_TEXT, TX_REQ_CAP, MB_OK or MB_ICONWARNING);
138 exit ;
139 end ;*)
140 DstList.Items.Delete(DstList.ItemIndex) ;
141end;
142
143procedure TfrmConsultAlertsTo.cboSrcListKeyDown(Sender: TObject; var Key: Word;
144 Shift: TShiftState);
145begin
146 if Key = VK_RETURN then cboSrcListMouseClick(Self);
147end;
148
149procedure TfrmConsultAlertsTo.cboSrcListMouseClick(Sender: TObject);
150begin
151 if cboSrcList.ItemIndex = -1 then exit ;
152 if DstList.SelectByID(cboSrcList.ItemID) = -1 then
153 DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
154end;
155
156end.
Note: See TracBrowser for help on using the repository browser.