Function

ExecuteReleaseEventOrders

Module

fODReleaseEvent

Last Modified

7/15/2014 3:26:42 PM

Comments

Procedure ExecuteReleaseEventOrders(AnOrderList: TList);
procedure ExecuteReleaseEventOrders(AnOrderList: TList);

Scope

Interfaced

Declaration

function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;

Calls Hierarchy


ExecuteReleaseEventOrders
 ├TfrmBase508Form.Create
 │ ├TfrmBase508Form.UpdateAccessibilityActions
 │ ├UnfocusableControlEnter
 │ └AdjustControls
 │   ├TfrmBase508Form.ModifyUnfocusableControl
 │   └..(rec)..
 ├GetCurrentSpec
 ├TEncounter.GetLocationName
 │ └TEncounter.UpdateText
 │   └GetEncounterText
 ├SendReleaseOrders
 │ └GetCurrentSpec
 ├FindOrderText
 ├CheckForChangeFromLCtoWCOnRelease
 │ └FormatLCtoWCDisplayTextOnRelease
 │   └GetLCtoWCInstructions
 ├ReportBox
 │ └CreateReportBox
 │   └TfrmBase508Form.Create...
 ├PrintOrdersOnSignRelease
 │ ├CurrentLocationForPatient
 │ ├TEncounter.SetLocation
 │ ├CommonLocationForOrders
 │ ├LookupLocation
 │ │ └TfrmBase508Form.Create...
 │ ├TfrmFrame.DisplayEncounterText
 │ │ ├TEncounter.GetLocationText
 │ │ │ └TEncounter.UpdateText...
 │ │ ├TEncounter.GetProviderName
 │ │ │ └TEncounter.UpdateText...
 │ │ └TfrmFrame.FitToolbar
 │ ├SetupOrdersPrint
 │ │ ├TfrmBase508Form.Create...
 │ │ ├OrderPrintDeviceInfo
 │ │ └TfrmOrdersPrint.SetupControls
 │ │   └TfrmOrdersPrint.SetupPrompting
 │ ├PrintOrdersOnReview
 │ └PrintServiceCopies
 ├CompleteEvt
 │ ├PtEvtEmpty
 │ └GetEventName
 ├UnlockOrder
 ├TfrmOrders.InitOrderSheetsForEvtDelay
 │ ├TfrmOrders.InitOrderSheets
 │ │ ├TfrmOrders.ClearOrderSheets
 │ │ ├LoadOrderSheetsED
 │ │ ├DGroupAll
 │ │ └EventInfo
 │ └TfrmOrders.DfltViewForEvtDelay
 │   ├TfrmOrders.CanChangeOrderView
 │   │ └ActiveOrdering
 │   └LoadOrderViewDefault
 └TfrmOrders.ClickLstSheet
   └TfrmOrders.lstSheetsClick
     ├CloseOrdering
     ├TfrmOrders.PtEvtCompleted
     │ ├IsCompletedPtEvt
     │ ├TfrmOrders.GroupChangesUpdate
     │ │ ├TChanges.ChangeOrderGrp
     │ │ └TChanges.ReplaceODGrpName
     │ ├TfrmOrders.InitOrderSheetsForEvtDelay...
     │ ├TfrmOrders.lstSheetsClick...
     │ └TfrmOrders.RefreshOrderList
     │   ├LoadOrdersAbbr
     │   │ ├ClearOrders
     │   │ ├LoadDGroupMap
     │   │ ├ExpiredOrdersStartDT
     │   │ ├FMNow
     │   │ └SeqOfDGroup
     │   │   └LoadDGroupMap
     │   ├ClearOrders
     │   ├LoadOrdersAbbr
     │   │ ├LoadDGroupMap
     │   │ ├FMNow
     │   │ └SeqOfDGroup...
     │   ├TfrmOrders.ExpandEventSection
     │   ├TfrmOrders.CompressEventSection
     │   ├SortOrders
     │   │ ├InverseByGroup
     │   │ │ └TChanges.Exist
     │   │ ├ForwardByGroup
     │   │ │ └TChanges.Exist
     │   │ ├InverseChrono
     │   │ └ForwardChrono
     │   ├TfrmOrders.AddToListBox
     │   │ └TfrmOrders.GetPlainText
     │   │   └TfrmOrders.GetOrderText
     │   │     ├LoadFlagReason
     │   │     ├TfrmOrders.GetStartStopText
     │   │     └NameOfStatus
     │   └DGroupAll
     ├DeleteEmptyEvt
     │ ├PtEvtEmpty
     │ ├GetEventName
     │ └DeletePtEvent
     ├TfrmOrders.ChangesUpdate
     │ ├TheParentPtEvt
     │ └TChanges.Remove
     │   ├UnlockOrder
     │   └UnlockDocument
     ├TfrmOrders.InitOrderSheetsForEvtDelay...
     ├..(rec)..
     ├LoadWriteOrdersED
     ├LoadWriteOrders
     ├TfrmOrders.RefreshOrderList...
     ├PtEvtEmpty
     └DeletePtEvent

Called-By Hierarchy


  ExecuteReleaseEventOrders
TfrmOrders.mnuActRelClick┘ 

Calls

