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

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

Initial upload of TMG-CPRS 1.0.26.69
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
596
597 //DETECT 1st TIME USER.
598 //If first time user (medSplitFound=false), then manually set panel heights.
599 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
600 medsSplitFnd := FALSE;
601 if Assigned(frmMeds) then
602 begin
603 retList := TStringList.Create;
604 tCallV(retList, 'ORWCH LOADALL', [nil]);
605
606 for i := 0 to retList.Count-1 do
607 begin
608 x := retList.strings[i];
609 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
610 begin
611 medsSplitFnd := False;//TRUE;
612 Break;
613 end;
614 end;
615
616 if not medsSplitFnd then
617 begin
618 pnlBottom.Height := frmMeds.Height div 2;
619 pnlMedIn.Height := pnlBottom.Height div 2;
620 end;
621 end;
622
623 //CQ9622
624 if hdrMedsIn.Sections[1].Width < 100 then
625 begin
626 hdrMedsIn.Sections[1].Width := 100;
627 hdrMedsIn.Refresh;
628 end;
629 if hdrMedsNonVA.Sections[1].Width < 100 then
630 begin
631 hdrMedsNonVA.Sections[1].Width := 100;
632 lstMedsNonVA.Refresh;
633 end;
634 if hdrMedsOut.Sections[1].Width < 100 then
635 begin
636 hdrMedsOut.Sections[1].Width := 100;
637 hdrMedsOut.Refresh;
638 end;
639 //end CQ9622
640end;
641
642procedure TfrmMeds.FormDestroy(Sender: TObject);
643begin
644 inherited;
645 ClearChildODList;
646 ClearMedList(uMedListIn);
647 ClearMedList(uMedListOut);
648 ClearMedList(uMedListNonVA);
649 uMedListIn.Free;
650 uMedListOut.Free;
651 uMedListNonVA.Free;
652 uPendingChanges.Free;
653 uPharmacyOrdersIn.Free;
654 uPharmacyOrdersOut.Free;
655 uNonVAOrdersOut.Free;
656 ChildODList.Free;
657end;
658
659{ View menu events ------------------------------------------------------------------------- }
660
661procedure TfrmMeds.mnuViewDetailClick(Sender: TObject);
662var
663 AnID, ATitle, AnOrder: string;
664 AListBox: TListBox;
665 i,j,idx: Integer;
666 tmpList: TStringList;
667begin
668 SetupVars; //kt added 9/15/2007 to replace constants with vars.
669 inherited;
670 tmpList := TStringList.Create;
671 try
672 idx := 0;
673 AListBox := ListSelected(TX_NOSEL);
674 if AListBox = nil then Exit
675// else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details' <-- original line. //kt 9/15/2007
676 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_Outpatient_Medication_Details') //kt added 9/15/2007
677// else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Details' <-- original line. //kt 9/15/2007
678 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_Non_VA_Medication_Details') //kt added 9/15/2007
679// else ATitle := 'Inpatient Medication Details'; <-- original line. //kt 9/15/2007
680 else ATitle := DKLangConstW('fMeds_Inpatient_Medication_Details'); //kt added 9/15/2007
681 FIterating := True;
682 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
683 begin
684 AnID := Piece(Strings[i], U, 1);
685 if AnID <> '' then
686 begin
687 tmpList.Assign(DetailMedLM(AnID));
688 end;
689 AnOrder := Piece(Strings[i], U, 2);
690 if AnOrder <> '' then
691 begin
692 tmpList.Add('');
693 tmpList.Add(StringOfChar('=', 74));
694 tmpList.Add('');
695 tmpList.AddStrings(MedAdminHistory(AnOrder));
696 end;
697 if CheckOrderGroup(AnOrder)=1 then // if it's UD group
698 begin
699 for j := 0 to tmpList.Count - 1 do
700 begin
701 if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
702 begin
703 idx := j;
704 Break;
705 end;
706 end;
707 if idx > 0 then
708 tmpList.Delete(idx);
709 end;
710 if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True);
711 if frmFrame.CCOWDrivedChange then
712 Exit;
713 end;
714 FIterating := False;
715 ResetSelectedForList(AListBox);
716 AListBox.SetFocus;
717 finally
718 tmpList.Free;
719 end;
720end;
721
722procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject);
723var
724 ATitle, AnOrder: string;
725 AListBox: TListBox;
726 i: Integer;
727begin
728 SetupVars; //kt added 9/15/2007 to replace constants with vars.
729 inherited;
730 AListBox := ListSelected(TX_NOSEL);
731 if AListBox = nil then Exit
732//else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History' <-- original line. //kt 9/15/2007
733 else if AListBox = lstMedsOut then ATitle := DKLangConstW('fMeds_Outpatient_Medication_Administration_History') //kt added 9/15/2007
734//else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History' <-- original line. //kt 9/15/2007
735 else if AListBox = lstMedsNonVA then ATitle := DKLangConstW('fMeds_Non_VA_Medication_Documentation_History') //kt added 9/15/2007
736//else ATitle := 'Inpatient Medication Administration History'; <-- original line. //kt 9/15/2007
737 else ATitle := DKLangConstW('fMeds_Inpatient_Medication_Administration_History'); //kt added 9/15/2007
738 FIterating := True;
739 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
740 begin
741 AnOrder := Piece(Strings[i], U, 2);
742 if AnOrder <> '' then
743 ReportBox(MedAdminHistory(AnOrder), ATitle, True);
744 end;
745 FIterating := False;
746 ResetSelectedForList(AListBox);
747 AListBox.SetFocus;
748end;
749
750{ Listbox events --------------------------------------------------------------------------- }
751
752procedure TfrmMeds.RefreshMedLists;
753var
754 i: Integer;
755 AMed: TMedListRec;
756begin
757 lstMedsIn.Clear;
758 lstMedsOut.Clear;
759 lstMedsNonVA.Clear;
760//StatusText('Retrieving active medications...'); <-- original line. //kt 9/15/2007
761 StatusText(DKLangConstW('fMeds_Retrieving_active_medicationsxxx')); //kt added 9/15/2007
762 LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA);
763 uPharmacyOrdersIn.Clear;
764 uPharmacyOrdersOut.Clear;
765 uNonVAOrdersOut.Clear;
766 with uMedListIn do for i := 0 to Count - 1 do
767 begin
768 AMed := TMedListRec(Items[i]);
769 uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID);
770 lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed);
771 end;
772
773 with uMedListNonVA do for i := 0 to Count - 1 do
774 begin
775 AMed := TMedListRec(Items[i]);
776 uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
777 lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed);
778 end;
779
780 with uMedListOut do for i := 0 to Count - 1 do
781 begin
782 AMed := TMedListRec(Items[i]);
783 uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
784 lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed);
785 end;
786
787 StatusText('');
788end;
789
790function TfrmMeds.GetActionText(const AMed: TMedListRec): string;
791var
792 AnAction: string;
793 Abbreviation: string;
794begin
795 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
796 Abbreviation := Piece(AnAction, U, 1);
797 result := '';
798 if Length(Abbreviation) > 0 then
799 begin
800// if CharAt(Abbreviation, 1) = 'X' then result := 'Change' <-- original line. //kt 9/15/2007
801 if CharAt(Abbreviation, 1) = 'X' then result := DKLangConstW('fMeds_Change') //kt added 9/15/2007
802// else if Abbreviation = 'NW' then result := 'New' <-- original line. //kt 9/15/2007
803 else if Abbreviation = 'NW' then result := DKLangConstW('fMeds_New') //kt added 9/15/2007
804// else if Abbreviation = 'RN' then result := 'Renew' <-- original line. //kt 9/15/2007
805 else if Abbreviation = 'RN' then result := DKLangConstW('fMeds_Renew') //kt added 9/15/2007
806// else if Abbreviation = 'RF' then result := 'Refill' <-- original line. //kt 9/15/2007
807 else if Abbreviation = 'RF' then result := DKLangConstW('fMeds_Refill') //kt added 9/15/2007
808// else if Abbreviation = 'HD' then result := 'Hold' <-- original line. //kt 9/15/2007
809 else if Abbreviation = 'HD' then result := DKLangConstW('fMeds_Hold') //kt added 9/15/2007
810// else if Abbreviation = 'DL' then result := 'Deleted' <-- original line. //kt 9/15/2007
811 else if Abbreviation = 'DL' then result := DKLangConstW('fMeds_Deleted') //kt added 9/15/2007
812 else if Abbreviation = 'DC' then result := 'DC'
813 else result := Abbreviation;
814 end;
815end;
816
817function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string;
818var
819 AnAction: string;
820 Indent: integer;
821begin
822 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
823 result := AMed.Instruct;
824 // replace pharmacy text with order text if this is a change
825 if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3);
826//if AMed.IVFluid then Indent := Pos(#10 + 'in ', result) else Indent := Pos(#13, result); <-- original line. //kt 9/15/2007
827 if AMed.IVFluid then Indent := Pos(#10 + DKLangConstW('fMeds_in'), result) else Indent := Pos(#13, result); //kt added 9/15/2007
828 if Indent > 0 then
829 begin
830 if AMed.IVFluid then
831 begin
832 Detail := Copy(result, Indent + 1, Length(result));
833 result := Copy(result, 1, Indent - 1);
834 end else
835 begin
836 Detail := Copy(result, Indent + 2, Length(result));
837 result := Copy(result, 1, Indent - 1);
838 end;
839 end;
840end;
841
842function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
843begin
844 result := '';
845 Detail := '';
846//if AMed.Status = 'Suspended' then AMed.Status := 'Active/Susp'; //HDS00007547 PSI-03-033 Interim Solution. <-- original line. //kt 9/15/2007
847 if AMed.Status = DKLangConstW('fMeds_Suspended') then AMed.Status := DKLangConstW('fMeds_ActivexSusp'); //HDS00007547 PSI-03-033 Interim Solution. //kt added 9/15/2007
848 case Column of
849 0: result := GetActionText(AMed);
850 1: result := GetInstructText(AMed, Detail);
851// 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate); <-- original line. //kt 9/15/2007
852 2: result := FormatFMDateTime(DKLangConstW('fMeds_mmxddxyy'), AMed.StopDate); //kt added 9/15/2007
853 3: result := AMed.Status;
854 4:
855 begin
856 if AMed.Inpatient then
857 result := MixedCase(AMed.Location)
858 else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill);
859 end;
860 5: result := AMed.Refills;
861 else
862 end;
863end;
864
865function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string;
866var
867 AMed: TMedListRec;
868 AHeader: THeaderControl;
869 i: integer;
870 x, y: string;
871begin
872 Result := '';
873 AMed := TMedListRec(GetMedList(Control)[Index]);
874 AHeader := GetHeader(Control);
875 for i := 0 to AHeader.Sections.Count-1 do
876 begin
877 x := GetListText(AMed, i, y);
878 if (x <> '') or (y <> '') then
879 Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF;
880 end;
881 Result := Trim(Result);
882end;
883
884function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl;
885begin
886 case Control.Tag of
887 TAG_OUTPT: result := hdrMedsOut;
888 TAG_NONVA: result := hdrMedsNonVA;
889 TAG_INPT: result := hdrMedsIn;
890
891 else
892 result := nil;
893 end;
894end;
895
896function TFrmMeds.GetMedList(Control: TWinControl): TList;
897begin
898 case Control.Tag of
899 TAG_OUTPT: result := uMedListOut;
900 TAG_NONVA: result := uMedListNonVA;
901 TAG_INPT: result := uMedListIn;
902 else
903 result := nil;
904 end;
905end;
906
907function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList;
908begin
909 case Control.Tag of
910 TAG_OUTPT: result := uPharmacyOrdersOut;
911 TAG_NONVA: result := uNonVAOrdersOut;
912 TAG_INPT: result := uPharmacyOrdersIn;
913 else
914 result := nil;
915 end;
916end;
917
918procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer;
919 var AHeight: Integer);
920var
921 NewHeight, RecRight: Integer;
922 AMed: TMedListRec;
923 AHeader: THeaderControl;
924 AMedList: TList;
925 ARect: TRect;
926 x, y, AnAction: string;
927begin
928 inherited;
929 NewHeight := AHeight;
930 AHeader := GetHeader(Control);
931 AMedList := GetMedList(Control);
932 with Control as TListBox do if Index < Items.Count then
933 begin
934 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
935 if AMed <> nil then
936 begin
937 ARect := ItemRect(Index);
938 ARect.Left := AHeader.Sections[0].Width + 2;
939 ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6;
940 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
941 if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold];
942 x := GetInstructText( AMed, y);
943 RecRight := ARect.Right;
944 NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
945 if(length(y)>0) then
946 begin
947 ARect.Left := AHeader.Sections[0].Width + FMT_INDENT;
948 ARect.Right := RecRight; // Draw Text alters ARect.
949 inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect));
950 end;
951 if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM*
952 if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM*
953 end; {if AMed}
954 end; {if Index}
955 AHeight := NewHeight;
956end;
957
958procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
959var
960 ReturnHt: Integer;
961 x, y, AnAction: string;
962 AMed: TMedListRec;
963 AMedList: TList;
964 AHeader: THeaderControl;
965 ARect: TRect;
966 i: integer;
967 RectLeft: integer;
968begin
969 inherited;
970 AHeader := GetHeader(Control);
971 AMedList := GetMedList(Control);
972 ListGridDrawLines(TListBox(Control), AHeader, Index, State);
973 with Control as TListBox do if Index < Items.Count then
974 begin
975 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
976 if AMed <> nil then
977 begin
978 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
979 if Length(AnAction) > 0 then
980 begin
981 Canvas.Font.Style := [fsBold];
982 //AGP Change 26.29 CQ #8188 Fix for highlighted new meds displaying blue font with a blue background.
983 if odSelected in State then
984 begin
985 Canvas.Brush.Color := clHighlight;
986 Canvas.Font.Color := clHighlightText;
987 //Canvas.FillRect(ARect);
988 Canvas.Font.Color := clWhite;
989 end;
990 if (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) and (Canvas.Font.Color <> clWhite) then
991 Canvas.Font.Color := clBlue;
992 if (Length(Piece(AnAction,'^',4)) > 0) then
993 AMed.Location := Piece(AnAction,'^',4);
994 end;
995 RectLeft := 0;
996 for i := 0 to AHeader.Sections.Count -1 do
997 begin
998 x := GetListText(AMed, i, y);
999 if Length(y) > 0 then
1000 begin
1001 ARect := ItemRect(Index);
1002 ARect.Left := RectLeft + 2;
1003 ARect.Right := (ARect.Left + AHeader.Sections[i].Width - 6);
1004
1005 //if ((ARect.Right - ARect.Left) < 100) then
1006 //ARect.Right := ARect.Right + (100 - (ARect.Left + AHeader.Sections[i].Width - 6));
1007
1008 ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
1009 or DT_WORDBREAK);
1010 ARect.Left := RectLeft + FMT_INDENT;
1011 ARect.Top := ARect.Top + ReturnHt;
1012 DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX
1013 or DT_WORDBREAK);
1014 end
1015 else
1016 ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1);
1017 Inc(RectLeft, AHeader.Sections[i].Width);
1018 end;
1019 end; {if AMed}
1020 end; {if Index}
1021end;
1022
1023procedure TfrmMeds.lstMedsExit(Sender: TObject);
1024begin
1025 inherited;
1026 if not FIterating then ResetSelectedForList(TListBox(Sender));
1027end;
1028
1029procedure TfrmMeds.lstMedsDblClick(Sender: TObject);
1030begin
1031 inherited;
1032 mnuViewDetailClick(Self);
1033end;
1034
1035procedure TfrmMeds.lstMedsInClick(Sender: TObject);
1036var
1037 i: integer;
1038begin
1039 inherited;
1040
1041 if PatientStatusChanged then exit;
1042 with lstMedsOut do for i := 0 to Items.Count -1 do
1043 Selected[i] := false;
1044 with lstMedsNonVA do for i := 0 to Items.Count - 1 do
1045 Selected[i] := FALSE;
1046end;
1047
1048procedure TfrmMeds.lstMedsOutClick(Sender: TObject);
1049var
1050 i: integer;
1051begin
1052 inherited;
1053
1054 if PatientStatusChanged then exit;
1055 with lstMedsIn do for i := 0 to Items.Count -1 do
1056 Selected[i] := false;
1057 with lstMedsNonVA do for i := 0 to Items.Count -1 do
1058 Selected[i] := false;
1059end;
1060
1061procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1062begin
1063 inherited;
1064 RedrawSuspend(Self.Handle);
1065 with lstMedsOut do
1066 begin
1067 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1068 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1069 end;
1070 RedrawActivate(Self.Handle);
1071 lstMedsOut.Invalidate;
1072 Refresh;
1073end;
1074
1075procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1076begin
1077 inherited;
1078 RedrawSuspend(Self.Handle);
1079 with lstMedsIn do
1080 begin
1081 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1082 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1083 end;
1084
1085 RedrawActivate(Self.Handle);
1086 lstMedsIn.Invalidate;
1087 Refresh;
1088end;
1089
1090{ Action menu events ---------------------------------------------------------------------- }
1091
1092procedure TfrmMeds.mnuActClick(Sender: TObject);
1093begin
1094 inherited;
1095 if PatientStatusChanged then exit;
1096 if lstMedsOut.SelCount > 0 then
1097 begin
1098// mnuActTransfer.Caption := 'Transfer to Inpatient...'; <-- original line. //kt 9/15/2007
1099 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_Inpatientxxx'); //kt added 9/15/2007
1100 mnuActTransfer.Enabled := True;
1101 end
1102 else if lstMedsIn.SelCount > 0 then
1103 begin
1104// mnuActTransfer.Caption := 'Transfer to Outpatient...'; <-- original line. //kt 9/15/2007
1105 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_to_Outpatientxxx'); //kt added 9/15/2007
1106 mnuActTransfer.Enabled := True;
1107 end
1108 else
1109 begin
1110// mnuActTransfer.Caption := 'Transfer to...'; <-- original line. //kt 9/15/2007
1111 mnuActTransfer.Caption := DKLangConstW('fMeds_Transfer_toxxx'); //kt added 9/15/2007
1112 mnuActTransfer.Enabled := False;
1113 end;
1114end;
1115
1116procedure TfrmMeds.mnuActDCClick(Sender: TObject);
1117{ discontinue/cancel/delete the selected med orders as appropriate for each order }
1118{ similar to action on fOrders}
1119var
1120 ActiveList: TListBox;
1121 SelectedList: TList;
1122 DelEvt: boolean;
1123begin
1124 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1125 inherited;
1126 DelEvt := False;
1127 ActiveList := ListSelected(TX_NOSEL);
1128 if ActiveList = nil then Exit;
1129 SelectedList := TList.Create;
1130 try
1131 FIterating := True;
1132 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1133 begin
1134 ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
1135 //ActivateDeactiveRenew(ActiveList); AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
1136 MakeSelectedList(ActiveList, SelectedList);
1137 if ExecuteDCOrders(SelectedList,DelEvt) then
1138 begin
1139 ResetSelectedForList(ActiveList);
1140 SynchListToOrders(ActiveList, SelectedList);
1141 end;
1142 if DelEvt then
1143 frmFrame.mnuFileRefreshClick(Self);
1144 end;
1145 finally
1146 FIterating := False;
1147 SelectedList.Free;
1148 UnlockIfAble;
1149 end;
1150end;
1151
1152procedure TfrmMeds.mnuActHoldClick(Sender: TObject);
1153{ hold the selected med orders as appropriate for each order }
1154{ similar to action on fOrders}
1155var
1156 ActiveList: TListBox;
1157 SelectedList: TList;
1158begin
1159 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1160 inherited;
1161 ActiveList := ListSelected(TX_NOSEL);
1162 if ActiveList = nil then Exit;
1163 SelectedList := TList.Create;
1164 if CheckMedStatus(ActiveList) = True then Exit;
1165 try
1166 FIterating := True;
1167 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1168 begin
1169 ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);
1170 MakeSelectedList(ActiveList, SelectedList);
1171 if ExecuteHoldOrders(SelectedList) then
1172 begin
1173 AddSelectedToChanges(SelectedList);
1174 ResetSelectedForList(ActiveList);
1175 SynchListToOrders(ActiveList, SelectedList);
1176 end;
1177 end;
1178 finally
1179 ActiveList.SetFocus;
1180 FIterating := False;
1181 SelectedList.Free;
1182 UnlockIfAble;
1183 end;
1184end;
1185
1186procedure TfrmMeds.mnuActRenewClick(Sender: TObject);
1187{ renew the selected med orders as appropriate for each order }
1188{ similar to action on fOrders}
1189var
1190 ActiveList: TListBox;
1191 SelectedList: TList;
1192 ParntOrder : TOrder;
1193begin
1194 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1195 inherited;
1196 ActiveList := ListSelected(TX_NOSEL);
1197 if ActiveList = nil then Exit;
1198 SelectedList := TList.Create;
1199 try
1200 FIterating := True;
1201 if CheckMedStatus(ActiveList) = True then Exit;
1202 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1203 begin
1204 ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);
1205 MakeSelectedList(ActiveList, SelectedList);
1206 if Length(FParentComplexOrderID)>0 then
1207 begin
1208 ParntOrder := GetOrderByIFN(FParentComplexOrderID);
1209 if CharAt(ParntOrder.Text,1)='+' then
1210 ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
1211// if Pos('First Dose NOW',ParntOrder.Text)>1 then <-- original line. //kt 9/15/2007
1212 if Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text)>1 then //kt added 9/15/2007
1213// Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW')); <-- original line. //kt 9/15/2007
1214 Delete(ParntOrder.text, Pos(DKLangConstW('fMeds_First_Dose_NOW'),ParntOrder.Text), Length(DKLangConstW('fMeds_First_Dose_NOW'))); //kt added 9/15/2007
1215 SelectedList.Add(ParntOrder);
1216 FParentComplexOrderID := '';
1217 end;
1218 if ExecuteRenewOrders(SelectedList) then
1219 begin
1220 AddSelectedToChanges(SelectedList);
1221 ResetSelectedForList(ActiveList);
1222 SynchListToOrders(ActiveList, SelectedList);
1223 end;
1224 end;
1225 finally
1226 ActiveList.SetFocus;
1227 FIterating := False;
1228 SelectedList.Free;
1229 UnlockIfAble;
1230 end;
1231end;
1232
1233procedure TfrmMeds.mnuActChangeClick(Sender: TObject);
1234{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1235{ similar to action on fOrders}
1236var
1237 i: Integer;
1238 ActiveList: TListBox;
1239 SelectedList: TList;
1240 ChangeIFNList: TStringList;
1241 DelayEvent: TOrderDelayEvent;
1242begin
1243 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1244 inherited;
1245 if not EncounterPresentEDO then Exit;
1246 ActiveList := ListSelected(TX_NOSEL);
1247 if ActiveList = nil then Exit;
1248 DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders
1249 DelayEvent.Specialty := 0;
1250 DelayEvent.Effective := 0;
1251 DelayEvent.EventIFN := 0;
1252 SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly
1253 ChangeIFNList := TStringList.Create;
1254 try
1255 FIterating := true;
1256 if CheckMedStatus(ActiveList) = True then Exit;
1257 ValidateSelected(ActiveList, OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
1258 MakeSelectedList(Activelist, SelectedList);
1259 with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
1260 if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL)
1261 then ChangeOrders(ChangeIFNList, DelayEvent);
1262 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1263 Activelist.SetFocus;
1264 finally
1265 SelectedList.Free;
1266 ChangeIFNList.Free;
1267 end;
1268end;
1269
1270procedure TfrmMeds.mnuActCopyClick(Sender: TObject);
1271{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1272{ similar to action on fOrders}
1273//const
1274//CP_TXT = 'copied'; <-- original line. //kt 9/15/2007
1275//XF_TXT = 'transfered'; <-- original line. //kt 9/15/2007
1276var
1277 i: Integer;
1278 LimitEvent: Char;
1279 ActiveList: TListBox;
1280 SelectedList: TList;
1281 CopyIFNList: TStringList;
1282 TempEvent,DelayEvent: TOrderDelayEvent;
1283 ActName, radTxt,thePtEvtID, AuthErr: string;
1284 IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean;
1285 CP_TXT : string; //kt
1286 XF_TXT : string; //kt
1287
1288begin
1289 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1290 CP_TXT := DKLangConstW('fMeds_copied'); //kt added 9/15/2007
1291 XF_TXT := DKLangConstW('fMeds_transfered'); //kt added 9/15/2007
1292
1293 inherited;
1294 AuthErr := '';
1295 ActName := '';
1296 if not EncounterPresentEDO then Exit;
1297 CheckAuthForMeds(AuthErr);
1298 if (Length(AuthErr)>0) then
1299 begin
1300 ShowMessage(AuthErr);
1301 if not EncounterPresent then Exit;
1302 end;
1303 if not FActionOnMedsTab then
1304 FActionOnMedsTab := True;
1305 DelayEvent.EventType := #0;
1306 DelayEvent.EventIFN := 0;
1307 DelayEvent.EventName := '';
1308 DelayEvent.Specialty := 0;
1309 DelayEvent.Effective := 0;
1310 DelayEvent.PtEventIFN := 0;
1311 DelayEvent.TheParent := TParentEvent.Create;
1312 DelayEvent.IsNewEvent := False;
1313 TempEvent := DelayEvent;
1314 DoesDestEvtOccur := False;
1315 ActiveList := ListSelected(TX_NOSEL);
1316 if CheckMedStatus(ActiveList) = True then Exit;
1317 if ActiveList = nil then Exit;
1318 NewOrderCreated := False;
1319 if frmOrders.lstSheets.ItemIndex >= 0 then
1320 begin
1321 frmOrders.lstSheets.ItemIndex := 0;
1322 frmOrders.lstSheetsClick(Application);
1323 end;
1324 LimitEvent := #0;
1325//if TComponent(Sender).Name = 'mnuActTransfer' then <-- original line. //kt 9/15/2007
1326 if TComponent(Sender).Name = DKLangConstW('fMeds_mnuActTransfer') then //kt added 9/15/2007
1327 begin
1328// ActName := 'Transfer'; <-- original line. //kt 9/15/2007
1329 ActName := DKLangConstW('fMeds_Transfer'); //kt added 9/15/2007
1330 IsTransferAction := True;
1331 radTxt := XF_TXT;
1332 if ActiveList = lstMedsOut then
1333 begin
1334 if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A';
1335 XferOutToInOnMeds := True;
1336 end;
1337 if ActiveList = lstMedsIn then
1338 begin
1339 if Patient.Inpatient then LimitEvent := 'D' else
1340 begin
1341 LimitEvent := 'C';
1342 XfInToOutNow := True;
1343 end;
1344 XferOutToInOnMeds := False;
1345 end;
1346 end else
1347 radTxt := CP_TXT;
1348 SelectedList := TList.Create; // temporary until able to create CopyIFNList directly
1349 CopyIFNList := TStringList.Create;
1350 try
1351 MakeSelectedList(Activelist, SelectedList, ActName);
1352// {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then <-- original line. //kt 9/15/2007
1353 {if (CopyIFNList.Count = 0) and (ActName = DKLangConstW('fMeds_Transfer')) then //kt added 9/15/2007
1354 Exit;}
1355 with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID);
1356 if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
1357 begin
1358 IsNewEvent := False;
1359 if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then
1360 begin
1361 if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then
1362 XferOutToInOnMeds := True;
1363 TempEvent.PtEventIFN := DelayEvent.PtEventIFN;
1364 TempEvent.EventName := DelayEvent.EventName;
1365 if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then
1366 begin
1367 DelayEvent.EventType := 'C';
1368 DelayEvent.PtEventIFN := 0;
1369 DelayEvent.EventName := '';
1370 DelayEvent.EventIFN := 0;
1371 DelayEvent.TheParent := TParentEvent.Create;
1372 DoesDestEvtOccur := True;
1373 needVerify := false;
1374 CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify);
1375 if XferOutToInOnMeds then
1376 XferOutToInOnMeds := False;
1377 if frmOrders <> nil then
1378 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName);
1379 Exit;
1380 end;
1381 if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then
1382 begin
1383 needVerify := False;
1384 uAutoAC := True;
1385 end else
1386 begin
1387 needVerify := True;
1388 uAutoAC := False;
1389 end;
1390 if LimitEvent = #0 then
1391 begin
1392 if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1393 NewOrderCreated := True;
1394 if ImmdCopyAct then
1395 ImmdCopyAct := False;
1396 end else
1397 begin
1398 if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1399 NewOrderCreated := True;
1400 end;
1401 if XferOutToInOnMeds then
1402 XferOutToInOnMeds := False;
1403 if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then
1404 frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0);
1405 if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then
1406 if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then
1407 begin
1408 if PtEvtEmpty(ThePtEvtID) then
1409 begin
1410 DeletePtEvent(ThePtEvtID);
1411 frmOrders.ChangesUpdate(ThePtEvtID);
1412 frmOrders.EventDefaultOrder := '';
1413 frmOrders.InitOrderSheetsForEvtDelay;
1414 if frmOrders.lstSheets.ItemIndex <> 0 then
1415 frmOrders.lstSheets.ItemIndex := 0;
1416 frmOrders.lstSheetsClick(Self);
1417 end;
1418 end;
1419 end;
1420 end;
1421 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1422 if IsTransferAction then
1423 IsTransferAction := False;
1424 if XferOuttoInOnMeds then
1425 XferOuttoInOnMeds := False;
1426 if XfInToOutNow then
1427 XfInToOutNow := False;
1428 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True);
1429 finally
1430 ActiveList.SetFocus;
1431 FActionOnMedsTab := False;
1432 uAutoAC := False;
1433 SelectedList.Free;
1434 CopyIFNList.Free;
1435 end;
1436end;
1437
1438procedure TfrmMeds.mnuActNewClick(Sender: TObject);
1439{ new med orders dependent on order dialog for inpatient or outpatient }
1440{ similar to lstWriteClick on fOrders}
1441var
1442 DialogInfo: string;
1443 DelayEvent: TOrderDelayEvent;
1444begin
1445 inherited;
1446 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1447 DelayEvent.Specialty := 0;
1448 DelayEvent.EventIFN := 0;
1449 DelayEvent.Effective := 0;
1450 frmOrders.DontCheck := True;
1451 frmOrders.lstSheets.ItemIndex := 0;
1452 frmOrders.lstSheetsClick(self);
1453 frmOrders.DontCheck := False;
1454 if not ReadyForNewOrder(DelayEvent) then Exit;
1455 frmOrders.DontCheck := True;
1456 frmOrders.lstSheets.ItemIndex := 0;
1457 frmOrders.lstSheetsClick(self);
1458 frmOrders.DontCheck := False;
1459 { get appropriate form, create the dialog form and show it }
1460 DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup
1461 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1462 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1463 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1464 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1465 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1466//else InfoBox('Unsupported dialog type', 'Error', MB_OK); <-- original line. //kt 9/15/2007
1467 else InfoBox(DKLangConstW('fMeds_Unsupported_dialog_type'), DKLangConstW('fMeds_Error'), MB_OK); //kt added 9/15/2007
1468 end; {case}
1469end;
1470
1471procedure TfrmMeds.mnuActRefillClick(Sender: TObject);
1472{ for selected orders, present refill dialog }
1473var
1474 ActiveList: TListBox;
1475 SelectedList: TList;
1476begin
1477 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1478 inherited;
1479 ActiveList := ListSelected(TX_NOSEL);
1480 if ActiveList = nil then Exit;
1481 SelectedList := TList.Create;
1482 if CheckMedStatus(ActiveList) = True then Exit;
1483 try
1484 FIterating := True;
1485 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1486 begin
1487 ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL);
1488 MakeSelectedList(ActiveList, SelectedList);
1489 if ExecuteRefillOrders(SelectedList) then
1490 begin
1491 ResetSelectedForList(ActiveList);
1492 SynchListToOrders(ActiveList, SelectedList);
1493 end;
1494 end;
1495 finally
1496 ActiveList.SetFocus;
1497 FIterating := False;
1498 SelectedList.Free;
1499 UnlockIfAble;
1500 end;
1501end;
1502
1503{ Action utilities --------------------------------------------------------------------------- }
1504
1505function TfrmMeds.ListSelected(const ErrMsg: string): TListBox;
1506{ return selected listbox - inpatient or outpatient }
1507begin
1508 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1509 Result := nil;
1510 if lstMedsOut.SelCount > 0 then Result := lstMedsOut
1511 else if lstMedsIn.SelCount > 0 then Result := lstMedsIn
1512 else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA;
1513 if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
1514end;
1515
1516procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
1517{ loop to validate action on each selected med order, deselect if not valid }
1518var
1519 i: Integer;
1520 OrderText, CurID: string;
1521 ErrMsg, AParentID: string;
1522 CheckedList,SomePharmacyOrders: TStringList;
1523 ChildOrder: TChildOD;
1524begin
1525 CheckedList := TStringList.Create;
1526 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1527 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
1528 begin
1529 if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
1530 begin
1531 Selected[i] := False;
1532// MessageDlg('You cannot renew inpatient medication orders from a clinic location for selected patient.', mtWarning, [mbOK], 0); <-- original line. //kt 9/15/2007
1533 MessageDlg(DKLangConstW('fMeds_You_cannot_renew_inpatient_medication_orders_from_a_clinic_location_for_selected_patientx'), mtWarning, [mbOK], 0); //kt added 9/15/2007
1534 end;
1535 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1536 if Length(CurID) > 0
1537 then CurID := Piece(CurID, U, 2)
1538 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1539 ValidateOrderAction(CurID, AnAction, ErrMsg);
1540 if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then
1541 begin
1542 InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK);
1543 Selected[i] := False;
1544 Continue;
1545 end;
1546 AParentID := '';
1547 if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then
1548 Selected[i] := False;
1549 if Length(AParentID)>0 then
1550 begin
1551 if ChildODList.IndexOf(CurID)< 0 then
1552 begin
1553 ChildOrder := TChildOD.Create;
1554 ChildOrder.ChildID := CurId;
1555 ChildOrder.ParentID := AParentID;
1556 ChildODList.AddObject(CurID, ChildOrder);
1557 end;
1558 end;
1559 if Length(ErrMsg) > 0 then
1560 begin
1561 OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2));
1562 InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK);
1563 Selected[i] := False;
1564 end;
1565 if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False;
1566 end;
1567end;
1568
1569procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string);
1570{ make a list of selected med orders }
1571var
1572 i,idx: Integer;
1573 AnOrder: TOrder;
1574 CurID,x: string;
1575 SomePharmacyOrders: TStringList;
1576 TempList: TStringList;
1577begin
1578 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1579 TempList := TStringList.Create;
1580 AList.Clear;
1581 with AListBox do for i := 0 to Items.Count - 1 do
1582 if Selected[i] then
1583 begin
1584 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1585 if Length(CurID) > 0
1586 then CurID := Piece(CurID, U, 2)
1587 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1588 AnOrder := GetOrderByIFN(CurID);
1589// if ActName = 'Transfer' then //imo <-- original line. //kt 9/15/2007
1590 if ActName = DKLangConstW('fMeds_Transfer') then //imo //kt added 9/15/2007
1591 begin
1592 if (AnOrder.DGroup = ClinDisp) then //imo
1593 begin
1594// x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transfered'; <-- original line. //kt 9/15/2007
1595 x := AnOrder.Text + #13#10 + DKLangConstW('fMeds_Clinic_medication_orders_can_not_be_transfered'); //kt added 9/15/2007
1596// if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then <-- original line. //kt 9/15/2007
1597 if ShowMsgOn(Length(x) > 0, x, DKLangConstW('fMeds_Unable_to_transferx')) then //kt added 9/15/2007
1598 begin
1599 AListBox.Selected[i] := False;
1600 Continue;
1601 end
1602 end;
1603 end;
1604 idx := ChildODList.IndexOf(AnOrder.ID);
1605 if idx > - 1 then
1606 AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID;
1607 if TempList.IndexOf(AnOrder.ID)= -1 then
1608 begin
1609 AList.Add(AnOrder);
1610 TempList.Add(AnOrder.ID);
1611 end;
1612 end;
1613 TempList.Clear;
1614end;
1615
1616procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList);
1617begin
1618 AListBox.Invalidate;
1619end;
1620
1621procedure TfrmMeds.popMedPopup(Sender: TObject);
1622begin
1623 inherited;
1624 if PatientStatusChanged then exit;
1625end;
1626
1627procedure TfrmMeds.mnuViewClick(Sender: TObject);
1628begin
1629 inherited;
1630 if PatientStatusChanged then exit;
1631end;
1632
1633procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject);
1634var
1635 i: integer;
1636begin
1637 inherited;
1638 if PatientStatusChanged then exit;
1639 with lstMedsIn do for i := 0 to Items.Count -1 do
1640 Selected[i] := false;
1641 with lstMedsOut do for i := 0 to Items.Count -1 do
1642 Selected[i] := false;
1643end;
1644
1645procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject);
1646begin
1647 inherited;
1648 mnuViewDetailClick(Self);
1649end;
1650
1651procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject);
1652begin
1653 inherited;
1654 if not FIterating then ResetSelectedForList(TListBox(Sender));
1655end;
1656
1657procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1658begin
1659 inherited;
1660 RedrawSuspend(Self.Handle);
1661 with lstMedsNonVA do
1662 begin
1663 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1664 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1665 end;
1666 RedrawActivate(Self.Handle);
1667 lstMedsNonVA.Invalidate;
1668 Refresh;
1669end;
1670
1671function FontChanged : boolean;
1672//CQ9182: SEE ALSO procedure TfrmFrame.mnuFontSizeClick()
1673begin
1674 Result := false;
1675 if Assigned(frmMeds) then
1676 begin
1677 if fMeds.oldFont = 0 then Result := False
1678 else
1679 if (fMeds.oldFont <> MainFontSize) then
1680 Result := true;
1681 end;
1682end;
1683
1684procedure TfrmMeds.FormResize(Sender: TObject);
1685var
1686 maxPanelHeight: integer;
1687
1688begin
1689 inherited;
1690 if Assigned(frmMeds) then
1691 begin
1692 //CQ9522 v26.51 Make sure all three panels are visible regardless of font size
1693 if Assigned(self.Parent) then
1694 begin
1695 if self.Height > parent.ClientHeight then
1696 self.Height := parent.ClientHeight;
1697 maxPanelHeight := round((parent.ClientHeight-20)/3);
1698 if pnlTop.Height + pnlBottom.Height > parent.ClientHeight then
1699 begin
1700 pnlBottom.Height := maxPanelHeight*2;
1701 pnlTop.Height := maxPanelHeight;
1702 end;
1703 end; //assigned(self.parent)
1704 end;
1705end;
1706
1707{ TChildOD }
1708
1709constructor TChildOD.Create;
1710begin
1711 ChildID := '';
1712 ParentID := '';
1713end;
1714
1715procedure TfrmMeds.hdrMedsOutResize(Sender: TObject);
1716begin
1717 inherited;
1718 with hdrMedsOut do
1719 begin
1720 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1721 Invalidate;
1722 end;
1723end;
1724
1725procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject);
1726begin
1727 inherited;
1728 with hdrMedsNonVA do
1729 begin
1730 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1731 Invalidate;
1732 end;
1733end;
1734
1735procedure TfrmMeds.hdrMedsInResize(Sender: TObject);
1736begin
1737 inherited;
1738 with hdrMedsIn do
1739 begin
1740 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1741 Invalidate;
1742 end;
1743end;
1744
1745procedure TfrmMeds.FormShow(Sender: TObject);
1746begin
1747 inherited;
1748 frmMeds.FormResize(Sender);
1749end;
1750
1751procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1752begin
1753 inherited;
1754 frmMeds.FormResize(Sender);
1755end;
1756
1757procedure TfrmMeds.splitBottomMoved(Sender: TObject);
1758begin
1759 inherited;
1760 splitBottom.Height := 5;
1761end;
1762
1763procedure TfrmMeds.splitTopMoved(Sender: TObject);
1764begin
1765 inherited;
1766 splitTop.Height := 5;
1767end;
1768
1769procedure TfrmMeds.InitfMedsSize;
1770var
1771 retList : TStringList;
1772 strSizeFlds,x: string;
1773 i: integer;
1774 medsSplitFnd : boolean;
1775 panelBottom, panelMedIn : integer;
1776begin
1777 SetupVars; //kt added 9/15/2007 to replace constants with vars.
1778 //CQ3229
1779 //DETECT 1st TIME USER.
1780 //If first time user (medSplitFound=false), then manually set panel heights.
1781 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
1782 medsSplitFnd := FALSE;
1783 if Assigned(frmMeds) then
1784 begin
1785 retList := TStringList.Create;
1786 tCallV(retList, 'ORWCH LOADALL', [nil]);
1787
1788 for i := 0 to retList.Count-1 do
1789 begin
1790 x := retList.strings[i];
1791 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
1792 begin
1793 medsSplitFnd := TRUE;
1794 Break;
1795 end;
1796 end;
1797
1798 if not medsSplitFnd then
1799 begin
1800 pnlBottom.Height := frmMeds.Height div 2;
1801 pnlMedIn.Height := pnlBottom.Height div 2;
1802 panelBottom := pnlBottom.Height;
1803 panelMedIn := pnlMedIn.Height;
1804 strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0';
1805 CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]);
1806 end;
1807 end;
1808
1809end;
1810
1811function TfrmMeds.PatientStatusChanged: boolean;
1812//const
1813//msgTxt1 = 'Patient status was changed from '; <-- original line. //kt 9/15/2007
1814//msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.'; <-- original line. //kt 9/15/2007
1815 //GE CQ9537 - Change message text
1816//msgTxt3 = 'Patient has been admitted.'; <-- original line. //kt 9/15/2007
1817//msgTxt4 = CRLF +'You will be prompted to sign your orders. Any new orders subsequently' + <-- original line. //kt 9/15/2007
1818// CRLF + 'entered and signed will be directed to the inpatient staff.'; <-- original line. //kt 9/15/2007
1819
1820var
1821 PtSelect: TPtSelect;
1822 IsInpatientNow: boolean;
1823 ptSts: string;
1824 msgTxt1 : string; //kt
1825 msgTxt2 : string; //kt
1826 msgTxt3 : string; //kt
1827 msgTxt4 : string; //kt
1828
1829begin
1830 msgTxt1 := DKLangConstW('fMeds_Patient_status_was_changed_from'); //kt added 9/15/2007
1831 msgTxt2 := DKLangConstW('fMeds_CPRS_needs_to_refresh_patient_information_to_display_patient_latest_recordx'); //kt added 9/15/2007
1832 //GE CQ9537 - Change message text
1833 msgTxt3 := DKLangConstW('fMeds_Patient_has_been_admittedx'); //kt added 9/15/2007
1834 msgTxt4 := CRLF +DKLangConstW('fMeds_You_will_be_prompted_to_sign_your_ordersx__Any_new_orders_subsequently') + //kt added 9/15/2007
1835 CRLF + DKLangConstW('fMeds_entered_and_signed_will_be_directed_to_the_inpatient_staffx'); //kt added 9/15/2007
1836 result := False;
1837 SelectPatient(Patient.DFN, PtSelect);
1838 IsInpatientNow := Length(PtSelect.Location) > 0;
1839 //GE CQ9537 - Change message text
1840 if Patient.Inpatient <> IsInpatientNow then
1841 begin
1842 if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0);
1843// if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.'; <-- original line. //kt 9/15/2007
1844 if Patient.Inpatient then ptSts := DKLangConstW('fMeds_Inpatient_to_Outpatientx'); //kt added 9/15/2007
1845 MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
1846 frmFrame.mnuFileRefreshClick(Application);
1847 Result := True;
1848 end;
1849end;
1850
1851function TfrmMeds.GetTotalSectionsWidth(Sender: TObject) : integer;
1852//CQ7586
1853//Return stored values of column widths
1854var
1855 i: integer;
1856begin
1857 Result := 0;
1858
1859 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1860 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1861 Result := Result + hdrMedsOut.Sections[i].Width;
1862
1863 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1864 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1865 Result := Result + hdrMedsIn.Sections[i].Width;
1866
1867 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1868 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1869 Result := Result + hdrMedsNonVA.Sections[i].Width;
1870end;
1871
1872procedure TfrmMeds.SetSectionWidths(Sender: TObject);
1873//CQ7586
1874//Copy values of column widths into array variables.
1875var
1876 i: integer;
1877begin
1878 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1879 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1880 OrigOutPtSecWidths[i] := hdrMedsOut.Sections[i].Width;
1881
1882 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1883 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1884 OrigInPtSecWidths[i] := hdrMedsIn.Sections[i].Width;
1885
1886 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1887 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1888 OrigNonVASecWidths[i] := hdrMedsNonVA.Sections[i].Width;
1889end;
1890
1891procedure TfrmMeds.hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1892begin
1893 inherited;
1894 Self.SetSectionWidths(Sender); //CQ7586
1895end;
1896
1897procedure TfrmMeds.hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1898begin
1899 inherited;
1900 Self.SetSectionWidths(Sender); //CQ7586
1901end;
1902
1903procedure TfrmMeds.hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1904begin
1905 inherited;
1906 Self.SetSectionWidths(Sender); //CQ7586
1907end;
1908
1909procedure TfrmMeds.hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1910//CQ7586
1911var
1912 i: integer;
1913 totalSectionsWidth, originalwidth: integer;
1914begin
1915 inherited;
1916 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1917 if totalSectionsWidth > lstMedsOut.Width - 5 then //could used any of the three list boxes here, since all are same width
1918 begin
1919 originalwidth := 0;
1920 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1921 originalwidth := originalwidth + OrigOutPtSecWidths[i];
1922 if originalwidth < totalSectionsWidth then
1923 begin
1924 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1925 hdrMedsOut.Sections[i].Width := OrigOutPtSecWidths[i];
1926 lstMedsOut.Invalidate;
1927 end;
1928 end;
1929 //CQ9622
1930 if hdrMedsOut.Sections[1].Width < 100 then
1931 begin
1932 hdrMedsOut.Sections[1].Width := 100;
1933 lstMedsOut.Refresh;
1934 end;
1935 //end CQ9622
1936 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
1937 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
1938end;
1939
1940procedure TfrmMeds.hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1941//CQ7586
1942var
1943 i: integer;
1944 totalSectionsWidth, originalwidth: integer;
1945begin
1946 inherited;
1947 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1948 if totalSectionsWidth > lstMedsNonVA.Width - 5 then //could used any of the three list boxes here, since all are same width
1949 begin
1950 originalwidth := 0;
1951 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1952 originalwidth := originalwidth + OrigNonVASecWidths[i];
1953 if originalwidth < totalSectionsWidth then
1954 begin
1955 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1956 hdrMedsNonVA.Sections[i].Width := OrigNonVASecWidths[i];
1957 lstMedsNonVA.Invalidate;
1958 end;
1959 end;
1960 //CQ9622
1961 if hdrMedsNonVA.Sections[1].Width < 100 then
1962 begin
1963 hdrMedsNonVA.Sections[1].Width := 100;
1964 lstMedsNonVA.Refresh;
1965 end;
1966 //end CQ9622
1967 pnlNonVA.Height := pnlNonVA.Height - 1; // forces autopanel resize
1968 pnlNonVA.Height := pnlNonVA.Height + 1; // forces autopanel resize
1969end;
1970
1971procedure TfrmMeds.hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1972//CQ7586
1973var
1974 i: integer;
1975 totalSectionsWidth, originalwidth: integer;
1976begin
1977 inherited;
1978 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1979 if totalSectionsWidth > lstMedsIn.Width - 5 then //could used any of the three list boxes here, since all are same width
1980 begin
1981 originalwidth := 0;
1982 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1983 originalwidth := originalwidth + OrigInPtSecWidths[i];
1984 if originalwidth < totalSectionsWidth then
1985 begin
1986 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1987 hdrMedsIn.Sections[i].Width := OrigInPtSecWidths[i];
1988 lstMedsIn.Invalidate;
1989 end;
1990 end;
1991 //CQ9622
1992 if hdrMedsIn.Sections[1].Width < 100 then
1993 begin
1994 hdrMedsIn.Sections[1].Width := 100;
1995 lstMedsIn.Refresh;
1996 end;
1997 //end CQ9622
1998 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
1999 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
2000end;
2001
2002procedure TfrmMeds.ClearChildODList;
2003var
2004 i: integer;
2005begin
2006 for i := 0 to ChildODList.count-1 do
2007 if(assigned(ChildODList.Objects[i])) then
2008 ChildODList.Objects[i].Free;
2009 ChildODList.Clear;
2010end;
2011
2012function TfrmMeds.CheckMedStatus(ActiveList: TListBox): boolean;
2013var
2014i: integer;
2015tmpList: TStringList;
2016Str: string;
2017AMed: TMedListRec;
2018AMedList: TList;
2019
2020begin
2021 result := False;
2022 tmpList:= TStringList.Create;
2023 if TMedListRec = nil then exit;
2024 AMedList := GetMedList(ActiveList);
2025 for i := 0 to ActiveList.Count - 1 do if ActiveList.Selected[i] then
2026 begin
2027 AMed := TMedListRec(AMedList[i]);
2028 str := Amed.PharmID + U + AMed.Status;
2029 tmpList.Add(Str);
2030 end;
2031 if tmpList <> nil then
2032 begin
2033 Result := GetMedStatus(tmpList);
2034 tmpList.Free;
2035 end;
2036 if Result = True then
2037 begin
2038// 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
2039 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
2040 frmFrame.mnuFileRefreshClick(Application);
2041 end;
2042end;
2043
2044(*procedure TfrmMeds.ActivateDeactiveRenew(AListBox: TListBox);
2045var
2046 i: Integer;
2047 CurID: string;
2048 SomePharmacyOrders: TStringList;
2049 tmpArr: TStringList;
2050begin
2051 tmpArr := TStringList.Create;
2052 SomePharmacyOrders := GetPharmacyOrders(AListBox);
2053 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
2054 begin
2055 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
2056 if Length(CurID) > 0 then CurID := Piece(CurID, U, 2)
2057 else CurID := Piece(SomePharmacyOrders[i], U, 2);
2058 tmpArr.Add(curID);
2059 end;
2060 if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr, AListBox);
2061end; *)
2062
2063procedure TfrmMeds.ViewInfo(Sender: TObject);
2064begin
2065 inherited;
2066 frmFrame.ViewInfo(Sender);
2067end;
2068
2069procedure TfrmMeds.mnuViewInformationClick(Sender: TObject);
2070begin
2071 inherited;
2072 mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
2073 mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
2074 mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
2075 mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
2076 mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
2077 mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
2078 mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
2079 mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
2080 mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
2081end;
2082
2083procedure TfrmMeds.mnuOptimizeFieldsClick(Sender: TObject);
2084var
2085 totalSectionsWidth, unit1, unit2, unit8: integer;
2086begin
2087 totalSectionsWidth := pnlTop.Width - 5;
2088 if totalSectionsWidth < 16 then exit;
2089 unit1 := (totalSectionsWidth div 16) - 1;
2090 unit2 := unit1 * 2;
2091 unit8 := unit1 * 8;
2092
2093 with hdrMedsNonVA do
2094 begin
2095 Sections[0].Width := unit1;
2096 Sections[1].Width := unit8;
2097 Sections[2].Width := unit2;
2098 Sections[3].Width := unit2;
2099 end;
2100 hdrMedsNonVASectionResize(hdrMedsNonVA, hdrMedsNonVA.Sections[0]);
2101 hdrMedsNonVA.Repaint;
2102
2103 with hdrMedsIn do
2104 begin
2105 Sections[0].Width := unit1;
2106 Sections[1].Width := unit8;
2107 Sections[2].Width := unit2;
2108 Sections[3].Width := unit2;
2109 Sections[4].Width := unit2;
2110 end;
2111 hdrMedsInSectionResize(hdrMedsIn, hdrMedsIn.Sections[0]);
2112 hdrMedsIn.Repaint;
2113 with hdrMedsOut do
2114 begin
2115 Sections[0].Width := unit1;
2116 Sections[1].Width := unit8;
2117 Sections[2].Width := unit2;
2118 Sections[3].Width := unit2;
2119 Sections[4].Width := unit2;
2120 Sections[5].Width := unit1;
2121 end;
2122 hdrMedsOutSectionResize(hdrMedsOut, hdrMedsOut.Sections[0]);
2123 hdrMedsOut.Repaint;
2124end;
2125
2126procedure TfrmMeds.hdrMedsOutSectionClick(HeaderControl: THeaderControl;
2127 Section: THeaderSection);
2128begin
2129 inherited;
2130 //if Section = hdrMedsOut.Sections[1] then
2131 mnuOptimizeFieldsClick(self);
2132end;
2133
2134procedure TfrmMeds.hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
2135 Section: THeaderSection);
2136begin
2137 inherited;
2138 //if Section = hdrMedsNonVA.Sections[1] then
2139 mnuOptimizeFieldsClick(self);
2140end;
2141
2142procedure TfrmMeds.hdrMedsInSectionClick(HeaderControl: THeaderControl;
2143 Section: THeaderSection);
2144begin
2145 inherited;
2146 //if Section = hdrMedsIn.Sections[1] then
2147 mnuOptimizeFieldsClick(self);
2148end;
2149
2150end.
2151
Note: See TracBrowser for help on using the repository browser.