source: cprs/trunk/CPRS-Chart/fPrintLocation.pas@ 924

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

Upgrading to version 27
File size: 19.2 KB
RevLine 
[830]1unit fPrintLocation;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fAutoSz, StdCtrls, ExtCtrls, ORCtrls,ORFn, rCore, uCore, oRNet, Math, fOrders, ORClasses, rOrders,
8 fMeds, rMeds, CheckLst, Grids, fFrame, fClinicWardMeds,
9 VA508AccessibilityManager;
10
11type
12 TfrmPrintLocation = class(TfrmAutoSz)
13 pnlTop: TPanel;
14 pnlBottom: TORAutoPanel;
15 orderGrid: TStringGrid;
16 pnlOrder: TPanel;
17 btnOK: TButton;
18 lblText: TLabel;
19 btnClinic: TButton;
20 btnWard: TButton;
21 lblEncounter: TLabel;
22 cbolocation: TORComboBox;
23 ORpnlBottom: TORAutoPanel;
24 orpnlTopBottom: TORAutoPanel;
25 cboEncLoc: TComboBox;
26 procedure pnlFieldsResize(Sender: TObject);
27 //procedure FormCreate(Sender: TObject);
28 procedure orderGridMouseDown(Sender: TObject; Button: TMouseButton;
29 Shift: TShiftState; X, Y: Integer);
30 procedure OrderGridDrawCell(Sender: TObject; ACol, ARow: Integer;
31 Rect: TRect; State: TGridDrawState);
32 procedure orderGridKeyPress(Sender: TObject; var Key: Char);
33 procedure btnClinicClick(Sender: TObject);
34 procedure btnWardClick(Sender: TObject);
35 procedure cbolocationChange(Sender: TObject);
36 procedure cbolocationExit(Sender: TObject);
37 procedure btnOKClick(Sender: TObject);
38 procedure FormResize(Sender: TObject);
39 procedure FormClose(Sender: TObject; var Action: TCloseAction);
40 private
41 { Private declarations }
42 function ValFor(FieldID, ARow: Integer): string;
43 procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
44 procedure ProcessClinicOrders(WardList, ClinicList: TStringList; WardIEN, ClinicIEN: integer; ContainsIMO: boolean);
45 procedure rpcChangeOrderLocation(pOrderList:TStringList; ContainsIMO: boolean);
46 public
47 { Public declarations }
48 CLoc,WLoc: string;
49 CloseOK: boolean;
50 DisplayOrders: boolean;
51 procedure PrintLocation(OrderLst: TStringList; pEncounterLoc: integer; pEncounterLocName, pEncounterLocText: string;
52 pEncounterDT: TFMDateTime; pEncounterVC: Char; var ClinicLst, WardLst: TStringList;
53 var wardIEN: integer; var wardLocation: string; ContainsIMOOrders: boolean; displayEncSwitch: boolean = false);
54 procedure SwitchEncounterLoction(pEncounterLoc: integer; pEncounterLocName, pEncounterLocText: string; pEncounterDT: TFMDateTime; pEncounterVC: Char);
55 end;
56
57var
58 frmPrintLocation: TfrmPrintLocation;
59 ClinicIEN, WardIen: integer;
60 ASvc, ClinicLocation, WardLocation: string;
61 ClinicArr: TStringList;
62 WardArr: TStringList;
63
64implementation
65
66{$R *.dfm}
67//uses
68//fFrame;
69
70Const
71COL_ORDERINFO = 0;
72COL_ORDERTEXT = 1;
73COL_LOCATION = 2;
74TAB = #9;
75 LOCATION_CHANGE_1 = 'This patient is currently admitted to ward';
76 LOCATION_CHANGE_2 = 'These orders are written at clinic';
77 LOCATION_CHANGE_3 = 'What Location are these orders associated with?';
78 LOCATION_CHANGE_4 = 'The encounter location is currently at clinic';
79
80
81{ TfrmPrintLocation }
82
83
84
85procedure TfrmPrintLocation.btnClinicClick(Sender: TObject);
86var
87i: integer;
88begin
89 inherited;
90 for i := 1 to self.orderGrid.RowCount do
91 begin
92 self.orderGrid.Cells[COL_LOCATION,i] := frmPrintLocation.CLoc;
93 end;
94end;
95
96procedure TfrmPrintLocation.btnOKClick(Sender: TObject);
97var
98i: integer;
99Action: TCloseAction;
100begin
101if ClinicArr = nil then ClinicArr := TStringList.Create;
102if WardArr = nil then wardArr := TStringList.Create;
103 if (frmPrintLocation.cboEncLoc.Enabled = true) and (frmPrintLocation.cboEncLoc.ItemIndex = -1) then
104 begin
105 infoBox('A location must be selected to continue processing patient data', 'Warning', MB_OK);
106 exit;
107 end;
108if frmPrintLocation.DisplayOrders = true then
109 begin
110 for i := 1 to self.orderGrid.RowCount-1 do
111 begin
112 if ValFor(COL_LOCATION, i) = '' then
113 begin
114 infoBox('Every order must have a location define.','Location error', MB_OK);
115 exit;
116 end;
117 if ValFor(COL_LOCATION, i) = frmPrintLocation.CLoc then ClinicArr.Add(ValFor(COL_ORDERINFO, i))
118 else if ValFor(COL_LOCATION, i) = frmPrintLocation.WLoc then WardArr.Add(ValFor(COL_ORDERINFO, i));
119 end;
120 end;
121 CloseOK := True;
122 Action := caFree;
123 frmPrintLocation.FormClose(frmPrintLocation, Action);
124 if Action = caFree then frmPrintLocation.Close;
125end;
126
127procedure TfrmPrintLocation.btnWardClick(Sender: TObject);
128var
129i: integer;
130begin
131 inherited;
132 for i := 1 to self.orderGrid.RowCount do
133 begin
134 self.orderGrid.Cells[COL_LOCATION,i] := frmPrintLocation.WLoc;
135 end;
136end;
137
138procedure TfrmPrintLocation.cbolocationChange(Sender: TObject);
139begin
140self.orderGrid.Cells[COL_LOCATION, self.orderGrid.Row] := self.cbolocation.Text;
141end;
142
143procedure TfrmPrintLocation.cbolocationExit(Sender: TObject);
144begin
145cboLocation.Hide;
146end;
147
148procedure TfrmPrintLocation.FormClose(Sender: TObject;
149 var Action: TCloseAction);
150var
151i :Integer;
152//Action1: TCloseAction;
153begin
154 inherited;
155 if not CloseOK then
156 begin
157 if ClinicArr = nil then ClinicArr := TStringList.Create;
158 if WardArr = nil then wardArr := TStringList.Create;
159 if (frmPrintLocation.cboEncLoc.Enabled = true) and (frmPrintLocation.cboEncLoc.ItemIndex = -1) then
160 begin
161 infoBox('A location must be selected to continue processing patient data', 'Warning', MB_OK);
162 Action := caNone;
163 exit;
164 end;
165 for i := 1 to self.orderGrid.RowCount-1 do
166 begin
167 if ValFor(COL_LOCATION, i) = '' then
168 begin
169 infoBox('Every order must have a location define.','Location error', MB_OK);
170 Action := caNone;
171 exit;
172 end;
173 if ValFor(COL_LOCATION, i) = frmPrintLocation.CLoc then ClinicArr.Add(ValFor(COL_ORDERINFO, i))
174 else if ValFor(COL_LOCATION, i) = frmPrintLocation.WLoc then WardArr.Add(ValFor(COL_ORDERINFO, i));
175 end;
176 CloseOK := True;
177 end;
178 Action := caFree;
179end;
180
181procedure TfrmPrintLocation.FormResize(Sender: TObject);
182begin
183 inherited;
184 pnlFieldsResize(Sender)
185end;
186
187(*procedure TfrmPrintLocation.FormCreate(Sender: TObject);
188var
189 ListCount: Integer;
190 x: string;
191begin
192 inherited;
193 with OrderGrid do
194 begin
195 ColWidths[0] := 8;
196 ColWidths[1] := 50;
197 ColWidths[2] := 50;
198 Cells[1,0] := 'Order';
199 Cells[2,0] := 'Location';
200 end;
201 //TAccessibleStringGrid.WrapControl(OrderGrid);
202
203end; *)
204
205procedure TfrmPrintLocation.OrderGridDrawCell(Sender: TObject; ACol,
206 ARow: Integer; Rect: TRect; State: TGridDrawState);
207begin
208 inherited;
209 OrderGrid.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
210 Piece(OrderGrid.Cells[ACol, ARow], TAB, 1));
211end;
212
213procedure TfrmPrintLocation.orderGridKeyPress(Sender: TObject; var Key: Char);
214begin
215 inherited;
216 if Key in [#32..#127] then ShowEditor(OrderGrid.Col, OrderGrid.Row, Key);
217end;
218
219procedure TfrmPrintLocation.orderGridMouseDown(Sender: TObject;
220 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
221var
222 ACol, ARow: Integer;
223begin
224 inherited;
225 OrderGrid.MouseToCell(X, Y, ACol, ARow);
226 if (ARow < 0) or (ACol < 0) then Exit;
227 if ACol > COL_ORDERINFO then ShowEditor(ACol, ARow, #0) else
228 begin
229 OrderGrid.Col := COL_ORDERTEXT;
230 OrderGrid.Row := ARow;
231 end;
232 //if OrderGrid.Col <> COL_ORDERTEXT then
233 //DropLastSequence;
234end;
235
236
237procedure TfrmPrintLocation.pnlFieldsResize(Sender: TObject);
238Const
239 REL_ORDER = 0.85;
240 REL_LOCATION = 0.15;
241var
242 i, center, diff, ht, RowCountShowing: Integer;
243 ColControl: TWinControl;
244begin
245 inherited;
246 if frmPrintLocation = nil then exit;
247 with frmPrintLocation do
248 begin
249 if (frmPrintLocation.WLoc = '') and (frmPrintLocation.CLoc = '') then exit;
250 lblText.Caption := LOCATION_CHANGE_1 + ': ' + frmPrintLocation.WLoc + CRLF;
251 if frmPrintLocation.DisplayOrders = false then
252 begin
253 lblText.Caption := lblText.Caption + LOCATION_CHANGE_4 + ': ' + frmPrintLocation.CLoc + CRLF;
254 btnClinic.Visible := false;
255 btnWard.Visible := false;
256 pnlTop.Height := lbltext.Top + lbltext.Height * 2;
257 pnlbottom.Top := pnltop.Top + pnltop.Height + 3;
258 ordergrid.Height := 1;
259 pnlBottom.Height := 1;
260 lblEncounter.Top := pnlBottom.Top + pnlBottom.Height;
261 cboEncLoc.Top := lblEncounter.Top;
262 cboEncLoc.Left := lblEncounter.Left + lblEncounter.Width + 4;
263 orpnlBottom.Top := cboEncLoc.Top + cboEncLoc.Height +10;
264 end
265 else
266 begin
267 lblText.Caption := lblText.Caption + LOCATION_CHANGE_2 + ': ' + frmPrintLocation.CLoc + CRLF + CRLF;
268 lblText.Caption := lblText.Caption + LOCATION_CHANGE_3;
269 lblText.Caption := lblText.Caption + CRLF + 'One clinic location allowed; ' + frmPrintLocation.CLoc + ' will be used';
270 btnClinic.Caption := 'All ' + frmPrintLocation.CLoc;
271 btnWard.Caption := 'All ' + frmPrintLocation.WLoc;
272 btnClinic.Width := TextWidthByFont(btnClinic.Handle, btnClinic.Caption);
273 btnWard.Width := TextWidthByFont(btnWard.Handle, btnWard.Caption);
274 center := frmPrintLocation.Width div 2;
275 btnClinic.Left := center - (btnClinic.Width + 3);
276 btnWard.Left := center + 3;
277 end;
278 if pnlTop.Width > width then
279 begin
280 pnltop.Width := width - 8;
281 orpnlTopBottom.Width := pnltop.Width;
282 end;
283 if orpnlTopBottom.Width > pnltop.Width then orpnlTopBottom.Width := pnltop.Width;
284
285 if pnlBottom.Width > width then
286 begin
287 pnlBottom.Width := width - 8;
288 ordergrid.Width := pnlBottom.Width - 2;
289 end;
290 if orderGrid.Width > pnlBottom.Width then orderGrid.Width := pnlBottom.Width - 2;
291 if frmPrintLocation.DisplayOrders = true then
292 begin
293 i := OrderGrid.Width - 12;
294 i := i - GetSystemMetrics(SM_CXVSCROLL);
295 orderGrid.ColWidths[0] := 0;
296 orderGrid.ColWidths[1] := Round(REL_ORDER * i);
297 orderGrid.ColWidths[2] := Round(REL_LOCATION * i);
298 orderGrid.Cells[1,0] := 'Order';
299 orderGrid.Cells[2,0] := 'Location';
300 cboEncLoc.Left := lblEncounter.Left + lblEncounter.Width + 4;
301 ht := pnlBottom.Top - orderGrid.Top - 6;
302 ht := ht div (orderGrid.DefaultRowHeight+1);
303 ht := ht * (orderGrid.DefaultRowHeight+1);
304 Inc(ht, 3);
305 OrderGrid.Height := ht;
306 ColControl := nil;
307 Case OrderGrid.Col of
308 COL_ORDERTEXT:ColCOntrol := pnlOrder;
309 COL_LOCATION:ColControl := cboLocation;
310 End;
311 if assigned(ColControl) and ColControl.Showing then
312 begin
313 RowCountShowing := (Height - 25) div (orderGrid.defaultRowHeight+1);
314 if (OrderGrid.Row <= RowCountShowing) then
315 ShowEditor(OrderGrid.Col, orderGrid.Row, #0)
316 else
317 ColControl.Hide;
318 end;
319 end;
320 diff := frmPrintLocation.btnOK.top;
321 //diff := (frmPrintLocation.ORpnlBottom.Top + frmPrintlocation.btnOK.Top) - frmPrintLocation.ORpnlBottom.Top;
322 frmPrintLocation.ORpnlBottom.Height := frmPrintLocation.btnOK.Top + frmPrintLocation.btnOK.Height + diff;
323 frmprintLocation.Height := frmprintLocation.orpnlBottom.Top + frmprintLocation.orpnlBottom.Height + 25;
324 end;
325end;
326
327
328procedure TfrmPrintLocation.PrintLocation(OrderLst: TStringList; pEncounterLoc:integer; pEncounterLocName,
329 pEncounterLocText: string; pEncounterDT: TFMDateTime; pEncounterVC: Char;
330 var ClinicLst, WardLst: TStringList; var wardIEN: integer; var wardLocation: string;
331 ContainsIMOOrders: boolean; displayEncSwitch: boolean = false);
332var
333OrderInfo, OrderText: string;
334cidx, i, widx: integer;
335begin
336 frmPrintLocation := TfrmPrintLocation.Create(Application);
337 frmPrintLocation.DisplayOrders := true;
338 frmPrintLocation.CloseOK := false;
339 ClinicArr := TStringList.Create;
340 WardArr := TStringList.Create;
341 frmPrintlocation.orderGrid.RowCount := OrderLst.Count + 1;
342 CurrentLocationForPatient(Patient.DFN, WardIEN, WardLocation, ASvc);
343 frmPrintLocation.lblEncounter.Enabled := displayEncSwitch;
344 frmPrintLocation.cboEncLoc.Enabled := displayEncSwitch;
345 frmPrintLocation.Cloc := pEncounterLocName;
346 frmPrintLocation.WLoc := WardLocation;
347 ResizeAnchoredFormToFont(frmPrintLocation);
348 frmPrintLocation.orderGrid.DefaultRowHeight := frmPrintLocation.cbolocation.Height;
349 for i := 0 to OrderLst.Count - 1 do
350 begin
351 OrderInfo := Piece(OrderLst.Strings[i],':',1);
352 OrderText := AnsiReplaceText(Piece(OrderLst.Strings[i],':',2),CRLF,'');
353 frmPrintLocation.orderGrid.Cells[COL_ORDERINFO,i+1] := OrderInfo;
354 frmPrintLocation.orderGrid.Cells[COL_ORDERTEXT,i+1] := OrderText;
355 end;
356 frmPrintLocation.cbolocation.Items.Add(frmPrintLocation.CLoc);
357 frmPrintLocation.cbolocation.Items.Add(frmPrintLocation.WLoc);
358 if frmPrintLocation.cboEncLoc.Enabled = True then
359 begin
360 frmPrintLocation.cboEncLoc.Items.Add(frmPrintLocation.CLoc);
361 frmPrintLocation.cboEncLoc.Items.Add(frmPrintLocation.WLoc);
362 end;
363 frmPrintLocation.ShowModal;
364 if assigned(ClinicArr) then ClinicLst.AddStrings(ClinicArr);
365 if assigned(WardArr) then WardLst.AddStrings(WardArr);
366 ProcessClinicOrders(WardLst, ClinicLst, WardIEN, pEncounterLoc, ContainsIMOOrders);
367 cidx := frmPrintLocation.cboEncLoc.Items.IndexOf(frmPrintLocation.CLoc);
368 widx := frmPrintLocation.cboEncLoc.Items.IndexOf(frmPrintLocation.WLoc);
369 if frmPrintLocation.cboEncLoc.ItemIndex = cidx then
370 begin
371 //Encounter.Location := pEncounterLoc;
372 //Encounter.LocationName := pEncounterLocName;
373 //Encounter.LocationText := pEncounterLocText;
374 uCore.Encounter.EncounterSwitch(pEncounterLoc, pEncounterLocName, pEncounterLocText, pEncounterDT, pEncounterVC);
375 fframe.frmFrame.DisplayEncounterText;
376 //fframe.frmFrame.DoNotChangeEncWindow := true;
377 fframe.frmFrame.OrderPrintForm := True;
378 end
379 else if frmPrintLocation.cboEncLoc.ItemIndex = widx then
380 begin
381 uCore.Encounter.EncounterSwitch(WardIEN, WardLocation, '', Patient.AdmitTime, 'H');
382 (* Encounter.Location := WardIEN;
383 Encounter.DateTime := Patient.AdmitTime;
384 Encounter.VisitCategory := 'H';
385 Encounter.Location := WardIEN;
386 Encounter.LocationName := WardLocation; *)
387 //fframe.frmFrame.DoNotChangeEncWindow := false;
388 fFrame.frmFrame.DisplayEncounterText;
389 end;
390 frmPrintLocation.Close;
391end;
392
393procedure TfrmPrintLocation.ProcessClinicOrders(WardList, ClinicList: TStringList;
394 WardIEN, ClinicIEN: integer; ContainsIMO: boolean);
395var
396i: integer;
397OrderArr: TStringList;
398begin
399 OrderArr := TStringList.Create;
400 for i := 0 to WardList.Count -1 do
401 begin
402 OrderArr.Add(WardList.Strings[i] + U + InttoStr(WardIen));
403 end;
404 for i := 0 to ClinicList.Count -1 do
405 begin
406 OrderArr.Add(ClinicList.Strings[i] + U + InttoStr(ClinicIen));
407 end;
408 rpcChangeOrderLocation(OrderArr, ContainsIMO);
409 WardArr.Free;
410end;
411
412
413procedure TfrmPrintLocation.rpcChangeOrderLocation(pOrderList:TStringList; ContainsIMO: boolean);
414var
415IMO: string;
416begin
417// OrderIEN^Location^ISIMO -- used to alter location if ward is selected.
418 if ContainsIMO = True then IMO := '1'
419 else IMO := '0';
420 CallV('ORWDX CHANGE',[pOrderList, Patient.DFN, IMO]);
421end;
422
423
424procedure TfrmPrintLocation.ShowEditor(ACol, ARow: Integer; AChar: Char);
425var
426 tmpText: string;
427 //Index: integer;
428
429 procedure PlaceControl(AControl: TWinControl);
430 var
431 ARect: TRect;
432 begin
433 with AControl do
434 begin
435 ARect := OrderGrid.CellRect(ACol, ARow);
436 SetBounds(ARect.Left + OrderGrid.Left + 1, ARect.Top + OrderGrid.Top + 1,
437 ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
438 Tag := ARow;
439 BringToFront;
440 Show;
441 SetFocus;
442 end;
443 end;
444
445 procedure SynchCombo(ACombo: TORComboBox; const ItemText, EditText: string);
446 var
447 i: Integer;
448 begin
449 ACombo.ItemIndex := -1;
450 for i := 0 to Pred(ACombo.Items.Count) do
451 if ACombo.Items[i] = ItemText then ACombo.ItemIndex := i;
452 if ACombo.ItemIndex < 0 then ACombo.Text := EditText;
453 end;
454
455begin
456 inherited;
457 //if AChar = ' ' then AChar := #0;
458 if ARow = 0 then Exit;
459 //with OrderGrid do if (Acol > COL_ORDER) and (ValFor(COL_ORDER, ARow) = '') then Exit;
460 //if (ACol = COL_Order) and (ARow > 1) and (ValFor(COL_Order, ARow-1) = '') then Exit;
461 Case ACol of
462 COL_LOCATION: begin
463 TmpText := ValFor(COL_Location, ARow);
464 SynchCombo(cboLocation, tmpText, tmpText);
465 PlaceControl(cboLocation);
466 end;
467 end;
468
469end;
470
471procedure TfrmPrintLocation.SwitchEncounterLoction(pEncounterLoc: integer; pEncounterLocName, pEncounterLocText: string;
472 pEncounterDT: TFMDateTime; pEncounterVC: Char);
473var
474cidx, widx, WardIEN: integer;
475Asvc, WardLocation: string;
476begin
477 //frmPrintLocation.Caption := 'Refresh Encounter Location Form';
478 frmPrintLocation := TfrmPrintLocation.Create(Application);
479 frmPrintLocation.DisplayOrders := false;
480 frmPrintLocation.CloseOK := false;
481 CurrentLocationForPatient(Patient.DFN, WardIEN, WardLocation, ASvc);
482 frmPrintLocation.lblEncounter.Enabled := True;
483 frmPrintLocation.cboEncLoc.Enabled := True;
484 frmPrintLocation.Cloc := pEncounterLocName;
485 frmPrintLocation.WLoc := WardLocation;
486 ResizeAnchoredFormToFont(frmPrintLocation);
487 frmPrintLocation.cboEncLoc.Items.Add(frmPrintLocation.CLoc);
488 frmPrintLocation.cboEncLoc.Items.Add(frmPrintLocation.WLoc);
489 frmPrintLocation.Caption := 'Refresh Encounter Location Form';
490 frmPrintLocation.ShowModal;
491 cidx := frmPrintLocation.cboEncLoc.Items.IndexOf(frmPrintLocation.CLoc);
492 widx := frmPrintLocation.cboEncLoc.Items.IndexOf(frmPrintLocation.WLoc);
493 if frmPrintLocation.cboEncLoc.ItemIndex = cidx then
494 begin
495 Encounter.Location := pEncounterLoc;
496 Encounter.LocationName := pEncounterLocName;
497 Encounter.LocationText := pEncounterLocText;
498 fframe.frmFrame.DisplayEncounterText;
499 //fframe.frmFrame.DoNotChangeEncWindow := true;
500 end
501 else if frmPrintLocation.cboEncLoc.ItemIndex = widx then
502 begin
503 uCore.Encounter.EncounterSwitch(WardIEN, WardLocation, '', Patient.AdmitTime, 'H');
504 (*Encounter.Location := WardIEN;
505 Encounter.LocationName := WardLocation; *)
506 //fframe.frmFrame.DoNotChangeEncWindow := false;
507 fFrame.frmFrame.DisplayEncounterText;
508 end;
509 frmPrintLocation.Close;
510end;
511
512function TfrmPrintLocation.ValFor(FieldID, ARow: Integer): string;
513
514begin
515 Result := '';
516 if (ARow < 1) or (ARow >= OrderGrid.RowCount) then Exit;
517 with OrderGrid do
518 case FieldID of
519 COL_ORDERINFO : Result := Piece(Cells[COL_ORDERINFO, ARow], TAB, 1);
520 COL_ORDERTEXT : Result := Piece(Cells[COL_ORDERTEXT, ARow], TAB, 1);
521 COL_LOCATION : Result := Piece(Cells[COL_LOCATION, ARow], TAB, 1);
522 end;
523end;
524
525end.
Note: See TracBrowser for help on using the repository browser.