Name Declaration Comments
CheckForChangeFromLCtoWCOnRelease procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList); -
TfrmOrders.ClickLstSheet procedure ClickLstSheet; -
CompleteEvt function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean = True): boolean; -
TfrmBase508Form.Create constructor Create(AOwner: TComponent); override; -
FindOrderText function FindOrderText(const AnID: string): string; -
GetCurrentSpec function GetCurrentSpec(const APtIFN: string): string; -
TEncounter.GetLocationName function GetLocationName: string; -
TfrmOrders.InitOrderSheetsForEvtDelay procedure InitOrderSheetsForEvtDelay; -
PrintOrdersOnSignRelease procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = ''); -
ReportBox procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean); -
SendReleaseOrders procedure SendReleaseOrders(OrderList: TStringList); -
UnlockOrder procedure UnlockOrder(OrderID: string); -

Called-By

Name Declaration Comments
TfrmOrders.mnuActRelClick procedure mnuActRelClick(Sender: TObject); -


Source

56    function ExecuteReleaseEventOrders(AnOrderList: TList): boolean;
57    const
58      TXT_RELEASE = #13 + #13 + '  The following orders will be released to service:';
59    var
60      i,j,idx: integer;
61      AOrder: TOrder;
62      OrdersLst: TStringlist;
63      OrderText, LastCheckedPtEvt, SpeCap: string;
64      frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
65      AList: TStringList;
66    
67      function FindOrderText(const AnID: string): string;
68      var
69        i: Integer;
70      begin
71        Result := '';
72        with AnOrderList do for i := 0 to Count - 1 do
73          with TOrder(Items[i]) do if ID = AnID then
74          begin
75            Result := Text;
76            Break;
77          end;
78      end;
79    
80    begin
81      frmOrdersReleaseEvent := TfrmOrdersReleaseEvent.Create(Application);
82      try
83        frmOrdersReleaseEvent.CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
84        if Length(frmOrdersReleaseEvent.CurrTS)>0 then
85          SpeCap := #13 + '  The current treating specialty is ' + frmOrdersReleaseEvent.CurrTS
86        else
87          SpeCap := #13 + '  No treating specialty is available.';
88        ResizeFormToFont(TForm(frmOrdersReleaseEvent));
89        if Patient.Inpatient then
90          frmOrdersReleaseEvent.lblRelease.Caption := '  ' + Patient.Name + ' is currently admitted to '
91             + Encounter.LocationName + SpeCap + TXT_RELEASE
92        else
93        begin
94          if Encounter.Location > 0 then
95            frmOrdersReleaseEvent.lblRelease.Caption := '  ' + Patient.Name + ' is currently at '
96              + Encounter.LocationName + SpeCap + TXT_RELEASE
97          else
98            frmOrdersReleaseEvent.lblRelease.Caption := '  ' + Patient.Name + ' is currently an outpatient.' + SpeCap + TXT_RELEASE;
99        end;
100       with frmOrdersReleaseEvent do
101         cklstOrders.Caption := lblRelease.Caption;
102       with  AnOrderList do for i := 0 to Count - 1 do
103       begin
104         AOrder := TOrder(Items[i]);
105         idx := frmOrdersReleaseEvent.cklstOrders.Items.AddObject(AOrder.Text,AOrder);
106         frmOrdersReleaseEvent.cklstOrders.Checked[idx] := True;
107       end;
108       frmOrdersReleaseEvent.ShowModal;
109       if frmOrdersReleaseEvent.OKPressed then
110       begin
111         OrdersLst := TStringList.Create;
112         for j := 0 to frmOrdersReleaseEvent.cklstOrders.Items.Count - 1 do
113         begin
114           if frmOrdersReleaseEvent.cklstOrders.Checked[j] then
115             OrdersLst.Add(TOrder(frmOrdersReleaseEvent.cklstOrders.Items.Objects[j]).ID);
116         end;
117         StatusText('Releasing Orders to Service...');
118         SendReleaseOrders(OrdersLst);
119         LastCheckedPtEvt := '';
120   
121         //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
122         with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
123         begin
124           if Pos('E', Piece(OrdersLst[i], U, 2)) > 0 then
125           begin
126             OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
127             if Piece(OrdersLst[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
128             InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
129                     TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
130             else if Piece(OrdersLst[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
131             InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
132                     TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
133             else
134             InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
135                     TC_SAVERR, MB_OK);
136           end;
137         end;
138         //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
139         AList := TStringList.Create;
140         try
141           CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst);
142           if AList.Text <> '' then
143             ReportBox(AList, 'Changed Orders', TRUE);
144         finally
145           AList.Free;
146         end;
147         PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
148   
149         with AnOrderList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
150         begin
151           if EventPtr <> LastCheckedPtEvt then
152           begin
153             LastCheckedPtEvt := EventPtr;
154             if CompleteEvt(EventPtr,EventName,False) then
155               frmOrdersReleaseEvent.FComplete := True;
156           end;
157         end;
158         StatusText('');
159         ordersLst.Free;
160         with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
161         if frmOrdersReleaseEvent.FComplete then
162         begin
163           frmOrders.InitOrderSheetsForEvtDelay;
164           frmOrders.ClickLstSheet;
165         end;
166         frmOrdersReleaseEvent.FComplete := False;
167         Result := True;
168       end else
169         Result := False;
170     Except
171       on E: exception do
172         Result := false;
173     end;
174     {finally
175       with AnOrderList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
176       if frmOrdersReleaseEvent.FComplete then
177       begin
178         frmOrders.InitOrderSheetsForEvtDelay;
179         frmOrders.ClickLstSheet;
180       end;
181       frmOrdersReleaseEvent.FComplete := False;
182     end;}
183   end;