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