source: cprs/trunk/CPRS-Chart/Orders/fOrdersCopy.pas@ 1028

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

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