Module

fOrdersCopy

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
fODBase -
mEvntDelay -
uConst -
uCore -

Units Used in Implementation

Name Comments
fOrders -
fOrdersTS -
rOrders -

Classes

Name Comments
TfrmCopyOrders -

Procedures

Name Owner Declaration Scope Comments
AdjustFormSize TfrmCopyOrders procedure AdjustFormSize; Private -
cmdCancelClick TfrmCopyOrders procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmCopyOrders procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmCopyOrders procedure FormCreate(Sender: TObject); Public/Published -
FormKeyDown TfrmCopyOrders procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
fraEvntDelayListcboEvntListChange TfrmCopyOrders procedure fraEvntDelayListcboEvntListChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsChange TfrmCopyOrders procedure fraEvntDelayListmlstEventsChange(Sender: TObject); Public/Published -
fraEvntDelayListmlstEventsDblClick TfrmCopyOrders procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject); Public/Published -
Highlight - procedure Highlight(APtEvtID: string); Local -
radEvtDelayClick TfrmCopyOrders procedure radEvtDelayClick(Sender: TObject); Public/Published -
radReleaseClick TfrmCopyOrders procedure radReleaseClick(Sender: TObject); Public/Published -
UMStillDelay TfrmCopyOrders 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 -
FindMatchedPtEvtID - function FindMatchedPtEvtID(EventName: string): integer; Local -
SetViewForCopy - function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean; var DestPtEvtID: integer; var DestPtEvtName: string): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
frmCopyOrders TfrmCopyOrders frmCopyOrders: TfrmCopyOrders; -


Module Source

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


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

Module Called-By (2 levels)


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