Module

fPtSelMsg

Path

C:\CPRS\CPRS30\fPtSelMsg.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
fFrame -
uCore -

Classes

Name Comments
TfrmPtSelMsg -

Procedures

Name Owner Declaration Scope Comments
ActiveFormChanged TfrmPtSelMsg procedure ActiveFormChanged(Sender: TObject); Private -
ClearEvents TfrmPtSelMsg procedure ClearEvents; Private -
cmdCloseClick TfrmPtSelMsg procedure cmdCloseClick(Sender: TObject); Public/Published -
FormClose TfrmPtSelMsg procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPtSelMsg procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmPtSelMsg procedure FormDestroy(Sender: TObject); Public/Published -
HidePatientSelectMessages - procedure HidePatientSelectMessages; Interfaced -
ShowPatientSelectMessages - procedure ShowPatientSelectMessages(const AMsg: string); Interfaced -
TabChanged TfrmPtSelMsg procedure TabChanged(Sender: TObject); Private -
timCloseTimer TfrmPtSelMsg procedure timCloseTimer(Sender: TObject); Public/Published -

Global Variables

Name Type Declaration Comments
frmPtSelMsg TfrmPtSelMsg frmPtSelMsg: TfrmPtSelMsg = nil; -


Module Source

1     unit fPtSelMsg;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
8     
9     type
10      TfrmPtSelMsg = class(TfrmBase508Form)
11        cmdClose: TButton;
12        timClose: TTimer;
13        memMessages: TRichEdit;
14        procedure FormClose(Sender: TObject; var Action: TCloseAction);
15        procedure cmdCloseClick(Sender: TObject);
16        procedure timCloseTimer(Sender: TObject);
17        procedure FormCreate(Sender: TObject);
18        procedure FormDestroy(Sender: TObject);
19      private
20        FSeconds: Integer;
21        FChanging: boolean;
22        FEventsActive: boolean;
23        FOldActiveFormChanged: TNotifyEvent;
24        FOldTabChanged: TNotifyEvent;
25        procedure ClearEvents;
26        procedure TabChanged(Sender: TObject);
27        procedure ActiveFormChanged(Sender: TObject);
28      public
29        { Public declarations }
30      end;
31    
32    procedure ShowPatientSelectMessages(const AMsg: string);
33    procedure HidePatientSelectMessages;
34    
35    implementation
36    
37    {$R *.DFM}
38    
39    uses ORFn, uCore, fFrame;
40    
41    var
42      frmPtSelMsg: TfrmPtSelMsg = nil;
43    
44    procedure ShowPatientSelectMessages(const AMsg: string);
45    begin
46      if assigned(frmPtSelMsg) then
47      begin
48        frmPtSelMsg.Free;
49        frmPtSelMsg := nil;
50      end;
51      if Length(AMsg) = 0 then Exit;
52      frmPtSelMsg := TfrmPtSelMsg.Create(Application);
53      ResizeAnchoredFormToFont(frmPtSelMsg);
54      frmPtSelMsg.memMessages.Lines.SetText(PChar(AMsg));  // Text := AMsg doesn't seem to work
55      frmPtSelMsg.memMessages.SelStart := 0;
56      if User.PtMsgHang = 0
57        then frmPtSelMsg.timClose.Enabled := False
58        else
59        begin
60          //frmPtSelMsg.timClose.Interval := User.PtMsgHang * 1000;
61          frmPtSelMsg.FSeconds := User.PtMsgHang;
62          frmPtSelMsg.timClose.Enabled := True;
63        end;
64      frmPtSelMsg.Show;
65    end;
66    
67    procedure HidePatientSelectMessages;
68    begin
69      if assigned(frmPtSelMsg) then
70      begin
71        frmPtSelMsg.Free;
72        frmPtSelMsg := nil;
73      end;
74    end;
75    
76    procedure TfrmPtSelMsg.timCloseTimer(Sender: TObject);
77    begin
78      Dec(FSeconds);
79      if FSeconds > 0
80        then Caption := 'Patient Lookup Messages   (Auto-Close in ' + IntToStr(FSeconds) + ' seconds)'
81        else Close;
82    end;
83    
84    procedure TfrmPtSelMsg.cmdCloseClick(Sender: TObject);
85    begin
86      Close;
87    end;
88    
89    procedure TfrmPtSelMsg.FormClose(Sender: TObject; var Action: TCloseAction);
90    begin
91      Action := caFree;
92    end;
93    
94    procedure TfrmPtSelMsg.FormCreate(Sender: TObject);
95    begin
96      FOldActiveFormChanged := Screen.OnActiveFormChange;
97      Screen.OnActiveFormChange := ActiveFormChanged;
98      FOldTabChanged := frmFrame.OnTabChanged;
99      frmFrame.OnTabChanged := TabChanged;
100     FEventsActive := TRUE;
101   end;
102   
103   procedure TfrmPtSelMsg.FormDestroy(Sender: TObject);
104   begin
105     ClearEvents;
106     frmPtSelMsg := nil;
107   end;
108   
109   procedure TfrmPtSelMsg.ActiveFormChanged(Sender: TObject);
110   begin
111     if assigned(FOldActiveFormChanged) then
112       FOldActiveFormChanged(Sender);
113     if (not FChanging) and (Screen.ActiveForm <> Self) and
114        (not (csDestroying in Self.ComponentState)) then
115     begin
116       FChanging := TRUE;
117       try
118         SetFocus;
119       finally
120         FChanging := FALSE;
121       end;
122     end;
123   end;
124   
125   procedure TfrmPtSelMsg.ClearEvents;
126   begin
127     if FEventsActive then
128     begin
129       Screen.OnActiveFormChange := FOldActiveFormChanged;
130       frmFrame.OnTabChanged := FOldTabChanged;
131       FEventsActive := FALSE;
132     end;
133   end;
134   
135   procedure TfrmPtSelMsg.TabChanged(Sender: TObject);
136   begin
137     if assigned(FOldTabChanged) then
138       FOldTabChanged(Sender);
139     ClearEvents;
140   end;
141   
142   end.

