Ignore:
Timestamp:
Jul 7, 2010, 4:31:10 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Upgrade to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Orders/fOrders.pas

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls,
    99  ExtCtrls, Menus, ORCtrls, ComCtrls, ORFn, rOrders, fODBase, uConst, uCore, uOrders,UBACore,
    10   UBAGlobals;
     10  UBAGlobals, VA508AccessibilityManager, fBase508Form;
    1111
    1212type
    … …  
    165165  private
    166166    { Private declarations }
     167    OrderListClickProcessing : Boolean;
    167168    FDfltSort: Integer;
    168169    FCurrentView: TOrderView;
    … …  
    184185    FDontCheck: boolean;
    185186    FParentComplexOrderID: string;
     187    FHighContrast2Mode: boolean;
    186188    function CanChangeOrderView: Boolean;
    187189    function GetEvtIFN(AnIndex: integer): string;
    … …  
    205207    procedure UseDefaultSort;
    206208    procedure SynchListToOrders;
    207 //    procedure ActivateDeactiveRenew;
     209    procedure ActivateDeactiveRenew;
    208210    procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
    209211    procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
    … …  
    214216    function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
    215217    function GetPlainText(AnOrder: TOrder; index: integer):string;
    216     function PatientStatusChanged: boolean;   
     218    //function PatientStatusChanged: boolean;
    217219    procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR;
    218220    function CheckOrderStatus: boolean;
     221    procedure RightClickMessageHandler(var Msg: TMessage; var Handled: Boolean);
    219222  public
    220223    procedure setSectionWidths; //CQ6170
    … …  
    267270     fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild,
    268271     fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses,
    269      fODConsult, fClinicWardMeds, fActivateDeactivate;
     272     fODConsult, fClinicWardMeds, fActivateDeactivate, VA2006Utils, rodMeds,
     273     VA508AccessibilityRouter, VAUtils;
    270274
    271275{$R *.DFM}
    … …  
    467471  AChildList: TStringlist;
    468472  CplxOrderID: string;
     473  DCNewOrder: boolean;
     474  DCChangeItem: TChangeItem;
    469475
    470476  procedure RemoveFromOrderList(ChildOrderID: string);
    … …  
    512518                  then CanSign := CH_SIGN_YES
    513519                  else CanSign := CH_SIGN_NA;
    514                 DCOrder(OrderForList, GetReqReason, ReturnedType);
     520                DCNEwOrder := false;
     521                if Changes.Orders.Count > 0 then
     522                  begin
     523                    for j := 0 to Changes.Orders.Count - 1 do
     524                      begin
     525                        DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
     526                        if DCChangeItem.ID = OrderForList.ID then
     527                          begin
     528                            if (Pos('DC', OrderForList.ActionOn) = 0) then
     529                            DCNewOrder := True;
     530                            //else DCNewOrder := False;
     531                          end;
     532                      end;
     533                  end;
     534                DCOrder(OrderForList, GetReqReason, DCNewOrder, ReturnedType);
    515535                Changes.Add(CH_ORD, OrderForList.ID, OrderForList.Text, '', CanSign);
    516536                FCompress := True;
    … …  
    587607begin
    588608  inherited;
     609  OrderListClickProcessing := false;
     610  FixHeaderControlDelphi2006Bug(hdrOrders);
    589611  PageID             := CT_ORDERS;
    590   lstOrders.Color    := ReadOnlyColor;
    591612  uOrderList         := TList.Create;
    592613  uEvtDCList         := TList.Create;
    … …  
    608629  FDontCheck := False;
    609630  FParentComplexOrderID := '';
     631  // 508 black color scheme that causes problems
     632  FHighContrast2Mode := BlackColorScheme and (ColorToRGB(clInfoBk) <> ColorToRGB(clBlack));
     633  AddMessageHandler(lstOrders, RightClickMessageHandler);
    610634end;
    611635
    … …  
    613637begin
    614638  inherited;
     639  RemoveMessageHandler(lstOrders, RightClickMessageHandler);
    615640  ClearOrders(uOrderList);
    616641  uEvtDCList.Clear;
    … …  
    684709    SaveTop := TopIndex;
    685710    Clear;
     711    repaint;
    686712    for i := 0 to uOrderList.Count - 1 do
    687713    begin
    … …  
    881907  inherited;
    882908  if not CanChangeOrderView then Exit;
    883   AnOrderView := TOrderView.Create;
    884   AnOrderView.Filter    := STS_ACTIVE;
    885   AnOrderView.DGroup    := DGroupAll;
    886   AnOrderView.ViewName  := 'All Services, Active';
    887   AnOrderView.InvChrono := True;
    888   AnOrderView.ByService := True;
    889   AnOrderView.CtxtTime  := 0;
    890   AnOrderView.TextView  := 0;
    891   AnOrderView.EventDelay.EventType := 'C';
    892   AnOrderView.EventDelay.Specialty := 0;
    893   AnOrderView.EventDelay.Effective := 0;
    894   AnOrderView.EventDelay.EventIFN  := 0;
    895   AnOrderView.EventDelay.EventName := 'All Services, Active';
    896   SelectOrderView(AnOrderView);
    897   with AnOrderView do if Changed then
    898   begin
    899     FCurrentView := AnOrderView;
    900     if FCurrentView.Filter in [15,16,17,24] then
    901     begin
    902       FCompress      := False;
    903       mnuActRel.Visible   := True;
    904       popOrderRel.Visible := True;
    905     end else
    906     begin
    907       mnuActRel.Visible   := False;
    908       popOrderRel.Visible := False;
    909     end;
    910 
    911     lstSheets.ItemIndex := -1;
    912     lblWrite.Caption := 'Write Orders';
    913     lstWrite.Clear;
    914     lstWrite.Caption := lblWrite.Caption;
    915     LoadWriteOrders(lstWrite.Items);
    916     RefreshOrderList(FROM_SERVER);
    917 
    918     if ByService then
    919     begin
    920       if InvChrono then FDfltSort := OVS_CATINV  else FDfltSort := OVS_CATFWD;
    921     end else
    922     begin
    923       if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
    924     end;
     909  AnOrderView := TOrderView.Create;              //       - this starts fresh instead, since CPRS v22
     910  try
     911    AnOrderView.Assign(FCurrentView);              // RV - v27.1 - preload form with current view params
     912  (*  AnOrderView.Filter    := STS_ACTIVE;                    - CQ #11261
     913    AnOrderView.DGroup    := DGroupAll;
     914    AnOrderView.ViewName  := 'All Services, Active';
     915    AnOrderView.InvChrono := True;
     916    AnOrderView.ByService := True;
     917    AnOrderView.CtxtTime  := 0;
     918    AnOrderView.TextView  := 0;
     919    AnOrderView.EventDelay.EventType := 'C';
     920    AnOrderView.EventDelay.Specialty := 0;
     921    AnOrderView.EventDelay.Effective := 0;
     922    AnOrderView.EventDelay.EventIFN  := 0;
     923    AnOrderView.EventDelay.EventName := 'All Services, Active';*)
     924    SelectOrderView(AnOrderView);
     925    with AnOrderView do if Changed then
     926    begin
     927      FCurrentView.Assign(AnOrderView);
     928      if FCurrentView.Filter in [15,16,17,24] then
     929      begin
     930        FCompress      := False;
     931        mnuActRel.Visible   := True;
     932        popOrderRel.Visible := True;
     933      end else
     934      begin
     935        mnuActRel.Visible   := False;
     936        popOrderRel.Visible := False;
     937      end;
     938
     939      //lstSheets.ItemIndex := -1;
     940      lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName;   // v27.5 - RV
     941
     942      lblWrite.Caption := 'Write Orders';
     943      lstWrite.Clear;
     944      lstWrite.Caption := lblWrite.Caption;
     945      LoadWriteOrders(lstWrite.Items);
     946      RefreshOrderList(FROM_SERVER);
     947
     948      if ByService then
     949      begin
     950        if InvChrono then FDfltSort := OVS_CATINV  else FDfltSort := OVS_CATFWD;
     951      end else
     952      begin
     953        if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
     954      end;
     955    end;
     956  finally
     957    AnOrderView.free;
    925958  end;
    926959end;
    … …  
    9841017      AnOrderID := Piece(BigOrderID, ';', 1);
    9851018      if StrToIntDef(AnOrderID,0) = 0 then
    986         ShowMessage('Detail view is not available for selected order.')
     1019        ShowMsg('Detail view is not available for selected order.')
    9871020      else
    9881021        begin
    989           tmpList.Assign(DetailOrder(BigOrderID));
     1022          FastAssign(DetailOrder(BigOrderID), tmpList);
    9901023          if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or
    9911024              (TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or
    992               (TOrder(Items.Objects[i]).DGroupName = 'Clin. Orders') or
     1025              (TOrder(Items.Objects[i]).DGroupName = 'Clinic Orders') or
    9931026              (TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then
    9941027            begin
    … …  
    9961029              tmpList.Add(StringOfChar('=', 74));
    9971030              tmpList.Add('');
    998               tmpList.AddStrings(MedAdminHistory(AnOrderID));
     1031              FastAddStrings(MedAdminHistory(AnOrderID), tmpList);
    9991032            end;
    10001033
    … …  
    12431276end;
    12441277
     1278procedure TfrmOrders.RightClickMessageHandler(var Msg: TMessage;
     1279  var Handled: Boolean);
     1280begin
     1281  if Msg.Msg = WM_RBUTTONUP then
     1282    lstOrders.RightClickSelect := (lstOrders.SelCount < 1);
     1283end;
     1284
    12451285function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string;
    12461286var
    … …  
    12541294  else
    12551295    FirstColumnDisplayed := 1;
    1256   for i:= FirstColumnDisplayed to 8 do begin
     1296  for i:= FirstColumnDisplayed to 9 do begin
    12571297    x := GetOrderText(AnOrder, index, i);
    12581298    if x <> '' then
    … …  
    12971337    {measure height of start/stop times}
    12981338    NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 3));
    1299     if NewHeight > 255 then NewHeight := 255;
     1339    if NewHeight > 255 then NewHeight := 255;  // This is maximum allowed by a Windows
    13001340    if NewHeight <  13 then NewHeight := 13;
    13011341  end;
    … …  
    13161356
    13171357function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string;
     1358var
     1359  AReason:  TStringlist;
     1360  i: integer;
    13181361begin
    13191362  if AnOrder <> nil then with AnOrder do
    … …  
    13341377        result := Text;
    13351378        if Flagged then
    1336           result := result + ' *Flagged*';
     1379        begin
     1380          if Notifications.Active then
     1381          begin
     1382            AReason := TStringList.Create;
     1383            try
     1384              result := result + crlf;
     1385              LoadFlagReason(AReason, ID);
     1386              for i := 0 to AReason.Count - 1 do
     1387                result :=  result + AReason[i] + CRLF;
     1388            finally
     1389              AReason.Free;
     1390            end;
     1391          end
     1392          else
     1393            result := result + '  *Flagged*';
     1394        end;
    13371395      end;
    13381396      3: result := GetStartStopText( StartTime, StopTime);
    … …  
    13751433    end;
    13761434    Canvas.FillRect(ARect);
    1377     Canvas.Pen.Color := clSilver;
     1435    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    13781436    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    13791437    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
    … …  
    14051463        if i = FirstColumnDisplayed then
    14061464        begin
    1407           if Flagged and (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) then
     1465          if Flagged then
    14081466          begin
    1409             Canvas.Brush.Color := clRed;
     1467            Canvas.Brush.Color := Get508CompliantColor(clRed);
    14101468            Canvas.FillRect(ARect);
    14111469          end;
    … …  
    14171475          if not (odSelected in State) and (AnOrder.Signature = OSS_UNSIGNED) then
    14181476          begin
    1419             if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
    1420               Canvas.Font.Color := clBlue;
     1477            if FHighContrast2Mode then
     1478              Canvas.Font.Color := clBlue
     1479            else
     1480              Canvas.Font.Color := Get508CompliantColor(clBlue);
    14211481          end;
    14221482        end;
    … …  
    14351495  inherited;
    14361496  FEvtColWidth := hdrOrders.Sections[0].Width;
    1437   RedrawSuspend(Self.Handle);
    14381497  RedrawOrderList;
    1439   RedrawActivate(Self.Handle);
    14401498  lstOrders.Invalidate;
    14411499  pnlRight.Refresh;
    … …  
    14571515  NextIndex: Integer;
    14581516begin
    1459   if PatientStatusChanged then exit;
     1517  if OrderListClickProcessing then Exit;
     1518  OrderListClickProcessing := true;   //Make sure this gets set to false prior to exiting.
     1519  //if PatientStatusChanged then exit;
    14601520  if BILLING_AWARE then //CQ5114
    14611521     fODConsult.displayDXCode := ''; //CQ5114
    … …  
    14661526  NextIndex := lstWrite.ItemIndex;
    14671527  if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
     1528  begin
     1529    OrderListClickProcessing := false;
    14681530    Exit;
     1531  end;
    14691532  if not ReadyForNewOrder(FCurrentView.EventDelay) then
    14701533  begin
    14711534    lstWrite.ItemIndex := RefNumFor(Self);
     1535    OrderListClickProcessing := false;
    14721536    Exit;
    14731537  end;
    1474  
     1538
    14751539  // don't write delayed orders for non-VA meds:
    14761540  if (FCurrentView.EventDelay.EventIFN>0) and (Piece(lstWrite.ItemID,';',2) = '145') then
    14771541    begin
    14781542      InfoBox('Delayed orders cannot be written for Non-VA Medications.', 'Meds, Non-VA', MB_OK);
     1543      OrderListClickProcessing := false;
    14791544      Exit;
    14801545    end;
    … …  
    14881553      begin
    14891554        lstWrite.ItemIndex := -1;
     1555        OrderListClickProcessing := false;
    14901556        Exit;
    14911557      end;
    1492   if frmFrame.CCOWDrivedChange then
     1558  if frmFrame.CCOWDrivedChange then begin
     1559    OrderListClickProcessing := false;
    14931560    Exit;
     1561  end;
    14941562  PositionTopOrder(StrToIntDef(Piece(lstWrite.ItemID, ';', 3), 0));  // position Display Group
    14951563  case CharAt(Piece(lstWrite.ItemID, ';', 4), 1) of
    … …  
    15171585    lstSheetsClick(Self);
    15181586  end;
     1587  OrderListClickProcessing := false;
    15191588  if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and
    15201589    (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
    … …  
    15601629    begin
    15611630      AnOrder := TOrder(Items.Objects[i]);
     1631      if (AnAction = 'RN') and (PassDrugTest(StrtoINT(Piece(AnOrder.ID, ';',1)), 'E', True, True)=True) then
     1632        begin
     1633          ShowMsg('Cannot renew Clozapine orders.');
     1634          Selected[i] := false;
     1635        end;
    15621636      if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
    15631637         begin
    … …  
    15701644        begin
    15711645          if (AnAction = 'RN') then
    1572             ShowMessage('The order contains invalid schedule and can not be renewed.')
     1646            ShowMsg('The order contains invalid schedule and can not be renewed.')
    15731647          else if (AnAction = 'EV') then
    1574             ShowMessage('The order contains invalid schedule and can not be changed to event delayed order.');
     1648            ShowMsg('The order contains invalid schedule and can not be changed to event delayed order.');
    15751649
    15761650          Selected[i] := False;
    … …  
    17201794    //if CheckOrderStatus = True then Exit;
    17211795    ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order
    1722     //ActivateDeactiveRenew;   AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
     1796    ActivateDeactiveRenew;   //AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
    17231797    MakeSelectedList(SelectedList);                     // build list of orders that remain
    17241798    // updating the Changes object happens in ExecuteDCOrders, based on individual order
    … …  
    17481822  if not CanManualRelease then
    17491823  begin
    1750     ShowMessage('You are not authorized to manual release delayed orders.');
     1824    ShowMsg('You are not authorized to manual release delayed orders.');
    17511825    Exit;
    17521826  end;
    … …  
    20852159    ChangeIFNList.Free;
    20862160  end;
     2161  if frmFrame.TimedOut then Exit;
    20872162  RedrawOrderList;
    20882163end;
    … …  
    22812356  if (User.OrderRole <> 2) and (User.OrderRole <> 3) then
    22822357  begin
    2283     ShowMessage('Sorry, You don''t have the permission to release selected orders manually');
     2358    ShowMsg('Sorry, You don''t have the permission to release selected orders manually');
    22842359    Exit;
    22852360  end;
    … …  
    29953070    if i > 0 then
    29963071      IsDefaultDlg := False;
     3072
    29973073    ADest.ItemIndex := -1;
    29983074    for j := 0 to ADest.Items.Count - 1 do
    … …  
    31073183begin
    31083184  inherited;
    3109   if PatientStatusChanged then exit;
     3185  //if PatientStatusChanged then exit;
    31103186  //frmFrame.UpdatePtInfoOnRefresh;
    31113187end;
    … …  
    31143190begin
    31153191  inherited;
    3116   if PatientStatusChanged then exit;
     3192  //if PatientStatusChanged then exit;
    31173193  //frmFrame.UpdatePtInfoOnRefresh;
    31183194end;
    … …  
    31213197begin
    31223198  inherited;
    3123   if PatientStatusChanged then exit;
     3199  //if PatientStatusChanged then exit;
    31243200  //frmFrame.UpdatePtInfoOnRefresh;
    31253201end;
    … …  
    31283204begin
    31293205  inherited;
    3130   if PatientStatusChanged then exit; 
     3206  //if PatientStatusChanged then exit; 
    31313207  //frmFrame.UpdatePtInfoOnRefresh;
    31323208end;
    … …  
    32733349end;
    32743350
    3275 function TfrmOrders.PatientStatusChanged: boolean;
     3351{function TfrmOrders.PatientStatusChanged: boolean;
    32763352const
    32773353
    … …  
    33023378    Result := True;
    33033379  end;
    3304 end;
     3380end;}
    33053381
    33063382function TfrmOrders.CheckOrderStatus: boolean;
    … …  
    33083384i: integer;
    33093385AnOrder: TOrder;
     3386OrderArray: TStringList;
    33103387begin
    33113388    Result := False;
     3389    OrderArray := TStringList.Create;
    33123390    with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
    33133391    begin
    33143392      AnOrder := TOrder(Items.Objects[i]);
    3315       if AnORder.Status <> GetOrderStatus(AnOrder.ID) then
    3316          begin
    3317            MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
    3318            frmFrame.mnuFileRefreshClick(Application);
    3319            Result := True;
    3320            EXIT;
    3321          end;
    3322     end;
    3323 end;
    3324 
    3325 (*procedure TfrmOrders.ActivateDeactiveRenew;
     3393      OrderArray.Add(AnOrder.ID + U + InttoStr(AnOrder.Status));
     3394    end;
     3395    if (OrderArray <> nil) and (not DoesOrderStatusMatch(OrderArray)) then
     3396      begin
     3397        MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
     3398        frmFrame.mnuFileRefreshClick(Application);
     3399        Result := True;
     3400      end;
     3401    ORderArray.Free;
     3402end;
     3403
     3404procedure TfrmOrders.ActivateDeactiveRenew;
    33263405var
    33273406  i: Integer;
    … …  
    33363415    end;
    33373416    if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr);
    3338 end;  *)
     3417end;
    33393418
    33403419procedure TfrmOrders.ViewInfo(Sender: TObject);
    … …  
    33953474end;
    33963475
     3476initialization
     3477  SpecifyFormIsNotADialog(TfrmOrders);
     3478
    33973479end.
    33983480
Note: See TracChangeset for help on using the changeset viewer.