Module

fMedCopy

Path

C:\CPRS\CPRS30\fMedCopy.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
mEvntDelay -
rCore -
rOrders -
uConst -
uCore -

Units Used in Implementation

Name Comments
fODBase -
fOrders -
fOrdersTS -

Classes

Name Comments
TfrmMedCopy -

Procedures

Name Owner Declaration Scope Comments
AdjustFormSize TfrmMedCopy procedure AdjustFormSize; Private -
cmdCancelClick TfrmMedCopy procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmMedCopy procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmMedCopy procedure FormCreate(Sender: TObject); Public/Published -
FormKeyDown TfrmMedCopy procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
fraEvntDelayListcboEvntListChange TfrmMedCopy procedure fraEvntDelayListcboEvntListChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsChange TfrmMedCopy procedure fraEvntDelayListmlstEventsChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsDblClick TfrmMedCopy procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject); Public/Published -
Highlight - procedure Highlight(APtEvtID: string); Local -
radDelayedClick TfrmMedCopy procedure radDelayedClick(Sender: TObject); Public/Published -
radReleaseClick TfrmMedCopy procedure radReleaseClick(Sender: TObject); Public/Published -
UMStillDelay TfrmMedCopy procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY; Public/Published -

Functions

Name Owner Declaration Scope Comments
DisplayEvntDialog - function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean; Local -
SetDelayEventForMed - function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent; var IsNewEvent: Boolean; LimitEvent: Char): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmMedCopy TfrmMedCopy frmMedCopy: TfrmMedCopy; -

Constants

Name Declaration Scope Comments
TC_SEL_DATE 'Missing Effective Date' Global -
TX_SEL_DATE 'An effective date (approximate) must be selected for discharge orders.' Global -


Module Source

