source: cprs/branches/foia-cprs/CPRS-Chart/fARTFreeTextMsg.pas@ 1743

Last change on this file since 1743 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 2.1 KB
RevLine 
[459]1unit fARTFreeTextMsg;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, ORCtrls;
8
9type
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
38implementation
39
40{$R *.dfm}
41
42procedure GetFreeTextARTComment(var AFreeTextComment: TStringList; var OKtoContinue: boolean);
43var
44 frmARTFreeTextMsg: TfrmARTFreeTextMsg;
45begin
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;
64end;
65
66procedure TfrmARTFreeTextMsg.cmdContinueClick(Sender: TObject);
67begin
68 inherited;
69 tmpList.Assign(memFreeText.Lines);
70 FContinue := True;
71 Close;
72end;
73
74end.
Note: See TracBrowser for help on using the repository browser.