Module

fOrderComment

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
rOrders -

Classes

Name Comments
TfrmWardComments -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmWardComments procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmWardComments procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmWardComments procedure FormCreate(Sender: TObject); Public/Published -
memCommentsKeyUp TfrmWardComments procedure memCommentsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteWardComments - function ExecuteWardComments(AnOrder: TOrder): Boolean; Interfaced -

Constants

Name Declaration Scope Comments
TC_PUT_ERR 'Unable to Save Comments' Global -


Module Source

1     unit fOrderComment;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, VA508AccessibilityManager;
8     
9     type
10      TfrmWardComments = class(TfrmAutoSz)
11        Label1: TLabel;
12        cmdOK: TButton;
13        cmdCancel: TButton;
14        memOrder: TMemo;
15        memComments: TRichEdit;
16        procedure FormCreate(Sender: TObject);
17        procedure cmdOKClick(Sender: TObject);
18        procedure cmdCancelClick(Sender: TObject);
19        procedure memCommentsKeyUp(Sender: TObject; var Key: Word;
20          Shift: TShiftState);
21      private
22        OKPressed: Boolean;
23      end;
24    
25    function ExecuteWardComments(AnOrder: TOrder): Boolean;
26    
27    implementation
28    
29    {$R *.DFM}
30    
31    const
32      TC_PUT_ERR = 'Unable to Save Comments';
33    
34    function ExecuteWardComments(AnOrder: TOrder): Boolean;
35    var
36      frmWardComments: TfrmWardComments;
37      ErrMsg: string;
38    begin
39      Result := False;
40      frmWardComments := TfrmWardComments.Create(Application);
41      try
42        ResizeFormToFont(TForm(frmWardComments));
43        with frmWardComments do
44        begin
45          memOrder.SetTextBuf(PChar(AnOrder.Text));
46          LoadWardComments(memComments.Lines, AnOrder.ID);
47          ShowModal;
48          if OKPressed then
49          begin
50            PutWardComments(memComments.Lines, AnOrder.ID, ErrMsg);
51            if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TC_PUT_ERR, MB_OK);
52            Result := True;
53          end;
54        end;
55      finally
56        frmWardComments.Release;
57      end;
58    end;
59    
60    procedure TfrmWardComments.FormCreate(Sender: TObject);
61    begin
62      inherited;
63      OKPressed := False;
64    end;
65    
66    procedure TfrmWardComments.cmdOKClick(Sender: TObject);
67    begin
68      inherited;
69      OKPressed := True;
70      Close;
71    end;
72    
73    procedure TfrmWardComments.cmdCancelClick(Sender: TObject);
74    begin
75      inherited;
76      Close;
77    end;
78    
79    procedure TfrmWardComments.memCommentsKeyUp(Sender: TObject; var Key: Word;
80      Shift: TShiftState);
81    begin
82      inherited;
83      if (Key = VK_TAB) then
84      begin
85        if ssShift in Shift then
86        begin
87          FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
88          Key := 0;
89        end
90        else if ssCtrl	in Shift then
91        begin
92          FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
93          Key := 0;
94        end;
95      end;
96      if (key = VK_ESCAPE) then begin
97        FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
98        key := 0;
99      end;
100   end;
101   
102   end.

Module Calls (2 levels)


fOrderComment
 ├fAutoSz
 │ └fBase508Form
 └rOrders
   ├uCore
   ├rCore
   ├uConst
   ├UBAGlobals
   └UBACore

Module Called-By (2 levels)


          fOrderComment
              fOrders┘ 
            uOrders┤   
            fODBase┤   
             fFrame┤   
              rMisc┤   
            uODBase┤   
              fMeds┤   
          fOrdersDC┤   
          fOrdersCV┤   
            fOMNavA┤   
             fOMSet┤   
 fOrdersEvntRelease┤   
    fODReleaseEvent┤   
         mEvntDelay┤   
          fODActive┤   
        fOrdersCopy┤   
           fMedCopy┤   
fActivateDeactivate┘