| 1 | unit fConsultAlertTo;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
 | 
|---|
| 6 |   Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 | 
|---|
| 7 | 
 | 
|---|
| 8 | type
 | 
|---|
| 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 | 
 | 
|---|
| 33 | TRecipientList = record
 | 
|---|
| 34 |     Changed: Boolean;
 | 
|---|
| 35 |     Recipients: string ;
 | 
|---|
| 36 |   end;
 | 
|---|
| 37 | 
 | 
|---|
| 38 | procedure SelectRecipients(FontSize: Integer; ActionType: integer; var RecipientList: TRecipientList) ;
 | 
|---|
| 39 | 
 | 
|---|
| 40 | implementation
 | 
|---|
| 41 | 
 | 
|---|
| 42 | {$R *.DFM}
 | 
|---|
| 43 | 
 | 
|---|
| 44 | uses rConsults, rCore, uCore, uConsults, fConsults;
 | 
|---|
| 45 | 
 | 
|---|
| 46 | const
 | 
|---|
| 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 | 
 | 
|---|
| 52 | procedure SelectRecipients(FontSize: Integer; ActionType: integer; var RecipientList: TRecipientList) ;
 | 
|---|
| 53 | { displays recipients select form for consults and returns a record of the selection }
 | 
|---|
| 54 | var
 | 
|---|
| 55 |   frmConsultAlertsTo: TfrmConsultAlertsTo;
 | 
|---|
| 56 | begin
 | 
|---|
| 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;
 | 
|---|
| 78 | end;
 | 
|---|
| 79 | 
 | 
|---|
| 80 | procedure TfrmConsultAlertsTo.cboSrcListNeedData(Sender: TObject;
 | 
|---|
| 81 |   const StartFrom: String; Direction, InsertAt: Integer);
 | 
|---|
| 82 | begin
 | 
|---|
| 83 |   (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
 | 
|---|
| 84 | end;
 | 
|---|
| 85 | 
 | 
|---|
| 86 | procedure TfrmConsultAlertsTo.cmdCancelClick(Sender: TObject);
 | 
|---|
| 87 | begin
 | 
|---|
| 88 |   Close;
 | 
|---|
| 89 | end;
 | 
|---|
| 90 | 
 | 
|---|
| 91 | procedure TfrmConsultAlertsTo.cmdOKClick(Sender: TObject);
 | 
|---|
| 92 | var
 | 
|---|
| 93 |   i: integer ;
 | 
|---|
| 94 | begin
 | 
|---|
| 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;
 | 
|---|
| 105 | end;
 | 
|---|
| 106 | 
 | 
|---|
| 107 | (*procedure TfrmConsultAlertsTo.cboSrcListdblClick(Sender: TObject);
 | 
|---|
| 108 | begin
 | 
|---|
| 109 |      if cboSrcList.ItemIndex = -1 then exit ;
 | 
|---|
| 110 |      if DstList.SelectByID(cboSrcList.ItemID) = -1 then
 | 
|---|
| 111 |        DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
 | 
|---|
| 112 | end;*)
 | 
|---|
| 113 | 
 | 
|---|
| 114 | procedure TfrmConsultAlertsTo.DstListClick(Sender: TObject);
 | 
|---|
| 115 | begin
 | 
|---|
| 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) ;
 | 
|---|
| 124 | end;
 | 
|---|
| 125 | 
 | 
|---|
| 126 | procedure TfrmConsultAlertsTo.cboSrcListKeyDown(Sender: TObject; var Key: Word;
 | 
|---|
| 127 |   Shift: TShiftState);
 | 
|---|
| 128 | begin
 | 
|---|
| 129 |   if Key = VK_RETURN then cboSrcListMouseClick(Self);
 | 
|---|
| 130 | end;
 | 
|---|
| 131 | 
 | 
|---|
| 132 | procedure TfrmConsultAlertsTo.cboSrcListMouseClick(Sender: TObject);
 | 
|---|
| 133 | begin
 | 
|---|
| 134 |      if cboSrcList.ItemIndex = -1 then exit ;
 | 
|---|
| 135 |      if DstList.SelectByID(cboSrcList.ItemID) = -1 then
 | 
|---|
| 136 |        DstList.Items.Add(cboSrcList.Items[cboSrcList.Itemindex]) ;
 | 
|---|
| 137 | end;
 | 
|---|
| 138 | 
 | 
|---|
| 139 | end.
 | 
|---|