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

Upgrade to version 27

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

Legend:

Unmodified
Added
Removed

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

    r456 r829  
    33  Top = 257
    44  BorderIcons = []
    5   BorderStyle = bsDialog
    65  Caption = 'Order Checking'
    76  ClientHeight = 169
    87  ClientWidth = 472
    98  Position = poScreenCenter
     9  ExplicitLeft = 305
     10  ExplicitTop = 257
     11  ExplicitWidth = 480
     12  ExplicitHeight = 203
    1013  PixelsPerInch = 96
    1114  TextHeight = 13
    12   object memChecks: TRichEdit
     15  object memChecks: TRichEdit [0]
    1316    Left = 0
    1417    Top = 0
    … …  
    2124    WantReturns = False
    2225  end
    23   object pnlBottom: TPanel
     26  object pnlBottom: TPanel [1]
    2427    Left = 0
    2528    Top = 136
    … …  
    5053    end
    5154  end
     55  inherited amgrMain: TVA508AccessibilityManager
     56    Data = (
     57      (
     58        'Component = memChecks'
     59        'Status = stsDefault')
     60      (
     61        'Component = pnlBottom'
     62        'Status = stsDefault')
     63      (
     64        'Component = cmdAccept'
     65        'Status = stsDefault')
     66      (
     67        'Component = cmdCancel'
     68        'Status = stsDefault')
     69      (
     70        'Component = frmOCAccept'
     71        'Status = stsDefault'))
     72  end
    5273end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    11inherited frmOCSession: TfrmOCSession
    2   Left = 365
    3   Top = 221
    4   Width = 504
    5   Height = 298
     2  Left = 366
     3  Top = 222
    64  BorderIcons = []
    75  Caption = 'Order Checks'
     6  ClientWidth = 494
    87  Position = poScreenCenter
    98  ShowHint = True
    109  OnClose = FormClose
    1110  OnShow = FormShow
     11  ExplicitWidth = 502
     12  ExplicitHeight = 240
    1213  PixelsPerInch = 96
    1314  TextHeight = 13
    14   object lstChecks: TCaptionListBox
     15  object lstChecks: TCaptionListBox [0]
    1516    Left = 0
    1617    Top = 0
    17     Width = 496
    18     Height = 160
     18    Width = 494
     19    Height = 162
    1920    Style = lbOwnerDrawVariable
    2021    Align = alClient
    … …  
    2829    HintOnItem = True
    2930  end
    30   object pnlBottom: TPanel
     31  object pnlBottom: TPanel [1]
    3132    Left = 0
    32     Top = 160
    33     Width = 496
     33    Top = 162
     34    Width = 494
    3435    Height = 111
    3536    Align = alBottom
    … …  
    3738    TabOrder = 0
    3839    DesignSize = (
    39       496
     40      494
    4041      111)
    4142    object lblJustify: TLabel
    42       Left = 8
     43      Left = 9
    4344      Top = 34
    4445      Width = 248
    … …  
    5051      Left = 8
    5152      Top = 50
    52       Width = 480
     53      Width = 478
    5354      Height = 21
    5455      Anchors = [akLeft, akTop, akRight]
    … …  
    6162      Left = 356
    6263      Top = 5
    63       Width = 133
     64      Width = 131
    6465      Height = 21
    6566      Anchors = [akLeft, akTop, akRight]
    6667      Caption = 'Cancel Selected Order(s)'
    67       TabOrder = 2
     68      TabOrder = 3
    6869      OnClick = cmdCancelOrderClick
    6970    end
    7071    object cmdContinue: TButton
    71       Left = 212
     72      Left = 157
    7273      Top = 82
    73       Width = 72
     74      Width = 70
    7475      Height = 21
    75       Anchors = [akLeft, akTop, akRight]
    7676      Caption = 'Continue'
    77       TabOrder = 3
     77      TabOrder = 4
    7878      OnClick = cmdContinueClick
    7979    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
     89    end
     90    object memNote: TMemo
     91      Left = 8
     92      Top = 4
     93      Width = 329
     94      Height = 29
     95      BorderStyle = bsNone
     96      Color = clBtnFace
     97      Lines.Strings = (
     98        'NOTE: The override justification is for tracking purposes and '
     99        'does not change or place new order(s).')
     100      ReadOnly = True
     101      TabOrder = 1
     102      OnEnter = memNoteEnter
     103    end
     104  end
     105  inherited amgrMain: TVA508AccessibilityManager
     106    Data = (
     107      (
     108        'Component = lstChecks'
     109        'Status = stsDefault')
     110      (
     111        'Component = pnlBottom'
     112        'Status = stsDefault')
     113      (
     114        'Component = txtJustify'
     115        'Status = stsDefault')
     116      (
     117        'Component = cmdCancelOrder'
     118        'Status = stsDefault')
     119      (
     120        'Component = cmdContinue'
     121        'Status = stsDefault')
     122      (
     123        'Component = btnReturn'
     124        'Status = stsDefault')
     125      (
     126        'Component = memNote'
     127        'Status = stsDefault')
     128      (
     129        'Component = frmOCSession'
     130        'Status = stsDefault'))
    80131  end
    81132end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls;
     7  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager;
    88
    99type
    … …  
    1515    cmdCancelOrder: TButton;
    1616    cmdContinue: TButton;
     17    btnReturn: TButton;
     18    memNote: TMemo;
    1719    procedure cmdCancelOrderClick(Sender: TObject);
    1820    procedure cmdContinueClick(Sender: TObject);
    … …  
    2628    procedure txtJustifyKeyDown(Sender: TObject; var Key: Word;
    2729      Shift: TShiftState);
     30    procedure btnReturnClick(Sender: TObject);
     31    procedure memNoteEnter(Sender: TObject);
    2832  private
    2933    FCritical: Boolean;
     34    FCancelSignProcess : Boolean;
    3035    FCheckList: TStringList;
    3136    FOrderList: TStringList;
    3237    procedure SetReqJustify;
     38    procedure SetReturn(const Value: Boolean);
    3339  public
    3440    { Public declarations }
     41    property CancelSignProcess : Boolean read FCancelSignProcess write SetReturn default false;
    3542  end;
    3643
    3744procedure ExecuteReleaseOrderChecks(SelectList: TList);
    38 procedure ExecuteSessionOrderChecks(OrderList: TStringList);
     45function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
    3946
    4047implementation
    … …  
    4249{$R *.DFM}
    4350
    44 uses rOrders, uCore, rMisc;
     51uses rOrders, uCore, rMisc, fFrame;
    4552
    4653type
    … …  
    8491      OrderIDList.Add(AnOrder.ID + '^^1');  // 3rd pce = 1 means releasing order
    8592    end;
    86     ExecuteSessionOrderChecks(OrderIDList);
    87     for i := SelectList.Count - 1 downto 0 do
    88     begin
    89       AnOrder := TOrder(SelectList.Items[i]);
    90       if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
     93    if ExecuteSessionOrderChecks(OrderIDList) then
     94      for i := SelectList.Count - 1 downto 0 do
    9195      begin
    92         Changes.Remove(CH_ORD, AnOrder.ID);
    93         SelectList.Delete(i);
    94       end;
    95     end;
     96        AnOrder := TOrder(SelectList.Items[i]);
     97        if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
     98        begin
     99          Changes.Remove(CH_ORD, AnOrder.ID);
     100          SelectList.Delete(i);
     101        end;
     102      end
     103    else
     104      SelectList.Clear;
    96105  finally
    97106    OrderIDList.Free;
    … …  
    99108end;
    100109
    101 procedure ExecuteSessionOrderChecks(OrderList: TStringList);
     110{Returns True if the Signature process should proceed.
     111 Clears OrderList If False. }
     112function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
    102113var
    103114  i, j: Integer;
    … …  
    109120  x: string;
    110121begin
     122  Result := True;
    111123  CheckList := TStringList.Create;
    112124  try
    … …  
    152164        if frmOCSession.Visible then frmOCSession.SetFocus;
    153165        frmOCSession.ShowModal;
     166        Result := not frmOCSession.CancelSignProcess;
     167        if frmOCSession.CancelSignProcess then begin
     168          OrderList.Clear;
     169          if Assigned(frmFrame) then
     170            frmFrame.SetActiveTab(CT_ORDERS);
     171        end;
    154172      finally
    155173        with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
    … …  
    176194  lblJustify.Visible := FCritical;
    177195  txtJustify.Visible := FCritical;
     196  memNote.Visible := FCritical;
    178197
    179198end;
    … …  
    234253                 if (Piece(OCRec.Checks[i], U, 2) = '1') then
    235254                   begin
    236                      if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
    237                        Canvas.Font.Color := clBlue;
     255                     Canvas.Font.Color := Get508CompliantColor(clBlue);
    238256                     Canvas.Font.Style := [fsUnderline];
    239257                   end
    … …  
    298316  inherited;
    299317  SetFormPosition(Self); //Get Saved Position & Size of Form
     318  FCancelSignProcess := False;
    300319end;
    301320
    … …  
    315334end;
    316335
     336procedure TfrmOCSession.btnReturnClick(Sender: TObject);
     337begin
     338  inherited;
     339  FCancelSignProcess := True;
     340  Close;
     341end;
     342
     343procedure TfrmOCSession.SetReturn(const Value: Boolean);
     344begin
     345  FCancelSignProcess := Value;
     346end;
     347
     348procedure TfrmOCSession.memNoteEnter(Sender: TObject);
     349begin
     350  inherited;
     351  memNote.SelStart := 0;
     352end;
     353
    317354end.

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

    r456 r829  
    1 object frmODActive: TfrmODActive
     1inherited frmODActive: TfrmODActive
    22  Left = 267
    33  Top = 216
    4   Width = 547
    5   Height = 350
    64  Caption = 'Copy active orders for selected event'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 316
     6  ClientWidth = 539
    137  OldCreateOrder = False
    148  Position = poScreenCenter
    159  OnCreate = FormCreate
    16   OnDestroy = FormDestroy
     10  ExplicitWidth = 320
     11  ExplicitHeight = 240
    1712  PixelsPerInch = 96
    1813  TextHeight = 13
    19   object lblCaption: TLabel
     14  object lblCaption: TLabel [0]
    2015    Left = 0
    2116    Top = 0
    … …  
    2823    WordWrap = True
    2924  end
    30   object pnlClient: TPanel
     25  object pnlClient: TPanel [1]
    3126    Left = 0
    3227    Top = 29
    3328    Width = 539
    34     Height = 293
     29    Height = 287
    3530    Align = alClient
    3631    BevelOuter = bvNone
    3732    Locked = True
    3833    TabOrder = 0
     34    ExplicitHeight = 294
    3935    DesignSize = (
    4036      539
    41       293)
     37      287)
    4238    object btnOK: TButton
    4339      Left = 386
    … …  
    8177      Width = 539
    8278      Height = 21
    83       DragReorder = False
    8479      Sections = <
    8580        item
    … …  
    110105    end
    111106  end
     107  inherited amgrMain: TVA508AccessibilityManager
     108    Data = (
     109      (
     110        'Component = pnlClient'
     111        'Status = stsDefault')
     112      (
     113        'Component = btnOK'
     114        'Status = stsDefault')
     115      (
     116        'Component = btnCancel'
     117        'Status = stsDefault')
     118      (
     119        'Component = lstActiveOrders'
     120        'Status = stsDefault')
     121      (
     122        'Component = hdControl'
     123        'Status = stsDefault')
     124      (
     125        'Component = frmODActive'
     126        'Status = stsDefault'))
     127  end
    112128end

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,rOrders,fOrders,uOrders,
    8   fFrame,ORCtrls,fAutoSz;
     8  fFrame,ORCtrls,fAutoSz, VA508AccessibilityManager;
    99
    1010type
    … …  
    4848implementation
    4949
     50uses
     51  VA2006Utils;
     52
    5053{$R *.DFM}
    5154
    … …  
    8386  DoesDestEvtOccur:boolean;
    8487begin
     88  try
     89  self.btnOK.Enabled := false;
    8590  DoesDestEvtOccur := False;
    8691  uAutoAC := True;
    … …  
    104109    uAutoAC := False;
    105110  end;
     111  finally
     112    self.btnOK.Enabled := True;
     113  end;
    106114  Close;
    107115end;
    … …  
    114122procedure TfrmODActive.FormCreate(Sender: TObject);
    115123begin
     124  FixHeaderControlDelphi2006Bug(hdControl);
    116125  ActiveOrderList := TList.Create;
    117126  FOrderView      := TOrderView.Create;
    … …  
    208217    ARect := TheeRect;
    209218    Canvas.FillRect(ARect);
    210     Canvas.Pen.Color := clSilver;
     219    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    211220    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    212221    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);

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

    r456 r829  
    55  Height = 339
    66  HorzScrollBar.Range = 520
    7   HorzScrollBar.Visible = True
    87  VertScrollBar.Range = 312
    9   VertScrollBar.Visible = True
    10   AutoScroll = False
    118  Caption = 'Enter Allergy Information'
     9  ExplicitHeight = 339
    1210  PixelsPerInch = 96
    1311  TextHeight = 13
    … …  
    142140    Top = 256
    143141    TabOrder = 16
     142    ExplicitLeft = 5
     143    ExplicitTop = 256
    144144  end
    145145  inherited cmdAccept: TButton
    … …  
    148148    Caption = 'Accept'
    149149    TabOrder = 13
     150    ExplicitLeft = 441
     151    ExplicitTop = 256
    150152  end
    151153  inherited cmdQuit: TButton
    … …  
    153155    Top = 283
    154156    TabOrder = 14
     157    ExplicitLeft = 441
     158    ExplicitTop = 283
    155159  end
    156160  inherited pnlMessage: TPanel
    … …  
    158162    Top = 253
    159163    TabOrder = 15
     164    ExplicitLeft = 20
     165    ExplicitTop = 253
    160166    inherited memMessage: TRichEdit
    161167      Left = 41
     168      ExplicitLeft = 41
    162169    end
    163170  end
    164   object cboReactionType: TORComboBox
     171  object cboReactionType: TORComboBox [15]
    165172    Left = 7
    166173    Top = 96
    … …  
    186193    CharsNeedMatch = 1
    187194  end
    188   object grpObsHist: TRadioGroup
     195  object grpObsHist: TRadioGroup [16]
    189196    Left = 364
    190197    Top = 11
    … …  
    200207    OnClick = grpObsHistClick
    201208  end
    202   object memComments: TRichEdit
     209  object memComments: TRichEdit [17]
    203210    Left = 282
    204211    Top = 142
    … …  
    210217    OnKeyUp = memCommentsKeyUp
    211218  end
    212   object lstSelectedSymptoms: TORListBox
     219  object lstSelectedSymptoms: TORListBox [18]
    213220    Left = 147
    214221    Top = 143
    … …  
    226233    OnChange = ControlChange
    227234  end
    228   object ckNoKnownAllergies: TCheckBox
     235  object ckNoKnownAllergies: TCheckBox [19]
    229236    Left = 8
    230237    Top = 18
    … …  
    235242    OnClick = ckNoKnownAllergiesClick
    236243  end
    237   object cboOriginator: TORComboBox
     244  object cboOriginator: TORComboBox [20]
    238245    Left = 210
    239246    Top = 22
    … …  
    263270    CharsNeedMatch = 1
    264271  end
    265   object cboSymptoms: TORComboBox
     272  object cboSymptoms: TORComboBox [21]
    266273    Left = 7
    267274    Top = 143
    … …  
    289296    CharsNeedMatch = 1
    290297  end
    291   object btnCurrent: TButton
     298  object btnCurrent: TButton [22]
    292299    Left = 137
    293300    Top = 14
    … …  
    298305    OnClick = btnCurrentClick
    299306  end
    300   object calObservedDate: TORDateBox
     307  object calObservedDate: TORDateBox [23]
    301308    Left = 365
    302309    Top = 62
    … …  
    309316    Caption = 'Reaction Date/Time'
    310317  end
    311   object cboSeverity: TORComboBox
     318  object cboSeverity: TORComboBox [24]
    312319    Left = 365
    313320    Top = 97
    … …  
    333340    CharsNeedMatch = 1
    334341  end
    335   object btnRemove: TButton
     342  object btnRemove: TButton [25]
    336343    Left = 210
    337344    Top = 224
    … …  
    342349    OnClick = btnRemoveClick
    343350  end
    344   object btnDateTime: TButton
     351  object btnDateTime: TButton [26]
    345352    Left = 147
    346353    Top = 224
    … …  
    351358    OnClick = btnDateTimeClick
    352359  end
     360  inherited amgrMain: TVA508AccessibilityManager
     361    Data = (
     362      (
     363        'Component = lstAllergy'
     364        'Status = stsDefault')
     365      (
     366        'Component = cboReactionType'
     367        'Status = stsDefault')
     368      (
     369        'Component = grpObsHist'
     370        'Status = stsDefault')
     371      (
     372        'Component = memComments'
     373        'Status = stsDefault')
     374      (
     375        'Component = lstSelectedSymptoms'
     376        'Status = stsDefault')
     377      (
     378        'Component = ckNoKnownAllergies'
     379        'Status = stsDefault')
     380      (
     381        'Component = cboOriginator'
     382        'Status = stsDefault')
     383      (
     384        'Component = cboSymptoms'
     385        'Status = stsDefault')
     386      (
     387        'Component = btnCurrent'
     388        'Status = stsDefault')
     389      (
     390        'Component = calObservedDate'
     391        'Status = stsDefault')
     392      (
     393        'Component = cboSeverity'
     394        'Status = stsDefault')
     395      (
     396        'Component = btnRemove'
     397        'Status = stsDefault')
     398      (
     399        'Component = btnDateTime'
     400        'Status = stsDefault')
     401      (
     402        'Component = memOrder'
     403        'Status = stsDefault')
     404      (
     405        'Component = cmdAccept'
     406        'Status = stsDefault')
     407      (
     408        'Component = cmdQuit'
     409        'Status = stsDefault')
     410      (
     411        'Component = pnlMessage'
     412        'Status = stsDefault')
     413      (
     414        'Component = memMessage'
     415        'Status = stsDefault')
     416      (
     417        'Component = frmODAllergy'
     418        'Status = stsDefault'))
     419  end
    353420  object dlgReactionDateTime: TORDateTimeDlg
    354     FMDateTime = 2981202
     421    FMDateTime = 2981202.000000000000000000
    355422    DateOnly = False
    356423    RequireTime = False

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

    r456 r829  
    66  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    77  Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
    8   Menus, ORDtTm, Buttons;
     8  Menus, ORDtTm, Buttons, VA508AccessibilityManager;
    99
    1010type
    … …  
    321321  AStringList := TStringList.Create;
    322322  try
    323     AStringList.Assign(memComments.Lines);
     323    FastAssign(memComments.Lines, AStringList);
    324324    LimitStringLength(AStringList, 74);
    325     memComments.Lines.Assign(AstringList);
     325    QuickCopy(AstringList, memComments);
    326326    ControlChange(Self);
    327327  finally

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

    r456 r829  
    1414    WordWrap = True
    1515  end
     16  inherited amgrMain: TVA508AccessibilityManager
     17    Data = (
     18      (
     19        'Component = memOrder'
     20        'Status = stsDefault')
     21      (
     22        'Component = cmdAccept'
     23        'Status = stsDefault')
     24      (
     25        'Component = cmdQuit'
     26        'Status = stsDefault')
     27      (
     28        'Component = pnlMessage'
     29        'Status = stsDefault')
     30      (
     31        'Component = memMessage'
     32        'Status = stsDefault')
     33      (
     34        'Component = frmODAuto'
     35        'Status = stsDefault'))
     36  end
    1637end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls;
     7  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    11inherited frmODBBank: TfrmODBBank
    2   Left = 272
    3   Top = 171
    4   Width = 543
    5   Height = 507
     2  Left = 409
     3  Top = 244
     4  HorzScrollBar.Range = 0
     5  VertScrollBar.Range = 0
    66  Caption = 'Blood Component and Diagnostic Test Order Form'
     7  ClientHeight = 600
     8  ClientWidth = 709
     9  ExplicitWidth = 717
     10  ExplicitHeight = 634
    711  PixelsPerInch = 96
    812  TextHeight = 13
     13  object pnlComments: TPanel [0]
     14    Left = 12
     15    Top = 25
     16    Width = 534
     17    Height = 368
     18    TabOrder = 5
     19    Visible = False
     20    object lblOrdComment: TLabel
     21      Left = 25
     22      Top = 3
     23      Width = 87
     24      Height = 13
     25      Caption = 'Order Comment'
     26      Font.Charset = DEFAULT_CHARSET
     27      Font.Color = clWindowText
     28      Font.Height = -11
     29      Font.Name = 'MS Sans Serif'
     30      Font.Style = [fsBold]
     31      ParentFont = False
     32    end
     33    object btnUpdateComments: TButton
     34      Left = 372
     35      Top = 174
     36      Width = 115
     37      Height = 25
     38      Caption = 'Update Comments'
     39      TabOrder = 0
     40      OnClick = btnUpdateCommentsClick
     41    end
     42    object btnCancelComment: TButton
     43      Left = 279
     44      Top = 174
     45      Width = 75
     46      Height = 25
     47      Caption = 'Cancel'
     48      TabOrder = 1
     49      OnClick = btnCancelCommentClick
     50    end
     51  end
    952  inherited memOrder: TCaptionMemo
    10     Top = 431
    11     Width = 423
    12     Anchors = [akLeft, akRight, akBottom]
     53    Left = 0
     54    Top = 399
     55    Width = 449
     56    Height = 59
     57    Visible = False
     58    ExplicitLeft = 0
     59    ExplicitTop = 399
     60    ExplicitWidth = 449
     61    ExplicitHeight = 59
    1362  end
    14   inherited cmdAccept: TButton
    15     Left = 435
    16     Top = 427
    17     Anchors = [akRight, akBottom]
    18   end
    19   inherited cmdQuit: TButton
    20     Left = 435
    21     Top = 454
    22     Anchors = [akRight, akBottom]
    23   end
    24   inherited pnlMessage: TPanel
    25     Left = 12
    26     Top = 433
    27     Width = 389
    28     Anchors = [akLeft, akRight, akBottom]
    29   end
    30   object pnlBB: TPanel
    31     Left = 4
    32     Top = 4
    33     Width = 525
    34     Height = 413
    35     TabOrder = 5
    36     object pnlFull: TPanel
    37       Left = 1
    38       Top = 1
    39       Width = 523
    40       Height = 411
    41       Align = alClient
    42       Caption = 'pnlFull'
    43       TabOrder = 0
    44       object pgeProduct: TPageControl
     63  object pgeProduct: TPageControl [2]
     64    Left = 0
     65    Top = 0
     66    Width = 709
     67    Height = 393
     68    ActivePage = TabDiag
     69    Align = alTop
     70    TabOrder = 6
     71    TabStop = False
     72    OnChange = pgeProductChange
     73    object TabInfo: TTabSheet
     74      Caption = 'Patient Information'
     75      ImageIndex = 3
     76      object edtInfo: TCaptionRichEdit
    4577        Left = 0
    46         Top = 4
    47         Width = 521
    48         Height = 411
    49         ActivePage = TabDiag
     78        Top = 8
     79        Width = 556
     80        Height = 337
     81        TabStop = False
     82        BevelInner = bvNone
     83        BevelOuter = bvNone
     84        Font.Charset = DEFAULT_CHARSET
     85        Font.Color = clWindowText
     86        Font.Height = -11
     87        Font.Name = 'Courier New'
     88        Font.Style = []
     89        ParentFont = False
     90        ReadOnly = True
     91        ScrollBars = ssBoth
     92        TabOrder = 0
     93        Caption = 'Patient Info'
     94      end
     95    end
     96    object TabDiag: TTabSheet
     97      Caption = 'Blood Bank Orders'
     98      ImageIndex = 2
     99      object lblReqComment: TOROffsetLabel
     100        Left = 298
     101        Top = 25
     102        Width = 108
     103        Height = 37
     104        HorzOffset = 2
     105        Transparent = False
     106        VertOffset = 2
     107        WordWrap = False
     108      end
     109      object pnlFields: TPanel
     110        Left = 0
     111        Top = 163
     112        Width = 701
     113        Height = 99
     114        Hint = 'Data entered into these fields apply to the entire order.'
     115        Align = alTop
     116        BevelEdges = []
     117        BevelOuter = bvNone
     118        ParentShowHint = False
     119        ShowHint = True
     120        TabOrder = 2
     121        object lblDiagComment: TOROffsetLabel
     122          Left = 257
     123          Top = 35
     124          Width = 46
     125          Height = 15
     126          Caption = 'Comment'
     127          Font.Charset = DEFAULT_CHARSET
     128          Font.Color = clWindowText
     129          Font.Height = -11
     130          Font.Name = 'MS Sans Serif'
     131          Font.Style = []
     132          HorzOffset = 2
     133          ParentFont = False
     134          Transparent = False
     135          VertOffset = 2
     136          WordWrap = True
     137        end
     138        object lblUrgency: TLabel
     139          Left = 8
     140          Top = -2
     141          Width = 44
     142          Height = 13
     143          Caption = 'Urgency*'
     144          Font.Charset = DEFAULT_CHARSET
     145          Font.Color = clWindowText
     146          Font.Height = -11
     147          Font.Name = 'MS Sans Serif'
     148          Font.Style = []
     149          ParentFont = False
     150        end
     151        object lblReason: TLabel
     152          Left = 10
     153          Top = 35
     154          Width = 99
     155          Height = 13
     156          Caption = 'Reason for Request*'
     157          Font.Charset = DEFAULT_CHARSET
     158          Font.Color = clWindowText
     159          Font.Height = -11
     160          Font.Name = 'MS Sans Serif'
     161          Font.Style = []
     162          ParentFont = False
     163        end
     164        object lblSurgery: TLabel
     165          Left = 115
     166          Top = -2
     167          Width = 36
     168          Height = 13
     169          Hint =
     170            'Enter the name of the surgical procedure that this request is fo' +
     171            'r.'
     172          Caption = 'Surgery'
     173          Font.Charset = DEFAULT_CHARSET
     174          Font.Color = clWindowText
     175          Font.Height = -11
     176          Font.Name = 'MS Sans Serif'
     177          Font.Style = []
     178          ParentFont = False
     179        end
     180        object lblRequiredField: TLabel
     181          Left = 10
     182          Top = 75
     183          Width = 122
     184          Height = 13
     185          Caption = '* Indicates a required field'
     186        end
     187        object cboUrgency: TORComboBox
     188          Left = 12
     189          Top = 12
     190          Width = 98
     191          Height = 21
     192          Style = orcsDropDown
     193          AutoSelect = True
     194          Caption = 'Urgency'
     195          Color = clWindow
     196          DropDownCount = 8
     197          Font.Charset = DEFAULT_CHARSET
     198          Font.Color = clWindowText
     199          Font.Height = -11
     200          Font.Name = 'MS Sans Serif'
     201          Font.Style = []
     202          ItemHeight = 13
     203          ItemTipColor = clWindow
     204          ItemTipEnable = True
     205          ListItemsOnly = True
     206          LongList = False
     207          LookupPiece = 0
     208          MaxLength = 0
     209          ParentFont = False
     210          Pieces = '2'
     211          Sorted = False
     212          SynonymChars = '<>'
     213          TabOrder = 0
     214          OnChange = cboUrgencyChange
     215          OnExit = cboUrgencyExit
     216          CharsNeedMatch = 1
     217        end
     218        object chkConsent: TCheckBox
     219          Left = 351
     220          Top = 10
     221          Width = 112
     222          Height = 17
     223          Hint = 'Informed Consent Signed On Chart?'
     224          Alignment = taLeftJustify
     225          Caption = 'Informed Consent?'
     226          Font.Charset = DEFAULT_CHARSET
     227          Font.Color = clWindowText
     228          Font.Height = -11
     229          Font.Name = 'MS Sans Serif'
     230          Font.Style = []
     231          ParentFont = False
     232          ParentShowHint = False
     233          ShowHint = True
     234          TabOrder = 3
     235          Visible = False
     236          OnClick = chkConsentClick
     237        end
     238        object cboSurgery: TORComboBox
     239          Left = 115
     240          Top = 12
     241          Width = 218
     242          Height = 21
     243          Style = orcsDropDown
     244          AutoSelect = True
     245          Caption = 'Surgery'
     246          Color = clWindow
     247          DropDownCount = 8
     248          Enabled = False
     249          Font.Charset = DEFAULT_CHARSET
     250          Font.Color = clWindowText
     251          Font.Height = -11
     252          Font.Name = 'MS Sans Serif'
     253          Font.Style = []
     254          ItemHeight = 13
     255          ItemTipColor = clWindow
     256          ItemTipEnable = True
     257          ListItemsOnly = False
     258          LongList = False
     259          LookupPiece = 0
     260          MaxLength = 0
     261          ParentFont = False
     262          Pieces = '2'
     263          Sorted = False
     264          SynonymChars = '<>'
     265          TabOrder = 1
     266          OnChange = cboSurgeryChange
     267          OnClick = cboSurgeryClick
     268          CharsNeedMatch = 1
     269        end
     270        object cboReasons: TORComboBox
     271          Left = 12
     272          Top = 51
     273          Width = 239
     274          Height = 21
     275          Style = orcsDropDown
     276          AutoSelect = True
     277          Color = clWindow
     278          DropDownCount = 8
     279          ItemHeight = 13
     280          ItemTipColor = clWindow
     281          ItemTipEnable = True
     282          ListItemsOnly = False
     283          LongList = False
     284          LookupPiece = 0
     285          MaxLength = 0
     286          Sorted = False
     287          SynonymChars = '<>'
     288          TabOrder = 2
     289          OnChange = cboReasonsChange
     290          OnEnter = cboReasonsEnter
     291          OnExit = cboReasonsExit
     292          CharsNeedMatch = 1
     293        end
     294        object memDiagComment: TRichEdit
     295          Left = 257
     296          Top = 51
     297          Width = 250
     298          Height = 48
     299          TabOrder = 4
     300          OnChange = memDiagCommentChange
     301        end
     302      end
     303      object pnlSelect: TPanel
     304        Left = 0
     305        Top = 35
     306        Width = 701
     307        Height = 128
     308        Align = alTop
     309        BevelEdges = []
     310        BevelOuter = bvNone
     311        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
     328        object pnlDiagnosticTests: TGroupBox
     329          Left = 256
     330          Top = 0
     331          Width = 267
     332          Height = 110
     333          Caption = 'Diagnostic Tests'
     334          Font.Charset = DEFAULT_CHARSET
     335          Font.Color = clWindowText
     336          Font.Height = -11
     337          Font.Name = 'MS Sans Serif'
     338          Font.Style = [fsBold]
     339          ParentFont = False
     340          TabOrder = 1
     341          object lblCollType: TLabel
     342            Left = 13
     343            Top = 33
     344            Width = 77
     345            Height = 13
     346            Caption = 'Collection Type*'
     347            Font.Charset = DEFAULT_CHARSET
     348            Font.Color = clWindowText
     349            Font.Height = -11
     350            Font.Name = 'MS Sans Serif'
     351            Font.Style = []
     352            ParentFont = False
     353          end
     354          object lblCollTime: TLabel
     355            Left = 12
     356            Top = 70
     357            Width = 104
     358            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
     370            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
     395            BevelOuter = bvNone
     396            Caption = 'Select collection time'
     397            TabOrder = 5
     398            TabStop = True
     399          end
     400          object cboAvailTest: TORComboBox
     401            Left = 13
     402            Top = 13
     403            Width = 234
     404            Height = 21
     405            Style = orcsDropDown
     406            AutoSelect = True
     407            Caption = 'Diagnostic Tests'
     408            Color = clWindow
     409            DropDownCount = 8
     410            Font.Charset = DEFAULT_CHARSET
     411            Font.Color = clWindowText
     412            Font.Height = -11
     413            Font.Name = 'MS Sans Serif'
     414            Font.Style = []
     415            ItemHeight = 13
     416            ItemTipColor = clWindow
     417            ItemTipEnable = True
     418            ListItemsOnly = False
     419            LongList = True
     420            LookupPiece = 0
     421            MaxLength = 0
     422            ParentFont = False
     423            Pieces = '2'
     424            Sorted = False
     425            SynonymChars = '<>'
     426            TabOrder = 0
     427            TabStop = True
     428            OnExit = cboAvailTestExit
     429            OnMouseClick = cboAvailTestSelect
     430            OnNeedData = cboAvailTestNeedData
     431            CharsNeedMatch = 1
     432          end
     433          object cboCollType: TORComboBox
     434            Left = 12
     435            Top = 46
     436            Width = 165
     437            Height = 21
     438            Style = orcsDropDown
     439            AutoSelect = True
     440            Caption = 'Collection Type'
     441            Color = clWindow
     442            DropDownCount = 8
     443            Font.Charset = DEFAULT_CHARSET
     444            Font.Color = clWindowText
     445            Font.Height = -11
     446            Font.Name = 'MS Sans Serif'
     447            Font.Style = []
     448            ItemHeight = 13
     449            ItemTipColor = clWindow
     450            ItemTipEnable = True
     451            ListItemsOnly = True
     452            LongList = False
     453            LookupPiece = 0
     454            MaxLength = 0
     455            ParentFont = False
     456            Pieces = '2'
     457            Sorted = False
     458            SynonymChars = '<>'
     459            TabOrder = 1
     460            OnChange = cboCollTypeChange
     461            CharsNeedMatch = 1
     462          end
     463          object cboCollTime: TORComboBox
     464            Left = 12
     465            Top = 82
     466            Width = 165
     467            Height = 21
     468            Style = orcsDropDown
     469            AutoSelect = True
     470            Caption = 'Collection Date/Time'
     471            Color = clWindow
     472            DropDownCount = 8
     473            Font.Charset = DEFAULT_CHARSET
     474            Font.Color = clWindowText
     475            Font.Height = -11
     476            Font.Name = 'MS Sans Serif'
     477            Font.Style = []
     478            ItemHeight = 13
     479            ItemTipColor = clWindow
     480            ItemTipEnable = True
     481            ListItemsOnly = False
     482            LongList = False
     483            LookupPiece = 0
     484            MaxLength = 0
     485            ParentFont = False
     486            Pieces = '2'
     487            Sorted = False
     488            SynonymChars = '<>'
     489            TabOrder = 2
     490            OnChange = cboCollTimeChange
     491            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
     508          end
     509          object txtImmedColl: TCaptionEdit
     510            Left = 12
     511            Top = 82
     512            Width = 165
     513            Height = 21
     514            Color = clBtnFace
     515            ReadOnly = True
     516            TabOrder = 4
     517            Text = 'txtImmedColl'
     518          end
     519        end
     520        object pnlBloodComponents: TGroupBox
     521          Left = 4
     522          Top = 0
     523          Width = 246
     524          Height = 110
     525          Caption = 'Blood Components'
     526          Font.Charset = DEFAULT_CHARSET
     527          Font.Color = clWindowText
     528          Font.Height = -11
     529          Font.Name = 'MS Sans Serif'
     530          Font.Style = [fsBold]
     531          ParentFont = False
     532          TabOrder = 0
     533          object lblQuantity: TLabel
     534            Left = 198
     535            Top = 0
     536            Width = 43
     537            Height = 13
     538            Caption = 'Quantity*'
     539            Font.Charset = DEFAULT_CHARSET
     540            Font.Color = clWindowText
     541            Font.Height = -11
     542            Font.Name = 'MS Sans Serif'
     543            Font.Style = []
     544            ParentFont = False
     545          end
     546          object lblModifiers: TLabel
     547            Left = 7
     548            Top = 33
     549            Width = 42
     550            Height = 13
     551            Caption = 'Modifiers'
     552            Font.Charset = DEFAULT_CHARSET
     553            Font.Color = clWindowText
     554            Font.Height = -11
     555            Font.Name = 'MS Sans Serif'
     556            Font.Style = []
     557            ParentFont = False
     558          end
     559          object lblWanted: TLabel
     560            Left = 7
     561            Top = 70
     562            Width = 96
     563            Height = 13
     564            Caption = 'Date/Time Wanted*'
     565            Font.Charset = DEFAULT_CHARSET
     566            Font.Color = clWindowText
     567            Font.Height = -11
     568            Font.Name = 'MS Sans Serif'
     569            Font.Style = []
     570            ParentFont = False
     571          end
     572          object cboAvailComp: TORComboBox
     573            Left = 11
     574            Top = 13
     575            Width = 181
     576            Height = 21
     577            Style = orcsDropDown
     578            AutoSelect = True
     579            Caption = 'Blood Components'
     580            Color = clWindow
     581            DropDownCount = 8
     582            Font.Charset = DEFAULT_CHARSET
     583            Font.Color = clWindowText
     584            Font.Height = -11
     585            Font.Name = 'MS Sans Serif'
     586            Font.Style = []
     587            ItemHeight = 13
     588            ItemTipColor = clWindow
     589            ItemTipEnable = True
     590            ListItemsOnly = False
     591            LongList = False
     592            LookupPiece = 0
     593            MaxLength = 0
     594            ParentFont = False
     595            Pieces = '2'
     596            Sorted = False
     597            SynonymChars = '<>'
     598            TabOrder = 0
     599            TabStop = True
     600            OnChange = cboAvailCompChange
     601            OnExit = cboAvailCompExit
     602            OnMouseClick = cboAvailCompSelect
     603            OnNeedData = cboAvailCompNeedData
     604            CharsNeedMatch = 1
     605          end
     606          object tQuantity: TEdit
     607            Left = 198
     608            Top = 13
     609            Width = 25
     610            Height = 21
     611            Font.Charset = DEFAULT_CHARSET
     612            Font.Color = clWindowText
     613            Font.Height = -11
     614            Font.Name = 'MS Sans Serif'
     615            Font.Style = []
     616            ParentFont = False
     617            TabOrder = 1
     618            OnChange = tQuantityChange
     619            OnClick = tQuantityClick
     620            OnEnter = tQuantityEnter
     621          end
     622          object cboModifiers: TORComboBox
     623            Left = 11
     624            Top = 46
     625            Width = 133
     626            Height = 21
     627            Style = orcsDropDown
     628            AutoSelect = True
     629            Caption = 'Modifier'
     630            Color = clWindow
     631            DropDownCount = 8
     632            Font.Charset = DEFAULT_CHARSET
     633            Font.Color = clWindowText
     634            Font.Height = -11
     635            Font.Name = 'MS Sans Serif'
     636            Font.Style = []
     637            ItemHeight = 13
     638            ItemTipColor = clWindow
     639            ItemTipEnable = True
     640            ListItemsOnly = True
     641            LongList = False
     642            LookupPiece = 0
     643            MaxLength = 0
     644            ParentFont = False
     645            Sorted = False
     646            SynonymChars = '<>'
     647            TabOrder = 2
     648            OnChange = cboModifiersChange
     649            CharsNeedMatch = 1
     650          end
     651          object calWantTime: TORDateBox
     652            Left = 11
     653            Top = 82
     654            Width = 149
     655            Height = 21
     656            Font.Charset = DEFAULT_CHARSET
     657            Font.Color = clWindowText
     658            Font.Height = -11
     659            Font.Name = 'MS Sans Serif'
     660            Font.Style = []
     661            ParentFont = False
     662            TabOrder = 3
     663            OnChange = calWantTimeChange
     664            DateOnly = False
     665            RequireTime = False
     666          end
     667        end
     668      end
     669      object GroupBox1: TGroupBox
     670        Left = 0
     671        Top = 0
     672        Width = 701
     673        Height = 35
     674        Align = alTop
     675        Caption = ' Personal Quick Orders'
    50676        Font.Charset = DEFAULT_CHARSET
    51677        Font.Color = clWindowText
    … …  
    53679        Font.Name = 'MS Sans Serif'
    54680        Font.Style = []
    55         Images = ImageList1
    56681        ParentFont = False
    57         TabIndex = 1
    58682        TabOrder = 0
    59         OnChange = pgeProductChange
    60         object tabInfo: TTabSheet
    61           Caption = 'Patient Information'
    62           ImageIndex = 3
    63           object edtInfo: TCaptionRichEdit
    64             Left = 0
    65             Top = 8
    66             Width = 513
    67             Height = 369
    68             Font.Charset = DEFAULT_CHARSET
    69             Font.Color = clWindowText
    70             Font.Height = -11
    71             Font.Name = 'Courier New'
    72             Font.Style = []
    73             ParentFont = False
    74             ReadOnly = True
    75             ScrollBars = ssBoth
    76             TabOrder = 0
    77             Caption = 'Patient Info'
    78           end
    79         end
    80         object TabDiag: TTabSheet
    81           Caption = 'Orders'
    82           ImageIndex = 2
    83           object lblReqComment: TOROffsetLabel
    84             Left = 300
    85             Top = 25
    86             Width = 104
    87             Height = 33
    88             HorzOffset = 2
    89             Transparent = False
    90             VertOffset = 2
    91             WordWrap = False
    92           end
    93           object pnlFields: TPanel
    94             Left = 0
    95             Top = 87
    96             Width = 513
    97             Height = 162
    98             Hint = 'Data entered into these fields apply to the entire order.'
    99             ParentShowHint = False
    100             ShowHint = True
    101             TabOrder = 0
    102             object lblDiagComment: TOROffsetLabel
    103               Left = 8
    104               Top = 114
    105               Width = 46
    106               Height = 15
    107               Caption = 'Comment'
    108               HorzOffset = 2
    109               Transparent = False
    110               VertOffset = 2
    111               WordWrap = True
    112             end
    113             object lblUrgency: TLabel
    114               Left = 8
    115               Top = 80
    116               Width = 40
    117               Height = 13
    118               Caption = 'Urgency'
    119             end
    120             object lblCollType: TLabel
    121               Left = 8
    122               Top = 41
    123               Width = 73
    124               Height = 13
    125               Caption = 'Collection Type'
    126             end
    127             object lblPreparation: TLabel
    128               Left = 352
    129               Top = 41
    130               Width = 54
    131               Height = 13
    132               Caption = 'Preparation'
    133               Enabled = False
    134               Visible = False
    135             end
    136             object lblWanted: TLabel
    137               Left = 352
    138               Top = 5
    139               Width = 90
    140               Height = 13
    141               Caption = 'Date Time Wanted'
    142             end
    143             object lblReason: TLabel
    144               Left = 332
    145               Top = 114
    146               Width = 95
    147               Height = 13
    148               Caption = 'Reason for Request'
    149             end
    150             object lblSurgery: TLabel
    151               Left = 352
    152               Top = 80
    153               Width = 36
    154               Height = 13
    155               Hint =
    156                 'Enter the name of the surgical procedure that this request is fo' +
    157                 'r.'
    158               Caption = 'Surgery'
    159             end
    160             object lblCollTime: TLabel
    161               Left = 8
    162               Top = 5
    163               Width = 100
    164               Height = 13
    165               Caption = 'Collection Date/Time'
    166             end
    167             object cmdImmedColl: TSpeedButton
    168               Left = 132
    169               Top = 21
    170               Width = 24
    171               Height = 17
    172               Font.Charset = DEFAULT_CHARSET
    173               Font.Color = clWindowText
    174               Font.Height = -16
    175               Font.Name = 'MS Sans Serif'
    176               Font.Style = [fsBold]
    177               Glyph.Data = {
    178                 D6000000424DD60000000000000076000000280000000C0000000C0000000100
    179                 0400000000006000000000000000000000001000000010000000000000000000
    180                 80000080000000808000800000008000800080800000C0C0C000808080000000
    181                 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    182                 0000333333333333000033333333333300003333333333330000300330033003
    183                 0000300330033003000033333333333300003333333333330000333333333333
    184                 0000333333333333000033333333333300003333333333330000}
    185               ParentFont = False
    186               ParentShowHint = False
    187               ShowHint = False
    188               OnClick = cmdImmedCollClick
    189             end
    190             object txtDiagComment: TCaptionEdit
    191               Left = 8
    192               Top = 132
    193               Width = 293
    194               Height = 21
    195               MaxLength = 240
    196               TabOrder = 6
    197               OnChange = txtDiagCommentChange
    198             end
    199             object cboUrgency: TORComboBox
    200               Left = 8
    201               Top = 96
    202               Width = 112
    203               Height = 21
    204               Style = orcsDropDown
    205               AutoSelect = True
    206               Caption = 'Urgency'
    207               Color = clWindow
    208               DropDownCount = 8
    209               ItemHeight = 13
    210               ItemTipColor = clWindow
    211               ItemTipEnable = True
    212               ListItemsOnly = True
    213               LongList = False
    214               LookupPiece = 0
    215               MaxLength = 0
    216               Pieces = '2'
    217               Sorted = False
    218               SynonymChars = '<>'
    219               TabOrder = 5
    220               OnChange = cboUrgencyChange
    221               CharsNeedMatch = 1
    222             end
    223             object cboCollType: TORComboBox
    224               Left = 8
    225               Top = 57
    226               Width = 149
    227               Height = 21
    228               Style = orcsDropDown
    229               AutoSelect = True
    230               Caption = 'Collection Type'
    231               Color = clWindow
    232               DropDownCount = 8
    233               ItemHeight = 13
    234               ItemTipColor = clWindow
    235               ItemTipEnable = True
    236               ListItemsOnly = True
    237               LongList = False
    238               LookupPiece = 0
    239               MaxLength = 0
    240               Pieces = '2'
    241               Sorted = False
    242               SynonymChars = '<>'
    243               TabOrder = 4
    244               OnChange = cboCollTypeChange
    245               CharsNeedMatch = 1
    246             end
    247             object chkConsent: TCheckBox
    248               Left = 192
    249               Top = 21
    250               Width = 112
    251               Height = 17
    252               Hint = 'Informed Consent Signed On Chart?'
    253               Alignment = taLeftJustify
    254               Caption = 'Informed Consent?'
    255               ParentShowHint = False
    256               ShowHint = True
    257               TabOrder = 11
    258               OnClick = chkConsentClick
    259             end
    260             object calWantTime: TORDateBox
    261               Left = 352
    262               Top = 17
    263               Width = 149
    264               Height = 21
    265               TabOrder = 7
    266               OnChange = calWantTimeChange
    267               DateOnly = False
    268               RequireTime = False
    269             end
    270             object tReason: TEdit
    271               Left = 332
    272               Top = 132
    273               Width = 169
    274               Height = 21
    275               MaxLength = 80
    276               TabOrder = 10
    277               OnChange = tReasonChange
    278             end
    279             object cboSurgery: TORComboBox
    280               Left = 352
    281               Top = 92
    282               Width = 149
    283               Height = 21
    284               Style = orcsDropDown
    285               AutoSelect = True
    286               Caption = 'Surgery'
    287               Color = clWindow
    288               DropDownCount = 8
    289               ItemHeight = 13
    290               ItemTipColor = clWindow
    291               ItemTipEnable = True
    292               ListItemsOnly = False
    293               LongList = False
    294               LookupPiece = 0
    295               MaxLength = 0
    296               Pieces = '2'
    297               Sorted = False
    298               SynonymChars = '<>'
    299               TabOrder = 9
    300               OnChange = cboSurgeryChange
    301               CharsNeedMatch = 1
    302             end
    303             object txtImmedColl: TCaptionEdit
    304               Left = 12
    305               Top = 17
    306               Width = 145
    307               Height = 21
    308               Color = clBtnFace
    309               ReadOnly = True
    310               TabOrder = 2
    311               Text = 'txtImmedColl'
    312             end
    313             object cboCollTime: TORComboBox
    314               Left = 8
    315               Top = 17
    316               Width = 149
    317               Height = 21
    318               Style = orcsDropDown
    319               AutoSelect = True
    320               Caption = 'Collection Date/Time'
    321               Color = clWindow
    322               DropDownCount = 8
    323               ItemHeight = 13
    324               ItemTipColor = clWindow
    325               ItemTipEnable = True
    326               ListItemsOnly = False
    327               LongList = False
    328               LookupPiece = 0
    329               MaxLength = 0
    330               Pieces = '2'
    331               Sorted = False
    332               SynonymChars = '<>'
    333               TabOrder = 0
    334               CharsNeedMatch = 1
    335             end
    336             object pnlCollTimeButton: TKeyClickPanel
    337               Left = 137
    338               Top = 19
    339               Width = 20
    340               Height = 19
    341               BevelOuter = bvNone
    342               Caption = 'Select collection time'
    343               TabOrder = 3
    344               TabStop = True
    345             end
    346             object calCollTime: TORDateBox
    347               Left = 8
    348               Top = 17
    349               Width = 149
    350               Height = 21
    351               TabOrder = 1
    352               OnChange = calCollTimeChange
    353               DateOnly = False
    354               RequireTime = False
    355             end
    356             object cboPreparation: TORComboBox
    357               Left = 352
    358               Top = 56
    359               Width = 149
    360               Height = 21
    361               Style = orcsDropDown
    362               AutoSelect = True
    363               Color = clWindow
    364               DropDownCount = 8
    365               Enabled = False
    366               Items.Strings = (
    367                 'I^Immediate'
    368                 'H^Hold')
    369               ItemHeight = 13
    370               ItemTipColor = clWindow
    371               ItemTipEnable = True
    372               ListItemsOnly = False
    373               LongList = False
    374               LookupPiece = 0
    375               MaxLength = 0
    376               Pieces = '2'
    377               Sorted = False
    378               SynonymChars = '<>'
    379               TabOrder = 8
    380               Visible = False
    381               OnChange = cboPreparationChange
    382               CharsNeedMatch = 1
    383             end
    384           end
    385           object pnlTop: TPanel
    386             Left = 0
    387             Top = 1
    388             Width = 513
    389             Height = 84
    390             TabOrder = 1
    391             object pnlSelect: TPanel
    392               Left = 5
    393               Top = 1
    394               Width = 511
    395               Height = 76
    396               TabOrder = 0
    397               object pnlDiagTests: TGroupBox
    398                 Left = 8
    399                 Top = 0
    400                 Width = 245
    401                 Height = 73
    402                 Caption = 'Diagnostic Tests'
    403                 Font.Charset = DEFAULT_CHARSET
    404                 Font.Color = clWindowText
    405                 Font.Height = -11
    406                 Font.Name = 'MS Sans Serif'
    407                 Font.Style = []
    408                 ParentFont = False
    409                 TabOrder = 0
    410                 object lblTNS: TLabel
    411                   Left = 8
    412                   Top = 52
    413                   Width = 3
    414                   Height = 13
    415                   Color = clActiveBorder
    416                   Font.Charset = DEFAULT_CHARSET
    417                   Font.Color = clMaroon
    418                   Font.Height = -11
    419                   Font.Name = 'MS Sans Serif'
    420                   Font.Style = []
    421                   ParentColor = False
    422                   ParentFont = False
    423                 end
    424                 object cboAvailTest: TORComboBox
    425                   Left = 7
    426                   Top = 18
    427                   Width = 226
    428                   Height = 21
    429                   Style = orcsDropDown
    430                   AutoSelect = True
    431                   Caption = 'Available Lab Tests'
    432                   Color = clWindow
    433                   DropDownCount = 8
    434                   ItemHeight = 13
    435                   ItemTipColor = clWindow
    436                   ItemTipEnable = True
    437                   ListItemsOnly = True
    438                   LongList = True
    439                   LookupPiece = 0
    440                   MaxLength = 0
    441                   Pieces = '2'
    442                   Sorted = False
    443                   SynonymChars = '<>'
    444                   TabOrder = 0
    445                   OnClick = cboAvailTestSelect
    446                   OnExit = cboAvailTestExit
    447                   OnNeedData = cboAvailTestNeedData
    448                   CharsNeedMatch = 1
    449                 end
    450               end
    451               object pnlBloodComponents: TGroupBox
    452                 Left = 252
    453                 Top = 0
    454                 Width = 253
    455                 Height = 73
    456                 Caption = 'Blood Components'
    457                 TabOrder = 1
    458                 object lblQuantity: TLabel
    459                   Left = 198
    460                   Top = 0
    461                   Width = 39
    462                   Height = 13
    463                   Caption = 'Quantity'
    464                 end
    465                 object lblModifiers: TLabel
    466                   Left = 10
    467                   Top = 48
    468                   Width = 42
    469                   Height = 13
    470                   Caption = 'Modifiers'
    471                 end
    472                 object cboAvailComp: TORComboBox
    473                   Left = 8
    474                   Top = 18
    475                   Width = 181
    476                   Height = 21
    477                   Style = orcsDropDown
    478                   AutoSelect = True
    479                   Caption = 'Available Lab Tests'
    480                   Color = clWindow
    481                   DropDownCount = 8
    482                   ItemHeight = 13
    483                   ItemTipColor = clWindow
    484                   ItemTipEnable = True
    485                   ListItemsOnly = True
    486                   LongList = True
    487                   LookupPiece = 0
    488                   MaxLength = 0
    489                   Pieces = '2'
    490                   Sorted = False
    491                   SynonymChars = '<>'
    492                   TabOrder = 0
    493                   OnClick = cboAvailCompSelect
    494                   OnExit = cboAvailCompExit
    495                   OnNeedData = cboAvailCompNeedData
    496                   CharsNeedMatch = 1
    497                 end
    498                 object tQuantity: TEdit
    499                   Left = 200
    500                   Top = 16
    501                   Width = 25
    502                   Height = 21
    503                   TabOrder = 1
    504                   Text = '0'
    505                 end
    506                 object upQuantity: TUpDown
    507                   Left = 225
    508                   Top = 16
    509                   Width = 15
    510                   Height = 21
    511                   Associate = tQuantity
    512                   Min = 0
    513                   Position = 0
    514                   TabOrder = 2
    515                   Wrap = False
    516                 end
    517                 object cboModifiers: TORComboBox
    518                   Left = 56
    519                   Top = 44
    520                   Width = 133
    521                   Height = 21
    522                   Style = orcsDropDown
    523                   AutoSelect = True
    524                   Caption = 'Modifier'
    525                   Color = clWindow
    526                   DropDownCount = 8
    527                   ItemHeight = 13
    528                   ItemTipColor = clWindow
    529                   ItemTipEnable = True
    530                   ListItemsOnly = True
    531                   LongList = False
    532                   LookupPiece = 0
    533                   MaxLength = 0
    534                   Sorted = False
    535                   SynonymChars = '<>'
    536                   TabOrder = 3
    537                   CharsNeedMatch = 1
    538                 end
    539               end
    540             end
    541           end
    542         end
    543         object TabResults: TTabSheet
    544           Caption = 'Lab Results'
    545           Enabled = False
    546           object edtResults: TCaptionRichEdit
    547             Left = 0
    548             Top = 8
    549             Width = 513
    550             Height = 369
    551             Font.Charset = DEFAULT_CHARSET
    552             Font.Color = clWindowText
    553             Font.Height = -11
    554             Font.Name = 'Courier New'
    555             Font.Style = []
    556             ParentFont = False
    557             TabOrder = 0
    558           end
     683        object cboQuick: TORComboBox
     684          Left = 15
     685          Top = 11
     686          Width = 488
     687          Height = 21
     688          Style = orcsDropDown
     689          AutoSelect = True
     690          Color = clWindow
     691          DropDownCount = 8
     692          ItemHeight = 13
     693          ItemTipColor = clWindow
     694          ItemTipEnable = True
     695          ListItemsOnly = False
     696          LongList = True
     697          LookupPiece = 0
     698          MaxLength = 0
     699          Pieces = '2'
     700          Sorted = False
     701          SynonymChars = '<>'
     702          TabOrder = 0
     703          OnClick = cboQuickClick
     704          CharsNeedMatch = 1
    559705        end
    560706      end
    561707      object pnlSelectedTests: TGroupBox
    562         Left = 4
    563         Top = 292
    564         Width = 518
    565         Height = 117
     708        Left = 0
     709        Top = 262
     710        Width = 701
     711        Height = 112
     712        Align = alTop
    566713        Caption = 'Selected Components and Tests'
    567         TabOrder = 1
     714        Font.Charset = DEFAULT_CHARSET
     715        Font.Color = clWindowText
     716        Font.Height = -11
     717        Font.Name = 'MS Sans Serif'
     718        Font.Style = [fsBold]
     719        ParentFont = False
     720        TabOrder = 3
    568721        Visible = False
    569         object btnAddTests: TORAlignSpeedButton
    570           Left = 426
    571           Top = 17
    572           Width = 75
    573           Height = 21
    574           Caption = 'Add'
    575           Font.Charset = DEFAULT_CHARSET
    576           Font.Color = clWindowText
    577           Font.Height = -11
    578           Font.Name = 'MS Sans Serif'
    579           Font.Style = []
    580           Glyph.Data = {
    581             F6000000424DF600000000000000760000002800000010000000100000000100
    582             0400000000008000000000000000000000001000000000000000000000000000
    583             8000008000000080800080000000800080008080000080808000C0C0C0000000
    584             FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    585             3333333333333333333333333333333333333333333003333333333333300333
    586             3333333333300333333333333330033333333330000000000333333000000000
    587             0333333333300333333333333330033333333333333003333333333333300333
    588             3333333333333333333333333333333333333333333333333333}
    589           ParentFont = False
    590           OnClick = btnAddTestsClick
    591         end
    592722        object lvSelectionList: TCaptionListView
    593           Left = 4
    594           Top = 16
    595           Width = 409
    596           Height = 93
     723          Left = 5
     724          Top = 12
     725          Width = 417
     726          Height = 91
     727          Color = clBtnFace
    597728          Columns = <
    598729            item
    … …  
    609740            end
    610741            item
    611               Caption = 'ID'
     742              Caption = 'ModifierItemIndex'
     743              Width = 0
     744            end
     745            item
     746              Caption = 'TestIEN'
    612747              Width = 0
    613748            end>
     749          Font.Charset = DEFAULT_CHARSET
     750          Font.Color = clWindowText
     751          Font.Height = -11
     752          Font.Name = 'MS Sans Serif'
     753          Font.Style = [fsBold]
     754          ReadOnly = True
    614755          RowSelect = True
     756          ParentFont = False
    615757          TabOrder = 0
     758          TabStop = False
    616759          ViewStyle = vsReport
     760          OnClick = lvSelectionListClick
    617761          Caption = 'lvSelectionList'
    618762        end
    619763        object btnRemove: TButton
    620           Left = 426
    621           Top = 42
     764          Left = 428
     765          Top = 37
    622766          Width = 75
    623767          Height = 21
    624768          Caption = 'Remove'
     769          Font.Charset = DEFAULT_CHARSET
     770          Font.Color = clWindowText
     771          Font.Height = -11
     772          Font.Name = 'MS Sans Serif'
     773          Font.Style = []
     774          ParentFont = False
    625775          TabOrder = 1
    626776          OnClick = btnRemoveClick
    627777        end
    628778        object btnRemoveAll: TButton
    629           Left = 426
    630           Top = 68
     779          Left = 428
     780          Top = 64
    631781          Width = 75
    632782          Height = 21
    633783          Caption = 'Remove All'
     784          Font.Charset = DEFAULT_CHARSET
     785          Font.Color = clWindowText
     786          Font.Height = -11
     787          Font.Name = 'MS Sans Serif'
     788          Font.Style = []
     789          ParentFont = False
    634790          TabOrder = 2
    635791          OnClick = btnRemoveAllClick
    636792        end
     793      end
     794    end
     795    object TabResults: TTabSheet
     796      Caption = 'Lab Results'
     797      object edtResults: TCaptionRichEdit
     798        Left = -4
     799        Top = 57
     800        Width = 517
     801        Height = 290
     802        Font.Charset = DEFAULT_CHARSET
     803        Font.Color = clWindowText
     804        Font.Height = -11
     805        Font.Name = 'Courier New'
     806        Font.Style = []
     807        ParentFont = False
     808        TabOrder = 0
    637809      end
    638810    end
    639811  end
     812  inherited cmdAccept: TButton
     813    Left = 455
     814    Top = 399
     815    TabOrder = 2
     816    Visible = False
     817    ExplicitLeft = 455
     818    ExplicitTop = 399
     819  end
     820  inherited cmdQuit: TButton
     821    Left = 455
     822    Top = 426
     823    Width = 52
     824    TabOrder = 3
     825    ExplicitLeft = 455
     826    ExplicitTop = 426
     827    ExplicitWidth = 52
     828  end
     829  inherited pnlMessage: TPanel
     830    Left = 8
     831    Top = 409
     832    Width = 409
     833    Height = 49
     834    TabOrder = 1
     835    ExplicitLeft = 8
     836    ExplicitTop = 409
     837    ExplicitWidth = 409
     838    ExplicitHeight = 49
     839    inherited memMessage: TRichEdit
     840      Left = 42
     841      Top = 5
     842      Width = 360
     843      ExplicitLeft = 42
     844      ExplicitTop = 5
     845      ExplicitWidth = 360
     846    end
     847  end
     848  inherited amgrMain: TVA508AccessibilityManager
     849    Data = (
     850      (
     851        'Component = memOrder'
     852        'Status = stsDefault')
     853      (
     854        'Component = cmdAccept'
     855        'Status = stsDefault')
     856      (
     857        'Component = cmdQuit'
     858        'Status = stsDefault')
     859      (
     860        'Component = pnlMessage'
     861        'Status = stsDefault')
     862      (
     863        'Component = memMessage'
     864        'Status = stsDefault')
     865      (
     866        'Component = frmODBBank'
     867        'Status = stsDefault')
     868      (
     869        'Component = pnlComments'
     870        'Status = stsDefault')
     871      (
     872        'Component = btnUpdateComments'
     873        'Status = stsDefault')
     874      (
     875        'Component = btnCancelComment'
     876        'Status = stsDefault')
     877      (
     878        'Component = pgeProduct'
     879        'Status = stsDefault')
     880      (
     881        'Component = TabInfo'
     882        'Status = stsDefault')
     883      (
     884        'Component = edtInfo'
     885        'Status = stsDefault')
     886      (
     887        'Component = TabDiag'
     888        'Status = stsDefault')
     889      (
     890        'Component = TabResults'
     891        'Status = stsDefault')
     892      (
     893        'Component = edtResults'
     894        'Status = stsDefault')
     895      (
     896        'Component = pnlFields'
     897        'Status = stsDefault')
     898      (
     899        'Component = cboUrgency'
     900        'Status = stsDefault')
     901      (
     902        'Component = chkConsent'
     903        'Status = stsDefault')
     904      (
     905        'Component = cboSurgery'
     906        'Status = stsDefault')
     907      (
     908        'Component = pnlSelect'
     909        'Status = stsDefault')
     910      (
     911        'Component = pnlDiagnosticTests'
     912        'Status = stsDefault')
     913      (
     914        'Component = cboAvailTest'
     915        'Status = stsDefault')
     916      (
     917        'Component = pnlBloodComponents'
     918        'Status = stsDefault')
     919      (
     920        'Component = cboAvailComp'
     921        'Status = stsDefault')
     922      (
     923        'Component = tQuantity'
     924        'Status = stsDefault')
     925      (
     926        'Component = cboModifiers'
     927        'Status = stsDefault')
     928      (
     929        'Component = GroupBox1'
     930        'Status = stsDefault')
     931      (
     932        'Component = cboQuick'
     933        'Status = stsDefault')
     934      (
     935        'Component = pnlSelectedTests'
     936        'Status = stsDefault')
     937      (
     938        'Component = lvSelectionList'
     939        'Status = stsDefault')
     940      (
     941        'Component = btnRemove'
     942        'Status = stsDefault')
     943      (
     944        'Component = btnRemoveAll'
     945        'Status = stsDefault')
     946      (
     947        'Component = cboReasons'
     948        'Text = Applies to entire order'
     949        'Status = stsOK')
     950      (
     951        'Component = memDiagComment'
     952        'Status = stsDefault')
     953      (
     954        'Component = cboCollType'
     955        'Status = stsDefault')
     956      (
     957        'Component = cboCollTime'
     958        'Status = stsDefault')
     959      (
     960        'Component = calWantTime'
     961        'Status = stsDefault')
     962      (
     963        'Component = calCollTime'
     964        'Status = stsDefault')
     965      (
     966        'Component = txtImmedColl'
     967        'Status = stsDefault')
     968      (
     969        'Component = pnlCollTimeButton'
     970        'Status = stsDefault'))
     971  end
    640972  object dlgLabCollTime: TORDateTimeDlg
    641     FMDateTime = 2980923
     973    FMDateTime = 2980923.000000000000000000
    642974    DateOnly = False
    643975    RequireTime = True
    644976    Left = 435
    645     Top = 12
     977    Top = 72
    646978  end
    647979  object ORWanted: TORDateTimeDlg
    648     FMDateTime = 2980923
     980    FMDateTime = 2980923.000000000000000000
    649981    DateOnly = False
    650982    RequireTime = True
    651     Left = 335
    652     Top = 12
    653   end
    654   object ImageList1: TImageList
    655     Left = 388
    656     Top = 12
    657     Bitmap = {
    658       494C010104000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
    659       0000000000003600000028000000400000003000000001002000000000000030
    660       0000000000000000000000000000000000000000000000000000000000000000
    661       0000000000000000000000000000000000000000000000000000000000000000
    662       0000000000000000000000000000000000000000000000000000000000000000
    663       0000000000000000000000000000000000000000000000000000000000000000
    664       0000000000000000000000000000000000000000000000000000000000000000
    665       0000000000000000000000000000000000000000000000000000000000000000
    666       0000000000000000000000000000000000000000000000000000000000000000
    667       0000000000000000000000000000000000000000000000000000000000000000
    668       0000000000000000000000000000000000000000000000000000000000000000
    669       0000000000000000000000000000000000000000000000000000000000000000
    670       0000000000000000000000000000000000000000000000000000000000000000
    671       0000000000000000000000000000000000000000000000000000000000000000
    672       0000000000000000000000000000000000000000000000000000000000000000
    673       0000000000000000000000000000000000000000000000000000000000000000
    674       0000000000000000000000000000000000000000000000000000000000000000
    675       0000000000000000000000000000000000000000000000000000000000000000
    676       0000000000000000000000000000000000000000000000000000000000000000
    677       0000000000000000000000000000000000000000000000000000000000000000
    678       0000000000000000000000000000000000000000000000000000000000000000
    679       0000000000000000000000000000000000000000000000000000000000000000
    680       0000000000000000000000000000000000000000000000000000000000000000
    681       0000000000000000000000000000000000000000000000000000000000000000
    682       0000000000000000000000000000000000000000000000000000000000000000
    683       0000000000000000000000000000000000000000000000000000000000000000
    684       0000000000000000000000000000000000000000000000000000000000000000
    685       0000000000000000000000000000000000000000000000000000000000000000
    686       0000000000000000000000000000000000000000000000000000000000000000
    687       0000000000000000000000000000000000000000000000000000000000000000
    688       0000000000000000000000000000000000000000000000000000000000000000
    689       0000000000000000000000000000000000000000000000000000000000000000
    690       0000000000000000000000000000000000000000000000000000000000000000
    691       0000000000000000000000000000000000000000000000000000000000000000
    692       0000000000000000000000000000000000000000000000000000000000000000
    693       0000000000000000000000000000000000000000000000000000000000000000
    694       0000000000000000000000000000000000000000000000000000000000000000
    695       0000000000000000000000000000000000000000000000000000000000000000
    696       0000000000000000000000000000000000000000000000000000000000000000
    697       0000000000000000000000000000000000000000000000000000000000000000
    698       0000000000000000000000000000000000000000000000000000000000000000
    699       0000000000000000000000000000000000000000000000000000000000000000
    700       0000000000000000000000000000000000000000000000000000000000000000
    701       0000000000000000000000000000000000000000000000000000000000000000
    702       0000000000000000000000000000000000000000000000000000000000000000
    703       0000000000000000000000000000000000000000000000000000000000000000
    704       0000000000000000000000000000000000000000000000000000000000000000
    705       0000000000000000000000000000000000000000000000000000000000000000
    706       0000000000000000000000000000000000000000000000000000000000000000
    707       0000000000000000000000000000000000000000000000000000000000000000
    708       0000000000000000000000000000000000000000000000000000000000000000
    709       0000000000000000000000000000000000000000000000000000000000000000
    710       0000000000000000000000000000000000000000000000000000000000000000
    711       0000000000000000000000000000000000000000000000000000000000000000
    712       0000000000000000000000000000000000000000000000000000000000000000
    713       0000000000000000000000000000000000000000000000000000000000000000
    714       0000000000000000000000000000000000000000000000000000000000000000
    715       0000000000000000000000000000000000000000000000000000000000000000
    716       0000000000000000000000000000000000000000000000000000000000000000
    717       0000000000000000000000000000000000000000000000000000000000000000
    718       0000000000000000000000000000000000000000000000000000000000000000
    719       0000000000000000000000000000000000000000000000000000000000000000
    720       0000000000000000000000000000000000000000000000000000000000000000
    721       0000000000000000000000000000000000000000000000000000000000000000
    722       0000000000000000000000000000000000000000000000000000000000000000
    723       0000000000000000000000000000000000000000000000000000000000000000
    724       0000000000000000000000000000000000000000000000000000000000000000
    725       0000000000000000000000000000000000000000000000000000000000000000
    726       0000000000000000000000000000000000000000000000000000000000000000
    727       0000000000000000000000000000000000000000000000000000000000000000
    728       0000000000000000000000000000000000000000000000000000000000000000
    729       0000000000000000000000000000000000000000000000000000000000000000
    730       0000000000000000000000000000000000000000000000000000000000000000
    731       0000000000000000000000000000000000000000000000000000000000000000
    732       0000000000000000000000000000000000000000000000000000000000000000
    733       0000000000000000000000000000000000000000000000000000000000000000
    734       0000000000000000000000000000000000000000000000000000000000000000
    735       0000000000000000000000000000000000000000000000000000000000000000
    736       0000000000000000000000000000000000000000000000000000000000000000
    737       0000000000000000000000000000000000000000000000000000000000000000
    738       0000000000000000000000000000000000000000000000000000000000000000
    739       0000000000000000000000000000000000000000000000000000000000000000
    740       0000000000000000000000000000000000000000000000000000000000000000
    741       0000000000000000000000000000000000000000000000000000000000000000
    742       0000000000000000000000000000000000000000000000000000000000000000
    743       0000000000000000000000000000000000000000000000000000000000000000
    744       0000000000000000000000000000000000000000000000000000000000000000
    745       0000000000000000000000000000000000000000000000000000000000000000
    746       0000000000000000000000000000000000000000000000000000000000000000
    747       0000000000000000000000000000000000000000000000000000000000000000
    748       0000000000000000000000000000000000000000000000000000000000000000
    749       0000000000000000000000000000000000000000000000000000000000000000
    750       0000000000000000000000000000000000000000000000000000000000000000
    751       0000000000000000000000000000000000000000000000000000000000000000
    752       0000000000000000000000000000000000000000000000000000000000000000
    753       0000000000000000000000000000000000000000000000000000000000000000
    754       0000000000000000000000000000000000000000000000000000000000000000
    755       0000000000000000000000000000000000000000000000000000000000000000
    756       0000000000000000000000000000000000000000000000000000000000000000
    757       0000000000000000000000000000000000000000000000000000000000000000
    758       0000000000000000000000000000000000000000000000000000000000000000
    759       0000000000000000000000000000000000000000000000000000000000000000
    760       0000000000000000000000000000000000000000000000000000000000000000
    761       0000000000000000000000000000000000000000000000000000000000000000
    762       0000000000000000000000000000000000000000000000000000000000000000
    763       0000000000000000000000000000000000000000000000000000000000000000
    764       0000000000000000000000000000000000000000000000000000000000000000
    765       0000000000000000000000000000000000000000000000000000000000000000
    766       0000000000000000000000000000000000000000000000000000000000000000
    767       0000000000000000000000000000000000000000000000000000000000000000
    768       0000000000000000000000000000000000000000000000000000000000000000
    769       0000000000000000000000000000000000000000000000000000000000000000
    770       0000000000000000000000000000000000000000000000000000000000000000
    771       0000000000000000000000000000000000000000000000000000000000000000
    772       0000000000000000000000000000000000000000000000000000000000000000
    773       0000000000000000000000000000000000000000000000000000000000000000
    774       0000000000000000000000000000000000000000000000000000000000000000
    775       0000000000000000000000000000000000000000000000000000000000000000
    776       0000000000000000000000000000000000000000000000000000000000000000
    777       0000000000000000000000000000000000000000000000000000000000000000
    778       0000000000000000000000000000000000000000000000000000000000000000
    779       0000000000000000000000000000000000000000000000000000000000000000
    780       0000000000000000000000000000000000000000000000000000000000000000
    781       0000000000000000000000000000000000000000000000000000000000000000
    782       0000000000000000000000000000000000000000000000000000000000000000
    783       0000000000000000000000000000000000000000000000000000000000000000
    784       0000000000000000000000000000000000000000000000000000000000000000
    785       0000000000000000000000000000000000000000000000000000000000000000
    786       0000000000000000000000000000000000000000000000000000000000000000
    787       0000000000000000000000000000000000000000000000000000000000000000
    788       0000000000000000000000000000000000000000000000000000000000000000
    789       0000000000000000000000000000000000000000000000000000000000000000
    790       0000000000000000000000000000000000000000000000000000000000000000
    791       0000000000000000000000000000000000000000000000000000000000000000
    792       0000000000000000000000000000000000000000000000000000000000000000
    793       0000000000000000000000000000000000000000000000000000000000000000
    794       0000000000000000000000000000000000000000000000000000000000000000
    795       0000000000000000000000000000000000000000000000000000000000000000
    796       0000000000000000000000000000000000000000000000000000000000000000
    797       0000000000000000000000000000000000000000000000000000000000000000
    798       0000000000000000000000000000000000000000000000000000000000000000
    799       0000000000000000000000000000000000000000000000000000000000000000
    800       0000000000000000000000000000000000000000000000000000000000000000
    801       0000000000000000000000000000000000000000000000000000000000000000
    802       0000000000000000000000000000000000000000000000000000000000000000
    803       0000000000000000000000000000000000000000000000000000000000000000
    804       0000000000000000000000000000000000000000000000000000000000000000
    805       0000000000000000000000000000000000000000000000000000000000000000
    806       0000000000000000000000000000000000000000000000000000000000000000
    807       0000000000000000000000000000000000000000000000000000000000000000
    808       0000000000000000000000000000000000000000000000000000000000000000
    809       0000000000000000000000000000000000000000000000000000000000000000
    810       0000000000000000000000000000000000000000000000000000000000000000
    811       0000000000000000000000000000000000000000000000000000000000000000
    812       0000000000000000000000000000000000000000000000000000000000000000
    813       0000000000000000000000000000000000000000000000000000000000000000
    814       0000000000000000000000000000000000000000000000000000000000000000
    815       0000000000000000000000000000000000000000000000000000000000000000
    816       0000000000000000000000000000000000000000000000000000000000000000
    817       0000000000000000000000000000000000000000000000000000000000000000
    818       0000000000000000000000000000000000000000000000000000000000000000
    819       0000000000000000000000000000000000000000000000000000000000000000
    820       0000000000000000000000000000000000000000000000000000000000000000
    821       0000000000000000000000000000000000000000000000000000000000000000
    822       0000000000000000000000000000000000000000000000000000000000000000
    823       0000000000000000000000000000000000000000000000000000000000000000
    824       0000000000000000000000000000000000000000000000000000000000000000
    825       0000000000000000000000000000000000000000000000000000000000000000
    826       0000000000000000000000000000000000000000000000000000000000000000
    827       0000000000000000000000000000000000000000000000000000000000000000
    828       0000000000000000000000000000000000000000000000000000000000000000
    829       0000000000000000000000000000000000000000000000000000000000000000
    830       0000000000000000000000000000000000000000000000000000000000000000
    831       0000000000000000000000000000000000000000000000000000000000000000
    832       0000000000000000000000000000000000000000000000000000000000000000
    833       0000000000000000000000000000000000000000000000000000000000000000
    834       0000000000000000000000000000000000000000000000000000000000000000
    835       0000000000000000000000000000000000000000000000000000000000000000
    836       0000000000000000000000000000000000000000000000000000000000000000
    837       0000000000000000000000000000000000000000000000000000000000000000
    838       0000000000000000000000000000000000000000000000000000000000000000
    839       0000000000000000000000000000000000000000000000000000000000000000
    840       0000000000000000000000000000000000000000000000000000000000000000
    841       0000000000000000000000000000000000000000000000000000000000000000
    842       0000000000000000000000000000000000000000000000000000000000000000
    843       0000000000000000000000000000000000000000000000000000000000000000
    844       0000000000000000000000000000000000000000000000000000000000000000
    845       0000000000000000000000000000000000000000000000000000000000000000
    846       0000000000000000000000000000000000000000000000000000000000000000
    847       0000000000000000000000000000000000000000000000000000000000000000
    848       0000000000000000000000000000000000000000000000000000000000000000
    849       0000000000000000000000000000000000000000000000000000000000000000
    850       0000000000000000000000000000000000000000000000000000000000000000
    851       0000000000000000000000000000000000000000000000000000000000000000
    852       0000000000000000000000000000000000000000000000000000000000000000
    853       0000000000000000000000000000000000000000000000000000000000000000
    854       0000000000000000000000000000000000000000000000000000000000000000
    855       0000000000000000000000000000000000000000000000000000000000000000
    856       0000000000000000000000000000000000000000000000000000000000000000
    857       0000000000000000000000000000000000000000000000000000000000000000
    858       0000000000000000000000000000000000000000000000000000000000000000
    859       0000000000000000000000000000000000000000000000000000000000000000
    860       0000000000000000000000000000000000000000000000000000000000000000
    861       0000000000000000000000000000000000000000000000000000000000000000
    862       0000000000000000000000000000000000000000000000000000000000000000
    863       0000000000000000000000000000000000000000000000000000000000000000
    864       0000000000000000000000000000000000000000000000000000000000000000
    865       0000000000000000000000000000000000000000000000000000000000000000
    866       0000000000000000000000000000000000000000000000000000000000000000
    867       0000000000000000000000000000000000000000000000000000000000000000
    868       0000000000000000000000000000000000000000000000000000000000000000
    869       0000000000000000000000000000000000000000000000000000000000000000
    870       0000000000000000000000000000000000000000000000000000000000000000
    871       0000000000000000000000000000000000000000000000000000000000000000
    872       0000000000000000000000000000000000000000000000000000000000000000
    873       0000000000000000000000000000000000000000000000000000000000000000
    874       0000000000000000000000000000000000000000000000000000000000000000
    875       0000000000000000000000000000000000000000000000000000000000000000
    876       0000000000000000000000000000000000000000000000000000000000000000
    877       0000000000000000000000000000000000000000000000000000000000000000
    878       0000000000000000000000000000000000000000000000000000000000000000
    879       0000000000000000000000000000000000000000000000000000000000000000
    880       0000000000000000000000000000000000000000000000000000000000000000
    881       0000000000000000000000000000000000000000000000000000000000000000
    882       0000000000000000000000000000000000000000000000000000000000000000
    883       0000000000000000000000000000000000000000000000000000000000000000
    884       0000000000000000000000000000000000000000000000000000000000000000
    885       0000000000000000000000000000000000000000000000000000000000000000
    886       0000000000000000000000000000000000000000000000000000000000000000
    887       0000000000000000000000000000000000000000000000000000000000000000
    888       0000000000000000000000000000000000000000000000000000000000000000
    889       0000000000000000000000000000000000000000000000000000000000000000
    890       0000000000000000000000000000000000000000000000000000000000000000
    891       0000000000000000000000000000000000000000000000000000000000000000
    892       0000000000000000000000000000000000000000000000000000000000000000
    893       0000000000000000000000000000000000000000000000000000000000000000
    894       0000000000000000000000000000000000000000000000000000000000000000
    895       0000000000000000000000000000000000000000000000000000000000000000
    896       0000000000000000000000000000000000000000000000000000000000000000
    897       0000000000000000000000000000000000000000000000000000000000000000
    898       0000000000000000000000000000000000000000000000000000000000000000
    899       0000000000000000000000000000000000000000000000000000000000000000
    900       0000000000000000000000000000000000000000000000000000000000000000
    901       0000000000000000000000000000000000000000000000000000000000000000
    902       0000000000000000000000000000000000000000000000000000000000000000
    903       0000000000000000000000000000000000000000000000000000000000000000
    904       0000000000000000000000000000000000000000000000000000000000000000
    905       0000000000000000000000000000000000000000000000000000000000000000
    906       0000000000000000000000000000000000000000000000000000000000000000
    907       0000000000000000000000000000000000000000000000000000000000000000
    908       0000000000000000000000000000000000000000000000000000000000000000
    909       0000000000000000000000000000000000000000000000000000000000000000
    910       0000000000000000000000000000000000000000000000000000000000000000
    911       0000000000000000000000000000000000000000000000000000000000000000
    912       0000000000000000000000000000000000000000000000000000000000000000
    913       0000000000000000000000000000000000000000000000000000000000000000
    914       0000000000000000000000000000000000000000000000000000000000000000
    915       0000000000000000000000000000000000000000000000000000000000000000
    916       0000000000000000000000000000000000000000000000000000000000000000
    917       0000000000000000000000000000000000000000000000000000000000000000
    918       0000000000000000000000000000000000000A0A0A002F2F2F00222222000C0C
    919       0C0015151500262626002A2A2A001F1F1F0001010100171717001C1C1C001313
    920       13001B1B1B00181818001616160000000000CFCFD000D9D9D900E2E2E200E9EA
    921       EA00F1F1F300FAFDF600FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
    922       FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0017171700A2A2A200FFFFFF00FAFA
    923       FA00A7B8110045BC3B0032C32100E0ED4B00DEF65200D8E34600B0B81800C4CC
    924       2B00E3F45100D0F14900D5E34500AFA31D000000000000000000000000000000
    925       0000000000000000000000000000000000000000000000000000000000000000
    926       0000000000000000000000000000000000000700040005D0250006D6320006D8
    927       260007F9070012FC0E0008FC000008FB0C000311ED000000FD00100ADF000000
    928       110000000000000000000000000002020200DDDEDF00E5E5E600E8E8ED009896
    929       A6004B4992004240BC003734BE003734C4003F3DCB005250D50079779700FFFF
    930       FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0056151700B2A09F00FAFAFA00F5F5
    931       F500BD9E070036E1370096D53200DEEE4300E8E73F00D5EE4600B99D1000BEB7
    932       1400E9E74200C7D12300AFD73B00D28229000000000000000000000000000000
    933       0000000000000000000000000000000000000000000000000000000000000000
    934       0000000000000000000000000000000000000600040001FF000001FF000001FF
    935       000001FF000001FF000001FF000000FF05000EC4360004ED000004E119000000
    936       270000000000000000000000000002020200E4E4E500E9EAE80063606B005C59
    937       CB00544FCD004E48CD004944BC004540C800433FCD004A48D3006060DE009695
    938       BD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BF191800EDA6A300FCFCFC00FCFC
    939       FC00A4A103005ECF770080D32A0046BD140081DD36009CE03500F2F54B007FCF
    940       28006FCE2900EFF55400BAA81B00C78F20000000000000000000000000000000
    941       0000000000000000000000000000000000000000000000000000000000000000
    942       0000000000000000000000000000000000000500030001FF000001FF000001FF
    943       000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
    944       000000000000000000000000000002020200E9EAE7009D99BF007773EC007A75
    945       F6007C75F700756EF4006D66E800635DDA00514DD0004A47D3005451D8006E6C
    946       DB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CF292800F2ABA800FCFCFC00FCFC
    947       FC00C2B91600CFC8250066C61B0036DB340021AB0600DCEF4C00F0F8510047BB
    948       140022BE1900F4F34F00C2911700B7B415000000000000000000000000000000
    949       0000000000000000000000000000000000000000000000000000000000000000
    950       0000000000000000000000000000000000000801060001FF000001FF000001FF
    951       000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
    952       000000000000000000000000000002020200EBEBED00A9A6D7009691F6009B95
    953       FB00AAA3FF00A79EFF009B93FF00837AF2006761D5005651C3005753D6006C6A
    954       DE00FDFEFF00FFFFFF00FFFFFF00FFFFFF00D57C2C00F2CAAE00FEFEFE00FCFC
    955       FC00F4FC5500E4F14F0057C41A003EE33C0043BD1500C0E94000F2F14900B0DD
    956       3A000DB60C00EFF24800D0F04500E1AD7E000000000000000000000000000000
    957       0000000000000000000000000000000000000000000000000000000000000000
    958       0000000000000000000000000000000000000500030001FF000001FF000001FF
    959       000001FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
    960       000000000000000000000000000002020200EDEDEE00EAEAEE00ABA5F600BAB5
    961       FB00E9E6FC00FFFFFF00D4D1FF009A92FD007770E400615CCB005F5BD400726F
    962       D900FFFFFF00FFFFFF00FFFFFF00FFFFFF00CFCF2900F0ECA500FCFCFC00FCFC
    963       FC0042F0450019B215001CBC160017B70B0079D42B0025D52A00E9F64E004BC0
    964       17002FC31700D9F34C003FB90F00FFFFF3000000000000000000000000000000
    965       0000000000000000000000000000000000000000000000000000000000000000
    966       0000000000000000000000000000000000000D060B0001FF000000EB110000FF
    967       0B000DFE070001FF000001FF000001FF000000EE0F000AFD080006F806000802
    968       030000000000000000000000000002020200EDEDEE00F1F1F200EDECEF00B9B3
    969       F800C1BBFC00D1D0FE00BEB6FF00968DFF007973EC006863D4006B67CA008381
    970       B800FFFFFF00FFFFFF00FFFFFF00FFFFFF009ED52A00D5EFA300FCFCFC00FCFC
    971       FC005DE8610050F57C009FDE3A003FE33E001EBA150027C017008AD92E003EC3
    972       1F0026BB14007FDE3A0037BB1000FFF2FA000000000000000000000000000000
    973       0000000000000000000000000000000000000000000000000000000000000000
    974       0000000000000000000000000000000000000500030001FF000000DC1D0001FF
    975       000006FF000001FF000001FF000001FF00000BFF070010FD020001FF00000500
    976       000000000000000000000000000002020200EBEBEC00EFEFEF00F2F1F300F4F3
    977       F300ABA7F100A39DF7009E8EFE00887AFF006D69E2006965CF007471C500E9EB
    978       F900FFFFFF00FFFFFF00FFFFFF00FFFFFF001DBF2A00A2E79E00FCFCFC00FCFC
    979       FC00BAAA670078EBD80034DE48004FF6870034D6360086CB2E00A1E032009FE2
    980       430022D931007DF96900E2F2F900FCFCFC000000000000000000000000000000
    981       0000000000000000000000000000000000000000000000000000000000000000
    982       0000000000000000000000000000000000000801060001FF000000E1220001FF
    983       000006FF000001FF000000FE000001FF000009FF070010FD020001FF00000500
    984       000000000000000000000000000002020200E5E5E500E9E9EA00ECECED00EFEF
    985       F000EFEEF1008A85E200736EF600635EF700615EC9006B68B000BCBCDC00FFFF
    986       FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050FB9F00B0FFD800F9F9F900FBFB
    987       FB00FCFCFC00FAFAFA006EB247002FFF860017AD13009BD53A000FB0000025C1
    988       2700DCE2D100FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    989       0000000000000000000000000000000000000000000000000000000000000000
    990       0000000000000000000000000000000000000C00030001FF000000E1220001FF
    991       000006FF000001FF00000EFC000007FC02000AE4210010FF000002FF00000901
    992       010000000000000000000000000002020200DBDBDB00E0E0E100E5E5E600E8E8
    993       E900EAE9EA00E7EBE6005F5EDE005858EF005F60A2008989B300FCFBFD00FFFF
    994       FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0042DBEA00ACECF700FFFFFF00FBFB
    995       FB00FCFCFC00FDFDFD00FFE9FF00EEDDC200127DBA0035D73C0043C70800E2C5
    996       A000FFFEFF00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    997       0000000000000000000000000000000000000000000000000000000000000000
    998       0000000000000000000000000000000000000500030003FF000000DD2A0001FF
    999       000006FF000002FD020005FF000000FF000000180A0004FF07001ECB16000002
    1000       000000000000000000000000000002020200C9C9CA00D0D0D100D7D8D800DCDC
    1001       DD00DEDFE000E0E1E100E1E0E0005353E3005A5D7500EDF0F100F6F9F900FAFB
    1002       FB00FDFDFE00FEFEFE00FFFFFF00FFFFFF006393E500BAD2EE00FCFCFC00FCFC
    1003       FC00FCFCFC00FCFCFC00FCFCFC00FFFFF800DE39D600167EB90044D8EE00F5FA
    1004       FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    1005       0000000000000000000000000000000000000000000000000000000000000000
    1006       0000000000000000000000000000000000000902070000FF000000DD2A0001FF
    1007       000006FF00000DF6060015751A0007FF00000806060003FF0000001000000005
    1008       000000000000000000000000000002020200B7B8B800BCBDBD00C4C5C500CCCD
    1009       CD00D1D1D100D4D5D500D7D7D800C6C5D0004D4EA900E5E6E300EDEEED00F3F4
    1010       F400F8F8F800FBFBFB00FCFCFC00FCFDFD00DC3BD300F0AAF000FDFDFD00FCFC
    1011       FC00FCFCFC00FCFCFC00FCFCFC00F1F2FF00C820B9001EA8B4005BCAFA00EAEC
    1012       FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    1013       0000000000000000000000000000000000000000000000000000000000000000
    1014       0000000000000000000000000000000000000500030000FF000000DD2A0001FF
    1015       000006FF00000DB0000020001C0000F500001300140025000D00000200000401
    1016       000000000000000000000000000002020200A5A5A600A5A5A600ACADAD00B5B5
    1017       B500BDBCBD0000000000C6C7C800CBC8CB00B1B0C400BDBDC100DDDDDB00E4E4
    1018       E400EAEAEA00EEEFEF00F1F2F200F2F3F300E03FD700F3ADF300F8F8F800FCFC
    1019       FC00FCFCFC00FCFCFC00FCFCFC00CCC7C600AD68C900515ADA0035C83600B185
    1020       8600FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    1021       0000000000000000000000000000000000000000000000000000000000000000
    1022       0000000000000000000000000000000000000A03080000FF000000D7240001FF
    1023       0000000600001D3F160000010000219024000000070000000000020103000000
    1024       0000000000000000000000000000020202008F8F8F008F8F8F008F8F8F009596
    1025       96009D9E9E00A5A5A600AAABAB00B0B0B100B6B6B700BAB8BA009C9DA100C5C6
    1026       C700CDCECE00D2D2D300D5D5D600D6D6D600A71BC200DE9FE500FCFCFC00FCFC
    1027       FC00FCFCFC00FCFCFC00FCFCFC00DA971200AFB91300CEA42100E86B2100677E
    1028       AE00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    1029       0000000000000000000000000000000000000000000000000000000000000000
    1030       0000000000000000000000000000000000000903000014F70600130830000BED
    1031       00000200010008000A0003020400000700000000070000000000020103000000
    1032       0000000000000000000000000000020202007C7D7D007C7D7D007C7D7D007C7D
    1033       7D007E7E7E00848585008B8B8C0091919200979798009C9D9D00A1A1A000A3A4
    1034       A200A8A9A900AEAEAE00B1B1B100B2B2B3003A2EFF00B0ADFD00FEFEFE00FFFF
    1035       FF00FCFCFC00FCFCFC00FFFCFF00AAD83100FAF8FE00511C1900FAE7F000EDD8
    1036       E000FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
    1037       0000000000000000000000000000000000000000000000000000000000000000
    1038       00000000000000000000000000000000000013131300161616000A0D11000000
    1039       0000030408000101010001010100010101000000030001010100000100000101
    1040       0100010101000101010001010100020202006B6B6C006B6B6C006B6B6C006B6B
    1041       6C006B6B6C006B6B6C006B6B6C006D6D6E0072727200767677007A7B7B007E7E
    1042       7E00818182008484840087878700888889000C04F10099A0F000F7F7F700FBFB
    1043       FB00FCFCFC00FCFCFC00FDFFFF00FFF7FF0057262400CE5C45009A252200B8C9
    1044       C600FCFCFC00FCFCFC00FCFCFC00FCFCFC00424D3E000000000000003E000000
    1045       2800000040000000300000000100010000000000800100000000000000000000
    1046       000000000000000000000000FFFFFF0000000000000000000000000000000000
    1047       0000000000000000000000000000000000000000000000000000000000000000
    1048       0000000000000000000000000000000000000000000000000000000000000000
    1049       0000000000000000000000000000000000000000000000000000000000000000
    1050       0000000000000000000000000000000000000000000000000000000000000000
    1051       0000000000000000000000000000000000000000000000000000000000000000
    1052       0000000000000000000000000000000000000000000000000000000000000000
    1053       0000000000000000000000000000000000000000000000000000000000000000
    1054       00000000000000000000000000000000FFFF000000000000FFFF000000000000
    1055       FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000
    1056       FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000
    1057       FFFF000000000000FFFF000000000000FFFF000004000000FFFF000000000000
    1058       FFFF000000000000FFFF00000000000000000000000000000000000000000000
    1059       000000000000}
     983    Left = 343
     984    Top = 72
    1060985  end
    1061986end

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

    r456 r829  
    11unit fODBBank;
    2 
    32interface
    43
    … …  
    65  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    76  Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
    8   ORDtTm, Buttons, Menus, ImgList;
     7  ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
    98
    109type
    1110  TfrmODBBank = class(TfrmODBase)
    12     pnlBB: TPanel;
    13     pnlFull: TPanel;
     11    dlgLabCollTime: TORDateTimeDlg;
     12    ORWanted: TORDateTimeDlg;
     13    pnlComments: TPanel;
     14    btnUpdateComments: TButton;
     15    btnCancelComment: TButton;
     16    lblOrdComment: TLabel;
    1417    pgeProduct: TPageControl;
    15     tabInfo: TTabSheet;
     18    TabInfo: TTabSheet;
    1619    edtInfo: TCaptionRichEdit;
    1720    TabDiag: TTabSheet;
    1821    lblReqComment: TOROffsetLabel;
     22    TabResults: TTabSheet;
     23    edtResults: TCaptionRichEdit;
    1924    pnlFields: TPanel;
    20     dlgLabCollTime: TORDateTimeDlg;
    21     ORWanted: TORDateTimeDlg;
    2225    lblDiagComment: TOROffsetLabel;
    23     txtDiagComment: TCaptionEdit;
    24     pnlSelectedTests: TGroupBox;
    25     lvSelectionList: TCaptionListView;
    2626    lblUrgency: TLabel;
     27    lblReason: TLabel;
     28    lblSurgery: TLabel;
    2729    cboUrgency: TORComboBox;
    28     lblCollType: TLabel;
    29     cboCollType: TORComboBox;
    3030    chkConsent: TCheckBox;
    31     lblPreparation: TLabel;
    32     calWantTime: TORDateBox;
    33     lblWanted: TLabel;
    34     tReason: TEdit;
    35     lblReason: TLabel;
    3631    cboSurgery: TORComboBox;
    37     lblSurgery: TLabel;
    38     txtImmedColl: TCaptionEdit;
    39     cboCollTime: TORComboBox;
    40     lblCollTime: TLabel;
    41     cmdImmedColl: TSpeedButton;
    42     pnlCollTimeButton: TKeyClickPanel;
    43     calCollTime: TORDateBox;
    44     cboPreparation: TORComboBox;
    45     btnRemove: TButton;
    46     btnRemoveAll: TButton;
    47     pnlTop: TPanel;
    4832    pnlSelect: TPanel;
    49     pnlDiagTests: TGroupBox;
     33    pnlDiagnosticTests: TGroupBox;
    5034    cboAvailTest: TORComboBox;
    5135    pnlBloodComponents: TGroupBox;
    5236    lblQuantity: TLabel;
     37    lblModifiers: TLabel;
    5338    cboAvailComp: TORComboBox;
    5439    tQuantity: TEdit;
    55     upQuantity: TUpDown;
    56     TabResults: TTabSheet;
    57     edtResults: TCaptionRichEdit;
    58     btnAddTests: TORAlignSpeedButton;
    59     ImageList1: TImageList;
    60     lblModifiers: TLabel;
    6140    cboModifiers: TORComboBox;
     41    GroupBox1: TGroupBox;
     42    cboQuick: TORComboBox;
     43    pnlSelectedTests: TGroupBox;
     44    lvSelectionList: TCaptionListView;
     45    btnRemove: TButton;
     46    btnRemoveAll: TButton;
     47    cboReasons: TORComboBox;
     48    lblRequiredField: TLabel;
     49    memDiagComment: TRichEdit;
     50    lblCollType: TLabel;
     51    cboCollType: TORComboBox;
     52    lblCollTime: TLabel;
     53    cboCollTime: TORComboBox;
     54    calWantTime: TORDateBox;
     55    lblWanted: TLabel;
     56    calCollTime: TORDateBox;
     57    txtImmedColl: TCaptionEdit;
     58    pnlCollTimeButton: TKeyClickPanel;
     59    cmdImmedColl: TSpeedButton;
    6260    lblTNS: TLabel;
    6361    procedure FormCreate(Sender: TObject);
    … …  
    7876    procedure pgeProductChange(Sender: TObject);
    7977    procedure cboCollTypeChange(Sender: TObject);
    80     procedure btnAddTestsClick(Sender: TObject);
    8178    procedure FormDestroy(Sender: TObject);
    8279    procedure btnRemoveClick(Sender: TObject);
    … …  
    8683    procedure chkConsentClick(Sender: TObject);
    8784    procedure cboUrgencyChange(Sender: TObject);
    88     procedure txtDiagCommentChange(Sender: TObject);
    89     procedure cboPreparationChange(Sender: TObject);
    9085    procedure cboSurgeryChange(Sender: TObject);
    91     procedure tReasonChange(Sender: TObject);
    9286    procedure calCollTimeChange(Sender: TObject);
     87    procedure cboQuickClick(Sender: TObject);
     88    procedure tQuantityEnter(Sender: TObject);
     89    procedure btnUpdateCommentsClick(Sender: TObject);
     90    procedure btnCancelCommentClick(Sender: TObject);
     91    procedure cboSurgeryClick(Sender: TObject);
     92    procedure cboReasonsEnter(Sender: TObject);
     93    procedure cboReasonsExit(Sender: TObject);
     94    procedure tQuantityClick(Sender: TObject);
     95    procedure tQuantityChange(Sender: TObject);
     96    procedure cboReasonsChange(Sender: TObject);
     97    procedure cboModifiersChange(Sender: TObject);
     98    procedure lvSelectionListClick(Sender: TObject);
     99    procedure cboAvailCompChange(Sender: TObject);
     100    procedure cboCollTimeChange(Sender: TObject);
     101    procedure memDiagCommentChange(Sender: TObject);
     102    procedure cboUrgencyExit(Sender: TObject);
    93103  protected
    94104    FCmtTypes: TStringList ;
    … …  
    106116    procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
    107117    procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
     118    procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
    108119    procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
     120    procedure ExtractReasons(OutList:TStrings; AList:TStrings);
    109121    procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
    110122    procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
     123    procedure ExtractOther(OutList:TStrings; AList:TStrings);
    111124    procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
    112125    procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
    … …  
    114127    procedure LoadUrgencies(AComboBox:TORComboBox);
    115128    procedure LoadModifiers(AComboBox:TORComboBox);
     129    procedure LoadReasons(AComboBox:TORComboBox);
     130
    116131  private
    117132    FLastCollType: string;
    … …  
    123138    FEvtDivision: integer;
    124139    FVbecLookup: string;
     140    FQuickList:  Integer;
     141    FQuickItems: TStringList;
     142    FOrderAction: Integer;
    125143    procedure ReadServerVariables;
     144    procedure SetOnQuickOrder;
    126145  public
    127146    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    153172    CollSamp: Integer;                    { index into CollSampList }
    154173    Specimen: Integer;                    { IEN of specimen }
     174    Urgency: Integer;                     { IEN of urgency }
    155175    Comment: TStringList;                 { text of comment }
    156176    TestReqComment: string;               { Name of required comment }
    … …  
    162182    SpecimenList: TStringList;            { Strings: IEN^Specimen Name }
    163183    SpecListCount: integer;               { count of original contents of SpecimenList}
     184    UrgencyList: TStringList;             { Strings: IEN^Urgency Name }
     185    ForceUrgency: Boolean;                { true if not prompt Urgency }
    164186    SurgeryList: TStringList;             { Strings: Surgeries}
    165187    PatientInfo: TStringList;             { Text of Patient Information}
    … …  
    179201    procedure LoadCollSamp(AComboBox: TORComboBox);
    180202    procedure LoadSpecimen(AComboBox: TORComboBox);
     203    procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
    181204    function  NameOfCollSamp: string;
    182205    function  NameOfSpecimen: string;
     206    function  NameOfUrgency: string;
    183207    function  ObtainCollSamp: Boolean;
    184208    function  ObtainSpecimen: Boolean;
     209    function  ObtainUrgency: Boolean;
    185210    function  ObtainComment: Boolean;
     211
    186212  end;
    187213
    … …  
    202228var
    203229  uSelectedItems: TStringList;   //Selected Items in ListView- if TestYes =1 then test else component
    204                                  //TestYes(1)^Test-Component(2)^Qty(3)^Sample(4,5)^Specimen(6,7)^Modifier(8)
     230                                 //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
    205231  uVBECList: TStringList;        //List of items from VBEC api
    206232  uTestsForResults: TStringList; //List of tests to show results
    207233  uUrgencyList: TStringList;     //List of Urgencies
     234  uTNSOrders: TStringList;       //List of Current orders for Type & Screen
    208235  uModifierList: TStringList;    //List of Modifiers
     236  uReasonsList: TStringList;     //List of Reasons for Request
    209237  uRaw: TStringList;             //Results Array
    210238  uTestSelected, uComponentSelected: Boolean;  //Used on Validate
    211   uDfltUrgency: Integer;
     239  uDfltUrgency: Integer;         //Default Urgency
     240  uSelUrgency: String;          //Previously Selected Urgency - Used when components have been added for specific urgency
     241  uSelSurgery: Integer;          //Selected Surgery for Blood order
    212242  uSpecimen, uGetTnS: Integer;            //Set to 1 if a specimen for test is already in lab... no need to collect
    213   uDfltCollType: string;
     243  uDfltCollType, uReason: string;
    214244  ALabTest: TLabTest;
    215245  UserHasLRLABKey: boolean;
    … …  
    228258
    229259  TI_INFO = 0;    //Corresponds with pgeProduct TabIndex
    230   TI_ORDER = 1;
     260  TI_COMPONENT = 1;
    231261  TI_RESULTS = 2;
    232262
    … …  
    239269  i: integer;
    240270  AList, ATests: TStringList;
     271  ListCount: Integer;
     272  x: string;
    241273begin
    242274  AutoSizeDisabled := True;
    … …  
    248280  uTestsForResults := TStringList.Create;
    249281  uUrgencyList := TStringList.Create;
     282  uTNSOrders := TStringList.Create;
    250283  uModifierList := TStringList.Create;
     284  uReasonsList := TStringList.Create;
    251285  uRaw := TStringList.Create;
    252286  uSpecimen := 0;
    253287  uGetTnS := 0;
     288  uReason := '';
    254289  lblTNS.Caption := '';
    255290  lblTNS.Visible := false;
     291  pnlMessage.Visible := false;
    256292  uDfltUrgency := 9;
    257   TabResults.ImageIndex := 0;
     293  uSelUrgency := '';
     294  uSelSurgery := 0;
     295  TabResults.Caption := 'Lab Results';
     296  edtResults.Lines.Clear;
     297  edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.');
    258298  Responses.Clear;
    259299  try
    … …  
    265305    LRFSCH   := '';
    266306    LRORDERMODE := TORDER_MODE_INFO;
    267     DisableComponentControls;
    268     DisableDiagTestControls;
    269307    FLastColltime := '';
    270308    FLastLabCollTime := '';
    … …  
    277315    AllowQuickOrder := True;
    278316    StatusText('Loading Dialog Definition');
    279     lblReqComment.Visible := False ;
    280     lblModifiers.Enabled := False;
    281     cboModifiers.Enabled := False;
    282317    FCmtTypes := TStringList.Create;
    283318    for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
    … …  
    289324      EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
    290325      if EvtDelayLoc>0 then
    291         AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
     326        FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
    292327      else
    293         AList.Assign(ODForLab(Encounter.Location,EvtDivision));
     328        FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
    294329    end else
    295       AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
     330      FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
    296331    CtrlInits.LoadDefaults(AList);
    297332    InitDialog;
     333    GroupBox1.Visible := True;
    298334    with CtrlInits do
    299335    begin
    … …  
    309345      StatusText('Initializing List of Tests');
    310346      FVbecLookup := 'S.VBT';
    311       cboAvailTest.InitLongList('');
     347      cboAvailTest.InitLongList('');      //Populates cboAvailTest control based on S.VBT xref
    312348    end;
    313349    cboAvailComp.Clear;
    … …  
    329365    AList.Clear;
    330366    ExtractUrgencies(uUrgencyList, uVBECList);
     367    ExtractTNSOrders(uTNSOrders, uVBECList);
    331368    LoadUrgencies(cboUrgency);
    332     cboUrgency.SelectByID(IntToStr(uDfltUrgency));
    333369    ExtractModifiers(uModifierList, uVBECList);
     370    ExtractReasons(uReasonsList, uVBECList);
    334371    LoadModifiers(cboModifiers);
    335     calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
    336     //cboPreparation.SelectByID('I');
    337     memMessage.Visible := false;
    338     memOrder.Visible := false;
    339     cmdAccept.Visible := false;
     372    LoadReasons(cboReasons);
     373    calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
    340374    pgeProduct.TabIndex := TI_INFO;
    341     lvSelectionList.Column[0].Width := 200;
    342     lvSelectionList.Column[1].Width := 40;
     375    lvSelectionList.Column[0].Width := 240;
     376    lvSelectionList.Column[1].Width := 30;
     377    lvSelectionList.Column[2].Width := 100;
     378    DisableComponentControls;
     379    DisableDiagTestControls;
    343380    pgeProduct.ActivePageIndex := TI_INFO;
    344     PreserveControl(cboAvailTest);
    345     PreserveControl(cboAvailComp);
    346     PreserveControl(cboCollType);
    347     PreserveControl(cboCollTime);
    348     PreserveControl(calCollTime);
    349     PreserveControl(calWantTime);
    350381    StatusText('');
    351 
     382    x := 'VBEC';
     383    FQuickItems := TStringList.Create;
     384    ListForQuickOrders(FQuickList, ListCount, x);
     385    if ListCount > 0 then
     386      begin
     387        SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
     388      end else
     389      begin
     390        ListCount := 1;
     391        FQuickItems.Add('0^(No quick orders available)');
     392      end;
     393
     394    FastAssign(FQuickItems, cboQuick.Items);
     395    if lvSelectionList.Items.Count > 0 then
     396      begin
     397        memOrder.Visible := true;
     398        cmdAccept.Visible := true;
     399      end;
    352400  finally
    353401    AList.Free;
    … …  
    375423procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
    376424var
    377   tmpResp: TResponse;
     425  AnInstance, CurAdd: Integer;
     426  AResponse: TResponse;
     427  i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer;
     428  aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string;
     429  ListItem: TListItem;
     430  aList: TStringList;
     431  aTests: TStringList;
     432begin
     433  inherited;
     434  aList := TStringList.Create;
     435  aTests:= TStringList.Create;
     436  try
     437  FOrderAction := OrderAction;
     438  ReadServerVariables;
     439  sub1 := '';
     440  aTypeScreen := '';
     441  aSpecimen := '^';
     442  aModifier := '';
     443  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
     444    begin
     445      AnInstance := NextInstance('ORDERABLE', 0);
     446      while AnInstance > 0 do
     447        begin
     448          AResponse := FindResponseByName('ORDERABLE', AnInstance);
     449          if AResponse <> nil then
     450            begin
     451              sub := GetSubtype(AResponse.EValue);
     452              if sub = 't' then
     453                begin
     454                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
     455                  ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     456                end
     457              else
     458                begin
     459                  SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
     460                  ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
     461                end;
     462              if ALabTest = nil then Exit;  // Causes access violation
     463              if AnInstance = 1 then
     464                begin
     465                  SetControl(cboReasons,         'REASON' , AnInstance);
     466                  SetControl(calWantTime,        'DATETIME', AnInstance);
     467                  SetControl(memDiagComment,     'COMMENT', AnInstance);
     468                  SetControl(chkConsent,         'YN', AnInstance);
     469                  //DetermineCollectionDefaults(Responses);
     470                  SetControl(cboCollType,        'COLLECT', AnInstance);
     471                  SetControl(cboCollTime,        'START', AnInstance);
     472                  SetupCollTimes(cboCollType.ItemID);
     473                  SetControl(cboUrgency,         'URGENCY', AnInstance);
     474                  SetControl(cboSurgery,         'MISC', AnInstance);
     475                  Urgency := cboUrgency.ItemIEN;
     476                  if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
     477                    begin
     478                      cboUrgency.ItemIndex := 0;
     479                      Urgency := cboUrgency.ItemIEN;
     480                    end;
     481                  i := 1 ;
     482                  AResponse := Responses.FindResponseByName('COMMENT',i);
     483                  while AResponse <> nil do
     484                    begin
     485                      Comment.Add(AResponse.EValue);
     486                      Inc(i);
     487                      AResponse := Responses.FindResponseByName('COMMENT',i);
     488                    end ;
     489                end;
     490              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
     491                begin
     492                  Changing := True;
     493                  DisableComponentControls;
     494                  EnableDiagTestControls;
     495                  LRORDERMODE := TORDER_MODE_DIAG;
     496                  aList.Clear;
     497                  aTestYes := '1';
     498                  ExtractTypeScreen(aList, uVBECList);
     499                  if aList.Count > 0 then aTypeScreen := aList[0];
     500                  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);
     521                  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);
     528                  if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     529                  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);
     571                  memOrder.Text := Responses.OrderText;
     572                  Changing := False;
     573                  if ObtainCollSamp then
     574                    begin
     575                      //For BloodBank orders, this condition should never occur
     576                    end
     577                  else
     578                    begin
     579                      with ALabTest do
     580                        with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     581                          begin
     582                            x := '' ;
     583                            for i := 0 to WardComment.Count-1 do
     584                            x := x + WardComment.strings[i]+#13#10 ;
     585                            pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     586                            OrderMessage(x) ;
     587                          end ;
     588                    end;
     589                end;
     590              if sub = 'c' then with ALabTest do  //COMPONENT
     591                begin
     592                  Changing := True;
     593                  DisableDiagTestControls;
     594                  EnableComponentControls;
     595                  aTestYes := '0';
     596                  LRORDERMODE := TORDER_MODE_COMP;
     597                  SetControl(cboModifiers,       'MODIFIER', AnInstance);
     598                  SetControl(tQuantity,          'QTY', AnInstance);
     599                  uComponentSelected := true;
     600                  aList.Clear;
     601                  TestAdded := 0;
     602                  getTest := 0;
     603                  ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     604                    for j := 0 to aList.Count - 1 do
     605                      begin
     606                        if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     607                          begin
     608                            if uTestsForResults.Count < 1 then getTest := 1;
     609                            for k := 0 to uTestsForResults.Count - 1 do
     610                              begin
     611                                if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     612                                  begin
     613                                    getTest := 0;
     614                                    break;
     615                                  end
     616                                else getTest := 1;
     617                              end;
     618                            if getTest = 1 then
     619                              begin
     620                                uTestsForResults.Add(piece(aList[j],'^',3));
     621                                TestAdded := 1;
     622                              end;
     623                          end;
     624                      end;
     625                    if TestAdded = 1 then
     626                      begin
     627                        edtResults.Clear;
     628                        aTests.Clear;
     629                        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);
     634                      end;
     635                    CurAdd := 1;
     636                    if uRaw.Count > 0 then
     637                    for j := 0 to uRaw.Count - 1 do
     638                      begin
     639                        if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     640                        Inc(CurAdd);
     641                      end;
     642                  with lvSelectionList do
     643                    begin
     644                      ListItem := Items.Add;
     645                      ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     646                      ListItem.SubItems.Add(tQuantity.Text);
     647                      if length(cboModifiers.ItemID) > 0 then
     648                        begin
     649                          ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     650                          ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     651                        end
     652                        else
     653                          begin
     654                            ListItem.SubItems.Add('');
     655                            ListItem.SubItems.Add('');
     656                          end;
     657                      ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     658                    end;
     659                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     660                  uSelectedItems.Add(aStr);
     661                  memOrder.Text := Responses.OrderText;
     662                  Changing := False;
     663                end;
     664            end;
     665          StatusText('');
     666          AnInstance := NextInstance('ORDERABLE', AnInstance);
     667        end;  //while AnInstance - ORDERABLE
     668      DisableComponentControls;
     669      DisableDiagTestControls;
     670    end;
     671    CurAdd := 1;
     672    for i := 0 to uSelectedItems.Count - 1 do
     673      begin
     674        aName := lvSelectionList.Items[i].Caption;
     675        x := uSelectedItems[i];
     676        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     677          begin
     678            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     679          end
     680        else
     681          begin
     682            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     683            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     684            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
     685            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     686            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     687            if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     688            if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     689              else
     690                begin
     691                  cboUrgency.ItemIndex := 1;
     692                  Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     693                  cboUrgencyChange(self);
     694                end;
     695          end;
     696        Inc(CurAdd);
     697      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;  }
     871  finally
     872    aList.Free;
     873    aTests.Free;
     874  end;
     875  edtResults.Height := 247;
     876  edtInfo.Height := 247;
     877  if lvSelectionList.Items.Count > 0 then
     878    begin
     879      pnlSelectedTests.Visible := True;
     880      cmdAccept.Visible := True;
     881      memOrder.Visible := True;
     882      GroupBox1.Visible := False;
     883    end;
     884end;
     885
     886procedure TfrmODBBank.SetOnQuickOrder;
     887  var
     888  AnInstance: Integer;
     889  AResponse: TResponse;
    378890  i: integer;
     891  x,sub,sub1,aTNSString: string;
     892  aList: TStringList;
     893  aGotIt: boolean;
     894  aTests: TStringList;
     895  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;
    379898begin
    380899  inherited;
    381   ReadServerVariables;
    382   if LRFZX <> '' then
    383     begin
    384       cboCollType.SelectByID(LRFZX);
    385       if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
    386     end;
    387   if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
    388    begin
    389       SetControl(cboAvailTest,       'ORDERABLE', 1);
    390       cboAvailTestSelect(Self);
    391       if ALabTest = nil then Exit;  // Causes access violation in FillCollSampleList
    392       Changing := True;
    393       DetermineCollectionDefaults(Responses);
    394       i := 1 ;
    395       tmpResp := Responses.FindResponseByName('COMMENT',i);
    396       while tmpResp <> nil do
    397         begin
    398           Comment.Add(tmpResp.EValue);
    399           Inc(i);
    400           tmpResp := Responses.FindResponseByName('COMMENT',i);
    401         end ;
    402       Changing := False;
    403    end;
     900  aList := TStringList.Create;
     901  aTests := TStringList.Create;
     902  try
     903    aModifier := '';
     904    aReason := '';
     905    aSurgery := '';
     906    aCollTime := '';
     907    aTestYes := '0';
     908    aTypeScreen := '';
     909    aSpecimen := '';
     910    sub1 := '';
     911    ExtractTypeScreen(aList, uVBECList);
     912    if aList.Count > 0 then aTypeScreen := aList[0];
     913    aList.Clear;
     914    Extractspecimen(aList, uVBECList);
     915    if aList.Count > 0 then aSpecimen := aList[0];
     916    with Responses, ALabTest do
     917      begin
     918        Changing := True;
     919        aGotIt := False;
     920        FLastItemID := cboQuick.ItemID;
     921        QuickOrder := ExtractInteger(cboQuick.ItemID);
     922        with Responses do
     923          begin
     924            StatusText('Initializing Quick Order');
     925            AnInstance := NextInstance('ORDERABLE', 0);
     926            while AnInstance > 0 do
     927              begin
     928                AResponse := FindResponseByName('ORDERABLE', AnInstance);
     929                sub := GetSubtype(AResponse.EValue);
     930                if sub = 't' then
     931                  begin
     932                    SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
     933                    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     934                  end
     935                else
     936                  begin
     937                    SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
     938                    ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
     939                  end;
     940                for i := 0 to aList.Count - 1 do
     941                  if aList[i] = ALabTest.TestName then
     942                    begin
     943                      aGotIt := true;
     944                      break;
     945                    end;
     946                if aGotIt = true then
     947                  begin
     948                    aGotIt := false;
     949                    AnInstance := NextInstance('ORDERABLE', AnInstance);
     950                    Continue;
     951                  end
     952                  else
     953                    begin
     954                      aList.Add(ALabTest.TestName);
     955                    end;
     956                if AResponse <> nil then
     957                  sub1 := GetSubtype(AResponse.EValue);
     958                if AnInstance = 1 then
     959                  begin
     960                    SetControl(cboReasons,         'REASON', AnInstance);
     961                    SetControl(calWantTime,        'DATETIME', AnInstance);
     962                    SetControl(memDiagComment,     'COMMENT', AnInstance);
     963                    SetControl(chkConsent,         'YN', AnInstance);
     964                    //DetermineCollectionDefaults(Responses);
     965                    SetControl(cboCollType,        'COLLECT', AnInstance);
     966                    SetupCollTimes(cboCollType.ItemID);
     967                    //SetControl(cboCollTime,        'START', AnInstance);
     968                    //LoadUrgency(cboCollType.ItemID, cboUrgency);
     969                    SetControl(cboUrgency,         'URGENCY', AnInstance);
     970                    Urgency := cboUrgency.ItemIEN;
     971                    if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
     972                      begin
     973                        cboUrgency.ItemIndex := 0;
     974                        Urgency := cboUrgency.ItemIEN;
     975                        cboUrgencyChange(self);
     976                      end;
     977                    SetControl(cboSurgery,         'MISC', AnInstance);
     978                    if not(ALabTest = nil) then
     979                      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;
     986                        i := 1 ;
     987                        AResponse := Responses.FindResponseByName('COMMENT',i);
     988                        while AResponse <> nil do
     989                          begin
     990                            Comment.Add(AResponse.EValue);
     991                            Inc(i);
     992                            AResponse := Responses.FindResponseByName('COMMENT',i);
     993                          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;
     1006                      end;
     1007                  end;
     1008                if sub1 = 'c' then
     1009                  begin
     1010                    DisableDiagTestControls;
     1011                    EnableComponentControls;
     1012                    LRORDERMODE := TORDER_MODE_COMP;
     1013                    SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
     1014                    SetControl(cboModifiers,       'MODIFIER', AnInstance);
     1015                    SetControl(tQuantity,          'QTY', AnInstance);
     1016                    //DetermineCollectionDefaults(Responses);
     1017                    //Check for and display any associated Lab Results
     1018                    aList.Clear;
     1019                    TestAdded := 0;
     1020                    getTest := 0;
     1021                    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     1022                      for j := 0 to aList.Count - 1 do
     1023                        begin
     1024                          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     1025                            begin
     1026                              if uTestsForResults.Count < 1 then getTest := 1;
     1027                              for k := 0 to uTestsForResults.Count - 1 do
     1028                                begin
     1029                                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     1030                                    begin
     1031                                      getTest := 0;
     1032                                      break;
     1033                                    end
     1034                                  else getTest := 1;
     1035                                end;
     1036                              if getTest = 1 then
     1037                                begin
     1038                                  uTestsForResults.Add(piece(aList[j],'^',3));
     1039                                  TestAdded := 1;
     1040                                end;
     1041                            end;
     1042                        end;
     1043                      if TestAdded = 1 then
     1044                        begin
     1045                          edtResults.Clear;
     1046                          aTests.Clear;
     1047                          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);
     1052                        end;
     1053                      CurAdd := 1;
     1054                      if uRaw.Count > 0 then
     1055                      for j := 0 to uRaw.Count - 1 do
     1056                        begin
     1057                          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     1058                          Inc(CurAdd);
     1059                        end;
     1060                    aSpecimen := '^';
     1061                    aTestYes := '0';
     1062                    aReason := '';
     1063                    aSurgery := '';
     1064                    aCollTime := '';
     1065                    ExtractSpecimen(aList, uVBECList);
     1066                    if aList.Count > 0 then aSpecimen := aList[0];
     1067                    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     1068                    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     1069                    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
     1070                    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     1071                    if Length(cboSurgery.ItemID) > 0 then
     1072                      begin
     1073                        aList.Clear;
     1074                        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     1075                        for i := 0 to aList.Count - 1 do
     1076                          begin
     1077                            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     1078                             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     1079                              begin
     1080                                aMSBOS := StrToInt(piece(aList[i],'^',4));
     1081                                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     1082                                  begin
     1083                                    with Application do
     1084                                    begin
     1085                                      NormalizeTopMosts;
     1086                                      aMSBOSContinue :=
     1087                                        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);
     1094                                      RestoreTopMosts;
     1095                                    end;
     1096                                    if aMSBOSContinue = 7 then
     1097                                      begin
     1098                                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
     1099                                        exit;
     1100                                      end;
     1101                                  end;
     1102                              end;
     1103                          end;
     1104                      end;
     1105                    if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     1106                      begin
     1107                        uGetTnS := 1;
     1108                      end;
     1109                    aList.Clear;
     1110                    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     1111                    for i := 0 to aList.Count - 1 do
     1112                      begin
     1113                        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     1114                          begin
     1115                            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     1116                            break;
     1117                          end;
     1118                      end;
     1119                    uComponentSelected := true;
     1120                    with lvSelectionList do
     1121                      begin
     1122                        ListItem := Items.Add;
     1123                        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     1124                        ListItem.SubItems.Add(tQuantity.Text);
     1125                        if length(cboModifiers.ItemID) > 0 then
     1126                          begin
     1127                            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     1128                            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     1129                          end
     1130                          else
     1131                            begin
     1132                              ListItem.SubItems.Add('');
     1133                              ListItem.SubItems.Add('');
     1134                            end;
     1135                        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     1136                      end;
     1137                    CurAdd := 1;
     1138                    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     1139                    uSelectedItems.Add(aStr);
     1140                    for i := 0 to uSelectedItems.Count - 1 do
     1141                      begin
     1142                        aName := lvSelectionList.Items[i].Caption;
     1143                        x := uSelectedItems[i];
     1144                        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     1145                          begin
     1146                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1147                          end
     1148                        else
     1149                          begin
     1150                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1151                            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     1152                            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
     1153                            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     1154                            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     1155                          end;
     1156                        Inc(CurAdd);
     1157                      end;
     1158                    memOrder.Text := Responses.OrderText;
     1159                    GroupBox1.Visible := False;
     1160                  aMsg := '';
     1161                  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;
     1219                  if lvSelectionList.Items.Count > 0 then
     1220                    begin
     1221                      pnlSelectedTests.Visible := True;
     1222                      cmdAccept.Visible := True;
     1223                      memOrder.Visible := True;
     1224                      GroupBox1.Visible := False;
     1225                    end;
     1226                  end
     1227                  else
     1228                    begin
     1229                      if sub1 = 't' then
     1230                      begin
     1231                        DisableComponentControls;
     1232                        EnableDiagTestControls;
     1233                        LRORDERMODE := TORDER_MODE_DIAG;
     1234                        aTestYes := '1';
     1235                        SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
     1236                        //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
     1237                        i := 1 ;
     1238                        AResponse := Responses.FindResponseByName('COMMENT',i);
     1239                        while AResponse <> nil do
     1240                          begin
     1241                            Comment.Add(AResponse.EValue);
     1242                            Inc(i);
     1243                            AResponse := Responses.FindResponseByName('COMMENT',i);
     1244                          end ;
     1245                        if ObtainCollSamp then
     1246                          begin
     1247                          //For BloodBank orders, this condition should never occur
     1248                          end
     1249                        else
     1250                          begin
     1251                            with ALabTest do
     1252                              with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1253                                begin
     1254                                  x := '' ;
     1255                                  for i := 0 to WardComment.Count-1 do
     1256                                  x := x + WardComment.strings[i]+#13#10 ;
     1257                                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1258                                  OrderMessage(x) ;
     1259                                end ;
     1260                          end;
     1261                        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;
     1267                        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     1268                          else
     1269                            begin
     1270                              cboUrgency.ItemIndex := 1;
     1271                              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     1272                              cboUrgencyChange(self);
     1273                            end;
     1274                        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     1275                        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;
     1317                        uTestSelected := true;
     1318                        with lvSelectionList do
     1319                          begin
     1320                            ListItem := Items.Add;
     1321                            ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
     1322                            ListItem.SubItems.Add('');
     1323                            ListItem.SubItems.Add('');
     1324                            ListItem.SubItems.Add('');
     1325                            ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
     1326                          end;
     1327                        CurAdd := 1;
     1328                        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     1329                        uSelectedItems.Add(aStr);
     1330                        for i := 0 to uSelectedItems.Count - 1 do
     1331                          begin
     1332                            aName := lvSelectionList.Items[i].Caption;
     1333                            x := uSelectedItems[i];
     1334                            if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     1335                              begin
     1336                                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1337                              end;
     1338                            Inc(CurAdd);
     1339                          end;
     1340                        memOrder.Text := Responses.OrderText;
     1341                      edtResults.Height := 247;
     1342                      edtInfo.Height := 247;
     1343                      if lvSelectionList.Items.Count > 0 then
     1344                        begin
     1345                          pnlSelectedTests.Visible := True;
     1346                          cmdAccept.Visible := True;
     1347                          memOrder.Visible := True;
     1348                          GroupBox1.Visible := False;
     1349                        end;
     1350                      end;
     1351                    end;
     1352                  AnInstance := NextInstance('ORDERABLE', AnInstance);
     1353              end;
     1354              //Quick Order
     1355          end;
     1356        for i := 0 to lvSelectionList.Items.Count - 1 do
     1357          begin
     1358            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     1359              begin
     1360                uGetTnS := 0;
     1361                uDfltUrgency := cboUrgency.ItemID;
     1362                lblTNS.Caption := '';
     1363                lblTNS.Visible := false;
     1364                memMessage.Text := '';
     1365                pnlMessage.Visible := false;
     1366                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     1367                if uTNSOrders.Count > 0 then
     1368                  begin
     1369                    for j := 0 to uTNSOrders.Count - 1 do
     1370                      aTNSString := aTNSString + CRLF + uTNSOrders[j];
     1371                    with Application do
     1372                      begin
     1373                        NormalizeTopMosts;
     1374                        aTNSDays := TNSDaysBack;
     1375                        aTNS :=
     1376                          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);
     1380                        RestoreTopMosts;
     1381                        if aTNS = 7 then
     1382                          begin
     1383                            lvSelectionList.ItemIndex := i;
     1384                            lvSelectionListClick(self);
     1385                            btnRemoveClick(self);
     1386                            break;
     1387                          end;
     1388                      end;
     1389                  end;
     1390                break;
     1391              end;
     1392          end;
     1393        if uGetTnS = 1 then
     1394          begin
     1395            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     1396            lblTNS.Visible := true;
     1397            memMessage.Text := 'TYPE + SCREEN must be added to order';
     1398            pnlMessage.Visible := true;
     1399            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     1400          end;
     1401        if ALabTest <> nil then
     1402          begin
     1403            if ObtainCollSamp then
     1404              begin
     1405               //For BloodBank orders, this condition should never occur
     1406              end
     1407            else
     1408              begin
     1409                with ALabTest do
     1410                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1411                    begin
     1412                      x := '' ;
     1413                      for i := 0 to WardComment.Count-1 do
     1414                      x := x + WardComment.strings[i]+#13#10 ;
     1415                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1416                      OrderMessage(x) ;
     1417                    end ;
     1418              end;
     1419            with ALabTest do
     1420              begin
     1421                if ObtainComment then
     1422                  LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
     1423                else
     1424                  DisableCommentPanels;
     1425                x := '' ;
     1426                for i := 0 to CurWardComment.Count-1 do
     1427                  x := x + CurWardComment.strings[i]+#13#10 ;
     1428                i :=  IndexOfCollSamp(CollSamp);
     1429                if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1430                  for i := 0 to WardComment.Count-1 do
     1431                    x := x + WardComment.strings[i]+#13#10 ;
     1432                pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1433                OrderMessage(x) ;
     1434              end;
     1435            GroupBox1.Visible := False;
     1436          end;
     1437        StatusText('');
     1438        Changing := False;
     1439      end;
     1440  finally                      //**SubTest
     1441    alist.Free;
     1442    aTests.Free;
     1443  end;
    4041444end;
    4051445
    … …  
    4221462      LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
    4231463      TestReqComment := ExtractDefault(LoadData, 'ReqCom');
     1464      UniqueCollSamp := false;
    4241465      if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
    4251466      x := ExtractDefault(LoadData, 'Unique CollSamp');
    … …  
    4311472      ExtractItems(SpecimenList, LoadData, 'Specimens');
    4321473      if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
     1474      UrgencyList := TStringList.Create;
     1475      if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then  { forced urgency }
     1476        begin
     1477          ForceUrgency := True;
     1478          UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
     1479          Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
     1480          uDfltUrgency := Urgency;
     1481        end
     1482      else
     1483        begin                 { list of urgencies }
     1484          ExtractItems(UrgencyList, LoadData, 'Urgencies');
     1485          if StrToIntDef(LRFURG, 0) > 0 then
     1486            Urgency := StrToInt(LRFURG)
     1487          else
     1488            Urgency := uDfltUrgency;
     1489        end;
    4331490      Comment := TStringList.Create ;
    4341491      CurWardComment := TStringList.Create;
    … …  
    4431500          OneSamp := TStringList.Create;
    4441501          try
    445             OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
     1502            FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
    4461503            FillCollSampList(OneSamp, CollSampList.Count);
    4471504          finally
    … …  
    4711528  CollSampList.Free;
    4721529  SpecimenList.Free;
     1530  UrgencyList.Free;
    4731531  CurWardComment.Free;
    4741532  Comment.Free;
    … …  
    6311689    begin
    6321690      if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
    633       AComboBox.Items.Assign(SpecimenList);
     1691      FastAssign(SpecimenList, AComboBox.Items);
    6341692      AComboBox.Items.Add('0^Other...');
    6351693      with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
    … …  
    6591717end;
    6601718
     1719procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
     1720var
     1721  i: integer;
     1722begin
     1723  if UrgencyList.Count < 1 then Exit;
     1724  with AComboBox do
     1725    begin
     1726      Clear;
     1727      for i := 0 to UrgencyList.Count - 1 do
     1728         if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
     1729           Continue
     1730         else
     1731           Items.Add(UrgencyList[i]);
     1732      if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
     1733        SelectByID(LRFURG)
     1734      else
     1735        SelectByIEN(uDfltUrgency);
     1736      Urgency := AComboBox.ItemIEN;
     1737    end;
     1738end;
     1739
    6611740function TLabTest.NameOfCollSamp: string;
    6621741var
    … …  
    6831762end;
    6841763
     1764function TLabTest.NameOfUrgency: string;
     1765var
     1766  i: Integer;
     1767begin
     1768  Result := '';
     1769  with UrgencyList do for i := 0 to Count - 1 do
     1770  begin
     1771    if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
     1772      then Result := Piece(Strings[i], '^', 2);
     1773    break;
     1774  end;
     1775end;
     1776
    6851777function TLabTest.ObtainCollSamp: Boolean;
    6861778begin
    … …  
    6981790end;
    6991791
     1792function TLabTest.ObtainUrgency: Boolean;
     1793begin
     1794  Result := not ForceUrgency;
     1795end;
     1796
    7001797function TLabTest.ObtainComment: Boolean;
    7011798begin
    … …  
    7081805end;
    7091806
     1807procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
     1808begin
     1809  ExtractItems(Outlist, AList,'REASONS');
     1810end;
     1811
    7101812procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
    7111813begin
    … …  
    7131815end;
    7141816
     1817procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
     1818begin
     1819  ExtractItems(Outlist, AList,'TNS ORDERS');
     1820end;
     1821
    7151822procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
    7161823begin
    … …  
    7261833begin
    7271834  ExtractItems(OutList, AList, 'TYPE AND SCREEN');
     1835end;
     1836
     1837procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
     1838begin
     1839  ExtractItems(OutList, AList, 'OTHER');
    7281840end;
    7291841
    … …  
    8131925  inherited;
    8141926  if uSelectedItems.Count < 1 then
    815     SetError(TX_NO_TESTS);
     1927    begin
     1928      SetError(TX_NO_TESTS);
     1929      Exit;
     1930    end;
    8161931  if uGetTns = 1 then
    817     SetError(TX_TNS_REQUIRED);
     1932    begin
     1933      SetError(TX_TNS_REQUIRED);
     1934      Exit;
     1935    end;
     1936  ValidateAdd(AnErrMsg);
    8181937end;
    8191938
    … …  
    8271946
    8281947var
    829   i, CmtType, DaysofFuturePast: integer;
     1948  aList: TStringList;
     1949  i, DaysofFuturePast: integer;
    8301950  d1, d2: TDateTime;
    831   x: string;
     1951  x,test,aOther: string;
    8321952const
    8331953  {Diagnostic Test Errors}
    834   TX_NO_TIME        = 'Collection Time is required.' ;
    835   TX_NO_TCOLLTYPE   = 'Collection Type is required.' ;
    836   TX_NO_TESTS       = 'A Lab Test or tests must be selected.' ;
     1954  TX_NO_TIME        = 'Collection Time is required' ;
     1955  TX_NO_TCOLLTYPE   = 'Collection Type is required' ;
     1956  TX_NO_TESTS       = 'A Lab Test or tests must be selected' ;
    8371957  TX_BAD_TIME       = 'Collection times must be chosen from the drop down list or entered as valid' +
    838                       ' Fileman date/times (T@1700, T+1@0800, etc.).' ;
    839   TX_PAST_TIME      = 'Collection times in the past are not allowed.';
    840   TX_NO_DAYS        = 'A number of days must be entered for continuous orders.';
    841   TX_NO_TIMES       = 'A number of times must be entered for continuous orders.';
    842   TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days".';
     1958                      ' Fileman date/times (T@1700, T+1@0800, etc.)' ;
     1959  TX_PAST_TIME      = 'Collection times in the past are not allowed';
     1960  TX_NO_DAYS        = 'A number of days must be entered for continuous orders';
     1961  TX_NO_TIMES       = 'A number of times must be entered for continuous orders';
     1962  TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days"';
    8431963  TX_TOO_MANY_DAYS  = 'Maximum number of days allowed is ';
    8441964  TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is:  X';
    8451965  //TX_NO_COMMENT     = 'A comment is required for this test and collection sample.';
    846   TX_NUMERIC_REQD   = 'A numeric value is required for urine volume.';
    847   TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order.';
    848   TX_TDM_REQD       = 'A value for LEVEL is required for this order.';
     1966  TX_NUMERIC_REQD   = 'A numeric value is required for urine volume';
     1967  TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order';
     1968  TX_TDM_REQD       = 'A value for LEVEL is required for this order';
    8491969  //TX_ANTICOAG_REQD  = 'You must specify an anticoagulant on this order.' ;
    850   TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified.';
    851   TX_NO_SPECIMEN    = 'A specimen MUST be specified.';
    852   TX_NO_URGENCY     = 'An urgency MUST be specified.';
    853   TX_NO_FREQUENCY   = 'A collection frequency MUST be specified.';
    854   TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
    855   TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
     1970  TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified';
     1971  TX_NO_SPECIMEN    = 'A specimen MUST be specified';
     1972  TX_NO_URGENCY     = 'An urgency MUST be specified';
     1973  TX_NO_FREQUENCY   = 'A collection frequency MUST be specified';
     1974  TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
     1975  TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
    8561976  TX_BADTIME_CAP    = 'Invalid Immediate Collect Time';
    8571977  {Component/Type & Screen Errors}
    858   TX_NO_COMPONENTS  = 'A Blood Product MUST be selected.';
    859   TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity".';
    860   TX_HIGH_QUANTITY  = 'Quantity too high.';
     1978  TX_NO_COMPONENTS  = 'A Blood Product MUST be selected';
     1979  TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity"';
     1980  TX_HIGH_QUANTITY  = 'Quantity too high';
    8611981  TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
    862   //TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';
    8631982  TX_NO_SURGERY     = 'A Surgery MUST be specified for Pre-Op orders';         //only if Pre-op selected
    8641983  TX_NO_REASON      = 'A Reason for Request MUST be entered';
     1984  TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
     1985  TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
    8651986  TX_NO_COMMENT     = 'A Comment MUST be entered for this Component';
    8661987  TX_DUPLICATE      = 'Duplicate Test/Component not allowed';
    … …  
    8701991  inherited;
    8711992  AnErrMsg := '';
    872   if aLabTest = nil then
    873     begin
    874       AnErrMsg := TX_NO_TEST_SELECTED;
    875       Exit;
    876     end;
    877   for i := 0 to uSelectedItems.Count - 1 do
    878     if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then
     1993  aList := TStringList.Create;
     1994  try
     1995    ExtractOther(aList, uVBECList);
     1996    if aList.Count > 0 then aOther := aList[0];
     1997    aList.Clear;
     1998    if uSelectedItems.Count < 1 then
    8791999      begin
    880         AnErrMsg := TX_DUPLICATE;
     2000        AnErrMsg := TX_NO_TEST_SELECTED;
    8812001        Exit;
    8822002      end;
    883   if LRORDERMODE = TORDER_MODE_DIAG then
    884     begin
    885       with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
    886 
    887       if ALabTest <> nil then
    888         if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
     2003    for i := 0 to uSelectedItems.Count - 1 do
     2004      begin
     2005        x := uSelectedItems[i];
     2006        test := lvSelectionList.Items[i].Caption;
     2007        if piece(x,'^',1) = '1' then    //Diagnostic Test
    8892008          begin
    890             SetError(TX_NO_IMMED);
    891             cboCollType.ItemIndex := -1;
     2009            if uSpecimen = 0 then
     2010              if cboCollType.ItemID = '' then
     2011                SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
     2012              else if cboCollType.ItemID = 'LC' then
     2013                begin
     2014                 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
     2015                 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
     2016                   begin
     2017                     if StrToFMDateTime(Text) < 0 then
     2018                       SetError(TX_BAD_TIME + ' (' + test + ')')
     2019                     else if StrToFMDateTime(Text) < FMNow then
     2020                       SetError(TX_PAST_TIME + ' (' + test + ')')
     2021                     else if OrderForInpatient then
     2022                       begin
     2023                         d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
     2024                         d2 := FMDateTimeToDateTime(FMToday);
     2025                         if EvtDelayLoc > 0 then
     2026                           DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
     2027                         else
     2028                           DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
     2029                         if DaysofFuturePast = 0 then DaysofFuturePast := 7;
     2030                         if ((d1 - d2) > DaysofFuturePast) then
     2031                           SetError('A lab collection cannot be ordered more than '
     2032                             + IntToStr(DaysofFuturePast) + ' days in advance');
     2033                       end
     2034                     else if EvtDelayLoc > 0 then
     2035                       begin
     2036                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
     2037                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
     2038                       end
     2039                     else if EvtDelayLoc <= 0 then
     2040                       begin
     2041                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
     2042                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
     2043                       end;
     2044                   end;
     2045                end
     2046              else
     2047                begin
     2048                  if cboCollType.ItemID = 'I' then
     2049                    begin
     2050                      calCollTime.Text := txtImmedColl.Text;
     2051                      x := ValidImmCollTime(calCollTime.FMDateTime);
     2052                      if (Piece(x, U, 1) <> '1') then
     2053                        SetError(Piece(x, U, 2));
     2054                    end;
     2055
     2056                  with calColltime do
     2057                    begin
     2058                      if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
     2059                      else
     2060                        begin
     2061                          // date only was entered
     2062                          if (FMDateTime - Trunc(FMDateTime) = 0) then
     2063                            begin
     2064                              if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
     2065                            end
     2066                          // date/time was entered
     2067                          else
     2068                            begin
     2069                              if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
     2070                            end;
     2071                        end;
     2072                    end;
     2073                end;
     2074
     2075            with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
     2076          end
     2077        else                            //Component
     2078          begin
     2079            if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
     2080              else
     2081                begin
     2082                  if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
     2083                  if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
     2084                end;
     2085            if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
     2086            if (cboReasons.Text = '') and not(uReason = '') then
     2087              begin
     2088                SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
     2089                cboReasons.Text := uReason; //reset reason back to previous value
     2090              end;
     2091              if (cboReasons.Text = '') then
     2092                begin
     2093                  SetError(TX_NO_REASON + ' (' + test + ').');
     2094                end;
     2095            if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
     2096            if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
     2097            if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
     2098            if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
    8922099          end;
    893       if uSpecimen = 0 then
    894         if cboCollType.ItemID = '' then
    895           SetError(TX_NO_TCOLLTYPE)
    896         else if cboCollType.ItemID = 'LC' then
    897           begin
    898            if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
    899            with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
    900              begin
    901                if StrToFMDateTime(Text) < 0 then
    902                  SetError(TX_BAD_TIME)
    903                else if StrToFMDateTime(Text) < FMNow then
    904                  SetError(TX_PAST_TIME)
    905                else if OrderForInpatient then
    906                  begin
    907                    d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
    908                    d2 := FMDateTimeToDateTime(FMToday);
    909                    if EvtDelayLoc > 0 then
    910                      DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
    911                    else
    912                      DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
    913                    if DaysofFuturePast = 0 then DaysofFuturePast := 7;
    914                    if ((d1 - d2) > DaysofFuturePast) then
    915                      SetError('A lab collection cannot be ordered more than '
    916                        + IntToStr(DaysofFuturePast) + ' days in advance');
    917                  end
    918                else if EvtDelayLoc > 0 then
    919                  begin
    920                    if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
    921                      SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
    922                  end
    923                else if EvtDelayLoc <= 0 then
    924                  begin
    925                    if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
    926                      SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
    927                  end;
    928              end;
    929           end
    930         else
    931           begin
    932             if cboCollType.ItemID = 'I' then
    933               begin
    934                 calCollTime.Text := txtImmedColl.Text;
    935                 x := ValidImmCollTime(calCollTime.FMDateTime);
    936                 if (Piece(x, U, 1) <> '1') then
    937                   SetError(Piece(x, U, 2));
    938               end;
    939 
    940             with calColltime do
    941               begin
    942                 if FMDateTime = 0 then SetError(TX_BAD_TIME)
    943                 else
    944                   begin
    945                     // date only was entered
    946                     if (FMDateTime - Trunc(FMDateTime) = 0) then
    947                       begin
    948                         if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
    949                       end
    950                     // date/time was entered
    951                     else
    952                       begin
    953                         if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
    954                       end;
    955                   end;
    956               end;
    957           end;
    958 
    959       with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY);
    960       if ALabTest <> nil then
    961         begin
    962           CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
    963           with ALabTest do
    964           case CmtType of
    965             0 : {ANTICOAGULATION}         {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
    966                                          SetError(TX_ANTICOAG_REQD)};
    967             1 : {DOSE/DRAW TIMES}         if (Pos('Last dose:',Comment.Text)=0) or
    968                                           (Pos('draw time:',Comment.Text)=0) then
    969                                          SetError(TX_DOSEDRAW_REQD);
    970             2 : {ORDER COMMENT}           {if (Length(Comment.Text)=0) then
    971                                          SetError(TX_NO_COMMENT)};
    972             3 : {ORDER COMMENT MODIFIED}  {if (Length(Comment.Text)=0) then
    973                                          SetError(TX_NO_COMMENT)};
    974             4 : {TDM (PEAK-TROUGH}        if (Pos('Dose is expected',Comment.Text)=0) then
    975                                          SetError(TX_TDM_REQD);
    976             5 : {TRANSFUSION}             {if (Length(Comment.Text)=0) then
    977                                          SetError(TX_NO_COMMENT)};
    978             6 : {URINE VOLUME}            if (Length(Comment.Text)>0) and
    979                                        (ExtractInteger(Comment.Text)<=0) then
    980                                           Comment.Text := '?';
    981                                          {SetError(TX_NUMERIC_REQD);}
    982           end;
    983         end;
    984     end
    985   else if LRORDERMODE = TORDER_MODE_COMP then
    986     begin
    987       with cboAvailComp do
    988         begin
    989           if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS);
    990         end;
    991       if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY);
    992       if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED);
    993       //if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION);
    994       if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY);
    995       if tReason.Text = '' then SetError(TX_NO_REASON);
    996       if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT);
    997       if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY);
    998     end;
     2100      end;
     2101  finally
     2102    aList.Free;
     2103  end;
    9992104end;
    10002105
    … …  
    12732378end;
    12742379
     2380procedure TfrmODBBank.cboQuickClick(Sender: TObject);
     2381begin
     2382  inherited;
     2383  SetOnQuickOrder;
     2384end;
     2385
     2386procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
     2387begin
     2388  inherited;
     2389  if (length(cboReasons.Text) > 75) then
     2390    begin
     2391      ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
     2392      cboReasons.Text := Copy(cboReasons.Text,0,75);
     2393      Exit;
     2394    end;
     2395  if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
     2396  memOrder.Text := Responses.OrderText;
     2397end;
     2398
     2399procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
     2400begin
     2401  inherited;
     2402  if Length(cboReasons.Text) > 0 then
     2403    uReason := cboReasons.Text;
     2404end;
     2405
     2406procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
     2407begin
     2408  inherited;
     2409  if Length(cboReasons.Text) > 0 then
     2410    uReason := cboReasons.Text;
     2411end;
     2412
    12752413procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
    12762414var
    1277   x: string;
    12782415  i: integer;
    1279 begin
    1280   DisableComponentControls;
    1281   EnableDiagTestControls;
    1282   LRORDERMODE := TORDER_MODE_DIAG;
    1283   with cboAvailTest do
    1284     begin
    1285       if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2416  text : string;
     2417  ListItem: TListItem;
     2418  aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string;
     2419  aList: TStringList;
     2420  curAdd,AnInstance,aTNS,aTNSDays: Integer;
     2421  sub,sub1: string;
     2422  AResponse: TResponse;
     2423begin
     2424  if cboAvailTest.ItemID = '' then Exit;
     2425  aList := TStringList.Create;
     2426  try
     2427    ALabTest := nil;
     2428    aTypeScreen := '';
     2429    aSpecimen := '^';
     2430    aTestYes := '1';
     2431    aModifier := '';
     2432    changing := true;
     2433    tQuantity.Text := '';
     2434    sub1 := '';
     2435    cboModifiers.ItemIndex := -1;
     2436    DisableComponentControls;
     2437    EnableDiagTestControls;
     2438    LRORDERMODE := TORDER_MODE_DIAG;
     2439    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     2440    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;
     2458    with cboAvailTest do
     2459      begin
     2460        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2461        FLastLabID := ItemID ;
     2462        FLastItemID := ItemID;
     2463        for i := 0 to uSelectedItems.Count - 1 do
     2464          if ItemID = piece(uSelectedItems[i],'^',2) then
     2465            begin
     2466              ItemIndex := -1;
     2467              lvSelectionList.Items[i].Selected := true;
     2468              lvSelectionListClick(self);
     2469              Exit;
     2470            end;
     2471        Changing := True;
     2472        Changing := False;
     2473        ExtractTypeScreen(aList, uVBECList);
     2474        if aList.Count > 0 then aTypeScreen := aList[0];
     2475        aList.Clear;
     2476        aTNSString := '';
     2477        if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
     2478          begin
     2479            for i := 0 to uTNSOrders.Count - 1 do
     2480              aTNSString := aTNSString + CRLF + uTNSOrders[i];
     2481            with Application do
     2482              begin
     2483                NormalizeTopMosts;
     2484                aTNSDays := TNSDaysBack;
     2485                aTNS :=
     2486                  MessageBox(PChar(aTNSString + CRLF + CRLF +
     2487                             'Do you wish to continue?'),
     2488                             PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     2489                             MB_YESNO);
     2490                RestoreTopMosts;
     2491                if aTNS = 7 then
     2492                  begin
     2493                    cboAvailTest.ItemIndex := -1;
     2494                    exit;
     2495                  end;
     2496              end;
     2497          end;
     2498        if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
     2499          begin
     2500            if ObtainCollSamp then
     2501              begin
     2502              //For BloodBank orders, this condition should never occur
     2503              end
     2504            else
     2505              begin
     2506                with ALabTest do
     2507                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     2508                    begin
     2509                      x := '' ;
     2510                      for i := 0 to WardComment.Count-1 do
     2511                      x := x + WardComment.strings[i]+#13#10 ;
     2512                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     2513                      OrderMessage(x) ;
     2514                    end ;
     2515              end;
     2516        end;
     2517        Changing := False;
     2518      end;
     2519    if LRORDERMODE = TORDER_MODE_DIAG then
     2520      begin
     2521        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     2522        with cboCollType do if Length(ItemID) > 0 then
     2523          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;
     2531            Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     2532          end;
     2533        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     2534        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     2535        if cboCollType.ItemID = 'LC' then
     2536          begin
     2537            with cboCollTime do
     2538              if Length(ItemID) > 0 then
     2539                begin
     2540                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     2541                  FLastLabCollTime := ItemID + U + Text;
     2542                end
     2543              else if Length(Text) > 0 then
     2544                begin
     2545                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     2546                  FLastLabCollTime := ValidCollTime(Text);
     2547                end;
     2548          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);
     2564      end;
     2565    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     2566    uTestSelected := true;
     2567    with lvSelectionList do
     2568      begin
     2569        ListItem := Items.Add;
     2570        ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
     2571        ListItem.SubItems.Add('');
     2572        ListItem.SubItems.Add('');
     2573        ListItem.SubItems.Add('');
     2574        ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
     2575        if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
     2576          begin
     2577            lblTNS.Caption := '';
     2578            lblTNS.Visible := false;
     2579            memMessage.Text := '';
     2580            pnlMessage.Visible := false;
     2581            uGetTnS := 0;
     2582            pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     2583          end;
     2584      end;
     2585    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     2586    uSelectedItems.Add(aStr);
     2587    CurAdd := 1;
     2588    for i := 0 to uSelectedItems.Count - 1 do
     2589      begin
     2590        aName := lvSelectionList.Items[i].Caption;
     2591        x := uSelectedItems[i];
     2592        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     2593          begin
     2594            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2595          end;
     2596        Inc(CurAdd);
     2597      end;
     2598    memOrder.Text := Responses.OrderText;
     2599  finally
     2600    aList.Free;
     2601  end;
     2602  edtResults.Height := 247;
     2603  edtInfo.Height := 247;
     2604  if lvSelectionList.Items.Count > 0 then
     2605    begin
     2606      pnlSelectedTests.Visible := True;
     2607      cmdAccept.Visible := True;
     2608      memOrder.Visible := True;
     2609      GroupBox1.Visible := False;
     2610    end;
     2611end;
     2612
     2613procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
     2614 var
     2615  aList,aTests: TStringList;
     2616  i,j,k,getTest,TestAdded: integer;
     2617  text : string;
     2618  aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
     2619  sub,sub1: string;
     2620  AResponse: TResponse;
     2621  ListItem: TListItem;
     2622  aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String;
     2623begin
     2624  if cboAvailComp.ItemID = '' then Exit;
     2625  aList := TStringList.Create;
     2626  aTests := TStringList.Create;
     2627  sub1 := '';
     2628  try
     2629    DisableDiagTestControls;
     2630    EnableComponentControls;
     2631    if not(changing = true) then
     2632      begin
     2633        changing := true;
     2634        tQuantity.Text := '';
     2635        cboModifiers.ItemIndex := -1;
     2636        changing := false;
     2637      end;
     2638    LRORDERMODE := TORDER_MODE_COMP;
     2639    with cboAvailComp do
     2640      begin
     2641        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2642        FLastLabID := ItemID ;
     2643        FLastItemID := ItemID;
     2644        for i := 0 to uSelectedItems.Count - 1 do
     2645          if ItemID = piece(uSelectedItems[i],'^',2) then
     2646            begin
     2647              ItemIndex := -1;
     2648              lvSelectionList.Items[i].Selected := true;
     2649              lvSelectionListClick(self);
     2650              Exit;
     2651            end;
     2652        ALabTest := TLabTest.Create(ItemID, Responses);
     2653        sub := GetSubtype(ALabTest.TestName);
     2654        Changing := False;
     2655        StatusText('');
     2656      end;
     2657    //Check for and display any associated Lab Results
     2658    aList.Clear;
     2659    TestAdded := 0;
     2660    getTest := 0;
     2661    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     2662      for j := 0 to aList.Count - 1 do
     2663        begin
     2664          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     2665            begin
     2666              if uTestsForResults.Count < 1 then getTest := 1;
     2667              for k := 0 to uTestsForResults.Count - 1 do
     2668                begin
     2669                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     2670                    begin
     2671                      getTest := 0;
     2672                      break;
     2673                    end
     2674                  else getTest := 1;
     2675                end;
     2676              if getTest = 1 then
     2677                begin
     2678                  uTestsForResults.Add(piece(aList[j],'^',3));
     2679                  TestAdded := 1;
     2680                end;
     2681            end;
     2682        end;
     2683      if TestAdded = 1 then
     2684        begin
     2685          edtResults.Clear;
     2686          aTests.Clear;
     2687          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);
     2692        end;
     2693      CurAdd := 1;
     2694      if uRaw.Count > 0 then
     2695      for j := 0 to uRaw.Count - 1 do
     2696        begin
     2697          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     2698          Inc(CurAdd);
     2699        end;
     2700    aTypeScreen := '';
     2701    aSpecimen := '^';
     2702    aTestYes := '0';
     2703    aReason := '';
     2704    aSurgery := '';
     2705    aCollTime := '';
     2706    aList.Clear;
     2707    ExtractTypeScreen(aList, uVBECList);
     2708    if aList.Count > 0 then aTypeScreen := aList[0];
     2709    aList.Clear;
     2710    ExtractSpecimen(aList, uVBECList);
     2711    if aList.Count > 0 then aSpecimen := aList[0];
     2712    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     2713    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     2714    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
     2718        aList.Clear;
     2719        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     2720        for i := 0 to aList.Count - 1 do
     2721          begin
     2722            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     2723             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     2724              begin
     2725                aMSBOS := StrToInt(piece(aList[i],'^',4));
     2726                if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     2727                  begin
     2728                    with Application do
     2729                    begin
     2730                      NormalizeTopMosts;
     2731                      aMSBOSContinue :=
     2732                        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);
     2739                      RestoreTopMosts;
     2740                    end;
     2741                    if aMSBOSContinue = 7 then
     2742                      begin
     2743                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
     2744                        exit;
     2745                      end;
     2746                  end;
     2747              end;
     2748          end;
     2749      end;
     2750    if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     2751      begin
     2752        uGetTnS := 1;
     2753        for i := 0 to lvSelectionList.Items.Count - 1 do
     2754          begin
     2755            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     2756              begin
     2757                uGetTnS := 0;
     2758                if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
     2759                lblTNS.Caption := '';
     2760                lblTNS.Visible := false;
     2761                memMessage.Text := '';
     2762                pnlMessage.Visible := false;
     2763                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     2764                break;
     2765              end;
     2766          end;
     2767      end;
     2768    aList.Clear;
     2769    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     2770    for i := 0 to aList.Count - 1 do
     2771      begin
     2772        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     2773          begin
     2774            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     2775            break;
     2776          end;
     2777      end;
     2778    uComponentSelected := true;
     2779    with lvSelectionList do
     2780      begin
     2781        ListItem := Items.Add;
     2782        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     2783        ListItem.SubItems.Add(tQuantity.Text);
     2784        if length(cboModifiers.ItemID) > 0 then
     2785          begin
     2786            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     2787            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     2788          end
     2789          else
     2790            begin
     2791              ListItem.SubItems.Add('');
     2792              ListItem.SubItems.Add('');
     2793            end;
     2794        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     2795      end;
     2796      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     2797      uSelectedItems.Add(aStr);
     2798      CurAdd := 1;
    12862799      for i := 0 to uSelectedItems.Count - 1 do
    1287         if ItemID = piece(uSelectedItems[i],'^',1) then
     2800        begin
     2801          aName := lvSelectionList.Items[i].Caption;
     2802          x := uSelectedItems[i];
     2803          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     2804            begin
     2805              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2806            end
     2807          else
     2808            begin
     2809              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2810              if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     2811              if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
     2812              if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     2813              if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     2814              if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     2815              if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     2816                else
     2817                  begin
     2818                    cboUrgency.ItemIndex := 1;
     2819                    Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     2820                  end;
     2821            end;
     2822          Inc(CurAdd);
     2823        end;
     2824      memOrder.Text := Responses.OrderText;
     2825  finally
     2826    alist.Free;
     2827    aTests.Free;
     2828  end;
     2829  aMsg := '';
     2830  LRORDERMODE := TORDER_MODE_INFO;
     2831  if uGetTnS = 1 then
     2832    begin
     2833      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     2834      lblTNS.Visible := true;
     2835      memMessage.Text := 'TYPE + SCREEN must be added to order';
     2836      pnlMessage.Visible := true;
     2837      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
    12882870          begin
    1289             ShowMessage('This test has already been selected!');
    1290             Exit;
     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;
    12912876          end;
    1292       FLastLabID := ItemID ;
    1293       FLastItemID := ItemID;
    1294       Changing := True;
    1295       if Sender <> Self then
    1296         Responses.Clear;       // Sender=Self when called from SetupDialog
    1297       if CharAt(ItemID, 1) = 'Q' then
    1298         with Responses do
    1299           begin
    1300             FLastItemID := ItemID;
    1301             QuickOrder := ExtractInteger(ItemID);
    1302             SetControl(cboAvailTest, 'ORDERABLE', 1);
    1303             if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1304             FLastLabID := ItemID;
    1305           end;
    1306       ALabTest := TLabTest.Create(ItemID, Responses);
    1307     end;
    1308   with ALabTest do
    1309   begin
    1310 
    1311     {with Responses do if QuickOrder > 0 then
    1312      begin
    1313       StatusText('Initializing Quick Order');
    1314       Changing := True;
    1315       SetControl(cboAvailTest,       'ORDERABLE', 1);
    1316       DetermineCollectionDefaults(Responses);
    1317       LoadUrgency(cboCollType.ItemID, cboUrgency);
    1318       SetControl(cboUrgency,         'URGENCY', 1);
    1319       Urgency := cboUrgency.ItemIEN;
    1320       if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    1321         begin
    1322           cboUrgency.ItemIndex := 0;
    1323           Urgency := cboUrgency.ItemIEN;
    1324         end;
    1325       tmpResp := FindResponseByName('SPECIMEN'  ,1);
    1326       i := 1 ;
    1327       tmpResp := Responses.FindResponseByName('COMMENT',i);
    1328       while tmpResp <> nil do
    1329         begin
    1330           Comment.Add(tmpResp.EValue);
    1331           Inc(i);
    1332           tmpResp := Responses.FindResponseByName('COMMENT',i);
    1333         end ;
    1334       end;  //  Quick Order}
    1335     if ObtainCollSamp then
    1336       begin
    1337         //For BloodBank orders, this condition should never occur
    1338       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;
     2885  if lvSelectionList.Items.Count > 0 then
     2886    begin
     2887      pnlSelectedTests.Visible := True;
     2888      cmdAccept.Visible := True;
     2889      memOrder.Visible := True;
     2890      GroupBox1.Visible := False;
     2891    end;
     2892  if tQuantity.CanFocus = true then tQuantity.SetFocus;
     2893end;
     2894
     2895procedure TfrmODBBank.DisableCommentPanels;
     2896begin
     2897  lblReqComment.Visible := False;
     2898end;
     2899
     2900procedure TfrmODBBank.DisableComponentControls;
     2901begin
     2902  lblQuantity.Enabled := false;
     2903  tQuantity.Enabled := false;
     2904  lblModifiers.Enabled := false;
     2905  cboModifiers.Enabled := false;
     2906  cboAvailComp.ItemIndex := -1;
     2907end;
     2908
     2909procedure TfrmODBBank.EnableComponentControls;
     2910begin
     2911  lblQuantity.Enabled := true;
     2912  tQuantity.Enabled := true;
     2913  lblModifiers.Enabled := true;
     2914  cboModifiers.Enabled := true;
     2915  if not(changing) then
     2916    if not(uSelUrgency = 'PRE-OP') then
     2917      if uSelUrgency = '' then
     2918        if lvSelectionList.Items.Count < 1 then
     2919          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     2920  if cboUrgency.Text = 'PRE-OP' then
     2921    begin
     2922      lblSurgery.Enabled := true;
     2923      cboSurgery.Enabled := true;
     2924      lblSurgery.Caption := 'Surgery*';
     2925    end
    13392926    else
    13402927      begin
    1341         with ALabTest do
    1342           with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1343             begin
    1344               x := '' ;
    1345               for i := 0 to WardComment.Count-1 do
    1346                 x := x + WardComment.strings[i]+#13#10 ;
    1347               pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1348               OrderMessage(x) ;
    1349             end ;
     2928        lblSurgery.Enabled := false;
     2929        cboSurgery.Enabled := false;
     2930        lblSurgery.Caption := 'Surgery';
    13502931      end;
    1351     if ObtainComment then
    1352       LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
    1353     else
    1354       DisableCommentPanels;
    1355     x := '' ;
    1356     for i := 0 to CurWardComment.Count-1 do
    1357       x := x + CurWardComment.strings[i]+#13#10 ;
    1358     i :=  IndexOfCollSamp(CollSamp);
    1359     if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1360        for i := 0 to WardComment.Count-1 do
    1361          x := x + WardComment.strings[i]+#13#10 ;
    1362     pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1363     OrderMessage(x) ;
    1364    end; { with }
    1365   StatusText('');
    1366   Changing := False;
    1367 end;
    1368 
    1369 procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
    1370 var
    1371   x: string;
    1372   i: integer;
    1373 begin
    1374   DisableDiagTestControls;
    1375   EnableComponentControls;
    1376   LRORDERMODE := TORDER_MODE_COMP;
    1377   with cboAvailComp do
    1378     begin
    1379       if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1380       for i := 0 to uSelectedItems.Count - 1 do
    1381         if ItemID = piece(uSelectedItems[i],'^',1) then
    1382           begin
    1383             ShowMessage('This component has already been selected!');
    1384             Exit;
    1385           end;
    1386       FLastLabID := ItemID ;
    1387       FLastItemID := ItemID;
    1388       Changing := True;
    1389       if Sender <> Self then
    1390         Responses.Clear;       // Sender=Self when called from SetupDialog
    1391       if CharAt(ItemID, 1) = 'Q' then
    1392         with Responses do
    1393           begin
    1394             FLastItemID := ItemID;
    1395             QuickOrder := ExtractInteger(ItemID);
    1396             SetControl(cboAvailComp, 'ORDERABLE', 1);
    1397             if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1398             FLastLabID := ItemID;
    1399           end;
    1400       ALabTest := TLabTest.Create(ItemID, Responses);
    1401     end;
    1402   with ALabTest do
    1403   begin
    1404 
    1405     {with Responses do if QuickOrder > 0 then
    1406      begin
    1407       StatusText('Initializing Quick Order');
    1408       Changing := True;
    1409       SetControl(cboAvailTest,       'ORDERABLE', 1);
    1410       DetermineCollectionDefaults(Responses);
    1411       LoadUrgency(cboCollType.ItemID, cboUrgency);
    1412       SetControl(cboUrgency,         'URGENCY', 1);
    1413       Urgency := cboUrgency.ItemIEN;
    1414       if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    1415         begin
    1416           cboUrgency.ItemIndex := 0;
    1417           Urgency := cboUrgency.ItemIEN;
    1418         end;
    1419       tmpResp := FindResponseByName('SPECIMEN'  ,1);
    1420       i := 1 ;
    1421       tmpResp := Responses.FindResponseByName('COMMENT',i);
    1422       while tmpResp <> nil do
    1423         begin
    1424           Comment.Add(tmpResp.EValue);
    1425           Inc(i);
    1426           tmpResp := Responses.FindResponseByName('COMMENT',i);
    1427         end ;
    1428       end;  //  Quick Order}
    1429     {if ObtainCollSamp then
    1430       begin
    1431         // should not occur with Blood orders
    1432       end
    1433     else
    1434       begin
    1435         with ALabTest do
    1436           with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1437             begin
    1438               x := '' ;
    1439               for i := 0 to WardComment.Count-1 do
    1440                 x := x + WardComment.strings[i]+#13#10 ;
    1441               pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1442               OrderMessage(x) ;
    1443             end ;
    1444       end;
    1445      }
    1446     if ObtainComment then
    1447       LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
    1448     else
    1449       DisableCommentPanels;
    1450     x := '' ;
    1451     for i := 0 to CurWardComment.Count-1 do
    1452       x := x + CurWardComment.strings[i]+#13#10 ;
    1453     i :=  IndexOfCollSamp(CollSamp);
    1454     if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1455        for i := 0 to WardComment.Count-1 do
    1456          x := x + WardComment.strings[i]+#13#10 ;
    1457     pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;
    1458     OrderMessage(x) ;
    1459    end; { with }
    1460   StatusText('');
    1461   Changing := False;
    1462 end;
    1463 
    1464 procedure TfrmODBBank.DisableCommentPanels;
    1465 begin
    1466   lblReqComment.Visible := False;
    1467 end;
    1468 
    1469 procedure TfrmODBBank.DisableComponentControls;
    1470 begin
    1471   lblModifiers.Enabled := false;
    1472   cboModifiers.Enabled := false;
    1473   lblWanted.Enabled := false;
    1474   calWantTime.Enabled := false;
    1475   //lblPreparation.Enabled := false;
    1476   //cboPreparation.Enabled := false;
    1477   lblSurgery.Enabled := false;
    1478   cboSurgery.Enabled := false;
    1479   lblReason.Enabled := false;
    1480   tReason.Enabled := false;
    1481   chkConsent.Enabled := false;
    1482   lblQuantity.Enabled := false;
    1483   tQuantity.Enabled := false;
    1484   upQuantity.Enabled := false;
    1485   cboAvailComp.ItemIndex := -1;
    1486   tQuantity.Text := '0';
    1487 end;
    1488 
    1489 procedure TfrmODBBank.EnableComponentControls;
    1490 begin
    1491   lblModifiers.Enabled := true;
    1492   cboModifiers.Enabled := true;
    1493   lblWanted.Enabled := true;
    1494   calWantTime.Enabled := true;
    1495   //lblPreparation.Enabled := true;
    1496   //cboPreparation.Enabled := true;
    1497   if cboUrgency.Text = 'PRE-OP' then
    1498     begin
    1499       lblSurgery.Enabled := true;
    1500       cboSurgery.Enabled := true;
    1501     end;
    1502   lblReason.Enabled := true;
    1503   tReason.Enabled := true;
    1504   chkConsent.Enabled := true;
    1505   lblQuantity.Enabled := true;
    1506   tQuantity.Enabled := true;
    1507   upQuantity.Enabled := true;
    1508   txtDiagComment.Enabled := true;
    15092932  lblDiagComment.Enabled := true;
    15102933end;
    … …  
    15152938  calCollTime.Enabled := false;
    15162939  cboCollTime.Enabled := false;
    1517   cboAvailTest.ItemIndex := -1;
    15182940  lblCollType.Enabled := false;
    15192941  cboCollType.Enabled := false;
    15202942  cmdImmedColl.Enabled := false;
     2943  cboAvailTest.ItemIndex := -1;
     2944  cboAvailTest.InitLongList('');
    15212945end;
    15222946
    15232947procedure TfrmODBBank.EnableDiagTestControls;
    15242948begin
    1525   calWantTime.Enabled := true;
    1526   lblWanted.Enabled := true;
    15272949  lblCollTime.Enabled := true;
    15282950  calCollTime.Enabled := true;
    … …  
    15302952  lblCollType.Enabled := true;
    15312953  cboCollType.Enabled := true;
    1532   lblUrgency.Enabled := true;
    1533   cboUrgency.Enabled := true;
    1534   txtDiagComment.Enabled := true;
    1535   lblDiagComment.Enabled := true;
    15362954  cmdImmedColl.Enabled := true;
     2955  if not(changing) then
     2956    if not(uSelUrgency = 'PRE-OP') then
     2957      if uSelUrgency = '' then
     2958        if lvSelectionList.Items.Count < 1 then
     2959          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
    15372960end;
    15382961
    … …  
    15482971begin
    15492972  if ALabTest = nil then exit;
     2973  if ALabTest.LabSubscript = 'BB' then exit;
    15502974  calCollTime.Clear;
    15512975  cboCollTime.Clear;
    … …  
    16183042end;
    16193043
     3044procedure TfrmODBBank.cboAvailCompChange(Sender: TObject);
     3045begin
     3046  inherited;
     3047  changing := true;
     3048  changing := false;
     3049end;
     3050
    16203051procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
    16213052begin
    … …  
    16623093  inherited;
    16633094  case pgeProduct.TabIndex of
    1664   TI_ORDER :     begin
    1665                   memMessage.Visible := true;
     3095  TI_COMPONENT :     begin
    16663096                  memOrder.Visible := true;
    16673097                  cmdAccept.Visible := true;
    16683098                  pnlSelectedTests.Visible := true;
    1669                   pgeProduct.Height := 281;
     3099                  lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
    16703100                end;
    16713101  TI_INFO :     begin
    1672                   if lvSelectionList.Items.Count > 0 then exit;
    1673                   LRORDERMODE := TORDER_MODE_INFO;
    1674                   memMessage.Visible := false;
    1675                   memOrder.Visible := false;
    1676                   cmdAccept.Visible := false;
    1677                   pnlSelectedTests.Visible := false;
    1678                   pgeProduct.Height := 411;
     3102                  if lvSelectionList.Items.Count > 0 then
     3103                  begin
     3104                    memOrder.Visible := true;
     3105                    cmdAccept.Visible := true;
     3106                    pnlSelectedTests.Visible := true;
     3107                  end
     3108                  else
     3109                  begin
     3110                    memOrder.Visible := false;
     3111                    cmdAccept.Visible := false;
     3112                    pnlSelectedTests.Visible := false;
     3113                  end;
    16793114                end;
    16803115  TI_RESULTS :  begin
    1681                   if lvSelectionList.Items.Count > 0 then exit;
    1682                   memMessage.Visible := false;
    1683                   memOrder.Visible := false;
    1684                   cmdAccept.Visible := false;
    1685                   pnlSelectedTests.Visible := false;
    1686                   pgeProduct.Height := 411;
     3116                  if lvSelectionList.Items.Count > 0 then
     3117                  begin
     3118                    memOrder.Visible := true;
     3119                    cmdAccept.Visible := true;
     3120                    pnlSelectedTests.Visible := true;
     3121                  end
     3122                  else
     3123                  begin
     3124                    memOrder.Visible := false;
     3125                    cmdAccept.Visible := false;
     3126                    pnlSelectedTests.Visible := false;
     3127                  end;
    16873128                end;
    16883129  end; {case}
    16893130end;
    16903131
    1691 procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
    1692 begin
    1693   if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
    1694   if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
    1695     begin
    1696       InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
    1697       cboCollType.ItemIndex := -1;
    1698       Exit;
    1699     end;
    1700   SetupCollTimes(cboCollType.ItemID);
    1701 end;
    1702 
    1703 procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
     3132procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
    17043133var
    1705   i: integer;
    1706 begin
    1707   with AComboBox do
    1708     begin
    1709       Clear;
    1710       for i := 0 to uModifierList.Count - 1 do
    1711            Items.Add(uModifierList[i]);
    1712     end;
    1713 end;
    1714 
    1715 procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
    1716 var
    1717   i: integer;
    1718 begin
    1719   with AComboBox do
    1720     begin
    1721       Clear;
    1722       for i := 0 to uUrgencyList.Count - 1 do
    1723          if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
    1724            Continue
    1725          else
    1726            Items.Add(uUrgencyList[i]);
    1727     end;
    1728 end;
    1729 
    1730 procedure TfrmODBBank.btnAddTestsClick(Sender: TObject);
    1731 var
    1732   aList, aTests, aRaw: TStringList;
    1733   ListItem: TListItem;
    1734   aStr, aMsg: String;                  //add independent structures for components, Tests, and associated fields.
    1735   aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String;
    1736   CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer;
    1737   x, name, aTypeScreen: String;
    1738 begin
    1739   if not ValidAdd then Exit;
    1740   aList := TStringList.Create;
    1741   aTests := TStringList.Create;
    1742   aRaw := TStringList.Create;
    1743   try
    1744     aCollType := '';
    1745     aModifier := '';
    1746     aPreparation := '';
    1747     aSurgery := '';
    1748     aCollTime := '';
    1749     aTestYes := '0';
    1750     aTypeScreen := '';
    1751     uGetTnS := 0;
    1752     aSpecimen := '';
    1753     ExtractTypeScreen(aList, uVBECList);
    1754     if aList.Count > 0 then aTypeScreen := aList[0];
    1755     aList.Clear;
    1756     ExtractSpecimen(aList, uVBECList);
    1757     if aList.Count > 0 then aSpecimen := aList[0];
    1758     if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1';
    1759     if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    1760     //if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex];
    1761     if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
    1762     if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    1763     if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then
    1764       begin
    1765         uTestSelected := true;
    1766         with lvSelectionList do
    1767           begin
    1768             ListItem := Items.Add;
    1769             ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
    1770             ListItem.SubItems.Add('');
    1771             if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
    1772               else ListItem.SubItems.Add('');
    1773             ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
    1774             if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
    1775               begin
    1776                 lblTNS.Caption := '';
    1777                 lblTNS.Visible := false;
    1778               end;
    1779           end;
    1780         lblCollTime.Enabled := false;
    1781         calCollTime.Enabled := false;
    1782         cboCollTime.Enabled := false;
    1783         lblCollType.Enabled := false;
    1784         cboCollType.Enabled := false;
    1785         cboAvailTest.ItemIndex := -1;
    1786       end;
    1787     if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then
    1788       begin
    1789         if Length(cboSurgery.ItemID) > 0 then
    1790           begin
    1791             aList.Clear;
    1792             ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
    1793             for i := 0 to aList.Count - 1 do
    1794               begin
    1795                 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    1796                  and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then
    1797                   begin
    1798                     aMSBOS := StrToInt(piece(aList[i],'^',4));
    1799                     if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
    1800                       begin
    1801                         with Application do
    1802                         begin
    1803                           NormalizeTopMosts;
    1804                           aMSBOSContinue :=
    1805                             MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
    1806                                        ') exceeds the maximum number of units (' + IntToStr(aMSBOS) +
    1807                                        ') for the ' + cboSurgery.text +
    1808                                        ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
    1809                                        PChar('Maximum Number of Units Exceeded'),
    1810                                        MB_YESNO);
    1811                           RestoreTopMosts;
    1812                         end;
    1813                         if aMSBOSContinue = 7 then
    1814                           begin
    1815                             ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.');
    1816                             exit;
    1817                           end;
    1818                       end;
    1819                   end;
    1820               end;
    1821           end;
    1822         if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
    1823           begin
    1824             uGetTnS := 1;
    1825             for i := 0 to lvSelectionList.Items.Count - 1 do
    1826               begin
    1827                 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
    1828                   begin
    1829                     uGetTnS := 0;
    1830                     uDfltUrgency := cboUrgency.ItemID;
    1831                     lblTNS.Caption := '';
    1832                     lblTNS.Visible := false;
    1833                     break;
    1834                   end;
    1835               end;
    1836           end;
    1837         aList.Clear;
    1838         ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
    1839         for i := 0 to aList.Count - 1 do
    1840           begin
    1841             if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
    1842               begin
    1843                 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
    1844                 break;
    1845               end;
    1846           end;
    1847         uComponentSelected := true;
    1848         with lvSelectionList do
    1849           begin
    1850             ListItem := Items.Add;
    1851             ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
    1852             ListItem.SubItems.Add(tQuantity.Text);
    1853             if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
    1854               else ListItem.SubItems.Add('');
    1855             ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
    1856           end;
    1857         lblWanted.Enabled := false;
    1858         calWantTime.Enabled := false;
    1859         //lblPreparation.Enabled := false;
    1860         //cboPreparation.Enabled := false;
    1861         lblSurgery.Enabled := false;
    1862         cboSurgery.Enabled := false;
    1863         lblReason.Enabled := false;
    1864         tReason.Enabled := false;
    1865         chkConsent.Enabled := false;
    1866         cboAvailComp.ItemIndex := -1;
    1867       end;
    1868     if Sender <> Self then
    1869       Responses.Clear;       // Sender=Self when called from SELF
    1870     CurAdd := 1;
    1871     aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen;  //aSpecimen has 2 pieces
    1872     uSelectedItems.Add(aStr);
    1873     for i := 0 to uSelectedItems.Count - 1 do
    1874       begin
    1875         name := lvSelectionList.Items[i].Caption;
    1876         x := uSelectedItems[i];
    1877         if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
    1878           begin
    1879             if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    1880           end
    1881         else
    1882           begin
    1883             if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    1884             if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
    1885             if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
    1886             if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
    1887             if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    1888           end;
    1889         Inc(CurAdd);
    1890         aList.Clear;
    1891         TestAdded := 0;
    1892         getTest := 0;
    1893         ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
    1894         for j := 0 to aList.Count - 1 do
    1895           begin
    1896             if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
    1897               begin
    1898                 if uTestsForResults.Count < 1 then getTest := 1;
    1899                 for k := 0 to uTestsForResults.Count - 1 do
    1900                   begin
    1901                     if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
    1902                       begin
    1903                         getTest := 0;
    1904                         break;
    1905                       end
    1906                     else getTest := 1;
    1907                   end;
    1908                 if getTest = 1 then
    1909                   begin
    1910                     uTestsForResults.Add(piece(aList[j],'^',3));
    1911                     TestAdded := 1;
    1912                   end;
    1913               end;
    1914           end;
    1915         if TestAdded = 1 then
    1916           begin
    1917             edtResults.Clear;
    1918             aTests.Clear;
    1919             GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
    1920             QuickCopy(ATests,edtResults);
    1921             if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1;
    1922             uRaw.Clear;
    1923             GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
    1924           end;
    1925       end;
    1926     if LRORDERMODE = TORDER_MODE_DIAG then
    1927       begin
    1928         if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    1929         with cboCollType do if Length(ItemID) > 0 then
    1930           begin
    1931             Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    1932             FLastCollType := ItemID;
    1933           end;
    1934         if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    1935         if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    1936         if cboCollType.ItemID = 'LC' then
    1937           begin
    1938             with cboCollTime do
    1939               if Length(ItemID) > 0 then
    1940                 begin
    1941                   Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
    1942                   FLastLabCollTime := ItemID + U + Text;
    1943                 end
    1944               else if Length(Text) > 0 then
    1945                 begin
    1946                   Responses.Update('START', 1, ValidCollTime(Text), Text) ;
    1947                   FLastLabCollTime := ValidCollTime(Text);
    1948                 end;
    1949           end
    1950         else
    1951           begin
    1952             with calCollTime do
    1953               if FMDateTime > 0 then
    1954                 begin
    1955                   Responses.Update('START', 1, ValidCollTime(Text), Text);
    1956                   FLastColltime := ValidCollTime(Text);
    1957                 end
    1958               else
    1959                 begin
    1960                   Responses.Update('START', 1, '', '') ;
    1961                   FLastCollTime := '';
    1962                 end;
    1963           end;
    1964       end;
    1965     if LRORDERMODE = TORDER_MODE_COMP then
    1966       begin
    1967         if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    1968         if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    1969         if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    1970         //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    1971         if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    1972         if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
    1973         if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
    1974       end;
    1975     memOrder.Text := Responses.OrderText;
    1976     CurAdd := 1;
    1977     if uRaw.Count > 0 then
    1978       for j := 0 to uRaw.Count - 1 do
     3134  CollType: string;
     3135const
     3136  TX_BAD_TIME         = ' is not a routine lab collection time.' ;
     3137  TX_BAD_TIME_CAP     = 'Invalid Time';
     3138begin
     3139  CollType := 'LC';
     3140  with cboCollTime do
     3141    begin
     3142      if ItemID = 'LO' then
    19793143        begin
    1980           if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
    1981           Inc(CurAdd);
     3144          ItemIndex := -1;
     3145          Text := GetFutureLabTime(FMToday);
    19823146        end;
    1983     tQuantity.Text := '0';
    1984     ALabTest := nil;
    1985   finally
    1986     aList.Free;
    1987     aTests.Free;
    1988     aRaw.Free;
    1989   end;
    1990   aMsg := '';
    1991   if UgetTnS = 1 then
    1992     begin
    1993       lblTNS.Caption := 'TYPE + SCREEN must be added to order';
    1994       lblTNS.Visible := true;
    1995       cboAvailTest.SelectByID(aTypeScreen);
    1996       cboAvailTestSelect(self);
    1997     end;
    1998   {if getTnS = 1 then
    1999     begin
    2000       for i := 1 to cboAvailTest.Items.Count - 1 do
    2001         begin
    2002           if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
    2003             begin
    2004               if piece(aSpecimen,'^',1) = '1' then
    2005                 begin
    2006                   cboCollTime.Text := calWantTime.Text;
    2007                   aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
    2008                   cboCollTime.Text := '';
    2009                   cboCollType.Text := '';
    2010                   uSpecimen := 1;
    2011                 end;
    2012               cboModifiers.Text := '';
    2013               cboAvailTest.SelectByID(aTypeScreen);
    2014               cboAvailTestSelect(Self);
    2015               btnAddTestsClick(Self);
    2016               uSpecimen := 0;
    2017               cboCollTime.Text := piece(aCollSave,'^',1);
    2018               cboCollType.Text := piece(aCollSave,'^',3);
    2019               aCollSave := '';
    2020               break;
    2021             end;
    2022         end;
    2023       aMsg := 'An order for Type and Screen has been added to this request' + '.';
    2024     end;
    2025   if (getTns = 1) then
    2026     begin
    2027       if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
    2028       ShowMessage(aMsg);
    2029     end;}
    2030   cboModifiers.Text := '';
    2031   edtResults.Height := 247;
    2032   edtInfo.Height := 247;
    2033 end;
    2034 
    2035 procedure TfrmODBBank.FormDestroy(Sender: TObject);
    2036 begin
    2037   inherited;
    2038   uSelectedItems.Free;
    2039   uVBECList.Free;
    2040   uTestsForResults.Free;
    2041   uUrgencyList.Free;
    2042   uModifierList.Free;
    2043   uRaw.Free;
    2044 end;
    2045 
    2046 procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
    2047 var
    2048   i,j,curAdd: integer;
    2049   x, name, aModifier, aTypeScreen: string;
    2050   aList: TStringList;
    2051 begin
    2052   inherited;
    2053   aList := TStringList.Create;
    2054   curAdd := 1;
    2055   aModifier := '';
    2056   aTypeScreen := '';
    2057   ExtractTypeScreen(aList, uVBECList);
    2058   if aList.Count > 0 then aTypeScreen := aList[0];
    2059   aList.Clear;
    2060   if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    2061   with lvSelectionList do
    2062     begin
    2063       for i := lvSelectionList.Items.Count - 1 downto 0 do
    2064         begin
    2065           if lvSelectionList.Items[i].Selected = true then
    2066             for j := uSelectedItems.Count - 1 downto 0 do
    2067             if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then
    2068               begin
    2069                 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
    2070                   begin
    2071                     uGetTnS := 1;
    2072                     lblTNS.Caption := 'TYPE+SCREEN must be added to order';
    2073                     lblTNS.Visible := true;
    2074                   end;
    2075                 uSelectedItems.Delete(j);
    2076                 lvSelectionList.Items[i].Delete;
    2077                 break;
    2078               end;
    2079         end;
    2080     end;
    2081   Responses.Clear;
    2082   for i := 0 to uSelectedItems.Count - 1 do
    2083     begin
    2084       name := lvSelectionList.Items[i].Caption;
    2085       x := uSelectedItems[i];
    2086       if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
    2087         begin
    2088           if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    2089         end
    2090       else
    2091         begin
    2092           if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    2093           if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
    2094           if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
    2095           if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
    2096         end;
    2097       Inc(CurAdd);
    2098     end;
    2099   if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    2100   if cboCollType.ItemID = 'LC' then
     3147    end;
     3148  cboCollType.SelectByID(CollType);
     3149  if uSelectedItems.Count > 0 then
    21013150    begin
    21023151      with cboCollTime do
    … …  
    21113160            FLastLabCollTime := ValidCollTime(Text);
    21123161          end;
     3162    end;
     3163end;
     3164
     3165procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
     3166begin
     3167  if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
     3168  if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
     3169    begin
     3170      InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
     3171      cboCollType.ItemIndex := -1;
     3172      Exit;
     3173    end;
     3174  if cboCollType.ItemID = 'I' then
     3175  begin
     3176    cboCollTime.ItemIndex := -1;
     3177    cboCollTime.Text := 'NOW';
     3178    calCollTime.Text := 'NOW';
     3179  end;
     3180  SetupCollTimes(cboCollType.ItemID);
     3181  if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
     3182  FLastCollType := cboCollType.ItemID;
     3183  calCollTimeChange(self);
     3184end;
     3185
     3186procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
     3187var
     3188  i: integer;
     3189  ListItem: TListItem;
     3190  x,q,m: string;
     3191begin
     3192  inherited;
     3193  if changing = true then Exit;
     3194  if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
     3195    begin
     3196      for i := 0 to lvSelectionList.Items.Count - 1 do
     3197        begin
     3198          x := uSelectedItems[i];
     3199          m := piece(x,'^',4);
     3200          q := piece(x,'^',3);
     3201          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
     3202            begin
     3203              ListItem := lvSelectionList.Items[i];
     3204              ListItem.SubItems.Clear;
     3205              ListItem.SubItems.Add(q);
     3206              if length(cboModifiers.ItemID) > 0 then
     3207                begin
     3208                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     3209                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     3210                end
     3211                else
     3212                  begin
     3213                    ListItem.SubItems.Add('');
     3214                    ListItem.SubItems.Add('');
     3215                  end;
     3216              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     3217              Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
     3218              Break;
     3219            end;
     3220        end;
     3221    end;
     3222  if Length(cboModifiers.Text) > 0 then
     3223    begin
     3224      memOrder.Text := Responses.OrderText;
     3225    end;
     3226end;
     3227
     3228procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
     3229var
     3230  i: integer;
     3231begin
     3232  with AComboBox do
     3233    begin
     3234      Clear;
     3235      for i := 0 to uModifierList.Count - 1 do
     3236           Items.Add(uModifierList[i]);
     3237    end;
     3238end;
     3239
     3240procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
     3241var
     3242  i: integer;
     3243begin
     3244  with AComboBox do
     3245    begin
     3246      Clear;
     3247      for i := 0 to uReasonsList.Count - 1 do
     3248           Items.Add(uReasonsList[i]);
     3249    end;
     3250end;
     3251
     3252procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
     3253var
     3254  i: integer;
     3255begin
     3256  with AComboBox do
     3257    begin
     3258      Clear;
     3259      for i := 0 to uUrgencyList.Count - 1 do
     3260         if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
     3261           Continue
     3262         else
     3263           Items.Add(uUrgencyList[i]);
     3264    end;
     3265end;
     3266
     3267procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
     3268var
     3269  ListItem: TListItem;
     3270  x,y: string;
     3271  i,j: integer;
     3272begin
     3273  inherited;
     3274  if lvSelectionList.Selected = nil then Exit;
     3275  ListItem := lvSelectionList.Selected;
     3276  changing := true;
     3277  tQuantity.Text := '';
     3278  cboModifiers.ItemIndex := -1;
     3279  i := lvSelectionList.ItemIndex;
     3280  j := 0;
     3281  if cboCollType.ItemID = 'LC' then
     3282    begin
     3283      if FLastLabCollTime <> '' then
     3284        cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
    21133285    end
    21143286  else
    21153287    begin
    2116       with calCollTime do
    2117         if FMDateTime > 0 then
     3288      if FLastCollTime = 'TODAY' then
     3289        calCollTime.Text := FLastCollTime
     3290      else if FLastCollTime = 'NOW' then
     3291        calCollTime.Text := FLastCollTime
     3292      else if FLastCollTime <> '' then
     3293        calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
     3294    end;
     3295  if FLastCollType <> '' then
     3296    cboCollType.SelectByID(FLastCollType);
     3297  if uSelectedItems.Count > 0 then
     3298    begin
     3299      x := uSelectedItems[i];
     3300      ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses);
     3301      if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2));
     3302      if not(piece(x,'^',1) = '1') and (j > 0) then //Components
     3303        begin
     3304          DisableDiagTestControls;
     3305          EnableComponentControls;
     3306          y := ListItem.SubItems[2];
     3307          changing := true;
     3308          cboModifiers.Text := '';
     3309          cboAvailComp.SelectByIEN(j);
     3310          tQuantity.Text := ListItem.SubItems[0];
     3311          changing := false;
     3312          if y <> '' then cboModifiers.ItemIndex := StrToInt(y);
     3313        end
     3314      else                            //Diagnostic Tests
     3315        begin
     3316          DisableComponentControls;
     3317          EnableDiagTestControls;
     3318          cboAvailTest.SelectByIEN(j);
     3319        end;
     3320    end;
     3321  changing := false;
     3322end;
     3323
     3324procedure TfrmODBBank.memDiagCommentChange(Sender: TObject);
     3325begin
     3326  inherited;
     3327  if (length(memDiagComment.Text) > 250) then
     3328    begin
     3329      ShowMsg('COMMENT cannot be longer than 250 characters');
     3330      memDiagComment.Text := Copy(memDiagComment.Text,0,250);
     3331      Exit;
     3332    end;
     3333  if lvSelectionList.Items.Count < 1 then Exit;
     3334
     3335  if uSelectedItems = nil then Exit;
     3336 
     3337  if uSelectedItems.Count > 0 then
     3338    Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3339  memOrder.Text := Responses.OrderText;
     3340end;
     3341
     3342procedure TfrmODBBank.FormDestroy(Sender: TObject);
     3343begin
     3344  inherited;
     3345  uSelectedItems.Free;
     3346  uVBECList.Free;
     3347  uTestsForResults.Free;
     3348  uUrgencyList.Free;
     3349  uTNSOrders.Free;
     3350  uModifierList.Free;
     3351  uReasonsList.Free;
     3352  uRaw.Free;
     3353end;
     3354
     3355procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
     3356var
     3357  i,j,curAdd: integer;
     3358  x, aName, aModifier, aReason, aTypeScreen: string;
     3359  aList: TStringList;
     3360  aSel, aSelTst : boolean;
     3361begin
     3362  inherited;
     3363  aList := TStringList.Create;
     3364  try
     3365    curAdd := 1;
     3366    aModifier := '';
     3367    aReason := '';
     3368    aTypeScreen := '';
     3369    aSel := false;
     3370    aSelTst := false;
     3371    ExtractTypeScreen(aList, uVBECList);
     3372    if aList.Count > 0 then aTypeScreen := aList[0];
     3373    aList.Clear;
     3374    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     3375    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     3376    if lvSelectionList.Items.Count < 1 then
     3377      begin
     3378        ShowMsg('There is nothing in the list to remove.');
     3379        exit;
     3380      end;
     3381    cboAvailComp.ItemIndex := -1;
     3382    tQuantity.Text := '';
     3383    cboAvailTest.ItemIndex := -1;
     3384    uGetTnS := 0;
     3385    lblTNS.Caption := '';
     3386    lblTNS.Visible := false;
     3387    memMessage.Text := '';
     3388    pnlMessage.Visible := false;
     3389    pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3390    with lvSelectionList do
     3391      begin
     3392        for i := lvSelectionList.Items.Count - 1 downto 0 do
    21183393          begin
    2119             Responses.Update('START', 1, ValidCollTime(Text), Text);
    2120             FLastColltime := ValidCollTime(Text);
     3394            if lvSelectionList.Items[i].Selected = true then
     3395              begin
     3396                aSel := true;
     3397                for j := uSelectedItems.Count - 1 downto 0 do
     3398                  if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
     3399                    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; }
     3410                      uSelectedItems.Delete(j);
     3411                      lvSelectionList.Items[i].Delete;
     3412                      break;
     3413                    end;
     3414              end;
     3415          end;
     3416      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
     3420          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*';
     3428            break;
     3429          end;
     3430      end;
     3431     
     3432    if (aSel = false) and (lvSelectionList.Items.Count > 0) then
     3433      begin
     3434        ShowMsg('Please select an item from the list to be removed.');
     3435        exit;
     3436      end;
     3437    Responses.Clear;
     3438    if lvSelectionList.Items.Count < 1 then
     3439      begin
     3440        cboReasons.ItemIndex := -1;
     3441        memDiagComment.Text := '';
     3442        cboSurgery.ItemIndex := -1;
     3443        cboUrgency.ItemIndex := -1;
     3444        cboCollType.ItemIndex := -1;
     3445        cboCollTime.ItemIndex := -1;
     3446        cboQuick.ItemIndex := -1;
     3447        calCollTime.Text := '';
     3448      end;
     3449    for i := 0 to uSelectedItems.Count - 1 do
     3450      begin
     3451        aName := lvSelectionList.Items[i].Caption;
     3452        x := uSelectedItems[i];
     3453        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     3454          begin
     3455            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     3456            aSelTst := true;
    21213457          end
    21223458        else
    21233459          begin
    2124             Responses.Update('START', 1, '', '') ;
    2125             FLastCollTime := '';
     3460            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     3461            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     3462            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
     3463            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     3464            cboModifiers.ItemIndex := -1;
     3465            cboAvailComp.ItemIndex := -1;
     3466            tQuantity.Text := '';
    21263467          end;
    2127     end;
    2128   with cboCollType do if Length(ItemID) > 0 then
    2129     begin
    2130       Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    2131       FLastCollType := ItemID;
    2132     end;
    2133   if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    2134   if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    2135   //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    2136   if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    2137   if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
    2138   if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
    2139   memOrder.Text := Responses.OrderText;
    2140   CurAdd := 1;
    2141   if uRaw.Count > 0 then
    2142     for j := 0 to uRaw.Count - 1 do
    2143       begin
    2144         if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
    21453468        Inc(CurAdd);
    21463469      end;
    2147   if uSelectedItems.Count < 1 then
    2148     begin
    2149       uGetTnS := 0;
    2150       lblTNS.Caption := '';
    2151       lblTNS.Visible := false;
    2152     end;
    2153   aList.Free;
     3470    if aSelTst = false then
     3471      begin
     3472        cboCollType.ItemIndex := -1;
     3473        cboCollTime.ItemIndex := -1;
     3474        calCollTime.Text := '';
     3475      end;
     3476    if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3477    if cboCollType.ItemID = 'LC' then
     3478      begin
     3479        with cboCollTime do
     3480          if Length(ItemID) > 0 then
     3481            begin
     3482              Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     3483              FLastLabCollTime := ItemID + U + Text;
     3484            end
     3485          else if Length(Text) > 0 then
     3486            begin
     3487              Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     3488              FLastLabCollTime := ValidCollTime(Text);
     3489            end;
     3490      end
     3491    else
     3492      begin
     3493        with calCollTime do
     3494          if FMDateTime > 0 then
     3495            begin
     3496              Responses.Update('START', 1, ValidCollTime(Text), Text);
     3497              FLastColltime := ValidCollTime(Text);
     3498            end
     3499          else
     3500            begin
     3501              Responses.Update('START', 1, '', '') ;
     3502              FLastCollTime := '';
     3503            end;
     3504      end;
     3505    with cboCollType do if Length(ItemID) > 0 then
     3506      begin
     3507        Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     3508        FLastCollType := ItemID;
     3509      end;
     3510    if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     3511    if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3512    if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3513    if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     3514    if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
     3515    memOrder.Text := Responses.OrderText;
     3516    CurAdd := 1;
     3517    if uRaw.Count > 0 then
     3518      for j := 0 to uRaw.Count - 1 do
     3519        begin
     3520          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     3521          Inc(CurAdd);
     3522        end;
     3523    if uSelectedItems.Count < 1 then
     3524      begin
     3525        uGetTnS := 0;
     3526        lblTNS.Caption := '';
     3527        lblTNS.Visible := false;
     3528        memMessage.Text := '';
     3529        pnlMessage.Visible := false;
     3530        GroupBox1.Visible := true;
     3531        pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3532      end;
     3533  finally
     3534    aList.Free;
     3535  end;
     3536end;
     3537
     3538procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
     3539begin
     3540  inherited;
     3541  pnlComments.Visible := false;
     3542  pnlComments.SendToBack;
     3543  Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3544  memOrder.Text := Responses.OrderText;
     3545end;
     3546
     3547procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
     3548begin
     3549  inherited;
     3550  pnlComments.Visible := false;
     3551  pnlComments.SendToBack;
    21543552end;
    21553553
    … …  
    21573555begin
    21583556  inherited;
     3557  if lvSelectionList.Items.Count < 1 then
     3558    begin
     3559      ShowMsg('There is nothing in the list to remove.');
     3560      exit;
     3561    end;
    21593562  lvSelectionList.Clear;
    21603563  uSelectedItems.Clear;
    … …  
    21643567  lblTNS.Caption := '';
    21653568  lblTNS.Visible := false;
     3569  memMessage.Text := '';
     3570  pnlMessage.Visible := false;
    21663571  InitDialog;
     3572  cboModifiers.ItemIndex := -1;
     3573  cboAvailTest.ItemIndex := -1;
     3574  cboAvailComp.ItemIndex := -1;
     3575  cboSurgery.ItemIndex := -1;
     3576  cboUrgency.ItemIndex := -1;
     3577  cboReasons.ItemIndex := -1;
     3578  cboCollType.ItemIndex := -1;
     3579  cboCollTime.ItemIndex := -1;
     3580  cboQuick.ItemIndex := -1;
     3581  calWantTime.Text := '';
     3582  memDiagComment.Text := '';
     3583  GroupBox1.Visible := true;
     3584  tQuantity.Text := '';
     3585  FLastCollType := '';
     3586  FLastCollTime := '';
     3587  FLastLabCollTime := '';
     3588  txtImmedColl.Text := '';
    21673589end;
    21683590
    … …  
    21753597  Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
    21763598begin
     3599  if not ValidAdd then Exit;
    21773600  if uGetTnS = 1 then
    21783601    begin
    … …  
    21913614    end;
    21923615  if Comp = true then
    2193     ShowMessage('The nursing blood administration order must be entered separately' + '.');
     3616    begin
     3617      if NursAdminSuppress = true then
     3618        ShowMsg('The nursing blood administration order must be entered separately' + '.');
     3619    end;
    21943620  inherited;
    21953621end;
    … …  
    21993625  inherited;
    22003626  if uSelectedItems.Count > 0 then
    2201     if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3627    begin
     3628      with calWantTime do if not Changing then
     3629        begin
     3630          if FMDateTime = 0 then
     3631            begin
     3632              ShowMsg('Invalid Date/Time entered');
     3633              Changing := true;
     3634              calWantTime.Text := '';
     3635              Changing := false;
     3636              Exit;
     3637            end
     3638          else
     3639            begin
     3640              // date/time was entered
     3641              if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then
     3642                begin
     3643                  ShowMsg('Date/Time Wanted must be a future Date/Time');
     3644                  Changing := true;
     3645                  calWantTime.Text := '';
     3646                  Changing := false;
     3647                  Exit;
     3648                end;
     3649            end;
     3650        end;
     3651      if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3652      memOrder.Text := Responses.OrderText;
     3653    end;
    22023654end;
    22033655
    … …  
    22073659  if uSelectedItems.Count > 0 then
    22083660    begin
    2209       if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes')
    2210       else Responses.Update('YN',1,'0','No');
     3661      if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
     3662      memOrder.Text := Responses.OrderText;
    22113663    end;
    22123664end;
    … …  
    22183670    begin
    22193671      Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     3672      uSelUrgency := cboUrgency.Text;
    22203673      if cboUrgency.Text = 'PRE-OP' then
    22213674        begin
    22223675          lblSurgery.Enabled := true;
    22233676          cboSurgery.Enabled := true;
     3677          lblSurgery.Caption := 'Surgery*';
    22243678        end
    22253679      else
    … …  
    22273681          lblSurgery.Enabled := false;
    22283682          cboSurgery.Enabled := false;
    2229           cboSurgery.Text := '';
    2230           if uSelectedItems.Count > 0 then
    2231             Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3683          lblSurgery.Caption := 'Surgery';
     3684          cboSurgery.ItemIndex := -1;
     3685          Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    22323686        end;
    2233     end;
    2234 end;
    2235 
    2236 procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject);
     3687    end
     3688  else
     3689    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     3690  memOrder.Text := Responses.OrderText;
     3691end;
     3692
     3693procedure TfrmODBBank.cboUrgencyExit(Sender: TObject);
    22373694begin
    22383695  inherited;
    2239   if uSelectedItems.Count > 0 then
    2240     Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    2241 end;
    2242 
    2243 procedure TfrmODBBank.cboPreparationChange(Sender: TObject);
     3696  if Length(cboUrgency.Text) < 1 then
     3697    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     3698end;
     3699
     3700procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
     3701var
     3702  aList: TStringList;
     3703  i,j,aMSBOS,aMSBOSContinue: integer;
     3704  x: string;
     3705  handled: boolean;
    22443706begin
    22453707  inherited;
    2246   Exit;  // disable Preparation, since it is no longer needed by VBECS
    2247   if uSelectedItems.Count > 0 then
    2248     if Length(cboPreparation.Text) > 0 then
    2249       Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    2250 end;
    2251 
    2252 procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
     3708  aList := TStringList.Create;
     3709  handled := false;
     3710  try
     3711    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     3712      begin
     3713        aList.Clear;
     3714        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     3715        for i := 0 to aList.Count - 1 do
     3716          begin
     3717            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3718             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3719              begin
     3720                aMSBOS := StrToInt(piece(aList[i],'^',4));
     3721                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     3722                  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;
     3744                  end;
     3745                handled := true;
     3746                break;
     3747              end;
     3748          end;
     3749      end;
     3750    if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then
     3751      begin
     3752        aList.Clear;
     3753        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     3754        for j := 0 to uSelectedItems.Count - 1 do
     3755          begin
     3756            ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     3757            for i := 0 to aList.Count - 1 do
     3758              begin
     3759                if (piece(uSelectedItems[j],'^',1) = '0')
     3760                 and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3761                 and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3762                  begin
     3763                    aMSBOS := StrToInt(piece(aList[i],'^',4));
     3764                    if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
     3765                      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;
     3792                      end;
     3793                    break;
     3794                  end;
     3795              end;
     3796          end;
     3797      end;
     3798    if uSelectedItems.Count > 0 then
     3799      if Length(cboSurgery.Text) > 0 then
     3800        Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3801    uSelSurgery := 0;
     3802    if Length(cboSurgery.Text) > 0 then
     3803      begin
     3804        if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID;
     3805        cboReasons.Text := cboSurgery.Text;
     3806        Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     3807      end;
     3808    memOrder.Text := Responses.OrderText;
     3809    finally
     3810      aList.Free;
     3811    end;
     3812end;
     3813
     3814procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
    22533815begin
    22543816  inherited;
    2255   if uSelectedItems.Count > 0 then
    2256     if Length(cboSurgery.Text) > 0 then
    2257       Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    2258 end;
    2259 
    2260 procedure TfrmODBBank.tReasonChange(Sender: TObject);
     3817  if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
     3818end;
     3819
     3820procedure TfrmODBBank.tQuantityChange(Sender: TObject);
     3821var
     3822  aList: TStringList;
     3823  i,aMSBOS,aMSBOSContinue: integer;
     3824  ListItem: TListItem;
     3825  x,m: string;
    22613826begin
    22623827  inherited;
    2263   if uSelectedItems.Count > 0 then
    2264     if Length(tReason.Text) > 0 then
    2265       Responses.Update('REASON',1,tReason.Text,tReason.Text);
     3828  if changing = true then Exit;
     3829  aList := TStringList.Create;
     3830  if Length(tQuantity.Text) > 0 then
     3831    begin
     3832      if Length(tQuantity.Text) > 2 then
     3833        begin
     3834          ShowMsg('Invalid entry. Please select a numeric value <100');
     3835          tQuantity.Text := '';
     3836          Exit;
     3837        end;
     3838      if StrToInt(tQuantity.Text) > 100 then
     3839        begin
     3840          ShowMsg('Quantity too high. Please select a value <100');
     3841          tQuantity.Text := Copy(tQuantity.Text,0,1);
     3842          Exit;
     3843        end;
     3844    end;
     3845  try
     3846    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     3847      begin
     3848        aList.Clear;
     3849        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgery
     3850        for i := 0 to aList.Count - 1 do
     3851          begin
     3852            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3853             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3854              begin
     3855                aMSBOS := StrToInt(piece(aList[i],'^',4));
     3856                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     3857                  begin
     3858                    with Application do
     3859                    begin
     3860                      NormalizeTopMosts;
     3861                      aMSBOSContinue :=
     3862                        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);
     3869                      RestoreTopMosts;
     3870                    end;
     3871                    if aMSBOSContinue = 7 then
     3872                      begin
     3873                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
     3874                        tQuantity.Text := '0';
     3875                        tQuantity.SelLength := 2;
     3876                        tQuantity.SelectAll;
     3877                        break;
     3878                      end;
     3879                  end;
     3880                break;
     3881              end;
     3882          end;
     3883      end;
     3884    if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
     3885      for i := 0 to lvSelectionList.Items.Count - 1 do
     3886        begin
     3887          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
     3888            begin
     3889              x := uSelectedItems[i];
     3890              m := piece(x,'^',4);
     3891              ListItem := lvSelectionList.Items[i];
     3892              ListItem.SubItems.Clear;
     3893              ListItem.SubItems.Add(tQuantity.Text);
     3894              SetPiece(x,U,3,tQuantity.Text);
     3895              Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
     3896              uSelectedItems[i] := x;
     3897              if length(cboModifiers.ItemID) > 0 then
     3898                begin
     3899                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     3900                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     3901                end
     3902                else
     3903                  begin
     3904                    ListItem.SubItems.Add('');
     3905                    ListItem.SubItems.Add('');
     3906                  end;
     3907
     3908              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     3909              Break;
     3910            end;
     3911        end;
     3912    if Length(tQuantity.Text) > 0 then
     3913      begin
     3914        memOrder.Text := Responses.OrderText;
     3915      end;
     3916  finally
     3917    aList.Free;
     3918  end;
     3919end;
     3920
     3921procedure TfrmODBBank.tQuantityClick(Sender: TObject);
     3922begin
     3923  inherited;
     3924  tQuantity.SelLength := 2;
     3925  tQuantity.SelectAll;
     3926end;
     3927
     3928procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
     3929begin
     3930  inherited;
     3931  tQuantity.SelLength := 2;
     3932  tQuantity.SelectAll;
    22663933end;
    22673934
    … …  
    22993966              end;
    23003967        end;
     3968      memOrder.Text := Responses.OrderText;
    23013969    end;
    23023970end;

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

    r456 r829  
    99  VertScrollBar.Range = 225
    1010  VertScrollBar.Visible = True
    11   AutoScroll = False
    1211  BorderIcons = [biSystemMenu]
    1312  Caption = ''
    1413  FormStyle = fsStayOnTop
    15   KeyPreview = True
    1614  OnClose = FormClose
    1715  OnCloseQuery = FormCloseQuery
    1816  OnCreate = FormCreate
    1917  OnKeyPress = FormKeyPress
     18  ExplicitWidth = 528
     19  ExplicitHeight = 275
    2020  PixelsPerInch = 96
    2121  TextHeight = 13
    22   object memOrder: TCaptionMemo
     22  object memOrder: TCaptionMemo [0]
    2323    Left = 6
    2424    Top = 194
    … …  
    3434    Caption = 'Order'
    3535  end
    36   object cmdAccept: TButton
     36  object cmdAccept: TButton [1]
    3737    Left = 442
    3838    Top = 194
    … …  
    4343    OnClick = cmdAcceptClick
    4444  end
    45   object cmdQuit: TButton
     45  object cmdQuit: TButton [2]
    4646    Left = 442
    4747    Top = 221
    … …  
    5353    OnClick = cmdQuitClick
    5454  end
    55   object pnlMessage: TPanel
     55  object pnlMessage: TPanel [3]
    5656    Left = 24
    5757    Top = 176
    … …  
    9292    end
    9393  end
     94  inherited amgrMain: TVA508AccessibilityManager
     95    Data = (
     96      (
     97        'Component = memOrder'
     98        'Status = stsDefault')
     99      (
     100        'Component = cmdAccept'
     101        'Status = stsDefault')
     102      (
     103        'Component = cmdQuit'
     104        'Status = stsDefault')
     105      (
     106        'Component = pnlMessage'
     107        'Status = stsDefault')
     108      (
     109        'Component = memMessage'
     110        'Status = stsDefault')
     111      (
     112        'Component = frmODBase'
     113        'Status = stsDefault'))
     114  end
    94115end

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

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls,
    99  ORCtrls, ORFn, uConst, rOrders, rODBase, uCore, ComCtrls, ExtCtrls, Menus, Mask,
    10   Buttons, UBAGlobals, UBACore;
     10  Buttons, UBAGlobals, UBACore, VA508AccessibilityManager;
    1111
    1212type
    … …  
    182182    procedure SetDialogIEN(Value: Integer); virtual;
    183183    procedure Validate(var AnErrMsg: string); virtual;
     184    procedure updateSig; virtual;
    184185    function ValidSave: Boolean;
    185186    procedure ShowOrderMessage(Show: boolean);
    … …  
    221222
    222223var
    223   frmODBase: TfrmODBase;
     224  frmODBase: TfrmODBase = nil;
    224225  XfInToOutNow :boolean = False;       // it's used only for transfering Inpatient Meds to OutPatient Med for
    225226                                       // immediately release (NO EVENT DELAY)
    … …  
    246247uses fOCAccept, uODBase, rCore, rMisc, fODMessage,
    247248  fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders,
    248   fFrame, uTemplateFields, fClinicWardMeds;
     249  fFrame, uTemplateFields, fClinicWardMeds, fODDietLT, rODDiet, VAUtils;
    249250
    250251const
    … …  
    425426  else if AControl is TButton then with TButton(AControl) do Caption := CtrlInit.Text
    426427  else if AControl is TEdit then with TEdit(AControl) do Text := CtrlInit.Text
    427   else if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)
    428   else if AControl is TRichEdit then with TRichEdit(AControl) do Lines.Assign(CtrlInit.List)
    429   else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)
    430   else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)
     428  else if AControl is TMemo then FastAssign(CtrlInit.List, TMemo(AControl).Lines)
     429  else if AControl is TRichEdit then QuickCopy(CtrlInit.List, TRichEdit(AControl))
     430  else if AControl is TORListBox then FastAssign(CtrlInit.List, TORListBox(AControl).Items)
     431  else if AControl is TListBox then FastAssign(CtrlInit.List, TListBox(AControl).Items)
    431432  else if AControl is TComboBox then with TComboBox(AControl) do
    432433  begin
    433     Items.Assign(CtrlInit.List);
     434    FastAssign(CtrlInit.List, TComboBox(AControl).Items);
    434435    Text := CtrlInit.Text;
    435436  end
    436437  else if AControl is TORComboBox then with TORComboBox(AControl) do
    437438  begin
    438     Items.Assign(CtrlInit.List);
     439    FastAssign(CtrlInit.List, TORComboBox(AControl).Items);
    439440    if LongList then InitLongList(Text) else Text := CtrlInit.Text;
    440441    SelectByID(CtrlInit.ListID);
    … …  
    450451  CtrlInit := FindInitByName(ASection);
    451452  if CtrlInit = nil then Exit;
    452   if      AControl is TMemo       then with TMemo(AControl)       do Lines.Assign(CtrlInit.List)
    453   else if AControl is TORListBox  then with TORListBox(AControl)  do Items.Assign(CtrlInit.List)
    454   else if AControl is TListBox    then with TListBox(AControl)    do Items.Assign(CtrlInit.List)
    455   else if AControl is TComboBox   then with TComboBox(AControl)   do Items.Assign(CtrlInit.List)
    456   else if AControl is TORComboBox then with TORComboBox(AControl) do Items.Assign(CtrlInit.List);
     453  if      AControl is TMemo       then FastAssign(CtrlInit.List, TMemo(AControl).Lines)
     454  else if AControl is TORListBox  then FastAssign(CtrlInit.List, TORListBox(AControl).Items)
     455  else if AControl is TListBox    then FastAssign(CtrlInit.List, TListBox(AControl).Items)
     456  else if AControl is TComboBox   then FastAssign(CtrlInit.List, TComboBox(AControl).Items)
     457  else if AControl is TORComboBox then FastAssign(CtrlInit.List, TORComboBox(AControl).Items);
    457458end;
    458459
    … …  
    10281029    //AGP Text orders are only treated as IMO if the order display group is a nursing display group
    10291030    if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
    1030        (((pos('OR GXTEXT WORD PROCESSING ORDE',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
     1031       (((pos('OR GXTEXT WORD PROCESSING ORDER',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
    10311032       ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or
    10321033       ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757
    … …  
    11441145        //  CheckBoilerplate4Fields(tmp, cptn)
    11451146        //else
    1146           ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo);
     1147
     1148        // CQ #11669 - changing an existing order shouldn't restart template - JM
     1149          if assigned(frmODBase) and (frmODBase.FOrderAction = ORDER_EDIT) then
     1150            CheckBoilerplate4Fields(tmp, cptn)
     1151          else
     1152            ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo);
    11471153      end
    11481154    else
    … …  
    13911397begin
    13921398  inherited;
    1393   memOrder.Color := ReadOnlyColor;
     1399  frmODBase   := Self;
    13941400  FAcceptOK   := False;
    13951401  FAutoAccept := False;
    … …  
    14201426  FEvtType   := OrderEventTypeOnCreate;
    14211427  FEvtName   := OrderEventNameOnCreate;
     1428  DefaultButton := cmdAccept;
    14221429end;
    14231430
    14241431procedure TfrmODBase.FormDestroy(Sender: TObject);
    14251432begin
     1433  frmODBase := nil;
    14261434  FCtrlInits.Free;
    14271435  FResponses.Free;
    … …  
    14781486  NewOrder: TOrder;
    14791487  CanSign, OrderAction: Integer;
     1488  IsDelayOrder: boolean;
    14801489  //thisSourceOrder: TOrder;
    14811490begin
    14821491  Result := True;
    14831492  Validate(ErrMsg);
     1493  IsDelayOrder := False;
    14841494  if Length(ErrMsg) > 0 then
    14851495  begin
    … …  
    15311541        else CanSign := CH_SIGN_NA;
    15321542      if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
    1533       Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign);
     1543      if NewOrder.EventPtr <> '' then IsDelayOrder := True;
     1544      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder);
    15341545
    15351546    UBAGlobals.TargetOrderID := NewOrder.ID;
    … …  
    15581569  theGrpName: string;
    15591570  alreadyClosed: boolean;
     1571  LateTrayFields: TLateTrayFields;
     1572  x, CxMsg: string;
    15601573begin
    15611574  FAcceptOK := False;
    … …  
    15711584    end;
    15721585  end;
     1586
     1587  // check for diet orders that will be auto-DCd because of start/stop overlaps
     1588  if Responses.Dialog = 'FHW1' then
     1589  begin
     1590    if (Self.EvtID <> 0) then
     1591    begin
     1592      CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept);
     1593      if CxMsg <> '' then
     1594      begin
     1595        if InfoBox(CxMsg + CRLF + CRLF +
     1596           'Have you done either of the above?', 'Possible delayed order conflict',
     1597           MB_ICONWARNING or MB_YESNO) = ID_NO
     1598           then exit;
     1599      end;
     1600    end
     1601    else if FAutoAccept then
     1602    begin
     1603      x := CurrentDietText;
     1604      CheckForAutoDCDietOrders(0, Self.DisplayGroup, x, CxMsg, nil);
     1605      if CxMsg <> '' then
     1606      begin
     1607        if InfoBox(CxMsg + CRLF +
     1608                  'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
     1609        begin
     1610          //AbortOrder := True;
     1611          FAcceptOK := FALSE;
     1612          //cmdQuitClick(Self);
     1613          exit;
     1614        end;
     1615      end;
     1616    end;
     1617  end;
     1618
    15731619  if ValidSave then
    15741620  begin
    … …  
    15811627        else
    15821628        begin
     1629          LateTrayFields.LateMeal := #0;
     1630          with Responses do
     1631            if FAutoAccept and ((Dialog = 'FHW1') or (Dialog = 'FHW OP MEAL') or (Dialog ='FHW SPECIAL MEAL')) then
     1632            begin
     1633              LateTrayCheck(Responses, Self.EvtID, not OrderForInpatient, LateTrayFields);
     1634            end;
    15831635          ClearDialogControls;    // to allow form to close without prompting to save order
     1636          with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient);
    15841637          Close;
    15851638          alreadyClosed := True;
    … …  
    16271680begin
    16281681  inherited;
     1682  FFromQuit := True;
    16291683  Close;
    16301684end;
    … …  
    16651719      exit;
    16661720    end;
     1721  if FFromQuit = False then updateSig;
    16671722  if Length(memOrder.Text) > 0 then
    16681723  begin
    … …  
    16811736      if not ValidSave then CanClose := False;
    16821737  if CanClose then InitDialog;
     1738end;
     1739
     1740procedure TfrmODBase.updateSig;
     1741begin
     1742
    16831743end;
    16841744
    … …  
    17851845        if Length(TempMSG)>0 then
    17861846        begin
    1787           ShowMessage(TempMSG);
     1847          ShowMsg(TempMSG);
    17881848          Result := False;
    17891849        end;

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

    r456 r829  
    1 object frmChangeEventDisp: TfrmChangeEventDisp
     1inherited frmChangeEventDisp: TfrmChangeEventDisp
    22  Left = 344
    33  Top = 230
    4   Width = 408
    5   Height = 444
    64  Caption = 'Change release event'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 417
     6  ClientWidth = 400
    137  OldCreateOrder = False
    148  Position = poDesktopCenter
     9  ExplicitWidth = 408
     10  ExplicitHeight = 444
    1511  PixelsPerInch = 96
    1612  TextHeight = 13
    17   object lblTop: TMemo
     13  object lblTop: TMemo [0]
    1814    Left = 0
    1915    Top = 0
    … …  
    2723    TabOrder = 2
    2824  end
    29   object pnlTop: TPanel
     25  object pnlTop: TPanel [1]
    3026    Left = 0
    3127    Top = 37
    … …  
    4036      Width = 394
    4137      Height = 333
     38      Style = lbOwnerDrawVariable
    4239      Align = alClient
    4340      ItemHeight = 13
    44       Style = lbOwnerDrawVariable
    4541      TabOrder = 0
    4642      OnDrawItem = lstCVOrdersDrawItem
    … …  
    4844    end
    4945  end
    50   object pnlBottom: TPanel
     46  object pnlBottom: TPanel [2]
    5147    Left = 0
    5248    Top = 376
    … …  
    5551    Align = alBottom
    5652    TabOrder = 1
     53    DesignSize = (
     54      400
     55      41)
    5756    object cmdOK: TButton
    5857      Left = 230
    … …  
    7675    end
    7776  end
     77  inherited amgrMain: TVA508AccessibilityManager
     78    Data = (
     79      (
     80        'Component = lblTop'
     81        'Status = stsDefault')
     82      (
     83        'Component = pnlTop'
     84        'Status = stsDefault')
     85      (
     86        'Component = lstCVOrders'
     87        'Status = stsDefault')
     88      (
     89        'Component = pnlBottom'
     90        'Status = stsDefault')
     91      (
     92        'Component = cmdOK'
     93        'Status = stsDefault')
     94      (
     95        'Component = cmdCancel'
     96        'Status = stsDefault')
     97      (
     98        'Component = frmChangeEventDisp'
     99        'Status = stsDefault'))
     100  end
    78101end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ExtCtrls, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ExtCtrls, ORCtrls, VA508AccessibilityManager;
    88
    99type
    … …  
    6464  begin
    6565    Canvas.FillRect(ARect);
    66     Canvas.Pen.Color := clSilver;
     66    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    6767    Canvas.MoveTo(0, ARect.Bottom - 1);
    6868    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);

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

    r456 r829  
    1 object frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew
     1inherited frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew
    22  Left = 240
    33  Top = 163
    4   Width = 537
    5   Height = 198
    64  Caption = 'Change Unreleased Renewed Order'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 171
     6  ClientWidth = 529
    137  OldCreateOrder = False
    148  OnCreate = FormCreate
     9  ExplicitWidth = 537
     10  ExplicitHeight = 198
    1511  PixelsPerInch = 96
    1612  TextHeight = 13
    17   object Panel2: TPanel
     13  object Panel2: TPanel [0]
    1814    Left = 0
    1915    Top = 57
    2016    Width = 529
    21     Height = 81
     17    Height = 82
    2218    Align = alClient
    2319    TabOrder = 0
     20    ExplicitHeight = 81
    2421    object lblRefill: TLabel
    2522      Left = 9
    … …  
    6360      SynonymChars = '<>'
    6461      TabOrder = 1
     62      CharsNeedMatch = 1
    6563    end
    6664  end
    67   object Panel3: TPanel
     65  object Panel3: TPanel [1]
    6866    Left = 0
    6967    Top = 57
    7068    Width = 529
    71     Height = 81
     69    Height = 82
    7270    Align = alClient
    7371    TabOrder = 3
     72    ExplicitHeight = 81
    7473    object Label1: TLabel
    7574      Left = 61
    … …  
    107106    end
    108107  end
    109   object memOrder: TCaptionMemo
     108  object memOrder: TCaptionMemo [2]
    110109    Left = 0
    111110    Top = 0
    … …  
    122121    TabOrder = 2
    123122  end
    124   object Panel1: TPanel
     123  object Panel1: TPanel [3]
    125124    Left = 0
    126     Top = 138
     125    Top = 139
    127126    Width = 529
    128127    Height = 32
    129128    Align = alBottom
    130129    TabOrder = 1
     130    ExplicitTop = 138
    131131    object btnOK: TButton
    132132      Left = 348
    … …  
    148148    end
    149149  end
     150  inherited amgrMain: TVA508AccessibilityManager
     151    Data = (
     152      (
     153        'Component = Panel2'
     154        'Status = stsDefault')
     155      (
     156        'Component = edtRefill'
     157        'Status = stsDefault')
     158      (
     159        'Component = cboPickup'
     160        'Status = stsDefault')
     161      (
     162        'Component = Panel3'
     163        'Status = stsDefault')
     164      (
     165        'Component = txtStart'
     166        'Status = stsDefault')
     167      (
     168        'Component = txtStop'
     169        'Status = stsDefault')
     170      (
     171        'Component = memOrder'
     172        'Status = stsDefault')
     173      (
     174        'Component = Panel1'
     175        'Status = stsDefault')
     176      (
     177        'Component = btnOK'
     178        'Status = stsDefault')
     179      (
     180        'Component = btnCancel'
     181        'Status = stsDefault')
     182      (
     183        'Component = frmODChangeUnreleasedRenew'
     184        'Status = stsDefault'))
     185  end
    150186end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders;
     7  Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    1 object frmODChild: TfrmODChild
     1inherited frmODChild: TfrmODChild
    22  Left = 433
    33  Top = 271
    4   Width = 512
    5   Height = 453
    64  Caption = 'Associated Complex Orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 426
     6  ClientWidth = 504
    137  OldCreateOrder = False
    148  Position = poMainFormCenter
    159  OnCreate = FormCreate
     10  ExplicitWidth = 512
     11  ExplicitHeight = 453
    1612  PixelsPerInch = 96
    1713  TextHeight = 13
    18   object lblWarning: TLabel
     14  object lblWarning: TLabel [0]
    1915    Left = 0
    2016    Top = 0
    … …  
    3026    WordWrap = True
    3127  end
    32   object Panel1: TPanel
     28  object Panel1: TPanel [1]
    3329    Left = 0
    3430    Top = 59
    3531    Width = 504
    36     Height = 325
     32    Height = 326
    3733    Align = alClient
    3834    BevelOuter = bvNone
    … …  
    4440      Top = 3
    4541      Width = 494
    46       Height = 315
     42      Height = 316
    4743      Style = lbOwnerDrawVariable
    4844      Align = alClient
    … …  
    5349    end
    5450  end
    55   object Panel2: TPanel
     51  object Panel2: TPanel [2]
    5652    Left = 0
    57     Top = 384
     53    Top = 385
    5854    Width = 504
    5955    Height = 41
    … …  
    8480    end
    8581  end
     82  inherited amgrMain: TVA508AccessibilityManager
     83    Data = (
     84      (
     85        'Component = Panel1'
     86        'Status = stsDefault')
     87      (
     88        'Component = lstODComplex'
     89        'Status = stsDefault')
     90      (
     91        'Component = Panel2'
     92        'Status = stsDefault')
     93      (
     94        'Component = btnOK'
     95        'Status = stsDefault')
     96      (
     97        'Component = btnCancel'
     98        'Status = stsDefault')
     99      (
     100        'Component = frmODChild'
     101        'Status = stsDefault'))
     102  end
    86103end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, StdCtrls, fAutoSZ, ORFn;
     7  ExtCtrls, StdCtrls, fAutoSZ, ORFn, VA508AccessibilityManager;
    88
    99type
    … …  
    8383    ARect.Left := ARect.Left + 2;
    8484    Canvas.FillRect(ARect);
    85     Canvas.Pen.Color := clSilver;
     85    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    8686    SaveColor := Canvas.Brush.Color;
    8787    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

    r456 r829  
    55  Height = 291
    66  Caption = 'Diet Order'
    7   OnKeyDown = FormKeyDown
     7  ExplicitWidth = 532
     8  ExplicitHeight = 291
    89  PixelsPerInch = 96
    910  TextHeight = 13
    … …  
    1516    ActivePage = pgeOutPt
    1617    Align = alTop
    17     TabIndex = 1
    1818    TabOrder = 4
    1919    TabStop = False
    … …  
    998998  inherited memOrder: TCaptionMemo
    999999    Top = 208
     1000    ExplicitTop = 208
    10001001  end
    10011002  inherited cmdAccept: TButton
    … …  
    10031004    Top = 208
    10041005    TabOrder = 2
     1006    ExplicitLeft = 445
     1007    ExplicitTop = 208
    10051008  end
    10061009  inherited cmdQuit: TButton
    … …  
    10081011    Top = 235
    10091012    TabOrder = 3
     1013    ExplicitLeft = 445
     1014    ExplicitTop = 235
    10101015  end
    10111016  inherited pnlMessage: TPanel
    … …  
    10131018    Height = 57
    10141019    TabOrder = 1
     1020    ExplicitTop = 197
     1021    ExplicitHeight = 57
    10151022    inherited imgMessage: TImage
    10161023      Top = 10
     1024      ExplicitTop = 10
    10171025    end
    10181026    inherited memMessage: TRichEdit
    10191027      Height = 45
     1028      ExplicitHeight = 45
    10201029    end
    10211030  end
     1031  inherited amgrMain: TVA508AccessibilityManager
     1032    Data = (
     1033      (
     1034        'Component = nbkDiet'
     1035        'Status = stsDefault')
     1036      (
     1037        'Component = pgeDiet'
     1038        'Status = stsDefault')
     1039      (
     1040        'Component = cboDietAvail'
     1041        'Status = stsDefault')
     1042      (
     1043        'Component = lstDietSelect'
     1044        'Status = stsDefault')
     1045      (
     1046        'Component = cmdRemove'
     1047        'Status = stsDefault')
     1048      (
     1049        'Component = txtDietComment'
     1050        'Status = stsDefault')
     1051      (
     1052        'Component = calDietStart'
     1053        'Status = stsDefault')
     1054      (
     1055        'Component = calDietStop'
     1056        'Status = stsDefault')
     1057      (
     1058        'Component = cboDelivery'
     1059        'Status = stsDefault')
     1060      (
     1061        'Component = chkCancelTubefeeding'
     1062        'Status = stsDefault')
     1063      (
     1064        'Component = pgeOutPt'
     1065        'Status = stsDefault')
     1066      (
     1067        'Component = grpOPMeal'
     1068        'Status = stsDefault')
     1069      (
     1070        'Component = grpOPDoW'
     1071        'Status = stsDefault')
     1072      (
     1073        'Component = chkOPMonday'
     1074        'Status = stsDefault')
     1075      (
     1076        'Component = chkOPTuesday'
     1077        'Status = stsDefault')
     1078      (
     1079        'Component = chkOPWednesday'
     1080        'Status = stsDefault')
     1081      (
     1082        'Component = chkOPThursday'
     1083        'Status = stsDefault')
     1084      (
     1085        'Component = chkOPFriday'
     1086        'Status = stsDefault')
     1087      (
     1088        'Component = chkOPSaturday'
     1089        'Status = stsDefault')
     1090      (
     1091        'Component = chkOPSunday'
     1092        'Status = stsDefault')
     1093      (
     1094        'Component = calOPStart'
     1095        'Status = stsDefault')
     1096      (
     1097        'Component = calOPStop'
     1098        'Status = stsDefault')
     1099      (
     1100        'Component = cboOPDietAvail'
     1101        'Status = stsDefault')
     1102      (
     1103        'Component = txtOPDietComment'
     1104        'Status = stsDefault')
     1105      (
     1106        'Component = cboOPDelivery'
     1107        'Status = stsDefault')
     1108      (
     1109        'Component = lstOPDietSelect'
     1110        'Status = stsDefault')
     1111      (
     1112        'Component = cmdOPRemove'
     1113        'Status = stsDefault')
     1114      (
     1115        'Component = chkOPCancelTubefeeding'
     1116        'Status = stsDefault')
     1117      (
     1118        'Component = pgeTubefeeding'
     1119        'Status = stsDefault')
     1120      (
     1121        'Component = cboProduct'
     1122        'Status = stsDefault')
     1123      (
     1124        'Component = txtTFComment'
     1125        'Status = stsDefault')
     1126      (
     1127        'Component = grdSelected'
     1128        'Status = stsDefault')
     1129      (
     1130        'Component = cmdTFRemove'
     1131        'Status = stsDefault')
     1132      (
     1133        'Component = chkCancelTrays'
     1134        'Status = stsDefault')
     1135      (
     1136        'Component = txtQuantity'
     1137        'Status = stsDefault')
     1138      (
     1139        'Component = cboStrength'
     1140        'Status = stsDefault')
     1141      (
     1142        'Component = calOPTFStart'
     1143        'Status = stsDefault')
     1144      (
     1145        'Component = cboOPTFRecurringMeals'
     1146        'Status = stsDefault')
     1147      (
     1148        'Component = pgeEarlyLate'
     1149        'Status = stsDefault')
     1150      (
     1151        'Component = grpMeal'
     1152        'Status = stsDefault')
     1153      (
     1154        'Component = grpMealTime'
     1155        'Status = stsDefault')
     1156      (
     1157        'Component = radET1'
     1158        'Status = stsDefault')
     1159      (
     1160        'Component = radET2'
     1161        'Status = stsDefault')
     1162      (
     1163        'Component = radET3'
     1164        'Status = stsDefault')
     1165      (
     1166        'Component = radLT1'
     1167        'Status = stsDefault')
     1168      (
     1169        'Component = radLT2'
     1170        'Status = stsDefault')
     1171      (
     1172        'Component = radLT3'
     1173        'Status = stsDefault')
     1174      (
     1175        'Component = calELStart'
     1176        'Status = stsDefault')
     1177      (
     1178        'Component = calELStop'
     1179        'Status = stsDefault')
     1180      (
     1181        'Component = grpDoW'
     1182        'Status = stsDefault')
     1183      (
     1184        'Component = chkMonday'
     1185        'Status = stsDefault')
     1186      (
     1187        'Component = chkTuesday'
     1188        'Status = stsDefault')
     1189      (
     1190        'Component = chkWednesday'
     1191        'Status = stsDefault')
     1192      (
     1193        'Component = chkThursday'
     1194        'Status = stsDefault')
     1195      (
     1196        'Component = chkFriday'
     1197        'Status = stsDefault')
     1198      (
     1199        'Component = chkSaturday'
     1200        'Status = stsDefault')
     1201      (
     1202        'Component = chkSunday'
     1203        'Status = stsDefault')
     1204      (
     1205        'Component = chkBagged'
     1206        'Status = stsDefault')
     1207      (
     1208        'Component = cboOPELRecurringMeals'
     1209        'Status = stsDefault')
     1210      (
     1211        'Component = pgeIsolations'
     1212        'Status = stsDefault')
     1213      (
     1214        'Component = lstIsolation'
     1215        'Status = stsDefault')
     1216      (
     1217        'Component = txtIPComment'
     1218        'Status = stsDefault')
     1219      (
     1220        'Component = txtIPCurrent'
     1221        'Status = stsDefault')
     1222      (
     1223        'Component = pgeAdditional'
     1224        'Status = stsDefault')
     1225      (
     1226        'Component = txtAOComment'
     1227        'Status = stsDefault')
     1228      (
     1229        'Component = calOPAOStart'
     1230        'Status = stsDefault')
     1231      (
     1232        'Component = cboOPAORecurringMeals'
     1233        'Status = stsDefault')
     1234      (
     1235        'Component = memOrder'
     1236        'Status = stsDefault')
     1237      (
     1238        'Component = cmdAccept'
     1239        'Status = stsDefault')
     1240      (
     1241        'Component = cmdQuit'
     1242        'Status = stsDefault')
     1243      (
     1244        'Component = pnlMessage'
     1245        'Status = stsDefault')
     1246      (
     1247        'Component = memMessage'
     1248        'Status = stsDefault')
     1249      (
     1250        'Component = frmODDiet'
     1251        'Status = stsDefault'))
     1252  end
    10221253end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst;
     7  fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    161162    FIsolationID: string;
    162163    FTabChanging: Boolean;
     164    FGiveMultiTabMessage: boolean;
    163165    procedure DietCheckForNPO;
    164166    procedure DietCheckForTF;
    … …  
    192194    procedure OPDietCheckForNPO;
    193195    procedure OPDietCheckForTF;
    194     function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
     196    function  PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
     197    //procedure CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
    195198  protected
    196199    procedure InitDialog; override;
    … …  
    210213{$R *.DFM}
    211214
    212 uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
     215uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, DateUtils,
     216  fOrders, uODBase, VA508AccessibilityRouter;
    213217
    214218const
    … …  
    314318begin
    315319  inherited;
     320  FGiveMultiTabMessage := ScreenReaderSystemActive;
    316321  AbortOrder := False;
    317322  uRecurringMealList := TStringList.Create;
    … …  
    366371        end;
    367372    end;
    368   TAccessibleStringGrid.WrapControl(grdSelected);
    369373end;
    370374
    371375procedure TfrmODDiet.FormDestroy(Sender: TObject);
    372376begin
    373   TAccessibleStringGrid.UnwrapControl(grdSelected);
    374377  TFClearGrid;
    375378  uRecurringMealList.Free;
    … …  
    667670end;
    668671
    669 procedure TfrmODDiet.nbkDietChange(Sender: TObject);
    670 var
    671   x, CxMsg: string ;
    672   i: integer;
    673   AStringList: TStringList;
     672(*procedure TfrmODDiet.CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
    674673const
    675 //  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
    676674  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
    677675              'you specify a start date for when the new diet should replace the current' + CRLF +
    678676              'diet:' + CRLF + CRLF;
    679677  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
     678  TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
     679  TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
     680                    'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
     681
     682                    '1. Specify an expiration date/time for this order that will' + CRLF +
     683                    '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
     684
     685                    '2. Specify a later start date/time for this order for when you' + CRLF +
     686                    '   would like it to cancel and replace those other orders.';
     687
     688var
     689  i: integer;
     690  AStringList: TStringList;
     691  AList: TList;
     692  x, PtEvtIFN, PtEvtName: string;
     693  //AResponse: TResponse;
     694begin
     695  if Self.EvtID = 0 then   // check current and future released diets
     696  begin
     697    x := CurrentText;
     698    if Piece(x, #13, 1) <> 'Current Diet:  ' then
     699    begin
     700      AStringList := TStringList.Create;
     701      try
     702        AStringList.Text := x;
     703        CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
     704                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
     705        if AStringList.Count > 1 then
     706        begin
     707          CancelText := CancelText + CRLF + CRLF +
     708                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
     709                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
     710          if AStringList.Count > 2 then
     711          for i := 2 to AStringList.Count - 1 do
     712            CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
     713        end;
     714      finally
     715        AStringList.Free;
     716      end;
     717    end;
     718  end
     719  else if Sender is TButton then     // delayed orders code here - on accept only
     720  begin
     721    //AResponse := Responses.FindResponseByName('STOP', 1);
     722    //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
     723    AList := TList.Create;
     724    try
     725      PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
     726      PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
     727      LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
     728      for i := AList.Count - 1 downto 0 do
     729      begin
     730        if TOrder(Alist.Items[i]).DGroup <> Self.DisplayGroup then
     731        begin
     732          TOrder(AList.Items[i]).Free;
     733          AList.Delete(i);
     734        end;
     735      end;
     736      if AList.Count > 0 then
     737      begin
     738        x := '';
     739        RetrieveOrderFields(AList, 0, 0);
     740        CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName;
     741        for i := 0 to AList.Count - 1 do
     742          with TOrder(AList.Items[i]) do
     743          begin
     744            x := x + #9 + Text + CRLF;
     745(*            if StartTime <> '' then
     746              x := #9 + x + 'Start:   ' + StartTime + CRLF
     747            else
     748              x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
     749(*          end;
     750        CancelText := CancelText + CRLF + CRLF + x;
     751        CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
     752      end;
     753    finally
     754      with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
     755      AList.Free;
     756    end;
     757  end;
     758end;*)
     759
     760procedure TfrmODDiet.nbkDietChange(Sender: TObject);
     761var
     762  x: string ;
     763  CxMsg: string;
    680764begin
    681765  inherited;
    … …  
    693777    AllowQuickOrder := True;
    694778    x := CurrentDietText;
    695     if Piece(x, #13, 1) <> 'Current Diet:  ' then
    696     begin
    697       AStringList := TStringList.Create;
    698       try
    699         AStringList.Text := x;
    700         CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
    701                  + #9 + Copy(AStringList[0], 16, 99) + CRLF;
    702         if AStringList.Count > 1 then
    703         begin
    704           CxMsg := CxMsg + CRLF + CRLF +
    705                    TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
    706                    + #9 + Copy(AStringList[1], 22, 99) + CRLF;
    707           if AStringList.Count > 2 then
    708           for i := 2 to AStringList.Count - 1 do
    709             CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
    710         end;
    711       finally
    712         AStringList.Free;
    713       end;
    714     end;
     779    CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, x, CxMsg, nbkDiet);
    715780    if CxMsg <> '' then
    716781    begin
    … …  
    745810          end
    746811        else
    747           cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
     812          FastAssign(uRecurringMealList, cboOPTFRecurringMeals.Items);
    748813    end;
    749814    cboOPTFRecurringMeals.Visible := not OrderForInpatient;
    … …  
    781846          end
    782847        else
    783           cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     848          FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
    784849      end
    785850    else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
    … …  
    828893        end
    829894      else
    830         cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
     895        FastAssign(uRecurringMealList, cboOPAORecurringMeals.Items);
    831896    end;
    832897    cboOPAORecurringMeals.Visible := not OrderForInpatient;
    … …  
    854919       AllowQuickOrder := False;
    855920       ResetControlsOP;
    856        cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
     921       FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items);
    857922       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    858923       chkOPCancelTubefeeding.State := cbGrayed;
    … …  
    873938       LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
    874939       cboOPDietAvail.InsertSeparator;
    875        cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
     940       FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items);
    876941       cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
    877942       { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    … …  
    886951  Changing := False;                                       // Changing reset
    887952  StatusText('');
     953  if FGiveMultiTabMessage then  // CQ#15483
     954  begin
     955    FGiveMultiTabMessage := FALSE;
     956    GetScreenReader.Speak('Multi Tab Form');
     957  end;
    888958end;
    889959
    … …  
    16151685        end
    16161686      else
    1617         cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
     1687        FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
    16181688    end;
    16191689  Changing := False;
    … …  
    21422212var
    21432213  DCOrder: TOrder;
    2144   AResponse, AnotherResponse: TResponse;
    21452214  LateTrayFields: TLateTrayFields;
    2146   NewOrder: TOrder;
    2147   CanSign: Integer;
     2215  //CxMsg: string;
    21482216begin
    21492217  // these actions should be before inherited, so that InitDialog doesn't clear properties
    … …  
    21512219  if nbkDiet.ActivePage = pgeDiet then
    21522220  begin
     2221(*    if Self.EvtID <> 0 then
     2222    begin
     2223      CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept);
     2224      if CxMsg <> '' then
     2225      begin
     2226        if InfoBox(CxMsg + CRLF + CRLF +
     2227           'Have you done either of the above?', 'Possible delayed order conflict',
     2228           MB_ICONWARNING or MB_YESNO) = ID_NO
     2229           then exit;
     2230      end;
     2231    end;*)
    21532232    // create dc tubefeeding order
    21542233    if chkCancelTubeFeeding.State = cbChecked then
    … …  
    21602239    end;
    21612240    // check if late tray should be ordered
    2162     AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    2163     if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    2164     begin
    2165       AResponse := Responses.FindResponseByName('START', 1);
    2166       if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
    2167     end;
     2241    LateTrayCheck(Responses, Self.EvtID, FALSE, LateTrayFields);
    21682242  end;
    21692243{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
    … …  
    21792253    end;
    21802254    // check if late tray should be ordered
    2181     AResponse := Responses.FindResponseByName('ORDERABLE', 1);
    2182     if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
    2183     begin
    2184       AResponse := Responses.FindResponseByName('START', 1);
    2185       AnotherResponse := Responses.FindResponseByName('MEAL', 1);
    2186       if (AResponse <> nil) and (AnotherResponse <> nil) then
    2187         CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
    2188     end;
    2189   end;
    2190   inherited;
    2191   with LateTrayFields do if LateMeal <> #0 then
    2192   begin
    2193     NewOrder := TOrder.Create;
    2194     OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
    2195     if NewOrder.ID <> '' then
    2196     begin
    2197       if OrderForInpatient then
    2198         begin
    2199           if (Encounter.Provider = User.DUZ) and User.CanSignOrders
    2200             then CanSign := CH_SIGN_YES
    2201             else CanSign := CH_SIGN_NA;
    2202         end
    2203       else
    2204         begin
    2205           CanSign := CH_SIGN_NA;
    2206         end;
    2207       Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
    2208       SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
    2209     end
    2210     else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
    2211     NewOrder.Free;
    2212   end;
     2255    LateTrayCheck(Responses, Self.EvtID, TRUE, LateTrayFields);
     2256  end;
     2257  inherited;
     2258  with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient);
    22132259end;
    22142260

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

    r456 r829  
    22  Left = 398
    33  Top = 254
    4   Width = 304
    5   Height = 188
    64  Caption = 'Late Tray?'
     5  ClientHeight = 161
     6  ClientWidth = 296
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitWidth = 304
     10  ExplicitHeight = 188
    911  PixelsPerInch = 96
    1012  TextHeight = 13
    11   object Bevel1: TBevel
     13  object Bevel1: TBevel [0]
    1214    Left = 0
    1315    Top = 66
    … …  
    1517    Height = 2
    1618  end
    17   object lblMealCutoff: TStaticText
     19  object lblMealCutoff: TStaticText [1]
    1820    Left = 8
    1921    Top = 16
    … …  
    2325    TabOrder = 4
    2426  end
    25   object Label2: TStaticText
     27  object Label2: TStaticText [2]
    2628    Left = 8
    2729    Top = 34
    … …  
    3133    TabOrder = 5
    3234  end
    33   object GroupBox1: TGroupBox
     35  object GroupBox1: TGroupBox [3]
    3436    Left = 109
    3537    Top = 76
    … …  
    6062    end
    6163  end
    62   object cmdYes: TButton
     64  object cmdYes: TButton [4]
    6365    Left = 216
    6466    Top = 8
    … …  
    7072    OnClick = cmdYesClick
    7173  end
    72   object cmdNo: TButton
     74  object cmdNo: TButton [5]
    7375    Left = 216
    7476    Top = 37
    … …  
    8082    OnClick = cmdNoClick
    8183  end
    82   object chkBagged: TCheckBox
     84  object chkBagged: TCheckBox [6]
    8385    Left = 8
    8486    Top = 76
    … …  
    8890    TabOrder = 3
    8991  end
     92  inherited amgrMain: TVA508AccessibilityManager
     93    Data = (
     94      (
     95        'Component = lblMealCutoff'
     96        'Status = stsDefault')
     97      (
     98        'Component = Label2'
     99        'Status = stsDefault')
     100      (
     101        'Component = GroupBox1'
     102        'Status = stsDefault')
     103      (
     104        'Component = radLT1'
     105        'Status = stsDefault')
     106      (
     107        'Component = radLT2'
     108        'Status = stsDefault')
     109      (
     110        'Component = radLT3'
     111        'Status = stsDefault')
     112      (
     113        'Component = cmdYes'
     114        'Status = stsDefault')
     115      (
     116        'Component = cmdNo'
     117        'Status = stsDefault')
     118      (
     119        'Component = chkBagged'
     120        'Status = stsDefault')
     121      (
     122        'Component = frmODDietLT'
     123        'Status = stsDefault'))
     124  end
    90125end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, ExtCtrls, StdCtrls, ORFn;
     7  fAutoSz, ExtCtrls, StdCtrls, ORFn, fODBase, rODBase, VA508AccessibilityManager;
    88
    99type
    … …  
    3636
    3737procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
     38procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
     39procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
    3840
    3941implementation
    … …  
    192194end;
    193195
     196procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
     197var
     198  AResponse, AnotherResponse: TResponse;
     199begin
     200  if IsOutpatient then
     201  begin
     202    AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
     203    if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     204    begin
     205      AResponse := SomeResponses.FindResponseByName('START', 1);
     206      AnotherResponse := SomeResponses.FindResponseByName('MEAL', 1);
     207      if (AResponse <> nil) and (AnotherResponse <> nil) then
     208        CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
     209    end;
     210  end
     211  else
     212  begin
     213    AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
     214    if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
     215    begin
     216      AResponse := SomeResponses.FindResponseByName('START', 1);
     217      if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
     218    end;
     219  end;
     220end;
     221
     222procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
     223const
     224  TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
     225  TC_EL_SAVE_ERR    = 'Error Saving Late Tray Order';
     226var
     227  NewOrder: TOrder;
     228  CanSign: integer;
     229begin
     230  NewOrder := TOrder.Create;
     231  try
     232    with LateTrayFields do OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
     233    if NewOrder.ID <> '' then
     234    begin
     235      if IsInpatient then
     236        begin
     237          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
     238            then CanSign := CH_SIGN_YES
     239            else CanSign := CH_SIGN_NA;
     240        end
     241      else
     242        begin
     243          CanSign := CH_SIGN_NA;
     244        end;
     245      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
     246      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
     247    end
     248    else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
     249  finally
     250    NewOrder.Free;
     251  end;
     252end;
     253
    194254// ---------- frmODDietLT procedures ---------------
    195255procedure TfrmODDietLT.FormCreate(Sender: TObject);

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

    r456 r829  
    11inherited frmODGen: TfrmODGen
    2   Left = 314
    3   Top = 410
     2  Left = 223
     3  Top = 290
    44  Caption = 'frmODGen'
     5  ExplicitLeft = 223
     6  ExplicitTop = 290
    57  PixelsPerInch = 96
    68  TextHeight = 13
    … …  
    1315    TabOrder = 4
    1416  end
    15   inherited cmdAccept: TButton
    16     Anchors = [akRight, akBottom]
     17  inherited cmdQuit: TButton
     18    Top = 219
     19    ExplicitTop = 219
    1720  end
    18   inherited cmdQuit: TButton
    19     Anchors = [akRight, akBottom]
     21  inherited amgrMain: TVA508AccessibilityManager
     22    Data = (
     23      (
     24        'Component = sbxMain'
     25        'Status = stsDefault')
     26      (
     27        'Component = memOrder'
     28        'Status = stsDefault')
     29      (
     30        'Component = cmdAccept'
     31        'Status = stsDefault')
     32      (
     33        'Component = cmdQuit'
     34        'Status = stsDefault')
     35      (
     36        'Component = pnlMessage'
     37        'Status = stsDefault')
     38      (
     39        'Component = memMessage'
     40        'Status = stsDefault')
     41      (
     42        'Component = frmODGen'
     43        'Status = stsDefault'))
    2044  end
    2145end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase;
     7  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    2324    procedure FormCreate(Sender: TObject);
    2425    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     26    procedure cmdAcceptClick(Sender: TObject);
    2527  private
    2628    FilterOut: boolean;
    … …  
    4244    procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
    4345    procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     46    procedure TrimAllMemos;
    4447  protected
     48    FFormCloseCalled : Boolean;
    4549    FCharHt: Integer;
    4650    FCharWd: Integer;
    … …  
    5458    procedure SetDialogIEN(Value: Integer); override;
    5559    procedure Validate(var AnErrMsg: string); override;
     60    procedure UpdateAccessabilityActions(var Actions: TAccessibilityActions); override;
    5661  public
    5762    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    7984  IDs,TSstr, AttendStr: string;
    8085begin
     86  FFormCloseCalled := false;
    8187  inherited;
    8288  FilterOut := True;
    … …  
    129135  FDialogItemList.Free;
    130136  FDialogCtrlList.Free;
     137  FFormCloseCalled := true;
    131138  inherited;
    132139end;
    … …  
    173180          theEvtInfo := EventInfo1(AResponse.IValue);
    174181          AResponse.EValue := Piece(theEvtInfo,'^',4);
    175         end;       
     182        end;
    176183        if AResponse = nil then
    177184        begin
    … …  
    199206    Changing := False;
    200207  end; {if OrderAction}
     208  UpdateColorsFor508Compliance(Self);
    201209  ControlChange(Self);
    202210  if (FFirstCtrl <> nil) and (FFirstCtrl.Enabled) then SetFocusedControl(FFirstCtrl);
     211end;
     212
     213procedure TfrmODGen.UpdateAccessabilityActions(
     214  var Actions: TAccessibilityActions);
     215begin
     216  exclude(Actions, aaColorConversion);
    203217end;
    204218
    … …  
    492506        with TORComboBox(Editor) do
    493507        begin
    494           Items.AddStrings(TStrings(TopTSList));
     508          FastAddStrings(TStrings(TopTSList), TORComboBox(Editor).Items);
    495509          LongList := false;
    496510        end;
    … …  
    573587end;
    574588
     589procedure TfrmODGen.TrimAllMemos;
     590var
     591  i : integer;
     592  Memo : TMemo;
     593begin
     594  if FFormCloseCalled then Exit; //it is possible for TrimAllMemos to get called after FormClose
     595  if Not Assigned(FDialogCtrlList) then Exit;
     596  for i := 0 to FDialogCtrlList.Count - 1 do
     597    if TDialogCtrl(FDialogCtrlList.Items[i]).Editor is TMemo then begin
     598      Memo := TMemo(TDialogCtrl(FDialogCtrlList.Items[i]).Editor);
     599      Memo.Lines.Text := Trim(Memo.Lines.Text);
     600    end;
     601end;
     602
     603procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
     604begin
     605  inherited;
     606  Application.ProcessMessages;
     607  TrimAllMemos;
     608end;
     609
    575610procedure TfrmODGen.ControlChange(Sender: TObject);
    576611var

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

    r456 r829  
    66  Height = 271
    77  Caption = 'Order a Lab Test'
     8  ExplicitWidth = 523
     9  ExplicitHeight = 271
    810  PixelsPerInch = 96
    911  TextHeight = 13
    … …  
    295297    Left = 443
    296298    TabOrder = 18
     299    ExplicitLeft = 443
    297300  end
    298301  inherited cmdQuit: TButton
    … …  
    304307    Height = 56
    305308    TabOrder = 21
     309    ExplicitLeft = 18
     310    ExplicitTop = 192
     311    ExplicitHeight = 56
    306312    inherited imgMessage: TImage
    307313      Top = 11
     314      ExplicitTop = 11
    308315    end
    309316    inherited memMessage: TRichEdit
    … …  
    312319      Height = 43
    313320      PopupMenu = MessagePopup
    314     end
    315   end
    316   object pnlCollTimeButton: TKeyClickPanel
     321      ExplicitLeft = 41
     322      ExplicitTop = 5
     323      ExplicitHeight = 43
     324    end
     325  end
     326  object pnlCollTimeButton: TKeyClickPanel [24]
    317327    Left = 288
    318328    Top = 167
    … …  
    350360    end
    351361  end
    352   object cboAvailTest: TORComboBox
     362  object cboAvailTest: TORComboBox [25]
    353363    Left = 6
    354364    Top = 18
    … …  
    376386    CharsNeedMatch = 1
    377387  end
    378   object cboFrequency: TORComboBox
     388  object cboFrequency: TORComboBox [26]
    379389    Left = 326
    380390    Top = 166
    … …  
    400410    CharsNeedMatch = 1
    401411  end
    402   object cboCollSamp: TORComboBox
     412  object cboCollSamp: TORComboBox [27]
    403413    Left = 269
    404414    Top = 28
    … …  
    427437    CharsNeedMatch = 1
    428438  end
    429   object cboSpecimen: TORComboBox
     439  object cboSpecimen: TORComboBox [28]
    430440    Left = 269
    431441    Top = 55
    … …  
    456466    CharsNeedMatch = 1
    457467  end
    458   object cboUrgency: TORComboBox
     468  object cboUrgency: TORComboBox [29]
    459469    Left = 269
    460470    Top = 82
    … …  
    480490    CharsNeedMatch = 1
    481491  end
    482   object txtAddlComment: TCaptionEdit
     492  object txtAddlComment: TCaptionEdit [30]
    483493    Left = 187
    484494    Top = 122
    … …  
    490500    Caption = 'Additional Comment'
    491501  end
    492   object txtDays: TCaptionEdit
     502  object txtDays: TCaptionEdit [31]
    493503    Left = 430
    494504    Top = 166
    … …  
    501511    Caption = 'How Long?'
    502512  end
    503   object FLabCommonCombo: TORListBox
     513  object FLabCommonCombo: TORListBox [32]
    504514    Left = 440
    505515    Top = 247
    … …  
    515525    LongList = False
    516526  end
    517   object cboCollTime: TORComboBox
     527  object cboCollTime: TORComboBox [33]
    518528    Left = 149
    519529    Top = 166
    … …  
    540550    CharsNeedMatch = 1
    541551  end
    542   object cboCollType: TORComboBox
     552  object cboCollType: TORComboBox [34]
    543553    Left = 6
    544554    Top = 166
    … …  
    564574    CharsNeedMatch = 1
    565575  end
     576  inherited amgrMain: TVA508AccessibilityManager
     577    Data = (
     578      (
     579        'Component = txtImmedColl'
     580        'Status = stsDefault')
     581      (
     582        'Component = calCollTime'
     583        'Status = stsDefault')
     584      (
     585        'Component = pnlUrineVolume'
     586        'Status = stsDefault')
     587      (
     588        'Component = txtUrineVolume'
     589        'Status = stsDefault')
     590      (
     591        'Component = pnlAntiCoagulation'
     592        'Status = stsDefault')
     593      (
     594        'Component = txtAntiCoagulant'
     595        'Status = stsDefault')
     596      (
     597        'Component = pnlOrderComment'
     598        'Status = stsDefault')
     599      (
     600        'Component = txtOrderComment'
     601        'Status = stsDefault')
     602      (
     603        'Component = pnlHide'
     604        'Status = stsDefault')
     605      (
     606        'Component = pnlDoseDraw'
     607        'Status = stsDefault')
     608      (
     609        'Component = txtDoseTime'
     610        'Status = stsDefault')
     611      (
     612        'Component = txtDrawTime'
     613        'Status = stsDefault')
     614      (
     615        'Component = pnlPeakTrough'
     616        'Status = stsDefault')
     617      (
     618        'Component = grpPeakTrough'
     619        'Status = stsDefault')
     620      (
     621        'Component = pnlCollTimeButton'
     622        'Status = stsDefault')
     623      (
     624        'Component = cboAvailTest'
     625        'Status = stsDefault')
     626      (
     627        'Component = cboFrequency'
     628        'Status = stsDefault')
     629      (
     630        'Component = cboCollSamp'
     631        'Status = stsDefault')
     632      (
     633        'Component = cboSpecimen'
     634        'Status = stsDefault')
     635      (
     636        'Component = cboUrgency'
     637        'Status = stsDefault')
     638      (
     639        'Component = txtAddlComment'
     640        'Status = stsDefault')
     641      (
     642        'Component = txtDays'
     643        'Status = stsDefault')
     644      (
     645        'Component = FLabCommonCombo'
     646        'Status = stsDefault')
     647      (
     648        'Component = cboCollTime'
     649        'Status = stsDefault')
     650      (
     651        'Component = cboCollType'
     652        'Status = stsDefault')
     653      (
     654        'Component = memOrder'
     655        'Status = stsDefault')
     656      (
     657        'Component = cmdAccept'
     658        'Status = stsDefault')
     659      (
     660        'Component = cmdQuit'
     661        'Status = stsDefault')
     662      (
     663        'Component = pnlMessage'
     664        'Status = stsDefault')
     665      (
     666        'Component = memMessage'
     667        'Status = stsDefault')
     668      (
     669        'Component = frmODLab'
     670        'Status = stsDefault'))
     671  end
    566672  object dlgLabCollTime: TORDateTimeDlg
    567     FMDateTime = 2980923
     673    FMDateTime = 2980923.000000000000000000
    568674    DateOnly = False
    569675    RequireTime = True

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

    r456 r829  
    66  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    77  Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
    8   ORDtTm, Buttons, Menus;
     8  ORDtTm, Buttons, Menus, VA508AccessibilityManager;
    99
    1010type
    … …  
    106106    FEvtDivision: integer;
    107107    procedure ReadServerVariables;
     108    procedure DisplayChangedOrders(ACollType: string);
    108109  public
    109110    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    240241      EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
    241242      if EvtDelayLoc>0 then
    242         AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
     243        FastAssign(ODForLab(EvtDelayLoc, EvtDivision), AList)
    243244      else
    244         AList.Assign(ODForLab(Encounter.Location,EvtDivision));
     245        FastAssign(ODForLab(Encounter.Location, EvtDivision), AList);
    245246    end else
    246       AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
     247      FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
    247248    CtrlInits.LoadDefaults(AList);
    248249    InitDialog;
    … …  
    457458          OneSamp := TStringList.Create;
    458459          try
    459             OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
     460            FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
    460461            FillCollSampList(OneSamp, CollSampList.Count);
    461462          finally
    … …  
    651652    begin
    652653      if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
    653       AComboBox.Items.Assign(SpecimenList);
     654      FastAssign(SpecimenList, AComboBox.Items);
    654655      AComboBox.Items.Add('0^Other...');
    655656      with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
    … …  
    902903  Days, MsgTxt: Double;
    903904  x: string;
     905  ACollType: string;
    904906const
    905907  TX_NO_TIME        = 'Collection Time is required.' ;
    … …  
    11261128        end;
    11271129    end;
     1130
     1131  if (AnErrMsg <> '') or (Self.EvtID > 0) then exit;
     1132   
     1133  // add check and display for auto-change from LC to WC - v27.1 - CQ #10226
     1134  ACollType := Responses.FindResponseByName('COLLECT', 1).EValue;
     1135  if ((ACollType = 'LC') or (ACollType = 'I')) then DisplayChangedOrders(ACollType);
     1136end;
     1137
     1138procedure TfrmODLab.DisplayChangedOrders(ACollType: string);
     1139var
     1140  AStartDate, ASchedule, ADuration: string;
     1141  ChangedOrdersList, AList: TStringlist;
     1142  i, j, k: integer;
     1143begin
     1144  ChangedOrdersList := TStringList.Create;
     1145  try
     1146    AStartDate := Responses.FindResponseByName('START', 1).IValue;
     1147    ASchedule  := Responses.FindResponseByName('SCHEDULE', 1).IValue;
     1148    if txtDays.Enabled then ADuration := Responses.FindResponseByName('DAYS', 1).EValue else ADuration := '';
     1149    CheckForChangeFromLCtoWCOnAccept(ChangedOrdersList, Encounter.Location, AStartDate, ACollType, ASchedule, ADuration);
     1150    if ChangedOrdersList.Text <> '' then
     1151    begin
     1152      AList := TStringList.Create;
     1153      try
     1154        AList.Text := Responses.OrderText;
     1155        with ChangedOrdersList do
     1156        begin
     1157          Insert(5, 'Order   :' + #9 + AList[0]);
     1158          k := Length(ChangedOrdersList[5]);
     1159          i := 0;
     1160          if AList.Count > 1 then
     1161            for j := 1 to AList.Count - 1 do
     1162            begin
     1163              Insert(5 + j, StringOfChar(' ', 9) + #9 + AList[j]);
     1164              k := HigherOf(k, Length(ChangedOrdersList[5 + j]));
     1165              i := j;
     1166            end;
     1167          Insert(5 + i + 1, StringOfChar('-', k + 4));
     1168        end;
     1169        ReportBox(ChangedOrdersList, 'Changed Orders', TRUE);
     1170      finally
     1171        AList.Free;
     1172      end;
     1173    end;
     1174  finally
     1175    ChangedOrdersList.Free;
     1176  end;
    11281177end;
    11291178

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

    r456 r829  
    1 object frmODLabImmedColl: TfrmODLabImmedColl
     1inherited frmODLabImmedColl: TfrmODLabImmedColl
    22  Left = 146
    33  Top = 150
    4   Width = 524
    5   Height = 286
    64  Caption = 'Immediate Collection Times'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 259
     6  ClientWidth = 516
    137  OldCreateOrder = True
    148  OnShow = FormShow
    159  PixelsPerInch = 96
    1610  TextHeight = 13
    17   object pnlBase: TORAutoPanel
     11  object pnlBase: TORAutoPanel [0]
    1812    Left = 0
    1913    Top = 0
    … …  
    8579    end
    8680  end
     81  inherited amgrMain: TVA508AccessibilityManager
     82    Data = (
     83      (
     84        'Component = pnlBase'
     85        'Status = stsDefault')
     86      (
     87        'Component = memImmedCollect'
     88        'Status = stsDefault')
     89      (
     90        'Component = calImmedCollect'
     91        'Status = stsDefault')
     92      (
     93        'Component = cmdOK'
     94        'Status = stsDefault')
     95      (
     96        'Component = cmdCancel'
     97        'Status = stsDefault')
     98      (
     99        'Component = frmODLabImmedColl'
     100        'Status = stsDefault'))
     101  end
    87102end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn;
     7  StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmODLabImmedColl = class(TForm)
     11  TfrmODLabImmedColl = class(TfrmBase508Form)
    1112    memImmedCollect: TCaptionMemo;
    1213    calImmedCollect: TORDateBox;
    … …  
    9394procedure TfrmODLabImmedColl.FormShow(Sender: TObject);
    9495begin
    95   memImmedCollect.Lines.Assign(ImmediateCollectTimes);
     96  FastAssign(ImmediateCollectTimes, memImmedCollect.Lines);
    9697  if Length(FCollTime) > 0 then
    9798    calImmedCollect.Text := FCollTime

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

    r456 r829  
    1 object frmODLabOthCollSamp: TfrmODLabOthCollSamp
     1inherited frmODLabOthCollSamp: TfrmODLabOthCollSamp
    22  Left = 321
    33  Top = 136
    4   Width = 236
    5   Height = 359
    64  BorderIcons = []
    75  Caption = 'Select Collection Sample'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 332
     7  ClientWidth = 228
    148  OldCreateOrder = True
    159  Position = poScreenCenter
     10  ExplicitWidth = 236
     11  ExplicitHeight = 359
    1612  PixelsPerInch = 96
    1713  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     14  object pnlBase: TORAutoPanel [0]
    1915    Left = 0
    2016    Top = 0
    … …  
    3834      ListItemsOnly = True
    3935      LongList = False
     36      LookupPiece = 0
    4037      MaxLength = 0
    4138      Pieces = '2'
    … …  
    4441      TabOrder = 0
    4542      OnDblClick = cboOtherCollSampDblClick
     43      CharsNeedMatch = 1
    4644    end
    4745    object cmdOK: TButton
    … …  
    6664    end
    6765  end
     66  inherited amgrMain: TVA508AccessibilityManager
     67    Data = (
     68      (
     69        'Component = pnlBase'
     70        'Status = stsDefault')
     71      (
     72        'Component = cboOtherCollSamp'
     73        'Status = stsDefault')
     74      (
     75        'Component = cmdOK'
     76        'Status = stsDefault')
     77      (
     78        'Component = cmdCancel'
     79        'Status = stsDefault')
     80      (
     81        'Component = frmODLabOthCollSamp'
     82        'Status = stsDefault'))
     83  end
    6884end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, ORCtrls, StdCtrls, ORFn;
     7  ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODLabOthCollSamp = class(TForm)
     10  TfrmODLabOthCollSamp = class(TfrmBase508Form)
    1111    pnlBase: TORAutoPanel;
    1212    cboOtherCollSamp: TORComboBox;

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

    r456 r829  
    1 object frmODLabOthSpec: TfrmODLabOthSpec
     1inherited frmODLabOthSpec: TfrmODLabOthSpec
    22  Left = 240
    33  Top = 136
    4   Width = 317
    5   Height = 359
    64  BorderIcons = []
    75  Caption = 'Select Specimen'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 332
     7  ClientWidth = 309
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
    … …  
    3832      ListItemsOnly = True
    3933      LongList = True
     34      LookupPiece = 0
    4035      MaxLength = 0
    4136      Pieces = '2'
    … …  
    4540      OnDblClick = cboOtherSpecDblClick
    4641      OnNeedData = cboOtherSpecNeedData
     42      CharsNeedMatch = 1
    4743    end
    4844    object cmdOK: TButton
    … …  
    6763    end
    6864  end
     65  inherited amgrMain: TVA508AccessibilityManager
     66    Data = (
     67      (
     68        'Component = pnlBase'
     69        'Status = stsDefault')
     70      (
     71        'Component = cboOtherSpec'
     72        'Status = stsDefault')
     73      (
     74        'Component = cmdOK'
     75        'Status = stsDefault')
     76      (
     77        'Component = cmdCancel'
     78        'Status = stsDefault')
     79      (
     80        'Component = frmODLabOthSpec'
     81        'Status = stsDefault'))
     82  end
    6983end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, ORCtrls, StdCtrls, ORFn;
     7  ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODLabOthSpec = class(TForm)
     10  TfrmODLabOthSpec = class(TfrmBase508Form)
    1111    pnlBase: TORAutoPanel;
    1212    cboOtherSpec: TORComboBox;
    … …  
    5252      with cboOtherSpec do
    5353        begin
    54           {MItems.Assign(SpecimenList);
     54          {FastAssign(SpecimenList, MItems);
    5555          InsertSeparator; }
    5656          InitLongList('');

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

    r456 r829  
    22  Left = 291
    33  Top = 307
    4   Width = 453
    5   Height = 254
    64  BorderIcons = []
    75  Caption = 'Complex Dose'
     6  ClientHeight = 227
     7  ClientWidth = 445
    88  Position = poScreenCenter
    99  OnCreate = FormCreate
     10  ExplicitWidth = 453
     11  ExplicitHeight = 254
    1012  PixelsPerInch = 96
    1113  TextHeight = 13
    12   object Bevel1: TBevel
     14  object Bevel1: TBevel [0]
    1315    Left = 6
    1416    Top = 174
    … …  
    1618    Height = 2
    1719  end
    18   object grdDoses: TStringGrid
     20  object grdDoses: TStringGrid [1]
    1921    Left = 6
    2022    Top = 6
    … …  
    3941      21)
    4042  end
    41   object cmdOK: TButton
     43  object cmdOK: TButton [2]
    4244    Left = 290
    4345    Top = 184
    … …  
    4850    OnClick = cmdOKClick
    4951  end
    50   object cmdCancel: TButton
     52  object cmdCancel: TButton [3]
    5153    Left = 368
    5254    Top = 184
    … …  
    5759    OnClick = cmdCancelClick
    5860  end
    59   object cboRoute: TORComboBox
     61  object cboRoute: TORComboBox [4]
    6062    Left = 170
    6163    Top = 200
    … …  
    7173    ListItemsOnly = False
    7274    LongList = False
     75    LookupPiece = 0
    7376    MaxLength = 0
    7477    Pieces = '2'
    … …  
    7982    OnClick = cboRouteClick
    8083    OnExit = cboRouteExit
    81   end
    82   object cboSchedule: TORComboBox
     84    CharsNeedMatch = 1
     85  end
     86  object cboSchedule: TORComboBox [5]
    8387    Left = 169
    8488    Top = 176
    … …  
    9498    ListItemsOnly = False
    9599    LongList = False
     100    LookupPiece = 0
    96101    MaxLength = 0
    97102    Sorted = False
    … …  
    100105    Visible = False
    101106    OnExit = cboScheduleExit
    102   end
    103   object pnlInstruct: TPanel
     107    CharsNeedMatch = 1
     108  end
     109  object pnlInstruct: TPanel [6]
    104110    Left = 6
    105111    Top = 177
    … …  
    144150      ListItemsOnly = False
    145151      LongList = False
     152      LookupPiece = 0
    146153      MaxLength = 80
    147154      Sorted = False
    148155      SynonymChars = '<>'
    149156      TabOrder = 0
    150     end
    151   end
    152   object pnlDays: TPanel
     157      CharsNeedMatch = 1
     158    end
     159  end
     160  object pnlDays: TPanel [7]
    153161    Left = 6
    154162    Top = 201
    … …  
    184192      Height = 21
    185193      Associate = txtDays
    186       Min = 0
    187194      Max = 999
    188       Position = 0
    189195      TabOrder = 1
    190       Wrap = False
    191     end
    192   end
    193   object cmdInsert: TButton
     196    end
     197  end
     198  object cmdInsert: TButton [8]
    194199    Left = 6
    195200    Top = 149
    … …  
    200205    OnClick = cmdInsertClick
    201206  end
    202   object cmdRemove: TButton
     207  object cmdRemove: TButton [9]
    203208    Left = 92
    204209    Top = 149
    … …  
    209214    OnClick = cmdRemoveClick
    210215  end
     216  inherited amgrMain: TVA508AccessibilityManager
     217    Data = (
     218      (
     219        'Component = grdDoses'
     220        'Status = stsDefault')
     221      (
     222        'Component = cmdOK'
     223        'Status = stsDefault')
     224      (
     225        'Component = cmdCancel'
     226        'Status = stsDefault')
     227      (
     228        'Component = cboRoute'
     229        'Status = stsDefault')
     230      (
     231        'Component = cboSchedule'
     232        'Status = stsDefault')
     233      (
     234        'Component = pnlInstruct'
     235        'Status = stsDefault')
     236      (
     237        'Component = cboInstruct'
     238        'Status = stsDefault')
     239      (
     240        'Component = pnlDays'
     241        'Status = stsDefault')
     242      (
     243        'Component = txtDays'
     244        'Status = stsDefault')
     245      (
     246        'Component = UpDown2'
     247        'Status = stsDefault')
     248      (
     249        'Component = cmdInsert'
     250        'Status = stsDefault')
     251      (
     252        'Component = cmdRemove'
     253        'Status = stsDefault')
     254      (
     255        'Component = frmODMedComplex'
     256        'Status = stsDefault'))
     257  end
    211258  object popUnits: TPopupMenu
    212259    AutoPopup = False

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fAutoSz, StdCtrls, Grids, Buttons, ExtCtrls, ORCtrls, Menus, ORFn, fODBase, uConst,
    8   ComCtrls;
     8  ComCtrls, VA508AccessibilityManager;
    99
    1010type

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

    r456 r829  
    22  Left = 333
    33  Top = 258
    4   Width = 316
    5   Height = 205
    64  Caption = 'Formulary Alternatives'
     5  ClientHeight = 178
     6  ClientWidth = 308
    77  FormStyle = fsStayOnTop
    88  OnCreate = FormCreate
     9  ExplicitWidth = 316
     10  ExplicitHeight = 205
    911  PixelsPerInch = 96
    1012  TextHeight = 13
    11   object Label1: TLabel
     13  object Label1: TLabel [0]
    1214    Left = 8
    1315    Top = 8
    … …  
    1618    Caption = 'The selected drug is not in the formulary.  Alternatives are:'
    1719  end
    18   object Label2: TStaticText
     20  object Label2: TStaticText [1]
    1921    Left = 8
    2022    Top = 127
    … …  
    2426    TabOrder = 3
    2527  end
    26   object lstFormAlt: TORListBox
     28  object lstFormAlt: TORListBox [2]
    2729    Left = 8
    2830    Top = 22
    … …  
    3941    Pieces = '2'
    4042  end
    41   object cmdYes: TButton
     43  object cmdYes: TButton [3]
    4244    Left = 74
    4345    Top = 148
    … …  
    5052    OnClick = cmdYesClick
    5153  end
    52   object cmdNo: TButton
     54  object cmdNo: TButton [4]
    5355    Left = 162
    5456    Top = 148
    … …  
    6062    OnClick = cmdNoClick
    6163  end
     64  inherited amgrMain: TVA508AccessibilityManager
     65    Data = (
     66      (
     67        'Component = Label2'
     68        'Status = stsDefault')
     69      (
     70        'Component = lstFormAlt'
     71        'Status = stsDefault')
     72      (
     73        'Component = cmdYes'
     74        'Status = stsDefault')
     75      (
     76        'Component = cmdNo'
     77        'Status = stsDefault')
     78      (
     79        'Component = frmODMedFA'
     80        'Status = stsDefault'))
     81  end
    6282end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORCtrls, ORFn;
     7  fAutoSz, StdCtrls, ORCtrls, ORFn, VA508AccessibilityManager;
    88
    99type
    … …  
    6060        with frmODMedFA do
    6161        begin
    62           lstFormAlt.Items.Assign(FormAltList);
     62          FastAssign(FormAltList, lstFormAlt.Items);
    6363          ShowModal;
    6464          if Length(FSelected) > 0 then

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

    r456 r829  
    11inherited frmODMedIV: TfrmODMedIV
    2   Left = 587
    3   Top = 331
    4   Width = 610
    5   Height = 341
     2  Left = 246
     3  Top = 256
     4  Width = 668
     5  Height = 465
    66  Caption = 'Infusion Order'
    7   OnKeyDown = FormKeyDown
     7  Constraints.MinHeight = 350
     8  Constraints.MinWidth = 500
     9  ExplicitWidth = 668
     10  ExplicitHeight = 465
    811  PixelsPerInch = 96
    912  TextHeight = 13
    1013  object lblInfusionRate: TLabel [0]
    11     Left = 6
    12     Top = 196
    13     Width = 96
    14     Height = 13
    15     Caption = 'Infusion Rate (ml/hr)'
     14    Left = 486
     15    Top = 197
     16    Width = 100
     17    Height = 13
     18    Caption = 'Infusion Rate (ml/hr)*'
    1619  end
    1720  object lblPriority: TLabel [1]
    18     Left = 134
    19     Top = 196
    20     Width = 31
    21     Height = 13
    22     Caption = 'Priority'
     21    Left = 8
     22    Top = 238
     23    Width = 35
     24    Height = 13
     25    Caption = 'Priority*'
    2326  end
    2427  object lblComponent: TLabel [2]
    2528    Left = 214
    26     Top = 6
    27     Width = 81
    28     Height = 13
    29     Caption = 'Solution/Additive'
     29    Top = 7
     30    Width = 85
     31    Height = 13
     32    Caption = 'Solution/Additive*'
    3033  end
    3134  object lblAmount: TLabel [3]
    3235    Left = 328
    33     Top = 6
    34     Width = 80
    35     Height = 13
    36     Caption = 'Volume/Strength'
     36    Top = 7
     37    Width = 84
     38    Height = 13
     39    Caption = 'Volume/Strength*'
    3740    WordWrap = True
    3841  end
    3942  object lblComments: TLabel [4]
    4043    Left = 214
    41     Top = 106
     44    Top = 107
    4245    Width = 49
    4346    Height = 13
    … …  
    4548  end
    4649  object lblLimit: TLabel [5]
    47     Left = 230
    48     Top = 196
    49     Width = 117
    50     Height = 13
    51     Caption = 'Duration or Total Volume'
    52   end
    53   object txtRate: TCaptionEdit [6]
    54     Left = 6
    55     Top = 210
     50    Left = 185
     51    Top = 238
     52    Width = 165
     53    Height = 13
     54    Caption = 'Duration or Total Volume (Optional)'
     55  end
     56  object Label1: TLabel [6]
     57    Left = 8
     58    Top = 344
     59    Width = 133
     60    Height = 13
     61    Caption = ' * Indicates a Required Field'
     62  end
     63  object lblRoute: TLabel [7]
     64    Left = 8
     65    Top = 197
     66    Width = 33
     67    Height = 13
     68    Caption = 'Route*'
     69  end
     70  object lblSchedule: TLabel [8]
     71    Left = 304
     72    Top = 197
     73    Width = 52
     74    Height = 13
     75    Caption = 'Schedule *'
     76  end
     77  object lblType: TLabel [9]
     78    Left = 184
     79    Top = 197
     80    Width = 28
     81    Height = 13
     82    Caption = 'Type*'
     83    ParentShowHint = False
     84    ShowHint = True
     85  end
     86  object txtNSS: TLabel [10]
     87    Left = 361
     88    Top = 197
     89    Width = 69
     90    Height = 13
     91    Caption = '(Day-of-Week)'
     92    Color = clBtnFace
     93    Font.Charset = DEFAULT_CHARSET
     94    Font.Color = clBlue
     95    Font.Height = -11
     96    Font.Name = 'MS Sans Serif'
     97    Font.Style = []
     98    ParentColor = False
     99    ParentFont = False
     100    OnClick = txtNSSClick
     101  end
     102  object txtAllIVRoutes: TLabel [11]
     103    Left = 47
     104    Top = 197
     105    Width = 129
     106    Height = 13
     107    Caption = '(Expanded Med Route List)'
     108    Font.Charset = DEFAULT_CHARSET
     109    Font.Color = clBlue
     110    Font.Height = -11
     111    Font.Name = 'MS Sans Serif'
     112    Font.Style = []
     113    ParentFont = False
     114    Visible = False
     115    OnClick = txtAllIVRoutesClick
     116  end
     117  object lblTypeHelp: TLabel [12]
     118    Left = 219
     119    Top = 197
     120    Width = 68
     121    Height = 13
     122    Caption = '(IV Type Help)'
     123    Font.Charset = DEFAULT_CHARSET
     124    Font.Color = clBlue
     125    Font.Height = -11
     126    Font.Name = 'MS Sans Serif'
     127    Font.Style = []
     128    ParentFont = False
     129    ParentShowHint = False
     130    ShowHint = False
     131    OnClick = lblTypeHelpClick
     132  end
     133  object txtRate: TCaptionEdit [13]
     134    Left = 486
     135    Top = 211
    56136    Width = 91
    57137    Height = 21
    58138    AutoSelect = False
    59     TabOrder = 5
    60     OnChange = ControlChange
    61     OnExit = txtRateExit
     139    TabOrder = 8
     140    OnChange = txtRateChange
    62141    Caption = 'Infusion Rate'
    63142  end
    64   object cboPriority: TORComboBox [7]
    65     Left = 134
    66     Top = 210
     143  object cboPriority: TORComboBox [14]
     144    Left = 8
     145    Top = 252
    67146    Width = 72
    68147    Height = 21
    … …  
    82161    Sorted = False
    83162    SynonymChars = '<>'
    84     TabOrder = 6
    85     OnChange = ControlChange
     163    TabOrder = 10
     164    OnChange = cboPriorityChange
     165    OnExit = cboPriorityExit
    86166    CharsNeedMatch = 1
    87167  end
    88   object grdSelected: TCaptionStringGrid [8]
     168  object grdSelected: TCaptionStringGrid [15]
    89169    Left = 214
    90     Top = 20
    91     Width = 384
     170    Top = 21
     171    Width = 437
    92172    Height = 76
    93173    ColCount = 3
    … …  
    99179    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected]
    100180    ScrollBars = ssVertical
    101     TabOrder = 2
     181    TabOrder = 1
    102182    OnDrawCell = grdSelectedDrawCell
    103183    OnKeyPress = grdSelectedKeyPress
    … …  
    105185    Caption = 'Selected Solution and Additives'
    106186  end
    107   object cmdRemove: TButton [9]
     187  object cmdRemove: TButton [16]
    108188    Left = 443
    109     Top = 99
     189    Top = 100
    110190    Width = 72
    111191    Height = 18
    112192    Caption = 'Remove'
    113     TabOrder = 3
     193    TabOrder = 2
    114194    OnClick = cmdRemoveClick
    115195  end
    116   object memComments: TCaptionMemo [10]
     196  object memComments: TCaptionMemo [17]
    117197    Left = 214
    118     Top = 120
    119     Width = 384
     198    Top = 121
     199    Width = 437
    120200    Height = 66
    121201    Lines.Strings = (
    122202      'memComments')
    123203    ScrollBars = ssVertical
    124     TabOrder = 4
     204    TabOrder = 13
    125205    OnChange = ControlChange
    126206    Caption = 'Comments'
    127207  end
    128   object txtSelected: TCaptionEdit [11]
     208  object txtSelected: TCaptionEdit [18]
    129209    Tag = -1
    130210    Left = 416
    131     Top = 44
     211    Top = 45
    132212    Width = 45
    133213    Height = 19
    … …  
    141221    Caption = 'Volume'
    142222  end
    143   object cboSelected: TCaptionComboBox [12]
     223  object cboSelected: TCaptionComboBox [19]
    144224    Tag = -1
    145225    Left = 460
    146     Top = 44
     226    Top = 45
    147227    Width = 53
    148228    Height = 21
    … …  
    151231    ItemHeight = 13
    152232    ParentCtl3D = False
    153     TabOrder = 1
     233    TabOrder = 4
    154234    Visible = False
    155235    OnChange = cboSelectedChange
    … …  
    158238  end
    159239  inherited memOrder: TCaptionMemo
    160     Top = 255
     240    Top = 359
    161241    Width = 475
    162     TabOrder = 10
    163   end
    164   inherited cmdAccept: TButton
    165     Left = 495
    166     Top = 255
    167     TabOrder = 8
    168   end
    169   inherited cmdQuit: TButton
    170     Left = 495
    171     Top = 282
    172     TabOrder = 9
    173   end
    174   inherited pnlMessage: TPanel
    175     Top = 237
     242    TabStop = True
     243    TabOrder = 16
     244    ExplicitTop = 359
     245    ExplicitWidth = 475
     246  end
     247  object pnlXDuration: TPanel [21]
     248    Left = 184
     249    Top = 252
     250    Width = 150
     251    Height = 21
     252    BevelOuter = bvNone
    176253    TabOrder = 11
    177   end
    178   object pnlXDuration: TPanel
    179     Left = 229
    180     Top = 210
    181     Width = 121
    182     Height = 21
    183     BevelOuter = bvNone
    184     TabOrder = 7
    185254    OnEnter = pnlXDurationEnter
    186     DesignSize = (
    187       121
    188       21)
    189     object btnXDuration: TBitBtn
    190       Left = 69
    191       Top = 1
    192       Width = 50
    193       Height = 20
    194       Anchors = [akLeft, akTop, akRight, akBottom]
    195       Caption = 'days'
    196       TabOrder = 1
    197       OnClick = btnXDurationClick
    198       Glyph.Data = {
    199         AE000000424DAE0000000000000076000000280000000E000000070000000100
    200         0400000000003800000000000000000000001000000000000000000000000000
    201         8000008000000080800080000000800080008080000080808000C0C0C0000000
    202         FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    203         330033333333333333003330333333733300330003333F87330030000033FFFF
    204         F30033333333333333003333333333333300}
    205       Layout = blGlyphRight
    206       NumGlyphs = 2
    207       Spacing = 0
    208     end
    209255    object txtXDuration: TCaptionEdit
    210256      Left = 0
    … …  
    217263      Caption = 'Duration'
    218264    end
    219   end
    220   object pnlCombo: TPanel
    221     Left = 8
    222     Top = 1
     265    object cboDuration: TComboBox
     266      Left = 70
     267      Top = 0
     268      Width = 75
     269      Height = 21
     270      ItemHeight = 13
     271      TabOrder = 2
     272      OnChange = cboDurationChange
     273      OnEnter = cboDurationEnter
     274    end
     275  end
     276  object pnlCombo: TPanel [22]
     277    Left = 8
     278    Top = 2
    223279    Width = 200
    224280    Height = 185
    225281    BevelOuter = bvNone
    226     TabOrder = 17
     282    TabOrder = 25
    227283    object cboAdditive: TORComboBox
    228284      Left = 0
    … …  
    260316      Align = alTop
    261317      TabHeight = 15
    262       TabOrder = 1
     318      TabOrder = 2
    263319      Tabs.Strings = (
    264320        '   Solutions   '
    … …  
    290346      SynonymChars = '<>'
    291347      TabPositions = '20'
    292       TabOrder = 2
     348      TabOrder = 1
    293349      OnExit = cboSolutionExit
    294350      OnMouseClick = cboSolutionMouseClick
    … …  
    297353    end
    298354  end
    299   object popDuration: TPopupMenu
    300     AutoHotkeys = maManual
    301     Left = 387
    302     Top = 91
    303     object popL: TMenuItem
    304       Tag = 1
    305       Caption = 'L'
    306       OnClick = popDurationClick
    307     end
    308     object popML: TMenuItem
    309       Tag = 2
    310       Caption = 'ml'
    311       OnClick = popDurationClick
    312     end
    313     object popDays: TMenuItem
    314       Tag = 3
    315       Caption = 'days'
    316       OnClick = popDurationClick
    317     end
    318     object popHours: TMenuItem
    319       Tag = 4
    320       Caption = 'hours'
    321       OnClick = popDurationClick
    322     end
     355  object cboRoute: TORComboBox [23]
     356    Left = 8
     357    Top = 211
     358    Width = 168
     359    Height = 21
     360    Style = orcsDropDown
     361    AutoSelect = True
     362    Color = clWindow
     363    DropDownCount = 8
     364    ItemHeight = 13
     365    ItemTipColor = clWindow
     366    ItemTipEnable = True
     367    ListItemsOnly = False
     368    LongList = False
     369    LookupPiece = 0
     370    MaxLength = 0
     371    Pieces = '2'
     372    Sorted = False
     373    SynonymChars = '<>'
     374    TabOrder = 3
     375    OnChange = cboRouteChange
     376    OnClick = cboRouteClick
     377    OnExit = cboRouteExit
     378    CharsNeedMatch = 1
     379    UniqueAutoComplete = True
     380  end
     381  object cboSchedule: TORComboBox [24]
     382    Left = 304
     383    Top = 211
     384    Width = 129
     385    Height = 21
     386    Style = orcsDropDown
     387    AutoSelect = True
     388    Color = clWindow
     389    DropDownCount = 8
     390    ItemHeight = 13
     391    ItemTipColor = clWindow
     392    ItemTipEnable = True
     393    ListItemsOnly = False
     394    LongList = False
     395    LookupPiece = 1
     396    MaxLength = 0
     397    Pieces = '1'
     398    Sorted = True
     399    SynonymChars = '<>'
     400    TabOrder = 6
     401    OnChange = cboScheduleChange
     402    OnClick = cboScheduleClick
     403    OnExit = cboScheduleExit
     404    CharsNeedMatch = 1
     405    UniqueAutoComplete = True
     406  end
     407  object cboType: TComboBox [25]
     408    Left = 184
     409    Top = 211
     410    Width = 114
     411    Height = 21
     412    ItemHeight = 13
     413    ParentShowHint = False
     414    ShowHint = True
     415    TabOrder = 5
     416    OnChange = cboTypeChange
     417  end
     418  object chkPRN: TCheckBox [26]
     419    Left = 436
     420    Top = 213
     421    Width = 45
     422    Height = 21
     423    Caption = 'PRN'
     424    TabOrder = 7
     425    OnClick = chkPRNClick
     426  end
     427  object chkDoseNow: TCheckBox [27]
     428    Left = 8
     429    Top = 279
     430    Width = 147
     431    Height = 17
     432    Anchors = [akLeft]
     433    Caption = 'Give Additional Dose Now'
     434    Constraints.MinWidth = 147
     435    TabOrder = 12
     436    OnClick = chkDoseNowClick
     437  end
     438  object cboInfusionTime: TComboBox [28]
     439    Left = 576
     440    Top = 211
     441    Width = 74
     442    Height = 21
     443    ItemHeight = 13
     444    TabOrder = 9
     445    OnChange = cboInfusionTimeChange
     446    OnEnter = cboInfusionTimeEnter
     447  end
     448  object lblAdminTime: TVA508StaticText [29]
     449    Name = 'lblAdminTime'
     450    Left = 8
     451    Top = 308
     452    Width = 4
     453    Height = 4
     454    Alignment = taLeftJustify
     455    ParentShowHint = False
     456    ShowHint = True
     457    TabOrder = 14
     458    TabStop = True
     459    Visible = False
     460    ShowAccelChar = True
     461  end
     462  object lblFirstDose: TVA508StaticText [30]
     463    Name = 'lblFirstDose'
     464    Left = 8
     465    Top = 323
     466    Width = 4
     467    Height = 4
     468    Alignment = taLeftJustify
     469    TabOrder = 15
     470    TabStop = True
     471    Visible = False
     472    ShowAccelChar = True
     473  end
     474  inherited cmdAccept: TButton
     475    Left = 495
     476    Top = 359
     477    TabOrder = 17
     478    ExplicitLeft = 495
     479    ExplicitTop = 359
     480  end
     481  inherited cmdQuit: TButton
     482    Left = 495
     483    Top = 386
     484    TabOrder = 18
     485    ExplicitLeft = 495
     486    ExplicitTop = 386
     487  end
     488  inherited pnlMessage: TPanel
     489    Left = 56
     490    Top = 349
     491    TabOrder = 19
     492    ExplicitLeft = 56
     493    ExplicitTop = 349
     494  end
     495  inherited amgrMain: TVA508AccessibilityManager
     496    Data = (
     497      (
     498        'Component = txtRate'
     499        'Status = stsDefault')
     500      (
     501        'Component = cboPriority'
     502        'Status = stsDefault')
     503      (
     504        'Component = grdSelected'
     505        'Status = stsDefault')
     506      (
     507        'Component = cmdRemove'
     508        'Status = stsDefault')
     509      (
     510        'Component = memComments'
     511        'Status = stsDefault')
     512      (
     513        'Component = txtSelected'
     514        'Status = stsDefault')
     515      (
     516        'Component = cboSelected'
     517        'Status = stsDefault')
     518      (
     519        'Component = pnlXDuration'
     520        'Status = stsDefault')
     521      (
     522        'Component = txtXDuration'
     523        'Status = stsDefault')
     524      (
     525        'Component = pnlCombo'
     526        'Status = stsDefault')
     527      (
     528        'Component = cboAdditive'
     529        'Status = stsDefault')
     530      (
     531        'Component = tabFluid'
     532        'Status = stsDefault')
     533      (
     534        'Component = cboSolution'
     535        'Status = stsDefault')
     536      (
     537        'Component = cboRoute'
     538        'Status = stsDefault')
     539      (
     540        'Component = cboSchedule'
     541        'Status = stsDefault')
     542      (
     543        'Component = cboType'
     544        'Status = stsDefault')
     545      (
     546        'Component = chkPRN'
     547        'Status = stsDefault')
     548      (
     549        'Component = chkDoseNow'
     550        'Status = stsDefault')
     551      (
     552        'Component = memOrder'
     553        'Status = stsDefault')
     554      (
     555        'Component = cmdAccept'
     556        'Status = stsDefault')
     557      (
     558        'Component = cmdQuit'
     559        'Status = stsDefault')
     560      (
     561        'Component = pnlMessage'
     562        'Status = stsDefault')
     563      (
     564        'Component = memMessage'
     565        'Status = stsDefault')
     566      (
     567        'Component = frmODMedIV'
     568        'Status = stsDefault')
     569      (
     570        'Component = cboInfusionTime'
     571        'Status = stsDefault')
     572      (
     573        'Component = cboDuration'
     574        'Status = stsDefault')
     575      (
     576        'Component = lblAdminTime'
     577        'Status = stsDefault')
     578      (
     579        'Component = lblFirstDose'
     580        'Status = stsDefault'))
    323581  end
    324582end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal;
     7  fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal, strUtils,
     8  VA508AccessibilityManager, VAUtils, fIVRoutes;
    89
    910type
    … …  
    1920    txtSelected: TCaptionEdit;
    2021    cboSelected: TCaptionComboBox;
    21     popDuration: TPopupMenu;
    22     popML: TMenuItem;
    23     popDays: TMenuItem;
    24     popHours: TMenuItem;
    25     popL: TMenuItem;
    2622    pnlXDuration: TPanel;
    2723    txtXDuration: TCaptionEdit;
    2824    lblLimit: TLabel;
    29     btnXDuration: TBitBtn;
    3025    pnlCombo: TPanel;
    3126    cboAdditive: TORComboBox;
    … …  
    3429    lblPriority: TLabel;
    3530    cboPriority: TORComboBox;
     31    Label1: TLabel;
     32    cboRoute: TORComboBox;
     33    cboSchedule: TORComboBox;
     34    lblRoute: TLabel;
     35    lblSchedule: TLabel;
     36    cboType: TComboBox;
     37    lblType: TLabel;
     38    chkPRN: TCheckBox;
     39    txtNSS: TLabel;
     40    chkDoseNow: TCheckBox;
     41    cboInfusionTime: TComboBox;
     42    cboDuration: TComboBox;
     43    lblAdminTime: TVA508StaticText;
     44    lblFirstDose: TVA508StaticText;
     45    txtAllIVRoutes: TLabel;
     46    lblTypeHelp: TLabel;
    3647    procedure FormCreate(Sender: TObject);
    3748    procedure tabFluidChange(Sender: TObject);
    38     procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
     49    procedure  cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
    3950      InsertAt: Integer);
    4051    procedure cboSolutionNeedData(Sender: TObject; const StartFrom: string; Direction,
    … …  
    5970    procedure grdSelectedMouseDown(Sender: TObject; Button: TMouseButton;
    6071      Shift: TShiftState; X, Y: Integer);
    61     procedure btnXDurationClick(Sender: TObject);
    62     procedure popDurationClick(Sender: TObject);
    6372    procedure txtXDurationChange(Sender: TObject);
    6473    procedure pnlXDurationEnter(Sender: TObject);
    6574    procedure txtXDurationExit(Sender: TObject);
    66     procedure txtRateExit(Sender: TObject);
     75    procedure cboScheduleChange(Sender: TObject);
     76    procedure cboTypeChange(Sender: TObject);
     77    procedure cboRouteChange(Sender: TObject);
     78    procedure txtRateChange(Sender: TObject);
     79    procedure cboPriorityChange(Sender: TObject);
     80    procedure cboPriorityExit(Sender: TObject);
     81    procedure cboRouteExit(Sender: TObject);
     82    procedure txtNSSClick(Sender: TObject);
     83    procedure cboScheduleClick(Sender: TObject);
     84    procedure chkPRNClick(Sender: TObject);
     85    procedure chkDoseNowClick(Sender: TObject);
     86    procedure loadExpectFirstDose;
     87    procedure SetSchedule(const x: string);
     88    procedure cboScheduleExit(Sender: TObject);
     89    procedure cboInfusionTimeChange(Sender: TObject);
     90    procedure cboDurationChange(Sender: TObject);
     91    procedure cboDurationEnter(Sender: TObject);
     92    procedure cboInfusionTimeEnter(Sender: TObject);
     93    procedure txtAllIVRoutesClick(Sender: TObject);
     94    procedure cboRouteClick(Sender: TObject);
     95    procedure lblTypeHelpClick(Sender: TObject);
    6796  private
    6897    FInpatient: Boolean;
     98    FNSSAdminTime: string;
     99    FNSSScheduleType: string;
     100    OSolIEN: integer;
     101    OAddIEN: integer;
     102    OSchedule: string;
     103    oAdmin: string;
     104    Action: integer;
     105    OrderIEN: string;
     106    FAdminTimeText: string;
     107    JAWSON: boolean;
     108    FOriginalDurationType: integer;
     109    FOriginalInfusionType: integer;
     110    FInitialOrderID: boolean;
    69111    procedure SetValuesFromResponses;
    70112    procedure DoSetFontSize( FontSize: integer);
    71113    procedure ClickOnGridCell;
    72114    procedure SetLimitationControl(aValue: string);
     115    function CreateOtherSchedule: string;
     116    function CreateOtherRoute: string;
     117    procedure UpdateRoute;
     118    procedure DisplayDoseNow(Status: boolean);
     119    procedure UpdateDuration(SchType: string);
     120    procedure ClearAllFields;
    73121  public
    74122    procedure InitDialog; override;
    … …  
    76124    procedure Validate(var AnErrMsg: string); override;
    77125    procedure SetFontSize( FontSize: integer); override;
     126    function ValidateInfusionRate(Rate: string): string;
     127    function IVTypeHelpText: string;
     128    property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
     129    property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
    78130  end;
    79131
    … …  
    85137{$R *.DFM}
    86138
    87 uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid, fFrame;
     139uses ORFn, uConst, rODMeds, rODBase, fFrame, uCore, fOtherSchedule, rCore;
    88140
    89141const
    … …  
    108160  TX_NO_UNITS  = 'Units must be entered for ';
    109161  TX_NO_RATE   = 'An infusion rate must be entered.';
    110   TX_BAD_RATE  = 'The infusion rate must be:  # ml/hr  or  text@labels per day';
     162  //TX_BAD_RATE  = 'The infusion rate must be:  # ml/hr  or  text@labels per day';
     163  TX_BAD_RATE =  'Infusion rate can only be up to 4 digits long or' + CRLF + 'Infusion rate must be # ml/hr or text@labels per day';
     164  TX_NO_INFUSION_TIME = 'An Infusion length must be entered or the Unit of Time for the Infuse Over Time field needs to be cleared out.';
     165  TX_NO_SCHEDULE = 'A schedule is required for an intermittent order.';
     166  TX_BAD_SCHEDULE = 'Unable to resolve non-standard schedule.';
     167  TX_NO_INFUSION_UNIT = 'Invalid Unit of Time, select either "Minutes" or "Hours" for the Infusion Length';
     168  TX_BAD_ROUTE = 'Route cannot be free-text';
     169  TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value';
    111170
    112171(*
    … …  
    131190begin
    132191  frmFrame.pnlVisit.Enabled := false;
     192  //AutoSizeDisabled := true;
    133193  inherited;
    134194  AllowQuickOrder := True;
    … …  
    147207  CtrlInits.LoadDefaults(ODForIVFluids);         // ODForIVFluids returns TStrings with defaults
    148208  InitDialog;
    149   TAccessibleStringGrid.WrapControl(grdSelected);
    150209end;
    151210
    … …  
    154213  i: Integer;
    155214begin
    156   TAccessibleStringGrid.UnwrapControl(grdSelected);
    157215  with grdSelected do for i := 0 to RowCount - 1 do TIVComponent(Objects[0, i]).Free;
    158216  inherited;
    … …  
    161219
    162220procedure TfrmODMedIV.FormResize(Sender: TObject);
     221var
     222bottom: integer;
    163223begin
    164224  inherited;
    … …  
    170230  end;
    171231  lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0];
     232  self.cboType.SelLength := 0;
     233  self.cboInfusionTime.SelLength := 0;
     234  self.cboDuration.SelLength := 0;
     235  bottom := self.cboPriority.Top + self.cboPriority.Height;
     236  if self.chkDoseNow.Top < bottom then self.chkDoseNow.Top := bottom + 5;
     237  self.txtRate.Height := self.cboInfusionTime.Height;
     238  self.txtXDuration.Height := self.cboDuration.Height;
     239  self.lblAdminTime.Height := TextHeightByFont(self.lblAdminTime.Font.Handle, 'A');
     240  self.lblFirstDose.Height := TextHeightByFont(self.lblFirstDose.Font.Handle, 'A');
     241  self.lblAdminTime.Width := TextWidthByFont(self.lblAdminTime.Font.Handle, self.lblAdminTime.Caption + '  ');
     242  self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + '  ');
     243  self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2;
     244  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;
     248      self.memOrder.Top := self.Label1.Top + self.Label1.Height;
     249    end;
    172250end;
    173251
    … …  
    182260  inherited;
    183261  //grdSelected.Selection := NOSELECTION;
     262  //FRouteConflict := False;
     263  //lblTypeHelp.Hint := IVTypeHelpText;
     264  lblType.Hint := IVTypeHelpText;
     265  cboType.Hint := IVTYpeHelpText;
    184266  with grdSelected do for i := 0 to RowCount - 1 do
    185267  begin
    … …  
    194276    cboSolution.InsertSeparator;
    195277    SetControl(cboPriority, 'Priorities');
     278    cboType.Items.Add('Continuous');
     279    cboType.Items.Add('Intermittent');
     280    cboType.ItemIndex := -1;
     281    cboType.SelLength := 0;
     282    //SetControl(cboRoute, 'Route');
     283    if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := '';
     284    //SetControl(cboSchedule, 'Schedules');
     285    LoadSchedules(cboSchedule.Items, patient.Inpatient);
     286    //if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then
     287    if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER');
     288
     289    cboSchedule.Enabled := False;
     290    lblschedule.Enabled := False;
     291    if cboInfusionTime.Items.Count = 0 then
     292       begin
     293        cboInfusionTime.Items.add('Minutes');
     294        cboInfusionTime.Items.Add('Hours');
     295       end;
     296    cboInfusionTime.Enabled := false;
     297    updateDuration('');
     298    if cboDuration.Items.Count = 0 then
     299      begin
     300        cboDuration.Items.Add('L');
     301        cboDuration.Items.Add('ml');
     302        cboDuration.Items.Add('days');
     303        cboDuration.Items.Add('hours');
     304      end;
     305    cboDuration.ItemIndex := -1;
     306    cboDuration.Text := '';
     307    if self.txtXDuration.Text <> '' then self.txtXDuration.Text := '';
     308    txtNSS.Visible := false;
     309    if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false;
     310    chkDoseNow.Visible := false;
     311    chkPRN.Enabled := false;
    196312  end;
    197313  tabFluid.TabIndex := 0;
    … …  
    199315  cboSolution.InitLongList('');
    200316  cboAdditive.InitLongList('');
     317  JAWSON := true;
     318  if ScreenReaderActive = false then
     319    begin
     320      lblAdminTime.TabStop := false;
     321      lblFirstDose.TabStop := false;
     322      memOrder.TabStop := false;
     323      JAWSON := false;
     324    end;
    201325  ActiveControl := cboSolution;  //SetFocusedControl(cboSolution);
    202326  StatusText('');
     327  OSolIEN := 0;
     328  OAddIEN := 0;
     329  OSchedule := '';
     330  oAdmin := '';
     331  self.txtAllIVRoutes.Visible := false;
     332end;
     333
     334function TfrmODMedIV.IVTypeHelpText: string;
     335begin
     336   result := 'Continuous Type:' + CRLF + '     IV’s that run at a specified “Rate” ( __ml/hr, __mcg/kg/min, etc)' +
     337             CRLF + CRLF + 'Intermittent Type:' + CRLF +
     338             '     IV’s administered at scheduled intervals (Q4H, QDay) or One-Time only, ' +
     339             CRLF + '     “over a specified time period” (e.g. “Infuse over 30 min.”).' + CRLF + CRLF +
     340             'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB';
     341end;
     342
     343procedure TfrmODMedIV.lblTypeHelpClick(Sender: TObject);
     344var
     345str: string;
     346begin
     347  inherited;
     348    str := IVTypeHelpText;
     349    infoBox(str, 'Informational Help Text', MB_OK);
     350end;
     351
     352
     353procedure TfrmODMedIV.loadExpectFirstDose;
     354var
     355i: integer;
     356AnIVComponent: TIVComponent;
     357fAddIEN, fSolIEN, Interval, idx: integer;
     358AdminTime:    TFMDateTime;
     359Admin, Duration, ShowText, SchTxt, SchType, IVType: string;
     360doseNow, calFirstDose: boolean;
     361begin
     362  idx := self.cboSchedule.ItemIndex;
     363  IVType := self.cboType.Items.Strings[self.cboType.itemindex];
     364  if idx = -1 then
     365    begin
     366      if IVType = 'Continuous' then
     367        begin
     368          self.lblFirstDose.Caption := '';
     369          self.lblFirstDose.Visible := false;
     370        end;
     371      exit;
     372    end;
     373  doseNow := true;
     374  SchType := Piece(self.cboSchedule.Items.Strings[idx],U,3);
     375  if self.EvtID > 0 then doseNow := false;
     376  if (IVType = 'Continuous') or ((idx > -1) and ((SchType = 'P') or (SchType = 'O') or (SchType = 'OC')) or
     377     (self.chkPRN.Checked = True))  then
     378     begin
     379       self.lblFirstDose.Caption := '';
     380       self.lblAdminTime.Caption := '';
     381       self.lblFirstDose.Visible := false;
     382       self.lblAdminTime.Visible := false;
     383       self.lblAdminTime.TabStop := false;
     384       self.lblFirstDose.TabStop := false;
     385       if (self.cboType.Text = 'Continuous') or (Piece(self.cboSchedule.Items.Strings[idx],U,3) = 'O') then doseNow := false;
     386       if chkDoseNow.Checked = true then lblFirstDose.Visible := false;
     387       if idx > -1 then oSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1);
     388       if (self.chkPRN.Checked = True) and (idx > -1) and (LeftStr(Piece(self.cboSchedule.Items.Strings[idx],U,1),3)<> 'PRN') then
     389          OSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1) + ' PRN';
     390       DisplayDoseNow(doseNow);
     391       exit;
     392       //  end;
     393     end
     394  else if SchType <> 'O' then
     395    begin
     396      self.lblAdminTime.Visible := true;
     397      if FAdminTimeText <> '' then self.lblAdminTime.Caption := 'Admin. Time: ' + FAdminTimeText
     398      else if Piece(self.cboSchedule.Items[idx],U,4) <> '' then
     399           self.lblAdminTime.Caption := 'Admin. Time: ' + Piece(self.cboSchedule.Items[idx],U,4)
     400      else self.lblAdminTime.Caption := 'Admin. Time: Not Defined';
     401    end;
     402 DisplayDoseNow(doseNow);
     403 if chkDoseNow.Checked = true then
     404   begin
     405     lblFirstDose.Visible := false;
     406     Exit;
     407   end;
     408 self.lblFirstDose.Visible := True;
     409 fSolIEN := 0;
     410 fAddIEN := 0;
     411 for i := 0 to self.grdSelected.RowCount - 1 do
     412  begin
     413   AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]);
     414   if AnIVComponent = nil then Continue;
     415   if (AnIVComponent.Fluid = 'B') and (fSolIEN = 0) then fSolIEN := AnIVComponent.IEN;
     416   if (AnIVComponent.Fluid = 'A') and (fAddIEN = 0) then fAddIEN := AnIVComponent.IEN;
     417   if (fSolIEN > 0) and (fAddIEN > 0) then break;
     418  end;
     419  SchTxt := self.cboSchedule.Text;
     420  Admin := '';
     421  if (self.lblAdminTime.visible = True) and (self.lblAdminTime.Caption <> '') then
     422    begin
     423      Admin := Copy(self.lblAdminTime.Caption,  14, (Length(self.lblAdminTime.Caption)-1));
     424      if not (Admin[1] in ['0'..'9']) then Admin := '';
     425    end;
     426  if (fSolIEN = oSolIEN) and (fAddIEN = oAddIEN) and (OSchedule = SchTxt) and (oAdmin = Admin) then CalFirstDose := false
     427  else
     428    begin
     429      CalFirstDose := True;
     430      oSolIEN := fSolIEN;
     431      oAddIEN := fAddIEN;
     432      oSchedule := SchTxt;
     433      oAdmin := Admin;
     434    end;
     435  if CalFirstDose = True then
     436  begin
     437    if fAddIEN > 0 then LoadAdminInfo(';' + schTxt, fAddIEN, ShowText, AdminTime, Duration, Admin)
     438    else LoadAdminInfo(';' + schTxt, fSolIEN, ShowText, AdminTime, Duration, Admin);
     439    if AdminTime > 0 then
     440      begin
     441        ShowText := 'Expected First Dose: ';
     442        Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
     443        case Interval of
     444        0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
     445        1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
     446        else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
     447      end;
     448    end;
     449    self.lblFirstDose.Caption := ShowText;
     450  end;
     451  if (self.lblFirstDose.Visible = true) and (self.lblFirstDose.Caption <> '') and (JAWSON = true) then self.lblFirstDose.TabStop := true
     452  else self.lblFirstDose.TabStop := false;
     453  if (self.lblAdminTime.Visible = true) and (self.lblAdminTime.Caption <> '') and (JAWSON = true) then self.lblAdminTime.TabStop := true
     454  else self.lblAdminTime.TabStop := false;
    203455end;
    204456
    205457procedure TfrmODMedIV.Validate(var AnErrMsg: string);
    206458var
    207   ItemOK: Boolean;
    208   x: string;
    209   i: Integer;
     459  DispWarning, ItemOK, Result: Boolean;
     460  LDec,RDec,x, tempStr, iunit, infError: string;
     461  digits, i, j, Len, temp, Value: Integer;
    210462
    211463  procedure SetError(const x: string);
    … …  
    221473    ItemOK := False;
    222474    for i := 0 to RowCount - 1 do
    223       if TIVComponent(Objects[0, i]).Fluid = 'B' then ItemOK := True;
    224     if not ItemOK then SetError(TX_NO_BASE);
     475      if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'B') then ItemOK := True;
     476    if (not ItemOK) and ((self.cboType.ItemIndex = -1) or (MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous')) then
     477        SetError(TX_NO_BASE);
    225478    for i := 0 to RowCount - 1 do
    226479    begin
    … …  
    229482      if (Objects[0, i] <> nil) and (Length(Cells[2, i]) = 0)
    230483        then SetError(TX_NO_UNITS + Cells[0, i]);
    231     end;
    232   end;
    233   if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else
    234   begin
    235     x := Trim(txtRate.Text);
    236     ValidateIVRate(x);
    237     if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x);
    238   end;
     484      if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'A') then
     485        begin
     486          temp := Pos('.', Cells[1, i]);
     487          if temp > 0 then
     488            begin
     489              tempStr := Cells[1, i];
     490               if temp = 1 then
     491                 begin
     492                   SetError(cells[0, i] + TX_LEADING_NUMERIC);
     493                   Exit;
     494                 end;
     495              for j := 1 to temp -1 do if not (tempStr[j] in ['0'..'9']) then
     496                begin
     497                  SetError(cells[0, i] + TX_LEADING_NUMERIC);
     498                  Exit;
     499                end;
     500            end;
     501        end;
     502  end;
     503  end;
     504  if Pos(U, self.memComments.Text) > 0 then SetError('Comments cannot contain a "^".'); 
     505  if cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3));
     506  if self.cboPriority.Text = '' then SetError('Priority is required');
     507  if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then SetError(TX_BAD_ROUTE);
     508  if (cboRoute.ItemIndex > -1) and (cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER')) then
     509      SetError('A valid route must be selected');
     510  if self.cboRoute.Text = '' then SetError('Route is required');
     511  if (self.txtXDuration.Text <> '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) = -1) then
     512      SetError('A valid duration type is required');
     513  if (self.txtXDuration.Text = '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) > -1) then
     514     SetError('Cannot have a duration type without a duration value');
     515
     516  if self.cboType.ItemIndex = -1 then
     517    begin
     518      SetError('IV Type is required');
     519      Exit;
     520    end;
     521  if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous' then
     522     begin
     523      if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else
     524        begin
     525          x := Trim(txtRate.Text);
     526          if pos('@', X) > 0 then
     527            begin
     528            LDec := Piece(x, '@', 1);
     529            RDec := Piece(x, '@', 2);
     530            if (Length(RDec) = 0) or (Length(RDec) > 2) then x := '';
     531            end
     532          else if Pos('.',X)>0 then
     533            begin
     534              LDec := Piece(x, '.', 1);
     535              RDec := Piece(x, '.', 2);
     536              if Length(LDec) = 0 then SetError('Infusion Rate required a leading numeric value');
     537              if Length(RDec) > 1 then SetError('Infusion Rate cannot exceed one decimal place');
     538            end
     539            else if LeftStr(txtRate.Text, 1) = '0' then
     540               SetError('Infusion Rate cannot start with a zero.');
     541          if ( Pos('@',x)=0) then
     542            begin
     543              if (Length(x) > 4) then
     544                begin
     545                  seterror(TX_BAD_RATE);
     546                  exit;
     547                end;
     548              for i := 1 to Length(x) do
     549                begin
     550                  if  not (x[i] in ['0'..'9']) and (x[i] <> '.') then
     551                    begin
     552                      SetError(TX_BAD_RATE);
     553                      exit;
     554                    end;
     555                end;
     556            end;
     557          if (pos('ml/hr', X) = 0) and (Length(x) > 0) and (pos('@', X) = 0) then X := X + ' ml/hr';
     558          if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x);
     559        end;
     560      if cboduration.text = 'doses' then SetError('Continuous Orders cannot have "doses" as a duration type');
     561    end
     562  else if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Intermittent' then
     563     begin
     564      if (cboInfusionTime.ItemIndex = -1) and (txtRate.Text <> '') then SetError(TX_NO_INFUSION_UNIT);
     565      if (txtRate.Text = '') and (cboInfusionTime.ItemIndex > -1) then SetError(TX_NO_INFUSION_TIME);
     566      if (txtRate.Text <> '') then
     567        begin
     568          infError := '';
     569          InfError := ValidateInfusionRate(txtRate.Text);
     570          if infError <> '' then SetError(InfError);
     571          Len := Length(txtRate.Text);
     572          iunit := MixedCase(self.cboInfusionTime.Items.Strings[cboInfusionTime.ItemIndex]);
     573          if (iunit = 'Minutes') and (Len > 4) then setError('Infuse Over Time cannot exceed 4 spaces for ' + iunit)
     574          else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit);
     575        end;
     576      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '')  then SetError(TX_NO_SCHEDULE);
     577      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE);
     578    end;
     579  if txtXDuration.Text = '' then
     580    begin
     581      if AnErrMsg = '' then self.FInitialOrderID := True;
     582      exit;
     583    end;
     584  Len := Length(txtXDuration.Text);
     585  if LeftStr(txtXDuration.Text,1) <> '.' then
     586    begin
     587      DispWarning := false;
     588      Digits := 2;
     589      if cboDuration.text = 'ml' then digits := 4;
     590      if ((cboDuration.text = 'days') or (cboDuration.text = 'hours')) and (Len > digits) then
     591          DispWarning := true
     592      else if (cboduration.text = 'ml') and (Len > digits) then  DispWarning := true
     593      else if (cboduration.text = 'L') and (Len > digits) and (Pos('.',txtXDuration.Text) = 0) then DispWarning := True;
     594      if DispWarning = true then SetError('Duration for ' + cboduration.text + ' cannot be greater than ' + InttoStr(digits) + ' digits.');
     595    end;
     596  if (Pos('.', txtXDuration.Text)>0)  then
     597  begin
     598    SetError('Invalid Duration, please enter a whole numbers for a duration.');
     599  end
     600  else if LeftStr(txtXDuration.text, 1) = '0' then
     601       SetError('Duration cannot start with a zero.');
     602  if (cboduration.text = 'doses') then
     603     begin
     604       if TryStrToInt(txtXDuration.Text, Value) = false then
     605         SetError('Duration with a unit of "doses" must be a whole number between 0 and 2000000')
     606       else if (Value < 0) or (Value > 2000000) then
     607         SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000');
     608     end;
     609  if AnErrMsg = '' then self.FInitialOrderID := True;
     610 
     611end;
     612
     613function TFrmODMedIV.ValidateInfusionRate(Rate: string): string;
     614var
     615Temp: Boolean;
     616i: integer;
     617begin
     618  Temp := False;
     619  if Pos('.',Rate) >0 then
     620    begin
     621      Result := 'Infuse Over Time can only be a whole number';
     622      exit;
     623    end
     624  else if LeftStr(Rate, 1) = '0' then Result := 'Infuse Over Time cannot start with a zero.';
     625  for i := 1 to Length(Rate) do if not (Rate[i] in ['0'..'9']) then Temp := True;
     626  if Temp = True then Result := 'The Infusion time can only be a whole number';
    239627end;
    240628
    241629procedure TfrmODMedIV.SetValuesFromResponses;
    242630var
    243   x: string;
    244   AnInstance: Integer;
     631  x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string;
     632  AnInstance, i, idx: Integer;
    245633  AResponse: TResponse;
    246634  AnIVComponent: TIVComponent;
     635  AllIVRoute: TStringList;
     636  PQO: boolean;
    247637begin
    248638  Changing := True;
     639  self.FInitialOrderID := false;
    249640  with Responses do
    250641  begin
    … …  
    265656            InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
    266657            cboAdditive.Text := '';
     658            AbortOrder := True;
    267659            Exit;
    268660          end;
    … …  
    273665            InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
    274666            cboAdditive.Text := '';
     667            AbortOrder := True;
    275668            Exit;
    276669          end;
    … …  
    310703            InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
    311704            cboAdditive.Text := '';
     705            AbortOrder := True;
    312706            Exit;
    313707          end;
    … …  
    318712            InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
    319713            cboAdditive.Text := '';
     714            AbortOrder := true;
    320715            Exit;
    321716          end;
    … …  
    342737      AnInstance := NextInstance('ADDITIVE', AnInstance);
    343738    end; {while AnInstance - ADDITIVE}
    344     SetControl(txtRate,     'RATE',    1);
    345     if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm '             {*kcm*}
    346       then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
     739    SetControl(cboType, 'TYPE', 1);
     740    if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;   
     741    updateRoute;
     742    AResponse := FindResponseByName('ROUTE', 1);
     743    if AResponse <> nil then
     744      begin
     745        tempRoute := AResponse.EValue;
     746        if tempRoute <> '' then
     747          begin
     748           idx := self.cboRoute.Items.IndexOf(tempRoute);
     749           if idx > -1 then self.cboRoute.ItemIndex := idx
     750           else begin
     751             tempIRoute := AResponse.IValue;
     752             if tempIRoute <> '' then
     753               begin
     754                AllIVRoute := TStringList.Create;
     755                LoadAllIVRoutes(AllIVRoute);
     756                idx := -1;
     757                for i := 0 to AllIVRoute.Count - 1 do
     758                  begin
     759                    if Piece(AllIVRoute.Strings[i], U, 1) = tempIRoute then
     760                      begin
     761                        idx := i;
     762                        break;
     763                      end;
     764                  end;
     765                if idx > -1 then
     766                  begin
     767                    self.cboRoute.Items.Add(AllIVRoute.Strings[idx]);
     768                    idx := self.cboRoute.Items.IndexOf(tempRoute);
     769                    if idx > -1 then self.cboRoute.ItemIndex := idx;
     770                  end;
     771                  AllIVRoute.Free;
     772                //if Pos(U, tempIRoute) = 0 then tempIRoute := tempIRoute + U + tempRoute;
     773                //self.cboRoute.Items.Add(tempIRoute);
     774                //idx := self.cboRoute.Items.IndexOf(tempRoute);
     775                //if idx > -1 then self.cboRoute.ItemIndex := idx;
     776               end;
     777           end;
     778          end;
     779      end;
     780    //SetControl(cboRoute, 'ROUTE', 1);
     781    if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := '';
     782    if self.cboType.Text = 'Intermittent' then
     783      begin
     784         lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
     785         lblSchedule.Enabled := True;
     786         cboschedule.Enabled := True;
     787         //if popDuration.Items.IndexOf(popDoses) = -1 then popDuration.Items.Add(popDoses);
     788         if cboDuration.Items.IndexOf('doses') = -1 then cboDuration.Items.Add('doses');         
     789         txtNss.Visible := true;
     790         chkDoseNow.Visible := true;
     791         chkPRN.Enabled := True;
     792         tempSch := '';
     793         AdminTime := '';
     794         AResponse := FindResponseByName('SCHEDULE', 1);
     795         if AResponse <> nil then tempSch := AResponse.EValue;
     796         lblAdminTime.Visible := True;
     797         lblAdminTime.Hint := AdminTimeHelpText;
     798         lblAdminTime.ShowHint := True;
     799         //AResponse := Responses.FindResponseByName('ADMIN', 1);
     800         //if AResponse <> nil then AdminTime := AResponse.EValue;
     801         //if Action = Order_Copy then FOriginalAdminTime := AdminTime;
     802         SetSchedule(tempSch);
     803         //if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5);
     804         //if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
     805         if (Action in [ORDER_COPY, ORDER_EDIT])  then
     806           begin
     807            TempOrder := Piece(OrderIEN,';',1);
     808            TempOrder := Copy(tempOrder, 2, Length(tempOrder));
     809             if DifferentOrderLocations(tempOrder, Patient.Location) = false then
     810              begin
     811                AResponse := Responses.FindResponseByName('ADMIN', 1);
     812                if AResponse <> nil then AdminTime := AResponse.EValue;
     813                //lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
     814                if cboSchedule.ItemIndex > -1 then
     815                  begin
     816                    tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex];
     817                    setPiece(tmpSch,U,4,AdminTime);
     818                    cboSchedule.Items.Strings[cboSchedule.ItemIndex] := tmpSch;
     819                  end;
     820              end;
     821           end;
     822         //if Piece(lblAdminTime.Caption, ':' ,2) = ' ' then lblAdminTime.Caption := 'Admin. Time: Not Defined';
     823         SetControl(txtRate,     'RATE',    1);
     824         cboInfusionTime.Enabled := true;
     825         PQO := false;
     826         if Pos('INFUSE OVER',UpperCase(txtRate.Text)) > 0 then
     827           begin
     828             txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
     829             PQO := True;
     830           end;
     831         if Pos('MINUTE',UpperCase(txtRate.Text))>0 then
     832           begin
     833             cboInfusionTime.Text := 'Minutes';
     834             cboInfusionTime.itemindex := 0;
     835             //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
     836             txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 8);
     837           end
     838         else if Pos('HOUR',UpperCase(txtRate.Text))>0 then
     839           begin
     840             cboInfusionTime.Text := 'Hours';
     841             cboInfusionTime.ItemIndex := 1;
     842             //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
     843             txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
     844           end
     845         else if (txtRate.Text <> '') and (PQO = false) and (ValidateInfusionRate(txtRate.Text) ='') then
     846           begin
     847             cboInfusionTime.Text := 'Minutes';
     848             cboInfusionTime.itemindex := 0;
     849           end;
     850      end
     851    else
     852      begin
     853        lblSchedule.Enabled := false;
     854        cboSchedule.ItemIndex := -1;
     855        cboSchedule.Enabled := false;
     856        if chkDoseNow.Visible = true then  chkDoseNow.Checked := false;
     857        chkDoseNow.Visible := false;
     858        txtNSS.Visible := false;
     859        cboInfusionTime.ItemIndex := -1;
     860        cboInfusionTime.Text := '';
     861        cboInfusionTime.Enabled := false;
     862        chkPRN.Checked := false;
     863        chkPRN.Enabled := false;
     864        txtRate.Text := '';
     865        cboDuration.ItemIndex := -1;
     866        cboDuration.Text := '';
     867        txtXDuration.Text := '';
     868        SetControl(txtRate,     'RATE',    1);
     869        if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm '             {*kcm*}
     870          then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
     871      end;
    347872    SetControl(cboPriority, 'URGENCY', 1);
    348873    SetControl(memComments, 'COMMENT', 1);
    … …  
    357882  end; {if...with Responses}
    358883  Changing := False;
     884  if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
     885  loadExpectFirstDose;
    359886  ControlChange(Self);
    360887end;
    … …  
    363890begin
    364891  inherited;
    365   if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then SetValuesFromResponses;
     892  Action := OrderAction;
     893  OrderIEN := id;
     894  self.FInitialOrderID := True;
     895  if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
     896  if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then
     897      FAdminTimeText := 'Not defined for Clinic Locations';
     898  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
     899    begin
     900
     901      SetValuesFromResponses;
     902    end;
    366903end;
    367904
    … …  
    400937end;
    401938
     939procedure TfrmODMedIV.cbotypeChange(Sender: TObject);
     940begin
     941  inherited;
     942  //if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then
     943  if (self.cboType.itemIndex = 1) then
     944    begin
     945      cboSchedule.ItemIndex := -1;
     946      lblAdminTime.Caption := '';
     947      lblAdminTime.Visible := false;
     948      lblschedule.Enabled := True;
     949      cboSchedule.Enabled := True;
     950      txtNSS.Visible := true;
     951      chkDoseNow.Checked := false;
     952      chkDoseNow.Visible := true;
     953      chkPRN.Checked := false;
     954      chkPRN.Enabled := True;
     955      lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
     956      cboInfusionTime.Enabled := true;
     957      cboDuration.Items.Add('doses');
     958    end
     959  //else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then
     960  else
     961    begin
     962      lblschedule.Enabled := False;
     963      cboSchedule.ItemIndex := -1;
     964      cboSchedule.Enabled := False;
     965      txtNSS.Visible := false;
     966      chkPRN.Checked := false;
     967      chkPRN.Enabled := false;
     968      if chkDoseNow.Visible = true then chkDoseNow.Checked := false;
     969      chkDoseNow.Visible := false;
     970      lblInfusionRate.Caption := 'Infusion Rate (ml/hr)*';
     971      cboInfusionTime.ItemIndex := -1;
     972      cboInfusionTime.Text := '';
     973      cboInfusionTime.Enabled := false;
     974      lblAdminTime.Visible := false;
     975      updateDuration('');
     976      cboduration.Items.Delete(cboDuration.Items.IndexOf('doses'));
     977    end;
     978  self.txtRate.Text := '';
     979  ControlChange(Sender);
     980end;
     981
     982procedure TfrmODMedIV.chkDoseNowClick(Sender: TObject);
     983Const
     984  T  = '"';
     985  T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication.';
     986  T2 = #13#13'The first order''s administrative schedule is "';
     987  T3 = #13'The second order''s administrative schedule is "';
     988  T4 = #13#13'Do you want to continue?';
     989  T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
     990  T2A = ' in addition to the one you are placing for the same medication.';
     991var
     992  medNm: string;
     993  theSch: string;
     994  //SchID: integer;
     995begin
     996  inherited;
     997  if (chkDoseNow.Checked) then
     998  begin
     999    medNm := 'Test';
     1000    //SchID := cboSchedule.ItemIndex;
     1001    theSch := cboSchedule.Text;
     1002    if length(theSch)>0 then
     1003    begin
     1004      //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
     1006      begin
     1007        chkDoseNow.Checked := False;
     1008        Exit;
     1009      end;
     1010    end else
     1011    begin
     1012      //if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
     1013      if InfoBox(T1A+T2A+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
     1014      begin
     1015        chkDoseNow.Checked := False;
     1016        Exit;
     1017      end;
     1018    end;
     1019  end;
     1020  ControlChange(self);
     1021end;
     1022
     1023procedure TfrmODMedIV.chkPRNClick(Sender: TObject);
     1024begin
     1025  inherited;
     1026  ControlChange(Self);
     1027end;
     1028
    4021029procedure TfrmODMedIV.cboSolutionMouseClick(Sender: TObject);
    4031030var
    4041031  AnIVComponent: TIVComponent;
    405   x: string;
     1032  x,routeIEN: string;
     1033  i: integer;
    4061034begin
    4071035  inherited;
    4081036  if CharAt(cboSolution.ItemID, 1) = 'Q' then              // setup quick order
    4091037  begin
     1038    //Clear pre-existing values
     1039    for i := 0 to self.grdSelected.RowCount do
     1040      begin
     1041         if self.grdSelected.Objects[0,i] <> nil then
     1042           begin
     1043             TIVComponent(self.grdSelected.Objects[0,i]).Free;
     1044             self.grdSelected.Rows[i].Clear;
     1045           end
     1046         else self.grdSelected.Rows[i].clear;
     1047      end;
     1048    self.grdSelected.RowCount := 0;
     1049    ControlChange(Sender);
    4101050    Responses.QuickOrder := ExtractInteger(cboSolution.ItemID);
    4111051    SetValuesFromResponses;
    … …  
    4321072    end;
    4331073  end;
    434 
     1074  RouteIEN := Piece(cboSolution.Items.Strings[cboSolution.itemindex],U,4);
    4351075  x := AmountsForIVFluid(cboSolution.ItemIEN, 'B');
    4361076  AnIVComponent := TIVComponent.Create;
    … …  
    4591099  Application.ProcessMessages;         //CQ: 10157
    4601100  ClickOnGridCell;
     1101  updateRoute;
    4611102  ControlChange(Sender);
     1103  //updateRoute(routeIEN);
    4621104end;
    4631105
    … …  
    4651107begin
    4661108  inherited;
    467   if cboSolution.ItemIEN > 0 then cboSolutionMouseClick(Self);
     1109  if EnterIsPressed then //CQ: 15097
     1110    if (cboSolution.ItemIEN > 0) or
     1111       ((cboSolution.ItemIEN = 0) and (CharAt(cboSolution.ItemID, 1) = 'Q')) then
     1112      cboSolutionMouseClick(Self);
    4681113end;
    4691114
    … …  
    4811126end;
    4821127
     1128procedure TfrmODMedIV.cboDurationChange(Sender: TObject);
     1129begin
     1130  inherited;
     1131  if (FOriginalDurationType > -1) and (FOriginalDurationType <> cboDuration.ItemIndex) then
     1132    begin
     1133      self.txtXDuration.Text := '';
     1134      FOriginalDurationType := cboDuration.ItemIndex;
     1135    end;
     1136  if (FOriginalDurationType = -1) and (cboDuration.ItemIndex > -1) then FOriginalDurationType := cboDuration.ItemIndex;
     1137  controlchange(sender);
     1138end;
     1139
     1140procedure TfrmODMedIV.cboDurationEnter(Sender: TObject);
     1141begin
     1142  inherited;
     1143  FOriginalDurationType := cboDuration.ItemIndex;
     1144end;
     1145
     1146
     1147procedure TfrmODMedIV.cboInfusionTimeChange(Sender: TObject);
     1148begin
     1149  inherited;
     1150  if (FOriginalInfusionType > -1) and (FOriginalInfusionType <> cboInfusionTime.ItemIndex) then
     1151     begin
     1152       self.txtRate.Text := '';
     1153       FOriginalInfusionType := cboInfusionTime.ItemIndex;
     1154     end;
     1155  if (FOriginalInfusionType = -1) and (cboInfusionTime.ItemIndex > -1) then FOriginalInfusionType := cboInfusionTime.ItemIndex;
     1156  ControlChange(Sender);
     1157end;
     1158
     1159procedure TfrmODMedIV.cboInfusionTimeEnter(Sender: TObject);
     1160begin
     1161  inherited;
     1162  FOriginalInfusionType := self.cboInfusionTime.ItemIndex;
     1163end;
     1164
     1165procedure TfrmODMedIV.cboPriorityChange(Sender: TObject);
     1166begin
     1167  inherited;
     1168  ControlChange(sender);
     1169end;
     1170
     1171procedure TfrmODMedIV.cboPriorityExit(Sender: TObject);
     1172begin
     1173  inherited;
     1174  if cboPriority.Text = '' then
     1175    begin
     1176      infoBox('Priority must have a value assigned to it', 'Warning', MB_OK);
     1177      cboPriority.SetFocus;
     1178    end;
     1179end;
     1180
     1181procedure TfrmODMedIV.cboRouteChange(Sender: TObject);
     1182begin
     1183  inherited;
     1184  if cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER') then cboRouteClick(cboRoute);
     1185  ControlChange(sender);
     1186end;
     1187
     1188procedure TfrmODMedIV.cboRouteClick(Sender: TObject);
     1189var
     1190otherRoute, temp: string;
     1191idx, oidx: integer;
     1192begin
     1193  inherited;
     1194  oidx := cboRoute.Items.IndexOf('OTHER');
     1195  if oidx = -1 then exit;
     1196 
     1197  if cboRoute.ItemIndex = oidx then
     1198    begin
     1199      otherRoute := CreateOtherRoute;
     1200      if length(otherRoute) > 1 then
     1201        begin
     1202          idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2));
     1203          if idx > -1 then
     1204            begin
     1205              temp := cboRoute.Items.Strings[idx];
     1206              //setPiece(temp,U,5,'1');
     1207              cboRoute.Items.Strings[idx] := temp;
     1208            end
     1209          else
     1210          begin
     1211             cboRoute.Items.Add(otherRoute);
     1212             idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2));
     1213          end;
     1214          cboRoute.ItemIndex := idx;
     1215        end
     1216      else
     1217        begin
     1218          cboRoute.ItemIndex := -1;
     1219          cboRoute.SetFocus;
     1220        end;
     1221    end;
     1222end;
     1223
     1224procedure TfrmODMedIV.cboRouteExit(Sender: TObject);
     1225begin
     1226  inherited;
     1227(*  if (cboRoute.Text <> '') and (cboRoute.ItemIndex = -1)  then
     1228    begin
     1229      infoBox(TX_BAD_ROUTE,'Warning',MB_OK);
     1230      cboRoute.SetFocus;
     1231    end; *)
     1232end;
     1233
    4831234procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject);
    4841235var
    4851236  AnIVComponent: TIVComponent;
    486   x: string;
     1237  x, routeIEN: string;
    4871238begin
    4881239  inherited;
    … …  
    5061257    end;
    5071258  end;
     1259  routeIEN := Piece(cboAdditive.Items.Strings[cboAdditive.itemindex],U,4);
    5081260  x := AmountsForIVFluid(cboAdditive.ItemIEN, 'A');
    5091261  AnIVComponent := TIVComponent.Create;
    … …  
    5261278  Application.ProcessMessages;         //CQ: 10157
    5271279  ClickOnGridCell;
     1280  updateRoute;
    5281281  ControlChange(Sender);
     1282  //UpdateRoute(RouteIEN);
    5291283end;
    5301284
    … …  
    5321286begin
    5331287  inherited;
    534   if cboAdditive.ItemIEN > 0 then cboAdditiveMouseClick(Self);
     1288  if (cboAdditive.ItemIEN > 0) and (EnterIsPressed) then
     1289    cboAdditiveMouseClick(Self);
    5351290end;
    5361291
    5371292{ grdSelected events }
     1293
     1294procedure TfrmODMedIV.ClearAllFields;
     1295begin
     1296  self.cboType.ItemIndex := -1;
     1297  self.cboType.Text := '';
     1298  self.memComments.Text := '';
     1299  self.txtRate.Text := '';
     1300  self.txtXDuration.text := '';
     1301  self.cboDuration.ItemIndex := -1;
     1302  self.cboDuration.Text := '';
     1303  self.txtAllIVRoutes.Visible := false;
     1304  self.FInitialOrderID := True;
     1305  cbotypeChange(self.cboType);
     1306  if self.cboroute.Items.Count > 0 then self.cboRoute.Clear;
     1307end;
    5381308
    5391309procedure TfrmODMedIV.ClickOnGridCell;
    … …  
    6081378end;
    6091379
     1380procedure TfrmODMedIV.cboScheduleChange(Sender: TObject);
     1381begin
     1382  inherited;
     1383   if self.txtXDuration.Enabled = true then
     1384     begin
     1385       self.txtXDuration.Text := '';
     1386       self.cboDuration.ItemIndex := -1;
     1387     end;
     1388   if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
     1389  ControlChange(sender);
     1390end;
     1391
     1392procedure TfrmODMedIV.cboScheduleClick(Sender: TObject);
     1393var
     1394  othSch: string;
     1395  idx, i : integer;
     1396begin
     1397  inherited;
     1398  if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
     1399    begin
     1400      othSch := CreateOtherSchedule;
     1401      if length(trim(othSch)) > 1 then
     1402        begin
     1403          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);
     1412          cboSchedule.ItemIndex := idx;
     1413        end;
     1414    end
     1415  else
     1416    begin
     1417      NSSAdminTime := '';
     1418      NSSScheduleType := '';
     1419    end;
     1420end;
     1421
     1422procedure TfrmODMedIV.cboScheduleExit(Sender: TObject);
     1423begin
     1424  inherited;
     1425    if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then
     1426    begin
     1427      infoBox('Please select a valid schedule from the list.'+ CRLF + CRLF +
     1428              'If you would like to create a Day-of-Week schedule please select ''OTHER'' from the list.',
     1429              'Incorrect Schedule.', MB_OK);
     1430      cboSchedule.Text := '';
     1431      cboSchedule.SetFocus;
     1432    end;
     1433end;
     1434
    6101435procedure TfrmODMedIV.cboSelectedChange(Sender: TObject);   // combo editor for grid
    6111436begin
    … …  
    6321457procedure TfrmODMedIV.cmdRemoveClick(Sender: TObject);  // remove button for grid
    6331458var
    634   i: Integer;
     1459  i, stRow, stRowCount: Integer;
    6351460begin
    6361461  inherited;
    … …  
    6381463  begin
    6391464    if Row < 0 then Exit;
     1465    stRow := Row;
     1466    stRowCount := RowCount;
    6401467    if Objects[0, Row] <> nil then TIVComponent(Objects[0, Row]).Free;
    6411468    for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
    … …  
    6431470    RowCount := RowCount - 1;
    6441471  end;
     1472  updateRoute;
     1473  if (stRowCount = 1) and (stRow = 0) then
     1474    begin
     1475      //self.cboRoute.ItemIndex := -1;
     1476      ClearAllFields;
     1477    end;
    6451478  ControlChange(Sender);
    6461479end;
    … …  
    6501483procedure TfrmODMedIV.ControlChange(Sender: TObject);
    6511484var
    652   i, CurAdd, CurBase: Integer;
    653   x,xlimIn,xLimEx,eSch,iSch: string;
     1485  i, CurAdd, CurBase, idx: Integer;
     1486  adminTime,x,xlimIn,xLimEx,eSch,iSch,iType, tmpdur, tmpSch, tmpRate: string;
    6541487  AnIVComponent: TIVComponent;
    6551488  FQOSchedule: TResponse;
    … …  
    6661499  inherited;
    6671500  if Changing then Exit;
     1501  loadExpectFirstDose;
    6681502//  FQOSchedule := TResponse.Create;
    6691503  FQOSchedule := Responses.FindResponseByName('SCHEDULE',1);
    … …  
    6761510  Responses.Clear;   // want this to clear even after SetupDialog in case instances don't match
    6771511  CurAdd := 1; CurBase := 1;
     1512  tmpRate := '';
    6781513  with grdSelected do for i := 0 to RowCount - 1 do
    6791514  begin
    … …  
    7021537  if length(txtXDuration.Text) > 0 then
    7031538  begin
    704     if (btnXDuration.Caption = 'L') or (btnXDuration.Caption = 'ml') then
    705     begin
    706       xlimEx := 'with total volume ' +  txtXDuration.Text + btnXDuration.Caption;
    707       xlimIn := 'with total volume ' +  txtXDuration.Text + btnXDuration.Caption;
     1539    tmpDur := LowerCase(cboDuration.Text);
     1540    if (tmpDur = 'l') or (tmpDur = 'ml') then
     1541    begin
     1542      xlimEx := 'with total volume ' +  txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex];
     1543      xlimIn := 'with total volume ' +  txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex];
    7081544    end
    709     else if (btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') then
    710     begin
    711       xlimEx := 'for ' + txtXDuration.Text + ' ' +  btnXDuration.Caption;
    712       xlimIn := 'for ' + txtXDuration.Text + ' ' +  btnXDuration.Caption;
    713     end  else
    714     begin
     1545    else if (tmpDur = 'days') or (tmpDur = 'hours') then
     1546    begin
     1547      xlimEx := 'for ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
     1548      xlimIn := 'for ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
     1549    end
     1550    else if tmpDur = 'doses' then
     1551      begin
     1552         xlimEx := 'for a total of ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
     1553         xlimIn := 'for a total of ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
     1554      end
     1555   else  begin
    7151556      xlimIn := '';
    7161557      xlimEx := '';
    7171558    end;
    7181559  end;
    719   //if x = IntToStr(StrToIntDef(x, -1)) then x := x + ' ml/hr';
    720   if IsNumericRate(x) then x := x + ' ml/hr';
    721   if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1)))
    722     then x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x));
    723   with txtRate     do if (Length(Text) > 0) then Responses.Update('RATE', 1, x, x);
     1560  if cboType.Text = 'Intermittent' then iType := 'I'
     1561  else iType := 'C';
     1562  Responses.Update('TYPE',1,iType,cboType.Text);
     1563  Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text);
     1564  tmpSch := UpperCase(Trim(cboSchedule.Text));
     1565  if chkPRN.Checked then tmpSch := tmpSch + ' PRN';
     1566  if UpperCase(Copy(tmpSch, Length(tmpSch) - 6, Length(tmpSch))) = 'PRN PRN'
     1567  then tmpSch := Copy(tmpSch, 1, Length(tmpSch) - 4);
     1568  Responses.Update('SCHEDULE',1,tmpSch,tmpSch);
     1569  (*adminTime := Piece(lblAdminTime.Caption,':',2);
     1570  adminTime := Copy(adminTime,1,Length(adminTime));
     1571  if (Action in [ORDER_COPY, ORDER_EDIT]) and ((FAdminTimeDelay <> '') or (FAdminTimeClinic <> '')) and
     1572      (cboSchedule.ItemIndex = FOriginalScheduleIndex) then  Responses.Update('ADMIN',1,FOriginalAdminTime,FOriginalAdminTime)
     1573  else Responses.Update('ADMIN',1,adminTime,adminTime);*)
     1574  idx := self.cboSchedule.ItemIndex;
     1575  if idx > -1 then
     1576     begin
     1577       adminTime := Piece(lblAdminTime.Caption,':',2);
     1578       adminTime := Copy(adminTime,2,Length(adminTime));
     1579       if FAdminTimeText <> '' then AdminTime :=  '';
     1580       if AdminTime = 'Not Defined' then AdminTime := '';
     1581       Responses.Update('ADMIN',1,adminTime,adminTime);
     1582     end;
     1583  if IsNumericRate(x) then
     1584    begin
     1585      if cboInfusionTime.Enabled = true then
     1586        begin
     1587           idx := cboInfusionTime.Items.IndexOf(cboInfusionTime.Text);
     1588           if idx > -1 then x := x + ' ' + cboInfusionTime.Items.Strings[idx];
     1589           tmpRate := 'Infuse Over ' + x;
     1590        end
     1591      else
     1592        if pos('ml/hr', x)= 0 then  x := x + ' ml/hr';
     1593    end;
     1594  if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1))) and (cboInfusionTime.Enabled = false) then
     1595    begin
     1596      if Pos('ml/hr', x) = 0 then
     1597         x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x));
     1598    end;
     1599  with txtRate     do if (Length(Text) > 0) then
     1600    begin
     1601      if tmpRate = '' then Responses.Update('RATE', 1, x, x)
     1602      else Responses.Update('RATE', 1, 'INFUSE OVER ' + x, tmpRate);
     1603    end;
    7241604  with cboPriority do if ItemIndex > -1     then Responses.Update('URGENCY', 1, ItemID, Text);
    7251605  if Length(xlimIn)>0 then Responses.Update('DAYS',1, xlimIn, xlimEx);
    7261606  with memComments do if GetTextLen > 0     then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
     1607  if (chkDoseNow.Visible = True) and (chkDoseNow.Checked = True) then
     1608    Responses.Update('NOW', 1, '1', 'NOW')
     1609  else Responses.Update('NOW', 1, '', '');
    7271610  memOrder.Text := Responses.OrderText;
    728   if (Length(eSch)>0) or (Length(iSch)>0) then
    729     Responses.Update('SCHEDULE',1,iSch,eSch);
     1611  (* (Length(eSch)>0) or (Length(iSch)>0) then
     1612    Responses.Update('SCHEDULE',1,iSch,eSch);  *)
     1613end;
     1614
     1615function TfrmODMedIV.CreateOtherRoute: string;
     1616var
     1617  aRoute: string;
     1618begin
     1619  aRoute := '';
     1620  Result := '';
     1621  if not ShowOtherRoutes(aRoute) then
     1622    begin
     1623      cboRoute.ItemIndex := -1;
     1624      cboRoute.Text := '';
     1625    end
     1626  else
     1627    begin
     1628      Result := aRoute;
     1629    end;
     1630end;
     1631
     1632function TfrmODMedIV.CreateOtherSchedule: string;
     1633var
     1634  aSchedule: string;
     1635begin
     1636  aSchedule := '';
     1637  if not ShowOtherSchedule(aSchedule) then
     1638  begin
     1639    cboSchedule.ItemIndex := -1;
     1640    cboSchedule.Text      := '';
     1641  end
     1642  else
     1643    begin
     1644        Result := Piece(aSchedule,U,1);
     1645        NSSAdminTime := Piece(aschedule,u,2);
     1646        NSSScheduleType := Piece(ASchedule, U, 3);
     1647    end;
    7301648end;
    7311649
    … …  
    7481666  inherited SetFontSize( FontSize );
    7491667  DoSetFontSize( FontSize );
     1668end;
     1669
     1670procedure TfrmODMedIV.DisplayDoseNow(Status: boolean);
     1671begin
     1672  if self.EvtID > 0 then Status := false;
     1673  if status = false then
     1674    begin
     1675      if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false;
     1676      self.chkDoseNow.Visible := false;
     1677    end;
     1678  if status = true then self.chkDoseNow.Visible := true;
    7501679end;
    7511680
    … …  
    7821711end;
    7831712
    784 procedure TfrmODMedIV.btnXDurationClick(Sender: TObject);
    785 var
    786   APoint: TPoint;
    787 begin
    788   inherited;
    789   txtXDuration.SetFocus;
    790   with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
    791   popDuration.Popup(APoint.X, APoint.Y);
    792 end;
    793 
    794 procedure TfrmODMedIV.popDurationClick(Sender: TObject);
    795 var
    796   x: string;
    797 begin
    798   inherited;
    799   with TMenuItem(Sender) do
    800   begin
    801     x := Caption;
    802     {if Length(Trim(txtXDuration.Text)) > 0 then
    803       if AnsiCompareStr(btnXduration.Caption,x) <> 0 then
    804         txtXDuration.Text := '';}
    805   end;
    806   btnXDuration.Caption := x;
    807   txtXDurationChange(Sender);
    808   ControlChange(Sender);
    809 end;
    810 
    8111713procedure TfrmODMedIV.txtXDurationChange(Sender: TObject);
    8121714begin
    … …  
    8151717  ControlChange(Sender);
    8161718end;
     1719
    8171720
    8181721procedure TfrmODMedIV.pnlXDurationEnter(Sender: TObject);
    … …  
    8291732  limitValue := '';
    8301733  tempVal := '';
    831   if ( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F') then  //days, hours
     1734  if pos('dose',AValue)>0 then
     1735    begin
     1736      limitValue := Piece(aValue,' ',5);
     1737      limitUnit := 'doses';
     1738    end;
     1739  if (( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F')) and (pos('dose',aValue)=0) then  //days, hours
    8321740  begin
    8331741     limitValue := Piece(aValue,' ',2);
    … …  
    8421750  if isNumeric(CharAt(aValue,1)) then
    8431751  begin
     1752    if LeftStr(avalue,1) = '0' then AValue := Copy(aValue,2,Length(aValue));
    8441753    limitValue := FloatToStr(ExtractFloat(aValue));
    8451754    limitUnit  := Copy(aValue,length(limitValue)+1,Length(aValue));
    … …  
    8531762    if Trim(UpperCase(limitUnit))='CC' then
    8541763      limitUnit := 'ml';
    855     btnXDuration.Caption := limitUnit;
    856   end;
    857 
    858 end;
     1764    cboduration.text := limitUnit;
     1765    if cboDuration.Text <> '' then cboDuration.ItemIndex := cboDuration.Items.IndexOf(cboDuration.Text)
     1766  end;
     1767
     1768end;
     1769
     1770procedure TfrmODMedIV.SetSchedule(const x: string);
     1771var
     1772NonPRNPart,tempSch: string;
     1773idx: integer;
     1774begin
     1775    cboSchedule.ItemIndex := -1;
     1776    chkPRN.Checked := False;
     1777    //Check to see if schedule is already define in the schedule list
     1778    idx := cboSchedule.Items.IndexOf(X);
     1779    if idx > -1 then
     1780      begin
     1781        cboSchedule.ItemIndex := idx;
     1782        exit;
     1783      end;
     1784      //Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID)
     1785      if (Pos('@', x) > 0) then
     1786        begin
     1787          tempSch := Piece(x, '@', 2);
     1788          idx := cboSchedule.Items.IndexOf(tempSch);
     1789          if idx > -1 then
     1790            begin
     1791             //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
     1792             tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
     1793             cboSchedule.Items.Add(tempSch);
     1794             cboSchedule.Text := (Piece(tempSch,U,1));
     1795             cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch,U,1));
     1796             EXIT;
     1797            end;
     1798          //Check to see if schedule is a Day-of-Week PRN Schedule (MO-WE-FR@BID PRN)
     1799          if Pos('PRN', tempSch) > 0 then
     1800            begin
     1801              NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
     1802              idx := cboSchedule.Items.IndexOf(NonPRNPart);
     1803              if idx > -1 then
     1804                begin
     1805                  //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
     1806                  tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
     1807                  cboSchedule.Items.Add(tempSch);
     1808                  cboSchedule.Text := (Piece(tempSch,U,1));
     1809                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1));
     1810                  chkPRN.Checked := True;
     1811                  EXIT;
     1812                end
     1813              else
     1814               //Add Day-of-Week PRN schedule built off Time Prompt (MO-WE-FR@0800-1000 PRN)
     1815               begin
     1816                  NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1));
     1817                  chkPRN.Checked := True;
     1818                  //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + AdminTime);
     1819                  //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2));
     1820                  cboSchedule.Items.Add(NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2));
     1821                  cboSchedule.Text := NonPRNPart;
     1822                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(NonPRNPart);
     1823                  EXIT;
     1824               end;
     1825            end;
     1826         //Add Non PRN Day-of-Week Schedule built off Time Prompt (MO-WE-FR@0800-1000)
     1827         //cboSchedule.Items.Add(U + x + U + U + U + AdminTime);
     1828         //cboSchedule.Items.Add(U + x + U + U + U + tempSch);
     1829         cboSchedule.Items.Add(x + U + U + U + tempSch);
     1830         cboSchedule.Text := x;
     1831         cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(X);
     1832        end
     1833        else
     1834          begin
     1835            //Handle standard schedule mark as PRN (Q4H PRN)
     1836            if Pos('PRN', X) > 0 then
     1837              begin
     1838                NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1));
     1839                idx := cboSchedule.Items.IndexOf(NonPRNPart);
     1840                if idx > -1 then
     1841                  begin
     1842                    cboSchedule.ItemIndex := idx;
     1843                    tempSch := cboSchedule.Items.Strings[idx];
     1844                    //setPiece(tempSch,U,5,AdminTime);
     1845                    cboSchedule.Items.Strings[idx] := tempSch;
     1846                    chkPRN.Checked := True;
     1847                    exit;
     1848                  end;
     1849              end;
     1850          end;
     1851end;
     1852
    8591853
    8601854procedure TfrmODMedIV.txtXDurationExit(Sender: TObject);
    8611855var
    862   Len: Integer;
    8631856  Code: double;
    864   Digits, Warning: string;
    865 begin
    866   inherited;
    867   if Changing then Exit;
    868   //AGP Change 26.15 HIN-1203-42283 Added additional check to make sure the user can only enter the correct duration
    869   Len := Length(txtXDuration.Text);
    870   if (Len > 0) and (Pos('.', txtXDuration.Text)=0) then
    871     begin
    872       Warning := '0';
    873       Digits := '2';
    874       if ((btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') or (btnXDuration.Caption = 'L')) and (Len > 2) then  Warning := '1';
    875       if (btnXDuration.Caption = 'ml') and (Len > 4) then  Warning := '1';
    876       if Warning = '1' then
    877           begin
    878              if btnXduration.Caption = 'ml' then Digits := '4';
    879              ShowMessage('Invalid Value.' + #13#10 + 'Reason: Duration for ' + btnXDuration.Caption + ' cannot be greater than ' + digits + ' digits.');
    880              txtXDuration.Text := '';
    881              txtXDuration.SetFocus;
    882              Exit;
    883           end;
    884       end;
    885   if (Pos('.', txtXDuration.Text)>0) and
    886      ((btnXduration.Caption = 'days') or (btnXduration.Caption = 'hours')) then
    887   begin
    888     ShowMessage('Can not save order.' + #13#10
    889        + 'Reason: Invalid Duration, please enter an integer value for days or hours.');
    890     txtXDuration.Text := '';
    891     txtXDuration.SetFocus;
    892     Exit;
    893   end;
     1857begin
     1858  inherited;
    8941859  if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then
    8951860  begin
    … …  
    9011866    if code < 0.0001 then
    9021867    begin
    903       ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');
     1868      ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');
    9041869      txtXDuration.Text := '';
    9051870      txtXDuration.SetFocus;
    … …  
    9101875    if (Length(txtXDuration.Text)>0) and (StrToFloat(txtXDuration.Text)<0) then
    9111876    begin
    912       ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');
     1877      ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');
    9131878      txtXDuration.Text := '';
    9141879      txtXDuration.SetFocus;
    … …  
    9211886end;
    9221887
    923 procedure TfrmODMedIV.txtRateExit(Sender: TObject);
    924 var
    925 ErrorText, LDec,RDec: string;
    926 i: Integer;
    927 Result: boolean;
    928 begin
    929   inherited;
    930   //AGP Change 26.28 for CQ # 7598 add infusion rate check for valid value
    931   ErrorText := 'The Infusion Rate must be in one of the following formats:' + CRLF + CRLF + 'nnnn.nn ml/hr or text@per labels per day';
    932   Result := False;
    933   if pos('@',Self.txtRate.Text)>0 then exit;
    934   if pos('.',Self.txtRate.Text)>0 then
    935       begin
    936          LDec := Piece(Self.txtRate.Text,'.',1);
    937          RDec := Piece(Self.txtRate.Text,'.',2);
    938          if Length(LDec)>4 then Result := True;
    939          if Length(RDec)>2 then Result := True;
    940       end
    941   else if Length(Self.txtRate.Text)>4 then Result := True;
    942   if (Result = False) and (pos('.',Self.txtRate.Text)=0) then
    943     begin
    944     for i := 1 to Length(Self.txtRate.Text) do if not (Self.txtRate.Text[i] in ['0'..'9']) then Result := True
    945     end;
    946   if Result = True then
    947     begin
    948        InfoBox(ErrorText,'Warning - Invalid Infusion Rate', MB_OK);
    949        Self.txtRate.Text := '';
    950        Self.txtRate.SetFocus;
    951     end;
     1888procedure TfrmODMedIV.UpdateDuration(SchType: string);
     1889begin
     1890if SchType = 'O' then
     1891   begin
     1892     self.cboDuration.ItemIndex := -1;
     1893     self.txtXDuration.Text := '';
     1894     self.cboDuration.Enabled := false;
     1895     self.txtXDuration.Enabled := false;
     1896     self.lblLimit.Enabled := false;
     1897   end
     1898else
     1899  begin
     1900     self.cboDuration.Enabled := true;
     1901     self.txtXDuration.Enabled := true;
     1902     self.lblLimit.Enabled := true;
     1903  end;
     1904end;
     1905
     1906procedure TfrmODMedIV.UpdateRoute;
     1907var
     1908AnIVComponent: TIVComponent;
     1909i: integer;
     1910OrderIds, TempIVRoute: TStringList;
     1911Default: boolean;
     1912begin
     1913  if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
     1914  TempIVRoute := TStringList.Create;
     1915  for I := (self.cboRoute.Items.Count -1) downto 0 do
     1916    begin
     1917      if Piece(self.cboRoute.Items.Strings[i], U, 5) = '1' then
     1918        TempIVRoute.Add(self.cboRoute.Items.Strings[i]);
     1919        self.cboRoute.Items.Delete(i);
     1920    end;
     1921  if self.cboRoute.ItemIndex = -1 then self.cboRoute.Text := '';
     1922  OrderIds := TStringList.Create;
     1923  for i := 0 to self.grdSelected.RowCount -1  do
     1924    begin
     1925      AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]);
     1926      if AnIVComponent <> nil then  orderIds.Add(InttoStr(AniVComponent.IEN));
     1927    end;
     1928 if OrderIds.Count > 0 then
     1929   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
     1934       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;
     1942       end;
     1943     OrderIds.Free;
     1944   end;
     1945 if TempIVRoute.Count > 0 then
     1946   begin
     1947     for I := 0 to tempIVRoute.Count - 1 do cboRoute.Items.Add(tempIVRoute.Strings[i]);
     1948     TempIVRoute.Free;
     1949   end;
     1950 cboRoute.Items.Add(U + 'OTHER');
     1951end;
     1952
     1953
     1954procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject);
     1955var
     1956i: integer;
     1957begin
     1958  inherited;
     1959  if MessageDlg('You can also select "OTHER" from the Route list'
     1960     + ' 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
     1963  begin
     1964      for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break;
     1965      cboRoute.ItemIndex := i;
     1966      cboRouteClick(self);
     1967      cboRouteChange(self.cboRoute);
     1968  end;
     1969end;
     1970
     1971procedure TfrmODMedIV.txtNSSClick(Sender: TObject);
     1972var
     1973i: integer;
     1974begin
     1975  inherited;
     1976  if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
     1977    + ' to create a day-of-week schedule.'
     1978    + #13#10 + 'Click OK to launch schedule builder',
     1979    mtInformation, [mbOK, mbCancel],0) = mrOK then
     1980  begin
     1981      //cboSchedule.Items.Add(U + 'OTHER');
     1982      for I := 0 to cboSchedule.Items.Count - 1 do if cboSchedule.Items.Strings[i] = 'OTHER' then break;
     1983      cboSchedule.ItemIndex := i;
     1984      //cboSchedule.SelectByID(U+'OTHER');
     1985      cboScheduleClick(Self);
     1986      cboScheduleChange(self.cboSchedule);
     1987  end;
     1988end;
     1989
     1990procedure TfrmODMedIV.txtRateChange(Sender: TObject);
     1991begin
     1992  inherited;
     1993  if Changing then Exit;
     1994  ControlChange(Sender);
    9521995end;
    9531996

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

    r456 r829  
    7474    ListItemsOnly = False
    7575    LongList = False
     76    LookupPiece = 0
    7677    MaxLength = 0
    7778    ParentShowHint = False
    … …  
    8586    OnExit = cboDispenseExit
    8687    OnMouseClick = cboDispenseMouseClick
     88    CharsNeedMatch = 1
    8789  end
    8890  object cboMedication: TORComboBox [9]
    … …  
    100102    ListItemsOnly = False
    101103    LongList = True
     104    LookupPiece = 0
    102105    MaxLength = 0
    103106    Pieces = '2'
    … …  
    109112    OnMouseClick = cboMedicationSelect
    110113    OnNeedData = cboMedicationNeedData
    111   end
    112   inherited memOrder: TMemo
     114    CharsNeedMatch = 1
     115  end
     116  inherited memOrder: TCaptionMemo
    113117    TabOrder = 10
    114118  end
    … …  
    116120    TabOrder = 8
    117121  end
    118   inherited cmdQuit: TButton
    119     TabOrder = 9
    120   end
    121   object cboRoute: TORComboBox [13]
     122  object cboRoute: TORComboBox [12]
    122123    Left = 364
    123124    Top = 18
    … …  
    133134    ListItemsOnly = False
    134135    LongList = False
     136    LookupPiece = 0
    135137    MaxLength = 0
    136138    Pieces = '2'
    … …  
    139141    TabOrder = 4
    140142    OnChange = ControlChange
    141   end
    142   object cboSchedule: TORComboBox [14]
     143    CharsNeedMatch = 1
     144  end
     145  object cboSchedule: TORComboBox [13]
    143146    Left = 442
    144147    Top = 18
    … …  
    154157    ListItemsOnly = False
    155158    LongList = False
     159    LookupPiece = 0
    156160    MaxLength = 0
    157161    Sorted = False
    … …  
    159163    TabOrder = 5
    160164    OnChange = ControlChange
    161   end
    162   object memComments: TMemo [15]
     165    CharsNeedMatch = 1
     166  end
     167  object memComments: TMemo [14]
    163168    Left = 223
    164169    Top = 128
    … …  
    169174    OnChange = ControlChange
    170175  end
    171   object cboPriority: TORComboBox [16]
     176  object cboPriority: TORComboBox [15]
    172177    Left = 442
    173178    Top = 128
    … …  
    183188    ListItemsOnly = False
    184189    LongList = False
     190    LookupPiece = 0
    185191    MaxLength = 0
    186192    Pieces = '2'
    … …  
    189195    TabOrder = 7
    190196    OnChange = ControlChange
    191   end
    192   object txtDosage: TCaptionEdit [17]
     197    CharsNeedMatch = 1
     198  end
     199  object txtDosage: TCaptionEdit [16]
    193200    Left = 224
    194201    Top = 18
    … …  
    200207    Caption = 'Dosage'
    201208  end
     209  inherited cmdQuit: TButton
     210    TabOrder = 9
     211  end
    202212  inherited pnlMessage: TPanel
    203213    TabOrder = 11
    204214  end
    205   object cboMedAlt: TORComboBox
     215  object cboMedAlt: TORComboBox [19]
    206216    Left = 6
    207217    Top = 18
    … …  
    217227    ListItemsOnly = False
    218228    LongList = True
     229    LookupPiece = 0
    219230    MaxLength = 0
    220231    Pieces = '2'
    … …  
    227238    OnMouseClick = cboMedicationSelect
    228239    OnNeedData = cboMedicationNeedData
     240    CharsNeedMatch = 1
     241  end
     242  inherited amgrMain: TVA508AccessibilityManager
     243    Data = (
     244      (
     245        'Component = cboDispense'
     246        'Status = stsDefault')
     247      (
     248        'Component = cboMedication'
     249        'Status = stsDefault')
     250      (
     251        'Component = cboRoute'
     252        'Status = stsDefault')
     253      (
     254        'Component = cboSchedule'
     255        'Status = stsDefault')
     256      (
     257        'Component = memComments'
     258        'Status = stsDefault')
     259      (
     260        'Component = cboPriority'
     261        'Status = stsDefault')
     262      (
     263        'Component = txtDosage'
     264        'Status = stsDefault')
     265      (
     266        'Component = cboMedAlt'
     267        'Status = stsDefault')
     268      (
     269        'Component = memOrder'
     270        'Status = stsDefault')
     271      (
     272        'Component = cmdAccept'
     273        'Status = stsDefault')
     274      (
     275        'Component = cmdQuit'
     276        'Status = stsDefault')
     277      (
     278        'Component = pnlMessage'
     279        'Status = stsDefault')
     280      (
     281        'Component = memMessage'
     282        'Status = stsDefault')
     283      (
     284        'Component = frmODMedIn'
     285        'Status = stsDefault'))
    229286  end
    230287end

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

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    99  fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore,
    10   Menus;
     10  Menus, VA508AccessibilityManager;
    1111
    1212type

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

    r456 r829  
    11inherited frmODMedNVA: TfrmODMedNVA
    2   Left = 100
    3   Top = 167
     2  Left = 203
     3  Top = 183
    44  Width = 632
    55  Height = 536
    66  Caption = 'Document Herbal/OTC/Non-VA Medications'
    77  Constraints.MinHeight = 365
     8  ExplicitWidth = 632
     9  ExplicitHeight = 536
    810  PixelsPerInch = 96
    911  TextHeight = 13
    … …  
    1517    Constraints.MinWidth = 25
    1618    TabOrder = 4
    17   end
    18   inherited cmdAccept: TButton
    19     Left = 540
    20     Top = 463
    21     Width = 69
    22     Anchors = [akRight, akBottom]
    23     TabOrder = 6
    24     Visible = False
    25   end
    26   inherited cmdQuit: TButton
    27     Left = 546
    28     Top = 489
    29     Width = 49
    30     Anchors = [akRight, akBottom]
    31     TabOrder = 7
    32   end
    33   inherited pnlMessage: TPanel
    34     Top = 240
    35   end
    36   object pnlMeds: TPanel
     19    ExplicitLeft = 0
     20    ExplicitTop = 461
     21    ExplicitWidth = 525
     22  end
     23  object pnlMeds: TPanel [1]
    3724    Left = 6
    3825    Top = 34
    … …  
    6451        end>
    6552      ColumnClick = False
     53      Constraints.MaxHeight = 165
    6654      HideSelection = False
    6755      HotTrack = True
    … …  
    10997    end
    11098  end
    111   object txtMed: TEdit
     99  object txtMed: TEdit [2]
    112100    Left = 5
    113101    Top = 6
    … …  
    123111    OnKeyUp = txtMedKeyUp
    124112  end
    125   object pnlFields: TPanel
     113  object pnlFields: TPanel [3]
    126114    Left = 3
    127115    Top = 30
    … …  
    181169        TabStop = True
    182170        Visible = False
     171        OnClick = lblGuidelineClick
    183172      end
    184173      object tabDose: TTabControl
    … …  
    397386    end
    398387  end
    399   object btnSelect: TButton
     388  object btnSelect: TButton [4]
    400389    Left = 539
    401390    Top = 463
    … …  
    409398    OnClick = btnSelectClick
    410399  end
     400  inherited cmdAccept: TButton
     401    Left = 540
     402    Top = 463
     403    Width = 69
     404    Anchors = [akRight, akBottom]
     405    TabOrder = 6
     406    Visible = False
     407    ExplicitLeft = 540
     408    ExplicitTop = 463
     409    ExplicitWidth = 69
     410  end
     411  inherited cmdQuit: TButton
     412    Left = 546
     413    Top = 489
     414    Width = 49
     415    Anchors = [akRight, akBottom]
     416    TabOrder = 7
     417    ExplicitLeft = 546
     418    ExplicitTop = 489
     419    ExplicitWidth = 49
     420  end
     421  inherited pnlMessage: TPanel
     422    Top = 240
     423    ExplicitTop = 240
     424  end
     425  inherited amgrMain: TVA508AccessibilityManager
     426    Data = (
     427      (
     428        'Component = pnlMeds'
     429        'Status = stsDefault')
     430      (
     431        'Component = lstQuick'
     432        'Status = stsDefault')
     433      (
     434        'Component = lstAll'
     435        'Status = stsDefault')
     436      (
     437        'Component = txtMed'
     438        'Status = stsDefault')
     439      (
     440        'Component = pnlFields'
     441        'Status = stsDefault')
     442      (
     443        'Component = pnlTop'
     444        'Status = stsDefault')
     445      (
     446        'Component = lblGuideline'
     447        'Status = stsDefault')
     448      (
     449        'Component = tabDose'
     450        'Status = stsDefault')
     451      (
     452        'Component = cboDosage'
     453        'Status = stsDefault')
     454      (
     455        'Component = cboRoute'
     456        'Status = stsDefault')
     457      (
     458        'Component = cboSchedule'
     459        'Status = stsDefault')
     460      (
     461        'Component = chkPRN'
     462        'Status = stsDefault')
     463      (
     464        'Component = pnlBottom'
     465        'Status = stsDefault')
     466      (
     467        'Component = memComment'
     468        'Status = stsDefault')
     469      (
     470        'Component = lblAdminTime'
     471        'Status = stsDefault')
     472      (
     473        'Component = calStart'
     474        'Status = stsDefault')
     475      (
     476        'Component = lbStatements'
     477        'Status = stsDefault')
     478      (
     479        'Component = memDrugMsg'
     480        'Status = stsDefault')
     481      (
     482        'Component = btnSelect'
     483        'Status = stsDefault')
     484      (
     485        'Component = memOrder'
     486        'Status = stsDefault')
     487      (
     488        'Component = cmdAccept'
     489        'Status = stsDefault')
     490      (
     491        'Component = cmdQuit'
     492        'Status = stsDefault')
     493      (
     494        'Component = pnlMessage'
     495        'Status = stsDefault')
     496      (
     497        'Component = memMessage'
     498        'Status = stsDefault')
     499      (
     500        'Component = frmODMedNVA'
     501        'Status = stsDefault'))
     502  end
    411503  object dlgStart: TORDateTimeDlg
    412     FMDateTime = 3001101
     504    FMDateTime = 3001101.000000000000000000
    413505    DateOnly = False
    414506    RequireTime = True

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
    8   Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn;
     8  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn, contnrs,
     9  VA508AccessibilityManager;
    910
    1011const
    … …  
    9495  private
    9596    {selection}
    96     FAllItems:   TStringList;
    97     FAllFirst:   Integer;
    98     FAllLast:    Integer;
    99     FAllList:    Integer;
     97    FNVAMedCache:   TObjectList;
     98    FCacheIEN:   integer;
    10099    FQuickList:  Integer;
    101100    FQuickItems: TStringList;
    … …  
    135134    FQOInitial: boolean;
    136135    FRemoveText : Boolean;
     136    FMedName: string;
    137137    {selection}
    138138    procedure ChangeDelayed;
    … …  
    140140    function FindQuickOrder(const x: string): Integer;
    141141    function isUniqueQuickOrder(iText: string): Boolean;
     142    function GetCacheChunkIndex(idx: integer): integer;
    142143    procedure ScrollToVisible(AListView: TListView);
    143144    procedure StartKeyTimer;
    … …  
    180181    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    181182    procedure CheckDecimal(var AStr: string);
     183    property MedName: string read FMedName write FMedName;
    182184  end;
    183185
    … …  
    194196
    195197uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
    196   uAccessibleStringGrid, fFrame, ORNet;
     198  fFrame, ORNet, VAUtils;
    197199
    198200const
    … …  
    259261  TIMER_FROM_DAYS = 1;
    260262  TIMER_FROM_QTY  = 2;
     263
     264  MED_CACHE_CHUNK_SIZE = 100; 
    261265  {text constants}
    262266  TX_ADMIN      = 'Requested Start: ';
    … …  
    346350  FRowHeight := MainFontHeight + 1;
    347351  x := 'NV RX';  // CLA 6/3/03
    348   ListForOrderable(FAllList, ListCount, x);
     352  ListForOrderable(FCacheIEN, ListCount, x);
    349353  lstAll.Items.Count := ListCount;
    350   FAllItems := TStringList.Create;
    351   FAllFirst := -1;
    352   FAllLast  := -1;
     354  FNVAMedCache := TObjectList.Create;
    353355  FQuickItems := TStringList.Create;
    354356  ListForQuickOrders(FQuickList, ListCount, x);
    … …  
    370372    then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
    371373  pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
     374  cmdAccept.Left := cmdQuit.Left;
     375  cmdaccept.Anchors := cmdQuit.anchors;
    372376  FNoZero := False;
    373377  FShrinked := False;
    … …  
    382386  {selection}
    383387  FQuickItems.Free;
    384   FAllItems.Free;
     388  FNVAMedCache.Free;
    385389  {edit}
    386390  FGuideline.Free;
    … …  
    553557   end;
    554558  end;
     559  if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
    555560end;
    556561
    … …  
    659664  UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
    660665  QuickIndex := FindQuickOrder(UserText);
    661   AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
     666  AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
    662667  if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
    663668  if AllIndex > -1 then
    … …  
    772777{ lstAll Methods (lstAll is TListView) }
    773778
     779// Cache is a list of 100 string lists, starting at idx 0
    774780procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
    775 const
    776   MAX_CACHE_ITEMS = 1000;
    777 begin
    778   // if range is within cache range we don't need to update anything
    779   if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
    780   // if range is outside of cache or a superset of cache, start over
    781   if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
    782      ((First < FAllFirst) and (Last > FAllLast)) or
    783      (FAllItems.Count > MAX_CACHE_ITEMS) then
    784   begin
    785     FAllItems.Clear;
    786     FAllFirst := -1;
    787     FAllLast  := -1;
    788   end;
    789   // if getting items immediately before cache range
    790   if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
    791   // if getting items immediately after cache range
    792   if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
    793   // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
    794   SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
    795   // reset FAllFirst & FAllLast indexes to reflect current FAllItems
    796   if FAllFirst < 0     then FAllFirst := First;
    797   if FAllLast  < 0     then FAllLast  := Last;
    798   if First < FAllFirst then FAllFirst := First;
    799   if Last > FAllLast   then FAllLast := Last;
     781var
     782  firstChunk, lastchunk, i: integer;
     783  list: TStringList;
     784  firstMed, LastMed: integer;
     785
     786begin
     787  firstChunk := GetCacheChunkIndex(First);
     788  lastChunk := GetCacheChunkIndex(Last);
     789  for i := firstChunk to lastChunk do
     790  begin
     791    if (FNVAMedCache.Count <= i) or (not assigned(FNVAMedCache[i])) then
     792    begin
     793      while FNVAMedCache.Count <= i do
     794        FNVAMedCache.add(nil);
     795      list := TStringList.Create;
     796      FNVAMedCache[i] := list;
     797      firstMed := i * MED_CACHE_CHUNK_SIZE;
     798      LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
     799      if LastMed >= lstAll.Items.Count then
     800        LastMed := lstAll.Items.Count - 1;
     801      SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
     802    end;
     803  end;
    800804end;
    801805
    … …  
    803807var
    804808  x: string;
    805 begin
    806   if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
    807     then LoadNonVAMedCache(Item.Index, Item.Index);
    808   x := FAllItems[Item.Index - FAllFirst];
     809  chunk: integer;
     810  list: TStringList;
     811begin
     812  LoadNonVAMedCache(Item.Index, Item.Index);
     813  chunk := GetCacheChunkIndex(Item.Index);
     814  list := TStringList(FNVAMedCache[chunk]);
     815  x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
    809816  Item.Caption := Piece(x, U, 2);
    810817  Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
    … …  
    822829var
    823830  MedIEN: Integer;
    824   MedName: string;
     831  //MedName: string;
    825832  QOQuantityStr: string;
    826   ErrMsg: string;
     833  ErrMsg, temp: string;
    827834begin
    828835  inherited;
    829836  QOQuantityStr := '';
    830   btnSelect.SetFocus;                             // let the exit events finish
     837  btnSelect.SetFocus;
     838  self.MedName := '';                             // let the exit events finish
    831839  if pnlMeds.Visible then                         // display the medication fields
    832840  begin
    … …  
    845853        //btnSelect.Visible := False;
    846854        btnSelect.Enabled := False;
    847         ShowMessage(ErrMsg);
     855        ShowMsg(ErrMsg);
    848856        Exit;
    849857      end;
    … …  
    862870    begin
    863871      MedIEN := Integer(lstAll.Selected.Data);
    864       MedName := lstAll.Selected.Caption;
     872      self.MedName := lstAll.Selected.Caption;
    865873      txtMed.Tag := MedIEN;
    866874      ErrMsg := '';
    … …  
    869877      begin
    870878        btnSelect.Enabled := False;
    871         ShowMessage(ErrMsg);
     879        ShowMsg(ErrMsg);
    872880        Exit;
    873881      end;
    … …  
    882890      begin
    883891        txtMed.Tag := MedIEN;
    884         txtMed.Text := MedName;
     892        temp := self.MedName;
     893        self.MedName := txtMed.Text;
     894        txtMed.Text := Temp;
    885895      end;
    886896      SetOnMedSelect;
    … …  
    918928var
    919929  i,j: Integer;
    920   x: string;
     930  temp,x: string;
    921931  QOPiUnChk: boolean;
    922932  PKIEnviron: boolean;
    … …  
    933943    // set up lists & initial values based on orderable item
    934944    SetControl(txtMed,       'Medication');
     945    if (self.MedName <> '') then
     946       begin
     947         if (txtMed.Text <> self.MedName) then
     948           begin
     949             temp := self.MedName;
     950             self.MedName := txtMed.Text;
     951             txtMed.Text := temp;
     952           end
     953         else MedName := '';
     954       end;
    935955    SetControl(cboDosage,    'Dosage');
    936956    SetControl(cboRoute,     'Route');
    … …  
    10441064      else
    10451065        SetDosage(IValueFor('INSTR', 1));
    1046         SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
    1047         SetSchedule(IValueFor('SCHEDULE',  1));
     1066      SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
     1067      SetControl(cboRoute,  'ROUTE',     1);  //AGP ADDED ROUTE FOR CQ 11252
     1068      SetSchedule(IValueFor('SCHEDULE',  1));
    10481069      if (cboSchedule.Text = '') and FIsQuickOrder then
    10491070      begin
    … …  
    16131634  FUpdated := FALSE;
    16141635  Responses.Clear;
    1615   Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
     1636  if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
     1637  else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
    16161638  DoseList := TStringList.Create;
    16171639  case tabDose.TabIndex of
    … …  
    17291751    Schedule  <TAB> (nothing)
    17301752    Duration  <TAB> Duration^Units }
     1753
     1754  // the following functions were created to get rid of a compile warning saying the
     1755  // return value may be undefined - too much branching logic in the case statements
     1756  // for the compiler to handle
     1757
     1758  function GetSchedule: string;
     1759  begin
     1760    Result := UpperCase(cboSchedule.Text);
     1761    if chkPRN.Checked then Result := Result + ' PRN';
     1762    if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
     1763      then Result := Copy(Result, 1, Length(Result) - 4);
     1764  end;
     1765
     1766  function GetScheduleEX: string;
     1767  begin
     1768    Result := '';
     1769    with cboSchedule do
     1770      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
     1771    if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
     1772    if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
     1773      then Result := Copy(Result, 1, Length(Result) - 10);
     1774  end;
     1775
    17311776begin
    17321777  Result := '';
    … …  
    17631808                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    17641809    FLD_SCHEDULE  : begin
    1765                       Result := UpperCase(cboSchedule.Text);
    1766                       if chkPRN.Checked then Result := Result + ' PRN';
    1767                       if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
    1768                         then Result := Copy(Result, 1, Length(Result) - 4);
     1810                      Result := GetSchedule;
    17691811                    end;
    17701812    FLD_SCHED_EX  : begin
    1771                       with cboSchedule do
    1772                         if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
    1773                       if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
    1774                       if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
    1775                         then Result := Copy(Result, 1, Length(Result) - 10);
     1813                      Result := GetScheduleEX;
    17761814                    end;
    17771815    FLD_SCHED_TYP : with cboSchedule do
    … …  
    21842222end;
    21852223
     2224function TfrmODMedNVA.GetCacheChunkIndex(idx: integer): integer;
     2225begin
     2226  Result := idx div MED_CACHE_CHUNK_SIZE;
     2227end;
     2228
    21862229procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
    21872230var
    … …  
    22092252            tmplst.Strings[i] := Piece(s,U,2);
    22102253        end;
    2211         Dest.Assign(tmplst);
     2254        FastAssign(tmplst, Dest);
    22122255    end;
    22132256 end;

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

    r456 r829  
    1 object frmODMedOIFA: TfrmODMedOIFA
     1inherited frmODMedOIFA: TfrmODMedOIFA
    22  Left = 0
    33  Top = 0
    4   Width = 313
    5   Height = 205
    64  Caption = 'Formulary Alternatives'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 178
     6  ClientWidth = 305
    137  FormStyle = fsStayOnTop
    148  OldCreateOrder = True
    … …  
    1913  PixelsPerInch = 96
    2014  TextHeight = 13
    21   object Label1: TLabel
     15  object Label1: TLabel [0]
    2216    Left = 0
    2317    Top = 0
    … …  
    2620    Align = alTop
    2721    Caption = 'The selected drug is not in the formulary.  Alternatives are:'
     22    ExplicitWidth = 273
    2823  end
    29   object Label2: TStaticText
     24  object Label2: TStaticText [1]
    3025    Left = 0
    3126    Top = 134
    … …  
    3530    Caption = 'Do you wish to use the selected alternative instead?'
    3631    TabOrder = 1
     32    ExplicitWidth = 250
    3733  end
    38   object lstFormAlt: TORListBox
     34  object lstFormAlt: TORListBox [2]
    3935    Left = 0
    4036    Top = 13
    … …  
    5248    Pieces = '2'
    5349  end
    54   object btnPanel: TPanel
     50  object btnPanel: TPanel [3]
    5551    Left = 0
    5652    Top = 151
    … …  
    8278    end
    8379  end
     80  inherited amgrMain: TVA508AccessibilityManager
     81    Data = (
     82      (
     83        'Component = Label2'
     84        'Status = stsDefault')
     85      (
     86        'Component = lstFormAlt'
     87        'Status = stsDefault')
     88      (
     89        'Component = btnPanel'
     90        'Status = stsDefault')
     91      (
     92        'Component = cmdYes'
     93        'Status = stsDefault')
     94      (
     95        'Component = cmdNo'
     96        'Status = stsDefault')
     97      (
     98        'Component = frmODMedOIFA'
     99        'Status = stsDefault'))
     100  end
    84101end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ExtCtrls, fAutoSz;
     7  StdCtrls, ORCtrls, ExtCtrls, fAutoSz, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODMedOIFA = class(TForm)
     10  TfrmODMedOIFA = class(TfrmBase508Form)
    1111    Label1: TLabel;
    1212    lstFormAlt: TORListBox;
    … …  
    5757        with frmODMedOIFA do
    5858        begin
    59           lstFormAlt.Items.Assign(FormAltList);
     59          FastAssign(FormAltList, lstFormAlt.Items);
    6060          ShowModal;
    6161          if Length(FSelected) > 0 then
    … …  
    9191        with frmODMedOIFA do
    9292        begin
    93           lstFormAlt.Items.Assign(FormAltList);
     93          FastAssign(FormAltList, lstFormAlt.Items);
    9494          ShowModal;
    9595          if Length(FSelected) > 0 then

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

    r456 r829  
    44  Height = 316
    55  Caption = 'Outpatient Medication Order'
     6  ExplicitHeight = 316
    67  PixelsPerInch = 96
    78  TextHeight = 13
    … …  
    198199    Top = 235
    199200    TabOrder = 15
    200   end
    201   inherited cmdAccept: TButton
    202     Top = 235
    203     TabOrder = 13
    204   end
    205   object cboRoute: TORComboBox [20]
     201    ExplicitTop = 235
     202  end
     203  object cboRoute: TORComboBox [19]
    206204    Left = 314
    207205    Top = 59
    … …  
    226224    CharsNeedMatch = 1
    227225  end
    228   object cboSchedule: TORComboBox [21]
     226  object cboSchedule: TORComboBox [20]
    229227    Left = 392
    230228    Top = 59
    … …  
    248246    CharsNeedMatch = 1
    249247  end
    250   object memComments: TMemo [22]
     248  object memComments: TMemo [21]
    251249    Left = 202
    252250    Top = 197
    … …  
    258256    OnEnter = memCommentsEnter
    259257  end
    260   object cboPriority: TORComboBox [23]
     258  object cboPriority: TORComboBox [22]
    261259    Left = 392
    262260    Top = 156
    … …  
    281279    CharsNeedMatch = 1
    282280  end
    283   object cboMedAlt: TORComboBox [24]
     281  object cboMedAlt: TORComboBox [23]
    284282    Left = 6
    285283    Top = 18
    … …  
    308306    CharsNeedMatch = 1
    309307  end
    310   object cboInstructions: TORComboBox [25]
     308  object cboInstructions: TORComboBox [24]
    311309    Left = 203
    312310    Top = 59
    … …  
    330328    CharsNeedMatch = 1
    331329  end
    332   object cboPickup: TORComboBox [26]
     330  object cboPickup: TORComboBox [25]
    333331    Left = 202
    334332    Top = 156
    … …  
    353351    CharsNeedMatch = 1
    354352  end
    355   object cboSC: TORComboBox [27]
     353  object cboSC: TORComboBox [26]
    356354    Left = 314
    357355    Top = 156
    … …  
    377375    CharsNeedMatch = 1
    378376  end
    379   object txtQuantity: TCaptionEdit [28]
     377  object txtQuantity: TCaptionEdit [27]
    380378    Left = 470
    381379    Top = 59
    … …  
    387385    Caption = 'Quantity'
    388386  end
    389   object txtRefills: TCaptionEdit [29]
     387  object txtRefills: TCaptionEdit [28]
    390388    Left = 470
    391389    Top = 105
    … …  
    397395    Caption = 'Refills'
    398396  end
    399   object spnRefills: TUpDown [30]
     397  object spnRefills: TUpDown [29]
    400398    Left = 501
    401399    Top = 105
    … …  
    403401    Height = 21
    404402    Associate = txtRefills
    405     Min = 0
    406403    Max = 11
    407     Position = 0
    408404    TabOrder = 8
    409     Wrap = False
    410   end
    411   object cmdComplex: TButton [31]
     405  end
     406  object cmdComplex: TButton [30]
    412407    Left = 202
    413408    Top = 18
    … …  
    418413    OnClick = cmdComplexClick
    419414  end
     415  inherited cmdAccept: TButton
     416    Top = 235
     417    TabOrder = 13
     418    ExplicitTop = 235
     419  end
    420420  inherited cmdQuit: TButton
    421421    Top = 262
    422422    TabOrder = 14
     423    ExplicitTop = 262
    423424  end
    424425  inherited pnlMessage: TPanel
    … …  
    426427    Top = 190
    427428    TabOrder = 16
     429    ExplicitLeft = 6
     430    ExplicitTop = 190
     431  end
     432  inherited amgrMain: TVA508AccessibilityManager
     433    Data = (
     434      (
     435        'Component = memComplex'
     436        'Status = stsDefault')
     437      (
     438        'Component = txtSIG'
     439        'Status = stsDefault')
     440      (
     441        'Component = cboDispense'
     442        'Status = stsDefault')
     443      (
     444        'Component = cboMedication'
     445        'Status = stsDefault')
     446      (
     447        'Component = cboRoute'
     448        'Status = stsDefault')
     449      (
     450        'Component = cboSchedule'
     451        'Status = stsDefault')
     452      (
     453        'Component = memComments'
     454        'Status = stsDefault')
     455      (
     456        'Component = cboPriority'
     457        'Status = stsDefault')
     458      (
     459        'Component = cboMedAlt'
     460        'Status = stsDefault')
     461      (
     462        'Component = cboInstructions'
     463        'Status = stsDefault')
     464      (
     465        'Component = cboPickup'
     466        'Status = stsDefault')
     467      (
     468        'Component = cboSC'
     469        'Status = stsDefault')
     470      (
     471        'Component = txtQuantity'
     472        'Status = stsDefault')
     473      (
     474        'Component = txtRefills'
     475        'Status = stsDefault')
     476      (
     477        'Component = spnRefills'
     478        'Status = stsDefault')
     479      (
     480        'Component = cmdComplex'
     481        'Status = stsDefault')
     482      (
     483        'Component = memOrder'
     484        'Status = stsDefault')
     485      (
     486        'Component = cmdAccept'
     487        'Status = stsDefault')
     488      (
     489        'Component = cmdQuit'
     490        'Status = stsDefault')
     491      (
     492        'Component = pnlMessage'
     493        'Status = stsDefault')
     494      (
     495        'Component = memMessage'
     496        'Status = stsDefault')
     497      (
     498        'Component = frmODMedOut'
     499        'Status = stsDefault'))
    428500  end
    429501  object popUnits: TPopupMenu

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask,
    8   Menus, Buttons;
     8  Menus, Buttons, VA508AccessibilityManager;
    99
    1010type

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

    r456 r829  
    11inherited frmODMeds: TfrmODMeds
    2   Left = 519
    3   Top = 204
     2  Left = 321
     3  Top = 183
    44  Width = 584
    5   Height = 515
     5  Height = 572
    66  HorzScrollBar.Range = 558
    77  VertScrollBar.Range = 399
    88  Caption = 'Medication Order'
    99  Constraints.MinHeight = 325
    10   OnKeyDown = FormKeyDown
    1110  OnShow = FormShow
     11  ExplicitWidth = 584
     12  ExplicitHeight = 572
    1213  DesignSize = (
    1314    576
    14     488)
     15    545)
    1516  PixelsPerInch = 96
    1617  TextHeight = 13
    … …  
    1920    Top = 34
    2021    Width = 580
    21     Height = 413
     22    Height = 470
    2223    Anchors = [akLeft, akTop, akRight, akBottom]
    2324    BevelOuter = bvNone
    24     Caption = 'pnlMeds'
    2525    TabOrder = 1
    2626    object sptSelect: TSplitter
    … …  
    6868      Top = 137
    6969      Width = 580
    70       Height = 276
     70      Height = 333
    7171      Align = alClient
    7272      BevelInner = bvLowered
    … …  
    9898  end
    9999  inherited memOrder: TCaptionMemo
    100     Top = 448
     100    Tag = 13
     101    Top = 505
    101102    Width = 502
     103    TabStop = True
    102104    Anchors = [akLeft, akRight, akBottom]
    103105    TabOrder = 4
     106    ExplicitTop = 505
     107    ExplicitWidth = 502
    104108  end
    105109  object txtMed: TEdit [2]
    … …  
    119123  object btnSelect: TButton [3]
    120124    Left = 515
    121     Top = 448
     125    Top = 505
    122126    Width = 72
    123127    Height = 21
    … …  
    129133    OnClick = btnSelectClick
    130134  end
    131   inherited cmdAccept: TButton
    132     Left = 514
    133     Top = 448
    134     Anchors = [akRight, akBottom]
    135     TabOrder = 6
    136     TabStop = False
    137     Visible = False
    138   end
    139   inherited cmdQuit: TButton
    140     Left = 514
    141     Top = 473
    142     Width = 51
    143     Anchors = [akRight, akBottom]
    144     TabOrder = 7
    145   end
    146   inherited pnlMessage: TPanel
    147     Left = 36
    148     Top = 156
    149     OnEnter = pnlMessageEnter
    150     inherited memMessage: TRichEdit
    151       OnKeyDown = memMessageKeyDown
    152     end
    153   end
    154   object pnlFields: TPanel
     135  object pnlFields: TPanel [4]
    155136    Left = 6
    156137    Top = 34
    157138    Width = 580
    158     Height = 413
     139    Height = 470
    159140    Anchors = [akLeft, akTop, akRight, akBottom]
    160141    BevelOuter = bvNone
    … …  
    167148      Top = 0
    168149      Width = 580
    169       Height = 184
     150      Height = 197
    170151      Align = alClient
    171152      Constraints.MinHeight = 80
    … …  
    173154      DesignSize = (
    174155        580
    175         184)
     156        197)
    176157      object lblRoute: TLabel
    177158        Left = 280
    … …  
    214195        Top = 36
    215196        Width = 580
    216         Height = 143
     197        Height = 156
    217198        Anchors = [akLeft, akTop, akRight, akBottom]
    218         ColCount = 6
     199        ColCount = 7
    219200        DefaultColWidth = 76
    220201        DefaultRowHeight = 21
    … …  
    237218          76
    238219          76
     220          76
    239221          76)
    240222      end
    … …  
    277259        Top = 36
    278260        Width = 279
    279         Height = 143
     261        Height = 155
    280262        Anchors = [akLeft, akTop, akRight, akBottom]
    281263        Style = orcsSimple
    … …  
    307289        Top = 36
    308290        Width = 113
    309         Height = 143
     291        Height = 156
    310292        Anchors = [akTop, akRight, akBottom]
    311293        Style = orcsSimple
    … …  
    337319        Top = 36
    338320        Width = 178
    339         Height = 143
     321        Height = 156
    340322        Anchors = [akTop, akRight, akBottom]
    341323        Style = orcsSimple
    … …  
    395377        TabOrder = 2
    396378        OnClick = btnXRemoveClick
     379      end
     380      object pnlXAdminTime: TPanel
     381        Left = 432
     382        Top = 149
     383        Width = 65
     384        Height = 17
     385        Caption = 'pnlXAdminTime'
     386        TabOrder = 9
     387        Visible = False
     388        OnClick = pnlXAdminTimeClick
    397389      end
    398390    end
    … …  
    521513        Anchors = [akLeft, akTop, akBottom]
    522514        Associate = txtXDuration
    523         Min = 0
    524515        Max = 999
    525         Position = 0
    526516        TabOrder = 1
    527         Wrap = False
    528       end
    529     end
    530     object pnlXSequence: TKeyClickPanel
    531       Left = 396
    532       Top = 122
    533       Width = 37
    534       Height = 21
    535       Caption = 'Then/And box'
    536       TabOrder = 5
    537       TabStop = True
    538       Visible = False
    539       OnClick = btnXSequenceClick
    540       OnEnter = pnlXSequenceEnter
    541       OnExit = pnlXSequenceExit
    542       object btnXSequence: TSpeedButton
    543         Left = 1
    544         Top = 1
    545         Width = 38
    546         Height = 19
    547         Hint = 'A duration must be defined if using "Then" as a sequence.'
    548         Caption = 'then'
    549         Glyph.Data = {
    550           AE000000424DAE0000000000000076000000280000000E000000070000000100
    551           0400000000003800000000000000000000001000000000000000000000000000
    552           8000008000000080800080000000800080008080000080808000C0C0C0000000
    553           FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    554           330033333333333333003330333333733300330003333F87330030000033FFFF
    555           F30033333333333333003333333333333300}
    556         Layout = blGlyphRight
    557         NumGlyphs = 2
    558         ParentShowHint = False
    559         ShowHint = True
    560         Spacing = 1
    561         OnClick = btnXSequenceClick
    562       end
    563       object SpeedButton1: TSpeedButton
    564         Left = 16
    565         Top = 16
    566         Width = 23
    567         Height = 22
    568517      end
    569518    end
    … …  
    626575    object pnlBottom: TPanel
    627576      Left = 0
    628       Top = 184
     577      Top = 197
    629578      Width = 580
    630       Height = 229
     579      Height = 273
    631580      Align = alBottom
    632       TabOrder = 6
     581      TabOrder = 5
    633582      DesignSize = (
    634583        580
    635         229)
     584        273)
    636585      object lblComment: TLabel
    637586        Left = 4
    … …  
    676625      object Image1: TImage
    677626        Left = 5
    678         Top = 177
     627        Top = 221
    679628        Width = 31
    680629        Height = 31
    681630        Anchors = [akLeft, akBottom]
    682631        Visible = False
     632        ExplicitTop = 177
    683633      end
    684634      object chkDoseNow: TCheckBox
    … …  
    688638        Height = 21
    689639        Caption = 'Give additional dose now'
    690         TabOrder = 9
     640        TabOrder = 8
    691641        OnClick = chkDoseNowClick
    692642      end
    … …  
    709659        Height = 17
    710660        Caption = '>> Quantity Dispensed: Multiples of 100 <<'
    711         TabOrder = 12
     661        TabOrder = 13
    712662      end
    713663      object txtSupply: TCaptionEdit
    … …  
    729679        Height = 21
    730680        Associate = txtSupply
    731         Min = 0
    732         Position = 0
    733681        TabOrder = 2
    734         Wrap = False
    735682      end
    736683      object txtQuantity: TCaptionEdit
    … …  
    751698        Width = 16
    752699        Height = 21
    753         Min = -32766
     700        Associate = txtQuantity
    754701        Max = 32766
    755         Position = 0
    756702        TabOrder = 4
    757         Wrap = False
    758         OnChangingEx = spnQuantityChangingEx
    759703      end
    760704      object txtRefills: TCaptionEdit
    … …  
    766710        TabOrder = 5
    767711        Text = '0'
    768         OnChange = ControlChange
     712        OnChange = txtRefillsChange
    769713        OnClick = txtRefillsClick
    770714        Caption = 'Refills'
    … …  
    776720        Height = 21
    777721        Associate = txtRefills
    778         Min = 0
    779722        Max = 11
    780         Position = 0
    781723        TabOrder = 6
    782         Wrap = False
    783724      end
    784725      object grpPickup: TGroupBox
    … …  
    839780        Sorted = False
    840781        SynonymChars = '<>'
    841         TabOrder = 10
     782        TabOrder = 9
    842783        OnChange = ControlChange
    843784        CharsNeedMatch = 1
    844       end
    845       object chkSC: TCheckBox
    846         Left = 3
    847         Top = 106
    848         Width = 175
    849         Height = 17
    850         Caption = 'for Service Connected condition'
    851         ParentShowHint = False
    852         ShowHint = True
    853         TabOrder = 8
    854         OnClick = chkSCClick
    855         OnEnter = chkSCEnter
    856       end
    857       object lblAdminTime: TStaticText
    858         Left = 262
    859         Top = 120
    860         Width = 4
    861         Height = 4
    862         TabOrder = 16
    863785      end
    864786      object stcPI: TStaticText
    … …  
    898820      object memDrugMsg: TMemo
    899821        Left = 37
    900         Top = 176
     822        Top = 220
    901823        Width = 533
    902824        Height = 51
    … …  
    908830        Visible = False
    909831      end
    910     end
     832      object lblAdminSch: TMemo
     833        Left = 344
     834        Top = 120
     835        Width = 68
     836        Height = 15
     837        Anchors = [akLeft, akTop, akRight]
     838        Color = clCream
     839        ParentShowHint = False
     840        ReadOnly = True
     841        ScrollBars = ssVertical
     842        ShowHint = True
     843        TabOrder = 10
     844        Visible = False
     845      end
     846      object lblAdminTime: TVA508StaticText
     847        Name = 'lblAdminTime'
     848        Left = 164
     849        Top = 116
     850        Width = 64
     851        Height = 15
     852        Alignment = taLeftJustify
     853        Caption = 'lblAdminTime'
     854        TabOrder = 11
     855        TabStop = True
     856        ShowAccelChar = True
     857      end
     858    end
     859    object cboXSequence: TORComboBox
     860      Left = 438
     861      Top = 122
     862      Width = 64
     863      Height = 21
     864      Style = orcsDropDown
     865      AutoSelect = True
     866      Caption = 'Sequence'
     867      Color = clWindow
     868      DropDownCount = 8
     869      Items.Strings = (
     870        'and'
     871        'then')
     872      ItemHeight = 13
     873      ItemTipColor = clWindow
     874      ItemTipEnable = True
     875      ListItemsOnly = False
     876      LongList = False
     877      LookupPiece = 0
     878      MaxLength = 0
     879      Sorted = False
     880      SynonymChars = '<>'
     881      TabOrder = 6
     882      Visible = False
     883      OnChange = cboXSequenceChange
     884      OnEnter = cboXSequenceEnter
     885      OnExit = cboXSequenceExit
     886      OnKeyDown = memMessageKeyDown
     887      CharsNeedMatch = 1
     888    end
     889  end
     890  inherited cmdAccept: TButton
     891    Left = 514
     892    Top = 505
     893    Anchors = [akRight, akBottom]
     894    TabOrder = 6
     895    TabStop = False
     896    Visible = False
     897    ExplicitLeft = 514
     898    ExplicitTop = 505
     899  end
     900  inherited cmdQuit: TButton
     901    Left = 514
     902    Top = 530
     903    Width = 51
     904    Anchors = [akRight, akBottom]
     905    TabOrder = 7
     906    ExplicitLeft = 514
     907    ExplicitTop = 530
     908    ExplicitWidth = 51
     909  end
     910  inherited pnlMessage: TPanel
     911    Left = 31
     912    Top = 200
     913    OnEnter = pnlMessageEnter
     914    ExplicitLeft = 31
     915    ExplicitTop = 200
     916    inherited imgMessage: TImage
     917      Left = 2
     918      ExplicitLeft = 2
     919    end
     920    inherited memMessage: TRichEdit
     921      OnKeyDown = memMessageKeyDown
     922    end
     923  end
     924  inherited amgrMain: TVA508AccessibilityManager
     925    Data = (
     926      (
     927        'Component = pnlMeds'
     928        'Status = stsDefault')
     929      (
     930        'Component = lstQuick'
     931        'Text = Quick Orders'
     932        'Status = stsOK')
     933      (
     934        'Component = lstAll'
     935        'Text = Medications'
     936        'Status = stsOK')
     937      (
     938        'Component = txtMed'
     939        'Text = Medication'
     940        'Status = stsOK')
     941      (
     942        'Component = btnSelect'
     943        'Status = stsDefault')
     944      (
     945        'Component = pnlFields'
     946        'Status = stsDefault')
     947      (
     948        'Component = pnlTop'
     949        'Status = stsDefault')
     950      (
     951        'Component = grdDoses'
     952        'Status = stsDefault')
     953      (
     954        'Component = lblGuideline'
     955        'Status = stsDefault')
     956      (
     957        'Component = tabDose'
     958        'Status = stsDefault')
     959      (
     960        'Component = cboDosage'
     961        'Status = stsDefault')
     962      (
     963        'Component = cboRoute'
     964        'Status = stsDefault')
     965      (
     966        'Component = cboSchedule'
     967        'Status = stsDefault')
     968      (
     969        'Component = chkPRN'
     970        'Status = stsDefault')
     971      (
     972        'Component = btnXInsert'
     973        'Status = stsDefault')
     974      (
     975        'Component = btnXRemove'
     976        'Status = stsDefault')
     977      (
     978        'Component = pnlXAdminTime'
     979        'Status = stsDefault')
     980      (
     981        'Component = cboXDosage'
     982        'Status = stsDefault')
     983      (
     984        'Component = cboXRoute'
     985        'Status = stsDefault')
     986      (
     987        'Component = pnlXDuration'
     988        'Status = stsDefault')
     989      (
     990        'Component = pnlXDurationButton'
     991        'Status = stsDefault')
     992      (
     993        'Component = txtXDuration'
     994        'Status = stsDefault')
     995      (
     996        'Component = spnXDuration'
     997        'Status = stsDefault')
     998      (
     999        'Component = pnlXSchedule'
     1000        'Status = stsDefault')
     1001      (
     1002        'Component = cboXSchedule'
     1003        'Status = stsDefault')
     1004      (
     1005        'Component = chkXPRN'
     1006        'Status = stsDefault')
     1007      (
     1008        'Component = pnlBottom'
     1009        'Status = stsDefault')
     1010      (
     1011        'Component = chkDoseNow'
     1012        'Status = stsDefault')
     1013      (
     1014        'Component = memComment'
     1015        'Status = stsDefault')
     1016      (
     1017        'Component = lblQtyMsg'
     1018        'Status = stsDefault')
     1019      (
     1020        'Component = txtSupply'
     1021        'Status = stsDefault')
     1022      (
     1023        'Component = spnSupply'
     1024        'Status = stsDefault')
     1025      (
     1026        'Component = txtQuantity'
     1027        'Status = stsDefault')
     1028      (
     1029        'Component = spnQuantity'
     1030        'Status = stsDefault')
     1031      (
     1032        'Component = txtRefills'
     1033        'Status = stsDefault')
     1034      (
     1035        'Component = spnRefills'
     1036        'Status = stsDefault')
     1037      (
     1038        'Component = grpPickup'
     1039        'Status = stsDefault')
     1040      (
     1041        'Component = radPickWindow'
     1042        'Status = stsDefault')
     1043      (
     1044        'Component = radPickMail'
     1045        'Status = stsDefault')
     1046      (
     1047        'Component = radPickClinic'
     1048        'Status = stsDefault')
     1049      (
     1050        'Component = cboPriority'
     1051        'Status = stsDefault')
     1052      (
     1053        'Component = stcPI'
     1054        'Status = stsDefault')
     1055      (
     1056        'Component = chkPtInstruct'
     1057        'Status = stsDefault')
     1058      (
     1059        'Component = memPI'
     1060        'Status = stsDefault')
     1061      (
     1062        'Component = memDrugMsg'
     1063        'Status = stsDefault')
     1064      (
     1065        'Component = memOrder'
     1066        'Status = stsDefault')
     1067      (
     1068        'Component = cmdAccept'
     1069        'Status = stsDefault')
     1070      (
     1071        'Component = cmdQuit'
     1072        'Status = stsDefault')
     1073      (
     1074        'Component = pnlMessage'
     1075        'Status = stsDefault')
     1076      (
     1077        'Component = memMessage'
     1078        'Status = stsDefault')
     1079      (
     1080        'Component = frmODMeds'
     1081        'Status = stsDefault')
     1082      (
     1083        'Component = cboXSequence'
     1084        'Status = stsDefault')
     1085      (
     1086        'Component = lblAdminSch'
     1087        'Status = stsDefault')
     1088      (
     1089        'Component = lblAdminTime'
     1090        'Status = stsDefault'))
    9111091  end
    9121092  object dlgStart: TORDateTimeDlg
    913     FMDateTime = 3001101
     1093    FMDateTime = 3001101.000000000000000000
    9141094    DateOnly = False
    9151095    RequireTime = True
    … …  
    9581138    end
    9591139  end
    960   object popXSequence: TPopupMenu
    961     AutoHotkeys = maManual
    962     Left = 448
    963     Top = 145
    964     object and1: TMenuItem
    965       Tag = 1
    966       Caption = 'and'
    967       OnClick = popXSequenceClick
    968     end
    969     object then1: TMenuItem
    970       Tag = 2
    971       Caption = 'then'
    972       OnClick = popXSequenceClick
    973     end
    974   end
    9751140end

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

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    99  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
    10   Menus, XUDIGSIGSC_TLB;
     10  Menus, XUDIGSIGSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs;
    1111
    1212const
    … …  
    2626    cboXRoute: TORComboBox;
    2727    pnlXDuration: TPanel;
    28     pnlXSequence: TKeyClickPanel;
    29     btnXSequence: TSpeedButton;
    3028    timCheckChanges: TTimer;
    3129    popDuration: TPopupMenu;
    … …  
    3432    hours1: TMenuItem;
    3533    minutes1: TMenuItem;
    36     popXSequence: TPopupMenu;
    37     and1: TMenuItem;
    38     then1: TMenuItem;
    3934    months1: TMenuItem;
    4035    weeks1: TMenuItem;
    … …  
    7873    radPickClinic: TRadioButton;
    7974    cboPriority: TORComboBox;
    80     chkSC: TCheckBox;
    81     lblAdminTime: TStaticText;
    8275    stcPI: TStaticText;
    8376    chkPtInstruct: TCheckBox;
    … …  
    8679    memDrugMsg: TMemo;
    8780    txtNSS: TLabel;
    88     SpeedButton1: TSpeedButton;
     81    pnlXAdminTime: TPanel;
     82    cboXSequence: TORComboBox;
     83    lblAdminSch: TMemo;
     84    lblAdminTime: TVA508StaticText;
    8985    procedure FormCreate(Sender: TObject);
    9086    procedure btnSelectClick(Sender: TObject);
    … …  
    138134    procedure cboXRouteChange(Sender: TObject);
    139135    procedure cboXScheduleChange(Sender: TObject);
    140     procedure pnlXSequenceExit(Sender: TObject);
    141     procedure btnXSequenceClick(Sender: TObject);
    142136    procedure grdDosesExit(Sender: TObject);
    143137    procedure ListViewEnter(Sender: TObject);
    144138    procedure timCheckChangesTimer(Sender: TObject);
    145139    procedure popDurationClick(Sender: TObject);
    146     procedure popXSequenceClick(Sender: TObject);
    147     procedure chkSCEnter(Sender: TObject);
    148     procedure chkSCClick(Sender: TObject);
    149140    procedure cmdAcceptClick(Sender: TObject);
    150141    procedure btnXInsertClick(Sender: TObject);
    … …  
    167158      Shift: TShiftState);
    168159    procedure cboXRouteEnter(Sender: TObject);
    169     procedure pnlXSequenceEnter(Sender: TObject);
    170160    procedure pnlMessageEnter(Sender: TObject);
    171161    procedure pnlMessageExit(Sender: TObject);
    … …  
    174164    procedure memPIClick(Sender: TObject);
    175165    procedure FormResize(Sender: TObject);
    176     procedure spnQuantityChangingEx(Sender: TObject;
    177       var AllowChange: Boolean; NewValue: Smallint;
    178       Direction: TUpDownDirection);
    179166    procedure memPIKeyDown(Sender: TObject; var Key: Word;
    180167      Shift: TShiftState);
    … …  
    196183    procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
    197184    procedure cboXScheduleEnter(Sender: TObject);
     185    procedure pnlXAdminTimeClick(Sender: TObject);
     186    procedure cboXSequenceChange(Sender: TObject);
     187    procedure cboXSequence1Exit(Sender: TObject);
     188    procedure cboXSequenceExit(Sender: TObject);
     189    procedure cboXSequenceEnter(Sender: TObject);
     190    procedure txtRefillsChange(Sender: TObject);
    198191    //procedure btnNSSClick(Sender: TObject);
    199192  private
     193    FCloseCalled : Boolean;
    200194    FScheduleChanged : Boolean;
    201195    {selection}
    202     FAllItems:   TStringList;
    203     FAllFirst:   Integer;
    204     FAllLast:    Integer;
    205     FAllList:    Integer;
     196    FMedCache:   TObjectList;
     197    FCacheIEN:   Integer;
    206198    FQuickList:  Integer;
    207199    FQuickItems: TStringList;
    … …  
    237229    FNoZERO: boolean;
    238230    FIsQuickOrder: boolean;
    239     FAdminTimeLbl: string;
    240231    FDisabledDefaultButton: TButton;
    241232    FDisabledCancelButton: TButton;
    … …  
    250241    FRemoveText : Boolean;
    251242    FSmplPRNChkd: Boolean;
     243    {Admin Time}
     244    FAdminTimeLbl: string;
     245    FMedName: String;
     246    FNSSAdminTime: string;
     247    FNSSScheduleType: string;
     248    FAdminTimeText: string;
     249    //FOriginalAdminTime: string;
     250    //FOriginalScheduleIndex: integer;
     251    FOrderAction: integer;
     252    JAWSON: boolean;
    252253    procedure ChangeDelayed;
    253254    function FindQuickOrder(const x: string): Integer;
    254255    function isUniqueQuickOrder(iText: string): Boolean;
     256    function GetCacheChunkIndex(idx: integer): integer;
    255257    procedure LoadMedCache(First, Last: Integer);
    256258    procedure ScrollToVisible(AListView: TListView);
    … …  
    284286    procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
    285287    procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
    286     procedure UpdateSC(const CurDispDrug: string);
    287288    procedure UpdateStartExpires(const CurSchedule: string);
    288289    procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
    … …  
    313314    function IsSupplyAndOutPatient : boolean;
    314315    function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
     316    procedure DisplayDoseNow(Status: boolean);
     317    function lblAdminSchGetText: string;
     318    procedure lblAdminSchSetText(str: string);
    315319  protected
     320    procedure Loaded; override;
    316321    procedure InitDialog; override;
    317322    procedure Validate(var AnErrMsg: string); override;
     323    procedure updateSig; override;
    318324  public
    319325    ARow1: integer;
    320326    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    321327    procedure CheckDecimal(var AStr: string);
     328    property MedName: string read FMedName write FMedName;
     329    property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
     330    property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
    322331  end;
    323332
    … …  
    331340
    332341uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
    333   uAccessibleStringGrid, uOrders, fOtherSchedule, StrUtils, fFrame;
     342  uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter;
    334343
    335344const
    336345  {grid columns for complex dosing}
    337   COL_SELECT   =  0;
    338   COL_DOSAGE   =  1;
    339   COL_ROUTE    =  2;
    340   COL_SCHEDULE =  3;
    341   COL_DURATION =  4;
    342   COL_SEQUENCE =  5;
    343   COL_CHKXPRN  =  6;
    344   VAL_DOSAGE   = 10;
    345   VAL_ROUTE    = 20;
    346   VAL_SCHEDULE = 30;
    347   VAL_DURATION = 40;
    348   VAL_SEQUENCE = 50;
    349   VAL_CHKXPRN  = 60;
    350   TAB          = #9;
     346  COL_SELECT    =  0;
     347  COL_DOSAGE    =  1;
     348  COL_ROUTE     =  2;
     349  COL_SCHEDULE  =  3;
     350  COL_DURATION  =  4;
     351  COL_ADMINTIME =  5;
     352  COL_SEQUENCE  =  6;
     353  COL_CHKXPRN   =  7;
     354  VAL_DOSAGE    = 10;
     355  VAL_ROUTE     = 20;
     356  VAL_SCHEDULE  = 30;
     357  VAL_DURATION  = 40;
     358  VAL_ADMINTIME = 50;
     359  VAL_SEQUENCE  = 60;
     360  VAL_CHKXPRN   = 70;
     361  TAB           = #9;
    351362  {field identifiers}
    352363  FLD_LOCALDOSE =  1;
    … …  
    395406  TIMER_FROM_DAYS = 1;
    396407  TIMER_FROM_QTY  = 2;
     408
     409  MED_CACHE_CHUNK_SIZE = 100;
    397410  {text constants}
    398411  TX_ADMIN      = 'Requested Start: ';
    … …  
    440453  AutoSizeDisabled := True;
    441454  inherited;
     455  FAdminTimeText := '';
    442456  btnXDuration.Align := alClient;
    443457  AllowQuickOrder := True;
    … …  
    475489  //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
    476490  //else LoadSchedules(cboSchedule.Items, FInptDlg);
    477   LoadSchedules(cboSchedule.Items, FInptDlg); 
     491  LoadSchedules(cboSchedule.Items, FInptDlg);
    478492  StatusText('');
    479493  if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
    … …  
    482496  FOrigiMsgDisp := FSuppressMsg;
    483497  InitDialog;
     498  isIMO := IfisIMODialog;
     499  if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then
     500      FAdminTimeText := 'Not defined for Clinic Locations';
    484501  if FInptDlg then
    485502  begin
    … …  
    489506  end;
    490507  with grdDoses do
    491   begin
     508  begin                                         
    492509    ColWidths[0] := 8;  // select
    493510    ColWidths[1] := 160; // dosage
    … …  
    495512    ColWidths[3] := 102;  // schedule
    496513    ColWidths[4] := 70;  // duration
    497     ColWidths[5] := 58;  // and/then
     514    if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then
     515      begin
     516        ColWidths[5] := 102;  // administration times
     517        ColWidths[6] := 58;  // and/then
     518      end
     519    else
     520        ColWidths[5] := 0;
     521        ColWidths[6] := 58;
    498522    Cells[1, 0]  := 'Dosage';
    499523    Cells[2, 0]  := 'Route';
    500524    Cells[3, 0]  := 'Schedule';
    501525    Cells[4, 0]  := 'Duration (optional)';
    502     Cells[5, 0]  := 'then/and';
    503   end;
    504   TAccessibleStringGrid.WrapControl(grdDoses);
     526    Cells[5, 0]  := 'Admin. Times';
     527    Cells[6, 0]  := 'then/and';
     528  end;
    505529
    506530  // medication selection
    507531  FRowHeight := MainFontHeight + 1;
    508532
    509   IsIMO := IfIsIMODialog; //IMO
     533  //IsIMO := IfIsIMODialog; //IMO
    510534  if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order.
    511535  if FInptDlg then x := 'UD RX'
    … …  
    517541    x := 'IVM RX';
    518542  end;
    519   ListForOrderable(FAllList, ListCount, x);
     543  if self.EvtID > 0  then FAdminTimeText := 'To Be Determined';
     544  ListForOrderable(FCacheIEN, ListCount, x);
    520545  lstAll.Items.Count := ListCount;
    521   FAllItems := TStringList.Create;
    522   FAllFirst := -1;
    523   FAllLast  := -1;
     546  FMedCache := TObjectList.Create;
    524547  FQuickItems := TStringList.Create;
    525548  ListForQuickOrders(FQuickList, ListCount, x);
    … …  
    546569  FShowPnlXScheduleOk := True;
    547570  FRemoveText := True;
     571  JAWSON := True;
     572  if ScreenReaderActive = false then
     573    begin
     574      lblAdminTime.TabStop := false;
     575      lblAdminSch.TabStop := false;
     576      memOrder.TabStop := false;
     577      JAWSON := false;
     578    end;
    548579end;
    549580
    … …  
    552583  {selection}
    553584  FQuickItems.Free;
    554   FAllItems.Free;
     585  FMedCache.Free;
    555586  {edit}
    556587  FGuideline.Free;
    557588  FAllDoses.Free;
    558589  FAllDrugs.Free;
    559   TAccessibleStringGrid.UnwrapControl(grdDoses);
    560590  frmFrame.pnlVisit.Enabled := true;
    561591  inherited;
    … …  
    584614procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
    585615var
    586   AnInstr, OrderID, nsSch, Text: string;
     616  AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string;
    587617  ix: integer;
    588 begin
    589   inherited;
     618  LocChange: boolean;
     619  AResponse: TResponse;
     620
     621begin
     622  inherited;
     623  FOrderAction := OrderAction;
     624  if self.EvtID > 0 then DisplayDoseNow(false);
    590625  if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
    591   if CharAt(ID,1)='X' then
     626  if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then
    592627  begin
    593628    OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
    594629    CheckExistingPI(OrderID, FPtInstruct);
    595630  end;
    596   if OrderAction = ORDER_QUICK then
     631  //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
     632  //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
    597634  begin
    598635    FIsQuickOrder := True;
    … …  
    610647    Changing := True;
    611648    txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
     649    if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
     650     (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
     651    if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
     652     ((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit;
     653  (*  if (OrderAction = ORDER_QUICK) then
     654      begin
     655        tempAltIEN := GetQOAltOI;
     656        if tempAltIEN > 0 then txtMed.Tag := tempAltIEN;
     657      end; *)
    612658    SetOnMedSelect;                               // set up for this medication
    613659    SetOnQuickOrder;                              // insert quick order responses
    … …  
    638684       end;
    639685    end;  //nss
     686    //if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
     687    if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
     688      begin
     689        TempOrder := Piece(id,';',1);
     690        TempOrder := Copy(tempOrder, 2, Length(tempOrder));
     691        LocChange := DifferentOrderLocations(tempOrder, Patient.Location);
     692          if LocChange = false then
     693            begin
     694              AResponse := Responses.FindResponseByName('ADMIN', 1);
     695              if AResponse <> nil then AdminTime := AResponse.EValue;
     696              if self.cboSchedule.ItemIndex > -1 then
     697                begin
     698                  tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
     699                  SetPiece(tempSchString,U,4,AdminTime);
     700                  self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
     701                end;
     702              if self.tabDose.TabIndex = TI_COMPLEX then
     703                begin
     704                  if self.cboXSchedule.ItemIndex > -1 then
     705                    begin
     706                      tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
     707                      SetPiece(tempSchString,U,4,AdminTime);
     708                      self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
     709                    end;
     710                end;
     711              AResponse := Responses.FindResponseByName('SCHTYPE', 1);
     712              if AResponse <> nil then tempSchType := AResponse.EValue;
     713              if self.cboSchedule.ItemIndex > -1 then
     714                begin
     715                  if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
     716                     self.chkPRN.Checked := True
     717                  else
     718                     begin
     719                       tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
     720                       SetPiece(tempSchString,U,3,tempSchType);
     721                       self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
     722                     end;
     723                  end;
     724               if self.tabDose.TabIndex = TI_COMPLEX then
     725                begin
     726                  if self.cboXSchedule.ItemIndex > -1 then
     727                    begin
     728                      if  (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
     729                          self.chkXPRN.Checked := True
     730                      else
     731                        begin
     732                          tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
     733                          SetPiece(tempSchString,U,3,tempSchType);
     734                          self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
     735                        end;
     736                    end;
     737                end;
     738            end;
     739        if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then
     740            lblAdminSchSetText('');
     741        if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
     742      end;
    640743    if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
    641     (XfInToOutNow = true) then UpdateRelated(FALSE); //AGP Change
     744    (XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change
    642745    Changing := False;
     746    if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
     747        (self.cboSchedule.ItemIndex > -1) then
     748          UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1));
    643749  end;
    644750  { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
    … …  
    663769procedure TfrmODMeds.Validate(var AnErrMsg: string);
    664770var
    665   i,ie,code: Integer;
     771  i,ie,code, curSupply, tempRefills: Integer;
     772  curDispDrug, tmpError, temp, x: string;
    666773
    667774  procedure SetError(const x: string);
    … …  
    736843  if txtMed.Tag = 0 then SetError(TX_NO_MED);
    737844  if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
     845  if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
    738846  i := Responses.NextInstance('INSTR', 0);
    739847  while i > 0 do
    … …  
    757865    i := Responses.NextInstance('INSTR', i);
    758866  end;
     867  if self.tabDose.TabIndex = TI_DOSE then
     868     begin
     869         if (LeftStr(cboDosage.Text,1)='.') then
     870       begin
     871         SetError('Dosage must have a leading numeric value');
     872         Exit;
     873       end;
     874     end;
    759875  //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
    760   if self.tabDose.TabIndex = 1 then
    761     begin
    762        for i := 2 to self.grdDoses.RowCount do
     876  if self.tabDose.TabIndex = TI_COMPLEX then
     877    begin
     878       for i := 1 to self.grdDoses.RowCount do
    763879         begin
    764            if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
     880           temp := ValFor(COL_DOSAGE, i);
     881           if (LeftStr(temp,1) = '.') then
    765882             begin
    766               SetError(TX_NO_SEQ);
    767               Exit;
     883                SetError('All dosage must have a leading numeric value');
     884                Exit;
    768885             end;
     886           if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
     887              begin
     888                SetError(TX_NO_SEQ);
     889                Exit;
     890              end;
    769891         end;
    770892    end;
    … …  
    772894  begin
    773895    if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK);
    774     if StrToIntDef(Responses.IValueFor('REFILLS', 1), 99) > spnRefills.Max
     896    temp := Responses.IValueFor('REFILLS', 1);
     897    for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then
     898      begin
     899        SetError('Refills can only be a number');
     900        Exit;
     901      end;
     902    tempRefills := StrToIntDef(temp, 0);
     903    if (spnRefills.Max > 0) and (tempRefills > 0) then
     904      begin
     905        i := Responses.NextInstance('DOSE', 0);
     906        while i > 0 do
     907        begin
     908          x := ValueOfResponse(FLD_DRUG_ID,   i);
     909          CurDispDrug := CurDispDrug + x + U;
     910          i := Responses.NextInstance('DOSE', i);
     911        end;
     912        CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
     913        UpdateRefills(CurDispDrug, CurSupply);
     914      end;
     915    if tempRefills > spnRefills.Max
    775916      then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
    776917    with txtQuantity do
    777       if not ValidQuantity(Responses.IValueFor('QTY', 1)) then SetError(TX_QTY_NV);
     918      begin
     919        if not ValidQuantity(Responses.IValueFor('QTY', 1)) then
     920          SetError(TX_QTY_NV);
     921      (*  else
     922          begin
     923            Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
     924            if Quantity <> '' then SetError(Quantity);
     925          end; *)
     926      end;
    778927    with txtSupply do
    779928    begin
    … …  
    787936      if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM);
    788937      if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1)  then SetError(TX_SUPPLY_LIM1);
    789     end;
     938      //Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)));
     939      //if Supply <> '' then  SetError(Supply);
     940    end;
     941    tmpError :=  ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
     942    if tmpError <> '' then SetError(tmpError)
     943    else ClearMaxData;
    790944  end;
    791945end;
    … …  
    815969  lblPriority.Visible := True;
    816970  cboPriority.Visible := True;
    817   chkSC.Visible := False;
    818971  chkDoseNow.Visible := True;
    819972  lblAdminTime.Visible := True;
     973  lblAdminSch.Visible := True;
     974  lblAdminSch.Hint := AdminTimeHelpText;
     975  if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except'));
    820976end;
    821977
    822978procedure TfrmODMeds.SetControlsOutpatient;
    823 var
    824   ExceptItem: TMenuItem;
    825979begin
    826980  FillerID := 'PSO';
    … …  
    833987  lblQuantity.Visible := True;
    834988  txtQuantity.Visible := True;
     989  //if IsClozapineOrder = True then txtQuantity.Enabled := false;
    835990  spnQuantity.Visible := True;
    836991  lblQtyMsg.Visible := True;
    … …  
    841996  lblPriority.Visible := True;
    842997  cboPriority.Visible := True;
    843   chkSC.Visible := True;
    844998  chkDoseNow.Visible := False;
    845999  lblAdminTime.Visible := False;
    846   ExceptItem := TMenuItem.Create(Self);
    847   ExceptItem.Caption := 'except';
    848   ExceptItem.Tag := 3;
    849   ExceptItem.OnClick := popXSequenceClick;
    850   popXSequence.Items.Add(ExceptItem);
     1000  lblAdminSch.Visible := False;
     1001  if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except');
     1002 
    8511003end;
    8521004
    … …  
    9061058  x: string;
    9071059begin
    908   if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then             // navigation
     1060  if txtMed.ReadOnly then    // v27.50 - RV - CQ #15365
     1061  begin
     1062    if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then           // navigation
     1063    begin
     1064      Key := 0;
     1065      Exit;
     1066    end;
     1067  end
     1068  else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then             // navigation
    9091069  begin
    9101070    FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
    … …  
    9311091  Shift: TShiftState);
    9321092begin
    933   if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
    934 end;
     1093  if txtMed.ReadOnly then exit;    // v27.50 - RV - CQ #15365
     1094  if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer;
     1095end;
     1096
    9351097
    9361098procedure TfrmODMeds.txtMedChange(Sender: TObject);
    … …  
    9681130  UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
    9691131  QuickIndex := FindQuickOrder(UserText);            // look in quick list first
    970   AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
     1132  AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
    9711133  if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
    9721134  if AllIndex > -1 then
    … …  
    10441206begin
    10451207  StopKeyTimer;
     1208  if txtMed.ReadOnly then exit;        // v27.50 - RV - CQ #15365
    10461209  if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
    10471210end;
    … …  
    11121275{ lstAll Methods (lstAll is TListView) }
    11131276
     1277procedure TfrmODMeds.Loaded;
     1278begin
     1279  inherited;
     1280  if ScreenReaderSystemActive then
     1281    tabDose.TabStop := TRUE;
     1282end;
     1283
     1284// Cache is a list of 100 string lists, starting at idx 0
    11141285procedure TfrmODMeds.LoadMedCache(First, Last: Integer);
    1115 const
    1116   MAX_CACHE_ITEMS = 1000;
    1117 begin
    1118   // if range is within cache range we don't need to update anything
    1119   if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
    1120   // if range is outside of cache or a superset of cache, start over
    1121   if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
    1122      ((First < FAllFirst) and (Last > FAllLast)) or
    1123      (FAllItems.Count > MAX_CACHE_ITEMS) then
    1124   begin
    1125     FAllItems.Clear;
    1126     FAllFirst := -1;
    1127     FAllLast  := -1;
    1128   end;
    1129   // if getting items immediately before cache range
    1130   if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
    1131   // if getting items immediately after cache range
    1132   if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
    1133   // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
    1134   SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
    1135   // reset FAllFirst & FAllLast indexes to reflect current FAllItems
    1136   if FAllFirst < 0     then FAllFirst := First;
    1137   if FAllLast  < 0     then FAllLast  := Last;
    1138   if First < FAllFirst then FAllFirst := First;
    1139   if Last > FAllLast   then FAllLast := Last;
     1286var
     1287  firstChunk, lastchunk, i: integer;
     1288  list: TStringList;
     1289  firstMed, LastMed: integer;
     1290
     1291begin
     1292  firstChunk := GetCacheChunkIndex(First);
     1293  lastChunk := GetCacheChunkIndex(Last);
     1294  for i := firstChunk to lastChunk do
     1295  begin
     1296    if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then
     1297    begin
     1298      while FMedCache.Count <= i do
     1299        FMedCache.add(nil);
     1300      list := TStringList.Create;
     1301      FMedCache[i] := list;
     1302      firstMed := i * MED_CACHE_CHUNK_SIZE;
     1303      LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
     1304      if LastMed >= lstAll.Items.Count then
     1305        LastMed := lstAll.Items.Count - 1;
     1306      SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
     1307    end;
     1308  end;
    11401309end;
    11411310
    … …  
    11431312var
    11441313  x: string;
    1145 begin
    1146   if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
    1147     then LoadMedCache(Item.Index, Item.Index);
    1148   x := FAllItems[Item.Index - FAllFirst];
     1314  chunk: integer;
     1315  list: TStringList;
     1316begin
     1317  LoadMedCache(Item.Index, Item.Index);
     1318  chunk := GetCacheChunkIndex(Item.Index);
     1319  list := TStringList(FMedCache[chunk]);
     1320  x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
    11491321  Item.Caption := Piece(x, U, 2);
    11501322  Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
    … …  
    11851357var
    11861358  MedIEN: Integer;
    1187   MedName: string;
     1359  //MedName: string;
    11881360  QOQuantityStr: string;
    1189   ErrMsg: string;
     1361  ErrMsg, Temp: string;
    11901362begin
    11911363  inherited;
    11921364  QOQuantityStr := '';
    11931365  btnSelect.SetFocus;                             // let the exit events finish
    1194 
     1366  self.MedName := '';
    11951367  if pnlMeds.Visible then                         // display the medication fields
    11961368  begin
    … …  
    12041376      Responses.QuickOrder := Integer(lstQuick.Selected.Data);
    12051377      txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
     1378      if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit;
     1379      if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit;
    12061380      IsActivateOI(ErrMsg, txtMed.Tag);
    12071381      if Length(ErrMsg)>0 then
    … …  
    12091383        //btnSelect.Visible := False;
    12101384        btnSelect.Enabled := False;
    1211         ShowMessage(ErrMsg);
     1385        ShowMsg(ErrMsg);
    12121386        Exit;
    12131387      end;
    … …  
    12281402        Exit;
    12291403      end;
     1404   (*   temp := self.MedName;
     1405      tempIEN := txtMed.Tag;
     1406      QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder));
     1407      if QOIEN > 0 then
     1408        begin
     1409          CheckFormularyOI(tempIEN, temp, FInptDlg);
     1410          if tempIEN <> txtMed.Tag then
     1411            begin
     1412              txtMed.Tag := tempIEN;
     1413              txtMed.Text := temp;
     1414            end;
     1415        end; *)
     1416      FAltChecked := True;
     1417      ;
    12301418      SetOnMedSelect;   // set up for this medication
    12311419      SetOnQuickOrder;  // insert quick order responses
    … …  
    12331421         QOQuantityStr := txtQuantity.Text;
    12341422      ShowMedFields;
     1423      if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
    12351424      if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
    12361425        txtQuantity.Text := QOQuantityStr;
    … …  
    12391428    begin
    12401429      MedIEN := Integer(lstAll.Selected.Data);
    1241       MedName := lstAll.Selected.Caption;
     1430      self.MedName := lstAll.Selected.Caption;
     1431      if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit;
     1432      if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit;
    12421433      txtMed.Tag := MedIEN;
    12431434      ErrMsg := '';
    … …  
    12471438        //btnSelect.Visible := False;
    12481439        btnSelect.Enabled := False;
    1249         ShowMessage(ErrMsg);
     1440        ShowMsg(ErrMsg);
    12501441        Exit;
    12511442      end;
    … …  
    12591450        Exit;
    12601451      end;
    1261       if Pos(' NF', MedName) > 0 then
    1262       begin
    1263         CheckFormularyOI(MedIEN, MedName, FInptDlg);
     1452      if Pos(' NF', self.MedName) > 0 then
     1453      begin
     1454        temp := self.MedName;
     1455        CheckFormularyOI(MedIEN, temp, FInptDlg);
    12641456        FAltChecked := True;
    12651457      end;
    … …  
    12671459      begin
    12681460        txtMed.Tag := MedIEN;
    1269         txtMed.Text := MedName;
     1461        temp := self.MedName;
     1462        self.MedName := txtMed.Text;
     1463        txtMed.Text := Temp;
    12701464      end;
    12711465      SetOnMedSelect;
    … …  
    13521546  cboSchedule.ItemIndex := -1;
    13531547  cboSchedule.Text := '';  // leave items intact
     1548  if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText('');
    13541549  txtSupply.Text := '';
    13551550  txtSupply.Tag := 0;
    … …  
    13711566var
    13721567  i,j: Integer;
    1373   x: string;
     1568  temp,x: string;
    13741569  QOPiUnChk: boolean;
    13751570  PKIEnviron: boolean;
     1571  AResponse: TResponse;
    13761572begin
    13771573  // clear controls?
    … …  
    13801576  txtQuantity.Tag := 0;
    13811577  spnQuantity.Tag := 0;
    1382   chkSC.Tag := 0;
    1383   QOPiUnChk := False;
     1578   QOPiUnChk := False;
    13841579  PKIEnviron := False;
    13851580  if GetPKISite then PKIEnviron := True;
    … …  
    13901585    // set up lists & initial values based on orderable item
    13911586    SetControl(txtMed,       'Medication');
     1587    if (self.MedName <> '') then
     1588       begin
     1589         if (txtMed.Text <> self.MedName) then
     1590           begin
     1591             temp := self.MedName;
     1592             self.MedName := txtMed.Text;
     1593             txtMed.Text := temp;
     1594           end
     1595         else MedName := '';
     1596       end;
    13921597    SetControl(cboDosage,    'Dosage');
    13931598    SetControl(cboRoute,     'Route');
    … …  
    13951600    cboRouteChange(Self);
    13961601    x := DefaultText('Schedule');
    1397     if x <> '' then
     1602    //AGP Change 27.72 trying to centralized the schedule setting code
     1603    AResponse := Responses.FindResponseByName('SCHEDULE',1);
     1604    if (AResponse <> nil) and (AResponse.EValue <> '') then  x := AResponse.EValue;
     1605    SetSchedule(x);
     1606   (* if x <> '' then
    13981607    begin
    13991608      cboSchedule.SelectByID(x);
     1609      if cboSchedule.ItemIndex > -1 then
     1610        AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4);
     1611      if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN')  then
     1612        begin
     1613          self.chkPRN.Checked := true;
     1614          x := Copy(x,1,(Length(x)-3));
     1615          if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1))
     1616        end;
    14001617      cboSchedule.Text := x;
    1401     end;
     1618    end; *)
    14021619    if Length(ValueOf(FLD_QTYDISP))>10 then
    14031620    begin
    … …  
    14311648      lblPriority.Top := memcomment.Top + memComment.Height + 1;
    14321649      cboPriority.Top := lblPriority.Top + lblPriority.Height;
    1433       lblAdminTime.Left := chkDoseNow.Left;
    1434       lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
     1650      lblAdminSch.Left := chkDoseNow.Left;
     1651      lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
     1652      lblAdminSch.Height := (MainFontHeight * 3) + 3;
     1653      lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5;
     1654      lblAdminTime.Left := lblAdminSch.Left;
     1655      lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1;
     1656      if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('')
     1657      else
     1658        begin
     1659          if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText)
     1660          else self.lblAdminSch.Visible := False;
     1661        end;
    14351662    end else
    14361663    begin
    … …  
    14481675      end;
    14491676      //if Length(FPtInstruct) = 0 then
    1450       FPtInstruct := TextOf('PtInstr');
     1677      if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr');
    14511678      for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
    14521679      FPtInstruct := TrimRight(FPtInstruct);
    … …  
    15121739        if FIsQuickOrder then TempSch := cboSchedule.Text;
    15131740        SetSchedule(IValueFor('SCHEDULE', i));
    1514         if (cboSchedule.Text = '') and FIsQuickOrder then
     1741        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
    15151742        begin
    15161743          cboSchedule.SelectByID(TempSch);
    15171744          cboSchedule.Text := TempSch;
    15181745        end;
     1746        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
    15191747        x := cboSchedule.Text;
    15201748        if chkPRN.Checked then x := x + ' PRN';
    … …  
    15241752        if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
    15251753        grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
     1754        if FInptDlg then
     1755          begin
     1756            if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
     1757            else if cboSchedule.ItemIndex > -1 then
     1758               grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
     1759            else grdDoses.Cells[COL_ADMINTIME, i] := '';
     1760            if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
     1761            if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
     1762          end;
    15261763        if      IValueFor('CONJ', i) = 'A' then x := 'AND'
    15271764        else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
    … …  
    15431780      SetControl(cboRoute,  'ROUTE',     1);
    15441781      SetSchedule(IValueFor('SCHEDULE',  1));
    1545       if (cboSchedule.Text = '') and FIsQuickOrder then
     1782      if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
    15461783      begin
    15471784        cboSchedule.SelectByID(TempSch);
    15481785        cboSchedule.Text := TempSch;
    15491786      end;
     1787      if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
    15501788      if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder)  then
    15511789         FNSSOther := True;
    … …  
    15881826      AResponse := Responses.FindResponseByName('PICKUP', 1);
    15891827      if AResponse <> nil then SetPickup(AResponse.IValue);
    1590       if FIsQuickOrder then
     1828      if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then
    15911829      begin
    15921830        if not QOHasRouteDefined(Responses.QuickOrder) then
    … …  
    16031841      end;
    16041842      if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup);
    1605       AResponse := Responses.FindResponseByName('SC',     1);
    1606       if AResponse <> nil then chkSC.Checked := AResponse.IValue = '1';
     1843//      AResponse := Responses.FindResponseByName('SC',     1);
     1844      Responses.FindResponseByName('SC',     1);
    16071845    end; {if FInptDlg..else}
    16081846  end; {with}
    1609   if FInptDlg then
     1847 if FInptDlg then
    16101848  begin
    16111849    x := ValueOfResponse(FLD_SCHEDULE, 1);
    … …  
    17041942  lblSchedule.Visible := True;
    17051943  cboSchedule.Visible := True;
     1944  if FInptDlg = True then lblAdminSch.Visible := True
     1945  else lblAdminSch.Visible := false;
    17061946  chkPRN.Visible := True;
    17071947  ActiveControl := cboDosage;
    … …  
    17181958    begin
    17191959      DestCombo.Items.Clear;
    1720       DestCombo.Items.Assign(SrcCombo.Items);
     1960      FastAssign(SrcCombo.Items, DestCombo.Items);
    17211961      DestCombo.ItemIndex := SrcCombo.ItemIndex;
    17221962      DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
    … …  
    17391979        else cnt := cnt+1;
    17401980      end;
     1981    if (index = -1) and (Text <> '') then
     1982       begin
     1983         for I := 0 to DestCombo.Items.Count - 1 do
     1984         if Piece(DestCombo.Items.Strings[i],U,1) = Text then
     1985            begin
     1986               DestCombo.ItemIndex := i;
     1987               DestCombo.Text := Text;
     1988               Exit;
     1989            end;
     1990       end;
    17411991    end;
    17421992  end;
    … …  
    18152065procedure TfrmODMeds.SetSchedule(const x: string);
    18162066var
    1817 NonPRNPart: string;
    1818 begin
    1819   cboSchedule.ItemIndex := -1;
    1820   //AGP change CQ 10593, remove code to match the new expected first dose code
    1821   //PSI-05-026
    1822  (* if Pos('PRN', x) > 0 then
    1823   begin
    1824     NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    1825     cboSchedule.SelectByID(NonPRNPart);
    1826     if cboSchedule.ItemIndex < 0 then
    1827     begin
    1828       if NSSchedule then
    1829       begin
    1830         chkPRN.Checked := False;
    1831         cboSchedule.Text := '';
    1832       end else
    1833       begin
    1834         chkPRN.Checked := True;
    1835         cboSchedule.Items.Add(NonPRNPart);
    1836         cboSchedule.Text := NonPRNPart;
     2067NonPRNPart,tempSch, tempText: string;
     2068begin
     2069    //AGP Change 27.72 if schedule matches why goes through and reprocess the same info?
     2070    if cboSchedule.ItemIndex > -1 then
     2071      begin
     2072        tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1);
     2073        if tempText = x then exit;
     2074        if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then
     2075          begin
     2076             NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
     2077             if nonPRNPart = tempText then exit;
     2078          end;
    18372079      end;
    1838     end else
    1839       chkPRN.Checked := True;
    1840   end else
    1841   begin  *)
    1842     chkPRN.Checked := False;
     2080    cboSchedule.ItemIndex := -1;
     2081    if chkPRN.Checked = True then chkPRN.Checked := False;
    18432082    cboSchedule.SelectByID(x);
    1844     if cboSchedule.ItemIndex < 0 then
    1845     begin
    1846       if NSSchedule then
    1847       begin
    1848         cboSchedule.Text := '';
     2083    if cboSchedule.ItemIndex > -1 then exit;
     2084   // if cboSchedule.ItemIndex < 0 then
     2085    //begin
     2086      //if NSSchedule then
     2087      //begin
     2088      //  cboSchedule.Text := '';
     2089      //end
     2090      if FInptDlg then
     2091        begin
     2092          if (Pos('@', x) > 0) then
     2093            begin
     2094            tempSch := Piece(x, '@', 2);
     2095            cboSchedule.SelectByID(tempSch);
     2096            if cboSchedule.ItemIndex > -1 then
     2097              begin
     2098                tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
     2099                cboSchedule.Items.Add(tempSch);
     2100                cboSchedule.Text := (Piece(tempSch,U,1));
     2101                cboSchedule.SelectByID(Piece(tempSch,u,1));
     2102                EXIT;
     2103              end;
     2104            if Pos('PRN', tempSch) > 0 then
     2105              begin
     2106                NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
     2107                cboSchedule.SelectByID(NonPRNPart);
     2108                if cboSchedule.ItemIndex > -1 then
     2109                  begin
     2110                    tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
     2111                    cboSchedule.Items.Add(tempSch);
     2112                    cboSchedule.Text := (Piece(tempSch,U,1));
     2113                    cboSchedule.SelectByID(Piece(tempSch,u,1));
     2114                    chkPRN.Checked := True;
     2115                    EXIT;
     2116                  end
     2117                else
     2118                  begin
     2119                    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
     2120                    chkPRN.Checked := true;
     2121                    tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2);
     2122                    cboSchedule.Items.Add(tempSch);
     2123                    cboSchedule.SelectByID(Piece(tempSch, U, 1));
     2124                    EXIT;
     2125                  end;
     2126              end;
     2127              cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2));
     2128              cboSchedule.Text := x;
     2129              cboSchedule.SelectByID(x);
     2130              EXIT;
     2131            end
     2132        else if Pos('PRN', x) > 0 then
     2133          begin
     2134            NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
     2135            chkPRN.Checked := True;
     2136            cboSchedule.SelectByID(NonPRNPart);
     2137            if cboSchedule.ItemIndex > -1 then  EXIT;
     2138          end;
    18492139      end
    1850       else
    1851       begin
    1852       if Pos('PRN', x) > 0 then
     2140      else if Pos('PRN', x) > 0 then
    18532141        begin
    18542142         NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
    … …  
    18612149         EXIT;
    18622150        end;
    1863          cboSchedule.Items.Add(x);
    1864          cboSchedule.Text := x;
    1865          cboSchedule.SelectByID(x);
    1866       end;
    1867   end;
     2151      cboSchedule.Items.Add(x);
     2152      cboSchedule.Text := x;
     2153      cboSchedule.SelectByID(x);
    18682154end;
    18692155
    … …  
    18722158var
    18732159  //text,x, tmpsch: string;
    1874   text, x: string;
     2160  text, tmpAdmin, x: string;
    18752161  reset: integer;
    18762162begin
    … …  
    18962182  TI_DOSE:    begin
    18972183                cboXSchedule.Clear;                       // Added to Fix CQ: 9603
     2184                cboXDosage.Clear;
    18982185                // clean up responses?
    18992186                FSuppressMsg := FOrigiMsgDisp;
    … …  
    19122199                FSuppressMsg := FOrigiMsgDisp;
    19132200                if reset = 1 then exit;
     2201               (*  AGP Change admin wrap 27.73
     2202                tmpAdmin := Piece(self.lblAdminSch.text, ':', 2);
     2203                tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *)
     2204                tmpAdmin := lblAdminSchGetText;
     2205                if FAdminTimeText <> '' then
     2206                  begin
     2207                    tmpAdmin := FAdminTimeText;
     2208                    if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False;
     2209                  end;               
    19142210                ShowControlsComplex;
    19152211                ResetOnTabChange;
    … …  
    19172213                txtNss.Visible := False;
    19182214                x := cboXDosage.Text + TAB;
     2215                if LeftStr(x,1) = '.' then x := '';
    19192216                with cboXDosage   do if ItemIndex > -1 then x := x + Items[ItemIndex];
    19202217                grdDoses.Cells[COL_DOSAGE,   1] := x;
    … …  
    19252222                with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
    19262223                grdDoses.Cells[COL_SCHEDULE, 1] := x;
    1927                 UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
     2224                //AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected.
     2225                if FSmplPRNChkd then
     2226                  begin
     2227                    pnlXSchedule.Tag := 1;
     2228                    self.chkXPRN.Checked := True;
     2229                  end;
     2230                if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
    19282231                ControlChange(Self);
    19292232             end; {TI_COMPLEX}
    19302233  end; {case}
    1931 end;
    1932 
     2234  if ScreenReaderSystemActive then
     2235    GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab');
     2236end;
     2237
     2238
     2239function TfrmODMeds.lblAdminSchGetText: string;
     2240var
     2241tempstr: string;
     2242i: integer;
     2243begin
     2244  result := '';
     2245  if self.lblAdminSch.Text = '' then exit;
     2246  tempstr := '';
     2247  if self.lblAdminSch.Lines.Count > 1 then
     2248    begin
     2249      for i := 0 to self.lblAdminSch.Lines.Count - 1 do
     2250        tempstr := tempStr + self.lblAdminSch.Lines.Strings[i];
     2251    end
     2252  else if self.lblAdminSch.Lines.Count = 1 then
     2253       begin
     2254         tempstr := self.lblAdminSch.Text;
     2255       end;
     2256  Result := Piece(tempStr,':',2);
     2257  Result := Copy(Result,2,Length(Result));
     2258end;
     2259
     2260procedure TfrmODMeds.lblAdminSchSetText(str: string);
     2261var
     2262cutoff: integer;
     2263begin
     2264  cutoff := lblAdminSch.width div MainFontWidth;
     2265  if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF +
     2266                                              Copy(str, cutoff + 1, Length(str))
     2267  else self.lblAdminSch.Text := str;
     2268end;
    19332269
    19342270procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
    … …  
    20102346
    20112347procedure TfrmODMeds.cboDosageChange(Sender: TObject);
    2012 begin
    2013   inherited;
     2348var
     2349temp1,temp2: string;
     2350Count: integer;
     2351begin
     2352  inherited;
     2353  Count := Pos(U,cboDosage.Text);
     2354  if Count > 0 then
     2355    begin
     2356      temp1 := copy(cboDosage.Text,0,count-1);
     2357      temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text));
     2358      infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
     2359      cboDosage.Text := temp1 + temp2;
     2360    end;
    20142361  UpdateRelated;
    20152362end;
    20162363
    20172364procedure TfrmODMeds.cboDosageExit(Sender: TObject);
    2018 begin
    2019   inherited;
     2365var
     2366str: string;
     2367begin
     2368  inherited;
     2369  str := cboDosage.Text;
    20202370  if (length(cboDosage.Text)<1) then
    2021     cboDosage.ItemIndex := -1;
     2371      cboDosage.ItemIndex := -1;
     2372 (* Probably not needed here since this on validation check on accept
     2373  if (LeftStr(cboDosage.Text,1)='.') then
     2374       begin
     2375         infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
     2376         if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus;
     2377         Exit;
     2378       end; *)
     2379  if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and
     2380    (Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5) <> Piece(cboDosage.Text,tab,1)) then
     2381    begin
     2382      cboDosage.ItemIndex := -1;
     2383      cboDosage.Text := Piece(str, tab, 1);
     2384      UpdateRelated(false);
     2385    end;
    20222386  if ActiveControl = memMessage then
    20232387  begin
    … …  
    20822446    if length(trim(othSch)) > 1 then
    20832447    begin
     2448      othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
     2449      cboSchedule.Items.Add(othSch);
     2450      idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
     2451      cboSchedule.ItemIndex := idx;
     2452    end;
     2453  end
     2454  else
     2455    begin
     2456      NSSAdminTime := '';
     2457      FNSSScheduleType := '';
     2458    end;
     2459  UpdateRelated(False);
     2460end;
     2461
     2462
     2463procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
     2464var
     2465  othSch: string;
     2466  idx : integer;
     2467begin
     2468  inherited;
     2469  if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
     2470  begin
     2471    othSch := CreateOtherScheduel;
     2472    if length(trim(othSch)) > 1 then
     2473    begin
    20842474      cboSchedule.Items.Add(othSch);
    20852475      idx := cboSchedule.Items.IndexOf(OthSch);
    … …  
    20872477    end;
    20882478  end;
    2089   UpdateRelated(False);
    2090 end;
    2091 
    2092 procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
    2093 var
    2094   othSch: string;
    2095   idx : integer;
    2096 begin
    2097   inherited;
    2098   if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
    2099   begin
    2100     othSch := CreateOtherScheduel;
    2101     if length(trim(othSch)) > 1 then
    2102     begin
    2103       cboSchedule.Items.Add(othSch);
    2104       idx := cboSchedule.Items.IndexOf(OthSch);
    2105       cboSchedule.ItemIndex := idx;
    2106     end;
    2107   end;
    2108 //Remove Deletion of Text, since we are changing the validation to be on exit of the control.
    2109 {  if (Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0) and FInptDlg then
    2110     cboSchedule.Text := '';}
    21112479  FScheduleChanged := true;
    21122480  UpdateRelated;
    … …  
    21782546  inherited;
    21792547  if Changing then Exit;
    2180   if not Showing then Exit;
     2548  if not Showing then
     2549    begin
     2550       if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then
     2551         begin
     2552           Changing := True;
     2553           txtQuantity.Text := FloattoStr(FLastQuantity);
     2554           Changing := False;
     2555         end;
     2556       Exit;
     2557    end;
    21812558  if FNoZERO = False then FNoZERO := True;
    21822559  // if value = 0, change probably caused by the spin button
    21832560  if txtQuantity.Text <> '0' then txtQuantity.Tag := 1;
    21842561  UpdateRelated;
    2185 end;
    2186 
    2187 procedure TfrmODMeds.chkSCEnter(Sender: TObject);
    2188 begin
    2189   inherited;
    2190   pnlMessage.TabOrder := chkSC.TabOrder+1;
    2191   DispOrderMessage(RatedDisabilities);
    2192 end;
    2193 
    2194 procedure TfrmODMeds.chkSCClick(Sender: TObject);
    2195 begin
    2196   inherited;
    2197   chkSC.Tag := 1;
    21982562end;
    21992563
    … …  
    23152679end;
    23162680
     2681
    23172682function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
    23182683var
    … …  
    24412806begin
    24422807  Result := '';
    2443   if FInptDlg then                                // inpatient dialog
     2808 if FInptDlg then                                // inpatient dialog
    24442809  begin
    24452810    DrugOK := True;
    … …  
    24912856            end
    24922857            else DoseUnits := Piece(DoseFields, '&', 2);
    2493             if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
     2858            if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False;
    24942859          end;
    24952860          if not DrugOK then
    … …  
    25362901  FUpdated := FALSE;
    25372902  Responses.Clear;
    2538   Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
     2903  if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
     2904  else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
    25392905  DoseList := TStringList.Create;
    25402906  case tabDose.TabIndex of
    … …  
    25792945                                else Responses.Update('ROUTE',    1, '', x);
    25802946      x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x);
     2947      if FInptDlg then
     2948        begin
     2949        (* AGP Change Admin Time Wrap 27.73
     2950          x := Piece(self.lblAdminSch.text,':',2);
     2951          x := Copy(x,2,Length(x));  *)
     2952          x := lblAdminSchGetText;
     2953          if FAdminTimeText <> '' then x := '';
     2954          if x = 'Not Defined' then x := '';
     2955          Responses.Update('ADMIN',1,x,x);
     2956          X := Valueof(FLD_SCHED_TYP);
     2957          if self.chkPRN.Checked = true then x := 'P';
     2958          Responses.Update('SCHTYPE',1,x,x);
     2959        end;
    25812960    end;
    25822961  TI_COMPLEX:
    … …  
    26273006        end;
    26283007        x := ValueOf(FLD_DURATION, i);  Responses.Update('DAYS',     i, UpperCase(x), x);
     3008        if FInptDlg then
     3009          begin
     3010            x := ValFor(VAL_ADMINTIME,i);
     3011            if FAdminTimeText <> '' then x := '';
     3012            if x = 'Not Defined' then x := '';
     3013            Responses.Update('ADMIN',i,x,x);
     3014            x := Valueof(FLD_SCHED_TYP, i);
     3015            if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P';
     3016            Responses.Update('SCHTYPE', i, x, x);
     3017          end;
    26293018        x := ValueOf(FLD_SEQUENCE, i);
    26303019        if      Uppercase(x) = 'THEN'   then x := 'T'
    … …  
    26743063  with grdDoses do
    26753064    case FieldID of
    2676     COL_DOSAGE   : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 1);
    2677     COL_ROUTE    : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 1);
    2678     COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
    2679     COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
    2680     COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
    2681     VAL_DOSAGE   : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 2);
    2682     VAL_ROUTE    : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 2);
    2683     VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
    2684     VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
    2685     VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
    2686     VAL_CHKXPRN  : Result := Cells[COL_CHKXPRN, ARow];
     3065    COL_DOSAGE    : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 1);
     3066    COL_ROUTE     : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 1);
     3067    COL_SCHEDULE  : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3068    COL_DURATION  : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
     3069    COL_SEQUENCE  : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
     3070    VAL_DOSAGE    : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 2);
     3071    VAL_ROUTE     : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 2);
     3072    VAL_SCHEDULE  : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3073    VAL_DURATION  : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
     3074    VAL_ADMINTIME : Result := Piece(Cells[COL_ADMINTIME, ARow], TAB, 1);
     3075    VAL_SEQUENCE  : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
     3076    VAL_CHKXPRN   : Result := Cells[COL_CHKXPRN, ARow];
    26873077    end;
    26883078end;
    … …  
    27303120function TfrmODMeds.DurationToDays: Integer;
    27313121var
    2732   i, DoseMinutes, TotalMinutes: Integer;
     3122  i, DoseMinutes, AndMinutes, TotalMinutes: Integer;
    27333123  AllRows: Boolean;
    27343124  Days: Extended;
    … …  
    27433133  if not AllRows then Exit;
    27443134
     3135  AndMinutes := 0;
    27453136  TotalMinutes := 0;
    27463137  with grdDoses do for i := 1 to Pred(RowCount) do
    … …  
    27543145      if Piece(x, ' ', 2) = 'HOURS'   then DoseMinutes := ExtractInteger(x) * 60;
    27553146      if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
    2756       TotalMinutes := TotalMinutes + DoseMinutes;
    2757     end;
     3147      // Determine how TotalMinutes should be calculated based on conjunction
     3148      if ValFor(COL_SEQUENCE, i) <> 'AND' then  // 'THEN', 'EXCEPT', or ''
     3149      begin
     3150        if AndMinutes = 0 then TotalMinutes := TotalMinutes + DoseMinutes;
     3151        if AndMinutes > 0 then
     3152        begin
     3153          if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
     3154          TotalMinutes := TotalMinutes + AndMinutes;
     3155          AndMinutes := 0;
     3156        end;
     3157        if ValFor(COL_SEQUENCE, i) = 'EXCEPT' then break;  //quit out of For Loop to stop counting TotalMinutes
     3158      end;
     3159      if (ValFor(COL_SEQUENCE, i) = 'AND') then
     3160        if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
     3161    end;
     3162  if AndMinutes > 0 then TotalMinutes := TotalMinutes + AndMinutes;
     3163
    27583164  Days := TotalMinutes / 1440;
    27593165  if Days > Int(Days) then Days := Days + 1;
    … …  
    27683174  REL_DURATION = 0.16;
    27693175  REL_ANDTHEN  = 0.10;
     3176  REL_ADMINTIME = 0.16;
    27703177var
    27713178  i, ht, RowCountShowing: Integer;
    … …  
    27773184    i := grdDoses.Width - 12;                 // 12 = 4 pixel margin + 8 pixel column 0
    27783185    i := i - GetSystemMetrics(SM_CXVSCROLL);  // compensate for appearance of scroll bar
    2779     ColWidths[1] := Round(REL_DOSAGE   * i);  // dosage
    2780     ColWidths[2] := Round(REL_ROUTE    * i);  // route
    2781     ColWidths[3] := Round(REL_SCHEDULE * i);  // schedule
    2782     ColWidths[4] := Round(REL_DURATION * i);  // duration
    2783     ColWidths[5] := Round(REL_ANDTHEN  * i);  // and/then
     3186    if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
     3187      begin
     3188        ColWidths[1] := Round(REL_DOSAGE   * i);  // dosage
     3189        ColWidths[2] := Round(REL_ROUTE    * i);  // route
     3190        ColWidths[3] := Round(REL_SCHEDULE * i);  // schedule
     3191        ColWidths[4] := Round(REL_DURATION * i);  // duration
     3192        ColWidths[5] := Round(0  * i);  // administration time
     3193        grdDoses.TabStops[5] := False;
     3194        ColWidths[6] := Round(REL_ANDTHEN  * i);  // and/then
     3195      end
     3196    else
     3197      begin
     3198        ColWidths[1] := Round(0.35    * i);  // dosage
     3199        ColWidths[2] := Round(0.10     * i);  // route
     3200        ColWidths[3] := Round(0.19  * i);  // schedule
     3201        ColWidths[4] := Round(0.12  * i);  // duration
     3202        ColWidths[5] := Round(0.16 * i);  // administration time
     3203        grdDoses.TabStops[5] := True;
     3204        ColWidths[6] := Round(0.08   * i);  // and/then
     3205      end;
    27843206    // adjust height of grid to not show partial rows
    27853207    ht := pnlBottom.Top - Top - 6;
    … …  
    27963218      COL_SCHEDULE:ColControl := pnlXSchedule;
    27973219      COL_DURATION:ColControl := pnlXDuration;
    2798       COL_SEQUENCE:ColControl := pnlXSequence;
     3220      COL_ADMINTIME:ColControl := pnlXAdminTime;
     3221      COL_SEQUENCE:ColControl := cboXSequence;
    27993222    end; {case}
    28003223
    … …  
    28443267  COL_ROUTE:    with cboXRoute    do if Items.Count > 0 then DroppedDown := True;
    28453268  COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True;
     3269  COL_SEQUENCE: with cboXSequence do if Items.Count > 0 then DroppedDown := True;
     3270                                     
    28463271  end;
    28473272  FDropColumn := -1;
    … …  
    29773402                  end; *)
    29783403                  Changing := FALSE;
    2979                   pnlXSequence.Tag := ARow;
     3404                  cboXSequence.Tag := ARow;
    29803405                  PlaceControl(pnlXSchedule);
    2981                   //cboXSchedule.SetFocus;
    29823406                  FDropColumn := COL_SCHEDULE;
    29833407                  if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE);
    … …  
    30053429                end;
    30063430  COL_SEQUENCE: begin
    3007                   x := ValFor(COL_SEQUENCE, ARow);
    3008                   //if x = '' then x := 'and';  AGP Change 26.46 remove for CQ 9535
    3009                   btnXSequence.Caption := x;
    3010                   pnlXSequence.Caption := btnXSequence.Caption;
    3011                   pnlXSequence.Tag := ARow;
     3431                  SynchCombo(cboXSequence, ValFor(VAL_SEQUENCE, ARow), ValFor(COL_SEQUENCE, ARow));
     3432                  cboXSequence.Tag := ARow;
    30123433                  ARow1 := ARow;
    3013                   PlaceControl(pnlXSequence);
    3014                   btnXSequence.Width := pnlXSequence.Width;
     3434                  PlaceControl(cboXSequence);
     3435                  FDropColumn := COL_SEQUENCE;
     3436                  if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SEQUENCE);
    30153437                end;
     3438  COL_ADMINTIME: BEGIN
     3439                 pnlXAdminTime.OnClick(pnlXAdminTime);
     3440                 end;
    30163441  end; {case ACol}
    30173442end;
    … …  
    30283453                   txtXDuration.SelStart := 1;
    30293454                 end;
     3455  COL_SEQUENCE : FindInCombo(Chr(Message.WParam), cboXSequence);
    30303456  end;
    30313457end;
    … …  
    30413467
    30423468procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
     3469var
     3470temp1,temp2: string;
     3471count: integer;
    30433472begin
    30443473  inherited;
    30453474  if not Changing and (cboXDosage.ItemIndex < 0) then
    30463475  begin
     3476    Count := Pos(U,cboXDosage.Text);
     3477    if Count > 0 then
     3478      begin
     3479        temp1 := copy(cboXDosage.Text,0,count-1);
     3480        temp2 := copy(cboXDosage.Text,count+1,Length(cboXDosage.text));
     3481        infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
     3482        cboXDosage.Text := temp1 + temp2;
     3483      end;
    30473484    grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
    30483485    UpdateRelated;
    … …  
    30853522
    30863523procedure TfrmODMeds.cboXDosageExit(Sender: TObject);
    3087 begin
    3088   inherited;
    3089   cboXDosageClick(Self);
    3090   cboXDosage.Tag := -1;
    3091   cboXDosage.Hide;
    3092   UpdateRelated;
    3093   RestoreDefaultButton;
    3094   RestoreCancelButton;
    3095   if (pnlMessage.Visible) and (memMessage.TabStop)  then
    3096   begin
    3097     pnlMessage.Parent := grdDoses.Parent;
    3098     pnlMessage.TabOrder := grdDoses.TabOrder;
    3099     ActiveControl := memMessage;
    3100   end
    3101   else if grdDoses.Showing then
    3102     ActiveControl := grdDoses
    3103   else
    3104     ActiveControl := cboDosage;
    3105 end;
     3524var
     3525//tempTag: integer;
     3526str: string;
     3527begin
     3528  inherited;
     3529  if cboXDosage.Showing then
     3530  begin
     3531    cboXDosageClick(Self);
     3532    str := cboXDosage.Text;
     3533    //tempTag := cboXDosage.Tag;
     3534    //cboXDosage.Tag := -1;
     3535    cboXDosage.Hide;
     3536    UpdateRelated;
     3537    RestoreDefaultButton;
     3538    RestoreCancelButton;
     3539   (*Probably not needed here since on validation check on accept
     3540    if (LeftStr(cboXDosage.Text,1)='.') and (self.tabDose.TabIndex = TI_COMPLEX) then
     3541         begin
     3542           infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
     3543           //cboXDosage.Tag := tempTag;
     3544           cboXDosage.Show;
     3545           cboXDosage.SetFocus;
     3546           Exit;
     3547         end;  *)
     3548    if (length(cboxdosage.Text)>0) and (cboxDosage.ItemIndex > -1) and
     3549      (Piece(cboxDosage.Items.Strings[cboxDosage.ItemIndex],U,5) <> Piece(cboxDosage.Text,'#',1)) then
     3550      begin
     3551        cboXDosage.ItemIndex := -1;
     3552        cboXDosage.Text := Piece(str, '#', 1);
     3553        self.grdDoses.Cells[COL_DOSAGE,self.grdDoses.row] := cboXDosage.Text;
     3554        UpdateRelated(false);
     3555      end;
     3556    if (pnlMessage.Visible) and (memMessage.TabStop)  then
     3557    begin
     3558      pnlMessage.Parent := grdDoses.Parent;
     3559      pnlMessage.TabOrder := grdDoses.TabOrder;
     3560      ActiveControl := memMessage;
     3561    end
     3562    else if grdDoses.Showing then
     3563      ActiveControl := grdDoses
     3564    else
     3565      ActiveControl := cboDosage;
     3566    end
     3567    else
     3568       cmdQuit.Click;
     3569  end;
    31063570
    31073571procedure TfrmODMeds.cboXRouteChange(Sender: TObject);
    … …  
    31753639    if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then
    31763640    begin
     3641      cboXSchedule.SelectByID('OTHER');
    31773642      othSch := CreateOtherScheduelComplex;
    31783643      if length(trim(othSch)) > 1 then
    31793644      begin
     3645        othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
    31803646        cboXSchedule.Items.Add(othSch);
    3181         idx := cboXSchedule.Items.IndexOf(OthSch);
     3647        idx := cboXSchedule.Items.IndexOf(Piece(OthSch, U, 1));
    31823648        cboXSchedule.ItemIndex := idx;
    31833649      end;
    31843650    end;
    3185   (* if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
    3186     with cboXSchedule do if ItemIndex > -1
    3187       then x := Text + PRN + TAB + Items[ItemIndex]
    3188       else x := Text + PRN; *)
     3651  if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
     3652    //if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
    31893653    with cboXSchedule do if ItemIndex > -1
    31903654      then x := Text + TAB + Items[ItemIndex]
    … …  
    31923656    grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
    31933657    self.cboSchedule.Text := x;
     3658     //AGP Start Expired uncommented out the line
     3659    if FInptDlg then UpdateStartExpires(Piece(x, tab, 1));
    31943660    UpdateRelated;
    31953661  end;
    … …  
    31983664procedure TfrmODMeds.cboXScheduleClick(Sender: TObject);
    31993665var
    3200   x: string;
    3201 begin
    3202   inherited;
    3203   //if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
     3666  PRN,x: string;
     3667begin
     3668  inherited;
     3669  //agp change CQ 11015
     3670  if (chkXPRN.Checked) then PRN := ' PRN' else PRN := '';
     3671  with cboXSchedule do
     3672    begin
     3673      if RightStr(Text,3) = 'PRN' then PRN := '';
     3674      if ItemIndex > -1 then x := Text + PRN + TAB + Items[ItemIndex]
     3675      else x := Text + PRN;
     3676    end;
    32043677 (* with cboXSchedule do if ItemIndex > -1
    3205     then x := Text + PRN + TAB + Items[ItemIndex]
    3206     else x := Text + PRN;  *)
    3207   with cboXSchedule do if ItemIndex > -1
    32083678    then x := Text + TAB + Items[ItemIndex]
    3209     else x := Text;
    3210    (* if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then
    3211     if lblAdmintime.visible then
    3212       lblAdmintime.Caption := ''; *)
     3679    else x := Text;  *)
    32133680  grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
    3214   UpdateStartExpires(x);
     3681  //AGP Start Expired uncommented out the line
     3682  UpdateStartExpires(Piece(x, tab, 1));
    32153683  UpdateRelated;
    32163684end;
    … …  
    32483716  else
    32493717    ActiveControl := cboDosage;
     3718  //AGP Start Expired commented out the line
     3719  //updateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
     3720end;
     3721
     3722procedure TfrmODMeds.pnlXAdminTimeClick(Sender: TObject);
     3723var
     3724Str: string;
     3725begin
     3726  inherited;
     3727  if not FInptDlg then Exit;
     3728 
     3729  str := 'The Administration Times for this dose are: ' + CRLF + CRLF + VALFOR(VAL_ADMINTIME,grddoses.Row);
     3730  str := str + CRLF + CRLF + AdminTimeHelpText;
     3731  infoBox(str,'Administration Time Information',MB_OK);
    32503732end;
    32513733
    … …  
    32723754    if (Code <> 0) {and (I=0)} then
    32733755    begin
    3274       ShowMessage('Please use numeric characters only.');
     3756      ShowMsg('Please use numeric characters only.');
    32753757      with txtXDuration do
    32763758      begin
    … …  
    33053787                    begin
    33063788                        grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
    3307                         pnlXSequence.Tag := ARow1;
    3308                         pnlXSequence.Caption := '';
    3309                         grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := '';
    3310                         btnXSequence.Click;
     3789                        cboXSequence.Tag := ARow1;
     3790                        grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := '';
     3791                        cboXSequence.Text := '';
     3792                        cboXSequence.ItemIndex := -1;
    33113793                    end
    33123794                    else
    … …  
    33403822end;
    33413823
    3342 procedure TfrmODMeds.btnXSequenceClick(Sender: TObject);
    3343 var
    3344   APoint: TPoint;
    3345 begin
    3346   inherited;
    3347   inherited;
    3348   with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
    3349   popXSequence.Popup(APoint.X, APoint.Y);
    3350   pnlXSequence.Caption := btnXSequence.Caption;
    3351   {
    3352   with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
    3353   popXSequence.Popup(APoint.X, APoint.Y);
    3354   pnlXSequence.Caption := btnXSequence.Caption;
    3355   if (pnlXSequence.Caption = 'then') and
    3356       ((ValFor(COL_DURATION, ARow1) = '') or
    3357        (ValFor(COL_DURATION, ARow1) = '0')) then
    3358      begin
    3359        InfoBox('A duration is required when using "Then" as a conjunction','Duration Warning',MB_OK);
    3360        pnlXSequence.Caption := '';
    3361        btnXSequence.Caption := '';
    3362      end;
    3363      }
    3364 end;
    3365 
    3366 procedure TfrmODMeds.popXSequenceClick(Sender: TObject);
    3367 var
    3368   x: string;
    3369 begin
    3370   inherited;
    3371   with TMenuItem(Sender) do if Tag > 0 then x := Caption else x := '';
    3372  //AGP Changes 26.12 PSI-04-63
    3373  //if ((x = 'then') and (FInptDlg)) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
    3374  //AGP change 26.32 Then/And conjunction requiring a duration to include outpatient orders
    3375  if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
    3376      begin
    3377        InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
    3378            'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
    3379        x := '';
    3380      end;
    3381   btnXSequence.Caption := x;
    3382   pnlXSequence.Caption := btnXSequence.Caption;
    3383   grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(x);
    3384   ControlChange(Sender);
    3385 end;
    3386 
    3387 procedure TfrmODMeds.pnlXSequenceExit(Sender: TObject);
    3388 begin
    3389   inherited;
    3390   grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(btnXSequence.Caption);
    3391   if ActiveControl = grdDoses then
    3392   begin
    3393     //This next condition seldom occurs, since entering the dosage on the last
    3394     // row adds another row
    3395     if grdDoses.Row = grdDoses.RowCount - 1 then
    3396       grdDoses.RowCount := grdDoses.RowCount + 1;
    3397   end;
    3398   pnlXSequence.Tag := -1;
    3399   pnlXSequence.Hide;
    3400   RestoreDefaultButton;
    3401   RestoreCancelButton;
    3402   if (pnlMessage.Visible) and (memMessage.TabStop) then
    3403   begin
    3404     pnlMessage.Parent := grdDoses.Parent;
    3405     pnlMessage.TabOrder := grdDoses.TabOrder;
    3406     ActiveControl := memMessage;
    3407   end
    3408   else if grdDoses.Showing then
    3409     ActiveControl := grdDoses
    3410   else
    3411     ActiveControl := cboDosage;
    3412 end;
    34133824
    34143825procedure TfrmODMeds.btnXInsertClick(Sender: TObject);
    … …  
    34633874    Schedule  <TAB> (nothing)
    34643875    Duration  <TAB> Duration^Units }
     3876
     3877  // the following functions were created to get rid of a compile warning saying the
     3878  // return value may be undefined - too much branching logic in the case statements
     3879  // for the compiler to handle
     3880 
     3881  function GetSingleDoseSchedule: string;
     3882  begin
     3883    Result := UpperCase(Trim(cboSchedule.Text));
     3884    if chkPRN.Checked then Result := Result + ' PRN';
     3885    if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
     3886      then Result := Copy(Result, 1, Length(Result) - 4);
     3887  end;
     3888
     3889  function GetSingleDoseScheduleEX: string;
     3890  begin
     3891    Result := '';
     3892    with cboSchedule do
     3893    begin
     3894      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
     3895(*     if (Length(Result)=0) and (ItemIndex > -1) then
     3896        begin
     3897          Result := Piece(Items[ItemIndex], U, 1);
     3898          if Piece(Items[ItemIndex], U, 3) = 'P' then
     3899          begin
     3900            if RightStr(Result,3) = 'PRN' then
     3901              begin
     3902                Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3903                if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3904                Result := Copy(Result,1,Length(Result)-1);
     3905              end;
     3906           Result := Result + ' AS NEEDED';
     3907          end;
     3908        end;
     3909    end; *)
     3910      if RightStr(Result,3) = 'PRN' then
     3911      begin
     3912        Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3913        if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3914          Result := Copy(Result,1,Length(Result)-1);
     3915        Result := Result + ' AS NEEDED'
     3916      end;
     3917      if (Length(Result) > 0) and chkPRN.Checked then
     3918        Result := Result + ' AS NEEDED';
     3919      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then
     3920        Result := Copy(Result, 1, Length(Result) - 10);
     3921      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
     3922      begin
     3923        Result := Copy(Result, 1, Length(Result) - 13);
     3924        if RightStr(Result,1)=' ' then
     3925          Result := Result + 'AS NEEDED'
     3926        else
     3927          Result := Result + ' AS NEEDED';
     3928      end;
     3929    end;
     3930  end;
     3931
     3932  function GetComplexDoseSchedule: string;
     3933  begin
     3934    with grdDoses do
     3935    begin
     3936      Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
     3937      if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3938      if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
     3939      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
     3940      Result := Copy(Result, 1, Length(Result) - 4);
     3941    end;
     3942  end;
     3943
     3944  function GetComplexDoseScheduleEX: string;
     3945  begin
     3946    with grdDoses do
     3947    begin
     3948      (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
     3949      if Result = '' then //Added for CQ: 7639
     3950      begin
     3951        Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3952        if RightStr(Result,4) = ' PRN' then
     3953          Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
     3954      end;
     3955      if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
     3956         Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
     3957         (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
     3958         then Result := Result + ' AS NEEDED';
     3959    end;*)
     3960      Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
     3961      if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
     3962      if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
     3963      if RightStr(Result,3) = 'PRN' then
     3964      begin
     3965        Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
     3966        if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
     3967        Result := Copy(Result,1,Length(Result)-1);
     3968        Result := Result + ' AS NEEDED';
     3969      end;
     3970      if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
     3971      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
     3972      then Result := Copy(Result, 1, Length(Result) - 10);
     3973      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
     3974      begin
     3975        Result := Copy(Result, 1, Length(Result) - 13);
     3976        if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
     3977        else Result := Result + ' AS NEEDED';
     3978      end;
     3979    end;
     3980  end;
     3981 
    34653982begin
    34663983  Result := '';
    … …  
    34964013    FLD_ROUTE_EX  : with cboRoute do
    34974014                     if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
    3498     FLD_SCHEDULE  : begin        //gary)
    3499                       Result := UpperCase(Trim(cboSchedule.Text));
    3500                       if chkPRN.Checked then Result := Result + ' PRN';
    3501                       if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
    3502                         then Result := Copy(Result, 1, Length(Result) - 4);
     4015    FLD_SCHEDULE  : begin     
     4016                      Result := GetSingleDoseSchedule;
    35034017                    end;
    35044018    FLD_SCHED_EX  : begin
    3505                       with cboSchedule do
    3506                         begin
    3507                         if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
    3508                    (*     if (Length(Result)=0) and (ItemIndex > -1) then
    3509                             begin
    3510                               Result := Piece(Items[ItemIndex], U, 1);
    3511                               if Piece(Items[ItemIndex], U, 3) = 'P' then
    3512                               begin
    3513                                 if RightStr(Result,3) = 'PRN' then
    3514                                   begin
    3515                                     Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
    3516                                     if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
    3517                                     Result := Copy(Result,1,Length(Result)-1);
    3518                                   end;
    3519                                Result := Result + ' AS NEEDED';
    3520                               end;
    3521                             end;
    3522                         end; *)
    3523                       if RightStr(Result,3) = 'PRN' then
    3524                            begin
    3525                               Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
    3526                               if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
    3527                               Result := Copy(Result,1,Length(Result)-1);
    3528                               Result := Result + ' AS NEEDED'
    3529                            end;
    3530                       if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
    3531                       if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
    3532                         then Result := Copy(Result, 1, Length(Result) - 10);
    3533                       if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
    3534                           begin
    3535                             Result := Copy(Result, 1, Length(Result) - 13);
    3536                             if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
    3537                             else Result := Result + ' AS NEEDED';
    3538                           end;
    3539                     end;
     4019                      Result := GetSingleDoseScheduleEX;
    35404020                    end;
    35414021    FLD_SCHED_TYP : with cboSchedule do
    … …  
    35784058      FLD_ROUTE_EX  : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4);
    35794059      FLD_SCHEDULE  : begin
    3580                          Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
    3581                          if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
    3582                          if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
    3583                          if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
    3584                          Result := Copy(Result, 1, Length(Result) - 4);
     4060                        Result := GetComplexDoseSchedule;
    35854061                      end;
    35864062      FLD_SCHED_EX  : begin
    3587                         (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
    3588                         if Result = '' then //Added for CQ: 7639
    3589                         begin
    3590                           Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
    3591                           if RightStr(Result,4) = ' PRN' then
    3592                             Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
    3593                         end;
    3594                         if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
    3595                            Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
    3596                            (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
    3597                            then Result := Result + ' AS NEEDED';
    3598                       end;*)
    3599                         Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
    3600                         if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
    3601                         if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
    3602                         if RightStr(Result,3) = 'PRN' then
    3603                            begin
    3604                               Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
    3605                               if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
    3606                               Result := Copy(Result,1,Length(Result)-1);
    3607                               Result := Result + ' AS NEEDED';
    3608                            end;
    3609                         if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
    3610                         if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
    3611                         then Result := Copy(Result, 1, Length(Result) - 10);
    3612                         if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
    3613                           begin
    3614                             Result := Copy(Result, 1, Length(Result) - 13);
    3615                             if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
    3616                             else Result := Result + ' AS NEEDED';
    3617                           end;
     4063                        Result := GetComplexDoseScheduleEX;
    36184064                      end;
    36194065      FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3);
    … …  
    36414087    FLD_PRIOR_NM  : Result := cboPriority.Text;
    36424088    FLD_COMMENT   : Result := memComment.Text;
    3643     FLD_SC        : if chkSC.Visible then
    3644                     begin
    3645                       if chkSC.Checked then Result := '1' else Result := '0';
    3646                     end;
     4089
    36474090    FLD_NOW_ID    : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1'   else Result := '';
    36484091    FLD_NOW_NM    : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := '';
    … …  
    36824125var
    36834126  ADrug: string;
    3684 begin
     4127  Checked: boolean;
     4128  tmpSupply: integer;
     4129begin
     4130  Checked := false;
    36854131  if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
    36864132     (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
    3687      or ((cboDosage.ItemIndex < 0) and not FIsQuickOrder ) then
    3688   begin
     4133     or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or
     4134     ((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial))  then
     4135  begin
     4136    Checked := True;
    36894137    ADrug := Piece(CurDispDrug, U, 1);
    36904138    CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
    … …  
    36944142      if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply)  then
    36954143        txtSupply.Text := IntToStr(CurSupply);
    3696       if (FIsQuickOrder and FQOInitial) then
     4144      if (FIsQuickOrder) and (FQOInitial) and (IsClozapineOrder = false) then
    36974145      begin
    36984146        if StrToFloatDef(txtSupply.Text,0) > 0 then
    … …  
    37124160      SkipQtyCheck := TRUE;
    37134161    end;
    3714   end;
     4162    if FQOInitial = true then FQOInitial := False;   
     4163  end;
     4164  if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
     4165    begin
     4166      ADrug := Piece(CurDispDrug, U, 1);
     4167      tmpSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
     4168      if (tmpSupply > 0) and (CurSupply > tmpSupply) then
     4169        begin
     4170          CurSupply := tmpSupply;
     4171          spnSupply.Position := CurSupply;
     4172          if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply)  then
     4173          txtSupply.Text := IntToStr(CurSupply);
     4174        end;
     4175      CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
     4176      if CurQuantity >= 0 then
     4177      begin
     4178       //spnQuantity.Position := CurQuantity;
     4179       if (txtQuantity.Text <> '') and (CurQuantity > 0) then
     4180        txtQuantity.Text := FloatToStr(CurQuantity);
     4181       if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) and (CurQuantity > 0)  then
     4182         txtQuantity.Text := FloatToStr(CurQuantity);
     4183      end;
     4184    end;
    37154185end;
    37164186
    … …  
    38084278end;
    38094279
    3810 procedure TfrmODMeds.UpdateSC(const CurDispDrug: string);
    3811 var
    3812   Dispense: Integer;
    3813 begin
    3814   Dispense := StrToIntDef(Piece(CurDispDrug, U, 1), 0);  // just use first dispense drug for now
    3815   if Patient.ServiceConnected and RequiresCopay(Dispense) then
    3816   begin
    3817     chkSC.Visible := True;
    3818     if chkSC.Tag = 0 then chkSC.Checked := Patient.SCPercent > 50;
    3819     if chkSC.Hint = '' then chkSC.Hint := RatedDisabilities;
    3820   end
    3821   else chkSC.Visible := False;
    3822   FUpdated := True;
     4280procedure TfrmODMeds.updateSig;
     4281begin
     4282  inherited;
     4283  if self.tabDose.TabIndex = TI_DOSE then self.cboDosage.OnExit(cboDosage);
     4284  if self.tabDose.TabIndex = TI_COMPLEX then self.cboxDosage.OnExit(cboxDosage);
    38234285end;
    38244286
    38254287procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string);
    38264288var
    3827   CompSch, ShowText, Duration, ASchedule: string;
     4289  CompSch, CompDose, LastSch, ShowText, Duration, ASchedule, TempSch, schType, Admin, tempAdmin: string;
    38284290  AdminTime:    TFMDateTime;
    3829   i, j, Interval, PrnPos: Integer;
    3830 begin
     4291  j, r, Interval, PrnPos, SchID: Integer;
     4292  EndCheck, rowCheck, DoseNow: boolean;
     4293begin
     4294  if not FInptDlg then Exit;
    38314295  if Length(CurSchedule)=0 then Exit;
    38324296  ASchedule := Trim(CurSchedule);
     4297  DoseNow := True;
     4298  if self.EvtID > 0 then DoseNow := false;
    38334299  if (Pos('^',ASchedule)>0) then
    38344300  begin
    … …  
    38374303      Delete(ASchedule, PrnPos-1, 4);
    38384304  end;
     4305  if (FAdminTimeText = '') and (self.EvtID > 0) then FAdminTimeText := 'To Be Determined';
     4306  AdminTime := 0;
    38394307  ASchedule := Trim(ASchedule);
     4308  //AGP Change for CQ 9906
     4309  EndCheck := False;
     4310  lastSch := '';
    38404311  if self.tabDose.TabIndex = TI_COMPLEX then
    38414312    begin
    3842       CompSch := valFor(VAL_SCHEDULE,1);
    3843       if CompSch = '' then
    3844         begin
    3845           ASchedule := '';
    3846           AdminTime := -1;
    3847         end;
    3848       if CompSch <> '' then
    3849         begin
    3850           for i := 0 to self.cboXSchedule.Items.Count-1 do
    3851             begin
    3852               if (Piece(self.cboXSchedule.Items.Strings[i],U,1) = CompSch) and (Piece(self.cboXSchedule.Items.Strings[i],U,3)='P') then
     4313    tempSch := ASchedule;
     4314    ASchedule := '';
     4315    for r := 1 to self.grdDoses.RowCount-1 do
     4316      begin
     4317        CompSch := valFor(VAL_SCHEDULE,r);
     4318        CompDose := valFor(VAL_DOSAGE,r);
     4319        RowCheck := valFor(VAL_CHKXPRN,r)='1';
     4320        if (RowCheck = True) then
     4321          begin
     4322            if EndCheck = false then AdminTime := -1;
     4323            if FAdminTimeText = '' then self.grdDoses.cells[COL_ADMINTIME, r] := ''
     4324            else Self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText;
     4325          end
     4326        else
     4327          begin
     4328            if CompSch <> '' then
     4329               begin
     4330                 //cboXSchedule.Items.IndexOfName(CompSch);
     4331                 //cboXSchedule.SelectByID(CompSch);
     4332                 SchID := -1;
     4333                 for j := 0 to cboXSchedule.Items.Count - 1 do
     4334                    begin
     4335                      if Piece(cboXSchedule.Items.Strings[j], U, 1) = CompSch then
     4336                        begin
     4337                          schID := j;
     4338                          break;
     4339                        end;
     4340                    end;
     4341                 //if cboXSchedule.ItemIndex > -1 then
     4342                 if SchID > -1 then
     4343                   begin
     4344                     //SchID := cboXSchedule.ItemIndex;
     4345                     if (Piece(self.cboXSchedule.Items.Strings[SchID],U,1) = CompSch) then
     4346                       begin
     4347                         SchType := Piece(self.cboXSchedule.Items.Strings[SchID],U,3);
     4348                         if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') then
     4349                             self.grdDoses.Cells[COL_ADMINTIME, r] := ''
     4350                         else if FAdminTimeText <> '' then self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText
     4351                         else
     4352                           begin
     4353                             self.grdDoses.Cells[COL_ADMINTIME, r] := Piece(self.cboXSchedule.Items.Strings[SchID],U,4);
     4354                             if self.grdDoses.Cells[COL_ADMINTIME, r] = '' then self.grdDoses.Cells[COL_ADMINTIME, r] := 'Not Defined';
     4355
     4356                           end;
     4357                         if CompDose <> '' then
     4358                           begin
     4359                             lastSch := CompSch;
     4360                             if (EndCheck = False) and ((SchType = 'P') or (SchType = 'O')) then AdminTime := -1
     4361                             //else Aschedule := ';' + CompSch;
     4362                           end;
     4363                       end;
     4364                     
     4365                   end;
     4366               end;
     4367          end;
     4368        if ((valFor(VAL_SEQUENCE,r) = 'AND') or (valFor(VAL_SEQUENCE,r) = '')) and (AdminTime > -1) and (EndCheck = false) then
     4369          begin
     4370            //if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
     4371            if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
     4372            if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
     4373          end
     4374        else if ValFor(VAL_SEQUENCE, r) = 'THEN' then
     4375          begin
     4376           // if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
     4377            if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
     4378            if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
     4379            EndCheck := True;
     4380          end
     4381      end;
     4382    end;
     4383  if self.tabDose.TabIndex = TI_DOSE then
     4384    begin
     4385     if LeftStr(ASchedule, 1) = ';' then tempSch := Piece(ASchedule, ';', 2)
     4386     else tempSch := ASchedule;
     4387     if self.chkPRN.Checked = True then
     4388       begin
     4389         AdminTime := -1;
     4390         lblAdminSchSetText('');
     4391         if (cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3) = 'O') then
     4392           DoseNow := false;
     4393       end
     4394     else begin
     4395         //cboSchedule.SelectByID(tempSch);
     4396         SchID := -1;
     4397         for j := 0 to cboSchedule.Items.Count - 1 do
     4398           begin
     4399             if Piece(cboSchedule.Items.Strings[j], U, 1) = tempSch then
    38534400                begin
    3854                   AdminTime := -1;
    3855                   Aschedule := '';
     4401                  schID := j;
     4402                  break;
    38564403                end;
    3857             end;
    3858         end;
    3859         if valFor(VAL_CHKXPRN,1)='1' then
    3860           begin
    3861             AdminTime := -1;
    3862             Aschedule := '';
    3863           end;
    3864       if (ASchedule <> '') and (CompSch <> '') then ASchedule := ';' + CompSch;
    3865     end;
    3866   if Length(ASchedule)>0 then
    3867       LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration);
    3868   //else Exit;
    3869   if (AdminTime > 0) and (self.tabDose.TabIndex = TI_DOSE) then
    3870     begin
    3871      if self.cboSchedule.ItemIndex = -1 then
    3872        begin
    3873          for j := 0 to self.cboSchedule.items.Count -1 do
     4404           end;
     4405         if schID > -1 then
    38744406           begin
    3875              if (Piece(self.cboSchedule.Items.Strings[j],U,1) = Piece(Aschedule,';',2)) and (Piece(self.cboSchedule.Items.Strings[j],U,3)='P') then
     4407             SchType := Piece(self.cboSchedule.Items.Strings[schID], U, 3);
     4408             if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then
    38764409               begin
    3877                  AdminTime := -1;
    3878                  break;
     4410                 lblAdminSchSetText('');
     4411                 if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then AdminTime := -1;
     4412                 if SchType = 'O' then DoseNow := false;
     4413               end
     4414             else
     4415               begin
     4416                 if FAdminTimeText <> '' then tempAdmin := 'Admin. Time: ' + FAdminTimeText
     4417                 else
     4418                   begin
     4419                      if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
     4420                          tempAdmin := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
     4421                      else tempAdmin := 'Admin. Time: Not Defined';
     4422                   end;
     4423                  lblAdminSchSetText(tempAdmin);
     4424             (*    if FAdminTimeText <> '' then self.lblAdminSch.text := 'Admin. Time: ' + FAdminTimeText
     4425                 else
     4426                   begin
     4427                      if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
     4428                          self.lblAdminSch.text := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
     4429                      else self.lblAdminSch.text := 'Admin. Time: Not Defined';
     4430                   end;   *)
     4431
    38794432               end;
    38804433           end;
    38814434       end;
    3882      if (self.cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.ItemIndex],U,3)='P') then
    3883        AdminTime := -1;
    3884      if self.chkPRN.Checked = true then AdminTime := -1
    3885     end;
     4435    end;
     4436  if (Length(ASchedule)>0) and (AdminTime > -1) then
     4437     begin
     4438      if LeftStr(Aschedule, 1) <> ';' then ASchedule := ';'+ASchedule;
     4439      Admin := '';
     4440      if (self.lblAdminSch.visible = True) and (self.lblAdminSch.text <> '') and (self.tabDose.TabIndex = TI_DOSE) then
     4441        begin
     4442          //AGP Change Admin Time Wrap 27.73
     4443          //Admin := Copy(self.lblAdminSch.text,  14, (Length(self.lblAdminSch.text)-1));
     4444          Admin := lblAdminSchGetText;
     4445          if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
     4446        end
     4447      else if self.tabDose.TabIndex = TI_COMPLEX then
     4448        begin
     4449          Admin := Self.grdDoses.Cells[COL_ADMINTIME, 1];
     4450          if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
     4451        end;           
     4452      LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration, Admin);
     4453     end;
    38864454  if AdminTime > 0 then
    38874455  begin
    … …  
    39064474  end
    39074475  else lblAdminTime.Caption := '';
     4476  if (lblAdminTime.Caption <> '') and (lblAdminTime.Visible = True) and (JAWSON = true) then lblAdminTime.TabStop := true
     4477  else lblAdminTime.TabStop := false;
     4478  if (lblAdminSch.text <> '') and (lblAdminSch.Visible = True) and (JAWSON = true) then lblAdminSch.TabStop := true
     4479  else lblAdminSch.TabStop := false;
     4480  DisplayDoseNow(DoseNow);
    39084481end;
    39094482
    … …  
    39144487  else
    39154488    spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D');
    3916   if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then
     4489  if (StrToIntDef(txtRefills.Text, 0) > spnRefills.Max) then
    39174490  begin
    39184491    txtRefills.Text := IntToStr(spnRefills.Max);
    … …  
    39404513  CurSupply, i, pNum, j: Integer;
    39414514  CurQuantity: double;
    3942   LackQtyInfo, SaveChanging, DispFirstDose: Boolean;
     4515  LackQtyInfo, SaveChanging: Boolean;
    39434516begin
    39444517  inherited;
    … …  
    39474520  SaveChanging := Changing;
    39484521  Changing := TRUE;
    3949   DispFirstDose := FALSE;
    39504522  // don't allow Exit procedure so Changing gets reset appropriately
    39514523  CurUnits    := '';
    … …  
    39974569  CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0);
    39984570  CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
     4571  //CurRefill  := StrToIntDef(ValueOfResponse(FLD_REFILLS) , 0);
    39994572  if FInptDlg then
    40004573  begin
    … …  
    40064579          lblAdminTime.Caption := '';
    40074580    end;
    4008     if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
    4009     if (ValueOf(FLD_SCHED_TYP) = 'O')
     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')
    40104584      or (Responses.EventType in ['A','D','T','M','O'])
    40114585      or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
    … …  
    40164590        chkDoseNow.Checked := False;
    40174591      end;
    4018       for i := 0 to cboSchedule.Items.Count-1 do
    4019         begin
    4020                   if Piece(cboSchedule.Items.Strings[i],U,1) = Uppercase(cboSchedule.Text) then
    4021             begin
    4022               DispFirstDose := True;
    4023               break;
    4024             end;
    4025         end;
    4026       if not DispFirstDose then
    4027         begin
    40284592          chkDoseNow.Visible := False;
    40294593          lblAdminTime.Visible := False;
    4030         end;
    40314594    end
    40324595    else
    … …  
    40344597        chkDoseNow.Visible := TRUE;
    40354598        lblAdminTime.Visible := not chkDoseNow.Checked;
    4036       end;
     4599      end;  *)
    40374600    if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
    40384601  end;
    … …  
    40404603  begin
    40414604    CurSchedule := CurScheduleOut;
    4042     if (CurInstruct <> FLastInstruct) and (CurUnits <> U) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
     4605    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
    40434606      then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
    40444607                               LackQtyInfo);
    … …  
    40494612    else
    40504613      UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity);
    4051     if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
    4052     if (CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply) then
     4614   // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
     4615    if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then
    40534616      UpdateRefills(CurDispDrug, CurSupply);
    40544617  end;
    … …  
    40984661    then DisplayGroup := DisplayGroupByName('UD RX')
    40994662  else DisplayGroup := DisplayGroupByName('O RX');
     4663 (* if (Not FInptDlg) then
     4664    begin
     4665      if (ValidateDaySupplyandQuantity(strtoInt(txtSupply.Text), strtoInt(txtQuantity.text)) = false) then Exit
     4666      else ClearMaxData;
     4667    end;   *)
     4668  //if (Not FInptDlg) and (ValidateMaxQuantity(strtoInt(txtQuantity.Text)) = false) then Exit;
     4669 
     4670
    41004671  //timCheckChangesTimer(Self);
    41014672  DropLastSequence;
    … …  
    41354706    if length(theSch)>0 then
    41364707    begin
    4137       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
     4708      //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
    41384710      begin
    41394711        chkDoseNow.Checked := False;
    … …  
    41524724  if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked  then
    41534725  begin
    4154     if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
     4726    if (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
    41554727                 'Please adjust the duration of the first row, if necessary.',
    4156                  'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) ) then
     4728                 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then
    41574729    begin
    41584730      chkDoseNow.Checked := False;
    … …  
    42834855  case Key of
    42844856//  VK_RETURN:   //moved to form key press
     4857  VK_RIGHT:
     4858    begin
     4859      if (not FInptDlg) and (self.grdDoses.Col = COL_DURATION) then
     4860        begin
     4861          self.grdDoses.Col := COL_SEQUENCE;
     4862          Key := 0;
     4863        end;
     4864    end;
     4865  VK_LEFT:
     4866    begin
     4867      if (not FInptDlg) and (self.grdDoses.Col = COL_SEQUENCE) then
     4868        begin
     4869          self.grdDoses.Col := COL_DURATION;
     4870          Key := 0;
     4871        end;
     4872    end;
    42854873  VK_ESCAPE:
    42864874    begin
    … …  
    43774965procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
    43784966begin
    4379   if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
     4967 (* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
    43804968  begin
    43814969    ShowEditor(grdDoses.Col, grdDoses.Row, #0);
    43824970    Key := #0;  //Don't let the base class turn it into a forward tab!
    4383   end
    4384   else if (Key = #13) and (ActiveControl = txtMed) then
     4971  end *)
     4972  //else
     4973  if (Key = #13) and (ActiveControl = txtMed) then
    43854974    Key := #0;   //Don't let the base class turn it into a forward tab!
    43864975end;
    … …  
    44064995end;
    44074996
    4408 procedure TfrmODMeds.pnlXSequenceEnter(Sender: TObject);
     4997procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
    44094998begin
    44104999  inherited;
    … …  
    44135002end;
    44145003
    4415 procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
    4416 begin
    4417   inherited;
    4418   DisableDefaultButton(self);
    4419   DisableCancelButton(self);
    4420 end;
    4421 
    44225004procedure TfrmODMeds.pnlMessageExit(Sender: TObject);
    44235005begin
    … …  
    44415023begin
    44425024  inherited;
    4443   ShowMessage('The patient instruction field may not be edited.');
     5025  ShowMsg('The patient instruction field may not be edited.');
    44445026  chkPtInstruct.SetFocus;
    44455027end;
    … …  
    44485030var
    44495031  aftHeight: integer;
     5032  tempAdmin: string;
    44505033begin
    44515034  inherited;
    … …  
    44565039  if pnlMessage.Visible then
    44575040    pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
    4458 end;
    4459 
    4460 procedure TfrmODMeds.spnQuantityChangingEx(Sender: TObject;
    4461   var AllowChange: Boolean; NewValue: Smallint;
    4462   Direction: TUpDownDirection);
    4463 var
    4464   tempQuant: double;
    4465 begin
    4466   inherited;
    4467   if Direction = updUp then
    4468   begin
    4469     tempQuant := StrToFloatDef(txtQuantity.Text,0) + 1;
    4470     txtQuantity.Text := FloatToStr(tempQuant);
    4471   end else if Direction = updDown then
    4472   begin
    4473     tempQuant := StrToFloatDef(txtQuantity.Text,0) - 1 ;
    4474     if tempQuant < 0 then tempQuant := 0;
    4475     txtQuantity.Text := FloatToStr(tempQuant);
    4476   end;
    4477   spnQuantity.Tag := 1;
    4478   txtQuantity.Tag := 1;
     5041  tempAdmin := lblAdminSchGetText;
     5042  if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin);
    44795043end;
    44805044
    … …  
    44835047begin
    44845048  inherited;
    4485   ShowMessage('The patient instruction field may not be edited.');
     5049  ShowMsg('The patient instruction field may not be edited.');
    44865050  chkPtInstruct.SetFocus;
    44875051end;
    … …  
    45535117    cboSchedule.ItemIndex := -1;
    45545118    cboSchedule.Text      := '';
    4555   end;
    4556   Result := aSchedule;
     5119  end
     5120  else
     5121    begin
     5122        Result := Piece(aSchedule,U,1);
     5123        NSSAdminTime := Piece(aschedule,u,2);
     5124        NSSScheduleType := Piece(aSchedule, U, 3);
     5125        if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
     5126    end;
    45575127end;
    45585128
    … …  
    45795149                       (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
    45805150                       (Integer(lstQuick.Selected.Data) > 0)) ;
     5151  if (btnSelect.Enabled) and (FOrderAction = ORDER_EDIT) then btnSelect.Enabled := false; 
    45815152  if (btnSelect.Enabled) and (FRemoveText) then
    45825153    txtMed.Text := '';
    45835154end;
    45845155
     5156
     5157procedure TfrmODMeds.DisplayDoseNow(Status: boolean);
     5158begin
     5159  if not FinptDlg then Status := False;
     5160  if Status = false then
     5161    begin
     5162      if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false;
     5163      self.chkDoseNow.Visible := false;
     5164    end;
     5165  if status = true then self.chkDoseNow.Visible := true; 
     5166end;
    45855167
    45865168procedure TfrmODMeds.DispOrderMessage(const AMessage: string);
    … …  
    46135195procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction);
    46145196begin
     5197  if FCloseCalled then Exit; //Temporary Hack: Close is called 2x for some reason & errors out
     5198  FCloseCalled := true;
    46155199  FResizedAlready := False;
    46165200  inherited;
    … …  
    46265210    cboXSchedule.ItemIndex := -1;
    46275211    cboXSchedule.Text      := '';
    4628   end;
    4629   Result := aSchedule;
     5212  end
     5213  else
     5214    begin
     5215        Result := Piece(aSchedule,U,1);
     5216        NSSAdminTime := Piece(aschedule,u,2);
     5217        NSSScheduleType := Piece(ASchedule, U, 3);
     5218        if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
     5219    end;
    46305220end;
    46315221
    … …  
    46605250procedure TfrmODMeds.FormShow(Sender: TObject);
    46615251begin
     5252  FCloseCalled := false;
    46625253  inherited;
    46635254  if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then
    46645255    PostMessage(Handle, UM_NSSOTHER, 0, 0);
     5256
     5257  //I was using btnSelect.Top for the following, but it gets moved around
     5258  Constraints.MinHeight := Constraints.MinHeight + ((Self.Height - cmdQuit.Top) * 2);
    46655259end;
    46665260
    … …  
    46975291      ScheduleCombo.ItemIndex := tmpIndex;
    46985292  end;
    4699   if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
    4700   begin
    4701     FShowPnlXScheduleOk := False; //Added for CQ: 7370
    4702     Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
     5293    if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
     5294        begin
     5295          FShowPnlXScheduleOk := False; //Added for CQ: 7370
     5296          Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
    47035297                           'If you would like to create a Day-of-Week schedule please'+
    47045298                           ' select ''OTHER'' from the list.',
    … …  
    47495343
    47505344// CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
     5345function TfrmODMeds.GetCacheChunkIndex(idx: integer): integer;
     5346begin
     5347  Result := idx div MED_CACHE_CHUNK_SIZE;
     5348end;
     5349
    47515350function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
    47525351var i: integer;
    … …  
    47725371end;
    47735372
     5373procedure TfrmODMeds.cboXSequenceChange(Sender: TObject);
     5374var
     5375x: string;
     5376begin
     5377  inherited;
     5378 x := cboXSequence.Text;
     5379 if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
     5380     begin
     5381       InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
     5382           'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
     5383       x := '';
     5384     end;
     5385  cboXSequence.text := x;
     5386  cboXSequence.ItemIndex := cboXSequence.Items.IndexOf(x);
     5387  grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(x);
     5388  //AGP Start Expire add line
     5389  UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
     5390  ControlChange(Sender);
     5391end;
     5392
     5393procedure TfrmODMeds.cboXSequenceEnter(Sender: TObject);
     5394begin
     5395  inherited;
     5396  DisableDefaultButton(self);
     5397  DisableCancelButton(self);
     5398end;
     5399
     5400procedure TfrmODMeds.cboXSequenceExit(Sender: TObject);
     5401begin
     5402  inherited;
     5403  grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(cboXSequence.Text);
     5404  if ActiveControl = grdDoses then
     5405  begin
     5406    //This next condition seldom occurs, since entering the dosage on the last
     5407    // row adds another row
     5408    if grdDoses.Row = grdDoses.RowCount - 1 then
     5409      grdDoses.RowCount := grdDoses.RowCount + 1;
     5410  end;
     5411  cboXSequence.Tag := -1;
     5412  cboXSequence.Hide;
     5413  RestoreDefaultButton;
     5414  RestoreCancelButton;
     5415  if (pnlMessage.Visible) and (memMessage.TabStop) then
     5416  begin
     5417    pnlMessage.Parent := grdDoses.Parent;
     5418    pnlMessage.TabOrder := grdDoses.TabOrder;
     5419    ActiveControl := memMessage;
     5420  end
     5421  else if grdDoses.Showing then
     5422    ActiveControl := grdDoses
     5423  else
     5424    ActiveControl := cboDosage;
     5425  //AGP Start Expire commented out line
     5426  //UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
     5427end;
     5428
     5429procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject);
     5430begin
     5431  inherited;
     5432  cboxSequence.Hide;
     5433end;
     5434
    47745435procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
    47755436  Shift: TShiftState);
    … …  
    47785439  //Fix for CQ: 7545
    47795440  if cboDosage.ItemIndex > -1 then
    4780     cboDosageClick(Sender);
     5441    cboDosageClick(Sender)
     5442  else
     5443    UpdateRelated;
    47815444end;
    47825445
    … …  
    47875450  //Fix for CQ: 7545
    47885451  if cboXDosage.ItemIndex > -1 then
    4789     cboXDosageClick(Sender);
     5452    cboXDosageClick(Sender)
     5453  else
     5454    begin
     5455      grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
     5456      UpdateRelated;
     5457    end;
    47905458end;
    47915459
    … …  
    48005468  inherited;
    48015469   self.txtQuantity.SelectAll;
     5470end;
     5471
     5472procedure TfrmODMeds.txtRefillsChange(Sender: TObject);
     5473begin
     5474  inherited;
     5475  ControlChange(sender);
    48025476end;
    48035477
    … …  
    48305504begin
    48315505  inherited;
    4832   //agp Change CQ 10719 
     5506  //agp Change CQ 10719
    48335507   self.chkXPRN.OnClick(self.chkXPRN);
    48345508end;
    48355509
     5510
    48365511end.

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

    r456 r829  
    1 object frmODMessage: TfrmODMessage
     1inherited frmODMessage: TfrmODMessage
    22  Left = 271
    33  Top = 515
    … …  
    66  ClientHeight = 39
    77  ClientWidth = 374
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    148  FormStyle = fsStayOnTop
    15   OldCreateOrder = False
    169  Position = poOwnerFormCenter
    1710  Visible = True
    1811  OnCreate = FormCreate
    1912  OnDestroy = FormDestroy
     13  DesignSize = (
     14    374
     15    39)
    2016  PixelsPerInch = 96
    2117  TextHeight = 13
    22   object imgMessage: TImage
     18  object imgMessage: TImage [0]
    2319    Left = 4
    2420    Top = 4
    … …  
    2622    Height = 32
    2723  end
    28   object memMessage: TRichEdit
     24  object memMessage: TRichEdit [1]
    2925    Left = 40
    3026    Top = 4
    … …  
    4238    TabOrder = 0
    4339  end
     40  inherited amgrMain: TVA508AccessibilityManager
     41    Data = (
     42      (
     43        'Component = memMessage'
     44        'Status = stsDefault')
     45      (
     46        'Component = frmODMessage'
     47        'Status = stsDefault'))
     48  end
    4449end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, StdCtrls, ComCtrls;
     7  ExtCtrls, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODMessage = class(TForm)
     10  TfrmODMessage = class(TfrmBase508Form)
    1111    memMessage: TRichEdit;
    1212    imgMessage: TImage;

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

    r456 r829  
    4545    TabOrder = 7
    4646  end
    47   object cboCare: TORComboBox
     47  object cboCare: TORComboBox [8]
    4848    Left = 6
    4949    Top = 20
    … …  
    5959    ListItemsOnly = True
    6060    LongList = True
     61    LookupPiece = 0
    6162    MaxLength = 0
    6263    Pieces = '2'
    … …  
    6768    OnMouseClick = ControlChange
    6869    OnNeedData = cboCareNeedData
     70    CharsNeedMatch = 1
    6971  end
    70   object calStart: TORDateBox
     72  object calStart: TORDateBox [9]
    7173    Left = 6
    7274    Top = 114
    … …  
    8082    Caption = 'Start Date/Time'
    8183  end
    82   object calStop: TORDateBox
     84  object calStop: TORDateBox [10]
    8385    Left = 158
    8486    Top = 114
    … …  
    9193    Caption = 'Stop Date/Time'
    9294  end
    93   object txtComment: TCaptionEdit
     95  object txtComment: TCaptionEdit [11]
    9496    Left = 6
    9597    Top = 67
    … …  
    100102    Caption = 'Instructions'
    101103  end
     104  inherited amgrMain: TVA508AccessibilityManager
     105    Data = (
     106      (
     107        'Component = cboCare'
     108        'Status = stsDefault')
     109      (
     110        'Component = calStart'
     111        'Status = stsDefault')
     112      (
     113        'Component = calStop'
     114        'Status = stsDefault')
     115      (
     116        'Component = txtComment'
     117        'Status = stsDefault')
     118      (
     119        'Component = memOrder'
     120        'Status = stsDefault')
     121      (
     122        'Component = cmdAccept'
     123        'Status = stsDefault')
     124      (
     125        'Component = cmdQuit'
     126        'Status = stsDefault')
     127      (
     128        'Component = pnlMessage'
     129        'Status = stsDefault')
     130      (
     131        'Component = memMessage'
     132        'Status = stsDefault')
     133      (
     134        'Component = frmODMisc'
     135        'Status = stsDefault'))
     136  end
    102137end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst;
     7  fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    33  Left = 282
    44  Top = 225
    5   Width = 576
    6   Height = 361
     5  Width = 586
     6  Height = 404
    77  Caption = 'Order an Imaging Procedure'
    8   Constraints.MinHeight = 344
    9   Constraints.MinWidth = 576
     8  Constraints.MinHeight = 404
     9  Constraints.MinWidth = 586
     10  ExplicitLeft = 282
     11  ExplicitTop = 225
     12  ExplicitWidth = 586
     13  ExplicitHeight = 404
    1014  PixelsPerInch = 96
    1115  TextHeight = 13
    1216  inherited memOrder: TCaptionMemo
    1317    Left = 0
    14     Top = 283
    15     Width = 480
     18    Top = 326
     19    Width = 490
    1620    Anchors = [akLeft, akRight, akBottom]
    1721    TabOrder = 6
     22    ExplicitLeft = 0
     23    ExplicitTop = 326
     24    ExplicitWidth = 490
    1825  end
    1926  object FRadCommonCombo: TORListBox [1]
    20     Left = 443
    21     Top = 346
     27    Left = 419
     28    Top = 362
    2229    Width = 121
    2330    Height = 11
    … …  
    3441    Top = 0
    3542    Width = 215
    36     Height = 281
     43    Height = 321
    3744    Anchors = [akLeft, akTop, akBottom]
    3845    BevelOuter = bvNone
    … …  
    4047    object lblDrug: TLabel
    4148      Left = 0
    42       Top = 38
     49      Top = 34
    4350      Width = 89
    4451      Height = 13
    … …  
    5360    end
    5461    object lblImType: TLabel
    55       Left = 1
    56       Top = 1
     62      Left = 0
     63      Top = 0
    5764      Width = 64
    5865      Height = 13
    … …  
    6875    object cboImType: TORComboBox
    6976      Left = 0
    70       Top = 15
     77      Top = 13
    7178      Width = 212
    7279      Height = 21
    … …  
    109116    object cboProcedure: TORComboBox
    110117      Left = 0
    111       Top = 53
     118      Top = 47
    112119      Width = 212
    113       Height = 114
     120      Height = 122
    114121      Style = orcsSimple
    115122      AutoSelect = True
    … …  
    170177    end
    171178  end
    172   object pnlRight: TORAutoPanel [3]
    173     Left = 214
    174     Top = 85
    175     Width = 355
    176     Height = 195
    177     Anchors = [akLeft, akRight, akBottom]
    178     BevelOuter = bvNone
     179  inherited cmdAccept: TButton
     180    Left = 497
     181    Top = 326
     182    Anchors = [akRight, akBottom]
    179183    TabOrder = 3
    180     object lblRequestDate: TLabel
    181       Left = 4
    182       Top = 5
    183       Width = 78
    184       Height = 13
    185       Caption = 'Requested Date'
    186     end
    187     object lblUrgency: TLabel
    188       Left = 104
    189       Top = 5
    190       Width = 40
    191       Height = 13
    192       Caption = 'Urgency'
    193     end
    194     object lblTransport: TLabel
    195       Left = 204
    196       Top = 5
    197       Width = 45
    198       Height = 13
    199       Caption = 'Transport'
    200     end
    201     object lblCategory: TLabel
    202       Left = 4
    203       Top = 42
    204       Width = 42
    205       Height = 13
    206       Caption = 'Category'
    207     end
    208     object lblSubmit: TLabel
    209       Left = 154
    210       Top = 42
    211       Width = 48
    212       Height = 13
    213       Caption = 'Submit To'
    214     end
    215     object lblLastExam: TLabel
    216       Left = 4
    217       Top = 82
    218       Width = 134
    219       Height = 13
    220       Caption = 'Exams Over the Last 7 Days'
    221     end
    222     object lblAskSubmit: TLabel
    223       Left = 446
    224       Top = 103
    225       Width = 3
    226       Height = 13
    227       Visible = False
    228     end
    229     object lblPreOp: TLabel
    230       Left = 198
    231       Top = 156
    232       Width = 84
    233       Height = 13
    234       Caption = 'PreOp Scheduled'
    235     end
    236     object calPreOp: TORDateBox
    237       Left = 198
    238       Top = 170
    239       Width = 96
    240       Height = 21
    241       TabOrder = 8
    242       OnChange = calPreOpChange
    243       OnExit = calPreOpExit
    244       DateOnly = False
    245       RequireTime = False
    246       Caption = 'PreOp Scheduled'
    247     end
    248     object chkIsolation: TCheckBox
    249       Left = 198
    250       Top = 94
    251       Width = 97
    252       Height = 17
    253       Hint = 'Is patient on isolation procedures?'
    254       Caption = 'Isolation'
    255       ParentShowHint = False
    256       ShowHint = True
    257       TabOrder = 6
    258       OnClick = ControlChange
    259       OnExit = chkIsolationExit
    260     end
    261     object calRequestDate: TORDateBox
    262       Left = 4
    263       Top = 18
    264       Width = 92
    265       Height = 21
    266       TabOrder = 0
    267       Text = 'TODAY'
    268       OnChange = ControlChange
    269       DateOnly = False
    270       RequireTime = False
    271       Caption = 'Requested Date'
    272     end
    273     object cboUrgency: TORComboBox
    274       Left = 104
    275       Top = 18
    276       Width = 92
    277       Height = 21
    278       Style = orcsDropDown
    279       AutoSelect = True
    280       Caption = 'Urgency'
    281       Color = clWindow
    282       DropDownCount = 8
    283       ItemHeight = 13
    284       ItemTipColor = clWindow
    285       ItemTipEnable = True
    286       ListItemsOnly = True
    287       LongList = False
    288       LookupPiece = 0
    289       MaxLength = 0
    290       Pieces = '2'
    291       Sorted = False
    292       SynonymChars = '<>'
    293       TabOrder = 1
    294       OnChange = ControlChange
    295       CharsNeedMatch = 1
    296     end
    297     object cboTransport: TORComboBox
    298       Left = 204
    299       Top = 18
    300       Width = 92
    301       Height = 21
    302       Style = orcsDropDown
    303       AutoSelect = True
    304       Caption = 'Transport'
    305       Color = clWindow
    306       DropDownCount = 8
    307       ItemHeight = 13
    308       ItemTipColor = clWindow
    309       ItemTipEnable = True
    310       ListItemsOnly = True
    311       LongList = False
    312       LookupPiece = 0
    313       MaxLength = 0
    314       Pieces = '2'
    315       Sorted = False
    316       SynonymChars = '<>'
    317       TabOrder = 2
    318       OnChange = ControlChange
    319       CharsNeedMatch = 1
    320     end
    321     object cboCategory: TORComboBox
    322       Left = 4
    323       Top = 57
    324       Width = 140
    325       Height = 21
    326       Style = orcsDropDown
    327       AutoSelect = True
    328       Caption = 'Category'
    329       Color = clWindow
    330       DropDownCount = 8
    331       ItemHeight = 13
    332       ItemTipColor = clWindow
    333       ItemTipEnable = True
    334       ListItemsOnly = True
    335       LongList = False
    336       LookupPiece = 0
    337       MaxLength = 0
    338       Pieces = '2'
    339       Sorted = False
    340       SynonymChars = '<>'
    341       TabOrder = 3
    342       OnChange = cboCategoryChange
    343       CharsNeedMatch = 1
    344     end
    345     object chkPreOp: TCheckBox
    346       Left = 146
    347       Top = 233
    348       Width = 61
    349       Height = 17
    350       Caption = 'Pre-Op'
    351       TabOrder = 9
    352       Visible = False
    353       OnClick = ControlChange
    354     end
    355     object cboSubmit: TORComboBox
    356       Left = 154
    357       Top = 57
    358       Width = 142
    359       Height = 21
    360       Style = orcsDropDown
    361       AutoSelect = True
    362       Caption = 'Submit To'
    363       Color = clWindow
    364       DropDownCount = 8
    365       ItemHeight = 13
    366       ItemTipColor = clWindow
    367       ItemTipEnable = True
    368       ListItemsOnly = True
    369       LongList = False
    370       LookupPiece = 0
    371       MaxLength = 0
    372       Pieces = '2'
    373       Sorted = False
    374       SynonymChars = '<>'
    375       TabOrder = 4
    376       OnChange = ControlChange
    377       CharsNeedMatch = 1
    378     end
    379     object lstLastExam: TORListBox
    380       Left = 4
    381       Top = 95
    382       Width = 187
    383       Height = 98
    384       Color = clBtnFace
    385       ExtendedSelect = False
    386       ItemHeight = 13
    387       MultiSelect = True
    388       ParentShowHint = False
    389       ShowHint = True
    390       TabOrder = 5
    391       Caption = 'Exams Over the Last 7 Days'
    392       ItemTipColor = clWindow
    393       LongList = False
    394       Pieces = '2'
    395     end
    396     object grpPregnant: TGroupBox
    397       Left = 196
    398       Top = 112
    399       Width = 158
    400       Height = 41
    401       Caption = 'Pregnant'
    402       TabOrder = 7
    403       object radPregnant: TRadioButton
    404         Left = 2
    405         Top = 17
    406         Width = 39
    407         Height = 17
    408         Caption = 'Yes'
    409         TabOrder = 0
    410         OnClick = ControlChange
    411       end
    412       object radPregnantNo: TRadioButton
    413         Left = 47
    414         Top = 17
    415         Width = 35
    416         Height = 17
    417         Caption = 'No'
    418         TabOrder = 1
    419         OnClick = ControlChange
    420       end
    421       object radPregnantUnknown: TRadioButton
    422         Left = 87
    423         Top = 16
    424         Width = 66
    425         Height = 17
    426         Caption = 'Unknown'
    427         TabOrder = 2
    428         OnClick = ControlChange
    429       end
    430     end
    431   end
    432   object pnlHandR: TPanel [4]
     184    ExplicitLeft = 497
     185    ExplicitTop = 326
     186  end
     187  object pnlRightBase: TORAutoPanel [4]
    433188    Left = 215
    434189    Top = 0
    435     Width = 353
    436     Height = 84
     190    Width = 362
     191    Height = 322
    437192    Anchors = [akLeft, akTop, akRight, akBottom]
    438193    BevelOuter = bvNone
    439     TabOrder = 2
    440     DesignSize = (
    441       353
    442       84)
    443     object lblReason: TLabel
    444       Left = 3
     194    Caption = 'pnlRightBase'
     195    TabOrder = 1
     196    object pnlRight: TORAutoPanel
     197      Left = 0
     198      Top = 127
     199      Width = 362
     200      Height = 195
     201      Align = alBottom
     202      Anchors = [akLeft, akTop, akRight, akBottom]
     203      BevelOuter = bvNone
     204      TabOrder = 1
     205      object lblRequestDate: TLabel
     206        Left = 4
     207        Top = 5
     208        Width = 62
     209        Height = 13
     210        Caption = 'Date Desired'
     211      end
     212      object lblUrgency: TLabel
     213        Left = 104
     214        Top = 5
     215        Width = 40
     216        Height = 13
     217        Caption = 'Urgency'
     218      end
     219      object lblTransport: TLabel
     220        Left = 204
     221        Top = 5
     222        Width = 45
     223        Height = 13
     224        Caption = 'Transport'
     225      end
     226      object lblCategory: TLabel
     227        Left = 4
     228        Top = 42
     229        Width = 42
     230        Height = 13
     231        Caption = 'Category'
     232      end
     233      object lblSubmit: TLabel
     234        Left = 154
     235        Top = 42
     236        Width = 48
     237        Height = 13
     238        Caption = 'Submit To'
     239      end
     240      object lblLastExam: TLabel
     241        Left = 4
     242        Top = 82
     243        Width = 134
     244        Height = 13
     245        Caption = 'Exams Over the Last 7 Days'
     246      end
     247      object lblAskSubmit: TLabel
     248        Left = 446
     249        Top = 103
     250        Width = 3
     251        Height = 13
     252        Visible = False
     253      end
     254      object lblPreOp: TLabel
     255        Left = 198
     256        Top = 156
     257        Width = 84
     258        Height = 13
     259        Caption = 'PreOp Scheduled'
     260      end
     261      object calPreOp: TORDateBox
     262        Left = 198
     263        Top = 170
     264        Width = 96
     265        Height = 21
     266        TabOrder = 8
     267        OnChange = calPreOpChange
     268        OnExit = calPreOpExit
     269        DateOnly = False
     270        RequireTime = False
     271        Caption = 'PreOp Scheduled'
     272      end
     273      object chkIsolation: TCheckBox
     274        Left = 198
     275        Top = 94
     276        Width = 97
     277        Height = 17
     278        Hint = 'Is patient on isolation procedures?'
     279        Caption = 'Isolation'
     280        ParentShowHint = False
     281        ShowHint = True
     282        TabOrder = 6
     283        OnClick = ControlChange
     284        OnExit = chkIsolationExit
     285      end
     286      object calRequestDate: TORDateBox
     287        Left = 4
     288        Top = 18
     289        Width = 92
     290        Height = 21
     291        TabOrder = 0
     292        OnChange = ControlChange
     293        DateOnly = False
     294        RequireTime = False
     295        Caption = 'Date Desired'
     296      end
     297      object cboUrgency: TORComboBox
     298        Left = 104
     299        Top = 18
     300        Width = 92
     301        Height = 21
     302        Style = orcsDropDown
     303        AutoSelect = True
     304        Caption = 'Urgency'
     305        Color = clWindow
     306        DropDownCount = 8
     307        ItemHeight = 13
     308        ItemTipColor = clWindow
     309        ItemTipEnable = True
     310        ListItemsOnly = True
     311        LongList = False
     312        LookupPiece = 0
     313        MaxLength = 0
     314        Pieces = '2'
     315        Sorted = False
     316        SynonymChars = '<>'
     317        TabOrder = 1
     318        OnChange = ControlChange
     319        CharsNeedMatch = 1
     320      end
     321      object cboTransport: TORComboBox
     322        Left = 204
     323        Top = 18
     324        Width = 92
     325        Height = 21
     326        Style = orcsDropDown
     327        AutoSelect = True
     328        Caption = 'Transport'
     329        Color = clWindow
     330        DropDownCount = 8
     331        ItemHeight = 13
     332        ItemTipColor = clWindow
     333        ItemTipEnable = True
     334        ListItemsOnly = True
     335        LongList = False
     336        LookupPiece = 0
     337        MaxLength = 0
     338        Pieces = '2'
     339        Sorted = False
     340        SynonymChars = '<>'
     341        TabOrder = 2
     342        OnChange = ControlChange
     343        CharsNeedMatch = 1
     344      end
     345      object cboCategory: TORComboBox
     346        Left = 4
     347        Top = 57
     348        Width = 140
     349        Height = 21
     350        Style = orcsDropDown
     351        AutoSelect = True
     352        Caption = 'Category'
     353        Color = clWindow
     354        DropDownCount = 8
     355        ItemHeight = 13
     356        ItemTipColor = clWindow
     357        ItemTipEnable = True
     358        ListItemsOnly = True
     359        LongList = False
     360        LookupPiece = 0
     361        MaxLength = 0
     362        Pieces = '2'
     363        Sorted = False
     364        SynonymChars = '<>'
     365        TabOrder = 3
     366        OnChange = cboCategoryChange
     367        CharsNeedMatch = 1
     368      end
     369      object chkPreOp: TCheckBox
     370        Left = 146
     371        Top = 233
     372        Width = 61
     373        Height = 17
     374        Caption = 'Pre-Op'
     375        TabOrder = 9
     376        Visible = False
     377        OnClick = ControlChange
     378      end
     379      object cboSubmit: TORComboBox
     380        Left = 154
     381        Top = 57
     382        Width = 142
     383        Height = 21
     384        Style = orcsDropDown
     385        AutoSelect = True
     386        Caption = 'Submit To'
     387        Color = clWindow
     388        DropDownCount = 8
     389        ItemHeight = 13
     390        ItemTipColor = clWindow
     391        ItemTipEnable = True
     392        ListItemsOnly = True
     393        LongList = False
     394        LookupPiece = 0
     395        MaxLength = 0
     396        Pieces = '2'
     397        Sorted = False
     398        SynonymChars = '<>'
     399        TabOrder = 4
     400        OnChange = ControlChange
     401        CharsNeedMatch = 1
     402      end
     403      object lstLastExam: TORListBox
     404        Left = 4
     405        Top = 95
     406        Width = 187
     407        Height = 98
     408        Color = clBtnFace
     409        ExtendedSelect = False
     410        ItemHeight = 13
     411        MultiSelect = True
     412        ParentShowHint = False
     413        ShowHint = True
     414        TabOrder = 5
     415        Caption = 'Exams Over the Last 7 Days'
     416        ItemTipColor = clWindow
     417        LongList = False
     418        Pieces = '2'
     419      end
     420      object grpPregnant: TGroupBox
     421        Left = 196
     422        Top = 112
     423        Width = 158
     424        Height = 41
     425        Caption = 'Pregnant'
     426        TabOrder = 7
     427        object radPregnant: TRadioButton
     428          Left = 2
     429          Top = 17
     430          Width = 39
     431          Height = 17
     432          Caption = 'Yes'
     433          TabOrder = 0
     434          OnClick = ControlChange
     435        end
     436        object radPregnantNo: TRadioButton
     437          Left = 47
     438          Top = 17
     439          Width = 35
     440          Height = 17
     441          Caption = 'No'
     442          TabOrder = 1
     443          OnClick = ControlChange
     444        end
     445        object radPregnantUnknown: TRadioButton
     446          Left = 87
     447          Top = 16
     448          Width = 66
     449          Height = 17
     450          Caption = 'Unknown'
     451          TabOrder = 2
     452          OnClick = ControlChange
     453        end
     454      end
     455    end
     456    object pnlHandR: TPanel
     457      Left = 0
    445458      Top = 0
    446       Width = 125
    447       Height = 13
    448       Caption = 'History && Reason for Exam'
    449     end
    450     object memReason: TCaptionMemo
    451       Left = 3
    452       Top = 15
    453       Width = 346
    454       Height = 68
    455       Anchors = [akLeft, akTop, akRight, akBottom]
    456       ScrollBars = ssVertical
     459      Width = 362
     460      Height = 127
     461      Align = alClient
     462      BevelOuter = bvNone
    457463      TabOrder = 0
    458       OnChange = ControlChange
    459       OnExit = memReasonExit
    460       Caption = 'History && Reason for Exam'
    461     end
    462   end
    463   inherited cmdAccept: TButton
    464     Left = 487
    465     Top = 283
     464      object lblHistory: TLabel
     465        Left = 0
     466        Top = 34
     467        Width = 362
     468        Height = 13
     469        Align = alTop
     470        Caption = 'Clinical History (Optional)'
     471        ExplicitWidth = 116
     472      end
     473      object lblReason: TLabel
     474        Left = 0
     475        Top = 0
     476        Width = 362
     477        Height = 13
     478        Align = alTop
     479        Caption = 'Reason for Study (REQUIRED - 64 characters maximum)'
     480        ExplicitWidth = 268
     481      end
     482      object memHistory: TCaptionMemo
     483        Left = 0
     484        Top = 47
     485        Width = 362
     486        Height = 80
     487        Align = alClient
     488        ScrollBars = ssVertical
     489        TabOrder = 3
     490        OnChange = ControlChange
     491        OnExit = memHistoryExit
     492        Caption = 'Clinical History (Optional)'
     493      end
     494      object txtReason: TCaptionEdit
     495        Left = 0
     496        Top = 13
     497        Width = 362
     498        Height = 21
     499        Align = alTop
     500        MaxLength = 64
     501        TabOrder = 0
     502        OnChange = ControlChange
     503        Caption = 'Reason for Study (REQUIRED)'
     504      end
     505    end
     506  end
     507  inherited cmdQuit: TButton
     508    Left = 498
     509    Top = 353
    466510    Anchors = [akRight, akBottom]
    467511    TabOrder = 4
    468   end
    469   inherited cmdQuit: TButton
    470     Left = 488
    471     Top = 310
    472     Anchors = [akRight, akBottom]
    473     TabOrder = 5
     512    ExplicitLeft = 498
     513    ExplicitTop = 353
    474514  end
    475515  inherited pnlMessage: TPanel
    476     Left = 13
    477     Top = 262
     516    Left = 5
     517    Top = 318
    478518    Width = 408
    479519    Height = 55
    480     TabOrder = 1
     520    TabOrder = 2
     521    ExplicitLeft = 5
     522    ExplicitTop = 318
     523    ExplicitWidth = 408
     524    ExplicitHeight = 55
    481525    inherited imgMessage: TImage
    482526      Left = 10
    483527      Top = 9
     528      ExplicitLeft = 10
     529      ExplicitTop = 9
    484530    end
    485531    inherited memMessage: TRichEdit
    … …  
    487533      Width = 344
    488534      Height = 43
    489     end
     535      ExplicitLeft = 55
     536      ExplicitWidth = 344
     537      ExplicitHeight = 43
     538    end
     539  end
     540  inherited amgrMain: TVA508AccessibilityManager
     541    Data = (
     542      (
     543        'Component = FRadCommonCombo'
     544        'Status = stsDefault')
     545      (
     546        'Component = pnlLeft'
     547        'Status = stsDefault')
     548      (
     549        'Component = cboImType'
     550        'Status = stsDefault')
     551      (
     552        'Component = lstSelectMod'
     553        'Status = stsDefault')
     554      (
     555        'Component = cboProcedure'
     556        'Status = stsDefault')
     557      (
     558        'Component = cboAvailMod'
     559        'Status = stsDefault')
     560      (
     561        'Component = cmdRemove'
     562        'Status = stsDefault')
     563      (
     564        'Component = pnlRightBase'
     565        'Status = stsDefault')
     566      (
     567        'Component = pnlRight'
     568        'Status = stsDefault')
     569      (
     570        'Component = calPreOp'
     571        'Status = stsDefault')
     572      (
     573        'Component = chkIsolation'
     574        'Status = stsDefault')
     575      (
     576        'Component = calRequestDate'
     577        'Status = stsDefault')
     578      (
     579        'Component = cboUrgency'
     580        'Status = stsDefault')
     581      (
     582        'Component = cboTransport'
     583        'Status = stsDefault')
     584      (
     585        'Component = cboCategory'
     586        'Status = stsDefault')
     587      (
     588        'Component = chkPreOp'
     589        'Status = stsDefault')
     590      (
     591        'Component = cboSubmit'
     592        'Status = stsDefault')
     593      (
     594        'Component = lstLastExam'
     595        'Status = stsDefault')
     596      (
     597        'Component = grpPregnant'
     598        'Status = stsDefault')
     599      (
     600        'Component = radPregnant'
     601        'Status = stsDefault')
     602      (
     603        'Component = radPregnantNo'
     604        'Status = stsDefault')
     605      (
     606        'Component = radPregnantUnknown'
     607        'Status = stsDefault')
     608      (
     609        'Component = pnlHandR'
     610        'Status = stsDefault')
     611      (
     612        'Component = memHistory'
     613        'Status = stsDefault')
     614      (
     615        'Component = txtReason'
     616        'Status = stsDefault')
     617      (
     618        'Component = memOrder'
     619        'Status = stsDefault')
     620      (
     621        'Component = cmdAccept'
     622        'Status = stsDefault')
     623      (
     624        'Component = cmdQuit'
     625        'Status = stsDefault')
     626      (
     627        'Component = pnlMessage'
     628        'Status = stsDefault')
     629      (
     630        'Component = memMessage'
     631        'Status = stsDefault')
     632      (
     633        'Component = frmODRad'
     634        'Status = stsDefault'))
    490635  end
    491636end

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

    r456 r829  
    66  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    77  Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
    8   ComCtrls, uConst, ORDtTm;
     8  ComCtrls, uConst, ORDtTm, VA508AccessibilityManager;
    99
    1010type
    … …  
    2222    cboSubmit: TORComboBox;
    2323    lstLastExam: TORListBox;
    24     lblReason: TLabel;
    25     memReason: TCaptionMemo;
     24    lblHistory: TLabel;
     25    memHistory: TCaptionMemo;
    2626    lstSelectMod: TORListBox;
    2727    lblSelectMod: TLabel;
    … …  
    4646    radPregnantNo: TRadioButton;
    4747    radPregnantUnknown: TRadioButton;
     48    lblReason: TLabel;
     49    txtReason: TCaptionEdit;
     50    pnlRightBase: TORAutoPanel;
    4851    procedure cboProcedureNeedData(Sender: TObject;
    4952              const StartFrom: string; Direction, InsertAt: Integer);
    … …  
    5659    procedure FormCreate(Sender: TObject);
    5760    procedure cboImTypeChange(Sender: TObject);
    58     procedure memReasonExit(Sender: TObject);
     61    procedure memHistoryExit(Sender: TObject);
    5962    procedure FormResize(Sender: TObject);
    6063    procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
    … …  
    97100  TX_NO_PROC          = 'An Imaging Procedure must be specified.'    ;
    98101  TX_NO_MODE          = 'A mode of transport must be selected.';
    99   TX_NO_REASON        = 'A History & Reason for Exam must be entered.'  ;
    100   TX_NO_DATE          = 'Unable to evaluate request date.' ;
     102  TX_NO_REASON        = 'A Reason for Study must be entered.'  ;
     103  TX_BAD_HISTORY      = 'An incomplete or invalid Clinical History has been entered.' + CRLF +
     104                        'Please correct or clear.';
     105  TX_NO_DATE          = 'A "Date Desired" must be specified.' ;
     106  TX_BAD_DATE         = 'The "Date Desired" you have entered is invalid.';
     107  TX_PAST_DATE        = '"Date Desired" must not be in the past.';
    101108  TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ;
    102109  TX_NO_SOURCE        = 'A source must be specified for Contract/Sharing/Research patients.';
    … …  
    131138    with cboImType do
    132139      begin
    133         Items.Assign(SubsetOfImagingTypes);
     140        FastAssign(SubsetOfImagingTypes, cboImType.Items);
    134141        for i := 0 to Items.Count-1 do
    135142          if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
    … …  
    151158    SetControl(cboSubmit,          'IMLOC', 1);
    152159    SetControl(cboCategory,        'CLASS', 1);
    153     SetControl(memReason,          'COMMENT', 1);
     160    SetControl(txtReason,           'REASON', 1);
     161    SetControl(memHistory,         'COMMENT', 1);
    154162    SetControl(chkIsolation,       'YN', 1);
    155163    SetControl(radPregnant,        'PREGNANT', 1);
    … …  
    214222   tmplst: TStringList;
    215223begin
    216   if not FEditCopy then inherited;
     224  if not FEditCopy then
     225  begin
     226    inherited;
     227    if not ReasonForStudyCarryOn then txtReason.text := '';
     228  end;
    217229
    218230  FPreOpDate := '';
    … …  
    236248    if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
    237249
    238     calRequestDate.Text := 'TODAY';
     250    //calRequestDate.Text := 'TODAY';     default removed per E3R #19834 - v27.10 - RV
    239251    SetControl(cboAvailMod, 'Modifiers');
    240252    SetControl(cboUrgency, 'Urgencies');
    … …  
    262274            tmplst := TStringList.Create;
    263275            try
    264               tmplst.Assign(cboSubmit.Items);
     276              FastAssign(cboSubmit.Items, tmplst);
    265277              SortByPiece(tmplst, U, 2);
    266               cboSubmit.Items.Assign(tmplst);
     278              FastAssign(tmplst, cboSubmit.Items);
    267279            finally
    268280              tmplst.Free;
    … …  
    299311  cboProcedure.InitLongList('') ;
    300312  StatusText('');
     313 
    301314end;
    302315
    … …  
    326339                                             else Responses.Update('YN',        1, '0'   , 'No');
    327340  with calPreOp do if Length(Text) > 0       then Responses.Update('PREOP',     1, FPreOpDate, Text);
    328   with memReason do if GetTextLen        > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
     341  with txtReason  do if GetTextLen        > 0 then Responses.Update('REASON',    1, Text, Text);
     342  with memHistory do if GetTextLen       > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
    329343  with lstSelectMod do for i := 0 to Items.Count - 1 do
    330344                                                  Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
    … …  
    380394        end ;
    381395    end;
     396
     397  if Length(txtReason.Text) < 3 then
     398    SetError(TX_NO_REASON)
     399  else
     400    begin
     401      j := 0;
     402      for i := 1 to Length(txtReason.Text) do
     403        begin
     404          if txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
     405          if not (txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
     406          if j = 2 then break;
     407        end;
     408      if j < 2 then SetError(TX_NO_REASON);
     409    end;
     410
     411  if Length(memHistory.Text) > 0 then
     412  begin
     413    j := 0;
     414    for i := 1 to Length(memHistory.Text) do
     415      begin
     416        if memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
     417        if not (memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
     418        if j = 2 then break;
     419      end;
     420    if j < 2 then SetError(TX_BAD_HISTORY);
     421  end;
     422
    382423  with cboCategory do
    383424    begin
    384       AskLoc := True;
     425      AskLoc := (ALocation = 0);
    385426      if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
    386427        AskLoc := False;
    … …  
    401442  if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
    402443
    403   if Length(memReason.Text) < 2 then
    404     SetError(TX_NO_REASON)
    405   else
    406     begin
    407       j := 0;
    408       for i := 1 to Length(memReason.Text) do
    409         begin
    410           if memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
    411           if not (memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
    412           if j = 2 then break;
    413         end;
    414       if j < 2 then SetError(TX_NO_REASON);
    415     end;
    416 
    417444  with cboSubmit do
    418445    if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
    419446
    420447  with calRequestDate do
    421     if FMDateTime = 0 then SetError(TX_NO_DATE);
     448  begin
     449    if FMDateTime = 0 then
     450      SetError(TX_NO_DATE)
     451    else if FMDateTime < 0 then
     452      SetError(TX_BAD_DATE)
     453    else if FMDateTime < FMToday then
     454      SetError(TX_PAST_DATE);
     455  end;
    422456
    423457end;
    … …  
    492526    ClearControl(lstSelectMod);
    493527    ClearControl(lstLastExam);
    494     //ClearControl(memReason);    {WPB-1298-30758}
     528    //ClearControl(memHistory);    {WPB-1298-30758}
    495529    Changing := False;
    496530    if CharAt(ItemID, 1) = 'Q' then
    … …  
    513547    SetControl(cboTransport,       'MODE', 1);
    514548    SetControl(cboCategory,        'CLASS', 1);
    515     SetControl(memReason,          'COMMENT', 1);
     549    SetControl(txtReason,           'REASON', 1);
     550    SetControl(memHistory,         'COMMENT', 1);
    516551    SetControl(chkIsolation,       'YN', 1);
    517552    SetControl(radPregnant,        'PREGNANT', 1);
    … …  
    581616  AutoSizeDisabled := True;
    582617  inherited;
    583   memReason.Width := pnlHandR.ClientWidth;
    584   memReason.Height := pnlHandR.ClientHeight - memReason.Top;
     618  memHistory.Width := pnlHandR.ClientWidth;
     619  memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
    585620  FillerID := 'RA';                     // does 'on Display' order check **KCM**
    586621  StatusText('Loading Dialog Definition');
    … …  
    590625  Responses.Dialog := 'RA OERR EXAM';              // loads formatting info
    591626  StatusText('Loading Default Values');
    592   cboImType.Items.Assign(SubsetOfImagingTypes);
     627  FastAssign(SubsetOfImagingTypes, cboImType.Items);
    593628  if Self.EvtID>0 then
    594629    FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
    … …  
    600635  PreserveControl(cboCategory);
    601636  PreserveControl(calPreOp);
    602   PreserveControl(memReason);      {WPB-1298-30758}
     637  PreserveControl(txtReason);
     638  PreserveControl(memHistory);      {WPB-1298-30758}
    603639  if (Patient.Sex <> 'F') then
    604640  begin
    … …  
    619655end;
    620656
    621 procedure TfrmODRad.memReasonExit(Sender: TObject);
     657procedure TfrmODRad.memHistoryExit(Sender: TObject);
    622658var
    623659  AStringList: TStringList;
    … …  
    626662  AStringList := TStringList.Create;
    627663  try
    628     AStringList.Assign(memReason.Lines);
     664    FastAssign(memHistory.Lines, AStringList);
    629665    LimitStringLength(AStringList, 74);
    630     memReason.Lines.Assign(AstringList);
     666    FastAssign(AstringList, memHistory.Lines);
    631667    ControlChange(Self);
    632668  finally
    … …  
    638674begin
    639675  inherited;
    640   memReason.Width := pnlHandR.ClientWidth;
    641   memReason.Height := pnlHandR.ClientHeight - memReason.Top;
     676  memHistory.Width := pnlHandR.ClientWidth;
     677  memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
    642678end;
    643679

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

    r456 r829  
    1 object frmODRadApproval: TfrmODRadApproval
     1inherited frmODRadApproval: TfrmODRadApproval
    22  Left = 295
    33  Top = 167
    … …  
    66  ClientHeight = 262
    77  ClientWidth = 259
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
    … …  
    6862      ListItemsOnly = True
    6963      LongList = False
     64      LookupPiece = 0
    7065      MaxLength = 0
    7166      Pieces = '2'
    … …  
    7368      SynonymChars = '<>'
    7469      TabOrder = 0
     70      CharsNeedMatch = 1
    7571    end
    7672  end
     73  inherited amgrMain: TVA508AccessibilityManager
     74    Data = (
     75      (
     76        'Component = pnlBase'
     77        'Status = stsDefault')
     78      (
     79        'Component = cmdOK'
     80        'Status = stsDefault')
     81      (
     82        'Component = cmdCancel'
     83        'Status = stsDefault')
     84      (
     85        'Component = cboRadiologist'
     86        'Status = stsDefault')
     87      (
     88        'Component = frmODRadApproval'
     89        'Status = stsDefault'))
     90  end
    7791end

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

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmODRadApproval = class(TForm)
     9  TfrmODRadApproval = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;
    … …  
    4949      ClientHeight := H; pnlBase.Height := H;
    5050      FChanged := False;
    51       cboRadiologist.Items.Assign(SubsetOfRadiologists);
     51      FastAssign(SubsetOfRadiologists, cboRadiologist.Items);
    5252      ShowModal;
    5353      Radiologist := FRadiologist ;

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

    r456 r829  
    1 object frmODRadConShRes: TfrmODRadConShRes
     1inherited frmODRadConShRes: TfrmODRadConShRes
    22  Left = 308
    33  Top = 206
    … …  
    77  ClientHeight = 121
    88  ClientWidth = 288
    9   Color = clBtnFace
    10   Font.Charset = DEFAULT_CHARSET
    11   Font.Color = clWindowText
    12   Font.Height = -11
    13   Font.Name = 'MS Sans Serif'
    14   Font.Style = []
    159  OldCreateOrder = True
    1610  Position = poScreenCenter
    1711  PixelsPerInch = 96
    1812  TextHeight = 13
    19   object pnlBase: TORAutoPanel
     13  object pnlBase: TORAutoPanel [0]
    2014    Left = 0
    2115    Top = 0
    … …  
    6963      ListItemsOnly = True
    7064      LongList = False
     65      LookupPiece = 0
    7166      MaxLength = 0
    7267      Pieces = '2'
    … …  
    7469      SynonymChars = '<>'
    7570      TabOrder = 0
     71      CharsNeedMatch = 1
    7672    end
    7773    object txtResearch: TCaptionEdit
    … …  
    8581    end
    8682  end
     83  inherited amgrMain: TVA508AccessibilityManager
     84    Data = (
     85      (
     86        'Component = pnlBase'
     87        'Status = stsDefault')
     88      (
     89        'Component = cmdOK'
     90        'Status = stsDefault')
     91      (
     92        'Component = cmdCancel'
     93        'Status = stsDefault')
     94      (
     95        'Component = cboSource'
     96        'Status = stsDefault')
     97      (
     98        'Component = txtResearch'
     99        'Status = stsDefault')
     100      (
     101        'Component = frmODRadConShRes'
     102        'Status = stsDefault'))
     103  end
    87104end

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

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmODRadConShRes = class(TForm)
     9  TfrmODRadConShRes = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;
    … …  
    5454      if SrcType in ['C','S'] then with cboSource do
    5555         begin
    56            Items.Assign(SubsetOfRadSources(SrcType));
     56           FastAssign(SubsetOfRadSources(SrcType), cboSource.Items);
    5757           if Items.Count > 0 then
    5858            begin

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

    r456 r829  
    1 object frmODRadImType: TfrmODRadImType
     1inherited frmODRadImType: TfrmODRadImType
    22  Left = 308
    33  Top = 206
    … …  
    66  ClientHeight = 189
    77  ClientWidth = 259
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
    … …  
    6963      ListItemsOnly = True
    7064      LongList = False
     65      LookupPiece = 0
    7166      MaxLength = 0
    7267      Pieces = '2'
    … …  
    7570      TabOrder = 0
    7671      OnDblClick = cboImTypeDblClick
     72      CharsNeedMatch = 1
    7773    end
    7874  end
     75  inherited amgrMain: TVA508AccessibilityManager
     76    Data = (
     77      (
     78        'Component = pnlBase'
     79        'Status = stsDefault')
     80      (
     81        'Component = cmdOK'
     82        'Status = stsDefault')
     83      (
     84        'Component = cmdCancel'
     85        'Status = stsDefault')
     86      (
     87        'Component = cboImType'
     88        'Status = stsDefault')
     89      (
     90        'Component = frmODRadImType'
     91        'Status = stsDefault'))
     92  end
    7993end

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

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmODRadImType = class(TForm)
     9  TfrmODRadImType = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;
    … …  
    5050      ClientHeight := H; pnlBase.Height := H;
    5151      FChanged := False;
    52       cboImType.Items.Assign(SubsetOfImagingTypes);
     52      FastAssign(SubsetOfImagingTypes, cboImType.Items);
    5353      if cboImType.Items.Count > 1 then
    5454         ShowModal

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

    r456 r829  
    1 object frmOrdersReleaseEvent: TfrmOrdersReleaseEvent
     1inherited frmOrdersReleaseEvent: TfrmOrdersReleaseEvent
    22  Left = 410
    33  Top = 145
    4   Width = 494
    5   Height = 488
    64  Caption = 'Release to Service'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   OldCreateOrder = False
     5  ClientHeight = 461
     6  ClientWidth = 486
    147  Position = poScreenCenter
    158  OnCreate = FormCreate
    169  OnDestroy = FormDestroy
     10  ExplicitWidth = 494
     11  ExplicitHeight = 488
    1712  PixelsPerInch = 96
    1813  TextHeight = 13
    19   object lblRelease: TLabel
     14  object lblRelease: TLabel [0]
    2015    Left = 0
    2116    Top = 0
    … …  
    2520    Layout = tlCenter
    2621    WordWrap = True
     22    ExplicitWidth = 3
    2723  end
    28   object pnlMiddle: TPanel
     24  object pnlMiddle: TPanel [1]
    2925    Left = 0
    3026    Top = 13
    … …  
    4945    end
    5046  end
    51   object pnlBottom: TPanel
     47  object pnlBottom: TPanel [2]
    5248    Left = 0
    5349    Top = 426
    … …  
    8177    end
    8278  end
     79  inherited amgrMain: TVA508AccessibilityManager
     80    Data = (
     81      (
     82        'Component = pnlMiddle'
     83        'Status = stsDefault')
     84      (
     85        'Component = cklstOrders'
     86        'Status = stsDefault')
     87      (
     88        'Component = pnlBottom'
     89        'Status = stsDefault')
     90      (
     91        'Component = btnOK'
     92        'Status = stsDefault')
     93      (
     94        'Component = btnCancel'
     95        'Status = stsDefault')
     96      (
     97        'Component = frmOrdersReleaseEvent'
     98        'Status = stsDefault'))
     99  end
    83100end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz;
     7  StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmOrdersReleaseEvent = class(TForm)
     11  TfrmOrdersReleaseEvent = class(TfrmBase508Form)
    1112    pnlMiddle: TPanel;
    1213    pnlBottom: TPanel;
    … …  
    4445{$R *.DFM}
    4546
    46 uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders;
     47uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders, rODLab, fRptBox,
     48  VAUtils;
     49
    4750const
    4851  TX_SAVERR1 = 'The error, ';
    … …  
    6063  OrderText, LastCheckedPtEvt, SpeCap: string;
    6164  frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
     65  AList: TStringList;
    6266
    6367  function FindOrderText(const AnID: string): string;
    … …  
    119123        begin
    120124          OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
    121           InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,TC_SAVERR, MB_OK);
     125          if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then
     126          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          else
     130          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
     131                  TC_SAVERR, MB_OK);
    122132        end;
     133      end;
     134      //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
     135      AList := TStringList.Create;
     136      try
     137        CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst);
     138        if AList.Text <> '' then
     139          ReportBox(AList, 'Changed Orders', TRUE);
     140      finally
     141        AList.Free;
    123142      end;
    124143      PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
    … …  
    194213  if not beSelected then
    195214  begin
    196     ShowMessage('You have to select at least one order!');
     215    ShowMsg('You have to select at least one order!');
    197216    Exit;
    198217  end;
    … …  
    238257  begin
    239258    Canvas.FillRect(ARect);
    240     Canvas.Pen.Color := clSilver;
     259    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    241260    Canvas.MoveTo(0, ARect.Bottom - 1);
    242261    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);

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

    r456 r829  
    22  Left = 371
    33  Top = 203
    4   Width = 304
    5   Height = 290
    64  Caption = 'frmODQuick'
     5  ClientHeight = 263
     6  ClientWidth = 296
     7  ExplicitWidth = 304
     8  ExplicitHeight = 290
    79  PixelsPerInch = 96
    810  TextHeight = 13
    9   object Label1: TLabel
     11  object Label1: TLabel [0]
    1012    Left = 8
    1113    Top = 8
    … …  
    1416    Caption = 'Enter the name that should be used for this quick order.'
    1517  end
    16   object Label2: TLabel
     18  object Label2: TLabel [1]
    1719    Left = 8
    1820    Top = 61
    … …  
    2123    Caption = 'Meds, Inpatient Common List'
    2224  end
    23   object SpeedButton1: TSpeedButton
     25  object SpeedButton1: TSpeedButton [2]
    2426    Left = 263
    2527    Top = 108
    … …  
    3638      33333333333C3333333333333333333333333333333333333333}
    3739  end
    38   object SpeedButton2: TSpeedButton
     40  object SpeedButton2: TSpeedButton [3]
    3941    Left = 263
    4042    Top = 144
    … …  
    5153      333333333CCCCC33333333333333333333333333333333333333}
    5254  end
    53   object Bevel1: TBevel
     55  object Bevel1: TBevel [4]
    5456    Left = 8
    5557    Top = 224
    … …  
    5759    Height = 2
    5860  end
    59   object Bevel2: TBevel
     61  object Bevel2: TBevel [5]
    6062    Left = 8
    6163    Top = 51
    … …  
    6365    Height = 2
    6466  end
    65   object Edit1: TCaptionEdit
     67  object Edit1: TCaptionEdit [6]
    6668    Left = 8
    6769    Top = 22
    … …  
    7173    Caption = 'Enter the name that should be used for this quick order.'
    7274  end
    73   object ORListBox1: TORListBox
     75  object ORListBox1: TORListBox [7]
    7476    Left = 8
    7577    Top = 75
    … …  
    8385    LongList = False
    8486  end
    85   object Button1: TButton
     87  object Button1: TButton [8]
    8688    Left = 136
    8789    Top = 234
    … …  
    9193    TabOrder = 2
    9294  end
    93   object Button2: TButton
     95  object Button2: TButton [9]
    9496    Left = 216
    9597    Top = 234
    … …  
    99101    TabOrder = 3
    100102  end
    101   object BitBtn1: TBitBtn
     103  object BitBtn1: TBitBtn [10]
    102104    Left = 263
    103105    Top = 191
    … …  
    107109    Kind = bkAbort
    108110  end
     111  inherited amgrMain: TVA508AccessibilityManager
     112    Data = (
     113      (
     114        'Component = Edit1'
     115        'Status = stsDefault')
     116      (
     117        'Component = ORListBox1'
     118        'Status = stsDefault')
     119      (
     120        'Component = Button1'
     121        'Status = stsDefault')
     122      (
     123        'Component = Button2'
     124        'Status = stsDefault')
     125      (
     126        'Component = BitBtn1'
     127        'Status = stsDefault')
     128      (
     129        'Component = frmODQuick'
     130        'Status = stsDefault'))
     131  end
    109132end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls;
     7  fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    2424    Caption = 'Stop Date/Time'
    2525  end
    26   inherited memOrder: TMemo
     26  inherited memOrder: TCaptionMemo
    2727    TabOrder = 6
    2828  end
    … …  
    3030    TabOrder = 3
    3131  end
    32   inherited cmdQuit: TButton
    33     TabOrder = 4
    34   end
    35   object memText: TMemo [6]
     32  object memText: TMemo [5]
    3633    Left = 6
    3734    Top = 18
    … …  
    4138    OnChange = ControlChange
    4239  end
    43   object txtStart: TORDateBox [7]
     40  object txtStart: TORDateBox [6]
    4441    Left = 226
    4542    Top = 164
    … …  
    5249    Caption = 'Start Date/Time'
    5350  end
    54   object txtStop: TORDateBox [8]
     51  object txtStop: TORDateBox [7]
    5552    Left = 374
    5653    Top = 164
    … …  
    6360    Caption = 'Stop Date/Time'
    6461  end
     62  inherited cmdQuit: TButton
     63    TabOrder = 4
     64  end
    6565  inherited pnlMessage: TPanel
    6666    TabOrder = 5
    6767  end
     68  inherited amgrMain: TVA508AccessibilityManager
     69    Data = (
     70      (
     71        'Component = memText'
     72        'Status = stsDefault')
     73      (
     74        'Component = txtStart'
     75        'Status = stsDefault')
     76      (
     77        'Component = txtStop'
     78        'Status = stsDefault')
     79      (
     80        'Component = memOrder'
     81        'Status = stsDefault')
     82      (
     83        'Component = cmdAccept'
     84        'Status = stsDefault')
     85      (
     86        'Component = cmdQuit'
     87        'Status = stsDefault')
     88      (
     89        'Component = pnlMessage'
     90        'Status = stsDefault')
     91      (
     92        'Component = memMessage'
     93        'Status = stsDefault')
     94      (
     95        'Component = frmODText'
     96        'Status = stsDefault'))
     97  end
    6898end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm;
     7  fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    1718    procedure FormCreate(Sender: TObject);
    1819    procedure ControlChange(Sender: TObject);
     20    procedure cmdAcceptClick(Sender: TObject);
    1921  public
    2022    procedure InitDialog; override;
    … …  
    4547  FillerID := 'OR';                     // does 'on Display' order check **KCM**
    4648  StatusText('Loading Dialog Definition');
    47   Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDE';  // loads formatting info
     49  Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDER';  // loads formatting info
    4850  //StatusText('Loading Default Values');                // there are no defaults for text only
    4951  //CtrlInits.LoadDefaults(ODForText);
    … …  
    110112end;
    111113
     114procedure TfrmODText.cmdAcceptClick(Sender: TObject);
     115begin
     116  inherited;
     117  Application.ProcessMessages; //CQ 14670
     118  memText.Lines.Text := Trim(memText.Lines.Text); //CQ 14670
     119end;
     120
    112121procedure TfrmODText.ControlChange(Sender: TObject);
    113122begin

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

    r456 r829  
    1 object frmInvalidActionList: TfrmInvalidActionList
     1inherited frmInvalidActionList: TfrmInvalidActionList
    22  Left = 445
    33  Top = 142
    4   Width = 534
    5   Height = 553
    64  Caption = 'Invalidated action orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   OldCreateOrder = False
     5  ClientHeight = 519
     6  ClientWidth = 526
    147  Position = poScreenCenter
    158  OnCreate = FormCreate
    … …  
    1710  PixelsPerInch = 96
    1811  TextHeight = 13
    19   object pnlTop: TPanel
     12  object pnlTop: TPanel [0]
    2013    Left = 0
    2114    Top = 0
    … …  
    3831      Width = 524
    3932      Height = 176
     33      Style = lbOwnerDrawVariable
    4034      Align = alClient
    4135      ItemHeight = 16
    42       Style = lbOwnerDrawVariable
    4336      TabOrder = 0
    4437      OnDrawItem = lstActDeniedOrdersDrawItem
    … …  
    5144      Width = 524
    5245      Height = 27
    53       DragReorder = False
    5446      Sections = <
    5547        item
    … …  
    6860    end
    6961  end
    70   object pnlBottom: TPanel
     62  object pnlBottom: TPanel [1]
    7163    Left = 0
    7264    Top = 229
    7365    Width = 526
    74     Height = 256
     66    Height = 249
    7567    Align = alClient
    7668    TabOrder = 1
     69    ExplicitHeight = 256
    7770    object Label2: TLabel
    7871      Left = 1
    … …  
    9588      Top = 41
    9689      Width = 524
    97       Height = 214
     90      Height = 207
     91      Style = lbOwnerDrawVariable
    9892      Align = alClient
    9993      ItemHeight = 16
    100       Style = lbOwnerDrawVariable
    10194      TabOrder = 0
    10295      OnDrawItem = lstValidOrdersDrawItem
    … …  
    10598    end
    10699  end
    107   object Panel1: TPanel
     100  object Panel1: TPanel [2]
    108101    Left = 0
    109     Top = 485
     102    Top = 478
    110103    Width = 526
    111104    Height = 41
    112105    Align = alBottom
    113106    TabOrder = 2
     107    ExplicitTop = 485
     108    DesignSize = (
     109      526
     110      41)
    114111    object btnOK: TButton
    115112      Left = 440
    … …  
    123120    end
    124121  end
     122  inherited amgrMain: TVA508AccessibilityManager
     123    Data = (
     124      (
     125        'Component = pnlTop'
     126        'Status = stsDefault')
     127      (
     128        'Component = lstActDeniedOrders'
     129        'Status = stsDefault')
     130      (
     131        'Component = hdrAction'
     132        'Status = stsDefault')
     133      (
     134        'Component = pnlBottom'
     135        'Status = stsDefault')
     136      (
     137        'Component = lstValidOrders'
     138        'Status = stsDefault')
     139      (
     140        'Component = Panel1'
     141        'Status = stsDefault')
     142      (
     143        'Component = btnOK'
     144        'Status = stsDefault')
     145      (
     146        'Component = frmInvalidActionList'
     147        'Status = stsDefault'))
     148  end
    125149end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls;
     7  ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmInvalidActionList = class(TForm)
     11  TfrmInvalidActionList = class(TfrmBase508Form)
    1112    pnlTop: TPanel;
    1213    lstActDeniedOrders: TCaptionListBox;
    … …  
    4344implementation
    4445
     46uses
     47  VA2006Utils;
     48
    4549{$R *.DFM}
    4650
    … …  
    97101    ARect := TheRect;
    98102    Canvas.FillRect(ARect);
    99     Canvas.Pen.Color := clSilver;
     103    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    100104    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    101105    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
    … …  
    168172procedure TfrmInvalidActionList.FormCreate(Sender: TObject);
    169173begin
     174  FixHeaderControlDelphi2006Bug(hdrAction);
    170175  TheInvaList := TStringList.Create;
    171176end;
    … …  
    234239    ARect := TheRect;
    235240    Canvas.FillRect(ARect);
    236     Canvas.Pen.Color := clSilver;
     241    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    237242    SaveColor := Canvas.Brush.Color;   
    238243    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

    r456 r829  
    4949    Caption = 'Additional Instructions'
    5050  end
    51   object cboMeasurement: TORComboBox
     51  object cboMeasurement: TORComboBox [10]
    5252    Left = 6
    5353    Top = 21
    … …  
    7373    CharsNeedMatch = 1
    7474  end
    75   object cboSchedule: TORComboBox
     75  object cboSchedule: TORComboBox [11]
    7676    Left = 144
    7777    Top = 21
    … …  
    9797    CharsNeedMatch = 1
    9898  end
    99   object calStart: TORDateBox
     99  object calStart: TORDateBox [12]
    100100    Left = 282
    101101    Top = 21
    … …  
    109109    Caption = 'Start Date'
    110110  end
    111   object calStop: TORDateBox
     111  object calStop: TORDateBox [13]
    112112    Left = 282
    113113    Top = 64
    … …  
    120120    Caption = 'Stop Date'
    121121  end
    122   object grpCallHO: TGroupBox
     122  object grpCallHO: TGroupBox [14]
    123123    Left = 407
    124124    Top = 9
    … …  
    223223      Height = 21
    224224      Associate = txtBPsys
    225       Min = 0
    226225      Max = 300
    227226      Position = 100
    228227      TabOrder = 5
    229       Wrap = False
    230228    end
    231229    object spnBPdia: TUpDown
    … …  
    235233      Height = 21
    236234      Associate = txtBPDia
    237       Min = 0
    238235      Max = 300
    239236      Position = 120
    240237      TabOrder = 6
    241       Wrap = False
    242238    end
    243239    object spnPulseLT: TUpDown
    … …  
    247243      Height = 21
    248244      Associate = txtPulseLT
    249       Min = 0
    250245      Max = 500
    251246      Position = 60
    252247      TabOrder = 7
    253       Wrap = False
    254248    end
    255249    object spnPulseGT: TUpDown
    … …  
    259253      Height = 21
    260254      Associate = txtPulGT
    261       Min = 0
    262255      Max = 300
    263256      Position = 120
    264257      TabOrder = 8
    265       Wrap = False
    266258    end
    267259    object spnTemp: TUpDown
    … …  
    271263      Height = 21
    272264      Associate = txtTemp
    273       Min = 0
    274265      Max = 120
    275266      Position = 101
    276267      TabOrder = 9
    277       Wrap = False
    278     end
    279   end
    280   object chkCallHO: TCheckBox
     268    end
     269  end
     270  object chkCallHO: TCheckBox [15]
    281271    Left = 414
    282272    Top = 8
    … …  
    287277    Visible = False
    288278  end
     279  inherited amgrMain: TVA508AccessibilityManager
     280    Data = (
     281      (
     282        'Component = txtComment'
     283        'Status = stsDefault')
     284      (
     285        'Component = cboMeasurement'
     286        'Status = stsDefault')
     287      (
     288        'Component = cboSchedule'
     289        'Status = stsDefault')
     290      (
     291        'Component = calStart'
     292        'Status = stsDefault')
     293      (
     294        'Component = calStop'
     295        'Status = stsDefault')
     296      (
     297        'Component = grpCallHO'
     298        'Status = stsDefault')
     299      (
     300        'Component = txtBPsys'
     301        'Status = stsDefault')
     302      (
     303        'Component = txtBPDia'
     304        'Status = stsDefault')
     305      (
     306        'Component = txtPulseLT'
     307        'Status = stsDefault')
     308      (
     309        'Component = txtPulGT'
     310        'Status = stsDefault')
     311      (
     312        'Component = txtTemp'
     313        'Status = stsDefault')
     314      (
     315        'Component = spnBPsys'
     316        'Status = stsDefault')
     317      (
     318        'Component = spnBPdia'
     319        'Status = stsDefault')
     320      (
     321        'Component = spnPulseLT'
     322        'Status = stsDefault')
     323      (
     324        'Component = spnPulseGT'
     325        'Status = stsDefault')
     326      (
     327        'Component = spnTemp'
     328        'Status = stsDefault')
     329      (
     330        'Component = chkCallHO'
     331        'Status = stsDefault')
     332      (
     333        'Component = memOrder'
     334        'Status = stsDefault')
     335      (
     336        'Component = cmdAccept'
     337        'Status = stsDefault')
     338      (
     339        'Component = cmdQuit'
     340        'Status = stsDefault')
     341      (
     342        'Component = pnlMessage'
     343        'Status = stsDefault')
     344      (
     345        'Component = memMessage'
     346        'Status = stsDefault')
     347      (
     348        'Component = frmODVitals'
     349        'Status = stsDefault'))
     350  end
    289351end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm;
     7  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    11inherited frmOMAction: TfrmOMAction
    22  Caption = 'frmOMAction'
     3  ExplicitWidth = 320
     4  ExplicitHeight = 240
    35  PixelsPerInch = 96
    46  TextHeight = 13
     7  inherited amgrMain: TVA508AccessibilityManager
     8    Data = (
     9      (
     10        'Component = frmOMAction'
     11        'Status = stsDefault'))
     12  end
    513end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, rOrders;
     7  fAutoSz, rOrders, VA508AccessibilityManager;
    88
    99

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

    r456 r829  
    22  Left = 390
    33  Top = 242
    4   Width = 520
    5   Height = 320
    64  Caption = 'HTML Ordering'
     5  ClientHeight = 293
     6  ClientWidth = 512
    77  OnClose = FormClose
    88  OnCreate = FormCreate
     9  ExplicitWidth = 520
     10  ExplicitHeight = 320
    911  PixelsPerInch = 96
    1012  TextHeight = 13
    11   object btnOK: TButton
     13  object btnOK: TButton [0]
    1214    Left = 352
    1315    Top = 268
    … …  
    1921    OnClick = btnOKClick
    2022  end
    21   object btnCancel: TButton
     23  object btnCancel: TButton [1]
    2224    Left = 433
    2325    Top = 268
    … …  
    3032    OnClick = btnCancelClick
    3133  end
    32   object btnBack: TButton
     34  object btnBack: TButton [2]
    3335    Left = 6
    3436    Top = 268
    … …  
    4143    OnClick = btnBackClick
    4244  end
    43   object pnlWeb: TPanel
     45  object pnlWeb: TPanel [3]
    4446    Left = 6
    4547    Top = 6
    … …  
    6668    end
    6769  end
    68   object btnShow: TButton
     70  object btnShow: TButton [4]
    6971    Left = 55
    7072    Top = 268
    … …  
    7678    OnClick = btnShowClick
    7779  end
     80  inherited amgrMain: TVA508AccessibilityManager
     81    Data = (
     82      (
     83        'Component = btnOK'
     84        'Status = stsDefault')
     85      (
     86        'Component = btnCancel'
     87        'Status = stsDefault')
     88      (
     89        'Component = btnBack'
     90        'Status = stsDefault')
     91      (
     92        'Component = pnlWeb'
     93        'Status = stsDefault')
     94      (
     95        'Component = webView'
     96        'Status = stsDefault')
     97      (
     98        'Component = btnShow'
     99        'Status = stsDefault')
     100      (
     101        'Component = frmOMHTML'
     102        'Status = stsDefault'))
     103  end
    78104end

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

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    99  fOMAction, StdCtrls, OleCtrls, SHDocVw, MSHTML, activex, rOrders, uConst,
    10   ExtCtrls;
     10  ExtCtrls, VA508AccessibilityManager;
    1111
    1212type
    … …  
    130130  end; {for i}
    131131  CallBroker;
    132   Dest.Assign(RPCBrokerV.Results);
     132  FastAssign(RPCBrokerV.Results, Dest);
    133133end;
    134134
    … …  
    159159  CallBroker;
    160160  WPText.Free;
    161   Dest.Assign(RPCBrokerV.Results);
     161  FastAssign(RPCBrokerV.Results, Dest);
    162162end;
    163163

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

    r456 r829  
    1 object frmOMNavA: TfrmOMNavA
    2   Left = 265
    3   Top = 445
    4   Width = 491
    5   Height = 305
     1inherited frmOMNavA: TfrmOMNavA
     2  Left = 212
     3  Top = 354
    64  BorderIcons = []
    7   Caption = 'frmOMNavA'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     5  Caption = 'Order Menu'
     6  ClientHeight = 278
     7  ClientWidth = 483
    148  OldCreateOrder = True
    159  OnActivate = FormActivate
    … …  
    1812  OnDestroy = FormDestroy
    1913  OnResize = FormResize
     14  ExplicitLeft = 212
     15  ExplicitTop = 354
     16  ExplicitWidth = 491
     17  ExplicitHeight = 312
    2018  PixelsPerInch = 96
    2119  TextHeight = 13
    22   object pnlTool: TPanel
     20  object pnlTool: TPanel [0]
    2321    Left = 0
    2422    Top = 0
    … …  
    3028    Color = clHighlight
    3129    Font.Charset = DEFAULT_CHARSET
    32     Font.Color = clWhite
     30    Font.Color = clHighlightText
    3331    Font.Height = -11
    3432    Font.Name = 'MS Sans Serif'
    … …  
    4442      Width = 50
    4543      Height = 17
     44      Align = alRight
    4645      Caption = 'Done'
    4746      Font.Charset = DEFAULT_CHARSET
    48       Font.Color = clWhite
     47      Font.Color = clBtnText
    4948      Font.Height = -11
    5049      Font.Name = 'MS Sans Serif'
    … …  
    5352      TabOrder = 0
    5453      OnClick = cmdDoneClick
    55       Align = alRight
    5654    end
    5755    object cmdPrev: TBitBtn
    … …  
    104102    end
    105103  end
    106   object grdMenu: TCaptionStringGrid
     104  object grdMenu: TCaptionStringGrid [1]
    107105    Left = 0
    108106    Top = 19
    … …  
    129127    Caption = 'Menu or Dialog Name'
    130128  end
     129  inherited amgrMain: TVA508AccessibilityManager
     130    Left = 8
     131    Top = 40
     132    Data = (
     133      (
     134        'Component = pnlTool'
     135        'Status = stsDefault')
     136      (
     137        'Component = cmdDone'
     138        'Status = stsDefault')
     139      (
     140        'Component = cmdPrev'
     141        'Status = stsDefault')
     142      (
     143        'Component = cmdNext'
     144        'Status = stsDefault')
     145      (
     146        'Component = grdMenu'
     147        'Status = stsDefault')
     148      (
     149        'Component = frmOMNavA'
     150        'Status = stsDefault'))
     151  end
     152  object accEventsGrdMenu: TVA508ComponentAccessibility
     153    Component = grdMenu
     154    OnCaptionQuery = accEventsGrdMenuCaptionQuery
     155    OnValueQuery = accEventsGrdMenuValueQuery
     156    Left = 40
     157    Top = 40
     158  end
    131159end

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

    r456 r829  
    77uses
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    9   Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame;
     9  Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame, fBase508Form,
     10  VA508AccessibilityManager;
    1011
    1112type
    12   TfrmOMNavA = class(TForm)
     13  TfrmOMNavA = class(TfrmBase508Form)
    1314    pnlTool: TPanel;
    1415    cmdDone: TORAlignButton;
    … …  
    1617    cmdPrev: TBitBtn;
    1718    cmdNext: TBitBtn;
     19    accEventsGrdMenu: TVA508ComponentAccessibility;
    1820    procedure FormActivate(Sender: TObject);
    1921    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    … …  
    4244      Shift: TShiftState);
    4345    procedure FormResize(Sender: TObject);
     46    procedure accEventsGrdMenuCaptionQuery(Sender: TObject;
     47      var Text: string);
     48    procedure accEventsGrdMenuValueQuery(Sender: TObject;
     49      var Text: string);
    4450  private
    4551    FOrderingMenu: Integer;
    … …  
    8894
    8995uses rODBase, ORFn, fODBase,fODGen, fODAuto, fOMVerify, uCore, rMisc, uODBase,
    90   fOrders, uAccessibleStringGrid;
     96  fOrders, VAUtils;
    9197
    9298const
    … …  
    271277  NoFresh := True;
    272278  ResizeFont;
    273   TAccessibleStringGrid.WrapControl(grdMenu);
     279//  TAccessibleStringGrid.WrapControl(grdMenu);
    274280end;
    275281
    … …  
    288294end;
    289295
     296procedure TfrmOMNavA.accEventsGrdMenuCaptionQuery(Sender: TObject;
     297  var Text: string);
     298begin
     299  Text := pnlTool.Caption;
     300end;
     301
    290302procedure TfrmOMNavA.FormDestroy(Sender: TObject);
    291303var
    … …  
    294306  OrderMenuItem: TOrderMenuItem;
    295307begin
    296   TAccessibleStringGrid.UnwrapControl(grdMenu);
     308//  TAccessibleStringGrid.UnwrapControl(grdMenu);
    297309  ClearMenuGrid;
    298310  for i := 0 to FMenuHits.Count - 1 do
    … …  
    371383      if Selected    then
    372384      begin
    373          if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
    374           Font.Color := clBlue;
     385        Font.Color := Get508CompliantColor(clBlue);
    375386        Font.Style := Font.Style + [fsUnderline];
    376387      end;
    … …  
    470481    //frmFrame.UpdatePtInfoOnRefresh;
    471482    FOrderMenuItem := TOrderMenuItem(Objects[Col, Row]);
    472     if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil;          // display only
     483    if Assigned(FOrderMenuItem) then
     484      if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil;          // display only
    473485    if FOrderMenuItem <> nil then
    474486    begin
    … …  
    624636    Result := False;
    625637    InfoBox(x, TC_DISABLED, MB_OK);
     638  end;
     639end;
     640
     641procedure TfrmOMNavA.accEventsGrdMenuValueQuery(Sender: TObject;
     642  var Text: string);
     643var
     644  OrderMenuItem : TOrderMenuItem;
     645begin
     646  inherited;
     647  if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin
     648    OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]);
     649    if OrderMenuItem.AutoAck then
     650      Text := 'Auto Accept, '+ OrderMenuItem.ItemText;
    626651  end;
    627652end;
    … …  
    660685       end; {'M'}
    661686  'Q': ActivateOrderDialog(IntToStr(AnItem.IEN), FDelayEvent, Self, 0);
    662   'P': ShowMessage('Order Dialogs of type "Prompt" cannot be processed.');
     687  'P': ShowMsg('Order Dialogs of type "Prompt" cannot be processed.');
    663688  'O': begin
    664689         // disable initially, since the 1st item in the set may be a menu
    … …  
    667692           then Self.Enabled := True;
    668693       end;
    669   else ShowMessage('Unknown Order Dialog type: ' + AnItem.DlgType);
     694  else ShowMsg('Unknown Order Dialog type: ' + AnItem.DlgType);
    670695  end; {case}
    671696end;

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

    r456 r829  
    22  Left = 221
    33  Top = 542
    4   Width = 167
    5   Height = 215
    64  BorderIcons = []
    75  Caption = 'Order Set Progress'
    8   OnCreate = FormCreate
     6  ClientHeight = 188
     7  ClientWidth = 159
     8  ExplicitWidth = 167
     9  ExplicitHeight = 215
    910  PixelsPerInch = 96
    1011  TextHeight = 13
    11   object lstItems: TCheckListBox
     12  object lstItems: TCheckListBox [0]
    1213    Left = 0
    1314    Top = 0
    … …  
    1516    Height = 167
    1617    Align = alClient
    17     Color = 15793151
     18    Color = clCream
    1819    ItemHeight = 13
    1920    TabOrder = 0
    2021  end
    21   object cmdStop: TORAlignButton
     22  object cmdStop: TORAlignButton [1]
    2223    Left = 0
    2324    Top = 167
    2425    Width = 159
    2526    Height = 21
     27    Align = alBottom
    2628    Caption = 'Stop Order Set'
    2729    TabOrder = 1
    28     Align = alBottom
     30  end
     31  inherited amgrMain: TVA508AccessibilityManager
     32    Data = (
     33      (
     34        'Component = lstItems'
     35        'Status = stsDefault')
     36      (
     37        'Component = cmdStop'
     38        'Status = stsDefault')
     39      (
     40        'Component = frmOMProgress'
     41        'Status = stsDefault'))
    2942  end
    3043end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn;
     7  fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn, VA508AccessibilityManager;
    88
    99type
    … …  
    1111    lstItems: TCheckListBox;
    1212    cmdStop: TORAlignButton;
    13     procedure FormCreate(Sender: TObject);
    1413  private
    1514    { Private declarations }
    … …  
    4645end;
    4746
    48 procedure TfrmOMProgress.FormCreate(Sender: TObject);
    49 begin
    50   inherited;
    51   lstItems.Color := ReadOnlyColor;
    52 end;
    53 
    5447end.

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

    r456 r829  
    1 object frmOMSet: TfrmOMSet
     1inherited frmOMSet: TfrmOMSet
    22  Left = 209
    33  Top = 191
    4   Width = 113
    5   Height = 229
    64  BorderIcons = []
    75  Caption = 'Selected Orders'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 202
     7  ClientWidth = 105
    148  FormStyle = fsStayOnTop
    15   OldCreateOrder = False
    169  OnClose = FormClose
    1710  OnCloseQuery = FormCloseQuery
    1811  OnCreate = FormCreate
    1912  OnDestroy = FormDestroy
     13  ExplicitWidth = 113
     14  ExplicitHeight = 229
    2015  DesignSize = (
    2116    105
    … …  
    2318  PixelsPerInch = 96
    2419  TextHeight = 13
    25   object lstSet: TCheckListBox
     20  object lstSet: TCheckListBox [0]
    2621    Left = 0
    2722    Top = 0
    … …  
    3429    TabOrder = 0
    3530  end
    36   object cmdInterupt: TButton
     31  object cmdInterupt: TButton [1]
    3732    Left = 4
    3833    Top = 172
    … …  
    4439    OnClick = cmdInteruptClick
    4540  end
     41  inherited amgrMain: TVA508AccessibilityManager
     42    Data = (
     43      (
     44        'Component = lstSet'
     45        'Status = stsDefault')
     46      (
     47        'Component = cmdInterupt'
     48        'Status = stsDefault')
     49      (
     50        'Component = frmOMSet'
     51        'Status = stsDefault'))
     52  end
    4653end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe;
     7  StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    1718  end;
    1819
    19   TfrmOMSet = class(TForm)
     20  TfrmOMSet = class(TfrmBase508Form)
    2021    lstSet: TCheckListBox;
    2122    cmdInterupt: TButton;
    … …  
    149150    'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
    150151                begin
    151                   if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
    152                     lstSet.Checked[lstSet.ItemIndex] := True
    153                   else SkipToNext;
     152                  if Not FClosing then
     153                  begin
     154                    if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
     155                      lstSet.Checked[lstSet.ItemIndex] := True
     156                    else SkipToNext;
     157                  end;
    154158                end;
    155159    'M':      if ActivateOrderMenu(  IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)

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

    r456 r829  
    22  Left = 328
    33  Top = 243
    4   Width = 587
    5   Height = 208
    64  BorderIcons = []
    75  Caption = 'New Order'
     6  ClientHeight = 181
     7  ClientWidth = 579
    88  OnClose = FormClose
    99  OnCreate = FormCreate
     10  ExplicitWidth = 587
     11  ExplicitHeight = 208
    1012  PixelsPerInch = 96
    1113  TextHeight = 13
    12   object cmdAccept: TButton
     14  object cmdAccept: TButton [0]
    1315    Left = 165
    1416    Top = 154
    … …  
    2022    OnClick = cmdAcceptClick
    2123  end
    22   object cmdEdit: TButton
     24  object cmdEdit: TButton [1]
    2325    Left = 253
    2426    Top = 154
    … …  
    2931    OnClick = cmdEditClick
    3032  end
    31   object cmdCancel: TButton
     33  object cmdCancel: TButton [2]
    3234    Left = 341
    3335    Top = 154
    … …  
    3941    OnClick = cmdCancelClick
    4042  end
    41   object memText: TRichEdit
     43  object memText: TRichEdit [3]
    4244    Left = 6
    4345    Top = 6
    … …  
    6971    OnKeyUp = memTextKeyUp
    7072  end
     73  inherited amgrMain: TVA508AccessibilityManager
     74    Data = (
     75      (
     76        'Component = cmdAccept'
     77        'Status = stsDefault')
     78      (
     79        'Component = cmdEdit'
     80        'Status = stsDefault')
     81      (
     82        'Component = cmdCancel'
     83        'Status = stsDefault')
     84      (
     85        'Component = memText'
     86        'Status = stsDefault')
     87      (
     88        'Component = frmOMVerify'
     89        'Status = stsDefault'))
     90  end
    7191end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 334
    33  Top = 234
    4   Height = 289
    54  Caption = 'Comments for Order'
     5  ClientHeight = 262
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 289
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 80
    … …  
    1517    Caption = 'Comments:'
    1618  end
    17   object cmdOK: TButton
     19  object cmdOK: TButton [1]
    1820    Left = 267
    1921    Top = 233
    … …  
    2527    OnClick = cmdOKClick
    2628  end
    27   object cmdCancel: TButton
     29  object cmdCancel: TButton [2]
    2830    Left = 347
    2931    Top = 233
    … …  
    3537    OnClick = cmdCancelClick
    3638  end
    37   object memOrder: TMemo
     39  object memOrder: TMemo [3]
    3840    Left = 8
    3941    Top = 8
    … …  
    4850    WantReturns = False
    4951  end
    50   object memComments: TRichEdit
     52  object memComments: TRichEdit [4]
    5153    Left = 8
    5254    Top = 94
    … …  
    5860    OnKeyUp = memCommentsKeyUp
    5961  end
     62  inherited amgrMain: TVA508AccessibilityManager
     63    Data = (
     64      (
     65        'Component = cmdOK'
     66        'Status = stsDefault')
     67      (
     68        'Component = cmdCancel'
     69        'Status = stsDefault')
     70      (
     71        'Component = memOrder'
     72        'Status = stsDefault')
     73      (
     74        'Component = memComments'
     75        'Status = stsDefault')
     76      (
     77        'Component = frmWardComments'
     78        'Status = stsDefault'))
     79  end
    6080end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 334
    33  Top = 234
    4   Height = 191
    54  Caption = 'Flag Order'
     5  ClientHeight = 264
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitLeft = 334
     9  ExplicitTop = 234
     10  ExplicitWidth = 320
     11  ExplicitHeight = 291
    812  PixelsPerInch = 96
    913  TextHeight = 13
    10   object Label1: TLabel
     14  object Label1: TLabel [0]
    1115    Left = 8
    1216    Top = 80
    13     Width = 75
     17    Width = 199
    1418    Height = 13
    15     Caption = 'Reason for Flag'
     19    Caption = 'Reason for Flag    (Enter or select from list)'
    1620  end
    17   object lblAlertRecipient: TLabel
     21  object lblAlertRecipient: TLabel [1]
    1822    Left = 8
    19     Top = 123
     23    Top = 211
    2024    Width = 69
    2125    Height = 13
    2226    Caption = 'Alert Recipient'
    2327  end
    24   object txtReason: TCaptionEdit
    25     Left = 8
    26     Top = 94
    27     Width = 411
    28     Height = 21
    29     MaxLength = 80
    30     TabOrder = 0
    31     Caption = 'Reason for Flag'
    32   end
    33   object cmdOK: TButton
     28  object cmdOK: TButton [2]
    3429    Left = 267
    35     Top = 139
     30    Top = 227
    3631    Width = 72
    3732    Height = 21
    … …  
    4136    OnClick = cmdOKClick
    4237  end
    43   object cmdCancel: TButton
     38  object cmdCancel: TButton [3]
    4439    Left = 347
    45     Top = 139
     40    Top = 227
    4641    Width = 72
    4742    Height = 21
    … …  
    5146    OnClick = cmdCancelClick
    5247  end
    53   object memOrder: TMemo
     48  object memOrder: TMemo [4]
    5449    Left = 8
    5550    Top = 8
    … …  
    6358    WantReturns = False
    6459  end
    65   object cboAlertRecipient: TORComboBox
     60  object cboAlertRecipient: TORComboBox [5]
    6661    Left = 7
    67     Top = 139
     62    Top = 227
    6863    Width = 226
    6964    Height = 21
    … …  
    8984    CharsNeedMatch = 1
    9085  end
     86  object cboFlagReason: TORComboBox [6]
     87    Left = 8
     88    Top = 99
     89    Width = 411
     90    Height = 106
     91    Style = orcsSimple
     92    AutoSelect = True
     93    Color = clWindow
     94    DropDownCount = 8
     95    ItemHeight = 13
     96    ItemTipColor = clWindow
     97    ItemTipEnable = True
     98    ListItemsOnly = False
     99    LongList = False
     100    LookupPiece = 0
     101    MaxLength = 80
     102    Pieces = '2'
     103    Sorted = False
     104    SynonymChars = '<>'
     105    TabOrder = 0
     106    CharsNeedMatch = 1
     107  end
     108  inherited amgrMain: TVA508AccessibilityManager
     109    Data = (
     110      (
     111        'Component = cmdOK'
     112        'Status = stsDefault')
     113      (
     114        'Component = cmdCancel'
     115        'Status = stsDefault')
     116      (
     117        'Component = memOrder'
     118        'Status = stsDefault')
     119      (
     120        'Component = cboAlertRecipient'
     121        'Status = stsDefault')
     122      (
     123        'Component = cboFlagReason'
     124        'Status = stsDefault')
     125      (
     126        'Component = frmFlagOrder'
     127        'Status = stsDefault'))
     128  end
    91129end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
    88
    99type
    1010  TfrmFlagOrder = class(TfrmAutoSz)
    11     txtReason: TCaptionEdit;
    1211    Label1: TLabel;
    1312    cmdOK: TButton;
    … …  
    1615    lblAlertRecipient: TLabel;
    1716    cboAlertRecipient: TORComboBox;
     17    cboFlagReason: TORComboBox;
    1818    procedure FormCreate(Sender: TObject);
    1919    procedure cmdOKClick(Sender: TObject);
    … …  
    5151      if OKPressed then
    5252      begin
    53         FlagOrder(AnOrder, txtReason.Text, AlertRecip);
     53        FlagOrder(AnOrder, cboFlagReason.Text, AlertRecip);
    5454        Result := True;
    5555      end;
    … …  
    6262
    6363procedure TfrmFlagOrder.FormCreate(Sender: TObject);
     64var
     65  tmpList: TStringList;
    6466begin
    6567  inherited;
    6668  OKPressed := False;
     69  tmpList := TStringList.Create;
     70  try
     71    GetUserListParam(tmpList, 'OR FLAGGED ORD REASONS');
     72    FastAssign(tmpList, cboFlagReason.Items);
     73  finally
     74    tmpList.Free;
     75  end;
    6776  cboAlertRecipient.InitLongList('');
    6877  //cboAlertRecipient.SelectByIEN(User.DUZ);
    … …  
    7584begin
    7685  inherited;
    77   if txtReason.Text = '' then
     86  if cboFlagReason.Text = '' then
     87  //if txtReason.Text = '' then
    7888  begin
    7989    InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);

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

    r456 r829  
    22  Left = 308
    33  Top = 171
    4   Width = 363
    5   Height = 362
    64  Caption = 'Add to Common List (Meds, Inpatient)'
     5  ClientHeight = 335
     6  ClientWidth = 355
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitLeft = 308
     10  ExplicitTop = 171
     11  ExplicitWidth = 363
     12  ExplicitHeight = 362
    913  PixelsPerInch = 96
    1014  TextHeight = 13
    11   object Panel1: TPanel
     15  object Panel1: TPanel [0]
    1216    Left = 0
    1317    Top = 0
    … …  
    4953    end
    5054  end
    51   object Panel2: TPanel
     55  object Panel2: TPanel [1]
    5256    Left = 0
    5357    Top = 113
    … …  
    162166    end
    163167  end
    164   object Panel3: TPanel
     168  object Panel3: TPanel [2]
    165169    Left = 0
    166170    Top = 294
    … …  
    189193    end
    190194  end
     195  inherited amgrMain: TVA508AccessibilityManager
     196    Data = (
     197      (
     198        'Component = Panel1'
     199        'Status = stsDefault')
     200      (
     201        'Component = memOrder'
     202        'Status = stsDefault')
     203      (
     204        'Component = txtDisplayName'
     205        'Status = stsDefault')
     206      (
     207        'Component = Panel2'
     208        'Status = stsDefault')
     209      (
     210        'Component = lstQuickList'
     211        'Status = stsDefault')
     212      (
     213        'Component = pnlUpButton'
     214        'Status = stsDefault')
     215      (
     216        'Component = pnlDownButton'
     217        'Status = stsDefault')
     218      (
     219        'Component = cmdRename'
     220        'Status = stsDefault')
     221      (
     222        'Component = cmdDelete'
     223        'Status = stsDefault')
     224      (
     225        'Component = Panel3'
     226        'Status = stsDefault')
     227      (
     228        'Component = cmdOK'
     229        'Status = stsDefault')
     230      (
     231        'Component = cmdCancel'
     232        'Status = stsDefault')
     233      (
     234        'Component = frmSaveQuickOrder'
     235        'Status = stsDefault'))
     236  end
    191237end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders;
     7  fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    5859  TX_NO_TEXT     = 'No fields have been entered - cannot save as quick order.';
    5960  TC_NO_TEXT     = 'Save as Quick Order';
     61  TX_DUP_NAME = 'There is already a quick order with that name.' + CRLF +
     62                'Please either delete the original or enter a different name.';
     63  TC_DUP_NAME = 'Unable to save quick order';
     64  TC_DUP_RENAME = 'Unable to rename quick order';
    6065
    6166function EditCommonList(ADisplayGroup: Integer): Boolean;
    … …  
    8489        ItemIndex := 0;
    8590      end;
     91      ActiveControl := lstQuickList;
    8692      ShowModal;
    8793      if OKPressed then
    … …  
    128134      else
    129135        DGroupName := NameOfDGroup(ResponseSet.DisplayGroup);
     136      if DGroupName = 'Inpt. Meds' then
     137        begin
     138          ResponseSet.DisplayGroup := InptDisp;
     139          DGroupName := NameOfDGroup(InptDisp);
     140        end;
    130141      Caption := 'Add Quick Order (' + DGroupName + ')';
    131142      lblQuickList.Caption := 'Common List for ' + DGroupName;
    … …  
    145156        ItemIndex := 0;
    146157      end;
     158      ActiveControl := txtDisplayName;
    147159      ShowModal;
    148160      if OKPressed then
    … …  
    213225var
    214226  AName: string;
     227  i: integer;
    215228begin
    216229  inherited;
    … …  
    219232    if ItemIndex < 0 then Exit;
    220233    AName := Piece(Items[ItemIndex], U, 2);
    221     if ExecuteRename(AName, TX_QO_RENAME)
    222       then Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
    223   end;
     234    if ExecuteRename(AName, TX_QO_RENAME) then
     235    begin
     236      i := Items.IndexOf(AName);
     237      if (i > -1) and (i <> ItemIndex) then
     238        InfoBox(TX_DUP_NAME, TC_DUP_RENAME, MB_ICONERROR or MB_OK)
     239      else
     240        Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
     241    end;
     242  end;
     243
    224244end;
    225245
    … …  
    247267
    248268procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
    249 begin
    250   inherited;
    251   if txtDisplayName.Enabled and (txtDisplayName.Text = '') then
    252   begin
    253     InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
    254     Exit;
     269var
     270  i: integer;
     271begin
     272  inherited;
     273  if txtDisplayName.Enabled then
     274  begin
     275    if (txtDisplayName.Text = '') then
     276    begin
     277      InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
     278      Exit;
     279    end;
     280    for i := 0 to lstQuickList.Count - 1 do
     281      if (UpperCase(lstQuickList.DisplayText[i]) = UpperCase(txtDisplayName.Text)) and (i > 0) then
     282      begin
     283        InfoBox(TX_DUP_NAME, TC_DUP_NAME, MB_ICONERROR or MB_OK);
     284        lstQuickList.ItemIndex := i;
     285        Exit;
     286      end;
    255287  end;
    256288  OKPressed := True;

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

    r456 r829  
    22  Left = 365
    33  Top = 389
    4   Height = 230
    54  Caption = 'Unflag Order'
     5  ClientHeight = 203
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 230
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 123
    … …  
    1517    Caption = 'Comment (optional)'
    1618  end
    17   object txtComment: TCaptionEdit
     19  object txtComment: TCaptionEdit [1]
    1820    Left = 8
    1921    Top = 137
    … …  
    2426    Caption = 'Comment (optional)'
    2527  end
    26   object cmdOK: TButton
     28  object cmdOK: TButton [2]
    2729    Left = 267
    2830    Top = 174
    … …  
    3436    OnClick = cmdOKClick
    3537  end
    36   object cmdCancel: TButton
     38  object cmdCancel: TButton [3]
    3739    Left = 347
    3840    Top = 174
    … …  
    4446    OnClick = cmdCancelClick
    4547  end
    46   object memReason: TMemo
     48  object memReason: TMemo [4]
    4749    Left = 8
    4850    Top = 80
    … …  
    5456    WantReturns = False
    5557  end
    56   object memOrder: TMemo
     58  object memOrder: TMemo [5]
    5759    Left = 8
    5860    Top = 8
    … …  
    6466    WantReturns = False
    6567  end
     68  inherited amgrMain: TVA508AccessibilityManager
     69    Data = (
     70      (
     71        'Component = txtComment'
     72        'Status = stsDefault')
     73      (
     74        'Component = cmdOK'
     75        'Status = stsDefault')
     76      (
     77        'Component = cmdCancel'
     78        'Status = stsDefault')
     79      (
     80        'Component = memReason'
     81        'Status = stsDefault')
     82      (
     83        'Component = memOrder'
     84        'Status = stsDefault')
     85      (
     86        'Component = frmUnflagOrder'
     87        'Status = stsDefault'))
     88  end
    6689end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 340
    33  Top = 165
    4   Width = 429
    5   Height = 440
    64  Caption = 'Custom Order View'
     5  ClientHeight = 413
     6  ClientWidth = 421
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitLeft = 340
     10  ExplicitTop = 165
     11  ExplicitWidth = 429
     12  ExplicitHeight = 440
    913  PixelsPerInch = 96
    1014  TextHeight = 13
    11   object pnlView: TPanel
     15  object pnlView: TPanel [0]
    1216    Left = 0
    1317    Top = 0
    … …  
    3236      Caption = 'All Services, Active Orders'
    3337      Layout = tlCenter
    34     end
    35   end
    36   object Panel1: TPanel
     38      ExplicitWidth = 153
     39      ExplicitHeight = 13
     40    end
     41  end
     42  object Panel1: TPanel [1]
    3743    Left = 0
    3844    Top = 21
    3945    Width = 421
    40     Height = 277
     46    Height = 278
    4147    Align = alClient
    4248    BevelOuter = bvNone
    … …  
    4551      Left = 211
    4652      Top = 0
    47       Width = 3
    48       Height = 277
    49       Cursor = crHSplit
     53      Height = 278
    5054      MinSize = 1
    5155      OnMoved = Splitter1Moved
    … …  
    5559      Top = 0
    5660      Width = 211
    57       Height = 277
     61      Height = 278
    5862      Align = alLeft
    5963      Constraints.MinWidth = 15
    … …  
    6872        Caption = 'Order Status'
    6973        Layout = tlCenter
     74        ExplicitWidth = 59
    7075      end
    7176      object trFilters: TCaptionTreeView
    … …  
    7378        Top = 14
    7479        Width = 209
    75         Height = 262
     80        Height = 263
    7681        Align = alClient
     82        HideSelection = False
    7783        Indent = 19
    7884        TabOrder = 0
    … …  
    8591      Top = 0
    8692      Width = 207
    87       Height = 277
     93      Height = 278
    8894      Align = alClient
    8995      Constraints.MinWidth = 15
    … …  
    98104        Caption = 'Service/Section'
    99105        Layout = tlCenter
     106        ExplicitWidth = 77
    100107      end
    101108      object treService: TCaptionTreeView
    … …  
    103110        Top = 14
    104111        Width = 205
    105         Height = 262
     112        Height = 263
    106113        Align = alClient
     114        HideSelection = False
    107115        Indent = 19
    108116        TabOrder = 0
    … …  
    112120    end
    113121  end
    114   object Panel4: TPanel
     122  object Panel4: TPanel [2]
    115123    Left = 0
    116     Top = 298
     124    Top = 299
    117125    Width = 421
    118126    Height = 114
    … …  
    224232    end
    225233  end
     234  inherited amgrMain: TVA508AccessibilityManager
     235    Data = (
     236      (
     237        'Component = pnlView'
     238        'Status = stsDefault')
     239      (
     240        'Component = Panel1'
     241        'Status = stsDefault')
     242      (
     243        'Component = Panel2'
     244        'Status = stsDefault')
     245      (
     246        'Component = trFilters'
     247        'Status = stsDefault')
     248      (
     249        'Component = Panel3'
     250        'Status = stsDefault')
     251      (
     252        'Component = treService'
     253        'Status = stsDefault')
     254      (
     255        'Component = Panel4'
     256        'Status = stsDefault')
     257      (
     258        'Component = chkDateRange'
     259        'Status = stsDefault')
     260      (
     261        'Component = GroupBox1'
     262        'Status = stsDefault')
     263      (
     264        'Component = calFrom'
     265        'Status = stsDefault')
     266      (
     267        'Component = calThru'
     268        'Status = stsDefault')
     269      (
     270        'Component = chkInvChrono'
     271        'Status = stsDefault')
     272      (
     273        'Component = chkByService'
     274        'Status = stsDefault')
     275      (
     276        'Component = cmdOK'
     277        'Status = stsDefault')
     278      (
     279        'Component = cmdCancel'
     280        'Status = stsDefault')
     281      (
     282        'Component = frmOrderView'
     283        'Status = stsDefault'))
     284  end
    226285end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm;
     7  fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    162163    Item[i].Expanded := True;
    163164    Item[i].Selected := True;
    164     FDGroupName := Item[i].Text;
     165    FFilter := Integer(Item[i].Data);
     166    FFilterName := Item[i].Text;
    165167    Break;
    166168  end;
    … …  
    303305    FFilter := Integer(Node.Data);
    304306    FFilterName := Node.Text;
     307    chkDateRange.Enabled := True;
    305308    if FFilter = 2 then                          // disallow date range for active orders view
    306309    begin
    … …  
    308311      chkDateRangeClick(Self);
    309312    end;
     313    if FFilter = 5 then                          // disallow date range for expiring orders view
     314    begin
     315      chkDateRange.Checked := False;
     316      chkDateRangeClick(Self);
     317      chkDateRange.Enabled := False;
     318    end;
    310319    if FFilter in [8, 9, 10, 20] then chkDateRange.Checked := True else
    311320    begin

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

    r456 r829  
    11inherited frmOrders: TfrmOrders
    22  Left = 451
    3   Top = 250
    4   Width = 774
    5   Height = 579
     3  Top = 177
    64  HelpContext = 4000
    75  Caption = 'Orders Page'
     6  ClientHeight = 571
     7  ClientWidth = 766
    88  HelpFile = 'overvw'
    99  Menu = mnuOrders
    1010  OnDestroy = FormDestroy
    1111  OnShow = FormShow
     12  ExplicitWidth = 774
     13  ExplicitHeight = 617
    1214  PixelsPerInch = 96
    1315  TextHeight = 13
    1416  inherited shpPageBottom: TShape
    15     Top = 528
     17    Top = 566
    1618    Width = 766
     19    ExplicitTop = 528
     20    ExplicitWidth = 766
    1721  end
    1822  inherited sptHorz: TSplitter
    1923    Left = 117
    20     Height = 528
     24    Height = 566
    2125    OnMoved = sptHorzMoved
     26    ExplicitLeft = 117
     27    ExplicitHeight = 528
    2228  end
    2329  inherited pnlLeft: TPanel
    2430    Width = 117
    25     Height = 528
     31    Height = 566
     32    ExplicitWidth = 117
     33    ExplicitHeight = 566
    2634    object OROffsetLabel1: TOROffsetLabel
    2735      Left = 0
    … …  
    7785      Top = 116
    7886      Width = 117
    79       Height = 412
     87      Height = 450
    8088      Align = alClient
    8189      ItemHeight = 13
    … …  
    94102      Width = 117
    95103      Height = 18
     104      Align = alTop
    96105      Caption = 'Write Delayed Orders'
    97106      TabOrder = 1
    98107      OnClick = btnDelayedOrderClick
    99       Align = alTop
    100108      Alignment = taLeftJustify
    101109    end
    … …  
    104112    Left = 121
    105113    Width = 645
    106     Height = 528
     114    Height = 566
    107115    ParentColor = True
    108116    ParentCtl3D = False
    109117    ParentFont = False
    110118    OnResize = pnlRightResize
     119    ExplicitLeft = 121
     120    ExplicitWidth = 645
     121    ExplicitHeight = 566
    111122    object lblOrders: TOROffsetLabel
    112123      Left = 0
    … …  
    147158      Width = 645
    148159      Height = 17
    149       DragReorder = False
    150160      Sections = <
    151161        item
    … …  
    216226      Top = 36
    217227      Width = 645
    218       Height = 492
     228      Height = 530
    219229      Style = lbOwnerDrawVariable
    220230      Align = alClient
    … …  
    229239      OnDrawItem = lstOrdersDrawItem
    230240      OnMeasureItem = lstOrdersMeasureItem
    231       RightClickSelect = True
    232241      Caption = 'Active Orders'
    233242    end
     243  end
     244  inherited amgrMain: TVA508AccessibilityManager
     245    Data = (
     246      (
     247        'Component = lstSheets'
     248        'Status = stsDefault')
     249      (
     250        'Component = lstWrite'
     251        'Status = stsDefault')
     252      (
     253        'Component = btnDelayedOrder'
     254        'Status = stsDefault')
     255      (
     256        'Component = hdrOrders'
     257        'Status = stsDefault')
     258      (
     259        'Component = lstOrders'
     260        'Status = stsDefault')
     261      (
     262        'Component = pnlLeft'
     263        'Status = stsDefault')
     264      (
     265        'Component = pnlRight'
     266        'Status = stsDefault')
     267      (
     268        'Component = frmOrders'
     269        'Status = stsDefault'))
    234270  end
    235271  object mnuOrders: TMainMenu

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

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

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

    r456 r829  
    22  Left = 374
    33  Top = 193
    4   Height = 278
    54  Caption = 'Alert when Results Available'
     5  ClientHeight = 251
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 278
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 8
    … …  
    1719      ' -'
    1820  end
    19   object lblAlertRecipient: TLabel
     21  object lblAlertRecipient: TLabel [1]
    2022    Left = 8
    2123    Top = 208
    … …  
    2426    Caption = 'Alert Recipient:'
    2527  end
    26   object lstOrders: TCaptionListBox
     28  object lstOrders: TCaptionListBox [2]
    2729    Left = 8
    2830    Top = 22
    … …  
    3537      ' -'
    3638  end
    37   object cmdOK: TButton
     39  object cmdOK: TButton [3]
    3840    Left = 267
    3941    Top = 222
    … …  
    4547    OnClick = cmdOKClick
    4648  end
    47   object cmdCancel: TButton
     49  object cmdCancel: TButton [4]
    4850    Left = 347
    4951    Top = 222
    … …  
    5557    OnClick = cmdCancelClick
    5658  end
    57   object cboAlertRecipient: TORComboBox
     59  object cboAlertRecipient: TORComboBox [5]
    5860    Left = 7
    5961    Top = 226
    … …  
    7981    OnExit = cboOnExit
    8082    OnNeedData = cboAlertRecipientNeedData
     83    CharsNeedMatch = 1
     84  end
     85  inherited amgrMain: TVA508AccessibilityManager
     86    Data = (
     87      (
     88        'Component = lstOrders'
     89        'Status = stsDefault')
     90      (
     91        'Component = cmdOK'
     92        'Status = stsDefault')
     93      (
     94        'Component = cmdCancel'
     95        'Status = stsDefault')
     96      (
     97        'Component = cboAlertRecipient'
     98        'Status = stsDefault')
     99      (
     100        'Component = frmAlertOrders'
     101        'Status = stsDefault'))
    81102  end
    82103end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    1 object frmChgEvent: TfrmChgEvent
     1inherited frmChgEvent: TfrmChgEvent
    22  Left = 256
    33  Top = 148
    4   Width = 562
    5   Height = 428
    64  Caption = 'Change Release Event'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 401
     6  ClientWidth = 554
    137  OldCreateOrder = False
    148  OnClose = FormClose
    159  OnCreate = FormCreate
     10  ExplicitWidth = 562
     11  ExplicitHeight = 428
    1612  PixelsPerInch = 96
    1713  TextHeight = 13
    18   object pnlTop: TPanel
     14  object pnlTop: TPanel [0]
    1915    Left = 0
    2016    Top = 0
    … …  
    2723      Left = 1
    2824      Top = 1
    29       Width = 552
     25      Width = 3
    3026      Height = 36
    3127      Align = alTop
    … …  
    3632    end
    3733  end
    38   object pnlBottom: TPanel
     34  object pnlBottom: TPanel [1]
    3935    Left = 0
    4036    Top = 38
    4137    Width = 554
    42     Height = 362
     38    Height = 363
    4339    Align = alClient
    4440    TabOrder = 1
     41    ExplicitHeight = 362
    4542    DesignSize = (
    4643      554
    47       362)
     44      363)
    4845    object cboSpecialty: TORComboBox
    4946      Left = 12
    … …  
    6966      OnChange = cboSpecialtyChange
    7067      OnDblClick = cboSpecialtyDblClick
     68      CharsNeedMatch = 1
    7169    end
    7270    object btnCancel: TButton
    … …  
    9290    end
    9391  end
     92  inherited amgrMain: TVA508AccessibilityManager
     93    Data = (
     94      (
     95        'Component = pnlTop'
     96        'Status = stsDefault')
     97      (
     98        'Component = pnlBottom'
     99        'Status = stsDefault')
     100      (
     101        'Component = cboSpecialty'
     102        'Status = stsDefault')
     103      (
     104        'Component = btnCancel'
     105        'Status = stsDefault')
     106      (
     107        'Component = btnAction'
     108        'Status = stsDefault')
     109      (
     110        'Component = frmChgEvent'
     111        'Status = stsDefault'))
     112  end
    94113end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders;
     7  StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    22  Left = 327
    33  Top = 169
    4   Height = 284
    54  Caption = 'Complete Orders'
     5  ClientHeight = 257
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 284
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 8
    … …  
    1517    Caption = 'The following orders will be marked as complete -'
    1618  end
    17   object lblESCode: TLabel
     19  object lblESCode: TLabel [1]
    1820    Left = 8
    1921    Top = 214
    … …  
    2224    Caption = 'Electronic Signature Code'
    2325  end
    24   object lstOrders: TCaptionListBox
     26  object lstOrders: TCaptionListBox [2]
    2527    Left = 8
    2628    Top = 22
    … …  
    3133    Caption = 'The following orders will be marked as complete -'
    3234  end
    33   object cmdOK: TButton
     35  object cmdOK: TButton [3]
    3436    Left = 267
    3537    Top = 228
    … …  
    4143    OnClick = cmdOKClick
    4244  end
    43   object cmdCancel: TButton
     45  object cmdCancel: TButton [4]
    4446    Left = 347
    4547    Top = 228
    … …  
    5153    OnClick = cmdCancelClick
    5254  end
    53   object txtESCode: TCaptionEdit
     55  object txtESCode: TCaptionEdit [5]
    5456    Left = 8
    5557    Top = 228
    … …  
    6062    Caption = 'Electronic Signature Code'
    6163  end
     64  inherited amgrMain: TVA508AccessibilityManager
     65    Data = (
     66      (
     67        'Component = lstOrders'
     68        'Status = stsDefault')
     69      (
     70        'Component = cmdOK'
     71        'Status = stsDefault')
     72      (
     73        'Component = cmdCancel'
     74        'Status = stsDefault')
     75      (
     76        'Component = txtESCode'
     77        'Status = stsDefault')
     78      (
     79        'Component = frmCompleteOrders'
     80        'Status = stsDefault'))
     81  end
    6282end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    1 object frmCopyOrders: TfrmCopyOrders
     1inherited frmCopyOrders: TfrmCopyOrders
    22  Left = 319
    33  Top = 139
    4   AutoScroll = False
    54  Caption = 'Copy Orders'
    65  ClientHeight = 419
    76  ClientWidth = 441
    8   Color = clBtnFace
    97  Constraints.MinHeight = 100
    108  Constraints.MinWidth = 330
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    169  OldCreateOrder = True
    1710  OnCreate = FormCreate
    18   OnKeyDown = FormKeyDown
     11  ExplicitWidth = 449
     12  ExplicitHeight = 446
    1913  PixelsPerInch = 96
    2014  TextHeight = 13
    21   object pnlInfo: TPanel
     15  object pnlRadio: TPanel [0]
    2216    Left = 0
    23     Top = 41
     17    Top = 80
    2418    Width = 441
    25     Height = 50
     19    Height = 65
    2620    Align = alTop
    2721    TabOrder = 1
    28     object Image1: TImage
    29       Left = 1
    30       Top = 1
    31       Width = 24
    32       Height = 22
    33       AutoSize = True
    34       Enabled = False
    35       Picture.Data = {
    36         07544269746D61707E010000424D7E0100000000000076000000280000001800
    37         000016000000010004000000000008010000C40E0000C40E0000100000000000
    38         0000000000000000800000800000008080008000000080008000808000008080
    39         8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
    40         FF008000000000000000000000080777777777777777777777700F7777777777
    41         7777777777700F88888888888888888887700F88888888888888888887700F88
    42         888808888888888887700F88888800888888888887700F8888880B0888888888
    43         87700F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC
    44         CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F88
    45         0BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB088
    46         87700F888800BBBBBBB0088887700F88888800000008888887700F8888888888
    47         8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF708000
    48         00000000000000000008}
    49       Transparent = True
    50     end
    51     object Label2: TStaticText
    52       Left = 31
    53       Top = 30
    54       Width = 365
    55       Height = 17
    56       Caption =
    57         'Use Transfer: if inpatient will move from one ward or treating t' +
    58         'eam to another.'
    59       TabOrder = 1
    60       TabStop = True
    61     end
    62     object Label1: TStaticText
    63       Left = 31
    64       Top = 4
    65       Width = 331
    66       Height = 17
    67       Caption =
    68         'Use Admit: if patient is newly admitted to the hospital or nursi' +
    69         'ng home.'
    70       TabOrder = 0
    71       TabStop = True
    72     end
    73   end
    74   inline fraEvntDelayList: TfraEvntDelayList
    75     Left = 0
    76     Top = 154
    77     Width = 441
    78     Height = 265
    79     Align = alClient
    80     TabOrder = 3
    81     Visible = False
    82     inherited pnlDate: TPanel
    83       Left = 336
    84       Height = 265
    85       inherited lblEffective: TLabel
    86         Left = 451
    87       end
    88       inherited orDateBox: TORDateBox
    89         Left = 451
    90       end
    91     end
    92     inherited pnlList: TPanel
    93       Width = 336
    94       Height = 265
    95       inherited lblEvntDelayList: TLabel
    96         Width = 334
    97       end
    98       inherited mlstEvents: TORListBox
    99         Width = 334
    100         Height = 229
    101         OnDblClick = cmdOKClick
    102         OnChange = fraEvntDelayListmlstEventsChange
    103       end
    104       inherited edtSearch: TCaptionEdit
    105         Width = 334
    106       end
    107     end
    108   end
    109   object pnlRadio: TPanel
    110     Left = 0
    111     Top = 91
    112     Width = 441
    113     Height = 63
    114     Align = alTop
    115     TabOrder = 2
    11622    object GroupBox1: TGroupBox
    11723      Left = 1
    11824      Top = 1
    11925      Width = 439
    120       Height = 61
     26      Height = 63
    12127      Align = alClient
    12228      Constraints.MinHeight = 50
    … …  
    14349        OnClick = radEvtDelayClick
    14450      end
    145     end
    146   end
    147   object pnlTop: TPanel
     51      object cmdOK: TButton
     52        Left = 345
     53        Top = 14
     54        Width = 72
     55        Height = 19
     56        Caption = 'OK'
     57        Constraints.MaxWidth = 73
     58        Default = True
     59        TabOrder = 2
     60        OnClick = cmdOKClick
     61      end
     62      object cmdCancel: TButton
     63        Left = 345
     64        Top = 38
     65        Width = 72
     66        Height = 18
     67        Cancel = True
     68        Caption = 'Cancel'
     69        Constraints.MaxWidth = 73
     70        TabOrder = 3
     71        OnClick = cmdCancelClick
     72      end
     73    end
     74  end
     75  object pnlTop: TPanel [1]
    14876    Left = 0
    14977    Top = 0
    15078    Width = 441
    151     Height = 41
     79    Height = 80
    15280    Align = alTop
    15381    BevelOuter = bvNone
    15482    TabOrder = 0
    155     object lblPtInfo: TStaticText
     83    object lblPtInfo: TVA508StaticText
     84      Name = 'lblPtInfo'
    15685      Left = 0
    157       Top = 0
     86      Top = 5
     87      Width = 400
     88      Height = 35
     89      Alignment = taLeftJustify
     90      AutoSize = True
     91      Caption = ' '
     92      Constraints.MinHeight = 15
     93      TabOrder = 0
     94      ShowAccelChar = True
     95    end
     96    object pnlInfo: TPanel
     97      Left = 0
     98      Top = 46
    15899      Width = 441
    159       Height = 41
    160       Align = alTop
    161       Anchors = [akLeft, akTop, akRight, akBottom]
    162       AutoSize = False
    163       Constraints.MinHeight = 40
     100      Height = 34
     101      Align = alBottom
     102      TabOrder = 1
     103      object Image1: TImage
     104        Left = 1
     105        Top = 1
     106        Width = 24
     107        Height = 22
     108        AutoSize = True
     109        Enabled = False
     110        Picture.Data = {
     111          07544269746D61707E010000424D7E0100000000000076000000280000001800
     112          000016000000010004000000000008010000C40E0000C40E0000100000000000
     113          0000000000000000800000800000008080008000000080008000808000008080
     114          8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
     115          FF008000000000000000000000080777777777777777777777700F7777777777
     116          7777777777700F88888888888888888887700F88888888888888888887700F88
     117          888808888888888887700F88888800888888888887700F8888880B0888888888
     118          87700F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC
     119          CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F88
     120          0BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB088
     121          87700F888800BBBBBBB0088887700F88888800000008888887700F8888888888
     122          8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF708000
     123          00000000000000000008}
     124        Transparent = True
     125      end
     126      object lblInstruction2: TVA508StaticText
     127        Name = 'lblInstruction2'
     128        Left = 31
     129        Top = 17
     130        Width = 363
     131        Height = 15
     132        Alignment = taLeftJustify
     133        Caption =
     134          'Use Transfer: if inpatient will move from one ward or treating t' +
     135          'eam to another.'
     136        TabOrder = 1
     137        ShowAccelChar = True
     138      end
     139      object lblInstruction: TVA508StaticText
     140        Name = 'lblInstruction'
     141        Left = 31
     142        Top = 1
     143        Width = 329
     144        Height = 15
     145        Alignment = taLeftJustify
     146        Caption =
     147          'Use Admit: if patient is newly admitted to the hospital or nursi' +
     148          'ng home.'
     149        TabOrder = 0
     150        ShowAccelChar = True
     151      end
     152    end
     153  end
     154  object pnlBottom: TPanel [2]
     155    Left = 0
     156    Top = 145
     157    Width = 441
     158    Height = 274
     159    Align = alClient
     160    TabOrder = 2
     161    ExplicitLeft = 8
     162    ExplicitTop = 165
     163    ExplicitWidth = 425
     164    ExplicitHeight = 236
     165    inline fraEvntDelayList: TfraEvntDelayList
     166      Left = 1
     167      Top = 1
     168      Width = 439
     169      Height = 272
     170      Align = alBottom
     171      AutoScroll = True
    164172      TabOrder = 0
    165173      TabStop = True
    166     end
    167   end
    168   object pnlBtns: TPanel
    169     Left = 334
    170     Top = 91
    171     Width = 107
    172     Height = 63
    173     Align = alCustom
    174     Anchors = [akTop, akRight]
    175     TabOrder = 4
    176     object gbBtns: TGroupBox
    177       Left = 1
    178       Top = 1
    179       Width = 105
    180       Height = 61
    181       Align = alClient
    182       TabOrder = 0
    183       DesignSize = (
    184         105
    185         61)
    186       object cmdOK: TButton
    187         Left = 17
    188         Top = 13
    189         Width = 72
    190         Height = 19
    191         Anchors = [akTop, akRight]
    192         Caption = 'OK'
    193         Constraints.MaxWidth = 73
    194         Default = True
    195         TabOrder = 0
    196         OnClick = cmdOKClick
    197       end
    198       object cmdCancel: TButton
    199         Left = 17
    200         Top = 34
    201         Width = 72
    202         Height = 18
    203         Anchors = [akRight, akBottom]
    204         Cancel = True
    205         Caption = 'Cancel'
    206         Constraints.MaxWidth = 73
    207         TabOrder = 1
    208         OnClick = cmdCancelClick
    209       end
    210     end
     174      Visible = False
     175      ExplicitTop = 145
     176      ExplicitWidth = 441
     177      ExplicitHeight = 274
     178      inherited pnlDate: TPanel
     179        Left = 334
     180        Height = 272
     181        ExplicitLeft = 336
     182        ExplicitHeight = 274
     183        inherited lblEffective: TLabel
     184          Left = 451
     185          Width = 71
     186          ExplicitLeft = 451
     187          ExplicitWidth = 71
     188        end
     189        inherited orDateBox: TORDateBox
     190          Left = 451
     191          ExplicitLeft = 451
     192        end
     193      end
     194      inherited pnlList: TPanel
     195        Width = 334
     196        Height = 272
     197        ExplicitWidth = 336
     198        ExplicitHeight = 274
     199        inherited lblEvntDelayList: TLabel
     200          Width = 332
     201          ExplicitWidth = 80
     202        end
     203        inherited mlstEvents: TORListBox
     204          Width = 332
     205          Height = 236
     206          OnDblClick = cmdOKClick
     207          OnChange = fraEvntDelayListmlstEventsChange
     208          ExplicitWidth = 334
     209          ExplicitHeight = 238
     210        end
     211        inherited edtSearch: TCaptionEdit
     212          Width = 332
     213          ExplicitWidth = 334
     214        end
     215      end
     216    end
     217  end
     218  inherited amgrMain: TVA508AccessibilityManager
     219    Data = (
     220      (
     221        'Component = pnlInfo'
     222        'Status = stsDefault')
     223      (
     224        'Component = lblInstruction2'
     225        'Status = stsDefault')
     226      (
     227        'Component = lblInstruction'
     228        'Status = stsDefault')
     229      (
     230        'Component = fraEvntDelayList'
     231        'Status = stsDefault')
     232      (
     233        'Component = fraEvntDelayList.pnlDate'
     234        'Status = stsDefault')
     235      (
     236        'Component = fraEvntDelayList.orDateBox'
     237        'Status = stsDefault')
     238      (
     239        'Component = fraEvntDelayList.pnlList'
     240        'Status = stsDefault')
     241      (
     242        'Component = fraEvntDelayList.mlstEvents'
     243        'Status = stsDefault')
     244      (
     245        'Component = fraEvntDelayList.edtSearch'
     246        'Status = stsDefault')
     247      (
     248        'Component = pnlRadio'
     249        'Status = stsDefault')
     250      (
     251        'Component = GroupBox1'
     252        'Status = stsDefault')
     253      (
     254        'Component = radRelease'
     255        'Status = stsDefault')
     256      (
     257        'Component = radEvtDelay'
     258        'Status = stsDefault')
     259      (
     260        'Component = pnlTop'
     261        'Status = stsDefault')
     262      (
     263        'Component = lblPtInfo'
     264        'Status = stsDefault')
     265      (
     266        'Component = frmCopyOrders'
     267        'Status = stsDefault')
     268      (
     269        'Component = cmdOK'
     270        'Status = stsDefault')
     271      (
     272        'Component = cmdCancel'
     273        'Status = stsDefault')
     274      (
     275        'Component = pnlBottom'
     276        'Status = stsDefault'))
    211277  end
    212278end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz;
     7  StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmCopyOrders = class(TForm)
     11  TfrmCopyOrders = class(TfrmBase508Form)
    1112    pnlInfo: TPanel;
    1213    fraEvntDelayList: TfraEvntDelayList;
    … …  
    1617    radEvtDelay: TRadioButton;
    1718    Image1: TImage;
    18     Label2: TStaticText;
    19     Label1: TStaticText;
     19    lblInstruction2: TVA508StaticText;
     20    lblInstruction: TVA508StaticText;
    2021    pnlTop: TPanel;
    21     lblPtInfo: TStaticText;
    22     pnlBtns: TPanel;
    23     gbBtns: TGroupBox;
     22    lblPtInfo: TVA508StaticText;
    2423    cmdOK: TButton;
    2524    cmdCancel: TButton;
     25    pnlBottom: TPanel;
    2626    procedure cmdOKClick(Sender: TObject);
    2727    procedure cmdCancelClick(Sender: TObject);
    … …  
    3737  private
    3838    OKPressed: Boolean;
     39    procedure AdjustFormSize;
    3940  public
    4041  end;
    … …  
    116117  frmCopyOrders := TfrmCopyOrders.Create(Application);
    117118  try
    118     ResizeFormToFont(TForm(frmCopyOrders));
     119    ResizeAnchoredFormToFont(TForm(frmCopyOrders));
     120    frmCopyOrders.AdjustFormSize;
    119121    CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
    120122    if Length(CurrTS)>0 then
    … …  
    132134        frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.'  + SpeCap;
    133135    end;
     136    frmCopyOrders.AdjustFormSize;
    134137    frmCopyOrders.ShowModal;
    135138    if (frmCopyOrders.OKPressed) and (frmCopyOrders.radRelease.Checked) then
    … …  
    234237  begin
    235238    pnlInfo.Visible := False;
    236     pnlBtns.Top := pnlRadio.Top;
    237   end;
    238   if not radEvtDelay.Checked then
    239   begin
    240     if not pnlInfo.Visible then
    241       Height := Height - fraEvntDelayList.Height - pnlInfo.Height
    242     else
    243           Height := Height - fraEvntDelayList.Height;   
    244   end;
     239  end;
     240  AdjustFormSize;
    245241end;
    246242
    … …  
    263259end;
    264260
     261procedure TfrmCopyOrders.AdjustFormSize;
     262var
     263  y: integer;
     264begin
     265  y := lblPtInfo.Height + 8; // allow for font changes
     266  if pnlInfo.Visible then
     267  begin
     268    lblInstruction2.top := lblInstruction.Height; // allow for font change
     269    pnlInfo.Height := lblInstruction2.top + lblInstruction2.Height;
     270    inc(y,pnlInfo.Height);
     271  end;
     272  pnlTop.Height := y;
     273  inc(y, pnlRadio.Height);
     274  if fraEvntDelayList.Visible then
     275  begin
     276    inc(y, fraEvntDelayList.Height);
     277  end;
     278  VertScrollBar.Range := y;
     279  ClientHeight := y;
     280end;
     281
    265282procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject);
    266283begin
    … …  
    275292    radRelease.Checked  := False;
    276293  radEvtDelay.Checked := True;
    277   Height := Height + fraEvntDelayList.Height;
    278294  fraEvntDelayList.Visible := True;
    279295  frmCopyOrders.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
    280296  fraEvntDelayList.DisplayEvntDelayList;
     297  AdjustFormSize;
    281298end;
    282299
    … …  
    288305  radRelease.Checked  := True;
    289306  fraEvntDelayList.Visible := False;
    290   Height := Height - fraEvntDelayList.Height;
     307  AdjustFormSize;
    291308end;
    292309
    … …  
    327344  Shift: TShiftState);
    328345begin
     346  inherited;
    329347  if Key = VK_RETURN then
    330348    cmdOKClick(Self);

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

    r456 r829  
    22  Left = 316
    33  Top = 226
    4   Width = 433
    5   Height = 316
    64  Caption = 'Discontinue / Cancel Orders'
     5  ClientHeight = 289
     6  ClientWidth = 425
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitLeft = 316
     10  ExplicitTop = 226
     11  ExplicitWidth = 433
     12  ExplicitHeight = 323
    913  PixelsPerInch = 96
    1014  TextHeight = 13
    11   object Label1: TLabel
     15  object Label1: TLabel [0]
    1216    Left = 0
    1317    Top = 0
    … …  
    1721    Caption = 'The following orders will be discontinued -'
    1822    WordWrap = True
     23    ExplicitWidth = 196
    1924  end
    20   object Panel1: TPanel
     25  object Panel1: TPanel [1]
    2126    Left = 0
    2227    Top = 13
    … …  
    3944    end
    4045  end
    41   object Panel2: TPanel
     46  object Panel2: TPanel [2]
    4247    Left = 0
    4348    Top = 201
    … …  
    4550    Height = 88
    4651    Align = alBottom
     52    Constraints.MinHeight = 88
    4753    TabOrder = 1
    4854    DesignSize = (
    … …  
    5662      Align = alTop
    5763      Caption = 'Reason for Discontinue (select one)'
     64      ExplicitWidth = 169
    5865    end
    5966    object lstReason: TORListBox
    … …  
    6572      ParentShowHint = False
    6673      ShowHint = True
    67       Sorted = True
    6874      TabOrder = 0
    6975      Caption = 'Reason for Discontinue (select one)'
    … …  
    7783      Width = 72
    7884      Height = 21
    79       Anchors = [akLeft, akBottom]
     85      Anchors = [akRight, akBottom]
    8086      Caption = 'OK'
    8187      Default = True
    … …  
    95101    end
    96102  end
     103  inherited amgrMain: TVA508AccessibilityManager
     104    Data = (
     105      (
     106        'Component = Panel1'
     107        'Status = stsDefault')
     108      (
     109        'Component = lstOrders'
     110        'Status = stsDefault')
     111      (
     112        'Component = Panel2'
     113        'Status = stsDefault')
     114      (
     115        'Component = lstReason'
     116        'Status = stsDefault')
     117      (
     118        'Component = cmdOK'
     119        'Status = stsDefault')
     120      (
     121        'Component = cmdCancel'
     122        'Status = stsDefault')
     123      (
     124        'Component = frmDCOrders'
     125        'Status = stsDefault'))
     126  end
    97127end

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

    r456 r829  
    44
    55uses
    6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
     6  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fBase508Form,
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, ORNet, VA508AccessibilityManager;
    88
    99type
    10   TfrmDCOrders = class(TfrmAutoSz)
     10  TfrmDCOrders = class(TfrmBase508Form)
    1111    Label1: TLabel;
    1212    Panel1: TPanel;
    … …  
    2424    procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
    2525      var AHeight: Integer);
     26    procedure FormDestroy(Sender: TObject);
     27    procedure unMarkedOrignalOrderDC(OrderArr: TStringList);
    2628  private
    2729    OKPressed: Boolean;
    2830    DCReason: Integer;
    29     function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;   
     31    function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
     32  public
     33    OrderIDArr: TStringList;
    3034  end;
    3135
    … …  
    4650  frmDCOrders: TfrmDCOrders;
    4751  AnOrder: TOrder;
    48   i,CanSign, DCType: Integer;
    49   NeedReason,NeedRefresh,OnCurrent: Boolean;
     52  i, j, CanSign, DCType: Integer;
     53  NeedReason,NeedRefresh,OnCurrent, DCNewOrder: Boolean;
    5054  OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt:  string;
    5155  PtEvtList: TStringList;
     56  DCChangeItem: TChangeItem;
    5257begin
    5358  Result := False;
    … …  
    5560  OnCurrent := False;
    5661  NeedRefresh := False;
     62  DCNewOrder := false;
    5763  PtEvtList := TStringList.Create;
    5864  if SelectedList.Count = 0 then Exit;
    … …  
    6571      AnOrder    := TOrder(Items[i]);
    6672      frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
     73      frmDCOrders.OrderIDArr.Add(AnOrder.ID);
    6774      if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
     75      if (NeedReason = True) and (AnOrder.Status = 10) and (AnOrder.Signature = 2) then  NeedReason := False;
     76     
    6877    end;
    6978    if NeedReason then
    … …  
    8796        OriginalID := AnOrder.ID;
    8897        PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
    89         DCOrder(AnOrder, frmDCOrders.DCReason, DCType);
     98        if Changes.Orders.Count = 0 then DCNewOrder := false
     99        else
     100          begin
     101            for j := 0 to Changes.Orders.Count - 1 do
     102              begin
     103                DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
     104                if DCChangeItem.ID = AnOrder.ID then
     105                  begin
     106                    if (Pos('DC', AnOrder.ActionOn) = 0) then
     107                       DCNewOrder := True
     108                    else DCNewOrder := False;
     109                  end;
     110              end;
     111          end;
     112        DCOrder(AnOrder, frmDCOrders.DCReason, DCNewOrder, DCType);
    90113        case DCType of
    91114        DCT_NEWORDER:  begin
    92                          Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID);
     115                         Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID, user.DUZ, AnOrder.DGroupName, True);
    93116                         AnOrder.ActionOn := OriginalID + '=DC';
    94117                       end;
    … …  
    150173  inherited;
    151174  OKPressed := False;
     175  OrderIDArr := TStringList.Create;
    152176  ListDCReasons(lstReason.Items, DefaultIEN);
    153177  lstReason.SelectByIEN(DefaultIEN);
    … …  
    179203begin
    180204  inherited;
     205  unMarkedOrignalOrderDC(Self.OrderIDArr);
    181206  Close;
    182207end;
    … …  
    194219  begin
    195220    Canvas.FillRect(ARect);
    196     Canvas.Pen.Color := clSilver;
     221    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    197222    Canvas.MoveTo(0, ARect.Bottom - 1);
    198223    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
    … …  
    230255end;
    231256
     257procedure TfrmDCOrders.FormDestroy(Sender: TObject);
     258begin
     259  inherited;
     260  if self.OrderIDArr <> nil then self.OrderIDArr.Free;
     261end;
     262
     263procedure TfrmDCOrders.unMarkedOrignalOrderDC(OrderArr: TStringList);
     264begin
     265 CallV('ORWDX1 UNDCORIG', [OrderArr]);
     266end;
     267
    232268end.

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

    r456 r829  
    1 object frmOrdersEvntRelease: TfrmOrdersEvntRelease
     1inherited frmOrdersEvntRelease: TfrmOrdersEvntRelease
    22  Left = 196
    33  Top = 66
    4   Width = 451
    5   Height = 355
    64  Caption = 'Auto DC/Release Event Orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 328
     6  ClientWidth = 443
    137  OldCreateOrder = False
    148  OnClose = FormClose
    159  OnCreate = FormCreate
    16   OnDestroy = FormDestroy
    1710  OnShow = FormShow
     11  ExplicitWidth = 451
     12  ExplicitHeight = 355
    1813  PixelsPerInch = 96
    1914  TextHeight = 13
    20   object pnlTop: TPanel
     15  object pnlTop: TPanel [0]
    2116    Left = 0
    2217    Top = 0
    … …  
    7368          Position = 5
    7469          TabOrder = 1
    75           Wrap = False
    7670          OnClick = updown1Click
    7771        end
    … …  
    10094          Left = 1
    10195          Top = 1
    102           Width = 290
     96          Width = 244
    10397          Height = 13
    10498          Align = alTop
    … …  
    109103          Left = 1
    110104          Top = 14
    111           Width = 290
     105          Width = 156
    112106          Height = 13
    113107          Align = alTop
    … …  
    117111    end
    118112  end
    119   object pnlBottom: TPanel
     113  object pnlBottom: TPanel [1]
    120114    Left = 0
    121115    Top = 85
    … …  
    184178    end
    185179  end
     180  inherited amgrMain: TVA508AccessibilityManager
     181    Data = (
     182      (
     183        'Component = pnlTop'
     184        'Status = stsDefault')
     185      (
     186        'Component = lblPtInfo'
     187        'Status = stsDefault')
     188      (
     189        'Component = Panel1'
     190        'Status = stsDefault')
     191      (
     192        'Component = Panel2'
     193        'Status = stsDefault')
     194      (
     195        'Component = btnApply'
     196        'Status = stsDefault')
     197      (
     198        'Component = updown1'
     199        'Status = stsDefault')
     200      (
     201        'Component = edtNumber'
     202        'Status = stsDefault')
     203      (
     204        'Component = Panel3'
     205        'Status = stsDefault')
     206      (
     207        'Component = pnlBottom'
     208        'Status = stsDefault')
     209      (
     210        'Component = btnOK'
     211        'Status = stsDefault')
     212      (
     213        'Component = btnCancel'
     214        'Status = stsDefault')
     215      (
     216        'Component = grdEvtList'
     217        'Status = stsDefault')
     218      (
     219        'Component = frmOrdersEvntRelease'
     220        'Status = stsDefault'))
     221  end
    186222end

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
    77  ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz,
    8   Spin, ComCtrls;
     8  Spin, ComCtrls, VA508AccessibilityManager;
    99
    1010type
    … …  
    4545    procedure updown1Click(Sender: TObject; Button: TUDBtnType);
    4646    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    47     procedure FormDestroy(Sender: TObject);
    4847  private
    4948    { Private declarations }
    … …  
    6564implementation
    6665
    67 uses rMisc, Accessibility_TLB, uAccessibleStringGrid;
     66uses rMisc, VAUtils;
    6867
    6968{$R *.DFM}
    … …  
    148147  grdEvtList.Cells[1,0] := 'Date/Time Occured';
    149148  SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal);
    150   TAccessibleStringGrid.WrapControl(grdEvtList);
    151149end;
    152150
    … …  
    200198  if grdEvtList.Row < 1 then
    201199  begin
    202     ShowMessage('You need to select an event first.');
     200    ShowMsg('You need to select an event first.');
    203201    FOkPressed := False;
    204202    Exit;
    … …  
    363361end;
    364362
    365 procedure TfrmOrdersEvntRelease.FormDestroy(Sender: TObject);
    366 begin
    367   TAccessibleStringGrid.UnwrapControl(grdEvtList);
    368   inherited;
    369 end;
    370 
    371363end.

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

    r456 r829  
    22  Left = 386
    33  Top = 413
    4   Height = 270
    54  Caption = 'Hold Orders'
     5  ClientHeight = 243
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 270
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 8
    … …  
    1517    Caption = 'The following orders will be placed on hold -'
    1618  end
    17   object lstOrders: TCaptionListBox
     19  object lstOrders: TCaptionListBox [1]
    1820    Left = 8
    1921    Top = 22
    … …  
    2426    Caption = 'The following orders will be placed on hold -'
    2527  end
    26   object cmdOK: TButton
     28  object cmdOK: TButton [2]
    2729    Left = 267
    2830    Top = 214
    … …  
    3436    OnClick = cmdOKClick
    3537  end
    36   object cmdCancel: TButton
     38  object cmdCancel: TButton [3]
    3739    Left = 347
    3840    Top = 214
    … …  
    4446    OnClick = cmdCancelClick
    4547  end
     48  inherited amgrMain: TVA508AccessibilityManager
     49    Data = (
     50      (
     51        'Component = lstOrders'
     52        'Status = stsDefault')
     53      (
     54        'Component = cmdOK'
     55        'Status = stsDefault')
     56      (
     57        'Component = cmdCancel'
     58        'Status = stsDefault')
     59      (
     60        'Component = frmHoldOrders'
     61        'Status = stsDefault'))
     62  end
    4663end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 292
    33  Top = 149
    4   Width = 470
    5   Height = 368
    64  Caption = 'Signature on Chart'
     5  ClientHeight = 341
     6  ClientWidth = 462
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitWidth = 470
     10  ExplicitHeight = 368
    911  PixelsPerInch = 96
    1012  TextHeight = 13
    11   object Panel2: TPanel
     13  object Panel2: TPanel [0]
    1214    Left = 0
    1315    Top = 0
    … …  
    2830        'ed -'
    2931      Layout = tlBottom
     32      ExplicitWidth = 318
    3033    end
    3134    object lstOrders: TCaptionListBox
    … …  
    4750    end
    4851  end
    49   object Panel1: TPanel
     52  object Panel1: TPanel [1]
    5053    Left = 0
    5154    Top = 305
    … …  
    8083    end
    8184  end
     85  inherited amgrMain: TVA508AccessibilityManager
     86    Data = (
     87      (
     88        'Component = Panel2'
     89        'Status = stsDefault')
     90      (
     91        'Component = lstOrders'
     92        'Status = stsDefault')
     93      (
     94        'Component = Panel1'
     95        'Status = stsDefault')
     96      (
     97        'Component = cmdOK'
     98        'Status = stsDefault')
     99      (
     100        'Component = cmdCancel'
     101        'Status = stsDefault')
     102      (
     103        'Component = frmOnChartOrders'
     104        'Status = stsDefault'))
     105  end
    82106end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
    88
    99type
    … …  
    3434
    3535uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore,
    36   fClinicWardMeds;
     36  fClinicWardMeds, rODLab, fRptBox;
    3737
    3838const
    … …  
    4747  SignList: TStringList;
    4848  OrderText: string;
     49  AList: TStringList;
    4950
    5051  function FindOrderText(const AnID: string): string;
    … …  
    9798              begin
    9899                OrderText := FindOrderText(Piece(SignList[i], U, 1));
     100                if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     101                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)
     104                else
    99105                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
    100106                        TC_SAVERR, MB_OK);
    … …  
    102108          end;
    103109        StatusText('');
     110          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
     111        AList := TStringList.Create;
     112        try
     113          CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
     114          if AList.Text <> '' then
     115            ReportBox(AList, 'Changed Orders', TRUE);
     116        finally
     117          AList.Free;
     118        end;
    104119        PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
    105120//        SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt);  //*KCM*
    … …  
    147162    x := FilteredString(Items[Index]);
    148163    AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
    149     //if AHeight > 255 then AHeight := 255;
    150164    if AHeight <  13 then AHeight := 15;
    151165  end;
    … …  
    165179    ARect.Left := ARect.Left + 2;
    166180    Canvas.FillRect(ARect);
    167     Canvas.Pen.Color := clSilver;
     181    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    168182    SaveColor := Canvas.Brush.Color;
    169183    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

    r456 r829  
    1 object frmOrdersPrint: TfrmOrdersPrint
     1inherited frmOrdersPrint: TfrmOrdersPrint
    22  Left = 353
    33  Top = 194
    4   Width = 364
    5   Height = 315
    64  Caption = 'Print orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   KeyPreview = True
     5  ClientHeight = 288
     6  ClientWidth = 356
    147  OldCreateOrder = True
    158  Position = poScreenCenter
    … …  
    1710  PixelsPerInch = 96
    1811  TextHeight = 13
    19   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    2013    Left = 0
    2114    Top = 0
    … …  
    222215    end
    223216  end
     217  inherited amgrMain: TVA508AccessibilityManager
     218    Data = (
     219      (
     220        'Component = pnlBase'
     221        'Status = stsDefault')
     222      (
     223        'Component = lblPartOne'
     224        'Status = stsDefault')
     225      (
     226        'Component = lblPart2'
     227        'Status = stsDefault')
     228      (
     229        'Component = ckChartCopy'
     230        'Status = stsDefault')
     231      (
     232        'Component = ckLabels'
     233        'Status = stsDefault')
     234      (
     235        'Component = ckRequisitions'
     236        'Status = stsDefault')
     237      (
     238        'Component = ckWorkCopy'
     239        'Status = stsDefault')
     240      (
     241        'Component = lstChartDevice'
     242        'Status = stsDefault')
     243      (
     244        'Component = lstLabelDevice'
     245        'Status = stsDefault')
     246      (
     247        'Component = lstReqDevice'
     248        'Status = stsDefault')
     249      (
     250        'Component = lstWorkDevice'
     251        'Status = stsDefault')
     252      (
     253        'Component = cmdChart'
     254        'Status = stsDefault')
     255      (
     256        'Component = cmdLabels'
     257        'Status = stsDefault')
     258      (
     259        'Component = cmdReqs'
     260        'Status = stsDefault')
     261      (
     262        'Component = cmdWork'
     263        'Status = stsDefault')
     264      (
     265        'Component = cmdOK'
     266        'Status = stsDefault')
     267      (
     268        'Component = cmdCancel'
     269        'Status = stsDefault')
     270      (
     271        'Component = frmOrdersPrint'
     272        'Status = stsDefault'))
     273  end
    224274end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame;
     7  StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmOrdersPrint = class(TForm)
     11  TfrmOrdersPrint = class(TfrmBase508Form)
    1112    ckChartCopy: TCheckBox;
    1213    ckLabels: TCheckBox;
    … …  
    5960  NO_WIN_PRINT = False;
    6061
    61 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean);
     62procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
     63                           PrintTitle: string = ''; PrintLoc: Integer = 0);
    6264
    6365implementation
    … …  
    6870  fDeviceSelect, uCore, ORNet, fOrders;
    6971
    70 procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean);
     72procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
     73                           PrintTitle: string = ''; PrintLoc: Integer = 0);
    7174{displays device and copy selection form for printing orders, and returns a record of the selections}
    7275var
    … …  
    7477begin
    7578  frmOrdersPrint := TfrmOrdersPrint.Create(Application);
     79  if PrintTitle <> '' then frmOrdersPrint.Caption := 'Print Orders for ' + PrintTitle;
    7680  try
    7781    frmFrame.CCOWBusy := True;
    … …  
    8791          lblPart2.Text := 'Greyed out items are not available.';
    8892        end;
    89       OrderPrintDeviceInfo(OrderList, PrintParams, Nature);
     93      OrderPrintDeviceInfo(OrderList, PrintParams, Nature, PrintLoc);
    9094      SetupControls(PrintParams);
    9195      if (PrintParams.AnyPrompts) {or FSelectAll} then ShowModal;

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

    r456 r829  
    1 object frmRefillOrders: TfrmRefillOrders
     1inherited frmRefillOrders: TfrmRefillOrders
    22  Left = 181
    33  Top = 267
    4   Width = 435
    5   Height = 311
    64  Caption = 'Refill Orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   OldCreateOrder = True
     5  ClientHeight = 284
    146  OnClose = FormClose
    157  OnCreate = FormCreate
    168  OnShow = FormShow
     9  ExplicitHeight = 311
    1710  PixelsPerInch = 96
    1811  TextHeight = 13
    19   object pnlBottom: TPanel
     12  object pnlBottom: TPanel [0]
    2013    Left = 0
    2114    Top = 200
    … …  
    8073    end
    8174  end
    82   object pnlClient: TPanel
     75  object pnlClient: TPanel [1]
    8376    Left = 0
    8477    Top = 0
    … …  
    9184      Left = 0
    9285      Top = 0
    93       Width = 427
    94       Height = 17
     86      Width = 181
     87      Height = 13
    9588      Align = alTop
    9689      Caption = 'Request refills for the following orders -'
    … …  
    107100    end
    108101  end
     102  inherited amgrMain: TVA508AccessibilityManager
     103    Data = (
     104      (
     105        'Component = pnlBottom'
     106        'Status = stsDefault')
     107      (
     108        'Component = cmdOK'
     109        'Status = stsDefault')
     110      (
     111        'Component = cmdCancel'
     112        'Status = stsDefault')
     113      (
     114        'Component = grbPickUp'
     115        'Status = stsDefault')
     116      (
     117        'Component = radWindow'
     118        'Status = stsDefault')
     119      (
     120        'Component = radMail'
     121        'Status = stsDefault')
     122      (
     123        'Component = radClinic'
     124        'Status = stsDefault')
     125      (
     126        'Component = pnlClient'
     127        'Status = stsDefault')
     128      (
     129        'Component = lstOrders'
     130        'Status = stsDefault')
     131      (
     132        'Component = frmRefillOrders'
     133        'Status = stsDefault'))
     134  end
    109135end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 318
    33  Top = 186
    4   Height = 370
    54  Caption = 'Release Orders to Service(s)'
     5  ClientHeight = 343
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitLeft = 318
     9  ExplicitTop = 186
     10  ExplicitHeight = 377
    811  PixelsPerInch = 96
    912  TextHeight = 13
    10   object Panel1: TPanel
     13  object Panel1: TPanel [0]
    1114    Left = 0
    1215    Top = 0
    … …  
    2932      Align = alTop
    3033      Caption = 'The following orders will be released -'
     34      ExplicitWidth = 176
    3135    end
    3236    object lstOrders: TCaptionListBox
    … …  
    4549    end
    4650  end
    47   object Panel2: TPanel
     51  object Panel2: TPanel [1]
    4852    Left = 0
    4953    Top = 296
    … …  
    5155    Height = 47
    5256    Align = alBottom
    53     BiDiMode = bdRightToLeft
    54     ParentBiDiMode = False
    5557    TabOrder = 1
    5658    object grpRelease: TGroupBox
    … …  
    109111    end
    110112  end
     113  inherited amgrMain: TVA508AccessibilityManager
     114    Data = (
     115      (
     116        'Component = Panel1'
     117        'Status = stsDefault')
     118      (
     119        'Component = lstOrders'
     120        'Status = stsDefault')
     121      (
     122        'Component = Panel2'
     123        'Status = stsDefault')
     124      (
     125        'Component = grpRelease'
     126        'Status = stsDefault')
     127      (
     128        'Component = radVerbal'
     129        'Status = stsDefault')
     130      (
     131        'Component = radPhone'
     132        'Status = stsDefault')
     133      (
     134        'Component = radPolicy'
     135        'Status = stsDefault')
     136      (
     137        'Component = cmdOK'
     138        'Status = stsDefault')
     139      (
     140        'Component = cmdCancel'
     141        'Status = stsDefault')
     142      (
     143        'Component = frmReleaseOrders'
     144        'Status = stsDefault'))
     145  end
    111146end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals,
     8  VA508AccessibilityManager;
    89
    910type
    … …  
    4243
    4344uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox,
    44   fFrame, fClinicWardMeds;
     45  fFrame, fClinicWardMeds, rODLab;
    4546
    4647const
    … …  
    6061  OrderText: string;
    6162  AnOrder: TOrder;
     63  AList: TStringList;
    6264
    6365  function FindOrderText(const AnID: string): string;
    … …  
    131133          begin
    132134            OrderText := FindOrderText(Piece(SignList[i], U, 1));
    133             InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, TC_SAVERR, MB_OK);
     135                if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     136                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)
     139                else
     140                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
     141                        TC_SAVERR, MB_OK);
    134142          end;
    135143          if Pos('R', Piece(SignList[i], U, 2)) > 0 then
    … …  
    137145        end;
    138146        StatusText('');
     147          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
     148        AList := TStringList.Create;
     149        try
     150          CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
     151          if AList.Text <> '' then
     152            ReportBox(AList, 'Changed Orders', TRUE);
     153        finally
     154          AList.Free;
     155        end;
    139156        PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
    140157//        SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
    … …  
    244261    ARect.Left := ARect.Left + 2;
    245262    Canvas.FillRect(ARect);
    246     Canvas.Pen.Color := clSilver;
     263    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    247264    SaveColor := Canvas.Brush.Color;
    248265    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    … …  
    271288    x := FilteredString(Items[Index]);
    272289    AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
    273     //if AHeight > 255 then AHeight := 255;
    274290    if AHeight <  13 then AHeight := 15;
    275291  end;

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

    r456 r829  
    55  HorzScrollBar.Visible = True
    66  VertScrollBar.Tracking = True
    7   AutoScroll = False
    87  Caption = 'Renew Orders'
    98  ClientHeight = 416
    … …  
    1312  OnClose = FormClose
    1413  OnCreate = FormCreate
    15   OnShow = FormShow
     14  ExplicitWidth = 600
     15  ExplicitHeight = 443
    1616  PixelsPerInch = 96
    1717  TextHeight = 13
    18   object hdrOrders: THeaderControl
     18  object hdrOrders: THeaderControl [0]
    1919    Left = 0
    2020    Top = 0
    2121    Width = 592
    2222    Height = 17
    23     DragReorder = False
    2423    Constraints.MinHeight = 17
    2524    Sections = <
    … …  
    3837    OnSectionResize = hdrOrdersSectionResize
    3938  end
    40   object pnlBottom: TPanel
     39  object pnlBottom: TPanel [1]
    4140    Left = 0
    4241    Top = 393
    … …  
    8685    end
    8786  end
    88   object lstOrders: TCaptionListBox
     87  object lstOrders: TCaptionListBox [2]
    8988    Left = 0
    9089    Top = 17
    … …  
    113112    HintOnItem = True
    114113  end
     114  inherited amgrMain: TVA508AccessibilityManager
     115    Data = (
     116      (
     117        'Component = hdrOrders'
     118        'Status = stsDefault')
     119      (
     120        'Component = pnlBottom'
     121        'Status = stsDefault')
     122      (
     123        'Component = cmdCancel'
     124        'Status = stsDefault')
     125      (
     126        'Component = cmdOK'
     127        'Status = stsDefault')
     128      (
     129        'Component = cmdChange'
     130        'Status = stsDefault')
     131      (
     132        'Component = lstOrders'
     133        'Status = stsDefault')
     134      (
     135        'Component = frmRenewOrders'
     136        'Status = stsDefault'))
     137  end
    115138end

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept,
    8   ExtCtrls, uODBase, ORCtrls;
     8  ExtCtrls, uODBase, ORCtrls, VA508AccessibilityManager;
    99
    1010type
    … …  
    2626    procedure cmdChangeClick(Sender: TObject);
    2727    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    28     procedure FormShow(Sender: TObject);
    2928    procedure hdrOrdersSectionResize(HeaderControl: THeaderControl;
    3029      Section: THeaderSection);
     30    procedure FormResize(Sender: TObject);
    3131  private
    3232    OKPressed: Boolean;
    … …  
    4242{$R *.DFM}
    4343
    44 uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals;
     44uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals,
     45  VA2006Utils;
    4546
    4647const
    … …  
    103104  try
    104105    frmRenewOrders.OrderList := SelectedList;
    105     ResizeFormToFont(TForm(frmRenewOrders));
    106106    IsInpt := OrderForInpatient;
    107107
    … …  
    260260begin
    261261  inherited;
    262   lstOrders.Color := ReadOnlyColor;
     262  FixHeaderControlDelphi2006Bug(hdrOrders);
    263263  OKPressed := False;
     264  ResizeFormToFont(Self);
     265  SetFormPosition(Self); 
     266end;
     267
     268procedure TfrmRenewOrders.FormResize(Sender: TObject);
     269var
     270i: integer;
     271Height: integer;
     272begin
     273  inherited;
     274  if lstorders.Count = 0 then exit;
     275  for I := 0 to lstOrders.Count - 1 do
     276    begin
     277       Height := lstOrders.ItemRect(i).Bottom - lstOrders.ItemRect(i).Top;
     278       lstOrdersMeasureItem(lstOrders,i,Height);
     279       //ListGridDrawCell(lstOrders, hdrOrders, i, TEXT_COLUMN, x, WORD_WRAPPED);
     280    end;
    264281end;
    265282
    … …  
    267284  Index: Integer; var Height: Integer);
    268285var
    269   x: string;
     286  x, tmp: string;
    270287  DateHeight, TextHeight: Integer;
    271288  AnOrder: TOrder;
    … …  
    273290begin
    274291  inherited;
    275   AnOrder := TOrder(OrderList.Items[Index]);
    276   if AnOrder <> nil then
    277   begin
    278     RenewFields := TOrderRenewFields(AnOrder.LinkObject);
    279     with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
    280     TextHeight := MeasureColumnHeight(RenewFields.NewText,Index,TEXT_COLUMN);
    281     DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
    282     Height := HigherOf(TextHeight, DateHeight);
    283     if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
    284   end
     292      AnOrder := TOrder(OrderList.Items[Index]);
     293      if (AnOrder <> nil) then
     294        begin
     295          RenewFields := TOrderRenewFields(AnOrder.LinkObject);
     296          with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
     297          //tmp := RenewFields.NewText;
     298          tmp := LstOrders.Items.Strings[index];
     299          TextHeight := MeasureColumnHeight(tmp,Index,TEXT_COLUMN);
     300          DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
     301          Height := HigherOf(TextHeight, DateHeight);
     302          if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
     303        end
    285304end;
    286305
    … …  
    420439end;
    421440
    422 procedure TfrmRenewOrders.FormShow(Sender: TObject);
    423 begin
    424   inherited;
    425   SetFormPosition(Self);
    426 end;
    427 
    428441procedure TfrmRenewOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
    429442begin

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

    r456 r829  
    1 object frmSignOrders: TfrmSignOrders
    2   Left = 400
    3   Top = 159
    4   Width = 585
    5   Height = 511
     1inherited frmSignOrders: TfrmSignOrders
     2  Left = 337
     3  Top = 142
    64  Caption = 'Sign Orders'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   KeyPreview = True
     5  ClientHeight = 487
     6  ClientWidth = 833
    147  OldCreateOrder = True
    158  Position = poScreenCenter
    169  OnCreate = FormCreate
    1710  OnDestroy = FormDestroy
    18   OnKeyDown = FormKeyDown
    1911  OnMouseDown = clstOrdersMouseDown
    2012  OnMouseMove = FormMouseMove
     13  OnResize = FormResize
    2114  OnShow = FormShow
     15  ExplicitWidth = 841
     16  ExplicitHeight = 514
    2217  DesignSize = (
    23     577
    24     484)
     18    833
     19    487)
    2520  PixelsPerInch = 96
    2621  TextHeight = 13
    27   object lblESCode: TLabel
     22  object lblESCode: TLabel [0]
    2823    Left = 8
    29     Top = 441
     24    Top = 449
    3025    Width = 123
    3126    Height = 13
    3227    Anchors = [akLeft, akBottom]
    3328    Caption = 'Electronic Signature Code'
    34   end
    35   object laDiagnosis: TLabel
     29    ExplicitTop = 446
     30  end
     31  object laDiagnosis: TLabel [1]
    3632    Left = 184
    3733    Top = 185
    … …  
    4137    Visible = False
    4238  end
    43   object Label2: TStaticText
     39  object lblOrderList: TStaticText [2]
    4440    Left = 8
    45     Top = 147
    46     Width = 171
     41    Top = 163
     42    Width = 205
    4743    Height = 17
    48     Caption = 'The following orders will be signed -'
     44    Caption = 'Signature will be Applied to Checked Items'
    4945    TabOrder = 3
    5046    TabStop = True
    5147  end
    52   object cmdOK: TButton
    53     Left = 417
    54     Top = 455
     48  object cmdOK: TButton [3]
     49    Left = 673
     50    Top = 458
    5551    Width = 72
    5652    Height = 21
    … …  
    6157    OnClick = cmdOKClick
    6258  end
    63   object cmdCancel: TButton
    64     Left = 497
    65     Top = 455
     59  object cmdCancel: TButton [4]
     60    Left = 753
     61    Top = 458
    6662    Width = 72
    6763    Height = 21
    … …  
    7268    OnClick = cmdCancelClick
    7369  end
    74   object txtESCode: TCaptionEdit
     70  object txtESCode: TCaptionEdit [5]
    7571    Left = 8
    76     Top = 455
     72    Top = 463
    7773    Width = 137
    7874    Height = 21
    … …  
    8278    Caption = 'Electronic Signature Code'
    8379  end
    84   inline fraCoPay: TfraCoPayDesc
    85     Left = 0
    86     Top = 0
    87     Width = 577
    88     Height = 132
    89     Align = alTop
    90     ParentShowHint = False
    91     ShowHint = True
    92     TabOrder = 5
    93     Visible = False
    94     inherited pnlRight: TPanel
    95       Left = 328
    96       inherited lblCaption: TStaticText
    97         Caption = 'Patient Orders Related To:'
    98       end
    99       inherited pnlMain: TPanel
    100         inherited Panel7: TPanel
    101           inherited lblHNC2: TORStaticText
    102             OnEnter = fraCoPayLabel23Enter
    103             OnExit = fraCoPayLabel23Exit
    104           end
    105           inherited lblHNC: TORStaticText
    106             OnEnter = fraCoPayLabel23Enter
    107             OnExit = fraCoPayLabel23Exit
    108           end
    109         end
    110         inherited Panel8: TPanel
    111           inherited Label12: TORStaticText
    112             OnEnter = fraCoPayLabel23Enter
    113             OnExit = fraCoPayLabel23Exit
    114           end
    115           inherited Label11: TORStaticText
    116             OnEnter = fraCoPayLabel23Enter
    117             OnExit = fraCoPayLabel23Exit
    118           end
    119         end
    120         inherited Panel9: TPanel
    121           inherited Label14: TORStaticText
    122             OnEnter = fraCoPayLabel23Enter
    123             OnExit = fraCoPayLabel23Exit
    124           end
    125           inherited Label13: TORStaticText
    126             OnEnter = fraCoPayLabel23Enter
    127             OnExit = fraCoPayLabel23Exit
    128           end
    129         end
    130         inherited Panel10: TPanel
    131           inherited Label16: TORStaticText
    132             OnEnter = fraCoPayLabel23Enter
    133             OnExit = fraCoPayLabel23Exit
    134           end
    135           inherited Label15: TORStaticText
    136             OnEnter = fraCoPayLabel23Enter
    137             OnExit = fraCoPayLabel23Exit
    138           end
    139         end
    140         inherited Panel11: TPanel
    141           inherited Label18: TORStaticText
    142             OnEnter = fraCoPayLabel23Enter
    143             OnExit = fraCoPayLabel23Exit
    144           end
    145           inherited Label17: TORStaticText
    146             OnEnter = fraCoPayLabel23Enter
    147             OnExit = fraCoPayLabel23Exit
    148           end
    149         end
    150         inherited Panel12: TPanel
    151           inherited Label24: TORStaticText
    152             OnEnter = fraCoPayLabel23Enter
    153             OnExit = fraCoPayLabel23Exit
    154           end
    155           inherited Label23: TORStaticText
    156             OnEnter = fraCoPayLabel23Enter
    157             OnExit = fraCoPayLabel23Exit
    158           end
    159         end
    160         inherited Panel1: TPanel
    161           inherited StaticText4: TORStaticText
    162             OnEnter = fraCoPayLabel23Enter
    163             OnExit = fraCoPayLabel23Exit
    164           end
    165           inherited StaticText1: TORStaticText
    166             OnEnter = fraCoPayLabel23Enter
    167             OnExit = fraCoPayLabel23Exit
    168           end
    169         end
    170       end
    171     end
    172     inherited pnlSC: TPanel
    173       Width = 328
    174       inherited lblSCDisplay: TLabel
    175         Width = 328
    176       end
    177       inherited memSCDisplay: TCaptionMemo
    178         Width = 328
    179       end
    180     end
    181   end
    182   object clstOrders: TCaptionCheckListBox
     80  object clstOrders: TCaptionCheckListBox [6]
    18381    Left = 8
    184     Top = 162
    185     Width = 564
    186     Height = 277
     82    Top = 181
     83    Width = 820
     84    Height = 262
    18785    OnClickCheck = clstOrdersClickCheck
    18886    Anchors = [akLeft, akTop, akRight, akBottom]
    … …  
    20199    Caption = 'The following orders will be signed -'
    202100  end
    203   object gbdxLookup: TGroupBox
     101  object gbdxLookup: TGroupBox [7]
    204102    Left = 7
    205     Top = 139
     103    Top = 157
    206104    Width = 99
    207105    Height = 43
    208106    Caption = 'Lookup Diagnosis'
    209107    Font.Charset = DEFAULT_CHARSET
    210     Font.Color = clBlack
     108    Font.Color = clWindowText
    211109    Font.Height = -11
    212110    Font.Name = 'MS Sans Serif'
    … …  
    227125    end
    228126  end
     127  inline fraCoPay: TfraCoPayDesc [8]
     128    Left = 0
     129    Top = 0
     130    Width = 833
     131    Height = 157
     132    Align = alTop
     133    AutoSize = True
     134    ParentShowHint = False
     135    ShowHint = True
     136    TabOrder = 5
     137    TabStop = True
     138    Visible = False
     139    ExplicitWidth = 833
     140    inherited pnlRight: TPanel
     141      Left = 545
     142      ExplicitLeft = 545
     143      inherited pnlMain: TPanel
     144        inherited pnlHNC: TPanel
     145          inherited lblHNC2: TVA508StaticText
     146            Width = 129
     147            ExplicitWidth = 129
     148          end
     149          inherited lblHNC: TVA508StaticText
     150            Width = 31
     151            ExplicitWidth = 31
     152          end
     153        end
     154        inherited pnlMST: TPanel
     155          inherited lblMST2: TVA508StaticText
     156            Width = 25
     157            ExplicitWidth = 25
     158          end
     159          inherited lblMST: TVA508StaticText
     160            Width = 31
     161            ExplicitWidth = 31
     162          end
     163        end
     164        inherited pnlSWAC: TPanel
     165          inherited lblSWAC2: TVA508StaticText
     166            Width = 127
     167            ExplicitWidth = 127
     168          end
     169          inherited lblSWAC: TVA508StaticText
     170            Width = 40
     171            ExplicitWidth = 40
     172          end
     173        end
     174        inherited pnlIR: TPanel
     175          inherited lblIR2: TVA508StaticText
     176            Width = 133
     177            ExplicitWidth = 133
     178          end
     179          inherited lblIR: TVA508StaticText
     180            Width = 19
     181            ExplicitWidth = 19
     182          end
     183        end
     184        inherited pnlAO: TPanel
     185          inherited lblAO2: TVA508StaticText
     186            Width = 115
     187            ExplicitWidth = 115
     188          end
     189          inherited lblAO: TVA508StaticText
     190            Width = 23
     191            ExplicitWidth = 23
     192          end
     193        end
     194        inherited pnlCV: TPanel
     195          inherited lblCV2: TVA508StaticText
     196            Width = 142
     197            ExplicitWidth = 142
     198          end
     199        end
     200        inherited pnlSHD: TPanel
     201          inherited lblSHAD: TVA508StaticText
     202            Width = 33
     203            ExplicitWidth = 33
     204          end
     205          inherited lblSHAD2: TVA508StaticText
     206            Width = 159
     207            ExplicitWidth = 159
     208          end
     209        end
     210      end
     211    end
     212    inherited pnlSCandRD: TPanel
     213      Width = 545
     214      ExplicitWidth = 545
     215      inherited lblSCDisplay: TLabel
     216        Width = 545
     217        ExplicitWidth = 311
     218      end
     219      inherited memSCDisplay: TCaptionMemo
     220        Width = 545
     221        ExplicitWidth = 545
     222      end
     223    end
     224  end
     225  inherited amgrMain: TVA508AccessibilityManager
     226    Data = (
     227      (
     228        'Component = lblOrderList'
     229        'Status = stsDefault')
     230      (
     231        'Component = cmdOK'
     232        'Status = stsDefault')
     233      (
     234        'Component = cmdCancel'
     235        'Status = stsDefault')
     236      (
     237        'Component = txtESCode'
     238        'Status = stsDefault')
     239      (
     240        'Component = clstOrders'
     241        'Status = stsDefault')
     242      (
     243        'Component = gbdxLookup'
     244        'Status = stsDefault')
     245      (
     246        'Component = buOrdersDiagnosis'
     247        'Status = stsDefault')
     248      (
     249        'Component = fraCoPay'
     250        'Status = stsDefault')
     251      (
     252        'Component = fraCoPay.pnlRight'
     253        'Status = stsDefault')
     254      (
     255        'Component = fraCoPay.lblCaption'
     256        'Status = stsDefault')
     257      (
     258        'Component = fraCoPay.pnlMain'
     259        'Status = stsDefault')
     260      (
     261        'Component = fraCoPay.pnlHNC'
     262        'Status = stsDefault')
     263      (
     264        'Component = fraCoPay.lblHNC2'
     265        'Status = stsDefault')
     266      (
     267        'Component = fraCoPay.lblHNC'
     268        'Status = stsDefault')
     269      (
     270        'Component = fraCoPay.pnlMST'
     271        'Status = stsDefault')
     272      (
     273        'Component = fraCoPay.lblMST2'
     274        'Status = stsDefault')
     275      (
     276        'Component = fraCoPay.lblMST'
     277        'Status = stsDefault')
     278      (
     279        'Component = fraCoPay.pnlSWAC'
     280        'Status = stsDefault')
     281      (
     282        'Component = fraCoPay.lblSWAC2'
     283        'Status = stsDefault')
     284      (
     285        'Component = fraCoPay.lblSWAC'
     286        'Status = stsDefault')
     287      (
     288        'Component = fraCoPay.pnlIR'
     289        'Status = stsDefault')
     290      (
     291        'Component = fraCoPay.lblIR2'
     292        'Status = stsDefault')
     293      (
     294        'Component = fraCoPay.lblIR'
     295        'Status = stsDefault')
     296      (
     297        'Component = fraCoPay.pnlAO'
     298        'Status = stsDefault')
     299      (
     300        'Component = fraCoPay.lblAO2'
     301        'Status = stsDefault')
     302      (
     303        'Component = fraCoPay.lblAO'
     304        'Status = stsDefault')
     305      (
     306        'Component = fraCoPay.pnlSC'
     307        'Status = stsDefault')
     308      (
     309        'Component = fraCoPay.lblSC2'
     310        'Status = stsDefault')
     311      (
     312        'Component = fraCoPay.lblSC'
     313        'Status = stsDefault')
     314      (
     315        'Component = fraCoPay.pnlCV'
     316        'Status = stsDefault')
     317      (
     318        'Component = fraCoPay.lblCV2'
     319        'Status = stsDefault')
     320      (
     321        'Component = fraCoPay.lblCV'
     322        'Status = stsDefault')
     323      (
     324        'Component = fraCoPay.pnlSHD'
     325        'Status = stsDefault')
     326      (
     327        'Component = fraCoPay.lblSHAD'
     328        'Status = stsDefault')
     329      (
     330        'Component = fraCoPay.lblSHAD2'
     331        'Status = stsDefault')
     332      (
     333        'Component = fraCoPay.pnlSCandRD'
     334        'Status = stsDefault')
     335      (
     336        'Component = fraCoPay.memSCDisplay'
     337        'Status = stsDefault')
     338      (
     339        'Component = frmSignOrders'
     340        'Status = stsDefault'))
     341  end
    229342  object poBACopyPaste: TPopupMenu
    230343    Left = 344

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

    r456 r829  
    99  fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
    1010  ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
    11   Menus, ORClasses;
     11  Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;
    1212
    1313type
    14   TfrmSignOrders = class(TForm)
     14  TfrmSignOrders = class(TfrmBase508Form)
    1515    cmdOK: TButton;
    1616    cmdCancel: TButton;
    1717    lblESCode: TLabel;
    1818    txtESCode: TCaptionEdit;
    19     fraCoPay: TfraCoPayDesc;
    2019    clstOrders: TCaptionCheckListBox;
    2120    laDiagnosis: TLabel;
    … …  
    2726    Diagnosis1: TMenuItem;
    2827    Exit1: TMenuItem;
    29     Label2: TStaticText;
     28    lblOrderList: TStaticText;
     29    fraCoPay: TfraCoPayDesc;
    3030    procedure FormCreate(Sender: TObject);
    3131    procedure cmdOKClick(Sender: TObject);
    … …  
    5454    procedure clstOrdersKeyUp(Sender: TObject; var Key: Word;
    5555      Shift: TShiftState);
     56    procedure FormResize(Sender: TObject);
    5657  private
    5758    OKPressed: Boolean;
    … …  
    6263    function ItemsAreChecked: Boolean;
    6364    function GetNumberOfSelectedOrders : byte;
    64     procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
     65    procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
    6566    procedure SetItemTextToState;
    6667    procedure FormatListForScreenReader;
    … …  
    7273
    7374{Begin BillingAware}
    74   { TODO 3 -oKW -cRefinement : Change to dynamic array or other dynamic structure for Billing Awareness Phase II. }
    75   TarRect = array[MIN_RECT..MAX_RECT] of TRect;
     75    TarRect = array[MIN_RECT..MAX_RECT] of TRect;
    7676
    7777  var
    … …  
    105105    srcIndex: integer;
    106106    CopyBuffer: TBADxRecord;
    107     //CopyActive: boolean;  //CQ6225
    108107  {End BillingAware}
    109108
    … …  
    114113uses
    115114  Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders,
    116   fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame;
     115  fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame, rODLab, fRptBox,
     116  VAUtils;
    117117
    118118const
    … …  
    141141           on EListError do
    142142              begin
    143               {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
     143              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
    144144              raise;
    145145              end;
    … …  
    174174  itemsList.Clear;
    175175  itemsList := uSigItems.GetSigItems; //Get FItems list
    176 
    177176  if BILLING_AWARE then
    178177     begin
    … …  
    190189           on EListError do
    191190              begin
    192               {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
     191              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
    193192              raise;
    194193              end;
    … …  
    198197
    199198function ExecuteSignOrders(SelectedList: TList): Boolean;
    200 var
    201   i, cidx,cnt, theSts: Integer;
     199const
     200  VERT_SPACING = 6;
     201
     202var
     203  i, cidx,cnt, theSts, WardIEN: Integer;
    202204  ShrinkHeight: integer;
    203205  SignList: TStringList;
    204206  Obj: TOrder;
    205   DigSigErr, DigStoreErr: Boolean;
     207  DigSigErr, DigStoreErr, ContainsIMOOrders, DoNotPrint: Boolean;
    206208  x, SigData, SigUser, SigDrugSch, SigDEA: string;
    207   cSignature, cHashData, cCrlUrl, cErr: string;
     209  cSignature, cHashData, cCrlUrl, cErr, WardName: string;
    208210  cProvDUZ: Int64;
    209   OrderText: string;
     211  OrderText, ASvc: string;
    210212  PrintLoc: Integer;
    211  // tempOrderID: string;
     213  AList, ClinicList, DCList, OrderPrintList, WardList: TStringList;
     214  EncLocName, EncLocText: string;
     215  EncLocIEN: integer;
     216  EncDT: TFMDateTime;
     217  EncVC: Char;
    212218
    213219  function FindOrderText(const AnID: string): string;
    … …  
    253259  DigSigErr := True;
    254260  PrintLoc := 0;
     261  EncLocIEN := 0;
     262  DoNotPrint := False;
    255263  if SelectedList.Count = 0 then Exit;
    256264  if BILLING_AWARE then
    … …  
    268276        cidx := frmSignOrders.clstOrders.Items.AddObject(Obj.Text,Obj);
    269277        SigItems.Add(CH_ORD,Obj.ID, cidx);
    270          //HDS6205 allows dx entry for NON CIDC Consult orders
    271    //    if BILLING_AWARE then  //HDS6205
    272    //        if UBAGlobals.BAConsultOrdersRequireDx.Count > 0 then  //HDS6205
    273    //        begin
    274   //            tempOrderID := UBACore.SetOrderIDConsultDxRequired(Piece(Obj.ID,';',1) + ';1');  //HDS6205
    275   //            tempOrderList.Add(tempOrderID);  //HDS6205
    276   //         end
    277   //         else
    278          if BILLING_AWARE then
    279             tempOrderList.Add(Obj.ID);
    280 
     278        if BILLING_AWARE then
     279           tempOrderList.Add(Obj.ID);
    281280        frmSignOrders.clstOrders.Checked[cidx] := TRUE;
    282281
    … …  
    295294       {End BillingAware}
    296295
    297         ShrinkHeight := frmSignOrders.fraCoPay.Height + 9;
    298         frmSignOrders.Height := frmSignOrders.Height - ShrinkHeight;
    299         frmSignOrders.Label2.Top := frmSignOrders.Label2.Top - ShrinkHeight;
    300         frmSignOrders.clstOrders.Top := frmSignOrders.clstOrders.Top - ShrinkHeight;
    301         frmSignOrders.clstOrders.Height := frmSignOrders.clstOrders.Height + ShrinkHeight;
     296        with frmSignOrders do begin
     297          ShrinkHeight := lblOrderList.Top - VERT_SPACING;
     298          Height := Height - ShrinkHeight;
     299          lblOrderList.Top := lblOrderList.Top - ShrinkHeight;
     300          clstOrders.Top := clstOrders.Top - ShrinkHeight;
     301          clstOrders.Height := clstOrders.Height + ShrinkHeight;
     302        end;
    302303      end;
    303304
    … …  
    329330    end;
    330331
    331      frmSignOrders.ShowModal;
     332      frmSignOrders.ShowModal;
    332333      if frmSignOrders.OKPressed then
    333334      begin
    334335        Result := True;
    335336        SignList := TStringList.Create;
     337        ClinicList := TStringList.Create;
     338        OrderPrintList := TStringList.Create;
     339        WardList := TStringList.Create;
     340        ContainsIMOOrders := false;
    336341        try
    337342          with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
    … …  
    346351                  if Length(SigData) < 1 then
    347352                    begin
    348                       ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
     353                      ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
    349354                      DigStoreErr := true;
    350355                    end;
    … …  
    368373                    else
    369374                      begin
    370                         ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
     375                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
    371376                        DigStoreErr := true;
    372377                      end;
    … …  
    374379                    on  E: Exception do
    375380                      begin
    376                         ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
     381                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
    377382                        DigStoreErr := true;
    378383                      end;
    … …  
    399404                  if GetPKISite and (Copy(TOrder(SelectedList.Items[i]).DigSigReq,1,1) = '2') then
    400405                    begin
    401                       ShowMessage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
     406                      ShowMsg('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
    402407                        'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
    403408                        CRLF + 'Please discontinue/cancel this order and create a hand written order for manual processing, or digitally sign the order at a PKI-enabled workstation.');
    … …  
    418423          if SignList.Count > 0 then
    419424          begin
    420 
    421           //hds7591  Clinic/Ward movement.  Patient Admission IMO
    422           if not frmFrame.TimedOut then
    423           begin
    424              if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
    425                 frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,uCore.Encounter.LocationName, PrintLoc)
    426              else
    427                 if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
    428                    frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
    429           end;
    430           uCore.TempEncounterLoc := 0;
    431           uCore.TempEncounterLocName := '';
    432           //hds7591  Clinic/Ward movement  Patient Admission IMO
     425            //hds7591  Clinic/Ward movement.  Patient Admission IMO
     426            if not frmFrame.TimedOut then
     427            begin
     428               if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
     429                   begin
     430                     DCList := TStringList.Create;
     431                     EncLocName := Encounter.LocationName;
     432                     EncLocIEN  := Encounter.Location;
     433                     EncLocText := Encounter.LocationText;
     434                     EncDT := Encounter.DateTime;
     435                     EncVC := Encounter.VisitCategory;
     436                     for i := 0 to SelectedList.Count - 1 do
     437                       begin
     438                         cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(SelectedList.Items[i]));
     439                         if frmSignOrders.clstOrders.Checked[cidx] = false then continue;
     440                         if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true;
     441                         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
     444                           begin
     445                             DCList.Add(TOrder(SelectedList.Items[i]).ID);
     446                             Continue;
     447                           end;
     448                         OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text);
     449                       end;
     450                      if OrderPrintList.Count > 0 then
     451                        begin
     452                          frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
     453                                                        WardList, WardIen,WardName, ContainsIMOOrders, true);
     454                          fframe.frmFrame.OrderPrintForm := false;
     455                        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);
     463                        end;
     464                      if DCList <> nil then DCList.Free;
     465                   end;
     466            end;
     467            uCore.TempEncounterLoc := 0;
     468            uCore.TempEncounterLocName := '';
     469            //hds7591  Clinic/Ward movement  Patient Admission IMO
    433470
    434471            SigItems.SaveSettings; // Save CoPay FIRST!
    435472            SendOrders(SignList, frmSignOrders.ESCode);
    436 
    437         end;
     473          end;
    438474
    439475            with SignList do if Count > 0 then for i := 0 to Count - 1 do
    … …  
    442478                begin
    443479                  OrderText := FindOrderText(Piece(SignList[i], U, 1));
     480                  if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
     481                  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)
     484                  else
    444485                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
    445                           TC_SAVERR, MB_OK);
     486                        TC_SAVERR, MB_OK);
    446487                end;
    447488              if Pos('R', Piece(SignList[i], U, 2)) > 0 then
    … …  
    459500              if theSts = 10 then  SignList.Delete(cnt);  //signed delayed order should not be printed.
    460501          end;
    461           PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
     502          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
     503          AList := TStringList.Create;
     504          try
     505            CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
     506            if AList.Text <> '' then
     507              ReportBox(AList, 'Changed Orders', TRUE);
     508          finally
     509            AList.Free;
     510          end;
     511          if(ClinicList.Count > 0) or (WardList.count > 0) then
     512              PrintOrdersOnSignReleaseMult(SignList, CLinicList, WardList, NO_PROVIDER, EncLocIEN, WardIEN, EncLocName, wardName)
     513            else if DoNotPrint = False then PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
    462514        finally
    463515          SignList.Free;
     516          OrderPrintList.free;
     517          WardList.free;
     518          ClinicList.free;
    464519        end;
    465520      end; {if frmSignOrders.OKPressed}
    … …  
    486541  if  BILLING_AWARE then
    487542      begin
    488         clstOrders.Height := 234;
     543        clstOrders.Height := 228;
    489544        clstOrders.Top :=  (gbdxLookup.top + 65);
    490545        gbDxLookup.Visible := TRUE;
    491         label2.Top := (gbdxLookup.Top +  48);
    492         laDiagnosis.Top :=  Label2.Top;
     546        lblOrderList.Top := (gbdxLookup.Top +  gbdxLookup.Height);
     547        laDiagnosis.Top :=  lblOrderList.Top;
    493548        laDiagnosis.Left := 270;
    494549        laDiagnosis.Visible := TRUE;
    … …  
    497552   else
    498553      begin
    499          label2.Top := 145;
    500          label2.Left := 8;
     554         lblOrderList.Top := 158;
     555         lblOrderList.Left := 8;
    501556     end;
    502557 {End BillingAware}
    … …  
    609664       begin
    610665          Canvas.FillRect(ARect);
    611           Canvas.Pen.Color := clSilver;
     666          Canvas.Pen.Color := Get508CompliantColor(clSilver);
    612667          Canvas.MoveTo(ARect.Left, ARect.Bottom);
    613668          Canvas.LineTo(ARect.Right, ARect.Bottom);
    … …  
    619674          //Adjust position of 'Diagnosis' column label for font size
    620675          laDiagnosis.Left := ARect.Right + 14;
    621 
    622               //ARect.Right below controls the right-hand side of the Dx Column
    623               //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
    624               //two rectangles overlap each other.
     676          if uSignItems.GetAllBtnLeftPos > 0 then
     677             laDiagnosis.left := uSignItems.GetAllBtnLeftPos - (laDiagnosis.Width +5);
     678              // ARect.Right below controls the right-hand side of the Dx Column
     679              // Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
     680              // two rectangles overlap each other.
    625681           if  BILLING_AWARE then
    626682           begin
    … …  
    631687              //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code
    632688               DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    633        {v25 BA}
    634         if  BILLING_AWARE then
     689       if  BILLING_AWARE then
    635690         begin
    636691             if Assigned(UBAGlobals.tempDxList) then
    637692                begin
    638                 tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
     693                   tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
    639694
    640695                if UBAGlobals.tempDxNodeExists(tempID) then
    … …  
    646701                       str := Piece(str,':',1);
    647702                       DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    648                        if Not UBACore.IsOrderBillable(tempID) then //and
    649                       //    Not UBAGlobals.tempDxNodeExists(tempID) then   // if consult is non cidc but requires dx, show it.
     703                       if Not UBACore.IsOrderBillable(tempID) then
    650704                       begin
    651705                            Canvas.Font.Color := clBlue;
    … …  
    676730             if Index < Items.Count then
    677731                begin
    678                 Canvas.FillRect(ARect);
    679                 Canvas.Pen.Color := clSilver;
    680                 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    681                 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
    682                 X := FilteredString(Items[Index]);
    683                 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
     732                  Canvas.FillRect(ARect);
     733                  Canvas.Pen.Color := Get508CompliantColor(clSilver);
     734                  Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
     735                  Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
     736                  X := FilteredString(Items[Index]);
     737                  DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    684738                end;
    685739           end;
    … …  
    761815        if Checked[i] then
    762816           begin
    763            Result := True;
    764            break;
     817             Result := True;
     818             break;
    765819           end;
    766820end;
    … …  
    795849                      for i := 0 to (tempDxList.Count - 1) do
    796850                         begin
    797                           thisRec := TBADxRecord(tempDxList.Items[i]);
     851                           thisRec := TBADxRecord(tempDxList.Items[i]);
    798852
    799853                          if Assigned(thisRec) then
    … …  
    815869                    on EListError do
    816870                       begin
    817                        {$ifdef debug}ShowMessage('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
     871                       {$ifdef debug}Show508Message('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
    818872                       raise;
    819873                       end;
    … …  
    841895{Begin BillingAware}
    842896
     897  if (clstOrders.Top + clstOrders.Height) > (lblESCode.Top - 4) then
     898      clstOrders.Height := lblESCode.Top - clstOrders.Top - 4;
     899
    843900  //INITIALIZATIONS
    844901  Paste1.Enabled := false;
    … …  
    859916         with fraCoPay do
    860917           begin
    861             Label24.Caption := 'Service &Connected Condition';
    862             StaticText4.Caption := 'Combat &Vet (Combat Related)';
    863             Label18.Caption := 'Agent &Orange Exposure';
    864             Label16.Caption := 'Ionizing &Radiation Exposure';
    865             Label14.Caption := '&Environmental Contaminants';
    866             Label12.Caption := '&MST';
     918            lblSC2.Caption := 'Service &Connected Condition';
     919            lblCV2.Caption := 'Combat &Vet (Combat Related)';
     920            lblAO2.Caption := 'Agent &Orange Exposure';
     921            lblIR2.Caption := 'Ionizing &Radiation Exposure';
     922            lblSWAC2.Caption := '&Environmental Contaminants';
     923            lblMST2.Caption := '&MST';
    867924            lblHNC2.Caption := '&Head and/or Neck Cancer';
    868             Label24.ShowAccelChar := true;
    869             StaticText4.ShowAccelChar := true;
    870             Label18.ShowAccelChar := true;
    871             Label16.ShowAccelChar := true;
    872             Label14.ShowAccelChar := true;
    873             Label12.ShowAccelChar := true;
     925            lblSHAD2.Caption := 'Shi&pboard Hazard and Defense';
     926            lblSC2.ShowAccelChar := true;
     927            lblCV2.ShowAccelChar := true;
     928            lblAO2.ShowAccelChar := true;
     929            lblIR2.ShowAccelChar := true;
     930            lblSWAC2.ShowAccelChar := true;
     931            lblMST2.ShowAccelChar := true;
    874932            lblHNC2.ShowAccelChar := true;
     933            lblSHAD2.ShowAccelChar := true;
    875934           end;
    876935        end;  //BILLING_AWARE
    … …  
    916975  match := false;
    917976  allBlank := false;
    918   //orderIDList := TStringList.Create;
    919977  if Assigned (orderIDList) then orderIDList.Clear;
    920978  if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear;
    … …  
    9521010                 {$ifdef debug}
    9531011                 with UBAGlobals.globalDxRec do
    954                     //ShowMessage('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
     1012                    //Show508Message('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
    9551013                 {$endif}
    9561014                  end;
    … …  
    9591017     except
    9601018        on E: Exception  do
    961            ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
     1019           ShowMsg(E.ClassName+' error raised, with message : '+E.Message);
    9621020   end;
    9631021
    … …  
    9661024  if numSelected = 0 then
    9671025     begin
    968      ShowMessage(UBAMessages.BA_NO_ORDERS_SELECTED);
     1026     ShowMsg(UBAMessages.BA_NO_ORDERS_SELECTED);
    9691027     Exit;
    9701028     end
    … …  
    9811039
    9821040  if ((match and allBlank) or (match and (not allBlank))) then  // All selected are blank or matching-not-blank
    983 //     begin
    984      { TODO 3 -oKW -cRefinement : Define a const to replace string literal }
    985        frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
     1041        frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
    9861042   else
    9871043     begin
    … …  
    9921048              Exit
    9931049         else
    994 //              begin
    9951050              if Assigned(UBAGlobals.globalDxRec) then
    9961051                 InitializeNewDxRec(UBAGlobals.globalDxRec);
    … …  
    10301085         if numSelected > 1 then
    10311086           begin
    1032            ShowMessage('Only 1 order at a time may be selected for ''Copying''');
     1087           ShowMsg('Only 1 order at a time may be selected for ''Copying''');
    10331088           Exit;
    10341089           end;
    … …  
    10581113               //*************************************************************************
    10591114               if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and
    1060              //    (NOT tempDxNodeExists(fOrdersSign.srcOrderID)) then   // added to allow copy to NON CIDC consult order the requires a DX. then
     1115               // added to allow copy to NON CIDC consult order the requires a DX. then
    10611116                 begin
    1062                  ShowMessage(BA_NA_COPY_DISALLOWED);
    1063                  fOrdersSign.srcOrderID := '';
    1064                  Exit;
     1117                   ShowMsg(BA_NA_COPY_DISALLOWED);
     1118                   fOrdersSign.srcOrderID := '';
     1119                   Exit;
    10651120                 end;
    10661121               //*************************************************************************
    … …  
    10741129     on EListError do
    10751130        begin
    1076         ShowMessage('EListError in frmSignOrders.Copy1Click()');
     1131          ShowMsg('EListError in frmSignOrders.Copy1Click()');
    10771132        raise;
    10781133        end;
    10791134   end;
    1080 
    1081   //CopyActive := true; //CQ6225
    1082   //Paste1.Enabled := true; //CQ6225
    10831135end;
    10841136
    … …  
    11011153               if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
    11021154                 begin
    1103                  fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
     1155                   fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
    11041156
    11051157                  if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself
    … …  
    11121164                     if Not UBACore.IsOrderBillable(targetOrderID) then
    11131165                       begin
    1114                        ShowMessage(BA_NA_PASTE_DISALLOWED);
    1115                        fOrdersSign.targetOrderID := '';
    1116                        Continue;
     1166                         ShowMsg(BA_NA_PASTE_DISALLOWED);
     1167                         fOrdersSign.targetOrderID := '';
     1168                         Continue;
    11171169                       end;
    11181170                     //***************************************************************
    … …  
    11211173                     with newRec do
    11221174                       begin
    1123                        FOrderID :=  fOrdersSign.targetOrderID;
    1124                        FBADxCode := CopyBuffer.FBADxCode;
    1125                        FBASecDx1 := CopyBuffer.FBASecDx1;
    1126                        FBASecDx2 := CopyBuffer.FBASecDx2;
    1127                        FBASecDx3 := CopyBuffer.FBASecDx3;
     1175                         FOrderID :=  fOrdersSign.targetOrderID;
     1176                         FBADxCode := CopyBuffer.FBADxCode;
     1177                         FBASecDx1 := CopyBuffer.FBASecDx1;
     1178                         FBASecDx2 := CopyBuffer.FBASecDx2;
     1179                         FBASecDx3 := CopyBuffer.FBASecDx3;
    11281180                       end;
    11291181
    … …  
    11381190        on EListError do
    11391191           begin
    1140            ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
     1192             ShowMsg('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
    11411193           raise;
    11421194           end;
    … …  
    11441196         clstOrders.Refresh; //Update grid to show pasted Dx
    11451197     end;
    1146 {
    1147   //CQ6225
    1148   if CopyActive then
    1149      begin
    1150      Paste1.Enabled := false;
    1151      CopyActive := false;
    1152      end;
    1153   //end CQ6225
    1154 }
    11551198end;
    11561199
    … …  
    11731216           if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
    11741217              begin
    1175               Copy1.Enabled := false;
    1176               Paste1.Enabled := false
     1218                Copy1.Enabled := false;
     1219                Paste1.Enabled := false
    11771220              end
    11781221           else
    11791222              begin
    1180               Copy1.Enabled := true;
    1181               //Paste1.Enabled := true; //commented out for CQ6225
     1223                Copy1.Enabled := true;
    11821224              end;
    11831225           //End CQ3325
    … …  
    11941236        on EListError do
    11951237           begin
    1196            ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()');
     1238             ShowMsg('EListError in frmSignOrders.clstOrdersMouseDown()');
    11971239           raise;
    11981240           end;
    … …  
    12251267           if clstOrders.Selected[i] then
    12261268              begin
    1227               thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
    1228 
    1229               //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
     1269                thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
     1270
     1271                //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
    12301272              if thisChangeItem = nil then
    12311273                 begin
    1232                  Copy1.Enabled := false;
    1233                  buOrdersDiagnosis.Enabled := false;
    1234                  Exit;
     1274                   Copy1.Enabled := false;
     1275                   buOrdersDiagnosis.Enabled := false;
     1276                   Exit;
    12351277                 end;
    12361278
    12371279              if (thisChangeItem <> nil) then //Blank row - not an order item
    12381280                 begin
    1239                  thisOrderList.Clear;
    1240                  thisOrderList.Add(thisChangeItem.ID);
    1241 
    1242                  if IsAllOrdersNA(thisOrderList) then
    1243                  begin
    1244                     Diagnosis1.Enabled := false;
    1245                     buOrdersDiagnosis.Enabled := false;
    1246                  end
     1281                   thisOrderList.Clear;
     1282                   thisOrderList.Add(thisChangeItem.ID);
     1283
     1284                   if IsAllOrdersNA(thisOrderList) then
     1285                   begin
     1286                     Diagnosis1.Enabled := false;
     1287                     buOrdersDiagnosis.Enabled := false;
     1288                  end
    12471289                 else
    12481290                 begin
    … …  
    12681310  j: integer; //CQ5054
    12691311begin
    1270 
    1271        if FOSTFHintWndActive then
    1272        begin
    1273           FOSTFhintWindow.ReleaseHandle ;
    1274           FOSTFHintWndActive := False ;
    1275        end;
    1276 
    1277        case Key of
    1278            67,99:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
    1279            86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
    1280            79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
    1281            82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
    1282            69,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
    1283            77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
    1284            72,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
    1285            //CQ5054
    1286            83,115: if (ssAlt in Shift) then
    1287                 begin
    1288                 for j := 0 to clstOrders.Items.Count-1 do
    1289                       clstOrders.Selected[j] := false;
    1290                 clstOrders.Selected[0] := true;
    1291                 clstOrders.SetFocus;
    1292                 end;
    1293            //end CQ5054
    1294        end;
     1312  inherited;
     1313  if FOSTFHintWndActive then
     1314  begin
     1315    FOSTFhintWindow.ReleaseHandle ;
     1316    FOSTFHintWndActive := False ;
     1317  end;
     1318
     1319  case Key of
     1320     67,99:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.lblSC2); //C,c
     1321     86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.lblCV2); //V,v
     1322     79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.lblAO2); //O,o
     1323     82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.lblIR2); //R,r
     1324     65,97:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.lblSWAC2); //A,a
     1325     77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.lblMST2); //M,m
     1326     78,110: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //N,n
     1327     72,104: if (ssALT in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSHAD,fraCopay.lblSHAD2); // H,h
     1328     //CQ5054
     1329     83,115: if (ssAlt in Shift) then
     1330          begin
     1331            for j := 0 to clstOrders.Items.Count-1 do
     1332                clstOrders.Selected[j] := false;
     1333            clstOrders.Selected[0] := true;
     1334            clstOrders.SetFocus;
     1335          end;
     1336     //end CQ5054
     1337  end;
    12951338end;
    12961339
    12971340//BILLING AWARE Procedure
    1298 procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
     1341procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
    12991342var
    13001343 HRect: TRect;
    … …  
    13061349     if FOSTFhintWndActive then
    13071350        begin
    1308         FOSTFhintWindow.ReleaseHandle;
    1309         FOSTFhintWndActive := False;
     1351          FOSTFhintWindow.ReleaseHandle;
     1352          FOSTFhintWndActive := False;
    13101353        end;
    13111354  except
    13121355     on E: Exception do
    13131356        begin
    1314         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
     1357        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
    13151358        raise;
    13161359        end;
    … …  
    13291372      hrect.Bottom := hrect.Bottom + Y;
    13301373
    1331   if FOSTFHintWndActive then
    1332      begin
    1333      with fraCoPay do
    1334         begin
    1335         //Abbreviated captions
    1336         Label23.ShowHint := false;
    1337         StaticText1.ShowHint := false;
    1338         Label17.ShowHint := false;
    1339         Label15.ShowHint := false;
    1340         Label13.ShowHint := false;
    1341         Label11.ShowHint := false;
    1342         lblHNC.ShowHint := false;
    1343         //Long captions
    1344         staticText4.ShowHint := false;
    1345         Label17.ShowHint := false;
    1346         Label18.ShowHint := false;
    1347         Label15.ShowHint := false;
    1348         Label16.ShowHint := false;
    1349         Label13.ShowHint := false;
    1350         Label14.ShowHint := false;
    1351         Label11.ShowHint := false;
    1352         Label12.ShowHint := false;
    1353         lblHNC.ShowHint := false;
    1354         lblHNC2.ShowHint := false;
    1355         end;
    1356      end
    1357   else
    1358      begin
    1359      with fraCoPay do
    1360         begin
    1361         //Abbreviated captions
    1362         Label23.ShowHint := true;
    1363         StaticText1.ShowHint := true;
    1364         Label17.ShowHint := true;
    1365         Label15.ShowHint := true;
    1366         Label13.ShowHint := true;
    1367         Label11.ShowHint := true;
    1368         lblHNC.ShowHint := true;
    1369         //Long captions       
    1370         staticText4.ShowHint := true;
    1371         Label17.ShowHint := true;
    1372         Label18.ShowHint := true;
    1373         Label15.ShowHint := true;
    1374         Label16.ShowHint := true;
    1375         Label13.ShowHint := true;
    1376         Label14.ShowHint := true;
    1377         Label11.ShowHint := true;
    1378         Label12.ShowHint := true;
    1379         lblHNC.ShowHint := true;
    1380         lblHNC2.ShowHint := true;
    1381         end;
    1382      end;
     1374      fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive);
    13831375
    13841376      FOSTFhintWindow.ActivateHint(hrect, pHintText);
    … …  
    13871379     on E: Exception do
    13881380        begin
    1389         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
     1381        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
    13901382        raise;
    13911383        end;
    … …  
    14051397     on E: Exception do
    14061398        begin
    1407         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
     1399        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
    14081400        raise;
    14091401        end;
    … …  
    14111403end;
    14121404
     1405procedure TfrmSignOrders.FormResize(Sender: TObject);
     1406begin
     1407  inherited;
     1408  clstOrders.invalidate;
     1409end;
     1410
    14131411procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    14141412begin
    1415   if FOSTFHintWndActive then
    1416      begin
    1417      with fraCoPay do
    1418         begin
    1419         //Abbreviated captions
    1420         Label23.ShowHint := false;
    1421         StaticText1.ShowHint := false;
    1422         Label17.ShowHint := false;
    1423         Label15.ShowHint := false;
    1424         Label13.ShowHint := false;
    1425         Label11.ShowHint := false;
    1426         lblHNC.ShowHint := false;
    1427         //Long captions
    1428         Label24.ShowHint := false;
    1429         staticText4.ShowHint := false;
    1430         Label17.ShowHint := false;
    1431         Label18.ShowHint := false;
    1432         Label15.ShowHint := false;
    1433         Label16.ShowHint := false;
    1434         Label13.ShowHint := false;
    1435         Label14.ShowHint := false;
    1436         Label11.ShowHint := false;
    1437         Label12.ShowHint := false;
    1438         lblHNC.ShowHint := false;
    1439         lblHNC2.ShowHint := false;
    1440         end;
    1441      end
    1442   else
    1443      begin
    1444      with fraCoPay do
    1445         begin
    1446         //Abbreviated captions
    1447         Label23.ShowHint := true;
    1448         StaticText1.ShowHint := true;
    1449         Label17.ShowHint := true;
    1450         Label15.ShowHint := true;
    1451         Label13.ShowHint := true;
    1452         Label11.ShowHint := true;
    1453         lblHNC.ShowHint := true;
    1454         //Long captions
    1455         Label24.ShowHint := true;
    1456         staticText4.ShowHint := true;
    1457         Label17.ShowHint := true;
    1458         Label18.ShowHint := true;
    1459         Label15.ShowHint := true;
    1460         Label16.ShowHint := true;
    1461         Label13.ShowHint := true;
    1462         Label14.ShowHint := true;
    1463         Label11.ShowHint := true;
    1464         Label12.ShowHint := true;
    1465         lblHNC.ShowHint := true;
    1466         lblHNC2.ShowHint := true;
    1467         end;
    1468      end;
    1469 
     1413  fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive)
    14701414end;
    14711415
    14721416procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
    14731417begin
    1474     (Sender as TORStaticText).Font.Style := [fsBold];
     1418    (Sender as TVA508StaticText).Font.Style := [fsBold];
    14751419end;
    14761420
    14771421procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
    14781422begin
    1479     (Sender as TORStaticText).Font.Style := [];
     1423    (Sender as TVA508StaticText).Font.Style := [];
    14801424end;
    14811425
    … …  
    15121456
    15131457procedure TfrmSignOrders.FormatListForScreenReader;
    1514 var
    1515   ListStateOn : longbool;
    1516   Success: longbool;
    1517 begin
    1518   //Determine if a screen reader is currently being used.
    1519   Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
    1520   if Success and ListStateOn then
     1458begin
     1459  if ScreenReaderActive then
    15211460    SetItemTextToState;
    15221461end;

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

    r456 r829  
    22  Left = 84
    33  Top = 77
    4   Width = 464
    5   Height = 385
    64  Caption = 'Release Orders'
     5  ClientHeight = 351
     6  ClientWidth = 456
    77  Constraints.MinHeight = 365
    88  Constraints.MinWidth = 310
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    11   OnKeyDown = FormKeyDown
     11  ExplicitLeft = 84
     12  ExplicitTop = 77
     13  ExplicitWidth = 464
     14  ExplicitHeight = 385
    1215  PixelsPerInch = 96
    1316  TextHeight = 13
    14   object pnlMiddle: TPanel
     17  object pnlMiddle: TPanel [0]
    1518    Left = 0
    1619    Top = 78
    … …  
    3639        Width = 333
    3740        Height = 17
    38         BiDiMode = bdRightToLeft
    3941        Caption = '  &Release new orders immediately'
    4042        Enabled = False
    41         ParentBiDiMode = False
    4243        TabOrder = 0
    4344        OnClick = radReleaseNowClick
    … …  
    7677    end
    7778  end
    78   object pnlTop: TPanel
     79  object pnlTop: TPanel [1]
    7980    Left = 0
    8081    Top = 0
    … …  
    8990      Left = 1
    9091      Top = 1
    91       Width = 450
     92      Width = 3
    9293      Height = 34
    9394      Align = alTop
    … …  
    109110        Top = 1
    110111        Width = 24
    111         Height = 36
     112        Height = 22
    112113        Align = alLeft
    113114        AutoSize = True
    … …  
    128129          00000000000000000008}
    129130        Transparent = True
     131        ExplicitHeight = 36
    130132      end
    131133      object Label1: TLabel
    … …  
    149151    end
    150152  end
    151   object Panel1: TPanel
     153  object Panel1: TPanel [2]
    152154    Left = 0
    153155    Top = 134
    154156    Width = 456
    155     Height = 224
     157    Height = 217
    156158    Align = alClient
    157159    TabOrder = 2
    … …  
    160162      Top = 1
    161163      Width = 454
    162       Height = 222
     164      Height = 215
    163165      Align = alClient
    164       AutoScroll = False
     166      AutoScroll = True
    165167      TabOrder = 0
     168      TabStop = True
    166169      Visible = False
     170      ExplicitLeft = 1
     171      ExplicitTop = 1
     172      ExplicitWidth = 454
     173      ExplicitHeight = 215
    167174      inherited pnlDate: TPanel
    168175        Left = 349
    169         Height = 222
     176        Height = 215
     177        ExplicitLeft = 349
     178        ExplicitHeight = 215
    170179        inherited lblEffective: TLabel
    171180          Left = 453
     181          Width = 71
     182          ExplicitLeft = 453
     183          ExplicitWidth = 71
    172184        end
    173185        inherited orDateBox: TORDateBox
    174186          Left = 453
     187          ExplicitLeft = 453
    175188        end
    176189      end
    177190      inherited pnlList: TPanel
    178191        Width = 349
    179         Height = 222
     192        Height = 215
     193        ExplicitWidth = 349
     194        ExplicitHeight = 215
    180195        inherited lblEvntDelayList: TLabel
    181196          Width = 347
     197          ExplicitWidth = 80
    182198        end
    183199        inherited mlstEvents: TORListBox
    184200          Width = 347
    185           Height = 186
     201          Height = 179
    186202          OnDblClick = cmdOKClick
     203          ExplicitWidth = 347
     204          ExplicitHeight = 179
    187205        end
    188206        inherited edtSearch: TCaptionEdit
    189207          Width = 347
    190         end
    191       end
    192     end
     208          ExplicitWidth = 347
     209        end
     210      end
     211    end
     212  end
     213  inherited amgrMain: TVA508AccessibilityManager
     214    Data = (
     215      (
     216        'Component = pnlMiddle'
     217        'Status = stsDefault')
     218      (
     219        'Component = grpChoice'
     220        'Status = stsDefault')
     221      (
     222        'Component = radReleaseNow'
     223        'Status = stsDefault')
     224      (
     225        'Component = radDelayed'
     226        'Status = stsDefault')
     227      (
     228        'Component = cmdOK'
     229        'Status = stsDefault')
     230      (
     231        'Component = cmdCancel'
     232        'Status = stsDefault')
     233      (
     234        'Component = pnlTop'
     235        'Status = stsDefault')
     236      (
     237        'Component = pnldif'
     238        'Status = stsDefault')
     239      (
     240        'Component = Panel1'
     241        'Status = stsDefault')
     242      (
     243        'Component = fraEvntDelayList'
     244        'Status = stsDefault')
     245      (
     246        'Component = fraEvntDelayList.pnlDate'
     247        'Status = stsDefault')
     248      (
     249        'Component = fraEvntDelayList.orDateBox'
     250        'Status = stsDefault')
     251      (
     252        'Component = fraEvntDelayList.pnlList'
     253        'Status = stsDefault')
     254      (
     255        'Component = fraEvntDelayList.mlstEvents'
     256        'Status = stsDefault')
     257      (
     258        'Component = fraEvntDelayList.edtSearch'
     259        'Status = stsDefault')
     260      (
     261        'Component = frmOrdersTS'
     262        'Status = stsDefault'))
    193263  end
    194264end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst;
     7  fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
     8  VA508AccessibilityManager;
    89
    910type

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

    r456 r829  
    22  Left = 269
    33  Top = 192
    4   Height = 270
    54  Caption = 'Release Orders from Hold'
     5  ClientHeight = 243
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 270
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Label1: TLabel
     12  object Label1: TLabel [0]
    1113    Left = 8
    1214    Top = 8
    … …  
    1517    Caption = 'The following orders will be released from hold -'
    1618  end
    17   object lstOrders: TCaptionListBox
     19  object lstOrders: TCaptionListBox [1]
    1820    Left = 8
    1921    Top = 22
    … …  
    2426    Caption = 'The following orders will be released from hold '
    2527  end
    26   object cmdOK: TButton
     28  object cmdOK: TButton [2]
    2729    Left = 267
    2830    Top = 214
    … …  
    3436    OnClick = cmdOKClick
    3537  end
    36   object cmdCancel: TButton
     38  object cmdCancel: TButton [3]
    3739    Left = 347
    3840    Top = 214
    … …  
    4446    OnClick = cmdCancelClick
    4547  end
     48  inherited amgrMain: TVA508AccessibilityManager
     49    Data = (
     50      (
     51        'Component = lstOrders'
     52        'Status = stsDefault')
     53      (
     54        'Component = cmdOK'
     55        'Status = stsDefault')
     56      (
     57        'Component = cmdCancel'
     58        'Status = stsDefault')
     59      (
     60        'Component = frmUnholdOrders'
     61        'Status = stsDefault'))
     62  end
    4663end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type

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

    r456 r829  
    22  Left = 341
    33  Top = 182
    4   Height = 367
    54  Caption = 'Verify Orders'
     5  ClientHeight = 340
    66  Position = poScreenCenter
    77  OnCreate = FormCreate
     8  ExplicitWidth = 320
     9  ExplicitHeight = 367
    810  PixelsPerInch = 96
    911  TextHeight = 13
    10   object Panel1: TPanel
     12  object Panel1: TPanel [0]
    1113    Left = 0
    1214    Top = 0
    … …  
    2729      Align = alTop
    2830      Caption = 'The following orders will be marked as verified -'
     31      ExplicitWidth = 222
    2932    end
    3033    object lstOrders: TCaptionListBox
    … …  
    4346    end
    4447  end
    45   object Panel2: TPanel
     48  object Panel2: TPanel [1]
    4649    Left = 0
    4750    Top = 293
    … …  
    8790    end
    8891  end
     92  inherited amgrMain: TVA508AccessibilityManager
     93    Data = (
     94      (
     95        'Component = Panel1'
     96        'Status = stsDefault')
     97      (
     98        'Component = lstOrders'
     99        'Status = stsDefault')
     100      (
     101        'Component = Panel2'
     102        'Status = stsDefault')
     103      (
     104        'Component = txtESCode'
     105        'Status = stsDefault')
     106      (
     107        'Component = cmdOK'
     108        'Status = stsDefault')
     109      (
     110        'Component = cmdCancel'
     111        'Status = stsDefault')
     112      (
     113        'Component = frmVerifyOrders'
     114        'Status = stsDefault'))
     115  end
    89116end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
    88
    99type
    … …  
    127127    x := FilteredString(Items[Index]);
    128128    AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
    129     //if AHeight > 255 then AHeight := 255;
    130129    if AHeight <  13 then AHeight := 15;
    131130  end;
    … …  
    145144    ARect.Left := ARect.Left + 2;
    146145    Canvas.FillRect(ARect);
    147     Canvas.Pen.Color := clSilver;
     146    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    148147    SaveColor := Canvas.Brush.Color;
    149148    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

    r456 r829  
    1 object frmOtherSchedule: TfrmOtherSchedule
     1inherited frmOtherSchedule: TfrmOtherSchedule
    22  Left = 544
    33  Top = 262
    4   AutoScroll = False
    54  Caption = 'Order with schedule '#39'OTHER'#39
    65  ClientHeight = 362
    7   ClientWidth = 369
    8   Color = clBtnFace
     6  ClientWidth = 592
    97  Constraints.MinHeight = 70
    108  Constraints.MinWidth = 280
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    169  OldCreateOrder = False
    1710  Position = poOwnerFormCenter
    1811  OnClose = FormClose
    1912  OnCreate = FormCreate
     13  ExplicitWidth = 600
     14  ExplicitHeight = 389
    2015  PixelsPerInch = 96
    2116  TextHeight = 13
    22   object Splitter1: TSplitter
     17  object Splitter1: TSplitter [0]
    2318    Left = 0
    2419    Top = 82
    25     Width = 369
     20    Width = 592
    2621    Height = 8
    2722    Cursor = crVSplit
    … …  
    2924    Beveled = True
    3025    MinSize = 1
     26    ExplicitWidth = 369
    3127  end
    32   object Panel1: TPanel
     28  object Panel1: TPanel [1]
    3329    Left = 0
    3430    Top = 0
    35     Width = 369
     31    Width = 592
    3632    Height = 82
    3733    Align = alTop
    … …  
    5046      Left = 52
    5147      Top = 4
    52       Width = 313
     48      Width = 536
    5349      Height = 74
    5450      Align = alClient
    … …  
    6157    end
    6258  end
    63   object Panel3: TPanel
     59  object Panel3: TPanel [2]
    6460    Left = 0
    6561    Top = 90
    66     Width = 369
     62    Width = 592
    6763    Height = 272
    6864    Align = alClient
    … …  
    162158      Width = 188
    163159      Height = 202
    164       Align = alRight
    165160      Caption = 'Set Administration Time'
    166161      TabOrder = 1
    … …  
    250245      Left = 1
    251246      Top = 203
    252       Width = 367
     247      Width = 590
    253248      Height = 68
    254249      Align = alBottom
    255       TabOrder = 2
     250      TabOrder = 3
    256251      DesignSize = (
    257         367
     252        590
    258253        68)
    259254      object Label1: TLabel
    … …  
    265260      end
    266261      object btn0k1: TButton
    267         Left = 204
     262        Left = 427
    268263        Top = 43
    269264        Width = 75
    … …  
    275270      end
    276271      object btnCancel: TButton
    277         Left = 285
     272        Left = 508
    278273        Top = 42
    279274        Width = 75
    … …  
    285280        OnClick = btnCancelClick
    286281      end
    287       object txtSchedule: TEdit
    288         Left = 64
    289         Top = 8
    290         Width = 296
    291         Height = 21
    292         Anchors = [akLeft, akTop, akRight]
    293         Color = clInfoBk
    294         Enabled = False
    295         Font.Charset = DEFAULT_CHARSET
    296         Font.Color = clWindowText
    297         Font.Height = -11
    298         Font.Name = 'MS Sans Serif'
    299         Font.Style = [fsBold]
    300         ParentFont = False
    301         ReadOnly = True
    302         TabOrder = 0
    303         OnChange = txtScheduleChange
    304       end
    305282      object btnReset: TButton
    306283        Left = 8
    … …  
    312289        OnClick = btnResetClick
    313290      end
    314     end
     291      object txtSchedule: TEdit
     292        Left = 63
     293        Top = 6
     294        Width = 520
     295        Height = 21
     296        Color = clInfoBk
     297        ReadOnly = True
     298        TabOrder = 0
     299      end
     300    end
     301    object GroupBox3: TGroupBox
     302      Left = 374
     303      Top = -2
     304      Width = 211
     305      Height = 202
     306      Caption = 'Schedule'
     307      TabOrder = 2
     308      object NSScboSchedule: TORComboBox
     309        Left = 5
     310        Top = 16
     311        Width = 121
     312        Height = 180
     313        Style = orcsSimple
     314        AutoSelect = True
     315        Color = clWindow
     316        DropDownCount = 8
     317        ItemHeight = 13
     318        ItemTipColor = clWindow
     319        ItemTipEnable = True
     320        ListItemsOnly = False
     321        LongList = False
     322        LookupPiece = 1
     323        MaxLength = 0
     324        Pieces = '1'
     325        Sorted = False
     326        SynonymChars = '<>'
     327        TabOrder = 0
     328        CharsNeedMatch = 1
     329        UniqueAutoComplete = True
     330      end
     331      object btnSchAdd: TButton
     332        Left = 132
     333        Top = 64
     334        Width = 60
     335        Height = 19
     336        Caption = 'Add'
     337        TabOrder = 1
     338        OnClick = btnSchAddClick
     339      end
     340      object btnSchRemove: TButton
     341        Left = 132
     342        Top = 94
     343        Width = 60
     344        Height = 19
     345        Caption = 'Remove'
     346        TabOrder = 2
     347        OnClick = btnSchRemoveClick
     348      end
     349    end
     350  end
     351  inherited amgrMain: TVA508AccessibilityManager
     352    Data = (
     353      (
     354        'Component = Panel1'
     355        'Status = stsDefault')
     356      (
     357        'Component = memMessage'
     358        'Status = stsDefault')
     359      (
     360        'Component = Panel3'
     361        'Status = stsDefault')
     362      (
     363        'Component = GroupBox1'
     364        'Status = stsDefault')
     365      (
     366        'Component = cbo7'
     367        'Status = stsDefault')
     368      (
     369        'Component = cbo1'
     370        'Status = stsDefault')
     371      (
     372        'Component = cbo2'
     373        'Status = stsDefault')
     374      (
     375        'Component = cbo3'
     376        'Status = stsDefault')
     377      (
     378        'Component = cbo4'
     379        'Status = stsDefault')
     380      (
     381        'Component = cbo5'
     382        'Status = stsDefault')
     383      (
     384        'Component = cbo6'
     385        'Status = stsDefault')
     386      (
     387        'Component = Button1'
     388        'Status = stsDefault')
     389      (
     390        'Component = GroupBox2'
     391        'Status = stsDefault')
     392      (
     393        'Component = lstHour'
     394        'Status = stsDefault')
     395      (
     396        'Component = lstMinute'
     397        'Status = stsDefault')
     398      (
     399        'Component = btnRemove'
     400        'Status = stsDefault')
     401      (
     402        'Component = btnAdd'
     403        'Status = stsDefault')
     404      (
     405        'Component = Panel4'
     406        'Status = stsDefault')
     407      (
     408        'Component = btn0k1'
     409        'Status = stsDefault')
     410      (
     411        'Component = btnCancel'
     412        'Status = stsDefault')
     413      (
     414        'Component = btnReset'
     415        'Status = stsDefault')
     416      (
     417        'Component = GroupBox3'
     418        'Status = stsDefault')
     419      (
     420        'Component = NSScboSchedule'
     421        'Status = stsDefault')
     422      (
     423        'Component = btnSchAdd'
     424        'Status = stsDefault')
     425      (
     426        'Component = btnSchRemove'
     427        'Status = stsDefault')
     428      (
     429        'Component = frmOtherSchedule'
     430        'Status = stsDefault')
     431      (
     432        'Component = txtSchedule'
     433        'Status = stsDefault'))
    315434  end
    316435end

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc;
     7  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc, ORCtrls, rODMeds,
     8  VA508AccessibilityManager, VAUtils;
    89
    910const
    … …  
    2930    btn0k1: TButton;
    3031    btnCancel: TButton;
    31     txtSchedule: TEdit;
    3232    Label1: TLabel;
    3333    btnReset: TButton;
    … …  
    3737    btnAdd: TButton;
    3838    Button1: TButton;
     39    GroupBox3: TGroupBox;
     40    NSScboSchedule: TORComboBox;
     41    btnSchAdd: TButton;
     42    btnSchRemove: TButton;
     43    txtSchedule: TEdit;
    3944    procedure FormCreate(Sender: TObject);
    4045    procedure btnCancelClick(Sender: TObject);
    … …  
    5863      Shift: TShiftState);
    5964    procedure Button1Click(Sender: TObject);
     65    procedure btnSchAddClick(Sender: TObject);
     66    procedure btnSchRemoveClick(Sender: TObject);
     67    procedure FormDestroy(Sender: TObject);
    6068  private
    6169    FDaySchedule: array [1..7] of string;
    6270    FTimeSchedule: TStringList;
     71    FSchedule: String;
    6372    FOtherSchedule: String;
    6473    FFromCheckBox: boolean;
    … …  
    6776    procedure SetDaySchedule(Sender: TObject);
    6877    procedure SetTimeSchedule;
     78    procedure SetScheduleSelection;
    6979    procedure UpdateOnFreeTextInput;
     80    procedure EnabledTime(TF: boolean);
     81    procedure EnabledSch(TF: boolean);
    7082    function CheckDay(ADayStr: string): string;
    7183   
    … …  
    7587function ShowOtherSchedule(var ASchedule: string): boolean;
    7688
     89var
     90   frmOtherSchedule: TfrmOtherSchedule;
     91
    7792implementation
    7893
    … …  
    8095{$R *.dfm}
    8196
    82 function ShowOtherSchedule(var ASchedule: string): boolean;
    83 var
    84   frmOtherSchedule: TfrmOtherSchedule;
     97function ShowOtherSchedule(var ASchedule: string):
     98
     99boolean;
     100var
     101
     102  AdminTime, SchType: string;
    85103begin
    86104  Result := False;
    87105  try
     106   ASchedule := '';
    88107   frmOtherSchedule := TfrmOtherSchedule.Create(Application);
    89108   ResizeFormToFont(TForm(frmOtherSchedule));
    … …  
    92111   begin
    93112     ASchedule := UpperCase(frmOtherSchedule.FOtherSchedule);
     113     if frmOtherSchedule.GroupBox3.Enabled = True then
     114       begin
     115         AdminTime := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,4);
     116         schType := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,3);
     117         ASchedule := ASchedule + U + AdminTime + U + schType;
     118         //if (schType = 'P') or (schType = 'OC') then ASchedule := ASchedule + U + '1'
     119         //else ASchedule := ASchedule + U + '0';
     120       end
     121     else if frmOtherSchedule.GroupBox2.Enabled = true then
     122       begin
     123         AdminTime := Piece(ASchedule,'@',2);
     124         ASchedule := ASchedule + U + AdminTime + U + 'C';
     125       end;
    94126     Result := True;
    95127   end;
    96128  except
    97    ShowMessage('Error happen when building other schedule');
     129   ShowMsg('Error happen when building other schedule');
    98130  end;
    99131end;
    … …  
    105137  nssMsg: string;
    106138begin
     139  frmOtherSchedule := nil;
    107140  FFromCheckBox := False;
    108141  FFromEditBox := False;
    … …  
    111144   FDaySchedule[i] := '';
    112145  FTimeSchedule := TStringlist.Create;
     146  FSchedule := '';
    113147  FOtherSchedule := '';
    114148  nssMsg := GetSiteMessage;
    … …  
    116150    nssMsg := NSS_TXT;
    117151  memMessage.Lines.Add(nssMsg);
     152  LoadDOWSchedules(NSScboSchedule.Items);
     153  if ScreenReaderActive = false then txtSchedule.TabStop := false;
     154
     155end;
     156
     157procedure TfrmOtherSchedule.FormDestroy(Sender: TObject);
     158begin
     159  inherited;
     160    //FDaySchedule
     161    FTimeSchedule.Free;
     162    frmOtherSchedule := nil;
     163    //FSchedule: String;
     164    //FOtherSchedule: String;
    118165end;
    119166
    120167procedure TfrmOtherSchedule.btnCancelClick(Sender: TObject);
    121168begin
    122   modalResult := mrCancel;
     169  frmOtherSchedule.Release;
    123170end;
    124171
    … …  
    128175    (cbo6.Checked = false) and (cbo7.Checked = false) then
    129176    begin
    130       ShowMessage('A day of week must be selected!');
     177      ShowMsg('A day of week must be selected!');
    131178      Exit;
    132179    end;
    133   if not IsValidSchStr(FOtherSchedule) then
    134   begin
    135     ShowMessage('The schedule you entered is invalid!');
     180  if Pos('@', self.txtSchedule.Text) = 0 then
     181    begin
     182      ShowMsg('An Administation Time or a schedule needs to be selected');
     183      exit;
     184    end;
     185(*  if not IsValidSchStr(FOtherSchedule) then
     186  begin
     187    Show508Message('The schedule you entered is invalid!');
    136188    Exit;
    137   end;
     189  end;  *)
    138190  modalResult := mrOK;
    139191end;
    … …  
    142194var
    143195  i : integer;
    144   TimePart, DayPart: string;
     196  TimePart, DayPart, Schedule: string;
    145197begin
    146198  with (Sender as TCheckBox) do
    … …  
    152204        FDaySchedule[TCheckBox(Sender).Tag] := '';
    153205    except
    154       ShowMessage('Error happened when building day schedule.');
     206      ShowMsg('Error happened when building day schedule.');
    155207      Exit;
    156208    end;
    … …  
    159211  TimePart := '';
    160212  DayPart := '';
    161   for i := 0 to FTimeSchedule.Count - 1 do
    162   begin
    163     if i = 0 then TimePart := TimePart + FTimeSchedule[i]
    164     else TimePart := TimePart + '-' + FTimeSchedule[i];
    165   end;
     213  schedule := '';
     214  if Self.GroupBox2.Enabled = True then
     215    begin
     216        for i := 0 to FTimeSchedule.Count - 1 do
     217          begin
     218            if i = 0 then TimePart := TimePart + FTimeSchedule[i]
     219            else TimePart := TimePart + '-' + FTimeSchedule[i];
     220          end;
     221    end;
     222  if (self.GroupBox3.Enabled = True) and (FSchedule <> '') then schedule := FSchedule;
    166223  for i := Low(FDaySchedule) to High(FDaySchedule) do
    167224  begin
    … …  
    179236      FOtherSchedule := TimePart;
    180237  end
     238  else if Length(schedule) > 0 then
     239    begin
     240      if length(DayPart) > 0 then
     241      FOtherSchedule := DayPart + '@' + Schedule
     242    else if Length(DayPart) = 0 then
     243      FOtherSchedule := Schedule;
     244    end
    181245  else FOtherSchedule := DayPart;
     246  txtSchedule.Text := FOtherSchedule;
     247end;
     248
     249
     250procedure TfrmOtherSchedule.SetScheduleSelection;
     251var
     252  i: integer;
     253  DayPart: string;
     254begin
     255  DayPart := '';
     256  for i := Low(FDaySchedule) to High(FDaySchedule) do
     257  begin
     258    if Length(FDaySchedule[i])>0 then
     259    begin
     260      if DayPart = '' then DayPart := FDaySchedule[i]
     261      else DayPart := DayPart + '-' + FDaySchedule[i];
     262    end;
     263  end;
     264  if Length(DayPart) > 0 then
     265  begin
     266    if FSchedule <> '' then
     267      FOtherSchedule := DayPart + '@' + FSchedule
     268    else
     269      FOtherSchedule := DayPart;
     270  end
     271  else FOtherSchedule := FSchedule;
     272  //if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule;
    182273  txtSchedule.Text := FOtherSchedule;
    183274end;
    … …  
    278369  hour, min: string;
    279370begin
     371  if FSchedule <> '' then Exit;
    280372  if lstHour.ItemIndex < 0 then exit;
    281373  hour := lstHour.Items[lstHour.ItemIndex];
    … …  
    298390  FTimeSchedule.Sort;
    299391  SetTimeSchedule;
     392  if FTimeSchedule.Count > 0 then EnabledSch(False);
    300393end;
    301394
    … …  
    313406  lstHour.ItemIndex := -1;
    314407  lstMinute.ItemIndex := -1;
     408  NSScboSchedule.ItemIndex := -1;
    315409  for i := low(FDaySchedule) to high(FDaySchedule) do
    316410    FDaySchedule[i] := '';
    … …  
    318412  FOtherSchedule := '';
    319413  txtSchedule.Text := '';
     414  FSchedule := '';
     415  EnabledTime(True);
     416  EnabledSch(True);
     417end;
     418
     419procedure TfrmOtherSchedule.btnSchAddClick(Sender: TObject);
     420begin
     421  inherited;
     422  if self.NSScboSchedule.ItemIndex < 0 then Exit;
     423  if FSchedule <> '' then
     424    begin
     425      infoBox('A Day-of-week schedule can only contain one schedule','Warning',MB_OK);
     426      Exit;
     427    end;
     428  FSchedule := self.NSScboSchedule.Text;
     429  SetScheduleSelection;
     430  Self.NSScboSchedule.Enabled := False;
     431  EnabledTime(False);
     432end;
     433
     434procedure TfrmOtherSchedule.btnSchRemoveClick(Sender: TObject);
     435begin
     436  inherited;
     437  if (FSchedule = '') or (self.NSScboSchedule.ItemIndex < 0) then exit;
     438  if self.NSScboSchedule.Text <> FSchedule then exit;
     439  Fschedule := '';
     440  SetScheduleSelection;
     441  self.NSScboSchedule.Enabled := True;
     442  EnabledTime(True);
    320443end;
    321444
    … …  
    346469  SetTimeSchedule;
    347470  FFromCheckBox := False;
     471  if FTimeSchedule.Count = 0 then EnabledSch(True);
    348472end;
    349473
    … …  
    370494    Action := caFree;
    371495  end;
     496  //frmOtherSchedule := nil;
    372497end;
    373498
    … …  
    523648end;
    524649
     650procedure TfrmOtherSchedule.EnabledSch(TF: boolean);
     651begin
     652   self.GroupBox3.Enabled := TF;
     653   self.NSScboSchedule.Enabled := TF;
     654   self.btnSchAdd.Enabled := TF;
     655   self.btnSchRemove.Enabled := TF;
     656//   if TF = False then self.NSScboSchedule.Color := cl3DLight
     657//   else self.NSScboSchedule.Color := clWindow;
     658   if TF = False then self.NSScboSchedule.ItemIndex := -1;
     659end;
     660
     661procedure TfrmOtherSchedule.EnabledTime(TF: boolean);
     662begin
     663  self.GroupBox2.Enabled := TF;
     664  self.lstHour.Enabled := TF;
     665  self.lstMinute.Enabled := TF;
     666  self.btnAdd.Enabled := TF;
     667  self.btnRemove.Enabled := TF;
     668  if TF = False then
     669    begin
     670      self.lstHour.ItemIndex := -1;
     671      self.lstMinute.ItemIndex := -1;
     672    end;
     673end;
     674
    525675procedure TfrmOtherSchedule.lstMinuteMouseUp(Sender: TObject;
    526676  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

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

    r456 r829  
    55interface
    66
    7 uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc ;
     7uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc,fNotes ;
    88
    99type
    … …  
    7171function EnableErrorComments: boolean;
    7272function IsARTClinicalUser(var AMessage: string): boolean;
     73function GetAllergyTitleText: string;
    7374
    7475implementation
    … …  
    169170  i: integer;
    170171begin
     172
    171173  with RPCBrokerV, EditRec do
    172174    begin
    … …  
    215217                    Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i];
    216218                end;
     219
    217220            end ;
    218221          with ChartMarked do if Count > 0 then
    … …  
    241244            end;
    242245        end;
    243       CallBroker;
    244       Result := Results[0];
    245     end;
     246        CallBroker;
     247        Result := Results[0];
     248        // Include "Allergy Entered in Error" items require signature list.
     249        //cq-8002  -piece 2 is Allergy Entered in Error (IEN)
     250       // code added allowing v27 GUI changes to continue if M change is not released prior.
     251       //cq-14842 -  add observed/drug allergies to the fReview/fSignOrders forms for signature.
     252       if Length(Piece(Result,'^',2))> 0 then
     253         Changes.Add(10, Piece(Result,'^',2), GetAllergyTitleText, '', 1)
     254       else
     255          exit;
     256        end;
    246257end;
    247258
    … …  
    363374end;
    364375
     376function GetAllergyTitleText: string;
     377begin
     378    Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(floatToStr(FMToday))) +
     379              '  ' + 'Adverse React/Allergy' + ', ' + Encounter.LocationName + ', ' + User.Name;
     380end;
     381
    365382end.

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

    r456 r829  
    11unit rODBase;
    22
    3 interface
     3interface                       
    44
    55uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders;
    … …  
    132132implementation
    133133
    134 uses TRPCB, uOrders, uODBase;
     134uses TRPCB, uOrders, uODBase, fODBase;
    135135
    136136var
    … …  
    182182        begin
    183183          IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
    184           TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'hours';
     184          TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours';
    185185        end
    186186        else if (Pos('D',upperCase(IVDuration))>0) then
    187187        begin
    188           IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
    189           TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days';
     188          if Pos('DOSES', upperCase(IVDuration)) > 0 then
     189            begin
     190              IVDurVal := Copy(IVDuration, 1, length(IVDuration)-5);
     191              TResponse(ResponseList.Items[j]).IValue := 'for a total of ' + IVDurVal + ' doses';
     192            end
     193          else
     194            begin
     195              IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
     196              TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' days';
     197            end;
    190198        end
    191199        else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
    … …  
    245253begin
    246254  CallV('ORWDXQ GETQLST', [DGroup]);
    247   Dest.Assign(RPCBrokerV.Results);
     255  FastAssign(RPCBrokerV.Results, Dest);
    248256end;
    249257
    … …  
    389397  HasObjects := FALSE;
    390398  TempBroker := TStringlist.Create;
    391   TempBroker.Assign(RPCBrokerV.Results);
     399  FastAssign(RPCBrokerV.Results, TempBroker);
    392400  try
    393401  with TempBroker do while i < Count do
    … …  
    427435
    428436procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
    429 begin
    430   CallV('ORWDX LOADRSP', [OrderID]);
     437var
     438Transfer: boolean;
     439begin
     440  if ((XferOuttoInOnMeds = True) or (XfInToOutNow = True)) and (CharAt(OrderID,1)='C') then Transfer := true
     441  else Transfer := false;
     442  CallV('ORWDX LOADRSP', [OrderID, Transfer]);
    431443  ExtractToResponses(Dest, HasObjects);
    432444end;
    … …  
    704716    begin
    705717      uMedRoutes := TStringList.Create;
    706       uMedRoutes.Assign(Results);
     718      FastAssign(RPCBrokerV.Results, uMedRoutes);
    707719      for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
    708720      begin
    … …  
    714726    end; {with RPCBrokerV}
    715727  end; {if uMedRoutes}
    716   Dest.AddStrings(uMedRoutes);
     728  FastAddStrings(uMedRoutes, Dest);
    717729end;
    718730
    … …  
    758770begin
    759771  CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
    760   AList.Assign(RPCBrokerV.Results);
     772  FastAssign(RPCBrokerV.Results, AList);
    761773end;
    762774
    … …  
    783795{ Returns init values for inpatient meds dialog.  The results must be used immediately. }
    784796begin
    785   CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE]);
     797  CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE, patient.dfn, patient.location]);
    786798  Result := RPCBrokerV.Results;
    787799end;
    … …  
    790802{ Returns init values for IV Fluids dialog.  The results must be used immediately. }
    791803begin
    792   CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS]);
     804  CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS, patient.dfn, patient.location]);
    793805  Result := RPCBrokerV.Results;
    794806end;
    … …  
    802814{ Returns init values for outpatient meds dialog.  The results must be used immediately. }
    803815begin
    804   CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT]);
     816  CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT, patient.dfn, patient.location]);
    805817  Result := RPCBrokerV.Results;
    806818end;

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

    r456 r829  
    117117begin
    118118  CallV('ORWDFH TFPROD', [nil]);
    119   Dest.AddStrings(RPCBrokerV.Results);
     119  FastAddStrings(RPCBrokerV.Results, Dest);
    120120end;
    121121
    … …  
    161161begin
    162162  CallV('ORWDFH ISOLIST', [nil]);
    163   Dest.Assign(RPCBrokerV.Results);
     163  FastAssign(RPCBrokerV.Results, Dest);
    164164end;
    165165
    … …  
    167167begin
    168168  CallV('ORWDXQ GETQLST', [GroupID, 'Q']);
    169   Dest.Assign(RPCBrokerV.Results);
     169  FastAssign(RPCBrokerV.Results, Dest);
    170170end;
    171171
    … …  
    203203begin
    204204  CallV('ORWDFH CURRENT MEALS', [Patient.DFN, MealType]);
    205   Dest.Assign(RPCBrokerV.Results);
     205  FastAssign(RPCBrokerV.Results, Dest);
    206206  MixedCaseList(Dest);
    207207end;

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

    r456 r829  
    2323function  GetLastCollectionTime: string;
    2424procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
     25procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
     26procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
    2527procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
    2628procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
    2729function  StatAllowed(PatientID: string): boolean;
    2830procedure GetBloodComponents(Dest: TStrings);
     31function  NursAdminSuppress: boolean;
     32function  GetSubtype(TestName: string): string;
     33function  TNSDaysBack: integer;
     34procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
     35procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
     36function  GetLCtoWCInstructions(Alocation: integer): string;
     37procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
     38procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
     39
     40const
     41  TX0 = 'The following Lab orders will be changed to Ward Collect:';
     42  TX2 = 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect';
     43  TX5 = 'Please contact the ward staff to insure the specimen is collected.';
     44  TX6 = 'You can print this screen for reference.';
     45  TX_BLANK = '';
    2946
    3047implementation
    3148
    3249uses  rODBase;
    33 (*    fODBase, rODBase, fODLab;*)
    3450
    3551procedure GetBloodComponents(Dest: TStrings);
    … …  
    3854end;
    3955
     56function NursAdminSuppress: boolean;
     57begin
     58  Result := (StrToInt(sCallV('ORWDXVB NURSADMN',[nil])) < 1);
     59end;
     60
    4061function  StatAllowed(PatientID: string): boolean;
    4162begin
    … …  
    5677begin
    5778  tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
     79end;
     80
     81function GetSubtype(TestName: string): string;
     82begin
     83  Result := sCallV('ORWDXVB SUBCHK', [TestName]);
     84end;
     85
     86function TNSDaysBack: integer;
     87begin
     88  Result := StrToIntDef(sCallV('ORWDXVB VBTNS', [nil]),3);
     89end;
     90
     91procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
     92begin
     93  CallV('ORWUL QV4DG', [DGrpNm]);
     94  AListIEN := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 1), 0);
     95  ACount   := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
     96end;
     97
     98procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
     99var
     100  i: Integer;
     101begin
     102 CallV('ORWUL QVSUB', [AListIEN,'','']);
     103 for i := 0 to RPCBrokerV.Results.Count -1 do
     104   Dest.Add(RPCBrokerV.Results[i]);
    58105end;
    59106
    … …  
    158205end;
    159206
     207procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
     208var
     209  AList: TStringList;
     210begin
     211  AList := TStringList.Create;
     212  try
     213    CallV('ORCDLR2 CHECK ONE LC TO WC', [ALocation, '', AStartDate, ACollType, ASchedule, ADuration]);
     214    FastAssign(RPCBrokerV.Results, AList);
     215    FormatLCtoWCDisplayTextOnAccept(AList, Dest);
     216  finally
     217    AList.Free;
     218  end;
     219end;
     220
     221procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
     222var
     223  AList: TStringList;
     224begin
     225  AList := TStringList.Create;
     226  try
     227    CallV('ORCDLR2 CHECK ALL LC TO WC', [ALocation, OrderList]);
     228    FastAssign(RPCBrokerV.Results, AList);
     229    FormatLCtoWCDisplayTextOnRelease(AList, Dest);
     230  finally
     231    AList.Free;
     232  end;
     233end;
     234
     235procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
     236var
     237  i: integer;
     238  x: string;
     239begin
     240  OutputList.Clear;
     241  for i := InputList.Count - 1 downto 0 do
     242    if Piece(InputList[i], U, 2) = '1' then InputList.Delete(i);
     243  if InputList.Count > 0 then
     244  begin
     245    SetListFMDateTime('mmm dd, yyyy@hh:nn', TStringList(InputList), U, 1);
     246    with OutputList do
     247    begin
     248      Add(TX0);
     249      Add(TX_BLANK);
     250      Add('Patient :' + #9 + Patient.Name);
     251      Add('SSN     :' + #9 + Patient.SSN);
     252      Add('Location:' + #9 + Encounter.LocationName + CRLF);
     253      for i := 0 to InputList.Count - 1 do
     254        Add(Piece(InputList[i], U, 1) + #9 + Piece(InputList[i], U, 3));
     255      Add(TX_BLANK);
     256      x := GetLCtoWCInstructions(Encounter.Location);
     257      if x = '' then x := TX5;
     258      Add(x);
     259      Add(TX6);
     260    end;
     261  end;
     262end;
     263
     264procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
     265var
     266  i, j, k, Changed: integer;
     267  AList: TStringlist;
     268  x: string;
     269begin
     270  OutputList.Clear;
     271  Changed := StrToIntDef(ExtractDefault(InputList, 'COUNT'), 0);
     272  if Changed > 0 then
     273  begin
     274    AList := TStringList.Create;
     275    try
     276      with OutputList do
     277      begin
     278        Add(TX0);
     279        Add(TX_BLANK);
     280        Add('Patient :' + #9 + Patient.Name);
     281        Add('SSN     :' + #9 + Patient.SSN);
     282        Add('Location:' + #9 + Encounter.LocationName);
     283        for i := 1 to Changed do
     284        begin
     285          Add(TX_BLANK);
     286          AList.Clear;
     287          ExtractText(AList, InputList, 'ORDER_' + IntToStr(i));
     288          Add('Order   :' + #9 + AList[0]);
     289          k := Length(OutputList[Count-1]);
     290          if AList.Count > 1 then
     291            for j := 1 to AList.Count - 1 do
     292            begin
     293              Add(StringOfChar(' ', 9) + #9 + AList[j]);
     294              k := HigherOf(k, Length(OutputList[Count - 1]));
     295            end;
     296          Add(StringOfChar('-', k + 4));
     297          AList.Clear;
     298          ExtractItems(AList, InputList, 'ORDER_' + IntToStr(i));
     299          SetListFMDateTime('mmm dd, yyyy@hh:nn', AList, U, 1);
     300          for j := 0 to AList.Count - 1 do
     301            OutputList.Add(Piece(AList[j], U, 1) + #9 + Piece(AList[j], U, 3));
     302        end;
     303        Add(TX_BLANK);
     304        x := GetLCtoWCInstructions(Encounter.Location);
     305        if x = '' then x := TX5;
     306        Add(x);
     307        Add(TX6);
     308      end;
     309    finally
     310      AList.Free;
     311    end;
     312  end;
     313end;
     314
     315function GetLCtoWCInstructions(Alocation: integer): string;
     316begin
     317  Result := sCallV('ORWDLR33 LC TO WC', [Encounter.Location]);
     318end;
     319
    160320end.
     321
     322

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

    r456 r829  
    33interface
    44
    5 uses SysUtils, Classes, ORNet, ORFn, uCore, uConst;
     5uses SysUtils, Classes, ORNet, ORFn, uCore, uConst, Windows;
     6
     7type
     8   TAdminTimeHelpText = record
     9    HelpText: string;
     10  end;
     11
     12  TInpatientClozapineText = record
     13    dispText: string;
     14  end;
     15
     16  TDrugHasMaxData = record
     17    CaptureMaxData: boolean;
     18    MaxSupply: integer;
     19    MaxQuantity: integer;
     20    MaxRefills: integer;
     21  end;
    622
    723function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean;
    … …  
    1733procedure LoadFormularyAltDose(AList: TStringList; DispDrug, OI: Integer; ForInpatient: Boolean);
    1834procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string;
    19   var AdminTime: TFMDateTime; var Duration: string);
     35  var AdminTime: TFMDateTime; var Duration: string; Admin: string = '');
    2036function GetAdminTime(const StartText, Schedule: string; OrdItem: Integer): TFMDateTime;
    2137procedure LoadSchedules(Dest: TStrings; IsInptDlg: boolean = False);
     38procedure LoadDOWSchedules(Dest: TStrings);
     39procedure LoadAllIVRoutes(Dest: TStrings);
     40procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
    2241function QtyToDays(Quantity: Double;   const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
    2342function DaysToQty(DaysSupply: Integer; const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
    … …  
    3251function QOHasRouteDefined(AQOID: integer): boolean;
    3352procedure CheckExistingPI(AOrderId: string; var APtI: string);
     53function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean;
     54function AdminTimeHelpText(): string;
     55//function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean;
     56//function ValidateMaxQuantity(Quantity: integer): boolean;
     57function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean;
     58function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String;
     59procedure ClearMaxData;
     60function DifferentOrderLocations(ID: string; Loc: integer): boolean;
     61function IsClozapineOrder: boolean;
     62//function ValidateQuantityErrorMsg(Quantity: integer): String;
     63function GetQOOrderableItem(DialogIEN: string): integer;
     64
    3465
    3566implementation
     67 var
     68  uAdminTimeHelpText: TAdminTimeHelpText;
     69  uDrugHasMaxData: TDrugHasMaxData;
     70  uInpatientClozapineText : TInpatientClozapineText;
    3671
    3772function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean;
    … …  
    6095begin
    6196  CallV('ORWUL FVSUB', [ListIEN, First+1, Last+1]);  // M side not 0-based
    62   if Append then Dest.AddStrings(RPCBrokerV.Results) else
     97  if Append then FastAddStrings(RPCBrokerV.Results, Dest) else
    6398  begin
    6499    for i := Pred(RPCBrokerV.Results.Count) downto 0 do Dest.Insert(0, RPCBrokerV.Results[i]);
    … …  
    123158  if ForInpatient then PtType := 'I' else PtType := 'O';
    124159  CallV('ORWDPS1 FORMALT', [AnIEN, PtType]);
    125   AList.Assign(RPCBrokerV.Results);
     160  FastAssign(RPCBrokerV.Results, AList);
    126161end;
    127162
    … …  
    132167  if ForInpatient then PtType := 'I' else PtType := 'O';
    133168  CallV('ORWDPS1 DOSEALT', [DispDrug, OI, PtType]);
    134   AList.Assign(RPCBrokerV.Results);
     169  FastAssign(RPCBrokerV.Results, AList);
    135170end;
    136171
    137172procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string;
    138   var AdminTime: TFMDateTime; var Duration: string);
     173  var AdminTime: TFMDateTime; var Duration: string; Admin: string = '');
    139174var
    140175  x: string;
    141176begin
    142   x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location]);
     177  x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location, Admin]);
    143178  StartText := Piece(x, U, 1);
    144179  AdminTime := MakeFMDateTime(Piece(x, U, 4));
    … …  
    157192begin
    158193  // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...);
    159   CallV('ORWDPS1 SCHALL', [nil]);
    160   Dest.Assign(RPCBrokerV.Results);
     194  CallV('ORWDPS1 SCHALL', [patient.dfn, patient.location]);
     195  FastAssign(RPCBrokerV.Results, Dest);
    161196  If (Dest.IndexOfName('OTHER') < 0) and IsInptDlg then
    162197    Dest.Add('OTHER');
    163198end;
    164199
     200procedure LoadAllIVRoutes(Dest: TStrings);
     201begin
     202  CallV('ORWDPS32 ALLIVRTE', []);
     203  FastAssign(RPCBrokerV.Results, Dest);
     204end;
     205
     206procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
     207begin
     208  CallV('ORWDPS33 IVDOSFRM', [OrderIDs, Default, False]);
     209  FastAssign(RPCBrokerV.Results, Dest);
     210end;
     211procedure LoadDOWSchedules(Dest: TStrings);
     212begin
     213  // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...);
     214  CallV('ORWDPS1 DOWSCH', [patient.dfn, patient.location]);
     215  FastAssign(RPCBrokerV.Results, Dest);
     216end;
     217
    165218function QtyToDays(Quantity: Double;   const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
    166219begin
    … …  
    173226  Result := StrToIntDef(sCallV('ORWDPS2 DAY2QTY',
    174227    [DaysSupply, UnitsPerDose, Schedule, Duration, Patient.DFN, Drug]), 0);
     228  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxQuantity := Result;
    175229end;
    176230
    … …  
    183237begin
    184238  Result := StrToIntDef(sCallV('ORWDPS1 DFLTSPLY', [UnitStr, SchedStr, Patient.DFN, ADrug]), 0);
     239  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxSupply := Result;
    185240end;
    186241
    … …  
    188243begin
    189244  Result := StrToIntDef(sCallV('ORWDPS2 MAXREF', [Patient.DFN, Drug, Days, OrdItem, Discharge]), 0);
     245  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxRefills := Result;
    190246end;
    191247
    … …  
    239295end;
    240296
     297function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean;
     298var
     299MessCap, MessText: string;
     300i: integer;
     301begin
     302  result := false;
     303  MessText := '';
     304  uDrugHasMaxData.CaptureMaxData := false;
     305  uDrugHasMaxData.MaxSupply := 0;
     306  uDrugHasMaxData.MaxQuantity := 0;
     307  uDrugHasMaxData.MaxRefills := 0;
     308  CallV('ORALWORD ALLWORD', [Patient.DFN, OI, OrderType, Encounter.Provider]);
     309  for i := 0 to RPCBrokerV.Results.Count -1 do
     310    begin
     311      if i = 0 then
     312        begin
     313          MessCap := Piece(RPCBrokerV.Results.strings[i],U,1);
     314          if Piece(RPCBrokerV.Results.strings[i],U,2) = '1' then uDrugHasMaxData.CaptureMaxData := True;
     315        end;
     316      if i >0 then MessText := MessText + RPCBrokerV.Results.Strings[i] + CRLF;
     317    end;
     318  if CheckForClozapineOnly = True then
     319    begin
     320      Result := uDrugHasMaxData.CaptureMaxData = True;
     321      Exit;
     322    end;
     323  if (MessText = '') and (MessCap = '') then
     324    begin
     325      Result := True;
     326      if (InptOrder = true) and (uDrugHasMaxData.CaptureMaxData = true) then
     327        begin
     328          uDrugHasMaxData.CaptureMaxData := false;
     329          if uInpatientClozapineText.dispText = '' then
     330            begin
     331              CallV('ORDDPAPI CLOZMSG', []);
     332              for i := 0 to RPCBrokerV.Results.Count -1 do
     333                 if i = 0 then uInpatientClozapineText.dispText := RPCBrokerV.Results.Strings[i]
     334                 else uInpatientClozapineText.dispText := uInpatientClozapineText.dispText + CRLF + RPCBrokerV.Results.Strings[i];
     335            end;
     336          if uInpatientClozapineText.dispText <> '' then infoBox(uInpatientClozapineText.dispText, 'Inpatient Drug Warning', MB_OK);
     337        end;
     338      exit;
     339    end;
     340  infoBox(MessText, MessCap,MB_OK);
     341end;
     342
     343function AdminTimeHelpText(): string;
     344var
     345i: integer;
     346begin
     347      if uAdminTimeHelpText.HelpText = '' then
     348       begin
     349          CallV('ORDDPAPI ADMTIME',[]);
     350          for I := 0 to RPCBrokerV.Results.Count - 1 do
     351            if I = 0 then uAdminTimeHelpText.HelpText := RPCBrokerV.Results.Strings[i]
     352            else uAdminTimeHelpText.HelpText := uAdminTimeHelpText.HelpText + CRLF +RPCBrokerV.Results.Strings[i];
     353       end;
     354   Result := uAdminTimeHelpText.helpText
     355end;
     356
     357function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean;
     358var
     359daySupply, Quantity, Refills: integer;
     360begin
     361  Result := True;
     362  if uDrugHasMaxData.CaptureMaxData = false then exit;
     363  daySupply := DefaultDays(tempDrug, tempUnit, tempSch);
     364  if (tempSupply > daySupply) and (uDrugHasMaxData.MaxSupply > 0) then
     365    begin
     366      infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply), 'Cannot Save Error', MB_OK);
     367      Result := false;
     368      uDrugHasMaxData.CaptureMaxData := false;
     369      Exit;
     370    end;
     371  Quantity := DaysToQty(daySupply, tempUnit, tempSch, tempDur, tempDrug);
     372  if (tempQuantity > Quantity) and (uDrugHasMaxData.MaxQuantity > 0) then
     373    begin
     374      infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK);
     375      Result := false;
     376      uDrugHasMaxData.CaptureMaxData := false;
     377      Exit;
     378    end;
     379  Refills := CalcMaxRefills(tempDrug, daySupply, OI, false);
     380  if tempRefills > Refills then
     381    begin
     382      infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxRefills), 'Cannot Save Error', MB_OK);
     383      Result := false;
     384      uDrugHasMaxData.CaptureMaxData := false;
     385      Exit;
     386    end;
     387end;
     388
     389function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean;
     390var
     391str: string;
     392begin
     393  Result := True;
     394  str := '';
     395  if uDrugHasMaxData.CaptureMaxData = false then exit;
     396  if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then
     397    begin
     398      str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply);
     399      Result := false;
     400    end;
     401  if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then
     402    begin
     403      if str <> '' then str := str + CRLF + 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity)
     404      else str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
     405      result := false;
     406    end;
     407 if str <> '' then infoBox(str, 'Cannot Save Error', MB_OK);
     408 //uDrugHasMaxData.CaptureMaxData := false;
     409end;
     410
     411function ValidateMaxQuantity(Quantity: integer): boolean;
     412begin
     413  Result := True;
     414  if uDrugHasMaxData.CaptureMaxData = false then exit;
     415  if uDrugHasMaxData.MaxQuantity = 0 then exit;
     416  if Quantity > uDrugHasMaxData.MaxQuantity then
     417    begin
     418      infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK);
     419      Result := false;
     420    end;
     421end;
     422
     423function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String;
     424begin
     425  Result := '';
     426  if uDrugHasMaxData.CaptureMaxData = false then exit;
     427  if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then
     428    begin
     429      Result := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply);
     430    end;
     431  if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then
     432    begin
     433      if Result <> '' then Result := Result + CRLF + 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity)
     434      else Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
     435    end;
     436  //uDrugHasMaxData.CaptureMaxData := false;
     437end;
     438
     439function ValidateQuantityErrorMsg(Quantity: integer): String;
     440begin
     441  Result := '';
     442  if uDrugHasMaxData.CaptureMaxData = false then exit;
     443  if uDrugHasMaxData.MaxQuantity = 0 then exit;
     444  if Quantity > uDrugHasMaxData.MaxQuantity then
     445    begin
     446      Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
     447    end;
     448end;
     449
     450procedure ClearMaxData;
     451begin
     452  uDrugHasMaxData.CaptureMaxData := false;
     453end;
     454
     455function DifferentOrderLocations(ID: string; Loc: integer): boolean;
     456begin
     457   Result := (sCallV('ORWDPS33 COMPLOC', [ID, Loc])='1');
     458end;
     459
     460function IsClozapineOrder: boolean;
     461begin
     462   if uDrugHasMaxData.CaptureMaxData = true then result := true
     463   else result := false;
     464end;
     465
     466function GetQOOrderableItem(DialogIEN: string): integer;
     467begin
     468  Result := StrtoInt(SCallV('ORWDPS1 QOMEDALT',[DialogIEN]))
     469end;
     470
    241471end.

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

    r456 r829  
    1313function SubsetOfImagingTypes: TStrings;
    1414function SubsetOfRadSources(SrcType: string): TStrings;
    15 function LocationType(Location: integer): string;
     15function LocationType(Location: integer): string; 
     16function ReasonForStudyCarryOn: Boolean;
    1617
    1718implementation
    … …  
    7374begin
    7475  Result := sCallV('ORWDRA32 LOCTYPE',[Location]);
     76end;   
     77
     78function ReasonForStudyCarryOn: Boolean;
     79begin
     80  Result := sCallV('ORWDXM1 SVRPC',['']) = '1';
    7581end;
    7682

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

    r456 r829  
    3939    LinkObject:   TObject;
    4040    EnteredInError:     Integer; //AGP Changes 26.12 PSI-04-053
     41    DCOriginalOrder: boolean;
    4142    procedure Assign(Source: TOrder);
    4243    procedure Clear;
    … …  
    200201procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
    201202procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
    202 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);  {*KCM*}
    203 procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
    204 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char); {*KCM*}
     203procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);  {*KCM*}
     204procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
     205procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {*KCM*}
    205206function UseNewMedDialogs: Boolean;
    206207
    … …  
    221222procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
    222223function GetREQReason: Integer;
    223 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
     224procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
    224225procedure ReleaseOrderHold(AnOrder: TOrder);
    225226procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
    … …  
    238239function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
    239240procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
     241function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
    240242//function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
    241243
    … …  
    340342implementation
    341343
    342 uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore;
     344uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils;
    343345
    344346var
    … …  
    576578
    577579procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
    578 {           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18
    579 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig}
     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}
    580582begin
    581583  with AnOrder do
    … …  
    600602    Retrieved := True;
    601603    OrderLocIEN  := Piece(Piece(x,U,19),':',2);   //imo
    602     OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
     604    if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown'
     605    else OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
    603606    Text := y;
    604607    XMLText := z;
    … …  
    609612    else AnOrder.EnteredInError := 0;
    610613    //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA  ' + Text;
     614    if Piece(x,U,20) = '1' then DCOriginalOrder := True
     615    else DCOriginalOrder := False;
    611616  end;
    612617end;
    … …  
    655660  AnOrder: TOrder;
    656661  FilterTS: string;
     662  AlertedUserOnly: boolean;
    657663begin
    658664  ClearOrders(Dest);
    659665  if uDGroupMap = nil then LoadDGroupMap;  // to make sure broker not called while looping thru Results
    660666  FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
    661   CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
     667  AlertedUserOnly := (Notifications.Active and (AView.Filter = 12));
     668  CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]);
    662669  if ((Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '')) and (AView.Filter = 5) then      // if no expiring orders found display expired orders)
    663670  begin
    … …  
    756763  CallV('ORWOR SHEETS', [Patient.DFN]);
    757764  MixedCaseByPiece(RPCBrokerV.Results, U, 2);
    758   Dest.Assign(RPCBrokerV.Results);
    759 end;
     765  FastAssign(RPCBrokerV.Results, Dest);
     766 end;
    760767
    761768procedure LoadOrderSheetsED(Dest: TStrings);
    … …  
    771778    for i := 0 to RPCbrokerV.Results.Count - 1 do
    772779      RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders';
    773     Dest.AddStrings(RPCBrokerV.Results);
     780    FastAddStrings(RPCBrokerV.Results, Dest);
    774781  end;
    775782end;
    … …  
    812819    for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := '';
    813820    CallBroker;
    814     IDList.Assign(Results);
     821    FastAssign(RPCBrokerV.Results,IDList);
    815822  end;
    816823end;
    … …  
    10151022begin
    10161023  CallV('ORWORDG ALLTREE', [nil]);
    1017   Dest.Assign(RPCBrokerV.Results);
     1024  FastAssign(RPCBrokerV.Results, Dest);
    10181025end;
    10191026
    … …  
    10221029  CallV('ORWOR TSALL', [nil]);
    10231030  MixedCaseList(RPCBrokerV.Results);
    1024   Dest.Assign(RPCBrokerV.Results);
     1031  FastAssign(RPCBrokerV.Results, Dest);
    10251032end;
    10261033
    … …  
    10321039  otherEvts: TStringList;
    10331040  commonList: TStringList;
     1041  IsObservation: boolean;
    10341042begin
    10351043  if Encounter <> nil then
    … …  
    10371045  else
    10381046    Currloc := 0;
     1047  IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1');
    10391048  commonList := TStringList.Create;
    10401049  CallV('OREVNTX1 CMEVTS',[Currloc]);
    … …  
    10531062      commonList.Add(Results[i]);
    10541063    end
     1064    else if IsObservation then
     1065    begin
     1066      if (Piece(Results[i],'^',3) = 'T') then
     1067        Continue;
     1068      commonList.Add(Results[i]);
     1069    end
    10551070    else
    10561071    begin
    … …  
    10611076  if commonList.Count > 0 then
    10621077  begin
    1063     Dest.AddStrings(TStrings(commonList));
     1078    FastAddStrings(TStrings(commonList), Dest);
    10641079    Dest.Add('^^^^^^^^___________________________________________________________________________________________');
    10651080    Dest.Add(LLS_SPACE);
    … …  
    10741089    begin
    10751090      RPCBrokerV.Results.Delete(0);
    1076       admitEvts.AddStrings(RPCBrokerV.Results);
     1091      FastAddStrings(RPCBrokerV.Results, admitEvts);
    10771092    end;
    1078     CallV('OREVNTX ACTIVE',['T^O^M^D']);
     1093    if IsObservation then
     1094      CallV('OREVNTX ACTIVE',['O^M^D'])
     1095    else
     1096      CallV('OREVNTX ACTIVE',['T^O^M^D']);
    10791097    //MixedCaseList(RPCBrokerV.Results);
    10801098    if RPCBrokerV.Results.Count > 0 then
    10811099    begin
    10821100      RPCBrokerV.Results.Delete(0);
    1083       otherEvts.AddStrings(RPCBrokerV.Results);
     1101      FastAddStrings(RPCBrokerV.Results, otherEvts);
    10841102    end;
    1085     Dest.AddStrings(TStrings(otherEvts));
     1103    FastAddStrings(TStrings(otherEvts), Dest);
    10861104    Dest.Add('^^^^^^^^_____________________________________________________________________________________________');
    10871105    Dest.Add(LLS_SPACE);
    1088     Dest.AddStrings(TStrings(admitEvts));
     1106    FastAddStrings(TStrings(admitEvts), Dest);
    10891107    admitEvts.Free;
    10901108    otherEvts.Free;
    … …  
    10961114    if RPCBrokerV.Results.Count > 0 then
    10971115      RPCBrokerV.Results.Delete(0);
    1098     Dest.AddStrings(RPCBrokerV.Results);
     1116    FastAddStrings(RPCBrokerV.Results, Dest);
    10991117  end
    11001118  else
    … …  
    11041122    if RPCBrokerV.Results.Count > 0 then
    11051123      RPCBrokerV.Results.Delete(0);
    1106     Dest.AddStrings(RPCBrokerV.Results);
     1124    FastAddStrings(RPCBrokerV.Results, Dest);
    11071125  end;
    11081126end;
    … …  
    11111129begin
    11121130  CallV('ORWORDG REVSTS', [nil]);
    1113   Dest.Assign(RPCBrokerV.Results);
     1131  FastAssign(RPCBrokerV.Results, Dest);
    11141132end;
    11151133
    … …  
    11181136begin
    11191137  CallV('ORWORDG REVSTS', [nil]);
    1120   Dest.Assign(RPCBrokerV.Results);
     1138  FastAssign(RPCBrokerV.Results, Dest);
    11211139end;
    11221140
    … …  
    11721190       RESERVED_PIECE               + U +   // 10
    11731191       KeyVars;
    1174   CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses]);
     1192  CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]);
    11751193  // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp
    11761194  with RPCBrokerV do
    … …  
    12751293    RPCBrokerV.Results.Delete(0);
    12761294  end;
    1277   SetItems.Assign(RPCBrokerV.Results);
     1295  FastAssign(RPCBrokerV.Results, SetItems);
    12781296end;
    12791297
    … …  
    12811299begin
    12821300  CallV('ORWDX WRLST', [Encounter.Location]);
    1283   Dest.Assign(RPCBrokerV.Results);
     1301  FastAssign(RPCBrokerV.Results, Dest);
    12841302end;
    12851303
    … …  
    12901308  begin
    12911309    Dest.Clear;
    1292     Dest.Assign(RPCBrokerV.Results);
     1310  FastAssign(RPCBrokerV.Results, Dest);
    12931311  end
    12941312end;
    … …  
    13101328      then Results[i] := Piece(Results[i], U, 1);
    13111329  OrderList.Clear;
    1312   OrderList.Assign(RPCBrokerV.Results);
     1330  FastAssign(RPCBrokerV.Results, OrderList);
    13131331end;
    13141332
    … …  
    13241342  CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]);
    13251343  OrderList.Clear;
    1326   OrderList.Assign(RPCBrokerV.Results);
     1344  FastAssign(RPCBrokerV.Results, OrderList);
    13271345end;
    13281346
    … …  
    13391357end;
    13401358
    1341 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);
    1342 begin
    1343   CallV('ORWD1 RVPRINT',  [Encounter.Location, DeviceInfo, OrderList]);
    1344 end;
    1345 
    1346 procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
    1347 begin
    1348   CallV('ORWD1 SVONLY',  [Encounter.Location, OrderList]);
     1359procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);
     1360var
     1361Loc: Integer;
     1362begin
     1363  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
     1364  else Loc := Encounter.Location;
     1365  CallV('ORWD1 RVPRINT',  [Loc, DeviceInfo, OrderList]);
     1366end;
     1367
     1368procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
     1369var
     1370Loc: Integer;
     1371begin
     1372  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
     1373  else Loc := Encounter.Location;
     1374  CallV('ORWD1 SVONLY',  [Loc, OrderList]);
    13491375end;
    13501376
    … …  
    14321458  CallV('ORWOR ACTION TEXT',[ID]);
    14331459  if RPCBrokerV.Results.Count > 0 then
    1434     Errlist.Assign(RPCBrokerV.Results);
     1460    FastAssign(RPCBrokerV.Results, Errlist);
    14351461end;
    14361462
    … …  
    15151541procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
    15161542begin
    1517   CallV('ORWDXA DCREASON', [nil]);
     1543  CallV('ORWDX2 DCREASON', [nil]);
    15181544  ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
    15191545  //AGP Change 26.15 for PSI-04-63
    … …  
    15261552end;
    15271553
    1528 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
    1529 var
    1530   AParentID : string;
     1554procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
     1555var
     1556  AParentID, DCOrigOrder: string;
    15311557begin
    15321558  AParentID := AnOrder.ParentID;
    1533   CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason]);
     1559  if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1'
     1560  else DCOrigOrder := '0';
     1561  CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]);
    15341562  UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID);
    15351563  DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0);
    … …  
    15531581begin
    15541582  CallV('ORWDXA FLAGTXT', [ID]);
    1555   Dest.Assign(RPCBrokerV.Results);
     1583  FastAssign(RPCBrokerV.Results, Dest);
    15561584end;
    15571585
    … …  
    15651593begin
    15661594  CallV('ORWDXA WCGET', [ID]);
    1567   Dest.Assign(RPCBrokerV.Results);
     1595  FastAssign(RPCBrokerV.Results, Dest);
    15681596end;
    15691597
    … …  
    16141642      if piece(Results[0],'^',1) = '-1' then
    16151643        begin
    1616           ShowMessage('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
     1644          ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
    16171645            'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF +
    16181646            'If this problem persists, then there is a problem in the CPRS PKI interface, and it needs to be reported through the proper channels, to the developer Cary Malmrose.');
    … …  
    16511679  SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
    16521680  SetOrderFromResults(AnOrder);
     1681end;
     1682
     1683function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
     1684begin
     1685 Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1;
    16531686end;
    16541687
    … …  
    16981731  CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
    16991732  if RPCBrokerV.Results.Count > 0 then
    1700     RejectedReason.Assign(RPCBrokerV.Results);
     1733    FastAssign(RPCBrokerV.Results, RejectedReason);
    17011734end;
    17021735
    … …  
    20762109      MixedCaseList( RPCBrokerV.Results );
    20772110      RPCBrokerV.Results.Delete(0);
    2078       Dest.Assign(RPCBrokerV.Results);
     2111      FastAssign(RPCBrokerV.Results, Dest);
    20792112    end;
    20802113  end;
    … …  
    20872120  begin
    20882121    SortByPiece(TStringList(RPCBrokerV.Results),'^',2);
    2089     Dest.Assign(RPCBrokerV.Results);
     2122    FastAssign(RPCBrokerV.Results, Dest);
    20902123  end;
    20912124end;
    … …  
    21882221    then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
    21892222    else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
    2190   ListOfChecks.Assign(RPCBrokerV.Results);
     2223  FastAssign(RPCBrokerV.Results, ListOfChecks);
    21912224end;
    21922225
    … …  
    21982231    then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList])
    21992232    else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
    2200   ListOfChecks.Assign(RPCBrokerV.Results);
     2233  FastAssign(RPCBrokerV.Results, ListOfChecks);
    22012234end;
    22022235
    … …  
    22042237begin
    22052238  CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
    2206   ListOfChecks.Assign(RPCBrokerV.Results);
     2239  FastAssign(RPCBrokerV.Results, ListOfChecks);
    22072240end;
    22082241
    … …  
    22532286                                  (PromptForWorkCopy     in ['1','2']));
    22542287        RPCBrokerV.Results.Delete(0);
    2255         OrdersToPrint.Assign(RPCBrokerV.Results);
     2288        FastAssign(RPCBrokerV.Results, OrdersToPrint);
    22562289      end;
    22572290    Result := TempParams;
    … …  
    22622295*)
    22632296
    2264 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char);
     2297procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0);
    22652298var
    22662299  x: string;
    22672300begin
    22682301  if Nature <> #0 then
    2269     CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList])
     2302    begin
     2303       if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList])
     2304       else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]);
     2305    end
    22702306  else
    2271     CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
     2307    begin
     2308      if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList])
     2309      else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
     2310    end;
    22722311  x := RPCBrokerV.Results[0];
    22732312  FillChar(PrintParams, SizeOf(PrintParams), #0);
    … …  
    22952334      RPCBrokerV.Results.Delete(0);
    22962335      OrderList.Clear;
    2297       OrderList.Assign(RPCBrokerV.Results);
     2336      FastAssign(RPCBrokerV.Results, OrderList);
    22982337    end;
    22992338end;

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

    r456 r829  
    2323procedure PushKeyVars(const NewVals: string);
    2424procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
     25procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
     26            var CancelText: string; Sender: TObject);
    2527
    2628implementation
    2729
    2830uses
    29   dShared, Windows, rTemplates;
     31  dShared, Windows, rTemplates, SysUtils, StdCtrls, fOrders, rOrders;
    3032
    3133var
    … …  
    190192end;
    191193
     194// Check for diet orders that will be auto-DCd on release because of start/stop overlaps.
     195// Moved here for visibility because it also needs to be checked on an auto-accept order.
     196procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
     197            var CancelText: string; Sender: TObject);
     198const
     199  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
     200              'you specify a start date for when the new diet should replace the current' + CRLF +
     201              'diet:' + CRLF + CRLF;
     202  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
     203  TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
     204  TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
     205                    'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
     206
     207                    '1. Specify an expiration date/time for this order that will' + CRLF +
     208                    '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
     209
     210                    '2. Specify a later start date/time for this order for when you' + CRLF +
     211                    '   would like it to cancel and replace those other orders.';
     212
     213var
     214  i: integer;
     215  AStringList: TStringList;
     216  AList: TList;
     217  x, PtEvtIFN, PtEvtName: string;
     218  //AResponse: TResponse;
     219begin
     220  if EvtID = 0 then   // check current and future released diets
     221  begin
     222    x := CurrentText;
     223    if Piece(x, #13, 1) <> 'Current Diet:  ' then
     224    begin
     225      AStringList := TStringList.Create;
     226      try
     227        AStringList.Text := x;
     228        CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
     229                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
     230        if AStringList.Count > 1 then
     231        begin
     232          CancelText := CancelText + CRLF + CRLF +
     233                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
     234                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
     235          if AStringList.Count > 2 then
     236          for i := 2 to AStringList.Count - 1 do
     237            CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
     238        end;
     239      finally
     240        AStringList.Free;
     241      end;
     242    end;
     243  end
     244  else if Sender is TButton then     // delayed orders code here - on accept only
     245  begin
     246    //AResponse := Responses.FindResponseByName('STOP', 1);
     247    //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
     248    AList := TList.Create;
     249    try
     250      PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
     251      PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
     252      LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
     253      for i := AList.Count - 1 downto 0 do
     254      begin
     255        if TOrder(Alist.Items[i]).DGroup <> DispGrp then
     256        begin
     257          TOrder(AList.Items[i]).Free;
     258          AList.Delete(i);
     259        end;
     260      end;
     261      if AList.Count > 0 then
     262      begin
     263        x := '';
     264        RetrieveOrderFields(AList, 0, 0);
     265        CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName;
     266        for i := 0 to AList.Count - 1 do
     267          with TOrder(AList.Items[i]) do
     268          begin
     269            x := x + #9 + Text + CRLF;
     270(*            if StartTime <> '' then
     271              x := #9 + x + 'Start:   ' + StartTime + CRLF
     272            else
     273              x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
     274          end;
     275        CancelText := CancelText + CRLF + CRLF + x;
     276        CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
     277      end;
     278    finally
     279      with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
     280      AList.Free;
     281    end;
     282  end;
     283end;
     284
     285
    192286initialization
    193287  uOrderEventType := #0;

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
    7   Dialogs, ORCtrls, stdCtrls, strUtils, fODBase;
     7  Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA;
    88
    99type
    1010  EOrderDlgFail = class(Exception);
     11
     12  //FQOAltOI = record
     13  //OI: integer;
     14  //end;
    1115
    1216{ Ordering Environment }
    … …  
    5862procedure QuickOrderListEdit;
    5963function RefNumFor(AnOwner: TComponent): Integer;
    60 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
     64procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer; EncLocName, WardLocName: string);
     65procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
    6166procedure SetFontSize( FontSize: integer);
    6267procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
     68//function GetQOAltOI: integer;
    6369
    6470{ Inpatient medication for Outpatient}
    … …  
    7985ProcDisp : Integer;
    8086ImgDisp  : Integer;
     87DietDisp : Integer;
    8188NonVADisp: Integer;
    8289MedsInDlgIen  : Integer;
    … …  
    9299OriginalMedsInHeight: Integer;
    93100OriginalNonVAMedsHeight: Integer;
     101PassDrugTstCall: boolean;
    94102
    95103implementation
    … …  
    100108     fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase,
    101109     fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy,
    102      UBAGlobals, fClinicWardMeds, uTemplateFields;
     110     UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils;
    103111
    104112var
    … …  
    113121  uOrderSetTime: TFMDateTime;
    114122  uNewMedDialog: Integer;
     123  //QOALTOI: FQOAltOI;
    115124
    116125const
    … …  
    453462    tmpList.Add('Cannot be released to service(s) because of the following happened action(s):');
    454463    tmpList.Add(' ');
    455     tmpList.AddStrings(TStrings(AnErrLst));
     464    FastAddStrings(TStrings(AnErrLst), tmpList);
    456465    ReportBox(tmpList,'Cannot be released to service(s)',False);
    457466    tmpList.Free;
    … …  
    472481  ProcDisp := DisplayGroupByName('PROC');
    473482  ImgDisp  := DisplayGroupByName('XRAY');
     483  DietDisp := DisplayGroupByName('DO');
    474484  NonVADisp := DisplayGroupByName('NV RX');
    475485  MedsInDlgIen  := DlgIENForName('PSJ OR PAT OE');
    … …  
    763773  end else
    764774  begin
    765     //ShowMessage('Order Dialogs of type "Action" are available in List Manager only.');
     775    //Show508Message('Order Dialogs of type "Action" are available in List Manager only.');
    766776    Result := False;
    767777  end;
    … …  
    774784  TC_NO_DEA     = 'DEA# Required';
    775785  TC_IMO_ERROR  = 'Inpatient medication order on outpatient authorization required';
     786  TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
     787  TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
    776788var
    777789  ResolvedDialog: TOrderDialogResolved;
    778   x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr: string;
    779   ODItem: integer;
    780   IsInpatient, IsAnIMOOrder: boolean;
    781   IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO: boolean;
     790  x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr, tempUnit, tempSupply, tempDrug, tempSch: string;
     791  temp,tempDur,tempQuantity, tempRefills: string;
     792  i, ODItem, tempOI, ALTOI: integer;
     793  DrugCheck, IsInpatient, IsAnIMOOrder, DrugTestDlgType: boolean;
     794  IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO, IsNewOrder: boolean;
    782795  tmpResp: TResponse;
     796  CxMsg: string;
     797  AButton: TButton;
    783798begin
    784799  IsPsoSupply := False;
    … …  
    787802  IsAnIMOOrder  := False;
    788803  ForIMO := False;
     804  IsNewOrder := True;
     805  PassDrugTstCall := False;
     806  DrugCheck := false;
     807  DrugTestDlgType := false;
     808  //QOAltOI.OI := 0;
    789809  // double check environment before continuing with order
    790810  if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
    … …  
    792812  if CharAt(AnID, 1) = 'X' then
    793813  begin
     814    IsNewOrder := False;
     815   // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
    794816    ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE,   x);
    795817    if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then
    … …  
    800822      x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
    801823    if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit;
     824    DrugCheck := true;
    802825  end;
    803826  if CharAt(AnID, 1) = 'C' then
    804827  begin
     828    IsNewOrder := False;
     829    //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
    805830    ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY,     x);
    806831    if Length(x) > 0 then
    807832      x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
    808     if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY)   then Exit;
     833    if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
     834    DrugCheck := true;
    809835 end;
    810836  if CharAt(AnID, 1) = 'T' then
    811837  begin
     838    IsNewOrder := False;
     839    if (XfInToOutNow = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
     840    if (XfInToOutNow = false) then
     841      begin
     842       if (XferOuttoInOnMeds = True) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
     843       if (XferOuttoInOnMeds = False) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', False)=false) then Exit;
     844      end;
    812845    ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x);
    813846    if Length(x) > 0 then
    … …  
    824857  else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then
    825858    ForIMO := True;
    826 
    827859  OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
    828860  OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
    … …  
    831863  ResolvedDialog.InputID := AnID;
    832864  BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO);
     865  if (ResolvedDialog.DisplayGroup = InPtDisp) or (ResolvedDialog.DisplayGroup = ClinDisp) then DrugTestDlgType := true;
     866  if (DrugCheck = true) and (ResolvedDialog.DisplayGroup = OutPtDisp) and
     867  (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
     868  if (DrugCheck = true) and (DrugTestDlgType = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
     869  if (IsNewOrder = True) and (ResolvedDialog.DialogType = 'Q') and
     870     ((ResolvedDialog.DisplayGroup = OutptDisp) or (DrugTestDlgType = true)) then
     871    begin
     872      if (PassDrugTest(ResolvedDialog.DialogIEN, 'Q', DrugTestDlgType)=false) then Exit
     873      else PassDrugTstCall := True;
     874    end;
    833875  if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen)
    834876    or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then
    … …  
    866908     if (Length(NssErr) > 1) then
    867909     begin
    868        if (NssErr <> 'OTHER') then
    869          ShowMessage('The order contains invalid non-standard schedule.');
     910       if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then
     911         ShowMsg('The order contains invalid non-standard schedule.');
    870912       NSSchedule := True;
    871913       ResolvedDialog.QuickLevel := 0;
    … …  
    878920      if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then
    879921      begin
    880         ShowMessage('The order contains invalid non-standard schedule.');
     922        ShowMsg('The order contains invalid non-standard schedule.');
    881923        NSSchedule := True;
    882924      end;
    … …  
    884926    if NSSchedule then ResolvedDialog.QuickLevel := 0;
    885927  end;
     928 (* if (ResolvedDialog.DialogType = 'Q') and ((ResolvedDialog.FormID = OD_MEDINPT) or (ResolvedDialog.FormID = OD_MEDOUTPT)) then
     929    begin
     930      temp := '';
     931      tempOI := GetQOOrderableItem(ResolvedDialog.InputID);
     932      if tempOI >0 then
     933        begin
     934          ALTOI := tempOI;
     935          CheckFormularyOI(AltOI,temp,True);
     936          if ALTOI <> tempOI then
     937            begin
     938              ResolvedDialog.QuickLevel := 0;
     939              QOAltOI.OI := ALTOI;
     940            end;
     941        end;
     942    end; *)
     943  //   ((ResolvedDialog.DisplayGroup = InptDisp) or (ResolvedDialog.DisplayGroup = OutptDisp) or (ResolvedDialog.DisplayGroup = MedsDisp)) then
     944 //    ResolvedDialog.QuickLevel := 0;
    886945  with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
     946
     947  // Check for potential conflicting auto-accept delayed-release diet orders (CQ #10946 - v27.36 - RV)
     948  with ResolvedDialog do if (QuickLevel = QL_AUTO) and (DisplayGroup = DietDisp) and (AnEvent.EventType <> 'C') then
     949  begin
     950    AButton := TButton.Create(Application);
     951    try
     952      CheckForAutoDCDietOrders(AnEvent.EventIFN, DisplayGroup, '', CxMsg, AButton);
     953      if CxMsg <> '' then
     954      begin
     955        if InfoBox(CxMsg + CRLF + CRLF + TX_EVTDEL_DIET_CONFLICT,
     956           TC_EVTDEL_DIET_CONFLICT,
     957           MB_ICONWARNING or MB_YESNO) = ID_NO
     958           then QuickLevel := QL_DIALOG;
     959      end;
     960    finally
     961      AButton.Free;
     962    end;
     963  end;
     964
    887965  with ResolvedDialog do
    888966  begin
    … …  
    10351113          else
    10361114             begin
     1115             if uOrderDialog.DisplayGroup = OutptDisp then
     1116               begin
     1117                 tempUnit := '';
     1118                 tempSupply := '';
     1119                 tempDrug := '';
     1120                 tempSch := '';
     1121                 tempDur := '';
     1122                 tmpResp := uOrderDialog.Responses.FindResponseByName('SUPPLY', 1);
     1123                 if tmpResp = nil then tempSupply := '0'
     1124                 else tempSupply := tmpResp.EValue;
     1125                 tmpResp := uOrderDialog.Responses.FindResponseByName('QTY', 1);
     1126                 if tmpResp = nil then tempQuantity := '0'
     1127                 else tempQuantity := tmpResp.EValue;
     1128                 tmpResp := uOrderDialog.Responses.FindResponseByName('REFILLS', 1);
     1129                 if tmpResp = nil then tempRefills := '0'
     1130                 else tempRefills := tmpResp.EValue;
     1131                 tmpResp := uOrderDialog.Responses.FindResponseByName('ORDERABLE', 1);
     1132                 tempOI := StrToIntDef(tmpResp.IValue,0);
     1133                 i := uORderDialog.Responses.NextInstance('DOSE',0);
     1134                 while i > 0 do
     1135                   begin
     1136                      x := Piece(uOrderDialog.Responses.IValueFor('DOSE',i), '&', 3);
     1137                      tempUnit := tempUnit + X + U;
     1138                      x := uOrderDialog.Responses.IValueFor('SCHEDULE',i);
     1139                      tempSch := tempSch + x + U;
     1140                      x := uOrderDialog.Responses.IValueFor('DRUG', i);
     1141                      tempDrug := Piece(x, U, 1);
     1142                      i := Responses.NextInstance('DOSE', i);
     1143                      x := UORderDialog.Responses.IValueFor('DAYS', i);
     1144                      tempDur := tempDur + x + '~';
     1145                      x := uOrderDialog.Responses.IValueFor('CONJ', i);
     1146                      tempDur := tempDur + x + U;
     1147                   end;
     1148                 if ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur, tempOI, StrtoInt(tempSupply), StrtoInt(tempQuantity), StrtoInt(tempRefills)) = false then Exit;
     1149               end;
    10371150             cmdAcceptClick(Application);  // auto-accept order
    10381151             Result := uOrderDialog.AcceptOK;
    10391152
    10401153             //BAPHII 1.3.2
    1041              //showmessage('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
     1154             //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
    10421155
    10431156             //End BAPHII 1.3.2
    … …  
    10611174  if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
    10621175    then UnlockOrder(EditedOrder);
    1063 
     1176  //QOAltOI.OI := 0;
    10641177end;
    10651178
    … …  
    11121225  uOrderHTML.ShowModal;
    11131226  ASetList := TStringList.Create;
    1114   ASetList.Assign(uOrderHTML.SetList);
     1227  FastAssign(uOrderHTML.SetList, ASetList);
    11151228  uOrderHTML.Release;
    11161229  if ASetList.Count = 0 then Exit;
    … …  
    16691782end;
    16701783
    1671 
    1672 procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
     1784procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer;
     1785EncLocName, WardLocName: string);
     1786var
     1787i,j: integer;
     1788tempOrder: string;
     1789tempOrderList: TStringList;
     1790begin
     1791  tempOrderList := TStringList.Create;
     1792  if (ClinicLst <> nil) and (ClinicLst.Count > 0) then
     1793    begin
     1794      for i := 0 to ClinicLst.Count - 1 do
     1795        begin
     1796          tempOrder := ClinicLst.Strings[i];
     1797          for j := 0 to OrderList.Count - 1 do
     1798            if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
     1799        end;
     1800      if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, EncLoc, EncLocName);
     1801    end;
     1802  if (WardLst <> nil) and (WardLst.Count > 0) then
     1803    begin
     1804      if tempOrderList.Count > 0 then
     1805        begin
     1806          tempOrderList.Free;
     1807          tempOrderList := TStringList.Create;
     1808        end;
     1809      for i := 0 to WardLst.Count - 1 do
     1810        begin
     1811          tempOrder := WardLst.Strings[i];
     1812          for j := 0 to OrderList.Count - 1 do
     1813            if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
     1814        end;
     1815      if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, WardLoc, WardLocName);
     1816    end;
     1817    tempOrderList.Free;
     1818end;
     1819
     1820procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
    16731821const
    16741822  TX_NEW_LOC1   = 'The patient''s location has changed to ';
    … …  
    16911839          then Encounter.Location := ALocation;
    16921840        end;
    1693     end
    1694   else
    1695     Encounter.Location := PrintLoc;
     1841    end;
     1842  //else
     1843  //Encounter.Location := PrintLoc;
     1844  if PrintLoc = 0
     1845    then PrintLoc := CommonLocationForOrders(OrderList);
     1846  if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
     1847 
     1848  if PrintLoc = 0 then                      // location required for DEVINFO
     1849  begin
     1850    LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
     1851    if ALocation > 0 then
     1852      begin
     1853        PrintLoc := ALocation;
     1854        Encounter.Location := ALocation;
     1855      end;
     1856  end;
     1857  if printLoc = 0 then frmFrame.DisplayEncounterText;
     1858  if PrintLoc <> 0 then
     1859  begin
     1860    SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName, PrintLoc);
     1861    if PrintIt then
     1862      PrintOrdersOnReview(OrderList, DeviceInfo, PrintLoc)
     1863    else
     1864      PrintServiceCopies(OrderList, PrintLoc);
     1865  end
     1866  else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
     1867 (*   Encounter.Location := PrintLoc;
    16961868  if Encounter.Location = 0
    16971869    then Encounter.Location := CommonLocationForOrders(OrderList);
    … …  
    17011873    if ALocation > 0 then Encounter.Location := ALocation;
    17021874  end;
    1703   frmFrame.DisplayEncounterText;
     1875  if printLoc = 0 then frmFrame.DisplayEncounterText;
    17041876  if Encounter.Location <> 0 then
    17051877  begin
    1706     SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt);
     1878    SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName);
    17071879    if PrintIt then
    17081880      PrintOrdersOnReview(OrderList, DeviceInfo)
    … …  
    17101882      PrintServiceCopies(OrderList);
    17111883  end
    1712   else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
     1884  else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);  *)
    17131885end;
    17141886
    … …  
    17311903   NMRec.LastIndex := NewIndex;
    17321904end;
     1905
     1906(*function GetQOAltOI: integer;
     1907begin
     1908  Result := QOAltOI.OI;
     1909end; *)
    17331910
    17341911function IsIMODialog(DlgID: integer): boolean; //IMO
Note: See TracChangeset for help on using the changeset viewer.