source: cprs/trunk/CPRS-Chart/Orders/fOMSet.pas@ 730

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 10.0 KB
RevLine 
[456]1unit fOMSet;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe;
8
9type
10 TSetItem = class
11 DialogIEN: Integer;
12 DialogType: Char;
13 OIIEN: string;
14 InPkg: string;
15 OwnedBy: TComponent;
16 RefNum: Integer;
17 end;
18
19 TfrmOMSet = class(TForm)
20 lstSet: TCheckListBox;
21 cmdInterupt: TButton;
22 procedure cmdInteruptClick(Sender: TObject);
23 procedure FormDestroy(Sender: TObject);
24 procedure FormClose(Sender: TObject; var Action: TCloseAction);
25 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
26 procedure FormCreate(Sender: TObject);
27 private
28 DoingNextItem : Boolean;
29 CloseRequested : Boolean;
30 FDelayEvent: TOrderDelayEvent;
31 FClosing: Boolean;
32 FRefNum: Integer;
33 FActiveMenus: Integer;
34 FClosebyDeaCheck: Boolean;
35 function IsCreatedByMenu(ASetItem: TSetItem): boolean;
36 function DeaCheckPassed(OIIens: string; APkg: string; AnEventType: Char): boolean;
37 procedure DoNextItem;
38 procedure UMDestroy(var Message: TMessage); message UM_DESTROY;
39 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
40 public
41 procedure InsertList(SetList: TStringList; AnOwner: TComponent; ARefNum: Integer;
42 const KeyVarStr: string; AnEventType:Char =#0);
43 procedure SetEventDelay(AnEvent: TOrderDelayEvent);
44 property RefNum: Integer read FRefNum write FRefNum;
45 end;
46
47var
48 frmOMSet: TfrmOMSet;
49
50implementation
51
52{$R *.DFM}
53
54uses uOrders, fOMNavA, rMisc, uODBase;
55
56const
57 TX_STOP = 'Do you want to stop entering the current set of orders?';
58 TC_STOP = 'Interrupt Order Set';
59
60procedure TfrmOMSet.SetEventDelay(AnEvent: TOrderDelayEvent);
61begin
62 FDelayEvent := AnEvent;
63end;
64
65procedure TfrmOMSet.InsertList(SetList: TStringList; AnOwner: TComponent; ARefNum: Integer;
66 const KeyVarStr: string; AnEventType: Char);
67{ expects SetList to be strings of DlgIEN^DlgType^DisplayName^OrderableItemIens }
68const
69 TXT_DEAFAIL = 'You need have #DEA key to place the order ';
70 TXT_INSTRUCT = #13 + 'Click OK to continue, Click Cancel to terminate the current order process.';
71var
72 i, InsertAt: Integer;
73 SetItem: TSetItem;
74begin
75 InsertAt := lstSet.ItemIndex + 1;
76 with SetList do for i := 0 to Count - 1 do
77 begin
78 SetItem := TSetItem.Create;
79 SetItem.DialogIEN := StrToIntDef(Piece(SetList[i], U, 1), 0);
80 SetItem.DialogType := CharAt(Piece(SetList[i], U, 2), 1);
81 SetItem.OIIEN := Piece(SetList[i], U, 4);
82 SetItem.InPkg := Piece(SetList[i], U, 5);
83 // put the Owner form and reference number in the last item
84 if i = Count - 1 then
85 begin
86 SetItem.OwnedBy := AnOwner;
87 SetItem.RefNum := ARefNum;
88 end;
89 if not DeaCheckPassed(SetItem.OIIEN, SetItem.InPkg, AnEventType) then
90 if InfoBox(TXT_DEAFAIL + Piece(SetList[i], U, 3) + TXT_INSTRUCT,
91 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then
92 Continue
93 else
94 begin
95 FClosebyDeaCheck := True;
96 Close;
97 Exit;
98 end;
99 lstSet.Items.InsertObject(InsertAt, Piece(SetList[i], U, 3), SetItem);
100 Inc(InsertAt);
101 end;
102 PushKeyVars(KeyVarStr);
103 DoNextItem;
104end;
105
106procedure TfrmOMSet.DoNextItem;
107var
108 SetItem: TSetItem;
109 theOwner: TComponent;
110
111 procedure SkipToNext;
112 begin
113 lstSet.Checked[lstSet.ItemIndex] := True;
114 DoNextItem;
115 end;
116
117begin
118 DoingNextItem := true;
119 //frmFrame.UpdatePtInfoOnRefresh;
120 if FClosing then Exit;
121 if frmOrders <> nil then
122 begin
123 if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
124 and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
125 begin
126 FDelayEvent.EventType := #0;
127 FDelayEvent.EventIFN := 0;
128 FDelayEvent.TheParent := TParentEvent.Create;
129 FDelayEvent.EventName := '';
130 FDelayEvent.PtEventIFN := 0;
131 end;
132 end;
133 with lstSet do
134 begin
135 if ItemIndex >= Items.Count - 1 then
136 begin
137 Close;
138 Exit;
139 end;
140 ItemIndex := ItemIndex + 1;
141 SetItem := TSetItem(Items.Objects[ItemIndex]);
142 case SetItem.DialogType of
143 'A': if not ActivateAction(IntToStr(SetItem.DialogIEN), Self, ItemIndex) then
144 begin
145 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
146 lstSet.Checked[lstSet.ItemIndex] := True
147 else SkipToNext;
148 end;
149 'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
150 begin
151 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
152 lstSet.Checked[lstSet.ItemIndex] := True
153 else SkipToNext;
154 end;
155 'M': if ActivateOrderMenu( IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)
156 then Inc(FActiveMenus)
157 else
158 begin
159 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
160 lstSet.Checked[lstSet.ItemIndex] := True
161 else
162 SkipToNext;
163 end;
164 'O': begin
165 if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
166 if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
167 begin
168 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
169 lstSet.Checked[lstSet.ItemIndex] := True
170 else SkipToNext;
171 end;
172 end;
173 else begin
174 InfoBox('Unsupported dialog type: ' + SetItem.DialogType, 'Error', MB_OK);
175 SkipToNext;
176 end;
177 end; {case}
178 end; {with lstSet}
179 DoingNextItem := false;
180end;
181
182procedure TfrmOMSet.UMDelayEvent(var Message: TMessage);
183begin
184 // ignore if delay from other than current itemindex
185 // (prevents completion of an order set from calling DoNextItem)
186 if Message.WParam = lstSet.ItemIndex then
187 if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
188 if CloseRequested then
189 Close;
190end;
191
192procedure TfrmOMSet.UMDestroy(var Message: TMessage);
193{ Received whenever activated item is finished. Posts to Owner if last item in the set. }
194var
195 SetItem: TSetItem;
196 RefNum: Integer;
197begin
198 RefNum := Message.WParam;
199 lstSet.Checked[RefNum] := True;
200 SetItem := TSetItem(lstSet.Items.Objects[RefNum]);
201 if SetItem.DialogType = 'M' then Dec(FActiveMenus);
202 if (SetItem.OwnedBy <> nil) and (SetItem.DialogType <> 'O') then
203 begin
204 PopKeyVars;
205 if ((lstSet.ItemIndex = lstSet.Count - 1) and (lstSet.Checked[lstSet.ItemIndex] = True)) then Close;
206 if {(SetItem.OwnedBy <> Self) and} (SetItem.OwnedBy is TWinControl) then
207 begin
208 SendMessage(TWinControl(SetItem.OwnedBy).Handle, UM_DESTROY, SetItem.RefNum, 0);
209 //Exit;
210 end;
211 end;
212 // let menu or dialog finish closing before going on to next item in the order set
213 While RefNum <= lstSet.Items.Count - 2 do
214 begin
215 if not (lstSet.Checked[RefNum+1]) then Break
216 else
217 begin
218 RefNum := RefNum + 1;
219 lstSet.ItemIndex := RefNum;
220 end;
221 end;
222 PostMessage(Handle, UM_DELAYEVENT, RefNum, 0);
223end;
224
225procedure TfrmOMSet.FormCreate(Sender: TObject);
226begin
227 FActiveMenus := 0;
228 FClosing := False;
229 FClosebyDeaCheck := False;
230 NoFresh := True;
231 CloseRequested := false;
232 DoingNextItem := false;
233end;
234
235procedure TfrmOMSet.FormDestroy(Sender: TObject);
236var
237 i: Integer;
238begin
239 with lstSet do for i := 0 to Items.Count - 1 do TSetItem(Items.Objects[i]).Free;
240 DestroyingOrderSet;
241end;
242
243procedure TfrmOMSet.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
244{ if this is not the last item in the set, prompt whether to interrupt processing }
245begin
246 if FClosebyDeaCheck then
247 CanClose := True
248 else if lstSet.ItemIndex < (lstSet.Items.Count - 1)
249 then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES;
250end;
251
252procedure TfrmOMSet.FormClose(Sender: TObject; var Action: TCloseAction);
253{ Notify remaining owners that their item is done (or - really never completed) }
254var
255 i: Integer;
256 SetItem: TSetItem;
257begin
258 // do we need to iterate thru and send messages where OwnedBy <> nil?
259 FClosing := True;
260 for i := 1 to FActiveMenus do PopLastMenu;
261 if lstSet.Items.Count > 0 then
262 begin
263 if lstSet.ItemIndex < 0 then lstSet.ItemIndex := 0;
264 with lstSet do for i := ItemIndex to Items.Count - 1 do
265 begin
266 SetItem := TSetItem(lstSet.Items.Objects[i]);
267 if (SetItem.OwnedBy <> nil) and (SetItem.OwnedBy is TWinControl)
268 then SendMessage(TWinControl(SetItem.OwnedBy).Handle, UM_DESTROY, SetItem.RefNum, 0);
269 end;
270 end;
271 SaveUserBounds(Self);
272 NoFresh := False;
273 Action := caFree;
274end;
275
276procedure TfrmOMSet.cmdInteruptClick(Sender: TObject);
277begin
278 if DoingNextItem then
279 CloseRequested := true //Fix for CQ: 8297
280 else
281 Close;
282end;
283
284function TfrmOMSet.DeaCheckPassed(OIIens: string; APkg: string; AnEventType: Char): boolean;
285var
286 tmpIenList: TStringList;
287 i: integer;
288 isInpt: boolean;
289begin
290 Result := True;
291 if Pos('PS',APkg) <> 1 then
292 Exit;
293 if Length(OIIens)=0 then Exit;
294 tmpIenList := TStringList.Create;
295 PiecesToList(OIIens,';',TStrings(tmpIenList));
296 case AnEventType of
297 'A','T': isInpt := True;
298 'D': isInpt := False;
299 else isInpt := Patient.Inpatient;
300 end;
301 for i := 0 to tmpIenList.Count - 1 do
302 if DEACheckFailed(StrToIntDef(tmpIenList[i],0), isInpt) then
303 begin
304 Result := False;
305 Break;
306 end;
307end;
308
309function TfrmOMSet.IsCreatedByMenu(ASetItem: TSetItem): boolean;
310begin
311 Result := False;
312 if (AsetItem.OwnedBy <> nil) and (ASetItem.OwnedBy.Name = 'frmOMNavA') then
313 Result := True;
314end;
315
316end.
Note: See TracBrowser for help on using the repository browser.