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