Module

fOrdersDC

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
rMisc -

Units Used in Implementation

Name Comments
fOrders -
rOrders -
uConst -
uCore -

Classes

Name Comments
TfrmDCOrders -

Procedures

Name Owner Declaration Scope Comments
cmdCancelClick TfrmDCOrders procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmDCOrders procedure cmdOKClick(Sender: TObject); Public/Published -
FormCreate TfrmDCOrders procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmDCOrders procedure FormDestroy(Sender: TObject); Public/Published -
lstOrdersDrawItem TfrmDCOrders procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lstOrdersMeasureItem TfrmDCOrders procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
unMarkedOrignalOrderDC TfrmDCOrders procedure unMarkedOrignalOrderDC(OrderArr: TStringList); Public/Published -

Functions

Name Owner Declaration Scope Comments
ExecuteDCOrders - function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean; Interfaced -
MeasureColumnHeight TfrmDCOrders function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer; Private -


Module Source

1     unit fOrdersDC;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fBase508Form,
7       fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, ORNet, VA508AccessibilityManager, rMisc;
8     
9     type
10      TfrmDCOrders = class(TfrmBase508Form)
11        Label1: TLabel;
12        Panel1: TPanel;
13        lstOrders: TCaptionListBox;
14        Panel2: TPanel;
15        lblReason: TLabel;
16        lstReason: TORListBox;
17        cmdOK: TButton;
18        cmdCancel: TButton;
19        procedure FormCreate(Sender: TObject);
20        procedure cmdOKClick(Sender: TObject);
21        procedure cmdCancelClick(Sender: TObject);
22        procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
23          Rect: TRect; State: TOwnerDrawState);
24        procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
25          var AHeight: Integer);
26        procedure FormDestroy(Sender: TObject);
27        procedure unMarkedOrignalOrderDC(OrderArr: TStringList);
28      private
29        OKPressed: Boolean;
30        DCReason: Integer;
31        function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
32      public
33        OrderIDArr: TStringList;
34      end;
35    
36    function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
37    
38    implementation
39    
40    {$R *.DFM}
41    
42    uses rOrders, uCore, uConst, fOrders;
43    
44    function ExecuteDCOrders(SelectedList: TList; var DelEvt: boolean): Boolean;
45    const
46      DCT_NEWORDER  = 1;
47      DCT_DELETION  = 2;
48      DCT_NEWSTATUS = 3;
49    var
50      frmDCOrders: TfrmDCOrders;
51      AnOrder: TOrder;
52      i, j, CanSign, DCType: Integer;
53      NeedReason,NeedRefresh,OnCurrent, DCNewOrder: Boolean;
54      OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt:  string;
55      PtEvtList: TStringList;
56      DCChangeItem: TChangeItem;
57    begin
58      Result := False;
59      DelEvt := False;
60      OnCurrent := False;
61      NeedRefresh := False;
62      DCNewOrder := false;
63      PtEvtList := TStringList.Create;
64      if SelectedList.Count = 0 then Exit;
65      frmDCOrders := TfrmDCOrders.Create(Application);
66      try
67        SetFormPosition(frmDCOrders);
68        ResizeFormToFont(TForm(frmDCOrders));
69        NeedReason := False;
70        with SelectedList do for i := 0 to Count - 1 do
71        begin
72          AnOrder    := TOrder(Items[i]);
73          frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
74          frmDCOrders.OrderIDArr.Add(AnOrder.ID);
75          if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
76          if (NeedReason = True) and (AnOrder.Status = 10) and (AnOrder.Signature = 2) then  NeedReason := False;
77          
78        end;
79        if NeedReason then
80        begin
81          frmDCOrders.lblReason.Visible := True;
82          frmDCOrders.lstReason.Visible := True;
83          frmDCOrders.lstReason.ScrollWidth := 10;
84        end else
85        begin
86          frmDCOrders.lblReason.Visible := False;
87          frmDCOrders.lstReason.Visible := False;
88        end;
89        frmDCOrders.ShowModal;
90        if frmDCOrders.OKPressed then
91        begin
92          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
93            then CanSign := CH_SIGN_YES
94            else CanSign := CH_SIGN_NA;
95          with SelectedList do for i := 0 to Count - 1 do
96          begin
97            AnOrder := TOrder(Items[i]);
98            OriginalID := AnOrder.ID;
99            PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
100           if Changes.Orders.Count = 0 then DCNewOrder := false
101           else
102             begin
103               for j := 0 to Changes.Orders.Count - 1 do
104                 begin
105                   DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
106                   if DCChangeItem.ID = AnOrder.ID then
107                     begin
108                       if (Pos('DC', AnOrder.ActionOn) = 0) then
109                          DCNewOrder := True
110                       else DCNewOrder := False;
111                     end;
112                 end;
113             end;
114           DCOrder(AnOrder, frmDCOrders.DCReason, DCNewOrder, DCType);
115           case DCType of
116           DCT_NEWORDER:  begin
117                            Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID, user.DUZ, AnOrder.DGroupName, True);
118                            AnOrder.ActionOn := OriginalID + '=DC';
119                          end;
120           DCT_DELETION:  begin
121                            Changes.Remove(CH_ORD, OriginalID);
122                            if (AnOrder.ID = '0') or (AnOrder.ID = '')
123                              then AnOrder.ActionOn := OriginalID + '=DL'    // delete order
124                              else AnOrder.ActionOn := OriginalID + '=CA';   // cancel action
125                             {else AnOrder.ActionOn := AnOrder.ID + '=CA';  - caused cancel from meds to not update orders}
126                            UnlockOrder(OriginalID);  // for deletion of unsigned DC
127                          end;
128           DCT_NEWSTATUS: begin
129                            AnOrder.ActionOn := OriginalID + '=DC';
130                            UnlockOrder(OriginalID);
131                          end;
132           else UnlockOrder(OriginalID);
133           end;
134           SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(AnOrder));
135         end;
136         if frmOrders.lstSheets.ItemIndex > -1 then
137           if CharAt(frmOrders.lstSheets.Items[frmOrders.lstSheets.ItemIndex],1)='C' then
138             OnCurrent := True;
139         if not OnCurrent then
140         begin
141           for i := 0 to PtEvtList.Count - 1 do
142           begin
143             if Length(PtEvtList[i])>1  then
144             begin
145               APtEvtID   := Piece(PtEvtList[i],'^',1);
146               APtEvtName := Piece(PtEvtList[i],'^',2);
147               AnEvtInfo := EventInfo(APtEvtID);
148               if isExistedEvent(Patient.DFN,Piece(AnEvtInfo,'^',2),tmpPtEvt) and (DeleteEmptyEvt(APtEvtID,APtEvtName,False)) then
149               begin
150                 NeedRefresh := True;
151                 frmOrders.ChangesUpdate(APtEvtID);
152               end;
153             end;
154           end;
155           if NeedRefresh then
156           begin
157             frmOrders.InitOrderSheetsForEvtDelay;
158             frmOrders.lstSheets.ItemIndex := 0;
159             frmOrders.lstSheetsClick(nil);
160             DelEvt := True;
161           end;
162         end;
163         Result := True;
164       end
165       else with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
166       SaveUserBounds(frmDCOrders);
167     finally
168       frmDCOrders.Release;
169     end;
170   end;
171   
172   procedure TfrmDCOrders.FormCreate(Sender: TObject);
173   var
174     DefaultIEN: Integer;
175   begin
176     inherited;
177     OKPressed := False;
178     OrderIDArr := TStringList.Create;
179     ListDCReasons(lstReason.Items, DefaultIEN);
180     lstReason.SelectByIEN(DefaultIEN);
181     { the following commented out so that providers can enter DC reasons }
182   //  if Encounter.Provider = User.DUZ then
183   //  begin
184   //    lblReason.Visible := False;
185   //    lstReason.Visible := False;
186   //  end;
187   end;
188   
189   procedure TfrmDCOrders.cmdOKClick(Sender: TObject);
190   const
191     TX_REASON_REQ = 'A reason for discontinue must be selected.';
192     TC_REASON_REQ = 'Missing Discontinue Reason';
193   begin
194     inherited;
195     if (lstReason.Visible) and (not (lstReason.ItemIEN > 0)) then
196     begin
197       InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);
198       Exit;
199     end;
200     OKPressed := True;
201     DCReason := lstReason.ItemIEN;
202     Close;
203   end;
204   
205   procedure TfrmDCOrders.cmdCancelClick(Sender: TObject);
206   begin
207     inherited;
208     unMarkedOrignalOrderDC(Self.OrderIDArr);
209     Close;
210   end;
211   
212   procedure TfrmDCOrders.lstOrdersDrawItem(Control: TWinControl;
213     Index: Integer; Rect: TRect; State: TOwnerDrawState);
214   var
215     x: string;
216     ARect: TRect;
217   begin
218     inherited;
219     x := '';
220     ARect := Rect;
221     with lstOrders do
222     begin
223       Canvas.FillRect(ARect);
224       Canvas.Pen.Color := Get508CompliantColor(clSilver);
225       Canvas.MoveTo(0, ARect.Bottom - 1);
226       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
227       if Index < Items.Count then
228       begin
229         x := Items[Index];
230         DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
231       end;
232     end;
233   end;
234   
235   procedure TfrmDCOrders.lstOrdersMeasureItem(Control: TWinControl;
236     Index: Integer; var AHeight: Integer);
237   var
238     x:string;
239   begin
240     inherited;
241     with lstOrders do if Index < Items.Count then
242     begin
243       x := Items[index];
244       AHeight := MeasureColumnHeight(x, Index);
245     end;
246   end;
247   
248   function TfrmDCOrders.MeasureColumnHeight(TheOrderText: string;
249     Index: Integer): integer;
250   var
251     ARect: TRect;
252   begin
253     ARect.Left := 0;
254     ARect.Top := 0;
255     ARect.Bottom := 0;
256     ARect.Right := lstOrders.Width - 6;
257     Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
258   end;
259   
260   procedure TfrmDCOrders.FormDestroy(Sender: TObject);
261   begin
262     inherited;
263     if self.OrderIDArr <> nil then self.OrderIDArr.Free;
264   end;
265   
266   procedure TfrmDCOrders.unMarkedOrignalOrderDC(OrderArr: TStringList);
267   begin
268    CallV('ORWDX1 UNDCORIG', [OrderArr]);
269   end;
270   
271   end.

Module Calls (2 levels)


fOrdersDC
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rMisc
 │ └fOrders
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├uCore...
 ├uConst
 └fOrders...

Module Called-By (2 levels)


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