source: cprs/trunk/CPRS-Chart/Orders/fODText.pas@ 1722

Last change on this file since 1722 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28

File size: 4.1 KB
RevLine 
[456]1unit fODText;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[829]7 fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm,
8 VA508AccessibilityManager;
[456]9
10type
11 TfrmODText = class(TfrmODBase)
12 memText: TMemo;
13 lblText: TLabel;
14 txtStart: TORDateBox;
15 txtStop: TORDateBox;
16 lblStart: TLabel;
17 lblStop: TLabel;
[1679]18 VA508CompMemOrder: TVA508ComponentAccessibility;
19 lblOrderSig: TLabel;
[456]20 procedure FormCreate(Sender: TObject);
21 procedure ControlChange(Sender: TObject);
[829]22 procedure cmdAcceptClick(Sender: TObject);
[1679]23 procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
[456]24 public
25 procedure InitDialog; override;
26 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
27 procedure Validate(var AnErrMsg: string); override;
28 end;
29
30var
31 frmODText: TfrmODText;
32
33implementation
34
35{$R *.DFM}
36
37uses rCore;
38
39const
40 TX_NO_TEXT = 'Some text must be entered.';
41 TX_STARTDT = 'Unable to interpret start date.';
42 TX_STOPDT = 'Unable to interpret stop date.';
43 TX_GREATER = 'Stop date must be greater than start date.';
44
45{ TfrmODBase common methods }
46
47procedure TfrmODText.FormCreate(Sender: TObject);
48begin
49 inherited;
50 FillerID := 'OR'; // does 'on Display' order check **KCM**
51 StatusText('Loading Dialog Definition');
[829]52 Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDER'; // loads formatting info
[456]53 //StatusText('Loading Default Values'); // there are no defaults for text only
54 //CtrlInits.LoadDefaults(ODForText);
55 InitDialog;
56 StatusText('');
57end;
58
59procedure TfrmODText.InitDialog;
60begin
61 inherited; // inherited clears dialog controls and responses
62 ActiveControl := memText; //SetFocusedControl(memText);
63end;
64
65procedure TfrmODText.SetupDialog(OrderAction: Integer; const ID: string);
66begin
67 inherited;
68 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
69 begin
70 SetControl(memText, 'COMMENT', 1);
71 SetControl(txtStart, 'START', 1);
72 SetControl(txtStop, 'STOP', 1);
73 end
74 else txtStart.Text := 'NOW';
75end;
76
[1679]77procedure TfrmODText.VA508CompMemOrderStateQuery(Sender: TObject;
78 var Text: string);
79begin
80 inherited;
81 Text := memOrder.Text;
82end;
83
[456]84procedure TfrmODText.Validate(var AnErrMsg: string);
85const
86 SPACE_CHAR = 32;
87var
88 ContainsPrintable: Boolean;
89 i: Integer;
90 StartTime, StopTime: TFMDateTime;
91
92 procedure SetError(const x: string);
93 begin
94 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
95 AnErrMsg := AnErrMsg + x;
96 end;
97
98begin
99 inherited;
100 ContainsPrintable := False;
101 for i := 1 to Length(memText.Text) do if Ord(memText.Text[i]) > SPACE_CHAR then
102 begin
103 ContainsPrintable := True;
104 break;
105 end;
106 if not ContainsPrintable then SetError(TX_NO_TEXT);
107 with txtStart do if Length(Text) > 0
108 then StartTime := StrToFMDateTime(Text)
109 else StartTime := 0;
110 with txtStop do if Length(Text) > 0
111 then StopTime := StrToFMDateTime(Text)
112 else StopTime := 0;
113 if StartTime = -1 then SetError(TX_STARTDT);
114 if StopTime = -1 then SetError(TX_STARTDT);
115 if (StopTime > 0) and (StopTime < StartTime) then SetError(TX_GREATER);
116 //the following is commented out because should be using relative times
117 //if AnErrMsg = '' then
118 //begin
119 // Responses.Update('START', 1, FloatToStr(StartTime), txtStart.Text);
120 // Responses.Update('STOP', 1, FloatToStr(StopTime), txtStop.Text);
121 //end;
122end;
123
[829]124procedure TfrmODText.cmdAcceptClick(Sender: TObject);
125begin
126 inherited;
127 Application.ProcessMessages; //CQ 14670
128 memText.Lines.Text := Trim(memText.Lines.Text); //CQ 14670
129end;
130
[456]131procedure TfrmODText.ControlChange(Sender: TObject);
132begin
133 inherited;
134 if Changing then Exit;
135 with memText do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
136 with txtStart do if Length(Text) > 0 then Responses.Update('START', 1, Text, Text);
137 with txtStop do if Length(Text) > 0 then Responses.Update('STOP', 1, Text, Text);
138 memOrder.Text := Responses.OrderText;
139end;
140
141end.
142
143
Note: See TracBrowser for help on using the repository browser.