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