Module

fOrdersTS

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
mEvntDelay -
rOrders -
uConst -

Units Used in Implementation

Name Comments
fOrders -
rMisc -
uCore -

Classes

Name Comments
TfrmOrdersTS -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmOrdersTS procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmOrdersTS procedure cmdOKClick(Sender: TObject); Public/Published -
FormClose TfrmOrdersTS procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmOrdersTS procedure FormCreate(Sender: TObject); Public/Published -
FormKeyDown TfrmOrdersTS procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
fraEvntDelayListcboEvntListChange TfrmOrdersTS procedure fraEvntDelayListcboEvntListChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsChange TfrmOrdersTS procedure fraEvntDelayListmlstEventsChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsDblClick TfrmOrdersTS procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject); Public/Published -
radDelayedClick TfrmOrdersTS procedure radDelayedClick(Sender: TObject); Public/Published -
radReleaseNowClick TfrmOrdersTS procedure radReleaseNowClick(Sender: TObject); Public/Published -
UMStillDelay TfrmOrdersTS procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY; Public/Published -

Functions

Name Owner Declaration Scope Comments
ShowDelayedEventsTreatingSepecialty - function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent; var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmOrdersTS TfrmOrdersTS frmOrdersTS: TfrmOrdersTS; -

Constants

Name Declaration Scope Comments
TX_ADMIT 'The release of orders entered ' + Global -
TX_ADMIT1 'You selected the Admit delayed event' Global -
TX_MCHEVT1 ' is already assigned to ' Global -
TX_MCHEVT2 #13 + 'Do you still want to write delayed orders?' Global -
TX_TRANSFER 'The release of orders entered ' + Global -
TX_TRANSFER1 'You selected the Transfer delayed event' Global -
TX_XISTEVT1 'Delayed orders already exist for event Delayed ' Global -
TX_XISTEVT2 #13 + 'Do you want to view those orders?' Global -


Module Source

