source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersCopy.~pas@ 1075

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 11.5 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOrdersCopy;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz,
9 DKLang;
10
11type
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
45function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean;
46 var DestPtEvtID: integer; var DestPtEvtName: string): Boolean;
47
48var
49 frmCopyOrders: TfrmCopyOrders;
50
51implementation
52{$R *.DFM}
53
54uses fOrders, fOrdersTS, ORFn, rOrders;
55
56function SetViewForCopy(var IsNewEvent: boolean; var DoesDestEvtOccur: boolean;
57 var DestPtEvtID: integer; var DestPtEvtName: string): Boolean;
58var
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
108begin
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;
235end;
236
237procedure TfrmCopyOrders.FormCreate(Sender: TObject);
238begin
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;
254end;
255
256procedure TfrmCopyOrders.cmdOKClick(Sender: TObject);
257begin
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;
273end;
274
275procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject);
276begin
277 inherited;
278 Close;
279end;
280
281procedure TfrmCopyOrders.radEvtDelayClick(Sender: TObject);
282begin
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;
291end;
292
293procedure TfrmCopyOrders.radReleaseClick(Sender: TObject);
294begin
295 inherited;
296 if radEvtDelay.Checked then
297 radEvtDelay.Checked := False;
298 radRelease.Checked := True;
299 fraEvntDelayList.Visible := False;
300 Height := Height - fraEvntDelayList.Height;
301end;
302
303procedure TfrmCopyOrders.fraEvntDelayListcboEvntListChange(
304 Sender: TObject);
305begin
306 inherited;
307 fraEvntDelayList.IsForCpXfer := True;
308 fraEvntDelayList.mlstEventsChange(Sender);
309 if fraEvntDelayList.MatchedCancel then Close
310end;
311
312procedure TfrmCopyOrders.UMStillDelay(var message: TMessage);
313begin
314 CmdOKClick(Application);
315end;
316
317procedure TfrmCopyOrders.fraEvntDelayListmlstEventsDblClick(
318 Sender: TObject);
319begin
320 inherited;
321 if fraEvntDelayList.mlstEvents.ItemID > 0 then
322 cmdOKClick(Self);
323end;
324
325procedure TfrmCopyOrders.fraEvntDelayListmlstEventsChange(Sender: TObject);
326begin
327 fraEvntDelayList.mlstEventsChange(Sender);
328 if fraEvntDelayList.MatchedCancel then
329 begin
330 OKPressed := False;
331 Close;
332 Exit;
333 end;
334end;
335
336procedure TfrmCopyOrders.FormKeyDown(Sender: TObject; var Key: Word;
337 Shift: TShiftState);
338begin
339 if Key = VK_RETURN then
340 cmdOKClick(Self);
341end;
342
343end.
Note: See TracBrowser for help on using the repository browser.