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

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

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