Module Calls (2 levels)


fPtSelMsg
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 └fFrame
   ├fPage
   ├uConst
   ├VERGENCECONTEXTORLib_TLB
   ├fBase508Form...
   ├XuDsigS
   ├rCore...
   ├fPtSelMsg...
   ├fPtSel
   ├fCover
   ├fProbs
   ├fMeds
   ├fOrders
   ├rOrders...
   ├fNotes
   ├fConsults
   ├fDCSumm
   ├rMisc
   ├fLabs
   ├fReports
   ├rReports
   ├fPtDemo
   ├fEncnt
   ├fPtCWAD
   ├uCore...
   ├fAbout
   ├fReview
   ├fxBroker
   ├fxLists
   ├fxServer
   ├fRptBox
   ├rODAllergy
   ├uInit
   ├fLabInfo
   ├uReminders
   ├fReminderTree
   ├fDeviceSelect
   ├fDrawers
   ├fReminderDialog
   ├fOptions
   ├fGraphs
   ├fGraphData
   ├rTemplates
   ├fSurgery
   ├rSurgery
   ├uEventHooks
   ├uSignItems
   ├rECS
   ├fIconLegend
   ├uOrders...
   ├uSpell
   ├uOrPtf
   ├fPatientFlagMulti
   ├fAlertForward
   ├UBAGlobals
   ├UBACore
   ├fOrdersSign
   ├uVitals
   ├fMHTest
   ├uFormMonitor
   ├fOtherSchedule
   ├uVA508CPRSCompatibility
   ├fIVRoutes
   ├fPrintLocation
   ├fTemplateEditor
   └fCombatVet

Module Called-By (2 levels)


                  fPtSelMsg
                   fFrame┘ 
              CPRSChart┤   
                  fPage┤   
                uOrders┤   
                fODBase┤   
                UBACore┤   
                fOrders┤   
                   uPCE┤   
      fBALocalDiagnoses┤   
             fEncVitals┤   
                fVitals┤   
                 fCover┤   
                 rCover┤   
           fPtSelMsg...┤   
                 fPtSel┤   
            fOrdersSign┤   
         fPrintLocation┤   
                  fMeds┤   
                fRptBox┤   
                 fNotes┤   
               fReports┤   
                 fEncnt┤   
                 fProbs┤   
          fReportsPrint┤   
                fGraphs┤   
              fConsults┤   
                fDCSumm┤   
        fReminderDialog┤   
                  fLabs┤   
              fLabPrint┤   
                fReview┤   
            fIconLegend┤   
           fOrdersPrint┤   
               fSurgery┤   
uVA508CPRSCompatibility┤   
           fOrdersRenew┤   
             fODConsult┤   
                fODProc┤   
                 fODRad┤   
                 fODLab┤   
                fODMeds┤   
               fODMedIV┤   
              fODVitals┤   
                fODAuto┤   
                 fOMSet┤   
         fOrdersRelease┤   
              fODMedNVA┤   
         fOrdersOnChart┤   
             fOCSession┤   
              fODActive┤   
               fPCEEdit┘