close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/Orders/fOMSet.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

Last change on this file since 908 was 829, checked in by Kevin Toppenberg, 14 years ago

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