source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersCopy.pas@ 1430

Last change on this file since 1430 was 459, checked in by Kevin Toppenberg, 17 years ago

Adding foia-cprs branch
File size: 10.2 KB
RevLine 
[459]1unit fOrdersCopy;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz;
8
9type
10 TfrmCopyOrders = class(TForm)
11 pnlInfo: TPanel;
12 fraEvntDelayList: TfraEvntDelayList;
13 pnlRadio: TPanel;
14 GroupBox1: TGroupBox;
15 radRelease: TRadioButton;
16 radEvtDelay: TRadioButton;
17 Image1: TImage;
18 Label2: TStaticText;
19 Label1: TStaticText;
20 pnlTop: TPanel;
21 lblPtInfo: TStaticText;
22 pnlBtns: TPanel;
23 gbBtns: TGroupBox;
24 cmdOK: TButton;
25 cmdCancel: TButton;
26 procedure cmdOKClick(Sender: TObject);
27 procedure cmdCancelClick(Sender: TObject);
28 procedure FormCreate(Sender: TObject);
29 procedure radEvtDelayClick(Sender: TObject);
30 procedure radReleaseClick(Sender: TObject);
31 procedure fraEvntDelayListcboEvntListChange(Sender: TObject);
32 procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY;
33 procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject);
34 procedure fraEvntDelayListmlstEventsChange(Sender: TObject);
35 procedure FormKeyDown(Sender: TObject; var Key: Word;
36 Shift: TShiftState);
37 private
38 OKPressed: Boolean;
39 public
40 end;
41
42function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean;
43 var DestPtEvtID: integer; var DestPtEvtName: string): Boolean;
44
45var
46 frmCopyOrders: TfrmCopyOrders;
47
48implementation
49{$R *.DFM}
50
51uses fOrders, fOrdersTS, ORFn, rOrders;
52
53function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean;
54 var DestPtEvtID: integer; var DestPtEvtName: string): Boolean;
55var
56 EvtInfo,APtEvtID, AnEvtDlg: string;
57 AnEvent: TOrderDelayEvent;
58 SpeCap, CurrTS: string;
59 ExistedPtEvtID: integer;
60
61 procedure Highlight(APtEvtID: string);
62 var
63 j: integer;
64 begin
65 frmOrders.InitOrderSheetsForEvtDelay;
66 for j := 0 to frmOrders.lstSheets.Items.Count - 1 do
67 begin
68 if Piece(frmOrders.lstSheets.Items[j],'^',1)=APtEvtID then
69 begin
70 frmOrders.lstSheets.ItemIndex := j;
71 break;
72 end;
73 end;
74 end;
75
76 function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
77 var
78 DlgData: string;
79 begin
80 DlgData := GetDlgData(AEvtDlg);
81 frmOrders.NeedShowModal := True;
82 frmOrders.IsDefaultDlg := True;
83 Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
84 frmOrders.IsDefaultDlg := False;
85 frmOrders.NeedShowModal := False;
86 end;
87
88 function FindMatchedPtEvtID(EventName: string): integer;
89 var
90 cnt: integer;
91 viewName: string;
92 begin
93 Result := 0;
94 for cnt := 0 to frmOrders.lstSheets.Items.Count - 1 do
95 begin
96 viewName := Piece(frmOrders.lstSheets.Items[cnt],'^',2);
97 if AnsiCompareText(EventName,viewName)=0 then
98 begin
99 Result := StrToIntDef(Piece(frmOrders.lstSheets.Items[cnt],'^',1),0);
100 break;
101 end;
102 end;
103 end;
104
105begin
106 Result := False;
107 AnEvent.EventType := #0;
108 AnEvent.EventIFN := 0;
109 AnEvent.EventName := '';
110 AnEvent.Specialty := 0;
111 AnEvent.Effective := 0;
112 AnEvent.PtEventIFN := 0;
113 AnEvent.TheParent := TParentEvent.Create;
114 AnEvent.IsNewEvent := False;
115
116 frmCopyOrders := TfrmCopyOrders.Create(Application);
117 try
118 ResizeFormToFont(TForm(frmCopyOrders));
119 CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
120 if Length(CurrTS)>0 then
121 SpeCap := #13 + 'The current treating specialty is ' + CurrTS
122 else
123 SpeCap := #13 + 'No treating specialty is available.';
124 //ResizeFormToFont(TForm(frmCopyOrders));
125 if Patient.Inpatient then
126 frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
127 else
128 begin
129 if (Encounter.Location > 0) then
130 frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap
131 else
132 frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap;
133 end;
134 frmCopyOrders.ShowModal;
135 if (frmCopyOrders.OKPressed) and (frmCopyOrders.radRelease.Checked) then
136 begin
137 frmOrders.lstSheets.ItemIndex := 0;
138 frmOrders.lstSheetsClick(Nil);
139 Result := True;
140 end;
141 if (frmCopyOrders.OKPressed) and (frmCopyOrders.radEvtDelay.Checked) then
142 begin
143 EvtInfo := frmCopyOrders.fraEvntDelayList.mlstEvents.Items[frmCopyOrders.fraEvntDelayList.mlstEvents.ItemIndex];
144 AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
145 AnEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0);
146 if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
147 begin
148 AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
149 AnEvent.EventType := AnEvent.TheParent.ParentType;
150 end;
151 AnEvent.EventName := frmCopyOrders.fraEvntDelayList.mlstEvents.DisplayText[frmCopyOrders.fraEvntDelayList.mlstEvents.ItemIndex];
152 AnEvent.Specialty := 0;
153 if frmCopyOrders.fraEvntDelayList.orDateBox.Visible then
154 AnEvent.Effective := frmCopyOrders.fraEvntDelayList.orDateBox.FMDateTime
155 else
156 AnEvent.Effective := 0;
157 ExistedPtEvtID := FindMatchedPtEvtID('Delayed ' + AnEvent.EventName + ' Orders');
158 if (ExistedPtEvtId>0) and IsCompletedPtEvt(ExistedPtEvtId) then
159 begin
160 DoesDestEvtOccur := True;
161 DestPtEvtId := ExistedPtEvtId;
162 DestPtEvtName := AnEvent.EventName;
163 IsNewEvent := False;
164 Result := True;
165 Exit;
166 end;
167 IsNewEvent := False;
168 if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 then
169 begin
170 IsNewEvent := True;
171 if AnEvent.TheParent.ParentIFN > 0 then
172 begin
173 if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
174 AnEvtDlg := AnEvent.TheParent.ParentDlg;
175 end
176 else
177 AnEvtDlg := Piece(EvtInfo,'^',5);
178 end;
179 if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
180 if not DisplayEvntDialog(AnEvtDlg, AnEvent) then
181 begin
182 frmOrders.lstSheets.ItemIndex := 0;
183 frmOrders.lstSheetsClick(nil);
184 Result := False;
185 Exit;
186 end;
187 if not isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), APtEvtID) then
188 begin
189 IsNewEvent := True;
190 if (AnEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0) then
191 SaveEvtForOrder(Patient.DFN,AnEvent.TheParent.ParentIFN,'');
192 SaveEvtForOrder(Patient.DFN,AnEvent.EventIFN,'');
193 if isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN),APtEvtID) then
194 begin
195 Highlight(APtEvtID);
196 AnEvent.IsNewEvent := False;
197 AnEvent.PtEventIFN := StrToIntDef(APtEvtID,0);
198 end;
199 end else
200 begin
201 Highlight(APtEvtID);
202 AnEvent.PtEventIFN := StrToIntDef(APtEvtID,0);
203 AnEvent.IsNewEvent := False;
204 end;
205 DestPtEvtId := AnEvent.PtEventIFN;
206 DestPtEvtName := AnEvent.EventName;
207 if (AnEvent.PtEventIFN >0) and IsCompletedPtEvt(AnEvent.PtEventIFN) then
208 begin
209 DoesDestEvtOccur := True;
210 IsNewEvent := False;
211 Result := True;
212 Exit;
213 end;
214 if frmOrders.lstSheets.ItemIndex > -1 then
215 begin
216 frmOrders.AskForCancel := False;
217 frmOrders.lstSheetsClick(nil);
218 frmOrders.AskForCancel := True;
219 end;
220 Result := True;
221 end;
222 finally
223 frmCopyOrders.fraEvntDelayList.ResetProperty;
224 frmCopyOrders.Release;
225 end;
226end;
227
228procedure TfrmCopyOrders.FormCreate(Sender: TObject);
229begin
230 inherited;
231 radRelease.Checked := True;
232 OKPressed := False;
233 if not Patient.Inpatient then
234 begin
235 pnlInfo.Visible := False;
236 pnlBtns.Top := pnlRadio.Top;
237 end;
238 if not radEvtDelay.Checked then
239 begin
240 if not pnlInfo.Visible then
241 Height := Height - fraEvntDelayList.Height - pnlInfo.Height
242 else
243 Height := Height - fraEvntDelayList.Height;
244 end;
245end;
246
247procedure TfrmCopyOrders.cmdOKClick(Sender: TObject);
248begin
249 inherited;
250 if (radEvtDelay.Checked) and (fraEvntDelayList.mlstEvents.ItemIndex < 0 ) then
251 begin
252 InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
253 Exit;
254 end;
255 if radRelease.Checked then
256 begin
257 ImmdCopyAct := True;
258 frmOrders.lstSheets.ItemIndex := 0;
259 frmOrders.lstSheetsClick(Self);
260 end;
261 OKPressed := True;
262 Close;
263end;
264
265procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject);
266begin
267 inherited;
268 Close;
269end;
270
271procedure TfrmCopyOrders.radEvtDelayClick(Sender: TObject);
272begin
273 inherited;
274 if radRelease.Checked then
275 radRelease.Checked := False;
276 radEvtDelay.Checked := True;
277 Height := Height + fraEvntDelayList.Height;
278 fraEvntDelayList.Visible := True;
279 frmCopyOrders.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
280 fraEvntDelayList.DisplayEvntDelayList;
281end;
282
283procedure TfrmCopyOrders.radReleaseClick(Sender: TObject);
284begin
285 inherited;
286 if radEvtDelay.Checked then
287 radEvtDelay.Checked := False;
288 radRelease.Checked := True;
289 fraEvntDelayList.Visible := False;
290 Height := Height - fraEvntDelayList.Height;
291end;
292
293procedure TfrmCopyOrders.fraEvntDelayListcboEvntListChange(
294 Sender: TObject);
295begin
296 inherited;
297 fraEvntDelayList.IsForCpXfer := True;
298 fraEvntDelayList.mlstEventsChange(Sender);
299 if fraEvntDelayList.MatchedCancel then Close
300end;
301
302procedure TfrmCopyOrders.UMStillDelay(var message: TMessage);
303begin
304 CmdOKClick(Application);
305end;
306
307procedure TfrmCopyOrders.fraEvntDelayListmlstEventsDblClick(
308 Sender: TObject);
309begin
310 inherited;
311 if fraEvntDelayList.mlstEvents.ItemID > 0 then
312 cmdOKClick(Self);
313end;
314
315procedure TfrmCopyOrders.fraEvntDelayListmlstEventsChange(Sender: TObject);
316begin
317 fraEvntDelayList.mlstEventsChange(Sender);
318 if fraEvntDelayList.MatchedCancel then
319 begin
320 OKPressed := False;
321 Close;
322 Exit;
323 end;
324end;
325
326procedure TfrmCopyOrders.FormKeyDown(Sender: TObject; var Key: Word;
327 Shift: TShiftState);
328begin
329 if Key = VK_RETURN then
330 cmdOKClick(Self);
331end;
332
333end.
Note: See TracBrowser for help on using the repository browser.