Module

fOrdersCV

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
rOrders -
uOrders -

Units Used in Implementation

Name Comments
fODChangeEvtDisp -
fOrders -
rMisc -
uConst -
uCore -

Classes

Name Comments
TfrmChgEvent -

Procedures

Name Owner Declaration Scope Comments
btnActionClick TfrmChgEvent procedure btnActionClick(Sender: TObject); Public/Published -
btnCancelClick TfrmChgEvent procedure btnCancelClick(Sender: TObject); Public/Published -
cboSpecialtyChange TfrmChgEvent procedure cboSpecialtyChange(Sender: TObject); Public/Published -
cboSpecialtyDblClick TfrmChgEvent procedure cboSpecialtyDblClick(Sender: TObject); Public/Published -
FilterOutEmptyPtEvt TfrmChgEvent procedure FilterOutEmptyPtEvt; Public -
FormClose TfrmChgEvent procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmChgEvent procedure FormCreate(Sender: TObject); Public/Published -
Highlight TfrmChgEvent procedure Highlight(APtEvtID: string); Public -
LoadSpecialtyList TfrmChgEvent procedure LoadSpecialtyList; Public
Public declarations
TfrmChgEvent
updateChanges TfrmChgEvent procedure updateChanges(Const AnOrderIDList: TStringList; Const AnEventName: String); Private -

Functions

Name Owner Declaration Scope Comments
DisplayEvntDialog - function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean; Local -
ExecuteChangeEvt - function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean; var DestPtEvtID: integer; var DestPtEvtName: string): boolean; Interfaced -
FindMatchedPtEvtID - function FindMatchedPtEvtID(EventName: string): integer; Local -


Module Source

