[459] | 1 | unit fMeds;
|
---|
| 2 |
|
---|
| 3 | {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
|
---|
| 4 |
|
---|
| 5 | interface
|
---|
| 6 |
|
---|
| 7 | uses
|
---|
| 8 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 9 | fPage, StdCtrls, Menus, ORCtrls, ORFn, ExtCtrls, ComCtrls, rOrders, uConst,
|
---|
| 10 | rMeds, ORNet;
|
---|
| 11 |
|
---|
| 12 | type
|
---|
| 13 | TChildOD = class
|
---|
| 14 | public
|
---|
| 15 | ChildID: string;
|
---|
| 16 | ParentID: string;
|
---|
| 17 | constructor Create;
|
---|
| 18 | end;
|
---|
| 19 | TfrmMeds = class(TfrmPage)
|
---|
| 20 | mnuMeds: TMainMenu;
|
---|
| 21 | mnuView: TMenuItem;
|
---|
| 22 | mnuViewChart: TMenuItem;
|
---|
| 23 | mnuChartReports: TMenuItem;
|
---|
| 24 | mnuChartLabs: TMenuItem;
|
---|
| 25 | mnuChartDCSumm: TMenuItem;
|
---|
| 26 | mnuChartCslts: TMenuItem;
|
---|
| 27 | mnuChartNotes: TMenuItem;
|
---|
| 28 | mnuChartOrders: TMenuItem;
|
---|
| 29 | mnuChartMeds: TMenuItem;
|
---|
| 30 | mnuChartProbs: TMenuItem;
|
---|
| 31 | mnuChartCover: TMenuItem;
|
---|
| 32 | mnuAct: TMenuItem;
|
---|
| 33 | mnuActNew: TMenuItem;
|
---|
| 34 | Z1: TMenuItem;
|
---|
| 35 | mnuActChange: TMenuItem;
|
---|
| 36 | mnuActDC: TMenuItem;
|
---|
| 37 | mnuActHold: TMenuItem;
|
---|
| 38 | mnuActRenew: TMenuItem;
|
---|
| 39 | Z2: TMenuItem;
|
---|
| 40 | mnuViewActive: TMenuItem;
|
---|
| 41 | mnuViewExpiring: TMenuItem;
|
---|
| 42 | Z3: TMenuItem;
|
---|
| 43 | mnuViewSortClass: TMenuItem;
|
---|
| 44 | mnuViewSortName: TMenuItem;
|
---|
| 45 | Z4: TMenuItem;
|
---|
| 46 | mnuViewDetail: TMenuItem;
|
---|
| 47 | popMed: TPopupMenu;
|
---|
| 48 | popMedDetails: TMenuItem;
|
---|
| 49 | N1: TMenuItem;
|
---|
| 50 | popMedChange: TMenuItem;
|
---|
| 51 | popMedDC: TMenuItem;
|
---|
| 52 | popMedRenew: TMenuItem;
|
---|
| 53 | N2: TMenuItem;
|
---|
| 54 | popMedNew: TMenuItem;
|
---|
| 55 | mnuActCopy: TMenuItem;
|
---|
| 56 | mnuActRefill: TMenuItem;
|
---|
| 57 | mnuActTransfer: TMenuItem;
|
---|
| 58 | popMedRefill: TMenuItem;
|
---|
| 59 | mnuChartSurgery: TMenuItem;
|
---|
| 60 | mnuViewHistory: TMenuItem;
|
---|
| 61 | popMedHistory: TMenuItem;
|
---|
| 62 | pnlBottom: TORAutoPanel;
|
---|
| 63 | splitBottom: TSplitter;
|
---|
| 64 | pnlMedIn: TPanel;
|
---|
| 65 | lstMedsIn: TCaptionListBox;
|
---|
| 66 | hdrMedsIn: THeaderControl;
|
---|
| 67 | pnlNonVA: TPanel;
|
---|
| 68 | lstMedsNonVA: TCaptionListBox;
|
---|
| 69 | hdrMedsNonVA: THeaderControl;
|
---|
| 70 | splitTop: TSplitter;
|
---|
| 71 | pnlTop: TORAutoPanel;
|
---|
| 72 | lstMedsOut: TCaptionListBox;
|
---|
| 73 | hdrMedsOut: THeaderControl;
|
---|
| 74 | procedure mnuChartTabClick(Sender: TObject);
|
---|
| 75 | procedure FormCreate(Sender: TObject);
|
---|
| 76 | procedure FormDestroy(Sender: TObject);
|
---|
| 77 | procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer;
|
---|
| 78 | var AHeight: Integer);
|
---|
| 79 | procedure lstMedsDrawItem(Control: TWinControl; Index: Integer;
|
---|
| 80 | Rect: TRect; State: TOwnerDrawState);
|
---|
| 81 | procedure mnuViewDetailClick(Sender: TObject);
|
---|
| 82 | procedure lstMedsExit(Sender: TObject);
|
---|
| 83 | procedure lstMedsDblClick(Sender: TObject);
|
---|
| 84 | procedure lstMedsInClick(Sender: TObject);
|
---|
| 85 | procedure lstMedsOutClick(Sender: TObject);
|
---|
| 86 | procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl;
|
---|
| 87 | Section: THeaderSection);
|
---|
| 88 | procedure hdrMedsInSectionResize(HeaderControl: THeaderControl;
|
---|
| 89 | Section: THeaderSection);
|
---|
| 90 | procedure mnuActDCClick(Sender: TObject);
|
---|
| 91 | procedure mnuActHoldClick(Sender: TObject);
|
---|
| 92 | procedure mnuActRenewClick(Sender: TObject);
|
---|
| 93 | procedure mnuActChangeClick(Sender: TObject);
|
---|
| 94 | procedure mnuActCopyClick(Sender: TObject);
|
---|
| 95 | procedure mnuActNewClick(Sender: TObject);
|
---|
| 96 | procedure mnuActRefillClick(Sender: TObject);
|
---|
| 97 | procedure mnuActClick(Sender: TObject);
|
---|
| 98 | procedure pnlMedOut1Resize(Sender: TObject);
|
---|
| 99 | procedure mnuViewHistoryClick(Sender: TObject);
|
---|
| 100 | procedure popMedPopup(Sender: TObject);
|
---|
| 101 | procedure mnuViewClick(Sender: TObject);
|
---|
| 102 | procedure lstMedsNonVAClick(Sender: TObject);
|
---|
| 103 | procedure lstMedsNonVADblClick(Sender: TObject);
|
---|
| 104 | procedure lstMedsNonVAExit(Sender: TObject);
|
---|
| 105 | procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
|
---|
| 106 | Section: THeaderSection);
|
---|
| 107 | procedure FormResize(Sender: TObject);
|
---|
| 108 | procedure hdrMedsOutResize(Sender: TObject);
|
---|
| 109 | procedure hdrMedsNonVAResize(Sender: TObject);
|
---|
| 110 | procedure hdrMedsInResize(Sender: TObject);
|
---|
| 111 | procedure FormShow(Sender: TObject);
|
---|
| 112 | procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
| 113 | Shift: TShiftState; X, Y: Integer);
|
---|
| 114 | procedure splitBottomMoved(Sender: TObject);
|
---|
| 115 | procedure splitTopMoved(Sender: TObject);
|
---|
| 116 | private
|
---|
| 117 | FIterating: Boolean;
|
---|
| 118 | FActionOnMedsTab: Boolean;
|
---|
| 119 | FParentComplexOrderID: string;
|
---|
| 120 | uMedListIn: TList;
|
---|
| 121 | uMedListOut: TList;
|
---|
| 122 | uMedListNonVA: TList;
|
---|
| 123 | uPendingChanges: TStringList;
|
---|
| 124 | uDGrp: array[0..6] of Integer;
|
---|
| 125 | uPharmacyOrdersIn: TStringList;
|
---|
| 126 | uPharmacyOrdersOut: TStringList;
|
---|
| 127 | uNonVAOrdersOut: TStringList;
|
---|
| 128 | ChildODList: TStringList;
|
---|
| 129 | function ListSelected(const ErrMsg: string): TListBox;
|
---|
| 130 | procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
|
---|
| 131 | procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = '');
|
---|
| 132 | procedure SynchListToOrders(AListBox: TListBox; AList: TList);
|
---|
| 133 | function GetActionText(const AMed: TMedListRec): string;
|
---|
| 134 | function GetInstructText(const AMed: TMedListRec; var Detail: string): string;
|
---|
| 135 | function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
|
---|
| 136 | function GetPlainText(Control: TWinControl; Index: integer): string;
|
---|
| 137 | function GetHeader(Control: TWinControl): THeaderControl;
|
---|
| 138 | function GetMedList(Control: TWinControl): TList;
|
---|
| 139 | function GetPharmacyOrders(Control: TWinControl): TStringList;
|
---|
| 140 | public
|
---|
| 141 | function PctOfTotalHeight(thisPanel: TPanel) : integer;
|
---|
| 142 | procedure RefreshMedLists;
|
---|
| 143 | procedure ClearPtData; override;
|
---|
| 144 | procedure DisplayPage; override;
|
---|
| 145 | procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
|
---|
| 146 | procedure SetFontSize( FontSize: integer); override;
|
---|
| 147 | property ActionOnMedsTab: boolean read FActionOnMedsTab;
|
---|
| 148 | property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID;
|
---|
| 149 | procedure InitfMedsSize;
|
---|
| 150 | end;
|
---|
| 151 |
|
---|
| 152 | var
|
---|
| 153 | frmMeds: TfrmMeds;
|
---|
| 154 | // LargePanelPortion: Integer;
|
---|
| 155 | // SmallPanelPortion: integer;
|
---|
| 156 | MedOutSize: double;
|
---|
| 157 | s: string;
|
---|
| 158 | LargePanelSize: integer;
|
---|
| 159 | SmallPanelSize : integer;
|
---|
| 160 | MedNonVAPanelSize: integer;
|
---|
| 161 |
|
---|
| 162 | totalHeight: integer;
|
---|
| 163 | MedOutPctOfTotalHeight: integer;
|
---|
| 164 | NonVAPctOfTotalHeight: integer;
|
---|
| 165 | MedInpctOfTotalHeight : integer;
|
---|
| 166 |
|
---|
| 167 | resizedTotalHeight: integer;
|
---|
| 168 | resizedMedOutPanelHeight: Extended;
|
---|
| 169 | resizedNonVAPanelHeight: Extended;
|
---|
| 170 | resizedMedInPanelHeight: Extended;
|
---|
| 171 |
|
---|
| 172 | splitterTop: TSplitter;
|
---|
| 173 | splitterBottom: TSplitter;
|
---|
| 174 |
|
---|
| 175 | implementation
|
---|
| 176 |
|
---|
| 177 | uses uCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold,
|
---|
| 178 | fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase;
|
---|
| 179 |
|
---|
| 180 | {$R *.DFM}
|
---|
| 181 |
|
---|
| 182 | const
|
---|
| 183 | COL_MEDNAME = 1;
|
---|
| 184 | DG_OUT = 0;
|
---|
| 185 | DG_IN = 1;
|
---|
| 186 | DG_UD = 2;
|
---|
| 187 | DG_IV = 3;
|
---|
| 188 | DG_TPN = 4;
|
---|
| 189 | DG_NVA = 5;
|
---|
| 190 | DG_IMO = 6;
|
---|
| 191 | FMT_INDENT = 12;
|
---|
| 192 | TAG_OUTPT = 1;
|
---|
| 193 | TAG_INPT = 2;
|
---|
| 194 | TAG_NONVA = 3;
|
---|
| 195 | TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF +
|
---|
| 196 | 'you wish to take action on.';
|
---|
| 197 | TC_NOSEL = 'No Orders Selected';
|
---|
| 198 | TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ';
|
---|
| 199 | TC_NO_DC = 'Unable to Discontinue';
|
---|
| 200 | TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
|
---|
| 201 | TC_NO_RENEW = 'Unable to Renew Order';
|
---|
| 202 | TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ';
|
---|
| 203 | TC_NO_HOLD = 'Unable to Hold';
|
---|
| 204 | TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
|
---|
| 205 | TC_NO_COPY = 'Unable to Copy Order';
|
---|
| 206 | TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
|
---|
| 207 | TC_NO_CHANGE = 'Unable to Change Order';
|
---|
| 208 | TX_NO_REFILL = CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: ';
|
---|
| 209 | TC_NO_REFILL = 'Unable to Refill Order';
|
---|
| 210 | MEDS_SPLIT_FORM = 'frmMedsSplit';
|
---|
| 211 |
|
---|
| 212 | { TPage common methods --------------------------------------------------------------------- }
|
---|
| 213 |
|
---|
| 214 | procedure TfrmMeds.ClearPtData;
|
---|
| 215 | begin
|
---|
| 216 | inherited ClearPtData;
|
---|
| 217 | lstMedsIn.Clear;
|
---|
| 218 | lstMedsOut.Clear;
|
---|
| 219 | lstMedsNonVA.Clear;
|
---|
| 220 | ClearMedList(uMedListIn);
|
---|
| 221 | ClearMedList(uMedListOut);
|
---|
| 222 | ClearMedList(uMedListNonVA);
|
---|
| 223 | uPendingChanges.Clear;
|
---|
| 224 | uPharmacyOrdersIn.Clear;
|
---|
| 225 | uPharmacyOrdersOut.Clear;
|
---|
| 226 | uMedListNonVA.Clear;
|
---|
| 227 |
|
---|
| 228 | end;
|
---|
| 229 |
|
---|
| 230 | procedure TfrmMeds.DisplayPage;
|
---|
| 231 | const
|
---|
| 232 | RATIO_SMALL = 0.13; //0.1866;
|
---|
| 233 | begin
|
---|
| 234 | inherited DisplayPage;
|
---|
| 235 |
|
---|
| 236 | frmFrame.ShowHideChartTabMenus(mnuViewChart);
|
---|
| 237 |
|
---|
| 238 | if InitPage and User.NoOrdering then
|
---|
| 239 | begin
|
---|
| 240 | mnuAct.Enabled := False;
|
---|
| 241 | popMedChange.Enabled := False;
|
---|
| 242 | popMedDC.Enabled := False;
|
---|
| 243 | popMedRenew.Enabled := False;
|
---|
| 244 | popMedNew.Enabled := False;
|
---|
| 245 |
|
---|
| 246 | end;
|
---|
| 247 |
|
---|
| 248 | //Swap Inpatient/Outpatient list display positions depending in inpatient/outpatient status
|
---|
| 249 | if InitPage and User.DisableHold then
|
---|
| 250 | mnuActHold.Visible := False;
|
---|
| 251 |
|
---|
| 252 | if Patient.Inpatient then
|
---|
| 253 | begin
|
---|
| 254 | splitBottom.Align := alNone;
|
---|
| 255 | hdrMedsIn.Align := alNone;
|
---|
| 256 |
|
---|
| 257 | lstMedsIn.Parent := pnlTop;
|
---|
| 258 | lstMedsIn.Align := alClient;
|
---|
| 259 | lstMedsOut.Parent := pnlMedIn;
|
---|
| 260 |
|
---|
| 261 | hdrMedsIn.Parent := pnlTop;
|
---|
| 262 | hdrMedsIn.Align := alTop;
|
---|
| 263 |
|
---|
| 264 | hdrMedsOut.Parent := pnlMedIn;
|
---|
| 265 | splitBottom.Align := alBottom;
|
---|
| 266 | end
|
---|
| 267 | else
|
---|
| 268 | begin
|
---|
| 269 | splitBottom.Align := alNone;
|
---|
| 270 | hdrMedsIn.Align := alNone;
|
---|
| 271 |
|
---|
| 272 | lstMedsIn.Parent := pnlMedIn;
|
---|
| 273 | lstMedsOut.Parent := pnlTop;
|
---|
| 274 | lstMedsOut.Align := alClient;
|
---|
| 275 |
|
---|
| 276 | hdrMedsIn.Parent := pnlMedIn;
|
---|
| 277 | hdrMedsIn.Align := alTop;
|
---|
| 278 |
|
---|
| 279 | hdrMedsOut.Parent := pnlTop;
|
---|
| 280 | splitBottom.Align := alBottom;
|
---|
| 281 | end;
|
---|
| 282 |
|
---|
| 283 |
|
---|
| 284 | RefreshMedLists;
|
---|
| 285 |
|
---|
| 286 | end;
|
---|
| 287 |
|
---|
| 288 | procedure TfrmMeds.mnuChartTabClick(Sender: TObject);
|
---|
| 289 | begin
|
---|
| 290 | inherited;
|
---|
| 291 | frmFrame.mnuChartTabClick(Sender);
|
---|
| 292 | end;
|
---|
| 293 |
|
---|
| 294 | procedure TfrmMeds.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
|
---|
| 295 | var
|
---|
| 296 | AMedList: TList;
|
---|
| 297 | AStringList: TStringList;
|
---|
| 298 | NewMedRec: TMedListRec;
|
---|
| 299 | i, idx, Match: Integer;
|
---|
| 300 | j: integer;
|
---|
| 301 | AChildList: TStringlist;
|
---|
| 302 | CplxOrderID: string;
|
---|
| 303 |
|
---|
| 304 | procedure SetCurrentOrderID;
|
---|
| 305 | var
|
---|
| 306 | i: Integer;
|
---|
| 307 | AMedRec: TMedListRec;
|
---|
| 308 | begin
|
---|
| 309 | with AMedList do for i := 0 to Count - 1 do
|
---|
| 310 | begin
|
---|
| 311 | AMedRec := TMedListRec(AMedList[i]);
|
---|
| 312 | if Piece(AMedRec.OrderID, ';', 1) = Piece(AnOrder.ActionOn, ';', 1) then
|
---|
| 313 | begin
|
---|
| 314 | end;
|
---|
| 315 | end;
|
---|
| 316 | end;
|
---|
| 317 |
|
---|
| 318 | function IndexForCurrentID(const AnID: string): Integer;
|
---|
| 319 | var
|
---|
| 320 | i: Integer;
|
---|
| 321 | begin
|
---|
| 322 | Result := -1;
|
---|
| 323 | for i := 0 to uPendingChanges.Count - 1 do
|
---|
| 324 | if Piece(uPendingChanges[i], U, 2) = AnID then Result := i;
|
---|
| 325 | if Result < 0 then
|
---|
| 326 | for i := 0 to uPendingChanges.Count - 1 do
|
---|
| 327 | if Piece(uPendingChanges[i], '=', 1) = Piece(AnID, ';', 1) then Result := i;
|
---|
| 328 | end;
|
---|
| 329 |
|
---|
| 330 | begin
|
---|
| 331 | AMedList := nil;
|
---|
| 332 | if AnOrder <> nil then
|
---|
| 333 | begin
|
---|
| 334 | if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut;
|
---|
| 335 | for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
|
---|
| 336 | end;
|
---|
| 337 | case OrderAction of
|
---|
| 338 | ORDER_NEW: { sent by accept order on new order }
|
---|
| 339 | if AMedList <> nil then
|
---|
| 340 | begin
|
---|
| 341 | // check this out carefully!!
|
---|
| 342 | NewMedRec := TMedListRec.Create;
|
---|
| 343 | NewMedRec.OrderID := AnOrder.ID;
|
---|
| 344 | NewMedRec.Instruct := AnOrder.Text;
|
---|
| 345 | NewMedRec.Inpatient := AMedList = uMedListIn;
|
---|
| 346 | AMedList.Insert(0, NewMedRec);
|
---|
| 347 | if AMedList = uMedListIn then
|
---|
| 348 | begin
|
---|
| 349 | lstMedsIn.Items.Insert(0, GetPlainText(lstMedsIn,0));
|
---|
| 350 | uPharmacyOrdersIn.Insert(0, U + AnOrder.ID);
|
---|
| 351 | end
|
---|
| 352 | else
|
---|
| 353 | begin
|
---|
| 354 | if AMedList = uMedListOut then
|
---|
| 355 | begin
|
---|
| 356 | lstMedsOut.Items.Insert(0, GetPlainText(lstMedsOut,0));
|
---|
| 357 | uPharmacyOrdersOut.Insert(0, U + AnOrder.ID);
|
---|
| 358 | end
|
---|
| 359 | else
|
---|
| 360 | begin
|
---|
| 361 | if AMedList = uMedListNonVA then
|
---|
| 362 | begin
|
---|
| 363 | lstMedsNonVA.Items.Insert(0, GetPlainText(lstMedsNonVA,0));
|
---|
| 364 | uNonVAOrdersOut.Insert(0, U + AnOrder.ID);
|
---|
| 365 | end;
|
---|
| 366 | end;
|
---|
| 367 | end;
|
---|
| 368 | uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + '=NW^' + AnOrder.ID);
|
---|
| 369 | end;
|
---|
| 370 | ORDER_DC: { sent by a diet to cancel a tubefeeding - do nothing };
|
---|
| 371 | ORDER_EDIT: { sent by accept on edit order }
|
---|
| 372 | if AMedList <> nil then
|
---|
| 373 | begin
|
---|
| 374 | Match := IndexForCurrentID(AnOrder.EditOf);
|
---|
| 375 | if Match < 0
|
---|
| 376 | { add a new pending change if there is no existing change that matches EditOf }
|
---|
| 377 | then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName)
|
---|
| 378 | { leave 1st piece (original ID) intact, while changing text & current ID }
|
---|
| 379 | else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName;
|
---|
| 380 | end;
|
---|
| 381 | ORDER_ACT: { sent by DC, Hold, & Renew actions }
|
---|
| 382 | if AMedList <> nil then
|
---|
| 383 | begin
|
---|
| 384 | if Piece(AnOrder.ActionOn, '=', 2) = 'CA' then
|
---|
| 385 | begin
|
---|
| 386 | // cancel action, remove from PendingChanges
|
---|
| 387 | for idx := uPendingChanges.Count-1 downto 0 do
|
---|
| 388 | begin
|
---|
| 389 | Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
|
---|
| 390 | if Match > -1 then uPendingChanges.Delete(Match);
|
---|
| 391 | end;
|
---|
| 392 | end
|
---|
| 393 | else if Piece(AnOrder.ActionOn, '=', 2) = 'DL' then
|
---|
| 394 | begin
|
---|
| 395 | // delete action, show as deleted (set OrderID's to 0 so not confused with next order)
|
---|
| 396 | Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
|
---|
| 397 | if Match > -1 then uPendingChanges[Match] := '0=DL';
|
---|
| 398 | if AMedList = uMedListIn
|
---|
| 399 | then AStringList := uPharmacyOrdersIn
|
---|
| 400 | else if AMedList = uMedListOut
|
---|
| 401 | then AStringList := uPharmacyOrdersOut
|
---|
| 402 | else AStringList := uNonVAOrdersOut;
|
---|
| 403 | with AStringList do for i := 0 to Count - 1 do
|
---|
| 404 | if (U + Piece(AnOrder.ActionOn, '=', 1)) = Strings[i] then Strings[i] := '^0';
|
---|
| 405 | Match := -1;
|
---|
| 406 | with AMedList do for i := 0 to Count - 1 do
|
---|
| 407 | if TMedListRec(Items[i]).OrderID = Piece(AnOrder.ActionOn, '=', 1) then Match := i;
|
---|
| 408 | if Match > -1 then TMedListRec(AMedList.Items[Match]).OrderID := '0';
|
---|
| 409 | end
|
---|
| 410 | else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' +
|
---|
| 411 | Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
|
---|
| 412 | end; {if AMedList}
|
---|
| 413 | ORDER_CPLXRN:
|
---|
| 414 | begin
|
---|
| 415 | AChildList := TStringList.Create;
|
---|
| 416 | CplxOrderID := Piece(AnOrder.ActionOn,'=',1);
|
---|
| 417 | GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList);
|
---|
| 418 | if AMedList = uMedListIn then with AMedList do
|
---|
| 419 | begin
|
---|
| 420 | for i := Count-1 downto 0 do
|
---|
| 421 | begin
|
---|
| 422 | for j := 0 to AChildList.Count - 1 do
|
---|
| 423 | begin
|
---|
| 424 | if (TMedListRec(Items[i]).OrderID = AChildList[j]) then
|
---|
| 425 | begin
|
---|
| 426 | { Delete(i);
|
---|
| 427 | Break;}
|
---|
| 428 | if not IsFirstDoseNowOrder(TMedListRec(Items[i]).OrderID) then
|
---|
| 429 | begin
|
---|
| 430 | uPendingChanges.Add(Piece(TMedListRec(Items[i]).OrderID, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID);
|
---|
| 431 | Break;
|
---|
| 432 | end;
|
---|
| 433 | end;
|
---|
| 434 | end;
|
---|
| 435 | end;
|
---|
| 436 | end;
|
---|
| 437 | AChildList.Clear;
|
---|
| 438 | AChildList.Free;
|
---|
| 439 | end;
|
---|
| 440 | ORDER_SIGN: { sent by fReview, fOrderSign when orders signed, AnOrder=nil}
|
---|
| 441 | begin
|
---|
| 442 | // ** only if tab has been visited?
|
---|
| 443 | uPendingChanges.Clear;
|
---|
| 444 | RefreshMedLists;
|
---|
| 445 | end;
|
---|
| 446 | end; {case}
|
---|
| 447 | end;
|
---|
| 448 |
|
---|
| 449 | procedure TfrmMeds.SetFontSize( FontSize: integer);
|
---|
| 450 | begin
|
---|
| 451 | inherited SetFontSize(FontSize);
|
---|
| 452 | if Patient.DFN <> '' then
|
---|
| 453 | RefreshMedLists;
|
---|
| 454 | end;
|
---|
| 455 |
|
---|
| 456 | { Form events ------------------------------------------------------------------------------ }
|
---|
| 457 |
|
---|
| 458 | procedure TfrmMeds.FormCreate(Sender: TObject);
|
---|
| 459 | var
|
---|
| 460 | medsSplitFnd : boolean;
|
---|
| 461 | panelBottom, panelMedIn : integer;
|
---|
| 462 | retList : TStringList;
|
---|
| 463 | i: integer;
|
---|
| 464 | x: string;
|
---|
| 465 | begin
|
---|
| 466 | inherited;
|
---|
| 467 | PageID := CT_MEDS;
|
---|
| 468 | lstMedsIn.Color := ReadOnlyColor;
|
---|
| 469 | lstMedsOut.Color := ReadOnlyColor;
|
---|
| 470 | uMedListIn := TList.Create;
|
---|
| 471 | uMedListOut := TList.Create;
|
---|
| 472 | uMedListNonVA := TList.Create;
|
---|
| 473 | uPendingChanges := TStringList.Create;
|
---|
| 474 | uDGrp[DG_OUT] := DGroupIEN('O RX');
|
---|
| 475 | uDGrp[DG_IN] := DGroupIEN('I RX');
|
---|
| 476 | uDGrp[DG_UD] := DGroupIEN('UD RX');
|
---|
| 477 | uDGrp[DG_IV] := DGroupIEN('IV RX');
|
---|
| 478 | uDGrp[DG_TPN] := DGroupIEN('TPN');
|
---|
| 479 | uDGrp[DG_NVA] := DGroupIEN('NV RX');
|
---|
| 480 | uDGrp[DG_IMO] := DGroupIEN('C RX');
|
---|
| 481 | uPharmacyOrdersIn := TStringList.Create;
|
---|
| 482 | uPharmacyOrdersOut := TStringList.Create;
|
---|
| 483 | uNonVAOrdersOut := TStringList.Create;
|
---|
| 484 | FActionOnMedsTab := False;
|
---|
| 485 | FParentComplexOrderID := '';
|
---|
| 486 | ChildODList := TStringList.Create;
|
---|
| 487 |
|
---|
| 488 |
|
---|
| 489 | //DETECT 1st TIME USER.
|
---|
| 490 | //If first time user (medSplitFound=false), then manually set panel heights.
|
---|
| 491 | //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
|
---|
| 492 | medsSplitFnd := FALSE;
|
---|
| 493 | if Assigned(frmMeds) then
|
---|
| 494 | begin
|
---|
| 495 | retList := TStringList.Create;
|
---|
| 496 | tCallV(retList, 'ORWCH LOADALL', [nil]);
|
---|
| 497 |
|
---|
| 498 | for i := 0 to retList.Count-1 do
|
---|
| 499 | begin
|
---|
| 500 | x := retList.strings[i];
|
---|
| 501 | if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
|
---|
| 502 | begin
|
---|
| 503 | medsSplitFnd := TRUE;
|
---|
| 504 | Break;
|
---|
| 505 | end;
|
---|
| 506 | end;
|
---|
| 507 |
|
---|
| 508 | if not medsSplitFnd then
|
---|
| 509 | begin
|
---|
| 510 | pnlBottom.Height := frmMeds.Height div 2;
|
---|
| 511 | pnlMedIn.Height := pnlBottom.Height div 2;
|
---|
| 512 | panelBottom := pnlBottom.Height;
|
---|
| 513 | panelMedIn := pnlMedIn.Height;
|
---|
| 514 | end;
|
---|
| 515 | end;
|
---|
| 516 |
|
---|
| 517 |
|
---|
| 518 |
|
---|
| 519 | end;
|
---|
| 520 |
|
---|
| 521 | procedure TfrmMeds.FormDestroy(Sender: TObject);
|
---|
| 522 | begin
|
---|
| 523 | inherited;
|
---|
| 524 | ClearMedList(uMedListIn);
|
---|
| 525 | ClearMedList(uMedListOut);
|
---|
| 526 | ClearMedList(uMedListNonVA);
|
---|
| 527 | uMedListIn.Free;
|
---|
| 528 | uMedListOut.Free;
|
---|
| 529 | uMedListNonVA.Free;
|
---|
| 530 | uPendingChanges.Free;
|
---|
| 531 | uPharmacyOrdersIn.Free;
|
---|
| 532 | uPharmacyOrdersOut.Free;
|
---|
| 533 | uNonVAOrdersOut.Free;
|
---|
| 534 | ChildODList.Free;
|
---|
| 535 | end;
|
---|
| 536 |
|
---|
| 537 | { View menu events ------------------------------------------------------------------------- }
|
---|
| 538 |
|
---|
| 539 | procedure TfrmMeds.mnuViewDetailClick(Sender: TObject);
|
---|
| 540 | var
|
---|
| 541 | AnID, ATitle, AnOrder: string;
|
---|
| 542 | AListBox: TListBox;
|
---|
| 543 | i,j,idx: Integer;
|
---|
| 544 | tmpList: TStringList;
|
---|
| 545 | begin
|
---|
| 546 | inherited;
|
---|
| 547 | tmpList := TStringList.Create;
|
---|
| 548 | try
|
---|
| 549 | idx := 0;
|
---|
| 550 | AListBox := ListSelected(TX_NOSEL);
|
---|
| 551 | if AListBox = nil then Exit
|
---|
| 552 | else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details'
|
---|
| 553 | else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Details'
|
---|
| 554 | else ATitle := 'Inpatient Medication Details';
|
---|
| 555 | FIterating := True;
|
---|
| 556 | with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
|
---|
| 557 | begin
|
---|
| 558 | AnID := Piece(Strings[i], U, 1);
|
---|
| 559 | if AnID <> '' then
|
---|
| 560 | begin
|
---|
| 561 | tmpList.Assign(DetailMedLM(AnID));
|
---|
| 562 | end;
|
---|
| 563 | AnOrder := Piece(Strings[i], U, 2);
|
---|
| 564 | if AnOrder <> '' then
|
---|
| 565 | begin
|
---|
| 566 | tmpList.Add('');
|
---|
| 567 | tmpList.Add(StringOfChar('=', 74));
|
---|
| 568 | tmpList.Add('');
|
---|
| 569 | tmpList.AddStrings(MedAdminHistory(AnOrder));
|
---|
| 570 | end;
|
---|
| 571 | if CheckOrderGroup(AnOrder)=1 then // if it's UD group
|
---|
| 572 | begin
|
---|
| 573 | for j := 0 to tmpList.Count - 1 do
|
---|
| 574 | begin
|
---|
| 575 | if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
|
---|
| 576 | begin
|
---|
| 577 | idx := j;
|
---|
| 578 | Break;
|
---|
| 579 | end;
|
---|
| 580 | end;
|
---|
| 581 | if idx > 0 then
|
---|
| 582 | tmpList.Delete(idx);
|
---|
| 583 | end;
|
---|
| 584 | if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True);
|
---|
| 585 | if frmFrame.CCOWDrivedChange then
|
---|
| 586 | Exit;
|
---|
| 587 | end;
|
---|
| 588 | FIterating := False;
|
---|
| 589 | ResetSelectedForList(AListBox);
|
---|
| 590 | AListBox.SetFocus;
|
---|
| 591 | finally
|
---|
| 592 | tmpList.Free;
|
---|
| 593 | end;
|
---|
| 594 | end;
|
---|
| 595 |
|
---|
| 596 | procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject);
|
---|
| 597 | var
|
---|
| 598 | ATitle, AnOrder: string;
|
---|
| 599 | AListBox: TListBox;
|
---|
| 600 | i: Integer;
|
---|
| 601 | begin
|
---|
| 602 | inherited;
|
---|
| 603 | AListBox := ListSelected(TX_NOSEL);
|
---|
| 604 | if AListBox = nil then Exit
|
---|
| 605 | else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History'
|
---|
| 606 | else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History'
|
---|
| 607 | else ATitle := 'Inpatient Medication Administration History';
|
---|
| 608 | FIterating := True;
|
---|
| 609 | with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
|
---|
| 610 | begin
|
---|
| 611 | AnOrder := Piece(Strings[i], U, 2);
|
---|
| 612 | if AnOrder <> '' then
|
---|
| 613 | ReportBox(MedAdminHistory(AnOrder), ATitle, True);
|
---|
| 614 | end;
|
---|
| 615 | FIterating := False;
|
---|
| 616 | ResetSelectedForList(AListBox);
|
---|
| 617 | AListBox.SetFocus;
|
---|
| 618 | end;
|
---|
| 619 |
|
---|
| 620 | { Listbox events --------------------------------------------------------------------------- }
|
---|
| 621 |
|
---|
| 622 | procedure TfrmMeds.RefreshMedLists;
|
---|
| 623 | var
|
---|
| 624 | i: Integer;
|
---|
| 625 | AMed: TMedListRec;
|
---|
| 626 | begin
|
---|
| 627 | lstMedsIn.Clear;
|
---|
| 628 | lstMedsOut.Clear;
|
---|
| 629 | lstMedsNonVA.Clear;
|
---|
| 630 | StatusText('Retrieving active medications...');
|
---|
| 631 | LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA);
|
---|
| 632 | uPharmacyOrdersIn.Clear;
|
---|
| 633 | uPharmacyOrdersOut.Clear;
|
---|
| 634 | uNonVAOrdersOut.Clear;
|
---|
| 635 | with uMedListIn do for i := 0 to Count - 1 do
|
---|
| 636 | begin
|
---|
| 637 | AMed := TMedListRec(Items[i]);
|
---|
| 638 | uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID);
|
---|
| 639 | lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed);
|
---|
| 640 | end;
|
---|
| 641 |
|
---|
| 642 | with uMedListNonVA do for i := 0 to Count - 1 do
|
---|
| 643 | begin
|
---|
| 644 | AMed := TMedListRec(Items[i]);
|
---|
| 645 | uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
|
---|
| 646 | lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed);
|
---|
| 647 | end;
|
---|
| 648 |
|
---|
| 649 | with uMedListOut do for i := 0 to Count - 1 do
|
---|
| 650 | begin
|
---|
| 651 | AMed := TMedListRec(Items[i]);
|
---|
| 652 | uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
|
---|
| 653 | lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed);
|
---|
| 654 | end;
|
---|
| 655 |
|
---|
| 656 | StatusText('');
|
---|
| 657 | end;
|
---|
| 658 |
|
---|
| 659 | function TfrmMeds.GetActionText(const AMed: TMedListRec): string;
|
---|
| 660 | var
|
---|
| 661 | AnAction: string;
|
---|
| 662 | Abbreviation: string;
|
---|
| 663 | begin
|
---|
| 664 | AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
|
---|
| 665 | Abbreviation := Piece(AnAction, U, 1);
|
---|
| 666 | result := '';
|
---|
| 667 | if Length(Abbreviation) > 0 then
|
---|
| 668 | begin
|
---|
| 669 | if CharAt(Abbreviation, 1) = 'X' then result := 'Change'
|
---|
| 670 | else if Abbreviation = 'NW' then result := 'New'
|
---|
| 671 | else if Abbreviation = 'RN' then result := 'Renew'
|
---|
| 672 | else if Abbreviation = 'RF' then result := 'Refill'
|
---|
| 673 | else if Abbreviation = 'HD' then result := 'Hold'
|
---|
| 674 | else if Abbreviation = 'DL' then result := 'Deleted'
|
---|
| 675 | else if Abbreviation = 'DC' then result := 'DC'
|
---|
| 676 | else result := Abbreviation;
|
---|
| 677 | end;
|
---|
| 678 | end;
|
---|
| 679 |
|
---|
| 680 | function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string;
|
---|
| 681 | var
|
---|
| 682 | AnAction: string;
|
---|
| 683 | Indent: integer;
|
---|
| 684 | begin
|
---|
| 685 | AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
|
---|
| 686 | result := AMed.Instruct;
|
---|
| 687 | // replace pharmacy text with order text if this is a change
|
---|
| 688 | if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3);
|
---|
| 689 | if AMed.IVFluid then Indent := Pos(#10 + 'in ', result) else Indent := Pos(#13, result);
|
---|
| 690 | if Indent > 0 then
|
---|
| 691 | begin
|
---|
| 692 | if AMed.IVFluid then
|
---|
| 693 | begin
|
---|
| 694 | Detail := Copy(result, Indent + 1, Length(result));
|
---|
| 695 | result := Copy(result, 1, Indent - 1);
|
---|
| 696 | end else
|
---|
| 697 | begin
|
---|
| 698 | Detail := Copy(result, Indent + 2, Length(result));
|
---|
| 699 | result := Copy(result, 1, Indent - 1);
|
---|
| 700 | end;
|
---|
| 701 | end;
|
---|
| 702 | end;
|
---|
| 703 |
|
---|
| 704 | function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
|
---|
| 705 | begin
|
---|
| 706 | result := '';
|
---|
| 707 | Detail := '';
|
---|
| 708 | case Column of
|
---|
| 709 | 0: result := GetActionText(AMed);
|
---|
| 710 | 1: result := GetInstructText(AMed, Detail);
|
---|
| 711 | 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate);
|
---|
| 712 | 3: result := AMed.Status;
|
---|
| 713 | 4:
|
---|
| 714 | begin
|
---|
| 715 | if AMed.Inpatient then
|
---|
| 716 | result := MixedCase(AMed.Location)
|
---|
| 717 | else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill);
|
---|
| 718 | end;
|
---|
| 719 | 5: result := AMed.Refills;
|
---|
| 720 | else
|
---|
| 721 | end;
|
---|
| 722 | end;
|
---|
| 723 |
|
---|
| 724 | function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string;
|
---|
| 725 | var
|
---|
| 726 | AMed: TMedListRec;
|
---|
| 727 | AHeader: THeaderControl;
|
---|
| 728 | i: integer;
|
---|
| 729 | x, y: string;
|
---|
| 730 | begin
|
---|
| 731 | Result := '';
|
---|
| 732 | AMed := TMedListRec(GetMedList(Control)[Index]);
|
---|
| 733 | AHeader := GetHeader(Control);
|
---|
| 734 | for i := 0 to AHeader.Sections.Count-1 do
|
---|
| 735 | begin
|
---|
| 736 | x := GetListText(AMed, i, y);
|
---|
| 737 | if (x <> '') or (y <> '') then
|
---|
| 738 | Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF;
|
---|
| 739 | end;
|
---|
| 740 | Result := Trim(Result);
|
---|
| 741 | end;
|
---|
| 742 |
|
---|
| 743 | function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl;
|
---|
| 744 | begin
|
---|
| 745 | case Control.Tag of
|
---|
| 746 | TAG_OUTPT: result := hdrMedsOut;
|
---|
| 747 | TAG_NONVA: result := hdrMedsNonVA;
|
---|
| 748 | TAG_INPT: result := hdrMedsIn;
|
---|
| 749 |
|
---|
| 750 | else result := nil;
|
---|
| 751 | end;
|
---|
| 752 | end;
|
---|
| 753 |
|
---|
| 754 | function TFrmMeds.GetMedList(Control: TWinControl): TList;
|
---|
| 755 | begin
|
---|
| 756 | case Control.Tag of
|
---|
| 757 | TAG_OUTPT: result := uMedListOut;
|
---|
| 758 | TAG_NONVA: result := uMedListNonVA;
|
---|
| 759 | TAG_INPT: result := uMedListIn;
|
---|
| 760 | else result := nil;
|
---|
| 761 | end;
|
---|
| 762 | end;
|
---|
| 763 |
|
---|
| 764 | function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList;
|
---|
| 765 | begin
|
---|
| 766 | case Control.Tag of
|
---|
| 767 | TAG_OUTPT: result := uPharmacyOrdersOut;
|
---|
| 768 | TAG_NONVA: result := uNonVAOrdersOut;
|
---|
| 769 | TAG_INPT: result := uPharmacyOrdersIn;
|
---|
| 770 | else
|
---|
| 771 | result := nil;
|
---|
| 772 | end;
|
---|
| 773 | end;
|
---|
| 774 |
|
---|
| 775 | procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer;
|
---|
| 776 | var AHeight: Integer);
|
---|
| 777 | var
|
---|
| 778 | NewHeight, RecRight: Integer;
|
---|
| 779 | AMed: TMedListRec;
|
---|
| 780 | AHeader: THeaderControl;
|
---|
| 781 | AMedList: TList;
|
---|
| 782 | ARect: TRect;
|
---|
| 783 | x, y, AnAction: string;
|
---|
| 784 | begin
|
---|
| 785 | inherited;
|
---|
| 786 | NewHeight := AHeight;
|
---|
| 787 | AHeader := GetHeader(Control);
|
---|
| 788 | AMedList := GetMedList(Control);
|
---|
| 789 | with Control as TListBox do if Index < Items.Count then
|
---|
| 790 | begin
|
---|
| 791 | AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
|
---|
| 792 | if AMed <> nil then
|
---|
| 793 | begin
|
---|
| 794 | ARect := ItemRect(Index);
|
---|
| 795 | ARect.Left := AHeader.Sections[0].Width + 2;
|
---|
| 796 | ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6;
|
---|
| 797 | AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
|
---|
| 798 | if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold];
|
---|
| 799 | x := GetInstructText( AMed, y);
|
---|
| 800 | RecRight := ARect.Right;
|
---|
| 801 | NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
|
---|
| 802 | if(length(y)>0) then
|
---|
| 803 | begin
|
---|
| 804 | ARect.Left := AHeader.Sections[0].Width + FMT_INDENT;
|
---|
| 805 | ARect.Right := RecRight; // Draw Text alters ARect.
|
---|
| 806 | inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect));
|
---|
| 807 | end;
|
---|
| 808 | if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM*
|
---|
| 809 | if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM*
|
---|
| 810 | end; {if AMed}
|
---|
| 811 | end; {if Index}
|
---|
| 812 | AHeight := NewHeight;
|
---|
| 813 | end;
|
---|
| 814 |
|
---|
| 815 | procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
|
---|
| 816 | State: TOwnerDrawState);
|
---|
| 817 | var
|
---|
| 818 | ReturnHt: Integer;
|
---|
| 819 | x, y, AnAction: string;
|
---|
| 820 | AMed: TMedListRec;
|
---|
| 821 | AMedList: TList;
|
---|
| 822 | AHeader: THeaderControl;
|
---|
| 823 | ARect: TRect;
|
---|
| 824 | i: integer;
|
---|
| 825 | RectLeft: integer;
|
---|
| 826 | begin
|
---|
| 827 | inherited;
|
---|
| 828 | AHeader := GetHeader(Control);
|
---|
| 829 | AMedList := GetMedList(Control);
|
---|
| 830 | ListGridDrawLines(TListBox(Control), AHeader, Index, State);
|
---|
| 831 | with Control as TListBox do if Index < Items.Count then
|
---|
| 832 | begin
|
---|
| 833 | AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
|
---|
| 834 | if AMed <> nil then
|
---|
| 835 | begin
|
---|
| 836 | AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
|
---|
| 837 | if Length(AnAction) > 0 then
|
---|
| 838 | begin
|
---|
| 839 | Canvas.Font.Style := [fsBold];
|
---|
| 840 | if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
|
---|
| 841 | Canvas.Font.Color := clBlue;
|
---|
| 842 | if (Length(Piece(AnAction,'^',4)) > 0) then
|
---|
| 843 | AMed.Location := Piece(AnAction,'^',4);
|
---|
| 844 | end;
|
---|
| 845 | RectLeft := 0;
|
---|
| 846 | for i := 0 to AHeader.Sections.Count -1 do
|
---|
| 847 | begin
|
---|
| 848 | x := GetListText(AMed, i, y);
|
---|
| 849 | if Length(y) > 0 then
|
---|
| 850 | begin
|
---|
| 851 | ARect := ItemRect(Index);
|
---|
| 852 | ARect.Left := RectLeft + 2;
|
---|
| 853 | ARect.Right := ARect.Left + AHeader.Sections[i].Width - 6;
|
---|
| 854 | ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
|
---|
| 855 | or DT_WORDBREAK);
|
---|
| 856 | ARect.Left := RectLeft + FMT_INDENT;
|
---|
| 857 | ARect.Top := ARect.Top + ReturnHt;
|
---|
| 858 | DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX
|
---|
| 859 | or DT_WORDBREAK);
|
---|
| 860 | end
|
---|
| 861 | else
|
---|
| 862 | ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1);
|
---|
| 863 | Inc(RectLeft, AHeader.Sections[i].Width);
|
---|
| 864 | end;
|
---|
| 865 | end; {if AMed}
|
---|
| 866 | end; {if Index}
|
---|
| 867 | end;
|
---|
| 868 |
|
---|
| 869 | procedure TfrmMeds.lstMedsExit(Sender: TObject);
|
---|
| 870 | begin
|
---|
| 871 | inherited;
|
---|
| 872 | if not FIterating then ResetSelectedForList(TListBox(Sender));
|
---|
| 873 | end;
|
---|
| 874 |
|
---|
| 875 | procedure TfrmMeds.lstMedsDblClick(Sender: TObject);
|
---|
| 876 | begin
|
---|
| 877 | inherited;
|
---|
| 878 | mnuViewDetailClick(Self);
|
---|
| 879 | end;
|
---|
| 880 |
|
---|
| 881 | procedure TfrmMeds.lstMedsInClick(Sender: TObject);
|
---|
| 882 | var
|
---|
| 883 | i: integer;
|
---|
| 884 | begin
|
---|
| 885 | inherited;
|
---|
| 886 | with lstMedsOut do for i := 0 to Items.Count -1 do
|
---|
| 887 | Selected[i] := false;
|
---|
| 888 | with lstMedsNonVA do for i := 0 to Items.Count - 1 do
|
---|
| 889 | Selected[i] := FALSE;
|
---|
| 890 | end;
|
---|
| 891 |
|
---|
| 892 | procedure TfrmMeds.lstMedsOutClick(Sender: TObject);
|
---|
| 893 | var
|
---|
| 894 | i: integer;
|
---|
| 895 | begin
|
---|
| 896 | inherited;
|
---|
| 897 | with lstMedsIn do for i := 0 to Items.Count -1 do
|
---|
| 898 | Selected[i] := false;
|
---|
| 899 | with lstMedsNonVA do for i := 0 to Items.Count -1 do
|
---|
| 900 | Selected[i] := false;
|
---|
| 901 | end;
|
---|
| 902 |
|
---|
| 903 | procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl;
|
---|
| 904 | Section: THeaderSection);
|
---|
| 905 | begin
|
---|
| 906 | inherited;
|
---|
| 907 | RedrawSuspend(Self.Handle);
|
---|
| 908 | with lstMedsOut do
|
---|
| 909 | begin
|
---|
| 910 | IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
|
---|
| 911 | IntegralHeight := not IntegralHeight; // listbox window to be recreated
|
---|
| 912 | end;
|
---|
| 913 | RedrawActivate(Self.Handle);
|
---|
| 914 | lstMedsOut.Invalidate;
|
---|
| 915 | Refresh;
|
---|
| 916 | end;
|
---|
| 917 |
|
---|
| 918 | procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl;
|
---|
| 919 | Section: THeaderSection);
|
---|
| 920 | begin
|
---|
| 921 | inherited;
|
---|
| 922 | RedrawSuspend(Self.Handle);
|
---|
| 923 | with lstMedsIn do
|
---|
| 924 | begin
|
---|
| 925 | IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
|
---|
| 926 | IntegralHeight := not IntegralHeight; // listbox window to be recreated
|
---|
| 927 | end;
|
---|
| 928 | RedrawActivate(Self.Handle);
|
---|
| 929 | lstMedsIn.Invalidate;
|
---|
| 930 | Refresh;
|
---|
| 931 | end;
|
---|
| 932 |
|
---|
| 933 | { Action menu events ---------------------------------------------------------------------- }
|
---|
| 934 |
|
---|
| 935 | procedure TfrmMeds.mnuActClick(Sender: TObject);
|
---|
| 936 | begin
|
---|
| 937 | inherited;
|
---|
| 938 | //frmFrame.UpdatePtInfoOnRefresh;
|
---|
| 939 | if lstMedsOut.SelCount > 0 then
|
---|
| 940 | begin
|
---|
| 941 | mnuActTransfer.Caption := 'Transfer to Inpatient...';
|
---|
| 942 | mnuActTransfer.Enabled := True;
|
---|
| 943 | end
|
---|
| 944 | else if lstMedsIn.SelCount > 0 then
|
---|
| 945 | begin
|
---|
| 946 | mnuActTransfer.Caption := 'Transfer to Outpatient...';
|
---|
| 947 | mnuActTransfer.Enabled := True;
|
---|
| 948 | end
|
---|
| 949 | else
|
---|
| 950 | begin
|
---|
| 951 | mnuActTransfer.Caption := 'Transfer to...';
|
---|
| 952 | mnuActTransfer.Enabled := False;
|
---|
| 953 | end;
|
---|
| 954 | end;
|
---|
| 955 |
|
---|
| 956 | procedure TfrmMeds.mnuActDCClick(Sender: TObject);
|
---|
| 957 | { discontinue/cancel/delete the selected med orders as appropriate for each order }
|
---|
| 958 | { similar to action on fOrders}
|
---|
| 959 | var
|
---|
| 960 | ActiveList: TListBox;
|
---|
| 961 | SelectedList: TList;
|
---|
| 962 | DelEvt: boolean;
|
---|
| 963 | begin
|
---|
| 964 | inherited;
|
---|
| 965 | DelEvt := False;
|
---|
| 966 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 967 | if ActiveList = nil then Exit;
|
---|
| 968 | SelectedList := TList.Create;
|
---|
| 969 | try
|
---|
| 970 | FIterating := True;
|
---|
| 971 | if AuthorizedUser and EncounterPresent and LockedForOrdering then
|
---|
| 972 | begin
|
---|
| 973 | ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
|
---|
| 974 | MakeSelectedList(ActiveList, SelectedList);
|
---|
| 975 | if ExecuteDCOrders(SelectedList,DelEvt) then
|
---|
| 976 | begin
|
---|
| 977 | ResetSelectedForList(ActiveList);
|
---|
| 978 | SynchListToOrders(ActiveList, SelectedList);
|
---|
| 979 | end;
|
---|
| 980 | if DelEvt then
|
---|
| 981 | frmFrame.mnuFileRefreshClick(Self);
|
---|
| 982 | end;
|
---|
| 983 | finally
|
---|
| 984 | FIterating := False;
|
---|
| 985 | SelectedList.Free;
|
---|
| 986 | UnlockIfAble;
|
---|
| 987 | end;
|
---|
| 988 | end;
|
---|
| 989 |
|
---|
| 990 | procedure TfrmMeds.mnuActHoldClick(Sender: TObject);
|
---|
| 991 | { hold the selected med orders as appropriate for each order }
|
---|
| 992 | { similar to action on fOrders}
|
---|
| 993 | var
|
---|
| 994 | ActiveList: TListBox;
|
---|
| 995 | SelectedList: TList;
|
---|
| 996 | begin
|
---|
| 997 | inherited;
|
---|
| 998 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 999 | if ActiveList = nil then Exit;
|
---|
| 1000 | SelectedList := TList.Create;
|
---|
| 1001 | try
|
---|
| 1002 | FIterating := True;
|
---|
| 1003 | if AuthorizedUser and EncounterPresent and LockedForOrdering then
|
---|
| 1004 | begin
|
---|
| 1005 | ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);
|
---|
| 1006 | MakeSelectedList(ActiveList, SelectedList);
|
---|
| 1007 | if ExecuteHoldOrders(SelectedList) then
|
---|
| 1008 | begin
|
---|
| 1009 | AddSelectedToChanges(SelectedList);
|
---|
| 1010 | ResetSelectedForList(ActiveList);
|
---|
| 1011 | SynchListToOrders(ActiveList, SelectedList);
|
---|
| 1012 | end;
|
---|
| 1013 | end;
|
---|
| 1014 | finally
|
---|
| 1015 | ActiveList.SetFocus;
|
---|
| 1016 | FIterating := False;
|
---|
| 1017 | SelectedList.Free;
|
---|
| 1018 | UnlockIfAble;
|
---|
| 1019 | end;
|
---|
| 1020 | end;
|
---|
| 1021 |
|
---|
| 1022 | procedure TfrmMeds.mnuActRenewClick(Sender: TObject);
|
---|
| 1023 | { renew the selected med orders as appropriate for each order }
|
---|
| 1024 | { similar to action on fOrders}
|
---|
| 1025 | var
|
---|
| 1026 | ActiveList: TListBox;
|
---|
| 1027 | SelectedList: TList;
|
---|
| 1028 | ParntOrder : TOrder;
|
---|
| 1029 | begin
|
---|
| 1030 | inherited;
|
---|
| 1031 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 1032 | if ActiveList = nil then Exit;
|
---|
| 1033 | SelectedList := TList.Create;
|
---|
| 1034 | try
|
---|
| 1035 | FIterating := True;
|
---|
| 1036 | if AuthorizedUser and EncounterPresent and LockedForOrdering then
|
---|
| 1037 | begin
|
---|
| 1038 | ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);
|
---|
| 1039 | MakeSelectedList(ActiveList, SelectedList);
|
---|
| 1040 | if Length(FParentComplexOrderID)>0 then
|
---|
| 1041 | begin
|
---|
| 1042 | ParntOrder := GetOrderByIFN(FParentComplexOrderID);
|
---|
| 1043 | if CharAt(ParntOrder.Text,1)='+' then
|
---|
| 1044 | ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
|
---|
| 1045 | if Pos('First Dose NOW',ParntOrder.Text)>1 then
|
---|
| 1046 | Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW'));
|
---|
| 1047 | SelectedList.Add(ParntOrder);
|
---|
| 1048 | FParentComplexOrderID := '';
|
---|
| 1049 | end;
|
---|
| 1050 | if ExecuteRenewOrders(SelectedList) then
|
---|
| 1051 | begin
|
---|
| 1052 | AddSelectedToChanges(SelectedList);
|
---|
| 1053 | ResetSelectedForList(ActiveList);
|
---|
| 1054 | SynchListToOrders(ActiveList, SelectedList);
|
---|
| 1055 | end;
|
---|
| 1056 | end;
|
---|
| 1057 | finally
|
---|
| 1058 | ActiveList.SetFocus;
|
---|
| 1059 | FIterating := False;
|
---|
| 1060 | SelectedList.Free;
|
---|
| 1061 | UnlockIfAble;
|
---|
| 1062 | end;
|
---|
| 1063 | end;
|
---|
| 1064 |
|
---|
| 1065 | procedure TfrmMeds.mnuActChangeClick(Sender: TObject);
|
---|
| 1066 | { loop thru selected med orders, present ordering dialog for each with defaults to selected order }
|
---|
| 1067 | { similar to action on fOrders}
|
---|
| 1068 | var
|
---|
| 1069 | i: Integer;
|
---|
| 1070 | ActiveList: TListBox;
|
---|
| 1071 | SelectedList: TList;
|
---|
| 1072 | ChangeIFNList: TStringList;
|
---|
| 1073 | DelayEvent: TOrderDelayEvent;
|
---|
| 1074 | begin
|
---|
| 1075 | inherited;
|
---|
| 1076 | if not EncounterPresentEDO then Exit;
|
---|
| 1077 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 1078 | if ActiveList = nil then Exit;
|
---|
| 1079 | DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders
|
---|
| 1080 | DelayEvent.Specialty := 0;
|
---|
| 1081 | DelayEvent.Effective := 0;
|
---|
| 1082 | DelayEvent.EventIFN := 0;
|
---|
| 1083 | SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly
|
---|
| 1084 | ChangeIFNList := TStringList.Create;
|
---|
| 1085 | try
|
---|
| 1086 | MakeSelectedList(Activelist, SelectedList);
|
---|
| 1087 | with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
|
---|
| 1088 | if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL)
|
---|
| 1089 | then ChangeOrders(ChangeIFNList, DelayEvent);
|
---|
| 1090 | SynchListToOrders(ActiveList, SelectedList); // rehighlights
|
---|
| 1091 | Activelist.SetFocus;
|
---|
| 1092 | finally
|
---|
| 1093 | SelectedList.Free;
|
---|
| 1094 | ChangeIFNList.Free;
|
---|
| 1095 | end;
|
---|
| 1096 | end;
|
---|
| 1097 |
|
---|
| 1098 | procedure TfrmMeds.mnuActCopyClick(Sender: TObject);
|
---|
| 1099 | { loop thru selected med orders, present ordering dialog for each with defaults to selected order }
|
---|
| 1100 | { similar to action on fOrders}
|
---|
| 1101 | const
|
---|
| 1102 | CP_TXT = 'copied';
|
---|
| 1103 | XF_TXT = 'transfered';
|
---|
| 1104 | var
|
---|
| 1105 | i: Integer;
|
---|
| 1106 | LimitEvent: Char;
|
---|
| 1107 | ActiveList: TListBox;
|
---|
| 1108 | SelectedList: TList;
|
---|
| 1109 | CopyIFNList: TStringList;
|
---|
| 1110 | TempEvent,DelayEvent: TOrderDelayEvent;
|
---|
| 1111 | ActName, radTxt,thePtEvtID, AuthErr: string;
|
---|
| 1112 | IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean;
|
---|
| 1113 |
|
---|
| 1114 | begin
|
---|
| 1115 | inherited;
|
---|
| 1116 | AuthErr := '';
|
---|
| 1117 | ActName := '';
|
---|
| 1118 | if not EncounterPresentEDO then Exit;
|
---|
| 1119 | CheckAuthForMeds(AuthErr);
|
---|
| 1120 | if (Length(AuthErr)>0) then
|
---|
| 1121 | begin
|
---|
| 1122 | ShowMessage(AuthErr);
|
---|
| 1123 | if not EncounterPresent then Exit;
|
---|
| 1124 | end;
|
---|
| 1125 | if not FActionOnMedsTab then
|
---|
| 1126 | FActionOnMedsTab := True;
|
---|
| 1127 | DelayEvent.EventType := #0;
|
---|
| 1128 | DelayEvent.EventIFN := 0;
|
---|
| 1129 | DelayEvent.EventName := '';
|
---|
| 1130 | DelayEvent.Specialty := 0;
|
---|
| 1131 | DelayEvent.Effective := 0;
|
---|
| 1132 | DelayEvent.PtEventIFN := 0;
|
---|
| 1133 | DelayEvent.TheParent := TParentEvent.Create;
|
---|
| 1134 | DelayEvent.IsNewEvent := False;
|
---|
| 1135 | TempEvent := DelayEvent;
|
---|
| 1136 | DoesDestEvtOccur := False;
|
---|
| 1137 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 1138 | if ActiveList = nil then Exit;
|
---|
| 1139 | NewOrderCreated := False;
|
---|
| 1140 | if frmOrders.lstSheets.ItemIndex >= 0 then
|
---|
| 1141 | begin
|
---|
| 1142 | frmOrders.lstSheets.ItemIndex := 0;
|
---|
| 1143 | frmOrders.lstSheetsClick(Application);
|
---|
| 1144 | end;
|
---|
| 1145 | LimitEvent := #0;
|
---|
| 1146 | if TComponent(Sender).Name = 'mnuActTransfer' then
|
---|
| 1147 | begin
|
---|
| 1148 | ActName := 'Transfer';
|
---|
| 1149 | IsTransferAction := True;
|
---|
| 1150 | radTxt := XF_TXT;
|
---|
| 1151 | if ActiveList = lstMedsOut then
|
---|
| 1152 | begin
|
---|
| 1153 | if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A';
|
---|
| 1154 | XferOutToInOnMeds := True;
|
---|
| 1155 | end;
|
---|
| 1156 | if ActiveList = lstMedsIn then
|
---|
| 1157 | begin
|
---|
| 1158 | if Patient.Inpatient then LimitEvent := 'D' else
|
---|
| 1159 | begin
|
---|
| 1160 | LimitEvent := 'C';
|
---|
| 1161 | XfInToOutNow := True;
|
---|
| 1162 | end;
|
---|
| 1163 | XferOutToInOnMeds := False;
|
---|
| 1164 | end;
|
---|
| 1165 | end else
|
---|
| 1166 | radTxt := CP_TXT;
|
---|
| 1167 | SelectedList := TList.Create; // temporary until able to create CopyIFNList directly
|
---|
| 1168 | CopyIFNList := TStringList.Create;
|
---|
| 1169 | try
|
---|
| 1170 | MakeSelectedList(Activelist, SelectedList, ActName);
|
---|
| 1171 | {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then
|
---|
| 1172 | Exit;}
|
---|
| 1173 | with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID);
|
---|
| 1174 | if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
|
---|
| 1175 | begin
|
---|
| 1176 | IsNewEvent := False;
|
---|
| 1177 | if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then
|
---|
| 1178 | begin
|
---|
| 1179 | if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then
|
---|
| 1180 | XferOutToInOnMeds := True;
|
---|
| 1181 | TempEvent.PtEventIFN := DelayEvent.PtEventIFN;
|
---|
| 1182 | TempEvent.EventName := DelayEvent.EventName;
|
---|
| 1183 | if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then
|
---|
| 1184 | begin
|
---|
| 1185 | DelayEvent.EventType := 'C';
|
---|
| 1186 | DelayEvent.PtEventIFN := 0;
|
---|
| 1187 | DelayEvent.EventName := '';
|
---|
| 1188 | DelayEvent.EventIFN := 0;
|
---|
| 1189 | DelayEvent.TheParent := TParentEvent.Create;
|
---|
| 1190 | DoesDestEvtOccur := True;
|
---|
| 1191 | needVerify := false;
|
---|
| 1192 | CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify);
|
---|
| 1193 | if XferOutToInOnMeds then
|
---|
| 1194 | XferOutToInOnMeds := False;
|
---|
| 1195 | if frmOrders <> nil then
|
---|
| 1196 | frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName);
|
---|
| 1197 | Exit;
|
---|
| 1198 | end;
|
---|
| 1199 | if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then
|
---|
| 1200 | begin
|
---|
| 1201 | needVerify := False;
|
---|
| 1202 | uAutoAC := True;
|
---|
| 1203 | end else
|
---|
| 1204 | begin
|
---|
| 1205 | needVerify := True;
|
---|
| 1206 | uAutoAC := False;
|
---|
| 1207 | end;
|
---|
| 1208 | if LimitEvent = #0 then
|
---|
| 1209 | begin
|
---|
| 1210 | if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
|
---|
| 1211 | NewOrderCreated := True;
|
---|
| 1212 | if ImmdCopyAct then
|
---|
| 1213 | ImmdCopyAct := False;
|
---|
| 1214 | end else
|
---|
| 1215 | begin
|
---|
| 1216 | if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
|
---|
| 1217 | NewOrderCreated := True;
|
---|
| 1218 | end;
|
---|
| 1219 | if XferOutToInOnMeds then
|
---|
| 1220 | XferOutToInOnMeds := False;
|
---|
| 1221 | if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then
|
---|
| 1222 | frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0);
|
---|
| 1223 | if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then
|
---|
| 1224 | if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then
|
---|
| 1225 | begin
|
---|
| 1226 | if PtEvtEmpty(ThePtEvtID) then
|
---|
| 1227 | begin
|
---|
| 1228 | DeletePtEvent(ThePtEvtID);
|
---|
| 1229 | frmOrders.ChangesUpdate(ThePtEvtID);
|
---|
| 1230 | frmOrders.EventDefaultOrder := '';
|
---|
| 1231 | frmOrders.InitOrderSheetsForEvtDelay;
|
---|
| 1232 | if frmOrders.lstSheets.ItemIndex <> 0 then
|
---|
| 1233 | frmOrders.lstSheets.ItemIndex := 0;
|
---|
| 1234 | frmOrders.lstSheetsClick(Self);
|
---|
| 1235 | end;
|
---|
| 1236 | end;
|
---|
| 1237 | end;
|
---|
| 1238 | end;
|
---|
| 1239 | SynchListToOrders(ActiveList, SelectedList); // rehighlights
|
---|
| 1240 | if IsTransferAction then
|
---|
| 1241 | IsTransferAction := False;
|
---|
| 1242 | if XferOuttoInOnMeds then
|
---|
| 1243 | XferOuttoInOnMeds := False;
|
---|
| 1244 | if XfInToOutNow then
|
---|
| 1245 | XfInToOutNow := False;
|
---|
| 1246 | frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True);
|
---|
| 1247 | finally
|
---|
| 1248 | ActiveList.SetFocus;
|
---|
| 1249 | FActionOnMedsTab := False;
|
---|
| 1250 | uAutoAC := False;
|
---|
| 1251 | SelectedList.Free;
|
---|
| 1252 | CopyIFNList.Free;
|
---|
| 1253 | end;
|
---|
| 1254 | end;
|
---|
| 1255 |
|
---|
| 1256 | procedure TfrmMeds.mnuActNewClick(Sender: TObject);
|
---|
| 1257 | { new med orders dependent on order dialog for inpatient or outpatient }
|
---|
| 1258 | { similar to lstWriteClick on fOrders}
|
---|
| 1259 | var
|
---|
| 1260 | DialogInfo: string;
|
---|
| 1261 | DelayEvent: TOrderDelayEvent;
|
---|
| 1262 | begin
|
---|
| 1263 | inherited;
|
---|
| 1264 | DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
|
---|
| 1265 | DelayEvent.Specialty := 0;
|
---|
| 1266 | DelayEvent.EventIFN := 0;
|
---|
| 1267 | DelayEvent.Effective := 0;
|
---|
| 1268 | frmOrders.DontCheck := True;
|
---|
| 1269 | frmOrders.lstSheets.ItemIndex := 0;
|
---|
| 1270 | frmOrders.lstSheetsClick(self);
|
---|
| 1271 | frmOrders.DontCheck := False;
|
---|
| 1272 | if not ReadyForNewOrder(DelayEvent) then Exit;
|
---|
| 1273 | frmOrders.DontCheck := True;
|
---|
| 1274 | frmOrders.lstSheets.ItemIndex := 0;
|
---|
| 1275 | frmOrders.lstSheetsClick(self);
|
---|
| 1276 | frmOrders.DontCheck := False;
|
---|
| 1277 | { get appropriate form, create the dialog form and show it }
|
---|
| 1278 | DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup
|
---|
| 1279 | case CharAt(Piece(DialogInfo, ';', 4), 1) of
|
---|
| 1280 | 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
|
---|
| 1281 | 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
|
---|
| 1282 | 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
|
---|
| 1283 | 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
|
---|
| 1284 | else InfoBox('Unsupported dialog type', 'Error', MB_OK);
|
---|
| 1285 | end; {case}
|
---|
| 1286 | end;
|
---|
| 1287 |
|
---|
| 1288 | procedure TfrmMeds.mnuActRefillClick(Sender: TObject);
|
---|
| 1289 | { for selected orders, present refill dialog }
|
---|
| 1290 | var
|
---|
| 1291 | ActiveList: TListBox;
|
---|
| 1292 | SelectedList: TList;
|
---|
| 1293 | begin
|
---|
| 1294 | inherited;
|
---|
| 1295 | ActiveList := ListSelected(TX_NOSEL);
|
---|
| 1296 | if ActiveList = nil then Exit;
|
---|
| 1297 | SelectedList := TList.Create;
|
---|
| 1298 | try
|
---|
| 1299 | FIterating := True;
|
---|
| 1300 | if AuthorizedUser and EncounterPresent and LockedForOrdering then
|
---|
| 1301 | begin
|
---|
| 1302 | ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL);
|
---|
| 1303 | MakeSelectedList(ActiveList, SelectedList);
|
---|
| 1304 | if ExecuteRefillOrders(SelectedList) then
|
---|
| 1305 | begin
|
---|
| 1306 | ResetSelectedForList(ActiveList);
|
---|
| 1307 | SynchListToOrders(ActiveList, SelectedList);
|
---|
| 1308 | end;
|
---|
| 1309 | end;
|
---|
| 1310 | finally
|
---|
| 1311 | ActiveList.SetFocus;
|
---|
| 1312 | FIterating := False;
|
---|
| 1313 | SelectedList.Free;
|
---|
| 1314 | UnlockIfAble;
|
---|
| 1315 | end;
|
---|
| 1316 | end;
|
---|
| 1317 |
|
---|
| 1318 | { Action utilities --------------------------------------------------------------------------- }
|
---|
| 1319 |
|
---|
| 1320 | function TfrmMeds.ListSelected(const ErrMsg: string): TListBox;
|
---|
| 1321 | { return selected listbox - inpatient or outpatient }
|
---|
| 1322 | begin
|
---|
| 1323 | Result := nil;
|
---|
| 1324 | if lstMedsOut.SelCount > 0 then Result := lstMedsOut
|
---|
| 1325 | else if lstMedsIn.SelCount > 0 then Result := lstMedsIn
|
---|
| 1326 | else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA;
|
---|
| 1327 | if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
|
---|
| 1328 | end;
|
---|
| 1329 |
|
---|
| 1330 | procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
|
---|
| 1331 | { loop to validate action on each selected med order, deselect if not valid }
|
---|
| 1332 | var
|
---|
| 1333 | i: Integer;
|
---|
| 1334 | OrderText, CurID: string;
|
---|
| 1335 | ErrMsg, AParentID: string;
|
---|
| 1336 | CheckedList,SomePharmacyOrders: TStringList;
|
---|
| 1337 | ChildOrder: TChildOD;
|
---|
| 1338 | begin
|
---|
| 1339 | CheckedList := TStringList.Create;
|
---|
| 1340 | SomePharmacyOrders := GetPharmacyOrders(AListBox);
|
---|
| 1341 | with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
|
---|
| 1342 | begin
|
---|
| 1343 | if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
|
---|
| 1344 | begin
|
---|
| 1345 | Selected[i] := False;
|
---|
| 1346 | MessageDlg('You can not renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
|
---|
| 1347 | end;
|
---|
| 1348 | CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
|
---|
| 1349 | if Length(CurID) > 0
|
---|
| 1350 | then CurID := Piece(CurID, U, 2)
|
---|
| 1351 | else CurID := Piece(SomePharmacyOrders[i], U, 2);
|
---|
| 1352 | ValidateOrderAction(CurID, AnAction, ErrMsg);
|
---|
| 1353 | if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then
|
---|
| 1354 | begin
|
---|
| 1355 | InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK);
|
---|
| 1356 | Selected[i] := False;
|
---|
| 1357 | Continue;
|
---|
| 1358 | end;
|
---|
| 1359 | AParentID := '';
|
---|
| 1360 | if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then
|
---|
| 1361 | Selected[i] := False;
|
---|
| 1362 | if Length(AParentID)>0 then
|
---|
| 1363 | begin
|
---|
| 1364 | if ChildODList.IndexOf(CurID)< 0 then
|
---|
| 1365 | begin
|
---|
| 1366 | ChildOrder := TChildOD.Create;
|
---|
| 1367 | ChildOrder.ChildID := CurId;
|
---|
| 1368 | ChildOrder.ParentID := AParentID;
|
---|
| 1369 | ChildODList.AddObject(CurID, ChildOrder);
|
---|
| 1370 | end;
|
---|
| 1371 | end;
|
---|
| 1372 | if Length(ErrMsg) > 0 then
|
---|
| 1373 | begin
|
---|
| 1374 | OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2));
|
---|
| 1375 | InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK);
|
---|
| 1376 | Selected[i] := False;
|
---|
| 1377 | end;
|
---|
| 1378 | if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False;
|
---|
| 1379 | end;
|
---|
| 1380 | end;
|
---|
| 1381 |
|
---|
| 1382 | procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string);
|
---|
| 1383 | { make a list of selected med orders }
|
---|
| 1384 | var
|
---|
| 1385 | i,idx: Integer;
|
---|
| 1386 | AnOrder: TOrder;
|
---|
| 1387 | CurID,x: string;
|
---|
| 1388 | SomePharmacyOrders: TStringList;
|
---|
| 1389 | TempList: TStringList;
|
---|
| 1390 | begin
|
---|
| 1391 | SomePharmacyOrders := GetPharmacyOrders(AListBox);
|
---|
| 1392 | TempList := TStringList.Create;
|
---|
| 1393 | AList.Clear;
|
---|
| 1394 | with AListBox do for i := 0 to Items.Count - 1 do
|
---|
| 1395 | if Selected[i] then
|
---|
| 1396 | begin
|
---|
| 1397 | CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
|
---|
| 1398 | if Length(CurID) > 0
|
---|
| 1399 | then CurID := Piece(CurID, U, 2)
|
---|
| 1400 | else CurID := Piece(SomePharmacyOrders[i], U, 2);
|
---|
| 1401 | AnOrder := GetOrderByIFN(CurID);
|
---|
| 1402 | if ActName = 'Transfer' then //imo
|
---|
| 1403 | begin
|
---|
| 1404 | if (AnOrder.DGroup = ClinDisp) then //imo
|
---|
| 1405 | begin
|
---|
| 1406 | x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transfered';
|
---|
| 1407 | if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then
|
---|
| 1408 | begin
|
---|
| 1409 | AListBox.Selected[i] := False;
|
---|
| 1410 | Continue;
|
---|
| 1411 | end
|
---|
| 1412 | end;
|
---|
| 1413 | end;
|
---|
| 1414 | idx := -1;
|
---|
| 1415 | idx := ChildODList.IndexOf(AnOrder.ID);
|
---|
| 1416 | if idx > - 1 then
|
---|
| 1417 | AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID;
|
---|
| 1418 | if TempList.IndexOf(AnOrder.ID)= -1 then
|
---|
| 1419 | begin
|
---|
| 1420 | AList.Add(AnOrder);
|
---|
| 1421 | TempList.Add(AnOrder.ID);
|
---|
| 1422 | end;
|
---|
| 1423 | end;
|
---|
| 1424 | TempList.Clear;
|
---|
| 1425 | end;
|
---|
| 1426 |
|
---|
| 1427 | procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList);
|
---|
| 1428 | { shows selected med orders as selected }
|
---|
| 1429 | //var
|
---|
| 1430 | // i, j: Integer;
|
---|
| 1431 | // AMedListRec: TMedListRec;
|
---|
| 1432 | // AnOrder: TOrder;
|
---|
| 1433 | begin
|
---|
| 1434 | // with AListBox do for i := 0 to Items.Count - 1 do
|
---|
| 1435 | // begin
|
---|
| 1436 | // AMedListRec := TMedListRec(AListBox.Items.Objects[i]);
|
---|
| 1437 | // with AList do for j := 0 to Count - 1 do
|
---|
| 1438 | // begin
|
---|
| 1439 | // AnOrder := TOrder(AList.Items[j]);
|
---|
| 1440 | // if Piece(AMedListRec.OrderID, ';', 1) = Piece(AnOrder.ID, ';', 1) then
|
---|
| 1441 | // begin
|
---|
| 1442 | // //AMedListRec.Instruct := AMedListRec.Instruct + ' * EDITED *';
|
---|
| 1443 | // //AMedListRec.Action := MED_NEW; //*KCM*
|
---|
| 1444 | // //AListBox.Selected[i] := True; // resets valid selections to indicate changes //*KCM*
|
---|
| 1445 | // end;
|
---|
| 1446 | // end;
|
---|
| 1447 | // end;
|
---|
| 1448 | AListBox.Invalidate;
|
---|
| 1449 | end;
|
---|
| 1450 |
|
---|
| 1451 | procedure TfrmMeds.pnlMedOut1Resize(Sender: TObject);
|
---|
| 1452 | begin
|
---|
| 1453 | inherited;
|
---|
| 1454 | //if pnlMedOut.Height < 20 then pnlMedOut.Height := 20;
|
---|
| 1455 | end;
|
---|
| 1456 |
|
---|
| 1457 |
|
---|
| 1458 | procedure TfrmMeds.popMedPopup(Sender: TObject);
|
---|
| 1459 | begin
|
---|
| 1460 | inherited;
|
---|
| 1461 | //frmFrame.UpdatePtInfoOnRefresh;
|
---|
| 1462 | end;
|
---|
| 1463 |
|
---|
| 1464 | procedure TfrmMeds.mnuViewClick(Sender: TObject);
|
---|
| 1465 | begin
|
---|
| 1466 | inherited;
|
---|
| 1467 | //frmFrame.UpdatePtInfoOnRefresh;
|
---|
| 1468 | end;
|
---|
| 1469 |
|
---|
| 1470 | procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject);
|
---|
| 1471 | var
|
---|
| 1472 | i: integer;
|
---|
| 1473 | begin
|
---|
| 1474 | inherited;
|
---|
| 1475 | with lstMedsIn do for i := 0 to Items.Count -1 do
|
---|
| 1476 | Selected[i] := false;
|
---|
| 1477 | with lstMedsOut do for i := 0 to Items.Count -1 do
|
---|
| 1478 | Selected[i] := false;
|
---|
| 1479 | end;
|
---|
| 1480 |
|
---|
| 1481 | procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject);
|
---|
| 1482 | begin
|
---|
| 1483 | inherited;
|
---|
| 1484 | mnuViewDetailClick(Self);
|
---|
| 1485 | end;
|
---|
| 1486 |
|
---|
| 1487 | procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject);
|
---|
| 1488 | begin
|
---|
| 1489 | inherited;
|
---|
| 1490 | if not FIterating then ResetSelectedForList(TListBox(Sender));
|
---|
| 1491 | end;
|
---|
| 1492 |
|
---|
| 1493 | procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
|
---|
| 1494 | Section: THeaderSection);
|
---|
| 1495 | begin
|
---|
| 1496 | inherited;
|
---|
| 1497 | RedrawSuspend(Self.Handle);
|
---|
| 1498 | with lstMedsNonVA do
|
---|
| 1499 | begin
|
---|
| 1500 | IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
|
---|
| 1501 | IntegralHeight := not IntegralHeight; // listbox window to be recreated
|
---|
| 1502 | end;
|
---|
| 1503 | RedrawActivate(Self.Handle);
|
---|
| 1504 | lstMedsNonVA.Invalidate;
|
---|
| 1505 | Refresh;
|
---|
| 1506 | end;
|
---|
| 1507 |
|
---|
| 1508 | function TfrmMeds.PctOfTotalHeight(thisPanel: TPanel) : integer;
|
---|
| 1509 | var
|
---|
| 1510 | pctOfTotal: real;
|
---|
| 1511 | begin
|
---|
| 1512 | pctOfTotal := ((thisPanel.Height / totalHeight) * 100);
|
---|
| 1513 | Result := Round(pctOfTotal);
|
---|
| 1514 | end;
|
---|
| 1515 |
|
---|
| 1516 | procedure TfrmMeds.FormResize(Sender: TObject);
|
---|
| 1517 | begin
|
---|
| 1518 | inherited;
|
---|
| 1519 | if Assigned(frmMeds) then
|
---|
| 1520 | begin
|
---|
| 1521 | //Adjust splitter positions to always be in view, regardless of window size
|
---|
| 1522 | if (pnlBottom.Height > frmMeds.Height-50) then pnlBottom.Height := frmMeds.Height-50;
|
---|
| 1523 | if (pnlMedIn.Height > pnlBottom.Height-50) then pnlMedIn.Height := pnlBottom.Height-50;
|
---|
| 1524 | end;
|
---|
| 1525 | end;
|
---|
| 1526 |
|
---|
| 1527 | { TChildOD }
|
---|
| 1528 |
|
---|
| 1529 | constructor TChildOD.Create;
|
---|
| 1530 | begin
|
---|
| 1531 | ChildID := '';
|
---|
| 1532 | ParentID := '';
|
---|
| 1533 | end;
|
---|
| 1534 |
|
---|
| 1535 | procedure TfrmMeds.hdrMedsOutResize(Sender: TObject);
|
---|
| 1536 | begin
|
---|
| 1537 | inherited;
|
---|
| 1538 | with hdrMedsOut do
|
---|
| 1539 | begin
|
---|
| 1540 | if Height < 16 then Height := 16;
|
---|
| 1541 | if Height > 16 then Height := 16;
|
---|
| 1542 | Invalidate;
|
---|
| 1543 | end;
|
---|
| 1544 | end;
|
---|
| 1545 |
|
---|
| 1546 | procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject);
|
---|
| 1547 | begin
|
---|
| 1548 | inherited;
|
---|
| 1549 | with hdrMedsNonVA do
|
---|
| 1550 | begin
|
---|
| 1551 | if Height < 16 then Height := 16;
|
---|
| 1552 | if Height > 16 then Height := 16;
|
---|
| 1553 | Invalidate;
|
---|
| 1554 | end;
|
---|
| 1555 | end;
|
---|
| 1556 |
|
---|
| 1557 | procedure TfrmMeds.hdrMedsInResize(Sender: TObject);
|
---|
| 1558 | begin
|
---|
| 1559 | inherited;
|
---|
| 1560 | with hdrMedsIn do
|
---|
| 1561 | begin
|
---|
| 1562 | if Height < 16 then Height := 16;
|
---|
| 1563 | if Height > 16 then Height := 16;
|
---|
| 1564 | Invalidate;
|
---|
| 1565 | end;
|
---|
| 1566 | end;
|
---|
| 1567 |
|
---|
| 1568 | procedure TfrmMeds.FormShow(Sender: TObject);
|
---|
| 1569 | begin
|
---|
| 1570 | inherited;
|
---|
| 1571 | frmMeds.FormResize(Sender);
|
---|
| 1572 | end;
|
---|
| 1573 |
|
---|
| 1574 | procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
| 1575 | begin
|
---|
| 1576 | inherited;
|
---|
| 1577 | frmMeds.FormResize(Sender);
|
---|
| 1578 | end;
|
---|
| 1579 |
|
---|
| 1580 | procedure TfrmMeds.splitBottomMoved(Sender: TObject);
|
---|
| 1581 | begin
|
---|
| 1582 | inherited;
|
---|
| 1583 | if splitBottom.Height > 5 then splitBottom.Height := 5;
|
---|
| 1584 | end;
|
---|
| 1585 |
|
---|
| 1586 | procedure TfrmMeds.splitTopMoved(Sender: TObject);
|
---|
| 1587 | begin
|
---|
| 1588 | inherited;
|
---|
| 1589 | if splitTop.Height > 5 then splitTop.Height := 5;
|
---|
| 1590 | end;
|
---|
| 1591 |
|
---|
| 1592 | procedure TfrmMeds.InitfMedsSize;
|
---|
| 1593 | var
|
---|
| 1594 | retList : TStringList;
|
---|
| 1595 | strSizeFlds,x: string;
|
---|
| 1596 | i: integer;
|
---|
| 1597 | medsSplitFnd : boolean;
|
---|
| 1598 | panelBottom, panelMedIn : integer;
|
---|
| 1599 | begin
|
---|
| 1600 | //CQ3229
|
---|
| 1601 | //DETECT 1st TIME USER.
|
---|
| 1602 | //If first time user (medSplitFound=false), then manually set panel heights.
|
---|
| 1603 | //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
|
---|
| 1604 | medsSplitFnd := FALSE;
|
---|
| 1605 | if Assigned(frmMeds) then
|
---|
| 1606 | begin
|
---|
| 1607 | retList := TStringList.Create;
|
---|
| 1608 | tCallV(retList, 'ORWCH LOADALL', [nil]);
|
---|
| 1609 |
|
---|
| 1610 | for i := 0 to retList.Count-1 do
|
---|
| 1611 | begin
|
---|
| 1612 | x := retList.strings[i];
|
---|
| 1613 | if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
|
---|
| 1614 | begin
|
---|
| 1615 | medsSplitFnd := TRUE;
|
---|
| 1616 | Break;
|
---|
| 1617 | end;
|
---|
| 1618 | end;
|
---|
| 1619 |
|
---|
| 1620 | if not medsSplitFnd then
|
---|
| 1621 | begin
|
---|
| 1622 | pnlBottom.Height := frmMeds.Height div 2;
|
---|
| 1623 | pnlMedIn.Height := pnlBottom.Height div 2;
|
---|
| 1624 | panelBottom := pnlBottom.Height;
|
---|
| 1625 | panelMedIn := pnlMedIn.Height;
|
---|
| 1626 | strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0';
|
---|
| 1627 | CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]);
|
---|
| 1628 | end;
|
---|
| 1629 | end;
|
---|
| 1630 |
|
---|
| 1631 | end;
|
---|
| 1632 |
|
---|
| 1633 | end.
|
---|
| 1634 |
|
---|