Module

fOMSet

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fBase508Form -
fFrame -
fODBase -
fOrders -
rODMeds -
rOrders -
uConst -
uCore -

Units Used in Implementation

Name Comments
fOMNavA -
rMisc -
uODBase -
uOrders -

Classes

Name Comments
TfrmOMSet -
TSetItem -

Procedures

Name Owner Declaration Scope Comments
cmdInteruptClick TfrmOMSet procedure cmdInteruptClick(Sender: TObject); Public/Published -
DoNextItem TfrmOMSet procedure DoNextItem; Private -
FormClose TfrmOMSet procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published Notify remaining owners that their item is done (or - really never completed)
FormCloseQuery TfrmOMSet procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); Public/Published If this is not the last item in the set, prompt whether to interrupt processing
FormCreate TfrmOMSet procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmOMSet procedure FormDestroy(Sender: TObject); Public/Published -
InsertList TfrmOMSet procedure InsertList(SetList: TStringList; AnOwner: TComponent; ARefNum: Integer; const KeyVarStr: string; AnEventType:Char =#0); Public Expects SetList to be strings of DlgIEN^DlgType^DisplayName^OrderableItemIens
SetEventDelay TfrmOMSet procedure SetEventDelay(AnEvent: TOrderDelayEvent); Public -
SkipToNext - procedure SkipToNext; Local -
UMDelayEvent TfrmOMSet procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT; Private -
UMDestroy TfrmOMSet procedure UMDestroy(var Message: TMessage); message UM_DESTROY; Private Received whenever activated item is finished. Posts to Owner if last item in the set.

Functions

Name Owner Declaration Scope Comments
DeaCheckPassed TfrmOMSet function DeaCheckPassed(OIIens: string; APkg: string; AnEventType: Char): string; Private -
IsCreatedByMenu TfrmOMSet function IsCreatedByMenu(ASetItem: TSetItem): boolean; Private -

Global Variables

Name Type Declaration Comments
frmOMSet TfrmOMSet frmOMSet: TfrmOMSet; -

Constants

Name Declaration Scope Comments
TC_STOP 'Interrupt Order Set' Global -
TX_STOP 'Do you want to stop entering the current set of orders?' Global -


Module Source

1     unit fOMSet;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fFrame, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TSetItem = class
12        DialogIEN: Integer;
13        DialogType: Char;
14        OIIEN: string;
15        InPkg: string;
16        OwnedBy: TComponent;
17        RefNum: Integer;
18      end;
19    
20      TfrmOMSet = class(TfrmBase508Form)
21        lstSet: TCheckListBox;
22        cmdInterupt: TButton;
23        procedure cmdInteruptClick(Sender: TObject);
24        procedure FormDestroy(Sender: TObject);
25        procedure FormClose(Sender: TObject; var Action: TCloseAction);
26        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
27        procedure FormCreate(Sender: TObject);
28      private
29        DoingNextItem : Boolean;
30        CloseRequested : Boolean;
31        FDelayEvent: TOrderDelayEvent;
32        FClosing: Boolean;
33        FRefNum: Integer;
34        FActiveMenus: Integer;
35        FClosebyDeaCheck: Boolean;
36        function  IsCreatedByMenu(ASetItem: TSetItem): boolean;
37        function  DeaCheckPassed(OIIens: string; APkg: string; AnEventType: Char): string;
38        procedure DoNextItem;
39        procedure UMDestroy(var Message: TMessage); message UM_DESTROY;
40        procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
41      public
42        procedure InsertList(SetList: TStringList; AnOwner: TComponent; ARefNum: Integer;
43                             const KeyVarStr: string; AnEventType:Char =#0);
44        procedure SetEventDelay(AnEvent: TOrderDelayEvent);
45        property RefNum: Integer read FRefNum write FRefNum;
46      end;
47    
48    var
49      frmOMSet: TfrmOMSet;
50    
51    implementation
52    
53    {$R *.DFM}
54    
55    uses uOrders, fOMNavA, rMisc, uODBase;
56    
57    const
58      TX_STOP = 'Do you want to stop entering the current set of orders?';
59      TC_STOP = 'Interrupt Order Set';
60    
61    procedure TfrmOMSet.SetEventDelay(AnEvent: TOrderDelayEvent);
62    begin
63      FDelayEvent := AnEvent;
64    end;
65    
66    procedure TfrmOMSet.InsertList(SetList: TStringList; AnOwner: TComponent; ARefNum: Integer;
67      const KeyVarStr: string; AnEventType: Char);
68    { expects SetList to be strings of DlgIEN^DlgType^DisplayName^OrderableItemIens }
69    const
70      TXT_DEAFAIL1 = 'Order for controlled substance ';
71      TXT_DEAFAIL2 = CRLF + 'could not be completed. Provider does not have a' + CRLF +
72                     'current, valid DEA# on record and is ineligible' + CRLF + 'to sign the order.';
73      TXT_SCHFAIL  = CRLF + 'could not be completed. Provider is not authorized' + CRLF +
74                     'to prescribe medications in Federal Schedule ';
75      TXT_NO_DETOX = CRLF + 'could not be completed. Provider does not have a' + CRLF +
76                     'valid Detoxification/Maintenance ID number on' + CRLF + 'record and is ineligible to sign the order.';
77      TXT_EXP_DETOX1 = CRLF + 'could not be completed. Provider''s Detoxification/Maintenance' + CRLF +
78                       'ID number expired due to an expired DEA# on ';
79      TXT_EXP_DETOX2 = '.' + CRLF + 'Provider is ineligible to sign the order.';
80      TXT_EXP_DEA1 = CRLF + 'could not be completed. Provider''s DEA# expired on ';
81      TXT_EXP_DEA2 = CRLF + 'and no VA# is assigned. Provider is ineligible to sign the order.';
82      TXT_INSTRUCT = CRLF + CRLF + 'Click RETRY to select another provider.' + CRLF +
83                     'Click CANCEL to cancel the current order process.';
84      TC_DEAFAIL   = 'Order not completed';
85    var
86      i, InsertAt: Integer;
87      SetItem: TSetItem;
88      DEAFailStr, TX_INFO: string;
89    begin
90      InsertAt := lstSet.ItemIndex + 1;
91      with SetList do for i := 0 to Count - 1 do
92      begin
93        SetItem := TSetItem.Create;
94        SetItem.DialogIEN  := StrToIntDef(Piece(SetList[i], U, 1), 0);
95        SetItem.DialogType := CharAt(Piece(SetList[i], U, 2), 1);
96        SetItem.OIIEN      := Piece(SetList[i], U, 4);
97        SetItem.InPkg      := Piece(SetList[i], U, 5);
98        // put the Owner form and reference number in the last item
99        if i = Count - 1 then
100       begin
101         SetItem.OwnedBy := AnOwner;
102         SetItem.RefNum  := ARefNum;
103       end;
104       DEAFailStr := '';
105       DEAFailStr := DeaCheckPassed(SetItem.OIIEN, SetItem.InPkg, AnEventType);
106       case StrToIntDef(Piece(DEAFailStr,U,1),0) of
107         1:  TX_INFO := TXT_DEAFAIL1 + Piece(SetList[i], U, 3) + TXT_DEAFAIL2;  //prescriber has an invalid or no DEA#
108         2:  TX_INFO := TXT_DEAFAIL1 + Piece(SetList[i], U, 3) + TXT_SCHFAIL + Piece(DEAFailStr,U,2) + '.';  //prescriber has no schedule privileges in 2,2N,3,3N,4, or 5
109         3:  TX_INFO := TXT_DEAFAIL1 + Piece(SetList[i], U, 3) + TXT_NO_DETOX;  //prescriber has an invalid or no Detox#
110         4:  TX_INFO := TXT_DEAFAIL1 + Piece(SetList[i], U, 3) + TXT_EXP_DEA1 + Piece(DEAFailStr,U,2) + TXT_EXP_DEA2;  //prescriber's DEA# expired and no VA# is assigned
111         5:  TX_INFO := TXT_DEAFAIL1 + Piece(SetList[i], U, 3) + TXT_EXP_DETOX1 + Piece(DEAFailStr,U,2) + TXT_EXP_DETOX2;  //valid detox#, but expired DEA#
112       end;
113       if StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] then
114         if InfoBox(TX_INFO + TXT_INSTRUCT, TC_DEAFAIL, MB_RETRYCANCEL or MB_ICONERROR) = IDRETRY then
115           begin
116             DEAContext := True;
117             fFrame.frmFrame.mnuFileEncounterClick(Self);
118             DEAFailStr := '';
119             DEAFailStr := DeaCheckPassed(SetItem.OIIEN, SetItem.InPkg, AnEventType);
120             if StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] then Continue
121           end
122         else
123           begin
124             FClosebyDeaCheck := True;
125             Close;
126             Exit;
127           end;
128       lstSet.Items.InsertObject(InsertAt, Piece(SetList[i], U, 3), SetItem);
129       Inc(InsertAt);
130     end;
131     PushKeyVars(KeyVarStr);
132     DoNextItem;
133   end;
134   
135   procedure TfrmOMSet.DoNextItem;
136   var
137     SetItem: TSetItem;
138     theOwner: TComponent;
139     ok: boolean;
140   
141     procedure SkipToNext;
142     begin
143       if FClosing then Exit;
144       lstSet.Checked[lstSet.ItemIndex] := True;
145       DoNextItem;
146     end;
147   
148   begin
149      DoingNextItem := true;
150     //frmFrame.UpdatePtInfoOnRefresh;
151     if FClosing then Exit;
152     if frmOrders <> nil then
153     begin
154      if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
155       and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
156      begin
157        FDelayEvent.EventType := #0;
158        FDelayEvent.EventIFN  := 0;
159        FDelayEvent.TheParent := TParentEvent.Create;
160        FDelayEvent.EventName := '';
161        FDelayEvent.PtEventIFN := 0;
162      end;
163     end;
164     with lstSet do
165     begin
166       if ItemIndex >= Items.Count - 1 then
167       begin
168         Close;
169         Exit;
170       end;
171       ItemIndex := ItemIndex + 1;
172       SetItem := TSetItem(Items.Objects[ItemIndex]);
173       case SetItem.DialogType of
174       'A':      if not ActivateAction(IntToStr(SetItem.DialogIEN), Self, ItemIndex) then
175                 begin
176                   if Not FClosing then
177                   begin
178                     if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
179                       lstSet.Checked[lstSet.ItemIndex] := True
180                     else SkipToNext;
181                   end;
182                 end;
183       'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
184                 begin
185                   if Not FClosing then
186                   begin
187                     if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
188                       lstSet.Checked[lstSet.ItemIndex] := True
189                     else SkipToNext;
190                   end;
191                 end;
192       'M':      begin
193                   ok := ActivateOrderMenu(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex);
194                   if not FClosing then
195                   begin
196                     if ok then
197                       Inc(FActiveMenus)
198                     else
199                     begin
200                       if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
201                         lstSet.Checked[lstSet.ItemIndex] := True
202                       else
203                         SkipToNext;
204                     end;
205                   end;
206                 end;
207       'O':      begin
208                   if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
209                   if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
210                   begin
211                     if Not FClosing then
212                     begin
213                       if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
214                         lstSet.Checked[lstSet.ItemIndex] := True
215                       else SkipToNext;
216                     end;
217                   end;
218                 end;
219       else      begin
220                   InfoBox('Unsupported dialog type: ' + SetItem.DialogType, 'Error', MB_OK);
221                   SkipToNext;
222                 end;
223       end; {case}
224     end; {with lstSet}
225     DoingNextItem := false;
226   end;
227   
228   procedure TfrmOMSet.UMDelayEvent(var Message: TMessage);
229   begin
230     if CloseRequested then
231     begin
232       Close;
233       if Not FClosing then
234         begin
235           CloseRequested := False;
236           FClosing := False;
237           DoNextItem;
238         end
239         else Exit;
240     end;
241     // ignore if delay from other than current itemindex
242     // (prevents completion of an order set from calling DoNextItem)
243     if Message.WParam = lstSet.ItemIndex then
244       if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
245   end;
246   
247   procedure TfrmOMSet.UMDestroy(var Message: TMessage);
248   { Received whenever activated item is finished.  Posts to Owner if last item in the set. }
249   var
250     SetItem: TSetItem;
251     RefNum: Integer;
252   begin
253     RefNum := Message.WParam;
254     lstSet.Checked[RefNum] := True;
255     SetItem := TSetItem(lstSet.Items.Objects[RefNum]);
256     if SetItem.DialogType = 'M' then Dec(FActiveMenus);
257     if (SetItem.OwnedBy <> nil) and (SetItem.DialogType <> 'O') then
258     begin
259       PopKeyVars;
260       if ((lstSet.ItemIndex = lstSet.Count - 1) and (lstSet.Checked[lstSet.ItemIndex] = True)) then Close;
261       if {(SetItem.OwnedBy <> Self) and} (SetItem.OwnedBy is TWinControl) then
262       begin
263         SendMessage(TWinControl(SetItem.OwnedBy).Handle, UM_DESTROY, SetItem.RefNum, 0);
264         //Exit;
265       end;
266     end;
267     // let menu or dialog finish closing before going on to next item in the order set
268     While RefNum <= lstSet.Items.Count - 2 do
269     begin
270       if not (lstSet.Checked[RefNum+1]) then Break
271       else
272       begin
273         RefNum := RefNum + 1;
274         lstSet.ItemIndex := RefNum;
275       end;
276     end;
277     PostMessage(Handle, UM_DELAYEVENT, RefNum, 0);
278   end;
279   
280   procedure TfrmOMSet.FormCreate(Sender: TObject);
281   begin
282     FActiveMenus := 0;
283     FClosing := False;
284     FClosebyDeaCheck := False;
285     NoFresh := True;
286     CloseRequested := false;
287     DoingNextItem := false;
288   end;
289   
290   procedure TfrmOMSet.FormDestroy(Sender: TObject);
291   var
292     i: Integer;
293   begin
294     with lstSet do for i := 0 to Items.Count - 1 do TSetItem(Items.Objects[i]).Free;
295     DestroyingOrderSet;
296   end;
297   
298   procedure TfrmOMSet.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
299   { if this is not the last item in the set, prompt whether to interrupt processing }
300   begin
301    if FClosebyDeaCheck then
302       CanClose := True
303    else if lstSet.ItemIndex < (lstSet.Items.Count - 1)
304      then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES;
305      FClosing := CanClose;
306   end;
307   
308   procedure TfrmOMSet.FormClose(Sender: TObject; var Action: TCloseAction);
309   { Notify remaining owners that their item is done (or - really never completed) }
310   var
311     i: Integer;
312     SetItem: TSetItem;
313   begin
314     // do we need to iterate thru and send messages where OwnedBy <> nil?
315     FClosing := True;
316     for i := 1 to FActiveMenus do PopLastMenu;
317     if lstSet.Items.Count > 0 then
318     begin
319       if lstSet.ItemIndex < 0 then lstSet.ItemIndex := 0;
320       with lstSet do for i := ItemIndex to Items.Count - 1 do
321       begin
322         SetItem := TSetItem(lstSet.Items.Objects[i]);
323         if (SetItem.OwnedBy <> nil) and (SetItem.OwnedBy is TWinControl)
324           then SendMessage(TWinControl(SetItem.OwnedBy).Handle, UM_DESTROY, SetItem.RefNum, 0);
325       end;
326     end;
327     SaveUserBounds(Self);
328     NoFresh := False;
329     Action := caFree;
330   end;
331   
332   procedure TfrmOMSet.cmdInteruptClick(Sender: TObject);
333   begin
334     if DoingNextItem then
335     begin
336       CloseRequested := true;             //Fix for CQ: 8297
337       FClosing := true;
338     end
339     else
340       Close;
341   end;
342   
343   function TfrmOMSet.DeaCheckPassed(OIIens: string; APkg: string; AnEventType: Char): string;
344   var
345     tmpIenList: TStringList;
346     i: integer;
347     InptDlg: boolean;
348     DEAFailstr: string;
349   begin
350     Result := '';
351     InptDlg := False;
352     if Pos('PS',APkg) <> 1 then
353       Exit;
354     if Length(OIIens)=0 then Exit;
355     tmpIenList := TStringList.Create;
356     PiecesToList(OIIens,';',TStrings(tmpIenList));
357     (* case AnEventType of
358     'A','T': isInpt := True;
359     'D': isInpt := False;
360     else isInpt := Patient.Inpatient;
361     end; *)
362     if APkg = 'PSO' then InptDlg := False
363     else if APkg = 'PSJ' then InptDlg := True;
364     for i := 0 to tmpIenList.Count - 1 do
365       begin
366         DEAFailStr := '';
367         DEAFailStr := DEACheckFailed(StrToIntDef(tmpIenList[i],0), InptDlg);
368         if StrToIntDef(Piece(DEAFailStr,U,1),0) in [1..5] then
369         begin
370           Result := DEAFailStr;
371           Break;
372         end;
373       end;
374   end;
375   
376   function TfrmOMSet.IsCreatedByMenu(ASetItem: TSetItem): boolean;
377   begin
378     Result := False;
379     if (AsetItem.OwnedBy <> nil) and (ASetItem.OwnedBy.Name = 'frmOMNavA') then
380       Result := True;
381   end;
382   
383   end.

Module Calls (2 levels)


fOMSet
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├uConst
 ├rODMeds
 │ ├uCore...
 │ └uConst
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders...
 │ ├rODBase
 │ ├uCore...
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore...
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├fOrders...
 ├fFrame...
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uOrders...
 ├rMisc...
 └uODBase...

Module Called-By (2 levels)


                      fOMSet
                   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┘