Module

uODBase

Path

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

Last Modified

7/15/2014 3:26:42 PM

Initialization Code

initialization
  uOrderEventType := #0;
  uOrderFormID := 0;
  uOrderEventName := '';
  uFillerAppID := TStringList.Create;
  uKeyVarList  := TStringList.Create;

Finalization Code

finalization
  uFillerAppID.Free;
  uKeyVarList.Free;

end.

Units Used in Interface

Name Comments
uConst -

Units Used in Implementation

Name Comments
dShared -
fOrders -
rOrders -
rTemplates -

Procedures

Name Owner Declaration Scope Comments
CheckForAutoDCDietOrders - procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string; var CancelText: string; Sender: TObject); Interfaced
Check for diet orders that will be auto-DCd on release because of start/stop overlaps.
 Moved here for visibility because it also needs to be checked on an auto-accept order.

AResponse: TResponse;
ClearFillerAppList - procedure ClearFillerAppList; Interfaced -
ExpandOrderObjects - procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = ''); Interfaced -
PopKeyVars - procedure PopKeyVars(NumLevels: Integer = 1); Interfaced -
PushKeyVars - procedure PushKeyVars(const NewVals: string); Interfaced -
SetOrderEventIDOnCreate - procedure SetOrderEventIDOnCreate(AnEvtID: integer); Interfaced -
SetOrderEventNameOnCreate - procedure SetOrderEventNameOnCreate(AnEvtNm: string); Interfaced -
SetOrderEventTypeOnCreate - procedure SetOrderEventTypeOnCreate(AType: Char); Interfaced -
SetOrderFormIDOnCreate - procedure SetOrderFormIDOnCreate(AFormID: Integer); Interfaced
Ordering Environment
Ordering Environment

Functions

Name Owner Declaration Scope Comments
AddFillerAppID - function AddFillerAppID(const AnID: string): Boolean; Interfaced
Order Checking
Order Checking
GetKeyVars - function GetKeyVars: string; Interfaced -
OrderEventIDOnCreate - function OrderEventIDOnCreate: integer; Interfaced -
OrderEventNameOnCreate - function OrderEventNameOnCreate: string; Interfaced -
OrderEventTypeOnCreate - function OrderEventTypeOnCreate: Char; Interfaced -
OrderFormIDOnCreate - function OrderFormIDOnCreate: Integer; Interfaced -

Global Variables

Name Type Declaration Comments
uFillerAppID TStringList uFillerAppID: TStringList; -
uKeyVarList TStringList uKeyVarList: TStringList; -
uOrderEventID Integer uOrderEventID: Integer; -
uOrderEventName UnicodeString uOrderEventName: string; -
uOrderEventType Char uOrderEventType: Char; -
uOrderFormID Integer uOrderFormID: Integer; -


Module Source

