Module

mEvntDelay

Path

C:\CPRS\CPRS30\mEvntDelay.pas

Last Modified

7/15/2014 3:26:40 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfraEvntDelayList);

end.

Units Used in Interface

Name Comments
uConst -
uCore -

Units Used in Implementation

Name Comments
fMedCopy -
fOrders -
fOrdersCopy -
fOrdersTS -
rOrders -

Classes

Name Comments
TfraEvntDelayList -

Procedures

Name Owner Declaration Scope Comments
CheckMatch TfraEvntDelayList procedure CheckMatch; Public -
DisplayEvntDelayList TfraEvntDelayList procedure DisplayEvntDelayList; Public -
edtSearchChange TfraEvntDelayList procedure edtSearchChange(Sender: TObject); Public/Published -
edtSearchKeyDown TfraEvntDelayList procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
mlstEventsChange TfraEvntDelayList procedure mlstEventsChange(Sender: TObject); Public/Published -
mlstEventsClick TfraEvntDelayList procedure mlstEventsClick(Sender: TObject); Public/Published -
mlstEventsKeyUp TfraEvntDelayList procedure mlstEventsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
ResetProperty TfraEvntDelayList procedure ResetProperty; Public -

Constants

Name Declaration Scope Comments
TX_MCHEVT1 ' is already assigned to ' Global -
TX_MCHEVT2 #13 + 'Do you still want to write delayed orders?' Global -
TX_MCHEVT3 #13#13 + 'If you continue to write delayed orders to this 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 mEvntDelay;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORCtrls, ORDtTm, uCore, ORFn, ExtCtrls,uConst;
8     
9     type
10      TfraEvntDelayList = class(TFrame)
11        pnlDate: TPanel;
12        pnlList: TPanel;
13        mlstEvents: TORListBox;
14        edtSearch: TCaptionEdit;
15        lblEffective: TLabel;
16        orDateBox: TORDateBox;
17        lblEvntDelayList: TLabel;
18        procedure edtSearchChange(Sender: TObject);
19        procedure mlstEventsChange(Sender: TObject);
20        procedure mlstEventsClick(Sender: TObject);
21        procedure mlstEventsKeyUp(Sender: TObject; var Key: Word;
22          Shift: TShiftState);
23        procedure edtSearchKeyDown(Sender: TObject; var Key: Word;
24          Shift: TShiftState);
25      private
26        FEvntLimit:       Char;
27        FUserDefaultEvent:integer;
28        fDefaultEvent:    integer;
29        FMatchedCancel:   Boolean;
30        FDisableWarning:  Boolean;
31        FIsForCpXfer:     Boolean;
32      public
33        constructor Create(AOwner: TComponent); override;
34        procedure ResetProperty;
35        procedure DisplayEvntDelayList;
36        procedure CheckMatch;
37        property EvntLimit:        Char     read FEvntLimit         write FEvntLimit;
38        property UserDefaultEvent: integer  read FUserDefaultEvent  write FUserDefaultEvent;
39        property DefaultEvent    : integer  read fDefaultEvent      write fDefaultEvent;
40        property MatchedCancel   : Boolean  read FMatchedCancel     write FMatchedCancel;
41        property DisableWarning  : Boolean  read FDisableWarning    write FDisableWarning;
42        property IsForCpXfer     : Boolean  read FIsForCpXfer       write FIsForCpXfer;
43      end;
44    
45    implementation
46    
47    {$R *.DFM}
48    
49    uses
50      rOrders, fOrders, fOrdersTS, fMedCopy, fOrdersCopy, VA508AccessibilityRouter;
51    
52    { TfraEvntDelayList }
53    const
54      TX_MCHEVT1  = ' is already assigned to ';
55      TX_MCHEVT2  = #13 + 'Do you still want to write delayed orders?';
56      TX_MCHEVT3  = #13#13 + 'If you continue to write delayed orders to this event,'
57        + 'they will not release until the patient moves away from and returns to this ward and treating specialty.'
58        + #13#13 + 'If you want these orders to be activated at signature, '
59        + 'then please write them under the ACTIVE view (and not as delayed orders).';
60      TX_XISTEVT1 = 'Delayed orders already exist for event Delayed ';
61      TX_XISTEVT2 = #13 + 'Do you want to view those orders?';
62    
63    constructor TfraEvntDelayList.Create(AOwner: TComponent);
64    begin
65      inherited Create(AOwner);
66      TabStop := FALSE;
67      FDisableWarning   := False;
68      FMatchedCancel    := False;
69      FIsForCpXfer      := False;
70      FEvntLimit        := #0;
71      FUserDefaultEvent := 0;
72      fDefaultEvent     := 0;
73    end;
74    
75    procedure TfraEvntDelayList.DisplayEvntDelayList;
76    var
77      i: integer;
78      tempStr: string;
79      defaultEvtType: Char;
80      NoUserDefault: boolean;
81    const
82      LINE = '^^^^^^^^________________________________________________________________________________________';
83    
84    begin
85      inherited;
86      mlstEvents.Items.Clear;
87      mlstEvents.InitLongList('');
88      NoUserDefault := False;
89      defaultEvtType := #0;
90    
91      if Patient.Inpatient then
92        ListSpecialtiesED(EvntLimit,mlstEvents.Items)
93      else
94        ListSpecialtiesED('A',mlstEvents.Items);
95      if mlstEvents.Items.Count < 1 then
96        Exit;
97      mlstEvents.ItemIndex := -1;
98      if not Patient.Inpatient then
99      begin
100       if UserDefaultEvent > 0 then
101         defaultEvtType := CharAt(EventInfo1(IntToStr(UserDefaultEvent)),1);
102         if defaultEvtType in ['T','D'] then
103           NoUserDefault := True;
104     end;
105     if (UserDefaultEvent > 0) and (not NoUserDefault) then
106     begin
107       for i := 0 to mlstEvents.Items.Count - 1 do
108       begin
109         if Piece(mlstEvents.Items[i],'^',1)=IntToStr(UserDefaultEvent) then
110         begin
111           tempStr := mlstEvents.Items[i];
112           Break;
113         end;
114       end;
115     end;
116     if Length(tempStr)>0 then
117     begin
118       DisableWarning := True;
119       mlstEvents.Items.Insert(0,tempStr);
120       mlstEvents.Items.Insert(1,LINE);
121       mlstEvents.Items.Insert(2,LLS_SPACE);
122       mlstEvents.ItemIndex := 0;
123       edtSearch.Text := mlstEvents.DisplayText[0];
124       tempStr := '';
125       DisableWarning := False;
126     end;
127   
128     if (DefaultEvent > 0) and (mlstEvents.ItemIndex<0) then
129     begin
130       for i := 0 to mlstEvents.items.Count - 1 do
131       begin
132         if Piece(mlstEvents.items[i],'^',1)=IntToStr(DefaultEvent) then
133         begin
134           tempStr := mlstEvents.Items[i];
135           Break;
136         end;
137       end;
138     end;
139     if Length(tempStr)>0 then
140     begin
141       mlstEvents.Items.Insert(0,tempStr);
142       mlstEvents.Items.Insert(1,LINE);
143       mlstEvents.Items.Insert(2,LLS_SPACE);
144       mlstEvents.ItemIndex := 0;
145       edtSearch.Text := mlstEvents.DisplayText[0];
146       tempStr := '';
147     end;
148   end;
149   
150   procedure TfraEvntDelayList.ResetProperty;
151   begin
152     FEvntLimit        := #0;
153     FUserDefaultEvent := 0;
154     fDefaultEvent     := 0;
155     FMatchedCancel    := False;
156     FDisableWarning   := False;
157     FIsForCpXfer      := False;
158   end;
159   
160   procedure TfraEvntDelayList.CheckMatch;
161   var
162     AnEvtID, ATsName: string;
163   begin
164     if mlstEvents.ItemIndex < 0 then Exit;
165     FMatchedCancel := False;
166     AnEvtID   := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
167     if isMatchedEvent(Patient.DFN,AnEvtID,ATsName) and (not DisableWarning) then
168     begin
169       if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2,
170         'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
171       begin
172         FMatchedCancel := True;
173         frmOrders.lstSheets.ItemIndex := 0;
174         frmOrders.lstSheetsClick(Self);
175       end;
176     end;
177   end;
178   
179   procedure TfraEvntDelayList.edtSearchChange(Sender: TObject);
180   var
181     i: integer;
182     needle,hay: String;
183   begin
184     if Length(edtSearch.Text)<1 then Exit;
185     if (edtSearch.Modified) then
186       begin
187         needle := UpperCase(edtSearch.text);
188         if length(needle)=0 then exit;
189         for i := 0 to mlstEvents.Items.Count - 1 do
190           begin
191             hay := UpperCase(mlstEvents.DisplayText[i]);
192             hay := Copy(hay,0,length(needle));
193             if Pos(needle, hay) > 0 then
194               begin
195                 mlstEvents.ItemIndex := i;
196                 mlstEvents.TopIndex := i;
197                 edtSearch.Text := mlstEvents.DisplayText[mlstEvents.itemindex];
198                 edtSearch.SelStart := length(needle);
199                 edtSearch.SelLength := length(edtSearch.Text);
200                 exit;
201               end;
202           end;
203       end;
204   end;
205   
206   procedure TfraEvntDelayList.mlstEventsChange(Sender: TObject);
207   var
208     i,idx : integer;
209     AnEvtID, AnEvtType, APtEvtID: string;
210     AnEvtName,ATsName: string;
211   begin
212     inherited;
213     if mlstEvents.ItemIndex >= 0 then
214     begin
215       AnEvtID   := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',1);
216       AnEvtType := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',3);
217       idx := mlstEvents.ItemIndex;
218     end else
219     begin
220       AnEvtID   := '';
221       AnEvtType := '';
222       idx := -1;
223     end;
224     if AnEvtType = 'D' then
225     begin
226       pnlDate.Visible := True;
227       lblEffective.Left := 1;
228       orDateBox.Left := 1;
229       orDateBox.Hint  := orDateBox.Text;
230     end else
231       pnlDate.Visible := False;
232     if mlstEvents.ItemIndex >= 0 then
233       AnEvtName := Piece(mlstEvents.Items[mlstEvents.ItemIndex],'^',9)
234     else
235       AnEvtName := '';
236     if isExistedEvent(Patient.DFN, AnEvtID, APtEvtID) then
237     begin
238       if IsForCpXfer then
239         DisableWarning := True;
240       for i := 0 to frmOrders.lstSheets.Items.Count - 1 do
241       begin
242         if Piece(frmOrders.lstSheets.Items[i],'^',1)=APtEvtID then
243         begin
244           frmOrders.lstSheets.ItemIndex := i;
245           frmOrders.ClickLstSheet;
246         end;
247       end;
248       IsForCpXfer := False;
249     end;
250     if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName))
251        and (not DisableWarning) then
252     begin
253       if InfoBox(Patient.Name + TX_MCHEVT1 + ATsName + ' on ' + Encounter.LocationName + TX_MCHEVT2 + TX_MCHEVT3,
254         'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
255      begin
256        FMatchedCancel := True;
257        frmOrders.lstSheets.ItemIndex := 0;
258        frmOrders.lstSheetsClick(Self);
259      end else
260      begin
261         if Screen.ActiveForm.Name = 'frmOrdersTS' then
262           SendMessage(frmOrdersTS.Handle, UM_STILLDELAY, 0, 0);
263         if Screen.ActiveForm.Name = 'frmMedCopy' then
264           SendMessage(frmMedCopy.Handle, UM_STILLDELAY, 0, 0);
265         if Screen.ActiveForm.Name = 'frmCopyOrders' then
266           SendMessage(frmCopyOrders.Handle, UM_STILLDELAY, 0, 0);
267      end;
268     end;
269     mlstEvents.ItemIndex := idx;
270   end;
271   
272   procedure TfraEvntDelayList.mlstEventsClick(Sender: TObject);
273   begin
274     edtSearch.Text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
275   end;
276   
277   procedure TfraEvntDelayList.mlstEventsKeyUp(Sender: TObject; var Key: Word;
278     Shift: TShiftState);
279   begin
280     if (mlstEvents.ItemIndex <> mlstEvents.FocusIndex) and (mlstEvents.FocusIndex > -1)  then
281     begin
282       if (Key = VK_UP) and ( ( mlstEvents.ItemIndex - mlstEvents.FocusIndex) > 1) and (mlstEvents.ItemIndex > 0) then
283         mlstEvents.ItemIndex := mlstEvents.ItemIndex - 1;
284       if (Key = VK_DOWN) and (mlstEvents.FocusIndex < mlstEvents.ItemIndex) then
285         mlstEvents.ItemIndex := mlstEvents.ItemIndex + 1
286       else
287         mlstEvents.ItemIndex := mlstEvents.FocusIndex;
288       edtSearch.text := mlstEvents.DisplayText[mlstEvents.ItemIndex];
289       mlstEvents.TopIndex := mlstEvents.ItemIndex;
290     end;
291   end;
292   
293   procedure TfraEvntDelayList.edtSearchKeyDown(Sender: TObject;
294     var Key: Word; Shift: TShiftState);
295   var
296     x : string;
297     i : integer;
298   begin
299     if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then
300     begin
301       edtSearch.SelectAll;
302       Key := 0;
303     end
304     else if Key = VK_BACK then
305     begin
306       x := edtSearch.Text;
307       i := edtSearch.SelStart;
308       if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
309       edtSearch.Text := x;
310       if i > 1 then edtSearch.SelStart := i;
311     end
312   end;
313   
314   initialization
315     SpecifyFormIsNotADialog(TfraEvntDelayList);
316   
317   end.

Module Calls (2 levels)


mEvntDelay
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├uConst
 ├rOrders...
 ├fOrders
 │ ├fHSplit
 │ ├rOrders...
 │ ├fODBase
 │ ├uConst
 │ ├uCore...
 │ ├uOrders...
 │ ├UBACore
 │ ├UBAGlobals
 │ ├fFrame
 │ ├fOrderVw
 │ ├fRptBox
 │ ├fLkUpLocation
 │ ├fOrdersDC
 │ ├fOrdersCV
 │ ├fOrdersHold
 │ ├fOrdersUnhold
 │ ├fOrdersAlert
 │ ├fOrderFlag
 │ ├fOrderUnflag
 │ ├fOrdersSign
 │ ├fOrdersRelease
 │ ├fOrdersOnChart
 │ ├fOrdersEvntRelease
 │ ├fOrdersComplete
 │ ├fOrdersVerify
 │ ├fOrderComment
 │ ├fOrdersRenew
 │ ├fODReleaseEvent
 │ ├rCore...
 │ ├fOCSession
 │ ├fOrdersPrint
 │ ├fOrdersTS
 │ ├fEffectDate
 │ ├fODActive
 │ ├fOrdersCopy
 │ ├uODBase
 │ ├rMeds
 │ ├fODValidateAction
 │ ├fMeds
 │ ├uInit
 │ ├fODConsult
 │ ├fClinicWardMeds
 │ ├fActivateDeactivate
 │ └rODMeds
 ├fOrdersTS...
 ├fMedCopy
 │ ├rOrders...
 │ ├uCore...
 │ ├rCore...
 │ ├mEvntDelay...
 │ ├uConst
 │ ├fBase508Form
 │ ├fODBase...
 │ └fOrders...
 └fOrdersCopy...

Module Called-By (2 levels)


       mEvntDelay
      fOrdersTS┤ 
      fOrders┤ │ 
mEvntDelay...┘ │ 
    fOrdersCopy┤ 
   fOrders...┤ │ 
mEvntDelay...┘ │ 
       fMedCopy┘ 
        fMeds┤   
mEvntDelay...┘