Ignore:
Timestamp:
Jul 6, 2008, 8:20:14 PM (16 years ago)
Author:
Kevin Toppenberg
Message:

Uploading from OR_30_258

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/foia-cprs/CPRS-Chart/fMeds.pas

    r459 r460  
    7272    lstMedsOut: TCaptionListBox;
    7373    hdrMedsOut: THeaderControl;
     74    mnuViewInformation: TMenuItem;
     75    mnuViewDemo: TMenuItem;
     76    mnuViewVisits: TMenuItem;
     77    mnuViewPrimaryCare: TMenuItem;
     78    mnuViewMyHealtheVet: TMenuItem;
     79    mnuInsurance: TMenuItem;
     80    mnuViewFlags: TMenuItem;
     81    mnuViewReminders: TMenuItem;
     82    mnuViewRemoteData: TMenuItem;
     83    mnuViewPostings: TMenuItem;
     84    mnuOptimizeFields: TMenuItem;
    7485    procedure mnuChartTabClick(Sender: TObject);
    7586    procedure FormCreate(Sender: TObject);
    … …  
    96107    procedure mnuActRefillClick(Sender: TObject);
    97108    procedure mnuActClick(Sender: TObject);
    98     procedure pnlMedOut1Resize(Sender: TObject);
    99109    procedure mnuViewHistoryClick(Sender: TObject);
    100110    procedure popMedPopup(Sender: TObject);
    … …  
    114124    procedure splitBottomMoved(Sender: TObject);
    115125    procedure splitTopMoved(Sender: TObject);
     126    procedure hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton;
     127      Shift: TShiftState; X, Y: Integer);
     128    procedure hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton;
     129      Shift: TShiftState; X, Y: Integer);
     130    procedure hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton;
     131      Shift: TShiftState; X, Y: Integer);
     132    procedure hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton;
     133      Shift: TShiftState; X, Y: Integer);
     134    procedure hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton;
     135      Shift: TShiftState; X, Y: Integer);
     136    procedure hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton;
     137      Shift: TShiftState; X, Y: Integer);
     138    //procedure ActivateDeactiveRenew(AListBox: TListBox);
     139    procedure ViewInfo(Sender: TObject);
     140    procedure mnuViewInformationClick(Sender: TObject);
     141    procedure mnuOptimizeFieldsClick(Sender: TObject);
     142    procedure hdrMedsOutSectionClick(HeaderControl: THeaderControl;
     143      Section: THeaderSection);
     144    procedure hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
     145      Section: THeaderSection);
     146    procedure hdrMedsInSectionClick(HeaderControl: THeaderControl;
     147      Section: THeaderSection);
    116148  private
    117149    FIterating: Boolean;
    … …  
    138170    function GetMedList(Control: TWinControl): TList;
    139171    function GetPharmacyOrders(Control: TWinControl): TStringList;
     172    function PatientStatusChanged: boolean;
     173    procedure ClearChildODList;
    140174  public
    141     function PctOfTotalHeight(thisPanel: TPanel) : integer;
    142175    procedure RefreshMedLists;
    143176    procedure ClearPtData; override;
    … …  
    148181    property ParentComplexOrderID: string read FParentComplexOrderID  write FParentComplexOrderID;
    149182    procedure InitfMedsSize;
    150   end;
     183    procedure SetSectionWidths(Sender: TObject);
     184    function GetTotalSectionsWidth(Sender: TObject) : integer;
     185    function CheckMedStatus(ActiveList: TListBox): boolean;
     186  end;
     187
     188type
     189  arOrigOutPtSecWidths = array[0..6] of integer; //CQ7586
     190  arOrigInPtSecWidths = array[0..4] of integer; //CQ7586
     191  arOrigNonVASecWidths = array[0..3] of integer; //CQ7586
    151192
    152193var
    … …  
    154195//  LargePanelPortion: Integer;
    155196//  SmallPanelPortion: integer;
     197
     198  OrigOutPtSecWidths: arOrigOutPtSecWidths; //CQ7586
     199  OrigInPtSecWidths : arOrigInPtSecWidths; //CQ7586
     200  OrigNonVASecWidths: arOrigNonVASecWidths; //CQ7586
     201
    156202  MedOutSize:  double;
    157203  s: string;
    … …  
    161207
    162208  totalHeight: integer;
    163   MedOutPctOfTotalHeight: integer;
    164   NonVAPctOfTotalHeight: integer;
    165   MedInpctOfTotalHeight : integer;
    166209
    167210  resizedTotalHeight: integer;
    … …  
    171214
    172215  splitterTop: TSplitter;
    173   splitterBottom: TSplitter; 
     216  splitterBottom: TSplitter;
     217
     218  oldFont: integer; //CQ9182
     219
    174220
    175221implementation
    176222
    177 uses uCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold,
    178      fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase;
     223uses uCore, rCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold,
     224     fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase,
     225     StrUtils, fActivateDeactivate;
    179226
    180227{$R *.DFM}
    181228
    182229const
     230  SMALL_PANEL = 20;
     231  LARGE_PANEL = 60;
    183232  COL_MEDNAME = 1;
    184233  DG_OUT = 0;
    … …  
    215264begin
    216265  inherited ClearPtData;
     266  ClearChildODList;
    217267  lstMedsIn.Clear;
    218268  lstMedsOut.Clear;
    … …  
    225275  uPharmacyOrdersOut.Clear;
    226276  uMedListNonVA.Clear;
     277  totalHeight := 0;
    227278
    228279end;
    … …  
    231282const
    232283 RATIO_SMALL = 0.13; //0.1866;
     284
     285
    233286begin
    234287  inherited DisplayPage;
    … …  
    251304
    252305  if Patient.Inpatient then
    253      begin
     306  begin
    254307     splitBottom.Align := alNone;
    255      hdrMedsIn.Align := alNone;
    256 
    257      lstMedsIn.Parent := pnlTop;
    258      lstMedsIn.Align := alClient;
     308     hdrMedsIn.Align  := alNone;
     309     lstMedsIn.Align   := alNone;
     310
     311     lstMedsIn.Parent  := pnlTop;
     312     lstMedsIn.Align   := alClient;
    259313     lstMedsOut.Parent := pnlMedIn;
    260314
    261      hdrMedsIn.Parent := pnlTop;
    262      hdrMedsIn.Align := alTop;
     315     hdrMedsIn.Parent  := pnlTop;
     316     hdrMedsIn.Align   := alTop;
    263317
    264318     hdrMedsOut.Parent := pnlMedIn;
    265      splitBottom.Align     := alBottom;
    266      end
     319     splitBottom.Align := alBottom;
     320
     321     lstMedsIn.Height  := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
     322     lstMedsIn.Height  := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
     323     lstMedsOut.Height := lstMedsOut.Height + 1;  // added to cause repaint if user makes area small
     324     lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
     325
     326  end
    267327  else
    268328     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;
     329        splitBottom.Align := alNone;
     330        hdrMedsIn.Align   := alNone;
     331
     332        lstMedsIn.Parent  := pnlMedIn;
     333        lstMedsOut.Parent := pnlTop;
     334        lstMedsOut.Align  := alClient;
     335
     336        hdrMedsIn.Parent  := pnlMedIn;
     337        hdrMedsIn.Align   := alTop;
     338
     339        hdrMedsOut.Parent := pnlTop;
     340        splitBottom.Align := alBottom;
     341
     342        lstMedsIn.Height  := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
     343        lstMedsIn.Height  := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
     344        lstMedsOut.Height := lstMedsOut.Height + 1;  // added to cause repaint if user makes area small
     345        lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
    281346     end;
    282 
    283 
    284   RefreshMedLists;
     347   RefreshMedLists;
    285348
    286349end;
    … …  
    332395  if AnOrder <> nil then
    333396  begin
     397    //AGP Change 26.24 CQ 7150 fixes the problem with non-va meds initially showing up in the inpatient section
    334398    if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut;
    335     for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
     399    If uDGrp[DG_NVA] = AnOrder.DGroup then AMedList := uMedListNonVA;
     400    if (AMedList <> uMedListOut) and (AMedList <> uMedListNonVA) then
     401      for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
    336402  end;
    337403  case OrderAction of
    … …  
    409475      end
    410476      else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' +
    411                                Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
     477              Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
     478
    412479    end; {if AMedList}
    413480  ORDER_CPLXRN:
    … …  
    450517begin
    451518  inherited SetFontSize(FontSize);
     519  mnuOptimizeFieldsClick(self);
    452520  if Patient.DFN <> '' then
    453521    RefreshMedLists;
    … …  
    459527var
    460528 medsSplitFnd : boolean;
    461   panelBottom, panelMedIn : integer;
    462529  retList : TStringList;
    463530  i: integer;
    … …  
    486553  ChildODList := TStringList.Create;
    487554
    488  
     555
     556
    489557  //DETECT 1st TIME USER.
    490558  //If first time user (medSplitFound=false), then manually set panel heights.
    … …  
    501569        if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
    502570           begin
    503            medsSplitFnd := TRUE;
     571           medsSplitFnd := False;//TRUE;
    504572           Break;
    505573           end;
    … …  
    510578          pnlBottom.Height := frmMeds.Height div 2;
    511579          pnlMedIn.Height := pnlBottom.Height div 2;
    512           panelBottom := pnlBottom.Height;
    513           panelMedIn  := pnlMedIn.Height;
    514580        end;
    515581     end;
    516582
    517 
    518 
     583  //CQ9622
     584  if hdrMedsIn.Sections[1].Width < 100 then
     585     begin
     586     hdrMedsIn.Sections[1].Width := 100;
     587     hdrMedsIn.Refresh;
     588     end;
     589  if hdrMedsNonVA.Sections[1].Width < 100 then
     590     begin
     591     hdrMedsNonVA.Sections[1].Width := 100;
     592     lstMedsNonVA.Refresh;
     593     end;
     594  if hdrMedsOut.Sections[1].Width < 100 then
     595     begin
     596     hdrMedsOut.Sections[1].Width := 100;
     597     hdrMedsOut.Refresh;
     598     end;
     599  //end CQ9622
    519600end;
    520601
    … …  
    522603begin
    523604  inherited;
     605  ClearChildODList;
    524606  ClearMedList(uMedListIn);
    525607  ClearMedList(uMedListOut);
    … …  
    706788  result := '';
    707789  Detail := '';
     790  if AMed.Status = 'Suspended' then AMed.Status := 'Active/Susp'; //HDS00007547 PSI-03-033 Interim Solution.
    708791  case Column of
    709792    0: result := GetActionText(AMed);
    710793    1: result := GetInstructText(AMed, Detail);
    711794    2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate);
    712     3: result := AMed.Status;
     795    3: result :=  AMed.Status;
    713796    4:
    714797     begin
    … …  
    748831    TAG_INPT:  result := hdrMedsIn;
    749832
    750     else       result := nil;
     833    else       
     834    result := nil;
    751835  end;
    752836end;
    … …  
    758842    TAG_NONVA: result := uMedListNonVA;
    759843    TAG_INPT:  result := uMedListIn;
    760     else       result := nil;
     844    else
     845    result := nil;
    761846  end;
    762847end;
    … …  
    768853    TAG_NONVA: result := uNonVAOrdersOut;
    769854    TAG_INPT:  result := uPharmacyOrdersIn;
    770   else       
     855  else
    771856     result := nil;
    772857  end;
    … …  
    813898end;
    814899
    815 procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
    816   State: TOwnerDrawState);
     900procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    817901var
    818902  ReturnHt: Integer;
    … …  
    838922      begin
    839923        Canvas.Font.Style := [fsBold];
    840         if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
     924        //AGP Change 26.29 CQ #8188 Fix for highlighted new meds displaying blue font with a blue background.
     925        if odSelected in State  then
     926            begin
     927              Canvas.Brush.Color := clHighlight;
     928              Canvas.Font.Color := clHighlightText;
     929              //Canvas.FillRect(ARect);
     930              Canvas.Font.Color := clWhite;
     931           end;
     932        if (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) and (Canvas.Font.Color <> clWhite) then
    841933          Canvas.Font.Color := clBlue;
    842934        if (Length(Piece(AnAction,'^',4)) > 0) then
    … …  
    851943          ARect := ItemRect(Index);
    852944          ARect.Left  := RectLeft + 2;
    853           ARect.Right := ARect.Left + AHeader.Sections[i].Width - 6;
     945          ARect.Right := (ARect.Left + AHeader.Sections[i].Width - 6);
     946
     947          //if ((ARect.Right - ARect.Left) < 100) then
     948              //ARect.Right := ARect.Right + (100 - (ARect.Left + AHeader.Sections[i].Width - 6));
     949
    854950          ReturnHt  := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
    855951                        or DT_WORDBREAK);
    … …  
    884980begin
    885981  inherited;
     982 
     983  if PatientStatusChanged then exit;
    886984  with lstMedsOut do for i := 0 to Items.Count -1 do
    887985    Selected[i] := false;
    … …  
    895993begin
    896994  inherited;
     995 
     996  if PatientStatusChanged then exit;
    897997  with lstMedsIn do for i := 0 to Items.Count -1 do
    898998    Selected[i] := false;
    … …  
    9011001end;
    9021002
    903 procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl;
    904   Section: THeaderSection);
     1003procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
    9051004begin
    9061005  inherited;
    … …  
    9161015end;
    9171016
    918 procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl;
    919   Section: THeaderSection);
     1017procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
    9201018begin
    9211019  inherited;
    … …  
    9261024    IntegralHeight := not IntegralHeight;  // listbox window to be recreated
    9271025  end;
     1026
    9281027  RedrawActivate(Self.Handle);
    9291028  lstMedsIn.Invalidate;
    … …  
    9361035begin
    9371036  inherited;
    938   //frmFrame.UpdatePtInfoOnRefresh;
     1037  if PatientStatusChanged then exit;
    9391038  if lstMedsOut.SelCount > 0 then
    9401039  begin
    … …  
    9721071    begin
    9731072      ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
     1073      //ActivateDeactiveRenew(ActiveList); AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
    9741074      MakeSelectedList(ActiveList, SelectedList);
    9751075      if ExecuteDCOrders(SelectedList,DelEvt) then
    … …  
    9991099  if ActiveList = nil then Exit;
    10001100  SelectedList := TList.Create;
     1101  if CheckMedStatus(ActiveList) = True then Exit;
    10011102  try
    10021103    FIterating := True;
    … …  
    10341135  try
    10351136    FIterating := True;
     1137    if CheckMedStatus(ActiveList) = True then Exit;
    10361138    if AuthorizedUser and EncounterPresent and LockedForOrdering then
    10371139    begin
    … …  
    10841186  ChangeIFNList := TStringList.Create;
    10851187  try
     1188    FIterating := true;
     1189    if CheckMedStatus(ActiveList) = True then Exit;
     1190    ValidateSelected(ActiveList, OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
    10861191    MakeSelectedList(Activelist, SelectedList);
    10871192    with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
    … …  
    11361241  DoesDestEvtOccur := False;
    11371242  ActiveList := ListSelected(TX_NOSEL);
     1243  if CheckMedStatus(ActiveList) = True then Exit;
    11381244  if ActiveList = nil then Exit;
    11391245  NewOrderCreated := False;
    … …  
    12961402  if ActiveList = nil then Exit;
    12971403  SelectedList := TList.Create;
     1404  if CheckMedStatus(ActiveList) = True then Exit;
    12981405  try
    12991406    FIterating := True;
    … …  
    13441451       begin
    13451452         Selected[i] := False;
    1346          MessageDlg('You can not renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
     1453         MessageDlg('You cannot renew inpatient medication orders from a clinic location for selected patient.', mtWarning, [mbOK], 0);
    13471454       end;
    13481455    CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
    … …  
    14121519        end;
    14131520      end;
    1414       idx := -1;
    14151521      idx := ChildODList.IndexOf(AnOrder.ID);
    14161522      if idx > - 1 then
    … …  
    14261532
    14271533procedure 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;
     1534begin
    14481535  AListBox.Invalidate;
    14491536end;
    14501537
    1451 procedure TfrmMeds.pnlMedOut1Resize(Sender: TObject);
    1452 begin
    1453   inherited;
    1454   //if pnlMedOut.Height < 20 then pnlMedOut.Height := 20;
    1455 end;
    1456 
    1457 
    14581538procedure TfrmMeds.popMedPopup(Sender: TObject);
    14591539begin
    14601540  inherited;
    1461   //frmFrame.UpdatePtInfoOnRefresh;
     1541  if PatientStatusChanged then exit;
    14621542end;
    14631543
    … …  
    14651545begin
    14661546  inherited;
    1467   //frmFrame.UpdatePtInfoOnRefresh;
     1547  if PatientStatusChanged then exit; 
    14681548end;
    14691549
    … …  
    14731553begin
    14741554  inherited;
     1555  if PatientStatusChanged then exit; 
    14751556  with lstMedsIn do for i := 0 to Items.Count -1 do
    14761557     Selected[i] := false;
    … …  
    14911572end;
    14921573
    1493 procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
    1494   Section: THeaderSection);
     1574procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
    14951575begin
    14961576  inherited;
    … …  
    15061586end;
    15071587
    1508 function TfrmMeds.PctOfTotalHeight(thisPanel: TPanel) : integer;
    1509 var
    1510   pctOfTotal: real;
    1511 begin
    1512   pctOfTotal := ((thisPanel.Height / totalHeight) * 100);
    1513   Result := Round(pctOfTotal);
     1588function FontChanged : boolean;
     1589//CQ9182:  SEE ALSO procedure TfrmFrame.mnuFontSizeClick()
     1590begin
     1591  Result := false;
     1592  if Assigned(frmMeds) then
     1593  begin
     1594     if fMeds.oldFont = 0 then Result := False
     1595     else
     1596        if (fMeds.oldFont <> MainFontSize)  then
     1597           Result := true;
     1598  end;
    15141599end;
    15151600
    15161601procedure TfrmMeds.FormResize(Sender: TObject);
     1602var
     1603 maxPanelHeight: integer;
     1604
    15171605begin
    15181606  inherited;
    15191607  if Assigned(frmMeds) then
     1608  begin
     1609    //CQ9522 v26.51 Make sure all three panels are visible regardless of font size
     1610    if Assigned(self.Parent) then
    15201611     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;
     1612      if self.Height > parent.ClientHeight then
     1613         self.Height := parent.ClientHeight;
     1614      maxPanelHeight := round((parent.ClientHeight-20)/3);
     1615      if pnlTop.Height + pnlBottom.Height > parent.ClientHeight then
     1616        begin
     1617          pnlBottom.Height := maxPanelHeight*2;
     1618          pnlTop.Height := maxPanelHeight;
     1619        end;
     1620     end;    //assigned(self.parent)
     1621  end;
    15251622end;
    15261623
    … …  
    15371634  inherited;
    15381635  with hdrMedsOut do
    1539      begin
    1540      if Height < 16 then Height := 16;
    1541      if Height > 16 then Height := 16;
     1636  begin
     1637     Height := TextHeightByFont(Font.Handle, Sections[0].Text);
    15421638     Invalidate;
    1543      end;
     1639  end;
    15441640end;
    15451641
    … …  
    15481644  inherited;
    15491645  with hdrMedsNonVA do
    1550      begin
    1551      if Height < 16 then Height := 16;
    1552      if Height > 16 then Height := 16;
     1646  begin
     1647     Height := TextHeightByFont(Font.Handle, Sections[0].Text);
    15531648     Invalidate;
    1554      end;
     1649  end;
    15551650end;
    15561651
    … …  
    15591654  inherited;
    15601655  with hdrMedsIn do
    1561      begin
    1562      if Height < 16 then Height := 16;
    1563      if Height > 16 then Height := 16;
     1656  begin
     1657     Height := TextHeightByFont(Font.Handle, Sections[0].Text);
    15641658     Invalidate;
    1565      end;
     1659  end;
    15661660end;
    15671661
    … …  
    15811675begin
    15821676  inherited;
    1583   if splitBottom.Height > 5 then splitBottom.Height := 5;
     1677  splitBottom.Height := 5;
    15841678end;
    15851679
    … …  
    15871681begin
    15881682  inherited;
    1589   if splitTop.Height > 5 then splitTop.Height := 5;
     1683  splitTop.Height := 5;
    15901684end;
    15911685
    … …  
    16121706        x := retList.strings[i];
    16131707        if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
    1614            begin
     1708        begin
    16151709           medsSplitFnd := TRUE;
    16161710           Break;
    … …  
    16311725end;
    16321726
     1727function TfrmMeds.PatientStatusChanged: boolean;
     1728const
     1729
     1730  msgTxt1 = 'Patient status was changed from ';
     1731  msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
     1732   //GE CQ9537  - Change message text
     1733  msgTxt3 = 'Patient has been admitted.';
     1734  msgTxt4 = CRLF +'You will be prompted to sign your orders.  Any new orders subsequently' +
     1735            CRLF + 'entered and signed will be directed to the inpatient staff.';
     1736
     1737var
     1738  PtSelect: TPtSelect;
     1739  IsInpatientNow: boolean;
     1740  ptSts: string;
     1741begin
     1742  result := False;
     1743  SelectPatient(Patient.DFN, PtSelect);
     1744  IsInpatientNow := Length(PtSelect.Location) > 0;
     1745   //GE CQ9537  - Change message text
     1746  if Patient.Inpatient <> IsInpatientNow then
     1747  begin
     1748    if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0);
     1749    if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
     1750    MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
     1751    frmFrame.mnuFileRefreshClick(Application);
     1752    Result := True;
     1753  end;
     1754end;
     1755
     1756function TfrmMeds.GetTotalSectionsWidth(Sender: TObject) : integer;
     1757//CQ7586
     1758//Return stored values of column widths
     1759var
     1760  i: integer;
     1761begin
     1762  Result := 0;
     1763
     1764  if (Sender as THeaderControl).Name = 'hdrMedsOut' then
     1765     for i := 0 to hdrMedsOut.Sections.Count - 1 do
     1766        Result := Result + hdrMedsOut.Sections[i].Width;
     1767
     1768  if (Sender as THeaderControl).Name = 'hdrMedsIn' then
     1769     for i := 0 to hdrMedsIn.Sections.Count - 1 do
     1770        Result := Result + hdrMedsIn.Sections[i].Width;
     1771
     1772  if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
     1773     for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
     1774        Result := Result + hdrMedsNonVA.Sections[i].Width;
     1775end;
     1776
     1777procedure TfrmMeds.SetSectionWidths(Sender: TObject);
     1778//CQ7586
     1779//Copy values of column widths into array variables.
     1780var
     1781  i: integer;
     1782begin
     1783  if (Sender as THeaderControl).Name = 'hdrMedsOut' then
     1784     for i := 0 to hdrMedsOut.Sections.Count - 1 do
     1785        OrigOutPtSecWidths[i] := hdrMedsOut.Sections[i].Width;
     1786
     1787  if (Sender as THeaderControl).Name = 'hdrMedsIn' then
     1788     for i := 0 to hdrMedsIn.Sections.Count - 1 do
     1789        OrigInPtSecWidths[i] := hdrMedsIn.Sections[i].Width;
     1790
     1791  if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
     1792     for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
     1793        OrigNonVASecWidths[i] := hdrMedsNonVA.Sections[i].Width;
     1794end;
     1795
     1796procedure TfrmMeds.hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1797begin
     1798  inherited;
     1799  Self.SetSectionWidths(Sender); //CQ7586
     1800end;
     1801
     1802procedure TfrmMeds.hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1803begin
     1804  inherited;
     1805  Self.SetSectionWidths(Sender); //CQ7586
     1806end;
     1807
     1808procedure TfrmMeds.hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1809begin
     1810  inherited;
     1811  Self.SetSectionWidths(Sender); //CQ7586
     1812end;
     1813
     1814procedure TfrmMeds.hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1815//CQ7586
     1816var
     1817  i: integer;
     1818  totalSectionsWidth, originalwidth: integer;
     1819begin
     1820  inherited;
     1821  totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
     1822  if totalSectionsWidth > lstMedsOut.Width - 5 then  //could used any of the three list boxes here, since all are same width
     1823  begin
     1824    originalwidth := 0;
     1825    for i := 0 to hdrMedsOut.Sections.Count - 1 do
     1826      originalwidth := originalwidth + OrigOutPtSecWidths[i];
     1827    if originalwidth < totalSectionsWidth then
     1828    begin
     1829      for i := 0 to hdrMedsOut.Sections.Count - 1 do
     1830        hdrMedsOut.Sections[i].Width := OrigOutPtSecWidths[i];
     1831      lstMedsOut.Invalidate;
     1832    end;
     1833  end;
     1834  //CQ9622
     1835  if hdrMedsOut.Sections[1].Width < 100 then
     1836  begin
     1837    hdrMedsOut.Sections[1].Width := 100;
     1838    lstMedsOut.Refresh;
     1839  end;
     1840  //end CQ9622
     1841  pnlBottom.Height := pnlBottom.Height - 1;  // forces autopanel resize
     1842  pnlBottom.Height := pnlBottom.Height + 1;  // forces autopanel resize
     1843end;
     1844
     1845procedure TfrmMeds.hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1846//CQ7586
     1847var
     1848  i: integer;
     1849  totalSectionsWidth, originalwidth: integer;
     1850begin
     1851  inherited;
     1852  totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
     1853  if totalSectionsWidth > lstMedsNonVA.Width - 5 then  //could used any of the three list boxes here, since all are same width
     1854  begin
     1855    originalwidth := 0;
     1856    for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
     1857      originalwidth := originalwidth + OrigNonVASecWidths[i];
     1858    if originalwidth < totalSectionsWidth then
     1859    begin
     1860      for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
     1861        hdrMedsNonVA.Sections[i].Width := OrigNonVASecWidths[i];
     1862      lstMedsNonVA.Invalidate;
     1863    end;
     1864  end;
     1865  //CQ9622
     1866  if hdrMedsNonVA.Sections[1].Width < 100 then
     1867  begin
     1868    hdrMedsNonVA.Sections[1].Width := 100;
     1869    lstMedsNonVA.Refresh;
     1870  end;
     1871  //end CQ9622
     1872  pnlNonVA.Height := pnlNonVA.Height - 1;  // forces autopanel resize
     1873  pnlNonVA.Height := pnlNonVA.Height + 1;  // forces autopanel resize
     1874end;
     1875
     1876procedure TfrmMeds.hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     1877//CQ7586
     1878var
     1879  i: integer;
     1880  totalSectionsWidth, originalwidth: integer;
     1881begin
     1882  inherited;
     1883  totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
     1884  if totalSectionsWidth > lstMedsIn.Width - 5 then  //could used any of the three list boxes here, since all are same width
     1885  begin
     1886    originalwidth := 0;
     1887    for i := 0 to hdrMedsIn.Sections.Count - 1 do
     1888      originalwidth := originalwidth + OrigInPtSecWidths[i];
     1889    if originalwidth < totalSectionsWidth then
     1890    begin
     1891      for i := 0 to hdrMedsIn.Sections.Count - 1 do
     1892        hdrMedsIn.Sections[i].Width := OrigInPtSecWidths[i];
     1893      lstMedsIn.Invalidate;
     1894    end;
     1895  end;
     1896  //CQ9622
     1897  if hdrMedsIn.Sections[1].Width < 100 then
     1898  begin
     1899    hdrMedsIn.Sections[1].Width := 100;
     1900    lstMedsIn.Refresh;
     1901  end;
     1902  //end CQ9622
     1903  pnlBottom.Height := pnlBottom.Height - 1;  // forces autopanel resize
     1904  pnlBottom.Height := pnlBottom.Height + 1;  // forces autopanel resize
     1905end;
     1906
     1907procedure TfrmMeds.ClearChildODList;
     1908var
     1909  i: integer;
     1910begin
     1911  for i := 0 to ChildODList.count-1 do
     1912    if(assigned(ChildODList.Objects[i])) then
     1913      ChildODList.Objects[i].Free;
     1914  ChildODList.Clear;
     1915end;
     1916
     1917function TfrmMeds.CheckMedStatus(ActiveList: TListBox): boolean;
     1918var
     1919i: integer;
     1920tmpList: TStringList;
     1921Str: string;
     1922AMed: TMedListRec;
     1923AMedList: TList;
     1924
     1925begin
     1926 result := False;
     1927 tmpList:= TStringList.Create;
     1928 if TMedListRec = nil then exit;
     1929 AMedList := GetMedList(ActiveList);
     1930 for i := 0 to ActiveList.Count - 1 do if ActiveList.Selected[i] then
     1931    begin
     1932       AMed := TMedListRec(AMedList[i]);
     1933       str := Amed.PharmID + U + AMed.Status;
     1934       tmpList.Add(Str);
     1935      end;
     1936 if tmpList <> nil then
     1937   begin
     1938     Result := GetMedStatus(tmpList);
     1939     tmpList.Free;
     1940   end;
     1941 if Result = True then
     1942     begin
     1943       MessageDlg('The Medication status has change.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct medication status', mtWarning, [mbOK], 0);
     1944       frmFrame.mnuFileRefreshClick(Application);
     1945     end;
     1946end;
     1947
     1948(*procedure TfrmMeds.ActivateDeactiveRenew(AListBox: TListBox);
     1949var
     1950  i: Integer;
     1951  CurID: string;
     1952  SomePharmacyOrders: TStringList;
     1953  tmpArr: TStringList;
     1954begin
     1955    tmpArr := TStringList.Create;
     1956    SomePharmacyOrders := GetPharmacyOrders(AListBox);
     1957    with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
     1958      begin
     1959        CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
     1960        if Length(CurID) > 0 then CurID := Piece(CurID, U, 2)
     1961        else CurID := Piece(SomePharmacyOrders[i], U, 2);
     1962        tmpArr.Add(curID);
     1963      end;
     1964    if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr, AListBox);
     1965end; *)
     1966
     1967procedure TfrmMeds.ViewInfo(Sender: TObject);
     1968begin
     1969  inherited;
     1970  frmFrame.ViewInfo(Sender);
     1971end;
     1972
     1973procedure TfrmMeds.mnuViewInformationClick(Sender: TObject);
     1974begin
     1975  inherited;
     1976  mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
     1977  mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
     1978  mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
     1979  mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
     1980  mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
     1981  mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
     1982  mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
     1983  mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
     1984  mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
     1985end;
     1986
     1987procedure TfrmMeds.mnuOptimizeFieldsClick(Sender: TObject);
     1988var
     1989  totalSectionsWidth, unit1, unit2, unit8: integer;
     1990begin
     1991  totalSectionsWidth := pnlTop.Width - 5;
     1992  if totalSectionsWidth < 16 then exit;
     1993  unit1 := (totalSectionsWidth div 16) - 1;
     1994  unit2 := unit1 * 2;
     1995  unit8 := unit1 * 8;
     1996
     1997  with hdrMedsNonVA do
     1998  begin
     1999    Sections[0].Width := unit1;
     2000    Sections[1].Width := unit8;
     2001    Sections[2].Width := unit2;
     2002    Sections[3].Width := unit2;
     2003  end;
     2004  hdrMedsNonVASectionResize(hdrMedsNonVA, hdrMedsNonVA.Sections[0]);
     2005  hdrMedsNonVA.Repaint;
     2006
     2007  with hdrMedsIn do
     2008  begin
     2009    Sections[0].Width := unit1;
     2010    Sections[1].Width := unit8;
     2011    Sections[2].Width := unit2;
     2012    Sections[3].Width := unit2;
     2013    Sections[4].Width := unit2;
     2014  end;
     2015  hdrMedsInSectionResize(hdrMedsIn, hdrMedsIn.Sections[0]);
     2016  hdrMedsIn.Repaint;
     2017  with hdrMedsOut do
     2018  begin
     2019    Sections[0].Width := unit1;
     2020    Sections[1].Width := unit8;
     2021    Sections[2].Width := unit2;
     2022    Sections[3].Width := unit2;
     2023    Sections[4].Width := unit2;
     2024    Sections[5].Width := unit1;
     2025  end;
     2026  hdrMedsOutSectionResize(hdrMedsOut, hdrMedsOut.Sections[0]);
     2027  hdrMedsOut.Repaint;
     2028end;
     2029
     2030procedure TfrmMeds.hdrMedsOutSectionClick(HeaderControl: THeaderControl;
     2031  Section: THeaderSection);
     2032begin
     2033  inherited;
     2034  //if Section = hdrMedsOut.Sections[1] then
     2035    mnuOptimizeFieldsClick(self);
     2036end;
     2037
     2038procedure TfrmMeds.hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
     2039  Section: THeaderSection);
     2040begin
     2041  inherited;
     2042  //if Section = hdrMedsNonVA.Sections[1] then
     2043    mnuOptimizeFieldsClick(self);
     2044end;
     2045
     2046procedure TfrmMeds.hdrMedsInSectionClick(HeaderControl: THeaderControl;
     2047  Section: THeaderSection);
     2048begin
     2049  inherited;
     2050  //if Section = hdrMedsIn.Sections[1] then
     2051    mnuOptimizeFieldsClick(self);
     2052end;
     2053
    16332054end.
    16342055
Note: See TracChangeset for help on using the changeset viewer.