1     unit uODBase;
2     
3     interface
4     
5     uses
6       Classes, ORFn, uConst;
7     
8     { Order Checking }
9     function AddFillerAppID(const AnID: string): Boolean;
10    procedure ClearFillerAppList;
11    
12    { Ordering Environment }
13    procedure SetOrderFormIDOnCreate(AFormID: Integer);
14    function OrderFormIDOnCreate: Integer;
15    procedure SetOrderEventTypeOnCreate(AType: Char);
16    function OrderEventTypeOnCreate: Char;
17    procedure SetOrderEventIDOnCreate(AnEvtID: integer);
18    function OrderEventIDOnCreate: integer;
19    procedure SetOrderEventNameOnCreate(AnEvtNm: string);
20    function OrderEventNameOnCreate: string;
21    function GetKeyVars: string;
22    procedure PopKeyVars(NumLevels: Integer = 1);
23    procedure PushKeyVars(const NewVals: string);
24    procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
25    procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
26                var CancelText: string; Sender: TObject);
27    
28    implementation
29    
30    uses
31      dShared, Windows, rTemplates, SysUtils, StdCtrls, fOrders, rOrders;
32    
33    var
34      uOrderEventType: Char;
35      uOrderEventID: Integer;
36      uOrderEventName: string;
37      uOrderFormID: Integer;
38      uFillerAppID: TStringList;
39      uKeyVarList:  TStringList;
40    
41    { Order Checking }
42    
43    function AddFillerAppID(const AnID: string): Boolean;
44    begin
45      Result := False;
46      if uFillerAppID.IndexOf(AnID) < 0 then
47      begin
48        Result := True;
49        uFillerAppID.Add(AnID);
50      end;
51    end;
52    
53    procedure ClearFillerAppList;
54    begin
55      uFillerAppID.Clear;
56    end;
57    
58    { Ordering Environment }
59    
60    procedure SetOrderFormIDOnCreate(AFormID: Integer);
61    begin
62      uOrderFormID := AFormID;
63    end;
64    
65    function OrderFormIDOnCreate: Integer;
66    begin
67      Result := uOrderFormID;
68    end;
69    
70    procedure SetOrderEventTypeOnCreate(AType: Char);
71    begin
72      uOrderEventType := AType;
73    end;
74    
75    function OrderEventTypeOnCreate: Char;
76    begin
77      Result := uOrderEventType;
78    end;
79    
80    procedure SetOrderEventIDOnCreate(AnEvtID: Integer);
81    begin
82      uOrderEventID := AnEvtID;
83    end;
84    
85    procedure SetOrderEventNameOnCreate(AnEvtNm: string);
86    begin
87      uOrderEventName := AnEvtNm;
88    end;
89    
90    function OrderEventNameOnCreate: string;
91    begin
92      Result := uOrderEventName;
93    end;
94    
95    function OrderEventIDOnCreate: integer;
96    begin
97      Result := uOrderEventID;
98    end;
99    
100   function GetKeyVars: string;
101   begin
102     Result := '';
103     with uKeyVarList do if Count > 0 then Result := Strings[Count - 1];
104   end;
105   
106   procedure PopKeyVars(NumLevels: Integer = 1);
107   begin
108     with uKeyVarList do while (NumLevels > 0) and (Count > 0) do
109     begin
110       Delete(Count - 1);
111       Dec(NumLevels);
112     end;
113   end;
114   
115   procedure PushKeyVars(const NewVals: string);
116   var
117     i: Integer;
118     x: string;
119   begin
120     if uKeyVarList.Count > 0 then x := uKeyVarList[uKeyVarList.Count - 1] else x := '';
121     for i := 1 to MAX_KEYVARS do
122       if Piece(NewVals, U, i) <> '' then SetPiece(x, U, i, Piece(NewVals, U, i));
123     uKeyVarList.Add(x);
124   end;
125   
126   procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
127   var
128     ObjList: TStringList;
129     Err: TStringList;
130     i, j, k, oLen: integer;
131     obj, ObjTxt: string;
132   const
133     CRDelim = #13;
134     TC_BOILER_ERR  = 'Order Boilerplate Object Error';
135     TX_BOILER_ERR  = 'Contact IRM and inform them about this error.' + CRLF +
136                      'Make sure you give them the name of the quick' + CRLF +
137                      'order that you are processing.' ;
138   begin
139     ObjList := TStringList.Create;
140     try
141       Err := nil;
142       if(not dmodShared.BoilerplateOK(Txt, CRDelim, ObjList, Err)) and (assigned(Err)) then
143       begin
144         try
145           Err.Add(CRLF + TX_BOILER_ERR);
146           InfoBox(Err.Text, TC_BOILER_ERR, MB_OK + MB_ICONERROR);
147         finally
148           Err.Free;
149         end;
150       end;
151       if(ObjList.Count > 0) then
152       begin
153         ContainsObjects := True;
154         GetTemplateText(ObjList);
155         i := 0;
156         while (i < ObjList.Count) do
157         begin
158           if(pos(ObjMarker, ObjList[i]) = 1) then
159           begin
160             obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
161             if(obj = '') then break;
162             j := i + 1;
163             while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
164               inc(j);
165             if((j - i) > 2) then
166             begin
167               ObjTxt := '';
168               for k := i+1 to j-1 do
169                 ObjTxt := ObjTxt + #13 + ObjList[k];
170             end
171             else
172               ObjTxt := ObjList[i+1];
173             i := j;
174             obj := '|' + obj + '|';
175             oLen := length(obj);
176             repeat
177               j := pos(obj, Txt);
178               if(j > 0) then
179               begin
180                 delete(Txt, j, OLen);
181                 insert(ObjTxt, Txt, j);
182               end;
183             until(j = 0);
184           end
185           else
186             inc(i);
187         end
188       end;
189     finally
190       ObjList.Free;
191     end;
192   end;
193   
194   // Check for diet orders that will be auto-DCd on release because of start/stop overlaps.
195   // Moved here for visibility because it also needs to be checked on an auto-accept order.
196   procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
197               var CancelText: string; Sender: TObject);
198   const
199     TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
200                 'you specify a start date for when the new diet should replace the current' + CRLF +
201                 'diet:' + CRLF + CRLF;
202     TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
203     TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
204     TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
205                       'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
206   
207                       '1. Specify an expiration date/time for this order that will' + CRLF +
208                       '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
209   
210                       '2. Specify a later start date/time for this order for when you' + CRLF +
211                       '   would like it to cancel and replace those other orders.';
212   
213   var
214     i: integer;
215     AStringList: TStringList;
216     AList: TList;
217     x, PtEvtIFN, PtEvtName: string;
218     //AResponse: TResponse;
219   begin
220     if EvtID = 0 then   // check current and future released diets
221     begin
222       x := CurrentText;
223       if Piece(x, #13, 1) <> 'Current Diet:  ' then
224       begin
225         AStringList := TStringList.Create;
226         try
227           AStringList.Text := x;
228           CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
229                    + #9 + Copy(AStringList[0], 16, 99) + CRLF;
230           if AStringList.Count > 1 then
231           begin
232             CancelText := CancelText + CRLF + CRLF +
233                      TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
234                      + #9 + Copy(AStringList[1], 22, 99) + CRLF;
235             if AStringList.Count > 2 then
236             for i := 2 to AStringList.Count - 1 do
237               CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
238           end;
239         finally
240           AStringList.Free;
241         end;
242       end;
243     end 
244     else if Sender is TButton then     // delayed orders code here - on accept only
245     begin
246       //AResponse := Responses.FindResponseByName('STOP', 1);
247       //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
248       AList := TList.Create;
249       try
250         PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
251         PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
252         LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
253         for i := AList.Count - 1 downto 0 do
254         begin
255           if TOrder(Alist.Items[i]).DGroup <> DispGrp then
256           begin
257             TOrder(AList.Items[i]).Free;
258             AList.Delete(i);
259           end;
260         end;
261         if AList.Count > 0 then
262         begin
263           x := '';
264           RetrieveOrderFields(AList, 0, 0);
265           CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName; 
266           for i := 0 to AList.Count - 1 do
267             with TOrder(AList.Items[i]) do
268             begin
269               x := x + #9 + Text + CRLF;
270   (*            if StartTime <> '' then
271                 x := #9 + x + 'Start:   ' + StartTime + CRLF
272               else
273                 x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
274             end;
275           CancelText := CancelText + CRLF + CRLF + x;
276           CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
277         end;
278       finally
279         with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
280         AList.Free;
281       end;
282     end;
283   end;
284   
285   
286   initialization
287     uOrderEventType := #0;
288     uOrderFormID := 0;
289     uOrderEventName := '';
290     uFillerAppID := TStringList.Create;
291     uKeyVarList  := TStringList.Create;
292   
293   finalization
294     uFillerAppID.Free;
295     uKeyVarList.Free;
296   
297   end.

Module Calls (2 levels)


uODBase
 ├uConst
 ├dShared
 │ ├uTemplates
 │ ├fDrawers
 │ ├rTemplates
 │ ├uCore
 │ ├uTemplateFields
 │ └uEventHooks
 ├rTemplates...
 ├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
 └rOrders...

Module Called-By (2 levels)


                     uODBase
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
               fARTAllgy┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                fODBase...┤ 
                rODBase...┤ 
                fOrders...┤ 
           fOrdersRenew...┤ 
                   fODDiet┤ 
              uOrders...┘ │ 
                fODConsult┤ 
              uOrders...┤ │ 
              fOrders...┤ │ 
       fBALocalDiagnoses┘ │ 
                   fODProc┤ 
              uOrders...┘ │ 
                   fODAuto┤ 
              uOrders...┘ │ 
                fOMNavA...┤ 
                 fOMVerify┤ 
              uOrders...┘ │ 
                 fOMSet...┘