1     unit fOrdersCV;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSz, uOrders, rOrders,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmChgEvent = class(TfrmAutoSz)
12        pnlTop: TPanel;
13        lblPtInfo: TLabel;
14        pnlBottom: TPanel;
15        cboSpecialty: TORComboBox;
16        btnCancel: TButton;
17        btnAction: TButton;
18        procedure FormCreate(Sender: TObject);
19        procedure cboSpecialtyChange(Sender: TObject);
20        procedure btnActionClick(Sender: TObject);
21        procedure btnCancelClick(Sender: TObject);
22        procedure cboSpecialtyDblClick(Sender: TObject);
23        procedure FormClose(Sender: TObject; var Action: TCloseAction);
24      private
25        { Private declarations }
26        FDefaultEvntIFN:   Integer;
27        FDefaultPtEvntIFN: Integer;
28        FCurrSpecialty    : string;
29        FDefaultIndex: String;
30        FOKPress: boolean;
31        FLastIndex: Integer;
32    
33        procedure updateChanges(Const AnOrderIDList: TStringList; Const AnEventName: String);
34    
35      public
36        { Public declarations }
37        procedure LoadSpecialtyList;
38        procedure Highlight(APtEvtID: string);
39        procedure FilterOutEmptyPtEvt;
40        property CurrSpecialty: string      read FCurrSpecialty     write FCurrSpecialty;
41        property DefaultIndex:   string    read FDefaultIndex      write FDefaultIndex;
42        property OKPress:        boolean    read FOKPress           write FOKPress;
43    
44      end;
45    
46    function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
47      var DestPtEvtID: integer; var DestPtEvtName: string): boolean;
48    
49    
50    implementation
51    
52    {$R *.DFM}
53    
54    uses uCore, uConst, fOrders, fODChangeEvtDisp, rMisc;
55    
56    function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
57      var DestPtEvtID: integer; var DestPtEvtName: string): boolean;
58    const
59      CHANGE_CAP = 'The release event for the following orders will be changed to: ';
60      REMOVE_CAP = 'The release event will be deleted for the following orders: ';
61    var
62      i: integer;
63      frmChgEvent : TfrmChgEvent;
64      AnOrder: TOrder;
65      AnOrderIDList: TStringList;
66      EvtInfo,AnEvtDlg: string;
67      AnEvent: TOrderDelayEvent;
68      ThePtEvtID, TheDefaultPtEvtID, TheDefaultEvtInfo, SpeCap: string;
69      IsNewEvent: boolean;
70      ExistedPtEvtId: integer;
71    
72      function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
73      var
74        DlgData: string;
75      begin
76        DlgData := GetDlgData(AEvtDlg);
77        frmOrders.NeedShowModal := True;
78        frmOrders.IsDefaultDlg := True;
79        Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
80        frmOrders.IsDefaultDlg := False;
81        frmOrders.NeedShowModal := False;
82      end;
83    
84      function FindMatchedPtEvtID(EventName: string): integer;
85      var
86        cnt: integer;
87        viewName: string;
88      begin
89        Result := 0;
90        for cnt := 0 to frmOrders.lstSheets.Items.Count - 1 do
91        begin
92          viewName := Piece(frmOrders.lstSheets.Items[cnt],'^',2);
93          if AnsiCompareText(EventName,viewName)=0 then
94          begin
95            Result := StrToIntDef(Piece(frmOrders.lstSheets.Items[cnt],'^',1),0);
96            break;
97          end;
98        end;
99    
100     end;
101   begin
102     Result := False;
103     IsNewEvent := False;
104     AnEvent.EventType := #0;
105     AnEvent.EventIFN  := 0;
106     AnEvent.EventName := '';
107     AnEvent.Specialty := 0;
108     AnEvent.Effective := 0;
109     AnEvent.PtEventIFN := 0;
110     AnEvent.TheParent := TParentEvent.Create;
111     AnEvent.IsNewEvent := False;
112   
113     if SelectedList.Count = 0 then Exit;
114     frmChgEvent := TfrmChgEvent.Create(Application);
115     SetFormPosition(frmChgEvent);
116     frmChgEvent.CurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1);
117     if Length(frmChgEvent.CurrSpecialty)>0 then
118       SpeCap := #13 + '  The current treating specialty is ' + frmChgEvent.CurrSpecialty
119     else
120       SpeCap := #13 + '  No treating specialty is available.';
121     ResizeFormToFont(TForm(frmChgEvent));
122     SetFormPosition(frmChgEvent);
123     if Patient.Inpatient then
124       frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
125     else
126       frmChgEvent.lblPtInfo.Caption := '   ' + Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap;
127     frmChgEvent.cboSpecialty.Caption := frmChgEvent.lblPtInfo.Caption;
128     ThePtEvtID := '';
129     AnOrder := TOrder(selectedList[0]);
130     TheDefaultPtEvtID := GetOrderPtEvtID(AnOrder.ID);
131     if Length(TheDefaultPtEvtID)>0 then
132     begin
133       frmChgEvent.FDefaultPtEvntIFN := StrToIntDef(TheDefaultPtEvtId,0);
134       TheDefaultEvtInfo := EventInfo(TheDefaultPtEvtID);
135       frmChgEvent.FDefaultEvntIFN := StrToIntDef(Piece(TheDefaultEvtInfo,'^',2),0);
136     end;
137     frmChgEvent.LoadSpecialtyList;
138     frmChgEvent.ShowModal;
139     if frmChgEvent.OKPress then
140     begin
141       if frmChgEvent.btnAction.Caption = 'Change' then
142       begin
143         AnOrderIDList := TStringList.Create;
144         for i := 0 to selectedList.Count - 1 do
145         begin
146           AnOrder := TOrder(selectedList[i]);
147           AnOrderIDList.Add(AnOrder.ID);
148         end;
149         EvtInfo := frmChgEvent.cboSpecialty.Items[frmChgEvent.cboSpecialty.ItemIndex];
150         AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
151         AnEvent.EventIFN  := StrToInt64Def(Piece(EvtInfo,'^',1),0);
152         if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
153         begin
154           AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
155           AnEvent.EventType := AnEvent.TheParent.ParentType;
156         end;
157         AnEvent.EventName := Piece(EvtInfo,'^',9);
158         ExistedPtEvtId := FindMatchedPtEvtID('Delayed ' + AnEvent.EventName + ' Orders');
159         if (ExistedPtEvtId>0) and IsCompletedPtEvt(ExistedPtEvtId) then
160         begin
161           DoesDestEvtOccur := True;
162           DestPtEvtId := ExistedPtEvtId;
163           DestPtEvtName := AnEvent.EventName;
164           ChangeEvent(AnOrderIDList, '');
165           Result := True;
166           Exit;
167         end;
168   
169         if Length(AnEvent.EventName) < 1 then
170           AnEvent.EventName := Piece(EvtInfo,'^',2);
171         AnEvent.Specialty := 0;
172         if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 then
173         begin
174            IsNewEvent := True;
175            if AnEvent.TheParent.ParentIFN > 0 then
176            begin
177              if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
178                AnEvtDlg := AnEvent.TheParent.ParentDlg;
179            end
180            else
181              AnEvtDlg := Piece(EvtInfo,'^',5);
182         end;
183         if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
184            if not DisplayEvntDialog(AnEvtDlg, AnEvent) then
185            begin
186              frmOrders.lstSheets.ItemIndex := 0;
187              frmOrders.lstSheetsClick(nil);
188              Result := False;
189              Exit;
190            end;
191         if not isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), ThePtEvtID) then
192         begin
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),ThePtEvtID) then
197           begin
198             AnEvent.IsNewEvent := False;
199             AnEvent.PtEventIFN := StrToIntDef(ThePtEvtID,0);
200           end;
201         end;
202         ChangeEvent(AnOrderIDList, ThePtEvtID);
203         frmChgEvent.updateChanges(AnOrderIDList,'Delayed ' + AnEvent.EventName);
204         frmChgEvent.Highlight(ThePtEvtID);
205         if frmOrders.lstSheets.ItemIndex >= 0 then
206           frmOrders.lstSheetsClick(Nil);
207       end else
208       begin
209         if not DispOrdersForEventChange(SelectedList, REMOVE_CAP) then exit;
210         AnOrderIDList := TStringList.Create;
211         for i := 0 to selectedList.Count - 1 do
212         begin
213           AnOrder := TOrder(selectedList[i]);
214           AnOrderIDList.Add(AnOrder.ID);
215         end;
216         ChangeEvent(AnOrderIDList,'');
217         frmChgEvent.updateChanges(AnOrderIDList,'');
218         frmChgEvent.FilterOutEmptyPtEvt;
219         frmOrders.InitOrderSheetsForEvtDelay;
220         frmOrders.lstSheets.ItemIndex := 0;
221         frmOrders.lstSheetsClick(Nil);
222       end;
223       Result := True;
224     end else
225       Result := False;
226   end;
227   
228   { TfrmChgEvent }
229   
230   procedure TfrmChgEvent.LoadSpecialtyList;
231   var
232     i: integer;
233     tempStr: string;
234   begin
235     inherited;
236     cboSpecialty.Items.Clear;
237     if Patient.Inpatient then
238     begin
239       ListSpecialtiesED(#0,cboSpecialty.Items);
240     end
241     else  ListSpecialtiesED('A',cboSpecialty.Items);
242     if FDefaultEvntIFN > 0 then
243     begin
244       for i := 0 to cboSpecialty.Items.Count - 1 do
245       begin
246         if Piece(cboSpecialty.Items[i],'^',1)=IntToStr(FDefaultEvntIFN) then
247         begin
248           tempStr := cboSpecialty.Items[i];
249           cboSpecialty.Items.Insert(0,tempStr);
250           cboSpecialty.Items.Insert(1,'^^^^^^^^__________________________________________________________________________________');
251           cboSpecialty.ItemIndex := 0;
252           FDefaultIndex := Piece(tempStr,'^',1);
253           btnAction.Visible := True;
254           btnAction.Caption := 'Remove';
255           break;
256         end;
257       end;
258       if cboSpecialty.ItemIndex < 0 then
259         btnAction.Visible := False;
260     end;
261   end;
262   
263   procedure TfrmChgEvent.FormCreate(Sender: TObject);
264   begin
265     inherited;
266     FDefaultEvntIFN   := 0;
267     FDefaultPtEvntIFN := 0;
268     FCurrSpecialty    := '';
269     FDefaultIndex     := '';
270     FOKPress          := False;
271     FLastIndex        := 0;
272   
273   end;
274   
275   procedure TfrmChgEvent.cboSpecialtyChange(Sender: TObject);
276   const
277     TX_MCHEVT1  = ' is already assigned to ';
278     TX_MCHEVT2  = #13 + 'Do you still want to write delayed orders?';
279   var
280     AnEvtID, AnEvtType: string;
281     AnEvtName,ATsName: string;
282     i: integer;
283     NMRec : TNextMoveRec;
284    begin
285     inherited;
286      NextMove(NMRec, FLastIndex, cboSpecialty.ItemIndex); //Logic added for 508 1/31/03
287      FLastIndex := NMRec.LastIndex ;
288     if (cboSpecialty.text = '') or (cboSpecialty.ItemIndex = -1) then
289     begin
290       btnAction.visible := False;
291       btnAction.Caption := '';
292     end
293     else if (Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1) <> FDefaultIndex) then
294     begin
295       btnAction.Visible := True;
296       btnAction.Caption := 'Change';
297     end
298     else
299     begin
300       btnAction.Visible := True;
301       btnAction.Caption := 'Remove';
302     end;
303     if cboSpecialty.ItemIndex >= 0 then
304     begin
305       AnEvtID   := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1);
306       AnEvtType := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',3);
307       AnEvtName := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',9)
308     end else
309     begin
310       AnEvtID   := '';
311       AnEvtType := '';
312       AnEvtName := '';
313     end;
314     ATsName := CurrSpecialty;
315     if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName)) then
316     begin
317       if InfoBox(Patient.Name + TX_MCHEVT1 + CurrSpecialty + ' on ' + Encounter.LocationName + TX_MCHEVT2,
318           'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then
319         btnActionClick(Self)
320      else
321      begin
322        if Length(FDefaultIndex) > 0 then
323        begin
324          for i := 0 to cboSpecialty.Items.Count - 1 do
325          begin
326            if Piece(cboSpecialty.items[i],'^',1)=FDefaultIndex then
327            begin
328              cboSpecialty.ItemIndex := cboSpecialty.ItemIndex + NMRec.NextStep; //Added this code for 508 compliance GRE 01/30/03
329              break;
330            end;
331          end;
332          btnAction.Caption := 'Remove';
333        end else
334        begin
335          cboSpecialty.ItemIndex := 0;
336          btnAction.Caption := 'Change';
337        end;
338      end;
339     end;
340   end;
341   
342   procedure TfrmChgEvent.btnActionClick(Sender: TObject);
343   const
344   TX_REASON_REQ = 'A Delayed Event must be selected.';
345   TX_REMOVE     = 'Are you sure you want to remove the release event from these orders?';
346   TX_CHANGE     = 'Are you sure you want to change the release event for these orders?';
347   
348   begin
349     inherited;
350     if cboSpecialty.ItemIndex < 0 then
351     begin
352       InfoBox(TX_REASON_REQ, 'No Selection made', MB_OK);
353       Exit;
354     end;
355     OKPress := True;
356     Close;
357   end;
358   
359   procedure TfrmChgEvent.btnCancelClick(Sender: TObject);
360   begin
361     Close;
362   end;
363   procedure TfrmChgEvent.cboSpecialtyDblClick(Sender: TObject);
364   begin
365     inherited;
366     if cboSpecialty.ItemIndex > -1 then
367       btnActionClick(Self);
368   end;
369   
370   procedure TfrmChgEvent.FormClose(Sender: TObject;
371     var Action: TCloseAction);
372   begin
373     inherited;
374     SaveUserBounds(Self);
375     Action := caFree;
376   end;
377   
378   procedure TfrmChgEvent.updateChanges(const AnOrderIDList: TStringList; const AnEventName: String);
379   var
380     jx,TempSigSts: integer;
381     theChangeItem: TChangeItem;
382     TempText: string;
383   begin
384     for jx := 0 to AnOrderIDList.Count - 1 do
385     begin
386       theChangeItem := Changes.Locate(CH_ORD,AnOrderIDList[jx]);
387       if theChangeItem = nil then
388       begin
389         TempText := RetrieveOrderText(AnOrderIDList[jx]);
390         Changes.Add(CH_ORD,AnOrderIDList[jx],TempText,AnEventName,1);
391       end
392       else
393       begin
394         TempText := theChangeItem.Text;
395         TempSigSts := theChangeItem.SignState;
396         Changes.Remove(CH_ORD,AnOrderIDList[jx]);
397         Changes.Add(CH_ORD,AnOrderIDList[jx],TempText, AnEventName, TempSigSts);
398       end;
399     end;
400     if FDefaultPtEvntIFN>0 then
401     begin
402       if PtEvtEmpty(IntToStr(FDefaultPtEvntIFN)) then
403       begin
404         DeletePtEvent(IntToStr(FDefaultPtEvntIFN));
405         frmOrders.ChangesUpdate(IntToStr(FDefaultPtEvntIFN));
406       end;
407     end;
408   end;
409   
410   procedure TfrmChgEvent.Highlight(APtEvtID: string);
411   var
412     jjj: integer;
413   begin
414     FilterOutEmptyPtEvt;
415     frmOrders.InitOrderSheetsForEvtDelay;
416     for jjj := 0 to frmOrders.lstSheets.Items.Count - 1 do
417     begin
418       if Piece(frmOrders.lstSheets.Items[jjj],'^',1)=APtEvtID then
419       begin
420         frmOrders.lstSheets.ItemIndex := jjj;
421         break;
422       end;
423     end;
424   end;
425   
426   procedure TfrmChgEvent.FilterOutEmptyPtEvt;
427   var
428     TmpStr: string;
429     hhh: integer;
430     AaPtEvtList: TStringList;
431   begin
432     AaPtEvtList := TStringList.Create;
433     LoadOrderSheetsED(AaPtEvtList);
434     for hhh := 0 to AaPtEvtList.Count - 1 do
435     begin
436       if StrToIntDef(Piece(AaPtEvtList[hhh],'^',1),0)>0 then
437       begin
438         if DeleteEmptyEvt(Piece(AaPtEvtList[hhh],'^',1),TmpStr, False) then
439           frmOrders.ChangesUpdate(Piece(AaPtEvtList[hhh],'^',1));
440       end;
441     end;
442   end;
443   
444   end.

Module Calls (2 levels)


fOrdersCV
 ├fAutoSz
 │ └fBase508Form
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA
 │ ├rCore
 │ ├uCore
 │ ├fFrame
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc
 │ ├uODBase
 │ ├rODMeds
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction
 │ ├fARTAllgy
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds
 │ ├rMeds
 │ ├rPCE
 │ ├fRptBox
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy
 │ ├UBAGlobals
 │ └uTemplateFields
 ├rOrders...
 ├uCore...
 ├uConst
 ├fOrders...
 ├fODChangeEvtDisp
 │ ├fAutoSz...
 │ └rOrders...
 └rMisc...

Module Called-By (2 levels)


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