source: cprs/branches/tmg-cprs/CPRS-Chart/fMeds.pas.old@ 1099

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 71.9 KB
Line 
1//kt -- Modified with SourceScanner on 7/19/2007
2unit fMeds;
3
4{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
5
6interface
7
8uses
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 fPage, StdCtrls, Menus, ORCtrls, ORFn, ExtCtrls, ComCtrls, rOrders, uConst,
11 rMeds, ORNet, DKLang;
12
13type
14 TChildOD = class
15 public
16 ChildID: string;
17 ParentID: string;
18 constructor Create;
19 end;
20 TfrmMeds = class(TfrmPage)
21 mnuMeds: TMainMenu;
22 mnuView: TMenuItem;
23 mnuViewChart: TMenuItem;
24 mnuChartReports: TMenuItem;
25 mnuChartLabs: TMenuItem;
26 mnuChartDCSumm: TMenuItem;
27 mnuChartCslts: TMenuItem;
28 mnuChartNotes: TMenuItem;
29 mnuChartOrders: TMenuItem;
30 mnuChartMeds: TMenuItem;
31 mnuChartProbs: TMenuItem;
32 mnuChartCover: TMenuItem;
33 mnuAct: TMenuItem;
34 mnuActNew: TMenuItem;
35 Z1: TMenuItem;
36 mnuActChange: TMenuItem;
37 mnuActDC: TMenuItem;
38 mnuActHold: TMenuItem;
39 mnuActRenew: TMenuItem;
40 Z2: TMenuItem;
41 mnuViewActive: TMenuItem;
42 mnuViewExpiring: TMenuItem;
43 Z3: TMenuItem;
44 mnuViewSortClass: TMenuItem;
45 mnuViewSortName: TMenuItem;
46 Z4: TMenuItem;
47 mnuViewDetail: TMenuItem;
48 popMed: TPopupMenu;
49 popMedDetails: TMenuItem;
50 N1: TMenuItem;
51 popMedChange: TMenuItem;
52 popMedDC: TMenuItem;
53 popMedRenew: TMenuItem;
54 N2: TMenuItem;
55 popMedNew: TMenuItem;
56 mnuActCopy: TMenuItem;
57 mnuActRefill: TMenuItem;
58 mnuActTransfer: TMenuItem;
59 popMedRefill: TMenuItem;
60 mnuChartSurgery: TMenuItem;
61 mnuViewHistory: TMenuItem;
62 popMedHistory: TMenuItem;
63 pnlBottom: TORAutoPanel;
64 splitBottom: TSplitter;
65 pnlMedIn: TPanel;
66 lstMedsIn: TCaptionListBox;
67 hdrMedsIn: THeaderControl;
68 pnlNonVA: TPanel;
69 lstMedsNonVA: TCaptionListBox;
70 hdrMedsNonVA: THeaderControl;
71 splitTop: TSplitter;
72 pnlTop: TORAutoPanel;
73 lstMedsOut: TCaptionListBox;
74 hdrMedsOut: THeaderControl;
75 mnuViewInformation: TMenuItem;
76 mnuViewDemo: TMenuItem;
77 mnuViewVisits: TMenuItem;
78 mnuViewPrimaryCare: TMenuItem;
79 mnuViewMyHealtheVet: TMenuItem;
80 mnuInsurance: TMenuItem;
81 mnuViewFlags: TMenuItem;
82 mnuViewReminders: TMenuItem;
83 mnuViewRemoteData: TMenuItem;
84 mnuViewPostings: TMenuItem;
85 mnuOptimizeFields: TMenuItem;
86 procedure mnuChartTabClick(Sender: TObject);
87 procedure FormCreate(Sender: TObject);
88 procedure FormDestroy(Sender: TObject);
89 procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer;
90 var AHeight: Integer);
91 procedure lstMedsDrawItem(Control: TWinControl; Index: Integer;
92 Rect: TRect; State: TOwnerDrawState);
93 procedure mnuViewDetailClick(Sender: TObject);
94 procedure lstMedsExit(Sender: TObject);
95 procedure lstMedsDblClick(Sender: TObject);
96 procedure lstMedsInClick(Sender: TObject);
97 procedure lstMedsOutClick(Sender: TObject);
98 procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl;
99 Section: THeaderSection);
100 procedure hdrMedsInSectionResize(HeaderControl: THeaderControl;
101 Section: THeaderSection);
102 procedure mnuActDCClick(Sender: TObject);
103 procedure mnuActHoldClick(Sender: TObject);
104 procedure mnuActRenewClick(Sender: TObject);
105 procedure mnuActChangeClick(Sender: TObject);
106 procedure mnuActCopyClick(Sender: TObject);
107 procedure mnuActNewClick(Sender: TObject);
108 procedure mnuActRefillClick(Sender: TObject);
109 procedure mnuActClick(Sender: TObject);
110 procedure mnuViewHistoryClick(Sender: TObject);
111 procedure popMedPopup(Sender: TObject);
112 procedure mnuViewClick(Sender: TObject);
113 procedure lstMedsNonVAClick(Sender: TObject);
114 procedure lstMedsNonVADblClick(Sender: TObject);
115 procedure lstMedsNonVAExit(Sender: TObject);
116 procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
117 Section: THeaderSection);
118 procedure FormResize(Sender: TObject);
119 procedure hdrMedsOutResize(Sender: TObject);
120 procedure hdrMedsNonVAResize(Sender: TObject);
121 procedure hdrMedsInResize(Sender: TObject);
122 procedure FormShow(Sender: TObject);
123 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
124 Shift: TShiftState; X, Y: Integer);
125 procedure splitBottomMoved(Sender: TObject);
126 procedure splitTopMoved(Sender: TObject);
127 procedure hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton;
128 Shift: TShiftState; X, Y: Integer);
129 procedure hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton;
130 Shift: TShiftState; X, Y: Integer);
131 procedure hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton;
132 Shift: TShiftState; X, Y: Integer);
133 procedure hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton;
134 Shift: TShiftState; X, Y: Integer);
135 procedure hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton;
136 Shift: TShiftState; X, Y: Integer);
137 procedure hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton;
138 Shift: TShiftState; X, Y: Integer);
139 //procedure ActivateDeactiveRenew(AListBox: TListBox);
140 procedure ViewInfo(Sender: TObject);
141 procedure mnuViewInformationClick(Sender: TObject);
142 procedure mnuOptimizeFieldsClick(Sender: TObject);
143 procedure hdrMedsOutSectionClick(HeaderControl: THeaderControl;
144 Section: THeaderSection);
145 procedure hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
146 Section: THeaderSection);
147 procedure hdrMedsInSectionClick(HeaderControl: THeaderControl;
148 Section: THeaderSection);
149 private
150 //kt Begin Mod (change Consts to Vars) 7/19/2007
151 MEDS_SPLIT_FORM : string; //kt
152 //kt End Mod -------------------
153 FIterating: Boolean;
154 FActionOnMedsTab: Boolean;
155 FParentComplexOrderID: string;
156 uMedListIn: TList;
157 uMedListOut: TList;
158 uMedListNonVA: TList;
159 uPendingChanges: TStringList;
160 uDGrp: array[0..6] of Integer;
161 uPharmacyOrdersIn: TStringList;
162 uPharmacyOrdersOut: TStringList;
163 uNonVAOrdersOut: TStringList;
164 ChildODList: TStringList;
165 function ListSelected(const ErrMsg: string): TListBox;
166 procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
167 procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = '');
168 procedure SynchListToOrders(AListBox: TListBox; AList: TList);
169 function GetActionText(const AMed: TMedListRec): string;
170 function GetInstructText(const AMed: TMedListRec; var Detail: string): string;
171 function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
172 function GetPlainText(Control: TWinControl; Index: integer): string;
173 function GetHeader(Control: TWinControl): THeaderControl;
174 function GetMedList(Control: TWinControl): TList;
175 function GetPharmacyOrders(Control: TWinControl): TStringList;
176 function PatientStatusChanged: boolean;
177 procedure ClearChildODList;
178 procedure SetupVars; //kt
179 public
180 procedure RefreshMedLists;
181 procedure ClearPtData; override;
182 procedure DisplayPage; override;
183 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
184 procedure SetFontSize( FontSize: integer); override;
185 property ActionOnMedsTab: boolean read FActionOnMedsTab;
186 property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID;
187 procedure InitfMedsSize;
188 procedure SetSectionWidths(Sender: TObject);
189 function GetTotalSectionsWidth(Sender: TObject) : integer;
190 function CheckMedStatus(ActiveList: TListBox): boolean;
191 end;
192
193type
194 arOrigOutPtSecWidths = array[0..6] of integer; //CQ7586
195 arOrigInPtSecWidths = array[0..4] of integer; //CQ7586
196 arOrigNonVASecWidths = array[0..3] of integer; //CQ7586
197
198var
199 frmMeds: TfrmMeds;
200// LargePanelPortion: Integer;
201// SmallPanelPortion: integer;
202
203 OrigOutPtSecWidths: arOrigOutPtSecWidths; //CQ7586
204 OrigInPtSecWidths : arOrigInPtSecWidths; //CQ7586
205 OrigNonVASecWidths: arOrigNonVASecWidths; //CQ7586
206
207 MedOutSize: double;
208 s: string;
209 LargePanelSize: integer;
210 SmallPanelSize : integer;
211 MedNonVAPanelSize: integer;
212
213 totalHeight: integer;
214
215 resizedTotalHeight: integer;
216 resizedMedOutPanelHeight: Extended;
217 resizedNonVAPanelHeight: Extended;
218 resizedMedInPanelHeight: Extended;
219
220 splitterTop: TSplitter;
221 splitterBottom: TSplitter;
222
223 oldFont: integer; //CQ9182
224
225
226implementation
227
228uses uCore, rCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold,
229 fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase,
230 StrUtils, fActivateDeactivate;
231
232{$R *.DFM}
233
234const
235 SMALL_PANEL = 20;
236 LARGE_PANEL = 60;
237 COL_MEDNAME = 1;
238 DG_OUT = 0;
239 DG_IN = 1;
240 DG_UD = 2;
241 DG_IV = 3;
242 DG_TPN = 4;
243 DG_NVA = 5;
244 DG_IMO = 6;
245 FMT_INDENT = 12;
246 TAG_OUTPT = 1;
247 TAG_INPT = 2;
248 TAG_NONVA = 3;
249 //kt 7-5-07 TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF +
250 //kt 7-5-07 'you wish to take action on.';
251 //kt 7-5-07 TC_NOSEL = 'No Orders Selected';
252 //kt 7-5-07 TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ';
253 //kt 7-5-07 TC_NO_DC = 'Unable to Discontinue';
254 //kt 7-5-07 TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
255 //kt 7-5-07 TC_NO_RENEW = 'Unable to Renew Order';
256 //kt 7-5-07 TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ';
257 //kt 7-5-07 TC_NO_HOLD = 'Unable to Hold';
258 //kt 7-5-07 TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
259 //kt 7-5-07 TC_NO_COPY = 'Unable to Copy Order';
260 //kt 7-5-07 TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
261 //kt 7-5-07 TC_NO_CHANGE = 'Unable to Change Order';
262 //kt 7-5-07 TX_NO_REFILL = CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: ';
263 //kt 7-5-07 TC_NO_REFILL = 'Unable to Refill Order';
264//MEDS_SPLIT_FORM = 'frmMedsSplit'; <-- original line. //kt 7/19/2007
265
266{ TPage common methods --------------------------------------------------------------------- }
267
268
269
270procedure TfrmMeds.SetupVars;
271//kt Added entire function to replace constant declarations 7/19/2007
272begin
273 MEDS_SPLIT_FORM := DKLangConstW('fMeds_frmMedsSplit');
274end;
275
276procedure TfrmMeds.ClearPtData;
277begin
278 inherited ClearPtData;
279 ClearChildODList;
280 lstMedsIn.Clear;
281 lstMedsOut.Clear;
282 lstMedsNonVA.Clear;
283 ClearMedList(uMedListIn);
284 ClearMedList(uMedListOut);
285 ClearMedList(uMedListNonVA);
286 uPendingChanges.Clear;
287 uPharmacyOrdersIn.Clear;
288 uPharmacyOrdersOut.Clear;
289 uMedListNonVA.Clear;
290 totalHeight := 0;
291
292end;
293
294procedure TfrmMeds.DisplayPage;
295const
296 RATIO_SMALL = 0.13; //0.1866;
297
298
299begin
300 inherited DisplayPage;
301
302 frmFrame.ShowHideChartTabMenus(mnuViewChart);
303
304 if InitPage and User.NoOrdering then
305 begin
306 mnuAct.Enabled := False;
307 popMedChange.Enabled := False;
308 popMedDC.Enabled := False;
309 popMedRenew.Enabled := False;
310 popMedNew.Enabled := False;
311
312 end;
313
314 //Swap Inpatient/Outpatient list display positions depending in inpatient/outpatient status
315 if InitPage and User.DisableHold then
316 mnuActHold.Visible := False;
317
318 if Patient.Inpatient then
319 begin
320 splitBottom.Align := alNone;
321 hdrMedsIn.Align := alNone;
322 lstMedsIn.Align := alNone;
323
324 lstMedsIn.Parent := pnlTop;
325 lstMedsIn.Align := alClient;
326 lstMedsOut.Parent := pnlMedIn;
327
328 hdrMedsIn.Parent := pnlTop;
329 hdrMedsIn.Align := alTop;
330
331 hdrMedsOut.Parent := pnlMedIn;
332 splitBottom.Align := alBottom;
333
334 lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
335 lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
336 lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small
337 lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
338
339 end
340 else
341 begin
342 splitBottom.Align := alNone;
343 hdrMedsIn.Align := alNone;
344
345 lstMedsIn.Parent := pnlMedIn;
346 lstMedsOut.Parent := pnlTop;
347 lstMedsOut.Align := alClient;
348
349 hdrMedsIn.Parent := pnlMedIn;
350 hdrMedsIn.Align := alTop;
351
352 hdrMedsOut.Parent := pnlTop;
353 splitBottom.Align := alBottom;
354
355 lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
356 lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
357 lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small
358 lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
359 end;
360 RefreshMedLists;
361
362end;
363
364procedure TfrmMeds.mnuChartTabClick(Sender: TObject);
365begin
366 inherited;
367 frmFrame.mnuChartTabClick(Sender);
368end;
369
370procedure TfrmMeds.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
371var
372 AMedList: TList;
373 AStringList: TStringList;
374 NewMedRec: TMedListRec;
375 i, idx, Match: Integer;
376 j: integer;
377 AChildList: TStringlist;
378 CplxOrderID: string;
379
380 procedure SetCurrentOrderID;
381 var
382 i: Integer;
383 AMedRec: TMedListRec;
384 begin
385 with AMedList do for i := 0 to Count - 1 do
386 begin
387 AMedRec := TMedListRec(AMedList[i]);
388 if Piece(AMedRec.OrderID, ';', 1) = Piece(AnOrder.ActionOn, ';', 1) then
389 begin
390 end;
391 end;
392 end;
393
394 function IndexForCurrentID(const AnID: string): Integer;
395 var
396 i: Integer;
397 begin
398 Result := -1;
399 for i := 0 to uPendingChanges.Count - 1 do
400 if Piece(uPendingChanges[i], U, 2) = AnID then Result := i;
401 if Result < 0 then
402 for i := 0 to uPendingChanges.Count - 1 do
403 if Piece(uPendingChanges[i], '=', 1) = Piece(AnID, ';', 1) then Result := i;
404 end;
405
406begin
407 AMedList := nil;
408 if AnOrder <> nil then
409 begin
410 //AGP Change 26.24 CQ 7150 fixes the problem with non-va meds initially showing up in the inpatient section
411 if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut;
412 If uDGrp[DG_NVA] = AnOrder.DGroup then AMedList := uMedListNonVA;
413 if (AMedList <> uMedListOut) and (AMedList <> uMedListNonVA) then
414 for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
415 end;
416 case OrderAction of
417 ORDER_NEW: { sent by accept order on new order }
418 if AMedList <> nil then
419 begin
420 // check this out carefully!!
421 NewMedRec := TMedListRec.Create;
422 NewMedRec.OrderID := AnOrder.ID;
423 NewMedRec.Instruct := AnOrder.Text;
424 NewMedRec.Inpatient := AMedList = uMedListIn;
425 AMedList.Insert(0, NewMedRec);
426 if AMedList = uMedListIn then
427 begin
428 lstMedsIn.Items.Insert(0, GetPlainText(lstMedsIn,0));
429 uPharmacyOrdersIn.Insert(0, U + AnOrder.ID);
430 end
431 else
432 begin
433 if AMedList = uMedListOut then
434 begin
435 lstMedsOut.Items.Insert(0, GetPlainText(lstMedsOut,0));
436 uPharmacyOrdersOut.Insert(0, U + AnOrder.ID);
437 end
438 else
439 begin
440 if AMedList = uMedListNonVA then
441 begin
442 lstMedsNonVA.Items.Insert(0, GetPlainText(lstMedsNonVA,0));
443 uNonVAOrdersOut.Insert(0, U + AnOrder.ID);
444 end;
445 end;
446 end;
447// uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + '=NW^' + AnOrder.ID); <-- original line. //kt 7/19/2007
448 uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + DKLangConstW('fMeds_xNWx') + AnOrder.ID); //kt added 7/19/2007
449 end;
450 ORDER_DC: { sent by a diet to cancel a tubefeeding - do nothing };
451 ORDER_EDIT: { sent by accept on edit order }
452 if AMedList <> nil then
453 begin
454 Match := IndexForCurrentID(AnOrder.EditOf);
455 if Match < 0
456 { add a new pending change if there is no existing change that matches EditOf }
457// then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName) <-- original line. //kt 7/19/2007
458 then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + DKLangConstW('fMeds_xXX') + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName) //kt added 7/19/2007
459 { leave 1st piece (original ID) intact, while changing text & current ID }
460// else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName; <-- original line. //kt 7/19/2007
461 else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + DKLangConstW('fMeds_xXX') + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName; //kt added 7/19/2007
462 end;
463 ORDER_ACT: { sent by DC, Hold, & Renew actions }
464 if AMedList <> nil then
465 begin
466 if Piece(AnOrder.ActionOn, '=', 2) = 'CA' then
467 begin
468 // cancel action, remove from PendingChanges
469 for idx := uPendingChanges.Count-1 downto 0 do
470 begin
471 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
472 if Match > -1 then uPendingChanges.Delete(Match);
473 end;
474 end
475 else if Piece(AnOrder.ActionOn, '=', 2) = 'DL' then
476 begin
477 // delete action, show as deleted (set OrderID's to 0 so not confused with next order)
478 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
479// if Match > -1 then uPendingChanges[Match] := '0=DL'; <-- original line. //kt 7/19/2007
480 if Match > -1 then uPendingChanges[Match] := DKLangConstW('fMeds_0xDL'); //kt added 7/19/2007
481 if AMedList = uMedListIn
482 then AStringList := uPharmacyOrdersIn
483 else if AMedList = uMedListOut
484 then AStringList := uPharmacyOrdersOut
485 else AStringList := uNonVAOrdersOut;
486 with AStringList do for i := 0 to Count - 1 do
487 if (U + Piece(AnOrder.ActionOn, '=', 1)) = Strings[i] then Strings[i] := '^0';
488 Match := -1;
489 with AMedList do for i := 0 to Count - 1 do
490 if TMedListRec(Items[i]).OrderID = Piece(AnOrder.ActionOn, '=', 1) then Match := i;
491 if Match > -1 then TMedListRec(AMedList.Items[Match]).OrderID := '0';
492 end
493 else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' +
494 Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
495
496 end; {if AMedList}
497 ORDER_CPLXRN:
498 begin
499 AChildList := TStringList.Create;
500 CplxOrderID := Piece(AnOrder.ActionOn,'=',1);
501 GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList);
502 if AMedList = uMedListIn then with AMedList do
503 begin
504 for i := Count-1 downto 0 do
505 begin
506 for j := 0 to AChildList.Count - 1 do
507 begin
508 if (TMedListRec(Items[i]).OrderID = AChildList[j]) then
509 begin
510 { Delete(i);
511 Break;}
512 if not IsFirstDoseNowOrder(TMedListRec(Items[i]).OrderID) then
513 begin
514 uPendingChanges.Add(Piece(TMedListRec(Items[i]).OrderID, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID);
515 Break;
516 end;
517 end;
518 end;
519 end;
520 end;
521 AChildList.Clear;
522 AChildList.Free;
523 end;
524 ORDER_SIGN: { sent by fReview, fOrderSign when orders signed, AnOrder=nil}
525 begin
526 // ** only if tab has been visited?
527 uPendingChanges.Clear;
528 RefreshMedLists;
529 end;
530 end; {case}
531end;
532
533procedure TfrmMeds.SetFontSize( FontSize: integer);
534begin
535 inherited SetFontSize(FontSize);
536 mnuOptimizeFieldsClick(self);
537 if Patient.DFN <> '' then
538 RefreshMedLists;
539end;
540
541{ Form events ------------------------------------------------------------------------------ }
542
543procedure TfrmMeds.FormCreate(Sender: TObject);
544var
545 medsSplitFnd : boolean;
546 retList : TStringList;
547 i: integer;
548 x: string;
549begin
550 SetupVars; //kt added 7/19/2007 to replace constants with vars.
551 inherited;
552 PageID := CT_MEDS;
553 lstMedsIn.Color := ReadOnlyColor;
554 lstMedsOut.Color := ReadOnlyColor;
555 uMedListIn := TList.Create;
556 uMedListOut := TList.Create;
557 uMedListNonVA := TList.Create;
558 uPendingChanges := TStringList.Create;
559 uDGrp[DG_OUT] := DGroupIEN('O RX');
560 uDGrp[DG_IN] := DGroupIEN('I RX');
561 uDGrp[DG_UD] := DGroupIEN('UD RX');
562 uDGrp[DG_IV] := DGroupIEN('IV RX');
563 uDGrp[DG_TPN] := DGroupIEN('TPN');
564 uDGrp[DG_NVA] := DGroupIEN('NV RX');
565 uDGrp[DG_IMO] := DGroupIEN('C RX');
566 uPharmacyOrdersIn := TStringList.Create;
567 uPharmacyOrdersOut := TStringList.Create;
568 uNonVAOrdersOut := TStringList.Create;
569 FActionOnMedsTab := False;
570 FParentComplexOrderID := '';
571 ChildODList := TStringList.Create;
572
573
574
575 //DETECT 1st TIME USER.
576 //If first time user (medSplitFound=false), then manually set panel heights.
577 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
578 medsSplitFnd := FALSE;
579 if Assigned(frmMeds) then
580 begin
581 retList := TStringList.Create;
582 tCallV(retList, 'ORWCH LOADALL', [nil]);
583
584 for i := 0 to retList.Count-1 do
585 begin
586 x := retList.strings[i];
587 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
588 begin
589 medsSplitFnd := False;//TRUE;
590 Break;
591 end;
592 end;
593
594 if not medsSplitFnd then
595 begin
596 pnlBottom.Height := frmMeds.Height div 2;
597 pnlMedIn.Height := pnlBottom.Height div 2;
598 end;
599 end;
600
601 //CQ9622
602 if hdrMedsIn.Sections[1].Width < 100 then
603 begin
604 hdrMedsIn.Sections[1].Width := 100;
605 hdrMedsIn.Refresh;
606 end;
607 if hdrMedsNonVA.Sections[1].Width < 100 then
608 begin
609 hdrMedsNonVA.Sections[1].Width := 100;
610 lstMedsNonVA.Refresh;
611 end;
612 if hdrMedsOut.Sections[1].Width < 100 then
613 begin
614 hdrMedsOut.Sections[1].Width := 100;
615 hdrMedsOut.Refresh;
616 end;
617 //end CQ9622
618end;
619
620procedure TfrmMeds.FormDestroy(Sender: TObject);
621begin
622 inherited;
623 ClearChildODList;
624 ClearMedList(uMedListIn);
625 ClearMedList(uMedListOut);
626 ClearMedList(uMedListNonVA);
627 uMedListIn.Free;
628 uMedListOut.Free;
629 uMedListNonVA.Free;
630 uPendingChanges.Free;
631 uPharmacyOrdersIn.Free;
632 uPharmacyOrdersOut.Free;
633 uNonVAOrdersOut.Free;
634 ChildODList.Free;
635end;
636
637{ View menu events ------------------------------------------------------------------------- }
638
639procedure TfrmMeds.mnuViewDetailClick(Sender: TObject);
640var
641 AnID, ATitle, AnOrder: string;
642 AListBox: TListBox;
643 i,j,idx: Integer;
644 tmpList: TStringList;
645begin
646 inherited;
647 tmpList := TStringList.Create;
648 try
649 idx := 0;
650 AListBox := ListSelected(TX_NOSEL);
651 if AListBox = nil then Exit
652// else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details' <-- original line. //kt 7/5/2007
653 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_OP_Meds') //kt 7-5-07
654// else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication' <-- original line. //kt 7/5/2007
655 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_NVA_Meds') //kt 7-5-07
656// else ATitle := 'Inpatient Medication Details'; <-- original line. //kt 7/5/2007
657 else ATitle := DKLangConstW('fMeds_IP_Meds'); //kt 7-5-07
658 FIterating := True;
659 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
660 begin
661 AnID := Piece(Strings[i], U, 1);
662 if AnID <> '' then
663 begin
664 tmpList.Assign(DetailMedLM(AnID));
665 end;
666 AnOrder := Piece(Strings[i], U, 2);
667 if AnOrder <> '' then
668 begin
669 tmpList.Add('');
670 tmpList.Add(StringOfChar('=', 74));
671 tmpList.Add('');
672 tmpList.AddStrings(MedAdminHistory(AnOrder));
673 end;
674 if CheckOrderGroup(AnOrder)=1 then // if it's UD group
675 begin
676 for j := 0 to tmpList.Count - 1 do
677 begin
678 if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
679 begin
680 idx := j;
681 Break;
682 end;
683 end;
684 if idx > 0 then
685 tmpList.Delete(idx);
686 end;
687 if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True);
688 if frmFrame.CCOWDrivedChange then
689 Exit;
690 end;
691 FIterating := False;
692 ResetSelectedForList(AListBox);
693 AListBox.SetFocus;
694 finally
695 tmpList.Free;
696 end;
697end;
698
699procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject);
700var
701 ATitle, AnOrder: string;
702 AListBox: TListBox;
703 i: Integer;
704begin
705 inherited;
706 AListBox := ListSelected(TX_NOSEL);
707 if AListBox = nil then Exit
708//else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History'
709 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_OP_Med_Admin_Hx') //kt 7-5-07
710//else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History'
711 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_NVA_Med_Doc_Hx') //kt 7-5-07
712//else ATitle := 'Inpatient Medication Administration History'; <-- original line. //kt 7/19/2007
713 else ATitle := DKLangConstW('fMeds_IP_Med_Admin_Hx'); //kt 7-5-07
714 FIterating := True;
715 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
716 begin
717 AnOrder := Piece(Strings[i], U, 2);
718 if AnOrder <> '' then
719 ReportBox(MedAdminHistory(AnOrder), ATitle, True);
720 end;
721 FIterating := False;
722 ResetSelectedForList(AListBox);
723 AListBox.SetFocus;
724end;
725
726{ Listbox events --------------------------------------------------------------------------- }
727
728procedure TfrmMeds.RefreshMedLists;
729var
730 i: Integer;
731 AMed: TMedListRec;
732begin
733 lstMedsIn.Clear;
734 lstMedsOut.Clear;
735 lstMedsNonVA.Clear;
736//StatusText('Retrieving active medications...'); <-- original line. //kt 7/19/2007
737 StatusText(DKLangConstW('fMeds_Retrieving_Active_Meds')); //kt 7-5-07
738 LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA);
739 uPharmacyOrdersIn.Clear;
740 uPharmacyOrdersOut.Clear;
741 uNonVAOrdersOut.Clear;
742 with uMedListIn do for i := 0 to Count - 1 do
743 begin
744 AMed := TMedListRec(Items[i]);
745 uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID);
746 lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed);
747 end;
748
749 with uMedListNonVA do for i := 0 to Count - 1 do
750 begin
751 AMed := TMedListRec(Items[i]);
752 uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
753 lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed);
754 end;
755
756 with uMedListOut do for i := 0 to Count - 1 do
757 begin
758 AMed := TMedListRec(Items[i]);
759 uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
760 lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed);
761 end;
762
763 StatusText('');
764end;
765
766function TfrmMeds.GetActionText(const AMed: TMedListRec): string;
767var
768 AnAction: string;
769 Abbreviation: string;
770begin
771 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
772 Abbreviation := Piece(AnAction, U, 1);
773 result := '';
774 if Length(Abbreviation) > 0 then
775 begin
776// if CharAt(Abbreviation, 1) = 'X' then result := 'Change' <-- original line. //kt 7/19/2007
777 if CharAt(Abbreviation, 1) = 'X' then result := DKLangConstW('fMeds_Change')
778// else if Abbreviation = 'NW' then result := 'New' <-- original line. //kt 7/19/2007
779 else if Abbreviation = 'NW' then result := DKLangConstW('fMeds_New')
780// else if Abbreviation = 'RN' then result := 'Renew' <-- original line. //kt 7/19/2007
781 else if Abbreviation = 'RN' then result := DKLangConstW('fMeds_Renew')
782// else if Abbreviation = 'RF' then result := 'Refill' <-- original line. //kt 7/19/2007
783 else if Abbreviation = 'RF' then result := DKLangConstW('fMeds_Refill')
784// else if Abbreviation = 'HD' then result := 'Hold' <-- original line. //kt 7/19/2007
785 else if Abbreviation = 'HD' then result := DKLangConstW('fMeds_Hold')
786// else if Abbreviation = 'DL' then result := 'Deleted' <-- original line. //kt 7/19/2007
787 else if Abbreviation = 'DL' then result := DKLangConstW('fMeds_Deleted')
788// else if Abbreviation = 'DC' then result := 'DC' <-- original line. //kt 7/19/2007
789 else if Abbreviation = 'DC' then result := DKLangConstW('fMeds_DC')
790 else result := Abbreviation;
791 end;
792end;
793
794function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string;
795var
796 AnAction: string;
797 Indent: integer;
798begin
799 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
800 result := AMed.Instruct;
801 // replace pharmacy text with order text if this is a change
802 if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3);
803//if AMed.IVFluid then Indent := Pos(#10 + 'in ', result) else Indent := Pos(#13, result); <-- original line. //kt 7/19/2007
804 if AMed.IVFluid then Indent := Pos(#10 + DKLangConstW('fMeds_in')+' ', result) else Indent := Pos(#13, result); //kt added 7/19/2007
805 if Indent > 0 then
806 begin
807 if AMed.IVFluid then
808 begin
809 Detail := Copy(result, Indent + 1, Length(result));
810 result := Copy(result, 1, Indent - 1);
811 end else
812 begin
813 Detail := Copy(result, Indent + 2, Length(result));
814 result := Copy(result, 1, Indent - 1);
815 end;
816 end;
817end;
818
819function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
820begin
821 result := '';
822 Detail := '';
823//if AMed.Status = 'Suspended' then AMed.Status := 'Active/Susp'; //HDS00007547 PSI-03-033 Interim Solution. <-- original line. //kt 7/19/2007
824 if AMed.Status = DKLangConstW('fMeds_Suspended') then AMed.Status := DKLangConstW('fMeds_ActivexSusp'); //HDS00007547 PSI-03-033 Interim Solution. //kt added 7/19/2007
825 case Column of
826 0: result := GetActionText(AMed);
827 1: result := GetInstructText(AMed, Detail);
828// 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate); <-- original line. //kt 7/19/2007
829 2: result := FormatFMDateTime(DKLangConstW('fMeds_mmxddxyy'), AMed.StopDate); //kt added 7/19/2007
830 3: result := AMed.Status;
831 4:
832 begin
833 if AMed.Inpatient then
834 result := MixedCase(AMed.Location)
835// else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill); <-- original line. //kt 7/19/2007
836 else result := FormatFMDateTime(DKLangConstW('fMeds_mmm_ddxyy'), AMed.LastFill); //kt added 7/19/2007
837 end;
838 5: result := AMed.Refills;
839 else
840 end;
841end;
842
843function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string;
844var
845 AMed: TMedListRec;
846 AHeader: THeaderControl;
847 i: integer;
848 x, y: string;
849begin
850 Result := '';
851 AMed := TMedListRec(GetMedList(Control)[Index]);
852 AHeader := GetHeader(Control);
853 for i := 0 to AHeader.Sections.Count-1 do
854 begin
855 x := GetListText(AMed, i, y);
856 if (x <> '') or (y <> '') then
857 Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF;
858 end;
859 Result := Trim(Result);
860end;
861
862function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl;
863begin
864 case Control.Tag of
865 TAG_OUTPT: result := hdrMedsOut;
866 TAG_NONVA: result := hdrMedsNonVA;
867 TAG_INPT: result := hdrMedsIn;
868
869 else
870 result := nil;
871 end;
872end;
873
874function TFrmMeds.GetMedList(Control: TWinControl): TList;
875begin
876 case Control.Tag of
877 TAG_OUTPT: result := uMedListOut;
878 TAG_NONVA: result := uMedListNonVA;
879 TAG_INPT: result := uMedListIn;
880 else
881 result := nil;
882 end;
883end;
884
885function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList;
886begin
887 case Control.Tag of
888 TAG_OUTPT: result := uPharmacyOrdersOut;
889 TAG_NONVA: result := uNonVAOrdersOut;
890 TAG_INPT: result := uPharmacyOrdersIn;
891 else
892 result := nil;
893 end;
894end;
895
896procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer;
897 var AHeight: Integer);
898var
899 NewHeight, RecRight: Integer;
900 AMed: TMedListRec;
901 AHeader: THeaderControl;
902 AMedList: TList;
903 ARect: TRect;
904 x, y, AnAction: string;
905begin
906 inherited;
907 NewHeight := AHeight;
908 AHeader := GetHeader(Control);
909 AMedList := GetMedList(Control);
910 with Control as TListBox do if Index < Items.Count then
911 begin
912 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
913 if AMed <> nil then
914 begin
915 ARect := ItemRect(Index);
916 ARect.Left := AHeader.Sections[0].Width + 2;
917 ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6;
918 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
919 if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold];
920 x := GetInstructText( AMed, y);
921 RecRight := ARect.Right;
922 NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
923 if(length(y)>0) then
924 begin
925 ARect.Left := AHeader.Sections[0].Width + FMT_INDENT;
926 ARect.Right := RecRight; // Draw Text alters ARect.
927 inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect));
928 end;
929 if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM*
930 if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM*
931 end; {if AMed}
932 end; {if Index}
933 AHeight := NewHeight;
934end;
935
936procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
937var
938 ReturnHt: Integer;
939 x, y, AnAction: string;
940 AMed: TMedListRec;
941 AMedList: TList;
942 AHeader: THeaderControl;
943 ARect: TRect;
944 i: integer;
945 RectLeft: integer;
946begin
947 inherited;
948 AHeader := GetHeader(Control);
949 AMedList := GetMedList(Control);
950 ListGridDrawLines(TListBox(Control), AHeader, Index, State);
951 with Control as TListBox do if Index < Items.Count then
952 begin
953 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
954 if AMed <> nil then
955 begin
956 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
957 if Length(AnAction) > 0 then
958 begin
959 Canvas.Font.Style := [fsBold];
960 //AGP Change 26.29 CQ #8188 Fix for highlighted new meds displaying blue font with a blue background.
961 if odSelected in State then
962 begin
963 Canvas.Brush.Color := clHighlight;
964 Canvas.Font.Color := clHighlightText;
965 //Canvas.FillRect(ARect);
966 Canvas.Font.Color := clWhite;
967 end;
968 if (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) and (Canvas.Font.Color <> clWhite) then
969 Canvas.Font.Color := clBlue;
970 if (Length(Piece(AnAction,'^',4)) > 0) then
971 AMed.Location := Piece(AnAction,'^',4);
972 end;
973 RectLeft := 0;
974 for i := 0 to AHeader.Sections.Count -1 do
975 begin
976 x := GetListText(AMed, i, y);
977 if Length(y) > 0 then
978 begin
979 ARect := ItemRect(Index);
980 ARect.Left := RectLeft + 2;
981 ARect.Right := (ARect.Left + AHeader.Sections[i].Width - 6);
982
983 //if ((ARect.Right - ARect.Left) < 100) then
984 //ARect.Right := ARect.Right + (100 - (ARect.Left + AHeader.Sections[i].Width - 6));
985
986 ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
987 or DT_WORDBREAK);
988 ARect.Left := RectLeft + FMT_INDENT;
989 ARect.Top := ARect.Top + ReturnHt;
990 DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX
991 or DT_WORDBREAK);
992 end
993 else
994 ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1);
995 Inc(RectLeft, AHeader.Sections[i].Width);
996 end;
997 end; {if AMed}
998 end; {if Index}
999end;
1000
1001procedure TfrmMeds.lstMedsExit(Sender: TObject);
1002begin
1003 inherited;
1004 if not FIterating then ResetSelectedForList(TListBox(Sender));
1005end;
1006
1007procedure TfrmMeds.lstMedsDblClick(Sender: TObject);
1008begin
1009 inherited;
1010 mnuViewDetailClick(Self);
1011end;
1012
1013procedure TfrmMeds.lstMedsInClick(Sender: TObject);
1014var
1015 i: integer;
1016begin
1017 inherited;
1018
1019 if PatientStatusChanged then exit;
1020 with lstMedsOut do for i := 0 to Items.Count -1 do
1021 Selected[i] := false;
1022 with lstMedsNonVA do for i := 0 to Items.Count - 1 do
1023 Selected[i] := FALSE;
1024end;
1025
1026procedure TfrmMeds.lstMedsOutClick(Sender: TObject);
1027var
1028 i: integer;
1029begin
1030 inherited;
1031
1032 if PatientStatusChanged then exit;
1033 with lstMedsIn do for i := 0 to Items.Count -1 do
1034 Selected[i] := false;
1035 with lstMedsNonVA do for i := 0 to Items.Count -1 do
1036 Selected[i] := false;
1037end;
1038
1039procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1040begin
1041 inherited;
1042 RedrawSuspend(Self.Handle);
1043 with lstMedsOut do
1044 begin
1045 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1046 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1047 end;
1048 RedrawActivate(Self.Handle);
1049 lstMedsOut.Invalidate;
1050 Refresh;
1051end;
1052
1053procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1054begin
1055 inherited;
1056 RedrawSuspend(Self.Handle);
1057 with lstMedsIn do
1058 begin
1059 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1060 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1061 end;
1062
1063 RedrawActivate(Self.Handle);
1064 lstMedsIn.Invalidate;
1065 Refresh;
1066end;
1067
1068{ Action menu events ---------------------------------------------------------------------- }
1069
1070procedure TfrmMeds.mnuActClick(Sender: TObject);
1071begin
1072 inherited;
1073 if PatientStatusChanged then exit;
1074 if lstMedsOut.SelCount > 0 then
1075 begin
1076// mnuActTransfer.Caption := 'Transfer to Inpatient...'; <-- original line. //kt 7/5/2007
1077 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_IP'); //kt 7-5-07
1078 mnuActTransfer.Enabled := True;
1079 end
1080 else if lstMedsIn.SelCount > 0 then
1081 begin
1082// mnuActTransfer.Caption := 'Transfer to Outpatient...'; <-- original line. //kt 7/19/2007
1083 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_OP'); //kt 7-5-07
1084 mnuActTransfer.Enabled := True;
1085 end
1086 else
1087 begin
1088// mnuActTransfer.Caption := 'Transfer to...'; <-- original line. //kt 7/19/2007
1089 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to'); //kt 7-5-07
1090 mnuActTransfer.Enabled := False;
1091 end;
1092end;
1093
1094procedure TfrmMeds.mnuActDCClick(Sender: TObject);
1095{ discontinue/cancel/delete the selected med orders as appropriate for each order }
1096{ similar to action on fOrders}
1097var
1098 ActiveList: TListBox;
1099 SelectedList: TList;
1100 DelEvt: boolean;
1101begin
1102 inherited;
1103 DelEvt := False;
1104 ActiveList := ListSelected(TX_NOSEL);
1105 if ActiveList = nil then Exit;
1106 SelectedList := TList.Create;
1107 try
1108 FIterating := True;
1109 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1110 begin
1111 ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
1112 //ActivateDeactiveRenew(ActiveList); AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
1113 MakeSelectedList(ActiveList, SelectedList);
1114 if ExecuteDCOrders(SelectedList,DelEvt) then
1115 begin
1116 ResetSelectedForList(ActiveList);
1117 SynchListToOrders(ActiveList, SelectedList);
1118 end;
1119 if DelEvt then
1120 frmFrame.mnuFileRefreshClick(Self);
1121 end;
1122 finally
1123 FIterating := False;
1124 SelectedList.Free;
1125 UnlockIfAble;
1126 end;
1127end;
1128
1129procedure TfrmMeds.mnuActHoldClick(Sender: TObject);
1130{ hold the selected med orders as appropriate for each order }
1131{ similar to action on fOrders}
1132var
1133 ActiveList: TListBox;
1134 SelectedList: TList;
1135begin
1136 inherited;
1137 ActiveList := ListSelected(TX_NOSEL);
1138 if ActiveList = nil then Exit;
1139 SelectedList := TList.Create;
1140 if CheckMedStatus(ActiveList) = True then Exit;
1141 try
1142 FIterating := True;
1143 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1144 begin
1145 ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);
1146 MakeSelectedList(ActiveList, SelectedList);
1147 if ExecuteHoldOrders(SelectedList) then
1148 begin
1149 AddSelectedToChanges(SelectedList);
1150 ResetSelectedForList(ActiveList);
1151 SynchListToOrders(ActiveList, SelectedList);
1152 end;
1153 end;
1154 finally
1155 ActiveList.SetFocus;
1156 FIterating := False;
1157 SelectedList.Free;
1158 UnlockIfAble;
1159 end;
1160end;
1161
1162procedure TfrmMeds.mnuActRenewClick(Sender: TObject);
1163{ renew the selected med orders as appropriate for each order }
1164{ similar to action on fOrders}
1165var
1166 ActiveList: TListBox;
1167 SelectedList: TList;
1168 ParntOrder : TOrder;
1169begin
1170 inherited;
1171 ActiveList := ListSelected(TX_NOSEL);
1172 if ActiveList = nil then Exit;
1173 SelectedList := TList.Create;
1174 try
1175 FIterating := True;
1176 if CheckMedStatus(ActiveList) = True then Exit;
1177 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1178 begin
1179 ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);
1180 MakeSelectedList(ActiveList, SelectedList);
1181 if Length(FParentComplexOrderID)>0 then
1182 begin
1183 ParntOrder := GetOrderByIFN(FParentComplexOrderID);
1184 if CharAt(ParntOrder.Text,1)='+' then
1185 ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
1186// if Pos('First Dose NOW',ParntOrder.Text)>1 then <-- original line. //kt 7/19/2007
1187 if Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text)>1 then //kt added 7/19/2007
1188// Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW')); <-- original line. //kt 7/19/2007
1189 Delete(ParntOrder.text, Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text), Length(DKLangConstW('fMeds_First_Dose_NOW'))); //kt added 7/19/2007
1190 SelectedList.Add(ParntOrder);
1191 FParentComplexOrderID := '';
1192 end;
1193 if ExecuteRenewOrders(SelectedList) then
1194 begin
1195 AddSelectedToChanges(SelectedList);
1196 ResetSelectedForList(ActiveList);
1197 SynchListToOrders(ActiveList, SelectedList);
1198 end;
1199 end;
1200 finally
1201 ActiveList.SetFocus;
1202 FIterating := False;
1203 SelectedList.Free;
1204 UnlockIfAble;
1205 end;
1206end;
1207
1208procedure TfrmMeds.mnuActChangeClick(Sender: TObject);
1209{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1210{ similar to action on fOrders}
1211var
1212 i: Integer;
1213 ActiveList: TListBox;
1214 SelectedList: TList;
1215 ChangeIFNList: TStringList;
1216 DelayEvent: TOrderDelayEvent;
1217begin
1218 inherited;
1219 if not EncounterPresentEDO then Exit;
1220 ActiveList := ListSelected(TX_NOSEL);
1221 if ActiveList = nil then Exit;
1222 DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders
1223 DelayEvent.Specialty := 0;
1224 DelayEvent.Effective := 0;
1225 DelayEvent.EventIFN := 0;
1226 SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly
1227 ChangeIFNList := TStringList.Create;
1228 try
1229 FIterating := true;
1230 if CheckMedStatus(ActiveList) = True then Exit;
1231 ValidateSelected(ActiveList, OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
1232 MakeSelectedList(Activelist, SelectedList);
1233 with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
1234 if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL)
1235 then ChangeOrders(ChangeIFNList, DelayEvent);
1236 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1237 Activelist.SetFocus;
1238 finally
1239 SelectedList.Free;
1240 ChangeIFNList.Free;
1241 end;
1242end;
1243
1244procedure TfrmMeds.mnuActCopyClick(Sender: TObject);
1245{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1246{ similar to action on fOrders}
1247//const
1248//CP_TXT = 'copied'; <-- original line. //kt 7/19/2007
1249//XF_TXT = 'transfered'; <-- original line. //kt 7/19/2007
1250var
1251 i: Integer;
1252 LimitEvent: Char;
1253 ActiveList: TListBox;
1254 SelectedList: TList;
1255 CopyIFNList: TStringList;
1256 TempEvent,DelayEvent: TOrderDelayEvent;
1257 ActName, radTxt,thePtEvtID, AuthErr: string;
1258 IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean;
1259 CP_TXT : string; //kt
1260 XF_TXT : string; //kt
1261
1262begin
1263 CP_TXT := DKLangConstW('fMeds_copied'); //kt added 7/19/2007
1264 XF_TXT := DKLangConstW('fMeds_transfered'); //kt added 7/19/2007
1265 inherited;
1266 AuthErr := '';
1267 ActName := '';
1268 if not EncounterPresentEDO then Exit;
1269 CheckAuthForMeds(AuthErr);
1270 if (Length(AuthErr)>0) then
1271 begin
1272 ShowMessage(AuthErr);
1273 if not EncounterPresent then Exit;
1274 end;
1275 if not FActionOnMedsTab then
1276 FActionOnMedsTab := True;
1277 DelayEvent.EventType := #0;
1278 DelayEvent.EventIFN := 0;
1279 DelayEvent.EventName := '';
1280 DelayEvent.Specialty := 0;
1281 DelayEvent.Effective := 0;
1282 DelayEvent.PtEventIFN := 0;
1283 DelayEvent.TheParent := TParentEvent.Create;
1284 DelayEvent.IsNewEvent := False;
1285 TempEvent := DelayEvent;
1286 DoesDestEvtOccur := False;
1287 ActiveList := ListSelected(TX_NOSEL);
1288 if CheckMedStatus(ActiveList) = True then Exit;
1289 if ActiveList = nil then Exit;
1290 NewOrderCreated := False;
1291 if frmOrders.lstSheets.ItemIndex >= 0 then
1292 begin
1293 frmOrders.lstSheets.ItemIndex := 0;
1294 frmOrders.lstSheetsClick(Application);
1295 end;
1296 LimitEvent := #0;
1297 if TComponent(Sender).Name = 'mnuActTransfer' then
1298 begin
1299// ActName := 'Transfer'; <-- original line. //kt 7/19/2007
1300 ActName := DKLangConstW('fMeds_Transfer'); //kt added 7/19/2007
1301 IsTransferAction := True;
1302 radTxt := XF_TXT;
1303 if ActiveList = lstMedsOut then
1304 begin
1305 if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A';
1306 XferOutToInOnMeds := True;
1307 end;
1308 if ActiveList = lstMedsIn then
1309 begin
1310 if Patient.Inpatient then LimitEvent := 'D' else
1311 begin
1312 LimitEvent := 'C';
1313 XfInToOutNow := True;
1314 end;
1315 XferOutToInOnMeds := False;
1316 end;
1317 end else
1318 radTxt := CP_TXT;
1319 SelectedList := TList.Create; // temporary until able to create CopyIFNList directly
1320 CopyIFNList := TStringList.Create;
1321 try
1322 MakeSelectedList(Activelist, SelectedList, ActName);
1323 {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then
1324 Exit;}
1325 with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID);
1326 if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
1327 begin
1328 IsNewEvent := False;
1329 if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then
1330 begin
1331 if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then
1332 XferOutToInOnMeds := True;
1333 TempEvent.PtEventIFN := DelayEvent.PtEventIFN;
1334 TempEvent.EventName := DelayEvent.EventName;
1335 if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then
1336 begin
1337 DelayEvent.EventType := 'C';
1338 DelayEvent.PtEventIFN := 0;
1339 DelayEvent.EventName := '';
1340 DelayEvent.EventIFN := 0;
1341 DelayEvent.TheParent := TParentEvent.Create;
1342 DoesDestEvtOccur := True;
1343 needVerify := false;
1344 CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify);
1345 if XferOutToInOnMeds then
1346 XferOutToInOnMeds := False;
1347 if frmOrders <> nil then
1348 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName);
1349 Exit;
1350 end;
1351 if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then
1352 begin
1353 needVerify := False;
1354 uAutoAC := True;
1355 end else
1356 begin
1357 needVerify := True;
1358 uAutoAC := False;
1359 end;
1360 if LimitEvent = #0 then
1361 begin
1362 if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1363 NewOrderCreated := True;
1364 if ImmdCopyAct then
1365 ImmdCopyAct := False;
1366 end else
1367 begin
1368 if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1369 NewOrderCreated := True;
1370 end;
1371 if XferOutToInOnMeds then
1372 XferOutToInOnMeds := False;
1373 if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then
1374 frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0);
1375 if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then
1376 if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then
1377 begin
1378 if PtEvtEmpty(ThePtEvtID) then
1379 begin
1380 DeletePtEvent(ThePtEvtID);
1381 frmOrders.ChangesUpdate(ThePtEvtID);
1382 frmOrders.EventDefaultOrder := '';
1383 frmOrders.InitOrderSheetsForEvtDelay;
1384 if frmOrders.lstSheets.ItemIndex <> 0 then
1385 frmOrders.lstSheets.ItemIndex := 0;
1386 frmOrders.lstSheetsClick(Self);
1387 end;
1388 end;
1389 end;
1390 end;
1391 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1392 if IsTransferAction then
1393 IsTransferAction := False;
1394 if XferOuttoInOnMeds then
1395 XferOuttoInOnMeds := False;
1396 if XfInToOutNow then
1397 XfInToOutNow := False;
1398 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True);
1399 finally
1400 ActiveList.SetFocus;
1401 FActionOnMedsTab := False;
1402 uAutoAC := False;
1403 SelectedList.Free;
1404 CopyIFNList.Free;
1405 end;
1406end;
1407
1408procedure TfrmMeds.mnuActNewClick(Sender: TObject);
1409{ new med orders dependent on order dialog for inpatient or outpatient }
1410{ similar to lstWriteClick on fOrders}
1411var
1412 DialogInfo: string;
1413 DelayEvent: TOrderDelayEvent;
1414begin
1415 inherited;
1416 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1417 DelayEvent.Specialty := 0;
1418 DelayEvent.EventIFN := 0;
1419 DelayEvent.Effective := 0;
1420 frmOrders.DontCheck := True;
1421 frmOrders.lstSheets.ItemIndex := 0;
1422 frmOrders.lstSheetsClick(self);
1423 frmOrders.DontCheck := False;
1424 if not ReadyForNewOrder(DelayEvent) then Exit;
1425 frmOrders.DontCheck := True;
1426 frmOrders.lstSheets.ItemIndex := 0;
1427 frmOrders.lstSheetsClick(self);
1428 frmOrders.DontCheck := False;
1429 { get appropriate form, create the dialog form and show it }
1430 DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup
1431 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1432 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1433 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1434 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1435 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1436//else InfoBox('Unsupported dialog type', 'Error', MB_OK); <-- original line. //kt 7/19/2007
1437 else InfoBox(DKLangConstW('fMeds_Unsupported_dialog_type'), DKLangConstW('fMeds_Error'), MB_OK); //kt added 7/19/2007
1438 end; {case}
1439end;
1440
1441procedure TfrmMeds.mnuActRefillClick(Sender: TObject);
1442{ for selected orders, present refill dialog }
1443var
1444 ActiveList: TListBox;
1445 SelectedList: TList;
1446begin
1447 inherited;
1448 ActiveList := ListSelected(TX_NOSEL);
1449 if ActiveList = nil then Exit;
1450 SelectedList := TList.Create;
1451 if CheckMedStatus(ActiveList) = True then Exit;
1452 try
1453 FIterating := True;
1454 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1455 begin
1456 ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL);
1457 MakeSelectedList(ActiveList, SelectedList);
1458 if ExecuteRefillOrders(SelectedList) then
1459 begin
1460 ResetSelectedForList(ActiveList);
1461 SynchListToOrders(ActiveList, SelectedList);
1462 end;
1463 end;
1464 finally
1465 ActiveList.SetFocus;
1466 FIterating := False;
1467 SelectedList.Free;
1468 UnlockIfAble;
1469 end;
1470end;
1471
1472{ Action utilities --------------------------------------------------------------------------- }
1473
1474function TfrmMeds.ListSelected(const ErrMsg: string): TListBox;
1475{ return selected listbox - inpatient or outpatient }
1476begin
1477 Result := nil;
1478 if lstMedsOut.SelCount > 0 then Result := lstMedsOut
1479 else if lstMedsIn.SelCount > 0 then Result := lstMedsIn
1480 else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA;
1481 if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
1482end;
1483
1484procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
1485{ loop to validate action on each selected med order, deselect if not valid }
1486var
1487 i: Integer;
1488 OrderText, CurID: string;
1489 ErrMsg, AParentID: string;
1490 CheckedList,SomePharmacyOrders: TStringList;
1491 ChildOrder: TChildOD;
1492begin
1493 CheckedList := TStringList.Create;
1494 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1495 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
1496 begin
1497// if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then <-- original line. //kt 7/19/2007
1498 if (AnAction = 'RN') and (pos(DKLangConstW('fMeds_Active'),AListBox.Items[i])>0) and (AListBox.name = DKLangConstW('fMeds_lstMedsIn')) and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then //kt added 7/19/2007
1499 begin
1500 Selected[i] := False;
1501// MessageDlg('You cannot renew inpatient medication orders from a clinic location for selected patient.', mtWarning, [mbOK], 0); <-- original line. //kt 7/19/2007
1502 MessageDlg(DKLangConstW('fMeds_Cant_Renew'), mtWarning, [mbOK], 0); //kt 7-5-07
1503 end;
1504 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1505 if Length(CurID) > 0
1506 then CurID := Piece(CurID, U, 2)
1507 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1508 ValidateOrderAction(CurID, AnAction, ErrMsg);
1509 if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then
1510 begin
1511 InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK);
1512 Selected[i] := False;
1513 Continue;
1514 end;
1515 AParentID := '';
1516 if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then
1517 Selected[i] := False;
1518 if Length(AParentID)>0 then
1519 begin
1520 if ChildODList.IndexOf(CurID)< 0 then
1521 begin
1522 ChildOrder := TChildOD.Create;
1523 ChildOrder.ChildID := CurId;
1524 ChildOrder.ParentID := AParentID;
1525 ChildODList.AddObject(CurID, ChildOrder);
1526 end;
1527 end;
1528 if Length(ErrMsg) > 0 then
1529 begin
1530 OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2));
1531 InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK);
1532 Selected[i] := False;
1533 end;
1534 if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False;
1535 end;
1536end;
1537
1538procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string);
1539{ make a list of selected med orders }
1540var
1541 i,idx: Integer;
1542 AnOrder: TOrder;
1543 CurID,x: string;
1544 SomePharmacyOrders: TStringList;
1545 TempList: TStringList;
1546begin
1547 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1548 TempList := TStringList.Create;
1549 AList.Clear;
1550 with AListBox do for i := 0 to Items.Count - 1 do
1551 if Selected[i] then
1552 begin
1553 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1554 if Length(CurID) > 0
1555 then CurID := Piece(CurID, U, 2)
1556 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1557 AnOrder := GetOrderByIFN(CurID);
1558// if ActName = 'Transfer' then //imo <-- original line. //kt 7/19/2007
1559 if ActName = DKLangConstW('fMeds_Transfer') then //imo //kt added 7/19/2007
1560 begin
1561 if (AnOrder.DGroup = ClinDisp) then //imo
1562 begin
1563// x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transfered'; <-- original line. //kt 7/19/2007
1564 x := AnOrder.Text + #13#10 + DKLangConstW('fMeds_Clinic_Meds_Cant_Transfers'); //kt 7-5-07
1565// if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then <-- original line. //kt 7/19/2007
1566 if ShowMsgOn(Length(x) > 0, x, DKLangConstW('fMeds_Unable_to_Transfer')) then //kt 7-5-07
1567 begin
1568 AListBox.Selected[i] := False;
1569 Continue;
1570 end
1571 end;
1572 end;
1573 idx := ChildODList.IndexOf(AnOrder.ID);
1574 if idx > - 1 then
1575 AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID;
1576 if TempList.IndexOf(AnOrder.ID)= -1 then
1577 begin
1578 AList.Add(AnOrder);
1579 TempList.Add(AnOrder.ID);
1580 end;
1581 end;
1582 TempList.Clear;
1583end;
1584
1585procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList);
1586begin
1587 AListBox.Invalidate;
1588end;
1589
1590procedure TfrmMeds.popMedPopup(Sender: TObject);
1591begin
1592 inherited;
1593 if PatientStatusChanged then exit;
1594end;
1595
1596procedure TfrmMeds.mnuViewClick(Sender: TObject);
1597begin
1598 inherited;
1599 if PatientStatusChanged then exit;
1600end;
1601
1602procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject);
1603var
1604 i: integer;
1605begin
1606 inherited;
1607 if PatientStatusChanged then exit;
1608 with lstMedsIn do for i := 0 to Items.Count -1 do
1609 Selected[i] := false;
1610 with lstMedsOut do for i := 0 to Items.Count -1 do
1611 Selected[i] := false;
1612end;
1613
1614procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject);
1615begin
1616 inherited;
1617 mnuViewDetailClick(Self);
1618end;
1619
1620procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject);
1621begin
1622 inherited;
1623 if not FIterating then ResetSelectedForList(TListBox(Sender));
1624end;
1625
1626procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1627begin
1628 inherited;
1629 RedrawSuspend(Self.Handle);
1630 with lstMedsNonVA do
1631 begin
1632 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1633 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1634 end;
1635 RedrawActivate(Self.Handle);
1636 lstMedsNonVA.Invalidate;
1637 Refresh;
1638end;
1639
1640function FontChanged : boolean;
1641//CQ9182: SEE ALSO procedure TfrmFrame.mnuFontSizeClick()
1642begin
1643 Result := false;
1644 if Assigned(frmMeds) then
1645 begin
1646 if fMeds.oldFont = 0 then Result := False
1647 else
1648 if (fMeds.oldFont <> MainFontSize) then
1649 Result := true;
1650 end;
1651end;
1652
1653procedure TfrmMeds.FormResize(Sender: TObject);
1654var
1655 maxPanelHeight: integer;
1656
1657begin
1658 inherited;
1659 if Assigned(frmMeds) then
1660 begin
1661 //CQ9522 v26.51 Make sure all three panels are visible regardless of font size
1662 if Assigned(self.Parent) then
1663 begin
1664 if self.Height > parent.ClientHeight then
1665 self.Height := parent.ClientHeight;
1666 maxPanelHeight := round((parent.ClientHeight-20)/3);
1667 if pnlTop.Height + pnlBottom.Height > parent.ClientHeight then
1668 begin
1669 pnlBottom.Height := maxPanelHeight*2;
1670 pnlTop.Height := maxPanelHeight;
1671 end;
1672 end; //assigned(self.parent)
1673 end;
1674end;
1675
1676{ TChildOD }
1677
1678constructor TChildOD.Create;
1679begin
1680 ChildID := '';
1681 ParentID := '';
1682end;
1683
1684procedure TfrmMeds.hdrMedsOutResize(Sender: TObject);
1685begin
1686 inherited;
1687 with hdrMedsOut do
1688 begin
1689 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1690 Invalidate;
1691 end;
1692end;
1693
1694procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject);
1695begin
1696 inherited;
1697 with hdrMedsNonVA do
1698 begin
1699 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1700 Invalidate;
1701 end;
1702end;
1703
1704procedure TfrmMeds.hdrMedsInResize(Sender: TObject);
1705begin
1706 inherited;
1707 with hdrMedsIn do
1708 begin
1709 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1710 Invalidate;
1711 end;
1712end;
1713
1714procedure TfrmMeds.FormShow(Sender: TObject);
1715begin
1716 inherited;
1717 frmMeds.FormResize(Sender);
1718end;
1719
1720procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1721begin
1722 inherited;
1723 frmMeds.FormResize(Sender);
1724end;
1725
1726procedure TfrmMeds.splitBottomMoved(Sender: TObject);
1727begin
1728 inherited;
1729 splitBottom.Height := 5;
1730end;
1731
1732procedure TfrmMeds.splitTopMoved(Sender: TObject);
1733begin
1734 inherited;
1735 splitTop.Height := 5;
1736end;
1737
1738procedure TfrmMeds.InitfMedsSize;
1739var
1740 retList : TStringList;
1741 strSizeFlds,x: string;
1742 i: integer;
1743 medsSplitFnd : boolean;
1744 panelBottom, panelMedIn : integer;
1745begin
1746 SetupVars; //kt added 7/19/2007 to replace constants with vars.
1747 //CQ3229
1748 //DETECT 1st TIME USER.
1749 //If first time user (medSplitFound=false), then manually set panel heights.
1750 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
1751 medsSplitFnd := FALSE;
1752 if Assigned(frmMeds) then
1753 begin
1754 retList := TStringList.Create;
1755 tCallV(retList, 'ORWCH LOADALL', [nil]);
1756
1757 for i := 0 to retList.Count-1 do
1758 begin
1759 x := retList.strings[i];
1760 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
1761 begin
1762 medsSplitFnd := TRUE;
1763 Break;
1764 end;
1765 end;
1766
1767 if not medsSplitFnd then
1768 begin
1769 pnlBottom.Height := frmMeds.Height div 2;
1770 pnlMedIn.Height := pnlBottom.Height div 2;
1771 panelBottom := pnlBottom.Height;
1772 panelMedIn := pnlMedIn.Height;
1773 strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0';
1774 CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]);
1775 end;
1776 end;
1777
1778end;
1779
1780function TfrmMeds.PatientStatusChanged: boolean;
1781//kt const
1782 //kt 7-5-07 msgTxt1 = 'Patient status was changed from ';
1783 //kt 7-5-07 msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
1784 //GE CQ9537 - Change message text
1785 //kt 7-5-07 msgTxt3 = 'Patient has been admitted.';
1786 //kt 7-5-07 msgTxt4 = CRLF + 'You will be prompted to sign your orders. Any new orders subsequently' +
1787 //kt 7-5-07 CRLF + 'entered and signed will be directed to the inpatient staff.';
1788
1789var
1790 PtSelect: TPtSelect;
1791 IsInpatientNow: boolean;
1792 ptSts: string;
1793begin
1794 result := False;
1795 SelectPatient(Patient.DFN, PtSelect);
1796 IsInpatientNow := Length(PtSelect.Location) > 0;
1797 //GE CQ9537 - Change message text
1798 if Patient.Inpatient <> IsInpatientNow then
1799 begin
1800 if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0);
1801// if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
1802 if Patient.Inpatient then ptSts := DKLangConstW('fMeds_IP_to_OP'); //kt 7-5-07
1803 MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
1804 frmFrame.mnuFileRefreshClick(Application);
1805 Result := True;
1806 end;
1807end;
1808
1809function TfrmMeds.GetTotalSectionsWidth(Sender: TObject) : integer;
1810//CQ7586
1811//Return stored values of column widths
1812var
1813 i: integer;
1814begin
1815 Result := 0;
1816
1817 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1818 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1819 Result := Result + hdrMedsOut.Sections[i].Width;
1820
1821 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1822 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1823 Result := Result + hdrMedsIn.Sections[i].Width;
1824
1825 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1826 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1827 Result := Result + hdrMedsNonVA.Sections[i].Width;
1828end;
1829
1830procedure TfrmMeds.SetSectionWidths(Sender: TObject);
1831//CQ7586
1832//Copy values of column widths into array variables.
1833var
1834 i: integer;
1835begin
1836 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1837 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1838 OrigOutPtSecWidths[i] := hdrMedsOut.Sections[i].Width;
1839
1840 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1841 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1842 OrigInPtSecWidths[i] := hdrMedsIn.Sections[i].Width;
1843
1844 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1845 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1846 OrigNonVASecWidths[i] := hdrMedsNonVA.Sections[i].Width;
1847end;
1848
1849procedure TfrmMeds.hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1850begin
1851 inherited;
1852 Self.SetSectionWidths(Sender); //CQ7586
1853end;
1854
1855procedure TfrmMeds.hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1856begin
1857 inherited;
1858 Self.SetSectionWidths(Sender); //CQ7586
1859end;
1860
1861procedure TfrmMeds.hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1862begin
1863 inherited;
1864 Self.SetSectionWidths(Sender); //CQ7586
1865end;
1866
1867procedure TfrmMeds.hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1868//CQ7586
1869var
1870 i: integer;
1871 totalSectionsWidth, originalwidth: integer;
1872begin
1873 inherited;
1874 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1875 if totalSectionsWidth > lstMedsOut.Width - 5 then //could used any of the three list boxes here, since all are same width
1876 begin
1877 originalwidth := 0;
1878 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1879 originalwidth := originalwidth + OrigOutPtSecWidths[i];
1880 if originalwidth < totalSectionsWidth then
1881 begin
1882 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1883 hdrMedsOut.Sections[i].Width := OrigOutPtSecWidths[i];
1884 lstMedsOut.Invalidate;
1885 end;
1886 end;
1887 //CQ9622
1888 if hdrMedsOut.Sections[1].Width < 100 then
1889 begin
1890 hdrMedsOut.Sections[1].Width := 100;
1891 lstMedsOut.Refresh;
1892 end;
1893 //end CQ9622
1894 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
1895 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
1896end;
1897
1898procedure TfrmMeds.hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1899//CQ7586
1900var
1901 i: integer;
1902 totalSectionsWidth, originalwidth: integer;
1903begin
1904 inherited;
1905 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1906 if totalSectionsWidth > lstMedsNonVA.Width - 5 then //could used any of the three list boxes here, since all are same width
1907 begin
1908 originalwidth := 0;
1909 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1910 originalwidth := originalwidth + OrigNonVASecWidths[i];
1911 if originalwidth < totalSectionsWidth then
1912 begin
1913 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1914 hdrMedsNonVA.Sections[i].Width := OrigNonVASecWidths[i];
1915 lstMedsNonVA.Invalidate;
1916 end;
1917 end;
1918 //CQ9622
1919 if hdrMedsNonVA.Sections[1].Width < 100 then
1920 begin
1921 hdrMedsNonVA.Sections[1].Width := 100;
1922 lstMedsNonVA.Refresh;
1923 end;
1924 //end CQ9622
1925 pnlNonVA.Height := pnlNonVA.Height - 1; // forces autopanel resize
1926 pnlNonVA.Height := pnlNonVA.Height + 1; // forces autopanel resize
1927end;
1928
1929procedure TfrmMeds.hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1930//CQ7586
1931var
1932 i: integer;
1933 totalSectionsWidth, originalwidth: integer;
1934begin
1935 inherited;
1936 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1937 if totalSectionsWidth > lstMedsIn.Width - 5 then //could used any of the three list boxes here, since all are same width
1938 begin
1939 originalwidth := 0;
1940 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1941 originalwidth := originalwidth + OrigInPtSecWidths[i];
1942 if originalwidth < totalSectionsWidth then
1943 begin
1944 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1945 hdrMedsIn.Sections[i].Width := OrigInPtSecWidths[i];
1946 lstMedsIn.Invalidate;
1947 end;
1948 end;
1949 //CQ9622
1950 if hdrMedsIn.Sections[1].Width < 100 then
1951 begin
1952 hdrMedsIn.Sections[1].Width := 100;
1953 lstMedsIn.Refresh;
1954 end;
1955 //end CQ9622
1956 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
1957 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
1958end;
1959
1960procedure TfrmMeds.ClearChildODList;
1961var
1962 i: integer;
1963begin
1964 for i := 0 to ChildODList.count-1 do
1965 if(assigned(ChildODList.Objects[i])) then
1966 ChildODList.Objects[i].Free;
1967 ChildODList.Clear;
1968end;
1969
1970function TfrmMeds.CheckMedStatus(ActiveList: TListBox): boolean;
1971var
1972i: integer;
1973tmpList: TStringList;
1974Str: string;
1975AMed: TMedListRec;
1976AMedList: TList;
1977
1978begin
1979 result := False;
1980 tmpList:= TStringList.Create;
1981 if TMedListRec = nil then exit;
1982 AMedList := GetMedList(ActiveList);
1983 for i := 0 to ActiveList.Count - 1 do if ActiveList.Selected[i] then
1984 begin
1985 AMed := TMedListRec(AMedList[i]);
1986 str := Amed.PharmID + U + AMed.Status;
1987 tmpList.Add(Str);
1988 end;
1989 if tmpList <> nil then
1990 begin
1991 Result := GetMedStatus(tmpList);
1992 tmpList.Free;
1993 end;
1994 if Result = True then
1995 begin
1996// MessageDlg('The Medication status has change.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct medication status', mtWarning, [mbOK], 0); <-- original line. //kt 7/19/2007
1997 MessageDlg(DKLangConstW('fMeds_Med_Status_Changed') + #13#10#13 +
1998 DKLangConstW('fMeds_CPRS_needs_to'), mtWarning, [mbOK], 0); //kt 7-5-07
1999 frmFrame.mnuFileRefreshClick(Application);
2000 end;
2001end;
2002
2003(*procedure TfrmMeds.ActivateDeactiveRenew(AListBox: TListBox);
2004var
2005 i: Integer;
2006 CurID: string;
2007 SomePharmacyOrders: TStringList;
2008 tmpArr: TStringList;
2009begin
2010 tmpArr := TStringList.Create;
2011 SomePharmacyOrders := GetPharmacyOrders(AListBox);
2012 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
2013 begin
2014 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
2015 if Length(CurID) > 0 then CurID := Piece(CurID, U, 2)
2016 else CurID := Piece(SomePharmacyOrders[i], U, 2);
2017 tmpArr.Add(curID);
2018 end;
2019 if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr, AListBox);
2020end; *)
2021
2022procedure TfrmMeds.ViewInfo(Sender: TObject);
2023begin
2024 inherited;
2025 frmFrame.ViewInfo(Sender);
2026end;
2027
2028procedure TfrmMeds.mnuViewInformationClick(Sender: TObject);
2029begin
2030 inherited;
2031 mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
2032 mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
2033 mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
2034 mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
2035 mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
2036 mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
2037 mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
2038 mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
2039 mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
2040end;
2041
2042procedure TfrmMeds.mnuOptimizeFieldsClick(Sender: TObject);
2043var
2044 totalSectionsWidth, unit1, unit2, unit8: integer;
2045begin
2046 totalSectionsWidth := pnlTop.Width - 5;
2047 if totalSectionsWidth < 16 then exit;
2048 unit1 := (totalSectionsWidth div 16) - 1;
2049 unit2 := unit1 * 2;
2050 unit8 := unit1 * 8;
2051
2052 with hdrMedsNonVA do
2053 begin
2054 Sections[0].Width := unit1;
2055 Sections[1].Width := unit8;
2056 Sections[2].Width := unit2;
2057 Sections[3].Width := unit2;
2058 end;
2059 hdrMedsNonVASectionResize(hdrMedsNonVA, hdrMedsNonVA.Sections[0]);
2060 hdrMedsNonVA.Repaint;
2061
2062 with hdrMedsIn do
2063 begin
2064 Sections[0].Width := unit1;
2065 Sections[1].Width := unit8;
2066 Sections[2].Width := unit2;
2067 Sections[3].Width := unit2;
2068 Sections[4].Width := unit2;
2069 end;
2070 hdrMedsInSectionResize(hdrMedsIn, hdrMedsIn.Sections[0]);
2071 hdrMedsIn.Repaint;
2072 with hdrMedsOut do
2073 begin
2074 Sections[0].Width := unit1;
2075 Sections[1].Width := unit8;
2076 Sections[2].Width := unit2;
2077 Sections[3].Width := unit2;
2078 Sections[4].Width := unit2;
2079 Sections[5].Width := unit1;
2080 end;
2081 hdrMedsOutSectionResize(hdrMedsOut, hdrMedsOut.Sections[0]);
2082 hdrMedsOut.Repaint;
2083end;
2084
2085procedure TfrmMeds.hdrMedsOutSectionClick(HeaderControl: THeaderControl;
2086 Section: THeaderSection);
2087begin
2088 inherited;
2089 //if Section = hdrMedsOut.Sections[1] then
2090 mnuOptimizeFieldsClick(self);
2091end;
2092
2093procedure TfrmMeds.hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
2094 Section: THeaderSection);
2095begin
2096 inherited;
2097 //if Section = hdrMedsNonVA.Sections[1] then
2098 mnuOptimizeFieldsClick(self);
2099end;
2100
2101procedure TfrmMeds.hdrMedsInSectionClick(HeaderControl: THeaderControl;
2102 Section: THeaderSection);
2103begin
2104 inherited;
2105 //if Section = hdrMedsIn.Sections[1] then
2106 mnuOptimizeFieldsClick(self);
2107end;
2108
2109end.
2110
Note: See TracBrowser for help on using the repository browser.