1     unit fOrdersTS;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmOrdersTS = class(TfrmAutoSz)
12        pnlMiddle: TPanel;
13        pnlTop: TPanel;
14        lblPtInfo: TVA508StaticText;
15        grpChoice: TGroupBox;
16        radReleaseNow: TRadioButton;
17        radDelayed: TRadioButton;
18        pnldif: TPanel;
19        Image1: TImage;
20        cmdOK: TButton;
21        cmdCancel: TButton;
22        lblUseAdmit: TVA508StaticText;
23        lblUseTransfer: TVA508StaticText;
24        pnlBottom: TPanel;
25        fraEvntDelayList: TfraEvntDelayList;
26        procedure cmdOKClick(Sender: TObject);
27        procedure cmdCancelClick(Sender: TObject);
28        procedure FormCreate(Sender: TObject);
29        procedure radDelayedClick(Sender: TObject);
30        procedure radReleaseNowClick(Sender: TObject);
31        procedure fraEvntDelayListcboEvntListChange(Sender: TObject);
32        procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY;
33        procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject);
34        procedure FormClose(Sender: TObject; var Action: TCloseAction);
35        procedure fraEvntDelayListmlstEventsChange(Sender: TObject);
36        procedure FormKeyDown(Sender: TObject; var Key: Word;
37          Shift: TShiftState);
38      private
39        OKPressed: Boolean;
40        FResult  : Boolean;
41        FImmediatelyRelease: boolean;
42        FCurrSpecialty: string;
43        F1stClick: Boolean;
44      end;
45    
46    function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
47     var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
48    
49    var
50      frmOrdersTS: TfrmOrdersTS;
51    
52    implementation
53    
54    uses uCore,fOrders, rMisc;
55    
56    {$R *.DFM}
57    
58    const
59      TX_TRANSFER1= 'You selected the Transfer delayed event';
60      TX_TRANSFER = 'The release of orders entered ' +
61                    'will be delayed until the patient is transferred to the ' +
62                    'following specialty.';
63      TX_ADMIT1   = 'You selected the Admit delayed event';
64      TX_ADMIT    = 'The release of orders entered ' +
65                    'will be delayed until the patient is admitted to the ' +
66                    'following specialty.';
67      TX_XISTEVT1 = 'Delayed orders already exist for event Delayed ';
68      TX_XISTEVT2 = #13 + 'Do you want to view those orders?';
69      TX_MCHEVT1  = ' is already assigned to ';
70      TX_MCHEVT2  = #13 + 'Do you still want to write delayed orders?';
71    
72    
73    function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
74     var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
75    var
76      EvtInfo,speCap: string;
77    begin
78      frmOrdersTS := TfrmOrdersTS.Create(Application);
79      frmOrdersTS.FCurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1);
80      frmOrdersTS.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
81      SetFormPosition(frmOrdersTS);
82      //frmOrdersTs.fraEvntDelayList.Top := frmOrdersTS.Height -
83      Result := frmOrdersTS.FResult;
84      if Length(ARadCapTion)>0 then
85        frmOrdersTS.radDelayed.Caption := ARadCaption;
86      try
87        ResizeFormToFont(TForm(frmOrdersTS));
88        if Length(frmOrdersTS.FCurrSpecialty)>0 then
89          SpeCap := #13 + 'The current treating specialty is ' + frmOrdersTS.FCurrSpecialty
90        else
91          SpeCap := #13 + 'No treating specialty is available.';
92        if Patient.Inpatient then
93          frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
94        else
95        begin
96          if (EnCounter.Location > 0) then
97            frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently on ' + Encounter.LocationName + SpeCap
98          else
99            frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap;
100       end;
101       if not (AnLimitEvent in ['A','D','T','M','O']) then
102         AnLimitEvent := #0;
103       frmOrdersTs.fraEvntDelayList.EvntLimit := AnLimitEvent;
104       if AnEvent.EventIFN > 0 then
105       begin
106         frmOrdersTS.fraEvntDelayList.DefaultEvent := AnEvent.EventIFN;
107         frmOrdersTS.radDelayed.Checked := True;
108       end else
109       begin
110         frmOrdersTS.radReleaseNow.Enabled := True;
111         frmOrdersTS.radReleaseNow.Checked := False;
112         frmOrdersTS.radDelayed.Checked    := False;
113       end;
114       frmOrdersTS.radDelayed.Checked := True;
115       frmOrdersTS.ShowModal;
116       if frmOrdersTS.FImmediatelyRelease then
117       begin
118         AnEvent.EventIFN  := 0;
119         AnEvent.EventName := '';
120         AnEvent.Specialty := 0;
121         AnEvent.Effective := 0;
122         ReleaseNow := frmOrdersTS.FImmediatelyRelease;
123         Result := frmOrdersTS.FResult;
124       end;
125       if (frmOrdersTS.OKPressed) and (frmOrdersTS.radDelayed.Checked) then
126       begin
127         EvtInfo := frmOrdersTS.fraEvntDelayList.mlstEvents.Items[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex];
128         AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
129         AnEvent.EventIFN  := StrToInt64Def(Piece(EvtInfo,'^',1),0);
130         AnEvent.TheParent := TParentEvent.Create;
131         if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
132         begin
133           AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
134           if AnEvent.EventType = #0 then
135             AnEvent.EventType := AnEvent.TheParent.ParentType;
136         end;
137         AnEvent.EventName := frmOrdersTS.fraEvntDelayList.mlstEvents.DisplayText[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex];
138         AnEvent.Specialty := 0;
139         if frmOrdersTS.fraEvntDelayList.orDateBox.Visible then
140           AnEvent.Effective := frmOrdersTS.fraEvntDelayList.orDateBox.FMDateTime
141         else
142           AnEvent.Effective := 0;
143         ADlgLst.Clear;
144         if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
145           ADlgLst.Add(AnEvent.TheParent.ParentDlg)
146         else if Length(Piece(EvtInfo,'^',5))>0 then
147           ADlgLst.Add(Piece(EvtInfo,'^',5));
148         if Length(Piece(EvtInfo,'^',6))>0 then
149           ADlgLst.Add(Piece(EvtInfo,'^',6)+ '^SET');
150         Result := frmOrdersTS.FResult;
151       end;
152     finally
153       frmOrdersTS.Release;
154       frmOrdersTS.FImmediatelyRelease := False;
155       frmOrdersTS.FCurrSpecialty := '';
156       frmOrdersTS.fraEvntDelayList.ResetProperty;
157     end;
158   end;
159   
160   procedure TfrmOrdersTS.FormCreate(Sender: TObject);
161   begin
162     inherited;
163     if not Patient.Inpatient then
164       pnldif.Visible  := False;
165     OKPressed           := False;
166     FResult             := False;
167     FImmediatelyRelease := False;
168     F1stClick           := True;
169     FCurrSpecialty      := '';
170   end;
171   
172   procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);   
173   var
174     tempStr: String;
175   begin
176     inherited;
177     if grpChoice.Tag = 0 then
178     begin
179       InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK);
180       Exit;
181     end;
182     if( not (fraEvntDelayList.mlstEvents.ItemIndex >= 0) ) and (radDelayed.Checked) then
183     begin
184       InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
185       Exit;
186     end;
187     
188     tempStr := fraEvntDelayList.mlstEvents.Items.ValueFromIndex[fraEvntDelayList.mlstEvents.ItemIndex];
189   
190     if(fraEvntDelayList.mlstEvents.ItemIndex >= 0) and (Length(Piece(tempStr,'^',2))<1)then
191     begin
192       InfoBox('Invalid release event selected.', 'No Selection Made', MB_OK);
193       Exit;
194     end;
195   
196     if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then
197     begin
198       fraEvntDelayList.CheckMatch;
199       if fraEvntDelayList.MatchedCancel then
200       begin
201         OKPressed := False;
202         Close;
203         Exit;
204       end;
205     end;
206     OKPressed := True;
207     FResult   := True;
208     Close;
209   end;
210   
211   procedure TfrmOrdersTS.cmdCancelClick(Sender: TObject);
212   begin
213     inherited;
214     FResult  := False;
215     Close;
216   end;
217   
218   procedure TfrmOrdersTS.radDelayedClick(Sender: TObject);
219   begin
220     inherited;
221     fraEvntDelayList.Visible := True;
222     fraEvntDelayList.DisplayEvntDelayList;
223     grpChoice.Tag := 1;
224   end;
225   
226   procedure TfrmOrdersTS.radReleaseNowClick(Sender: TObject);
227   begin
228     inherited;
229     grpChoice.Tag := 1;
230     if InfoBox('Would you like to close this window and return to the Orders Tab?',
231           'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then
232     begin
233       FImmediatelyRelease := True;
234       FResult             := False;
235       Close;
236     end
237     else
238     begin
239       fraEvntDelayList.mlstEvents.Items.Clear;
240       FImmediatelyRelease   := False;
241       radReleaseNow.Checked := False;
242       radDelayed.Checked    := True;
243     end;
244   end;
245   
246   procedure TfrmOrdersTS.fraEvntDelayListcboEvntListChange(Sender: TObject);
247   begin
248     inherited;
249     fraEvntDelayList.mlstEventsChange(Sender);
250     F1stClick   := False;
251     if fraEvntDelayList.MatchedCancel then  Close
252   end;
253   
254   procedure TfrmOrdersTS.UMStillDelay(var message: TMessage);
255   begin
256     inherited;
257     if grpChoice.Tag = 0 then
258     begin
259       InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK);
260       Exit;
261     end;
262     if(not (fraEvntDelayList.mlstEvents.ItemIndex >= 0)) and (radDelayed.Checked) then
263     begin
264       InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
265       Exit;
266     end;
267     OKPressed := True;
268     FResult   := True;
269     Close;
270   end;
271   
272   procedure TfrmOrdersTS.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
273   begin
274     inherited;
275     if fraEvntDelayList.mlstEvents.ItemID > 0 then
276       cmdOKClick(Self);
277   end;
278   
279   procedure TfrmOrdersTS.FormClose(Sender: TObject;
280     var Action: TCloseAction);
281   begin
282     inherited;
283     SaveUserBounds(Self);
284     Action := caFree;
285   end;
286   
287   procedure TfrmOrdersTS.fraEvntDelayListmlstEventsChange(Sender: TObject);
288   begin
289     inherited;
290     fraEvntDelayList.mlstEventsChange(Sender);
291     if fraEvntDelayList.MatchedCancel then
292     begin
293       OKPressed := False;
294       Close;
295       Exit;
296     end;
297   end;
298   
299   procedure TfrmOrdersTS.FormKeyDown(Sender: TObject; var Key: Word;
300     Shift: TShiftState);
301   begin
302     inherited;
303     if Key = VK_RETURN then
304        cmdOKClick(Self);
305   end;
306   
307   end.

Module Calls (2 levels)


fOrdersTS
 ├fAutoSz
 │ └fBase508Form
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├mEvntDelay
 │ ├uCore...
 │ ├uConst
 │ ├rOrders...
 │ ├fOrders
 │ ├fOrdersTS...
 │ ├fMedCopy
 │ └fOrdersCopy
 ├uConst
 ├uCore...
 └rMisc
   └fOrders...

Module Called-By (2 levels)


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