1     unit fMedCopy;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORDtTm, ORCtrls, ORFn, rOrders, uCore, rCore, mEvntDelay, fAutoSz,
8       ExtCtrls, uConst, fBase508Form, VA508AccessibilityManager;
9     
10    type
11      TfrmMedCopy = class(TfrmBase508Form)
12        pnlTop: TPanel;
13        lblPtInfo: TVA508StaticText;
14        pnlInpatient: TPanel;
15        lblInstruction: TStaticText;
16        Image1: TImage;
17        lblInstruction2: TStaticText;
18        pnlMiddle: TPanel;
19        gboxMain: TGroupBox;
20        radDelayed: TRadioButton;
21        radRelease: TRadioButton;
22        cmdOK: TButton;
23        cmdCancel: TButton;
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 radReleaseClick(Sender: TObject);
31        procedure fraEvntDelayListcboEvntListChange(Sender: TObject);
32        procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY;
33        procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject);
34        procedure fraEvntDelayListmlstEventsChange(Sender: TObject);
35        procedure FormKeyDown(Sender: TObject; var Key: Word;
36          Shift: TShiftState);
37    
38      private
39        FDelayEvent: TOrderDelayEvent;
40        FOKPressed: Boolean;
41        procedure AdjustFormSize;
42      public
43        { Public declarations }
44      end;
45    
46    function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
47              var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
48    var
49       frmMedCopy: TfrmMedCopy;
50    
51    implementation
52    {$R *.DFM}
53    
54    uses  fODBase, fOrdersTS, fOrders, VAUtils;
55    
56    const
57      TX_SEL_DATE = 'An effective date (approximate) must be selected for discharge orders.';
58      TC_SEL_DATE = 'Missing Effective Date';
59    
60    function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
61              var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
62    const
63      TX_RELEASE1  = 'Release ';
64      TX_RELEASE2  = ' orders immediately';
65      TX_DELAYED1  = 'Delay release of ';
66      TX_DELAYED2  = ' orders until';
67    var
68      EvtInfo,PtEvtID,AnEvtDlg: string;
69      SpeCap, CurrTS: string;
70    
71      procedure Highlight(APtEvtID: string);
72      var
73        j: integer;
74      begin
75        frmOrders.InitOrderSheetsForEvtDelay;
76        for j := 0 to frmOrders.lstSheets.Items.Count - 1 do
77        begin
78          if Piece(frmOrders.lstSheets.Items[j],'^',1)=APtEvtID then
79          begin
80            frmOrders.lstSheets.ItemIndex := j;
81            break;
82          end;
83        end;
84      end;
85    
86      function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
87      var
88        DlgData: string;
89      begin
90        DlgData := GetDlgData(AEvtDlg);
91        frmOrders.NeedShowModal := True;
92        frmOrders.IsDefaultDlg := True;
93        Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
94        frmOrders.IsDefaultDlg := False;
95        frmOrders.NeedShowModal := False;
96      end;
97    
98    begin
99      if LimitEvent = 'C' then
100     begin
101       Result := True;
102       ADelayEvent.EventType := 'C';
103       ADelayEvent.Specialty := 0;
104       ADelayEvent.Effective := 0;
105       Exit;
106     end;
107     Result := False;
108     frmMedCopy := TfrmMedCopy.Create(Application);
109     try
110       if (LimitEvent = 'A') and (not Patient.Inpatient) then
111       begin
112         frmMedCopy.radDelayed.Checked := True;
113         frmMedCopy.radRelease.Enabled := False;
114       end;
115       ResizeAnchoredFormToFont(frmMedCopy);
116       frmMedCopy.AdjustFormSize;
117       CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
118       if Length(CurrTS)>0 then
119         SpeCap := #13 + '  The current treating specialty is ' + CurrTS
120       else
121         SpeCap := #13 + '  No treating specialty is available.';
122       if Patient.Inpatient then
123         frmMedCopy.lblPtInfo.Caption := '   ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
124       else
125       begin
126         if (Encounter.Location > 0) then
127           frmMedCopy.lblPtInfo.Caption := Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap
128         else
129           frmMedCopy.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap;
130       end;
131       frmMedCopy.AdjustFormSize;
132       frmMedCopy.fraEvntDelayList.EvntLimit := LimitEvent;
133       if Pos('transfer',RadCap)>0 then
134         frmMedCopy.Caption := 'Transfer Medication Orders';
135       frmMedCopy.radRelease.Caption := TX_RELEASE1 + RadCap + TX_RELEASE2;
136       frmMedCopy.radDelayed.Caption := TX_DELAYED1 + RadCap + TX_DELAYED2;
137       if LimitEvent='D' then
138       begin
139         frmMedCopy.pnlInpatient.Visible := False;
140         frmMedCopy.AdjustFormSize;
141       end;
142       frmMedCopy.ShowModal;
143       if (frmMedCopy.FOKPressed) and (frmMedCopy.radRelease.Checked) then
144       begin
145         if (frmMedCopy.radRelease.Checked) and (LimitEvent = 'D') then
146           XfInToOutNow := True
147         else XfInToOutNow := False;
148         ADelayEvent := frmMedCopy.FDelayEvent;
149         Result := True;
150       end
151       else if (frmMedCopy.FOKPressed) and (frmMedCopy.radDelayed.Checked) then
152       begin
153         EvtInfo := frmMedCopy.fraEvntDelayList.mlstEvents.Items[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex];
154         ADelayEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
155         ADelayEvent.EventIFN  := StrToInt64Def(Piece(EvtInfo,'^',1),0);
156         if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
157         begin
158           ADelayEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
159           ADelayEvent.EventType := ADelayEvent.TheParent.ParentType;
160         end;
161         ADelayEvent.EventName := frmMedCopy.fraEvntDelayList.mlstEvents.DisplayText[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex];
162         ADelayEvent.Specialty := 0;
163         if frmMedCopy.fraEvntDelayList.orDateBox.Visible then
164           ADelayEvent.Effective := frmMedCopy.fraEvntDelayList.orDateBox.FMDateTime
165         else
166           ADelayEvent.Effective := 0;
167         IsNewEvent := False;
168         if TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 then
169         begin
170            IsNewEvent := True;
171            if ADelayEvent.TheParent.ParentIFN > 0 then
172            begin
173              if StrToIntDef(ADelayEvent.TheParent.ParentDlg,0)>0 then
174                AnEvtDlg := ADelayEvent.TheParent.ParentDlg;
175            end
176            else
177              AnEvtDlg := Piece(EvtInfo,'^',5);
178         end;
179         if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
180            if not DisplayEvntDialog(AnEvtDlg, ADelayEvent) then
181            begin
182              frmOrders.lstSheets.ItemIndex := 0;
183              frmOrders.lstSheetsClick(nil);
184              Result := False;
185              Exit;
186            end;
187         if not isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN), PtEvtID) then
188         begin
189           IsNewEvent := True;
190           if (ADelayEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 ) then
191             SaveEvtForOrder(Patient.DFN,ADelayEvent.TheParent.ParentIFN,'');
192           SaveEvtForOrder(Patient.DFN,ADelayEvent.EventIFN,'');
193           if isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN),PtEvtID) then
194           begin
195             Highlight(PtEvtID);
196             ADelayEvent.IsNewEvent := False;
197             ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0);
198           end;
199         end else
200         begin
201           Highlight(PtEvtID);
202           ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0);
203           ADelayEvent.IsNewEvent := False;
204         end;
205   
206         if frmOrders.lstSheets.ItemIndex > -1 then
207         begin
208           frmOrders.AskForCancel := False;
209           frmOrders.lstSheetsClick(nil);
210           frmOrders.AskForCancel := True;
211         end;
212         Result := True;
213       end;
214     finally
215       frmMedCopy.fraEvntDelayList.ResetProperty;
216       frmMedCopy.Release;
217     end;
218   end;
219   
220   procedure TfrmMedCopy.FormCreate(Sender: TObject);
221   begin
222     inherited;
223     FOKPressed            := False;
224     FDelayEvent.EventType := #0;
225     FDelayEvent.EventIFN  := 0;
226     radRelease.Checked := True;
227     if not Patient.Inpatient then
228       pnlInpatient.Visible := False;
229     AdjustFormSize;
230   end;
231   
232   procedure TfrmMedCopy.cmdOKClick(Sender: TObject);
233   var
234     today : TFMDateTime;
235   begin
236     inherited;
237     today := FMToday;
238     if (radDelayed.Checked) and (fraEvntDelayList.mlstEvents.ItemIndex < 0) then
239     begin
240       InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
241       Exit;
242     end;
243     if (radRelease.Checked) and (Pos('copied',radRelease.Caption)>0)  then
244     begin
245       ImmdCopyAct := True;
246       FDelayEvent.EventType := 'C';
247       FDelayEvent.Specialty := 0;
248       FDelayEvent.Effective := 0;
249     end
250     else if (radRelease.Checked) and (Pos('transfer',radRelease.Caption)>0) then
251     begin
252       FDelayEvent.EventType := 'D';
253       FDelayEvent.Specialty := 0;
254       FDelayEvent.Effective := today;
255     end;
256     FOKPressed := True;
257     Close;
258   end;
259   
260   procedure TfrmMedCopy.AdjustFormSize;
261   var
262     y: integer;
263   begin
264     y := lblPtInfo.Height + 8; // allow for font changes
265     if pnlInpatient.Visible then
266     begin
267       lblInstruction2.top := lblInstruction.Height; // allow for font change
268       pnlInpatient.Height := lblInstruction2.top + lblInstruction2.Height;
269       inc(y,pnlInpatient.Height);
270     end;
271     pnlTop.Height := y;
272     inc(y, pnlMiddle.Height);
273     if fraEvntDelayList.Visible then
274     begin
275       inc(y, fraEvntDelayList.Height);
276     end;
277     VertScrollBar.Range := y;
278     ClientHeight := y;
279   end;
280   
281   procedure TfrmMedCopy.cmdCancelClick(Sender: TObject);
282   begin
283     inherited;
284     Close;
285   end;
286   
287   procedure TfrmMedCopy.radDelayedClick(Sender: TObject);
288   const
289     WarningMSG = 'If you''re writing medication orders to transfer these from Inpatient' +
290       ' to Outpatient, please use the ''release immediately'' choice.  These will be' +
291       ' readied in advance by Pharmacy for the patient''s expected discharge date.';
292   begin
293     inherited;
294     frmMedCopy.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
295     fraEvntDelayList.DisplayEvntDelayList;
296     if fraEvntDelayList.mlstEvents.Items.Count < 1 then
297     begin
298       ShowMsg(WarningMSG);
299       radRelease.Checked := True;
300     end else
301     begin
302       fraEvntDelayList.Visible := True;
303     end;
304     AdjustFormSize;
305   end;
306   
307   procedure TfrmMedCopy.radReleaseClick(Sender: TObject);
308   begin
309     inherited;
310     fraEvntDelayList.Visible := False;
311     AdjustFormSize;
312   end;
313   
314   procedure TfrmMedCopy.fraEvntDelayListcboEvntListChange(Sender: TObject);
315   begin
316     inherited;
317     fraEvntDelayList.mlstEventsChange(Sender);
318     if fraEvntDelayList.MatchedCancel then Close
319   end;
320   
321   procedure TfrmMedCopy.UMStillDelay(var message: TMessage);
322   begin
323     cmdOKClick(Application);
324   end;
325   
326   procedure TfrmMedCopy.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
327   begin
328     if fraEvntDelayList.mlstEvents.ItemID > 0 then
329       cmdOKClick(Self);
330   end;
331   
332   procedure TfrmMedCopy.fraEvntDelayListmlstEventsChange(Sender: TObject);
333   begin
334     fraEvntDelayList.mlstEventsChange(Sender);
335     if fraEvntDelayList.MatchedCancel then
336     begin
337       FOKPressed := False;
338       Close;
339       Exit;
340     end;
341   end;
342   
343   procedure TfrmMedCopy.FormKeyDown(Sender: TObject; var Key: Word;
344     Shift: TShiftState);
345   begin
346     inherited;
347     if Key = VK_RETURN then
348       cmdOKClick(Self);
349   end;
350   
351   end.

Module Calls (2 levels)


fMedCopy
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├uCore...
 ├rCore...
 ├mEvntDelay
 │ ├uCore...
 │ ├uConst
 │ ├rOrders...
 │ ├fOrders
 │ ├fOrdersTS
 │ ├fMedCopy...
 │ └fOrdersCopy
 ├uConst
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders...
 │ ├rODBase
 │ ├uCore...
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore...
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders...
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 └fOrders...

Module Called-By (2 levels)


         fMedCopy
          fMeds┤ 
      uOrders┤ │ 
       fFrame┤ │ 
      fOrders┤ │ 
fOptionsOther┘ │ 
     mEvntDelay┘ 
    fOrdersTS┤   
  fOrdersCopy┤   
  fMedCopy...┘