Module

fOrdersRelease

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -
UBACore -
UBAGlobals -

Units Used in Implementation

Name Comments
fClinicWardMeds -
fFrame -
fOrdersPrint -
fRptBox -
fSignItem -
rCore -
rODLab -
rOrders -
uConst -
uCore -
uOrders -

Classes

Name Comments
TfrmReleaseOrders -

Procedures

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

Functions

Name Owner Declaration Scope Comments
ExecuteReleaseOrders - function ExecuteReleaseOrders(SelectedList: TList): Boolean; Interfaced -
FindOrderText - function FindOrderText(const AnID: string): string; Local -
SignNotRequired - function SignNotRequired: Boolean; Local -

Constants

Name Declaration Scope Comments
TC_ES_REQ 'Electronic Signature' Global -
TC_NO_REL 'Unable to Release Orders' Global -
TC_SAVERR 'Error Saving Order' Global -
TX_ES_REQ 'Enter your electronic signature to release these orders.' Global -
TX_NO_REL CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ' Global -
TX_SAVERR1 'The error, ' Global -
TX_SAVERR2 ', occurred while trying to save:' + CRLF + CRLF Global -


Module Source

1     unit fOrdersRelease;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmReleaseOrders = class(TfrmAutoSz)
12        Panel1: TPanel;
13        lstOrders: TCaptionListBox;
14        Label1: TLabel;
15        Panel2: TPanel;
16        grpRelease: TGroupBox;
17        radVerbal: TRadioButton;
18        radPhone: TRadioButton;
19        radPolicy: TRadioButton;
20        cmdOK: TButton;
21        cmdCancel: TButton;
22        procedure FormCreate(Sender: TObject);
23        procedure cmdOKClick(Sender: TObject);
24        procedure cmdCancelClick(Sender: TObject);
25        procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
26          Rect: TRect; State: TOwnerDrawState);
27        procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
28          var AHeight: Integer);
29        procedure Panel1Resize(Sender: TObject);
30      private
31        FOrderList: TList;
32        FNature: Char;
33        FSigSts: Char;
34        OKPressed: Boolean;
35        ESCode: string;
36      end;
37    
38    function ExecuteReleaseOrders(SelectedList: TList): Boolean;
39    
40    implementation
41    
42    {$R *.DFM}
43    
44    uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox,
45      fFrame, fClinicWardMeds, rODLab;
46    
47    const
48      TX_SAVERR1 = 'The error, ';
49      TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
50      TC_SAVERR  = 'Error Saving Order';
51      TX_ES_REQ  = 'Enter your electronic signature to release these orders.';
52      TC_ES_REQ  = 'Electronic Signature';
53      TX_NO_REL  = CRLF + CRLF + '- cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ';
54      TC_NO_REL  = 'Unable to Release Orders';
55    
56    function ExecuteReleaseOrders(SelectedList: TList): Boolean;
57    var
58      frmReleaseOrders: TfrmReleaseOrders;
59      i, PrintLoc: Integer;
60      SignList: TStringList;
61      OrderText: string;
62      AnOrder: TOrder;
63      AList: TStringList;
64    
65      function FindOrderText(const AnID: string): string;
66      var
67        i: Integer;
68      begin
69        Result := '';
70        with SelectedList do for i := 0 to Count - 1 do
71          with TOrder(Items[i]) do if ID = AnID then
72          begin
73            Result := Text;
74            Break;
75          end;
76      end;
77    
78      function SignNotRequired: Boolean;
79      var
80        i: Integer;
81      begin
82        Result := True;
83        with SelectedList do for i := 0 to Pred(Count) do
84        begin
85          with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
86        end;
87      end;
88    
89    
90    begin
91      Result := False;
92      PrintLoc := 0;
93      if SelectedList.Count = 0 then Exit;
94      frmReleaseOrders := TfrmReleaseOrders.Create(Application);
95      try
96        ResizeFormToFont(TForm(frmReleaseOrders));
97        frmReleaseOrders.FOrderList := SelectedList;
98        with SelectedList do for i := 0 to Count - 1 do
99          frmReleaseOrders.lstOrders.Items.Add(TOrder(Items[i]).Text);
100       if SignNotRequired then frmReleaseOrders.grpRelease.Visible := False;
101       frmReleaseOrders.ShowModal;
102       if frmReleaseOrders.OKPressed then
103       begin
104         Result := True;
105         SignList := TStringList.Create;
106         try
107           with SelectedList, frmReleaseOrders do
108             for i := 0 to Count - 1 do
109             begin
110               AnOrder := TOrder(Items[i]);
111               SignList.Add(AnOrder.ID + U + FSigSts + U + RS_RELEASE + U + FNature);
112             end;
113           StatusText('Sending Orders to Service(s)...');
114           if SignList.Count > 0 then SendOrders(SignList, frmReleaseOrders.ESCode);
115   
116           if (not frmFrame.TimedOut) then
117             begin
118                if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
119                   frmClinicWardMeds.ClinicOrWardLocation(SignList, uCore.TempEncounterLoc,uCore.TempEncounterLocName, PrintLoc)
120                else
121                   if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
122                      frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
123             end;
124             uCore.TempEncounterLoc := 0;
125             uCore.TempEncounterLocName := '';
126   
127           //hds7591  Clinic/Ward movement.
128   
129   
130         //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
131           with SignList do if Count > 0 then for i := 0 to Count - 1 do
132           begin
133             if Pos('E', Piece(SignList[i], U, 2)) > 0 then
134             begin
135               OrderText := FindOrderText(Piece(SignList[i], U, 1));
136                   if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
137                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
138                           TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
139                   else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
140                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
141                           TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
142                   else
143                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
144                           TC_SAVERR, MB_OK);
145             end;
146             if Pos('R', Piece(SignList[i], U, 2)) > 0 then
147               NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
148           end;
149           StatusText('');
150             //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
151           AList := TStringList.Create;
152           try
153             CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
154             if AList.Text <> '' then
155               ReportBox(AList, 'Changed Orders', TRUE);
156           finally
157             AList.Free;
158           end;
159           PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
160   //        SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
161   //        if PrintIt then PrintOrdersOnReview(SignList, DeviceInfo);                       //*KCM*
162         finally
163           SignList.Free;
164         end;
165    {BillingAware}
166     // HDS6435
167     // HDS00005143 - if cidc master sw is on and  BANurseConsultOrders.Count > 0 then
168     // save those orders with selected DX enteries.  Resulting in dx populated for provider.
169         if rpcGetBAMasterSwStatus then
170         begin
171            if  BANurseConsultOrders.Count > 0 then
172            begin
173               rpcSaveNurseConsultOrder(BANurseConsultOrders);
174               BANurseConsultOrders.Clear;
175            end;
176         end;
177   {BillingAware}
178   // HDS6435
179       end; {if frmReleaseOrders.OKPressed}
180         finally
181       frmReleaseOrders.Release;
182       with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
183     end;
184   end;
185   
186   procedure TfrmReleaseOrders.FormCreate(Sender: TObject);
187   begin
188     inherited;
189     OKPressed := False;
190     ESCode := '';
191     if Encounter.Provider = User.DUZ then
192     begin
193       FNature := NO_POLICY;
194       radPolicy.Checked := True;
195     end else
196     begin
197       FNature := NO_VERBAL;
198       radVerbal.Checked := True;
199     end;
200     FSigSts := SS_UNSIGNED;
201   end;
202   
203   procedure TfrmReleaseOrders.cmdOKClick(Sender: TObject);
204   var
205     i: Integer;
206     AnErrMsg: string;
207     AnOrder: TOrder;
208   begin
209     inherited;
210     // set up nature, signature status
211     if      radPhone.Checked  then FNature := NO_PHONE
212     else if radPolicy.Checked then FNature := NO_POLICY
213     else                           FNature := NO_VERBAL;
214     FSigSts := SS_UNSIGNED;
215     if not grpRelease.Visible then
216     begin
217       FNature := NO_PROVIDER;
218       FSigSts := SS_NOTREQD;
219     end;
220     if FNature = NO_POLICY then FSigSts := SS_ESIGNED;
221     // validate release of the orders with this nature of order
222     StatusText('Validating Release...');
223     AnErrMsg := '';
224     with FOrderList do for i := 0 to Count - 1 do
225     begin
226       AnOrder := TOrder(Items[i]);
227       ValidateOrderActionNature(AnOrder.ID, OA_RELEASE, FNature, AnErrMsg);
228       if Length(AnErrMsg) > 0 then
229       begin
230         if IsInvalidActionWarning(AnOrder.Text, AnOrder.ID) then Break;
231         InfoBox(AnOrder.Text + TX_NO_REL + AnErrMsg, TC_NO_REL, MB_OK);
232         Break;
233       end;
234     end;
235     StatusText('');
236     if Length(AnErrMsg) > 0 then Exit;
237     // get the signature code for releasing the orders
238     if grpRelease.Visible then
239     begin
240       SignatureForItem(Font.Size, TX_ES_REQ, TC_ES_REQ, ESCode);
241       if ESCode = '' then Exit;
242     end;
243     OKPressed := True;
244     Close;
245   end;
246   
247   procedure TfrmReleaseOrders.cmdCancelClick(Sender: TObject);
248   begin
249     inherited;
250     Close;
251   end;
252   
253   procedure TfrmReleaseOrders.lstOrdersDrawItem(Control: TWinControl;
254     Index: Integer; Rect: TRect; State: TOwnerDrawState);
255   var
256     x: string;
257     ARect: TRect;
258     SaveColor: TColor;
259   begin
260     inherited;
261     with lstOrders do
262     begin
263       ARect := Rect;
264       ARect.Left := ARect.Left + 2;
265       Canvas.FillRect(ARect);
266       Canvas.Pen.Color := Get508CompliantColor(clSilver);
267       SaveColor := Canvas.Brush.Color;
268       Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
269       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
270       if Index < Items.Count then
271       begin
272         x := FilteredString(Items[Index]);
273         DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
274         Canvas.Brush.Color := SaveColor;
275         ARect.Right := ARect.Right + 4;
276       end;
277     end;
278   end;
279   
280   procedure TfrmReleaseOrders.lstOrdersMeasureItem(Control: TWinControl;
281     Index: Integer; var AHeight: Integer);
282   var
283     x: string;
284     ARect: TRect;
285   begin
286     inherited;
287     with lstOrders do if Index < Items.Count then
288     begin
289       ARect := ItemRect(Index);
290       Canvas.FillRect(ARect);
291       x := FilteredString(Items[Index]);
292       AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
293       if AHeight <  13 then AHeight := 15;
294     end;
295   end;
296   
297   procedure TfrmReleaseOrders.Panel1Resize(Sender: TObject);
298   begin
299     inherited;
300     lstOrders.Invalidate;
301   end;
302   
303   end.

Module Calls (2 levels)


fOrdersRelease
 ├fAutoSz
 │ └fBase508Form
 ├UBACore
 │ ├uConst
 │ ├UBAGlobals
 │ ├fFrame
 │ ├fReview
 │ ├rOrders
 │ ├uCore
 │ ├rCore
 │ └UBAConst
 ├UBAGlobals...
 ├rOrders...
 ├uConst
 ├fSignItem
 │ ├rCore...
 │ └fBase508Form...
 ├uCore...
 ├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
 ├fRptBox...
 ├fFrame...
 ├fClinicWardMeds
 │ ├fAutoSz...
 │ ├rCore...
 │ └uCore...
 └rODLab
   └uCore...

Module Called-By (2 levels)


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