| [459] | 1 | unit fARTFreeTextMsg; | 
|---|
|  | 2 |  | 
|---|
|  | 3 | interface | 
|---|
|  | 4 |  | 
|---|
|  | 5 | uses | 
|---|
|  | 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | 
|---|
|  | 7 | Dialogs, fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, ORCtrls; | 
|---|
|  | 8 |  | 
|---|
|  | 9 | type | 
|---|
|  | 10 | TfrmARTFreeTextMsg = class(TfrmAutoSz) | 
|---|
|  | 11 | pnlText: TORAutoPanel; | 
|---|
|  | 12 | pnlButton: TORAutoPanel; | 
|---|
|  | 13 | cmdContinue: TButton; | 
|---|
|  | 14 | lblText: TLabel; | 
|---|
|  | 15 | memFreeText: TCaptionRichEdit; | 
|---|
|  | 16 | lblComments: TOROffsetLabel; | 
|---|
|  | 17 | procedure cmdContinueClick(Sender: TObject); | 
|---|
|  | 18 | private | 
|---|
|  | 19 | FContinue: boolean; | 
|---|
|  | 20 | public | 
|---|
|  | 21 | end; | 
|---|
|  | 22 |  | 
|---|
|  | 23 | const | 
|---|
|  | 24 | LABEL_TEXT = 'You may now add any comments you may have to the message that' + CRLF + | 
|---|
|  | 25 | 'is going to be sent with the request to add this reactant.' + CRLF + CRLF + | 
|---|
|  | 26 |  | 
|---|
|  | 27 | 'You may want to add things like sign/symptoms, observed or historical, etc.,' + CRLF + | 
|---|
|  | 28 | 'that may be useful to the reviewer.' + CRLF + CRLF + | 
|---|
|  | 29 |  | 
|---|
|  | 30 | 'Already included are the entry you attempted, the patient you attempted to' + CRLF + | 
|---|
|  | 31 | 'enter it for, and your name, title, and contact information.'; | 
|---|
|  | 32 |  | 
|---|
|  | 33 | var | 
|---|
|  | 34 | tmpList: TStringList; | 
|---|
|  | 35 |  | 
|---|
|  | 36 | procedure GetFreeTextARTComment(var AFreeTextComment: TStringList; var OKtoContinue: boolean); | 
|---|
|  | 37 |  | 
|---|
|  | 38 | implementation | 
|---|
|  | 39 |  | 
|---|
|  | 40 | {$R *.dfm} | 
|---|
|  | 41 |  | 
|---|
|  | 42 | procedure GetFreeTextARTComment(var AFreeTextComment: TStringList; var OKtoContinue: boolean); | 
|---|
|  | 43 | var | 
|---|
|  | 44 | frmARTFreeTextMsg: TfrmARTFreeTextMsg; | 
|---|
|  | 45 | begin | 
|---|
|  | 46 | frmARTFreeTextMsg := TfrmARTFreeTextMsg.Create(Application); | 
|---|
|  | 47 | tmpList := TStringList.Create; | 
|---|
|  | 48 | try | 
|---|
|  | 49 | with frmARTFreeTextMsg do | 
|---|
|  | 50 | begin | 
|---|
|  | 51 | FContinue := OKtoContinue; | 
|---|
|  | 52 | tmpList.Text := ''; | 
|---|
|  | 53 | lblText.Caption := LABEL_TEXT; | 
|---|
|  | 54 | ResizeFormToFont(TForm(frmARTFreeTextMsg)); | 
|---|
|  | 55 | ActiveControl := memFreeText; | 
|---|
|  | 56 | frmARTFreeTextMsg.ShowModal; | 
|---|
|  | 57 | OKtoContinue := FContinue; | 
|---|
|  | 58 | AFreeTextComment.Assign(tmpList); | 
|---|
|  | 59 | end; | 
|---|
|  | 60 | finally | 
|---|
|  | 61 | tmpList.Free; | 
|---|
|  | 62 | frmARTFreeTextMsg.Release; | 
|---|
|  | 63 | end; | 
|---|
|  | 64 | end; | 
|---|
|  | 65 |  | 
|---|
|  | 66 | procedure TfrmARTFreeTextMsg.cmdContinueClick(Sender: TObject); | 
|---|
|  | 67 | begin | 
|---|
|  | 68 | inherited; | 
|---|
|  | 69 | tmpList.Assign(memFreeText.Lines); | 
|---|
|  | 70 | FContinue := True; | 
|---|
|  | 71 | Close; | 
|---|
|  | 72 | end; | 
|---|
|  | 73 |  | 
|---|
|  | 74 | end. | 
|---|