| 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. | 
|---|