Module

fODText

Path

C:\CPRS\CPRS30\Orders\fODText.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fODBase -
uConst -

Units Used in Implementation

Name Comments
rCore -

Classes

Name Comments
TfrmODText -

Procedures

Name Owner Declaration Scope Comments
cmdAcceptClick TfrmODText procedure cmdAcceptClick(Sender: TObject); Public/Published -
ControlChange TfrmODText procedure ControlChange(Sender: TObject); Public/Published -
FormCreate TfrmODText procedure FormCreate(Sender: TObject); Public/Published TfrmODBase common methods
InitDialog TfrmODText procedure InitDialog; override; Public -
SetError - procedure SetError(const x: string); Local -
SetupDialog TfrmODText procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
VA508CompMemOrderStateQuery TfrmODText procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string); Public/Published -
Validate TfrmODText procedure Validate(var AnErrMsg: string); override; Public -

Global Variables

Name Type Declaration Comments
frmODText TfrmODText frmODText: TfrmODText; -

Constants

Name Declaration Scope Comments
TX_GREATER 'Stop date must be greater than start date.' Global -
TX_NO_TEXT 'Some text must be entered.' Global -
TX_STARTDT 'Unable to interpret start date.' Global -
TX_STOPDT 'Unable to interpret stop date.' Global -


Module Source

1     unit fODText;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmODText = class(TfrmODBase)
12        memText: TMemo;
13        lblText: TLabel;
14        txtStart: TORDateBox;
15        txtStop: TORDateBox;
16        lblStart: TLabel;
17        lblStop: TLabel;
18        VA508CompMemOrder: TVA508ComponentAccessibility;
19        lblOrderSig: TLabel;
20        procedure FormCreate(Sender: TObject);
21        procedure ControlChange(Sender: TObject);
22        procedure cmdAcceptClick(Sender: TObject);
23        procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
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    
30    var
31      frmODText: TfrmODText;
32    
33    implementation
34    
35    {$R *.DFM}
36    
37    uses rCore;
38    
39    const
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    
47    procedure TfrmODText.FormCreate(Sender: TObject);
48    begin
49      inherited;
50      FillerID := 'OR';                     // does 'on Display' order check **KCM**
51      StatusText('Loading Dialog Definition');
52      Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDER';  // loads formatting info
53      //StatusText('Loading Default Values');                // there are no defaults for text only
54      //CtrlInits.LoadDefaults(ODForText);
55      InitDialog;
56      StatusText('');
57    end;
58    
59    procedure TfrmODText.InitDialog;
60    begin
61      inherited;                             // inherited clears dialog controls and responses
62      ActiveControl := memText;  //SetFocusedControl(memText);
63    end;
64    
65    procedure TfrmODText.SetupDialog(OrderAction: Integer; const ID: string);
66    begin
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';
75    end;
76    
77    procedure TfrmODText.VA508CompMemOrderStateQuery(Sender: TObject;
78      var Text: string);
79    begin
80      inherited;
81      Text := memOrder.Text;
82    end;
83    
84    procedure TfrmODText.Validate(var AnErrMsg: string);
85    const
86      SPACE_CHAR = 32;
87    var
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    
98    begin
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;
122   end;
123   
124   procedure TfrmODText.cmdAcceptClick(Sender: TObject);
125   begin
126     inherited;
127     Application.ProcessMessages; //CQ 14670
128     memText.Lines.Text := Trim(memText.Lines.Text); //CQ 14670
129   end;
130   
131   procedure TfrmODText.ControlChange(Sender: TObject);
132   begin
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;
139   end;
140   
141   end.

Module Calls (2 levels)


fODText
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uConst
 └rCore...

Module Called-By (2 levels)


                     fODText
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