Ignore:
Timestamp:
May 7, 2015, 12:34:29 PM (9 years ago)
Author:
healthsevak
Message:

Updating the working copy to CPRS version 28

Location:
cprs/trunk/CPRS-Chart/Orders
Files:
57 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Orders/fOCAccept.dfm

    r829 r1679  
    44  BorderIcons = []
    55  Caption = 'Order Checking'
    6   ClientHeight = 169
    7   ClientWidth = 472
     6  ClientHeight = 186
     7  ClientWidth = 622
     8  Constraints.MinHeight = 200
     9  Constraints.MinWidth = 600
    810  Position = poScreenCenter
    9   ExplicitLeft = 305
    10   ExplicitTop = 257
    11   ExplicitWidth = 480
    12   ExplicitHeight = 203
     11  ExplicitWidth = 630
     12  ExplicitHeight = 220
    1313  PixelsPerInch = 96
    1414  TextHeight = 13
    … …  
    1616    Left = 0
    1717    Top = 0
    18     Width = 472
    19     Height = 136
     18    Width = 622
     19    Height = 153
    2020    Align = alClient
     21    Font.Charset = DEFAULT_CHARSET
     22    Font.Color = clWindowText
     23    Font.Height = -11
     24    Font.Name = 'Courier New'
     25    Font.Style = []
     26    ParentFont = False
    2127    ReadOnly = True
    2228    ScrollBars = ssVertical
    … …  
    2632  object pnlBottom: TPanel [1]
    2733    Left = 0
    28     Top = 136
    29     Width = 472
     34    Top = 153
     35    Width = 622
    3036    Height = 33
    3137    Align = alBottom
    … …  
    3440    object cmdAccept: TButton
    3541      Left = 148
    36       Top = 7
     42      Top = 6
    3743      Width = 80
    3844      Height = 21
    … …  
    5157      ModalResult = 7
    5258      TabOrder = 1
     59      OnClick = cmdCancelClick
     60    end
     61    object Button1: TButton
     62      Left = 384
     63      Top = 6
     64      Width = 145
     65      Height = 21
     66      Caption = 'Drug Interaction Monograph'
     67      Enabled = False
     68      TabOrder = 2
     69      OnClick = Button1Click
    5370    end
    5471  end
    … …  
    6986      (
    7087        'Component = frmOCAccept'
     88        'Status = stsDefault')
     89      (
     90        'Component = Button1'
    7191        'Status = stsDefault'))
    7292  end

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

    r829 r1679  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager, rOrders, fOCMonograph;
    88
    99type
    … …  
    1313    cmdAccept: TButton;
    1414    cmdCancel: TButton;
     15    Button1: TButton;
     16    procedure Button1Click(Sender: TObject);
     17    procedure cmdCancelClick(Sender: TObject);
     18    procedure FormResize(Sender: TObject);
    1519  private
    1620    { Private declarations }
    … …  
    2731function AcceptOrderWithChecks(OCList: TStringList): Boolean;
    2832var
    29   i: Integer;
     33  i,j: Integer;
    3034  frmOCAccept: TfrmOCAccept;
    31 begin
     35  substring: String;
     36  remOC: TStringList;
     37begin         
     38  remOC := TStringList.Create;
    3239  Result := True;
    3340  if OCList.Count > 0 then
    … …  
    3643    try
    3744      ResizeFormToFont(TForm(frmOCAccept));
     45      frmOCAccept.Button1.Enabled := false;
     46      if IsMonograph then frmOCAccept.Button1.Enabled := true;
     47
    3848      for i := 0 to OCList.Count - 1 do
    3949      begin
    40         frmOCAccept.memChecks.Lines.Add(Piece(OCList[i], U, 4));
     50        substring := Copy(Piece(OCList[i], U, 4),0,2);
     51        if substring='||' then
     52        begin
     53          substring := Copy(Piece(OCList[i], U, 4),3,Length(Piece(OCList[i], U, 4)));
     54          GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2));
     55          frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+')  ' + Piece(substring,'&',2));
     56          for j:= 0 to remOC.Count - 1 do frmOCAccept.memChecks.Lines.Add('      '+remOC[j]);
     57          frmOCAccept.memChecks.Lines.Add('           ');
     58        end
     59        else
     60        begin
     61          frmOCAccept.memChecks.Lines.Add('('+inttostr(i+1)+' of '+inttostr(OCList.Count)+')  ' + Piece(OCList[i], U, 4));
     62        end;
     63       
    4164        frmOCAccept.memChecks.Lines.Add('');
    4265      end;
    … …  
    4669    finally
    4770      frmOCAccept.Release;
     71      remOC.Destroy;
    4872    end;
    4973  end;
    5074end;
    5175
     76procedure TfrmOCAccept.Button1Click(Sender: TObject);
     77var
     78  monoList: TStringList;
     79begin
     80  inherited;
     81  monoList := TStringList.Create;
     82  GetMonographList(monoList);
     83  ShowMonographs(monoList);
     84  monoList.Free;
     85end;
     86
     87procedure TfrmOCAccept.cmdCancelClick(Sender: TObject);
     88begin
     89  inherited;
     90  DeleteMonograph;
     91end;
     92
     93procedure TfrmOCAccept.FormResize(Sender: TObject);
     94begin
     95  inherited;
     96  memChecks.Refresh;
     97end;
     98
    5299end.

  • cprs/trunk/CPRS-Chart/Orders/fOCSession.dfm

    r829 r1679  
    22  Left = 366
    33  Top = 222
     4  Width = 714
     5  Height = 530
     6  HorzScrollBar.Visible = True
     7  VertScrollBar.Visible = True
     8  AutoScroll = True
    49  BorderIcons = []
    510  Caption = 'Order Checks'
    6   ClientWidth = 494
     11  Constraints.MinHeight = 500
     12  Constraints.MinWidth = 500
    713  Position = poScreenCenter
    814  ShowHint = True
    915  OnClose = FormClose
     16  OnCreate = FormCreate
     17  OnMouseWheelDown = FormMouseWheelDown
    1018  OnShow = FormShow
    11   ExplicitWidth = 502
    12   ExplicitHeight = 240
     19  ExplicitWidth = 714
     20  ExplicitHeight = 530
    1321  PixelsPerInch = 96
    1422  TextHeight = 13
    15   object lstChecks: TCaptionListBox [0]
     23  object pnlBottom: TPanel [0]
    1624    Left = 0
    17     Top = 0
    18     Width = 494
    19     Height = 162
    20     Style = lbOwnerDrawVariable
    21     Align = alClient
    22     ItemHeight = 13
    23     MultiSelect = True
    24     ParentShowHint = False
    25     ShowHint = True
    26     TabOrder = 1
    27     OnDrawItem = lstChecksDrawItem
    28     OnMeasureItem = lstChecksMeasureItem
    29     HintOnItem = True
    30   end
    31   object pnlBottom: TPanel [1]
    32     Left = 0
    33     Top = 162
    34     Width = 494
    35     Height = 111
    36     Align = alBottom
     25    Top = 352
     26    Width = 706
     27    Height = 146
     28    Anchors = [akLeft, akTop, akBottom]
    3729    BevelOuter = bvNone
    3830    TabOrder = 0
    3931    DesignSize = (
    40       494
    41       111)
     32      706
     33      146)
    4234    object lblJustify: TLabel
    4335      Left = 9
    44       Top = 34
    45       Width = 248
     36      Top = 58
     37      Width = 234
    4638      Height = 13
    47       Anchors = [akLeft, akTop, akRight]
    48       Caption = 'Enter justification for overriding critical order checks -'
    49     end
    50     object txtJustify: TCaptionEdit
    51       Left = 8
    52       Top = 50
    53       Width = 478
    54       Height = 21
    55       Anchors = [akLeft, akTop, akRight]
    56       MaxLength = 80
    57       TabOrder = 0
    58       OnKeyDown = txtJustifyKeyDown
    59       Caption = 'Enter justification for overriding critical order checks -'
    60     end
    61     object cmdCancelOrder: TButton
    62       Left = 356
    63       Top = 5
    64       Width = 131
    65       Height = 21
    66       Anchors = [akLeft, akTop, akRight]
    67       Caption = 'Cancel Selected Order(s)'
    68       TabOrder = 3
    69       OnClick = cmdCancelOrderClick
    70     end
    71     object cmdContinue: TButton
    72       Left = 157
    73       Top = 82
    74       Width = 70
    75       Height = 21
    76       Caption = 'Continue'
    77       TabOrder = 4
    78       OnClick = cmdContinueClick
    79     end
    80     object btnReturn: TButton
    81       Left = 241
    82       Top = 82
    83       Width = 97
    84       Height = 21
    85       Cancel = True
    86       Caption = 'Return to Orders'
    87       TabOrder = 5
    88       OnClick = btnReturnClick
     39      Anchors = [akLeft]
     40      Caption = 'Enter reason for overriding order checks:'
     41      Font.Charset = DEFAULT_CHARSET
     42      Font.Color = clWindowText
     43      Font.Height = -11
     44      Font.Name = 'MS Sans Serif'
     45      Font.Style = [fsBold]
     46      ParentFont = False
    8947    end
    9048    object memNote: TMemo
    91       Left = 8
    92       Top = 4
    93       Width = 329
    94       Height = 29
     49      Left = 392
     50      Top = 12
     51      Width = 306
     52      Height = 40
    9553      BorderStyle = bsNone
    9654      Color = clBtnFace
    9755      Lines.Strings = (
    98         'NOTE: The override justification is for tracking purposes and '
     56        'NOTE: The override reason is for tracking purposes and '
    9957        'does not change or place new order(s).')
    10058      ReadOnly = True
     59      TabOrder = 0
     60      OnEnter = memNoteEnter
     61    end
     62    object txtJustify: TCaptionEdit
     63      Left = 8
     64      Top = 80
     65      Width = 682
     66      Height = 21
     67      Anchors = [akLeft]
     68      AutoSize = False
     69      MaxLength = 80
     70      TabOrder = 3
     71      OnKeyDown = txtJustifyKeyDown
     72      Caption = 'Enter justification for overriding critical order checks -'
     73    end
     74    object cmdCancelOrder: TButton
     75      Left = 9
     76      Top = 17
     77      Width = 168
     78      Height = 21
     79      Caption = 'Cancel Checked Order(s)'
     80      Font.Charset = DEFAULT_CHARSET
     81      Font.Color = clWindowText
     82      Font.Height = -11
     83      Font.Name = 'MS Sans Serif'
     84      Font.Style = [fsBold]
     85      ParentFont = False
    10186      TabOrder = 1
    102       OnEnter = memNoteEnter
     87      OnClick = cmdCancelOrderClick
     88    end
     89    object cmdContinue: TButton
     90      Left = 219
     91      Top = 112
     92      Width = 127
     93      Height = 23
     94      Anchors = [akLeft, akTop, akRight, akBottom]
     95      Caption = 'Accept Order(s)'
     96      Font.Charset = DEFAULT_CHARSET
     97      Font.Color = clWindowText
     98      Font.Height = -11
     99      Font.Name = 'MS Sans Serif'
     100      Font.Style = [fsBold]
     101      ParentFont = False
     102      TabOrder = 4
     103      OnClick = cmdContinueClick
     104    end
     105    object btnReturn: TButton
     106      Left = 352
     107      Top = 112
     108      Width = 122
     109      Height = 23
     110      Anchors = [akLeft, akTop, akRight, akBottom]
     111      Cancel = True
     112      Caption = 'Return to Orders'
     113      Font.Charset = DEFAULT_CHARSET
     114      Font.Color = clWindowText
     115      Font.Height = -11
     116      Font.Name = 'MS Sans Serif'
     117      Font.Style = [fsBold]
     118      ParentFont = False
     119      TabOrder = 5
     120      OnClick = btnReturnClick
     121    end
     122    object cmdMonograph: TButton
     123      Left = 536
     124      Top = 107
     125      Width = 162
     126      Height = 21
     127      Anchors = [akRight, akBottom]
     128      Caption = 'Drug Interaction Monograph'
     129      TabOrder = 6
     130      OnClick = cmdMonographClick
     131    end
     132  end
     133  object pnlTop: TORAutoPanel [1]
     134    Left = 0
     135    Top = 0
     136    Width = 706
     137    Height = 346
     138    Align = alTop
     139    BevelEdges = []
     140    BevelOuter = bvNone
     141    TabOrder = 1
     142    DesignSize = (
     143      706
     144      346)
     145    object lblHover: TLabel
     146      Left = 16
     147      Top = 32
     148      Width = 445
     149      Height = 13
     150      Caption =
     151        'If the order check description is cut short, hover over the text' +
     152        ' to view the complete description.'
     153    end
     154    object grdchecks: TCaptionStringGrid
     155      Left = 16
     156      Top = 64
     157      Width = 682
     158      Height = 279
     159      Margins.Top = 0
     160      Anchors = [akLeft, akBottom]
     161      ColCount = 3
     162      DefaultDrawing = False
     163      FixedColor = clBtnShadow
     164      FixedCols = 0
     165      RowCount = 2
     166      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowMoving, goTabs]
     167      ScrollBars = ssVertical
     168      TabOrder = 1
     169      OnDrawCell = grdchecksDrawCell
     170      OnEnter = grdchecksEnter
     171      OnKeyDown = grdchecksKeyDown
     172      OnMouseDown = grdchecksMouseDown
     173      OnMouseMove = grdchecksMouseMove
     174      OnMouseWheelDown = grdchecksMouseWheelDown
     175      OnMouseWheelUp = grdchecksMouseWheelUp
     176      OnSelectCell = grdchecksSelectCell
     177      JustToTab = True
     178    end
     179    object lblInstr: TVA508StaticText
     180      Name = 'lblInstr'
     181      Left = 0
     182      Top = 12
     183      Width = 641
     184      Height = 15
     185      Margins.Bottom = 0
     186      Alignment = taLeftJustify
     187      AutoSize = True
     188      Caption =
     189        'To cancel an order select the order by checking the checkbox and' +
     190        ' press the "Cancel Checked Order(s)" button.'
     191      Font.Charset = DEFAULT_CHARSET
     192      Font.Color = clWindowText
     193      Font.Height = -11
     194      Font.Name = 'MS Sans Serif'
     195      Font.Style = [fsBold]
     196      ParentFont = False
     197      TabOrder = 0
     198      TabStop = True
     199      ShowAccelChar = True
    103200    end
    104201  end
    … …  
    106203    Data = (
    107204      (
    108         'Component = lstChecks'
    109         'Status = stsDefault')
    110       (
    111205        'Component = pnlBottom'
    112206        'Status = stsDefault')
    … …  
    128222      (
    129223        'Component = frmOCSession'
     224        'Status = stsDefault')
     225      (
     226        'Component = cmdMonograph'
     227        'Status = stsDefault')
     228      (
     229        'Component = grdchecks'
     230        'Status = stsDefault')
     231      (
     232        'Component = pnlTop'
    130233        'Status = stsDefault'))
    131234  end

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

    r829 r1679  
    44
    55uses
    6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager;
     6  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fOCMonograph,
     7  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager,
     8  Grids, strUtils, uDlgComponents, VAUtils, VA508AccessibilityRouter;
    89
    910type
    1011  TfrmOCSession = class(TfrmAutoSz)
    11     lstChecks: TCaptionListBox;
    1212    pnlBottom: TPanel;
    1313    lblJustify: TLabel;
    … …  
    1717    btnReturn: TButton;
    1818    memNote: TMemo;
     19    cmdMonograph: TButton;
     20    grdchecks: TCaptionStringGrid;
     21    lblInstr: TVA508StaticText;
     22    pnlTop: TORAutoPanel;
     23    lblHover: TLabel;
    1924    procedure cmdCancelOrderClick(Sender: TObject);
    2025    procedure cmdContinueClick(Sender: TObject);
    21     procedure lstChecksMeasureItem(Control: TWinControl; Index: Integer;
    22       var Height: Integer);
    23     procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
    24       Rect: TRect; State: TOwnerDrawState);
    2526    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2627    procedure FormShow(Sender: TObject);
    … …  
    3031    procedure btnReturnClick(Sender: TObject);
    3132    procedure memNoteEnter(Sender: TObject);
     33    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     34    procedure cmdMonographClick(Sender: TObject);
     35    procedure grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
     36      Rect: TRect; State: TGridDrawState);
     37    function CheckBoxRect(poRect: TRect): TRect;
     38    function GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
     39    function InCheckBox(Grid: TStringGrid; X, Y, ACol, ARow: integer): boolean;
     40    procedure SetCheckState(grid: TStringGrid; ACol, ARow: integer; State: boolean);
     41    procedure grdchecksMouseDown(Sender: TObject; Button: TMouseButton;
     42      Shift: TShiftState; X, Y: Integer);
     43    procedure grdchecksSelectCell(Sender: TObject; ACol, ARow: Integer;
     44      var CanSelect: Boolean);
     45    procedure GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
     46    procedure grdchecksEnter(Sender: TObject);
     47    procedure FormCreate(Sender: TObject);
     48    procedure grdchecksKeyDown(Sender: TObject; var Key: Word;
     49      Shift: TShiftState);
     50    procedure grdchecksMouseWheelDown(Sender: TObject; Shift: TShiftState;
     51      MousePos: TPoint; var Handled: Boolean);
     52    procedure grdchecksMouseWheelUp(Sender: TObject; Shift: TShiftState;
     53      MousePos: TPoint; var Handled: Boolean);
     54    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
     55      MousePos: TPoint; var Handled: Boolean);
     56    procedure grdchecksMouseMove(Sender: TObject; Shift: TShiftState; X,
     57      Y: Integer);
     58   // procedure memNoteSetText(str: string);
    3259  private
    3360    FCritical: Boolean;
    … …  
    112139function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
    113140var
    114   i, j: Integer;
    115   LastID, NewID: string;
    116   CheckList: TStringList;
     141  i, j, k, l, m, rowcnt: Integer;
     142  LastID, NewID, gridtext: string;
     143  CheckList,remOC: TStringList;
    117144  OCRec: TOCRec;
    118   //AChangeItem: TChangeItem;
    119145  frmOCSession: TfrmOCSession;
    120   x: string;
     146  x,substring: string;
    121147begin
    122148  Result := True;
    … …  
    129155    begin
    130156      frmOCSession := TfrmOCSession.Create(Application);
     157      //frmOCSession.grdchecks.RowCount := frmOCSession.grdchecks.RowCount + 1; *)
     158      //rowcnt := frmOCSession.grdchecks.RowCount;
     159      //if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
     160      rowcnt := 1;
     161      frmOCSession.grdchecks.canvas.Font.Name := 'Courier New';
     162      frmOCSession.grdchecks.Canvas.Font.Size := MainFontSize;
     163      frmOCSession.cmdMonograph.Enabled := false;
     164      if IsMonograph then frmOCSession.cmdMonograph.Enabled := true;
    131165      try
    132166        ResizeFormToFont(TForm(frmOCSession));
    … …  
    148182          x := TextForOrder(OCRec.OrderID);
    149183          OCRec.OrderText := x;
     184          frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^O^0^';
     185          frmOCSession.grdchecks.Cells[1,rowcnt] := OCRec.OrderText;
     186          RowCnt := RowCnt + 1;
     187          if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
     188          l := 0;
     189          m := 0;
     190          for j := 0 to CheckList.Count - 1 do
     191            if Piece(CheckList[j], U, 1) = OCRec.OrderID then m := m+1;
     192
    150193          for j := 0 to CheckList.Count - 1 do
    151194            if Piece(CheckList[j], U, 1) = OCRec.OrderID then
    152195            begin
    153               OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
    154               x := x + CRLF + Piece(CheckList[j], U, 4);
     196              l := l+1;
     197              gridText := '';
     198              substring := Copy(Piece(CheckList[j], U, 4),0,2);
     199              if substring='||' then
     200              begin
     201                remOC := TStringList.Create;
     202                substring := Copy(Piece(CheckList[j], U, 4),3,Length(Piece(CheckList[j], U, 4)));
     203                GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2));
     204                for k := 0 to remOC.Count - 1 do
     205                begin
     206                  //add each line to x and OCRec.Checks
     207                  if k=remOC.Count-1 then
     208                  begin
     209                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+'      '+RemOC[k]);
     210                    x := x + CRLF + RemOC[k];
     211                    if gridText = '' then gridText := RemOC[k]
     212                    else gridText := gridText + CRLF + '      ' +RemOC[k];
     213                  end
     214                  else if k=0 then
     215                  begin
     216                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+RemOC[k]);
     217                    x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+')  ' + RemOC[k];
     218                    if gridText = '' then gridText := '('+inttostr(l)+' of '+inttostr(m)+')  ' + RemOC[k]
     219                    else gridText := gridText + CRLF + RemOC[k];
     220                  end
     221                  else
     222                  begin
     223                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+'      '+RemOC[k]);
     224                    x := x + CRLF + RemOC[k];
     225                    if gridText = '' then gridText := RemOC[k]
     226                    else gridText := gridText + CRLF + '      ' + RemOC[k];
     227                  end;
     228                end;
     229                x := x + CRLF + '        ';
     230                    if gridText = '' then gridText := '      '
     231                    else gridText := gridText + CRLF + '      ';
     232                remOC.free;
     233              end
     234              else
     235              begin
     236                OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
     237                x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+')  ' + Piece(CheckList[j], U, 4);
     238                gridText := '('+inttostr(l)+' of '+inttostr(m)+')  ' + Piece(CheckList[j], U, 4);
     239              end;
     240             if (Piece(CheckList[j], U, 3) = '1') then frmOCSession.grdchecks.Cells[1,rowcnt] := '*Order Check requires Reason for Override' + CRLF +  gridText
     241             else frmOCSession.grdchecks.Cells[1,rowcnt] := gridText;
     242              frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^I^'+Piece(CheckList[j], U, 3);
     243              //frmOCSession.grdchecks.Objects[2, rowcnt] := OCRec;
     244              rowcnt := rowcnt +1;
     245              if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
    155246            end;
    156           //AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
    157           //if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
    158           frmOCSession.lstChecks.Items.Add(x);
    159247        end; {with...for i}
    160248        frmOCSession.FOrderList := OrderList;
    … …  
    170258            frmFrame.SetActiveTab(CT_ORDERS);
    171259        end;
     260          if ScreenReaderActive = True then
     261            begin
     262              frmOCSession.lblInstr.TabStop := true;
     263              frmOCSession.memNote.TabStop := true;
     264              frmOCSession.memNote.TabOrder := 2;
     265            end
     266          else
     267          begin
     268            frmOCSession.lblInstr.TabStop := false;
     269            frmOCSession.memNote.TabStop := false;
     270          end;
    172271      finally
    173272        with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
    … …  
    178277    CheckList.Free;
    179278  end;
     279end;
     280
     281
     282procedure TfrmOCSession.SetCheckState(grid: TStringGrid; ACol, ARow: integer;
     283  State: boolean);
     284var
     285  temp: string;
     286begin
     287  temp := grid.Cells[2, ARow];
     288  if State = True then SetPiece(temp, U, 3, '1')
     289  else SetPiece(temp, U, 3, '0');
     290  grid.Cells[2, ARow] := temp;
     291  grid.Repaint;
    180292end;
    181293
    … …  
    195307  txtJustify.Visible := FCritical;
    196308  memNote.Visible := FCritical;
    197 
    198 end;
    199 
    200 procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    201 var
    202   i, AHt, TotalHt: Integer;
    203   x: string;
    204   ARect: TRect;
    205   OCRec: TOCRec;
    206 begin
    207   inherited;
    208 
    209   with lstChecks do
    210      begin
    211        if Index >= uCheckedOrders.Count then Exit;
    212        OCRec := TOCRec(uCheckedOrders.Items[Index]);
    213        ARect := ItemRect(Index);
    214        ARect.Left := ARect.Left + 2;
    215        AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
    216        TotalHt := AHt;
    217 
    218        for i := 0 to OCRec.Checks.Count - 1 do
     309end;
     310
     311function TfrmOCSession.CheckBoxRect(poRect: TRect): TRect;
     312const ciCheckBoxDim = 20;
     313begin
     314  with poRect do begin
     315    Result.Top := Top + FontHeightPixel(Font.Handle);
     316    Result.Left   := Left - (ciCheckBoxDim div 2) + (Right - Left) div 2;
     317    Result.Right  := Result.Left + ciCheckBoxDim;
     318    Result.Bottom := Result.Top + ciCheckBoxDim;
     319  end
     320end;
     321
     322procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
     323var
     324  cnt, i, j, already: Integer;
     325  AnOrderID: string;
     326  DeleteOrderList, DeleteRowList: TstringList;
     327  StillCritical: boolean;
     328begin
     329  inherited;
     330  DeleteOrderList := TStringList.Create;
     331  DeleteRowList := TStringList.Create;
     332  for I := 0 to grdChecks.RowCount do
     333    if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
     334      begin
     335        AnOrderID := Piece(grdChecks.Cells[2, i], U, 1);
     336        already := DeleteOrderList.IndexOf(AnOrderID);
     337        if (already>=0) or (DeleteCheckedOrder(AnOrderID)) then
    219338          begin
    220             ARect := ItemRect(Index);
    221             ARect.Left := ARect.Left + 10;
    222             x := Piece(OCRec.Checks[i], U, 3);
    223             AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
    224             TotalHt := TotalHt + AHt;
     339             for j := FCheckList.Count - 1 downto 0 do
     340             if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
     341             DeleteOrderList.Add(AnOrderId);
     342             for j := FOrderList.Count - 1 downto 0 do
     343             if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
     344             for j := uCheckedOrders.Count - 1 downto 0 do
     345               if TOCRec(uCheckedOrders.Items[j]).OrderID = AnOrderId then
     346
    225347          end;
    226      end;
    227   Height := TotalHt + 2; // add 2 for focus rectangle
    228   if Height > 255 then Height := 255; //CQ7178
    229 end;
    230 
    231 procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    232 var
    233   i, AHt: Integer;
    234   x: string;
    235   ARect: TRect;
    236   OCRec: TOCRec;
    237 begin
    238   inherited;
    239 
    240   with lstChecks do
    241      begin
    242        if Index >= uCheckedOrders.Count then Exit;
    243        OCRec := TOCRec(uCheckedOrders.Items[Index]);
    244        ARect := ItemRect(Index);
    245        AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
    246        ARect.Left := ARect.Left + 10;
    247        ARect.Top  := ARect.Top + AHt;
    248        for i := 0 to OCRec.Checks.Count - 1 do
     348      end;
     349    if DeleteOrderList.Count = 0 then
     350      begin
     351        infoBox('No orders are marked to cancel. Check the Cancel box by the orders to cancel. ', 'Error', MB_OK);
     352      end;
     353
     354    for i := 0 to DeleteOrderList.Count - 1 do
     355      begin
     356        AnOrderId := DeleteORderList.Strings[i];
     357        for j := 0 to grdChecks.RowCount do
     358          if Piece(grdChecks.Cells[2, j], u, 1) = AnOrderId then
     359            begin
     360              //grdChecks.Rows[j].Clear;
     361              DeleteRowList.Add(InttoStr(j));
     362            end;
     363      end;
     364    if (grdChecks.RowCount - 1) = DeleteRowList.Count then Close;
     365    cnt := 0;
     366    for i := 0 to DeleteRowList.Count - 1 do
     367      begin
     368        GridDeleteRow(((StrtoInt(DeleteRowList.Strings[i])) - cnt), grdChecks);
     369        cnt := cnt +1;
     370      end;
     371    //check if the remaining order checks are not high level and thus don't require justification
     372    if FCritical then
     373    begin
     374      StillCritical := false;
     375      for I := 0 to grdChecks.RowCount do
     376      begin
     377        if ((Piece(grdChecks.cells[2,I],U,3) = '1') and not(Piece(grdChecks.Cells[2, i], U, 2) = 'O')) then
    249378          begin
    250             x := Piece(OCRec.Checks[i], U, 3);
    251             if not (odSelected in State) then
    252                begin
    253                  if (Piece(OCRec.Checks[i], U, 2) = '1') then
    254                    begin
    255                      Canvas.Font.Color := Get508CompliantColor(clBlue);
    256                      Canvas.Font.Style := [fsUnderline];
    257                    end
    258                  else Canvas.Font.Color := clWindowText;
    259                end;
    260             AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
    261             ARect.Top  := ARect.Top + AHt;
    262         end;
    263      end;
    264 
    265 end;
    266 
    267 procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
    268 var
    269   i, j: Integer;
    270   AnOrderID: string;
    271   OCRec: TOCRec;
    272 begin
    273   inherited;
    274   for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then
    275   begin
    276     OCRec := TOCRec(uCheckedOrders.Items[i]);
    277     AnOrderID := OCRec.OrderID;
    278     if DeleteCheckedOrder(AnOrderID) then
    279     begin
    280       for j := FCheckList.Count - 1 downto 0 do
    281         if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
    282       for j := FOrderList.Count - 1 downto 0 do
    283         if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
    284       OCRec.Free;
    285       uCheckedOrders.Delete(i);
    286       lstChecks.Items.Delete(i);
     379            StillCritical := true;
     380            break;
     381          end;
     382      end;
     383      if StillCritical = false then
     384      begin
     385        FCritical := false;
     386        lblJustify.Visible := FCritical;
     387        txtJustify.Visible := FCritical;
     388        memNote.Visible := FCritical;
     389      end;
    287390    end;
    288   end;
    289   if uCheckedOrders.Count = 0 then Close;
     391    grdChecks.Repaint;
    290392end;
    291393
    292394procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
    293 begin
    294   inherited;
     395var
     396i: integer;
     397Cancel: boolean;
     398begin
     399  inherited;
     400  Cancel := False;
    295401  if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
    296402  begin
    … …  
    299405    Exit;
    300406  end;
     407   
     408  if FCritical and (ContainsUpCarretChar(txtJustify.Text)) then
     409  begin
     410     InfoBox('The justification may not contain the ^ character.',
     411            'Justification Required', MB_OK);
     412    Exit;
     413  end;
     414
     415  for i := 0 to grdChecks.RowCount do
     416     if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
     417       begin
     418         Cancel := True;
     419         Break;
     420       end;
     421  if Cancel = True then
     422    begin
     423      InfoBox('One or more orders have been marked to cancel!' + CRLF + CRLF +
     424        'To cancel these orders, click the "Cancel Checked Order(s)" button.' + CRLF + CRLF +
     425        'To place these orders, uncheck the Cancel box beside the order you wish to keep and then click the "Accept Order(s)" button again.',
     426        'Error', MB_OK);
     427      Exit;
     428    end;
     429
    301430  StatusText('Saving Order Checks...');
    302431  SaveOrderChecksForSession(txtJustify.Text, FCheckList);
    … …  
    305434end;
    306435
     436procedure TfrmOCSession.cmdMonographClick(Sender: TObject);
     437var
     438  monoList: TStringList;
     439begin
     440  inherited;
     441  monoList := TStringList.Create;
     442  GetMonographList(monoList);
     443  ShowMonographs(monoList);
     444  monoList.Free;
     445end;
     446
     447
    307448procedure TfrmOCSession.FormClose(Sender: TObject;
    308449  var Action: TCloseAction);
    … …  
    310451  inherited;
    311452  SaveUserBounds(Self); //Save Position & Size of Form
     453  DeleteMonograph;
     454end;
     455
     456procedure TfrmOCSession.FormCreate(Sender: TObject);
     457begin
     458  inherited;
     459   grdChecks.Cells[0, 0] := 'Cancel';
     460   grdChecks.Cells[1, 0] := 'Order/Order Check Text';
     461   //cmdMonograph.Font.Size := MainFontSize;
     462   //cmdMonograph.Width :=  TextWidthByFont(cmdMonograph.Font.Handle, cmdMonograph.Caption);
    312463end;
    313464
    314465procedure TfrmOCSession.FormShow(Sender: TObject);
     466
    315467begin
    316468  inherited;
    317469  SetFormPosition(Self); //Get Saved Position & Size of Form
    318470  FCancelSignProcess := False;
    319 end;
    320 
     471  if ScreenReaderActive = True then lblInstr.SetFocus
     472  else
     473    begin
     474      lblInstr.TabStop := false;
     475      grdChecks.SetFocus;
     476    end;
     477  self.lblInstr.Font.Size := mainFontSize + 1;
     478  //self.lblJustify.Height := self.lblJustify.Height + 20;
     479 (*if self.lblJustify.Visible = true then
     480     begin
     481       self.lblJustify.top := self.txtJustify.Top +  self.lblJustify.Height + 50;
     482     end; *)
     483
     484  //if mainFontSize < 12 then inc := 90
     485  //else if mainFontSize < 18 then inc := 130
     486  //else inc := 155;
     487  //self.constraints.MinWidth := self.lblInstr.Left +  TextWidthByFont(self.lblInstr.Font.Handle, self.lblInstr.Caption) + inc;
     488end;
     489
     490procedure TfrmOCSession.grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
     491  Rect: TRect; State: TGridDrawState);
     492var
     493 Wrap: boolean;
     494 format, str, cdl, temp, colorText: string;
     495 IsBelowOrder, isSelected: boolean;
     496 chkRect, DrawRect, colorRect: TRect;
     497 ChkState: Cardinal;
     498begin
     499  inherited;
     500  temp := grdChecks.Cells[2, ARow];
     501  format := Piece(grdChecks.Cells[2, ARow], U, 2);
     502  cdl := Piece(grdChecks.Cells[2, ARow], U, 3);
     503  colorText := '*Order Check requires Reason for Override';
     504  grdChecks.Canvas.Brush.Color := Get508CompliantColor(clWhite);
     505  grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
     506  grdChecks.Canvas.Font.Style := [];
     507  isSelected := false;
     508
     509  if ARow = 0 then
     510    begin
     511      grdChecks.Canvas.Brush.Color := Get508CompliantColor(clbtnFace);
     512      grdChecks.Canvas.Font.Style := [fsBold];
     513    end;
     514
     515  //change commented out code to handle different font color this code may not be needed anymore
     516  if (format = '') and (ARow > 0) then
     517    grdchecks.Canvas.Font.Color := Get508CompliantColor(clBlue)
     518  else
     519    grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
     520  if cdl = '1' then grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
     521
     522  //controls highlighting cell when focused in on the cell
     523  if State = [gdSelected..gdFocused] then
     524    begin
     525      isSelected := true;  //use to control colors for high order checks
     526      grdChecks.Canvas.Font.Color := Get508CompliantColor(clWhite);
     527      grdChecks.Canvas.Brush.Color := clHighlight;
     528      grdChecks.Canvas.Font.Color := clHighlightText;
     529      grdChecks.Canvas.Font.Style := [fsBold];
     530      grdChecks.Canvas.MoveTo(Rect.Left,Rect.top);
     531    end
     532  //if not an order than blanked out lines seperating the order check
     533  else if (format = 'I') then
     534    begin
     535      if (Arow < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, Arow + 1], U, 2) = 'O') then IsBelowOrder := True
     536      else IsBelowOrder := False;
     537      grdChecks.Canvas.MoveTo(Rect.Left,Rect.Bottom);
     538      grdChecks.Canvas.Pen.Color := Get508CompliantColor(clwhite);
     539      grdChecks.Canvas.LineTo(Rect.Left, Rect.Top);
     540      grdChecks.Canvas.LineTo(Rect.Right, Rect.Top);
     541      grdChecks.Canvas.LineTo(Rect.Right, Rect.Bottom);
     542     if (isBelowOrder = False) or (ARow = (grdChecks.RowCount -1)) then grdChecks.Canvas.LineTo(Rect.left, Rect.Bottom);
     543    end;
     544  Str:= grdChecks.Cells[ACol, ARow];
     545  //determine if the cell needs to wrap
     546  if ACol = 1 then Wrap := true
     547  else wrap := false;
     548  //Blank out existing Cell to prevent overlap after resize
     549  grdChecks.Canvas.FillRect(Rect);
     550  //get existing cell
     551  DrawRect:= Rect;
     552  if (ACol = 0) and (format = 'O') and (ARow > 0) then
     553     begin
     554        if Piece(grdChecks.Cells[2, ARow], U, 4) = '' then
     555          begin
     556            DrawRect.Bottom := DrawRect.Bottom + FontHeightPixel(Font.Handle) + 5;
     557            setPiece(temp, U, 4, 'R');
     558            grdChecks.Cells[2, ARow] := temp;
     559          end;
     560        if GetCheckState(grdChecks, ACol, ARow) = True then chkState := DFCS_CHECKED
     561        else chkState := DFCS_BUTTONCHECK;
     562        chkRect := CheckBoxRect(DrawRect);
     563        DrawFrameControl(grdChecks.Canvas.Handle, chkRect, DFC_BUTTON, chkState);
     564        DrawText(grdChecks.Canvas.Handle, PChar('Cancel?'), length('Cancel?'), DrawRect, DT_SINGLELINE or DT_Top or DT_Center);
     565        if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) or
     566            ((DrawRect.Bottom - DrawRect.Top) < grdChecks.RowHeights[ARow]) then
     567            begin
     568              grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     569            end;
     570     end;
     571  //If order check than indent the order check text
     572  if (ACol = 1) and (format = 'I') then DrawRect.Left := DrawRect.Left + 10;
     573  //colorRect use to create Rect for Order Check Label
     574  colorRect := DrawRect;
     575  if Wrap then
     576     begin
     577      if (cdl = '1') and (format = 'I') then
     578       begin
     579          if isSelected = false then
     580            begin
     581              grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
     582              grdChecks.Canvas.Font.Style := [fsBold];
     583            end;
     584          //determine rect size for order check label
     585          DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_calcrect or dt_wordbreak);
     586          DrawRect.Top := ColorRect.Bottom;
     587          //determine rect size for order check text
     588          DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
     589          str := copy(str, length(colorText + CRLF) + 1, length(str));
     590          if isSelected = false then
     591            begin
     592              grdChecks.Canvas.Font.Color := Get508CompliantColor(clblue);
     593              grdChecks.Canvas.Font.Style := [];
     594            end;
     595       end
     596       //determine size for non-high order check text
     597       else DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
     598       DrawRect.Bottom := DrawRect.Bottom + 2;
     599       //Resize the Cell height if the height does not match the Rect Height
     600       if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) then
     601          begin
     602            grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     603          end
     604       else
     605          begin
     606            //if cell doesn't need to grow reset the cell
     607            DrawRect.Right:= Rect.Right;
     608            if (cdl = '1') and (format = 'I') then
     609              begin
     610                //DrawRect.Top := ColorRect.Bottom;
     611                if isSelected = false then
     612                  begin
     613                    grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
     614                    grdChecks.Canvas.Font.Style := [fsBold];
     615                  end;
     616                DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_wordbreak);
     617                if isSelected = false then
     618                  begin
     619                    grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
     620                    grdChecks.Canvas.Font.Style := [];
     621                  end;
     622              end;
     623            DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
     624            //reset height
     625            if format = 'I' then grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     626          end;
     627      end
     628  else
     629    //if not wrap than grow just draw the cell
     630    DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
     631end;
     632
     633procedure TfrmOCSession.grdchecksEnter(Sender: TObject);
     634begin
     635  inherited;
     636  if ScreenReaderActive then
     637    begin
     638      grdChecks.Row := 1;
     639      grdChecks.Col := 0;
     640      GetScreenReader.Speak('Navigate through the grid to reviews the orders and the order checks');
     641      if GetCheckState(grdchecks, 0, 1) = true then
     642        GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
     643      else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,1] + ' Order');
     644    end;
     645  grdChecks.Row := 1;
     646  grdChecks.Col := 0;
     647end;
     648
     649procedure TfrmOCSession.grdchecksKeyDown(Sender: TObject; var Key: Word;
     650  Shift: TShiftState);
     651begin
     652  inherited;
     653     if key = VK_TAB then
     654      begin
     655       if ssCtrl        in Shift then
     656         begin
     657            if txtJustify.Visible = TRUE then  ActiveControl := txtJustify
     658            else ActiveControl := cmdContinue;
     659            Key := 0;
     660            Exit;
     661         end;
     662      end;
     663      if grdchecks.Col = 0 then
     664       begin
     665         Case Key of
     666            VK_Tab:
     667              begin
     668                if (ssShift in Shift) and (grdChecks.Row > 1) then
     669                     begin
     670                       grdChecks.Col := 1;
     671                       grdChecks.Row := grdChecks.Row - 1;
     672                     end;
     673                end;
     674           VK_Space:
     675             begin
     676               if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then
     677                 begin
     678                   if GetCheckState(grdChecks, 2, grdChecks.Row) = True then
     679                       SetCheckState(grdChecks, 2, grdChecks.Row, False)
     680                      else SetCheckState(grdChecks, 2, grdChecks.Row, True);
     681                   if ScreenReaderActive then
     682                     begin
     683                       if GetCheckState(grdchecks, 0, grdChecks.Row) = true then
     684                          GetScreenReader.Speak('Cancel checkbox checked')
     685                        else GetScreenReader.Speak('Cancel checkbox unChecked');
     686                     end;
     687                 end;
     688             end;
     689       (*    VK_Down:
     690              begin
     691                 if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
     692                   begin
     693                      for I := grdChecks.Row + 1 to grdChecks.RowCount do
     694                        begin
     695                          if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     696                          else
     697                            begin
     698                              grdChecks.Row := i;
     699                              exit;
     700                            end;
     701
     702                        end;
     703                   end;
     704              end;
     705           VK_Up:
     706             Begin
     707               if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
     708                 begin
     709                   for i := grdChecks.Row - 1 downto 0 do
     710                     begin
     711                       if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     712                       else
     713                         begin
     714                           grdChecks.Row := i;
     715                           exit;
     716                         end;
     717                     end;
     718                 end;
     719             End; *)
     720         End;
     721       end;
     722    if grdChecks.Col = 1 then
     723       begin
     724       // needed to add control for tab key to handle the blank cells that should not have focus.
     725         if key = VK_Tab then
     726           begin
     727             if ssShift in Shift then
     728                begin
     729                  if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
     730                  else if grdChecks.Row > 1 then
     731                     begin
     732                       grdChecks.Col := 1;
     733                       grdChecks.Row := grdChecks.Row - 1;
     734                     end;
     735                 end
     736             else
     737               begin
     738                 if grdChecks.Row = (grdChecks.RowCount - 1) then
     739                   begin
     740                     if ScreenReaderActive = True then ActiveControl := memNote
     741                     else if txtJustify.Visible = TRUE then  ActiveControl := txtJustify
     742                     else ActiveControl := cmdContinue;
     743                     Key := 0;
     744                   end
     745                 else
     746                   begin
     747                     grdChecks.Row := grdChecks.Row + 1;
     748                     if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
     749                     else grdChecks.Col := 2;
     750                   end;
     751               end;
     752             Key := 0;
     753           end;
     754       end;
     755end;
     756
     757procedure TfrmOCSession.grdchecksMouseDown(Sender: TObject;
     758  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     759var
     760 Row, Col: integer;
     761begin
     762  inherited;
     763     grdChecks.MouseToCell(X, Y, Col, Row);
     764     if Col <> 0 then exit;
     765     if Piece(grdChecks.Cells[2,row], U, 2) <> 'O' then exit;
     766     if InCheckBox(grdChecks, X, Y, Col, Row) = false then exit;
     767     if GetCheckState(grdChecks, Col, Row) = True then SetCheckState(grdChecks, Col, Row, False)
     768     else SetCheckState(grdChecks, Col, Row, True);
     769end;
     770
     771
     772
     773procedure TfrmOCSession.grdchecksMouseMove(Sender: TObject; Shift: TShiftState;
     774  X, Y: Integer);
     775var
     776acol , arow: integer;
     777//P : Tpoint;
     778//Rect: TRect;
     779begin
     780//Rect :=  grdChecks.CellRect(ACol, ARow);
     781//P.X := Rect.Left;
     782//P.Y := Rect.Top;
     783
     784grdChecks.MouseToCell(X,y,acol , arow);
     785//check to see if hint should show
     786if ARow > grdChecks.RowCount then Exit;
     787if ACol <> 1 then exit;
     788if grdChecks.RowHeights[Arow] < grdChecks.Height then Exit;
     789
     790
     791
     792grdChecks.Hint := grdChecks.Cells[ACol, ARow];
     793Application.HintHidePause := 20000; //20 Sec
     794if grdChecks.Hint <> '' then grdCHecks.ShowHint := true;
     795
     796//Application.HintColor := clYellow;
     797//Application.ActivateHint(P);
     798
     799end;
     800
     801procedure TfrmOCSession.grdchecksMouseWheelDown(Sender: TObject;
     802  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     803begin
     804  inherited;
     805(*  if grdChecks.Col = 0 then
     806    begin
     807      if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
     808        begin
     809          for I := grdChecks.Row + 1 to grdChecks.RowCount do
     810            begin
     811              if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     812              else
     813                begin
     814                  grdChecks.Row := i;
     815                  exit;
     816                end;
     817            end;
     818        end;
     819    end; *)
     820end;
     821
     822procedure TfrmOCSession.grdchecksMouseWheelUp(Sender: TObject;
     823  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     824begin
     825  inherited;
     826 (* if grdChecks.Col = 0 then
     827    begin
     828      if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
     829        begin
     830          for i := grdChecks.Row - 1 downto 0 do
     831            begin
     832              if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     833              else
     834                begin
     835                  grdChecks.Row := i;
     836                  exit;
     837                end;
     838            end;
     839        end;
     840    end;   *)
     841end;
     842
     843procedure TfrmOCSession.grdchecksSelectCell(Sender: TObject; ACol,
     844  ARow: Integer; var CanSelect: Boolean);
     845begin
     846  inherited;
     847      CanSelect := True;
     848      if ARow = 0 then CanSelect := false
     849      else if (ACol = 2) then CanSelect := False
     850      else if (ACol = 1) and (grdChecks.Cells[Acol, Arow] = '') then CanSelect := False;
     851      //else if (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) <> 'O') then CanSelect := false;
     852      if (CanSelect = True) and (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) = 'O') and (ScreenReaderActive) then
     853        begin
     854           if GetCheckState(grdchecks, ACol, ARow) = true then
     855             GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
     856           else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,Arow] + ' Order');
     857        end;
     858end;
     859
     860procedure TfrmOCSession.GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
     861var
     862  i: Integer;
     863begin
     864  Grid.Row := RowNumber;
     865  if (Grid.Row = Grid.RowCount - 1) then
     866    { On the last row}
     867    Grid.RowCount := Grid.RowCount - 1
     868  else
     869  begin
     870    { Not the last row}
     871    for i := RowNumber to Grid.RowCount - 1 do
     872      Grid.Rows[i] := Grid.Rows[i + 1];
     873    Grid.RowCount := Grid.RowCount - 1;
     874  end;
     875end;
     876
     877function TfrmOCSession.InCheckBox(Grid: TStringGrid; X, Y, ACol,
     878  ARow: integer): boolean;
     879var
     880  Rect: TRect;
     881begin
     882  Result := False;
     883  Rect := CheckBoxRect(grid.CellRect(ACol, ARow));
     884  if Y < Rect.Top then Exit;
     885  if Y > Rect.Bottom then Exit;
     886  if X < Rect.Left then exit;
     887  if X > Rect.Right then exit;
     888  Result := True;
     889end;
     890
     891function TfrmOCSession.GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
     892begin
     893   if Piece(grid.Cells[2, ARow], U, 3) = '1' then Result := True
     894   else Result := false;
     895end;
    321896
    322897procedure TfrmOCSession.FormResize(Sender: TObject);
    … …  
    324899  //TfrmAutoSz has defect must call inherited Resize for the resize to function.
    325900  inherited;
     901    grdChecks.ColWidths[0] := round(grdChecks.Width * 0.08);
     902    grdChecks.ColWidths[1] := round(grdChecks.Width * 0.88);   //Order Text
     903    grdChecks.ColWidths[2] := 0;     //OrderID^Format^IsCheck
     904    grdChecks.tabStops[2] := false;
     905    if grdChecks.RowCount > 1 then grdChecks.Refresh;
     906    self.pnlBottom.Top := self.pnlTop.Top + self.pnlTop.Height;
    326907end;
    327908
    … …  
    352933end;
    353934
     935
     936procedure TfrmOCSession.FormKeyDown(Sender: TObject; var Key: Word;
     937   Shift: TShiftState);
     938 begin
     939   inherited;
     940   if (Key = VK_F4) and (ssAlt in Shift) then Key := 0;
     941end;
     942procedure TfrmOCSession.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
     943  MousePos: TPoint; var Handled: Boolean);
     944begin
     945  inherited;
     946  if self.grdchecks.Focused = false then
     947    begin
     948    end;
     949end;
     950
    354951end.

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

    r829 r1679  
    6161      CheckBoilerplate4Fields(tmp, cptn);
    6262
     63
     64      if WasTemplateDialogCanceled then AnErrMsg := 'The Auto-Accept Quick Order cannot be saved since the template was cancelled.';
     65
    6366    if tmp <> '' then
    6467      Responses.Update('COMMENT', 1, TX_WPTYPE, tmp)
    … …  
    8790  IdentifyDialog(DialogNames, DialogIEN);
    8891  Responses.Dialog := DialogNames.BaseName;                      // loads formatting info
     92  Responses.DialogDisplayName := DialogNames.Display;
    8993  StatusText('');
    9094end;

  • cprs/trunk/CPRS-Chart/Orders/fODBBank.dfm

    r829 r1679  
    22  Left = 409
    33  Top = 244
    4   HorzScrollBar.Range = 0
    5   VertScrollBar.Range = 0
     4  Width = 700
     5  Height = 626
     6  AutoScroll = True
    67  Caption = 'Blood Component and Diagnostic Test Order Form'
    7   ClientHeight = 600
    8   ClientWidth = 709
    9   ExplicitWidth = 717
    10   ExplicitHeight = 634
     8  OnShow = FormShow
     9  ExplicitWidth = 700
     10  ExplicitHeight = 626
    1111  PixelsPerInch = 96
    1212  TextHeight = 13
    13   object pnlComments: TPanel [0]
     13  object Splitter1: TSplitter [0]
     14    Left = 0
     15    Top = 0
     16    Width = 692
     17    Height = 2
     18    Cursor = crVSplit
     19    Align = alTop
     20  end
     21  object pnlComments: TPanel [1]
    1422    Left = 12
    1523    Top = 25
    … …  
    5159  end
    5260  inherited memOrder: TCaptionMemo
    53     Left = 0
    54     Top = 399
     61    Left = 4
     62    Top = 503
    5563    Width = 449
    5664    Height = 59
    5765    Visible = False
    58     ExplicitLeft = 0
    59     ExplicitTop = 399
     66    ExplicitLeft = 4
     67    ExplicitTop = 503
    6068    ExplicitWidth = 449
    6169    ExplicitHeight = 59
    6270  end
    63   object pgeProduct: TPageControl [2]
     71  object pgeProduct: TPageControl [3]
    6472    Left = 0
    65     Top = 0
    66     Width = 709
    67     Height = 393
     73    Top = 2
     74    Width = 692
     75    Height = 497
    6876    ActivePage = TabDiag
    6977    Align = alTop
    70     TabOrder = 6
    71     TabStop = False
     78    TabOrder = 4
    7279    OnChange = pgeProductChange
    7380    object TabInfo: TTabSheet
    7481      Caption = 'Patient Information'
    7582      ImageIndex = 3
     83      ExplicitLeft = 0
     84      ExplicitTop = 0
     85      ExplicitWidth = 0
     86      ExplicitHeight = 0
    7687      object edtInfo: TCaptionRichEdit
    7788        Left = 0
    78         Top = 8
    79         Width = 556
    80         Height = 337
    81         TabStop = False
     89        Top = 0
     90        Width = 684
     91        Height = 469
     92        Align = alClient
    8293        BevelInner = bvNone
    8394        BevelOuter = bvNone
    … …  
    91102        ScrollBars = ssBoth
    92103        TabOrder = 0
     104        WordWrap = False
    93105        Caption = 'Patient Info'
    94106      end
    … …  
    98110      ImageIndex = 2
    99111      object lblReqComment: TOROffsetLabel
    100         Left = 298
     112        Left = 300
    101113        Top = 25
    102114        Width = 108
    … …  
    109121      object pnlFields: TPanel
    110122        Left = 0
    111         Top = 163
    112         Width = 701
    113         Height = 99
     123        Top = 145
     124        Width = 684
     125        Height = 210
    114126        Hint = 'Data entered into these fields apply to the entire order.'
    115127        Align = alTop
    … …  
    120132        TabOrder = 2
    121133        object lblDiagComment: TOROffsetLabel
    122           Left = 257
    123           Top = 35
    124           Width = 46
     134          Left = 0
     135          Top = 128
     136          Width = 62
    125137          Height = 15
    126138          Caption = 'Comment'
    … …  
    137149        end
    138150        object lblUrgency: TLabel
    139           Left = 8
    140           Top = -2
     151          Left = 0
     152          Top = -1
    141153          Width = 44
    142154          Height = 13
    … …  
    150162        end
    151163        object lblReason: TLabel
    152           Left = 10
    153           Top = 35
    154           Width = 99
     164          Left = 0
     165          Top = 40
     166          Width = 95
    155167          Height = 13
    156           Caption = 'Reason for Request*'
     168          Caption = 'Reason for Request'
    157169          Font.Charset = DEFAULT_CHARSET
    158170          Font.Color = clWindowText
    … …  
    163175        end
    164176        object lblSurgery: TLabel
    165           Left = 115
    166           Top = -2
     177          Left = 117
     178          Top = 0
    167179          Width = 36
    168180          Height = 13
    … …  
    171183            'r.'
    172184          Caption = 'Surgery'
     185          Enabled = False
    173186          Font.Charset = DEFAULT_CHARSET
    174187          Font.Color = clWindowText
    … …  
    179192        end
    180193        object lblRequiredField: TLabel
    181           Left = 10
    182           Top = 75
     194          Left = 398
     195          Top = 38
    183196          Width = 122
    184197          Height = 13
    185198          Caption = '* Indicates a required field'
    186199        end
     200        object lblTNS: TLabel
     201          Left = 270
     202          Top = 0
     203          Width = 14
     204          Height = 13
     205          Caption = 'tns'
     206          Color = clActiveBorder
     207          Font.Charset = DEFAULT_CHARSET
     208          Font.Color = clMaroon
     209          Font.Height = -11
     210          Font.Name = 'MS Sans Serif'
     211          Font.Style = []
     212          ParentColor = False
     213          ParentFont = False
     214          Visible = False
     215        end
     216        object lblNoBloodReq: TLabel
     217          Left = 341
     218          Top = 21
     219          Width = 176
     220          Height = 13
     221          Caption = 'No Blood Required for this Procedure'
     222          Font.Charset = DEFAULT_CHARSET
     223          Font.Color = clMaroon
     224          Font.Height = -11
     225          Font.Name = 'MS Sans Serif'
     226          Font.Style = []
     227          ParentFont = False
     228          Visible = False
     229        end
    187230        object cboUrgency: TORComboBox
    188           Left = 12
    189           Top = 12
     231          Left = 4
     232          Top = 14
    190233          Width = 98
    191234          Height = 21
    … …  
    217260        end
    218261        object chkConsent: TCheckBox
    219           Left = 351
    220           Top = 10
     262          Left = 529
     263          Top = 92
    221264          Width = 112
    222265          Height = 17
    … …  
    237280        end
    238281        object cboSurgery: TORComboBox
    239           Left = 115
    240           Top = 12
     282          Left = 117
     283          Top = 14
    241284          Width = 218
    242285          Height = 21
    … …  
    269312        end
    270313        object cboReasons: TORComboBox
    271           Left = 12
    272           Top = 51
    273           Width = 239
    274           Height = 21
    275           Style = orcsDropDown
     314          Left = 4
     315          Top = 55
     316          Width = 525
     317          Height = 74
     318          Style = orcsSimple
    276319          AutoSelect = True
    277320          Color = clWindow
    … …  
    293336        end
    294337        object memDiagComment: TRichEdit
    295           Left = 257
    296           Top = 51
    297           Width = 250
    298           Height = 48
     338          Left = 4
     339          Top = 144
     340          Width = 525
     341          Height = 60
    299342          TabOrder = 4
    300343          OnChange = memDiagCommentChange
    … …  
    304347        Left = 0
    305348        Top = 35
    306         Width = 701
    307         Height = 128
     349        Width = 684
     350        Height = 110
    308351        Align = alTop
    309352        BevelEdges = []
    310353        BevelOuter = bvNone
    311354        TabOrder = 1
    312         object lblTNS: TLabel
    313           Left = 298
    314           Top = 109
    315           Width = 14
    316           Height = 13
    317           Caption = 'tns'
    318           Color = clActiveBorder
    319           Font.Charset = DEFAULT_CHARSET
    320           Font.Color = clMaroon
    321           Font.Height = -11
    322           Font.Name = 'MS Sans Serif'
    323           Font.Style = []
    324           ParentColor = False
    325           ParentFont = False
    326           Visible = False
    327         end
    328355        object pnlDiagnosticTests: TGroupBox
    329           Left = 256
     356          Left = 266
    330357          Top = 0
    331           Width = 267
     358          Width = 256
    332359          Height = 110
    333360          Caption = 'Diagnostic Tests'
    … …  
    339366          ParentFont = False
    340367          TabOrder = 1
     368          OnClick = pnlDiagnosticTestsClick
     369          OnEnter = pnlDiagnosticTestsEnter
     370          OnExit = pnlDiagnosticTestsExit
    341371          object lblCollType: TLabel
    342372            Left = 13
    … …  
    355385            Left = 12
    356386            Top = 70
    357             Width = 104
     387            Width = 100
    358388            Height = 13
    359             Caption = 'Collection Date/Time*'
    360             Font.Charset = DEFAULT_CHARSET
    361             Font.Color = clWindowText
    362             Font.Height = -11
    363             Font.Name = 'MS Sans Serif'
    364             Font.Style = []
    365             ParentFont = False
    366           end
    367           object cmdImmedColl: TSpeedButton
    368             Left = 148
    369             Top = 89
     389            Caption = 'Collection Date/Time'
     390            Font.Charset = DEFAULT_CHARSET
     391            Font.Color = clWindowText
     392            Font.Height = -11
     393            Font.Name = 'MS Sans Serif'
     394            Font.Style = []
     395            ParentFont = False
     396          end
     397          object pnlCollTimeButton: TKeyClickPanel
     398            Left = 178
     399            Top = 82
    370400            Width = 21
    371             Height = 11
    372             Font.Charset = DEFAULT_CHARSET
    373             Font.Color = clWindowText
    374             Font.Height = -16
    375             Font.Name = 'MS Sans Serif'
    376             Font.Style = [fsBold]
    377             Glyph.Data = {
    378               D6000000424DD60000000000000076000000280000000C0000000C0000000100
    379               0400000000006000000000000000000000001000000010000000000000000000
    380               80000080000000808000800000008000800080800000C0C0C000808080000000
    381               FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    382               0000333333333333000033333333333300003333333333330000300330033003
    383               0000300330033003000033333333333300003333333333330000333333333333
    384               0000333333333333000033333333333300003333333333330000}
    385             ParentFont = False
    386             ParentShowHint = False
    387             ShowHint = False
    388             OnClick = cmdImmedCollClick
    389           end
    390           object pnlCollTimeButton: TKeyClickPanel
    391             Left = 85
    392             Top = 89
    393             Width = 20
    394             Height = 13
     401            Height = 21
    395402            BevelOuter = bvNone
    396403            Caption = 'Select collection time'
    397404            TabOrder = 5
    398405            TabStop = True
     406            object cmdImmedColl: TSpeedButton
     407              Left = 0
     408              Top = 0
     409              Width = 21
     410              Height = 21
     411              Align = alClient
     412              Font.Charset = DEFAULT_CHARSET
     413              Font.Color = clWindowText
     414              Font.Height = -16
     415              Font.Name = 'MS Sans Serif'
     416              Font.Style = [fsBold]
     417              Glyph.Data = {
     418                D6000000424DD60000000000000076000000280000000C0000000C0000000100
     419                0400000000006000000000000000000000001000000010000000000000000000
     420                80000080000000808000800000008000800080800000C0C0C000808080000000
     421                FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
     422                0000333333333333000033333333333300003333333333330000300330033003
     423                0000300330033003000033333333333300003333333333330000333333333333
     424                0000333333333333000033333333333300003333333333330000}
     425              ParentFont = False
     426              ParentShowHint = False
     427              ShowHint = False
     428              OnClick = cmdImmedCollClick
     429            end
     430          end
     431          object calCollTime: TORDateBox
     432            Left = 12
     433            Top = 82
     434            Width = 165
     435            Height = 21
     436            Font.Charset = DEFAULT_CHARSET
     437            Font.Color = clWindowText
     438            Font.Height = -11
     439            Font.Name = 'MS Sans Serif'
     440            Font.Style = []
     441            ParentFont = False
     442            TabOrder = 4
     443            OnChange = calCollTimeChange
     444            OnEnter = calCollTimeEnter
     445            DateOnly = False
     446            RequireTime = False
    399447          end
    400448          object cboAvailTest: TORComboBox
    … …  
    417465            ItemTipEnable = True
    418466            ListItemsOnly = False
    419             LongList = True
     467            LongList = False
    420468            LookupPiece = 0
    421469            MaxLength = 0
    … …  
    426474            TabOrder = 0
    427475            TabStop = True
     476            OnClick = cboAvailTestSelect
     477            OnEnter = cboAvailTestEnter
    428478            OnExit = cboAvailTestExit
    429             OnMouseClick = cboAvailTestSelect
    430479            OnNeedData = cboAvailTestNeedData
    431480            CharsNeedMatch = 1
    … …  
    434483            Left = 12
    435484            Top = 46
    436             Width = 165
     485            Width = 197
    437486            Height = 21
    438487            Style = orcsDropDown
    … …  
    459508            TabOrder = 1
    460509            OnChange = cboCollTypeChange
     510            OnClick = cboCollTypeClick
     511            OnEnter = cboCollTypeEnter
    461512            CharsNeedMatch = 1
    462513          end
    … …  
    489540            TabOrder = 2
    490541            OnChange = cboCollTimeChange
     542            OnEnter = cboCollTimeEnter
    491543            CharsNeedMatch = 1
    492           end
    493           object calCollTime: TORDateBox
    494             Left = 12
    495             Top = 82
    496             Width = 165
    497             Height = 21
    498             Font.Charset = DEFAULT_CHARSET
    499             Font.Color = clWindowText
    500             Font.Height = -11
    501             Font.Name = 'MS Sans Serif'
    502             Font.Style = []
    503             ParentFont = False
    504             TabOrder = 3
    505             OnChange = calCollTimeChange
    506             DateOnly = False
    507             RequireTime = False
    508544          end
    509545          object txtImmedColl: TCaptionEdit
    … …  
    514550            Color = clBtnFace
    515551            ReadOnly = True
    516             TabOrder = 4
    517             Text = 'txtImmedColl'
     552            TabOrder = 3
     553            OnEnter = txtImmedCollEnter
    518554          end
    519555        end
    … …  
    521557          Left = 4
    522558          Top = 0
    523           Width = 246
     559          Width = 256
    524560          Height = 110
    525561          Caption = 'Blood Components'
     562          Color = clBtnFace
    526563          Font.Charset = DEFAULT_CHARSET
    527564          Font.Color = clWindowText
    … …  
    529566          Font.Name = 'MS Sans Serif'
    530567          Font.Style = [fsBold]
     568          ParentColor = False
    531569          ParentFont = False
    532570          TabOrder = 0
     571          OnClick = pnlBloodComponentsClick
     572          OnEnter = pnlBloodComponentsEnter
     573          OnExit = pnlBloodComponentsExit
    533574          object lblQuantity: TLabel
    534575            Left = 198
    535576            Top = 0
    536             Width = 43
     577            Width = 39
    537578            Height = 13
    538             Caption = 'Quantity*'
     579            Caption = 'Quantity'
    539580            Font.Charset = DEFAULT_CHARSET
    540581            Font.Color = clWindowText
    … …  
    560601            Left = 7
    561602            Top = 70
    562             Width = 96
     603            Width = 92
    563604            Height = 13
    564             Caption = 'Date/Time Wanted*'
     605            Caption = 'Date/Time Wanted'
    565606            Font.Charset = DEFAULT_CHARSET
    566607            Font.Color = clWindowText
    … …  
    598639            TabOrder = 0
    599640            TabStop = True
    600             OnChange = cboAvailCompChange
     641            OnEnter = cboAvailCompEnter
    601642            OnExit = cboAvailCompExit
    602643            OnMouseClick = cboAvailCompSelect
    … …  
    623664            Left = 11
    624665            Top = 46
    625             Width = 133
     666            Width = 181
    626667            Height = 21
    627668            Style = orcsDropDown
    … …  
    647688            TabOrder = 2
    648689            OnChange = cboModifiersChange
     690            OnEnter = cboModifiersEnter
    649691            CharsNeedMatch = 1
    650692          end
    … …  
    652694            Left = 11
    653695            Top = 82
    654             Width = 149
     696            Width = 181
    655697            Height = 21
    656698            Font.Charset = DEFAULT_CHARSET
    … …  
    662704            TabOrder = 3
    663705            OnChange = calWantTimeChange
     706            OnEnter = calWantTimeEnter
    664707            DateOnly = False
    665708            RequireTime = False
    … …  
    670713        Left = 0
    671714        Top = 0
    672         Width = 701
     715        Width = 684
    673716        Height = 35
    674717        Align = alTop
    … …  
    684727          Left = 15
    685728          Top = 11
    686           Width = 488
     729          Width = 508
    687730          Height = 21
    688731          Style = orcsDropDown
    … …  
    707750      object pnlSelectedTests: TGroupBox
    708751        Left = 0
    709         Top = 262
    710         Width = 701
    711         Height = 112
     752        Top = 355
     753        Width = 684
     754        Height = 109
    712755        Align = alTop
    713756        Caption = 'Selected Components and Tests'
    … …  
    722765        object lvSelectionList: TCaptionListView
    723766          Left = 5
    724           Top = 12
    725           Width = 417
     767          Top = 15
     768          Width = 430
    726769          Height = 91
    727           Color = clBtnFace
    728770          Columns = <
    729771            item
    … …  
    751793          Font.Height = -11
    752794          Font.Name = 'MS Sans Serif'
    753           Font.Style = [fsBold]
     795          Font.Style = []
    754796          ReadOnly = True
    755797          RowSelect = True
    … …  
    762804        end
    763805        object btnRemove: TButton
    764           Left = 428
     806          Left = 450
    765807          Top = 37
    766808          Width = 75
    … …  
    777819        end
    778820        object btnRemoveAll: TButton
    779           Left = 428
     821          Left = 450
    780822          Top = 64
    781823          Width = 75
    … …  
    795837    object TabResults: TTabSheet
    796838      Caption = 'Lab Results'
     839      ExplicitLeft = 0
     840      ExplicitTop = 0
     841      ExplicitWidth = 0
     842      ExplicitHeight = 0
    797843      object edtResults: TCaptionRichEdit
    798         Left = -4
    799         Top = 57
    800         Width = 517
    801         Height = 290
     844        Left = 0
     845        Top = 0
     846        Width = 684
     847        Height = 469
     848        Align = alClient
    802849        Font.Charset = DEFAULT_CHARSET
    803850        Font.Color = clWindowText
    … …  
    812859  inherited cmdAccept: TButton
    813860    Left = 455
    814     Top = 399
     861    Top = 503
     862    Width = 75
    815863    TabOrder = 2
    816864    Visible = False
    817865    ExplicitLeft = 455
    818     ExplicitTop = 399
     866    ExplicitTop = 503
     867    ExplicitWidth = 75
    819868  end
    820869  inherited cmdQuit: TButton
    821870    Left = 455
    822     Top = 426
     871    Top = 541
    823872    Width = 52
    824873    TabOrder = 3
    825874    ExplicitLeft = 455
    826     ExplicitTop = 426
     875    ExplicitTop = 541
    827876    ExplicitWidth = 52
    828877  end
    829878  inherited pnlMessage: TPanel
    830879    Left = 8
    831     Top = 409
     880    Top = 513
    832881    Width = 409
    833882    Height = 49
    834883    TabOrder = 1
    835884    ExplicitLeft = 8
    836     ExplicitTop = 409
     885    ExplicitTop = 513
    837886    ExplicitWidth = 409
    838887    ExplicitHeight = 49
    … …  
    946995      (
    947996        'Component = cboReasons'
    948         'Text = Applies to entire order'
    949         'Status = stsOK')
     997        'Status = stsDefault')
    950998      (
    951999        'Component = memDiagComment'
    … …  
    9581006        'Status = stsDefault')
    9591007      (
     1008        'Component = txtImmedColl'
     1009        'Status = stsDefault')
     1010      (
     1011        'Component = calCollTime'
     1012        'Status = stsDefault')
     1013      (
     1014        'Component = pnlCollTimeButton'
     1015        'Status = stsDefault')
     1016      (
    9601017        'Component = calWantTime'
    961         'Status = stsDefault')
    962       (
    963         'Component = calCollTime'
    964         'Status = stsDefault')
    965       (
    966         'Component = txtImmedColl'
    967         'Status = stsDefault')
    968       (
    969         'Component = pnlCollTimeButton'
    9701018        'Status = stsDefault'))
    9711019  end

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

    r829 r1679  
    5757    txtImmedColl: TCaptionEdit;
    5858    pnlCollTimeButton: TKeyClickPanel;
     59    lblTNS: TLabel;
     60    lblNoBloodReq: TLabel;
    5961    cmdImmedColl: TSpeedButton;
    60     lblTNS: TLabel;
     62    Splitter1: TSplitter;
    6163    procedure FormCreate(Sender: TObject);
    6264    procedure cboAvailTestSelect(Sender: TObject);
    … …  
    9799    procedure cboModifiersChange(Sender: TObject);
    98100    procedure lvSelectionListClick(Sender: TObject);
    99     procedure cboAvailCompChange(Sender: TObject);
    100101    procedure cboCollTimeChange(Sender: TObject);
    101102    procedure memDiagCommentChange(Sender: TObject);
    102103    procedure cboUrgencyExit(Sender: TObject);
     104    procedure pnlBloodComponentsEnter(Sender: TObject);
     105    procedure pnlDiagnosticTestsEnter(Sender: TObject);
     106    procedure pnlDiagnosticTestsExit(Sender: TObject);
     107    procedure pnlBloodComponentsExit(Sender: TObject);
     108    procedure pnlBloodComponentsClick(Sender: TObject);
     109    procedure pnlDiagnosticTestsClick(Sender: TObject);
     110    procedure cboCollTypeClick(Sender: TObject);
     111    procedure cboAvailTestEnter(Sender: TObject);
     112    procedure cboCollTypeEnter(Sender: TObject);
     113    procedure txtImmedCollEnter(Sender: TObject);
     114    procedure calCollTimeEnter(Sender: TObject);
     115    procedure cboCollTimeEnter(Sender: TObject);
     116    procedure cboModifiersEnter(Sender: TObject);
     117    procedure calWantTimeEnter(Sender: TObject);
     118    procedure cboAvailCompEnter(Sender: TObject);
     119    procedure FormShow(Sender: TObject);
    103120  protected
    104121    FCmtTypes: TStringList ;
    … …  
    244261  ALabTest: TLabTest;
    245262  UserHasLRLABKey: boolean;
     263  uChangingMSBOS: boolean;
    246264  LRFZX     : string;  //the default collection type  (LC,WC,SP,I)
    247265  LRFSAMP   : string;  //the default sample           (ptr)
    … …  
    293311  uSelUrgency := '';
    294312  uSelSurgery := 0;
     313  uChangingMSBOS := false;
    295314  TabResults.Caption := 'Lab Results';
    296315  edtResults.Lines.Clear;
    … …  
    314333    UserHasLRLABKey := User.HasKey('LRLAB');
    315334    AllowQuickOrder := True;
     335    if GetDiagnosticPanelLocation then
     336      begin
     337        pnlDiagnosticTests.Left := 0;
     338        pnlBloodComponents.Left := (pnlDiagnosticTests.Width + 10);
     339        pnlDiagnosticTests.TabOrder := 0;
     340        pnlBloodComponents.TabOrder := 1;
     341      end
     342    else
     343      begin
     344        pnlBloodComponents.Left := 0;
     345        pnlDiagnosticTests.Left := (pnlBloodComponents.Width + 10);
     346        pnlBloodComponents.TabOrder := 0;
     347        pnlDiagnosticTests.TabOrder := 1;
     348      end;
    316349    StatusText('Loading Dialog Definition');
    317350    FCmtTypes := TStringList.Create;
    … …  
    342375      else
    343376        cboCollType.SelectByID('SP');
    344       SetupCollTimes(cboCollType.ItemID);
    345       StatusText('Initializing List of Tests');
    346       FVbecLookup := 'S.VBT';
    347       cboAvailTest.InitLongList('');      //Populates cboAvailTest control based on S.VBT xref
    348     end;
     377      //SetupCollTimes(cboCollType.ItemID);
     378    end;
     379    cboAvailTest.Clear;
     380    aList.Clear;
     381    GetDiagnosticTests(aList);            //Get Tests in right order
     382    for i := 0 to aList.Count - 1 do
     383      cboAvailTest.Items.Add(aList[i]);
    349384    cboAvailComp.Clear;
    350385    aList.Clear;
    … …  
    365400    AList.Clear;
    366401    ExtractUrgencies(uUrgencyList, uVBECList);
    367     ExtractTNSOrders(uTNSOrders, uVBECList);
     402    if not(self.EvtID > 0) then ExtractTNSOrders(uTNSOrders, uVBECList);
    368403    LoadUrgencies(cboUrgency);
    369404    ExtractModifiers(uModifierList, uVBECList);
    … …  
    371406    LoadModifiers(cboModifiers);
    372407    LoadReasons(cboReasons);
    373     calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
    374408    pgeProduct.TabIndex := TI_INFO;
    375409    lvSelectionList.Column[0].Width := 240;
    … …  
    378412    DisableComponentControls;
    379413    DisableDiagTestControls;
     414    pnlDiagnosticTests.Caption := 'Diagnostic Tests';
    380415    pgeProduct.ActivePageIndex := TI_INFO;
    381416    StatusText('');
    … …  
    425460  AnInstance, CurAdd: Integer;
    426461  AResponse: TResponse;
    427   i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer;
    428   aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string;
     462  i, j, k, aTNS, getTest, TestAdded, aMSBOSContinue: integer;
     463  aStr, aTestYes, aName, aTypeScreen, aSpecimen, aSpecimenUID, aSpecimenReq, aModifier, sub, sub1, x, aTNSString, aUrgText: string;
    429464  ListItem: TListItem;
    430   aList: TStringList;
     465  aList, cList: TStringList;
    431466  aTests: TStringList;
     467  xLabTest: TLabTest;
     468  aGotTNS : Boolean;
    432469begin
    433470  inherited;
    434471  aList := TStringList.Create;
     472  cList := TStringList.Create;
    435473  aTests:= TStringList.Create;
     474  aGotTNS := false;
    436475  try
    437476  FOrderAction := OrderAction;
    … …  
    439478  sub1 := '';
    440479  aTypeScreen := '';
    441   aSpecimen := '^';
     480  aSpecimen := '';
     481  aSpecimenUID := '';
     482  aSpecimenReq := '';
    442483  aModifier := '';
    443484  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
    444485    begin
     486      pgeProduct.ActivePageIndex := TI_COMPONENT;
    445487      AnInstance := NextInstance('ORDERABLE', 0);
    446488      while AnInstance > 0 do
    … …  
    453495                begin
    454496                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
    455                   ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     497                  changing := true;
     498                  cboAvailTestSelect(Self);
     499                  changing := false;
    456500                end
    457501              else
    … …  
    468512                  SetControl(chkConsent,         'YN', AnInstance);
    469513                  //DetermineCollectionDefaults(Responses);
    470                   SetControl(cboCollType,        'COLLECT', AnInstance);
    471                   SetControl(cboCollTime,        'START', AnInstance);
    472                   SetupCollTimes(cboCollType.ItemID);
     514                  SetControl(cboSurgery,         'MISC', AnInstance);
    473515                  SetControl(cboUrgency,         'URGENCY', AnInstance);
    474                   SetControl(cboSurgery,         'MISC', AnInstance);
     516                  if cboUrgency.ItemIEN = 0 then
     517                    begin
     518                      if StrToIntDef(LRFURG, 0) > 0 then
     519                        cboUrgency.SelectByID(LRFURG)
     520                      else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
     521                        cboUrgency.ItemIndex := 0;
     522                    end;
    475523                  Urgency := cboUrgency.ItemIEN;
    476524                  if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    … …  
    487535                      AResponse := Responses.FindResponseByName('COMMENT',i);
    488536                    end ;
     537                  cboUrgencyChange(self);
    489538                end;
    490539              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
    … …  
    494543                  EnableDiagTestControls;
    495544                  LRORDERMODE := TORDER_MODE_DIAG;
     545                  //DetermineCollectionDefaults(Responses);
    496546                  aList.Clear;
    497547                  aTestYes := '1';
    … …  
    499549                  if aList.Count > 0 then aTypeScreen := aList[0];
    500550                  aList.Clear;
    501                   with lvSelectionList do
    502                     begin
    503                       ListItem := Items.Add;
    504                       ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
    505                       ListItem.SubItems.Add('');
    506                       ListItem.SubItems.Add('');
    507                       ListItem.SubItems.Add('');
    508                       ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
    509                       if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
    510                         begin
    511                           lblTNS.Caption := '';
    512                           lblTNS.Visible := false;
    513                           memMessage.Text := '';
    514                           pnlMessage.Visible := false;
    515                           uGetTnS := 0;
    516                           pnlDiagnosticTests.Caption := 'Diagnostic Tests';
    517                         end;
    518                     end;
    519                   aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
    520                   uSelectedItems.Add(aStr);
    521551                  if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    522                   {with cboCollType do if Length(ItemID) > 0 then
    523                     begin
    524                       Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    525                       FLastCollType := ItemID;
    526                     end;  }
    527                   if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     552                  if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     553                    else
     554                      begin
     555                        cboUrgency.ItemIndex := 2;
     556                        for i := 0 to cboUrgency.Items.Count - 1 do
     557                          begin
     558                            aUrgText := cboUrgency.Items[i];
     559                            if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
     560                              begin
     561                                cboUrgency.ItemIndex := i;
     562                                break;
     563                              end;
     564                          end;
     565                        Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     566                        cboUrgencyChange(self);
     567                      end;
    528568                  if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
    529569                  if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
    530                   LoadCollType(cboCollType);
    531                   if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
    532                     if not(ALabTest.LabCanCollect) and OrderForInpatient then
    533                       cboCollType.SelectByID('WC')
    534                     else if not(ALabTest.LabCanCollect) then
    535                       cboCollType.SelectByID('SP');
    536                   SetupCollTimes(cboCollType.ItemID);
    537                   if cboCollType.ItemID = 'LC' then
    538                     begin
    539                       with cboCollTime do
    540                         if Length(ItemID) > 0 then
    541                           begin
    542                             Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
    543                             FLastLabCollTime := ItemID + U + Text;
    544                           end
    545                         else if Length(Text) > 0 then
    546                           begin
    547                             Responses.Update('START', 1, ValidCollTime(Text), Text) ;
    548                             FLastLabCollTime := ValidCollTime(Text);
    549                           end;
    550                     end
    551                   else
    552                     begin
    553                       with calCollTime do
    554                         if FMDateTime > 0 then
    555                           begin
    556                             Responses.Update('START', 1, ValidCollTime(Text), Text);
    557                             FLastColltime := ValidCollTime(Text);
    558                           end
    559                         else
    560                           begin
    561                             Responses.Update('START', 1, '', '') ;
    562                             FLastCollTime := '';
    563                           end;
    564                     end;
    565                   with cboCollType do if Length(ItemID) > 0 then
    566                     begin
    567                       Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    568                       FLastCollType := ItemID;
    569                     end;
    570                   //if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
    571570                  memOrder.Text := Responses.OrderText;
    572571                  Changing := False;
    … …  
    625624                    if TestAdded = 1 then
    626625                      begin
    627                         edtResults.Clear;
    628626                        aTests.Clear;
    629627                        GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
    630                         QuickCopy(ATests,edtResults);
    631                         if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
    632                         uRaw.Clear;
    633                         GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     628                        if aTests.Count > 0 then
     629                          begin
     630                            edtResults.Clear;
     631                            QuickCopy(ATests,edtResults);
     632                            TabResults.Caption := 'Lab Results Available';
     633                            uRaw.Clear;
     634                            GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     635                          end;
    634636                      end;
    635637                    CurAdd := 1;
    … …  
    640642                        Inc(CurAdd);
    641643                      end;
     644                  for i := lvSelectionList.Items.Count - 1 downto 0 do
     645                    begin
     646                      if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     647                        begin
     648                          aGotTNS := true;
     649                          break;
     650                        end;
     651                    end;
     652                  if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
     653                    begin
     654                      uGetTnS := 1;
     655                    end;
     656                  if aList.Count > 0 then
     657                    begin
     658                      aSpecimen := piece(aList[0], '^',1);
     659                      aSpecimenUID := piece(aList[0], '^',2);
     660                    end;
     661                  aList.Clear;
     662                  ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     663                  for i := 0 to aList.Count - 1 do
     664                    begin
     665                      if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     666                        begin
     667                          aSpecimenReq := piece(aList[i],'^',2);
     668                          if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
     669                            aSpecimenUID := '';
     670                          break;
     671                        end;
     672                    end;
    642673                  with lvSelectionList do
    643674                    begin
    … …  
    657688                      ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
    658689                    end;
    659                   aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     690                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
    660691                  uSelectedItems.Add(aStr);
    661692                  memOrder.Text := Responses.OrderText;
    662693                  Changing := False;
     694                  if (Length(cboSurgery.Text) > 0) then
     695                    begin
     696                      for i := 0 to cboSurgery.Items.Count - 1 do
     697                        if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
     698                          begin
     699                            cboSurgery.ItemIndex := i;
     700                            Break;
     701                          end;
     702                      cboSurgeryChange(self);
     703                    end;
    663704                end;
    664705            end;
    … …  
    669710      DisableDiagTestControls;
    670711    end;
     712    cList.Clear;
     713    if (Length(cboSurgery.ItemID) > 0) then
     714      begin
     715        for j := 0 to uSelectedItems.Count - 1 do
     716          begin
     717            xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     718            if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
     719              begin
     720                cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
     721              end;
     722            xLabTest.Free;
     723          end;
     724      end;
     725    if (uChangingMSBOS = false) and (cList.Count > 0) then
     726      begin
     727        lblNoBloodReq.Visible := true;
     728        with Application do
     729          begin
     730            NormalizeTopMosts;
     731            aMSBOSContinue :=
     732              MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
     733               '.' + CRLF +
     734               'If you still need to order any components, please enter a justification in the Comment box.'
     735                + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
     736               PChar('No Blood Required'),MB_YESNO);
     737            RestoreTopMosts;
     738          end;
     739        if aMSBOSContinue = 6 then
     740          begin
     741            tQuantity.Text := '';
     742            for j := uSelectedItems.Count - 1 downto 0 do
     743              begin
     744                if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     745                  begin
     746                    lvSelectionList.Items[j].Delete;
     747                    uSelectedItems.Delete(j);
     748                    Responses.Update('ORDERABLE', (j+1) ,'', '');
     749                    Responses.Update('MODIFIER', (j+1), '', '');
     750                    Responses.Update('QTY', (j+1), '', '');
     751                  end;
     752              end;
     753            cboAvailComp.Text := '';
     754            cboAvailComp.ItemIndex := -1;
     755            cboModifiers.Text := '';
     756            cboModifiers.ItemIndex := -1;
     757            lblNoBloodReq.Visible := false;
     758            //if fODBBank. Active then cboAvailTest.SetFocus;
     759            lblTNS.Caption := '';
     760            lblTNS.Visible := false;
     761            DisableComponentControls;
     762          end;
     763      end;
     764      for i := 0 to lvSelectionList.Items.Count - 1 do
     765        begin
     766          if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     767            begin
     768              uGetTnS := 0;
     769              aGotTNS := true;
     770              uDfltUrgency := cboUrgency.ItemID;
     771              lblTNS.Caption := '';
     772              lblTNS.Visible := false;
     773              memMessage.Text := '';
     774              pnlMessage.Visible := false;
     775              pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     776              if uTNSOrders.Count > 0 then
     777                begin
     778                  for j := 0 to uTNSOrders.Count - 1 do
     779                    aTNSString := aTNSString + CRLF + uTNSOrders[j];
     780                  with Application do
     781                    begin
     782                      NormalizeTopMosts;
     783                      aTNS :=
     784                        MessageBox(PChar(aTNSString + CRLF + CRLF +
     785                           'Do you wish to cancel this request for Type & Screen?'),
     786                           PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     787                           MB_YESNO);
     788                      RestoreTopMosts;
     789                      if aTNS = 6 then
     790                        begin
     791                          lvSelectionList.ItemIndex := i;
     792                          lvSelectionListClick(self);
     793                          btnRemoveClick(self);
     794                          break;
     795                        end;
     796                    end;
     797                end;
     798              break;
     799            end;
     800        end;
     801      if uSelectedItems.Count < 1 then uGetTNS := 0;
     802
     803      for i := uSelectedItems.Count - 1 downto 0 do
     804        begin
     805          if (aGotTNS = false) and not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
     806            begin
     807              uGetTnS := 1;
     808              break;
     809            end;
     810        end;
     811
    671812    CurAdd := 1;
    672813    for i := 0 to uSelectedItems.Count - 1 do
    … …  
    689830              else
    690831                begin
    691                   cboUrgency.ItemIndex := 1;
     832                  cboUrgency.ItemIndex := 2;
     833                  for j := 0 to cboUrgency.Items.Count - 1 do
     834                    begin
     835                      aUrgText := cboUrgency.Items[j];
     836                      if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
     837                        begin
     838                          cboUrgency.ItemIndex := j;
     839                          break;
     840                        end;
     841                    end;
    692842                  Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    693843                  cboUrgencyChange(self);
    … …  
    696846        Inc(CurAdd);
    697847      end;
    698     for i := 0 to lvSelectionList.Items.Count - 1 do
    699       begin
    700         if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
    701           begin
    702             if uTNSOrders.Count > 0 then
    703               begin
    704                 for j := 0 to uTNSOrders.Count - 1 do
    705                   aTNSString := aTNSString + CRLF + uTNSOrders[j];
    706                 with Application do
    707                   begin
    708                     NormalizeTopMosts;
    709                     aTNSDays := TNSDaysBack;
    710                     aTNS :=
    711                       MessageBox(PChar(aTNSString + CRLF + CRLF +
    712                                  'Do you wish to continue with this request for Type & Screen?'),
    713                                  PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
    714                                  MB_YESNO);
    715                     RestoreTopMosts;
    716                     if aTNS = 7 then
    717                       begin
    718                         lvSelectionList.ItemIndex := i;
    719                         lvSelectionListClick(self);
    720                         btnRemoveClick(self);
    721                         break;
    722                       end;
    723                   end;
    724               end;
    725             break;
    726           end;
    727       end;
    728   {if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
    729     begin
    730       if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1;
    731       AnInstance := NextInstance('ORDERABLE', 0);
    732       while AnInstance > 0 do
    733         begin
    734           AResponse := FindResponseByName('ORDERABLE', AnInstance);
    735           if AResponse <> nil then
    736             begin
    737               sub := GetSubtype(AResponse.EValue);
    738               if sub = 't' then
    739                 begin
    740                   SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
    741                   ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
    742                 end
    743               else
    744                 begin
    745                   SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
    746                   ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
    747                 end;
    748               //SetControl(cboTests,           'ORDERABLE', AnInstance);
    749               //ALabTest := TLabTest.Create(cboTests.ItemID, Responses);
    750               if ALabTest = nil then Exit;  // Causes access violation
    751               //sub := GetSubtype(ALabTest.TestName);
    752               if AnInstance = 1 then
    753                 begin
    754                   DetermineCollectionDefaults(Responses);
    755                   SetControl(cboReasons,         'REASON', AnInstance);
    756                   SetControl(chkConsent,         'YN', AnInstance);
    757                   SetControl(cboSurgery,         'MISC', AnInstance);
    758                   //SetControl(cboCollType,        'COLLECT', AnInstance);
    759                   //SetControl(cboCollTime,        'START', AnInstance);
    760                   SetControl(calWantTime,        'DATETIME', AnInstance);
    761                   //LoadUrgency(cboCollType.ItemID, cboUrgency);
    762                   SetControl(cboUrgency,         'URGENCY', AnInstance);
    763                   Urgency := cboUrgency.ItemIEN;
    764                   if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
    765                     begin
    766                       cboUrgency.ItemIndex := 0;
    767                       Urgency := cboUrgency.ItemIEN;
    768                     end;
    769                   i := 1 ;
    770                   AResponse := Responses.FindResponseByName('COMMENT',i);
    771                   while AResponse <> nil do
    772                       begin
    773                         if Length(AResponse.Evalue) > 0 then
    774                           Comment.Add(AResponse.EValue);
    775                         Inc(i);
    776                         AResponse := Responses.FindResponseByName('COMMENT',i);
    777                       end ;
    778                 end;
    779               if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
    780                 begin
    781                   Changing := True;
    782                   DisableComponentControls;
    783                   EnableDiagTestControls;
    784                   LRORDERMODE := TORDER_MODE_DIAG;
    785                   with Responses do
    786                     begin
    787                       StatusText('Initializing Order');
    788                       AResponse := FindResponseByName('ORDERABLE', AnInstance);
    789                       if AResponse <> nil then
    790                         sub1 := GetSubtype(AResponse.EValue);
    791                       if sub1 = 't' then
    792                         begin
    793                           SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
    794                           //SetControl(cboTests,           'ORDERABLE', AnInstance);
    795                           //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
    796                           cboAvailTestSelect(self);
    797                         end;
    798                     end;
    799                   Changing := False;
    800                   if ObtainCollSamp then
    801                     begin
    802                       //For BloodBank orders, this condition should never occur
    803                     end
    804                   else
    805                     begin
    806                       with ALabTest do
    807                         with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    808                           begin
    809                             x := '' ;
    810                             for i := 0 to WardComment.Count-1 do
    811                             x := x + WardComment.strings[i]+#13#10 ;
    812                             pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    813                             OrderMessage(x) ;
    814                           end ;
    815                     end;
    816                 end;
    817               if sub = 'c' then with ALabTest do  //COMPONENT
    818                 begin
    819                   Changing := True;
    820                   DisableDiagTestControls;
    821                   EnableComponentControls;
    822                   LRORDERMODE := TORDER_MODE_COMP;
    823                   with Responses do
    824                     begin
    825                       StatusText('Initializing Order');
    826                       AResponse := FindResponseByName('ORDERABLE', AnInstance);
    827                       if AResponse <> nil then
    828                         sub1 := GetSubtype(AResponse.EValue);
    829                       if sub1 = 'c' then
    830                         begin
    831                           SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
    832                           //SetControl(cboTests,           'ORDERABLE', AnInstance);
    833                           SetControl(cboModifiers,       'MODIFIER', AnInstance);
    834                           SetControl(tQuantity,          'QTY', AnInstance);
    835                           //DetermineCollectionDefaults(Responses);
    836                           cboAvailCompSelect(self);
    837                         end;
    838                     end;
    839                   Changing := False;
    840                 end;
    841               with ALabTest do
    842                 begin
    843                   if ObtainComment then
    844                     LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
    845                   else
    846                     DisableCommentPanels;
    847                   x := '' ;
    848                   for i := 0 to CurWardComment.Count-1 do
    849                     x := x + CurWardComment.strings[i]+#13#10 ;
    850                   i :=  IndexOfCollSamp(CollSamp);
    851                   if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    852                     for i := 0 to WardComment.Count-1 do
    853                       x := x + WardComment.strings[i]+#13#10 ;
    854                   pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    855                   if Length(x) > 0 then
    856                     begin
    857                       OrderMessage(x) ;
    858                     end;
    859                 end;
    860               StatusText('');
    861               Changing := True;
    862               //if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses);
    863               Changing := False;
    864             end;
    865           AnInstance := NextInstance('ORDERABLE', AnInstance);
    866         end; //while AnInstance - ORDERABLE
    867       DisableComponentControls;
    868       DisableDiagTestControls;
    869       uQuickInProcess := 0;
    870     end;  }
     848    if uGetTnS = 1 then
     849      begin
     850        lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     851        lblTNS.Visible := true;
     852        memMessage.Text := 'TYPE + SCREEN must be added to order';
     853        pnlMessage.Visible := true;
     854        pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     855      end
     856      else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
    871857  finally
    872858    aList.Free;
     859    cList.Free;
    873860    aTests.Free;
    874861  end;
    875   edtResults.Height := 247;
    876   edtInfo.Height := 247;
    877862  if lvSelectionList.Items.Count > 0 then
    878863    begin
    … …  
    881866      memOrder.Visible := True;
    882867      GroupBox1.Visible := False;
     868      lvSelectionList.Items[0].Selected := true;
     869      lvSelectionListClick(self);
    883870    end;
    884871end;
    … …  
    890877  i: integer;
    891878  x,sub,sub1,aTNSString: string;
    892   aList: TStringList;
    893   aGotIt: boolean;
     879  aList, cList: TStringList;
     880  aGotIt, aGotTNS: boolean;
    894881  aTests: TStringList;
    895882  ListItem: TListItem;
    896   aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String;
    897   CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer;
     883  xLabTest: TLabTest;
     884  aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aSpecimenUID, aSpecimenReq, aTypeScreen, aUrgText: String;
     885  CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS: Integer;
    898886begin
    899887  inherited;
    900888  aList := TStringList.Create;
     889  cList := TStringList.Create;
    901890  aTests := TStringList.Create;
     891  pgeProduct.ActivePageIndex := TI_COMPONENT;
    902892  try
    903893    aModifier := '';
    … …  
    908898    aTypeScreen := '';
    909899    aSpecimen := '';
     900    aSpecimenUID := '';
     901    aSpecimenReq := '';
    910902    sub1 := '';
     903    aGotTNS := false;
    911904    ExtractTypeScreen(aList, uVBECList);
    912905    if aList.Count > 0 then aTypeScreen := aList[0];
    913906    aList.Clear;
    914     Extractspecimen(aList, uVBECList);
    915     if aList.Count > 0 then aSpecimen := aList[0];
     907    ExtractSpecimen(aList, uVBECList);
     908    if aList.Count > 0 then
     909      begin
     910        aSpecimen := piece(aList[0], '^',1);
     911        aSpecimenUID := piece(aList[0], '^',2);
     912      end;
    916913    with Responses, ALabTest do
    917914      begin
    … …  
    963960                    SetControl(chkConsent,         'YN', AnInstance);
    964961                    //DetermineCollectionDefaults(Responses);
    965                     SetControl(cboCollType,        'COLLECT', AnInstance);
    966                     SetupCollTimes(cboCollType.ItemID);
    967                     //SetControl(cboCollTime,        'START', AnInstance);
    968                     //LoadUrgency(cboCollType.ItemID, cboUrgency);
    969962                    SetControl(cboUrgency,         'URGENCY', AnInstance);
    970                     Urgency := cboUrgency.ItemIEN;
    971                     if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
     963                    if cboUrgency.ItemIEN = 0 then
    972964                      begin
    973                         cboUrgency.ItemIndex := 0;
    974                         Urgency := cboUrgency.ItemIEN;
    975                         cboUrgencyChange(self);
     965                        if StrToIntDef(LRFURG, 0) > 0 then
     966                          cboUrgency.SelectByID(LRFURG)
     967                        else if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
     968                          cboUrgency.ItemIndex := 0;
    976969                      end;
    977970                    SetControl(cboSurgery,         'MISC', AnInstance);
     971                    if Length(cboSurgery.Text) > 0 then
     972                      begin
     973                        for i := 0 to cboSurgery.Items.Count - 1 do
     974                          if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
     975                            begin
     976                              cboSurgery.ItemIndex := i;
     977                              Break;
     978                            end;
     979                        cboSurgeryChange(self);
     980                      end;
    978981                    if not(ALabTest = nil) then
    979982                      begin
    980                         Urgency := cboUrgency.ItemIEN;
    981                         if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    982                           begin
    983                             cboUrgency.ItemIndex := 0;
    984                             Urgency := cboUrgency.ItemIEN;
    985                           end;
    986983                        i := 1 ;
    987984                        AResponse := Responses.FindResponseByName('COMMENT',i);
    … …  
    992989                            AResponse := Responses.FindResponseByName('COMMENT',i);
    993990                          end ;
    994                       end;
    995                     if not(cboCollType.ItemID = 'LC') then
    996                       begin
    997                         if Length(cboCollTime.Text) > 0 then
    998                           begin
    999                             calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text);
    1000                             FLastCollTime := cboCollTime.Text;
    1001                           end
    1002                         else
    1003                           begin
    1004                             FLastCollTime := '';
    1005                           end;
    1006991                      end;
    1007992                  end;
    … …  
    1014999                    SetControl(cboModifiers,       'MODIFIER', AnInstance);
    10151000                    SetControl(tQuantity,          'QTY', AnInstance);
    1016                     //DetermineCollectionDefaults(Responses);
    1017                     //Check for and display any associated Lab Results
    10181001                    aList.Clear;
    10191002                    TestAdded := 0;
    … …  
    10431026                      if TestAdded = 1 then
    10441027                        begin
    1045                           edtResults.Clear;
    10461028                          aTests.Clear;
    10471029                          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
    1048                           QuickCopy(ATests,edtResults);
    1049                           if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
    1050                           uRaw.Clear;
    1051                           GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     1030                          if aTests.Count > 0 then
     1031                            begin
     1032                              edtResults.Clear;
     1033                              QuickCopy(ATests,edtResults);
     1034                              TabResults.Caption := 'Lab Results Available';
     1035                              uRaw.Clear;
     1036                              GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     1037                            end;
    10521038                        end;
    10531039                      CurAdd := 1;
    … …  
    10581044                          Inc(CurAdd);
    10591045                        end;
    1060                     aSpecimen := '^';
     1046                    aSpecimen := '';
     1047                    aSpecimenUID := '';
     1048                    aSpecimenReq := '';
    10611049                    aTestYes := '0';
    10621050                    aReason := '';
    … …  
    10641052                    aCollTime := '';
    10651053                    ExtractSpecimen(aList, uVBECList);
    1066                     if aList.Count > 0 then aSpecimen := aList[0];
     1054                    if aList.Count > 0 then
     1055                      begin
     1056                        aSpecimen := piece(aList[0], '^', 1);
     1057                        aSpecimenUID := piece(aList[0], '^', 2);
     1058                      end;
    10671059                    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    10681060                    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
    10691061                    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
    1070                     if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    10711062                    if Length(cboSurgery.ItemID) > 0 then
    10721063                      begin
    … …  
    10761067                          begin
    10771068                            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    1078                              and (piece(aList[i],'^',3) = cboSurgery.Text) then
     1069                             and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
    10791070                              begin
    10801071                                aMSBOS := StrToInt(piece(aList[i],'^',4));
    … …  
    10861077                                      aMSBOSContinue :=
    10871078                                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
    1088                                                    ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
    1089                                                    + IntToStr(aMSBOS) +
    1090                                                    ') for the ' + cboSurgery.text +
    1091                                                    ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
    1092                                                    PChar('Maximum Number of Units Exceeded'),
    1093                                                    MB_YESNO);
     1079                                           ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
     1080                                           + IntToStr(aMSBOS) +
     1081                                           ') for the ' + cboSurgery.text +
     1082                                           ' surgical procedure.' + CRLF +
     1083                                           'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
     1084                                            + CRLF + CRLF + 'Edit the Blood component Quantity?'),
     1085                                           PChar('Maximum Number of Units Exceeded'),
     1086                                           MB_YESNO);
    10941087                                      RestoreTopMosts;
    10951088                                    end;
    1096                                     if aMSBOSContinue = 7 then
     1089                                    if aMSBOSContinue = 6 then
    10971090                                      begin
    10981091                                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
     1092                                        lvSelectionList.Clear;
     1093                                        uSelectedItems.Clear;
     1094                                        uTestsForResults.Clear;
     1095                                        uRaw.Clear;
     1096                                        uGetTnS := 0;
     1097                                        lblTNS.Caption := '';
     1098                                        lblTNS.Visible := false;
     1099                                        memMessage.Text := '';
     1100                                        pnlMessage.Visible := false;
     1101                                        FLastItemID := '';
     1102                                        InitDialog;
     1103                                        cboModifiers.ItemIndex := -1;
     1104                                        cboAvailTest.ItemIndex := -1;
     1105                                        cboAvailComp.ItemIndex := -1;
     1106                                        cboSurgery.ItemIndex := -1;
     1107                                        cboUrgency.ItemIndex := -1;
     1108                                        cboReasons.ItemIndex := -1;
     1109                                        cboCollType.ItemIndex := -1;
     1110                                        cboCollTime.ItemIndex := -1;
     1111                                        cboQuick.ItemIndex := -1;
     1112                                        calWantTime.Text := '';
     1113                                        memDiagComment.Text := '';
     1114                                        GroupBox1.Visible := true;
     1115                                        tQuantity.Text := '';
     1116                                        FLastCollType := '';
     1117                                        FLastCollTime := '';
     1118                                        FLastLabCollTime := '';
     1119                                        txtImmedColl.Text := '';
     1120                                        calCollTime.text := '';
    10991121                                        exit;
    11001122                                      end;
    … …  
    11031125                          end;
    11041126                      end;
    1105                     if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     1127                    for i := lvSelectionList.Items.Count - 1 downto 0 do
     1128                      begin
     1129                        if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     1130                          begin
     1131                            aGotTNS := true;
     1132                            break;
     1133                          end;
     1134                      end;
     1135                    if (uTNSOrders.Count < 1) and (aGotTNS = false) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
    11061136                      begin
    11071137                        uGetTnS := 1;
    … …  
    11131143                        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
    11141144                          begin
    1115                             aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     1145                            aSpecimenReq := piece(aList[i],'^',2);
     1146                            if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
     1147                              aSpecimenUID := '';
    11161148                            break;
    11171149                          end;
    … …  
    11361168                      end;
    11371169                    CurAdd := 1;
    1138                     aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     1170                    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
    11391171                    uSelectedItems.Add(aStr);
    11401172                    for i := 0 to uSelectedItems.Count - 1 do
    … …  
    11601192                  aMsg := '';
    11611193                  LRORDERMODE := TORDER_MODE_INFO;
    1162                   {if uGetTnS = 1 then
    1163                     begin
    1164                       lblTNS.Caption := 'TYPE + SCREEN must be added to order';
    1165                       lblTNS.Visible := true;
    1166                       memMessage.Text := 'TYPE + SCREEN must be added to order';
    1167                       memMessage.Visible := false;
    1168                       pnlMessage.Visible := true;
    1169                       pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
    1170                     end;  }
    1171                   {if uGetTnS = 1 then
    1172                     begin
    1173                       if responses.QuickOrder < 1 then
    1174                         begin
    1175                           for i := 1 to cboAvailTest.Items.Count - 1 do
    1176                             begin
    1177                               if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
    1178                                 begin
    1179                                   if piece(aSpecimen,'^',1) = '1' then
    1180                                     begin
    1181                                       cboCollTime.Text := calWantTime.Text;
    1182                                       aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
    1183                                       cboCollTime.Text := '';
    1184                                       cboCollType.Text := '';
    1185                                       uSpecimen := 1;
    1186                                     end;
    1187                                   cboModifiers.Text := '';
    1188                                   cboAvailTest.SelectByID(aTypeScreen);
    1189                                   cboTests.SelectByID(aTypeScreen);
    1190                                   cboTestsClick(self);
    1191                                   //cboAvailTestSelect(Self);
    1192                                   uSpecimen := 0;
    1193                                   cboCollTime.Text := piece(aCollSave,'^',1);
    1194                                   cboCollType.Text := piece(aCollSave,'^',3);
    1195                                   aCollSave := '';
    1196                                   break;
    1197                                 end;
    1198                             end;
    1199                           aMsg := 'An order for Type and Screen has been added to this request' + '.';
    1200                         end
    1201                         else
    1202                           begin
    1203                             lblTNS.Caption := 'TYPE + SCREEN must be added to order';
    1204                             lblTNS.Visible := true;
    1205                             memMessage.Text := 'TYPE + SCREEN must be added to order';
    1206                             memMessage.Visible := false;
    1207                             pnlMessage.Visible := true;
    1208                           end;
    1209                     end;
    1210                   if (uGetTnS = 1) then
    1211                     begin
    1212                       if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
    1213                       ShowMsg(aMsg);
    1214                     end;  }
    1215 
    1216                   //cboModifiers.Text := '';
    1217                   edtResults.Height := 247;
    1218                   edtInfo.Height := 247;
    12191194                  if lvSelectionList.Items.Count > 0 then
    12201195                    begin
    … …  
    12341209                        aTestYes := '1';
    12351210                        SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
    1236                         //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
     1211                        //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
    12371212                        i := 1 ;
    12381213                        AResponse := Responses.FindResponseByName('COMMENT',i);
    … …  
    12601235                          end;
    12611236                        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    1262                         with cboCollType do if Length(ItemID) > 0 then
    1263                           begin
    1264                             Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    1265                             FLastCollType := ItemID;
    1266                           end;
    12671237                        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
    12681238                          else
    12691239                            begin
    1270                               cboUrgency.ItemIndex := 1;
     1240                              cboUrgency.ItemIndex := 2;
     1241                              for i := 0 to cboUrgency.Items.Count - 1 do
     1242                                begin
     1243                                  aUrgText := cboUrgency.Items[i];
     1244                                  if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
     1245                                    begin
     1246                                      cboUrgency.ItemIndex := i;
     1247                                      break;
     1248                                    end;
     1249                                end;
    12711250                              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    12721251                              cboUrgencyChange(self);
    … …  
    12741253                        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
    12751254                        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
    1276                         LoadCollType(cboCollType);
    1277                         if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
    1278                           if not(ALabTest.LabCanCollect) and OrderForInpatient then
    1279                             cboCollType.SelectByID('WC')
    1280                           else if not(ALabTest.LabCanCollect) then
    1281                             cboCollType.SelectByID('SP');
    1282                         SetupCollTimes(cboCollType.ItemID);
    1283                         if cboCollType.ItemID = 'LC' then
    1284                           begin
    1285                             with cboCollTime do
    1286                               if Length(ItemID) > 0 then
    1287                                 begin
    1288                                   Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
    1289                                   FLastLabCollTime := ItemID + U + Text;
    1290                                 end
    1291                               else if Length(Text) > 0 then
    1292                                 begin
    1293                                   Responses.Update('START', 1, ValidCollTime(Text), Text) ;
    1294                                   FLastLabCollTime := ValidCollTime(Text);
    1295                                 end;
    1296                           end
    1297                         else
    1298                           begin
    1299                             with calCollTime do
    1300                               if FMDateTime > 0 then
    1301                                 begin
    1302                                   Responses.Update('START', 1, ValidCollTime(Text), Text);
    1303                                   FLastColltime := ValidCollTime(Text);
    1304                                 end
    1305                               else
    1306                                 begin
    1307                                   Responses.Update('START', 1, '', '') ;
    1308                                   FLastCollTime := '';
    1309                                 end;
    1310                           end;
    1311                         if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    1312                         with cboCollType do if Length(ItemID) > 0 then
    1313                           begin
    1314                             Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    1315                             FLastCollType := ItemID;
    1316                           end;
    13171255                        uTestSelected := true;
    13181256                        with lvSelectionList do
    … …  
    13261264                          end;
    13271265                        CurAdd := 1;
    1328                         aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     1266                        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
    13291267                        uSelectedItems.Add(aStr);
    13301268                        for i := 0 to uSelectedItems.Count - 1 do
    … …  
    13391277                          end;
    13401278                        memOrder.Text := Responses.OrderText;
    1341                       edtResults.Height := 247;
    1342                       edtInfo.Height := 247;
    13431279                      if lvSelectionList.Items.Count > 0 then
    13441280                        begin
    … …  
    13531289              end;
    13541290              //Quick Order
     1291          end;
     1292        cList.Clear;
     1293        if (Length(cboSurgery.ItemID) > 0) then
     1294          begin
     1295            for j := 0 to uSelectedItems.Count - 1 do
     1296              begin
     1297                xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     1298                if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
     1299                  begin
     1300                    cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
     1301                  end;
     1302                xLabTest.Free;
     1303              end;
     1304          end;
     1305        if (uChangingMSBOS = false) and (cList.Count > 0) then
     1306          begin
     1307            lblNoBloodReq.Visible := true;
     1308            with Application do
     1309              begin
     1310                NormalizeTopMosts;
     1311                aMSBOSContinue :=
     1312                  MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
     1313                   '.' + CRLF +
     1314                   'If you still need to order any components, please enter a justification in the Comment box.'
     1315                    + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
     1316                   PChar('No Blood Required'),MB_YESNO);
     1317                RestoreTopMosts;
     1318              end;
     1319            if aMSBOSContinue = 6 then
     1320              begin
     1321                tQuantity.Text := '';
     1322                for j := uSelectedItems.Count - 1 downto 0 do
     1323                  begin
     1324                    if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     1325                      begin
     1326                        lvSelectionList.Items[j].Delete;
     1327                        uSelectedItems.Delete(j);
     1328                        Responses.Update('ORDERABLE', (j+1) ,'', '');
     1329                        Responses.Update('MODIFIER', (j+1), '', '');
     1330                        Responses.Update('QTY', (j+1), '', '');
     1331                      end;
     1332                  end;
     1333                cboAvailComp.Text := '';
     1334                cboAvailComp.ItemIndex := -1;
     1335                cboModifiers.Text := '';
     1336                cboModifiers.ItemIndex := -1;
     1337                lblNoBloodReq.Visible := false;
     1338                //if fODBBank. Active then cboAvailTest.SetFocus;
     1339                lblTNS.Caption := '';
     1340                lblTNS.Visible := false;
     1341                DisableComponentControls;
     1342              end;
    13551343          end;
    13561344        for i := 0 to lvSelectionList.Items.Count - 1 do
    … …  
    13721360                      begin
    13731361                        NormalizeTopMosts;
    1374                         aTNSDays := TNSDaysBack;
    13751362                        aTNS :=
    13761363                          MessageBox(PChar(aTNSString + CRLF + CRLF +
    1377                                      'Do you wish to continue with this request for Type & Screen?'),
    1378                                      PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
    1379                                      MB_YESNO);
     1364                             'Do you wish to cancel this request for Type & Screen?'),
     1365                             PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     1366                             MB_YESNO);
    13801367                        RestoreTopMosts;
    1381                         if aTNS = 7 then
     1368                        if aTNS = 6 then
    13821369                          begin
    13831370                            lvSelectionList.ItemIndex := i;
    … …  
    13981385            pnlMessage.Visible := true;
    13991386            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
    1400           end;
     1387          end
     1388          else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
    14011389        if ALabTest <> nil then
    14021390          begin
    … …  
    14401428  finally                      //**SubTest
    14411429    alist.Free;
     1430    cList.Free;
    14421431    aTests.Free;
    14431432  end;
    … …  
    17191708procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
    17201709var
    1721   i: integer;
     1710  i, PreviousSelectionIndex: integer;
     1711  PreviousSelectionString: String;
    17221712begin
    17231713  if UrgencyList.Count < 1 then Exit;
    17241714  with AComboBox do
    17251715    begin
     1716     PreviousSelectionIndex := -1;
     1717     PreviousSelectionString := SelText;
    17261718      Clear;
    17271719      for i := 0 to UrgencyList.Count - 1 do
     1720        begin
    17281721         if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
    17291722           Continue
    17301723         else
    17311724           Items.Add(UrgencyList[i]);
     1725         if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
     1726           PreviousSelectionIndex := i;
     1727        end;
    17321728      if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
    17331729        SelectByID(LRFURG)
     1730      else if PreviousSelectionIndex > -1 then
     1731        ItemIndex := PreviousSelectionIndex
    17341732      else
    17351733        SelectByIEN(uDfltUrgency);
    … …  
    18641862  i:integer;
    18651863  aborh: boolean;
    1866   aSpecimen, aSpecimenDate: string;
     1864  aSpecimen, aSpecimenUID, aSpecimenDate: string;
    18671865  aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
    18681866begin
    … …  
    18701868  aborh := false;
    18711869  aSpecimen := '';
     1870  aSpecimenUID := '';
    18721871  OutList.Clear;
    18731872  ExtractItems(OutList,Alist,'ABORH');
    … …  
    18861885  OutList.Clear;
    18871886  ExtractSpecimen(OutList, uVBECList);
    1888   if OutList.Count > 0 then aSpecimen := OutList[0];
     1887  if OutList.Count > 0 then
     1888    begin
     1889      aSpecimen := Piece(OutList[0], '^',1);
     1890      aSpecimenUID := Piece(OutList[0], '^',2);
     1891    end;
    18891892  OutList.Clear;
    18901893  ExtractItems(OutList,AList,'SPECIMENS');
    18911894  aWantDateTime := calWantTime.FMDateTime;
    1892   aSpecimenDate := piece(aSpecimen,'^',1);
     1895  aSpecimenDate := aSpecimen;
    18931896  aExpiredSpecimenDate := 0;
    18941897  if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
    1895 
    18961898  for i := 0 to OutList.Count - 1 do
    18971899    begin
    18981900      if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
    1899         if aSpecimen = '' then
    1900           begin
    1901             result := true;
    1902             exit;
    1903           end
    1904         else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
    1905           begin
    1906             result := true;
    1907             exit;
    1908           end;
     1901        begin
     1902          if self.EvtID > 0 then
     1903            begin
     1904              result := true;
     1905              exit;
     1906            end;
     1907          if aSpecimen = '' then
     1908            begin
     1909              result := true;
     1910              exit;
     1911            end
     1912          else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
     1913            begin
     1914              result := true;
     1915              exit;
     1916            end;
     1917        end;
    19091918    end;
    19101919end;
    … …  
    19631972  TX_TOO_MANY_DAYS  = 'Maximum number of days allowed is ';
    19641973  TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is:  X';
    1965   //TX_NO_COMMENT     = 'A comment is required for this test and collection sample.';
    19661974  TX_NUMERIC_REQD   = 'A numeric value is required for urine volume';
    19671975  TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order';
    19681976  TX_TDM_REQD       = 'A value for LEVEL is required for this order';
    1969   //TX_ANTICOAG_REQD  = 'You must specify an anticoagulant on this order.' ;
    19701977  TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified';
    19711978  TX_NO_SPECIMEN    = 'A specimen MUST be specified';
    … …  
    21892196  tmpImmTime, tmpTime: TFMDateTime;
    21902197  x, tmpORECALLType, tmpORECALLTime: string;
    2191 begin
     2198  j: integer;
     2199  havetest: boolean;
     2200begin
     2201  havetest := false;
     2202  for j := uSelectedItems.Count - 1 downto 0 do
     2203    begin
     2204      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') and ((length(calCollTime.Text) > 0) or (length(cboCollTime.Text) > 0)) then
     2205        begin
     2206          havetest := true;
     2207          Break;
     2208        end;
     2209    end;
     2210  //if (havetest = True) and (not(FOrderAction in [ORDER_QUICK, ORDER_EDIT])) then havetest := false;
    21922211  x := GetLastCollectionTime;
    21932212  tmpORECALLType := Piece(x, U, 1);
    21942213  tmpORECALLTime := Piece(x, U, 2);
    21952214  if CollType = 'SP' then
     2215    begin
     2216      cboColltime.Visible    := False;
     2217      txtImmedColl.Visible   := False;
     2218      pnlCollTimeButton.Visible   := False;
     2219      pnlCollTimeButton.TabStop := False;
     2220      calCollTime.Visible    := True;
     2221      calCollTime.Enabled    := True;
     2222      if FLastCollTime <> '' then
     2223        begin
     2224          calCollTime.Text := ValidCollTime(FLastColltime);
     2225          if IsFMDateTime(calCollTime.Text) then
     2226            begin
     2227              calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
     2228              calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
     2229            end;
     2230        end
     2231      else if tmpORECALLTime <> '' then
     2232        begin
     2233          calCollTime.Text := ValidCollTime(tmpORECALLTime);
     2234          if IsFMDateTime(calCollTime.Text) then
     2235            begin
     2236              calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
     2237              calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
     2238            end;
     2239        end
     2240      else if LRFDATE <> '' then
     2241        calCollTime.Text     := LRFDATE
     2242      else if not(FOrderAction in [ORDER_EDIT]) then
     2243        calCollTime.Text     := 'TODAY'
     2244      else if (havetest = false) then
     2245        calCollTime.Text     := 'TODAY';
     2246     if (havetest = false) and (RemoveCollTimeDefault = True) then
     2247        begin
     2248          calCollTime.Text := '';
     2249          calCollTime.FMDateTime := 0;
     2250        end;
     2251    end
     2252  else if CollType = 'WC' then
    21962253    begin
    21972254      cboColltime.Visible    := False;
    … …  
    22032260      if FLastCollTime <> '' then
    22042261        begin
    2205           calCollTime.Text := ValidCollTime(FLastColltime);
     2262          calCollTime.Text := ValidColltime(FLastColltime);
    22062263          if IsFMDateTime(calCollTime.Text) then
    22072264            begin
    22082265              calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
    2209               calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
     2266              calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
    22102267            end;
    22112268        end
    22122269      else if tmpORECALLTime <> '' then
    22132270        begin
    2214           calCollTime.Text := ValidCollTime(tmpORECALLTime);
     2271          calCollTime.Text := ValidColltime(tmpORECALLTime);
    22152272          if IsFMDateTime(calCollTime.Text) then
    22162273            begin
    22172274              calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
    2218               calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
     2275              calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
    22192276            end;
    22202277        end
    22212278      else if LRFDATE <> '' then
    22222279        calCollTime.Text     := LRFDATE
    2223       else
    2224         calCollTime.Text     := 'TODAY';
    2225     end
    2226   else if CollType = 'WC' then
    2227     begin
    2228       cboColltime.Visible    := False;
    2229       txtImmedColl.Visible   := False;
    2230       pnlCollTimeButton.Visible   := False;
    2231       pnlCollTimeButton.TabStop := False;
    2232       calCollTime.Visible    := True;
    2233       calColltime.Enabled    := True;
    2234       if FLastCollTime <> '' then
    2235         begin
    2236           calCollTime.Text := ValidColltime(FLastColltime);
    2237           if IsFMDateTime(calCollTime.Text) then
    2238             begin
    2239               calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
    2240               calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
    2241             end;
    2242         end
    2243       else if tmpORECALLTime <> '' then
    2244         begin
    2245           calCollTime.Text := ValidColltime(tmpORECALLTime);
    2246           if IsFMDateTime(calCollTime.Text) then
    2247             begin
    2248               calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
    2249               calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
    2250             end;
    2251         end
    2252       else if LRFDATE <> '' then
    2253         calCollTime.Text     := LRFDATE
    2254       else
     2280      else if not(FOrderAction in [ORDER_EDIT]) then
    22552281        calCollTime.Text     := 'NOW';
     2282      if (havetest = false) and (RemoveCollTimeDefault = True) then
     2283        begin
     2284          calCollTime.Text := '';
     2285          calCollTime.FMDateTime := 0;
     2286        end;
    22562287    end
    22572288  else if CollType = 'LC' then
    … …  
    22742305      else
    22752306        cboCollTime.ItemIndex := 0;
     2307      if (havetest = false) and (RemoveCollTimeDefault = True) then
     2308        begin
     2309          cboCollTime.Text := '';
     2310        end;
    22762311    end
    22772312  else if CollType = 'I' then
    … …  
    22792314      cboColltime.Visible    := False;
    22802315      calCollTime.Visible    := False;
    2281       calColltime.Enabled    := False;
     2316      calCollTime.Enabled    := False;
    22822317      txtImmedColl.Visible   := True;
    22832318      pnlCollTimeButton.Visible   := True;
    … …  
    22912326      else if LRFDATE <> '' then
    22922327        tmpTime := StrToFMDateTime(LRFDATE);
    2293 
    22942328      if tmpTime > tmpImmTime then
    22952329        begin
    … …  
    23012335          calCollTime.FMDateTime := GetDefaultImmCollTime;
    23022336          txtImmedColl.Text      := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
     2337        end;
     2338      if (havetest = false) and (RemoveCollTimeDefault = True) then
     2339        begin
     2340          calCollTime.Text := '';
     2341          calCollTime.FMDateTime := 0;
     2342          txtImmedColl.Text := '';
    23032343        end;
    23042344    end;
    … …  
    23872427begin
    23882428  inherited;
     2429  cboReasons.Text := StringReplace(cboReasons.Text,CRLF,'  ',[rfReplaceAll]);
    23892430  if (length(cboReasons.Text) > 75) then
    23902431    begin
    … …  
    24142455var
    24152456  i: integer;
    2416   text : string;
    24172457  ListItem: TListItem;
    2418   aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string;
     2458  aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,x,aName,aTNSString, aUrgText: string;
    24192459  aList: TStringList;
    2420   curAdd,AnInstance,aTNS,aTNSDays: Integer;
     2460  curAdd,aTNS: Integer;
    24212461  sub,sub1: string;
    2422   AResponse: TResponse;
     2462  aChanging: Boolean;
    24232463begin
    24242464  if cboAvailTest.ItemID = '' then Exit;
    24252465  aList := TStringList.Create;
     2466  aChanging := changing;
    24262467  try
    24272468    ALabTest := nil;
    24282469    aTypeScreen := '';
    2429     aSpecimen := '^';
     2470    aSpecimen := '';
     2471    aSpecimenUID := '';
     2472    aSpecimenReq := '';
    24302473    aTestYes := '1';
    24312474    aModifier := '';
    24322475    changing := true;
    24332476    tQuantity.Text := '';
     2477    changing := aChanging;
    24342478    sub1 := '';
    24352479    cboModifiers.ItemIndex := -1;
    … …  
    24392483    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
    24402484    sub := GetSubtype(ALabTest.TestName);
    2441     with CtrlInits do
    2442         begin
    2443           SetControl(cboCollType, 'Collection Types');
    2444           LoadCollType(cboCollType);
    2445           if FLastCollType <> '' then
    2446             cboCollType.SelectByID(FLastCollType)
    2447           else if uDfltCollType <> '' then
    2448             cboCollType.SelectByID(uDfltCollType)
    2449           else if OrderForInpatient then
    2450             if (ALabTest.LabCanCollect) then
    2451               cboCollType.SelectByID('LC')
    2452             else
    2453               cboCollType.SelectByID('WC')
    2454           else
    2455             cboCollType.SelectByID('SP');
    2456           SetupCollTimes(cboCollType.ItemID);
    2457         end;
     2485    {if not(FOrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK]) then
     2486      DetermineCollectionDefaults(Responses); }
     2487    DetermineCollectionDefaults(Responses);
    24582488    with cboAvailTest do
    24592489      begin
    2460         if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2490        if (Length(ItemID) = 0) or (ItemID = '0') then
     2491          begin
     2492            changing := aChanging;
     2493            Exit;
     2494          end;
    24612495        FLastLabID := ItemID ;
    24622496        FLastItemID := ItemID;
    … …  
    24672501              lvSelectionList.Items[i].Selected := true;
    24682502              lvSelectionListClick(self);
     2503              changing := aChanging;
    24692504              Exit;
    24702505            end;
    2471         Changing := True;
    2472         Changing := False;
    24732506        ExtractTypeScreen(aList, uVBECList);
    24742507        if aList.Count > 0 then aTypeScreen := aList[0];
    24752508        aList.Clear;
    24762509        aTNSString := '';
    2477         if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
     2510        if (Changing = false) and (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
    24782511          begin
    24792512            for i := 0 to uTNSOrders.Count - 1 do
    … …  
    24822515              begin
    24832516                NormalizeTopMosts;
    2484                 aTNSDays := TNSDaysBack;
    24852517                aTNS :=
    24862518                  MessageBox(PChar(aTNSString + CRLF + CRLF +
    2487                              'Do you wish to continue?'),
    2488                              PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
    2489                              MB_YESNO);
     2519                   'Do you wish to cancel this request for Type & Screen?'),
     2520                   PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     2521                   MB_YESNO);
    24902522                RestoreTopMosts;
    2491                 if aTNS = 7 then
     2523                if aTNS = 6 then
    24922524                  begin
    24932525                    cboAvailTest.ItemIndex := -1;
    … …  
    25152547              end;
    25162548        end;
    2517         Changing := False;
    25182549      end;
    25192550    if LRORDERMODE = TORDER_MODE_DIAG then
    25202551      begin
    25212552        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    2522         with cboCollType do if Length(ItemID) > 0 then
     2553        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     2554        else if changing = false then
    25232555          begin
    2524             Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    2525             FLastCollType := ItemID;
    2526           end;
    2527         if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
    2528         else
    2529           begin
    2530             cboUrgency.ItemIndex := 1;
     2556            for i := 0 to cboUrgency.Items.Count - 1 do
     2557              begin
     2558                aUrgText := cboUrgency.Items[i];
     2559                if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
     2560                  begin
     2561                    cboUrgency.ItemIndex := i;
     2562                    break;
     2563                  end;
     2564              end;
    25312565            Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    25322566          end;
    25332567        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
    25342568        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     2569        with cboCollTime do
     2570
    25352571        if cboCollType.ItemID = 'LC' then
    25362572          begin
    … …  
    25472583                end;
    25482584          end
    2549           else
    2550             begin
    2551               with calCollTime do
    2552                 if FMDateTime > 0 then
    2553                   begin
    2554                     Responses.Update('START', 1, ValidCollTime(Text), Text);
    2555                     FLastColltime := ValidCollTime(Text);
    2556                   end
    2557                 else
    2558                   begin
    2559                     Responses.Update('START', 1, '', '') ;
    2560                     FLastCollTime := '';
    2561                   end;
    2562             end;
    2563           if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
     2585        else
     2586          begin
     2587            with calCollTime do
     2588              if FMDateTime > 0 then
     2589                begin
     2590                  Responses.Update('START', 1, ValidCollTime(Text), Text);
     2591                  FLastColltime := ValidCollTime(Text);
     2592                end
     2593              else
     2594                begin
     2595                  Responses.Update('START', 1, '', '') ;
     2596                  FLastCollTime := '';
     2597                end;
     2598          end;
     2599        if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
    25642600      end;
    2565     if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    25662601    uTestSelected := true;
    25672602    with lvSelectionList do
    … …  
    25832618          end;
    25842619      end;
    2585     aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     2620    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
    25862621    uSelectedItems.Add(aStr);
    25872622    CurAdd := 1;
    … …  
    26002635    aList.Free;
    26012636  end;
    2602   edtResults.Height := 247;
    2603   edtInfo.Height := 247;
    26042637  if lvSelectionList.Items.Count > 0 then
    26052638    begin
    … …  
    26182651  aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
    26192652  sub,sub1: string;
    2620   AResponse: TResponse;
    26212653  ListItem: TListItem;
    2622   aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String;
     2654  aTypeScreen,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName,aUrgText: String;
     2655  aChanging: Boolean;
    26232656begin
    26242657  if cboAvailComp.ItemID = '' then Exit;
    … …  
    26262659  aTests := TStringList.Create;
    26272660  sub1 := '';
     2661  aChanging := changing;
    26282662  try
    26292663    DisableDiagTestControls;
    … …  
    26342668        tQuantity.Text := '';
    26352669        cboModifiers.ItemIndex := -1;
    2636         changing := false;
     2670        changing := aChanging;
    26372671      end;
    26382672    LRORDERMODE := TORDER_MODE_COMP;
    … …  
    26522686        ALabTest := TLabTest.Create(ItemID, Responses);
    26532687        sub := GetSubtype(ALabTest.TestName);
    2654         Changing := False;
     2688        changing := aChanging;
    26552689        StatusText('');
    26562690      end;
    2657     //Check for and display any associated Lab Results
    26582691    aList.Clear;
    26592692    TestAdded := 0;
    26602693    getTest := 0;
    2661     ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     2694    ExtractTests(aList, uVBECList);   //Get Lab Results associated with ordered components
    26622695      for j := 0 to aList.Count - 1 do
    26632696        begin
    … …  
    26832716      if TestAdded = 1 then
    26842717        begin
    2685           edtResults.Clear;
    26862718          aTests.Clear;
    26872719          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
    2688           QuickCopy(ATests,edtResults);
    2689           if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available';
    2690           uRaw.Clear;
    2691           GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     2720          if aTests.Count > 0 then
     2721            begin
     2722              edtResults.Clear;
     2723              QuickCopy(ATests,edtResults);
     2724              TabResults.Caption := 'Lab Results Available';
     2725              uRaw.Clear;
     2726              GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     2727            end;
    26922728        end;
    26932729      CurAdd := 1;
    … …  
    26992735        end;
    27002736    aTypeScreen := '';
    2701     aSpecimen := '^';
     2737    aSpecimen := '';
     2738    aSpecimenUID := '';
     2739    aSpecimenReq := '';
    27022740    aTestYes := '0';
    27032741    aReason := '';
    … …  
    27092747    aList.Clear;
    27102748    ExtractSpecimen(aList, uVBECList);
    2711     if aList.Count > 0 then aSpecimen := aList[0];
     2749    if aList.Count > 0 then
     2750      begin
     2751        aSpecimen := piece(aList[0], '^', 1);
     2752        aSpecimenUID := piece(aList[0], '^', 2);
     2753      end;
     2754    if (cboSurgery.ItemID = '') and (length(cboSurgery.Text) > 0) then
     2755      begin
     2756        for i := 0 to cboSurgery.Items.Count - 1 do
     2757          if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
     2758            begin
     2759              cboSurgery.ItemIndex := i;
     2760              Break;
     2761            end;
     2762      end;
    27122763    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    27132764    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
    27142765    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
    2715     if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    2716     if Length(cboSurgery.ItemID) > 0 then
    2717       begin
     2766    if (Length(cboSurgery.ItemID) > 0) and (length(tQuantity.Text) > 0) and (strToInt(tQuantity.Text) > 0) then
     2767      begin
     2768        uChangingMSBOS := true;
     2769        cboSurgeryChange(self);
     2770        uChangingMSBOS := false;
     2771        if cboAvailComp.ItemIndex = -1 then Exit;
    27182772        aList.Clear;
    27192773        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
    … …  
    27212775          begin
    27222776            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    2723              and (piece(aList[i],'^',3) = cboSurgery.Text) then
     2777             and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
    27242778              begin
    27252779                aMSBOS := StrToInt(piece(aList[i],'^',4));
    … …  
    27312785                      aMSBOSContinue :=
    27322786                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
    2733                                    ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
    2734                                    + IntToStr(aMSBOS) +
    2735                                    ') for the ' + cboSurgery.text +
    2736                                    ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
    2737                                    PChar('Maximum Number of Units Exceeded'),
    2738                                    MB_YESNO);
     2787                         ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
     2788                         + IntToStr(aMSBOS) +
     2789                         ') for the ' + cboSurgery.text +
     2790                         ' surgical procedure.' + CRLF +
     2791                         'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
     2792                          + CRLF + CRLF + 'Edit the Blood component Quantity?'),
     2793                         PChar('Maximum Number of Units Exceeded'),
     2794                         MB_YESNO);
    27392795                      RestoreTopMosts;
    27402796                    end;
    2741                     if aMSBOSContinue = 7 then
     2797                    if aMSBOSContinue = 6 then
    27422798                      begin
    27432799                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
    … …  
    27482804          end;
    27492805      end;
    2750     if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     2806    if (uTNSOrders.Count < 1) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
    27512807      begin
    27522808        uGetTnS := 1;
    … …  
    27722828        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
    27732829          begin
    2774             aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     2830            aSpecimenReq := piece(aList[i],'^',2);
     2831            if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
     2832              aSpecimenUID := '';
    27752833            break;
    27762834          end;
    … …  
    27942852        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
    27952853      end;
    2796       aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     2854      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
    27972855      uSelectedItems.Add(aStr);
    27982856      CurAdd := 1;
    … …  
    28162874                else
    28172875                  begin
    2818                     cboUrgency.ItemIndex := 1;
     2876                    cboUrgency.ItemIndex := 2;
     2877                    for j := 0 to cboUrgency.Items.Count - 1 do
     2878                      begin
     2879                        aUrgText := cboUrgency.Items[j];
     2880                        if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
     2881                          begin
     2882                            cboUrgency.ItemIndex := i;
     2883                            break;
     2884                          end;
     2885                      end;
    28192886                    Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    28202887                  end;
    … …  
    28362903      pnlMessage.Visible := true;
    28372904      pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
    2838     end;
    2839   {if uGetTnS = 1 then
    2840     begin
    2841       if responses.QuickOrder < 1 then
    2842         begin
    2843           for i := 1 to cboAvailTest.Items.Count - 1 do
    2844             begin
    2845               if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
    2846                 begin
    2847                   if piece(aSpecimen,'^',1) = '1' then
    2848                     begin
    2849                       cboCollTime.Text := calWantTime.Text;
    2850                       aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
    2851                       cboCollTime.Text := '';
    2852                       cboCollType.Text := '';
    2853                       uSpecimen := 1;
    2854                     end;
    2855                   cboModifiers.Text := '';
    2856                   cboAvailTest.SelectByID(aTypeScreen);
    2857                   cboTests.SelectByID(aTypeScreen);
    2858                   cboTestsClick(self);
    2859                   //cboAvailTestSelect(Self);
    2860                   uSpecimen := 0;
    2861                   cboCollTime.Text := piece(aCollSave,'^',1);
    2862                   cboCollType.Text := piece(aCollSave,'^',3);
    2863                   aCollSave := '';
    2864                   break;
    2865                 end;
    2866             end;
    2867           aMsg := 'An order for Type and Screen has been added to this request' + '.';
    2868         end
    2869         else
    2870           begin
    2871             lblTNS.Caption := 'TYPE + SCREEN must be added to order';
    2872             lblTNS.Visible := true;
    2873             memMessage.Text := 'TYPE + SCREEN must be added to order';
    2874             memMessage.Visible := false;
    2875             pnlMessage.Visible := true;
    2876           end;
    2877       end;
    2878   if (uGetTnS = 1) then
    2879     begin
    2880       if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
    2881       ShowMsg(aMsg);
    2882     end;  }
    2883   edtResults.Height := 247;
    2884   edtInfo.Height := 247;
     2905    end
     2906    else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
    28852907  if lvSelectionList.Items.Count > 0 then
    28862908    begin
    … …  
    28992921
    29002922procedure TfrmODBBank.DisableComponentControls;
     2923var
     2924  j: integer;
    29012925begin
    29022926  lblQuantity.Enabled := false;
    … …  
    29042928  lblModifiers.Enabled := false;
    29052929  cboModifiers.Enabled := false;
     2930  lblQuantity.Caption := 'Quantity';
     2931  lblWanted.Caption := 'Date/Time Wanted';
     2932  lblReason.Caption := 'Reason for Request';
    29062933  cboAvailComp.ItemIndex := -1;
     2934  for j := uSelectedItems.Count - 1 downto 0 do
     2935    begin
     2936      if piece(uSelectedItems[j],'^',1) = '0' then
     2937        begin
     2938          lblReason.Caption := 'Reason for Request*';
     2939          lblWanted.Caption := 'Date/Time Wanted*';
     2940          Break;
     2941        end;
     2942    end;
    29072943end;
    29082944
    … …  
    29132949  lblModifiers.Enabled := true;
    29142950  cboModifiers.Enabled := true;
     2951  lblQuantity.Caption := 'Quantity*';
     2952  lblWanted.Caption := 'Date/Time Wanted*';
     2953  lblReason.Caption := 'Reason for Request*';
    29152954  if not(changing) then
    29162955    if not(uSelUrgency = 'PRE-OP') then
    … …  
    29192958          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
    29202959  if cboUrgency.Text = 'PRE-OP' then
    2921     begin
    2922       lblSurgery.Enabled := true;
    2923       cboSurgery.Enabled := true;
    2924       lblSurgery.Caption := 'Surgery*';
    2925     end
    2926     else
    2927       begin
    2928         lblSurgery.Enabled := false;
    2929         cboSurgery.Enabled := false;
    2930         lblSurgery.Caption := 'Surgery';
    2931       end;
     2960        begin
     2961          lblSurgery.Enabled := true;
     2962          cboSurgery.Enabled := true;
     2963          lblSurgery.Caption := 'Surgery*';
     2964        end
     2965      else
     2966        begin
     2967          if Length(cboSurgery.Text) > 0 then
     2968            begin
     2969              lblSurgery.Enabled := true;
     2970              cboSurgery.Enabled := true;
     2971              lblSurgery.Caption := 'Surgery*';
     2972            end
     2973            else
     2974            begin
     2975              lblSurgery.Enabled := false;
     2976              cboSurgery.Enabled := false;
     2977              lblSurgery.Caption := 'Surgery';
     2978              cboSurgery.ItemIndex := -1;
     2979              Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     2980            end;
     2981        end;
     2982
    29322983  lblDiagComment.Enabled := true;
    29332984end;
    29342985
    29352986procedure TfrmODBBank.DisableDiagTestControls;
    2936 begin
    2937   lblCollTime.Enabled := false;
    2938   calCollTime.Enabled := false;
    2939   cboCollTime.Enabled := false;
    2940   lblCollType.Enabled := false;
    2941   cboCollType.Enabled := false;
    2942   cmdImmedColl.Enabled := false;
     2987var
     2988  i,j: integer;
     2989  diagflg: boolean;
     2990begin
     2991  diagflg := false;
     2992  for i := 0 to uSelectedItems.Count - 1 do
     2993    begin
     2994      if (piece(uSelectedItems[i],'^',1) = '1') then
     2995        begin
     2996          diagflg := true;
     2997          Break;
     2998        end;
     2999    end;
     3000  if diagflg = false then
     3001    begin
     3002      lblCollTime.Enabled := false;
     3003      calCollTime.Enabled := false;
     3004      cboCollTime.Enabled := false;
     3005      lblCollType.Enabled := false;
     3006      cboCollType.Enabled := false;
     3007      cmdImmedColl.Enabled := false;
     3008    end;
     3009  lblCollTime.Caption := 'Collection Date/Time';
     3010  lblCollType.Caption := 'Collection Type';
    29433011  cboAvailTest.ItemIndex := -1;
    2944   cboAvailTest.InitLongList('');
     3012  for j := uSelectedItems.Count - 1 downto 0 do
     3013    begin
     3014      if piece(uSelectedItems[j],'^',1) = '1' then
     3015        begin
     3016          lblCollTime.Caption := 'Collection Date/Time*';
     3017          lblCollType.Caption := 'Collection Type*';
     3018          Break;
     3019        end;
     3020    end;
    29453021end;
    29463022
    … …  
    29533029  cboCollType.Enabled := true;
    29543030  cmdImmedColl.Enabled := true;
     3031  lblCollTime.Caption := 'Collection Date/Time*';
     3032  lblCollType.Caption := 'Collection Type*';
    29553033  if not(changing) then
    29563034    if not(uSelUrgency = 'PRE-OP') then
    … …  
    29713049begin
    29723050  if ALabTest = nil then exit;
    2973   if ALabTest.LabSubscript = 'BB' then exit;
    2974   calCollTime.Clear;
    2975   cboCollTime.Clear;
    29763051  calCollTime.Enabled := True;
    29773052  lblCollTime.Enabled := True;
    … …  
    30243099              begin
    30253100                calCollTime.Enabled := False;
    3026                 if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
     3101                cboCollType.SelectByID('I');
     3102                SetupCollTimes('I');
     3103                //cboCollTypeClick(self);
     3104                //txtImmedColl.Enabled := True;
     3105                if RespStart <> nil then
     3106                  begin
     3107                    txtImmedColl.Text := RespStart.EValue;
     3108                  end;
    30273109              end;
    30283110        end
    … …  
    30323114end;
    30333115
     3116procedure TfrmODBBank.cboAvailTestEnter(Sender: TObject);
     3117var
     3118  j: integer;
     3119begin
     3120  inherited;
     3121  if Length(cboAvailTest.Text) > 0 then Exit;
     3122  for j := uSelectedItems.Count - 1 downto 0 do
     3123    begin
     3124      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
     3125        begin
     3126          lvSelectionList.Items[j].Selected := true;
     3127          lvSelectionListClick(self);
     3128          Break;
     3129        end;
     3130    end;
     3131end;
     3132
    30343133procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
    30353134begin
    30363135  inherited;
    3037   if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
     3136  if (Length(cboAvailTest.Text)>0) and (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then
     3137    begin
     3138      ShowMsg('Invalid Test Selection. Please select a valid Test.');
     3139      cboAvailTestSelect(cboAvailTest);
     3140      cboAvailTest.SetFocus;
     3141      Exit;
     3142    end;
    30383143  if cboAvailTest.ItemID = FLastLabID then Exit;
    3039   cboAvailTestSelect(cboAvailTest);
    3040   cboAvailTest.SetFocus;
    3041   PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
    3042 end;
    3043 
    3044 procedure TfrmODBBank.cboAvailCompChange(Sender: TObject);
    3045 begin
    3046   inherited;
    3047   changing := true;
    3048   changing := false;
     3144  if not (Length(cboAvailTest.ItemID) = 0) then cboAvailTestSelect(cboAvailTest);
     3145end;
     3146
     3147procedure TfrmODBBank.cboAvailCompEnter(Sender: TObject);
     3148var
     3149  j: integer;
     3150begin
     3151  inherited;
     3152  if Length(cboAvailComp.Text) > 0 then Exit;
     3153  for j := uSelectedItems.Count - 1 downto 0 do
     3154    begin
     3155      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     3156        begin
     3157          lvSelectionList.Items[j].Selected := true;
     3158          lvSelectionListClick(self);
     3159          Break;
     3160        end;
     3161    end;
    30493162end;
    30503163
    … …  
    30523165begin
    30533166  inherited;
    3054   if (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then Exit;
     3167  if (Length(cboAvailComp.Text)>0) and (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then
     3168    begin
     3169      ShowMsg('Invalid Component selection. Please select a valid Component.');
     3170      cboAvailCompSelect(cboAvailComp);
     3171      cboAvailComp.SetFocus;
     3172      Exit;
     3173    end;
    30553174  if cboAvailComp.ItemID = FLastLabID then Exit;
    3056   cboAvailCompSelect(cboAvailComp);
    3057   cboAvailComp.SetFocus;
    3058   PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
     3175  if not (Length(cboAvailComp.ItemID) = 0) then cboAvailCompSelect(cboAvailComp);
    30593176end;
    30603177
    … …  
    31303247end;
    31313248
     3249procedure TfrmODBBank.pnlBloodComponentsClick(Sender: TObject);
     3250begin
     3251  inherited;
     3252  cboAvailComp.SetFocus;
     3253end;
     3254
     3255procedure TfrmODBBank.pnlBloodComponentsEnter(Sender: TObject);
     3256begin
     3257  inherited;
     3258  pnlBloodComponents.Color := clActiveborder;
     3259end;
     3260
     3261procedure TfrmODBBank.pnlBloodComponentsExit(Sender: TObject);
     3262begin
     3263  inherited;
     3264  pnlBloodcomponents.Color := clBtnFace;
     3265end;
     3266
     3267procedure TfrmODBBank.pnlDiagnosticTestsClick(Sender: TObject);
     3268begin
     3269  inherited;
     3270  cboAvailTest.SetFocus;
     3271end;
     3272
     3273procedure TfrmODBBank.pnlDiagnosticTestsEnter(Sender: TObject);
     3274begin
     3275  inherited;
     3276  pnlDiagnosticTests.Color := clActiveBorder;
     3277end;
     3278
     3279procedure TfrmODBBank.pnlDiagnosticTestsExit(Sender: TObject);
     3280begin
     3281  inherited;
     3282  pnlDiagnosticTests.Color := clBtnFace;
     3283end;
     3284
    31323285procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
    31333286var
    … …  
    31633316end;
    31643317
     3318procedure TfrmODBBank.cboCollTimeEnter(Sender: TObject);
     3319var
     3320  j: integer;
     3321begin
     3322  inherited;
     3323  if Length(cboAvailTest.Text) > 0 then Exit;
     3324  for j := uSelectedItems.Count - 1 downto 0 do
     3325    begin
     3326      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
     3327        begin
     3328          lvSelectionList.Items[j].Selected := true;
     3329          lvSelectionListClick(self);
     3330          Break;
     3331        end;
     3332    end;
     3333end;
     3334
    31653335procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
    31663336begin
    … …  
    31803350  SetupCollTimes(cboCollType.ItemID);
    31813351  if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
    3182   FLastCollType := cboCollType.ItemID;
    31833352  calCollTimeChange(self);
     3353end;
     3354
     3355procedure TfrmODBBank.cboCollTypeClick(Sender: TObject);
     3356begin
     3357  inherited;
     3358  FOrderAction := 0;
     3359end;
     3360
     3361procedure TfrmODBBank.cboCollTypeEnter(Sender: TObject);
     3362var
     3363  j: integer;
     3364begin
     3365  inherited;
     3366  if Length(cboAvailTest.Text) > 0 then Exit;
     3367  for j := uSelectedItems.Count - 1 downto 0 do
     3368    begin
     3369      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
     3370        begin
     3371          lvSelectionList.Items[j].Selected := true;
     3372          lvSelectionListClick(self);
     3373          Break;
     3374        end;
     3375    end;
    31843376end;
    31853377
    … …  
    32263418end;
    32273419
     3420procedure TfrmODBBank.cboModifiersEnter(Sender: TObject);
     3421var
     3422  j: integer;
     3423begin
     3424  inherited;
     3425  if Length(cboAvailComp.Text) > 0 then Exit;
     3426  for j := uSelectedItems.Count - 1 downto 0 do
     3427    begin
     3428      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     3429        begin
     3430          lvSelectionList.Items[j].Selected := true;
     3431          lvSelectionListClick(self);
     3432          Break;
     3433        end;
     3434    end;
     3435end;
     3436
    32283437procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
    32293438var
    … …  
    32573466    begin
    32583467      Clear;
    3259       for i := 0 to uUrgencyList.Count - 1 do
     3468      {for i := 0 to uUrgencyList.Count - 1 do
    32603469         if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
    32613470           Continue
    32623471         else
    3263            Items.Add(uUrgencyList[i]);
     3472           Items.Add(uUrgencyList[i]); }
     3473      for i := 0 to uUrgencyList.Count - 1 do
     3474        Items.Add(uUrgencyList[i]);
    32643475    end;
    32653476end;
    … …  
    32813492  if cboCollType.ItemID = 'LC' then
    32823493    begin
    3283       if FLastLabCollTime <> '' then
     3494      if (FLastLabCollTime <> '') and (length(cboCollTime.Text) < 1) then
    32843495        cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
    32853496    end
    3286   else
     3497  else if length(calcollTime.Text) < 1 then
    32873498    begin
    32883499      if FLastCollTime = 'TODAY' then
    … …  
    32933504        calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
    32943505    end;
    3295   if FLastCollType <> '' then
     3506  if (FLastCollType <> '') and (length(cboCollType.Text) < 1) then
    32963507    cboCollType.SelectByID(FLastCollType);
    32973508  if uSelectedItems.Count > 0 then
    … …  
    33253536begin
    33263537  inherited;
     3538  memDiagComment.Text := StringReplace(memDiagComment.Text,CRLF,'  ',[rfReplaceAll]);
    33273539  if (length(memDiagComment.Text) > 250) then
    33283540    begin
    … …  
    33533565end;
    33543566
     3567procedure TfrmODBBank.FormShow(Sender: TObject);
     3568begin
     3569  inherited;
     3570  pgeProduct.SetFocus;
     3571end;
     3572
    33553573procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
    33563574var
    … …  
    33583576  x, aName, aModifier, aReason, aTypeScreen: string;
    33593577  aList: TStringList;
    3360   aSel, aSelTst : boolean;
     3578  aSel, aSelTst, aSelComp, aGotTNS : boolean;
    33613579begin
    33623580  inherited;
    … …  
    33693587    aSel := false;
    33703588    aSelTst := false;
     3589    aSelComp := false;
     3590    aGotTNS := false;
    33713591    ExtractTypeScreen(aList, uVBECList);
    33723592    if aList.Count > 0 then aTypeScreen := aList[0];
    … …  
    33813601    cboAvailComp.ItemIndex := -1;
    33823602    tQuantity.Text := '';
     3603    tQuantity.Enabled := false;
     3604    lblQuantity.Enabled := false;
    33833605    cboAvailTest.ItemIndex := -1;
    33843606    uGetTnS := 0;
    … …  
    33983620                  if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
    33993621                    begin
    3400                       {if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then
    3401                         begin
    3402                           uGetTnS := 1;
    3403                           lblTNS.Caption := 'TYPE+SCREEN must be added to order';
    3404                           lblTNS.Visible := true;
    3405                           memMessage.Text := 'TYPE + SCREEN must be added to order';
    3406                           //memMessage.Visible := true;
    3407                           pnlMessage.Visible := true;
    3408                           pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
    3409                         end; }
    34103622                      uSelectedItems.Delete(j);
    34113623                      lvSelectionList.Items[i].Delete;
    … …  
    34153627          end;
    34163628      end;
    3417     for i := uSelectedItems.Count - 1 downto 0 do
    3418       begin
    3419         if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then
     3629    for i := lvSelectionList.Items.Count - 1 downto 0 do
     3630      begin
     3631        if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
    34203632          begin
    3421             uGetTnS := 1;
    3422             lblTNS.Caption := 'TYPE+SCREEN must be added to order';
    3423             lblTNS.Visible := true;
    3424             memMessage.Text := 'TYPE + SCREEN must be added to order';
    3425             //memMessage.Visible := true;
    3426             pnlMessage.Visible := true;
    3427             pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     3633            aGotTNS := true;
    34283634            break;
    34293635          end;
    34303636      end;
    3431      
     3637    if aGotTNS = false then
     3638      begin
     3639        for i := uSelectedItems.Count - 1 downto 0 do
     3640          begin
     3641            if not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
     3642              begin
     3643                uGetTnS := 1;
     3644                lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     3645                lblTNS.Visible := true;
     3646                memMessage.Text := 'TYPE + SCREEN must be added to order';
     3647                pnlMessage.Visible := true;
     3648                pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     3649                break;
     3650              end
     3651              else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3652          end;
     3653      end;
    34323654    if (aSel = false) and (lvSelectionList.Items.Count > 0) then
    34333655      begin
    … …  
    34363658      end;
    34373659    Responses.Clear;
     3660    pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3661    lblCollTime.Caption := 'Collection Date/Time';
     3662    lblCollType.Caption := 'Collection Type';
     3663    lblQuantity.Caption := 'Quantity';
     3664    lblWanted.Caption := 'Date/Time Wanted';
     3665    lblReason.Caption := 'Reason for Request';
    34383666    if lvSelectionList.Items.Count < 1 then
    34393667      begin
    3440         cboReasons.ItemIndex := -1;
    3441         memDiagComment.Text := '';
    3442         cboSurgery.ItemIndex := -1;
    3443         cboUrgency.ItemIndex := -1;
     3668        uGetTnS := 0;
     3669        lblTNS.Caption := '';
     3670        lblTNS.Visible := false;
     3671        memMessage.Text := '';
     3672        pnlMessage.Visible := false;
     3673        FLastItemID := '';
     3674        InitDialog;
     3675        cboModifiers.ItemIndex := -1;
     3676        cboAvailTest.ItemIndex := -1;
     3677        cboAvailComp.ItemIndex := -1;
    34443678        cboCollType.ItemIndex := -1;
    34453679        cboCollTime.ItemIndex := -1;
    34463680        cboQuick.ItemIndex := -1;
    3447         calCollTime.Text := '';
     3681        calWantTime.Text := '';
     3682        GroupBox1.Visible := true;
     3683        tQuantity.Text := '';
     3684        FLastCollType := '';
     3685        FLastCollTime := '';
     3686        FLastLabCollTime := '';
     3687        txtImmedColl.Text := '';
     3688        calCollTime.text := '';
     3689        lblNoBloodReq.Visible := false;
    34483690      end;
    34493691    for i := 0 to uSelectedItems.Count - 1 do
    … …  
    34543696          begin
    34553697            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     3698            lblCollTime.Caption := 'Collection Date/Time*';
     3699            lblCollType.Caption := 'Collection Type*';
    34563700            aSelTst := true;
    34573701          end
    … …  
    34653709            cboAvailComp.ItemIndex := -1;
    34663710            tQuantity.Text := '';
     3711            lblQuantity.Caption := 'Quantity*';
     3712            lblWanted.Caption := 'Date/Time Wanted*';
     3713            lblReason.Caption := 'Reason for Request*';
     3714            //aSelComp := true;
    34673715          end;
    34683716        Inc(CurAdd);
    … …  
    34743722        calCollTime.Text := '';
    34753723      end;
     3724    {if aSelcomp = false then
     3725      lblNoBloodReq.Visible := false
     3726    else
     3727      lblNoBloodReq.Visible := true;  }
    34763728    if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    34773729    if cboCollType.ItemID = 'LC' then
    … …  
    35693821  memMessage.Text := '';
    35703822  pnlMessage.Visible := false;
     3823  FLastItemID := '';
    35713824  InitDialog;
    35723825  cboModifiers.ItemIndex := -1;
    … …  
    35833836  GroupBox1.Visible := true;
    35843837  tQuantity.Text := '';
     3838  tQuantity.Enabled := false;
     3839  lblQuantity.Enabled := false;
    35853840  FLastCollType := '';
    35863841  FLastCollTime := '';
    35873842  FLastLabCollTime := '';
    35883843  txtImmedColl.Text := '';
     3844  calCollTime.text := '';
     3845  lblNoBloodReq.Visible := false;
     3846  pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3847  lblCollTime.Caption := 'Collection Date/Time';
     3848  lblCollType.Caption := 'Collection Type';
     3849  lblQuantity.Caption := 'Quantity';
     3850  lblWanted.Caption := 'Date/Time Wanted';
     3851  lblReason.Caption := 'Reason for Request';
    35893852end;
    35903853
    … …  
    36223885
    36233886procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
    3624 begin
    3625   inherited;
     3887var
     3888  i: integer;
     3889  aList: TStringList;
     3890  aSpecimen, aSpecimenUID, aSpecimenReq: string;
     3891  aChanging: Boolean;
     3892begin
     3893  inherited;
     3894  aList := TStringList.Create;
     3895  aChanging := changing;
     3896  try
     3897  aSpecimen := '';
     3898  aSpecimenUID := '';
     3899  aSpecimenReq := '';
    36263900  if uSelectedItems.Count > 0 then
    36273901    begin
    3628       with calWantTime do if not Changing then
     3902      with calWantTime do if not changing then
    36293903        begin
    36303904          if FMDateTime = 0 then
    36313905            begin
    36323906              ShowMsg('Invalid Date/Time entered');
    3633               Changing := true;
     3907              changing := true;
    36343908              calWantTime.Text := '';
    3635               Changing := false;
     3909              changing := aChanging;
    36363910              Exit;
    36373911            end
    … …  
    36423916                begin
    36433917                  ShowMsg('Date/Time Wanted must be a future Date/Time');
    3644                   Changing := true;
     3918                  changing := true;
    36453919                  calWantTime.Text := '';
    3646                   Changing := false;
     3920                  changing := aChanging;
    36473921                  Exit;
    36483922                end;
    … …  
    36513925      if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    36523926      memOrder.Text := Responses.OrderText;
     3927      aList.Clear;
     3928      ExtractSpecimen(aList, uVBECList);
     3929      if aList.Count > 0 then
     3930      begin
     3931        aSpecimen := piece(aList[0], '^', 1);
     3932        aSpecimenUID := piece(aList[0], '^', 2);
     3933      end;
     3934      aList.Clear;
     3935      ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     3936      for i := 0 to aList.Count - 1 do
     3937        begin
     3938          if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     3939            begin
     3940              aSpecimenReq := piece(aList[i],'^',2);
     3941              if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
     3942                aSpecimenUID := '';
     3943              break;
     3944            end;
     3945        end;
     3946      Responses.Update('SPECSTS', 1, aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID, aSpecimenReq);
     3947    end;
     3948  finally
     3949    aList.Free;
     3950  end;
     3951end;
     3952
     3953procedure TfrmODBBank.calWantTimeEnter(Sender: TObject);
     3954var
     3955  j: integer;
     3956begin
     3957  inherited;
     3958  if Length(cboAvailComp.Text) > 0 then Exit;
     3959  for j := uSelectedItems.Count - 1 downto 0 do
     3960    begin
     3961      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     3962        begin
     3963          lvSelectionList.Items[j].Selected := true;
     3964          lvSelectionListClick(self);
     3965          Break;
     3966        end;
    36533967    end;
    36543968end;
    … …  
    36793993      else
    36803994        begin
    3681           lblSurgery.Enabled := false;
    3682           cboSurgery.Enabled := false;
    3683           lblSurgery.Caption := 'Surgery';
    3684           cboSurgery.ItemIndex := -1;
    3685           Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3995          if Length(cboSurgery.Text) > 0 then
     3996            begin
     3997              lblSurgery.Enabled := true;
     3998              cboSurgery.Enabled := true;
     3999              lblSurgery.Caption := 'Surgery*';
     4000            end
     4001            else
     4002            begin
     4003              lblSurgery.Enabled := false;
     4004              cboSurgery.Enabled := false;
     4005              lblSurgery.Caption := 'Surgery';
     4006              cboSurgery.ItemIndex := -1;
     4007              Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     4008            end;
    36864009        end;
    36874010    end
    … …  
    37004023procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
    37014024var
    3702   aList: TStringList;
     4025  aList, bList, cList: TStringList;
    37034026  i,j,aMSBOS,aMSBOSContinue: integer;
    3704   x: string;
    3705   handled: boolean;
    3706 begin
    3707   inherited;
     4027  x,aTypeScreen: string;
     4028  handled,aGotTNS: boolean;
     4029  xLabTest: TLabTest;
     4030begin
     4031  inherited;
     4032  cboSurgery.Text := StringReplace(cboSurgery.Text,CRLF,'  ',[rfReplaceAll]);
    37084033  aList := TStringList.Create;
     4034  bList := TStringList.Create;
     4035  cList := TStringList.Create;
    37094036  handled := false;
     4037  //uGetTNS := 0;
     4038  //aGotTNS := false;
     4039  ExtractTypeScreen(aList, uVBECList);
     4040  if aList.Count > 0 then aTypeScreen := aList[0];
     4041  aList.Clear;
     4042  bList.Clear;
     4043  cList.Clear;
    37104044  try
    3711     if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     4045    cboSurgery.DroppedDown := false;
     4046    if (Length(cboSurgery.ItemID) > 0) then
     4047      begin
     4048        for j := 0 to uSelectedItems.Count - 1 do
     4049          begin
     4050            xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     4051            if (piece(uSelectedItems[j],'^',1) = '0') and (not(piece(uSelectedItems[j],'^',3)='')) and (StrToInt(piece(uSelectedItems[j],'^',3)) > 0) and (piece(cboSurgery.Items[cboSurgery.ItemIndex],'^',3) = '1') then
     4052              begin
     4053                cList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3));
     4054              end;
     4055            xLabTest.Free;
     4056          end;
     4057      end;
     4058    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) and (Length(cboAvailComp.Text) > 0) then
    37124059      begin
    37134060        aList.Clear;
    … …  
    37164063          begin
    37174064            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    3718              and (piece(aList[i],'^',3) = cboSurgery.Text) then
     4065             and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
    37194066              begin
    37204067                aMSBOS := StrToInt(piece(aList[i],'^',4));
    37214068                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
    37224069                  begin
    3723                     with Application do
    3724                     begin
    3725                       NormalizeTopMosts;
    3726                       aMSBOSContinue :=
    3727                         MessageBox(PChar('The number of unit Quantity selected (' + tQuantity.Text +
    3728                                    ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
    3729                                    + IntToStr(aMSBOS) +
    3730                                    ') for the ' + cboSurgery.text +
    3731                                    ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'),
    3732                                    PChar('Maximum Number of Units Exceeded'),
    3733                                    MB_YESNO);
    3734                       RestoreTopMosts;
    3735                     end;
    3736                     if aMSBOSContinue = 7 then
    3737                       begin
    3738                         ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
    3739                         tQuantity.Text := '0';
    3740                         tQuantity.SelLength := 2;
    3741                         tQuantity.SelectAll;
    3742                         break;
    3743                       end;
     4070                    bList.Add(aLabTest.TestName + '^' + tQuantity.Text + '^' + IntToStr(aMSBOS));
    37444071                  end;
    37454072                handled := true;
    … …  
    37544081        for j := 0 to uSelectedItems.Count - 1 do
    37554082          begin
    3756             ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     4083            xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
    37574084            for i := 0 to aList.Count - 1 do
    37584085              begin
    37594086                if (piece(uSelectedItems[j],'^',1) = '0')
    3760                  and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    3761                  and (piece(aList[i],'^',3) = cboSurgery.Text) then
     4087                 and (StrToInt(piece(aList[i],'^',1)) = xLabTest.ItemID)
     4088                 and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
    37624089                  begin
    37634090                    aMSBOS := StrToInt(piece(aList[i],'^',4));
    37644091                    if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
    37654092                      begin
    3766                         with Application do
    3767                         begin
    3768                           NormalizeTopMosts;
    3769                           aMSBOSContinue :=
    3770                             MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) +
    3771                                ') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units ('
    3772                                + IntToStr(aMSBOS) +
    3773                                ') for the ' + cboSurgery.text +
    3774                                ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'),
    3775                                PChar('Maximum Number of Units Exceeded'),
    3776                                MB_YESNO);
    3777                           RestoreTopMosts;
    3778                         end;
    3779                         if aMSBOSContinue = 7 then
    3780                           begin
    3781                             ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption);
    3782                             tQuantity.Text := '0';
    3783                             tQuantity.SelLength := 2;
    3784                             tQuantity.SelectAll;
    3785                             x := uSelectedItems[j];
    3786                             SetPiece(x,U,3,'');
    3787                             uSelectedItems[j] := x;
    3788                             lvSelectionList.Items[j].SubItems[0] := '';
    3789                             RePaint;
    3790                             break;
    3791                           end;
     4093                        bList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3) + '^' + IntToStr(aMSBOS));
    37924094                      end;
    37934095                    break;
    37944096                  end;
    37954097              end;
     4098            xLabTest.Free;
     4099          end;
     4100      end;
     4101    if (uChangingMSBOS = false) and (cList.Count > 0) then
     4102      begin
     4103        lblNoBloodReq.Visible := true;
     4104        with Application do
     4105          begin
     4106            NormalizeTopMosts;
     4107            aMSBOSContinue :=
     4108              MessageBox(PChar('No blood is required for the surgical procedure: ' + cboSurgery.text +
     4109               '.' + CRLF +
     4110               'If you still need to order any components, please enter a justification in the Comment box.'
     4111                + CRLF + CRLF + 'Do you want me to remove ALL the component orders you''ve just entered? '),
     4112               PChar('No Blood Required'),MB_YESNO);
     4113            RestoreTopMosts;
     4114          end;
     4115        if aMSBOSContinue = 6 then
     4116          begin
     4117            tQuantity.Text := '';
     4118            bList.Clear;
     4119            for j := uSelectedItems.Count - 1 downto 0 do
     4120              begin
     4121                if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     4122                  begin
     4123                    lvSelectionList.Items[j].Delete;
     4124                    uSelectedItems.Delete(j);
     4125                    Responses.Update('ORDERABLE', (j+1) ,'', '');
     4126                    Responses.Update('MODIFIER', (j+1), '', '');
     4127                    Responses.Update('QTY', (j+1), '', '');
     4128                  end;
     4129              end;
     4130            cboAvailComp.Text := '';
     4131            cboAvailComp.ItemIndex := -1;
     4132            cboModifiers.Text := '';
     4133            cboModifiers.ItemIndex := -1;
     4134            lblNoBloodReq.Visible := false;
     4135            //if fODBBank. Active then cboAvailTest.SetFocus;
     4136            lblTNS.Caption := '';
     4137            lblTNS.Visible := false;
     4138            uGetTNS := 0;
     4139            aGotTNS := false;
     4140            DisableComponentControls;
     4141            for i := lvSelectionList.Items.Count - 1 downto 0 do
     4142              begin
     4143                if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     4144                  begin
     4145                    aGotTNS := true;
     4146                    break;
     4147                  end;
     4148              end;
     4149            for i := uSelectedItems.Count - 1 downto 0 do
     4150              begin
     4151                if (aGotTNS = false) and not(piece(uSelectedItems[i],'^',1) = '1') and (uTNSOrders.Count < 1) and (piece(uSelectedItems[i],'^',5) = '1') then //CQ 17349
     4152                  begin
     4153                    uGetTnS := 1;
     4154                    lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     4155                    lblTNS.Visible := true;
     4156                    memMessage.Text := 'TYPE + SCREEN must be added to order';
     4157                    pnlMessage.Visible := true;
     4158                    pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     4159                    break;
     4160                  end
     4161                  else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     4162              end;
     4163          end;
     4164      end
     4165      else
     4166        begin
     4167          lblNoBloodReq.Visible := false;
     4168        end;
     4169
     4170    if (uChangingMSBOS = false) and (bList.Count > 0) then
     4171      begin
     4172        x := '';
     4173        for i := 0 to bList.Count - 1 do
     4174          begin
     4175            x := x + CRLF + piece(bList[i],'^',1) + ' (' + piece(bList[i],'^',2) + ') Max allowed: ' + piece(bList[i],'^',3);
     4176          end;
     4177        with Application do
     4178          begin
     4179            NormalizeTopMosts;
     4180            aMSBOSContinue :=
     4181              MessageBox(PChar('The number of units ordered' + x + CRLF +
     4182               'Exceeds the maximum number recommended for '
     4183               + cboSurgery.text + CRLF + CRLF +
     4184               'If you need to order more than the recommended maximum units, please enter a justification in the Comment box.')
     4185               ,PChar('Maximum Number of Units Exceeded'),
     4186               MB_OK);
     4187            RestoreTopMosts;
    37964188          end;
    37974189      end;
    … …  
    38064198        Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
    38074199      end;
    3808     memOrder.Text := Responses.OrderText; 
     4200    memOrder.Text := Responses.OrderText;
    38094201    finally
    38104202      aList.Free;
     4203      bList.Free;
     4204      cList.Free;
    38114205    end;
    38124206end;
    … …  
    38444238    end;
    38454239  try
    3846     if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
    3847       begin
     4240    if not(aLabTest = nil) and (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     4241      begin
     4242        uChangingMSBOS := true;
     4243        cboSurgeryChange(self);
     4244        uChangingMSBOS := false;
    38484245        aList.Clear;
    38494246        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgery
    … …  
    38514248          begin
    38524249            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    3853              and (piece(aList[i],'^',3) = cboSurgery.Text) then
     4250             and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) and (Length(tQuantity.Text) > 0) then
    38544251              begin
    38554252                aMSBOS := StrToInt(piece(aList[i],'^',4));
    … …  
    38614258                      aMSBOSContinue :=
    38624259                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
    3863                                    ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
    3864                                    + IntToStr(aMSBOS) +
    3865                                    ') for the ' + cboSurgery.text +
    3866                                    ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
    3867                                    PChar('Maximum Number of Units Exceeded'),
    3868                                    MB_YESNO);
     4260                         ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
     4261                         + IntToStr(aMSBOS) +
     4262                         ') for the ' + cboSurgery.text +
     4263                         ' surgical procedure.' + CRLF +
     4264                         'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
     4265                          + CRLF + CRLF + 'Edit the Blood component Quantity?'),
     4266                         PChar('Maximum Number of Units Exceeded'),
     4267                         MB_YESNO);
     4268
    38694269                      RestoreTopMosts;
    38704270                    end;
    3871                     if aMSBOSContinue = 7 then
     4271                    if aMSBOSContinue = 6 then
    38724272                      begin
    38734273                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
    … …  
    39274327
    39284328procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
     4329var
     4330  j: integer;
    39294331begin
    39304332  inherited;
    39314333  tQuantity.SelLength := 2;
    39324334  tQuantity.SelectAll;
     4335  if Length(cboAvailComp.Text) > 0 then Exit;
     4336  for j := uSelectedItems.Count - 1 downto 0 do
     4337    begin
     4338      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '0') then
     4339        begin
     4340          lvSelectionList.Items[j].Selected := true;
     4341          lvSelectionListClick(self);
     4342          Break;
     4343        end;
     4344    end;
     4345end;
     4346
     4347procedure TfrmODBBank.txtImmedCollEnter(Sender: TObject);
     4348var
     4349  j: integer;
     4350begin
     4351  inherited;
     4352  if Length(cboAvailTest.Text) > 0 then Exit;
     4353  for j := uSelectedItems.Count - 1 downto 0 do
     4354    begin
     4355      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
     4356        begin
     4357          lvSelectionList.Items[j].Selected := true;
     4358          lvSelectionListClick(self);
     4359          Break;
     4360        end;
     4361    end;
    39334362end;
    39344363
    … …  
    39704399end;
    39714400
     4401procedure TfrmODBBank.calCollTimeEnter(Sender: TObject);
     4402var
     4403  j: integer;
     4404begin
     4405  inherited;
     4406  if Length(cboAvailTest.Text) > 0 then Exit;
     4407  for j := uSelectedItems.Count - 1 downto 0 do
     4408    begin
     4409      if not(lvSelectionList.Items[j] = nil) and (piece(uSelectedItems[j],'^',1) = '1') then
     4410        begin
     4411          lvSelectionList.Items[j].Selected := true;
     4412          lvSelectionListClick(self);
     4413          Break;
     4414        end;
     4415    end;
     4416end;
     4417
    39724418end.

  • cprs/trunk/CPRS-Chart/Orders/fODBase.dfm

    r829 r1679  
    2525    Width = 430
    2626    Height = 48
    27     TabStop = False
    2827    Color = clCream
    2928    Ctl3D = True
    … …  
    3231    ScrollBars = ssVertical
    3332    TabOrder = 0
    34     Caption = 'Order'
    3533  end
    3634  object cmdAccept: TButton [1]

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

    r829 r1679  
    4444  private
    4545    FDialog: string;
     46    FDialogDisplayName: string;
    4647    FResponseList: TList;
    4748    FPrompts: TList;
    … …  
    99100      const AnIValue, AnEValue: string);
    100101    property Dialog: string            read FDialog         write SetDialog;
     102    property DialogDisplayName: string read FDialogDisplayName write FDialogDisplayName;
    101103    property DisplayGroup: Integer     read FDisplayGroup   write FDisplayGroup;
    102104    property CopyOrder:    string      read FCopyOrder      write SetCopyOrder;
    … …  
    645647  if CopyOrder <> '' then DupORIFN := CopyOrder;
    646648  //if {(CopyOrder <> '') or} (EditOrder <> '') then Exit;  // only check new orders
    647   with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
    648     if (PromptID = 'ORDERABLE') or (PromptID = 'ADDITIVE') then
    649     begin
    650       OrderableIEN := IValue;
    651       TheInstance := Instance;
    652       PkgPart := '';
    653       if AFillerID = 'LR' then PkgPart := '^LR^' + IValueFor('SPECIMEN', TheInstance);
    654       if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH')
    655         then PkgPart := U + AFillerID + U + IValueFor('DRUG', TheInstance);
    656         // was -- then PkgPart := '^PS^' + IValueFor('DRUG', TheInstance);
    657       if AFillerID = 'PSIV' then
     649  with FResponseList do
     650    for i := 0 to FResponseList.Count - 1 do
    658651      begin
    659         if PromptID = 'ORDERABLE' then PkgPart := '^PSIV^B;' + IValueFor('VOLUME', TheInstance);
    660         if PromptID = 'ADDITIVE'  then PkgPart := '^PSIV^A';
     652        with TResponse(Items[i]) do
     653          begin
     654            if (PromptID = 'ORDERABLE') or (PromptID = 'ADDITIVE') then
     655              begin
     656                OrderableIEN := IValue;
     657                TheInstance := Instance;
     658                PkgPart := '';
     659                if AFillerID = 'LR' then PkgPart := '^LR^' + IValueFor('SPECIMEN', TheInstance);
     660                if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH') or (AFillerID = 'PSNV')
     661                  then PkgPart := U + AFillerID + U + IValueFor('DRUG', TheInstance);
     662                // was -- then PkgPart := '^PS^' + IValueFor('DRUG', TheInstance);
     663                if AFillerID = 'PSIV' then
     664                  begin
     665                    if PromptID = 'ORDERABLE' then PkgPart := '^PSIV^B;' + IValueFor('VOLUME', TheInstance);
     666                    if PromptID = 'ADDITIVE'  then PkgPart := '^PSIV^A';
     667                  end;
     668                AList.Add(OrderableIEN + PkgPart);
     669              end;
     670            //AGP IV CHANGES
     671            if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH') or (AFillerID = 'PSIV') or (AFillerID = 'PSNV') then
     672              begin
     673                IF PromptID = 'COMMENT' then continue;
     674                Alist.Add(AFillerID + U + PromptID + U + InttoStr(Instance) + U + IValueFor(PromptID, Instance) + U + EValueFor(PromptID, Instance));
     675              end;
    661676      end;
    662       AList.Add(OrderableIEN + PkgPart);
    663     end;
     677  end;
    664678  AStartDtTm := IValueFor('START', 1);
    665679end;
    … …  
    11381152    ExpandOrderObjects(tmp, HasObjects);
    11391153    FOrderContainsObjects := FOrderContainsObjects or HasObjects;
     1154   
     1155    if frmODBase.FAbortOrder then
     1156    begin
     1157      SetTemplateDialogCanceled(FALSE);
     1158      Exit;
     1159    end;
     1160
    11401161    if IEN <> 0 then
    11411162      begin
    … …  
    11551176      CheckBoilerplate4Fields(tmp, cptn);
    11561177    List.Text := tmp;
     1178    if WasTemplateDialogCanceled then frmODBase.FAbortOrder := True;
     1179
    11571180  end;
    11581181
    … …  
    13011324{Caller needs to set pnlMessage.TabOrder}
    13021325begin
     1326  //TDP - Added pnlMessage.Caption for screen reader readability
     1327  pnlMessage.Caption := 'Informational Message.';
    13031328  memMessage.Lines.SetText(PChar(AMessage));
    13041329  //begin CQ: 2640
    … …  
    13231348  FOrderAction := OrderAction;
    13241349  FAbortOrder := False;
     1350  SetTemplateDialogCanceled(False);   //wat/jh CQ 20061
    13251351  case OrderAction of
    13261352  ORDER_NEW:   {nothing};
    … …  
    14681494    StatusText('Order Checking...');
    14691495    Responses.BuildOCItems(OIList, StartDtTm, FillerID);
    1470     OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN);
     1496    OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN,'0');
    14711497    DupORIFN := '';
    14721498    StatusText('');
    … …  
    14901516begin
    14911517  Result := True;
     1518  IsDelayOrder := False;
    14921519  Validate(ErrMsg);
    1493   IsDelayOrder := False;
    14941520  if Length(ErrMsg) > 0 then
    14951521  begin
    … …  
    15001526  if not AcceptOrderChecks then
    15011527  begin
     1528    //added code to shut CPRS down without access violations if the fOCAccept is open when timing out.
     1529    if frmFrame.TimedOut then
     1530      begin
     1531         Result := False;
     1532         Exit;
     1533      end;
    15021534    if AskAnotherOrder(DialogIEN) then
    15031535        InitDialog           // ClearDialogControls is in InitDialog
    … …  
    15411573        else CanSign := CH_SIGN_NA;
    15421574      if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
    1543       if NewOrder.EventPtr <> '' then IsDelayOrder := True;
    1544       Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder);
     1575      if (NewOrder.EventPtr <> '') and (GetEventDefaultDlg(responses.FEventIFN) <> InttoStr(Responses.QuickOrder)) then
     1576          IsDelayOrder := True;
     1577      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False, IsDelayOrder);
    15451578
    15461579    UBAGlobals.TargetOrderID := NewOrder.ID;
    … …  
    17111744  //self.Responses.Cancel := False;
    17121745  if User.NoOrdering then Exit;
    1713   if FAbortOrder then exit;
     1746  if FAbortOrder then
     1747  begin
     1748    SetTemplateDialogCanceled(FALSE);
     1749    exit;
     1750  end;
    17141751  if FOrderAction in [ORDER_EDIT, ORDER_COPY] then Exit;  // don't invoke verify dialog
    17151752  if FOrderAction = ORDER_QUICK then Exit;                // should this be here??

  • cprs/trunk/CPRS-Chart/Orders/fODDiet.dfm

    r829 r1679  
    2222    object pgeDiet: TTabSheet
    2323      Caption = 'Diet'
     24      ExplicitLeft = 0
     25      ExplicitTop = 0
     26      ExplicitWidth = 0
     27      ExplicitHeight = 0
    2428      object lblDietAvail: TLabel
    2529        Left = 4
    … …  
    435439    object pgeTubefeeding: TTabSheet
    436440      Caption = 'Tubefeeding'
     441      ExplicitLeft = 0
     442      ExplicitTop = 0
     443      ExplicitWidth = 0
     444      ExplicitHeight = 0
    437445      object lblTFProductList: TLabel
    438446        Left = 4
    … …  
    584592        Style = csDropDownList
    585593        Ctl3D = False
    586         ItemHeight = 13
     594        ItemHeight = 0
    587595        ParentCtl3D = False
    588596        TabOrder = 2
    … …  
    640648    object pgeEarlyLate: TTabSheet
    641649      Caption = 'Early / Late Tray'
     650      ExplicitLeft = 0
     651      ExplicitTop = 0
     652      ExplicitWidth = 0
     653      ExplicitHeight = 0
    642654      object lblELStart: TLabel
    643655        Left = 287
    … …  
    872884    object pgeIsolations: TTabSheet
    873885      Caption = 'Isolations / Precautions'
     886      ExplicitLeft = 0
     887      ExplicitTop = 0
     888      ExplicitWidth = 0
     889      ExplicitHeight = 0
    874890      object lblIsolation: TLabel
    875891        Left = 4
    … …  
    932948    object pgeAdditional: TTabSheet
    933949      Caption = 'Additional Order'
     950      ExplicitLeft = 0
     951      ExplicitTop = 0
     952      ExplicitWidth = 0
     953      ExplicitHeight = 0
    934954      object lblAddlOrder: TLabel
    935955        Left = 4

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

    r829 r1679  
    235235  TX_TFAMT  = 'The quantity is invalid for ';
    236236  TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
    237   TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
    238               '  Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF +
    239               '  Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
    240               '  May also input 100CC/HR X 16 for 16 hours.  Valid quantity for powder form' + CRLF +
    241               '  product can be "# GRAMS" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U and the' + CRLF +
    242               '  frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID).';
     237
     238  // CQ #15833 - Removed references of 'c' and 'cc', changed 100CC example to 100ML - JCS
     239  TX_HLPQTY = CRLF + 'Valid entries for quantity:' + CRLF + CRLF +
     240              'Units             K for Kcals;  M for ml;  O for oz.;  U for units (e.g. cans), PKG' + CRLF +
     241              'Frequency     DAILY  HOUR  QH  BID  TID  QID  Q2H  Q3H  Q4H  Q6H' + CRLF + CRLF +
     242              'Or   100 ml/HR X 16  for 16 hours' + CRLF + CRLF +
     243              'IF powder form product, Then' + CRLF +
     244              '          (# GRAMS or # Unit or PKG) / FREQUENCY' + CRLF + CRLF +
     245              'Examples:' + CRLF +
     246              '          20 GRAMS/Day' + CRLF +
     247              '          1 PKG/TID' + CRLF +
     248              '          6 U/D' + CRLF +
     249              '          1 U/Q3H' + CRLF +
     250              '          50ml/TID' + CRLF +
     251              '          100 ML/HR';
    243252  TX_ELMEAL      = 'A meal must be selected.';
    244253  TX_ELTIME      = 'A meal time must be selected.';

  • cprs/trunk/CPRS-Chart/Orders/fODGen.dfm

    r829 r1679  
    22  Left = 223
    33  Top = 290
     4  Height = 295
    45  Caption = 'frmODGen'
    5   ExplicitLeft = 223
    6   ExplicitTop = 290
     6  ExplicitHeight = 295
    77  PixelsPerInch = 96
    88  TextHeight = 13
    9   object sbxMain: TScrollBox [0]
     9  object lblOrderSig: TLabel [0]
     10    Left = 8
     11    Top = 193
     12    Width = 44
     13    Height = 13
     14    Caption = 'Order Sig'
     15  end
     16  inherited memOrder: TCaptionMemo
     17    Top = 209
     18    ExplicitTop = 209
     19  end
     20  object sbxMain: TScrollBox [2]
    1021    Left = 0
    1122    Top = 0
    … …  
    1526    TabOrder = 4
    1627  end
     28  inherited cmdAccept: TButton
     29    Top = 209
     30    ExplicitTop = 209
     31  end
    1732  inherited cmdQuit: TButton
    18     Top = 219
    19     ExplicitTop = 219
     33    Top = 234
     34    ExplicitTop = 234
     35  end
     36  inherited pnlMessage: TPanel
     37    Top = 191
     38    ExplicitTop = 191
    2039  end
    2140  inherited amgrMain: TVA508AccessibilityManager
    … …  
    2645      (
    2746        'Component = memOrder'
    28         'Status = stsDefault')
     47        'Label = lblOrderSig'
     48        'Status = stsOK')
    2949      (
    3050        'Component = cmdAccept'
    … …  
    4363        'Status = stsDefault'))
    4464  end
     65  object VA508CompMemOrder: TVA508ComponentAccessibility
     66    Component = memOrder
     67    OnStateQuery = VA508CompMemOrderStateQuery
     68    Left = 96
     69    Top = 232
     70  end
    4571end

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

    r829 r1679  
    2222  TfrmODGen = class(TfrmODBase)
    2323    sbxMain: TScrollBox;
     24    lblOrderSig: TLabel;
     25    VA508CompMemOrder: TVA508ComponentAccessibility;
    2426    procedure FormCreate(Sender: TObject);
    2527    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2628    procedure cmdAcceptClick(Sender: TObject);
     29    procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
    2730  private
    2831    FilterOut: boolean;
    … …  
    3538      Direction, InsertAt: Integer);
    3639    procedure PlaceControls;
    37     procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    38     procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     40    procedure PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
     41    procedure PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    3942    procedure PlaceHidden(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    40     procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    41     procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    42     procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    43     procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    44     procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     43    procedure PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
     44    procedure PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
     45    procedure PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
     46    procedure PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
     47    procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    4548    procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    4649    procedure TrimAllMemos;
     50    function SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
    4751  protected
    4852    FFormCloseCalled : Boolean;
    … …  
    8488  IDs,TSstr, AttendStr: string;
    8589begin
    86   FFormCloseCalled := false;
     90  FFormCloseCalled := false;   
    8791  inherited;
    8892  FilterOut := True;
    … …  
    243247end;
    244248
     249procedure TfrmODGen.VA508CompMemOrderStateQuery(Sender: TObject;
     250  var Text: string);
     251begin
     252  inherited;
     253  Text := memOrder.Text;
     254end;
     255
    245256procedure TfrmODGen.Validate(var AnErrMsg: string);
    246257var
    … …  
    328339    DialogCtrl.Preserve := Length(DialogItem.EDefault) > 0;
    329340    case DialogItem.DataType of
    330     'D': PlaceDateTime(DialogCtrl, DialogItem);
    331     'F': PlaceFreeText(DialogCtrl, DialogItem);
     341    'D': PlaceDateTime(DialogCtrl, DialogItem, I);
     342    'F': PlaceFreeText(DialogCtrl, DialogItem, i);
    332343    'H': PlaceHidden(DialogCtrl, DialogItem);
    333     'N': PlaceNumeric(DialogCtrl, DialogItem);
    334     'P': PlaceLookup(DialogCtrl, DialogItem);
    335     'R': PlaceDateTime(DialogCtrl, DialogItem);
    336     'S': PlaceSetOfCodes(DialogCtrl, DialogItem);
    337     'W': PlaceMemo(DialogCtrl, DialogItem);
    338     'Y': PlaceYesNo(DialogCtrl, DialogItem);
     344    'N': PlaceNumeric(DialogCtrl, DialogItem, i);
     345    'P': PlaceLookup(DialogCtrl, DialogItem, i);
     346    'R': PlaceDateTime(DialogCtrl, DialogItem, i);
     347    'S': PlaceSetOfCodes(DialogCtrl, DialogItem, i);
     348    'W': PlaceMemo(DialogCtrl, DialogItem, i);
     349    'Y': PlaceYesNo(DialogCtrl, DialogItem, i);
    339350    end;
    340351    FDialogCtrlList.Add(DialogCtrl);
    … …  
    343354end;
    344355
    345 procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     356procedure TfrmODGen.PlaceDateTime(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    346357const
    347358  NUM_CHAR = 22;
    … …  
    354365    TORDateBox(Editor).DateOnly := Pos('T', DialogItem.Domain) = 0;
    355366    with TORDateBox(Editor) do RequireTime := (not DateOnly) and (Pos('R', DialogItem.Domain) > 0); //v26.48 - RV  PSI-05-002
     367    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     368  //  TORDateBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    356369    TORDateBox(Editor).Text := DialogItem.EDefault;
    357370    TORDateBox(Editor).Hint := DialogItem.HelpText;
    … …  
    364377end;
    365378
    366 procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     379procedure TfrmODGen.PlaceFreeText(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    367380begin
    368381  with DialogCtrl do
    … …  
    374387                     HT_FRAME * FCharHt);
    375388    TEdit(Editor).MaxLength := StrToIntDef(Piece(DialogItem.Domain, ':', 2), 0);
     389    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     390  //  TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    376391    TEdit(Editor).Text := DialogItem.EDefault;
    377392    TEdit(Editor).Hint := DialogItem.HelpText;
    … …  
    384399end;
    385400
    386 procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     401procedure TfrmODGen.PlaceNumeric(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    387402const
    388403  NUM_CHAR = 16;
    … …  
    394409    Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
    395410    TEdit(Editor).MaxLength := NUM_CHAR;
     411    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     412   // TCaptionEdit(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    396413    TEdit(Editor).Text := DialogItem.EDefault;
    397414    TEdit(Editor).Hint := DialogItem.HelpText + '|' + DialogItem.Domain;
    … …  
    404421end;
    405422
    406 procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     423procedure TfrmODGen.PlaceSetOfCodes(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    407424const
    408425  NUM_CHAR = 32;
    … …  
    417434    TORComboBox(Editor).ListItemsOnly := True;
    418435    TORComboBox(Editor).Pieces := '2';
     436    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     437  //  TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    419438    Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
    420439    x := DialogItem.Domain;
    … …  
    427446    TORComboBox(Editor).SelectByID(DialogItem.IDefault);
    428447    //TORComboBox(Editor).Text := DialogItem.EDefault;
    429     TORComboBox(Editor).Hint := DialogItem.HelpText;
     448    TORComboBox(Editor).RpcCall := DialogItem.HelpText;
    430449    if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
    431450    TORComboBox(Editor).OnChange := ControlChange;
    … …  
    435454end;
    436455
    437 procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     456procedure TfrmODGen.PlaceYesNo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    438457const
    439458  NUM_CHAR = 9;
    … …  
    446465    TORComboBox(Editor).ListItemsOnly := True;
    447466    TORComboBox(Editor).Pieces := '2';
     467    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     468    //TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    448469    Editor.SetBounds(FEditorLeft, FEditorTop, NUM_CHAR * FCharWd, HT_FRAME * FCharHt);
    449470    TORComboBox(Editor).Items.Add('0^No');
    … …  
    451472    TORComboBox(Editor).SelectByID(DialogItem.IDefault);
    452473    //TORComboBox(Editor).Text := DialogItem.EDefault;
    453     TORComboBox(Editor).Hint := DialogItem.HelpText;
     474    TORComboBox(Editor).RpcCall := DialogItem.HelpText;
    454475    if Length(DialogItem.HelpText) > 0 then TORComboBox(Editor).ShowHint := True;
    455476    TORComboBox(Editor).OnChange := ControlChange;
    … …  
    459480end;
    460481
    461 procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     482procedure TfrmODGen.PlaceLookup(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    462483const
    463484  NUM_CHAR = 32;
    … …  
    482503    TORComboBox(Editor).Pieces := '2';
    483504    TORComboBox(Editor).LongList := True;
     505     SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     506   // TORComboBox(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    484507    // 2nd bar piece of hint is not visible, hide xref, global ref, & screen code in tab pieces
    485     TORComboBox(Editor).Hint := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
     508    TORComboBox(Editor).RpcCall := DialogItem.HelpText + '|' + XRef + #9 + GblRef + #9 +
    486509                                DialogItem.ScreenRef;
    487510    if ( compareText(TsID,DialogItem.Id)=0 ) or (compareText(TSDomain,DialogItem.Domain)=0)then
    … …  
    538561begin
    539562  inherited;
    540   XRef := Piece(TORComboBox(Sender).Hint, '|', 2);
     563  XRef := Piece(TORComboBox(Sender).RpcCall, '|', 2);
    541564  GblRef    := Piece(XRef, #9, 2);
    542565  ScreenRef := Piece(XRef, #9, 3);
    … …  
    545568end;
    546569
    547 procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     570procedure TfrmODGen.PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem; CurrentItemNumber: Integer);
    548571const
    549572  NUM_LINES = 3;
    … …  
    556579                     sbxMain.Width - FEditorLeft - WD_MARGIN - GetSystemMetrics(SM_CXVSCROLL),
    557580                     (FCharHt * NUM_LINES) + HT_FRAME);
     581    SetComponentName(Editor, CurrentItemNumber, DialogCtrl);
     582   // TCaptionMemo(Editor).Name := DialogCtrl.ID + IntToStr(CurrentItemNumber);
    558583    TMemo(Editor).Text := DialogItem.EDefault;
    559584    TMemo(Editor).Hint := DialogItem.HelpText;
    … …  
    574599
    575600procedure TfrmODGen.PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     601var
     602  ht: integer;
    576603begin
    577604  with DialogCtrl do
    … …  
    580607    Prompt.Parent := sbxMain;
    581608    Prompt.Caption := DialogItem.Prompt;
     609    ht := Prompt.Height;   // CQ#15849
     610    if ht < FCharHt then
     611      ht := FCharHt;
    582612    Prompt.AutoSize := False;
    583     Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, FCharHt);
     613    Prompt.SetBounds(WD_MARGIN, FEditorTop + HT_LBLOFF, FLabelWd, ht);
    584614    Prompt.Alignment := taRightJustify;
    585615    Prompt.Visible := True;
    … …  
    604634begin
    605635  inherited;
     636  TrimAllMemos;
    606637  Application.ProcessMessages;
    607   TrimAllMemos;
    608638end;
    609639
    … …  
    632662end;
    633663
     664function TfrmODGen.SetComponentName(Editor: TWinControl; Index: Integer; DialogCtrl: TDialogCtrl): Boolean;
     665Var
     666 I: Integer;
     667 SaveName: String;
     668begin
     669 //strip all non alphanumeric characters to create the save name
     670 SaveName := '';
     671 //Check for blank id
     672 if DialogCtrl.ID = '' then DialogCtrl.ID := 'EMPTY';
     673
     674 for i := 1 to length(DialogCtrl.ID) do begin
     675   if (DialogCtrl.ID[i] in ['A'..'Z']) or (DialogCtrl.ID[i] in ['a'..'z']) or (DialogCtrl.ID[i] in ['0'..'9']) then
     676    SaveName := SaveName + DialogCtrl.ID[i];
     677 end;
     678 SaveName := SaveName + '_' + IntToStr(Index);
     679
     680 //extra backup - make sure that the component name doesn't already exist
     681 //Now set up the component name
     682 try
     683  Editor.Name := SaveName;
     684 except
     685  Editor.Name := SaveName + '_' + IntToStr(Index);
     686 end;
     687end;
     688
    634689end.
    635690

  • cprs/trunk/CPRS-Chart/Orders/fODLab.dfm

    r829 r1679  
    9999  end
    100100  inherited memOrder: TCaptionMemo
    101     TabOrder = 20
     101    TabOrder = 22
    102102  end
    103103  object txtImmedColl: TCaptionEdit [13]
    … …  
    108108    Color = clBtnFace
    109109    ReadOnly = True
    110     TabOrder = 14
     110    TabOrder = 16
    111111    Text = 'txtImmedColl'
    112112  end
    … …  
    116116    Width = 165
    117117    Height = 21
    118     TabOrder = 13
     118    TabOrder = 15
    119119    OnChange = ControlChange
    120120    DateOnly = False
    … …  
    128128    BevelInner = bvLowered
    129129    BevelOuter = bvNone
    130     TabOrder = 8
     130    TabOrder = 10
    131131    object lblUrineVolume: TOROffsetLabel
    132132      Left = 6
    … …  
    156156    BevelInner = bvLowered
    157157    BevelOuter = bvNone
    158     TabOrder = 7
     158    TabOrder = 9
    159159    object lblAntiCoagulant: TOROffsetLabel
    160160      Left = 6
    … …  
    184184    BevelInner = bvLowered
    185185    BevelOuter = bvNone
    186     TabOrder = 6
     186    TabOrder = 8
    187187    Visible = False
    188188    object lblOrderComment: TOROffsetLabel
    … …  
    212212    Height = 118
    213213    BevelOuter = bvNone
    214     TabOrder = 5
     214    TabOrder = 7
    215215  end
    216216  object pnlDoseDraw: TORAutoPanel [19]
    … …  
    221221    BevelInner = bvLowered
    222222    BevelOuter = bvNone
    223     TabOrder = 10
     223    TabOrder = 12
    224224    object lblDose: TOROffsetLabel
    225225      Left = 10
    … …  
    268268    BevelInner = bvLowered
    269269    BevelOuter = bvNone
    270     TabOrder = 9
     270    TabOrder = 11
    271271    object lblPeakTrough: TOROffsetLabel
    272272      Left = 6
    … …  
    294294    end
    295295  end
    296   inherited cmdAccept: TButton
    297     Left = 443
    298     TabOrder = 18
    299     ExplicitLeft = 443
    300   end
    301   inherited cmdQuit: TButton
    302     TabOrder = 19
    303   end
    304   inherited pnlMessage: TPanel
    305     Left = 18
    306     Top = 192
    307     Height = 56
    308     TabOrder = 21
    309     ExplicitLeft = 18
    310     ExplicitTop = 192
    311     ExplicitHeight = 56
    312     inherited imgMessage: TImage
    313       Top = 11
    314       ExplicitTop = 11
    315     end
    316     inherited memMessage: TRichEdit
    317       Left = 41
    318       Top = 5
    319       Height = 43
    320       PopupMenu = MessagePopup
    321       ExplicitLeft = 41
    322       ExplicitTop = 5
    323       ExplicitHeight = 43
    324     end
    325   end
    326   object pnlCollTimeButton: TKeyClickPanel [24]
     296  object pnlCollTimeButton: TKeyClickPanel [21]
    327297    Left = 288
    328298    Top = 167
    … …  
    331301    BevelOuter = bvNone
    332302    Caption = 'Select collection time'
    333     TabOrder = 15
     303    TabOrder = 17
    334304    TabStop = True
    335305    OnClick = cmdImmedCollClick
    … …  
    360330    end
    361331  end
    362   object cboAvailTest: TORComboBox [25]
     332  object cboAvailTest: TORComboBox [22]
    363333    Left = 6
    364334    Top = 18
    … …  
    386356    CharsNeedMatch = 1
    387357  end
    388   object cboFrequency: TORComboBox [26]
     358  object cboFrequency: TORComboBox [23]
    389359    Left = 326
    390360    Top = 166
    … …  
    406376    Sorted = False
    407377    SynonymChars = '<>'
    408     TabOrder = 16
     378    TabOrder = 18
    409379    OnChange = cboFrequencyChange
    410380    CharsNeedMatch = 1
    411381  end
    412   object cboCollSamp: TORComboBox [27]
     382  object cboCollSamp: TORComboBox [24]
    413383    Left = 269
    414384    Top = 28
    … …  
    437407    CharsNeedMatch = 1
    438408  end
    439   object cboSpecimen: TORComboBox [28]
     409  object cboSpecimen: TORComboBox [25]
    440410    Left = 269
    441411    Top = 55
    … …  
    459429    Sorted = False
    460430    SynonymChars = '<>'
    461     TabOrder = 2
     431    TabOrder = 3
    462432    OnChange = cboSpecimenChange
    463433    OnEnter = cboSpecimenMouseClick
    … …  
    466436    CharsNeedMatch = 1
    467437  end
    468   object cboUrgency: TORComboBox [29]
     438  object cboUrgency: TORComboBox [26]
    469439    Left = 269
    470440    Top = 82
    … …  
    486456    Sorted = False
    487457    SynonymChars = '<>'
    488     TabOrder = 3
     458    TabOrder = 5
    489459    OnChange = cboUrgencyChange
    490460    CharsNeedMatch = 1
    491461  end
    492   object txtAddlComment: TCaptionEdit [30]
     462  object txtAddlComment: TCaptionEdit [27]
    493463    Left = 187
    494464    Top = 122
    495465    Width = 180
    496466    Height = 21
    497     TabOrder = 4
     467    TabOrder = 6
    498468    Visible = False
    499469    OnExit = txtAddlCommentExit
    500470    Caption = 'Additional Comment'
    501471  end
    502   object txtDays: TCaptionEdit [31]
     472  object txtDays: TCaptionEdit [28]
    503473    Left = 430
    504474    Top = 166
    … …  
    507477    Hint = 'Enter a number of days, or an "X" followed by a number of times.'
    508478    Enabled = False
    509     TabOrder = 17
     479    TabOrder = 20
    510480    OnChange = ControlChange
    511481    Caption = 'How Long?'
    512482  end
    513   object FLabCommonCombo: TORListBox [32]
     483  object FLabCommonCombo: TORListBox [29]
    514484    Left = 440
    515485    Top = 247
    … …  
    520490    ParentShowHint = False
    521491    ShowHint = True
    522     TabOrder = 22
     492    TabOrder = 26
    523493    Visible = False
    524494    ItemTipColor = clWindow
    525495    LongList = False
    526496  end
    527   object cboCollTime: TORComboBox [33]
     497  object cboCollTime: TORComboBox [30]
    528498    Left = 149
    529499    Top = 166
    … …  
    545515    Sorted = False
    546516    SynonymChars = '<>'
    547     TabOrder = 12
     517    TabOrder = 14
    548518    OnChange = cboCollTimeChange
    549519    OnExit = cboCollTimeExit
    550520    CharsNeedMatch = 1
    551521  end
    552   object cboCollType: TORComboBox [34]
     522  object cboCollType: TORComboBox [31]
    553523    Left = 6
    554524    Top = 166
    … …  
    570540    Sorted = False
    571541    SynonymChars = '<>'
    572     TabOrder = 11
     542    TabOrder = 13
    573543    OnChange = cboCollTypeChange
    574544    CharsNeedMatch = 1
    575545  end
     546  object Frequencylbl508: TVA508StaticText [32]
     547    Name = 'Frequencylbl508'
     548    Left = 323
     549    Top = 149
     550    Width = 59
     551    Height = 15
     552    Alignment = taLeftJustify
     553    Caption = 'How Often?'
     554    Enabled = False
     555    TabOrder = 19
     556    Visible = False
     557    ShowAccelChar = True
     558  end
     559  object HowManyDayslbl508: TVA508StaticText [33]
     560    Name = 'HowManyDayslbl508'
     561    Left = 431
     562    Top = 152
     563    Width = 57
     564    Height = 15
     565    Alignment = taLeftJustify
     566    Caption = 'How Long?'
     567    Enabled = False
     568    TabOrder = 21
     569    Visible = False
     570    ShowAccelChar = True
     571  end
     572  inherited cmdAccept: TButton
     573    Left = 443
     574    TabOrder = 23
     575    ExplicitLeft = 443
     576  end
     577  object specimenlbl508: TVA508StaticText [35]
     578    Name = 'specimenlbl508'
     579    Left = 210
     580    Top = 56
     581    Width = 49
     582    Height = 15
     583    Alignment = taLeftJustify
     584    Caption = 'Specimen'
     585    Enabled = False
     586    TabOrder = 4
     587    Visible = False
     588    ShowAccelChar = True
     589  end
     590  inherited cmdQuit: TButton
     591    TabOrder = 24
     592  end
     593  object CollSamplbl508: TVA508StaticText [37]
     594    Name = 'CollSamplbl508'
     595    Left = 187
     596    Top = 31
     597    Width = 72
     598    Height = 15
     599    Alignment = taLeftJustify
     600    Caption = 'Collect Sample'
     601    Enabled = False
     602    TabOrder = 2
     603    Visible = False
     604    ShowAccelChar = True
     605  end
     606  inherited pnlMessage: TPanel
     607    Left = 18
     608    Top = 192
     609    Height = 56
     610    TabOrder = 25
     611    ExplicitLeft = 18
     612    ExplicitTop = 192
     613    ExplicitHeight = 56
     614    inherited imgMessage: TImage
     615      Top = 11
     616      ExplicitTop = 11
     617    end
     618    inherited memMessage: TRichEdit
     619      Left = 41
     620      Top = 5
     621      Height = 43
     622      PopupMenu = MessagePopup
     623      ExplicitLeft = 41
     624      ExplicitTop = 5
     625      ExplicitHeight = 43
     626    end
     627  end
    576628  inherited amgrMain: TVA508AccessibilityManager
    577629    Data = (
    … …  
    668720      (
    669721        'Component = frmODLab'
     722        'Status = stsDefault')
     723      (
     724        'Component = Frequencylbl508'
     725        'Status = stsDefault')
     726      (
     727        'Component = HowManyDayslbl508'
     728        'Status = stsDefault')
     729      (
     730        'Component = specimenlbl508'
     731        'Status = stsDefault')
     732      (
     733        'Component = CollSamplbl508'
    670734        'Status = stsDefault'))
    671735  end

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

    r829 r1679  
    66  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    77  Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
    8   ORDtTm, Buttons, Menus, VA508AccessibilityManager;
     8  ORDtTm, Buttons, Menus, VA508AccessibilityManager, VA508AccessibilityRouter;
    99
    1010type
    … …  
    5757    MessagePopup: TPopupMenu;
    5858    ViewinReportWindow1: TMenuItem;
     59    Frequencylbl508: TVA508StaticText;
     60    HowManyDayslbl508: TVA508StaticText;
     61    specimenlbl508: TVA508StaticText;
     62    CollSamplbl508: TVA508StaticText;
    5963    procedure FormCreate(Sender: TObject);
    6064    procedure ControlChange(Sender: TObject);
    … …  
    107111    procedure ReadServerVariables;
    108112    procedure DisplayChangedOrders(ACollType: string);
     113    procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl; lbl2: string);
    109114  public
    110115    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    206211procedure TfrmODLab.FormCreate(Sender: TObject);
    207212var
    208   i, n: integer;
     213  i, n, HMD508: integer;
    209214  AList: TStringList;
    210215begin
    … …  
    263268      if cboAvailTest.Items.Count > 0 then cboAvailTest.InsertSeparator;
    264269      cboAvailTest.InitLongList('');
     270      //TDP - CQ#19396 HMD508 added to guarantee 508 label did not change width
     271      HMD508 := HowManyDayslbl508.Width;
    265272      SetControl(cboFrequency, 'Schedules');
     273      HowManydayslbl508.Width := HMD508;
    266274      with cboFrequency do
    267275        begin
    … …  
    271279      lblHowManyDays.Enabled := False;                 { have this call change event in case }
    272280      txtDays.Enabled := False;                         { the default is not 'one time'?      }
     281      //TDP - CQ#19396 Following line does not appear to be needed
     282      //setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
    273283    end;
    274284    if EvTDelayLoc>0 then
    … …  
    283293        Font.Color := clGrayText;
    284294        lblFrequency.Enabled := False;
     295        setup508Label(Text, Frequencylbl508, cboFrequency, lblFrequency.Caption);
    285296      end;
    286297    PreserveControl(cboAvailTest);
    … …  
    294305    AList.Free;
    295306  end;
     307end;
     308
     309{TDP - CQ#19396 Added to address 508 related changes. I modified slightly to
     310       change lbl.Caption and retain lbl.Width}
     311procedure TfrmODLab.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl; lbl2: string);
     312var
     313Width: integer;
     314begin
     315  if ScreenReaderSystemActive and not ctrl.Enabled then begin
     316    lbl.Enabled := True;
     317    lbl.Visible := True;
     318    Width := lbl.Width;
     319    lbl.Caption := lbl2 +'. Read Only. Value is ' + Text;
     320    lbl.Width := Width;
     321  end else
     322    lbl.Visible := false;
    296323end;
    297324
    … …  
    745772procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
    746773var
    747   i: integer;
     774  i, PreviousSelectionIndex: integer;
     775  PreviousSelectionString: String;
    748776begin
    749777  with AComboBox do
    750778    begin
     779    PreviousSelectionIndex := -1;
     780    PreviousSelectionString := SelText;
     781
    751782      Clear;
    752       for i := 0 to UrgencyList.Count - 1 do
     783      for i := 0 to UrgencyList.Count - 1 do begin
    753784         if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
    754785           Continue
    755786         else
    756787           Items.Add(UrgencyList[i]);
     788         if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
     789           PreviousSelectionIndex := i;
     790      end;
     791
    757792      if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
    758793        SelectByID(LRFURG)
     794      else if PreviousSelectionIndex > -1 then
     795        ItemIndex := PreviousSelectionIndex
    759796      else
    760797        SelectByIEN(uDfltUrgency);
    … …  
    12921329        lblCollSamp.Enabled := True;
    12931330        cboCollSamp.Enabled := True;
     1331        //TDP - CQ#19396 Added cboCollSamp 508 changes
     1332        setup508Label(cboCollSamp.Text, collsamplbl508, cboCollSamp, lblCollSamp.Caption);
    12941333      end
    12951334    else
    … …  
    13061345        lblCollSamp.Enabled := False;
    13071346        cboCollSamp.Enabled := False;
     1347        //TDP - CQ#19396 Added cboCollSamp 508 changes
     1348        setup508Label(cboCollSamp.Text, collsamplbl508, cboCollSamp, lblCollSamp.Caption);
    13081349      end;
    13091350    if ObtainSpecimen then
    … …  
    13111352      lblSpecimen.Enabled:= True;
    13121353      cboSpecimen.Enabled:= True;
     1354      setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
    13131355    end else
    13141356    begin
    13151357      lblSpecimen.Enabled:= False;
    13161358      cboSpecimen.Enabled:= False;
     1359      setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
    13171360    end;
    13181361    if ObtainUrgency then
    … …  
    13601403      lblSpecimen.Enabled:= True;
    13611404      cboSpecimen.Enabled:= True;
     1405      setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
    13621406     end else
    13631407     begin
    13641408      lblSpecimen.Enabled:= False;
    13651409      cboSpecimen.Enabled:= False;
     1410      setup508Label(cboSpecimen.Text, specimenlbl508, cboSpecimen, lblSpecimen.Caption);
    13661411     end;
    13671412    if ObtainComment then
    … …  
    14191464procedure TfrmODLab.cboFrequencyChange(Sender: TObject);
    14201465var
    1421   x: string;
     1466  x, HowManyText: string;
    14221467const
    14231468  HINT_TEXT1 = 'Enter a number of days';
    … …  
    14341479          txtDays.Hint := '';
    14351480        txtDays.Enabled := True;
     1481        //TDP - txtDays 508 changes
     1482        if txtDays.Text = '' then HowManyText := 'no value'
     1483        else HowManyText := txtDays.Text;
     1484        setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
    14361485        txtDays.Showhint := True;
    14371486      end
    … …  
    14411490        lblHowManyDays.Enabled := False;
    14421491        txtDays.Enabled := False;
     1492        //TDP - txtDays 508 changes
     1493        HowManyText := 'no value';
     1494        setup508Label(HowManyText, HowManyDayslbl508, txtDays, lblHowManyDays.Caption);
    14431495        txtDays.ShowHint := False;
    14441496      end;
    … …  
    20252077
    20262078end.
    2027 
    2028 

  • cprs/trunk/CPRS-Chart/Orders/fODMedIV.dfm

    r829 r1679  
    55  Height = 465
    66  Caption = 'Infusion Order'
    7   Constraints.MinHeight = 350
     7  Constraints.MinHeight = 360
    88  Constraints.MinWidth = 500
    99  ExplicitWidth = 668
    … …  
    2727  object lblComponent: TLabel [2]
    2828    Left = 214
    29     Top = 7
     29    Top = 6
    3030    Width = 85
    3131    Height = 13
    … …  
    3434  object lblAmount: TLabel [3]
    3535    Left = 328
    36     Top = 7
     36    Top = 6
    3737    Width = 84
    3838    Height = 13
    … …  
    5555  end
    5656  object Label1: TLabel [6]
    57     Left = 8
    58     Top = 344
    59     Width = 133
    60     Height = 13
    61     Caption = ' * Indicates a Required Field'
     57    Left = 10
     58    Top = 345
     59    Width = 44
     60    Height = 13
     61    Caption = 'Order Sig'
    6262  end
    6363  object lblRoute: TLabel [7]
    … …  
    131131    OnClick = lblTypeHelpClick
    132132  end
    133   object txtRate: TCaptionEdit [13]
     133  object lblAddFreq: TLabel [13]
     134    Left = 488
     135    Top = 6
     136    Width = 95
     137    Height = 13
     138    Caption = 'Additive Frequency*'
     139  end
     140  object lblPrevAddFreq: TLabel [14]
     141    Left = 557
     142    Top = 6
     143    Width = 77
     144    Height = 13
     145    Caption = 'Prev. Add. Freq.'
     146  end
     147  object txtRate: TCaptionEdit [15]
    134148    Left = 486
    135149    Top = 211
    … …  
    137151    Height = 21
    138152    AutoSelect = False
    139     TabOrder = 8
     153    TabOrder = 10
    140154    OnChange = txtRateChange
    141155    Caption = 'Infusion Rate'
    142156  end
    143   object cboPriority: TORComboBox [14]
     157  object cboPriority: TORComboBox [16]
    144158    Left = 8
    145159    Top = 252
    … …  
    161175    Sorted = False
    162176    SynonymChars = '<>'
    163     TabOrder = 10
     177    TabOrder = 12
    164178    OnChange = cboPriorityChange
    165179    OnExit = cboPriorityExit
     180    OnKeyUp = cboPriorityKeyUp
    166181    CharsNeedMatch = 1
    167182  end
    168   object grdSelected: TCaptionStringGrid [15]
    169     Left = 214
    170     Top = 21
     183  object grdSelected: TCaptionStringGrid [17]
     184    Left = 215
     185    Top = 18
    171186    Width = 437
    172187    Height = 76
    173     ColCount = 3
    174188    DefaultColWidth = 100
    175189    DefaultRowHeight = 19
     190    DefaultDrawing = False
    176191    FixedCols = 0
    177192    RowCount = 1
    … …  
    179194    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected]
    180195    ScrollBars = ssVertical
    181     TabOrder = 1
     196    TabOrder = 2
    182197    OnDrawCell = grdSelectedDrawCell
    183198    OnKeyPress = grdSelectedKeyPress
    184199    OnMouseDown = grdSelectedMouseDown
    185     Caption = 'Selected Solution and Additives'
    186   end
    187   object cmdRemove: TButton [16]
     200  end
     201  object cmdRemove: TButton [18]
    188202    Left = 443
    189203    Top = 100
    … …  
    191205    Height = 18
    192206    Caption = 'Remove'
    193     TabOrder = 2
     207    TabOrder = 3
    194208    OnClick = cmdRemoveClick
    195209  end
    196   object memComments: TCaptionMemo [17]
     210  object memComments: TCaptionMemo [19]
    197211    Left = 214
    198212    Top = 121
    … …  
    202216      'memComments')
    203217    ScrollBars = ssVertical
    204     TabOrder = 13
     218    TabOrder = 4
    205219    OnChange = ControlChange
    206220    Caption = 'Comments'
    207221  end
    208   object txtSelected: TCaptionEdit [18]
     222  object txtSelected: TCaptionEdit [20]
    209223    Tag = -1
    210224    Left = 416
    … …  
    219233    OnChange = txtSelectedChange
    220234    OnExit = txtSelectedExit
     235    OnKeyDown = txtSelectedKeyDown
    221236    Caption = 'Volume'
    222237  end
    223   object cboSelected: TCaptionComboBox [19]
     238  object cboSelected: TCaptionComboBox [21]
    224239    Tag = -1
    225     Left = 460
     240    Left = 462
    226241    Top = 45
    227242    Width = 53
    … …  
    231246    ItemHeight = 13
    232247    ParentCtl3D = False
    233     TabOrder = 4
     248    TabOrder = 6
    234249    Visible = False
    235     OnChange = cboSelectedChange
    236     OnExit = cboSelectedExit
     250    OnCloseUp = cboSelectedCloseUp
     251    OnKeyDown = cboSelectedKeyDown
    237252    Caption = 'Volume/Strength'
    238253  end
    239254  inherited memOrder: TCaptionMemo
    240     Top = 359
     255    Top = 364
    241256    Width = 475
    242     TabStop = True
    243     TabOrder = 16
    244     ExplicitTop = 359
     257    TabOrder = 17
     258    ExplicitTop = 364
    245259    ExplicitWidth = 475
    246260  end
    247   object pnlXDuration: TPanel [21]
     261  object pnlXDuration: TPanel [23]
    248262    Left = 184
    249263    Top = 252
    … …  
    251265    Height = 21
    252266    BevelOuter = bvNone
    253     TabOrder = 11
     267    TabOrder = 13
    254268    OnEnter = pnlXDurationEnter
    255269    object txtXDuration: TCaptionEdit
    … …  
    261275      OnChange = txtXDurationChange
    262276      OnExit = txtXDurationExit
    263       Caption = 'Duration'
    264277    end
    265278    object cboDuration: TComboBox
    … …  
    269282      Height = 21
    270283      ItemHeight = 13
    271       TabOrder = 2
     284      TabOrder = 1
    272285      OnChange = cboDurationChange
    273286      OnEnter = cboDurationEnter
    274287    end
    275288  end
    276   object pnlCombo: TPanel [22]
     289  object pnlCombo: TPanel [24]
    277290    Left = 8
    278291    Top = 2
    … …  
    280293    Height = 185
    281294    BevelOuter = bvNone
    282     TabOrder = 25
     295    TabOrder = 26
    283296    object cboAdditive: TORComboBox
    284297      Left = 0
    … …  
    303316      SynonymChars = '<>'
    304317      TabPositions = '20'
    305       TabOrder = 0
     318      TabOrder = 1
    306319      OnExit = cboAdditiveExit
    307320      OnMouseClick = cboAdditiveMouseClick
    … …  
    321334        '   Additives   ')
    322335      TabIndex = 0
    323       TabStop = False
    324336      OnChange = tabFluidChange
    325337    end
    … …  
    346358      SynonymChars = '<>'
    347359      TabPositions = '20'
    348       TabOrder = 1
     360      TabOrder = 0
    349361      OnExit = cboSolutionExit
    350362      OnMouseClick = cboSolutionMouseClick
    … …  
    353365    end
    354366  end
    355   object cboRoute: TORComboBox [23]
     367  object cboRoute: TORComboBox [25]
    356368    Left = 8
    357369    Top = 211
    … …  
    372384    Sorted = False
    373385    SynonymChars = '<>'
    374     TabOrder = 3
     386    TabOrder = 5
    375387    OnChange = cboRouteChange
    376388    OnClick = cboRouteClick
    377389    OnExit = cboRouteExit
     390    OnKeyDown = cboRouteKeyDown
     391    OnKeyUp = cboRouteKeyUp
    378392    CharsNeedMatch = 1
    379393    UniqueAutoComplete = True
    380394  end
    381   object cboSchedule: TORComboBox [24]
     395  object cboSchedule: TORComboBox [26]
    382396    Left = 304
    383397    Top = 211
    … …  
    398412    Sorted = True
    399413    SynonymChars = '<>'
    400     TabOrder = 6
     414    TabOrder = 8
    401415    OnChange = cboScheduleChange
    402416    OnClick = cboScheduleClick
    403417    OnExit = cboScheduleExit
     418    OnKeyDown = cboScheduleKeyDown
     419    OnKeyUp = cboScheduleKeyUp
    404420    CharsNeedMatch = 1
    405421    UniqueAutoComplete = True
    406422  end
    407   object cboType: TComboBox [25]
     423  object cboType: TComboBox [27]
    408424    Left = 184
    409425    Top = 211
    … …  
    413429    ParentShowHint = False
    414430    ShowHint = True
    415     TabOrder = 5
     431    TabOrder = 7
    416432    OnChange = cboTypeChange
    417   end
    418   object chkPRN: TCheckBox [26]
     433    OnKeyDown = cboTypeKeyDown
     434  end
     435  object chkPRN: TCheckBox [28]
    419436    Left = 436
    420437    Top = 213
    … …  
    422439    Height = 21
    423440    Caption = 'PRN'
    424     TabOrder = 7
     441    TabOrder = 9
    425442    OnClick = chkPRNClick
    426443  end
    427   object chkDoseNow: TCheckBox [27]
     444  object chkDoseNow: TCheckBox [29]
    428445    Left = 8
    429446    Top = 279
    … …  
    433450    Caption = 'Give Additional Dose Now'
    434451    Constraints.MinWidth = 147
    435     TabOrder = 12
     452    TabOrder = 14
    436453    OnClick = chkDoseNowClick
    437454  end
    438   object cboInfusionTime: TComboBox [28]
     455  object cboInfusionTime: TComboBox [30]
    439456    Left = 576
    440457    Top = 211
    … …  
    442459    Height = 21
    443460    ItemHeight = 13
    444     TabOrder = 9
     461    TabOrder = 11
    445462    OnChange = cboInfusionTimeChange
    446463    OnEnter = cboInfusionTimeEnter
    447464  end
    448   object lblAdminTime: TVA508StaticText [29]
     465  object lblAdminTime: TVA508StaticText [31]
    449466    Name = 'lblAdminTime'
    450467    Left = 8
    … …  
    455472    ParentShowHint = False
    456473    ShowHint = True
    457     TabOrder = 14
     474    TabOrder = 15
    458475    TabStop = True
    459476    Visible = False
    460477    ShowAccelChar = True
    461478  end
    462   object lblFirstDose: TVA508StaticText [30]
     479  object lblFirstDose: TVA508StaticText [32]
    463480    Name = 'lblFirstDose'
    464481    Left = 8
    … …  
    467484    Height = 4
    468485    Alignment = taLeftJustify
    469     TabOrder = 15
     486    TabOrder = 16
    470487    TabStop = True
    471488    Visible = False
    472489    ShowAccelChar = True
    473490  end
     491  object cboAddFreq: TCaptionComboBox [33]
     492    Left = 488
     493    Top = 72
     494    Width = 145
     495    Height = 21
     496    ItemHeight = 13
     497    TabOrder = 25
     498    Visible = False
     499    OnCloseUp = cboAddFreqCloseUp
     500    OnKeyDown = cboAddFreqKeyDown
     501  end
    474502  inherited cmdAccept: TButton
    475503    Left = 495
    476     Top = 359
    477     TabOrder = 17
     504    Top = 364
     505    TabOrder = 18
    478506    ExplicitLeft = 495
    479     ExplicitTop = 359
     507    ExplicitTop = 364
    480508  end
    481509  inherited cmdQuit: TButton
    482510    Left = 495
    483     Top = 386
    484     TabOrder = 18
     511    Top = 391
     512    TabOrder = 19
    485513    ExplicitLeft = 495
    486     ExplicitTop = 386
     514    ExplicitTop = 391
    487515  end
    488516  inherited pnlMessage: TPanel
    489517    Left = 56
    490     Top = 349
    491     TabOrder = 19
     518    Top = 341
     519    TabOrder = 20
    492520    ExplicitLeft = 56
    493     ExplicitTop = 349
     521    ExplicitTop = 341
     522  end
     523  object lbl508Required: TVA508StaticText [37]
     524    Name = 'lbl508Required'
     525    Left = 6
     526    Top = 318
     527    Width = 135
     528    Height = 15
     529    Alignment = taLeftJustify
     530    Caption = ' * Indicates a Required Field'
     531    TabOrder = 1
     532    ShowAccelChar = True
    494533  end
    495534  inherited amgrMain: TVA508AccessibilityManager
    … …  
    497536      (
    498537        'Component = txtRate'
    499         'Status = stsDefault')
     538        'Label = lblInfusionRate'
     539        'Status = stsOK')
    500540      (
    501541        'Component = cboPriority'
    502         'Status = stsDefault')
     542        'Label = lblPriority'
     543        'Status = stsOK')
    503544      (
    504545        'Component = grdSelected'
    … …  
    521562      (
    522563        'Component = txtXDuration'
    523         'Status = stsDefault')
     564        'Label = lblLimit'
     565        'Status = stsOK')
    524566      (
    525567        'Component = pnlCombo'
    … …  
    536578      (
    537579        'Component = cboRoute'
    538         'Status = stsDefault')
     580        'Label = lblRoute'
     581        'Status = stsOK')
    539582      (
    540583        'Component = cboSchedule'
    541         'Status = stsDefault')
     584        'Label = lblSchedule'
     585        'Status = stsOK')
    542586      (
    543587        'Component = cboType'
    544         'Status = stsDefault')
     588        'Label = lblType'
     589        'Status = stsOK')
    545590      (
    546591        'Component = chkPRN'
    … …  
    551596      (
    552597        'Component = memOrder'
    553         'Status = stsDefault')
     598        'Label = Label1'
     599        'Status = stsOK')
    554600      (
    555601        'Component = cmdAccept'
    … …  
    569615      (
    570616        'Component = cboInfusionTime'
    571         'Status = stsDefault')
     617        'Text = Infusion Rate Time'
     618        'Status = stsOK')
    572619      (
    573620        'Component = cboDuration'
    574         'Status = stsDefault')
     621        'Text = Duration/Volume Units'
     622        'Status = stsOK')
    575623      (
    576624        'Component = lblAdminTime'
    … …  
    578626      (
    579627        'Component = lblFirstDose'
     628        'Status = stsDefault')
     629      (
     630        'Component = cboAddFreq'
     631        'Status = stsDefault')
     632      (
     633        'Component = lbl508Required'
    580634        'Status = stsDefault'))
    581635  end
     636  object VA508CompOrderSig: TVA508ComponentAccessibility
     637    Component = memOrder
     638    OnStateQuery = VA508CompOrderSigStateQuery
     639    Left = 24
     640    Top = 368
     641  end
     642  object VA508CompRoute: TVA508ComponentAccessibility
     643    Component = cboRoute
     644    OnInstructionsQuery = VA508CompRouteInstructionsQuery
     645    Left = 104
     646    Top = 240
     647  end
     648  object VA508CompType: TVA508ComponentAccessibility
     649    Component = cboType
     650    OnInstructionsQuery = VA508CompTypeInstructionsQuery
     651    Left = 224
     652    Top = 280
     653  end
     654  object VA508CompSchedule: TVA508ComponentAccessibility
     655    Component = cboSchedule
     656    OnInstructionsQuery = VA508CompScheduleInstructionsQuery
     657    Left = 384
     658    Top = 240
     659  end
     660  object VA508CompGrdSelected: TVA508ComponentAccessibility
     661    Component = grdSelected
     662    OnCaptionQuery = VA508CompGrdSelectedCaptionQuery
     663    Left = 288
     664    Top = 64
     665  end
    582666end

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

    r829 r1679  
    4545    txtAllIVRoutes: TLabel;
    4646    lblTypeHelp: TLabel;
     47    cboAddFreq: TCaptionComboBox;
     48    lblAddFreq: TLabel;
     49    lblPrevAddFreq: TLabel;
     50    lbl508Required: TVA508StaticText;
     51    VA508CompOrderSig: TVA508ComponentAccessibility;
     52    VA508CompRoute: TVA508ComponentAccessibility;
     53    VA508CompType: TVA508ComponentAccessibility;
     54    VA508CompSchedule: TVA508ComponentAccessibility;
     55    VA508CompGrdSelected: TVA508ComponentAccessibility;
    4756    procedure FormCreate(Sender: TObject);
    4857    procedure tabFluidChange(Sender: TObject);
    … …  
    5968    procedure FormResize(Sender: TObject);
    6069    procedure txtSelectedExit(Sender: TObject);
    61     procedure cboSelectedExit(Sender: TObject);
    6270    procedure ControlChange(Sender: TObject);
    6371    procedure txtSelectedChange(Sender: TObject);
    64     procedure cboSelectedChange(Sender: TObject);
    6572    procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
    6673      State: TGridDrawState);
    … …  
    94101    procedure cboRouteClick(Sender: TObject);
    95102    procedure lblTypeHelpClick(Sender: TObject);
     103    procedure cboSelectedCloseUp(Sender: TObject);
     104    procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     105    procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
     106      Shift: TShiftState);
     107    procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
     108      Shift: TShiftState);
     109    procedure cboAddFreqKeyDown(Sender: TObject; var Key: Word;
     110      Shift: TShiftState);
     111    procedure cboAddFreqCloseUp(Sender: TObject);
     112    procedure FormKeyPress(Sender: TObject; var Key: Char);
     113    procedure txtSelectedKeyDown(Sender: TObject; var Key: Word;
     114      Shift: TShiftState);
     115    procedure cboSelectedKeyDown(Sender: TObject; var Key: Word;
     116      Shift: TShiftState);
     117    procedure cboTypeKeyDown(Sender: TObject; var Key: Word;
     118      Shift: TShiftState);
     119    procedure cboRouteKeyDown(Sender: TObject; var Key: Word;
     120      Shift: TShiftState);
     121    procedure cboScheduleKeyDown(Sender: TObject; var Key: Word;
     122      Shift: TShiftState);
     123    procedure VA508CompOrderSigStateQuery(Sender: TObject; var Text: string);
     124    procedure VA508CompRouteInstructionsQuery(Sender: TObject;
     125      var Text: string);
     126    procedure VA508CompTypeInstructionsQuery(Sender: TObject; var Text: string);
     127    procedure VA508CompScheduleInstructionsQuery(Sender: TObject;
     128      var Text: string);
     129    procedure VA508CompGrdSelectedCaptionQuery(Sender: TObject;
     130      var Text: string);
    96131  private
    97132    FInpatient: Boolean;
    … …  
    102137    OSchedule: string;
    103138    oAdmin: string;
    104     Action: integer;
    105139    OrderIEN: string;
    106140    FAdminTimeText: string;
    … …  
    108142    FOriginalDurationType: integer;
    109143    FOriginalInfusionType: integer;
    110     FInitialOrderID: boolean;
     144    FIVTypeDefined: boolean;
     145    //FInitialOrderID: boolean;
    111146    procedure SetValuesFromResponses;
    112147    procedure DoSetFontSize( FontSize: integer);
    … …  
    119154    procedure UpdateDuration(SchType: string);
    120155    procedure ClearAllFields;
     156    function UpdateAddFreq(OI: integer): string;
     157    function IsAltCtrl_L_Pressed(Shift : TShiftState; Key : Word) : Boolean;
     158    procedure SetCtrlAlt_L_LabelAccessText(var Text: string; theLabel : TLabel);
    121159  public
     160    OrdAction: integer;
    122161    procedure InitDialog; override;
    123162    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    152191    Units: string;
    153192    Volumes: string;
     193    AddFreq: string;
    154194  end;
    155195
    … …  
    168208  TX_BAD_ROUTE = 'Route cannot be free-text';
    169209  TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value';
     210  TX_BAD_BAG = 'A valid additive frequency must be entered for ';
     211  Tx_BAG_NO_COMMENTS ='"See Comments" entered for additive ';
     212  TX_BAG_NO_COMMENTS1 = ' no comments defined for this order.';
    170213
    171214(*
    … …  
    200243    Exit;
    201244  end;
     245  OrdAction := -1;
    202246  DoSetFontSize(MainFontSize);
    203247  FillerID := 'PSIV';                            // does 'on Display' order check **KCM**
    … …  
    221265var
    222266bottom: integer;
    223 begin
    224   inherited;
     267isNewOrder: boolean;
     268begin
     269  inherited;
     270  if OrdAction in [ORDER_COPY, ORDER_EDIT] then isNewOrder := false
     271  else isNewOrder := True;
    225272  with grdSelected do
    226273  begin
    227274    ColWidths[1] := Canvas.TextWidth(' 10000 ') + GetSystemMetrics(SM_CXVSCROLL);
    228275    ColWidths[2] := Canvas.TextWidth('meq.') + GetSystemMetrics(SM_CXVSCROLL);
    229     ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - 4;
     276    //AGP ADDITIVE FREQUENCY CHANGES
     277    ColWidths[3] := Canvas.TextWidth(lblAddFreq.Caption + '  ') + GetSystemMetrics(SM_CXVSCROLL);
     278     if IsNewOrder = false then
     279      begin
     280        ColWidths[4] := Canvas.TextWidth(lblPrevAddFreq.Caption) + GetSystemMetrics(SM_CXVSCROLL);
     281        ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 5;
     282      end
     283    else
     284      begin
     285        ColWidths[4] := 0;
     286        ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 25;
     287      end;
    230288  end;
    231289  lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0];
     290  lblAddFreq.Left := grdSelected.Left +  grdSelected.ColWidths[0] +  grdSelected.ColWidths[1] + grdSelected.ColWidths[2];
     291  if isNewOrder = false then
     292    begin
     293      lblPrevAddFreq.Visible := True;
     294      lblPrevAddFreq.Left := grdSelected.Left +  grdSelected.ColWidths[0] +  grdSelected.ColWidths[1] + grdSelected.ColWidths[2] + grdSelected.ColWidths[3];
     295    end
     296  else lblPrevAddFreq.Visible := False;
    232297  self.cboType.SelLength := 0;
    233298  self.cboInfusionTime.SelLength := 0;
    … …  
    243308  self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2;
    244309  self.lblFirstDose.Top := self.lblAdminTime.Top + self.lblAdminTime.Height + 2;
    245   if self.Label1.Top < (self.lblFirstDose.Top + self.lblFirstDose.Height) then
    246     begin
    247       self.Label1.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 2;
     310  self.lbl508Required.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 5;
     311  if self.Label1.Top < (self.lbl508Required.Top + self.lbl508Required.Height) then
     312    begin
     313      self.Label1.Top := self.lbl508Required.Top + self.lbl508Required.Height + 5;
    248314      self.memOrder.Top := self.Label1.Top + self.Label1.Height;
    249315    end;
    … …  
    262328  //FRouteConflict := False;
    263329  //lblTypeHelp.Hint := IVTypeHelpText;
     330  ClearAllFields;
     331  //FIVTypeDefined := false;
    264332  lblType.Hint := IVTypeHelpText;
    265333  cboType.Hint := IVTYpeHelpText;
    … …  
    286354    //if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then
    287355    if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER');
    288 
    289356    cboSchedule.Enabled := False;
    290357    lblschedule.Enabled := False;
    … …  
    310377    chkDoseNow.Visible := false;
    311378    chkPRN.Enabled := false;
     379    //AGP ADDITIVE FREQUENCY CHANGES
     380    if cboAddFreq.Items.Count = 0 then
     381      begin
     382        cboAddFreq.Items.Add('1 Bag/Day');
     383        cboAddFreq.Items.Add('All Bags');
     384        cboAddFreq.Items.Add('See Comments');
     385      end;
    312386  end;
    313387  tabFluid.TabIndex := 0;
    … …  
    330404  oAdmin := '';
    331405  self.txtAllIVRoutes.Visible := false;
     406  memorder.text := '';
     407  memOrder.Lines.Clear;
    332408end;
    333409
    … …  
    339415             CRLF + '     “over a specified time period” (e.g. “Infuse over 30 min.”).' + CRLF + CRLF +
    340416             'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB';
     417end;
     418
     419procedure TfrmODMedIV.SetCtrlAlt_L_LabelAccessText(var Text: string; theLabel : TLabel);
     420begin
     421  if theLabel.Visible then
     422    Text := 'Press Ctrl + Alt + L to access ' + theLabel.Caption;
    341423end;
    342424
    … …  
    455537end;
    456538
     539procedure TfrmODMedIV.VA508CompRouteInstructionsQuery(
     540  Sender: TObject; var Text: string);
     541begin
     542  inherited;
     543  SetCtrlAlt_L_LabelAccessText(Text, txtAllIVRoutes);
     544end;
     545
     546procedure TfrmODMedIV.VA508CompScheduleInstructionsQuery(Sender: TObject;
     547  var Text: string);
     548begin
     549  inherited;
     550  SetCtrlAlt_L_LabelAccessText(Text, txtNSS);
     551end;
     552
     553procedure TfrmODMedIV.VA508CompTypeInstructionsQuery(Sender: TObject;
     554  var Text: string);
     555begin
     556  inherited;
     557  SetCtrlAlt_L_LabelAccessText(Text, lblTypeHelp);
     558end;
     559
     560procedure TfrmODMedIV.VA508CompGrdSelectedCaptionQuery(Sender: TObject;
     561  var Text: string);
     562begin
     563  inherited;
     564  if grdSelected.Col = 0 then
     565    Text := lblComponent.Caption
     566  else if grdSelected.Col = 1 then
     567    Text := lblAmount.Caption
     568  else if grdSelected.Col = 2 then
     569    Text := lblAmount.Caption + ', Unit'
     570  else if grdSelected.Col = 3 then
     571    Text := lblAddFreq.Caption
     572  else if grdSelected.Col = 4 then
     573    Text := lblPrevAddFreq.Caption;
     574end;
     575
     576procedure TfrmODMedIV.VA508CompOrderSigStateQuery(Sender: TObject;
     577  var Text: string);
     578begin
     579  inherited;
     580  Text := memOrder.Text;
     581end;
     582
    457583procedure TfrmODMedIV.Validate(var AnErrMsg: string);
    458584var
    459585  DispWarning, ItemOK, Result: Boolean;
    460   LDec,RDec,x, tempStr, iunit, infError: string;
     586  LDec,RDec,x, tempStr, iunit, infError, Bag: string;
    461587  digits, i, j, Len, temp, Value: Integer;
    462588
    … …  
    499625                end;
    500626            end;
     627           //AGP ADDITIVE FREQUENCY CHANGES
     628           if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous' then
     629             begin
     630               Bag := (Cells[3, i]);
     631               if Length(Bag) = 0 then
     632                 begin
     633                   SetError(TX_BAD_BAG + cells[0, i]);
     634                 end
     635               else if cboAddFreq.Items.IndexOf(Bag) = -1 then
     636                  begin
     637                    SetError(TX_BAD_BAG + cells[0, i]);
     638                  end
     639               else if (MixedCase(Bag) = 'See Comments') and ((self.memComments.Text = '') or (self.memComments.Text = CRLF)) then
     640                  begin
     641                    SetError(Tx_BAG_NO_COMMENTS + cells[0,i] + Tx_BAG_NO_COMMENTS1);
     642                  end;
     643                   
     644             end;
    501645        end;
    502646  end;
    … …  
    574718          else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit);
    575719        end;
    576       if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '')  then SetError(TX_NO_SCHEDULE);
     720      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '') and (chkPRN.Checked = false) then SetError(TX_NO_SCHEDULE);
     721      if (cboSchedule.ItemIndex > -1) and (cboSchedule.Text = '') then
     722        begin
     723          cboSchedule.ItemIndex := -1;
     724          SetError(TX_NO_SCHEDULE)
     725        end;
    577726      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE);
    578727    end;
    579728  if txtXDuration.Text = '' then
    580729    begin
    581       if AnErrMsg = '' then self.FInitialOrderID := True;
    582       exit;
     730      if AnErrMsg = '' then exit;
     731      //if AnErrMsg = '' then self.FInitialOrderID := True;
     732      //exit;
    583733    end;
    584734  Len := Length(txtXDuration.Text);
    … …  
    607757         SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000');
    608758     end;
    609   if AnErrMsg = '' then self.FInitialOrderID := True;
     759  //if AnErrMsg = '' then self.FInitialOrderID := True;
    610760 
    611761end;
    … …  
    629779procedure TfrmODMedIV.SetValuesFromResponses;
    630780var
    631   x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string;
    632   AnInstance, i, idx: Integer;
    633   AResponse: TResponse;
     781  x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute, PreAddFreq: string;
     782  AnInstance, i, idx, j: Integer;
     783  AResponse, AddFreqResp: TResponse;
    634784  AnIVComponent: TIVComponent;
    635785  AllIVRoute: TStringList;
    … …  
    637787begin
    638788  Changing := True;
    639   self.FInitialOrderID := false;
     789  //self.FInitialOrderID := false;
    640790  with Responses do
    641791  begin
     792    SetControl(cboType, 'TYPE', 1);
     793    if cboType.ItemIndex > -1 then  FIVTypeDefined := True;
    642794    FInpatient := OrderForInpatient;
    643795    AnInstance := NextInstance('ORDERABLE', 0);
    … …  
    682834            Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
    683835          Cells[2, RowCount - 1] := AnIVComponent.Units;
     836          Cells[3, RowCount - 1] := 'N/A';
    684837        end;
    685838      end;
    … …  
    721874        AnIVComponent.Units   := Piece(x, U, 1);
    722875        AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x));
     876        //AGP ADDITIVE FREQUENCY CHANGES
     877        AnIVComponent.AddFreq := '';
     878        PreAddFreq := '';
     879        AddFreqResp := FindResponseByName('ADDFREQ', AnInstance);
     880        if AddFreqResp <> nil then
     881          begin
     882            if cboAddFreq.Items.IndexOf(AddFreqResp.IValue) = -1 then
     883                 begin
     884                   AnIvComponent.AddFreq := '';
     885                 end
     886            else AnIvComponent.AddFreq := AddFreqResp.IValue;
     887            PreAddFreq := AddFreqResp.IValue;
     888          end;
    723889        with grdSelected do
    724890        begin
    … …  
    729895            Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
    730896          Cells[2, RowCount - 1] := AnIVComponent.Units;
     897          Cells[3, RowCount -1] := AnIVComponent.AddFreq;
     898          if OrdAction in [ORDER_COPY, ORDER_EDIT] then Cells[4, RowCount -1] := PreAddFreq;
    731899        end;
    732900      end;
    … …  
    803971         //if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5);
    804972         //if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
    805          if (Action in [ORDER_COPY, ORDER_EDIT])  then
     973         if (OrdAction in [ORDER_COPY, ORDER_EDIT])  then
    806974           begin
    807975            TempOrder := Piece(OrderIEN,';',1);
    … …  
    812980                if AResponse <> nil then AdminTime := AResponse.EValue;
    813981                //lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
    814                 if cboSchedule.ItemIndex > -1 then
     982                if (cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
    815983                  begin
    816984                    tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex];
    … …  
    8481016             cboInfusionTime.itemindex := 0;
    8491017           end;
     1018          For j := 0 to grdSelected.RowCount -1 do
     1019            grdSelected.Cells[3,j] := 'N/A';
    8501020      end
    8511021    else
    … …  
    8901060begin
    8911061  inherited;
    892   Action := OrderAction;
     1062  OrdAction := OrderAction;
    8931063  OrderIEN := id;
    894   self.FInitialOrderID := True;
     1064  //self.FInitialOrderID := True;
    8951065  if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
     1066  if isIMO = true then self.Caption := 'Clinic ' + self.Caption;
    8961067  if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then
    8971068      FAdminTimeText := 'Not defined for Clinic Locations';
    8981069  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
    8991070    begin
    900 
    9011071      SetValuesFromResponses;
    9021072    end;
    … …  
    9281098procedure TfrmODMedIV.cboSolutionNeedData(Sender: TObject; const StartFrom: string;
    9291099  Direction, InsertAt: Integer);
    930 var
    931   CurString: string;
    932 begin
    933   inherited;
    934   if (Direction = 1) then
    935     CurString := AnsiUpperCase(StartFrom) + '          ';
    936   cboSolution.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVB RX'));
     1100begin
     1101  cboSolution.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVB RX'));
    9371102end;
    9381103
    9391104procedure TfrmODMedIV.cbotypeChange(Sender: TObject);
     1105var
     1106i: integer;
    9401107begin
    9411108  inherited;
    … …  
    9551122      lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
    9561123      cboInfusionTime.Enabled := true;
    957       cboDuration.Items.Add('doses');
     1124      if cboDuration.items.IndexOf('doses') = -1 then cboDuration.Items.Add('doses');
     1125      //AGP ADDITIVE FREQUECNY CHANGES
     1126      lblAddFreq.Caption := 'Additive Frequency';
     1127      for i := 0 to grdselected.RowCount - 1 do
     1128        begin
     1129          if (TIVComponent(grdselected.Objects[0, i]) <> nil) and (TIVComponent(grdselected.Objects[0, i]).Fluid = 'A') then
     1130            begin
     1131              grdSelected.Cells[3, i] := 'N/A';
     1132            end;
     1133        end;
    9581134    end
    9591135  //else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then
    … …  
    9751151      updateDuration('');
    9761152      cboduration.Items.Delete(cboDuration.Items.IndexOf('doses'));
    977     end;
     1153      lblAddFreq.Caption := 'Additive Frequency*';
     1154      if FIVTypeDefined = True then
     1155        begin
     1156          for i := 0 to grdselected.RowCount - 1 do
     1157            begin
     1158              if (TIVComponent(grdselected.Objects[0, i]) <> nil) and (TIVComponent(grdselected.Objects[0, i]).Fluid = 'A') then
     1159                begin
     1160                  grdSelected.Cells[3, i] := '';
     1161                end;
     1162            end;
     1163        end;
     1164    end;
     1165  FIVTypeDefined := True;
    9781166  self.txtRate.Text := '';
    9791167  ControlChange(Sender);
     1168end;
     1169
     1170procedure TfrmODMedIV.cboTypeKeyDown(Sender: TObject; var Key: Word;
     1171  Shift: TShiftState);
     1172begin
     1173  inherited;
     1174  if IsAltCtrl_L_Pressed(Shift, Key) then
     1175    lblTypeHelpClick(lblTypeHelp);
     1176end;
     1177
     1178function TfrmODMedIV.IsAltCtrl_L_Pressed(Shift : TShiftState; Key : Word) : Boolean;
     1179begin
     1180  Result := (ssCtrl in Shift) and (ssAlt in Shift) and (Key = Ord('L'));
    9801181end;
    9811182
    … …  
    9861187  T2 = #13#13'The first order''s administrative schedule is "';
    9871188  T3 = #13'The second order''s administrative schedule is "';
    988   T4 = #13#13'Do you want to continue?';
     1189  T4 = #13#13'Do you want to continue?';   
     1190  T5 = '" and a priority of "';
    9891191  T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
    9901192  T2A = ' in addition to the one you are placing for the same medication.';
    … …  
    9921194  medNm: string;
    9931195  theSch: string;
     1196  ordPriority: string;
    9941197  //SchID: integer;
    9951198begin
    … …  
    10001203    //SchID := cboSchedule.ItemIndex;
    10011204    theSch := cboSchedule.Text;
     1205    ordPriority := cboPriority.SelText;
    10021206    if length(theSch)>0 then
    10031207    begin
    10041208      //if (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
    1005       if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
     1209      //if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
     1210      if (InfoBox(T1+T2+'NOW'+T5+ordPriority+T+T3+theSch+T5+ordPriority+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
    10061211      begin
    10071212        chkDoseNow.Checked := False;
    … …  
    10891294    Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
    10901295    Cells[2, RowCount - 1] := AnIVComponent.Units;
     1296    Cells[3, RowCount - 1] := 'N/A';
    10911297    Row := RowCount - 1;
    10921298    if Length(Piece(AnIVComponent.Volumes, U, 2)) > 0 then Col := 1 else Col := 0;
    1093     if RowCount = 1 then        // switch to additives after 1st IV
     1299  (*  if RowCount = 1 then        // switch to additives after 1st IV
    10941300    begin
    10951301       tabFluid.TabIndex := 1;
    10961302       tabFluidChange(Self);
    1097     end;
     1303    end;  *)
    10981304  end;
    10991305  Application.ProcessMessages;         //CQ: 10157
     1306  updateRoute;
    11001307  ClickOnGridCell;
    1101   updateRoute;
     1308  //updateRoute;
    11021309  ControlChange(Sender);
    11031310  //updateRoute(routeIEN);
    … …  
    11171324procedure TfrmODMedIV.cboAdditiveNeedData(Sender: TObject; const StartFrom: string;
    11181325  Direction, InsertAt: Integer);
    1119 var
    1120   CurString: string;
    1121 begin
    1122   inherited;
    1123   if (Direction = 1) then
    1124     CurString := AnsiUpperCase(StartFrom) + '          ';
    1125   cboAdditive.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVA RX'));
     1326begin
     1327  cboAdditive.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.IVA RX'));
     1328end;
     1329
     1330procedure TfrmODMedIV.cboAddFreqCloseUp(Sender: TObject);
     1331begin
     1332  inherited;
     1333  with cboAddFreq do
     1334  begin
     1335    if tag < 0 then exit;
     1336    grdSelected.Cells[Tag div 256, Tag mod 256] := MixedCase(items.Strings[itemindex]);
     1337    Tag := -1;
     1338    Hide;
     1339    ControlChange(Sender);
     1340    TControl(self.grdSelected).Enabled := True;
     1341    ActiveControl := self.grdSelected;
     1342  end;
     1343  grdSelected.Refresh;
     1344end;
     1345
     1346procedure TfrmODMedIV.cboAddFreqKeyDown(Sender: TObject; var Key: Word;
     1347  Shift: TShiftState);
     1348begin
     1349  inherited;
     1350  if (Key = VK_RETURN) or (Key = VK_Tab) then
     1351  begin
     1352    cboAddFreqCloseUp(cboAddFreq);
     1353    Key := 0;
     1354  end;
    11261355end;
    11271356
    … …  
    11771406      cboPriority.SetFocus;
    11781407    end;
     1408end;
     1409
     1410procedure TfrmODMedIV.cboPriorityKeyUp(Sender: TObject; var Key: Word;
     1411  Shift: TShiftState);
     1412begin
     1413  inherited;
     1414  if (Key = VK_BACK) and (cboPriority.Text = '') then cboPriority.ItemIndex := -1;
    11791415end;
    11801416
    … …  
    12321468end;
    12331469
     1470procedure TfrmODMedIV.cboRouteKeyDown(Sender: TObject; var Key: Word;
     1471  Shift: TShiftState);
     1472begin
     1473  inherited;
     1474  if IsAltCtrl_L_Pressed(Shift, Key) then
     1475    txtAllIVRoutesClick(txtAllIVRoutes);
     1476end;
     1477
     1478procedure TfrmODMedIV.cboRouteKeyUp(Sender: TObject; var Key: Word;
     1479  Shift: TShiftState);
     1480begin
     1481  inherited;
     1482  if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1; 
     1483end;
     1484
    12341485procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject);
    12351486var
    … …  
    12731524    Cells[0, RowCount - 1] := AnIVComponent.Name;
    12741525    Cells[2, RowCount - 1] := AnIVComponent.Units;
     1526    Cells[3, RowCount -1] :=  UpdateAddFreq(AnIVComponent.IEN);
    12751527    Row := RowCount - 1;
    12761528    Col := 1;
    … …  
    13021554  self.cboDuration.Text := '';
    13031555  self.txtAllIVRoutes.Visible := false;
    1304   self.FInitialOrderID := True;
     1556  //self.FInitialOrderID := True;
    13051557  cbotypeChange(self.cboType);
    13061558  if self.cboroute.Items.Count > 0 then self.cboRoute.Clear;
     1559  FIVTypeDefined := false;
    13071560end;
    13081561
    … …  
    13241577      SetFocus;
    13251578      if AControl is TComboBox then                    //CQ: 10157
    1326         TComboBox(AControl).DroppedDown := True;
     1579        begin
     1580          TComboBox(AControl).DroppedDown := True;
     1581          TControl(self.grdSelected).Enabled := false;
     1582        end;
    13271583    end;
    13281584  end;
    … …  
    13301586begin
    13311587  AnIVComponent := TIVComponent(grdSelected.Objects[0, grdSelected.Row]);
    1332   if (AnIVComponent = nil) or (grdSelected.Col = 0) then Exit;
     1588  if (AnIVComponent = nil) or (grdSelected.Col = 0) then
     1589    begin
     1590      if (AnIVComponent <> nil) and (grdSelected.Col = 0) then grdSelected.Refresh;
     1591      Exit;
     1592    end;
    13331593  // allow selection if more the 1 unit to choose from
    13341594  if (grdSelected.Col = 2) and (Length(Piece(AnIVComponent.Units, U, 2)) > 0) then
    … …  
    13541614    PlaceControl(txtSelected);
    13551615  end;
     1616  // AGP ADDITIVE FREQUENCY CHANGES
     1617  if (Self.cboType.ItemIndex < 1) and (grdSelected.Col = 3) and (AnIVComponent.Fluid = 'A') then
     1618  begin
     1619    cboAddFreq.ItemIndex := cboAddFreq.Items.IndexOf(grdSelected.Cells[grdSelected.Col, grdSelected.Row]);
     1620    cboAddFreq.Tag  := (grdSelected.Col * 256) + grdSelected.Row;
     1621    PlaceControl(cboAddFreq);
     1622  end;
    13561623end;
    13571624
    … …  
    13761643    Hide;
    13771644  end;
     1645  grdSelected.Refresh;
     1646end;
     1647
     1648
     1649
     1650procedure TfrmODMedIV.txtSelectedKeyDown(Sender: TObject; var Key: Word;
     1651  Shift: TShiftState);
     1652begin
     1653  inherited;
     1654  if (Key = VK_RETURN) or (Key = VK_Tab) then
     1655    begin
     1656      ActiveControl := grdSelected;
     1657      Key := 0;
     1658    end;
    13781659end;
    13791660
    13801661procedure TfrmODMedIV.cboScheduleChange(Sender: TObject);
     1662var
     1663othSch: string;
     1664idx: integer;
    13811665begin
    13821666  inherited;
    … …  
    13861670       self.cboDuration.ItemIndex := -1;
    13871671     end;
    1388    if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
     1672   if self.cboSchedule.ItemIndex > -1 then
     1673      begin
     1674        if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
     1675          begin
     1676            othSch := CreateOtherSchedule;
     1677            if length(trim(othSch)) > 1 then
     1678              begin
     1679                cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
     1680                idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
     1681                cboSchedule.ItemIndex := idx;
     1682            end
     1683            else cboSchedule.itemindex := -1;
     1684        end;
     1685        if cboSchedule.itemIndex > -1  then  updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
     1686      end;
    13891687  ControlChange(sender);
    13901688end;
    … …  
    13931691var
    13941692  othSch: string;
    1395   idx, i : integer;
     1693  idx: integer;
    13961694begin
    13971695  inherited;
    … …  
    14021700        begin
    14031701          cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
    1404           idx := -1;
    1405           for I := 0 to cboSchedule.Items.Count - 1 do
    1406             if Piece(cboSchedule.Items.Strings[i], U, 1) = othSch then
    1407               begin
    1408                 idx := i;
    1409                 break;
    1410               end;
    1411           //idx := cboSchedule.Items.IndexOfName(othSch);
     1702          idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
    14121703          cboSchedule.ItemIndex := idx;
    14131704        end;
    … …  
    14311722      cboSchedule.SetFocus;
    14321723    end;
    1433 end;
    1434 
    1435 procedure TfrmODMedIV.cboSelectedChange(Sender: TObject);   // combo editor for grid
     1724    if (cboSchedule.ItemIndex > -1) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
     1725end;
     1726
     1727procedure TfrmODMedIV.cboScheduleKeyDown(Sender: TObject; var Key: Word;
     1728  Shift: TShiftState);
     1729begin
     1730  inherited;
     1731  if IsAltCtrl_L_Pressed(Shift, Key) then
     1732    txtNSSClick(txtNSS);
     1733end;
     1734
     1735procedure TfrmODMedIV.cboScheduleKeyUp(Sender: TObject; var Key: Word;
     1736  Shift: TShiftState);
     1737begin
     1738  inherited;
     1739  if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1; 
     1740end;
     1741
     1742procedure TfrmODMedIV.cboSelectedCloseUp(Sender: TObject);
    14361743begin
    14371744  inherited;
    14381745  with cboSelected do
    14391746  begin
    1440     if Tag < 0 then Exit;
    1441     grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
    1442   end;
    1443   ControlChange(Sender);
    1444 end;
    1445 
    1446 procedure TfrmODMedIV.cboSelectedExit(Sender: TObject);
    1447 begin
    1448   inherited;
    1449   with cboSelected do
    1450   begin
    1451     grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
     1747    if tag < 0 then exit;
     1748    grdSelected.Cells[Tag div 256, Tag mod 256] := MixedCase(items.Strings[itemindex]);
    14521749    Tag := -1;
    14531750    Hide;
     1751    ControlChange(Sender);
     1752    TControl(self.grdSelected).Enabled := True;
     1753    ActiveControl := self.grdSelected;
     1754  end;
     1755  grdSelected.Refresh;
     1756end;
     1757
     1758procedure TfrmODMedIV.cboSelectedKeyDown(Sender: TObject; var Key: Word;
     1759  Shift: TShiftState);
     1760begin
     1761  inherited;
     1762  if (Key = VK_RETURN) or (Key = VK_Tab) then
     1763  begin
     1764    cboSelectedCloseUp(cboSelected);
     1765    Key := 0;
    14541766  end;
    14551767end;
    … …  
    15281840        if Length(Cells[1,i]) > 0 then Responses.Update('STRENGTH', CurAdd, Cells[1,i], Cells[1,i]);
    15291841        if Length(Cells[2,i]) > 0 then Responses.Update('UNITS',    CurAdd, Cells[2,i], Cells[2,i]);
     1842        //AGP ADDITIVE FREQUECNY CHANGES
     1843        if (Length(Cells[3,i]) > 0) and (Cells[3,i] <> 'N/A') then Responses.Update('ADDFREQ',    CurAdd, Cells[3,i], Cells[3,i]);
    15301844        Inc(CurAdd);
    15311845      end; {if Fluid A}
    … …  
    15581872    end;
    15591873  end;
    1560   if cboType.Text = 'Intermittent' then iType := 'I'
    1561   else iType := 'C';
     1874  if (cboType.ItemIndex > -1) and (cboType.Items.Strings[cboType.ItemIndex] = 'Intermittent') then iType := 'I'
     1875  else if (cboType.ItemIndex > -1) and (cboType.Items.Strings[cboType.ItemIndex] = 'Continuous') then iType := 'C'
     1876  else iType := '';
    15621877  Responses.Update('TYPE',1,iType,cboType.Text);
    15631878  Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text);
    … …  
    16351950begin
    16361951  aSchedule := '';
    1637   if not ShowOtherSchedule(aSchedule) then
    1638   begin
    1639     cboSchedule.ItemIndex := -1;
    1640     cboSchedule.Text      := '';
    1641   end
    1642   else
     1952  cboSchedule.ItemIndex := -1;
     1953  cboSchedule.Text      := '';
     1954  cboSchedule.DroppedDown := false;
     1955  if ShowOtherSchedule(aSchedule) then
    16431956    begin
    16441957        Result := Piece(aSchedule,U,1);
    … …  
    16521965begin
    16531966  inherited;
    1654   if Sender = ActiveControl then Exit;
    1655   if not (gdSelected in State) then Exit;
     1967  //if Sender = ActiveControl then Exit;
     1968  //if not (gdSelected in State) then Exit;
    16561969  with Sender as TStringGrid do
    16571970  begin
    1658     Canvas.Brush.Color := Color;
    1659     Canvas.Font := Font;
     1971    if State = [gdSelected..gdFocused] then
     1972      begin
     1973        Canvas.Font.Color := Get508CompliantColor(clWhite);
     1974        Canvas.Brush.Color := clHighlight;
     1975        //Canvas.Font.Color := clHighlightText;
     1976        Canvas.Font.Style := [fsBold];
     1977        Canvas.MoveTo(Rect.Left,Rect.top);
     1978      end
     1979    else
     1980      begin
     1981        if (ACol = 4) and (ColWidths[4] > 0) then
     1982          Canvas.Brush.Color := clInactiveBorder
     1983        else  Canvas.Brush.Color := clWindow;
     1984        Canvas.Font := Font;
     1985      end;
     1986    Canvas.FillRect(Rect);
     1987    //Canvas.Brush.Color := Color;
     1988
    16601989    Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
    16611990  end;
    … …  
    16962025    tabFluidChange(tabFluid);
    16972026  end;
     2027end;
     2028
     2029procedure TfrmODMedIV.FormKeyPress(Sender: TObject; var Key: Char);
     2030begin
     2031  if (Key = #13) and (ActiveControl = grdSelected) then
     2032  Key := #0;   //Don't let the base class turn it into a forward tab!
     2033  inherited;
    16982034end;
    16992035
    … …  
    17812117        cboSchedule.ItemIndex := idx;
    17822118        exit;
     2119      end;
     2120    //if PRN schedule than set the checkbox than exit
     2121    if (X = ' PRN') or (X = 'PRN') then
     2122      begin
     2123        chkPRN.Checked := True;
     2124        Exit;
    17832125      end;
    17842126      //Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID)
    … …  
    18052147                  //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
    18062148                  tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
    1807                   cboSchedule.Items.Add(tempSch);
    18082149                  cboSchedule.Text := (Piece(tempSch,U,1));
    18092150                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1));
    … …  
    18862227end;
    18872228
     2229function TfrmODMedIV.UpdateAddFreq(OI: integer): string;
     2230begin
     2231  if (self.cboType.ItemIndex = -1) or (MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous') then
     2232     Result := GetDefaultAddFreq(OI)
     2233  else Result := '';
     2234end;
     2235
    18882236procedure TfrmODMedIV.UpdateDuration(SchType: string);
    18892237begin
    … …  
    19092257i: integer;
    19102258OrderIds, TempIVRoute: TStringList;
    1911 Default: boolean;
     2259//Default: boolean;
    19122260begin
    19132261  if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
    … …  
    19282276 if OrderIds.Count > 0 then
    19292277   begin
    1930      if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
    1931      else Default := False;
    1932      LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds, Default);
    1933      if default = True then
     2278     //if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
     2279     //else Default := False;
     2280     LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds);
     2281     //if default = True then
     2282     //  begin
     2283     for I := 0 to cboRoute.items.Count - 1 do
    19342284       begin
    1935          for I := 0 to cboRoute.items.Count - 1 do
    1936            if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then
    1937              begin
    1938                cboRoute.ItemIndex := i;
    1939                break;
    1940              end;
    1941          self.FInitialOrderID := false;
     2285        if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then
     2286          begin
     2287           cboRoute.ItemIndex := i;
     2288           break;
     2289          end;
    19422290       end;
     2291       //  self.FInitialOrderID := false;
     2292       //end;
    19432293     OrderIds.Free;
    19442294   end;
    … …  
    19542304procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject);
    19552305var
    1956 i: integer;
    1957 begin
    1958   inherited;
    1959   if MessageDlg('You can also select "OTHER" from the Route list'
     2306  i: integer;
     2307  msg : String;
     2308begin
     2309  inherited;
     2310  msg := 'You can also select "OTHER" from the Route list'
    19602311     + ' to select a Route from the Expanded Med Route List.'
    1961      + #13#10 + 'Click OK to launch the Expanded Med Route List.',
    1962      mtInformation, [mbOK, mbCancel],0) = mrOK then
     2312     + #13#10 + 'Click OK to launch the Expanded Med Route List.';
     2313  if ShowMsg(msg, smiInfo, smbOKCancel) = smrOk then
    19632314  begin
    19642315      for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break;
    … …  
    19712322procedure TfrmODMedIV.txtNSSClick(Sender: TObject);
    19722323var
    1973 i: integer;
    1974 begin
    1975   inherited;
    1976   if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
     2324  i: integer;
     2325  msg : String;
     2326begin
     2327  inherited;
     2328  msg := 'You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
    19772329    + ' to create a day-of-week schedule.'
    1978     + #13#10 + 'Click OK to launch schedule builder',
    1979     mtInformation, [mbOK, mbCancel],0) = mrOK then
     2330    + #13#10 + 'Click OK to launch schedule builder';
     2331  if ShowMsg(msg, smiInfo, smbOKCancel) = smrOK then
    19802332  begin
    19812333      //cboSchedule.Items.Add(U + 'OTHER');

  • cprs/trunk/CPRS-Chart/Orders/fODMedNVA.dfm

    r829 r1679  
    33  Top = 183
    44  Width = 632
    5   Height = 536
     5  Height = 542
    66  Caption = 'Document Herbal/OTC/Non-VA Medications'
    77  Constraints.MinHeight = 365
    88  ExplicitWidth = 632
    9   ExplicitHeight = 536
     9  ExplicitHeight = 542
    1010  PixelsPerInch = 96
    1111  TextHeight = 13
    1212  inherited memOrder: TCaptionMemo
    1313    Left = 0
    14     Top = 461
     14    Top = 467
    1515    Width = 525
    1616    Anchors = [akLeft, akRight, akBottom]
    … …  
    1818    TabOrder = 4
    1919    ExplicitLeft = 0
    20     ExplicitTop = 461
     20    ExplicitTop = 467
    2121    ExplicitWidth = 525
    2222  end
    … …  
    2525    Top = 34
    2626    Width = 593
    27     Height = 415
     27    Height = 421
    2828    Anchors = [akLeft, akTop, akRight, akBottom]
    2929    BevelOuter = bvNone
    … …  
    7373      Top = 137
    7474      Width = 593
    75       Height = 278
     75      Height = 284
    7676      Align = alClient
    7777      Columns = <
    … …  
    9999  object txtMed: TEdit [2]
    100100    Left = 5
    101     Top = 6
     101    Top = 12
    102102    Width = 596
    103103    Height = 21
    … …  
    113113  object pnlFields: TPanel [3]
    114114    Left = 3
    115     Top = 30
     115    Top = 43
    116116    Width = 624
    117     Height = 428
     117    Height = 423
    118118    Anchors = [akLeft, akTop, akRight, akBottom]
    119119    BevelOuter = bvNone
    … …  
    125125      Top = 0
    126126      Width = 624
    127       Height = 264
     127      Height = 259
    128128      Align = alClient
    129129      Constraints.MinHeight = 80
    … …  
    132132      DesignSize = (
    133133        624
    134         264)
     134        259)
    135135      object lblRoute: TLabel
    136136        Left = 349
    … …  
    172172      end
    173173      object tabDose: TTabControl
    174         Left = -7
     174        Left = 1
    175175        Top = 19
    176176        Width = 175
    … …  
    188188        Top = 36
    189189        Width = 383
    190         Height = 222
     190        Height = 217
    191191        Anchors = [akLeft, akTop, akRight, akBottom]
    192192        Style = orcsSimple
    … …  
    210210        OnClick = cboDosageClick
    211211        OnExit = cboDosageExit
     212        OnKeyUp = cboDosageKeyUp
    212213        CharsNeedMatch = 1
    213214      end
    … …  
    216217        Top = 36
    217218        Width = 114
    218         Height = 223
     219        Height = 218
    219220        Anchors = [akTop, akRight, akBottom]
    220221        Style = orcsSimple
    … …  
    238239        OnChange = cboRouteChange
    239240        OnClick = ControlChange
    240         OnExit = cboRouteExit
     241        OnKeyUp = cboRouteKeyUp
    241242        CharsNeedMatch = 1
    242243      end
    243244      object cboSchedule: TORComboBox
    244245        Left = 467
    245         Top = 36
     246        Top = 37
    246247        Width = 157
    247         Height = 223
     248        Height = 218
    248249        Anchors = [akTop, akRight, akBottom]
    249250        Style = orcsSimple
    … …  
    265266        OnChange = cboScheduleChange
    266267        OnClick = cboScheduleClick
    267         OnExit = cboScheduleExit
     268        OnKeyUp = cboScheduleKeyUp
    268269        CharsNeedMatch = 1
    269270      end
    … …  
    283284    object pnlBottom: TPanel
    284285      Left = 0
    285       Top = 264
     286      Top = 259
    286287      Width = 624
    287288      Height = 164
    … …  
    388389  object btnSelect: TButton [4]
    389390    Left = 539
    390     Top = 463
     391    Top = 469
    391392    Width = 72
    392393    Height = 21
    … …  
    400401  inherited cmdAccept: TButton
    401402    Left = 540
    402     Top = 463
     403    Top = 469
    403404    Width = 69
    404405    Anchors = [akRight, akBottom]
    … …  
    406407    Visible = False
    407408    ExplicitLeft = 540
    408     ExplicitTop = 463
     409    ExplicitTop = 469
    409410    ExplicitWidth = 69
    410411  end
    411412  inherited cmdQuit: TButton
    412413    Left = 546
    413     Top = 489
     414    Top = 495
    414415    Width = 49
    415416    Anchors = [akRight, akBottom]
    416417    TabOrder = 7
    417418    ExplicitLeft = 546
    418     ExplicitTop = 489
     419    ExplicitTop = 495
    419420    ExplicitWidth = 49
    420421  end
    … …  
    436437      (
    437438        'Component = txtMed'
    438         'Status = stsDefault')
     439        'Text = Medication'
     440        'Status = stsOK')
    439441      (
    440442        'Component = pnlFields'
    … …  
    484486      (
    485487        'Component = memOrder'
    486         'Status = stsDefault')
     488        'Text = Order Sig'
     489        'Status = stsOK')
    487490      (
    488491        'Component = cmdAccept'

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

    r829 r1679  
    6363    procedure lblGuidelineClick(Sender: TObject);
    6464    procedure ListViewClick(Sender: TObject);
    65     procedure cboScheduleExit(Sender: TObject);
    6665    procedure cboScheduleChange(Sender: TObject);
    6766    procedure cboRouteChange(Sender: TObject);
    … …  
    7069    procedure cboDosageChange(Sender: TObject);
    7170    procedure cboScheduleClick(Sender: TObject);
    72     procedure cboRouteExit(Sender: TObject);
    7371    procedure DispOrderMessage(const AMessage: string);
    7472
    … …  
    9290      Change: TItemChange);
    9391    procedure FormKeyPress(Sender: TObject; var Key: Char);
     92    procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
     93      Shift: TShiftState);
     94    procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     95    procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
     96      Shift: TShiftState);
    9497
    9598  private
    … …  
    380383  FRemoveText := True;
    381384  FShrinkDrugMsg := False;
     385  if ScreenReaderActive then lstQuick.TabStop := True;
    382386end;
    383387
    … …  
    813817  chunk := GetCacheChunkIndex(Item.Index);
    814818  list := TStringList(FNVAMedCache[chunk]);
    815   x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
    816   Item.Caption := Piece(x, U, 2);
    817   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
     819  //This is to make sure that the index that is being used is not outside of the stringlist
     820  If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
     821   x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
     822   Item.Caption := Piece(x, U, 2);
     823   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
     824  end;
    818825end;
    819826
    … …  
    11381145  btnSelect.Default := False;
    11391146  cmdAccept.Visible := True;
    1140   cmdAccept.Default := True;
     1147  cmdAccept.Default := False;
    11411148  btnSelect.TabOrder := txtMed.TabOrder + 1;
    11421149  cmdAccept.TabStop := True;
    … …  
    13911398end;
    13921399
     1400procedure TfrmODMedNVA.cboDosageKeyUp(Sender: TObject; var Key: Word;
     1401  Shift: TShiftState);
     1402begin
     1403  inherited;
     1404  if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
     1405end;
     1406
    13931407{ cboRoute -------------------------------------- }
    13941408
    … …  
    14071421end;
    14081422
    1409 procedure TfrmODMedNVA.cboRouteExit(Sender: TObject);
    1410 begin
    1411   inherited;
     1423
     1424
     1425procedure TfrmODMedNVA.cboRouteKeyUp(Sender: TObject; var Key: Word;
     1426  Shift: TShiftState);
     1427begin
     1428  inherited;
     1429  if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
    14121430end;
    14131431
    … …  
    14261444end;
    14271445
    1428 procedure TfrmODMedNVA.cboScheduleExit(Sender: TObject);
    1429 begin
     1446
     1447procedure TfrmODMedNVA.cboScheduleKeyUp(Sender: TObject; var Key: Word;
     1448  Shift: TShiftState);
     1449begin
     1450  inherited;
     1451  if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.ItemIndex := -1;
    14301452end;
    14311453

  • cprs/trunk/CPRS-Chart/Orders/fODMeds.dfm

    r829 r1679  
    33  Top = 183
    44  Width = 584
    5   Height = 572
    6   HorzScrollBar.Range = 558
    7   VertScrollBar.Range = 399
     5  Height = 578
     6  AutoScroll = True
    87  Caption = 'Medication Order'
    98  Constraints.MinHeight = 325
     9  Constraints.MinWidth = 452
    1010  OnShow = FormShow
    1111  ExplicitWidth = 584
    12   ExplicitHeight = 572
     12  ExplicitHeight = 578
    1313  DesignSize = (
    1414    576
    15     545)
     15    544)
    1616  PixelsPerInch = 96
    1717  TextHeight = 13
    … …  
    2020    Top = 34
    2121    Width = 580
    22     Height = 470
     22    Height = 476
    2323    Anchors = [akLeft, akTop, akRight, akBottom]
    2424    BevelOuter = bvNone
    … …  
    6868      Top = 137
    6969      Width = 580
    70       Height = 333
     70      Height = 339
    7171      Align = alClient
    7272      BevelInner = bvLowered
    … …  
    9999  inherited memOrder: TCaptionMemo
    100100    Tag = 13
    101     Top = 505
     101    Top = 511
    102102    Width = 502
    103     TabStop = True
    104103    Anchors = [akLeft, akRight, akBottom]
    105104    TabOrder = 4
    106     ExplicitTop = 505
     105    ExplicitTop = 511
    107106    ExplicitWidth = 502
    108107  end
    109108  object txtMed: TEdit [2]
    110109    Left = 6
    111     Top = 6
     110    Top = 12
    112111    Width = 580
    113112    Height = 21
    … …  
    123122  object btnSelect: TButton [3]
    124123    Left = 515
    125     Top = 505
     124    Top = 511
    126125    Width = 72
    127126    Height = 21
    … …  
    135134  object pnlFields: TPanel [4]
    136135    Left = 6
    137     Top = 34
     136    Top = 44
    138137    Width = 580
    139     Height = 470
     138    Height = 465
    140139    Anchors = [akLeft, akTop, akRight, akBottom]
    141140    BevelOuter = bvNone
    … …  
    148147      Top = 0
    149148      Width = 580
    150       Height = 197
     149      Height = 192
    151150      Align = alClient
    152151      Constraints.MinHeight = 80
    … …  
    154153      DesignSize = (
    155154        580
    156         197)
     155        192)
    157156      object lblRoute: TLabel
    158157        Left = 280
    … …  
    195194        Top = 36
    196195        Width = 580
    197         Height = 156
     196        Height = 151
    198197        Anchors = [akLeft, akTop, akRight, akBottom]
    199198        ColCount = 7
    … …  
    259258        Top = 36
    260259        Width = 279
    261         Height = 155
     260        Height = 150
    262261        Anchors = [akLeft, akTop, akRight, akBottom]
    263262        Style = orcsSimple
    … …  
    289288        Top = 36
    290289        Width = 113
    291         Height = 156
     290        Height = 151
    292291        Anchors = [akTop, akRight, akBottom]
    293292        Style = orcsSimple
    … …  
    312311        OnClick = ControlChange
    313312        OnExit = cboRouteExit
     313        OnKeyUp = cboRouteKeyUp
    314314        CharsNeedMatch = 1
    315315        UniqueAutoComplete = True
    … …  
    319319        Top = 36
    320320        Width = 178
    321         Height = 156
     321        Height = 151
    322322        Anchors = [akTop, akRight, akBottom]
    323323        Style = orcsSimple
    … …  
    341341        OnEnter = cboScheduleEnter
    342342        OnExit = cboScheduleExit
     343        OnKeyUp = cboScheduleKeyUp
    343344        CharsNeedMatch = 1
    344345        UniqueAutoComplete = True
    … …  
    473474        TabStop = True
    474475        OnClick = btnXDurationClick
     476        OnEnter = pnlXDurationButtonEnter
    475477        object btnXDuration: TSpeedButton
    476478          Left = 0
    … …  
    558560        OnExit = cboXScheduleExit
    559561        OnKeyDown = memMessageKeyDown
     562        OnKeyUp = cboXScheduleKeyUp
    560563        CharsNeedMatch = 1
    561564        UniqueAutoComplete = True
    … …  
    575578    object pnlBottom: TPanel
    576579      Left = 0
    577       Top = 197
     580      Top = 192
    578581      Width = 580
    579582      Height = 273
    … …  
    600603      end
    601604      object lblQuantity: TLabel
    602         Left = 84
     605        Left = 81
    603606        Top = 65
    604607        Width = 39
    … …  
    609612      end
    610613      object lblRefills: TLabel
    611         Left = 164
     614        Left = 140
    612615        Top = 65
    613616        Width = 28
    … …  
    616619      end
    617620      object lblPriority: TLabel
    618         Left = 500
     621        Left = 503
    619622        Top = 61
    620623        Width = 31
    … …  
    682685      end
    683686      object txtQuantity: TCaptionEdit
    684         Left = 83
     687        Left = 80
    685688        Top = 78
    686         Width = 60
     689        Width = 40
    687690        Height = 21
    688691        AutoSize = False
    … …  
    694697      end
    695698      object spnQuantity: TUpDown
    696         Left = 143
     699        Left = 120
    697700        Top = 78
    698701        Width = 16
    … …  
    703706      end
    704707      object txtRefills: TCaptionEdit
    705         Left = 164
     708        Left = 140
    706709        Top = 78
    707710        Width = 30
    … …  
    715718      end
    716719      object spnRefills: TUpDown
    717         Left = 194
     720        Left = 170
    718721        Top = 78
    719722        Width = 15
    … …  
    724727      end
    725728      object grpPickup: TGroupBox
    726         Left = 283
     729        Left = 188
    727730        Top = 66
    728731        Width = 172
    729732        Height = 36
    730         Anchors = [akTop, akRight]
    731733        Caption = 'Pick Up'
    732734        TabOrder = 7
    … …  
    760762      end
    761763      object cboPriority: TORComboBox
    762         Left = 499
     764        Left = 502
    763765        Top = 76
    764766        Width = 72
    … …  
    782784        TabOrder = 9
    783785        OnChange = ControlChange
     786        OnKeyUp = cboPriorityKeyUp
    784787        CharsNeedMatch = 1
    785788      end
    … …  
    885888      OnExit = cboXSequenceExit
    886889      OnKeyDown = memMessageKeyDown
     890      OnKeyUp = cboXSequenceKeyUp
    887891      CharsNeedMatch = 1
    888892    end
    … …  
    890894  inherited cmdAccept: TButton
    891895    Left = 514
    892     Top = 505
     896    Top = 511
    893897    Anchors = [akRight, akBottom]
    894898    TabOrder = 6
    … …  
    896900    Visible = False
    897901    ExplicitLeft = 514
    898     ExplicitTop = 505
     902    ExplicitTop = 511
    899903  end
    900904  inherited cmdQuit: TButton
    901905    Left = 514
    902     Top = 530
     906    Top = 536
    903907    Width = 51
    904908    Anchors = [akRight, akBottom]
    905909    TabOrder = 7
    906910    ExplicitLeft = 514
    907     ExplicitTop = 530
     911    ExplicitTop = 536
    908912    ExplicitWidth = 51
    909913  end
    … …  
    10641068      (
    10651069        'Component = memOrder'
    1066         'Status = stsDefault')
     1070        'Text = Order Sig'
     1071        'Status = stsOK')
    10671072      (
    10681073        'Component = cmdAccept'
    … …  
    10851090      (
    10861091        'Component = lblAdminSch'
    1087         'Status = stsDefault')
     1092        'Text = Admin Schedule.'
     1093        'Status = stsOK')
    10881094      (
    10891095        'Component = lblAdminTime'

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

    r829 r1679  
    189189    procedure cboXSequenceEnter(Sender: TObject);
    190190    procedure txtRefillsChange(Sender: TObject);
     191    procedure QuantityMessageCheck(Tag: integer)  ;
     192    procedure pnlXDurationButtonEnter(Sender: TObject);
     193    procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     194    procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
     195      Shift: TShiftState);
     196    procedure cboXScheduleKeyUp(Sender: TObject; var Key: Word;
     197      Shift: TShiftState);
     198    procedure cboXSequenceKeyUp(Sender: TObject; var Key: Word;
     199      Shift: TShiftState);
     200    procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
     201      Shift: TShiftState);
    191202    //procedure btnNSSClick(Sender: TObject);
    192203  private
    … …  
    289300    procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
    290301      var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
    291     procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
     302    procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
    292303      var CurSupply: Integer; var CurQuantity: double);
    293304    procedure UpdateDurationControls( FreeText: boolean);
    … …  
    397408  FLD_COMMENT   = 80;
    398409  FLD_PTINSTR   = 85;
     410  FLD_DRUG_ID_INT = 90;
    399411  {dosage type tab index values}
    400412  TI_DOSE       =  0;
    … …  
    542554  end;
    543555  if self.EvtID > 0  then FAdminTimeText := 'To Be Determined';
     556  if (isIMO = True) then self.Caption := 'Clinic Orders Medications'
     557  else if FInptDlg = True then self.Caption := 'Inpatient Medications'
     558  else if DlgFormID = OD_MEDOUTPT then self.Caption := 'Outpatient Medications'
     559  else self.Caption := 'Medications Orders';
    544560  ListForOrderable(FCacheIEN, ListCount, x);
    545561  lstAll.Items.Count := ListCount;
    … …  
    614630procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
    615631var
    616   AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string;
    617   ix: integer;
     632  AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime, x: string;
     633  i, ix: integer;
    618634  LocChange: boolean;
    619635  AResponse: TResponse;
    … …  
    631647  //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
    632648  //this is not the best approach but this should fix the problem with order edit losing the quantity value.
    633   if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
     649  if ((OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY)) then
    634650  begin
    635651    FIsQuickOrder := True;
    … …  
    647663    Changing := True;
    648664    txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
     665    if OrderAction = ORDER_QUICK then
     666      begin
     667        if DEACheckFailed(txtMed.Tag, FInptDlg) then
     668          begin
     669            //btnSelect.Visible := False;
     670            btnSelect.Enabled := False;
     671            InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
     672            AbortOrder := True;
     673            Exit;
     674          end;
     675      end;
    649676    if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
    650677     (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
    … …  
    672699             if length(nsSch) > 0 then
    673700             begin
    674                 SetSchedule(nsSch);
     701                SetSchedule(UpperCase(nsSch));
    675702                {cboSchedule.SelectByID(nsSch);
    676703                if cboSchedule.ItemIndex < 0 then
    … …  
    694721              AResponse := Responses.FindResponseByName('ADMIN', 1);
    695722              if AResponse <> nil then AdminTime := AResponse.EValue;
    696               if self.cboSchedule.ItemIndex > -1 then
     723              if (self.cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
    697724                begin
    698725                  tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
    … …  
    700727                  self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
    701728                end;
    702               if self.tabDose.TabIndex = TI_COMPLEX then
     729              if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) and (AdminTime <> '') then
    703730                begin
    704731                  if self.cboXSchedule.ItemIndex > -1 then
    … …  
    722749                     end;
    723750                  end;
    724                if self.tabDose.TabIndex = TI_COMPLEX then
     751               if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) then
    725752                begin
    726753                  if self.cboXSchedule.ItemIndex > -1 then
    … …  
    742769      end;
    743770    if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
    744     (XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change
     771       (XfInToOutNow = true) or (FIsQuickOrder) then
     772       begin
     773         UpdateRelated(FALSE); //AGP Change
     774         //Need to do the following code to reset the FLastUnits and FLastSchedule in case a free text Dose is found. If the following
     775         //code is not done than the quantity will reset to zero
     776         if not FInptDlg  then
     777         begin
     778           FLastUnits := '';
     779           FLastSchedule := '';
     780           FLastInstruct := '';
     781           //Lasti := Responses.InstanceCount('INSTR');
     782           //Lasti := Responses.NextInstance('DOSE', 0);
     783           for I := 1 to Responses.InstanceCount('INSTR') do
     784             begin
     785               x := ValueOfResponse(FLD_DOSEUNIT,  i);
     786               FLastUnits  := FLastUnits   + x  + U;
     787               x := Responses.IValueFor('INSTR',    i);
     788               FLastInstruct := FLastInstruct + x + U;
     789               x := ValueOfResponse(FLD_SCHEDULE,  i);
     790               FLastSchedule := FLastSchedule + x + U;
     791             end;
     792         end;
     793       end;
    745794    Changing := False;
    746795    if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
    … …  
    762811    memComment.Clear;  // sometimes the sig is in the comment
    763812  end;
     813  FQOInitial := False;
    764814  ControlChange(Self);
    765815  if Self.IsSupply then
    … …  
    818868    ADrug  := ValueOfResponse(FLD_DRUG_ID,  AnInstance);
    819869    tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x);
     870    if Pos(CRLF, tmpX)> 0 then
     871      begin
     872        SetError('Schedule cannot contains control characters');
     873        Exit;
     874      end;
    820875    if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED)
    821876    else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
    … …  
    824879    begin
    825880      if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O');
     881   (*   if FInptDlg and (tmpX <> '') and (cboSchedule.ItemIndex = -1) and
     882      (self.tabDose.TabIndex = TI_DOSE) then
     883         //SetError('Unique Schedule Selection Required');
     884         SetError('More than one schedule starts with "'+tmpX+'". Please select a schedule from the list.');  *)
    826885      if ValidLevel = SCH_NO_RTN then
    827886      begin
    … …  
    857916      if Length(Responses.IValueFor('INSTR', i)) > 60       then
    858917      begin
    859          SetError(TX_DOSE_LEN);
    860          cboDosage.SetFocus;  //CQ: 7467
     918         if self.tabDose.TabIndex = TI_COMPLEX then
     919           begin
     920              SetError('Dosage: ' + Responses.IValueFor('INSTR', i) + CRLF + TX_DOSE_LEN);
     921           end
     922         else
     923           begin
     924              SetError(TX_DOSE_LEN);
     925              cboDosage.SetFocus;  //CQ: 7467
     926           end;
    861927      end;
    862928    end;
    … …  
    889955                Exit;
    890956              end;
     957           if Uppercase(ValFor(Col_Sequence, i)) = 'THEN' then
     958             begin
     959                if ValFor(Col_Duration,i) = '' then
     960                  begin
     961                    SetError('A duration is required when using "Then" as a sequence.');
     962                    Exit;
     963                  end;
     964             end;
    891965         end;
    892966    end;
    … …  
    13181392  chunk := GetCacheChunkIndex(Item.Index);
    13191393  list := TStringList(FMedCache[chunk]);
    1320   x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
    1321   Item.Caption := Piece(x, U, 2);
    1322   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
     1394  //This is to make sure that the index that is being used is not outside of the stringlist
     1395  If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
     1396   x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
     1397   Item.Caption := Piece(x, U, 2);
     1398   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
     1399  end;
    13231400end;
    13241401
    … …  
    14151492        end; *)
    14161493      FAltChecked := True;
    1417       ;
    14181494      SetOnMedSelect;   // set up for this medication
    14191495      SetOnQuickOrder;  // insert quick order responses
    … …  
    14241500      if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
    14251501        txtQuantity.Text := QOQuantityStr;
     1502      //FQOInitial := False;
    14261503    end
    14271504    else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then  // orderable item
    … …  
    14531530      begin
    14541531        temp := self.MedName;
    1455         CheckFormularyOI(MedIEN, temp, FInptDlg);
     1532        CheckFormularyOI(medIEN, temp, FInptDlg);
    14561533        FAltChecked := True;
     1534        txtMed.Text := '';
    14571535      end;
    14581536      if MedIEN <> txtMed.Tag then
    … …  
    14811559  else ShowMedSelect;                             // show the selection fields
    14821560  FNoZERO   := False;
     1561  if FQOInitial = True then FQOInitial := False;
     1562 
    14831563end;
    14841564
    … …  
    15851665    // set up lists & initial values based on orderable item
    15861666    SetControl(txtMed,       'Medication');
    1587     if (self.MedName <> '') then
     1667        if (self.MedName <> '') then
    15881668       begin
    15891669         if (txtMed.Text <> self.MedName) then
    … …  
    16031683    AResponse := Responses.FindResponseByName('SCHEDULE',1);
    16041684    if (AResponse <> nil) and (AResponse.EValue <> '') then  x := AResponse.EValue;
    1605     SetSchedule(x);
     1685    SetSchedule(UpperCase(x));
    16061686   (* if x <> '' then
    16071687    begin
    … …  
    17161796var
    17171797  AResponse: TResponse;
    1718   x,LocRoute,TempSch,DispGrp: string;
     1798  x,LocRoute,TempSch,DispGrp, SchType: string;
    17191799  i, DispDrug: Integer;
    17201800begin
    … …  
    17301810        SetDosage(IValueFor('INSTR', i));
    17311811        with cboDosage do
    1732           if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
     1812          //agp change QO code to populate the Grid with the same fields after selection CQ 15933
     1813          //if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
     1814          if ItemIndex > -1 then x := Piece(Text, TAB, 1) + TAB + Items[ItemIndex]
    17331815         else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
    17341816        grdDoses.Cells[COL_DOSAGE, i] := x;
    … …  
    17371819          if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
    17381820        grdDoses.Cells[COL_ROUTE,  i] := x;
    1739         if FIsQuickOrder then TempSch := cboSchedule.Text;
    1740         SetSchedule(IValueFor('SCHEDULE', i));
    1741         if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
    1742         begin
    1743           cboSchedule.SelectByID(TempSch);
    1744           cboSchedule.Text := TempSch;
    1745         end;
     1821        SetSchedule(UpperCase(IValueFor('SCHEDULE', i)));
    17461822        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
    17471823        x := cboSchedule.Text;
    … …  
    17551831          begin
    17561832            if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
    1757             else if cboSchedule.ItemIndex > -1 then
     1833            else if (cboSchedule.ItemIndex > -1) and (chkPRN.Checked = false) then
    17581834               grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
    17591835            else grdDoses.Cells[COL_ADMINTIME, i] := '';
    17601836            if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
    17611837            if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
     1838            //done to prevent admin time showing up in schedules that should not have admin times. Also remove Not Defined for schedule
     1839            //should not show the admin time
     1840            if (cboSchedule.ItemIndex > -1) or (chkPRN.Checked = True) then
     1841              begin
     1842                SchType := '';
     1843                if (cboSchedule.ItemIndex > -1) then SchType := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,3);
     1844                if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') or (ChkPRN.Checked = True) then
     1845                  grdDoses.Cells[COL_ADMINTIME, i] := '';
     1846              end;
    17621847          end;
     1848        chkPRN.Checked := false;
    17631849        if      IValueFor('CONJ', i) = 'A' then x := 'AND'
    17641850        else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
    … …  
    17791865        SetDosage(IValueFor('INSTR', 1));
    17801866      SetControl(cboRoute,  'ROUTE',     1);
    1781       SetSchedule(IValueFor('SCHEDULE',  1));
     1867      SetSchedule(UpperCase(IValueFor('SCHEDULE',  1)));
    17821868      if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
    17831869      begin
    … …  
    18451931    end; {if FInptDlg..else}
    18461932  end; {with}
    1847  if FInptDlg then
     1933 if (FInptDlg) then
    18481934  begin
    18491935    x := ValueOfResponse(FLD_SCHEDULE, 1);
    … …  
    19011987  btnSelect.Default := False;
    19021988  cmdAccept.Visible := True;
    1903   cmdAccept.Default := True;
     1989  cmdAccept.Default := False;
    19041990  cmdAccept.Left := cmdQuit.Left;
    19051991  cmdAccept.Top := MemOrder.Top;
    … …  
    19962082begin
    19972083  tabDose.TabIndex := TI_COMPLEX;
     2084  lblAdminSchSetTexT('');
    19982085  MoveCombo(cboDosage,   cboXDosage);
    19992086  MoveCombo(cboRoute,    cboXRoute);
    … …  
    20792166      end;
    20802167    cboSchedule.ItemIndex := -1;
     2168    cboSchedule.Text := '';
    20812169    if chkPRN.Checked = True then chkPRN.Checked := False;
    20822170    cboSchedule.SelectByID(x);
    20832171    if cboSchedule.ItemIndex > -1 then exit;
     2172    if (X = ' PRN') or (X = 'PRN') then
     2173      begin
     2174        chkPRN.Checked := True;
     2175        Exit;
     2176      end;
    20842177   // if cboSchedule.ItemIndex < 0 then
    20852178    //begin
    … …  
    24332526end;
    24342527
     2528procedure TfrmODMeds.cboRouteKeyUp(Sender: TObject; var Key: Word;
     2529  Shift: TShiftState);
     2530begin
     2531  inherited;
     2532  if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
     2533end;
     2534
    24352535{ cboSchedule ----------------------------------- }
    24362536
    … …  
    24722572    if length(trim(othSch)) > 1 then
    24732573    begin
     2574      othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
    24742575      cboSchedule.Items.Add(othSch);
    2475       idx := cboSchedule.Items.IndexOf(OthSch);
     2576      idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
    24762577      cboSchedule.ItemIndex := idx;
    24772578    end;
    … …  
    25262627  txtXDurationChange(Sender);
    25272628  ControlChange(Sender);
     2629end;
     2630
     2631procedure TfrmODMeds.QuantityMessageCheck(tag: integer);
     2632var
     2633DispDrug: integer;
     2634x: string;
     2635
     2636begin
     2637  if FInptDlg then Exit;
     2638  DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, tag), 0);
     2639  if DispDrug > 0 then
     2640  begin
     2641    if not FSuppressMsg then
     2642    begin
     2643      DispOrderMessage(DispenseMessage(DispDrug));
     2644      FSuppressMsg  := False;
     2645    end;
     2646    x := QuantityMessage(DispDrug);
     2647  end
     2648  else x := '';
     2649  if Length(x) > 0
     2650    then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
     2651    else lblQtyMsg.Caption := '';
    25282652end;
    25292653
    … …  
    27422866    for i := 0 to Pred(FAllDoses.Count) do
    27432867    begin
    2744       if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
     2868       // CQ #16957 - Corrected code that would potentially mis-match drugs - JCS
     2869      //if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
     2870      if AnsiSameText(DoseDrug, Pieces(FAllDoses[i],U,1,2)) then
    27452871      begin
    27462872        Result := Piece(FAllDoses[i], U, 3);
    … …  
    31423268      if Piece(x, ' ', 2) = 'MONTHS'  then DoseMinutes := ExtractInteger(x) * 43200;
    31433269      if Piece(x, ' ', 2) = 'WEEKS'   then DoseMinutes := ExtractInteger(x) * 10080;
    3144       if Piece(x, ' ', 2) = 'DAYS'    then DoseMinutes := ExtractInteger(x) * 1440;
     3270      if Pos('DAY',Piece(x, ' ', 2))>0    then DoseMinutes := ExtractInteger(x) * 1440;
    31453271      if Piece(x, ' ', 2) = 'HOURS'   then DoseMinutes := ExtractInteger(x) * 60;
    31463272      if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
    … …  
    31823308  with grdDoses do
    31833309  begin
    3184     i := grdDoses.Width - 12;                 // 12 = 4 pixel margin + 8 pixel column 0
     3310    i := grdDoses.Width - 20;                 // 20 = 12 pixel margin + 8 pixel column 0
    31853311    i := i - GetSystemMetrics(SM_CXVSCROLL);  // compensate for appearance of scroll bar
    31863312    if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
    … …  
    34643590  DisableDefaultButton(self);
    34653591  DisableCancelButton(self);
     3592  QuantityMessageCheck(cboXDosage.Tag);
    34663593end;
    34673594
    … …  
    37303857  str := str + CRLF + CRLF + AdminTimeHelpText;
    37313858  infoBox(str,'Administration Time Information',MB_OK);
     3859end;
     3860
     3861procedure TfrmODMeds.pnlXDurationButtonEnter(Sender: TObject);
     3862begin
     3863  inherited;
     3864  QuantityMessageCheck(self.grdDoses.Row);
    37323865end;
    37333866
    … …  
    40744207    FLD_QUANTITY  :
    40754208    begin
    4076        if Pos(',', txtQuantity.Text)>0 then 
     4209       if Pos(',', txtQuantity.Text)>0 then
    40774210        Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2)
    40784211       else
    … …  
    41294262begin
    41304263  Checked := false;
    4131   if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
     4264 if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
    41324265     (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
    41334266     or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or
    … …  
    41374270    ADrug := Piece(CurDispDrug, U, 1);
    41384271    CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
    4139     if CurSupply > 0 then
     4272    if CurSupply > 0 then           
    41404273    begin
    41414274      spnSupply.Position := CurSupply;
    … …  
    41604293      SkipQtyCheck := TRUE;
    41614294    end;
    4162     if FQOInitial = true then FQOInitial := False;   
     4295    //if FQOInitial = true then FQOInitial := False;
    41634296  end;
    41644297  if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
    … …  
    41854318end;
    41864319
    4187 procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
     4320//add CURInstrcut to this procedure. This address a problem with an user starting with a free-text dosage and changing
     4321//to another free-text dose and the quantity value not updating.
     4322procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
    41884323  var CurSupply: Integer; var CurQuantity: double);
    41894324const
    … …  
    41974332  ADrug: string;
    41984333  SaveChanging: Boolean;
    4199   tmpQuty: Double;
    4200 begin
    4201   tmpQuty := 0;
     4334  tmpQuantity: double;
     4335begin
    42024336  if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then
    42034337  begin
    … …  
    42204354     (CurDuration = FLastDuration) and
    42214355     (CurQuantity = FLastQuantity) and
    4222      (CurSupply   = FLastSupply)   then Exit;
     4356     (CurSupply   = FLastSupply)   and
     4357     (CurInstruct = FLastInstruct) then Exit;
    42234358  // exit if supply & quantity have both been directly edited
    42244359  if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit;
    … …  
    42294364  else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY
    42304365  else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY;
    4231   if (UpdateControl = UPD_NONE) and ((CurUnits <> FLastUnits) or (CurSchedule <> FLastSchedule)) then
     4366  if (UpdateControl = UPD_NONE) and (((CurUnits <> FLastUnits) or (CurInstruct <> FLastInstruct)) or (CurSchedule <> FLastSchedule)) then
    42324367  begin
    42334368    if txtQuantity.Tag = 0    then UpdateControl := UPD_QUANTITY
    … …  
    42394374                   if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
    42404375                   begin
    4241                      FQOInitial := False;
     4376                     txtQuantity.Text := FloatToStr(CurQuantity);
    42424377                     Exit;
    42434378                   end;
    4244                    if FIsQuickOrder and (CurQuantity > 0) then
    4245                      tmpQuty := CurQuantity;
    42464379                   CurQuantity := DaysToQty(CurSupply,   CurUnits, CurSchedule, CurDuration, ADrug);
    4247                    if (tmpQuty > 0) and (CurQuantity <= 0) then
    4248                    begin
    4249                      txtQuantity.Text := FloatToStr(tmpQuty);
    4250                      CurQuantity := tmpQuty;
    4251                    end else if (CurQuantity >= 0) then
     4380                   if (CurQuantity >= 0) then
    42524381                     txtQuantity.Text := FloatToStr(CurQuantity);
    42534382                 end;
    … …  
    42584387  UPD_BOTH     : begin
    42594388                   txtSupply.Text     := IntToStr(CurSupply);
    4260                    tmpQuty := 0;
     4389                   spnSupply.Position := StrToIntDef(txtSupply.Text, 0);
     4390                   tmpQuantity := DaysToQty(CurSupply,   CurUnits, CurSchedule, CurDuration, ADrug);
    42614391                   if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
     4392                      begin
     4393                        txtQuantity.Text := FloatToStr(CurQuantity);
     4394                        Exit;
     4395                      end;
     4396                  (* if FIsQuickOrder and (CurQuantity > 0) and (tmpQuantity = 0) and FQOInitial then
    42624397                   begin
    4263                      FQOInitial := False;
     4398                     txtQuantity.Text := FloatToStr(CurQuantity);
    42644399                     Exit;
    4265                    end;
    4266                    if FIsQuickOrder and (CurQuantity > 0) then
    4267                      tmpQuty := CurQuantity;
    4268                    CurQuantity := DaysToQty(CurSupply,   CurUnits, CurSchedule, CurDuration, ADrug);
    4269                    if (tmpQuty > 0) and (CurQuantity <= 0) then
    4270                    begin
    4271                      txtQuantity.Text := FloatToStr(tmpQuty);
    4272                      CurQuantity := tmpQuty;
    4273                    end else if CurQuantity >= 0 then
     4400                   end;  *)
     4401                   //CurQuantity := DaysToQty(CurSupply,   CurUnits, CurSchedule, CurDuration, ADrug);
     4402                   CurQuantity := tmpQuantity;
     4403                   if CurQuantity >= 0 then
    42744404                     txtQuantity.Text := FloatToStr(CurQuantity);
    42754405                 end;
    … …  
    45794709          lblAdminTime.Caption := '';
    45804710    end;
    4581    if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule);
    4582    //AGP remove this code for CQ 11772
    4583   (*if (ValueOf(FLD_SCHED_TYP) = 'O')
    4584       or (Responses.EventType in ['A','D','T','M','O'])
    4585       or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
    4586     begin
    4587       if (chkDoseNow.Checked) and (chkDoseNow.Visible) then
    4588       begin
    4589         chkDoseNowClick(Self);
    4590         chkDoseNow.Checked := False;
    4591       end;
    4592           chkDoseNow.Visible := False;
    4593           lblAdminTime.Visible := False;
    4594     end
    4595     else
    4596       begin
    4597         chkDoseNow.Visible := TRUE;
    4598         lblAdminTime.Visible := not chkDoseNow.Checked;
    4599       end;  *)
     4711   if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then
     4712     UpdateStartExpires(CurSchedule);
    46004713    if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
    46014714  end;
    4602     if not FInptDlg then
     4715  if not FInptDlg then
    46034716  begin
    46044717    CurSchedule := CurScheduleOut;
    46054718    if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
     4719    //if ((CurInstruct <> FLastInstruct) and (CurUnits <> U))
    46064720      then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
    46074721                               LackQtyInfo);
    … …  
    46114725    end
    46124726    else
    4613       UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity);
     4727      UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct, CurSupply, CurQuantity);
    46144728   // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
    46154729    if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0))  then
    … …  
    46334747  if FUpdated then ControlChange(Self);
    46344748  FScheduleChanged := false;
     4749  //FQOInitial := False;
    46354750end;
    46364751
    … …  
    46444759    Exit;
    46454760  end;
     4761  if timCheckChanges.Enabled = True then sleep(1500);
    46464762  //AGP Change for 26.45 PSI-04-069
    46474763  if self.tabDose.TabIndex = 1 then
    … …  
    46904806  T  = '"';
    46914807  T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "';
    4692   T2 = #13#13'The first order''s administrative schedule is "';
    4693   T3 = #13'The second order''s administrative schedule is "';
     4808  T2 = #13#13'The "Give additional dose now" order has an administration schedule of "';
     4809  T3 = #13'The "Ongoing" order has an administration schedule of "';
    46944810  T4 = #13#13'Do you want to continue?';
     4811  T5 = '" and a priority of "';           
    46954812  T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
    46964813  T2A = ' in addition to the one you are placing for the same medication "';
    … …  
    46984815  medNm: string;
    46994816  theSch: string;
     4817  ordPriority: string;
    47004818begin
    47014819  inherited;
    … …  
    47044822    medNm := txtMed.Text;
    47054823    theSch := cboSchedule.Text;
     4824    ordPriority := cboPriority.SelText;
    47064825    if length(theSch)>0 then
    47074826    begin
    47084827      //if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then
    4709       if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
     4828      //if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
     4829      if InfoBox(T1+medNm+T+T2+'NOW'+T5+ordPriority+T+T3+theSch+T5+ordPriority+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
    47104830      begin
    47114831        chkDoseNow.Checked := False;
    … …  
    48324952     lblAdminTime.Caption := '';
    48334953     PrnPos := Pos('PRN',cboSchedule.Text);
    4834      if (PrnPos < 1) then
     4954     if (PrnPos < 1) and (FQOInitial = false) then
    48354955        UpdateStartExpires(cboSchedule.Text + ' PRN');
    48364956  end
    … …  
    48404960    begin
    48414961      tempSch := ';'+Trim(cboSchedule.Text);
    4842       UpdateStartExpires(tempSch);
     4962      if FQOInitial = false then UpdateStartExpires(tempSch);
    48434963    end;
    48444964    //lblAdminTime.Caption := FAdminTimeLbl;
    … …  
    48464966      cboScheduleClick(Self);
    48474967  end;
     4968  if FQOInitial = false then updateRelated(False);
     4969  //updateRelated(False);
    48484970  ControlChange(Self);
    48494971end;
    … …  
    49655087procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
    49665088begin
    4967  (* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
    4968   begin
    4969     ShowEditor(grdDoses.Col, grdDoses.Row, #0);
    4970     Key := #0;  //Don't let the base class turn it into a forward tab!
    4971   end *)
    4972   //else
    4973   if (Key = #13) and (ActiveControl = txtMed) then
    4974     Key := #0;   //Don't let the base class turn it into a forward tab!
     5089 if (Key = #13) and (ActiveControl = txtMed) then
     5090  Key := #0   //Don't let the base class turn it into a forward tab!
     5091 else if (Key = #13) and (self.tabDose.TabIndex = TI_Complex) then
     5092      Key := #0
     5093 else
     5094  inherited;
    49755095end;
    49765096
    … …  
    49935113  DisableDefaultButton(self);
    49945114  DisableCancelButton(self);
     5115  QuantityMessageCheck(self.grdDoses.Row);
    49955116end;
    49965117
    … …  
    50415162  tempAdmin := lblAdminSchGetText;
    50425163  if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin);
     5164  if not (FInptDLG) then
     5165    begin
     5166      if self.cboPriority.Left < (self.grpPickup.Left + self.grpPickup.Width) then
     5167        begin
     5168          self.cboPriority.Left := self.grpPickup.Left + self.grpPickup.Width + 2;
     5169          if self.Width < (self.cboPriority.Left + self.cboPriority.Width) then
     5170                begin
     5171                  self.Width := self.cboPriority.Left + self.cboPriority.Width + 9;
     5172                  self.cboPriority.Left := self.pnlBottom.Width - self.cboPriority.Width - 2;
     5173                end;
     5174          self.lblPriority.Left := self.cboPriority.Left;
     5175        end;
     5176    end;
    50435177end;
    50445178
    … …  
    51345268  result := False;
    51355269  IsInptDlg := False;
    5136   Td := FMToday;
     5270  // CQ #15188 - changed to use function to determine Td value - TDP
     5271  //Td := FMToday;
     5272  Td := IMOTimeFrame;
    51375273  if DlgFormID = MedsInDlgFormId  then IsInptDlg := TRUE;
    51385274  IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
     5275
     5276  // CQ #15188 - allow IMO functionality 23 hours after encounter date/time - JCS
     5277  // CQ #15188 - changed to use function to set Td.  Reverted this line back to original - TDP
     5278  {if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and
     5279    (Encounter.DateTime > DateTimeToFMDateTime(FMDateTimeToDateTime(FMNow) - (23/24))) then}
    51395280  if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
    51405281    result := True;
    … …  
    52715412    cboSchedule.ItemIndex := -1;
    52725413  ValidateInpatientSchedule(cboSchedule);
     5414  updateRelated(False);
     5415end;
     5416
     5417
     5418procedure TfrmODMeds.cboScheduleKeyUp(Sender: TObject; var Key: Word;
     5419  Shift: TShiftState);
     5420begin
     5421  inherited;
     5422  if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.itemindex:= -1;
    52735423end;
    52745424
    … …  
    52855435    ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
    52865436    {if user entered schedule verify it is in list}
    5287   if ScheduleCombo.ItemIndex < 0 then // CQ: 7397
     5437  if (ScheduleCombo.ItemIndex < 0) and (not FInptDlg) then // CQ: 7397  and CQ 17934
    52885438  begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule
    52895439    tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
    … …  
    52985448                           ' select ''OTHER'' from the list.',
    52995449                           'Incorrect Schedule.');
     5450          ScheduleCombo.ItemIndex := -1;
     5451          ScheduleCombo.Text := '';
    53005452    FShowPnlXScheduleOk := True;  //Added for CQ: 7370
    53015453    if ScheduleCombo.CanFocus then
    53025454      ScheduleCombo.SetFocus;
    5303     ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
     5455    //ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
    53045456  end;
    53055457end;
    … …  
    53695521            doesn't for simple orders }
    53705522  ValidateInpatientSchedule(cboXSchedule);
     5523end;
     5524
     5525
     5526procedure TfrmODMeds.cboXScheduleKeyUp(Sender: TObject; var Key: Word;
     5527  Shift: TShiftState);
     5528begin
     5529  inherited;
     5530  if (Key = VK_BACK) and (cboXSchedule.Text = '') then cboXSchedule.ItemIndex := -1;
    53715531end;
    53725532
    … …  
    53965556  DisableDefaultButton(self);
    53975557  DisableCancelButton(self);
     5558  QuantityMessageCheck(self.grdDoses.Row);
    53985559end;
    53995560
    … …  
    54275588end;
    54285589
     5590
     5591procedure TfrmODMeds.cboXSequenceKeyUp(Sender: TObject; var Key: Word;
     5592  Shift: TShiftState);
     5593begin
     5594  inherited;
     5595  if (Key = VK_BACK) and (cboXSequence.Text = '') then cboXSequence.ItemIndex := -1;
     5596end;
     5597
    54295598procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject);
    54305599begin
    … …  
    54375606begin
    54385607  inherited;
     5608  if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
    54395609  //Fix for CQ: 7545
    54405610  if cboDosage.ItemIndex > -1 then
    … …  
    54445614end;
    54455615
     5616
     5617procedure TfrmODMeds.cboPriorityKeyUp(Sender: TObject; var Key: Word;
     5618  Shift: TShiftState);
     5619begin
     5620  inherited;
     5621  if (Key = VK_BACK) and (cboPriority.Text = '') then cboPriority.ItemIndex := -1;
     5622end;
     5623
    54465624procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word;
    54475625  Shift: TShiftState);
    54485626begin
    54495627  inherited;
     5628  if (Key = VK_BACK) and (cboXDosage.Text = '') then cboXDosage.itemindex := -1;
    54505629  //Fix for CQ: 7545
    54515630  if cboXDosage.ItemIndex > -1 then
    … …  
    55065685  //agp Change CQ 10719
    55075686   self.chkXPRN.OnClick(self.chkXPRN);
     5687   QuantityMessageCheck(self.grdDoses.Row);
    55085688end;
    55095689

  • cprs/trunk/CPRS-Chart/Orders/fODMisc.dfm

    r829 r1679  
    3434  end
    3535  inherited memOrder: TCaptionMemo
     36    TabStop = False
     37    TabOrder = 5
     38  end
     39  inherited cmdAccept: TButton
    3640    TabOrder = 6
    3741  end
    38   inherited cmdAccept: TButton
    39     TabOrder = 4
    40   end
    4142  inherited cmdQuit: TButton
    42     TabOrder = 5
     43    TabOrder = 7
    4344  end
    4445  inherited pnlMessage: TPanel
    45     TabOrder = 7
     46    TabOrder = 1
    4647  end
    4748  object cboCare: TORComboBox [8]
    48     Left = 6
    49     Top = 20
     49    Left = 8
     50    Top = 25
    5051    Width = 292
    5152    Height = 21
    5253    Style = orcsDropDown
    5354    AutoSelect = True
     55    Caption = 'Patient Care'
    5456    Color = clWindow
    5557    DropDownCount = 8
    … …  
    7577    Width = 140
    7678    Height = 21
    77     TabOrder = 2
     79    TabOrder = 3
    7880    Text = 'Now'
    7981    OnChange = ControlChange
    … …  
    8789    Width = 140
    8890    Height = 21
    89     TabOrder = 3
     91    TabOrder = 4
    9092    OnChange = ControlChange
    9193    DateOnly = False
    … …  
    98100    Width = 508
    99101    Height = 21
    100     TabOrder = 1
     102    TabOrder = 2
    101103    OnChange = ControlChange
    102104    Caption = 'Instructions'

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

    r829 r1679  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst,
    8   VA508AccessibilityManager;
     8  VA508AccessibilityManager, VA508AccessibilityRouter;
    99
    1010type
    … …  
    5656  InitDialog;
    5757  StatusText('');
     58  if ScreenReaderSystemActive then memOrder.TabStop := true;
    5859end;
    5960
    … …  
    7778    Changing := False;
    7879    ControlChange(Self);
    79     SetFocusedControl(txtComment);
     80    if not ScreenReaderSystemActive then SetFocusedControl(txtComment);
    8081  end;
    8182end;

  • cprs/trunk/CPRS-Chart/Orders/fODRad.dfm

    r829 r1679  
    88  Constraints.MinHeight = 404
    99  Constraints.MinWidth = 586
    10   ExplicitLeft = 282
    11   ExplicitTop = 225
    1210  ExplicitWidth = 586
    1311  ExplicitHeight = 404
    … …  
    1917    Width = 490
    2018    Anchors = [akLeft, akRight, akBottom]
    21     TabOrder = 6
     19    TabOrder = 4
    2220    ExplicitLeft = 0
    2321    ExplicitTop = 326
    … …  
    3230    ParentShowHint = False
    3331    ShowHint = True
    34     TabOrder = 7
     32    TabOrder = 3
    3533    Visible = False
    3634    ItemTipColor = clWindow
    … …  
    173171      Height = 18
    174172      Caption = 'Remove'
    175       TabOrder = 4
     173      TabOrder = 5
    176174      OnClick = cmdRemoveClick
    177175    end
    178176  end
    179   inherited cmdAccept: TButton
    180     Left = 497
    181     Top = 326
    182     Anchors = [akRight, akBottom]
    183     TabOrder = 3
    184     ExplicitLeft = 497
    185     ExplicitTop = 326
    186   end
    187   object pnlRightBase: TORAutoPanel [4]
     177  object pnlRightBase: TORAutoPanel [3]
    188178    Left = 215
    189179    Top = 0
    … …  
    233223      object lblSubmit: TLabel
    234224        Left = 154
    235         Top = 42
     225        Top = 45
    236226        Width = 48
    237227        Height = 13
    … …  
    264254        Width = 96
    265255        Height = 21
    266         TabOrder = 8
     256        TabOrder = 9
    267257        OnChange = calPreOpChange
    268258        OnExit = calPreOpExit
    … …  
    280270        ParentShowHint = False
    281271        ShowHint = True
    282         TabOrder = 6
     272        TabOrder = 7
    283273        OnClick = ControlChange
    284274        OnExit = chkIsolationExit
    … …  
    373363        Height = 17
    374364        Caption = 'Pre-Op'
    375         TabOrder = 9
     365        TabOrder = 13
    376366        Visible = False
    377367        OnClick = ControlChange
    … …  
    412402        ParentShowHint = False
    413403        ShowHint = True
    414         TabOrder = 5
     404        TabOrder = 6
    415405        Caption = 'Exams Over the Last 7 Days'
    416406        ItemTipColor = clWindow
    … …  
    424414        Height = 41
    425415        Caption = 'Pregnant'
    426         TabOrder = 7
     416        TabOrder = 8
    427417        object radPregnant: TRadioButton
    428418          Left = 2
    … …  
    453443        end
    454444      end
     445      object Submitlbl508: TVA508StaticText
     446        Name = 'Submitlbl508'
     447        Left = 154
     448        Top = 43
     449        Width = 120
     450        Height = 15
     451        Alignment = taLeftJustify
     452        Caption = 'Submit To (for screen R.)'
     453        Enabled = False
     454        TabOrder = 5
     455        Visible = False
     456        ShowAccelChar = True
     457      end
    455458    end
    456459    object pnlHandR: TPanel
    … …  
    505508    end
    506509  end
     510  inherited cmdAccept: TButton
     511    Left = 497
     512    Top = 326
     513    Anchors = [akRight, akBottom]
     514    TabOrder = 5
     515    ExplicitLeft = 497
     516    ExplicitTop = 326
     517  end
    507518  inherited cmdQuit: TButton
    508519    Left = 498
    509520    Top = 353
    510521    Anchors = [akRight, akBottom]
    511     TabOrder = 4
     522    TabOrder = 6
    512523    ExplicitLeft = 498
    513524    ExplicitTop = 353
    … …  
    519530    Height = 55
    520531    TabOrder = 2
     532    OnMouseUp = pnlMessageMouseUp
    521533    ExplicitLeft = 5
    522534    ExplicitTop = 318
    … …  
    596608      (
    597609        'Component = grpPregnant'
    598         'Status = stsDefault')
     610        'Text = Pregnant group box.  Disabled.  Patient is male.'
     611        'Status = stsOK')
    599612      (
    600613        'Component = radPregnant'
    … …  
    614627      (
    615628        'Component = txtReason'
    616         'Status = stsDefault')
     629       
     630          'Text = Reason for Study REQUIRED text 64 characters maximum leng' +
     631          'th'
     632        'Status = stsOK')
    617633      (
    618634        'Component = memOrder'
    … …  
    632648      (
    633649        'Component = frmODRad'
     650        'Status = stsDefault')
     651      (
     652        'Component = Submitlbl508'
    634653        'Status = stsDefault'))
    635654  end
     655  object VA508ComponentAccessibility1: TVA508ComponentAccessibility
     656    Component = memHistory
     657    OnStateQuery = VA508ComponentAccessibility1StateQuery
     658    Left = 336
     659    Top = 64
     660  end
     661  object VA508ComponentAccessibility2: TVA508ComponentAccessibility
     662    Component = grpPregnant
     663    Left = 536
     664    Top = 224
     665  end
    636666end

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

    r829 r1679  
    66  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    77  Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
    8   ComCtrls, uConst, ORDtTm, VA508AccessibilityManager;
     8  ComCtrls, uConst, ORDtTm, VA508AccessibilityManager, VA508AccessibilityRouter;
    99
    1010type
    … …  
    4949    txtReason: TCaptionEdit;
    5050    pnlRightBase: TORAutoPanel;
     51    Submitlbl508: TVA508StaticText;
     52    VA508ComponentAccessibility1: TVA508ComponentAccessibility;
     53    VA508ComponentAccessibility2: TVA508ComponentAccessibility;
    5154    procedure cboProcedureNeedData(Sender: TObject;
    5255              const StartFrom: string; Direction, InsertAt: Integer);
    … …  
    7174    procedure calPreOpExit(Sender: TObject);
    7275    procedure cboImTypeDropDownClose(Sender: TObject);
     76    procedure pnlMessageExit(Sender: TObject);
     77    procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
     78      var Text: string);
     79    procedure pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
     80      Shift: TShiftState; X, Y: Integer);
    7381  private
    7482    FLastRadID: string;
    … …  
    8290    procedure ImageTypeChange;
    8391    procedure FormFirstOpened(Sender: TObject);
     92    procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
    8493  protected
    8594    procedure InitDialog; override;
    … …  
    221230   i: integer;
    222231   tmplst: TStringList;
     232   cboSubmitText: String;
    223233begin
    224234  if not FEditCopy then
    … …  
    266276        lblSubmit.Enabled := False;
    267277        cboSubmit.Enabled := False;
     278        //TDP - CQ#19393 cboSubmit 508 changes
     279        cboSubmitText := cboSubmit.Text;
     280        if cboSubmitText = '' then cboSubmitText := 'No Value';
     281        setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
    268282        cboSubmit.Font.Color := clGrayText;
    269283      end
    … …  
    283297            lblSubmit.Enabled := True;
    284298            cboSubmit.Enabled := True;
     299            //TDP - CQ#19393 cboSubmit 508 changes
     300            cboSubmitText := cboSubmit.Text;
     301            if cboSubmitText = '' then cboSubmitText := 'No Value';
     302            setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
    285303            cboSubmit.Font.Color := clWindowText;
    286304          end
    … …  
    290308            lblSubmit.Enabled := False;
    291309            cboSubmit.Enabled := False;
     310            //TDP - CQ#19393 cboSubmit 508 changes
     311            cboSubmitText := cboSubmit.Text;
     312            if cboSubmitText = '' then cboSubmitText := 'No Value';
     313            setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
    292314            cboSubmit.Font.Color := clGrayText;
    293315          end;
    … …  
    301323        lblSubmit.Enabled := False;
    302324        cboSubmit.Enabled := False;
     325        //TDP - CQ#19393 cboSubmit 508 changes
     326        cboSubmitText := cboSubmit.Text;
     327        if cboSubmitText = '' then cboSubmitText := 'No Value';
     328        setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
    303329        cboSubmit.Font.Color := clGrayText;
    304330      end;
    … …  
    311337  cboProcedure.InitLongList('') ;
    312338  StatusText('');
    313  
    314339end;
    315340
    … …  
    349374  else with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
    350375  memOrder.Text := Responses.OrderText;
     376end;
     377
     378//TDP - CQ#19393 Made history memobox read text
     379procedure TfrmODRad.VA508ComponentAccessibility1StateQuery(Sender: TObject;
     380  var Text: string);
     381begin
     382  inherited;
     383  Text := memHistory.Text;
    351384end;
    352385
    … …  
    639672  if (Patient.Sex <> 'F') then
    640673  begin
     674    //TDP - CQ#19393 change to allow grpPregnant to be tabbed to if screen reader active
     675    if ScreenReaderSystemActive then grpPregnant.TabStop := True;
    641676    radPregnant.Enabled := False;
    642677    radPregnantNo.Enabled := False;
    … …  
    695730begin
    696731  if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
     732  begin
    697733    radPregnantNo.Checked := True;
     734    grpPregnant.TabStop := False;
     735  end;
    698736end;
    699737
    … …  
    720758end;
    721759
     760//TDP - CQ#19393 cboSubmit 508 changes. Can change in future to be generic if needed. (See fODLab.pas)
     761procedure TfrmODRad.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
     762begin
     763  if ScreenReaderSystemActive and not ctrl.Enabled then begin
     764    lbl.Enabled := True;
     765    lbl.Visible := True;
     766    lbl.Caption := lblSubmit.Caption + '. Read Only. Value is ' + Text;
     767    lbl.Width := lblSubmit.Width + 2;
     768  end else
     769    lbl.Visible := false;
     770end;
     771
    722772procedure TfrmODRad.cboProcedureExit(Sender: TObject);
    723773var
    … …  
    739789    for i := 0 to Items.Count - 1 do
    740790      Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
     791  //TDP - Made Order Message next focus if showing and Tab or Entered was pressed
     792  if (pnlMessage.Showing) AND ((TabIsPressed()) OR (EnterIsPressed())) then memMessage.SetFocus;
    741793end;
    742794
    … …  
    778830begin
    779831  result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
     832end;
     833
     834{TDP - Added to control where focus went now that pnlMessage was being focused
     835       out of turn after cboProcedure.}
     836procedure TfrmODRad.pnlMessageExit(Sender: TObject);
     837begin
     838  inherited;
     839  if TabIsPressed() then cboAvailMod.SetFocus;
     840  if ShiftTabIsPressed() then cboProcedure.SetFocus;
     841end;
     842
     843{TDP - Added to control where focus went now that pnlMessage was being focused
     844       out of turn after cboProcedure.}
     845procedure TfrmODRad.pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
     846  Shift: TShiftState; X, Y: Integer);
     847begin
     848  inherited;
     849  cboProcedure.SetFocus;
    780850end;
    781851

  • cprs/trunk/CPRS-Chart/Orders/fODRadConShRes.dfm

    r829 r1679  
    99  OldCreateOrder = True
    1010  Position = poScreenCenter
     11  ExplicitWidth = 294
     12  ExplicitHeight = 146
    1113  PixelsPerInch = 96
    1214  TextHeight = 13

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

    r829 r1679  
    6060             Enabled := True;
    6161             SelectByID(Piece(Source,U,1));
    62              BringToFront;
     62             cboSource.Visible := True;
     63             txtResearch.Visible := False;
     64             //BringToFront;
    6365             ShowModal;
    6466            end
    … …  
    7173        begin
    7274          cboSource.Enabled := False;
    73           txtResearch.BringToFront;
     75          cboSource.Visible := False;
     76          srcLabel.Caption := 'Enter Source:';
     77          txtResearch.Visible := True;
     78          //txtResearch.BringToFront;
    7479          txtResearch.Text := Source;
    7580          ShowModal;

  • cprs/trunk/CPRS-Chart/Orders/fODReleaseEvent.dfm

    r829 r1679  
    99  OnDestroy = FormDestroy
    1010  ExplicitWidth = 494
    11   ExplicitHeight = 488
     11  ExplicitHeight = 495
    1212  PixelsPerInch = 96
    1313  TextHeight = 13

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

    r829 r1679  
    118118      SendReleaseOrders(OrdersLst);
    119119      LastCheckedPtEvt := '';
     120
     121      //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
    120122      with OrdersLst do if Count > 0 then for i := 0 to Count - 1 do
    121123      begin
    … …  
    123125        begin
    124126          OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
    125           if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then
     127          if Piece(OrdersLst[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
    126128          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
    127                   'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
    128                   TC_SAVERR, MB_OK)
     129                  TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
     130          else if Piece(OrdersLst[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
     131          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
     132                  TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
    129133          else
    130134          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,

  • cprs/trunk/CPRS-Chart/Orders/fODText.dfm

    r829 r1679  
    11inherited frmODText: TfrmODText
     2  Width = 525
     3  Height = 279
     4  Anchors = [akLeft, akTop, akBottom]
    25  Caption = 'Text Only Order'
     6  ExplicitWidth = 525
     7  ExplicitHeight = 279
    38  PixelsPerInch = 96
    49  TextHeight = 13
    … …  
    2429    Caption = 'Stop Date/Time'
    2530  end
     31  object lblOrderSig: TLabel [3]
     32    Left = 8
     33    Top = 178
     34    Width = 44
     35    Height = 13
     36    Caption = 'Order Sig'
     37  end
    2638  inherited memOrder: TCaptionMemo
    27     TabOrder = 6
    28   end
    29   inherited cmdAccept: TButton
    30     TabOrder = 3
     39    TabOrder = 4
    3140  end
    3241  object memText: TMemo [5]
    … …  
    3544    Width = 508
    3645    Height = 124
    37     TabOrder = 0
     46    Anchors = [akLeft, akTop, akBottom]
     47    TabOrder = 1
    3848    OnChange = ControlChange
    3949  end
    … …  
    4353    Width = 140
    4454    Height = 21
    45     TabOrder = 1
     55    TabOrder = 2
    4656    OnChange = ControlChange
    4757    DateOnly = False
    … …  
    5464    Width = 140
    5565    Height = 21
    56     TabOrder = 2
     66    TabOrder = 3
    5767    OnChange = ControlChange
    5868    DateOnly = False
    … …  
    6070    Caption = 'Stop Date/Time'
    6171  end
     72  inherited cmdAccept: TButton
     73    TabOrder = 5
     74  end
    6275  inherited cmdQuit: TButton
    63     TabOrder = 4
     76    TabOrder = 6
    6477  end
    6578  inherited pnlMessage: TPanel
    66     TabOrder = 5
     79    TabOrder = 0
    6780  end
    6881  inherited amgrMain: TVA508AccessibilityManager
    … …  
    7992      (
    8093        'Component = memOrder'
    81         'Status = stsDefault')
     94        'Label = lblOrderSig'
     95        'Status = stsOK')
    8296      (
    8397        'Component = cmdAccept'
    … …  
    96110        'Status = stsDefault'))
    97111  end
     112  object VA508CompMemOrder: TVA508ComponentAccessibility
     113    Component = memOrder
     114    OnStateQuery = VA508CompMemOrderStateQuery
     115    Left = 152
     116    Top = 216
     117  end
    98118end

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

    r829 r1679  
    1616    lblStart: TLabel;
    1717    lblStop: TLabel;
     18    VA508CompMemOrder: TVA508ComponentAccessibility;
     19    lblOrderSig: TLabel;
    1820    procedure FormCreate(Sender: TObject);
    1921    procedure ControlChange(Sender: TObject);
    2022    procedure cmdAcceptClick(Sender: TObject);
     23    procedure VA508CompMemOrderStateQuery(Sender: TObject; var Text: string);
    2124  public
    2225    procedure InitDialog; override;
    … …  
    7073  end
    7174  else txtStart.Text := 'NOW';
     75end;
     76
     77procedure TfrmODText.VA508CompMemOrderStateQuery(Sender: TObject;
     78  var Text: string);
     79begin
     80  inherited;
     81  Text := memOrder.Text;
    7282end;
    7383

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

    r829 r1679  
    647647  if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin
    648648    OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]);
     649    Text := OrderMenuItem.Mnemonic + ', ' + OrderMenuItem.ItemText;
    649650    if OrderMenuItem.AutoAck then
    650       Text := 'Auto Accept, '+ OrderMenuItem.ItemText;
     651      Text := 'Auto Accept, '+ Text;
    651652  end;
    652653end;

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

    r829 r1679  
    109109  SetItem: TSetItem;
    110110  theOwner: TComponent;
     111  ok: boolean;
    111112
    112113  procedure SkipToNext;
    113114  begin
     115    if FClosing then Exit;
    114116    lstSet.Checked[lstSet.ItemIndex] := True;
    115117    DoNextItem;
    … …  
    117119
    118120begin
    119   DoingNextItem := true;
     121   DoingNextItem := true;
    120122  //frmFrame.UpdatePtInfoOnRefresh;
    121123  if FClosing then Exit;
    … …  
    144146    'A':      if not ActivateAction(IntToStr(SetItem.DialogIEN), Self, ItemIndex) then
    145147              begin
    146                 if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
    147                   lstSet.Checked[lstSet.ItemIndex] := True
    148                 else SkipToNext;
     148                if Not FClosing then
     149                begin
     150                  if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
     151                    lstSet.Checked[lstSet.ItemIndex] := True
     152                  else SkipToNext;
     153                end;
    149154              end;
    150155    'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
     156              begin
     157                if Not FClosing then
     158                begin
     159                  if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
     160                    lstSet.Checked[lstSet.ItemIndex] := True
     161                  else SkipToNext;
     162                end;
     163              end;
     164    'M':      begin
     165                ok := ActivateOrderMenu(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex);
     166                if not FClosing then
     167                begin
     168                  if ok then
     169                    Inc(FActiveMenus)
     170                  else
     171                  begin
     172                    if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
     173                      lstSet.Checked[lstSet.ItemIndex] := True
     174                    else
     175                      SkipToNext;
     176                  end;
     177                end;
     178              end;
     179    'O':      begin
     180                if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
     181                if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
    151182                begin
    152183                  if Not FClosing then
    … …  
    157188                  end;
    158189                end;
    159     'M':      if ActivateOrderMenu(  IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)
    160                 then Inc(FActiveMenus)
    161                 else
    162                 begin
    163                   if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
    164                     lstSet.Checked[lstSet.ItemIndex] := True
    165                   else
    166                     SkipToNext;
    167                 end;
    168     'O':      begin
    169                 if (Self.Owner.Name = 'frmOMNavA') then theOwner := Self.Owner else theOwner := self;
    170                 if not ActivateOrderSet( IntToStr(SetItem.DialogIEN), FDelayEvent, theOwner, ItemIndex) then
    171                 begin
    172                   if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
    173                     lstSet.Checked[lstSet.ItemIndex] := True
    174                   else SkipToNext;
    175                 end;
    176190              end;
    177191    else      begin
    … …  
    186200procedure TfrmOMSet.UMDelayEvent(var Message: TMessage);
    187201begin
     202  if CloseRequested then
     203  begin
     204    Close;
     205    if Not FClosing then
     206      begin
     207        CloseRequested := False;
     208        FClosing := False;
     209        DoNextItem;
     210      end
     211      else Exit;
     212  end;
    188213  // ignore if delay from other than current itemindex
    189214  // (prevents completion of an order set from calling DoNextItem)
    190215  if Message.WParam = lstSet.ItemIndex then
    191216    if lstSet.ItemIndex < lstSet.Items.Count - 1 then DoNextItem else Close;
    192   if CloseRequested then
    193     Close;
    194217end;
    195218
    … …  
    252275 else if lstSet.ItemIndex < (lstSet.Items.Count - 1)
    253276   then CanClose := InfoBox(TX_STOP, TC_STOP, MB_YESNO) = IDYES;
     277   FClosing := CanClose;
    254278end;
    255279
    … …  
    281305begin
    282306  if DoingNextItem then
    283     CloseRequested := true              //Fix for CQ: 8297
     307  begin
     308    CloseRequested := true;             //Fix for CQ: 8297
     309    FClosing := true;
     310  end
    284311  else
    285312    Close;

  • cprs/trunk/CPRS-Chart/Orders/fOMVerify.dfm

    r829 r1679  
    88  OnClose = FormClose
    99  OnCreate = FormCreate
     10  OnShow = FormShow
    1011  ExplicitWidth = 587
    1112  ExplicitHeight = 208
    … …  
    4647    Width = 567
    4748    Height = 132
     49    TabStop = False
    4850    Font.Charset = ANSI_CHARSET
    4951    Font.Color = clWindowText
    … …  
    6567      '10')
    6668    ParentFont = False
     69    ReadOnly = True
    6770    ScrollBars = ssBoth
    6871    TabOrder = 3
    6972    WantTabs = True
    7073    WordWrap = False
    71     OnKeyUp = memTextKeyUp
     74    OnKeyDown = memTextKeyDown
    7275  end
    7376  inherited amgrMain: TVA508AccessibilityManager
    … …  
    8487      (
    8588        'Component = memText'
    86         'Status = stsDefault')
     89        'Text = Order information.'
     90        'Status = stsOK')
    8791      (
    8892        'Component = frmOMVerify'
    8993        'Status = stsDefault'))
    9094  end
     95  object VA508ComponentAccessibility1: TVA508ComponentAccessibility
     96    Component = memText
     97    OnStateQuery = VA508ComponentAccessibility1StateQuery
     98    Left = 48
     99    Top = 32
     100  end
    91101end

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

    r829 r1679  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager;
     7  fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager, VA508AccessibilityRouter;
    88
    99type
    … …  
    1313    cmdCancel: TButton;
    1414    memText: TRichEdit;
     15    VA508ComponentAccessibility1: TVA508ComponentAccessibility;
    1516    procedure cmdAcceptClick(Sender: TObject);
    1617    procedure cmdEditClick(Sender: TObject);
    … …  
    2021    procedure memTextKeyUp(Sender: TObject; var Key: Word;
    2122      Shift: TShiftState);
     23    procedure FormDestroy(Sender: TObject);
     24    procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
     25      var Text: string);
     26    procedure FormShow(Sender: TObject);
     27    procedure memTextKeyDown(Sender: TObject; var Key: Word;
     28      Shift: TShiftState);
    2229  private
    2330    FLevel: Integer;
    … …  
    2633procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False);
    2734
     35var
     36 frmOMVerify: TfrmOMVerify;
    2837implementation
    2938
    … …  
    3443procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean);
    3544var
    36   frmOMVerify: TfrmOMVerify;
     45  //frmOMVerify: TfrmOMVerify;
    3746  tempStrs,prompts: TStringList;
    3847  flag: boolean;
    … …  
    6877  prompts.Add('priority');
    6978  frmOMVerify := TfrmOMVerify.Create(Application);
    70   try
    7179    ResizeFormToFont(TForm(frmOMVerify));
    7280    if InptDispGrp then
    … …  
    7987      SetString(VerifyText, tempStrs.GetText, StrLen(tempStrs.GetText))
    8088    end;
    81 
    82     with frmOMVerify do
    83     begin
    84       SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height);
    8589      SetFormPosition(frmOMVerify);
    8690      ExpandOrderObjects(VerifyText, HasObjects);
    87       memText.Lines.SetText(PChar(VerifyText));
    88       ShowModal;
    89       QuickLevel := FLevel;
    90     end;
    91   finally
    92     frmOMVerify.Release;
    93   end;
     91      frmOMVerify.memText.Lines.SetText(PChar(VerifyText));
     92      frmOMVerify.ShowModal;
     93      if frmOMVerify.ModalResult = mrOK then
     94        begin
     95          QuickLevel := frmOMVerify.FLevel;
     96        end;
     97      //agp on CPRS timeout ModalResult equal mrCancel this prevent starting a new order
     98      //when the chart is timing out.
     99      if frmOMVerify.ModalResult = mrCancel then QuickLevel := QL_CANCEL;     
     100     frmOMVerify.Free;
    94101end;
    95102
    … …  
    98105begin
    99106  inherited;
     107  frmOMVerify := nil;
    100108  FLevel := QL_CANCEL;
     109  ModalResult := mrNone;
     110end;
     111
     112
     113procedure TfrmOMVerify.FormDestroy(Sender: TObject);
     114begin
     115  inherited;
     116  frmOMVerify := nil;
     117end;
     118
     119procedure TfrmOMVerify.FormShow(Sender: TObject);
     120begin
     121  inherited;
     122  if ScreenReaderSystemActive then
     123  begin
     124    memText.TabStop := true;
     125    memText.SetFocus;
     126  end;
    101127end;
    102128
    … …  
    105131  inherited;
    106132  FLevel := QL_AUTO;
    107   Close;
     133  ModalResult := mrOK;
    108134end;
    109135
    … …  
    112138  inherited;
    113139  FLevel := QL_DIALOG;
    114   Close;
     140  ModalResult := mrOK;
    115141end;
    116142
    … …  
    119145  inherited;
    120146  FLevel := QL_CANCEL;
    121   Close;
     147  ModalResult := mrOK;
    122148end;
    123149
    … …  
    129155end;
    130156
     157procedure TfrmOMVerify.memTextKeyDown(Sender: TObject; var Key: Word;
     158  Shift: TShiftState);
     159begin
     160  inherited;
     161  if ShiftTabIsPressed() then
     162  begin
     163    FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
     164    Key := 0;
     165  end;
     166  if TabIsPressed() then
     167  begin
     168    FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
     169    Key := 0;
     170  end;
     171  if (key = VK_ESCAPE) then begin
     172    FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
     173    key := 0;
     174  end;
     175end;
     176
    131177procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word;
    132178  Shift: TShiftState);
    133179begin
    134180  inherited;
    135   if (Key = VK_TAB) then
     181  {if (Key = VK_TAB) then
    136182  begin
    137183    if ssShift in Shift then
    … …  
    149195    FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
    150196    key := 0;
    151   end;
     197  end; }
     198end;
     199
     200procedure TfrmOMVerify.VA508ComponentAccessibility1StateQuery(Sender: TObject;
     201  var Text: string);
     202begin
     203  inherited;
     204  Text := memText.Text;
    152205end;
    153206

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

    r829 r1679  
    44  HelpContext = 4000
    55  Caption = 'Orders Page'
    6   ClientHeight = 571
     6  ClientHeight = 591
    77  ClientWidth = 766
    88  HelpFile = 'overvw'
    … …  
    1111  OnShow = FormShow
    1212  ExplicitWidth = 774
    13   ExplicitHeight = 617
     13  ExplicitHeight = 645
    1414  PixelsPerInch = 96
    1515  TextHeight = 13
    1616  inherited shpPageBottom: TShape
    17     Top = 566
     17    Top = 586
    1818    Width = 766
    1919    ExplicitTop = 528
    … …  
    2222  inherited sptHorz: TSplitter
    2323    Left = 117
    24     Height = 566
     24    Height = 586
    2525    OnMoved = sptHorzMoved
    2626    ExplicitLeft = 117
    … …  
    2929  inherited pnlLeft: TPanel
    3030    Width = 117
    31     Height = 566
     31    Height = 586
    3232    ExplicitWidth = 117
    33     ExplicitHeight = 566
     33    ExplicitHeight = 586
    3434    object OROffsetLabel1: TOROffsetLabel
    3535      Left = 0
    … …  
    6464      Cursor = crVSplit
    6565      Align = alTop
     66      OnMoved = sptVertMoved
    6667    end
    6768    object lstSheets: TORListBox
    … …  
    7172      Height = 56
    7273      Align = alTop
     74      Constraints.MinHeight = 30
    7375      ItemHeight = 13
    7476      ParentShowHint = False
    … …  
    8587      Top = 116
    8688      Width = 117
    87       Height = 450
     89      Height = 470
    8890      Align = alClient
    8991      ItemHeight = 13
    … …  
    112114    Left = 121
    113115    Width = 645
    114     Height = 566
     116    Height = 586
    115117    ParentColor = True
    116118    ParentCtl3D = False
    … …  
    119121    ExplicitLeft = 121
    120122    ExplicitWidth = 645
    121     ExplicitHeight = 566
     123    ExplicitHeight = 586
    122124    object lblOrders: TOROffsetLabel
    123125      Left = 0
    … …  
    226228      Top = 36
    227229      Width = 645
    228       Height = 530
     230      Height = 550
    229231      Style = lbOwnerDrawVariable
    230232      Align = alClient

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

    r829 r1679  
    163163      Section: THeaderSection);
    164164    procedure sptHorzMoved(Sender: TObject);
     165    procedure sptVertMoved(Sender: TObject);
    165166  private
    166167    { Private declarations }
    … …  
    225226    function AllowContextChange(var WhyNot: string): Boolean; override;
    226227    function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean;
    227     function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False): boolean;
     228    function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False; Signing: boolean = False): boolean;
    228229    procedure RefreshToFirstItem;
    229230    procedure ChangesUpdate(APtEvtID: string);
    … …  
    11761177    FCompress := False;
    11771178  end;
    1178 
     1179  //CQ 18660 Orders for events should be modal. Orders for non-event should not be modal
     1180  if AnOrderView.EventDelay.EventIFN = 0 then NeedShowModal := False
     1181  else NeedShowModal := True;
    11791182  if (FCurrentView <> nil) and (AnOrderView.EventDelay.EventIFN <> FCurrentView.EventDelay.EventIFN) and (FCurrentView.EventDelay.EventIFN > 0 ) then
    11801183  begin
    … …  
    13981401      begin
    13991402        result := MixedCase(ProviderName);
    1400         result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1);
     1403//        result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1);
     1404// CQ#15915
     1405        result := Piece(result, ',', 1) + ',' + Piece(result, ',', 2);
    14011406      end;
    14021407      5: result := VerNurse;
    … …  
    23502355  ALocation: Integer;
    23512356  AName: string;
    2352 begin
    2353   inherited;
     2357  Delayed: boolean;
     2358begin
     2359  inherited;
     2360  Delayed := False;
    23542361  if NoneSelected(TX_NOSEL_SIGN) then Exit;
    23552362  if not AuthorizedUser then Exit;
    … …  
    23752382  if not LockedForOrdering then Exit;
    23762383
    2377   if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
    2378     Exit;
     2384  //CQ 18392 and CQ 18121 Made changes to this code, PtEVTComplete function and the finally statement at the end to support the fix for these CQs
     2385  if (FCurrentView.EventDelay.PtEventIFN>0) then
     2386      Delayed := (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName, false, true));
     2387  //if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
     2388  //  Exit;
    23792389
    23802390  SelectedList := TList.Create;
    … …  
    24132423    SelectedList.Free;
    24142424    UnlockIfAble;
     2425    //CQ #17491: Added UpdatePtInfoOnRefresh here to allow for the updating of the patient
     2426    //status indicator in the header bar if the patient becomes admitted/discharged.
     2427    frmFrame.UpdatePtInfoOnRefresh;
     2428    if Delayed = True then
     2429      begin
     2430        InitOrderSheetsForEvtDelay;
     2431        lstSheets.ItemIndex := 0;
     2432        lstSheetsClick(self);
     2433        RefreshOrderList(True);
     2434      end;
    24152435  end;
    24162436end;
    … …  
    32433263end;
    32443264
    3245 function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean): boolean;
     3265function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean; Signing: boolean): boolean;
    32463266begin
    32473267  Result := False;
    … …  
    32533273      InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING);
    32543274    GroupChangesUpdate('Delayed ' + APtEvtName);
     3275    if signing = true then
     3276      begin
     3277        Result := True;
     3278        exit;
     3279      end;
    32553280    InitOrderSheetsForEvtDelay;
    32563281    lstSheets.ItemIndex := 0;
    … …  
    33383363        hdrOrders.Sections[i].Width := origWidths[i];
    33393364      lstOrders.Invalidate;
     3365      RefreshOrderList(false);
    33403366    end;
    33413367  end;
    … …  
    34743500end;
    34753501
     3502procedure TfrmOrders.sptVertMoved(Sender: TObject);
     3503begin
     3504  inherited;
     3505  if self.sptVert.Top < self.lstSheets.Constraints.MinHeight then
     3506     self.sptVert.Top := self.lstSheets.Constraints.MinHeight + 1;
     3507 
     3508end;
     3509
    34763510initialization
    34773511  SpecifyFormIsNotADialog(TfrmOrders);

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

    r829 r1679  
    8080      frmDCOrders.lblReason.Visible := True;
    8181      frmDCOrders.lstReason.Visible := True;
     82      frmDCOrders.lstReason.ScrollWidth := 10;
    8283    end else
    8384    begin

  • cprs/trunk/CPRS-Chart/Orders/fOrdersOnChart.dfm

    r829 r1679  
    88  OnCreate = FormCreate
    99  ExplicitWidth = 470
    10   ExplicitHeight = 368
     10  ExplicitHeight = 375
    1111  PixelsPerInch = 96
    1212  TextHeight = 13

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

    r829 r1679  
    9393          uCore.TempEncounterLocName := '';
    9494
     95      //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
    9596        with SignList do if Count > 0 then for i := 0 to Count - 1 do
    9697          begin
    … …  
    9899              begin
    99100                OrderText := FindOrderText(Piece(SignList[i], U, 1));
    100                 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     101                if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
    101102                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
    102                         'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
    103                         TC_SAVERR, MB_OK)
     103                        TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
     104                else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
     105                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
     106                        TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
    104107                else
    105108                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,

  • cprs/trunk/CPRS-Chart/Orders/fOrdersRelease.dfm

    r829 r1679  
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
    8   ExplicitLeft = 318
    9   ExplicitTop = 186
    108  ExplicitHeight = 377
    119  PixelsPerInch = 96

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

    r829 r1679  
    128128
    129129
     130      //CQ #15813 Modired code to look for error string mentioned in CQ and change strings to conts - JCS
    130131        with SignList do if Count > 0 then for i := 0 to Count - 1 do
    131132        begin
    … …  
    133134          begin
    134135            OrderText := FindOrderText(Piece(SignList[i], U, 1));
    135                 if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     136                if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
    136137                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
    137                         'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
    138                         TC_SAVERR, MB_OK)
     138                        TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
     139                else if Piece(SignList[i],U,4) = TX_SAVERR_IMAGING_PROC_SEARCH_STRING then
     140                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
     141                        TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
    139142                else
    140143                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,

  • cprs/trunk/CPRS-Chart/Orders/fOrdersRenew.dfm

    r829 r1679  
    5858      Caption = 'Cancel'
    5959      Constraints.MinHeight = 21
    60       TabOrder = 0
     60      TabOrder = 2
    6161      OnClick = cmdCancelClick
    6262    end
    … …  
    8181      Constraints.MinHeight = 21
    8282      Enabled = False
    83       TabOrder = 2
     83      TabOrder = 0
    8484      OnClick = cmdChangeClick
    8585    end
    … …  
    111111    OnMeasureItem = lstOrdersMeasureItem
    112112    HintOnItem = True
     113    ExplicitTop = 12
    113114  end
    114115  inherited amgrMain: TVA508AccessibilityManager

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

    r829 r1679  
    262262  FixHeaderControlDelphi2006Bug(hdrOrders);
    263263  OKPressed := False;
     264  hdrOrders.Sections[0].Width := Round(self.width * 0.75);
     265  hdrOrders.Sections[1].Width := Round(self.width * 0.25);
    264266  ResizeFormToFont(Self);
    265   SetFormPosition(Self); 
     267  SetFormPosition(Self);
    266268end;
    267269
    … …  
    410412var
    411413  ARect: TRect;
    412 begin
     414  cnt: integer;
     415  x: string;
     416begin
     417  cnt := 0;
    413418  ARect.Left := 0;
    414419  ARect.Top := 0;
    … …  
    416421  ARect.Right := hdrOrders.Sections[Column].Width -6;
    417422  Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,TheOrderText,ARect);
     423  //AGP 28.0 this fix address the issue of WrappedTextHeightByFont appearing to not take in account CRLF
     424  if Pos(CRLF, TheOrderText) > 0 then
     425    begin
     426      repeat
     427        x := Copy(TheOrderText, 1, Pos(CRLF, TheOrderText) - 1);
     428        if Length(x) = 0 then x := TheOrderText;
     429        Delete(TheOrderText, 1, Length(x) + 2);  {delete text + CRLF}
     430        cnt := cnt + 1;
     431      until TheOrderText = '';
     432      if cnt > 0 then Result := Result + (cnt * Abs(self.Font.Height));
     433      if Result > 255 then Result := 255;
     434    end;
     435 
    418436end;
    419437
    … …  
    423441  OIInfo,FillerID: string;
    424442  AnOIList: TStringList;
     443  subI: integer;
    425444begin
    426445  AnOIList := TStringList.Create;
    427446  OIInfo := DataForOrderCheck(AnOrderID);
    428447  FillerID := Piece(OIInfo,'^',2);
    429   AnOIList.Add(OIInfo);
    430   OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID);
     448  subI := 1;
     449  while Length(Piece(OIInfo,'|',subI))>1 do
     450  begin
     451    AnOIList.Add(Piece(OIInfo,'|',subI));
     452    subI := subI + 1;
     453  end;
     454  OrderChecksOnAccept(OCList, FillerID, '', AnOIList, AnOrderID,'1');
    431455  Result :=  AcceptOrderWithChecks(OCList);
    432456end;

  • cprs/trunk/CPRS-Chart/Orders/fOrdersSign.dfm

    r829 r1679  
    1414  OnShow = FormShow
    1515  ExplicitWidth = 841
    16   ExplicitHeight = 514
     16  ExplicitHeight = 521
    1717  DesignSize = (
    1818    833

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

    r829 r1679  
    77uses
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    9   fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
     9  fAutoSz, StdCtrls, StrUtils, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
    1010  ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
    1111  Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;
    … …  
    211211  OrderText, ASvc: string;
    212212  PrintLoc: Integer;
    213   AList, ClinicList, DCList, OrderPrintList, WardList: TStringList;
     213  AList, ClinicList, OrderPrintList, WardList: TStringList;
    214214  EncLocName, EncLocText: string;
    215215  EncLocIEN: integer;
    216216  EncDT: TFMDateTime;
    217217  EncVC: Char;
     218  //ChangeItem: TChangeItem;
    218219
    219220  function FindOrderText(const AnID: string): string;
    … …  
    330331    end;
    331332
    332       frmSignOrders.ShowModal;
     333     frmSignOrders.ShowModal;
    333334      if frmSignOrders.OKPressed then
    334335      begin
    … …  
    428429               if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
    429430                   begin
    430                      DCList := TStringList.Create;
    431431                     EncLocName := Encounter.LocationName;
    432432                     EncLocIEN  := Encounter.Location;
    … …  
    440440                         if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true;
    441441                         if TOrder(SelectedList.Items[i]).DGroupName = '' then continue;
    442                          if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue;
    443                          if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then
     442                         if (Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0) or
     443                            (TOrder(SelectedList.Items[i]).IsOrderPendDC = true) then
    444444                           begin
    445                              DCList.Add(TOrder(SelectedList.Items[i]).ID);
     445                             WardList.Add(TOrder(SelectedList.Items[i]).ID);
    446446                             Continue;
    447447                           end;
     448                         //ChangeItem := Changes.Locate(20,TOrder(SelectedList.Items[i]).ID);
     449                         //if ChangeItem = nil then continue;
     450                         //if ChangeItem.Delay = true then continue;
     451                         if TOrder(SelectedList.Items[i]).IsDelayOrder = true then continue;                         
    448452                         OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text);
    449453                       end;
    … …  
    452456                          frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
    453457                                                        WardList, WardIen,WardName, ContainsIMOOrders, true);
    454                           fframe.frmFrame.OrderPrintForm := false;
     458                          //fframe.frmFrame.OrderPrintForm := false;
    455459                        end
    456                       else DoNotPrint := True;
    457                       if (DCList <> nil) and (DCList.Count > 0) then
    458                         begin
    459                           for i := 0 to DCList.Count - 1 do
    460                              WardList.Add(DCList.Strings[i]);
    461                           if (WardIEN = 0) and (WardName = '') then
    462                           CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
     460                        else if (clinicList.count = 0) and (wardList.Count = 0) then DoNotPrint := True;
     461                        if (WardIEN = 0) and (WardName = '') then CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
    463462                        end;
    464                       if DCList <> nil then DCList.Free;
    465                    end;
    466463            end;
    467464            uCore.TempEncounterLoc := 0;
    … …  
    473470          end;
    474471
     472          //CQ #15813 Modified code to look for error string mentioned in CQ and change strings to conts - JCS
     473          //CQ #15813 Adjusted code to handle error message properly - TDP
    475474            with SignList do if Count > 0 then for i := 0 to Count - 1 do
    476475            begin
    … …  
    478477                begin
    479478                  OrderText := FindOrderText(Piece(SignList[i], U, 1));
    480                   if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     479                  if Piece(SignList[i],U,4) = TX_SAVERR_PHARM_ORD_NUM_SEARCH_STRING then
    481480                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
    482                         'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
    483                         TC_SAVERR, MB_OK)
     481                        TX_SAVERR_PHARM_ORD_NUM, TC_SAVERR, MB_OK)
     482                  else if AnsiContainsStr(Piece(SignList[i],U,4), TX_SAVERR_IMAGING_PROC_SEARCH_STRING) then
     483                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
     484                        TX_SAVERR_IMAGING_PROC, TC_SAVERR, MB_OK)
    484485                  else
    485486                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,

  • cprs/trunk/CPRS-Chart/Orders/fOrdersTS.dfm

    r829 r1679  
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    11   ExplicitLeft = 84
    12   ExplicitTop = 77
    1311  ExplicitWidth = 464
    1412  ExplicitHeight = 385
    … …  
    1715  object pnlMiddle: TPanel [0]
    1816    Left = 0
    19     Top = 78
     17    Top = 60
    2018    Width = 456
    2119    Height = 56
    2220    Align = alTop
    2321    Constraints.MinHeight = 45
    24     TabOrder = 0
     22    TabOrder = 1
    2523    object grpChoice: TGroupBox
    2624      Left = 1
    … …  
    8179    Top = 0
    8280    Width = 456
    83     Height = 78
     81    Height = 60
    8482    Align = alTop
    8583    Anchors = [akLeft, akTop, akRight, akBottom]
    8684    AutoSize = True
    8785    BorderStyle = bsSingle
    88     TabOrder = 1
    89     object lblPtInfo: TLabel
     86    TabOrder = 0
     87    object lblPtInfo: TVA508StaticText
     88      Name = 'lblPtInfo'
    9089      Left = 1
    9190      Top = 1
    92       Width = 3
     91      Width = 450
    9392      Height = 34
    9493      Align = alTop
    95       Color = clBtnFace
     94      Alignment = taLeftJustify
    9695      Constraints.MinHeight = 34
    97       ParentColor = False
    98       Layout = tlCenter
     96      TabOrder = 0
     97      ShowAccelChar = True
    9998    end
    10099    object pnldif: TPanel
    … …  
    102101      Top = 35
    103102      Width = 450
    104       Height = 38
     103      Height = 20
    105104      Align = alTop
    106105      Anchors = [akLeft, akTop, akRight, akBottom]
    107       TabOrder = 0
     106      TabOrder = 1
    108107      object Image1: TImage
    109108        Left = 1
    110109        Top = 1
    111110        Width = 24
    112         Height = 22
     111        Height = 18
    113112        Align = alLeft
    114113        AutoSize = True
    … …  
    131130        ExplicitHeight = 36
    132131      end
    133       object Label1: TLabel
     132      object lblUseAdmit: TVA508StaticText
     133        Name = 'lblUseAdmit'
    134134        Left = 34
    135135        Top = 4
    136         Width = 327
    137         Height = 13
     136        Width = 329
     137        Height = 15
     138        Alignment = taLeftJustify
    138139        Caption =
    139140          'Use Admit: if patient is newly admitted to the hospital or nursi' +
    140141          'ng home.'
    141       end
    142       object Label2: TLabel
     142        TabOrder = 0
     143        ShowAccelChar = True
     144      end
     145      object lblUseTransfer: TVA508StaticText
     146        Name = 'lblUseTransfer'
    143147        Left = 34
    144148        Top = 21
    145         Width = 361
    146         Height = 13
     149        Width = 363
     150        Height = 15
     151        Alignment = taLeftJustify
    147152        Caption =
    148153          'Use Transfer: if inpatient will move from one ward or treating t' +
    149154          'eam to another.'
    150       end
    151     end
    152   end
    153   object Panel1: TPanel [2]
     155        TabOrder = 1
     156        Visible = False
     157        ShowAccelChar = True
     158      end
     159    end
     160  end
     161  object pnlBottom: TPanel [2]
    154162    Left = 0
    155     Top = 134
     163    Top = 116
    156164    Width = 456
    157     Height = 217
     165    Height = 235
    158166    Align = alClient
    159167    TabOrder = 2
     168    ExplicitTop = 112
     169    ExplicitHeight = 239
    160170    inline fraEvntDelayList: TfraEvntDelayList
    161171      Left = 1
    162172      Top = 1
    163173      Width = 454
    164       Height = 215
     174      Height = 233
    165175      Align = alClient
    166176      AutoScroll = True
    167177      TabOrder = 0
    168       TabStop = True
    169178      Visible = False
    170179      ExplicitLeft = 1
    171180      ExplicitTop = 1
    172181      ExplicitWidth = 454
    173       ExplicitHeight = 215
     182      ExplicitHeight = 237
    174183      inherited pnlDate: TPanel
    175184        Left = 349
    176         Height = 215
     185        Height = 233
    177186        ExplicitLeft = 349
    178         ExplicitHeight = 215
     187        ExplicitHeight = 237
    179188        inherited lblEffective: TLabel
    180189          Left = 453
    … …  
    190199      inherited pnlList: TPanel
    191200        Width = 349
    192         Height = 215
     201        Height = 233
    193202        ExplicitWidth = 349
    194         ExplicitHeight = 215
     203        ExplicitHeight = 237
    195204        inherited lblEvntDelayList: TLabel
    196205          Width = 347
    … …  
    199208        inherited mlstEvents: TORListBox
    200209          Width = 347
    201           Height = 179
     210          Height = 197
    202211          OnDblClick = cmdOKClick
     212          OnChange = fraEvntDelayListmlstEventsChange
    203213          ExplicitWidth = 347
    204           ExplicitHeight = 179
     214          ExplicitHeight = 201
    205215        end
    206216        inherited edtSearch: TCaptionEdit
    … …  
    238248        'Status = stsDefault')
    239249      (
    240         'Component = Panel1'
     250        'Component = pnlBottom'
    241251        'Status = stsDefault')
    242252      (
    … …  
    260270      (
    261271        'Component = frmOrdersTS'
     272        'Status = stsDefault')
     273      (
     274        'Component = lblUseTransfer'
     275        'Status = stsDefault')
     276      (
     277        'Component = lblPtInfo'
     278        'Status = stsDefault')
     279      (
     280        'Component = lblUseAdmit'
    262281        'Status = stsDefault'))
    263282  end

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

    r829 r1679  
    1212    pnlMiddle: TPanel;
    1313    pnlTop: TPanel;
    14     lblPtInfo: TLabel;
     14    lblPtInfo: TVA508StaticText;
    1515    grpChoice: TGroupBox;
    1616    radReleaseNow: TRadioButton;
    … …  
    2020    cmdOK: TButton;
    2121    cmdCancel: TButton;
    22     Label1: TLabel;
    23     Label2: TLabel;
    24     Panel1: TPanel;
     22    lblUseAdmit: TVA508StaticText;
     23    lblUseTransfer: TVA508StaticText;
     24    pnlBottom: TPanel;
    2525    fraEvntDelayList: TfraEvntDelayList;
    2626    procedure cmdOKClick(Sender: TObject);
    … …  
    170170end;
    171171
    172 procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);
     172procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);   
     173var
     174  tempStr: String;
    173175begin
    174176  inherited;
    … …  
    183185    Exit;
    184186  end;
     187 
     188  tempStr := fraEvntDelayList.mlstEvents.Items.ValueFromIndex[fraEvntDelayList.mlstEvents.ItemIndex];
     189
     190  if(fraEvntDelayList.mlstEvents.ItemIndex >= 0) and (Length(Piece(tempStr,'^',2))<1)then
     191  begin
     192    InfoBox('Invalid release event selected.', 'No Selection Made', MB_OK);
     193    Exit;
     194  end;
     195
    185196  if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then
    186197  begin

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

    r829 r1679  
    4747      begin
    4848        OriginalID := TOrder(Items[i]).ID;
    49         ReleaseOrderHold(TOrder(Items[i]));
     49        ReleaseOrderHold(TOrder(Items[i]));   
     50        TOrder(Items[i]).ActionOn := OriginalID + '=UH';
     51        SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_ACT, Integer(Items[i]));
    5052      end;
    5153      Result := True;

  • cprs/trunk/CPRS-Chart/Orders/fOtherSchedule.dfm

    r829 r1679  
    1212  OnCreate = FormCreate
    1313  ExplicitWidth = 600
    14   ExplicitHeight = 389
     14  ExplicitHeight = 396
    1515  PixelsPerInch = 96
    1616  TextHeight = 13
    … …  
    308308      object NSScboSchedule: TORComboBox
    309309        Left = 5
    310         Top = 16
     310        Top = 19
    311311        Width = 121
    312312        Height = 180
    … …  
    326326        SynonymChars = '<>'
    327327        TabOrder = 0
     328        OnExit = NSScboScheduleExit
     329        OnKeyUp = NSScboScheduleKeyUp
    328330        CharsNeedMatch = 1
    329331        UniqueAutoComplete = True

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

    r829 r1679  
    6666    procedure btnSchRemoveClick(Sender: TObject);
    6767    procedure FormDestroy(Sender: TObject);
     68    procedure NSScboScheduleExit(Sender: TObject);
     69    procedure NSScboScheduleKeyUp(Sender: TObject; var Key: Word;
     70      Shift: TShiftState);
    6871  private
    6972    FDaySchedule: array [1..7] of string;
    … …  
    683686end;
    684687
     688procedure TfrmOtherSchedule.NSScboScheduleExit(Sender: TObject);
     689begin
     690  inherited;
     691  if Pos(CRLF, NSScboSchedule.Text)> 0 then
     692    begin
     693      NSScboSchedule.Text := '';
     694      NSScboSchedule.ItemIndex := -1;
     695      Application.MessageBox('Schedule field cannot contain a control character. Please select a valid unique schedule from the list.' +CRLF +
     696                             'Or remove the schedule text from the schedule list and select specific times from the administration times list.',
     697                              'Incorrect Schedule.');
     698      NSScboSchedule.SetFocus;
     699    end;
     700  if (NSScboSchedule.Text <> '') and (NSScboSchedule.ItemIndex = -1) then
     701    begin
     702      Application.MessageBox('Please select a valid unique schedule from the list.' +CRLF +
     703                             'Or remove the schedule text from the schedule list and select specific times from the administration times list.',
     704                              'Incorrect Schedule.');
     705      NSSCboSchedule.Text := '';
     706      NSScboSchedule.SetFocus;
     707    end;
     708
     709end;
     710
     711procedure TfrmOtherSchedule.NSScboScheduleKeyUp(Sender: TObject; var Key: Word;
     712  Shift: TShiftState);
     713begin
     714  inherited;
     715  if (Key = VK_BACK) and (NSScboSchedule.Text = '') then NSScboSchedule.itemindex:= -1;
     716end;
     717
    685718procedure TfrmOtherSchedule.lstMinuteKeyDown(Sender: TObject;
    686719  var Key: Word; Shift: TShiftState);

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

    r829 r1679  
    446446procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
    447447var
    448   i: Integer;
    449   x, y, z: string;
     448  i, inc, len, numLoop, remain: Integer;
     449  ocStr, tmpStr, x, y, z: string;
    450450begin
    451451  with RPCBrokerV do
    … …  
    469469    Param[6].PType := literal;
    470470    Param[6].Value := AnOrder.EditOf;        // null if new order, otherwise ORIFN of original
    471     if (ConstructOrder.DGroup = IVDisp) then
     471    if (ConstructOrder.DGroup = IVDisp) or (ConstructOrder.DialogName = 'PSJI OR PAT FLUID OE') then
    472472      SetupORDIALOG(Param[7], ConstructOrder.ResponseList, True)
    473473    else
    … …  
    483483      y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
    484484        '","' + IntToStr(i+1) + '"';
    485       Param[7].Mult[y] := Pieces(OCList[i], U, 2, 4);
     485      //Param[7].Mult[y] := Pieces(OCList[i], U, 2, 4);
     486      OCStr :=  Pieces(OCList[i], U, 2, 4);
     487      len := Length(OCStr);
     488      if len > 255 then
     489        begin
     490          numLoop := len div 255;
     491          remain := len mod 255;
     492          inc := 0;
     493          while inc <= numLoop do
     494            begin
     495              tmpStr := Copy(OCStr, 1, 255);
     496              OCStr := Copy(OCStr, 256, Length(OcStr));
     497              Param[7].Mult[y + ',' + InttoStr(inc)] := tmpStr;
     498              inc := inc +1;
     499            end;
     500          if remain > 0 then  Param[7].Mult[y + ',' + inttoStr(inc)] := OCStr;
     501
     502        end
     503      else
     504       Param[7].Mult[y] := OCStr;
    486505    end;
    487506    if ConstructOrder.DelayEvent in ['A','D','T','M','O'] then

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

    r829 r1679  
    2828procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
    2929function  StatAllowed(PatientID: string): boolean;
     30function  RemoveCollTimeDefault: boolean;
     31function  GetDiagnosticPanelLocation: boolean;
    3032procedure GetBloodComponents(Dest: TStrings);
     33procedure GetDiagnosticTests(Dest: TStrings);
    3134function  NursAdminSuppress: boolean;
    3235function  GetSubtype(TestName: string): string;
    … …  
    5457end;
    5558
     59procedure GetDiagnosticTests(Dest: TStrings);
     60begin
     61  tCallV(Dest, 'ORWDXVB3 DIAGORD', []);
     62end;
     63
    5664function NursAdminSuppress: boolean;
    5765begin
    … …  
    6270begin
    6371  Result := (StrToInt(sCallV('ORWDXVB STATALOW',[PatientID])) > 0);
     72end;
     73
     74function  RemoveCollTimeDefault: boolean;
     75begin
     76  Result := (StrToInt(sCallV('ORWDXVB3 COLLTIM',[nil])) > 0);
     77end;
     78
     79function  GetDiagnosticPanelLocation: boolean;
     80begin
     81  Result := (StrToInt(sCallV('ORWDXVB3 SWPANEL',[nil])) > 0);
    6482end;
    6583

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

    r829 r1679  
    3838procedure LoadDOWSchedules(Dest: TStrings);
    3939procedure LoadAllIVRoutes(Dest: TStrings);
    40 procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
     40procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList);
     41function GetDefaultAddFreq(OID: integer): string;
    4142function QtyToDays(Quantity: Double;   const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
    4243function DaysToQty(DaysSupply: Integer; const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
    … …  
    204205end;
    205206
    206 procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
    207 begin
    208   CallV('ORWDPS33 IVDOSFRM', [OrderIDs, Default, False]);
     207procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList);
     208begin
     209  CallV('ORWDPS33 IVDOSFRM', [OrderIDs, False]);
    209210  FastAssign(RPCBrokerV.Results, Dest);
    210211end;
     212
     213function GetDefaultAddFreq(OID: integer): string;
     214begin
     215  result := sCallV('ORWDPS33 GETADDFR', [OID]);
     216end;
     217
    211218procedure LoadDOWSchedules(Dest: TStrings);
    212219begin

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

    r829 r1679  
    1313function SubsetOfImagingTypes: TStrings;
    1414function SubsetOfRadSources(SrcType: string): TStrings;
    15 function LocationType(Location: integer): string; 
     15function LocationType(Location: integer): string;
    1616function ReasonForStudyCarryOn: Boolean;
    1717
    … …  
    7474begin
    7575  Result := sCallV('ORWDRA32 LOCTYPE',[Location]);
    76 end;   
     76end;
    7777
    7878function ReasonForStudyCarryOn: Boolean;

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

    r829 r1679  
    4040    EnteredInError:     Integer; //AGP Changes 26.12 PSI-04-053
    4141    DCOriginalOrder: boolean;
     42    IsOrderPendDC: boolean;
     43    IsDelayOrder: boolean;
    4244    procedure Assign(Source: TOrder);
    4345    procedure Clear;
    … …  
    312314
    313315{ Order Checking }
     316function IsMonograph(): Boolean;
     317procedure DeleteMonograph();
     318procedure GetMonographList(ListOfMonographs: TStringList);
     319procedure GetMonograph(Monograph: TStringList; x: Integer);
     320procedure GetXtraTxt(OCText: TStringList; x: String; y: String);
    314321function FillerIDForDialog(IEN: Integer): string;
    315322function OrderChecksEnabled: Boolean;
    316323function OrderChecksOnDisplay(const FillerID: string): string;
    317324procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
    318   OIList: TStringList; DupORIFN: string);
     325  OIList: TStringList; DupORIFN: string; Renewal: string);
    319326procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
    320327  OIList: TStringList);
    … …  
    578585
    579586procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
    580 {           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18    19     20
    581 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder}
     587{           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18    19     20         21          22
     588{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder^ISDCOrder^IsDelayOrder}
    582589begin
    583590  with AnOrder do
    … …  
    614621    if Piece(x,U,20) = '1' then DCOriginalOrder := True
    615622    else DCOriginalOrder := False;
     623    if Piece(X,u,21) = '1' then  IsOrderPendDC := True
     624    else IsOrderPendDC := False;
     625    if Piece(x,u,22) = '1' then IsDelayOrder := True
     626    else IsDelayOrder := False;
    616627  end;
    617628end;
    … …  
    12501261  OrderMenuItem: TOrderMenuItem;
    12511262  i: Integer;
     1263  OrderTitle: String;
    12521264begin
    12531265  CallV('ORWDXM MENU', [AMenuIEN]);
    … …  
    12561268    // Results[0] = Name^Cols^PathSwitch^^^LRFZX^LRFSAMP^LRFSPEC^LRFDATE^LRFURG^LRFSCH^PSJNPOC^
    12571269    //              GMRCNOPD^GMRCNOAT^GMRCREAF^^^^^
    1258     AnOrderMenu.Title   := Piece(Results[0], U, 1);
     1270   OrderTitle := Piece(Results[0], U, 1);
     1271   if (Pos('&', OrderTitle) > 0) and
     1272   (Copy(OrderTitle, Pos('&', OrderTitle) + 1, 1) <> '&') then
     1273   OrderTitle := Copy(OrderTitle, 1, Pos('&', OrderTitle)) + '&' + Copy(OrderTitle, Pos('&', OrderTitle) + 1, Length(OrderTitle));
     1274
     1275    AnOrderMenu.Title   := OrderTitle;
    12591276    AnOrderMenu.NumCols := StrToIntDef(Piece(Results[0], U, 2), 1);
    12601277    AnOrderMenu.KeyVars := Pieces(Results[0], U, 6, 6 + MAX_KEYVARS);
    … …  
    22002217begin
    22012218  Result := sCallV('ORWDXC FILLID', [IEN]);
     2219end; 
     2220function IsMonograph(): Boolean;
     2221var ret: string;
     2222begin
     2223  ret := CharAt(sCallV('ORCHECK ISMONO', [nil]), 1);
     2224  Result := ret = '1';
     2225end;
     2226
     2227procedure GetMonographList(ListOfMonographs: TStringList);
     2228begin
     2229  CallV('ORCHECK GETMONOL', []);
     2230  FastAssign(RPCBrokerV.Results, ListOfMonographs);
     2231end;
     2232
     2233procedure GetMonograph(Monograph: TStringList; x: Integer);
     2234begin
     2235  CallV('ORCHECK GETMONO', [x]);
     2236  FastAssign(RPCBrokerV.Results, Monograph);
     2237end;
     2238
     2239procedure DeleteMonograph();
     2240begin
     2241  CallV('ORCHECK DELMONO', []);
     2242end; 
     2243
     2244procedure GetXtraTxt(OCText: TStringList; x: String; y: String);
     2245begin
     2246  CallV('ORCHECK GETXTRA', [x,y]);
     2247  FastAssign(RPCBrokerV.Results, OCText);
    22022248end;
    22032249
    … …  
    22152261
    22162262procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
    2217   OIList: TStringList; DupORIFN: string);
     2263  OIList: TStringList; DupORIFN: string; Renewal: string);
    22182264begin
    22192265  // don't pass OIList if no items, since broker pauses 5 seconds per order
    22202266  if OIList.Count > 0
    2221     then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
     2267    then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN, Renewal])
    22222268    else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
    22232269  FastAssign(RPCBrokerV.Results, ListOfChecks);
    … …  
    22412287
    22422288procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
    2243 begin
    2244   CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]);
     2289var
     2290 i, inc, len, numLoop, remain, y: integer;
     2291 OCStr, TmpStr: string;
     2292begin
     2293  //CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]);
    22452294  { no result used currently }
     2295  RPCBrokerV.ClearParameters := True;
     2296  RPCBrokerV.RemoteProcedure := 'ORWDXC SAVECHK';
     2297  RPCBrokerV.Param[0].PType := literal;
     2298  RPCBrokerV.Param[0].Value := Patient.DFN;  //*DFN*
     2299  RPCBrokerV.Param[1].PType := literal;
     2300  RPCBrokerV.Param[1].Value := AReason;
     2301  RPCBrokerV.Param[2].PType := list;
     2302  RPCBrokerV.Param[2].Mult['"ORCHECKS"'] := IntToStr(ListOfChecks.count);
     2303  for i := 0 to ListOfChecks.Count - 1 do
     2304    begin
     2305       OCStr := ListofChecks.Strings[i];
     2306       len := Length(OCStr);
     2307       if len > 255 then
     2308        begin
     2309          numLoop := len div 255;
     2310          remain := len mod 255;
     2311          inc := 0;
     2312          while inc <= numLoop do
     2313            begin
     2314              tmpStr := Copy(OCStr, 1, 255);
     2315              OCStr := Copy(OCStr, 256, Length(OcStr));
     2316              RPCBrokerV.Param[2].Mult['"ORCHECKS",' + InttoStr(i) + ',' + InttoStr(inc)] := tmpStr;
     2317              inc := inc +1;
     2318            end;
     2319          if remain > 0 then  RPCBrokerV.Param[2].Mult['"ORCHECKS",' + InttoStr(i) + ',' + inttoStr(inc)] := OCStr;
     2320
     2321        end
     2322      else
     2323       RPCBrokerV.Param[2].Mult['"ORCHECKS",' + InttoStr(i)] := OCStr;
     2324    end;
     2325   CallBroker;
    22462326end;
    22472327

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

    r829 r1679  
    44
    55uses
    6   Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
    7   Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA;
     6  Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rConsults,
     7  rOrders, ORFn, Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA,
     8  VA508AccessibilityRouter;
    89
    910type
    … …  
    7273function AllowActionOnIMO(AnEvtTyp: char): boolean;
    7374function IMOActionValidation(AnId: string; var IsIMOOD: boolean; var x: string; AnEventType: char): boolean;
     75function IMOTimeFrame: TFMDateTime;
    7476
    7577
    … …  
    290292    ((Encounter.Provider > 0) and (not PersonHasKey(Encounter.Provider, 'PROVIDER'))) then
    291293  begin
    292     UpdateEncounter(NPF_PROVIDER);
     294    UpdateEncounter(NPF_PROVIDER, 0, 0, True);
    293295    frmFrame.DisplayEncounterText;
    294296  end;
    … …  
    491493  MedsNVADlgFormID := FormIDForDialog(MedsNVADlgIen);
    492494  MedsIVDlgFormID := FormIDForDialog(MedsIVDlgIen);
     495end;
     496
     497function CanCloseDialog(dialog : TfrmODBase) : Boolean;
     498begin
     499  if uOrderDialog.FillerID = 'GMRC' then
     500    result := fODConsult.CanFreeConsultDialog(dialog)
     501            or fODProc.CanFreeProcDialog(dialog);
    493502end;
    494503
    … …  
    750759    case AFormID of
    751760      OM_ALLERGY:     if ARTPatchInstalled then
    752                         DialogClass := TfrmARTAllergy
     761                      begin
     762//                        DialogClass := TfrmARTAllergy;
     763                          EnterEditAllergy(0, TRUE, FALSE, AnOwner, ARefNum);
     764                          Result := True;
     765//                          uOrderMenu.Close;
     766                          Exit;
     767                      end
    753768                      else
    754769                        begin
    … …  
    786801  TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
    787802  TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
     803  TX_INACTIVE_SVC = 'This consult service is currently inactive and not receiving requests.' + CRLF +
     804                    'Please contact your Clinical Coordinator/IRM staff to fix this order.';
     805  TX_INACTIVE_SVC_CAP = 'Inactive Service';
     806  TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF +
     807              'Please contact your Clinical Coordinator/IRM staff to fix this order.';
     808  TC_NO_SVC = 'No service specified';
    788809var
    789810  ResolvedDialog: TOrderDialogResolved;
    … …  
    796817  CxMsg: string;
    797818  AButton: TButton;
     819  SvcIEN: string;
     820  //CsltFrmID: integer;
    798821begin
    799822  IsPsoSupply := False;
    … …  
    807830  DrugTestDlgType := false;
    808831  //QOAltOI.OI := 0;
     832  Application.ProcessMessages;
    809833  // double check environment before continuing with order
    810834  if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
    … …  
    859883  OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
    860884  OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
     885  //CQ 18660 Orders for events should be modal. Orders for non-event should not be modal
     886  if AnEvent.EventIFN > 0 then frmOrders.NeedShowModal := true
     887  else frmOrders.NeedShowModal := false;
    861888  // evaluate order dialog, build response list & see what form should be presented
    862889  FillChar(ResolvedDialog, SizeOf(ResolvedDialog), #0);
    … …  
    967994    if QuickLevel = QL_REJECT then InfoBox(ShowText, TC_DLG_REJECT, MB_OK);
    968995    if (QuickLevel = QL_VERIFY) and (IsPharmacyOrder or ANeedVerify) then  ShowVerifyText(QuickLevel, ShowText, DisplayGroup=InptDisp);
    969     if QuickLevel = QL_AUTO   then FormID := OD_AUTOACK;
     996    if QuickLevel = QL_AUTO then
     997    begin
     998      //CsltFrmID := FormID;
     999      FormID := OD_AUTOACK;
     1000    end;
    9701001    if (QuickLevel = QL_REJECT) or (QuickLevel = QL_CANCEL) then Exit;
    9711002    PushKeyVars(ResolvedDialog.QOKeyVars);
    … …  
    10461077                    uOrderDialog.IsSupply := True;
    10471078                  SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);
     1079                  {if ((ResolvedDialog.DisplayGroup = CsltDisp)
     1080                    and (ResolvedDialog.QuickLevel = QL_AUTO)) then
     1081                    TfrmODCslt.SetupDialog(ORDER_QUICK, ResolvedDialog.ResponseID);}
    10481082                end;
    10491083          end;
    10501084
    10511085          if Assigned(uOrderDialog) then
    1052             with uOrderDialog do if AbortOrder then
    1053               begin
    1054                 Close;
    1055                 Exit;
    1056               end;
     1086            with uOrderDialog do
     1087              if AbortOrder and CanCloseDialog(uOrderDialog) then
     1088                begin
     1089                  Close;
     1090                  if Assigned(uOrderDialog) then
     1091                    uOrderDialog.Destroy;
     1092                  Exit;
     1093                end;
    10571094
    10581095          if CharAt(AnID, 1) = 'T' then
    … …  
    11481185                 if ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur, tempOI, StrtoInt(tempSupply), StrtoInt(tempQuantity), StrtoInt(tempRefills)) = false then Exit;
    11491186               end;
     1187             if ((ResolvedDialog.DisplayGroup = CsltDisp) and (ResolvedDialog.QuickLevel = QL_AUTO)) then
     1188             begin
     1189               with Responses do
     1190               begin
     1191                 Changing := True;
     1192                 tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
     1193                 if tmpResp <> nil then
     1194                   SvcIEN := GetServiceIEN(tmpResp.IValue)
     1195                 else
     1196                 begin
     1197                   InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK);
     1198                   //AbortOrder := True;
     1199                   //Close;
     1200                   Exit;
     1201                 end;
     1202                 if SvcIEN = '-1' then
     1203                 begin
     1204                   InfoBox(TX_INACTIVE_SVC, TX_INACTIVE_SVC_CAP, MB_OK);
     1205                   //AbortOrder := True;
     1206                   //Close;
     1207                   Exit;
     1208                 end;
     1209               end;
     1210             end;
    11501211             cmdAcceptClick(Application);  // auto-accept order
    11511212             Result := uOrderDialog.AcceptOK;
     1213             if (result = true) and (ScreenReaderActive) then
     1214               GetScreenReader.Speak('Auto Accept Quick Order '+ Responses.DialogDisplayName + ' placed.');
    11521215
    11531216             //BAPHII 1.3.2
    … …  
    13041367var
    13051368  InitialCall: Boolean;
     1369  i: integer;
     1370  str: string;
    13061371begin
    13071372  InitialCall := False;
     1373  if ScreenReaderActive then
     1374    begin
     1375      for i := 0 to AList.Count - 1 do
     1376         begin
     1377           if Piece(Alist.Strings[i],U,2) = 'Q' then str := str + CRLF + 'Quick Order ' + Piece(Alist.Strings[i],U,3)
     1378           else if Piece(Alist.Strings[i],U,2) = 'S' then str := str + CRLF + 'Order Set ' + Piece(Alist.Strings[i],U,3)
     1379           else if Piece(Alist.Strings[i],U,2) = 'M' then str := str + CRLF + 'Order Menu ' + Piece(Alist.Strings[i],U,3)
     1380           else if Piece(Alist.Strings[i],U,2) = 'A' then str := str + CRLF + 'Order Action ' + Piece(Alist.Strings[i],U,3)
     1381           else str := str + CRLF + 'Order Dialog ' + Piece(Alist.Strings[i],U,3);
     1382         end;
     1383      if infoBox('This order set contains the following items:'+ CRLF + str + CRLF+ CRLF + 'Select the OK button to start this order set.' +
     1384                 'To stop the order set while it is in process, press “Alt +F6” to navigate to the order set dialog, and select the Stop Order Set Button.', 'Starting Order Set'  ,MB_OKCANCEL) = IDCANCEL then
     1385        begin
     1386          Result := False;
     1387          exit;
     1388        end;
     1389    end;
    13081390  if uOrderSet = nil then
    13091391  begin
    … …  
    13791461  { make sure a location and provider are selected before ordering }
    13801462  if not AuthorizedUser then Exit;
    1381   if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then x := ''
     1463  //Added to force users without the Provider or ORES key to select an a provider when adding new orders to existing delay orders
     1464  if (not Patient.Inpatient) and (AnEvent.EventIFN > 0 ) then
     1465    begin
     1466      if (User.OrderRole = OR_PHYSICIAN) and (Encounter.Provider = User.DUZ) and (User.IsProvider) then
     1467        x := ''
     1468      else if not EncounterPresentEDO then Exit;
     1469      x := '';
     1470    end
    13821471  else
    13831472  begin
    … …  
    18421931  //else
    18431932  //Encounter.Location := PrintLoc;
     1933  if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
    18441934  if PrintLoc = 0
    18451935    then PrintLoc := CommonLocationForOrders(OrderList);
    1846   if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
    1847  
    18481936  if PrintLoc = 0 then                      // location required for DEVINFO
    18491937  begin
    … …  
    18651953  end
    18661954  else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
    1867  (*   Encounter.Location := PrintLoc;
    1868   if Encounter.Location = 0
    1869     then Encounter.Location := CommonLocationForOrders(OrderList);
    1870   if Encounter.Location = 0 then                      // location required for DEVINFO
    1871   begin
    1872     LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
    1873     if ALocation > 0 then Encounter.Location := ALocation;
    1874   end;
    1875   if printLoc = 0 then frmFrame.DisplayEncounterText;
    1876   if Encounter.Location <> 0 then
    1877   begin
    1878     SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName);
    1879     if PrintIt then
    1880       PrintOrdersOnReview(OrderList, DeviceInfo)
    1881     else
    1882       PrintServiceCopies(OrderList);
    1883   end
    1884   else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);  *)
    18851955end;
    18861956
    … …  
    19161986  result := False;
    19171987  IsInptDlg := False;
    1918   Td := FMToday;
     1988  //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
     1989  //Td := FMToday;
     1990  Td := IMOTimeFrame;
    19191991  if ( (DlgID = MedsInDlgIen) or (DlgID = MedsIVDlgIen) or (IsInptQO(dlgId)) or (IsIVQO(dlgId))) then IsInptDlg := TRUE;
    19201992  IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
    … …  
    19362008  else
    19372009  begin
    1938     Td := FMToday;
     2010    //CQ #15188 - allow IMO functionality 23 hours after encounter date/time - TDP
     2011    //Td := FMToday;
     2012    Td := IMOTimeFrame;
    19392013    if IsValidIMOLoc(Encounter.Location,Patient.DFN) and (Encounter.DateTime > Td) then
    19402014      Result := True
    … …  
    20042078    end;
    20052079  end;
     2080end;
     2081
     2082//CQ #15188 - New function to allow IMO functionality 23 hours after encounter date/time - TDP
     2083function IMOTimeFrame: TFMDateTime;
     2084begin
     2085  Result := DateTimeToFMDateTime(FMDateTimeToDateTime(FMNow) - (23/24));
    20062086end;
    20072087
Note: See TracChangeset for help on using the changeset viewer.