Changeset 829 for cprs/trunk

cprs/trunk/CPRS-Chart/BA/UBAConst.pas

r456	r829
30	30	MILITARY_SEXUAL_TRAUMA = 'MST';
31	31	COMBAT_VETERAN = 'CV';
	32	SHIPBOARD_HAZARD_DEFENSE= 'SHD';
32	33
33	34	MAX_DX = 4;

cprs/trunk/CPRS-Chart/BA/UBACore.pas

-              r456
+              r829
   end;
    BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
+   FastAssign(holdOrderList, BAOrderList); //assign signable orders to BAOrderList for further processing
    holdOrderList.Clear; // CQ5025
     //call with passList determine if LRMP
      if rpcOrderRequiresDx(passList) then
       BAOrderList.Assign(updatedBAOrderList);
+      FastAssign(updatedBAOrderList, BAOrderList);
     // check of all orders dx columns are flagged with N/A.....
 …
     end
     else
        updatedList.Assign(pList);
+       FastAssign(pList, updatedList);
     // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.IsOrderBillable()');{$endif}
         raise;
         end;
 …
         begin
            // Verify Patient is Insured
+           // OR Switch = 2 ask questions for all patients.
            if  rpcIsPatientInsured(pPatientDFN)  then
               BILLING_AWARE := TRUE;
 …
        on EListError do
        begin
          {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
+         {$ifdef debug}Show508Message('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
          raise;
      end;
 …
 procedure rpcGetSC4Orders;
 begin
+//  ****** RPC Logic returning SC/TF codes for COPAY  ********
+//     if (CIDC is ON) and (PatientInsured is True) then
+//        return SC/TF for OutPatient Meds, Labs, Prosthetics, Imaging.
+//     else
+//       return SC/TF for Outpatient Meds only.
    RPCBrokerV.Param[0].PType := literal;
    RPCBrokerV.Param[0].Value := Patient.DFN;
 …
     uDxLst.Clear;
     tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
     UBACore.UDxLst.Assign(tmplst);
+    FastAssign(tmplst, UBACore.UDxLst);
     tmplst.clear;
 end;
 …
 function  rpcIsPatientInsured(pPatientDFN: string):boolean;
 begin
    Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1');
+   Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) > '0');
 end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.OrdersHaveDx()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.OrdersHaveDx()');{$endif}
         raise;
         end;
 …
    UBAGlobals.MST := Copy(x,5,1);
    UBAGlobals.HNC := Copy(x,6,1);
+   UBAGlobals.CV :=  Copy(x,7,1);
+   UBAGlobals.CV  := Copy(x,7,1);
+   UBAGlobals.SHD := Copy(x,8,1);
 end;
 …
              UBAGlobals.HNC := 'C';
+       if UBAGlobals.SHD <> 'N' then
+          if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
+             UBAGlobals.SHD := 'C';
        //  Build Treatment Factor List to be passed to fOrdersSign form
        strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV);
+       strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV + SHD);
        UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut );
      end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
         raise;
         end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.OrderRequiresSCEI()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.OrderRequiresSCEI()');{$endif}
         raise;
         end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
         raise;
         end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
         raise;
         end;
 …
                  if piece(x,U,1) = COMBAT_VETERAN then
                  begin
+                  if piece(x,U,2) = '1' then
+                     UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
+                  else
+                     UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
+               end;
+         end;
+                   if piece(x,U,2) = '1' then
+                      UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
+                   else
+                      UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
+                 end
+                 else
+                    if piece(x,U,1) = SHIPBOARD_HAZARD_DEFENSE then
+                    begin
+                       if piece(x,U,2) = '1' then
+                          UBAGlobals.BAFactorsRec.FBAFactorSHAD := Piece(x,U,3)
+                      else
+                         UBAGlobals.BAFactorsRec.FBAFactorSHAD := (UBAGlobals.BAFactorsRec.FBAFactorSHAD + CRLF + Piece(x,U,3) );
+                  end;
+            end;
   except
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.BuileTFHintRec()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.BuileTFHintRec()');{$endif}
         raise;
         end;
 …
      on EListError do
         begin
            {$ifdef debug}ShowMessage('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
+           {$ifdef debug}Show508Message('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
            raise;
         end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBACore.LoadConsultOrderRec()');{$endif}
+        {$ifdef debug}Show508Message('EListError in UBACore.LoadConsultOrderRec()');{$endif}
         raise;
         end;
 …
      with thisRetVal do
      begin
         FBAOrderID := pOrderID;
+        FBAOrderID    := pOrderID;
         FBAEligible   := pEligible;
         FBATFactors   := pTFactors;
 …
   tmpOrderList: TStringList;
 begin
     orderList := TStringList.Create;
+    orderList    := TStringList.Create;
     tmpOrderList := TStringList.Create;
     orderList.Clear;
 …
     strTFactors   :=  pPLFactors;  // value selected from problem list
     strFlagsOut   := '';   // flags updated with selected values from problem list
     x := strFlagsAsIs;
     Result := '';
+    x             := strFlagsAsIs;
+    Result        := '';
     UBAGlobals.SC  := Copy(x,1,1);
 …
     UBAGlobals.MST := Copy(x,5,1);
     UBAGlobals.HNC := Copy(x,6,1);
+    UBAGlobals.CV :=  Copy(x,7,1); // load factors to global vars;
+    UBAGlobals.CV  :=  Copy(x,7,1); // load factors to global vars;
+    UBAGlobals.SHD := Copy(x,8,1);
   if UBAGlobals.SC  <> 'N' then
 …
           UBAGlobals.CV := 'C';
+    if UBAGlobals.SHD <> 'N' then
+       if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
+          UBAGlobals.SHD := 'C';
      strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR +
                      UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC +
                      UBAGlobals.CV);
+                     UBAGlobals.CV + UBAGlobals.SHD);
   Result := strFlagsOut;
 end;
 …
    holdList := TStringList.Create;
    holdList.Clear;
    holdList.Assign(UBAGlobals.BACopiedOrderFlags);
+   FastAssign(UBAGlobals.BACopiedOrderFlags, holdList);
    UBAGlobals.BACopiedOrderFlags.Clear;
    for i := 0 to holdList.Count-1 do
 …
       holdList := TStringList.Create;
       holdList.Clear;
       holdList.Assign(UBAGlobals.BAConsultPLFlags);
+      FastAssign(UBAGlobals.BAConsultPLFlags, holdList);
       UBAGlobals.BAConsultPLFlags.Clear;
       for i := 0 to holdList.Count-1 do

cprs/trunk/CPRS-Chart/BA/UBAGlobals.pas

-              r456
+              r829
    PtHNC:boolean;
    PtMST:boolean;
+   PtSHAD:boolean;
    constructor Create(Alist:TStringList);
    function GetGMPDFN(dfn:string;name:String):string;
 …
      FBAFactorHNC       : string;
      FBAFactorCV        : string;
+     FBAFactorSHAD       : string;
   end;
 …
      CB_HNC             :string;
      CB_CV              :string;
+     CB_SHAD             :string;
   end;
 …
   TFactors          : string;
   SC,AO,IR          : string;
   MST,HNC,CV,EC     : string;
+  MST,HNC,CV,SHD,EC : string;
   PLFactorsIndexes  : TStringList;
   BAHoldPrimaryDx   : string;     //  used to verify primart dx has been changed.
   BAPrimaryDxChanged: boolean;
-//  OrdersReqDxLst    : TStringList;  // List of selected Orders flagged collect DX Y/N
   NonBillableOrderList : TStringList;  // contains reference to those selected orders that are non billable
   OrderListSCEI    : TSTringList;  //   OrderID Exists SCEI are required.
 …
   BAFWarningShown: boolean;       // flag used to determine if Inactive ICD Code has been shown.
   BAPersonalDX:  boolean;
-//  BAConsultOrdersRequireDx: TStringList; //orderid  -  if orderid exists - consult order that requires dx...
   BADeltedOrders: TStringList;
 implementation
+uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore;
+uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore,
+  VAUtils;
 procedure RemoveOrderFromDxList(thisOrderID: string);
 …
         on EListError do
            begin
            {$ifdef debug}ShowMessage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
+           {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
            raise;
            end;
 …
                            on EListError do
                              begin
                               {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
+                              {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
                               raise;
                              end;
 …
                            on EListError do
                              begin
                               {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
+                              {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
                               raise;
                              end;
 …
       on EListError do
         begin
          {$ifdef debug}ShowMessage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
+         {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
          raise;
         end;
 …
       on EListError do
         begin
          {$ifdef debug}ShowMessage('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
+         {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
          raise;
         end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
                              raise;
                              end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
                              raise;
                              end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
                              raise;
                              end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
                              raise;
                              end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
                              raise;
                              end;
 …
                           on EListError do
                              begin
                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
+                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
                              raise;
                              end;
 …
               on EListError do
                  begin
                  {$ifdef debug}ShowMessage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
+                 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
                  raise;
                  end;
 …
         on EListError do
            begin
            {$ifdef debug}ShowMessage('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
+           {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
            raise;
            end;
 …
      on EListError do
         begin
         {$ifdef debug}ShowMessage('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
+        {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
         raise;
         end;
 …
 : PtHNC              := (AList[i] = '1');
 : PtMST              := (AList[i] = '1');
+: PtSHAD              := (AList[i] = '1');
     end;
 end;
 …
 procedure TBAPLPt.LoadPatientParams(AList:TstringList);
 begin
   AList.Assign(rpcInitPt(Patient.DFN));
+  FastAssign(rpcInitPt(Patient.DFN), AList);
   BAPLPt := TBAPLPt.create(Alist);
 end;
 …
         on EListError do
            begin
            {$ifdef debug}ShowMessage('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
+           {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
            raise;
            end;
 …
   BANurseConsultOrders := TStringList.Create;
   BADeltedOrders       := TStringList.Create;
- // BAConsultOrdersRequireDx := TStringList.Create;
   BAConsultDxList.Clear;
   NonBillableOrderList.Clear;
 …
   BANurseConsultOrders.Clear;
   BADeltedOrders.Clear;
+  //BAConsultOrdersRequireDx.Clear;
 end.

cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.dfm

-              r456
+              r829
+object frmBALocalDiagnoses: TfrmBALocalDiagnoses
+  Left = 192
+  Top = 61
+  Width = 620
+  Height = 544
+inherited frmBALocalDiagnoses: TfrmBALocalDiagnoses
+  Left = 272
+  Top = 142
   Caption = 'Assign Diagnoses to Order(s)'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  KeyPreview = True
+  ClientHeight = 517
+  ClientWidth = 612
   OldCreateOrder = False
   Position = poScreenCenter
 …
   OnActivate = FormActivate
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnKeyPress = FormKeyPress
   OnShow = FormShow
+  ExplicitWidth = 620
+  ExplicitHeight = 551
   PixelsPerInch = 96
   TextHeight = 13
   object pnlTop: TPanel
+  object pnlTop: TPanel [0]
     Left = 0
     Top = 0
 …
 )
     object lbOrders: TListBox
       Left = 7
+      Left = 8
       Top = 25
       Width = 599
+      Width = 602
       Height = 69
       Anchors = [akLeft, akTop, akRight, akBottom]
       IntegralHeight = True
       ItemHeight = 13
       TabOrder = 2
+      TabOrder = 1
       OnMouseMove = lbOrdersMouseMove
     end
     object ORStaticText1: TORStaticText
       Left = 216
+    object lblPatientName: TStaticText
+      Left = 8
       Top = 8
-      Width = 169
-      Height = 14
-      AutoSize = False
-      Caption = 'Selected Orders'
-      TabOrder = 1
-      TabStop = True
-      OnEnter = ORStaticText1Enter
-      OnExit = ORStaticText1Exit
-    end
-    object lblPatientName: TStaticText
-      Left = 11
-      Top = 9
       Width = 76
       Height = 17
 …
       ParentFont = False
       TabOrder = 0
+      TabStop = True
+    end
+  end
+  object pnlMain: TPanel
+    end
+  end
+  object pnlMain: TPanel [1]
     Left = 0
     Top = 96
 …
     Align = alClient
     TabOrder = 1
+    object lblDiagSect: TLabel
+      Left = 9
+      Top = 1
+      Width = 241
+      Height = 17
+      AutoSize = False
+      Caption = 'Diagnosis Section'
+    end
+    object lblDiagCodes: TLabel
+      Left = 253
+      Top = 1
+      Width = 353
+      Height = 17
+      AutoSize = False
+      Caption = 'Diagnosis Codes'
+    end
     object lbSections: TORListBox
       Left = 9
       Top = 16
+      Top = 14
       Width = 238
+      Height = 201
+      Style = lbOwnerDrawVariable
+      Height = 199
       IntegralHeight = True
       ItemHeight = 13
 …
       LongList = False
       Pieces = '3'
-      CheckEntireLine = True
     end
     object btnOther: TButton
 …
     end
     object lbDiagnosis: TORListBox
       Left = 248
+      Left = 253
       Top = 16
       Width = 353
 …
       Pieces = '1,2,3'
     end
+    object ORStaticText2: TORStaticText
+      Left = 8
+      Top = 1
+      Width = 241
+      Height = 17
+      AutoSize = False
+      BevelKind = bkFlat
+      Caption = 'Diagnosis Section'
+      TabOrder = 0
+      TabStop = True
+      OnEnter = ORStaticText1Enter
+      OnExit = ORStaticText1Exit
+    end
+    object ORStaticText3: TORStaticText
+      Left = 248
+      Top = 1
+      Width = 353
+      Height = 17
+      AutoSize = False
+      BevelKind = bkFlat
+      Caption = 'Diagnosis Codes'
+      TabOrder = 3
+      TabStop = True
+      OnEnter = ORStaticText1Enter
+      OnExit = ORStaticText1Exit
+    end
+  end
+  object pnlBottom: TORAutoPanel
+  end
+  object pnlBottom: TORAutoPanel [2]
     Left = 0
     Top = 355
 …
 )
-    object lvDxGrid: TListView
-      Left = 12
-      Top = 19
-      Width = 445
-      Height = 85
-      Color = clInfoBk
-      Columns = <
-        item
-          Caption = 'Add To PL/PD'
-          Width = 85
-        end
-        item
-          Caption = 'Primary'
-          MinWidth = 65
-          Width = 65
-        end
-        item
-          Caption = 'Diagnosis for Selected Orders'
-          MinWidth = 275
-          Width = 290
-        end>
-      Ctl3D = False
-      HideSelection = False
-      MultiSelect = True
-      ReadOnly = True
-      RowSelect = True
-      TabOrder = 1
-      ViewStyle = vsReport
-      OnClick = lvDxGridClick
-      OnKeyDown = lvDxGridKeyDown
-      OnKeyUp = lvDxGridKeyUp
-    end
     object cbAddToPDList: TCheckBox
       Left = 459
 …
       Height = 17
       Caption = 'Add to Personal Dx List'
       TabOrder = 3
+      TabOrder = 2
       OnClick = cbAddToPDListClick
     end
 …
       Anchors = [akLeft, akTop, akRight, akBottom]
       Caption = 'Add To Problem List'
       TabOrder = 2
+      TabOrder = 0
       OnClick = cbAddToPLClick
     end
 …
       Height = 19
       Caption = '&Primary'
       TabOrder = 4
+      TabOrder = 3
       OnClick = btnPrimaryClick
     end
 …
       Height = 19
       Caption = '&Remove'
       TabOrder = 5
+      TabOrder = 4
       OnClick = btnRemoveClick
     end
 …
       Height = 18
       Caption = '&Select All'
       TabOrder = 6
+      TabOrder = 5
       OnClick = btnSelectAllClick
     end
 …
       Height = 21
       Caption = '&OK'
       TabOrder = 7
+      TabOrder = 6
       OnClick = buOKClick
     end
 …
       Height = 21
       Caption = '&Cancel'
       TabOrder = 8
+      TabOrder = 7
       OnClick = buCancelClick
     end
+    object ORStaticText4: TORStaticText
+      Left = 14
+      Top = 3
+      Width = 219
+      Height = 14
+      AutoSize = False
+    object gbProvDiag: TGroupBox
+      Left = 8
+      Top = 0
+      Width = 449
+      Height = 105
       Caption = 'Provisional Diagnosis'
+      TabOrder = 0
+      TabStop = True
+      OnEnter = ORStaticText1Enter
+      OnExit = ORStaticText1Exit
+    end
+      TabOrder = 1
+      object lvDxGrid: TListView
+        Left = 2
+        Top = 15
+        Width = 445
+        Height = 88
+        Align = alClient
+        Color = clInfoBk
+        Columns = <
+          item
+            Caption = 'Add To PL/PD'
+            Width = 85
+          end
+          item
+            Caption = 'Primary'
+            MinWidth = 65
+            Width = 65
+          end
+          item
+            Caption = 'Diagnosis for Selected Orders'
+            MinWidth = 275
+            Width = 290
+          end>
+        Ctl3D = False
+        HideSelection = False
+        MultiSelect = True
+        ReadOnly = True
+        RowSelect = True
+        TabOrder = 0
+        ViewStyle = vsReport
+        OnClick = lvDxGridClick
+        OnKeyDown = lvDxGridKeyDown
+        OnKeyUp = lvDxGridKeyUp
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lbOrders'
+        'Status = stsDefault')
+      (
+        'Component = lblPatientName'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbSections'
+        'Label = lblDiagSect'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = lbDiagnosis'
+        'Label = lblDiagCodes'
+        'Status = stsOK')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cbAddToPDList'
+        'Status = stsDefault')
+      (
+        'Component = cbAddToPL'
+        'Status = stsDefault')
+      (
+        'Component = btnPrimary'
+        'Status = stsDefault')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = buOK'
+        'Status = stsDefault')
+      (
+        'Component = buCancel'
+        'Status = stsDefault')
+      (
+        'Component = gbProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = lvDxGrid'
+        'Status = stsDefault')
+      (
+        'Component = frmBALocalDiagnoses'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.pas

-              r456
+              r829
   Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls,fPCELex, uConsults, ORFn,
   rPCE,DBCtrls, DB, DBClient, uPCE, fEncounterFrame, ComCtrls, Grids, UBAGlobals,
   Buttons, Menus, UBACore, UCore;
+  Buttons, Menus, UBACore, UCore, VA508AccessibilityManager;
 type
 …
     lbSections: TORListBox;
     pnlBottom: TORAutoPanel;
-    lvDxGrid: TListView;
     cbAddToPDList: TCheckBox;
     cbAddToPL: TCheckBox;
 …
     btnOther: TButton;
     lbDiagnosis: TORListBox;
+    ORStaticText1: TORStaticText;
+    ORStaticText2: TORStaticText;
+    ORStaticText3: TORStaticText;
+    ORStaticText4: TORStaticText;
+    lblDiagSect: TLabel;
+    lblDiagCodes: TLabel;
     lblPatientName: TStaticText;
+    gbProvDiag: TGroupBox;
+    lvDxGrid: TListView;
     procedure buOKClick(Sender: TObject);
     procedure buCancelClick(Sender: TObject);
 …
     procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
       Y: Integer);
+    procedure ORStaticText1Enter(Sender: TObject);
+    procedure ORStaticText1Exit(Sender: TObject);
+    procedure ORStaticText3Enter(Sender: TObject);
+    procedure ORStaticText3Exit(Sender: TObject);
+    procedure FormKeyPress(Sender: TObject; var Key: Char);
   private
 …
     function  PersonalListDxFound(pDxCode:string):boolean;
     procedure ReSetCheckBoxStatus(pDxCode:String);
+    procedure DeleteSelectedDx;
+    function  IsCtrlDown: boolean;
   public
 …
      procedure Enter(theCaller: smallint; pOrderIDList: TStringList);
      procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string);
   end;
 …
 uses rCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
   uAccessibleStringGrid,ORNet, fProbs, fOrdersSign, UBAConst,
   UBAMessages, fReview, uSignItems, fODConsult, fFrame;
+  ORNet, fProbs, fOrdersSign, UBAConst,
+  UBAMessages, fReview, uSignItems, fODConsult, fFrame, VAUtils;
 var
 …
 end;
+procedure TfrmBALocalDiagnoses.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+  inherited;
+   if frmBALocalDiagnoses.IsCtrlDown then
+   begin
+     if ( Key = #10 ) then
+        frmBALocalDiagnoses.buOK.Click;
+   end;
+end;
 procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings);
 { return section names in format: ListIndex^SectionName (sections begin with '^') }
 …
     ECFDiagnosis := TStringList.Create;
     uProblems := TStringList.Create;
     lblPatientName.Caption := Patient.Name;
+    lblPatientName.Caption := Patient.Name + ' Selected Orders';
     DeselectGridItems;
 …
       begin
          a :=  Piece(BADiagnosis[j], U, 2) + U + Piece(BADiagnosis[j], U, 1) + U + '        ' + Piece(BADiagnosis[j], U, 3) ;
          if a = '' then showmessage('found nothing');
+         if a = '' then ShowMsg('found nothing');
             lbDiagnosis.Items.Add(a);
       end;
 …
   inherited;
   deleteDX := True;
   lvDxGrid.DeleteSelected;
+  frmBALocalDiagnoses.DeleteSelectedDX;
   ClearAndDisableCBoxes;
   DeselectGridItems;
   EnsurePrimary;
   deleteDX := False;
                                 // if all dx's removed, clear out displaycode
+  // if all dx's removed, clear out displaycode
   if lvDxGrid.items.Count = 0 then FODConsult.displayDXCode := '';
 end;
 …
     begin
        DeselectGridItems;
        ShowMessage(BA_MAX_DX); //** max  4 diagnoses per order
+       ShowMsg(BA_MAX_DX); //** max  4 diagnoses per order
     end;
 end;
 …
     NewList.Clear;
     // ** Add Diagnosis to Problem List if flagged with 'Add' in First Col.
     with lvDxGrid do
+    with frmBALocalDiagnoses.lvDxGrid do
     begin
        for i := 0 to Items.Count-1 do
 …
    i : integer;
    tempStr1,tempStr2, tempStr3: string;
    tempFactor1,x: string;
+   tempFactor1: string;
    tempStrList: TStringList;
 begin
 …
    tempFactor1 := '';
    if lvDxGrid.Items.Count > 0 then
    with lvDxGrid do
+   if frmBALocalDiagnoses.lvDxGrid.Items.Count > 0 then
+   with frmBALocalDiagnoses.lvDxGrid do
    begin
       for i := 0 to Items.Count-1 do
       begin
          x := lvDxGrid.Items[i].Subitems[0];
          x := lvDxGrid.Items[i].Subitems[1];
          x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
+     //    x := lvDxGrid.Items[i].Subitems[0];
+     //    x := lvDxGrid.Items[i].Subitems[1];
+     //    x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
          tempStrList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]);
       end;
 …
       on EListError do
          begin
          {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}
+         {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}
          raise;
          end;
 …
       on EListError do
          begin
          {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}
+         {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}
          raise;
          end;
 …
        if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
        begin
           ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
+          ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED);
           LoadEncounterForm;
           Refresh;
 …
   if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
   begin
      ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
+     ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED);
      LoadEncounterForm;
      Refresh;
 …
   (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
               TListBox).Items[Index]); {** display the text }
 end;
 …
 end;
-procedure TfrmBALocalDiagnoses.ORStaticText1Enter(Sender: TObject);
-begin
-  inherited;
-  (Sender as TORStaticText).Font.Style := [fsBold];
-end;
-procedure TfrmBALocalDiagnoses.ORStaticText1Exit(Sender: TObject);
-begin
-  inherited;
-  (Sender as TORStaticText).Font.Style := [];
-end;
-procedure TfrmBALocalDiagnoses.ORStaticText3Enter(Sender: TObject);
-begin
-  inherited;
-  (Sender as TORStaticText).Font.Style := [fsBold];
-end;
-procedure TfrmBALocalDiagnoses.ORStaticText3Exit(Sender: TObject);
-begin
-  inherited;
-  (Sender as TORStaticText).Font.Style := [];
-end;
 procedure TfrmBALocalDiagnoses.ResetCheckBoxStatus(pDxCode:string);
 begin
 …
  if  Not PersonalListDxFound(pDxCode) then
     cbAddToPDList.Enabled  := True;
+end;
+end;
+procedure TfrmBALocalDiagnoses.DeleteSelectedDx;
+var
+  I: Integer;
+begin
+  frmBALocalDiagnoses.lvDxGrid.Items.BeginUpdate;
+  try
+    for I := frmBALocalDiagnoses.lvDxGrid.Items.Count - 1 downto 0 do
+      if  frmBALocalDiagnoses.lvDxGrid.Items[I].Selected then
+        frmBALocalDiagnoses.lvdxGrid.Items[I].delete;
+  finally
+    lvDxGrid.Items.EndUpdate;
+  end;
+end;
+function  TfrmBALocalDiagnoses.IsCtrlDown: boolean;
+var
+  State: TKeyboardState;
+begin { isCtrlDown }
+  GetKeyboardState(State);
+  Result := ((State[VK_CONTROL] and 128)<>0); // Ctrl-button
+end; { isCtrlDown }

cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm

-              r456
+              r829
   Left = 231
   Top = 183
-  Width = 747
-  Height = 557
   Caption = 'Personal Diagnoses List'
+  ClientHeight = 530
+  ClientWidth = 739
   Constraints.MinHeight = 100
   Constraints.MinWidth = 200
 …
   OnCreate = FormCreate
   OnShow = FormShow
+  ExplicitWidth = 747
+  ExplicitHeight = 557
   PixelsPerInch = 96
   TextHeight = 13
   object Panel1: TPanel
+  object Panel1: TPanel [0]
     Left = 0
     Top = 0
 …
         Width = -3
         Height = 463
-        Cursor = crHSplit
       end
       object Splitter2: TSplitter
 …
         Width = 7
         Height = 463
-        Cursor = crHSplit
       end
       object Splitter3: TSplitter
 …
         Width = 1
         Height = 463
-        Cursor = crHSplit
       end
       object Splitter5: TSplitter
 …
         Width = 2
         Height = 463
-        Cursor = crHSplit
       end
       object pnlBottom: TPanel
 …
           Width = 168
           Height = 17
-          DragReorder = False
           Sections = <
             item
 …
           Width = 201
           Height = 17
-          DragReorder = False
           Sections = <
             item
 …
           Width = 257
           Height = 17
-          DragReorder = False
           Sections = <
             item
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = Button1'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = lbSections'
+        'Status = stsDefault')
+      (
+        'Component = hdrCntlDxSections'
+        'Status = stsDefault')
+      (
+        'Component = Panel4'
+        'Status = stsDefault')
+      (
+        'Component = lbDiagnosis'
+        'Status = stsDefault')
+      (
+        'Component = hdrCntlDxAdd'
+        'Status = stsDefault')
+      (
+        'Component = Panel5'
+        'Status = stsDefault')
+      (
+        'Component = lbPersonalDx'
+        'Status = stsDefault')
+      (
+        'Component = hdrCntlDx'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = StaticText3'
+        'Status = stsDefault')
+      (
+        'Component = Panel7'
+        'Status = stsDefault')
+      (
+        'Component = btnAdd'
+        'Status = stsDefault')
+      (
+        'Component = btnDelete'
+        'Status = stsDefault')
+      (
+        'Component = frmBAOptionsDiagnoses'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.pas

r456	r829
7	7	Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet,
8	8	UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst,
9		ComCtrls;
	9	ComCtrls, VA508AccessibilityManager;
10	10
11	11	type

cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm

-              r456
+              r829
 object frmConsMedRslt: TfrmConsMedRslt
+inherited frmConsMedRslt: TfrmConsMedRslt
   Left = 468
   Top = 172
 …
   ClientHeight = 242
   ClientWidth = 505
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
-  OldCreateOrder = True
   Position = poScreenCenter
+  OnDestroy = FormDestroy
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       TabOrder = 3
       OnNeedData = NewPersonNeedData
+    end
+      CharsNeedMatch = 1
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = lstMedResults'
+        'Status = stsDefault')
+      (
+        'Component = cmdDetails'
+        'Status = stsDefault')
+      (
+        'Component = ckAlert'
+        'Status = stsDefault')
+      (
+        'Component = calDateofAction'
+        'Status = stsDefault')
+      (
+        'Component = cboPerson'
+        'Status = stsDefault')
+      (
+        'Component = frmConsMedRslt'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
+  Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox,
+  VA508AccessibilityManager;
 type
 …
       if MedResult.Action = 'ATTACH' then
         begin
           lstMedResults.Items.Assign(GetAssignableMedResults(ConsultIEN));
+          FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items);
           ckAlert.Visible := True;
         end
       else if MedResult.Action = 'REMOVE' then
         begin
           lstMedResults.Items.Assign(GetRemovableMedResults(ConsultIEN));
+          FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items);
           ckAlert.Visible := False;
         end;
 …
 var
   x: string;
+  //MsgString, HasImages: string;
 begin
   inherited;
   if lstMedResults.ItemIndex = -1 then exit;
   x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1);
+  // ---------------------------------------------------------------
+  // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast
+(*  MsgString := 'MED^' + x;
+  HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0];
+  SetPiece(HasImages, U, 10, HasImages);
+  NotifyOtherApps(NAE_REPORT, MsgString);*)
+  // ---------------------------------------------------------------
   NotifyOtherApps(NAE_REPORT, 'MED^' + x);
   if(not assigned(FShowDetails)) then

cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm

-              r456
+              r829
 object frm513Print: Tfrm513Print
+inherited frm513Print: Tfrm513Print
   Left = 116
   Top = 375
-  AutoScroll = False
   Caption = 'Print SF 513'
+  ClientHeight = 308
+  ClientWidth = 427
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = True
+  ClientHeight = 306
   Position = poScreenCenter
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  ExplicitHeight = 340
   PixelsPerInch = 96
   TextHeight = 13
   object lblPrintTo: TLabel
+  object lblPrintTo: TLabel [0]
     Left = 7
     Top = 265
 …
     Height = 13
   end
   object lblConsultTitle: TMemo
+  object lblConsultTitle: TMemo [1]
     Left = 10
     Top = 8
 …
     TabOrder = 0
   end
   object grpChooseCopy: TGroupBox
+  object grpChooseCopy: TGroupBox [2]
     Left = 321
     Top = 4
 …
     end
   end
   object grpDevice: TGroupBox
+  object grpDevice: TGroupBox [3]
     Left = 8
     Top = 69
 …
       OnChange = cboDeviceChange
       OnNeedData = cboDeviceNeedData
+      CharsNeedMatch = 1
     end
   end
   object cmdOK: TButton
+  object cmdOK: TButton [4]
     Left = 267
     Top = 272
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [5]
     Left = 347
     Top = 272
 …
     OnClick = cmdCancelClick
   end
   object chkDefault: TCheckBox
+  object chkDefault: TCheckBox [6]
     Left = 7
     Top = 288
 …
     TabOrder = 3
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblConsultTitle'
+        'Status = stsDefault')
+      (
+        'Component = grpChooseCopy'
+        'Status = stsDefault')
+      (
+        'Component = radChartCopy'
+        'Status = stsDefault')
+      (
+        'Component = radWorkCopy'
+        'Status = stsDefault')
+      (
+        'Component = grpDevice'
+        'Status = stsDefault')
+      (
+        'Component = txtRightMargin'
+        'Status = stsDefault')
+      (
+        'Component = txtPageLength'
+        'Status = stsDefault')
+      (
+        'Component = cboDevice'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = chkDefault'
+        'Status = stsDefault')
+      (
+        'Component = frm513Print'
+        'Status = stsDefault'))
+  end
   object dlgWinPrinter: TPrintDialog
     Left = 268

cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls;
+  fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls,
+  VA508AccessibilityManager, uReports;
 type
 …
     procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
       Direction, InsertAt: Integer);
-    procedure FormCreate(Sender: TObject);
     procedure cboDeviceChange(Sender: TObject);
     procedure radChartCopyClick(Sender: TObject);
 …
     procedure cmdOKClick(Sender: TObject);
     procedure cmdCancelClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
   private
     { Private declarations }
 …
 end;
-procedure Tfrm513Print.FormCreate(Sender: TObject);
-begin
-  inherited;
-  FReportText := TRichEdit.Create(Self);
-  with FReportText do
-    begin
-      Parent := Self;
-      Visible := False;
-      Width := 600;
-    end;
-end;
 procedure Tfrm513Print.DisplaySelectDevice;
 begin
 …
 begin
   inherited;
+  FReportText := CreateReportTextComponent(Self);
   RemoteSiteID := '';
   RemoteQuery := '';
 …
       if dlgWinPrinter.Execute then with FReportText do
         begin
           FReportText.Lines.Assign(GetFormattedSF513(FConsult, ChartCopy));
+          QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText);
           PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg);
           if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
 …
   if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
   User.CurrentPrinter := cboDevice.ItemID;
+  FReportText.Free;
   Close;
 end;
 …
 end;
-procedure Tfrm513Print.FormDestroy(Sender: TObject);
-begin
-  FReportText.Free;
-  inherited;
-end;
 end.

cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm

-              r456
+              r829
 object frmConsultAction: TfrmConsultAction
+inherited frmConsultAction: TfrmConsultAction
   Left = 277
   Top = 217
-  Width = 600
-  Height = 406
   BorderIcons = []
   Caption = 'frmConsultAction'
+  Color = clBtnFace
+  ClientHeight = 379
+  ClientWidth = 592
   Constraints.MinHeight = 406
   Constraints.MinWidth = 600
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TPanel
+  object pnlBase: TPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = pnlForward'
+        'Status = stsDefault')
+      (
+        'Component = Label1'
+        'Status = stsDefault')
+      (
+        'Component = cboAttentionOf'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = treService'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = pnlOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlSigFind'
+        'Status = stsDefault')
+      (
+        'Component = grpSigFindings'
+        'Status = stsDefault')
+      (
+        'Component = pnlComments'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = pnlAlert'
+        'Status = stsDefault')
+      (
+        'Component = lblAutoAlerts'
+        'Status = stsDefault')
+      (
+        'Component = ckAlert'
+        'Status = stsDefault')
+      (
+        'Component = pnlAllActions'
+        'Status = stsDefault')
+      (
+        'Component = calDateofAction'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboPerson'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultAction'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
+  StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm;
+  StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmConsultAction = class(TForm)
+  TfrmConsultAction = class(TfrmBase508Form)
     lblActionBy: TOROffsetLabel;
     calDateofAction: TORDateBox;
 …
    begin
      OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber));
      SvcList.Assign(GetProcedureServices(OrdItmIEN));
      //SvcList.Assign(GetProcedureServices(ProcIEN));   RPC expects pointer to 101.43, NOT 123.3  (RV)
+     FastAssign(GetProcedureServices(OrdItmIEN), SvcList);
+     //FastAssign(GetProcedureServices(ProcIEN), SvcList);   RPC expects pointer to 101.43, NOT 123.3  (RV)
      i := SvcList.IndexOf(IntToStr(ConsultRec.ToService) + U + Trim(ExternalName(ConsultRec.ToService, 123.5)));
      if i > -1 then SvcList.Delete(i);
 …
    end
  else
    SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN));           {RV}
+   FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN), SvcList);           {RV}
  if (IsProcedure and (SvcList.Count <= 0)) then
    begin
 …
  FToService := cboService.ItemIEN;
  cboAttentionOf.InitLongList('') ;
  with cboUrgency do
   begin
     Items.Assign(SubsetofUrgencies(ConsultRec.IEN)) ;
+ with cboUrgency do
+  begin
+    FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ;
     MixedCaseList(Items) ;
     SelectByIEN(ConsultRec.Urgency);
 …
 end;
+procedure TfrmConsultAction.ShowAutoAlertText;
+(*procedure TfrmConsultAction.ShowAutoAlertText;      ****  SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan
 const
   TX_ALERT1          = 'An alert will automatically be sent to ';
 …
    end;
    lblAutoAlerts.Caption := x;
+end;
+end;*)
+procedure TfrmConsultAction.ShowAutoAlertText;
+const
+  TX_ALERT1          = 'An alert will automatically be sent to ';
+  TX_ALERT_PROVIDER  = 'the ordering provider';
+  TX_ALERT_SVC_USERS = 'notification recipients for this service.';
+  TX_ALERT_NOBODY    = 'No automatic alerts will be sent.';  // this should be rare to never
+var
+  x: string;
+begin
+  case FUserLevel of
+    UL_NONE, UL_REVIEW:
+      begin
+        if FUserIsRequester then
+          x := TX_ALERT1 + TX_ALERT_SVC_USERS
+        else
+          x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
+      end;
+    UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
+      begin
+        if FUserIsRequester then
+          //x := TX_ALERT_NOBODY   Replace with following line
+          x := TX_ALERT1 + TX_ALERT_SVC_USERS
+        else
+          x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
+      end;
+    UL_UNRESTRICTED:
+      begin
+        if FUserIsRequester then
+          x := TX_ALERT1 + TX_ALERT_SVC_USERS
+        else
+          x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
+      end;
+  end;
+  lblAutoAlerts.Caption := x;
+end;
 initialization

cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm

-              r456
+              r829
 object frmConsultAlertsTo: TfrmConsultAlertsTo
+inherited frmConsultAlertsTo: TfrmConsultAlertsTo
   Left = 297
   Top = 206
 …
   Caption = 'Send Alert'
   ClientHeight = 262
+  ClientWidth = 358
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientWidth = 371
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
     Width = 358
+    Width = 371
     Height = 262
     Align = alClient
     BevelOuter = bvNone
     TabOrder = 0
+    ExplicitWidth = 358
     object SrcLabel: TLabel
       Left = 12
 …
     end
     object DstLabel: TLabel
       Left = 196
+      Left = 217
       Top = 14
       Width = 132
 …
       Caption = 'OK'
       ModalResult = 1
       TabOrder = 2
+      TabOrder = 4
       OnClick = cmdOKClick
     end
 …
       Caption = 'Cancel'
       ModalResult = 2
       TabOrder = 3
+      TabOrder = 5
       OnClick = cmdCancelClick
     end
 …
       OnMouseClick = cboSrcListMouseClick
       OnNeedData = cboSrcListNeedData
+      CharsNeedMatch = 1
     end
     object DstList: TORListBox
       Left = 196
+      Left = 217
       Top = 30
       Width = 144
 …
       ParentShowHint = False
       ShowHint = True
       TabOrder = 1
+      TabOrder = 2
       OnClick = DstListClick
       Caption = 'Currently selected recipients'
 …
       Pieces = '2'
     end
+    object btnAdd: TButton
+      Left = 160
+      Top = 109
+      Width = 51
+      Height = 25
+      Caption = 'Add'
+      TabOrder = 1
+      OnClick = cboSrcListMouseClick
+    end
+    object btnRemove: TButton
+      Left = 160
+      Top = 140
+      Width = 51
+      Height = 25
+      Caption = 'Remove'
+      TabOrder = 3
+      OnClick = DstListClick
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboSrcList'
+        'Status = stsDefault')
+      (
+        'Component = DstList'
+        'Status = stsDefault')
+      (
+        'Component = btnAdd'
+        'Status = stsDefault')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultAlertsTo'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
   Buttons, ORCtrls, ORfn, ExtCtrls;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmConsultAlertsTo = class(TForm)
+  TfrmConsultAlertsTo = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;
 …
     DstLabel: TLabel;
     pnlBase: TORAutoPanel;
+    btnAdd: TButton;
+    btnRemove: TButton;
     procedure cboSrcListNeedData(Sender: TObject; const StartFrom: String;
       Direction, InsertAt: Integer);

cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm

-              r456
+              r829
 object frmConsultsByDate: TfrmConsultsByDate
+inherited frmConsultsByDate: TfrmConsultsByDate
   Left = 372
   Top = 217
-  Width = 259
-  Height = 178
   BorderIcons = []
   Caption = 'List Consults by Date Range'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 151
+  ClientWidth = 251
   OldCreateOrder = True
   Position = poScreenCenter
+  ExplicitWidth = 259
+  ExplicitHeight = 178
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = calBeginDate'
+        'Status = stsDefault')
+      (
+        'Component = calEndDate'
+        'Status = stsDefault')
+      (
+        'Component = radSort'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultsByDate'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
+  StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults;
+  StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmConsultsByDate = class(TForm)
+  TfrmConsultsByDate = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     lblBeginDate: TLabel;

cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm

-              r456
+              r829
 object frmConsultsByService: TfrmConsultsByService
+inherited frmConsultsByService: TfrmConsultsByService
   Left = 339
   Top = 175
-  Width = 328
-  Height = 412
   BorderIcons = []
   Caption = 'List Consults by Service'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 385
+  ClientWidth = 320
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       OnKeyPause = cboServiceSelect
       OnMouseClick = cboServiceSelect
+      CharsNeedMatch = 1
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = radSort'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = treService'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultsByService'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults;
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmConsultsByService = class(TForm)
+  TfrmConsultsByService = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     lblService: TLabel;
 …
       ClientHeight := H; pnlBase.Height := H;
       FChanged := False;
       //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP));                         {RV}
       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP));             {RV}
+      //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
+      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);             {RV}
       SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
       for i := 0 to SvcList.Count - 1 do

cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm

-              r456
+              r829
 object frmConsultsByStatus: TfrmConsultsByStatus
+inherited frmConsultsByStatus: TfrmConsultsByStatus
   Left = 286
   Top = 202
-  Width = 316
-  Height = 232
   BorderIcons = []
   Caption = 'List Consults by Status'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 205
+  ClientWidth = 308
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = radSort'
+        'Status = stsDefault')
+      (
+        'Component = lstStatus'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultsByStatus'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults;
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmConsultsByStatus = class(TForm)
+  TfrmConsultsByStatus = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     lblStatus: TLabel;
 …
       FChanged := False;
       with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
       lstStatus.Items.Assign(SubSetOfStatus);
+      FastAssign(SubSetOfStatus, lstStatus.Items);
       CurrentStatus := CurrentContext.Status;
       if CurrentStatus <> '' then with lstStatus do

cprs/trunk/CPRS-Chart/Consults/fConsults.dfm

-              r456
+              r829
 inherited frmConsults: TfrmConsults
+  Left = 247
+  Top = 174
+  Width = 723
+  Height = 467
+  Left = 402
+  Top = 80
   HelpContext = 6000
   Caption = 'Consults Page'
+  ClientHeight = 421
+  ClientWidth = 715
   Menu = mnuConsults
   OnDestroy = FormDestroy
   OnHide = FormHide
-  OnMouseMove = FormMouseMove
   OnShow = FormShow
+  ExplicitWidth = 723
+  ExplicitHeight = 467
   PixelsPerInch = 96
   TextHeight = 13
 …
     Top = 416
     Width = 715
+    ExplicitTop = 416
+    ExplicitWidth = 715
   end
   inherited sptHorz: TSplitter
 …
     Height = 416
     OnCanResize = sptHorzCanResize
+    ExplicitLeft = 83
+    ExplicitWidth = 2
+    ExplicitHeight = 416
   end
   inherited pnlRight: TPanel [2]
 …
     Width = 630
     Height = 416
+    OnExit = pnlRightExit
     OnResize = pnlRightResize
+    ExplicitLeft = 85
+    ExplicitWidth = 630
+    ExplicitHeight = 416
     object sptVert: TSplitter
       Left = 0
 …
       BevelOuter = bvNone
       TabOrder = 0
-      OnExit = pnlResultsExit
       object lblTitle: TOROffsetLabel
         Left = 0
 …
         WantReturns = False
         WordWrap = False
-        OnMouseMove = FormMouseMove
       end
     end
 …
       BevelOuter = bvNone
       TabOrder = 1
-      OnExit = pnlResultsExit
       OnResize = pnlResultsResize
       object memResults: TRichEdit
 …
         OnChange = memResultChange
         OnKeyDown = memResultsKeyDown
-        OnMouseMove = FormMouseMove
       end
       object pnlFields: TPanel
 …
           TabOrder = 0
           OnClick = cmdChangeClick
-          OnMouseMove = FormMouseMove
         end
         object txtSubject: TCaptionEdit
 …
           TabOrder = 1
           Text = 'txtSubject'
-          OnMouseMove = FormMouseMove
           Caption = 'Subject'
         end
 …
     Width = 83
     Height = 416
+    OnExit = pnlLeftExit
     OnResize = pnlLeftResize
+    ExplicitWidth = 83
+    ExplicitHeight = 416
     object splConsults: TSplitter
       Left = 0
 …
       BevelOuter = bvNone
       TabOrder = 1
-      OnExit = pnlActionExit
       object splDrawers: TSplitter
         Left = 0
 …
         Width = 83
         Height = 21
+        Align = alTop
         Caption = 'New Consult'
         Constraints.MinHeight = 21
+        TabOrder = 2
+        Default = True
+        TabOrder = 1
         OnClick = cmdNewConsultClick
+        OnMouseMove = FormMouseMove
+        Align = alTop
+        OnExit = cmdNewConsultExit
       end
       object cmdNewProc: TORAlignButton
 …
         Width = 83
         Height = 21
+        Align = alTop
         Caption = 'New Procedure'
         Constraints.MinHeight = 21
         TabOrder = 3
+        TabOrder = 2
         OnClick = cmdNewProcClick
-        OnMouseMove = FormMouseMove
-        Align = alTop
       end
       object cmdEditResubmit: TORAlignButton
 …
         Width = 83
         Height = 21
+        Align = alTop
         Caption = 'Edit/Resubmit'
         Constraints.MinHeight = 21
 …
         Font.Style = []
         ParentFont = False
         TabOrder = 1
+        TabOrder = 0
         Visible = False
         OnClick = cmdEditResubmitClick
+        OnMouseMove = FormMouseMove
+        Align = alTop
+        OnExit = cmdEditResubmitExit
       end
       object lstNotes: TORListBox
 …
         Visible = False
         OnClick = lstNotesClick
-        OnMouseMove = FormMouseMove
         ItemTipColor = clWindow
         LongList = False
 …
         Constraints.MinWidth = 30
         HideSelection = False
+        Images = dmodShared.imgNotes
         Indent = 19
         PopupMenu = popNoteList
         ReadOnly = True
+        TabOrder = 0
+        StateImages = dmodShared.imgImages
+        TabOrder = 3
         OnChange = tvCsltNotesChange
         OnClick = tvCsltNotesClick
 …
         OnDragOver = tvCsltNotesDragOver
         OnExpanded = tvCsltNotesExpanded
-        OnMouseMove = FormMouseMove
         OnStartDrag = tvCsltNotesStartDrag
         Caption = 'Consult Notes'
 …
       Width = 83
       Height = 21
+      Align = alBottom
       Caption = 'Encounter'
       Enabled = False
 …
       Visible = False
       OnClick = cmdPCEClick
-      OnExit = pnlActionExit
-      OnMouseMove = FormMouseMove
-      Align = alBottom
     end
     object pnlConsultList: TPanel
 …
         Align = alClient
         HideSelection = False
+        Indent = 15
+        Images = dmodShared.imgConsults
+        Indent = 19
         PopupMenu = popNoteList
         ReadOnly = True
         TabOrder = 0
-        OnAddition = tvConsultsAddition
         OnClick = tvConsultsClick
         OnCollapsed = tvConsultsCollapsed
-        OnDeletion = tvConsultsDeletion
         OnExit = tvConsultsExit
         OnExpanded = tvConsultsExpanded
         OnKeyUp = tvConsultsKeyUp
-        OnMouseMove = FormMouseMove
         Caption = 'Consults'
         NodePiece = 0
 …
       end
     end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlRead'
+        'Status = stsDefault')
+      (
+        'Component = memConsult'
+        'Status = stsDefault')
+      (
+        'Component = memPCEShow'
+        'Status = stsDefault')
+      (
+        'Component = pnlResults'
+        'Status = stsDefault')
+      (
+        'Component = memResults'
+        'Status = stsDefault')
+      (
+        'Component = pnlFields'
+        'Status = stsDefault')
+      (
+        'Component = lblRefDate'
+        'Status = stsDefault')
+      (
+        'Component = lblAuthor'
+        'Status = stsDefault')
+      (
+        'Component = lblVisit'
+        'Status = stsDefault')
+      (
+        'Component = lblCosigner'
+        'Status = stsDefault')
+      (
+        'Component = lblSubject'
+        'Status = stsDefault')
+      (
+        'Component = lblNewTitle'
+        'Status = stsDefault')
+      (
+        'Component = cmdChange'
+        'Status = stsDefault')
+      (
+        'Component = txtSubject'
+        'Status = stsDefault')
+      (
+        'Component = pnlAction'
+        'Status = stsDefault')
+      (
+        'Component = cmdNewConsult'
+        'Status = stsDefault')
+      (
+        'Component = cmdNewProc'
+        'Status = stsDefault')
+      (
+        'Component = cmdEditResubmit'
+        'Status = stsDefault')
+      (
+        'Component = lstNotes'
+        'Status = stsDefault')
+      (
+        'Component = tvCsltNotes'
+        'Status = stsDefault')
+      (
+        'Component = cmdPCE'
+        'Status = stsDefault')
+      (
+        'Component = pnlConsultList'
+        'Status = stsDefault')
+      (
+        'Component = lstConsults'
+        'Status = stsDefault')
+      (
+        'Component = tvConsults'
+        'Status = stsDefault')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = pnlRight'
+        'Status = stsDefault')
+      (
+        'Component = frmConsults'
+        'Status = stsDefault'))
   end
   object popNoteMemo: TPopupMenu
 …
     Top = 303
   end
+  object imgLblNotes: TVA508ImageListLabeler
+    Components = <
+      item
+        Component = tvCsltNotes
+      end>
+    Labels = <>
+    RemoteLabeler = dmodShared.imgLblNotes
+    Left = 16
+    Top = 48
+  end
+  object imgLblImages: TVA508ImageListLabeler
+    Components = <
+      item
+        Component = tvCsltNotes
+      end>
+    Labels = <>
+    RemoteLabeler = dmodShared.imgLblImages
+    Left = 8
+    Top = 88
+  end
+  object imgLblConsults: TVA508ImageListLabeler
+    Components = <
+      item
+        Component = tvConsults
+      end>
+    Labels = <>
+    RemoteLabeler = dmodShared.imgLblConsults
+    Left = 56
+    Top = 96
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fConsults.pas

-              r456
+              r829
 unit fConsults;
+{Notes of Intent:
+  Tab Order:
+    The tab order has been custom coded to place the pnlRight in the Tab order
+    right after the tvConsults.
+}
 interface
 …
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm,
   fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE,
+  ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList;
+  ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList,
+  VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
 type
 …
     mnuViewRemoteData: TMenuItem;
     mnuViewPostings: TMenuItem;
+    imgLblNotes: TVA508ImageListLabeler;
+    imgLblImages: TVA508ImageListLabeler;
+    imgLblConsults: TVA508ImageListLabeler;
     procedure mnuChartTabClick(Sender: TObject);
     procedure lstConsultsClick(Sender: TObject);
 …
     procedure popNoteMemoPreviewClick(Sender: TObject);
     procedure popNoteMemoInsTemplateClick(Sender: TObject);
-    procedure tvConsultsAddition(Sender: TObject; Node: TTreeNode);
-    procedure tvConsultsDeletion(Sender: TObject; Node: TTreeNode);
     procedure tvConsultsExit(Sender: TObject);
-    procedure pnlResultsExit(Sender: TObject);
-    procedure pnlActionExit(Sender: TObject);
     procedure FormHide(Sender: TObject);
     procedure FormShow(Sender: TObject);
-    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
-      Y: Integer);
     procedure ViewInfo(Sender: TObject);
     procedure mnuViewInformationClick(Sender: TObject);
+    procedure pnlLeftExit(Sender: TObject);
+    procedure pnlRightExit(Sender: TObject);
+    procedure cmdEditResubmitExit(Sender: TObject);
+    procedure cmdNewConsultExit(Sender: TObject);
   private
+    FocusToRightPanel : Boolean;
     FEditingIndex: Integer;      // TIU index of document being currently edited
     FChanged: Boolean;
 …
     FNotifPending: boolean;
     FOldFramePnlPatientExit: TNotifyEvent;
+    FOldDrawerPnlTemplatesButtonExit: TNotifyEvent;
+    FOldDrawerPnlEncounterButtonExit: TNotifyEvent;
+    FOldDrawerEdtSearchExit: TNotifyEvent;
+    FMousing: TDateTime;
+    //FMousing: TDateTime;
+    procedure DoLeftPanelCustomShiftTab;
     procedure frmFramePnlPatientExit(Sender: TObject);
-    procedure frmDrawerPnlTemplatesButtonExit(Sender: TObject);
-    procedure frmDrawerPnlEncounterButtonExit(Sender: TObject);
-    procedure frmDrawerEdtSearchExit(Sender: TObject);
     procedure DoAutoSave(Suppress: integer = 1);
     function GetTitleText(AnIndex: Integer): string;
 …
      fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor,
      dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields,
      uTemplates,  uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils;
+     uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter;
 const
 …
       DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote);
       ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
       memResults.Lines.Assign(TmpBoilerPlate);
+      QuickCopyWith508Msg(TmpBoilerPlate, memResults);
       TmpBoilerPlate.Free;
     end;
 …
       DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
       ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
       memResults.Lines.Assign(TmpBoilerPlate);
+      QuickCopyWith508Msg(TmpBoilerPlate, memResults);
       TmpBoilerPlate.Free;
     end;
 …
 { Form events -----------------------------------------------------------------}
+procedure TfrmConsults.pnlRightExit(Sender: TObject);
+begin
+  inherited;
+  if TabIsPressed then
+    FindNextControl(tvConsults, True, True, False).SetFocus
+  else if ShiftTabIsPressed then
+    FindNextControl(pnlLeft, True, True, False).SetFocus;
+end;
 procedure TfrmConsults.pnlRightResize(Sender: TObject);
 …
 end;
+procedure TfrmConsults.cmdNewConsultExit(Sender: TObject);
+begin
+  inherited;
+  if Not cmdEditResubmit.Visible then
+    DoLeftPanelCustomShiftTab;
+end;
 procedure TfrmConsults.cmdNewProcClick(Sender: TObject);
 begin
 …
          mnuActPrintSF513.Enabled     :=  True;
          mnuActConsultResults.Enabled :=  (lstConsults.ItemIEN > 0) and
                                           (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN)) and
+                                          (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and
                                           ((status<>ST_DISCONTINUED) and
                                            (status<>ST_CANCELLED)))
 …
   mnuActComplete.Enabled           :=   mnuActConsultResults.Enabled and
                                         ((MenuAccessRec.UserLevel = UL_UPDATE) or
+                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN))
+                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
+                                        (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
                                         and
                                        ((ConsultRec.ORStatus=ST_PENDING) or
 …
   mnuActMakeAddendum.Enabled       :=  mnuActConsultResults.Enabled and
                                         ((MenuAccessRec.UserLevel = UL_UPDATE) or
+                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN))
+                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
+                                        (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
                                         and
                                         (ConsultRec.ORStatus=ST_COMPLETE) and
 …
        if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then
          begin
            memConsult.Lines.Assign(GetDetailedMedicineResults(lstNotes.ItemID));
+           QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult);
            x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1);
+           NotifyOtherApps(NAE_REPORT, 'MED^' + x);
+           x := 'MED^' + x;
+           SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
+           NotifyOtherApps(NAE_REPORT, x);
          end
        else
 …
            mnuActChange.Enabled     := False;
            mnuActLoadBoiler.Enabled := False;
+           NotifyOtherApps(NAE_REPORT, 'TIU^' + lstNotes.ItemID);
+           x := 'TIU^' + lstNotes.ItemID;
+           SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
+           NotifyOtherApps(NAE_REPORT, x);
          end;
        memConsult.SelStart := 0;
 …
 end;
+{for printing multiple notes}
 procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
 var
 …
   i: integer;
 begin
-  inherited;
   with AForm.lbIDParents do
+  begin
+    for i := 0 to Items.Count - 1 do
+     begin
+       if Selected[i] then
+        begin
+         NoteIEN := StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
+         if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else
+          begin
+           if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
+           if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
+          end;
+        end; {if selected}
+     end; {for}
+  end; {with}
+  for i := 0 to Items.Count - 1 do
+  if Selected[i] then
+  begin
+    NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
+    if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
+    else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
+    else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
+  end;
 end;
 …
   memConsult.SelStart := 0;
   SetResultMenus;
+  if memConsult.CanFocus then
+    memConsult.SetFocus;
 end;
 …
   LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1);
   memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
+  pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
+  //CQ13181     508 Consults--Splitter bar doesn't retain size
+ //CQ13181  pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
 end;
 procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
+var
+  SavedCsltID: string;
 begin
   if ViewContext = 0 then exit;     // form has not yet been displayed, so nothing to update
   if EditingIndex <> -1 then exit;  // do not rebuild list until after save
+  with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID;
   case OrderAction of
   ORDER_NEW:  UpdateList ;
   ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil}
   end;
+  if SavedCsltID <> '' then with tvConsults do
+  begin
+    Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
+    tvConsultsChange(Self, Selected);
+  end;
 end;
 …
 begin
   inherited;
+  FocusToRightPanel := False;
   PageID := CT_CONSULTS;
-  memConsult.Color := ReadOnlyColor;
-  memPCEShow.Color := ReadOnlyColor;
-  lblNewTitle.Color := ReadOnlyColor;
   EditingIndex := -1;
   FLastNoteID := '';
 …
   frmDrawers.Splitter := splDrawers;
   frmDrawers.DefTempPiece := 2;
-  tvCsltNotes.Images := dmodShared.imgNotes;
-  tvCsltNotes.StateImages := dmodShared.imgImages;
-  tvConsults.Images := dmodShared.imgConsults;
   FImageFlag := TBitmap.Create;
   FDocList := TStringList.Create;
 …
     end;
   FCsltList := TStringList.Create;
-  TAccessibleTreeView.WrapControl(tvConsults);
 end;
 …
   tvConsultsChange(Self, tvConsults.Selected);
   //lstConsultsClick(Self);
+  if memConsult.CanFocus then
+    memConsult.SetFocus;
 end;
 …
 end;
+procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject);
+begin
+  inherited;
+  DoLeftPanelCustomShiftTab;
+end;
 procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject);
 begin
 …
   inherited;
   EditTemplates(Self, True);
+end;
+procedure TfrmConsults.pnlLeftExit(Sender: TObject);
+begin
+  inherited;
+  if (Not FocusToRightPanel) then
+    if ShiftTabIsPressed then
+      frmFrame.tabPage.SetFocus
+    else if TabIsPressed then
+      frmFrame.pnlPatient.SetFocus;
+  if FocusToRightPanel then
+    FocusToRightPanel := False;
 end;
 …
 procedure TfrmConsults.FormDestroy(Sender: TObject);
 begin
-  TAccessibleTreeView.UnwrapControl(tvConsults);
   FDocList.Free;
   FCsltList.Free;
 …
     if (DocType = TYP_ADDENDUM) then
     begin
       if AskCosignerForDocument(Addend, Author) and (Cosigner <= 0) then Result := True;
+      if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True;
     end else
     begin
 …
   ErrMsg: string;
 begin
+  if fFrame.frmFrame.DLLActive = True then Exit;
   if (EditingIndex > -1) and FChanged then
   begin
 …
     InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
   //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
+end;
+procedure TfrmConsults.DoLeftPanelCustomShiftTab;
+begin
+  if ShiftTabIsPressed then begin
+    FocusToRightPanel := True;
+    FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus;
+  end;
 end;
 …
   begin
     ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
     memResults.Lines.Assign(BoilerText);
+    QuickCopyWith508Msg(BoilerText, memResults);
     FChanged := False;
   end;
 …
 : begin
              ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
              memResults.Lines.AddStrings(BoilerText);  // append
+             QuickCopyWith508Msg(BoilerText, memResults);  // append
            end;
 : AssignBoilerText;                         // replace
 …
         CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending);
         UpdateConsultsTreeView(FCsltList, tvConsults);
         lstConsults.Items.Assign(tmpList);
+        FastAssign(tmpList, lstConsults.Items);
       end;
     with tvConsults do
 …
       uChanging := True;
       Items.BeginUpdate;
       lstConsults.Items.AddStrings(DocList);
+      FastAddStrings(DocList, lstConsults.Items);
       BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext);
       Items.EndUpdate;
 …
   Signers := TStringList.Create;
   try
     Signers.Assign(GetCurrentSigners(NoteIEN));
+    FastAssign(GetCurrentSigners(NoteIEN), Signers);
     for i := 0 to Signers.Count - 1 do
       if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then
 …
 end;
-procedure TfrmConsults.tvConsultsAddition(Sender: TObject;
-  Node: TTreeNode);
-begin
-  inherited;
-  TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
-end;
-procedure TfrmConsults.tvConsultsDeletion(Sender: TObject;
-  Node: TTreeNode);
-begin
-  inherited;
-  TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
-end;
 procedure TfrmConsults.lstConsultsToPrint;
 var
 …
 end;
-{Tab Order tricks.  Need to change
-  tvConsult
-  tvCsltNotes
-  cmdEditResubmit
-  cmdNewConsult
-  cmdNewProc
-  frmDrawers.pnlTemplateButton
-  frmDrawers.pnlEncounterButton
-  cmdPCE
-  cmdChange
-  txtSubject
-  memResults
-to
-  tvConsult
-  cmdChange
-  txtSubject
-  memResults
-  tvCsltNotes
-  cmdEditResubmit
-  cmdNewConsult
-  cmdNewProc
-  frmDrawers.pnlTemplateButton
-  frmDrawers.pnlEncounterButton
-  cmdPCE
+}
 procedure TfrmConsults.tvConsultsExit(Sender: TObject);
 begin
   inherited;
+  if IncSecond(FMousing,1) < Now then
+  begin
+    if (Screen.ActiveControl = tvCsltNotes) or
+        (Screen.ActiveControl = cmdEditResubmit) or
+        (Screen.ActiveControl = cmdNewConsult) or
+        (Screen.ActiveControl = cmdNewProc) or
+        (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or
+        (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or
+        (Screen.ActiveControl = cmdPCE) then
+      FindNextControl( cmdPCE, True, True, False).SetFocus;
+  end;
+  FMousing := 0;
+end;
+procedure TfrmConsults.pnlResultsExit(Sender: TObject);
+begin
+  inherited;
+  if IncSecond(FMousing,1) < Now then
+  begin
+    if (Screen.ActiveControl = frmFrame.pnlPatient) then
+      FindNextControl( tvConsults, True, True, False).SetFocus
+    else
+    if (Screen.ActiveControl = tvCsltNotes) or
+        (Screen.ActiveControl = cmdEditResubmit) or
+        (Screen.ActiveControl = cmdNewConsult) or
+        (Screen.ActiveControl = cmdNewProc) or
+        (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or
+        (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or
+        (Screen.ActiveControl = cmdPCE) then
+      FindNextControl( tvCsltNotes, False, True, False).SetFocus;
+  end;
+  FMousing := 0;
+end;
+procedure TfrmConsults.pnlActionExit(Sender: TObject);
+begin
+  inherited;
+  if IncSecond(FMousing,1) < Now then
+  begin
+    if (Screen.ActiveControl = memConsult) or
+        (Screen.ActiveControl = cmdChange) or
+        (Screen.ActiveControl = txtSubject) or
+        (Screen.ActiveControl = memResults) then
+      begin
+        //frmFrame.pnlPatient.SetFocus  //COMMENTED OUT FOR CQ6498
+        if memResults.CanFocus then
+          memResults.SetFocus //ADDED THIS LINE FOR CQ6498
+        else
+          memConsult.SetFocus;
+      end
+    else
+    if (Screen.ActiveControl = tvConsults) then
+      FindNextControl( frmFrame.pnlPatient, False, True, False).SetFocus;
+  end;
+  FMousing := 0;
+  FocusToRightPanel := True;
+  if TabIsPressed then
+    FindNextControl(pnlLeft, False, True, False).SetFocus;
 end;
 …
 begin
   FOldFramePnlPatientExit(Sender);
+  if IncSecond(FMousing,1) < Now then
+  begin
+    if (Screen.ActiveControl = memConsult) or
+        (Screen.ActiveControl = cmdChange) or
+        (Screen.ActiveControl = txtSubject) or
+        (Screen.ActiveControl = memResults) then
+      FindNextControl( memConsult, False, True, False).SetFocus;
+  end;
+  FMousing := 0;
+  if ShiftTabIsPressed then
+    FindNextControl( pnlRight, False, True, False).SetFocus;
 end;
 …
   inherited;
   frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit;
-  frmDrawers.pnlTemplatesButton.OnExit := FOldDrawerPnlTemplatesButtonExit;
-  frmDrawers.pnlEncounterButton.OnExit := FOldDrawerPnlEncounterButtonExit;
-  frmDrawers.edtSearch.OnExit := FOldDrawerEdtSearchExit;
 end;
 …
   FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit;
   frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit;
-  FOldDrawerPnlTemplatesButtonExit := frmDrawers.pnlTemplatesButton.OnExit;
-  frmDrawers.pnlTemplatesButton.OnExit := frmDrawerPnlTemplatesButtonExit;
-  FOldDrawerPnlEncounterButtonExit := frmDrawers.pnlEncounterButton.OnExit;
-  frmDrawers.pnlEncounterButton.OnExit := frmDrawerPnlEncounterButtonExit;
-  FOldDrawerEdtSearchExit := frmDrawers.edtSearch.OnExit;
-  frmDrawers.edtSearch.OnExit := frmDrawerEdtSearchExit;
   {Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked
   and looked for side effects and a better solution and this was the best!}
 …
   end
   {End of ClearQuest Defect HDS0000948 Fixes}
-end;
-procedure TfrmConsults.frmDrawerEdtSearchExit(Sender: TObject);
-begin
-  FOldDrawerEdtSearchExit(Sender);
-  pnlActionExit(Sender);
-end;
-procedure TfrmConsults.frmDrawerPnlTemplatesButtonExit(Sender: TObject);
-begin
-  FOldDrawerPnlTemplatesButtonExit(Sender);
-  pnlActionExit(Sender);
-end;
-procedure TfrmConsults.frmDrawerPnlEncounterButtonExit(Sender: TObject);
-begin
-  FOldDrawerPnlEncounterButtonExit(Sender);
-  pnlActionExit(Sender);
-end;
-procedure TfrmConsults.FormMouseMove(Sender: TObject; Shift: TShiftState;
-  X, Y: Integer);
-begin
-  inherited;
-  FMousing := Now;
 end;
 …
 initialization
+  SpecifyFormIsNotADialog(TfrmConsults);
   uPCEEdit := TPCEData.Create;
   uPCEShow := TPCEData.Create;

cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm

-              r456
+              r829
 object frmConsultsView: TfrmConsultsView
+inherited frmConsultsView: TfrmConsultsView
   Left = 320
   Top = 172
-  Width = 414
-  Height = 400
   BorderIcons = []
   Caption = 'List Selected Consults'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 373
+  ClientWidth = 406
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       OnKeyPause = cboServiceSelect
       OnMouseClick = cboServiceSelect
+      CharsNeedMatch = 1
     end
     object cboGroupBy: TORComboBox
 …
       ListItemsOnly = False
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       SynonymChars = '<>'
       TabOrder = 5
+    end
+      CharsNeedMatch = 1
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = calBeginDate'
+        'Status = stsDefault')
+      (
+        'Component = calEndDate'
+        'Status = stsDefault')
+      (
+        'Component = lstStatus'
+        'Status = stsDefault')
+      (
+        'Component = radSort'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = treService'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = cboGroupBy'
+        'Status = stsDefault')
+      (
+        'Component = frmConsultsView'
+        'Status = stsDefault'))
   end
   object popStatus: TPopupMenu

cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
+  StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus;
+  StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmConsultsView = class(TForm)
+  TfrmConsultsView = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     lblBeginDate: TLabel;
 …
       FChanged := False;
       with radSort do ItemIndex := 1;
       //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP));                         {RV}
       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP));           {RV}
+      //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
+      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);           {RV}
       SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
       for i := 0 to SvcList.Count - 1 do
 …
           cboServiceSelect(frmConsultsView);
         end;
       lstStatus.Items.Assign(SubSetOfStatus);
+      FastAssign(SubSetOfStatus, lstStatus.Items);
       CurrentStatus := CurrentContext.Status;
       if CurrentStatus <> '' then with lstStatus do

cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm

-              r456
+              r829
 object frmCsltNote: TfrmCsltNote
+inherited frmCsltNote: TfrmCsltNote
   Left = 147
   Top = 206
 …
   ClientHeight = 189
   ClientWidth = 398
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2,3'
 …
       SynonymChars = '<>'
       TabOrder = 0
+      CharsNeedMatch = 1
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboCsltNote'
+        'Status = stsDefault')
+      (
+        'Component = frmCsltNote'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
   Buttons, ORCtrls, ORfn, ExtCtrls;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmCsltNote = class(TForm)
+  TfrmCsltNote = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;

cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm

-              r456
+              r829
 object frmEditCslt: TfrmEditCslt
+inherited frmEditCslt: TfrmEditCslt
   Tag = 110
   Left = 409
   Top = 225
   Width = 569
   Height = 367
+  Width = 599
+  Height = 375
   HorzScrollBar.Range = 561
   VertScrollBar.Range = 340
-  AutoScroll = False
   Caption = 'Edit/Resubmit a Cancelled Consult'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  Constraints.MinHeight = 371
+  Constraints.MinWidth = 573
   OldCreateOrder = True
   Position = poScreenCenter
+  ExplicitLeft = 409
+  ExplicitTop = 225
+  ExplicitWidth = 599
+  ExplicitHeight = 375
   DesignSize = (
 )
+)
   PixelsPerInch = 96
   TextHeight = 13
   object lblService: TLabel
+  object lblService: TLabel [0]
     Left = 4
     Top = 4
 …
     Caption = 'Consult to Service/Specialty'
   end
   object lblReason: TLabel
+  object lblReason: TLabel [1]
     Left = 4
     Top = 166
 …
     Caption = 'Reason for Consult'
   end
   object lblComment: TLabel
+  object lblComment: TLabel [2]
     Left = 4
     Top = 105
 …
     Caption = 'New Comments:'
   end
   object lblComments: TLabel
+  object lblComments: TLabel [3]
     Left = 4
     Top = 51
 …
     Caption = 'Display Comments:'
   end
   object lblUrgency: TStaticText
+  object lblUrgency: TStaticText [4]
     Left = 196
     Top = 4
 …
     TabOrder = 16
   end
   object lblPlace: TStaticText
+  object lblPlace: TStaticText [5]
     Left = 376
     Top = 41
 …
     TabOrder = 17
   end
   object lblAttn: TStaticText
+  object lblAttn: TStaticText [6]
     Left = 376
     Top = 4
 …
     TabOrder = 18
   end
   object lblProvDiag: TStaticText
+  object lblProvDiag: TStaticText [7]
     Left = 195
     Top = 82
 …
     TabOrder = 19
   end
   object lblInpOutp: TStaticText
+  object lblInpOutp: TStaticText [8]
     Left = 197
     Top = 47
 …
     TabOrder = 20
   end
   object memReason: TRichEdit
+  object memReason: TRichEdit [9]
     Left = 4
     Top = 179
     Width = 552
     Height = 129
+    Width = 589
+    Height = 137
     Anchors = [akLeft, akTop, akRight, akBottom]
     Font.Charset = DEFAULT_CHARSET
 …
     OnKeyPress = memCommentKeyPress
     OnKeyUp = memCommentKeyUp
+  end
+  object pnlMessage: TPanel
+    Left = 21
+    Top = 292
+    Width = 381
+    ExplicitHeight = 136
+  end
+  object pnlMessage: TPanel [10]
+    Left = 16
+    Top = 294
+    Width = 418
     Height = 44
     Anchors = [akLeft, akRight, akBottom]
 …
     end
   end
   object cboService: TORComboBox
+  object cboService: TORComboBox [11]
     Left = 4
     Top = 19
 …
     CharsNeedMatch = 1
   end
   object cboUrgency: TORComboBox
+  object cboUrgency: TORComboBox [12]
     Left = 196
     Top = 19
 …
     CharsNeedMatch = 1
   end
   object radInpatient: TRadioButton
+  object radInpatient: TRadioButton [13]
     Left = 197
     Top = 61
 …
     OnClick = radInpatientClick
   end
   object radOutpatient: TRadioButton
+  object radOutpatient: TRadioButton [14]
     Left = 269
     Top = 61
 …
     OnClick = radOutpatientClick
   end
   object cboPlace: TORComboBox
+  object cboPlace: TORComboBox [15]
     Left = 376
     Top = 54
     Width = 179
+    Width = 216
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     CharsNeedMatch = 1
   end
   object txtProvDiag: TCaptionEdit
+  object txtProvDiag: TCaptionEdit [16]
     Left = 195
     Top = 95
     Width = 309
+    Width = 346
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     Caption = 'Provisional Diagnosis'
   end
   object txtAttn: TORComboBox
+  object txtAttn: TORComboBox [17]
     Left = 376
     Top = 19
     Width = 181
+    Width = 218
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     CharsNeedMatch = 1
   end
   object cboCategory: TORComboBox
+  object cboCategory: TORComboBox [18]
     Left = 561
     Top = 103
 …
     CharsNeedMatch = 1
   end
   object cmdAccept: TButton
     Left = 407
     Top = 313
+  object cmdAccept: TButton [19]
+    Left = 437
+    Top = 319
     Width = 72
     Height = 21
 …
     OnClick = cmdAcceptClick
   end
   object cmdQuit: TButton
     Left = 484
     Top = 313
+  object cmdQuit: TButton [20]
+    Left = 514
+    Top = 319
     Width = 72
     Height = 21
 …
     OnClick = cmdQuitClick
   end
   object memComment: TRichEdit
+  object memComment: TRichEdit [21]
     Left = 4
     Top = 121
     Width = 550
+    Width = 587
     Height = 41
     Anchors = [akLeft, akTop, akRight]
 …
     OnKeyUp = memCommentKeyUp
   end
   object btnCmtCancel: TButton
+  object btnCmtCancel: TButton [22]
     Left = 110
     Top = 49
 …
     OnClick = btnCmtCancelClick
   end
   object btnCmtOther: TButton
+  object btnCmtOther: TButton [23]
     Left = 110
     Top = 75
 …
     OnClick = btnCmtOtherClick
   end
   object cmdLexSearch: TButton
     Left = 508
+  object cmdLexSearch: TButton [24]
+    Left = 545
     Top = 95
     Width = 46
 …
     TabOrder = 9
     OnClick = cmdLexSearchClick
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblUrgency'
+        'Status = stsDefault')
+      (
+        'Component = lblPlace'
+        'Status = stsDefault')
+      (
+        'Component = lblAttn'
+        'Status = stsDefault')
+      (
+        'Component = lblProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = lblInpOutp'
+        'Status = stsDefault')
+      (
+        'Component = memReason'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = radInpatient'
+        'Status = stsDefault')
+      (
+        'Component = radOutpatient'
+        'Status = stsDefault')
+      (
+        'Component = cboPlace'
+        'Status = stsDefault')
+      (
+        'Component = txtProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = txtAttn'
+        'Status = stsDefault')
+      (
+        'Component = cboCategory'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = memComment'
+        'Status = stsDefault')
+      (
+        'Component = btnCmtCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnCmtOther'
+        'Status = stsDefault')
+      (
+        'Component = cmdLexSearch'
+        'Status = stsDefault')
+      (
+        'Component = frmEditCslt'
+        'Status = stsDefault'))
   end
   object mnuPopProvDx: TPopupMenu

cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
   Menus ;
+  Menus, fBase508Form, VA508AccessibilityManager;
 type
   TfrmEditCslt = class(TForm)
+  TfrmEditCslt = class(TfrmBase508Form)
     cboService: TORComboBox;
     cboUrgency: TORComboBox;
 …
 begin
   FChanging := True;
   Defaults.Assign(ODForConsults);
+  FastAssign(ODForConsults, Defaults);
   FLastServiceID := '';
   cboService.Items.Clear;
 …
     end;
   StatusText('Initializing Long List');
   SvcList.Assign(LoadServiceList(CN_SVC_LIST_ORD))   ;
+  FastAssign(LoadServiceList(CN_SVC_LIST_ORD), SvcList)   ;
   with cboService do
     begin
 …
     ProvDx.CodeInactive := True;
    end;
   memReason.Lines.Assign(OldRec.RequestReason);
+  QuickCopy(OldRec.RequestReason, memReason);
   memComment.Clear ;
   btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
 …
           RequestReason.Clear
         else
           RequestReason.Assign(Lines);
+          QuickCopy(memReason, RequestReason);
       with memComment do
         if GetTextLen > 0 then
           NewComments.Assign(Lines)
+          QuickCopy(memComment, NewComments)
         else
           NewComments.Clear;
 …
   AStringList := TStringList.Create;
   try
+    AStringList.Assign(memReason.Lines);
+    //QuickCopy(memReason, AStringList);
+    AStringList.Text := memReason.Text;
     LimitStringLength(AStringList, 74);
+    memReason.Lines.Assign(AstringList);
+    //QuickCopy(AstringList, memReason);
+    memReason.Text := AStringList.Text;
     ControlChange(Self);
   finally

cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm

-              r456
+              r829
 object frmEditProc: TfrmEditProc
+inherited frmEditProc: TfrmEditProc
   Tag = 112
   Left = 296
   Top = 245
   Width = 569
   Height = 335
+  Width = 571
+  Height = 359
   HorzScrollBar.Range = 561
   VertScrollBar.Range = 308
-  AutoScroll = False
   Caption = 'Edit and resubmit a cancelled procedure'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  Constraints.MinHeight = 359
+  Constraints.MinWidth = 571
   OldCreateOrder = True
   Position = poScreenCenter
+  ExplicitLeft = 296
+  ExplicitTop = 245
+  ExplicitWidth = 571
+  ExplicitHeight = 359
   DesignSize = (
 )
+)
   PixelsPerInch = 96
   TextHeight = 13
   object lblProc: TLabel
+  object lblProc: TLabel [0]
     Left = 3
     Top = 7
 …
     Caption = 'Procedure'
   end
   object lblReason: TLabel
+  object lblReason: TLabel [1]
     Left = 3
     Top = 167
 …
     Caption = 'Reason for Consult'
   end
   object lblService: TOROffsetLabel
+  object lblService: TOROffsetLabel [2]
     Left = 3
     Top = 49
 …
     WordWrap = False
   end
   object lblComment: TLabel
+  object lblComment: TLabel [3]
     Left = 106
     Top = 109
 …
     Caption = 'New Comments'
   end
   object lblComments: TLabel
+  object lblComments: TLabel [4]
     Left = 3
     Top = 99
 …
     Caption = 'Display Comments:'
   end
   object lblUrgency: TStaticText
+  object lblUrgency: TStaticText [5]
     Left = 190
     Top = 7
 …
     TabOrder = 18
   end
   object lblPlace: TStaticText
+  object lblPlace: TStaticText [6]
     Left = 362
     Top = 50
 …
     TabOrder = 19
   end
   object lblAttn: TStaticText
+  object lblAttn: TStaticText [7]
     Left = 362
     Top = 7
 …
     TabOrder = 20
   end
   object lblProvDiag: TStaticText
+  object lblProvDiag: TStaticText [8]
     Left = 190
     Top = 81
 …
     TabOrder = 21
   end
   object lblInpOutp: TStaticText
+  object lblInpOutp: TStaticText [9]
     Left = 192
     Top = 48
 …
     TabOrder = 17
   end
   object memReason: TRichEdit
+  object memReason: TRichEdit [10]
     Left = 2
     Top = 181
     Width = 555
     Height = 95
+    Width = 557
+    Height = 119
     Anchors = [akLeft, akTop, akRight, akBottom]
     Font.Charset = DEFAULT_CHARSET
 …
     OnKeyUp = memCommentKeyUp
   end
   object cmdAccept: TButton
     Left = 399
     Top = 282
+  object cmdAccept: TButton [11]
+    Left = 401
+    Top = 303
     Width = 72
     Height = 21
 …
     OnClick = cmdAcceptClick
   end
   object cmdQuit: TButton
     Left = 484
     Top = 282
+  object cmdQuit: TButton [12]
+    Left = 486
+    Top = 303
     Width = 72
     Height = 21
 …
     OnClick = cmdQuitClick
   end
   object cboUrgency: TORComboBox
+  object cboUrgency: TORComboBox [13]
     Left = 190
     Top = 22
 …
     CharsNeedMatch = 1
   end
   object radInpatient: TRadioButton
+  object radInpatient: TRadioButton [14]
     Left = 190
     Top = 61
 …
     OnClick = radInpatientClick
   end
   object radOutpatient: TRadioButton
+  object radOutpatient: TRadioButton [15]
     Left = 264
     Top = 61
 …
     OnClick = radOutpatientClick
   end
   object cboPlace: TORComboBox
+  object cboPlace: TORComboBox [16]
     Left = 362
     Top = 63
     Width = 195
+    Width = 197
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     OnChange = ControlChange
     CharsNeedMatch = 1
+  end
+  object txtProvDiag: TCaptionEdit
+    ExplicitWidth = 195
+  end
+  object txtProvDiag: TCaptionEdit [17]
     Left = 190
     Top = 94
     Width = 313
+    Width = 315
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     Caption = 'Provisional Diagnosis'
   end
   object txtAttn: TORComboBox
+  object txtAttn: TORComboBox [18]
     Left = 362
     Top = 22
     Width = 195
+    Width = 197
     Height = 21
     Anchors = [akLeft, akTop, akRight]
 …
     OnNeedData = txtAttnNeedData
     CharsNeedMatch = 1
+  end
+  object cboProc: TORComboBox
+    ExplicitWidth = 195
+  end
+  object cboProc: TORComboBox [19]
     Left = 3
     Top = 22
 …
     CharsNeedMatch = 1
   end
   object cboCategory: TORComboBox
+  object cboCategory: TORComboBox [20]
     Left = 505
     Top = -11
 …
     CharsNeedMatch = 1
   end
   object cboService: TORComboBox
+  object cboService: TORComboBox [21]
     Left = 3
     Top = 65
 …
     CharsNeedMatch = 1
   end
   object memComment: TRichEdit
+  object memComment: TRichEdit [22]
     Left = 106
     Top = 123
     Width = 449
+    Width = 451
     Height = 38
     Anchors = [akLeft, akTop, akRight]
 …
     OnKeyUp = memCommentKeyUp
   end
   object pnlMessage: TPanel
     Left = 29
     Top = 264
     Width = 381
+  object pnlMessage: TPanel [23]
+    Left = 19
+    Top = 276
+    Width = 383
     Height = 44
     Anchors = [akLeft, akRight, akBottom]
 …
     end
   end
   object btnCmtCancel: TButton
+  object btnCmtCancel: TButton [24]
     Left = 11
     Top = 116
 …
     OnClick = btnCmtCancelClick
   end
   object btnCmtOther: TButton
+  object btnCmtOther: TButton [25]
     Left = 11
     Top = 139
 …
     OnClick = btnCmtOtherClick
   end
   object cmdLexSearch: TButton
     Left = 507
+  object cmdLexSearch: TButton [26]
+    Left = 509
     Top = 94
     Width = 49
 …
     TabOrder = 8
     OnClick = cmdLexSearchClick
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblUrgency'
+        'Status = stsDefault')
+      (
+        'Component = lblPlace'
+        'Status = stsDefault')
+      (
+        'Component = lblAttn'
+        'Status = stsDefault')
+      (
+        'Component = lblProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = lblInpOutp'
+        'Status = stsDefault')
+      (
+        'Component = memReason'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = radInpatient'
+        'Status = stsDefault')
+      (
+        'Component = radOutpatient'
+        'Status = stsDefault')
+      (
+        'Component = cboPlace'
+        'Status = stsDefault')
+      (
+        'Component = txtProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = txtAttn'
+        'Status = stsDefault')
+      (
+        'Component = cboProc'
+        'Status = stsDefault')
+      (
+        'Component = cboCategory'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = memComment'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = btnCmtCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnCmtOther'
+        'Status = stsDefault')
+      (
+        'Component = cmdLexSearch'
+        'Status = stsDefault')
+      (
+        'Component = frmEditProc'
+        'Status = stsDefault'))
   end
   object mnuPopProvDx: TPopupMenu

cprs/trunk/CPRS-Chart/Consults/fEditProc.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
   Menus;
+  Menus, fBase508Form, VA508AccessibilityManager;
 type
   TfrmEditProc = class(TForm)
+  TfrmEditProc = class(TfrmBase508Form)
     cmdAccept: TButton;
     cmdQuit: TButton;
 …
   FChanging := True;
   Defaults := TStringList.Create;
   Defaults.Assign(ODForProcedures);
+  FastAssign(ODForProcedures, Defaults);
   FLastProcID := '';
   cboProc.InitLongList(OldRec.ConsultProcName) ;
 …
     ProvDx.CodeInactive := True;
    end;
   memReason.Lines.Assign(OldRec.RequestReason);
+  QuickCopy(OldRec.RequestReason, memReason);
   btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
   btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
 …
           RequestReason.Clear
         else
           RequestReason.Assign(Lines);
+          QuickCopy(memReason, RequestReason);
       with memComment do
         if GetTextLen > 0 then
           NewComments.Assign(Lines)
+          QuickCopy(memComment, NewComments)
         else
           NewComments.Clear;
 …
       begin
         Clear;
         Items.Assign(GetProcedureServices(cboProc.ItemIEN));
+        FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
         if Items.Count > 0 then
           begin
 …
   AStringList := TStringList.Create;
   try
+    AStringList.Assign(memReason.Lines);
+    //QuickCopy(memReason, AStringList);
+    AStringList.Text := memReason.Text;
     LimitStringLength(AStringList, 74);
+    memReason.Lines.Assign(AstringList);
+    //QuickCopy(AstringList, memReason);
+    memReason.Text := AStringList.Text;
     ControlChange(Self);
   finally

cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm

-              r456
+              r829
   Constraints.MinWidth = 606
   Font.Charset = ANSI_CHARSET
+  ExplicitWidth = 606
+  ExplicitHeight = 376
   PixelsPerInch = 96
   TextHeight = 13
 …
     Caption = 'Consult to Service/Specialty'
   end
+  object pnlReason: TPanel [1]
+  object lblProvDiag: TLabel [1]
+    Left = 309
+    Top = 81
+    Width = 100
+    Height = 13
+    Anchors = [akTop, akRight]
+    Caption = 'Provisional Diagnosis'
+  end
+  object lblUrgency: TLabel [2]
+    Left = 309
+    Top = 2
+    Width = 40
+    Height = 13
+    Anchors = [akTop, akRight]
+    Caption = 'Urgency'
+  end
+  object lblPlace: TLabel [3]
+    Left = 454
+    Top = 43
+    Width = 100
+    Height = 13
+    Anchors = [akTop, akRight]
+    Caption = 'Place of Consultation'
+  end
+  object lblAttn: TLabel [4]
+    Left = 454
+    Top = 2
+    Width = 42
+    Height = 13
+    Anchors = [akTop, akRight]
+    Caption = 'Attention'
+  end
+  object pnlReason: TPanel [5]
     Left = 3
     Top = 154
+    Top = 128
     Width = 585
     Height = 135
+    Height = 161
     Anchors = [akLeft, akTop, akRight]
     BevelOuter = bvNone
     TabOrder = 11
+    TabOrder = 10
     object lblReason: TLabel
       Left = 0
 …
       Align = alTop
       Caption = 'Reason for Request'
+      ExplicitWidth = 95
     end
     object memReason: TRichEdit
 …
       Top = 13
       Width = 585
       Height = 122
+      Height = 148
       Align = alClient
       Font.Charset = ANSI_CHARSET
 …
     end
   end
-  object lblUrgency: TStaticText [2]
-    Left = 309
-    Top = 2
-    Width = 44
-    Height = 17
-    Anchors = [akTop, akRight]
-    Caption = 'Urgency'
-    TabOrder = 17
-  end
-  object lblPlace: TStaticText [3]
-    Left = 454
-    Top = 43
-    Width = 104
-    Height = 17
-    Anchors = [akTop, akRight]
-    Caption = 'Place of Consultation'
-    TabOrder = 18
-  end
-  object lblAttn: TStaticText [4]
-    Left = 454
-    Top = 2
-    Width = 46
-    Height = 17
-    Anchors = [akTop, akRight]
-    Caption = 'Attention'
-    TabOrder = 19
-  end
-  object lblProvDiag: TStaticText [5]
-    Left = 309
-    Top = 81
-    Width = 104
-    Height = 17
-    Anchors = [akTop, akRight]
-    Caption = 'Provisional Diagnosis'
-    TabOrder = 20
-  end
   inherited memOrder: TCaptionMemo
     Left = 3
 …
     Width = 417
     Height = 41
+    TabStop = True
+    Anchors = [akLeft, akBottom]
     Lines.Strings = (
       'The order text...'
 …
       '--------------------------------'
       'An order message may be displayed here.')
+    TabOrder = 1
+  end
+  inherited cmdAccept: TButton
+    Left = 427
+    Top = 315
+    TabOrder = 12
+  end
+  inherited cmdQuit: TButton
+    Left = 531
+    Top = 315
+    Width = 61
+    TabOrder = 13
+  end
+  inherited pnlMessage: TPanel
+    Left = 13
+    Top = 295
+    Width = 377
+    Anchors = [akLeft, akRight, akBottom]
+    TabOrder = 14
+    inherited memMessage: TRichEdit
+      Width = 292
+    end
+  end
+  object cboService: TORComboBox
+    TabOrder = 11
+    ExplicitLeft = 3
+    ExplicitTop = 305
+    ExplicitWidth = 417
+    ExplicitHeight = 41
+  end
+  object cboService: TORComboBox [7]
     Left = 0
     Top = 16
 …
     SynonymChars = '<>'
     TabOrder = 0
+    TabStop = True
     OnChange = ControlChange
     OnClick = cboServiceSelect
 …
     CharsNeedMatch = 1
   end
   object cboUrgency: TORComboBox
+  object cboUrgency: TORComboBox [8]
     Left = 309
     Top = 16
 …
     Style = orcsDropDown
     AutoSelect = True
-    Caption = 'Urgency'
     Color = clWindow
     DropDownCount = 8
 …
     Sorted = False
     SynonymChars = '<>'
     TabOrder = 4
+    TabOrder = 3
     TabStop = True
     OnChange = ControlChange
     CharsNeedMatch = 1
   end
   object cboPlace: TORComboBox
+  object cboPlace: TORComboBox [9]
     Left = 454
     Top = 56
 …
     Style = orcsDropDown
     AutoSelect = True
-    Caption = 'Place of Consultation'
     Color = clWindow
     DropDownCount = 8
 …
     Sorted = False
     SynonymChars = '<>'
     TabOrder = 7
+    TabOrder = 6
     OnChange = ControlChange
     CharsNeedMatch = 1
   end
   object txtProvDiag: TCaptionEdit
+  object txtProvDiag: TCaptionEdit [10]
     Left = 309
     Top = 94
 …
     PopupMenu = mnuPopProvDx
     ShowHint = True
     TabOrder = 9
+    TabOrder = 8
     OnChange = txtProvDiagChange
+    Caption = 'Provisional Diagnosis'
+  end
+  object txtAttn: TORComboBox
+  end
+  object txtAttn: TORComboBox [11]
     Left = 454
     Top = 16
 …
     Style = orcsDropDown
     AutoSelect = True
-    Caption = 'Attention'
     Color = clWindow
     DropDownCount = 8
 …
     Sorted = False
     SynonymChars = '<>'
     TabOrder = 5
+    TabOrder = 4
     OnChange = ControlChange
     OnNeedData = txtAttnNeedData
     CharsNeedMatch = 1
   end
   object treService: TORTreeView
+  object treService: TORTreeView [12]
     Left = 0
     Top = 38
 …
     ParentFont = False
     ReadOnly = True
     TabOrder = 3
+    TabOrder = 2
     Visible = False
     OnChange = treServiceChange
     OnCollapsing = treServiceCollapsing
+    OnEnter = treServiceEnter
     OnExit = treServiceExit
     OnKeyDown = treServiceKeyDown
     OnKeyUp = treServiceKeyUp
     OnMouseDown = treServiceMouseDown
-    Caption = 'object lblService: TLabel'
     NodePiece = 0
   end
   object cboCategory: TORComboBox
+  object cboCategory: TORComboBox [13]
     Left = 225
     Top = -5
 …
     CharsNeedMatch = 1
   end
   object pnlServiceTreeButton: TKeyClickPanel
+  object pnlServiceTreeButton: TKeyClickPanel [14]
     Left = 274
     Top = 14
 …
     Font.Style = []
     ParentFont = False
     TabOrder = 2
+    TabOrder = 1
     TabStop = True
     OnClick = btnServiceTreeClick
 …
       Width = 22
       Height = 22
+      Hint = 'View services/specialties hierarchically'
       Glyph.Data = {
         26050000424D26050000000000003604000028000000100000000F0000000100
 …
         FFFFFFFFFFFFFFFFFFFF}
       Margin = 0
+      ParentShowHint = False
+      ShowHint = True
       OnClick = btnServiceTreeClick
     end
   end
   object cmdLexSearch: TButton
+  object cmdLexSearch: TButton [15]
     Left = 543
     Top = 94
 …
     Anchors = [akTop, akRight]
     Caption = 'Lexicon'
     TabOrder = 10
+    TabOrder = 9
     OnClick = cmdLexSearchClick
   end
   object gbInptOpt: TGroupBox
+  object gbInptOpt: TGroupBox [16]
     Left = 309
     Top = 35
 …
     Anchors = [akTop, akRight]
     Caption = 'Patient will be seen as an:'
     TabOrder = 6
+    TabOrder = 5
     object radInpatient: TRadioButton
       Left = 3
 …
     end
   end
   object btnDiagnosis: TButton
+  object btnDiagnosis: TButton [17]
     Left = 543
     Top = 95
 …
     Anchors = [akTop, akRight]
     Caption = 'Diagnosis'
     TabOrder = 8
+    TabOrder = 7
     OnClick = btnDiagnosisClick
+  end
+  inherited cmdAccept: TButton
+    Left = 439
+    Top = 315
+    Anchors = [akLeft, akBottom]
+    TabOrder = 12
+    ExplicitLeft = 439
+    ExplicitTop = 315
+  end
+  inherited cmdQuit: TButton
+    Left = 531
+    Top = 315
+    Width = 61
+    Anchors = [akLeft, akBottom]
+    TabOrder = 13
+    ExplicitLeft = 531
+    ExplicitTop = 315
+    ExplicitWidth = 61
+  end
+  inherited pnlMessage: TPanel
+    Left = 13
+    Top = 295
+    Width = 377
+    Anchors = [akLeft, akRight, akBottom]
+    TabOrder = 14
+    ExplicitLeft = 13
+    ExplicitTop = 295
+    ExplicitWidth = 377
+    inherited memMessage: TRichEdit
+      Width = 292
+      ExplicitWidth = 292
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlReason'
+        'Status = stsDefault')
+      (
+        'Component = memReason'
+        'Label = lblReason'
+        'Status = stsOK')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Label = lblUrgency'
+        'Status = stsOK')
+      (
+        'Component = cboPlace'
+        'Label = lblPlace'
+        'Status = stsOK')
+      (
+        'Component = txtProvDiag'
+        'Label = lblProvDiag'
+        'Status = stsOK')
+      (
+        'Component = txtAttn'
+        'Label = lblAttn'
+        'Status = stsOK')
+      (
+        'Component = treService'
+        'Status = stsDefault')
+      (
+        'Component = cboCategory'
+        'Status = stsDefault')
+      (
+        'Component = pnlServiceTreeButton'
+        'Status = stsDefault')
+      (
+        'Component = cmdLexSearch'
+        'Status = stsDefault')
+      (
+        'Component = gbInptOpt'
+        'Status = stsDefault')
+      (
+        'Component = radInpatient'
+        'Status = stsDefault')
+      (
+        'Component = radOutpatient'
+        'Status = stsDefault')
+      (
+        'Component = btnDiagnosis'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODCslt'
+        'Status = stsDefault'))
   end
   object mnuPopProvDx: TPopupMenu

cprs/trunk/CPRS-Chart/Consults/fODConsult.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
+  Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet ;
+  Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
+  VA508AccessibilityManager ;
 type
 …
     txtAttn: TORComboBox;
     lblService: TLabel;
     lblUrgency: TStaticText;
     lblPlace: TStaticText;
     lblAttn: TStaticText;
     lblProvDiag: TStaticText;
+    lblUrgency: TLabel;
+    lblPlace: TLabel;
+    lblAttn: TLabel;
+    lblProvDiag: TLabel;
     treService: TORTreeView;
     cboCategory: TORComboBox;
 …
     procedure cmdQuitClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
+    procedure FormResize(Sender: TObject);
+    procedure treServiceEnter(Sender: TObject);
   private
 …
     procedure SaveConsultDxForNurse(pDiagnosis: string);  // save the dx entered by nurese if Master BA switch is ON
     procedure SetUpCopyConsultDiagnoses(pOrderID:string);
+    procedure AdjustMemReasonSize;
   protected
     procedure InitDialog; override;
 …
 uses
     rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
     ORClasses, clipbrd, uTemplates, fFrame, uODBase;
+    ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility;
 var
 …
   TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
+  TX_SVC_HRCHY = 'services/specialties hierarchy';
+  TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
+  TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
 procedure TfrmODCslt.FormCreate(Sender: TObject);
 begin
 …
   Responses.Dialog := 'GMRCOR CONSULT';   // loads formatting info
   StatusText('Loading Default Values');
   Defaults.Assign(ODForConsults);  // ODForConsults returns TStrings with defaults
+  FastAssign(ODForConsults, Defaults);  // ODForConsults returns TStrings with defaults
   CtrlInits.LoadDefaults(Defaults);
   txtAttn.InitLongList('') ;
 …
   btnServiceTree.Enabled := True;
   pnlServiceTreeButton.Enabled := True;
-  ActiveControl := cboService;
   SetProvDiagPromptingMode;
+  ActiveControl := cboService; // set after call to SetProvDiagPromptingMode
   Changing := False;
   StatusText('');
 …
                     'Please contact your Clinical Coordinator/IRM staff to fix this order.';
   TX_INACTIVE_SVC_CAP = 'Inactive Service';
+  TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF +
+              'Please contact your Clinical Coordinator/IRM staff to fix this order.';
+  TC_NO_SVC = 'No service specified';
 var
  i:integer;
 …
       Changing := True;
       tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
+      SvcIEN := GetServiceIEN(tmpResp.IValue);
+      if tmpResp <> nil then
+        SvcIEN := GetServiceIEN(tmpResp.IValue)
+      else
+        begin
+          InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK);
+          AbortOrder := True;
+          Close;
+          Exit;
+        end;
       if SvcIEN = '-1' then
         begin
 …
       SetProvDiagPromptingMode;
       GetProvDxandValidateCode(Responses);
+      SetTemplateDialogCanceled(FALSE);
       SetControl(memReason,     'COMMENT',   1);
+      if WasTemplateDialogCanceled then
+      begin
+        AbortOrder := True;
+        Close;
+        Exit;
+      end;
+      SetTemplateDialogCanceled(FALSE);
       SetupReasonForRequest(OrderAction);
+      if WasTemplateDialogCanceled then
+      begin
+        AbortOrder := True;
+        Close;
+        Exit;
+      end;
       Changing := False;
       ControlChange(Self);
 …
     begin
       if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ;
       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD));           {RV}
       AList.Assign(SvcList);
+      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD), SvcList);           {RV}
+      FastAssign(SvcList, AList);
       SortByPiece(AList, U, 2);
       BuildServiceTree(treService, SvcList, '0', nil) ;
 …
       if QuickList.Count > 0 then with cboService do
         begin
           Items.Assign(QuickList);
+          FastAssign(QuickList, cboService.Items);
           Items.Add(LLS_LINE);
           Items.Add(LLS_SPACE);
 …
               Exit;
             end;
           memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+          QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
         end;
       PreserveControl(treService);
 …
       SetControl(cboPlace,      'PLACE',     1);
       SetControl(txtAttn,       'PROVIDER',  1);
+      SetTemplateDialogCanceled(FALSE);
       SetControl(memReason,     'COMMENT',   1);
+      if WasTemplateDialogCanceled and OrderContainsObjects then
+      begin
+        AbortOrder := TRUE;
+        Close;
+        Exit;
+      end;
       if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
         memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+        QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
       SetupReasonForRequest(ORDER_QUICK);
       GetProvDxandValidateCode(Responses);
 …
               Exit;
             end;
           memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+          QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
           SetupReasonForRequest(ORDER_NEW);
         end;
 …
 end;
+procedure TfrmODCslt.treServiceEnter(Sender: TObject);
+begin
+  inherited;
+  cmdQuit.Cancel := FALSE;
+end;
 procedure TfrmODCslt.treServiceExit(Sender: TObject);
 begin
   inherited;
+  cmdQuit.Cancel := TRUE;
   with cboService do
   begin
 …
   AStringList := TStringList.Create;
   try
+    AStringList.Assign(memReason.Lines);
+    //QuickCopy(memReason, AStringList);
+    AStringList.Text := memReason.Text;
     LimitStringLength(AStringList, 74);
+    memReason.Lines.Assign(AstringList);
+    //QuickCopy(AstringList, memReason);
+    memReason.Text := AStringList.Text;
     ControlChange(Self);
   finally
 …
               SetControl(cboPlace,      'PLACE',     1);
               SetControl(txtAttn,       'PROVIDER',  1);
+              SetTemplateDialogCanceled(FALSE);
               SetControl(memReason,     'COMMENT',   1);
+              if WasTemplateDialogCanceled and OrderContainsObjects then
+              begin
+                AbortOrder := TRUE;
+                Close;
+                Exit;
+              end;
 //              if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
 //                memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+//                QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
               SetupReasonForRequest(ORDER_QUICK);
               GetProvDxandValidateCode(Responses);
 …
                       Exit;
                     end;
                   memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+                  QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
                   SetupReasonForRequest(ORDER_NEW);
                   Changing := False;
 …
   if treService.Visible then
   begin
+  // for some reason screen reader is reading caption when tree view is not visible
+    treService.Caption := TX_SVC_HRCHY;
+    pnlServiceTreeButton.Caption := TX_CLOSE_SVC_HRCHY;
+    btnServiceTree.Hint := TX_CLOSE_SVC_HRCHY;
     treService.SetFocus;
     with treService do for i := 0 to Items.Count-1 do
 …
         end;
     end;
+  end
+  else
+  begin
+    treService.Caption := '';
+    pnlServiceTreeButton.Caption := TX_VIEW_SVC_HRCHY;
+    btnServiceTree.Hint := TX_VIEW_SVC_HRCHY;
+    pnlServiceTreeButton.SetFocus;
   end;
   Changing := False;
 …
       txtProvDiag.Enabled    := False;
       txtProvDiag.Font.Color := clGrayText;
-      lblProvDiag.Enabled    := False;
       txtProvDiag.ReadOnly   := True;
       txtProvDiag.Color      := clBtnFace;
 …
   txtProvDiag.Color      := clBtnFace;
   txtProvDiag.Font.Color := clBtnText;
-  lblProvDiag.Enabled    := False;
   txtProvDiag.Hint       := '';
   if cboService.ItemIEN = 0 then Exit;
 …
       txtProvDiag.Color      := clBtnFace;
       txtProvDiag.Font.Color := clBtnText;
-      lblProvDiag.Enabled    := False;
     end
   else
 …
               txtProvDiag.Color      := clWindow;
               txtProvDiag.Font.Color := clWindowText;
-              lblProvDiag.Enabled    := True;
             end;
       'L':  begin
 …
               txtProvDiag.Color      := clInfoBk;
               txtProvDiag.Font.Color := clInfoText;
-              lblProvDiag.Enabled    := True;
            end;
     end;
 …
 begin
   if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then
     memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
+    QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
   EditReason := GMRCREAF;
   if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR);
 …
       if ItemIEN > 0 then
         begin
           Alist.Assign(GetServicePrerequisites(ItemID + CSLT_PTR));
+          FastAssign(GetServicePrerequisites(ItemID + CSLT_PTR), Alist);
           if AList.Count > 0 then
             begin
 …
   try
     Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve);
     TmpSL.Assign(Result);
+    FastAssign(Result, TmpSL);
     x := TmpSL.Text;
     ExpandOrderObjects(x, HasObjects);
 …
     Responses.OrderContainsObjects := HasObjects;
     ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo);
+    if TmpSL.Text <> x then Responses.OrderContainsObjects := False;
+    Result.Assign(TmpSL);
+    AbortOrder := WasTemplateDialogCanceled;
+    Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects;
+    if AbortOrder then
+    begin
+      Result.Text := '';
+      Close;
+      Exit;
+    end
+    else
+      FastAssignWith508Msg(TmpSL, Result);
   finally
     TmpSL.Free;
 …
       treServiceChange(Sender, treService.Selected);
     end;
+  VK_ESCAPE:
+    begin
+      key := 0;
+      btnServiceTreeClick(Self);
+    end
   else
     FKeyBoarding := True;
 …
 end;
+procedure TfrmODCslt.FormResize(Sender: TObject);
+begin
+  inherited;
+  AdjustMemReasonSize();
+end;
+procedure TfrmODCslt.AdjustMemReasonSize;
+const
+  PIXEL_SPACE = 3;
+begin
+  pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
+  pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
+end;
 end.

cprs/trunk/CPRS-Chart/Consults/fODProc.dfm

-              r456
+              r829
   Constraints.MinHeight = 393
   Constraints.MinWidth = 543
+  ExplicitLeft = 208
+  ExplicitTop = 188
+  ExplicitWidth = 543
+  ExplicitHeight = 393
   PixelsPerInch = 96
   TextHeight = 13
 …
       'An order message may be displayed here.')
     TabOrder = 1
+    ExplicitLeft = 0
+    ExplicitTop = 321
+    ExplicitWidth = 380
+    ExplicitHeight = 41
   end
   object cboUrgency: TORComboBox [9]
 …
     CharsNeedMatch = 1
   end
+  inherited cmdAccept: TButton
+    Left = 387
+    Top = 339
+    Anchors = [akRight, akBottom]
+    TabOrder = 10
+  end
+  inherited cmdQuit: TButton
+    Left = 469
+    Top = 339
+    Width = 64
+    Anchors = [akRight, akBottom]
+    TabOrder = 11
+  end
+  inherited pnlMessage: TPanel
+    Left = 50
+    Top = 320
+    Width = 316
+    Anchors = [akLeft, akRight, akBottom]
+    TabOrder = 12
+    inherited memMessage: TRichEdit
+      Width = 254
+    end
+  end
+  object cmdLexSearch: TButton
+  object cmdLexSearch: TButton [15]
     Left = 486
     Top = 93
 …
     OnClick = cmdLexSearchClick
   end
   object gbInptOpt: TGroupBox
+  object gbInptOpt: TGroupBox [16]
     Left = 249
     Top = 36
 …
     end
   end
   object txtProvDiag: TCaptionEdit
+  object txtProvDiag: TCaptionEdit [17]
     Left = 249
     Top = 93
 …
     OnChange = txtProvDiagChange
     Caption = 'Provisional Diagnosis'
+  end
+  inherited cmdAccept: TButton
+    Left = 387
+    Top = 339
+    Anchors = [akRight, akBottom]
+    TabOrder = 10
+    ExplicitLeft = 387
+    ExplicitTop = 339
+  end
+  inherited cmdQuit: TButton
+    Left = 469
+    Top = 339
+    Width = 64
+    Anchors = [akRight, akBottom]
+    TabOrder = 11
+    ExplicitLeft = 469
+    ExplicitTop = 339
+    ExplicitWidth = 64
+  end
+  inherited pnlMessage: TPanel
+    Left = 50
+    Top = 320
+    Width = 316
+    Anchors = [akLeft, akRight, akBottom]
+    TabOrder = 12
+    ExplicitLeft = 50
+    ExplicitTop = 320
+    ExplicitWidth = 316
+    inherited memMessage: TRichEdit
+      Width = 254
+      ExplicitWidth = 254
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblUrgency'
+        'Status = stsDefault')
+      (
+        'Component = lblPlace'
+        'Status = stsDefault')
+      (
+        'Component = lblAttn'
+        'Status = stsDefault')
+      (
+        'Component = lblProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = pnlReason'
+        'Status = stsDefault')
+      (
+        'Component = memReason'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = cboPlace'
+        'Status = stsDefault')
+      (
+        'Component = txtAttn'
+        'Status = stsDefault')
+      (
+        'Component = cboProc'
+        'Status = stsDefault')
+      (
+        'Component = cboCategory'
+        'Status = stsDefault')
+      (
+        'Component = cboService'
+        'Status = stsDefault')
+      (
+        'Component = cmdLexSearch'
+        'Status = stsDefault')
+      (
+        'Component = gbInptOpt'
+        'Status = stsDefault')
+      (
+        'Component = radInpatient'
+        'Status = stsDefault')
+      (
+        'Component = radOutpatient'
+        'Status = stsDefault')
+      (
+        'Component = txtProvDiag'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODProc'
+        'Status = stsDefault'))
   end
   object mnuPopProvDx: TPopupMenu

cprs/trunk/CPRS-Chart/Consults/fODProc.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
   Menus;
+  Menus, VA508AccessibilityManager;
 type
 …
     procedure memReasonKeyUp(Sender: TObject; var Key: Word;
       Shift: TShiftState);
-    procedure FormDestroy(Sender: TObject);
     procedure memReasonKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
 …
 uses
     rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
+    clipbrd, fPreReq, uTemplates, uAccessibleRichEdit, fFrame, uODBase;
+    clipbrd, fPreReq, uTemplates, fFrame, uODBase,
+  uVA508CPRSCompatibility;
 var
 …
   inherited;
   DoSetFontSize(MainFontSize);
-  TAccessibleRichEdit.WrapControl(memReason);
   AllowQuickOrder := True;
   FillChar(ProvDx, SizeOf(ProvDx), 0);
 …
     SetControl(cboProc,       'ORDERABLE', 1);
     if cboProc.ItemIndex < 0 then exit;
     cboService.Items.Assign(GetProcedureServices(cboProc.ItemIEN));
+    FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
     Changing := True;
     tmpResp := TResponse(FindResponseByName('CLASS',1));
 …
     SetProvDiagPromptingMode;
     GetProvDxandValidateCode(Responses);
+    SetTemplateDialogCanceled(FALSE);
     SetControl(memReason,     'COMMENT',   1);
+    if WasTemplateDialogCanceled then
+    begin
+      AbortOrder := True;
+      Close;
+      Exit;
+    end;
+    SetTemplateDialogCanceled(FALSE);
     SetupReasonForRequest(OrderAction);
+    if WasTemplateDialogCanceled then
+    begin
+      AbortOrder := True;
+      Close;
+      Exit;
+    end;
     Changing := False;
     OrderMessage(ConsultMessage(cboProc.ItemIEN));
 …
       begin
         Clear;
         Items.Assign(GetProcedureServices(cboProc.ItemIEN));
+        FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
         if Items.Count > 1 then
           ItemIndex := -1
 …
       with cboService do
         begin
           Items.Assign(GetProcedureServices(cboProc.ItemIEN));
+          FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
           if Items.Count > 1 then
             ItemIndex := -1
 …
       SetControl(cboPlace,      'PLACE',     1);
       SetControl(txtAttn,       'PROVIDER',  1);
+      SetTemplateDialogCanceled(FALSE);
       SetControl(memReason,     'COMMENT',   1);
+//      if ((cboProc.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
+//        memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
+      if WasTemplateDialogCanceled and OrderContainsObjects then
+      begin
+        AbortOrder := TRUE;
+        Close;
+        Exit;
+      end;
       SetupReasonForRequest(ORDER_QUICK);
       GetProvDxandValidateCode(Responses);
 …
               Exit;
             end;
           memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
+          FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines);
           SetupReasonForRequest(ORDER_NEW);
         end;
 …
   AStringList := TStringList.Create;
   try
     AStringList.Assign(memReason.Lines);
+    AStringList.Text := memReason.Text;
     LimitStringLength(AStringList, 74);
     memReason.Lines.Assign(AstringList);
+    memReason.Text := AStringList.Text;
     ControlChange(Self);
   finally
 …
 begin
   if ((OrderAction = ORDER_QUICK) and (cboProc.ItemID <> '') and (Length(memReason.Text) = 0)) then
     memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
+    FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines);
   EditReason := GMRCREAF;
   if EditReason = '' then EditReason := ReasonForRequestEditable(Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
 …
       if ItemIEN > 0 then
         begin
           Alist.Assign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)));
+          FastAssign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)), Alist);
           if AList.Count > 0 then
             begin
 …
 end;
+function TfrmODProc.DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
+function TfrmODProc.DefaultReasonForRequest(Service: string;
+  Resolve: Boolean): TStrings;
 var
   TmpSL: TStringList;
 …
   try
     Result := GetDefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), Resolve);
     TmpSL.Assign(Result);
+    FastAssign(Result, TmpSL);
     x := TmpSL.Text;
     ExpandOrderObjects(x, HasObjects);
     TmpSL.Text := x;
     Responses.OrderContainsObjects := HasObjects;
     ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(piece(piece(cboProc.Items[cboProc.ItemIndex],U,4),';',1),0),
+    ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(Piece(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), ';', 1), 0),
                    ltProcedure, nil, 'Reason for Request: ' + cboProc.DisplayText[cboProc.ItemIndex], DocInfo);
+    if TmpSL.Text <> x then Responses.OrderContainsObjects := False;
+    Result.Assign(TmpSL);
+    AbortOrder := WasTemplateDialogCanceled;
+    Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects;
+    if AbortOrder then
+    begin
+      Result.Text := '';
+      Close;
+      Exit;
+    end
+    else
+      FastAssignWith508Msg(TmpSL, Result);
   finally
     TmpSL.Free;
 …
 end;
-procedure TfrmODProc.FormDestroy(Sender: TObject);
-begin
-  inherited;
-  TAccessibleRichEdit.UnwrapControl(memReason);
-end;
 procedure TfrmODProc.SetFontSize(FontSize: integer);
 begin

cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm

-              r456
+              r829
 object frmPrerequisites: TfrmPrerequisites
+inherited frmPrerequisites: TfrmPrerequisites
   Left = 337
   Top = 219
-  Width = 377
-  Height = 348
   BorderIcons = [biSystemMenu]
   Caption = 'frmPrerequisites'
+  Color = clBtnFace
+  ClientHeight = 319
+  ClientWidth = 367
   Font.Charset = ANSI_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
+  OnActivate = OnActivate
   OnClose = FormClose
   OnCreate = FormCreate
+  OnShow = FormShow
+  ExplicitWidth = 375
+  ExplicitHeight = 346
   PixelsPerInch = 96
   TextHeight = 13
   object lblFontTest: TLabel
+  object lblFontTest: TLabel [0]
     Left = 148
     Top = 208
 …
     ParentFont = False
   end
   object memReport: TRichEdit
+  object memReport: TRichEdit [1]
     Left = 0
     Top = 33
     Width = 369
     Height = 288
+    Width = 367
+    Height = 286
     Align = alClient
     Color = clCream
 …
     WordWrap = False
   end
   object pnlButton: TPanel
+  object pnlButton: TPanel [2]
     Left = 0
     Top = 0
     Width = 369
+    Width = 367
     Height = 33
     Align = alTop
 …
     TabOrder = 2
     DesignSize = (
 )
     object cmdContinue: TButton
       Left = 209
+      Left = 207
       Top = 6
       Width = 75
 …
     end
     object cmdCancel: TButton
       Left = 292
+      Left = 290
       Top = 6
       Width = 75
 …
     end
   end
   object cmdPrint: TButton
+  object cmdPrint: TButton [3]
     Left = 2
     Top = 6
 …
     OnClick = cmdPrintClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memReport'
+        'Status = stsDefault')
+      (
+        'Component = pnlButton'
+        'Status = stsDefault')
+      (
+        'Component = cmdContinue'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cmdPrint'
+        'Status = stsDefault')
+      (
+        'Component = frmPrerequisites'
+        'Status = stsDefault'))
+  end
   object dlgPrintReport: TPrintDialog
     Left = 113

cprs/trunk/CPRS-Chart/Consults/fPreReq.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ORFn, ComCtrls, ExtCtrls;
+  StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager,
+  uReports;
 type
   TfrmPrerequisites = class(TForm)
+  TfrmPrerequisites = class(TfrmBase508Form)
     lblFontTest: TLabel;
     memReport: TRichEdit;
 …
     procedure cmdCancelClick(Sender: TObject);
     procedure cmdPrintClick(Sender: TObject);
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
+    procedure OnActivate(Sender: TObject);
     procedure FormCreate(Sender: TObject);
-    procedure FormClose(Sender: TObject; var Action: TCloseAction);
-    procedure FormShow(Sender: TObject);
   private
     procedure AlignButtons();
 …
 uses
   uCore, rCore, rReports, Printers,rMisc;
+  uCore, rCore, rReports, Printers, rMisc;
 {$R *.DFM}
 …
       ForceInsideWorkArea(Rect);
       BoundsRect := Rect;
+      memReport.Lines.Assign(ReportText);
+      ResizeAnchoredFormToFont(result);
+      QuickCopy(ReportText, memReport);
       //Quick fix to work around glich in resize algorithim
       AlignButtons();
 …
       AHeader := TStringList.Create;
       CreatePatientHeader(AHeader, Self.Caption);
       memPrintReport := TRichEdit.Create(Self);
+      memPrintReport := CreateReportTextComponent(Self);
       try
         MaxLines := 60 - AHeader.Count;
 …
         with memPrintReport do
           begin
-            Visible := False;
-            Parent := Self;
-            Font.Name := 'Courier New';
-            Font.Size := MainFontSize;
-            Width := Printer.Canvas.TextWidth(StringOfChar('-', 74));
-            //Width := 600;
             repeat
               with Lines do
 …
 end;
-procedure TfrmPrerequisites.FormCreate(Sender: TObject);
-begin
-  memreport.Color := ReadOnlyColor;
-end;
 procedure TfrmPrerequisites.AlignButtons;
 Const
   BtnSpace = 8;
 begin
   cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace;
+  cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3;
   cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width;
 end;
 …
 end;
 procedure TfrmPrerequisites.FormShow(Sender: TObject);
+procedure TfrmPrerequisites.FormCreate(Sender: TObject);
 begin
+  inherited;
+  ResizeAnchoredFormToFont(Self);
   SetFormPosition(Self); //Get Saved Position & Size of Form
 end;
+procedure TfrmPrerequisites.OnActivate(Sender: TObject);
+begin
+  if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0;
+end;
 end.

cprs/trunk/CPRS-Chart/Consults/rConsults.pas

-              r456
+              r829
            Results[i] := x;
          end;
        Dest.Assign(Results);
+       FastAssign(Results, Dest);
      end
     else
 …
 begin
   CallV('ORQQCN DETAIL', [IEN]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORQQCN MED RESULTS', [IEN]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   alist := TStringList.Create ;
  try
   alist.Assign(RPCBrokerV.Results) ;
+  FastAssign(RPCBrokerV.Results, aList);
   x := alist[0] ;
   if Piece(x,u,1) <> '-1' then
 …
 begin
   CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end;
 …
 begin
   CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end;
 …
 begin
   CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end;
 …
 begin
   CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end;
 …
      ActionDate: TFMDateTime; Comments: TStrings);
 begin
      CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end ;
 …
 AlertTo: string) ;
 begin
      CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end ;
 …
           RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
 begin
      CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end ;
 …
 AlertTo: string) ;
 begin
      CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
+  CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
+  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
 end ;
 …
       ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4));
       Title := StrToIntDef(Piece(x, U, 5), 0);
+      DateTime := StrToFloatDef(Piece(x, U, 6), 0);
     end;
   Result := AnEditRec;

cprs/trunk/CPRS-Chart/Consults/uConsults.pas

-              r456
+              r829
     ProvDxCode: string;                     {  30.1}
     RequestProcessingActivity: TStringList; {  40}
+    //EarliestDate: TFMDateTime;
+    //LatestDate: TFMDateTime;
   end ;
 …
     Urgency: integer;
     UrgencyName: string;
+    //EarliestDate: TFMDateTime;
+    //LatestDate: TFMDateTime;
     Place: string;
     PlaceName: string;
 …
    UL_ADMIN             = 3;
    UL_UPDATE_AND_ADMIN  = 4;
+   UL_UNRESTRICTED      = 5;
    {Clinical Procedure statuses}
 …
   SrcList := TStringList.Create;
   try
     SrcList.Assign(Source);
+    FastAssign(Source, SrcList);
     with SrcList do
       begin

cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.dfm

-              r456
+              r829
   PixelsPerInch = 96
   TextHeight = 13
-  object lblAdd2PL: TLabel [0]
-    Left = 555
-    Top = 255
-    Width = 53
-    Height = 26
-    Caption = 'Add to Problem list'
-    WordWrap = True
-  end
   inherited lblSection: TLabel
     Width = 89
     Caption = 'Diagnoses Section'
+    ExplicitWidth = 89
   end
   inherited btnOK: TBitBtn
 …
     Width = 523
     TabOrder = 1
+    ExplicitWidth = 523
     inherited lbGrid: TORListBox
       Tag = 20
       Width = 523
       Pieces = '1,2,3'
+      ExplicitWidth = 523
     end
     inherited hcGrid: THeaderControl
 …
           Width = 110
         end>
+      ExplicitWidth = 523
     end
   end
   inherited edtComment: TCaptionEdit
     TabOrder = 3
+  end
+  object cmdDiagPrimary: TButton [8]
+    Left = 536
+    Top = 306
+    Width = 75
+    Height = 21
+    Caption = 'Primary'
+    Enabled = False
+    TabOrder = 5
+    OnClick = cmdDiagPrimaryClick
+  end
+  object ckbDiagProb: TCheckBox [9]
+    Left = 535
+    Top = 258
+    Width = 76
+    Height = 38
+    Caption = 'Add to Problem list'
+    TabOrder = 4
+    WordWrap = True
+    OnClick = ckbDiagProbClicked
   end
   inherited btnRemove: TButton
 …
     TabOrder = 2
     TabStop = True
+    ExplicitLeft = 454
   end
   inherited pnlMain: TPanel
 …
       IntegralHeight = True
       Pieces = '2,3,4,5'
+      ExplicitHeight = 196
     end
     inherited pnlLeft: TPanel
 …
     end
   end
+  object cmdDiagPrimary: TButton
+    Left = 536
+    Top = 306
+    Width = 75
+    Height = 21
+    Caption = 'Primary'
+    Enabled = False
+    TabOrder = 5
+    OnClick = cmdDiagPrimaryClick
+  end
+  object ckbDiagProb: TCheckBox
+    Left = 536
+    Top = 262
+    Width = 13
+    Height = 13
+    Caption = 'Add to Problem list'
+    TabOrder = 4
+    OnClick = ckbDiagProbClicked
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cmdDiagPrimary'
+        'Status = stsDefault')
+      (
+        'Component = ckbDiagProb'
+        'Status = stsDefault')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmDiagnoses'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore;
+  ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, VA508AccessibilityManager;
 type
 …
     cmdDiagPrimary: TButton;
     ckbDiagProb: TCheckBox;
-    lblAdd2PL: TLabel;
     procedure cmdDiagPrimaryClick(Sender: TObject);
     procedure ckbDiagProbClicked(Sender: TObject);
 …
 uses
   fEncounterFrame, uConst, UBACore;
+  fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter;
 procedure TfrmDiagnoses.EnsurePrimaryDiag;
 …
             PLItemCount := PLItemCount + 1;
       OK := OK and (PLItemCount < lbGrid.SelCount);
-      lblAdd2PL.Enabled := OK;
       ckbDiagProb.Enabled := OK;
       if(OK) then
 …
 begin
   inherited;
+  if lbxSection.width = 0 then Exit;
   FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
   FSectionTabs[1] := -FSectionTabs[0]+2;
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmDiagnoses);
 end.

cprs/trunk/CPRS-Chart/Encounter/fEncVitals.dfm

-              r456
+              r829
   Top = 210
   Caption = 'Vitals'
-  KeyPreview = True
   OnActivate = FormActivate
   OnDestroy = FormDestroy
   OnKeyDown = FormKeyDown
   OnResize = FormResize
+  OnShow = FormShow
+  ExplicitWidth = 632
+  ExplicitHeight = 427
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 624
     Height = 368
-    Hint = 'To sort, click on column headers|'
     Align = alClient
     Columns = <>
 …
     Align = alBottom
     BevelOuter = bvNone
+    TabOrder = 5
+    TabOrder = 4
+    object btnEnterVitals: TButton
+      Left = 8
+      Top = 6
+      Width = 75
+      Height = 21
+      Caption = 'Enter Vitals'
+      TabOrder = 0
+      OnClick = btnEnterVitalsClick
+    end
+    object btnOKkludge: TButton
+      Left = 434
+      Top = 6
+      Width = 75
+      Height = 21
+      Caption = 'OK'
+      TabOrder = 1
+      OnClick = btnOKClick
+    end
+    object btnCancelkludge: TButton
+      Left = 522
+      Top = 6
+      Width = 75
+      Height = 21
+      Caption = 'Cancel'
+      TabOrder = 2
+      OnClick = btnCancelClick
+    end
   end
   inherited btnOK: TBitBtn
+    Left = 444
+    Top = 377
+    TabOrder = 3
+    Left = 208
+    Top = 374
+    Caption = 'OK No Show'
+    TabOrder = 2
+    Visible = False
+    ExplicitLeft = 208
+    ExplicitTop = 374
   end
   inherited btnCancel: TBitBtn
+    Left = 524
+    Top = 377
+    TabOrder = 4
+    Left = 289
+    Top = 374
+    Caption = 'Cancel No Show'
+    TabOrder = 3
+    Visible = False
+    ExplicitLeft = 289
+    ExplicitTop = 374
   end
   object pnlmain: TPanel
+  object pnlmain: TPanel [4]
     Left = 28
     Top = 24
 …
     end
   end
+  object btnEnterVitals: TButton
+    Left = 8
+    Top = 377
+    Width = 75
+    Height = 21
+    Caption = 'Enter Vitals'
+    TabOrder = 2
+    OnClick = btnEnterVitalsClick
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lvVitals'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnEnterVitals'
+        'Status = stsDefault')
+      (
+        'Component = btnOKkludge'
+        'Status = stsDefault')
+      (
+        'Component = btnCancelkludge'
+        'Status = stsDefault')
+      (
+        'Component = pnlmain'
+        'Status = stsDefault')
+      (
+        'Component = lblDate'
+        'Status = stsDefault')
+      (
+        'Component = lblDateBP'
+        'Status = stsDefault')
+      (
+        'Component = lblDateTemp'
+        'Status = stsDefault')
+      (
+        'Component = lblDateResp'
+        'Status = stsDefault')
+      (
+        'Component = lblDatePulse'
+        'Status = stsDefault')
+      (
+        'Component = lblDateHeight'
+        'Status = stsDefault')
+      (
+        'Component = lblDateWeight'
+        'Status = stsDefault')
+      (
+        'Component = lblLstMeas'
+        'Status = stsDefault')
+      (
+        'Component = lbllastBP'
+        'Status = stsDefault')
+      (
+        'Component = lblLastTemp'
+        'Status = stsDefault')
+      (
+        'Component = lblLastResp'
+        'Status = stsDefault')
+      (
+        'Component = lblLastPulse'
+        'Status = stsDefault')
+      (
+        'Component = lblLastHeight'
+        'Status = stsDefault')
+      (
+        'Component = lblLastWeight'
+        'Status = stsDefault')
+      (
+        'Component = lblVital'
+        'Status = stsDefault')
+      (
+        'Component = lblVitBP'
+        'Status = stsDefault')
+      (
+        'Component = lnlVitTemp'
+        'Status = stsDefault')
+      (
+        'Component = lblVitResp'
+        'Status = stsDefault')
+      (
+        'Component = lblVitPulse'
+        'Status = stsDefault')
+      (
+        'Component = lblVitHeight'
+        'Status = stsDefault')
+      (
+        'Component = lblVitWeight'
+        'Status = stsDefault')
+      (
+        'Component = lblVitPain'
+        'Status = stsDefault')
+      (
+        'Component = lblLastPain'
+        'Status = stsDefault')
+      (
+        'Component = lblDatePain'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasBP'
+        'Status = stsDefault')
+      (
+        'Component = cboTemp'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasTemp'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasResp'
+        'Status = stsDefault')
+      (
+        'Component = cboHeight'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasWt'
+        'Status = stsDefault')
+      (
+        'Component = cboWeight'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasDate'
+        'Status = stsDefault')
+      (
+        'Component = cboPain'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasPulse'
+        'Status = stsDefault')
+      (
+        'Component = txtMeasHt'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmEncVitals'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fEncVitals.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, ORDtTm, StdCtrls, ORCtrls, ExtCtrls, Buttons, fAutoSz, ORFn,
+  rvitals, ComCtrls, ORNet, uVitals
+  , TRPCB // Vitals Lite 2004-05-21 ===========================================
+  ;
+{== Vitals Lite 2004-05-21 ===================================================}
+type
+  TGMV_GetInputPanel = function(
+    var anApp: TApplication;
+    aB: TRPCBroker;
+    aP,         // Patient DFN
+    aL,         // Hospitals IEN
+    aSig,       // Application signature
+    aTemplate   // Vitals Input template
+        : String;
+    aNow        // Input Date/Time
+        :TDateTime):TCustomForm;
+{== Vitals Lite 2004-05-21 ===================================================}
+  rvitals, ComCtrls, ORNet, uVitals, VAUtils, TRPCB, VA508AccessibilityManager;
 type
 …
     txtMeasHt: TCaptionEdit;
     pnlBottom: TPanel;
+    lvVitals: TCaptionListView;
     btnEnterVitals: TButton;
+    lvVitals: TCaptionListView;
+    btnOKkludge: TButton;
+    btnCancelkludge: TButton;
     procedure SetVitPointer(Sender: TObject);
     procedure txtMeasBPExit(Sender: TObject);
 …
     procedure txtMeasHtExit(Sender: TObject);
     procedure txtMeasWtExit(Sender: TObject);
-    procedure FormKeyDown(Sender: TObject; var Key: Word;
-      Shift: TShiftState);
     procedure btnEnterVitalsClick(Sender: TObject); //vitals lite
   private
 …
      fEncounterFrame, uInit
   //   , fGMV_InputTemp // Vitals Lite 2004-05-21
+     ;
+     , VA508AccessibilityRouter;
 const
 …
 {== Vitals Lite 2004-05-21 ===================================================}
+  FreeLibrary(VitalsDLLHandle);
+  if VitalsDLLHandle <> 0 then
+  begin
+    FreeLibrary(VitalsDLLHandle);
+    VitalsDLLHandle := 0;
+  end;
 {== Vitals Lite 2004-05-21 ===================================================}
   inherited;
 …
   GMV_LibName :='GMV_VitalsViewEnter.dll';
   GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
+  VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
+  if VitalsDLLHandle = 0 then
+    VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
   if VitalsDLLHandle = 0 then // No Handle found
     MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0)
 …
   txtMeasWt.text    := '';
   cboPain.text      := '';
-end;
-procedure TfrmEncVitals.FormKeyDown(Sender: TObject; var Key: Word;
-  Shift: TShiftState);
-begin
-  {capture return key press if on the vital screen}
-  begin
-    inherited;
-    if (ActiveCtrl.tag in VitalDateTagSet)then
-    begin
-      if Key = VK_RETURN then
-      begin
-        Key := 0;
-        if (ActiveCtrl.Tag = TAG_VITPAIN) then
-          ChangeFocus(btnOK)
-        else
-        begin
-          GetParentForm(Self).Perform(WM_NEXTDLGCTL,0,0);
-          SetVitPointer(Sender);
-        end;
-      end;
-    end;
-  end;
 end;
 …
   end
   else
     MessageDLG('Can not find function "'+GMV_FName+'".',mtError,[mbok],0);
+    MessageDLG('Unable to find function "'+GMV_FName+'".',mtError,[mbok],0);
   @VLPtVitals := nil;
   LoadVitalsList;
 …
   if assigned(VLPtVitals) then
   begin
     frmFrame.VitalsDLLActive := True;  // need this flag for CCOW (RV)
+//    frmFrame.DLLActive := True;  // need this flag for CCOW (RV)
     VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
     if assigned(VitalsList) then
 …
     MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
   @VLPtVitals := nil;
   frmFrame.VitalsDLLActive := False;  // need this flag for CCOW (RV)
+//  frmFrame.DLLActive := False;  // need this flag for CCOW (RV)
 end;
 //End Vitals Lite
+initialization
+  SpecifyFormIsNotADialog(TfrmEncVitals);
 end.

cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.dfm

-              r456
+              r829
 object frmEncounterFrame: TfrmEncounterFrame
+inherited frmEncounterFrame: TfrmEncounterFrame
   Left = 290
   Top = 108
-  Width = 640
-  Height = 451
   Caption = 'Encounter Frame'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 424
+  ClientWidth = 632
   FormStyle = fsMDIForm
-  KeyPreview = True
   OldCreateOrder = True
   Position = poScreenCenter
 …
   OnCreate = FormCreate
   OnDestroy = FormDestroy
-  OnKeyDown = FormKeyDown
   OnResize = FormResize
+  OnShow = FormShow
+  ExplicitLeft = 290
+  ExplicitTop = 108
+  ExplicitWidth = 640
+  ExplicitHeight = 458
   PixelsPerInch = 96
   TextHeight = 13
   object Bevel1: TBevel
+  object Bevel1: TBevel [0]
     Left = 0
     Top = 0
 …
     Align = alTop
   end
   object StatusBar1: TStatusBar
+  object StatusBar1: TStatusBar [1]
     Left = 0
     Top = 417
+    Top = 424
     Width = 632
     Height = 0
     Panels = <>
-    SimplePanel = False
   end
   object pnlPage: TPanel
+  object pnlPage: TPanel [2]
     Left = 0
     Top = 24
     Width = 632
     Height = 393
+    Height = 400
     Align = alClient
     BevelOuter = bvNone
 …
     TabOrder = 1
   end
   object TabControl: TTabControl
+  object TabControl: TTabControl [3]
     Left = 0
     Top = 2
 …
     OnChange = TabControlChange
     OnChanging = TabControlChanging
+    OnExit = TabControlExit
+    OnEnter = TabControlEnter
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = StatusBar1'
+        'Status = stsDefault')
+      (
+        'Component = pnlPage'
+        'Status = stsDefault')
+      (
+        'Component = TabControl'
+        'Status = stsDefault')
+      (
+        'Component = frmEncounterFrame'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas

-              r456
+              r829
   Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase,
   fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd,
+  fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals,rvitals;
+  fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals, rvitals, fBase508Form,
+  VA508AccessibilityManager;
 const
 …
 type
   TfrmEncounterFrame = class(TForm)
+  TfrmEncounterFrame = class(TfrmBase508Form)
     StatusBar1: TStatusBar;
     pnlPage: TPanel;
 …
     procedure TabControlChanging(Sender: TObject;
       var AllowChange: Boolean);
-    procedure TabControlExit(Sender: TObject);
     procedure FormKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
 …
     procedure FormCanResize(Sender: TObject; var NewWidth,
       NewHeight: Integer; var Resize: Boolean);
+    procedure FormShow(Sender: TObject);
+    procedure TabControlEnter(Sender: TObject);
   private
 …
                             //in the frame.  They must be available at compile time
     FLastPage: TfrmPCEBase;
+    FGiveMultiTabMessage: boolean;
     procedure CreateChildForms(Sender: TObject; Location: integer);
     procedure SynchPCEData;
 …
   uCore,
   fGAF, uConst,
   rCore, fPCEProvider, rMisc;
+  rCore, fPCEProvider, rMisc, VA508AccessibilityRouter, VAUtils;
 {$R *.DFM}
 …
   FAbort := TRUE;
   SetFormFonts;
+  FGiveMultiTabMessage := ScreenReaderSystemActive;
 end;
 …
         if (Storemessage <> 'True') then
         begin
           showmessage(storemessage);
+          ShowMsg(storemessage);
 //        exit;
         end;
 …
   if (sender as tTabControl).tabindex = -1 then exit;
+  if TabControl.CanFocus and Assigned(FLastPage) and not TabControl.Focused then
+    TabControl.SetFocus;  //CQ: 14845
   for i := CT_FIRST to CT_LAST do
   begin
 …
         PageIDToForm(i).show;
         SwitchToPage(PageIDToForm(i));
+        Exit;
       end;
   end;
 …
 end;
+procedure TfrmEncounterFrame.TabControlExit(Sender: TObject);
+var
+  i: integer;
+begin
+  //Keep the focus on the active page
+  if (sender as tTabControl).tabindex = -1 then exit;
+  for i := CT_FIRST to CT_LAST do
+  begin
+    with Formlist do
+      with sender as tTabControl do
+        if Tabindex = IndexOf(PageIdToTab(i)) then
+      begin
+        PageIDToForm(i).FocusFirstControl;
+      end;
+procedure TfrmEncounterFrame.TabControlEnter(Sender: TObject);
+begin
+  if FGiveMultiTabMessage then // CQ#15483
+  begin
+    FGiveMultiTabMessage := FALSE;
+    GetScreenReader.Speak('Multi tab form');
   end;
 end;
 …
   CanChange: boolean;
 begin
+  inherited;
   if (Key = VK_ESCAPE) then
   begin
 …
     end;
   end;
-  if FLastPage = frmEncVitals then
-    frmEncVitals.FormKeyDown(Sender, Key, Shift);
 end;
 …
 end;
+procedure TfrmEncounterFrame.FormShow(Sender: TObject);
+begin
+  inherited;
+  if TabControl.CanFocus then
+    TabControl.SetFocus;
+end;
 end.

cprs/trunk/CPRS-Chart/Encounter/fExam.dfm

-              r456
+              r829
   Top = 223
   Caption = 'Encounter Examinations'
+  ExplicitLeft = 509
+  ExplicitTop = 223
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 65
     Caption = 'Exam Section'
+    ExplicitWidth = 65
   end
   inherited btnOK: TBitBtn
 …
     TabOrder = 3
   end
+  object cboExamResults: TORComboBox [9]
+    Tag = 60
+    Left = 490
+    Top = 280
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Results'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 0
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboExamResultsChange
+    CharsNeedMatch = 1
+  end
   inherited btnRemove: TButton
     TabOrder = 5
 …
     end
   end
+  object cboExamResults: TORComboBox
+    Tag = 60
+    Left = 490
+    Top = 280
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Results'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboExamResultsChange
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboExamResults'
+        'Label = lblExamResults'
+        'Status = stsOK')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmExams'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fExam.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
+  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 procedure TfrmExams.cboExamResultsChange(Sender: TObject);
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmExams);
 end.

cprs/trunk/CPRS-Chart/Encounter/fGAF.dfm

-              r456
+              r829
   Caption = 'frmGAF'
   OnActivate = FormActivate
+  ExplicitLeft = 8
+  ExplicitTop = 8
   PixelsPerInch = 96
   TextHeight = 13
 …
     Height = 13
     Align = alTop
+    ExplicitWidth = 3
   end
   object Spacer2: TLabel [4]
 …
     Height = 13
     Align = alTop
+    ExplicitWidth = 3
   end
   object lblGAF: TStaticText [5]
 …
     Align = alTop
     TabOrder = 0
+    ExplicitLeft = 0
+    ExplicitTop = 35
+    ExplicitWidth = 624
     inherited lbGrid: TORListBox
       Width = 624
 …
       Caption = 'Most recent Global Assessment of Functioning (GAF) scores'
       Pieces = '1,2,3,4'
+      ExplicitWidth = 624
     end
     inherited hcGrid: THeaderControl
 …
           Width = 60
         end>
+      ExplicitWidth = 624
     end
   end
   object edtScore: TCaptionEdit
+  object edtScore: TCaptionEdit [10]
     Left = 226
     Top = 171
 …
     Caption = 'Score'
   end
   object udScore: TUpDown
+  object udScore: TUpDown [11]
     Left = 259
     Top = 171
 …
     Height = 21
     Associate = edtScore
-    Min = 0
-    Position = 0
     TabOrder = 2
+    Wrap = False
+  end
+  object dteGAF: TORDateBox
+  end
+  object dteGAF: TORDateBox [12]
     Left = 226
     Top = 202
 …
     Caption = 'Date Determined:'
   end
   object cboGAFProvider: TORComboBox
+  object cboGAFProvider: TORComboBox [13]
     Left = 226
     Top = 233
 …
     OnExit = cboGAFProviderExit
     OnNeedData = cboGAFProviderNeedData
+  end
+  object btnURL: TButton
+    CharsNeedMatch = 1
+  end
+  object btnURL: TButton [14]
     Left = 3
     Top = 376
 …
     OnClick = btnURLClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblGAF'
+        'Status = stsDefault')
+      (
+        'Component = lblEntry'
+        'Status = stsDefault')
+      (
+        'Component = edtScore'
+        'Status = stsDefault')
+      (
+        'Component = udScore'
+        'Status = stsDefault')
+      (
+        'Component = dteGAF'
+        'Status = stsDefault')
+      (
+        'Component = cboGAFProvider'
+        'Status = stsDefault')
+      (
+        'Component = btnURL'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmGAF'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fGAF.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls,
   ORDtTm, ComCtrls, fPCEBaseGrid, Menus;
+  ORDtTm, ComCtrls, fPCEBaseGrid, Menus, VA508AccessibilityManager;
 type
 …
 implementation
 uses rPCE, rCore, uCore, uPCE, fEncounterFrame;
+uses rPCE, rCore, uCore, uPCE, fEncounterFrame, VA508AccessibilityRouter;
 {$R *.DFM}
 …
   FTabName := CT_GAFNm;
   btnURL.Visible := (User.WebAccess and (GAFURL <> ''));
+end;
+  FormActivate(Sender);
+end;
+initialization
+  SpecifyFormIsNotADialog(TfrmGAF);
 end.

cprs/trunk/CPRS-Chart/Encounter/fHFSearch.dfm

-              r456
+              r829
   Left = 286
   Top = 248
-  Width = 363
-  Height = 417
   Caption = 'Other Health Factors'
+  ClientHeight = 390
+  ClientWidth = 355
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 363
+  ExplicitHeight = 417
   PixelsPerInch = 96
   TextHeight = 13
   object splMain: TSplitter
+  object splMain: TSplitter [0]
     Left = 0
     Top = 131
 …
     Align = alTop
   end
   object lblCat: TLabel
+  object lblCat: TLabel [1]
     Left = 0
     Top = 0
 …
     Align = alTop
     Caption = 'Category:'
+    ExplicitWidth = 45
   end
   object cbxSearch: TORComboBox
+  object cbxSearch: TORComboBox [2]
     Left = 0
     Top = 13
 …
     ListItemsOnly = True
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnChange = cbxSearchChange
     OnDblClick = tvSearchDblClick
+    CharsNeedMatch = 1
   end
   object tvSearch: TORTreeView
+  object tvSearch: TORTreeView [3]
     Left = 0
     Top = 134
 …
     Align = alClient
     HideSelection = False
+    Images = dmodShared.imgTemplates
     Indent = 23
     ReadOnly = True
-    StateImages = dmodShared.imgTemplates
     TabOrder = 1
     OnChange = tvSearchChange
 …
     OnGetImageIndex = tvSearchGetImageIndex
     OnGetSelectedIndex = tvSearchGetImageIndex
     Caption = 'Other Health Factors'
+    Caption = 'Health Factors Category'
     NodePiece = 2
+    ExplicitTop = 137
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [4]
     Left = 0
     Top = 363
 …
     BevelOuter = bvNone
     TabOrder = 2
+    DesignSize = (
+)
     object btnOK: TButton
       Left = 196
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Left = 176
+    Data = (
+      (
+        'Component = cbxSearch'
+        'Status = stsDefault')
+      (
+        'Component = tvSearch'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmHFSearch'
+        'Status = stsDefault'))
+  end
+  object imgListHFtvSearch: TVA508ImageListLabeler
+    Components = <
+      item
+        Component = tvSearch
+      end>
+    Labels = <>
+    RemoteLabeler = dmodShared.imgLblHealthFactorLabels
+    Left = 224
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fHFSearch.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls;
+  fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls,
+  VA508AccessibilityManager, VA508ImageListLabeler;
 type
 …
     splMain: TSplitter;
     lblCat: TLabel;
+    imgListHFtvSearch: TVA508ImageListLabeler;
     procedure FormCreate(Sender: TObject);
     procedure btnOKClick(Sender: TObject);
 …
   HFList: TStringList;
   i: integer;
   Node :TORTreeNode;
+  Node, Child :TORTreeNode;
   CAT: string;
 …
         begin
           StringData := HFList[i];
+          StateIndex := 2;
+          ImageIndex := 2;
+          SelectedIndex := 2;
         end;
       end;
 …
           Node := TORTreeNode(Node.GetNextSibling);
         end;
+        TORTreeNode(tvSearch.Items.AddChild(Node, '')).StringData := Pieces(HFList[i],U,1,2);
+        Child := TORTreeNode(tvSearch.Items.AddChild(Node, ''));
+        Child.StringData := Pieces(HFList[i],U,1,2);
+        Child.ImageIndex := -1;
+        Child.StateIndex := -1;
       end;
     end;
 …
   begin
     if(Node.Expanded) then
       Node.StateIndex := 3
+      Node.ImageIndex := 3
     else
+      Node.StateIndex := 2;
+  end;
+      Node.ImageIndex := 2;
+  end
+  else
+    Node.ImageIndex := -1;
+  Node.SelectedIndex := Node.ImageIndex;
 //  tvSearch.Invalidate;
 end;

cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.dfm

-              r456
+              r829
   Top = 205
   Caption = 'Health Factor page'
+  ExplicitLeft = 374
+  ExplicitTop = 205
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 103
     Caption = 'Health Factor Section'
+    ExplicitWidth = 103
   end
   inherited btnOK: TBitBtn
 …
     TabOrder = 3
   end
+  inherited btnRemove: TButton
+    TabOrder = 5
+  end
+  inherited btnSelectAll: TButton
+    TabOrder = 2
+    TabStop = True
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited lbxSection: TORListBox
+      Tag = 70
+    end
+    inherited pnlLeft: TPanel
+      inherited lbSection: TORListBox
+        Tag = 70
+        TabOrder = 0
+        Caption = 'Health Factor Section'
+      end
+      inherited btnOther: TButton
+        Tag = 23
+        Caption = 'Other Health Factor...'
+        TabOrder = 1
+      end
+    end
+  end
+  object cboHealthLevel: TORComboBox
+  object cboHealthLevel: TORComboBox [9]
     Tag = 50
     Left = 490
 …
     CharsNeedMatch = 1
   end
+  inherited btnRemove: TButton
+    TabOrder = 5
+  end
+  inherited btnSelectAll: TButton
+    TabOrder = 2
+    TabStop = True
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited lbxSection: TORListBox
+      Tag = 70
+      ExplicitLeft = 210
+    end
+    inherited pnlLeft: TPanel
+      inherited lbSection: TORListBox
+        Tag = 70
+        TabOrder = 0
+        Caption = 'Health Factor Section'
+      end
+      inherited btnOther: TButton
+        Tag = 23
+        Caption = 'Other Health Factor...'
+        TabOrder = 1
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboHealthLevel'
+        'Label = lblHealthLevel'
+        'Status = stsOK')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmHealthFactors'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
+  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 procedure tfrmHealthFactors.cboHealthLevelChange(Sender: TObject);
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmHealthFactors);
 end.

cprs/trunk/CPRS-Chart/Encounter/fImmunization.dfm

-              r456
+              r829
   Top = 169
   Caption = 'Encouner Immunization'
+  ExplicitLeft = 373
+  ExplicitTop = 169
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 100
     Caption = 'Immunization Section'
+    ExplicitWidth = 100
   end
   object lblContra: TLabel [6]
 …
     TabOrder = 3
   end
+  inherited btnRemove: TButton
+    TabOrder = 7
+  end
+  inherited btnSelectAll: TButton
+    TabOrder = 2
+    TabStop = True
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited lbxSection: TORListBox
+      Tag = 40
+    end
+    inherited pnlLeft: TPanel
+      inherited lbSection: TORListBox
+        Tag = 40
+        TabOrder = 0
+        Caption = 'Immunization Section'
+      end
+      inherited btnOther: TButton
+        Tag = 20
+        Caption = 'Other Immunization...'
+        TabOrder = 1
+      end
+    end
+  end
+  object cboImmReaction: TORComboBox
+  object cboImmReaction: TORComboBox [11]
     Tag = 20
     Left = 490
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     TabOrder = 5
     OnChange = cboImmReactionChange
+  end
+  object cboImmSeries: TORComboBox
+    CharsNeedMatch = 1
+  end
+  object cboImmSeries: TORComboBox [12]
     Tag = 10
     Left = 490
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     TabOrder = 4
     OnChange = cboImmSeriesChange
+  end
+  object ckbContra: TCheckBox
+    CharsNeedMatch = 1
+  end
+  object ckbContra: TCheckBox [13]
     Left = 490
     Top = 319
 …
     OnClick = ckbContraClick
   end
+  inherited btnRemove: TButton
+    TabOrder = 7
+  end
+  inherited btnSelectAll: TButton
+    TabOrder = 2
+    TabStop = True
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited lbxSection: TORListBox
+      Tag = 40
+    end
+    inherited pnlLeft: TPanel
+      inherited lbSection: TORListBox
+        Tag = 40
+        TabOrder = 0
+        Caption = 'Immunization Section'
+      end
+      inherited btnOther: TButton
+        Tag = 20
+        Caption = 'Other Immunization...'
+        TabOrder = 1
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboImmReaction'
+        'Label = lblReaction'
+        'Status = stsOK')
+      (
+        'Component = cboImmSeries'
+        'Label = lblSeries'
+        'Status = stsOK')
+      (
+        'Component = ckbContra'
+        'Status = stsDefault')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmImmunizations'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fImmunization.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
+  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 procedure TfrmImmunizations.cboImmSeriesChange(Sender: TObject);
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmImmunizations);
 end.

cprs/trunk/CPRS-Chart/Encounter/fPCEBase.dfm

-              r456
+              r829
 object frmPCEBase: TfrmPCEBase
+inherited frmPCEBase: TfrmPCEBase
   Left = 194
   Top = 170
-  AutoScroll = False
   Caption = 'Basic Page'
   ClientHeight = 400
   ClientWidth = 624
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
-  OldCreateOrder = True
   OnClose = FormClose
   OnCreate = FormCreate
+  OnShow = FormShow
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   DesignSize = (
 …
   PixelsPerInch = 96
   TextHeight = 13
   object btnOK: TBitBtn
+  object btnOK: TBitBtn [0]
     Left = 467
     Top = 376
 …
     Height = 21
     Anchors = [akRight, akBottom]
     Caption = 'OK'
+    Caption = '&OK'
     ModalResult = 1
     TabOrder = 0
 …
     NumGlyphs = 2
   end
   object btnCancel: TBitBtn
+  object btnCancel: TBitBtn [1]
     Left = 547
     Top = 376
 …
     Height = 21
     Anchors = [akRight, akBottom]
     Caption = 'Cancel'
+    Caption = '&Cancel'
     ModalResult = 2
     TabOrder = 1
 …
     NumGlyphs = 2
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEBase'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEBase.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
   StdCtrls, fAutoSz, Buttons, ORCtrls, ORFn, uPCE, ORDtTm, Checklst,
   ComCtrls;
+  ComCtrls, VA508AccessibilityManager, fBase508Form;
 type
 …
     procedure btnOKClick(Sender: TObject); virtual;
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
-    procedure FormShow(Sender: TObject);
   private
     FDisplayCount: Integer;                      // number of times page displayed
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 …
 end;
+procedure TfrmPCEBase.FormShow(Sender: TObject);
+begin
+  inherited;
+  FocusFirstControl;
+end;
+initialization
+  SpecifyFormIsNotADialog(TfrmPCEBase);
 end.

cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.dfm

-              r456
+              r829
 inherited frmPCEBaseGrid: TfrmPCEBaseGrid
   Left = 200
   Top = 303
+  Left = 128
+  Top = 192
   Caption = 'frmPCEBaseGrid'
+  ExplicitLeft = 128
+  ExplicitTop = 192
   PixelsPerInch = 96
   TextHeight = 13
   object pnlGrid: TPanel
+  object pnlGrid: TPanel [2]
     Left = 6
     Top = 238
 …
     Height = 87
     BevelOuter = bvNone
-    Caption = 'pnlGrid'
     TabOrder = 2
     OnResize = pnlGridResize
 …
       Width = 451
       Height = 17
-      DragReorder = False
       Sections = <
         item
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEBaseGrid'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn;
+  fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn,
+  VA508AccessibilityManager;
 type
 …
 implementation
+uses
+  VA2006Utils, VA508AccessibilityRouter;
 {$R *.DFM}
 …
 begin
   inherited;
+  lbGrid.Color := ReadOnlyColor;
+  lbGrid.ItemTipColor := ReadOnlyColor;
+  FixHeaderControlDelphi2006Bug(hcGrid);
   FSectionGap := 15;
   SyncGridHeader(TRUE);
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmPCEBaseGrid);
 end.

cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.dfm

-              r456
+              r829
   Top = 166
   Caption = 'frmPCEBaseMain'
   OnDestroy = FormDestroy
   OnResize = FormResize
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
 …
     Left = 464
     TabOrder = 1
+    ExplicitLeft = 464
   end
   inherited btnCancel: TBitBtn
     Left = 544
     TabOrder = 2
+    ExplicitLeft = 544
   end
   inherited pnlGrid: TPanel
     Width = 475
     TabOrder = 0
+    ExplicitWidth = 475
     inherited lbGrid: TORListBox
       Width = 475
       MultiSelect = True
       OnClick = lbGridSelect
+      OnExit = lbGridExit
       OnChange = lbGridSelect
       CheckEntireLine = True
+      ExplicitWidth = 475
     end
     inherited hcGrid: THeaderControl
       Width = 475
+    end
+  end
+  object edtComment: TCaptionEdit
+      ExplicitWidth = 475
+    end
+  end
+  object edtComment: TCaptionEdit [7]
     Left = 6
     Top = 343
 …
     Caption = 'Comments'
   end
   object btnRemove: TButton
+  object btnRemove: TButton [8]
     Left = 536
     Top = 343
 …
     OnClick = btnRemoveClick
   end
   object btnSelectAll: TButton
+  object btnSelectAll: TButton [9]
     Left = 406
     Top = 326
 …
     OnClick = btnSelectAllClick
   end
   object pnlMain: TPanel
+  object pnlMain: TPanel [10]
     Left = 6
     Top = 20
 …
       Left = 204
       Top = 0
-      Width = 3
       Height = 204
-      Cursor = crHSplit
       OnMoved = splLeftMoved
     end
 …
       TabOrder = 1
       OnClick = clbListClick
+      OnExit = lbxSectionExit
       OnMouseDown = clbListMouseDown
       Caption = 'Section Name'
 …
         TabOrder = 1
         OnClick = lbSectionClick
+        OnExit = lbSectionExit
         Caption = 'Section'
         ItemTipColor = clWindow
 …
         Pieces = '3'
         CheckEntireLine = True
+        ExplicitLeft = -3
+        ExplicitTop = -2
       end
       object btnOther: TButton
 …
         TabOrder = 0
         OnClick = btnOtherClick
+        OnExit = btnOtherExit
       end
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Left = 24
+    Top = 24
+    Data = (
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEBaseMain'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas

-              r456
+              r829
 unit fPCEBaseMain;
+{Warning: The tab order has been changed in the OnExit event of several controls.
+ To change the tab order of lbSection, lbxSection, and btnOther you must do it programatically.}
 interface
 …
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBaseGrid, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, rPCE, uPCE,
   CheckLst, ORFn;
+  CheckLst, ORFn, VA508AccessibilityManager;
 type
 …
     procedure splLeftMoved(Sender: TObject);
     procedure edtCommentKeyPress(Sender: TObject; var Key: Char);
+    procedure lbSectionExit(Sender: TObject);
+    procedure btnOtherExit(Sender: TObject);
+    procedure lbxSectionExit(Sender: TObject);
+    procedure lbGridExit(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
   private
     FCommentItem: integer;
     FCommentChanged: boolean;
     FUpdateCount: integer;
+    FSectionPopulated: boolean;
     //FUpdatingGrid: boolean;  moved to 'protected' so frmDiagnoses can see it  (RV)
   protected
 …
 implementation
+uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch;
+uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter,
+  ORCtrlsVA508Compatibility, fBase508Form;
 {$R *.DFM}
+type
+  TLBSectionManager = class(TORListBox508Manager)
+  public
+    function GetItemInstructions(Component: TWinControl): string; override;
+    function GetState(Component: TWinControl): string; override;
+  end;
 procedure TfrmPCEBaseMain.lbSectionClick(Sender: TObject);
 …
   FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN);
   CheckOffEntries;
+  FSectionPopulated := TRUE;
+end;
+procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject);
+begin
+  inherited;
+  if TabIsPressed then
+    if lbxSection.CanFocus then
+      lbxSection.SetFocus;
 end;
 …
   try
     SaveGridSelected;
     tmpList.Assign(lbGrid.Items);
+    FastAssign(lbGrid.Items, tmpList);
     for i := 0 to lbGrid.Items.Count-1 do
     begin
 …
       tmpList.Objects[i] := lbGrid.Items.Objects[i];
     end;
+    lbGrid.Items.Assign(tmpList);
+  //FastAssign(tmpList,lbGrid.Items); //cq: 13228  Causin a/v errors.
+    lbGrid.Items.Assign(tmpList);    //cq: 13228
     RestoreGridSelected;
     SyncGridData;
 …
 end;
+procedure TfrmPCEBaseMain.btnOtherExit(Sender: TObject);
+begin
+  inherited;
+  if TabIsPressed then begin
+    if lbGrid.CanFocus then
+      lbGrid.SetFocus
+  end
+  else if ShiftTabIsPressed then
+    if lbxSection.CanFocus then
+      lbxSection.SetFocus;
+end;
 procedure TfrmPCEBaseMain.edtCommentExit(Sender: TObject);
 begin
 …
 end;
+procedure TfrmPCEBaseMain.lbGridExit(Sender: TObject);
+begin
+  inherited;
+  if ShiftTabIsPressed then
+    if btnOther.CanFocus then
+      btnOther.SetFocus;
+end;
 procedure TfrmPCEBaseMain.lbGridSelect(Sender: TObject);
 begin
 …
 //  clbList.ItemIndex := -1;
   UpdateControls;
+end;
+procedure TfrmPCEBaseMain.FormCreate(Sender: TObject);
+begin
+  inherited FormCreate(Sender);
+  lbxSection.HideSelection := TRUE;
+  amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create;
 end;
 …
 end;
+procedure TfrmPCEBaseMain.lbxSectionExit(Sender: TObject);
+begin
+  inherited;
+  if TabIsPressed then begin
+    if btnOther.CanFocus then
+      btnOther.SetFocus
+  end
+  else if ShiftTabIsPressed then
+    if lbSection.CanFocus then
+      lbSection.SetFocus;
+end;
 procedure TfrmPCEBaseMain.UpdateTabPos;
 begin
 …
 end;
+{ TLBSectionManager }
+function TLBSectionManager.GetItemInstructions(Component: TWinControl): string;
+var
+  lb : TORListBox;
+  idx: integer;
+begin
+  lb := TORListBox(Component);
+  idx := lb.ItemIndex;
+  if (idx >= 0) and lb.Selected[idx] then
+    Result := 'Press space bar to populate ' +
+        TfrmPCEBaseMain(Component.Owner).FTabName + ' section'
+  else
+    result := inherited GetItemInstructions(Component);
+end;
+function TLBSectionManager.GetState(Component: TWinControl): string;
+var
+  frm: TfrmPCEBaseMain;
+begin
+  Result := '';
+  frm := TfrmPCEBaseMain(Component.Owner);
+  if frm.FSectionPopulated then
+  begin
+    frm.FSectionPopulated := FALSE;
+    Result := frm.FTabName + ' section populated with ' +
+        inttostr(frm.lbxSection.Count) + ' items';
+  end;
+end;
+initialization
+  SpecifyFormIsNotADialog(TfrmPCEBaseMain);
 end.

cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.dfm

-              r456
+              r829
 object frmPCEEdit: TfrmPCEEdit
+inherited frmPCEEdit: TfrmPCEEdit
   Left = 214
   Top = 107
 …
   ClientHeight = 128
   ClientWidth = 543
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
-  OldCreateOrder = False
   Position = poScreenCenter
   OnCreate = FormCreate
 …
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TStaticText
+  object Label1: TStaticText [0]
     Left = 0
     Top = 0
 …
     ParentFont = False
     TabOrder = 5
+    ExplicitWidth = 201
   end
   object lblNew: TMemo
+  object lblNew: TMemo [1]
     Left = 136
     Top = 32
 …
     TabOrder = 3
   end
   object lblNote: TMemo
+  object lblNote: TMemo [2]
     Left = 136
     Top = 73
 …
     TabOrder = 4
   end
   object btnNew: TButton
+  object btnNew: TButton [3]
     Left = 8
     Top = 28
 …
     TabOrder = 0
   end
   object btnNote: TButton
+  object btnNote: TButton [4]
     Left = 8
     Top = 69
 …
     TabOrder = 1
   end
   object btnCancel: TButton
+  object btnCancel: TButton [5]
     Left = 465
     Top = 104
 …
     TabOrder = 2
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Label1'
+        'Status = stsDefault')
+      (
+        'Component = lblNew'
+        'Status = stsDefault')
+      (
+        'Component = lblNote'
+        'Status = stsDefault')
+      (
+        'Component = btnNew'
+        'Status = stsDefault')
+      (
+        'Component = btnNote'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEEdit'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORFn, uPCE;
+  StdCtrls, ORFn, uPCE, fBase508Form, VA508AccessibilityManager;
 type
   TfrmPCEEdit = class(TForm)
+  TfrmPCEEdit = class(TfrmBase508Form)
     btnNew: TButton;
     btnNote: TButton;

cprs/trunk/CPRS-Chart/Encounter/fPCELex.dfm

-              r456
+              r829
   BorderStyle = bsDialog
   Caption = 'Lookup Other Diagnosis'
+  ClientHeight = 275
+  ClientWidth = 429
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
   object lblSearch: TLabel
+  object lblSearch: TLabel [0]
     Left = 6
     Top = 16
 …
     Caption = 'Search for Diagnosis'
   end
   object lblSelect: TLabel
+  object lblSelect: TLabel [1]
     Left = 6
     Top = 67
 …
     Visible = False
   end
   object txtSearch: TCaptionEdit
+  object txtSearch: TCaptionEdit [2]
     Left = 6
     Top = 30
 …
     Caption = 'Search for Diagnosis'
   end
   object cmdSearch: TButton
+  object cmdSearch: TButton [3]
     Left = 346
     Top = 30
 …
     OnClick = cmdSearchClick
   end
   object cmdOK: TButton
+  object cmdOK: TButton [4]
     Left = 263
     Top = 245
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [5]
     Left = 346
     Top = 245
 …
     OnClick = cmdCancelClick
   end
   object lstSelect: TORListBox
+  object lstSelect: TORListBox [6]
     Left = 6
     Top = 81
 …
     Pieces = '2'
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = txtSearch'
+        'Status = stsDefault')
+      (
+        'Component = cmdSearch'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = lstSelect'
+        'Status = stsDefault')
+      (
+        'Component = frmPCELex'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCELex.pas

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

cprs/trunk/CPRS-Chart/Encounter/fPCEOther.dfm

-              r456
+              r829
 object frmPCEOther: TfrmPCEOther
+inherited frmPCEOther: TfrmPCEOther
   Left = 451
   Top = 201
-  Width = 279
-  Height = 340
   ActiveControl = cboOther
   Caption = 'OtherItems'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = True
+  ClientHeight = 313
+  ClientWidth = 271
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 279
+  ExplicitHeight = 340
   PixelsPerInch = 96
   TextHeight = 13
   object cmdCancel: TButton
+  object cmdCancel: TButton [0]
     Left = 190
     Top = 287
 …
     OnClick = cmdCancelClick
   end
   object cmdOK: TButton
+  object cmdOK: TButton [1]
     Left = 110
     Top = 287
 …
     OnClick = cmdOKClick
   end
   object cboOther: TORComboBox
+  object cboOther: TORComboBox [2]
     Left = 8
     Top = 8
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnChange = cboOtherChange
     OnDblClick = cboOtherDblClick
+    CharsNeedMatch = 1
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cboOther'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEOther'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEOther.pas

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, ORFn, ORCtrls, StdCtrls;
	7	fAutoSz, ORFn, ORCtrls, StdCtrls, VA508AccessibilityManager;
8	8
9	9	type

cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.dfm

-              r456
+              r829
 object frmPCEProvider: TfrmPCEProvider
+inherited frmPCEProvider: TfrmPCEProvider
   Left = 192
   Top = 104
 …
   ClientHeight = 254
   ClientWidth = 317
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
-  OldCreateOrder = False
   Position = poScreenCenter
   OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 13
   object Spacer1: TLabel
+  object Spacer1: TLabel [0]
     Left = 0
     Top = 0
 …
     Height = 13
     Align = alTop
+    ExplicitWidth = 3
   end
   object lblMsg: TMemo
+  object lblMsg: TMemo [1]
     Left = 0
     Top = 13
 …
     TabOrder = 4
   end
   object cboPrimary: TORComboBox
+  object cboPrimary: TORComboBox [2]
     Left = 6
     Top = 69
 …
     CharsNeedMatch = 1
   end
   object btnYes: TButton
+  object btnYes: TButton [3]
     Left = 158
     Top = 40
 …
     TabOrder = 1
   end
   object btnNo: TButton
+  object btnNo: TButton [4]
     Left = 238
     Top = 40
 …
     TabOrder = 2
   end
   object btnSelect: TButton
+  object btnSelect: TButton [5]
     Left = 6
     Top = 40
 …
     OnClick = btnSelectClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblMsg'
+        'Status = stsDefault')
+      (
+        'Component = cboPrimary'
+        'Status = stsDefault')
+      (
+        'Component = btnYes'
+        'Status = stsDefault')
+      (
+        'Component = btnNo'
+        'Status = stsDefault')
+      (
+        'Component = btnSelect'
+        'Status = stsDefault')
+      (
+        'Component = frmPCEProvider'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn;
+  StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmPCEProvider = class(TForm)
+  TfrmPCEProvider = class(TfrmBase508Form)
     cboPrimary: TORComboBox;
     lblMsg: TMemo;

cprs/trunk/CPRS-Chart/Encounter/fPatientEd.dfm

-              r456
+              r829
   Top = 267
   Caption = 'Patient Education'
+  ExplicitLeft = 275
+  ExplicitTop = 267
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 123
     Caption = 'Patient Education Section'
+    ExplicitWidth = 123
   end
   inherited btnOK: TBitBtn
 …
     TabOrder = 3
   end
+  object cboPatUnderstanding: TORComboBox [9]
+    Tag = 40
+    Left = 490
+    Top = 280
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Level Of Understanding'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 0
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboPatUnderstandingChange
+    CharsNeedMatch = 1
+  end
   inherited btnRemove: TButton
     TabOrder = 5
 …
     end
   end
+  object cboPatUnderstanding: TORComboBox
+    Tag = 40
+    Left = 490
+    Top = 280
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Level Of Understanding'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboPatUnderstandingChange
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboPatUnderstanding'
+        'Status = stsDefault')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmPatientEd'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fPatientEd.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
+  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 {///////////////////////////////////////////////////////////////////////////////
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmPatientEd);
 end.

cprs/trunk/CPRS-Chart/Encounter/fProcedure.dfm

-              r456
+              r829
 inherited frmProcedures: TfrmProcedures
   Left = 295
   Top = 212
+  Left = 548
+  Top = 172
   Caption = 'Encounter Procedure'
+  ExplicitWidth = 632
+  ExplicitHeight = 427
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 88
     Caption = 'Procedure Section'
+    ExplicitWidth = 88
   end
   inherited lblList: TLabel
     Left = 154
+    ExplicitLeft = 154
   end
   inherited bvlMain: TBevel
 …
     Width = 537
     Height = 166
+    ExplicitTop = 232
+    ExplicitWidth = 537
+    ExplicitHeight = 166
   end
   object lblMod: TLabel [5]
 …
     Top = 344
     TabOrder = 8
+    ExplicitLeft = 544
+    ExplicitTop = 344
   end
   inherited btnCancel: TBitBtn
     Top = 371
     TabOrder = 9
+    ExplicitTop = 371
   end
   inherited pnlGrid: TPanel
     Width = 523
     TabOrder = 1
+    ExplicitWidth = 523
     inherited lbGrid: TORListBox
       Tag = 30
 …
       Caption = 'Selected Procedures'
       Pieces = '1,2'
+      ExplicitWidth = 523
     end
     inherited hcGrid: THeaderControl
 …
           Width = 112
         end>
+      ExplicitWidth = 523
     end
   end
 …
     TabOrder = 2
   end
+  inherited btnRemove: TButton
+    Left = 454
+    Top = 371
+    TabOrder = 7
+  end
+  inherited btnSelectAll: TButton
+    Left = 374
+    Top = 371
+    Height = 21
+    TabOrder = 6
+    TabStop = True
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited splLeft: TSplitter
+      Left = 145
+    end
+    object splRight: TSplitter [1]
+      Left = 349
+      Top = 0
+      Width = 3
+      Height = 204
+      Cursor = crHSplit
+      Align = alRight
+      OnMoved = splRightMoved
+    end
+    inherited lbxSection: TORListBox
+      Tag = 30
+      Left = 148
+      Width = 201
+      ItemHeight = 14
+      Pieces = '2,3'
+    end
+    inherited pnlLeft: TPanel
+      Width = 145
+      inherited lbSection: TORListBox
+        Tag = 30
+        Width = 145
+        TabOrder = 0
+      end
+      inherited btnOther: TButton
+        Tag = 13
+        Left = 3
+        Caption = 'Other Procedure...'
+        TabOrder = 1
+      end
+    end
+    object lbMods: TORListBox
+      Left = 352
+      Top = 0
+      Width = 260
+      Height = 204
+      Style = lbOwnerDrawFixed
+      Align = alRight
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -11
+      Font.Name = 'MS Sans Serif'
+      Font.Style = []
+      ItemHeight = 14
+      ParentFont = False
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+      Caption = 'Modifiers'
+      ItemTipColor = clWindow
+      LongList = False
+      Pieces = '2,3'
+      TabPosInPixels = True
+      CheckBoxes = True
+      CheckEntireLine = True
+      OnClickCheck = lbModsClickCheck
+    end
+  end
+  object spnProcQty: TUpDown
+  object spnProcQty: TUpDown [11]
     Left = 348
     Top = 371
 …
     Position = 1
     TabOrder = 5
+    Wrap = False
+  end
+  object txtProcQty: TCaptionEdit
+  end
+  object txtProcQty: TCaptionEdit [12]
     Left = 288
     Top = 371
 …
     Caption = 'Quantity'
   end
   object cboProvider: TORComboBox
+  object cboProvider: TORComboBox [13]
     Left = 56
     Top = 371
 …
     OnChange = cboProviderChange
     OnNeedData = cboProviderNeedData
+    CharsNeedMatch = 1
+  end
+  inherited btnRemove: TButton
+    Left = 454
+    Top = 371
+    TabOrder = 7
+    ExplicitLeft = 454
+    ExplicitTop = 371
+  end
+  inherited btnSelectAll: TButton
+    Left = 374
+    Top = 371
+    Height = 21
+    TabOrder = 6
+    TabStop = True
+    ExplicitLeft = 374
+    ExplicitTop = 371
+    ExplicitHeight = 21
+  end
+  inherited pnlMain: TPanel
+    TabOrder = 0
+    inherited splLeft: TSplitter
+      Left = 145
+      ExplicitLeft = 145
+    end
+    object splRight: TSplitter [1]
+      Left = 349
+      Top = 0
+      Height = 204
+      Align = alRight
+      OnMoved = splRightMoved
+    end
+    inherited lbxSection: TORListBox
+      Tag = 30
+      Left = 148
+      Width = 201
+      ItemHeight = 14
+      Pieces = '2,3'
+      ExplicitLeft = 148
+      ExplicitWidth = 201
+    end
+    inherited pnlLeft: TPanel
+      Width = 145
+      ExplicitWidth = 145
+      inherited lbSection: TORListBox
+        Tag = 30
+        Width = 145
+        TabOrder = 0
+        ExplicitWidth = 145
+      end
+      inherited btnOther: TButton
+        Tag = 13
+        Left = 3
+        Caption = 'Other Procedure...'
+        TabOrder = 1
+        ExplicitLeft = 3
+      end
+    end
+    object lbMods: TORListBox
+      Left = 352
+      Top = 0
+      Width = 260
+      Height = 204
+      Style = lbOwnerDrawFixed
+      Align = alRight
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -11
+      Font.Name = 'MS Sans Serif'
+      Font.Style = []
+      ItemHeight = 14
+      ParentFont = False
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+      OnExit = lbModsExit
+      Caption = 'Modifiers'
+      ItemTipColor = clWindow
+      LongList = False
+      Pieces = '2,3'
+      TabPosInPixels = True
+      CheckBoxes = True
+      CheckEntireLine = True
+      OnClickCheck = lbModsClickCheck
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lbMods'
+        'Label = lblMod'
+        'Status = stsOK')
+      (
+        'Component = spnProcQty'
+        'Status = stsDefault')
+      (
+        'Component = txtProcQty'
+        'Status = stsDefault')
+      (
+        'Component = cboProvider'
+        'Status = stsDefault')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmProcedures'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fProcedure.pas

-              r456
+              r829
 unit fProcedure;
+{Warning: The tab order has been changed in the OnExit event of several controls.
+ To change the tab order of lbSection, lbxSection, lbMods, and btnOther you must do it programatically.}
 interface
 …
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, ComCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain;
+  fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
       Direction, InsertAt: Integer);
     procedure cboProviderChange(Sender: TObject);
+    procedure lbxSectionExit(Sender: TObject);
+    procedure lbModsExit(Sender: TObject);
+    procedure btnOtherExit(Sender: TObject);
   private
     FCheckingCode: boolean;
 …
     FLastCPTCodes: string;
     FModsReadOnly: boolean;
+    FProviderChanging: boolean;
     FModsROChecked: string;
     function MissingProvider: boolean;
 …
 uses
   fEncounterFrame, uConst, rCore;
+  fEncounterFrame, uConst, rCore, VA508AccessibilityRouter;
 const
 …
       if(lbGrid.Selected[i]) then
         TPCEProc(lbGrid.Items.Objects[i]).Provider := cboProvider.ItemIEN;
+    GridChanged;
+    FProviderChanging := TRUE; // CQ 11707
+    try
+      GridChanged;
+    finally
+      FProviderChanging := FALSE;
+    end;
   end;
 end;
 …
   FSectionTabCount := 1;
   FormResize(Self);
+  lbMods.HideSelection := TRUE;
 end;
 …
           txtProcQty.Text := '';
         end;
+        if(SameProv) then
+          cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200))
+        else
+          cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName);
+          //cboProvider.ItemIndex := -1;     v22.8 - RV
+        if not FProviderChanging then // CQ 11707
+        begin
+          if(SameProv) then
+            cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200))
+          else
+            cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName);
+            //cboProvider.ItemIndex := -1;     v22.8 - RV
+        end;
       end
       else
 …
 end;
+procedure TfrmProcedures.lbModsExit(Sender: TObject);
+begin
+  inherited;
+  if TabIsPressed then
+    if btnOther.CanFocus then
+      btnOther.SetFocus;
+end;
 procedure TfrmProcedures.lbSectionClick(Sender: TObject);
 begin
 …
     inherited;
     Sync2Grid;
+    lbxSection.Selected[Index] := True;
     if(lbxSection.ItemIndex >= 0) and (lbxSection.ItemIndex = Index) and
       (lbxSection.Checked[Index]) then
     begin
       UpdateModifierList(lbxSection.Items, Index);
       lbxSection.Checked[Index] := TRUE;
+      UpdateModifierList(lbxSection.Items, Index); // CQ#16439
+      lbxSection.Checked[Index] := TRUE;
       for i := 0 to lbGrid.Items.Count-1 do
       begin
 …
             Modifiers := Piece(lbxSection.Items[lbxSection.ItemIndex], U, 4);
             GridChanged;
+            lbxSection.Selected[Index] := True; // CQ#15493
             exit;
           end;
 …
 end;
+procedure TfrmProcedures.lbxSectionExit(Sender: TObject);
+begin
+  if TabIsPressed then begin
+    if lbMods.CanFocus then
+      lbMods.SetFocus;
+  end
+  else if ShiftTabIsPressed then
+    if lbSection.CanFocus then
+      lbSection.SetFocus;
+end;
 procedure TfrmProcedures.btnOtherClick(Sender: TObject);
 begin
 …
   Sync2Grid;
   ShowModifiers;
+end;
+procedure TfrmProcedures.btnOtherExit(Sender: TObject);
+begin
+  if TabIsPressed then begin
+    if lbGrid.CanFocus then
+      lbGrid.SetFocus;
+  end
+  else if ShiftTabIsPressed then
+    if lbMods.CanFocus then
+      lbMods.SetFocus;
 end;
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmProcedures);
 end.

cprs/trunk/CPRS-Chart/Encounter/fSkinTest.dfm

-              r456
+              r829
   Top = 163
   Caption = 'Encounter Skin Test form'
+  ExplicitLeft = 213
+  ExplicitTop = 163
   PixelsPerInch = 96
   TextHeight = 13
 …
     Width = 84
     Caption = 'Skin Test Section'
+    ExplicitWidth = 84
   end
   inherited btnOK: TBitBtn
 …
     TabOrder = 3
   end
+  object UpDnReading: TUpDown [12]
+    Left = 531
+    Top = 304
+    Width = 15
+    Height = 21
+    Associate = EdtReading
+    Max = 40
+    TabOrder = 6
+    OnChanging = UpDnReadingChanging
+  end
+  object EdtReading: TCaptionEdit [13]
+    Left = 490
+    Top = 304
+    Width = 41
+    Height = 21
+    Enabled = False
+    TabOrder = 5
+    Text = '0'
+    OnChange = EdtReadingChange
+    Caption = 'Reading'
+  end
+  object edtDtRead: TCaptionEdit [14]
+    Left = 104
+    Top = 376
+    Width = 97
+    Height = 21
+    TabOrder = 8
+    Text = 'edtDtRead'
+    Visible = False
+    Caption = 'Date Read'
+  end
+  object edtDTGiven: TCaptionEdit [15]
+    Left = 280
+    Top = 376
+    Width = 81
+    Height = 21
+    TabOrder = 9
+    Text = 'edtDTGiven'
+    Visible = False
+    Caption = 'Date Given'
+  end
+  object cboSkinResults: TORComboBox [16]
+    Tag = 30
+    Left = 490
+    Top = 260
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Results'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 0
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboSkinResultsChange
+    CharsNeedMatch = 1
+  end
   inherited btnRemove: TButton
     TabOrder = 7
 …
     end
   end
+  object UpDnReading: TUpDown
+    Left = 531
+    Top = 304
+    Width = 15
+    Height = 21
+    Associate = EdtReading
+    Min = 0
+    Max = 40
+    Position = 0
+    TabOrder = 6
+    Wrap = False
+    OnChanging = UpDnReadingChanging
+  end
+  object EdtReading: TCaptionEdit
+    Left = 490
+    Top = 304
+    Width = 41
+    Height = 21
+    Enabled = False
+    TabOrder = 5
+    Text = '0'
+    OnChange = EdtReadingChange
+    Caption = 'Reading'
+  end
+  object edtDtRead: TCaptionEdit
+    Left = 104
+    Top = 376
+    Width = 97
+    Height = 21
+    TabOrder = 8
+    Text = 'edtDtRead'
+    Visible = False
+    Caption = 'Date Read'
+  end
+  object edtDTGiven: TCaptionEdit
+    Left = 280
+    Top = 376
+    Width = 81
+    Height = 21
+    TabOrder = 9
+    Text = 'edtDTGiven'
+    Visible = False
+    Caption = 'Date Given'
+  end
+  object cboSkinResults: TORComboBox
+    Tag = 30
+    Left = 490
+    Top = 260
+    Width = 121
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Caption = 'Results'
+    Color = clWindow
+    DropDownCount = 8
+    Enabled = False
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 4
+    OnChange = cboSkinResultsChange
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = UpDnReading'
+        'Status = stsDefault')
+      (
+        'Component = EdtReading'
+        'Label = lblReading'
+        'Status = stsOK')
+      (
+        'Component = edtDtRead'
+        'Label = lblDTRead'
+        'Status = stsOK')
+      (
+        'Component = edtDTGiven'
+        'Label = lblDTGiven'
+        'Status = stsOK')
+      (
+        'Component = cboSkinResults'
+        'Label = lblSkinResults'
+        'Status = stsOK')
+      (
+        'Component = edtComment'
+        'Label = lblComment'
+        'Status = stsOK')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnSelectAll'
+        'Status = stsDefault')
+      (
+        'Component = pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = lbxSection'
+        'Label = lblList'
+        'Status = stsOK')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lbSection'
+        'Label = lblSection'
+        'Status = stsOK')
+      (
+        'Component = btnOther'
+        'Status = stsDefault')
+      (
+        'Component = pnlGrid'
+        'Status = stsDefault')
+      (
+        'Component = lbGrid'
+        'Status = stsDefault')
+      (
+        'Component = hcGrid'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmSkinTests'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fSkinTest.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
   fPCELex, fPCEOther, rCore, fPCEBaseMain;
+  fPCELex, fPCEOther, rCore, fPCEBaseMain, VA508AccessibilityManager;
 type
 …
 uses
   fEncounterFrame;
+  fEncounterFrame, VA508AccessibilityRouter;
 procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject);
 …
       else
       begin
         Showmessage('If the reading is over 9, the results are required to be positive.');
+        Show508Message('If the reading is over 9, the results are required to be positive.');
         cboSkinResults.SelectById('P');
        end;
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmSkinTests);
 end.

cprs/trunk/CPRS-Chart/Encounter/fVisitType.dfm

-              r456
+              r829
 inherited frmVisitType: TfrmVisitType
+  Left = 255
+  Top = 186
+  Left = 260
   Caption = 'Encounter VisitType'
+  ClientWidth = 620
+  ClientHeight = 438
+  ClientWidth = 592
+  Constraints.MinHeight = 465
+  Constraints.MinWidth = 600
   OnCloseQuery = FormCloseQuery
+  OnResize = FormResize
+  ExplicitLeft = 260
+  ExplicitWidth = 600
+  ExplicitHeight = 472
   PixelsPerInch = 96
   TextHeight = 13
   object lblVType: TLabel [0]
     Left = 150
     Top = 6
     Width = 67
     Height = 13
     Caption = 'Section Name'
+  inherited btnOK: TBitBtn
+    Left = 436
+    Top = 414
+    TabOrder = 3
+    ExplicitLeft = 474
+    ExplicitTop = 459
   end
+  object lblSCDisplay: TLabel [1]
+    Left = 6
+    Top = 123
+    Width = 186
+    Height = 13
+    Caption = 'Service Connection && Rated Disabilities'
+  end
+  object lblVTypeSection: TLabel [2]
+    Left = 6
+    Top = 6
+    Width = 58
+    Height = 13
+    Caption = 'Type of Visit'
+  end
+  object lblCurrentProv: TLabel [3]
+    Left = 277
+    Top = 249
+    Width = 165
+    Height = 13
+    Caption = 'Current providers for this encounter'
+  end
+  object lblProvider: TLabel [4]
+    Left = 6
+    Top = 249
+    Width = 89
+    Height = 13
+    Caption = 'Available providers'
+  end
+  object lblMod: TLabel [5]
+    Left = 358
+    Top = 6
+    Width = 42
+    Height = 13
+    Hint = 'Modifiers'
+    Caption = 'Modifiers'
+    ParentShowHint = False
+    ShowHint = True
+  end
+  inherited btnOK: TBitBtn
+    Left = 463
+    Top = 377
+    TabOrder = 8
+  end
+  inherited btnCancel: TBitBtn
+    Left = 543
+    Top = 377
+    TabOrder = 9
+  end
+  object pnlMain: TPanel
+    Left = 2
+    Top = 19
+    Width = 615
+    Height = 92
+  object pnlTop: TPanel [1]
+    Left = 0
+    Top = 0
+    Width = 592
+    Height = 105
+    Align = alTop
     BevelOuter = bvNone
     TabOrder = 0
+    ExplicitWidth = 630
     object splLeft: TSplitter
       Left = 145
       Top = 0
       Width = 3
       Height = 92
       Cursor = crHSplit
       OnMoved = splLeftMoved
+      Height = 105
+      ExplicitLeft = 154
+      ExplicitTop = 7
+      ExplicitHeight = 145
     end
     object splRight: TSplitter
+      Left = 352
+      Top = 0
+      Width = 3
+      Height = 92
+      Cursor = crHSplit
+      Align = alRight
+      OnMoved = splRightMoved
+      Left = 361
+      Top = 0
+      Height = 105
+      ExplicitLeft = 634
     end
     object pnlLeft: TPanel
 …
       Top = 0
       Width = 145
       Height = 92
+      Height = 105
       Align = alLeft
       BevelOuter = bvNone
       TabOrder = 0
+      ExplicitHeight = 145
+      object lblVTypeSection: TLabel
+        Left = 0
+        Top = 0
+        Width = 145
+        Height = 13
+        Align = alTop
+        Caption = 'Type of Visit'
+        ExplicitWidth = 58
+      end
       object lstVTypeSection: TORListBox
         Tag = 10
         Left = 0
         Top = 0
+        Top = 13
         Width = 145
         Height = 92
         Align = alTop
+        Align = alClient
         ItemHeight = 13
         ParentShowHint = False
 …
       end
     end
+    object lbxVisits: TORListBox
+      Tag = 10
+    object pnlModifiers: TPanel
+      Left = 364
+      Top = 0
+      Width = 228
+      Height = 105
+      Align = alClient
+      BevelOuter = bvNone
+      TabOrder = 2
+      ExplicitLeft = 431
+      ExplicitWidth = 199
+      ExplicitHeight = 145
+      object lblMod: TLabel
+        Left = 0
+        Top = 0
+        Width = 228
+        Height = 13
+        Hint = 'Modifiers'
+        Align = alTop
+        Caption = 'Modifiers'
+        ParentShowHint = False
+        ShowHint = True
+        ExplicitWidth = 42
+      end
+      object lbMods: TORListBox
+        Left = 0
+        Top = 13
+        Width = 228
+        Height = 92
+        Style = lbOwnerDrawFixed
+        Align = alClient
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'MS Sans Serif'
+        Font.Style = []
+        ItemHeight = 14
+        ParentFont = False
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 0
+        Caption = 'Modifiers'
+        ItemTipColor = clWindow
+        LongList = False
+        Pieces = '2,3'
+        TabPosInPixels = True
+        CheckBoxes = True
+        CheckEntireLine = True
+        OnClickCheck = lbModsClickCheck
+        ExplicitWidth = 199
+        ExplicitHeight = 132
+      end
+    end
+    object pnlSection: TPanel
       Left = 148
       Top = 0
+      Width = 204
+      Height = 92
+      Style = lbOwnerDrawFixed
+      Width = 213
+      Height = 105
+      Align = alLeft
+      BevelOuter = bvNone
+      Caption = 'pnlSection'
+      TabOrder = 1
+      object lblVType: TLabel
+        Left = 0
+        Top = 0
+        Width = 213
+        Height = 13
+        Align = alTop
+        Caption = 'Section Name'
+        ExplicitWidth = 67
+      end
+      object lbxVisits: TORListBox
+        Tag = 10
+        Left = 0
+        Top = 13
+        Width = 213
+        Height = 92
+        Style = lbOwnerDrawFixed
+        Align = alClient
+        ItemHeight = 16
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 0
+        OnClick = lbxVisitsClick
+        Caption = 'Section Name'
+        ItemTipColor = clWindow
+        LongList = False
+        Pieces = '3,4,5'
+        TabPosInPixels = True
+        CheckBoxes = True
+        CheckEntireLine = True
+        OnClickCheck = lbxVisitsClickCheck
+        ExplicitLeft = -3
+        ExplicitTop = 7
+        ExplicitWidth = 281
+      end
+    end
+  end
+  object pnlMiddle: TPanel [2]
+    Left = 0
+    Top = 105
+    Width = 592
+    Height = 164
+    Align = alTop
+    BevelOuter = bvNone
+    TabOrder = 1
+    ExplicitTop = 145
+    ExplicitWidth = 630
+    inline fraVisitRelated: TfraVisitRelated
+      Left = 384
+      Top = 0
+      Width = 208
+      Height = 164
+      Align = alRight
+      TabOrder = 1
+      ExplicitLeft = 384
+      ExplicitWidth = 208
+      ExplicitHeight = 164
+      inherited gbVisitRelatedTo: TGroupBox
+        Width = 208
+        Height = 164
+        ExplicitWidth = 208
+        ExplicitHeight = 164
+        inherited chkMSTYes: TCheckBox
+          Top = 127
+          ExplicitTop = 127
+        end
+        inherited chkMSTNo: TCheckBox
+          Top = 127
+          ExplicitTop = 127
+        end
+        inherited chkHNCYes: TCheckBox
+          Top = 143
+          ExplicitTop = 143
+        end
+        inherited chkHNCNo: TCheckBox
+          Top = 142
+          Width = 150
+          Height = 18
+          Caption = 'Head and/or Neck Cancer     No'
+          ExplicitTop = 142
+          ExplicitWidth = 150
+          ExplicitHeight = 18
+        end
+      end
+    end
+    object pnlSC: TPanel
+      Left = 0
+      Top = 0
+      Width = 384
+      Height = 164
       Align = alClient
+      ItemHeight = 16
+      ParentShowHint = False
+      ShowHint = True
+      BevelOuter = bvNone
+      TabOrder = 0
+      ExplicitWidth = 422
+      object lblSCDisplay: TLabel
+        Left = 0
+        Top = 0
+        Width = 384
+        Height = 13
+        Align = alTop
+        Caption = 'Service Connection && Rated Disabilities'
+        ExplicitWidth = 186
+      end
+      object memSCDisplay: TCaptionMemo
+        Left = 0
+        Top = 13
+        Width = 384
+        Height = 151
+        Align = alClient
+        Color = clBtnFace
+        Lines.Strings = (
+          '')
+        ReadOnly = True
+        ScrollBars = ssVertical
+        TabOrder = 0
+        OnEnter = memSCDisplayEnter
+        Caption = 'Service Connection && Rated Disabilities'
+      end
+    end
+  end
+  object pnlBottom: TPanel [3]
+    Left = 0
+    Top = 269
+    Width = 592
+    Height = 141
+    Align = alTop
+    BevelOuter = bvNone
+    TabOrder = 2
+    ExplicitTop = 309
+    ExplicitWidth = 630
+    object btnAdd: TButton
+      Left = 260
+      Top = 35
+      Width = 75
+      Height = 21
+      Caption = 'Add'
       TabOrder = 1
+      OnClick = lbxVisitsClick
+      Caption = 'Section Name'
+      ItemTipColor = clWindow
+      LongList = False
+      Pieces = '3,4,5'
+      TabPosInPixels = True
+      CheckBoxes = True
+      CheckEntireLine = True
+      OnClickCheck = lbxVisitsClickCheck
+    end
+    object lbMods: TORListBox
+      Left = 355
+      Top = 0
+      Width = 260
+      Height = 92
+      Style = lbOwnerDrawFixed
+      OnClick = btnAddClick
+    end
+    object btnDelete: TButton
+      Left = 260
+      Top = 72
+      Width = 75
+      Height = 21
+      Caption = 'Remove'
+      TabOrder = 2
+      OnClick = btnDeleteClick
+    end
+    object btnPrimary: TButton
+      Left = 260
+      Top = 112
+      Width = 75
+      Height = 21
+      Caption = 'Primary'
+      TabOrder = 3
+      OnClick = btnPrimaryClick
+    end
+    object pnlBottomLeft: TPanel
+      Left = 0
+      Top = 0
+      Width = 240
+      Height = 141
+      Align = alLeft
+      BevelOuter = bvNone
+      TabOrder = 0
+      object lblProvider: TLabel
+        Left = 0
+        Top = 0
+        Width = 240
+        Height = 13
+        Align = alTop
+        Caption = 'Available providers'
+        ExplicitWidth = 89
+      end
+      object cboPtProvider: TORComboBox
+        Left = 0
+        Top = 13
+        Width = 240
+        Height = 128
+        Style = orcsSimple
+        Align = alClient
+        AutoSelect = True
+        Caption = 'Available providers'
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = True
+        LongList = True
+        LookupPiece = 2
+        MaxLength = 0
+        Pieces = '2,3'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 0
+        CheckEntireLine = True
+        OnChange = cboPtProviderChange
+        OnDblClick = cboPtProviderDblClick
+        OnNeedData = cboPtProviderNeedData
+        CharsNeedMatch = 1
+        ExplicitWidth = 260
+      end
+    end
+    object pnlBottomRight: TPanel
+      Left = 352
+      Top = 0
+      Width = 240
+      Height = 141
       Align = alRight
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -11
+      Font.Name = 'MS Sans Serif'
+      Font.Style = []
+      ItemHeight = 14
+      ParentFont = False
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+      Caption = 'Modifiers'
+      ItemTipColor = clWindow
+      LongList = False
+      Pieces = '2,3'
+      TabPosInPixels = True
+      CheckBoxes = True
+      CheckEntireLine = True
+      OnClickCheck = lbModsClickCheck
+      BevelOuter = bvNone
+      TabOrder = 4
+      object lblCurrentProv: TLabel
+        Left = 0
+        Top = 0
+        Width = 240
+        Height = 13
+        Align = alTop
+        Caption = 'Current providers for this encounter'
+        ExplicitWidth = 165
+      end
+      object lbProviders: TORListBox
+        Left = 0
+        Top = 13
+        Width = 240
+        Height = 128
+        Align = alClient
+        ItemHeight = 13
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 0
+        OnDblClick = lbProvidersDblClick
+        Caption = 'Current providers for this encounter'
+        ItemTipColor = clWindow
+        LongList = False
+        Pieces = '2'
+        OnChange = lbProvidersChange
+        CheckEntireLine = True
+        ExplicitTop = 11
+        ExplicitWidth = 220
+      end
     end
   end
+  object memSCDisplay: TCaptionMemo
+    Left = 6
+    Top = 137
+    Width = 411
+    Height = 107
+    Color = clBtnFace
+    Lines.Strings = (
+      '')
+    ScrollBars = ssVertical
+    TabOrder = 1
+    Caption = 'Service Connection && Rated Disabilities'
+  inherited btnCancel: TBitBtn
+    Left = 517
+    Top = 414
+    TabOrder = 4
+    ExplicitLeft = 555
+    ExplicitTop = 459
   end
+  object lbProviders: TORListBox
+    Left = 277
+    Top = 265
+    Width = 183
+    Height = 126
+    ItemHeight = 13
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 7
+    OnDblClick = lbProvidersDblClick
+    Caption = 'Current providers for this encounter'
+    ItemTipColor = clWindow
+    LongList = False
+    Pieces = '2'
+    OnChange = lbProvidersChange
+    CheckEntireLine = True
+  end
+  object cboPtProvider: TORComboBox
+    Left = 6
+    Top = 265
+    Width = 183
+    Height = 126
+    Style = orcsSimple
+    AutoSelect = True
+    Caption = 'Available providers'
+    Color = clWindow
+    DropDownCount = 8
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = True
+    LongList = True
+    LookupPiece = 2
+    MaxLength = 0
+    Pieces = '2,3'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 3
+    TabStop = True
+    CheckEntireLine = True
+    OnChange = cboPtProviderChange
+    OnDblClick = cboPtProviderDblClick
+    OnNeedData = cboPtProviderNeedData
+  end
+  object btnAdd: TButton
+    Left = 196
+    Top = 275
+    Width = 75
+    Height = 21
+    Caption = 'Add'
+    TabOrder = 4
+    OnClick = btnAddClick
+  end
+  object btnDelete: TButton
+    Left = 196
+    Top = 307
+    Width = 75
+    Height = 21
+    Caption = 'Remove'
+    TabOrder = 5
+    OnClick = btnDeleteClick
+  end
+  object btnPrimary: TButton
+    Left = 196
+    Top = 355
+    Width = 75
+    Height = 21
+    Caption = 'Primary'
+    TabOrder = 6
+    OnClick = btnPrimaryClick
+  end
+  inline fraVisitRelated: TfraVisitRelated
+    Left = 426
+    Top = 112
+    Width = 192
+    Height = 137
+    TabOrder = 2
+  inherited amgrMain: TVA508AccessibilityManager
+    Left = 8
+    Top = 24
+    Data = (
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmVisitType'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = lstVTypeSection'
+        'Label = lblVTypeSection'
+        'Status = stsOK')
+      (
+        'Component = pnlMiddle'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.gbVisitRelatedTo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkSCYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkAOYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkIRYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkECYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkMSTYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkMSTNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkECNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkIRNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkAONo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkSCNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkHNCYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkHNCNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkCVYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkCVNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkSHDYes'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.chkSHDNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.lblSCNo'
+        'Status = stsDefault')
+      (
+        'Component = fraVisitRelated.lblSCYes'
+        'Status = stsDefault')
+      (
+        'Component = pnlSC'
+        'Status = stsDefault')
+      (
+        'Component = memSCDisplay'
+        'Label = lblSCDisplay'
+        'Status = stsOK')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnAdd'
+        'Status = stsDefault')
+      (
+        'Component = btnDelete'
+        'Status = stsDefault')
+      (
+        'Component = btnPrimary'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottomLeft'
+        'Status = stsDefault')
+      (
+        'Component = cboPtProvider'
+        'Label = lblProvider'
+        'Status = stsOK')
+      (
+        'Component = pnlBottomRight'
+        'Status = stsDefault')
+      (
+        'Component = lbProviders'
+        'Label = lblCurrentProv'
+        'Status = stsOK')
+      (
+        'Component = pnlModifiers'
+        'Status = stsDefault')
+      (
+        'Component = lbMods'
+        'Label = lblMod'
+        'Status = stsOK')
+      (
+        'Component = pnlSection'
+        'Status = stsDefault')
+      (
+        'Component = lbxVisits'
+        'Label = lblVType'
+        'Status = stsOK'))
   end
 end

cprs/trunk/CPRS-Chart/Encounter/fVisitType.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fPCEBase, StdCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn, rCore,
   ComCtrls, mVisitRelated;
+  ComCtrls, mVisitRelated, VA508AccessibilityManager;
 type
   TfrmVisitType = class(TfrmPCEBase)
+    lblVType: TLabel;
+    pnlTop: TPanel;
+    splLeft: TSplitter;
+    splRight: TSplitter;
+    pnlLeft: TPanel;
+    lstVTypeSection: TORListBox;
+    pnlMiddle: TPanel;
+    fraVisitRelated: TfraVisitRelated;
+    pnlSC: TPanel;
     lblSCDisplay: TLabel;
-    lblVTypeSection: TLabel;
     memSCDisplay: TCaptionMemo;
+    lbProviders: TORListBox;
+    lblCurrentProv: TLabel;
+    cboPtProvider: TORComboBox;
+    lblProvider: TLabel;
+    pnlBottom: TPanel;
     btnAdd: TButton;
     btnDelete: TButton;
     btnPrimary: TButton;
+    fraVisitRelated: TfraVisitRelated;
+    lstVTypeSection: TORListBox;
+    lbxVisits: TORListBox;
+    pnlBottomLeft: TPanel;
+    lblProvider: TLabel;
+    cboPtProvider: TORComboBox;
+    pnlBottomRight: TPanel;
+    lbProviders: TORListBox;
+    lblCurrentProv: TLabel;
+    lblVTypeSection: TLabel;
+    pnlModifiers: TPanel;
     lbMods: TORListBox;
     lblMod: TLabel;
     pnlMain: TPanel;
     pnlLeft: TPanel;
     splLeft: TSplitter;
+    pnlSection: TPanel;
+    lbxVisits: TORListBox;
+    lblVType: TLabel;
     procedure lstVTypeSectionClick(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 …
     procedure FormResize(Sender: TObject);
     procedure lbxVisitsClickCheck(Sender: TObject; Index: Integer);
-    procedure splLeftMoved(Sender: TObject);
-    procedure splRightMoved(Sender: TObject);
     procedure lbModsClickCheck(Sender: TObject; Index: Integer);
     procedure lbxVisitsClick(Sender: TObject);
+    procedure memSCDisplayEnter(Sender: TObject);
   protected
     FSplitterMove: boolean;
 …
 uses
   fEncounterFrame, uCore, uConst;
+  fEncounterFrame, uCore, uConst, VA508AccessibilityRouter;
 const
 …
   RefreshProviders;
   FLastMods := uEncPCEData.VisitType.Modifiers;
+  fraVisitRelated.TabStop := FALSE;
 end;
 …
   v, i: integer;
   s: string;
+  padding, size: integer;
+  btnOffset: integer;
 begin
   if FSplitterMove then
     FSplitterMove := FALSE
   else
+    begin
+      inherited;
+      FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth);
+      FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth);
+      if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2;
+      lbxVisits.TabPositions := SectionString;
+      v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth);
+      s := '';
+      for i := 1 to 20 do
+      begin
+        if s <> '' then s := s + ',';
+        s := s + inttostr(v);
+        if(v<0) then
+          dec(v,32)
+        else
+          inc(v,32);
+      end;
+      lbMods.TabPositions := s;
+    end;
+  begin
+//      inherited;
+    FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth);
+    FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth);
+    if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2;
+    lbxVisits.TabPositions := SectionString;
+    v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth);
+    s := '';
+    for i := 1 to 20 do
+    begin
+      if s <> '' then s := s + ',';
+      s := s + inttostr(v);
+      if(v<0) then
+        dec(v,32)
+      else
+        inc(v,32);
+    end;
+    lbMods.TabPositions := s;
+  end;
+  btnOffset := btnAdd.Width div 7;
+  padding := btnAdd.Width + (btnOffset * 2);
+  size := (ClientWidth - padding) div 2;
+  pnlBottomLeft.Width := size;
+  pnlBottomRight.Width := size;
+  btnAdd.Left := size + btnOffset;
+  btnDelete.Left := size + btnOffset;
+  btnPrimary.Left := size + btnOffset;
+  btnOK.top := ClientHeight - btnOK.Height - 4;
+  btnCancel.top := btnOK.Top;
+  btnCancel.Left := ClientWidth - btnCancel.Width - 4;
+  btnOK.Left := btnCancel.Left - btnOK.Width - 4;
+  size := ClientHeight - btnOK.Height - pnlMiddle.Height - pnlBottom.Height - 8;
+  pnlTop.Height := size;
 end;
 …
 end;
-procedure TfrmVisitType.splLeftMoved(Sender: TObject);
-begin
-  inherited;
-  lblVType.Left := lbxVisits.Left + pnlMain.Left;
-  FSplitterMove := TRUE;
-  FormResize(Sender);
-end;
-procedure TfrmVisitType.splRightMoved(Sender: TObject);
-begin
-  inherited;
-  lblMod.Left := lbMods.Left + pnlMain.Left;
-  FSplitterMove := TRUE;
-  FormResize(Sender);
-end;
 procedure TfrmVisitType.lbModsClickCheck(Sender: TObject; Index: Integer);
 var
 …
 end;
+procedure TfrmVisitType.memSCDisplayEnter(Sender: TObject);
+begin
+  inherited;
+  memSCDisplay.SelStart := 0;
+end;
 initialization
+  SpecifyFormIsNotADialog(TfrmVisitType);
 //frmVisitType.CreateProviderList;

cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.dfm

-              r456
+              r829
   Left = 0
   Top = 0
   Width = 192
   Height = 136
+  Width = 206
+  Height = 172
   TabOrder = 0
   object bvlSCFrame: TBevel
+  object gbVisitRelatedTo: TGroupBox
     Left = 0
-    Top = 14
-    Width = 191
-    Height = 119
-    Shape = bsFrame
-  end
-  object lblSCYes: TStaticText
-    Left = 3
     Top = 0
+    Width = 22
+    Height = 13
+    AutoSize = False
+    Caption = 'Yes'
+    TabOrder = 14
+  end
+  object lblSCNo: TStaticText
+    Left = 26
+    Top = 0
+    Width = 18
+    Height = 13
+    AutoSize = False
+    Caption = 'No'
+    TabOrder = 15
+  end
+  object lblSCSelect: TStaticText
+    Left = 44
+    Top = 0
+    Width = 131
+    Height = 13
+    Alignment = taCenter
+    AutoSize = False
+    Width = 206
+    Height = 172
+    Align = alClient
     Caption = 'Visit Related To'
-    TabOrder = 16
-  end
-  object chkSCYes: TCheckBox
-    Tag = 1
-    Left = 6
-    Top = 17
-    Width = 16
-    Height = 17
     TabOrder = 0
+    OnClick = chkClick
+  end
+  object chkAOYes: TCheckBox
+    Tag = 2
+    Left = 6
+    Top = 49
+    Width = 16
+    Height = 17
+    TabOrder = 4
+    OnClick = chkClick
+  end
+  object chkIRYes: TCheckBox
+    Tag = 3
+    Left = 6
+    Top = 65
+    Width = 16
+    Height = 17
+    TabOrder = 6
+    OnClick = chkClick
+  end
+  object chkECYes: TCheckBox
+    Tag = 4
+    Left = 6
+    Top = 81
+    Width = 16
+    Height = 17
+    TabOrder = 8
+    OnClick = chkClick
+  end
+  object chkMSTYes: TCheckBox
+    Tag = 5
+    Left = 6
+    Top = 97
+    Width = 16
+    Height = 17
+    TabOrder = 10
+    OnClick = chkClick
+  end
+  object chkMSTNo: TCheckBox
+    Tag = 15
+    Left = 26
+    Top = 97
+    Width = 160
+    Height = 17
+    Caption = 'MST'
+    TabOrder = 11
+    OnClick = chkClick
+  end
+  object chkECNo: TCheckBox
+    Tag = 14
+    Left = 26
+    Top = 81
+    Width = 160
+    Height = 17
+    Caption = 'Environmental Contaminants'
+    TabOrder = 9
+    OnClick = chkClick
+  end
+  object chkIRNo: TCheckBox
+    Tag = 13
+    Left = 26
+    Top = 65
+    Width = 160
+    Height = 17
+    Caption = 'Ionizing Radiation Exposure'
+    TabOrder = 7
+    OnClick = chkClick
+  end
+  object chkAONo: TCheckBox
+    Tag = 12
+    Left = 26
+    Top = 49
+    Width = 160
+    Height = 17
+    Caption = 'Agent Orange Exposure'
+    TabOrder = 5
+    OnClick = chkClick
+  end
+  object chkSCNo: TCheckBox
+    Tag = 11
+    Left = 26
+    Top = 17
+    Width = 160
+    Height = 17
+    Caption = 'Service Connected Condition'
+    TabOrder = 1
+    OnClick = chkClick
+  end
+  object chkHNCYes: TCheckBox
+    Tag = 6
+    Left = 6
+    Top = 113
+    Width = 16
+    Height = 17
+    TabOrder = 12
+    OnClick = chkClick
+  end
+  object chkHNCNo: TCheckBox
+    Tag = 16
+    Left = 26
+    Top = 113
+    Width = 160
+    Height = 17
+    Caption = 'Head and/or Neck Cancer'
+    TabOrder = 13
+    OnClick = chkClick
+  end
+  object chkCVYes: TCheckBox
+    Tag = 7
+    Left = 6
+    Top = 33
+    Width = 16
+    Height = 17
+    TabOrder = 2
+    OnClick = chkClick
+  end
+  object chkCVNo: TCheckBox
+    Tag = 17
+    Left = 26
+    Top = 33
+    Width = 160
+    Height = 17
+    Caption = 'Combat Vet (Combat Related)'
+    TabOrder = 3
+    OnClick = chkClick
+    object chkSCYes: TCheckBox
+      Tag = 1
+      Left = 7
+      Top = 33
+      Width = 14
+      Height = 17
+      Caption = 'Service Connected Condition     Yes'
+      TabOrder = 0
+      OnClick = chkClick
+    end
+    object chkAOYes: TCheckBox
+      Tag = 2
+      Left = 7
+      Top = 65
+      Width = 14
+      Height = 17
+      Caption = 'Agent Orange Exposure     Yes'
+      TabOrder = 4
+      OnClick = chkClick
+    end
+    object chkIRYes: TCheckBox
+      Tag = 3
+      Left = 7
+      Top = 81
+      Width = 14
+      Height = 17
+      Caption = 'Ionizing Radiation Exposure     Yes'
+      TabOrder = 6
+      OnClick = chkClick
+    end
+    object chkECYes: TCheckBox
+      Tag = 4
+      Left = 7
+      Top = 97
+      Width = 14
+      Height = 17
+      Caption = 'Southwest Asia Conditions     Yes'
+      TabOrder = 8
+      OnClick = chkClick
+    end
+    object chkMSTYes: TCheckBox
+      Tag = 5
+      Left = 7
+      Top = 129
+      Width = 14
+      Height = 17
+      Caption = 'MST     Yes'
+      TabOrder = 12
+      OnClick = chkClick
+    end
+    object chkMSTNo: TCheckBox
+      Tag = 15
+      Left = 27
+      Top = 129
+      Width = 40
+      Height = 17
+      Caption = 'MST     No'
+      TabOrder = 13
+      OnClick = chkClick
+    end
+    object chkECNo: TCheckBox
+      Tag = 14
+      Left = 27
+      Top = 97
+      Width = 148
+      Height = 17
+      Caption = 'Southwest Asia Conditions     No'
+      TabOrder = 9
+      OnClick = chkClick
+    end
+    object chkIRNo: TCheckBox
+      Tag = 13
+      Left = 27
+      Top = 81
+      Width = 154
+      Height = 17
+      Caption = 'Ionizing Radiation Exposure    No'
+      TabOrder = 7
+      OnClick = chkClick
+    end
+    object chkAONo: TCheckBox
+      Tag = 12
+      Left = 27
+      Top = 65
+      Width = 136
+      Height = 17
+      Caption = 'Agent Orange Exposure    No'
+      TabOrder = 5
+      OnClick = chkClick
+    end
+    object chkSCNo: TCheckBox
+      Tag = 11
+      Left = 27
+      Top = 33
+      Width = 158
+      Height = 17
+      Caption = 'Service Connected Condition    No'
+      TabOrder = 1
+      OnClick = chkClick
+    end
+    object chkHNCYes: TCheckBox
+      Tag = 6
+      Left = 7
+      Top = 145
+      Width = 14
+      Height = 17
+      Caption = 'Head and/or Neck Cancer    Yes'
+      TabOrder = 14
+      OnClick = chkClick
+    end
+    object chkHNCNo: TCheckBox
+      Tag = 16
+      Left = 27
+      Top = 145
+      Width = 144
+      Height = 17
+      Caption = 'Head and/or Neck Cancer    No'
+      TabOrder = 15
+      OnClick = chkClick
+    end
+    object chkCVYes: TCheckBox
+      Tag = 7
+      Left = 7
+      Top = 49
+      Width = 14
+      Height = 17
+      Caption = 'Combat Vet (Combat Related)     Yes'
+      TabOrder = 2
+      OnClick = chkClick
+    end
+    object chkCVNo: TCheckBox
+      Tag = 17
+      Left = 27
+      Top = 49
+      Width = 165
+      Height = 17
+      Caption = 'Combat Vet (Combat Related)    No'
+      TabOrder = 3
+      OnClick = chkClick
+    end
+    object chkSHDYes: TCheckBox
+      Tag = 8
+      Left = 7
+      Top = 112
+      Width = 14
+      Height = 17
+      Caption = 'Shipboard Hazard and Defense     Yes'
+      TabOrder = 10
+      OnClick = chkClick
+    end
+    object chkSHDNo: TCheckBox
+      Tag = 18
+      Left = 27
+      Top = 112
+      Width = 168
+      Height = 17
+      Caption = 'Shipboard Hazard and Defense     No'
+      TabOrder = 11
+      OnClick = chkClick
+    end
+    object lblSCNo: TStaticText
+      Left = 27
+      Top = 16
+      Width = 18
+      Height = 13
+      AutoSize = False
+      Caption = 'No'
+      TabOrder = 17
+    end
+    object lblSCYes: TStaticText
+      Left = 4
+      Top = 16
+      Width = 22
+      Height = 13
+      AutoSize = False
+      Caption = 'Yes'
+      TabOrder = 16
+    end
   end
 end

cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.pas

-              r456
+              r829
 type
   TfraVisitRelated = class(TFrame)
+    lblSCYes: TStaticText;
+    lblSCNo: TStaticText;
+    lblSCSelect: TStaticText;
+    bvlSCFrame: TBevel;
+    gbVisitRelatedTo: TGroupBox;
     chkSCYes: TCheckBox;
     chkAOYes: TCheckBox;
 …
     chkCVYes: TCheckBox;
     chkCVNo: TCheckBox;
+    chkSHDYes: TCheckBox;
+    chkSHDNo: TCheckBox;
+    lblSCNo: TStaticText;
+    lblSCYes: TStaticText;
     procedure chkClick(Sender: TObject);
   private
 …
     procedure SetCheckState(CheckYes, CheckNo: TCheckBox; CheckState: Integer);
     function GetCheckState(CheckYes, CheckNo: TCheckBox): Integer;
   public
     constructor Create(AOwner: TComponent); override;
     procedure GetRelated(PCEData: TPCEData); overload;
     procedure GetRelated(var ASCRelated, AAORelated, AIRRelated,
                                 AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer); overload;
+                                AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload;
     procedure InitAllow(SCCond: TSCConditions);
     procedure InitRelated(PCEData: TPCEData); overload;
     procedure InitRelated(const ASCRelated, AAORelated, AIRRelated,
+                                AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer); overload;
+                                AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload;
   end;
 implementation
+uses VA508AccessibilityRouter;
 {$R *.DFM}
 …
   TAG_HNCYES     = 6;
   TAG_CVYES      = 7;
+  TAG_SHDYES     = 8;
   TAG_SCNO       = 11;
   TAG_AONO       = 12;
 …
   TAG_HNCNO      = 16;
   TAG_CVNO       = 17;
+  TAG_SHDNO      = 18;
 procedure TfraVisitRelated.chkClick(Sender: TObject);
 …
   inherited;
   if Sender is TCheckBox then with TCheckBox(Sender) do case Tag of
+    TAG_SCYES:  if Checked then chkSCNo.Checked   := False;
+    TAG_AOYES:  if Checked then chkAONo.Checked   := False;
+    TAG_IRYES:  if Checked then chkIRNo.Checked   := False;
+    TAG_ECYES:  if Checked then chkECNo.Checked   := False;
+    TAG_MSTYES: if Checked then chkMSTNo.Checked  := False;
+    TAG_HNCYES: if Checked then chkHNCNo.Checked  := False;
+    TAG_CVYES:  if Checked then chkCVNo.Checked   := False;
+    TAG_SCNO:   if Checked then chkSCYes.Checked  := False;
+    TAG_AONO:   if Checked then chkAOYes.Checked  := False;
+    TAG_IRNO:   if Checked then chkIRYes.Checked  := False;
+    TAG_ECNO:   if Checked then chkECYes.Checked  := False;
+    TAG_MSTNO:  if Checked then chkMSTYes.Checked := False;
+    TAG_HNCNO:  if Checked then chkHNCYes.Checked := False;
+    TAG_CVNO:   if Checked then chkCVYes.Checked  := False;
+    TAG_SCYES:   if Checked then chkSCNo.Checked    := False;
+    TAG_AOYES:   if Checked then chkAONo.Checked    := False;
+    TAG_IRYES:   if Checked then chkIRNo.Checked    := False;
+    TAG_ECYES:   if Checked then chkECNo.Checked    := False;
+    TAG_MSTYES:  if Checked then chkMSTNo.Checked   := False;
+    TAG_HNCYES:  if Checked then chkHNCNo.Checked   := False;
+    TAG_CVYES:   if Checked then chkCVNo.Checked    := False;
+    TAG_SHDYES:  if Checked then chkSHDNo.Checked   := False;
+    TAG_SCNO:    if Checked then chkSCYes.Checked   := False;
+    TAG_AONO:    if Checked then chkAOYes.Checked   := False;
+    TAG_IRNO:    if Checked then chkIRYes.Checked   := False;
+    TAG_ECNO:    if Checked then chkECYes.Checked   := False;
+    TAG_MSTNO:   if Checked then chkMSTYes.Checked  := False;
+    TAG_HNCNO:   if Checked then chkHNCYes.Checked  := False;
+    TAG_CVNO:    if Checked then chkCVYes.Checked   := False;
+    TAG_SHDNO:   if Checked then chkSHDYes.Checked := False;
   end;
   if chkSCYes.Checked then
 …
     DisableCheck(chkIRYes);
     DisableCheck(chkECYes);
+    DisableCheck(chkSHDYes);
 //    DisableCheck(chkMSTYes);
     DisableCheck(chkAONo);
     DisableCheck(chkIRNo);
     DisableCheck(chkECNo);
+    DisableCheck(chkSHDNo);
 //    DisableCheck(chkMSTNo);
   end else
 …
     SetCheckEnable(chkIRYes,  chkIRNo,  FSCCond.IRAllow);
     SetCheckEnable(chkECYes,  chkECNo,  FSCCond.ECAllow);
+    SetCheckEnable(chkSHDYEs, chkSHDNo, FSCCond.SHDAllow);
   end;
   SetCheckEnable(chkMSTYes, chkMSTNo, FSCCond.MSTAllow);
   SetCheckEnable(chkHNCYes, chkHNCNo, FSCCond.HNCAllow);
+  SetCheckEnable(chkCVYes, chkCVNo, FSCCond.CVAllow);
+  if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked then //or chkMSTYes.Checked then
+  begin
+    chkSCYes.Checked := False;
+    chkSCNo.Checked := True;
+  SetCheckEnable(chkCVYes, chkCVNo,   FSCCond.CVAllow);
+  if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked or chkSHDYes.Checked then //or chkMSTYes.Checked then
+  begin
+    if FSCCond.SCAllow then
+    begin
+       chkSCYes.Checked := False;
+       chkSCNo.Checked := True;
+    end;
   end;
 end;
 …
 constructor TfraVisitRelated.Create(AOwner: TComponent);
 begin
   inherited;
+  inherited Create(AOwner);
+  TabStop := FALSE;
   lblSCYes.Height := 13;
   lblSCNo.Height := 13;
-//  chkHNCYes.Visible := HNCOK;
-//  chkHNCNo.Visible := HNCOK;
-//  if not HNCOK then
-//  begin
-//    height := height - chkHNCYes.height + 1;
-//    bvlSCFrame.height := bvlSCFrame.height - chkHNCYes.height + 1;
-//  end;
 end;
 …
   PCEData.HNCRelated := GetCheckState(chkHNCYes, chkHNCNo);
   PCEData.CVRelated  := GetCheckState(chkCVYes,  chkCVNo);
+  PCEData.SHADRelated := GetCheckState(chkSHDYes, chkSHDNo);
 end;
 procedure TfraVisitRelated.GetRelated(var ASCRelated, AAORelated,
   AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer);
+  AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer);
 begin
   ASCRelated  := GetCheckState(chkSCYes,  chkSCNo);
 …
   AHNCRelated := GetCheckState(chkHNCYes, chkHNCNo);
   ACVRelated  := GetCheckState(chkCVYes,  chkCVNo);
+  ASHDRelated := GetCheckState(chkSHDYes, chkSHDNo);
 end;
 …
     SetCheckEnable(chkHNCYes, chkHNCNo, HNCAllow);
     SetCheckEnable(chkCVYes,  chkCVNo,  CVAllow);
+    SetCheckEnable(chkSHDYes, chkSHDNo, SHDAllow);
   end;
 end;
 …
   SetCheckState(chkHNCYes, chkHNCNo, PCEData.HNCRelated);
   SetCheckState(chkCVYes,  chkCVNo,  PCEData.CVRelated);
+  SetCheckState(chkSHDYes, chkSHDNo, PCEData.SHADRelated);
+   //HDS00015356: GWOT Default, if Related no specified default to "Yes"
+  // -1=Null, 0=No, 1 = Yes
+  if FSCCond.CVAllow then
+  begin
+    if PCEData.CVRelated = SCC_NA then
+       chkCVYes.Checked := True;
+  end;
 end;
 procedure TfraVisitRelated.InitRelated(const ASCRelated, AAORelated, AIRRelated,
   AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer);
+  AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer);
 begin
   SetCheckState(chkSCYes,  chkSCNo,  ASCRelated);
 …
   SetCheckState(chkHNCYes, chkHNCNo, AHNCRelated);
   SetCheckState(chkCVYes,  chkCVNo,  ACVRelated);
+  SetCheckState(chkSHDYes, chkSHDNo, ASHDRelated);
+   //HDS00015356: GWOT Default, if Related no specified default to "Yes"
+   // -1=Null, 0=No, 1 = Yes
+  if FSCCond.CVAllow then
+  begin
+    if ACVRelated = SCC_NA then
+       chkCVYes.Checked := True;
+  end;
 end;
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfraVisitRelated);
 end.

cprs/trunk/CPRS-Chart/Encounter/rPCE.pas

-              r456
+              r829
     HNCAllow: Boolean;        // prompt for Head or Neck Cancer
     HNCDflt:  Boolean;        // default if prompting Head or Neck Cancer
+    CVAllow: Boolean;        // prompt for Combat Veteran Related
+    CVDflt:  Boolean;        // default if prompting Comabt Veteran
+    CVAllow:  Boolean;        // prompt for Combat Veteran Related
+    CVDflt:   Boolean;        // default if prompting Comabt Veteran
+    SHDAllow: Boolean;        // prompt for Shipboard Hazard and Defense
+    SHDDflt:  Boolean;        // default if prompting Shipboard Hazard and Defense
   end;
 …
                                              ANoteIEN: integer): string;
 function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
+function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean;
 function IsCancelOrNoShow(ANote: integer): boolean;
 function IsNonCountClinic(ALocation: integer): boolean;
 …
   end;
   CallV('ORWPCE LEX', [x, CodeSys, ADate]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
     uVTypeLastDate := EncDt;
   end;
   Dest.Assign(uVTypeForLoc);
+  FastAssign(uVTypeForLoc, Dest);
 end;
 …
     CVAllow  := Piece(Piece(x, ';', 7), U, 1) = '1';
     CVDflt   := Piece(Piece(x, ';', 7), U, 2) = '1';
+    SHDAllow := Piece(Piece(x, ';', 8), U, 1) = '1';
+    SHDDflt  := Piece(Piece(x, ';', 8), U, 2) = '1';
   end;
 end;
 …
 begin
   CallV('ORWPCE SCDIS', [Patient.DFN]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   else
     CallV('ORWPCE PCE4NOTE', [ANoteIEN]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
         end;
       end;
       uHasCPT.AddStrings(RPCBrokerV.Results);
+      FastAddStrings(RPCBrokerV.Results, uHasCPT);
     end;
   end;
 …
     begin
       if idx = 0 then
+        tCallV(TmpSL,RPC,[nil])
+      begin
+        if (typ = 1) or (typ = 2) then
+          tCallV(TmpSL,RPC,[uEncPCEData.VisitDateTime])
+        else
+          tCallV(TmpSL,RPC,[nil]);
+      end
       else
         tCallV(TmpSL,RPC,[idx]);
 …
       end;
     end;
     Dest.Assign(TmpSL);
+    FastAssign(TmpSL, Dest);
   finally
     TmpSL.Free;
 …
 end;
+function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean;
+begin
+  Result := (sCallV('TIU IS USER A USR PROVIDER', [AUser, ADate]) = '1');
+end;
 //function HNCOK: boolean;
 //begin

cprs/trunk/CPRS-Chart/Encounter/uPCE.pas

-              r456
+              r829
 unit uPCE;
 interface
 …
     FHNCRelated:   Integer;                        //
     FCVRelated:    Integer;                        //
+    FSHADRelated:   Integer;                        //
     FVisitType:    TPCEProc;                       //
     FProviders:    TPCEProviderList;
 …
     procedure SetHNCRelated(Value: Integer);
     procedure SetCVRelated(Value: Integer);
+    procedure SetSHADRelated(Value: Integer);
     procedure SetEncUseCurr(Value: Boolean);
     function GetHasData: Boolean;
 …
     function StrExams: string;
     function StrVisitType(const ASCRelated, AAORelated, AIRRelated, AECRelated,
                                 AMSTRelated, AHNCRelated, ACVRelated: Integer): string; overload;
+                                AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string; overload;
     function StrVisitType: string; overload;
     function StandAlone: boolean;
 …
     property HNCRelated:   Integer  read FHNCRelated  write SetHNCRelated;
     property CVRelated:    Integer  read FCVRelated  write SetCVRelated;
+    property SHADRelated:   Integer  read FSHADRelated write SetSHADRelated;
     property VisitType:    TPCEProc read FVisitType   write SetVisitType;
     property VisitString:  string   read GetVisitString;
 …
       begin
         Result := PCESetsOfCodes.Add(Hdr);
         PCESetsOfCodes.AddStrings(TempSL);
+        FastAddStrings(TempSL, PCESetsOfCodes);
       end;
     finally
 …
       HistLocations.Insert(0,'0');
     end;
     List.AddStrings(HistLocations);
+    FastAddStrings(HistLocations, List);
   end
   else
 …
         begin
           idx := PCESetsOfCodes.Add(Hdr);
           PCESetsOfCodes.AddStrings(TempSL);
+          FastAddStrings(TempSL, PCESetsOfCodes);
         end;
       finally
 …
   FHNCRelated  := SCC_NA;
   FCVRelated   := SCC_NA;
+  FSHADRelated := SCC_NA;
   FSCChanged   := False;
 end;
 …
   FHNCRelated := SCC_NA;
   FCVRelated  := SCC_NA;
+  FSHADRelated := SCC_NA;
   ClearList(FDiagnoses);
 …
       if(FileCat = 'E') and (FHistoricalLocation <> '') then
         Add('VST^OL^' + FHistoricalLocation);     // Outside Location
+      //Add('PRV^' + IntToStr(FEncProvider));       // Encounter Provider
+      //Add('PRV^' + IntToStr(UProvider.IEN));      // Encounter Provider
+      {with FProviders do for i := 0 to Count - 1 do with TPCEProvider(Items[i]) do
+        begin
+          PCEList.Add(DelimitedStr);
+        end;}
+      PCEList.AddStrings(FProviders);
+      FastAddStrings(FProviders, PCEList);
       if FSCChanged then
       begin
         if FSCRelated <> SCC_NA then  Add('VST^SC^'  + IntToStr(FSCRelated));
         if FAORelated <> SCC_NA then  Add('VST^AO^'  + IntToStr(FAORelated));
         if FIRRelated <> SCC_NA then  Add('VST^IR^'  + IntToStr(FIRRelated));
         if FECRelated <> SCC_NA then  Add('VST^EC^'  + IntToStr(FECRelated));
         if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated));
+//        if HNCOK and (FHNCRelated <> SCC_NA) then
         if FHNCRelated <> SCC_NA then Add('VST^HNC^' + IntToStr(FHNCRelated));
         if FCVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));
+        if FSCRelated  <> SCC_NA then  Add('VST^SC^'  + IntToStr(FSCRelated));
+        if FAORelated  <> SCC_NA then  Add('VST^AO^'  + IntToStr(FAORelated));
+        if FIRRelated  <> SCC_NA then  Add('VST^IR^'  + IntToStr(FIRRelated));
+        if FECRelated  <> SCC_NA then  Add('VST^EC^'  + IntToStr(FECRelated));
+        if FMSTRelated <> SCC_NA then  Add('VST^MST^' + IntToStr(FMSTRelated));
+        if FHNCRelated  <> SCC_NA then Add('VST^HNC^'+ IntToStr(FHNCRelated));
+        if FCVRelated   <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));
+        if FSHADRelated <> SCC_NA then Add('VST^SHD^'+ IntToStr(FSHADRelated));
       end;
      with FDiagnoses  do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
 …
 begin
   Result := -1;
-//  with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
   with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
-//  with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) then
   begin
     Result := i;
 …
     begin
       PostItem := TPCEItem(Objects[j]);
-//      if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
       if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
-//      if (PreItem.Match(PostItem)) then MatchFound := True;
     end;
     if not MatchFound then
 …
       if CurImmunization.Reaction = '' then CurImmunization.Reaction := NoPCEValue;
-//      if (SrcImmunization.Provider <> CurImmunization.Provider) or
       if(SrcImmunization.Series <> CurImmunization.Series) or
         (SrcImmunization.Reaction <> CurImmunization.Reaction) or
 …
         (CurImmunization.Comment <> SrcImmunization.Comment)then
       begin
-//        CurImmunization.Provider        := SrcImmunization.Provider;
         CurImmunization.Series          := SrcImmunization.Series;
         CurImmunization.Reaction        := SrcImmunization.Reaction;
 …
       if CurSkinTest.Results = '' then CurSkinTest.Results := NoPCEValue;
       if SrcSkinTest.Results = '' then SrcSkinTest.Results := NoPCEValue;
+//      if (SrcSkinTest.Provider <> CurSkinTest.Provider) or
       if(SrcSkinTest.Results <> CurSkinTest.Results) or
         (SrcSkinTest.Reading <> CurSkinTest.Reading) or
         (CurSkinTest.Comment <> SrcSkinTest.Comment) then
       begin
+//        CurSkinTest.Provider := SrcSkinTest.Provider;
+        (CurSkinTest.Comment <> SrcSkinTest.Comment) then
+      begin
         CurSkinTest.Results := SrcSkinTest.Results;
         CurSkinTest.Reading := SrcSkinTest.Reading;
         CurSkinTest.Comment := SrcSkinTest.Comment;
+        CurSkinTest.Comment := SrcSkinTest.Comment;
         CurSkinTest.FSend := True;
       end;
 …
       if CurPatientEd.level = '' then CurPatientEd.level := NoPCEValue;
       if SrcPatientEd.level = '' then SrcPatientEd.level := NoPCEValue;
-//      if (SrcPatientEd.Provider <> CurPatientEd.Provider) or
       if(SrcPatientEd.Level <> CurPatientEd.Level) or
         (CurPatientEd.Comment <> SrcPatientEd.Comment) then
       begin
-//        CurPatientEd.Provider := SrcPatientEd.Provider;
         CurPatientEd.Level  := SrcPatientEd.Level;
         CurPatientEd.Comment := SrcPatientEd.Comment;
 …
       if CurHealthFactor.level = '' then CurHealthFactor.level := NoPCEValue;
       if SrcHealthFactor.level = '' then SrcHealthFactor.level := NoPCEValue;
-//      if (SrcHealthFactor.Provider <> CurHealthFactor.Provider) or
       if(SrcHealthFactor.Level <> CurHealthFactor.Level) or
         (CurHealthFactor.Comment <> SrcHealthFactor.Comment) then
       begin
-//        CurHealthFactor.Provider := SrcHealthFactor.Provider;
         CurHealthFactor.Level  := SrcHealthFactor.Level;
         CurHealthFactor.Comment := SrcHealthFactor.Comment;
 …
       if CurExam.Results = '' then CurExam.Results := NoPCEValue;
       if SrcExam.Results = '' then SrcExam.Results := NoPCEValue;
-//      if (SrcExam.Provider <> CurExam.Provider) or
       if(SrcExam.Results <> CurExam.Results) or
         (CurExam.Comment <> SrcExam.Comment) then
       begin
-//        CurExam.Provider := SrcExam.Provider;
         CurExam.Results  := SrcExam.Results;
         CurExam.Comment := SrcExam.Comment;
 …
 end;
+procedure TPCEData.SetSHADRelated(Value: Integer);
+begin
+  if (Value <> FSHADRelated) then
+  begin
+    FSHADRelated := Value;
+    FSCChanged   := True;
+  end;
+end;
 procedure TPCEData.SetEncUseCurr(Value: Boolean);
 begin
 …
     FStandAlone   := Encounter.StandAlone;
     FStandAloneLoaded := TRUE;
-    //FCPTRequired  := Encounter.StandAlone;
     FEncInpatient := Encounter.Inpatient;
+    //if FEncInpatient then FCPTRequired := False;
+    //SetDefaultProvider(FProviders, FEncLocation, FNoteIEN, PersonClassDate);
   end else
   begin
 …
     FProviders.PrimaryIdx := -1;
     FEncSvcCat    := 'A';
-    //FCPTRequired  := False;
     FEncInpatient := False;
   end;
   //
   SetRPCEncLocation(FEncLocation);
-//  SetRPCEncDateTime(FEncDateTime);
 end;
 …
 function TPCEData.StrVisitType(const ASCRelated, AAORelated, AIRRelated,
   AECRelated, AMSTRelated, AHNCRelated, ACVRelated: Integer): string;
+  AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string;
 { returns as a string the type of encounter (according to CPT) & related contitions treated }
 …
     end;
   Result := Trim(Result + StrVisitType(FSCRelated, FAORelated, FIRRelated,
                                        FECRelated, FMSTRelated, FHNCRelated, FCVRelated));
+                                       FECRelated, FMSTRelated, FHNCRelated, FCVRelated, FSHADRelated));
 end;
 …
   Dest.FHNCRelated   := FHNCRelated;
   Dest.FCVRelated    := FCVRelated;
+  Dest.FSHADRelated  := FSHADRelated;
   FVisitType.CopyProc(Dest.VisitType);
   Dest.FProviders.Assign(FProviders);
 …
   if(not FutureEncounter(Self)) then
   begin
-//    if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone) or CPTRequiredForNote(FNoteIEN)) then
     if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone)) then
     begin
 …
 //        if HNCOK and (EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
         if(EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
         if(EC.CVAllow and (CVRelated = SCC_NA)) then NeedSC := TRUE;
+        if(EC.CVAllow and (CVRelated = SCC_NA) and (SHADRelated = SCC_NA)) then NeedSC := TRUE;
         if(NeedSC) then
           Include(Result, ndSC);
 …
   if(Result) then Result := (FHNCRelated = SCC_NA);
   if(Result) then Result := (FCVRelated = SCC_NA);
+  if(Result) then Result := (FSHADRelated = SCC_NA);
   if(Result) then Result := (FDiagnoses.Count = 0);
   if(Result) then Result := (FProcedures.Count = 0);

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

-              r456
+              r829
   Top = 257
   BorderIcons = []
-  BorderStyle = bsDialog
   Caption = 'Order Checking'
   ClientHeight = 169
   ClientWidth = 472
   Position = poScreenCenter
+  ExplicitLeft = 305
+  ExplicitTop = 257
+  ExplicitWidth = 480
+  ExplicitHeight = 203
   PixelsPerInch = 96
   TextHeight = 13
   object memChecks: TRichEdit
+  object memChecks: TRichEdit [0]
     Left = 0
     Top = 0
 …
     WantReturns = False
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 136
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memChecks'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmOCAccept'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls;
	7	fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
 inherited frmOCSession: TfrmOCSession
+  Left = 365
+  Top = 221
+  Width = 504
+  Height = 298
+  Left = 366
+  Top = 222
   BorderIcons = []
   Caption = 'Order Checks'
+  ClientWidth = 494
   Position = poScreenCenter
   ShowHint = True
   OnClose = FormClose
   OnShow = FormShow
+  ExplicitWidth = 502
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
   object lstChecks: TCaptionListBox
+  object lstChecks: TCaptionListBox [0]
     Left = 0
     Top = 0
     Width = 496
     Height = 160
+    Width = 494
+    Height = 162
     Style = lbOwnerDrawVariable
     Align = alClient
 …
     HintOnItem = True
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 160
     Width = 496
+    Top = 162
+    Width = 494
     Height = 111
     Align = alBottom
 …
     TabOrder = 0
     DesignSize = (
 )
     object lblJustify: TLabel
       Left = 8
+      Left = 9
       Top = 34
       Width = 248
 …
       Left = 8
       Top = 50
       Width = 480
+      Width = 478
       Height = 21
       Anchors = [akLeft, akTop, akRight]
 …
       Left = 356
       Top = 5
       Width = 133
+      Width = 131
       Height = 21
       Anchors = [akLeft, akTop, akRight]
       Caption = 'Cancel Selected Order(s)'
       TabOrder = 2
+      TabOrder = 3
       OnClick = cmdCancelOrderClick
     end
     object cmdContinue: TButton
       Left = 212
+      Left = 157
       Top = 82
       Width = 72
+      Width = 70
       Height = 21
-      Anchors = [akLeft, akTop, akRight]
       Caption = 'Continue'
       TabOrder = 3
+      TabOrder = 4
       OnClick = cmdContinueClick
     end
+    object btnReturn: TButton
+      Left = 241
+      Top = 82
+      Width = 97
+      Height = 21
+      Cancel = True
+      Caption = 'Return to Orders'
+      TabOrder = 5
+      OnClick = btnReturnClick
+    end
+    object memNote: TMemo
+      Left = 8
+      Top = 4
+      Width = 329
+      Height = 29
+      BorderStyle = bsNone
+      Color = clBtnFace
+      Lines.Strings = (
+        'NOTE: The override justification is for tracking purposes and '
+        'does not change or place new order(s).')
+      ReadOnly = True
+      TabOrder = 1
+      OnEnter = memNoteEnter
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstChecks'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = txtJustify'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancelOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdContinue'
+        'Status = stsDefault')
+      (
+        'Component = btnReturn'
+        'Status = stsDefault')
+      (
+        'Component = memNote'
+        'Status = stsDefault')
+      (
+        'Component = frmOCSession'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls;
+  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager;
 type
 …
     cmdCancelOrder: TButton;
     cmdContinue: TButton;
+    btnReturn: TButton;
+    memNote: TMemo;
     procedure cmdCancelOrderClick(Sender: TObject);
     procedure cmdContinueClick(Sender: TObject);
 …
     procedure txtJustifyKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
+    procedure btnReturnClick(Sender: TObject);
+    procedure memNoteEnter(Sender: TObject);
   private
     FCritical: Boolean;
+    FCancelSignProcess : Boolean;
     FCheckList: TStringList;
     FOrderList: TStringList;
     procedure SetReqJustify;
+    procedure SetReturn(const Value: Boolean);
   public
     { Public declarations }
+    property CancelSignProcess : Boolean read FCancelSignProcess write SetReturn default false;
   end;
 procedure ExecuteReleaseOrderChecks(SelectList: TList);
 procedure ExecuteSessionOrderChecks(OrderList: TStringList);
+function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
 implementation
 …
 {$R *.DFM}
 uses rOrders, uCore, rMisc;
+uses rOrders, uCore, rMisc, fFrame;
 type
 …
       OrderIDList.Add(AnOrder.ID + '^^1');  // 3rd pce = 1 means releasing order
     end;
+    ExecuteSessionOrderChecks(OrderIDList);
+    for i := SelectList.Count - 1 downto 0 do
+    begin
+      AnOrder := TOrder(SelectList.Items[i]);
+      if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
+    if ExecuteSessionOrderChecks(OrderIDList) then
+      for i := SelectList.Count - 1 downto 0 do
       begin
+        Changes.Remove(CH_ORD, AnOrder.ID);
+        SelectList.Delete(i);
+      end;
+    end;
+        AnOrder := TOrder(SelectList.Items[i]);
+        if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
+        begin
+          Changes.Remove(CH_ORD, AnOrder.ID);
+          SelectList.Delete(i);
+        end;
+      end
+    else
+      SelectList.Clear;
   finally
     OrderIDList.Free;
 …
 end;
+procedure ExecuteSessionOrderChecks(OrderList: TStringList);
+{Returns True if the Signature process should proceed.
+ Clears OrderList If False. }
+function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
 var
   i, j: Integer;
 …
   x: string;
 begin
+  Result := True;
   CheckList := TStringList.Create;
   try
 …
         if frmOCSession.Visible then frmOCSession.SetFocus;
         frmOCSession.ShowModal;
+        Result := not frmOCSession.CancelSignProcess;
+        if frmOCSession.CancelSignProcess then begin
+          OrderList.Clear;
+          if Assigned(frmFrame) then
+            frmFrame.SetActiveTab(CT_ORDERS);
+        end;
       finally
         with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
 …
   lblJustify.Visible := FCritical;
   txtJustify.Visible := FCritical;
+  memNote.Visible := FCritical;
 end;
 …
                  if (Piece(OCRec.Checks[i], U, 2) = '1') then
                    begin
+                     if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
+                       Canvas.Font.Color := clBlue;
+                     Canvas.Font.Color := Get508CompliantColor(clBlue);
                      Canvas.Font.Style := [fsUnderline];
                    end
 …
   inherited;
   SetFormPosition(Self); //Get Saved Position & Size of Form
+  FCancelSignProcess := False;
 end;
 …
 end;
+procedure TfrmOCSession.btnReturnClick(Sender: TObject);
+begin
+  inherited;
+  FCancelSignProcess := True;
+  Close;
+end;
+procedure TfrmOCSession.SetReturn(const Value: Boolean);
+begin
+  FCancelSignProcess := Value;
+end;
+procedure TfrmOCSession.memNoteEnter(Sender: TObject);
+begin
+  inherited;
+  memNote.SelStart := 0;
+end;
 end.

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

-              r456
+              r829
 object frmODActive: TfrmODActive
+inherited frmODActive: TfrmODActive
   Left = 267
   Top = 216
-  Width = 547
-  Height = 350
   Caption = 'Copy active orders for selected event'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 316
+  ClientWidth = 539
   OldCreateOrder = False
   Position = poScreenCenter
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
   object lblCaption: TLabel
+  object lblCaption: TLabel [0]
     Left = 0
     Top = 0
 …
     WordWrap = True
   end
   object pnlClient: TPanel
+  object pnlClient: TPanel [1]
     Left = 0
     Top = 29
     Width = 539
     Height = 293
+    Height = 287
     Align = alClient
     BevelOuter = bvNone
     Locked = True
     TabOrder = 0
+    ExplicitHeight = 294
     DesignSize = (
 )
+)
     object btnOK: TButton
       Left = 386
 …
       Width = 539
       Height = 21
-      DragReorder = False
       Sections = <
         item
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlClient'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = lstActiveOrders'
+        'Status = stsDefault')
+      (
+        'Component = hdControl'
+        'Status = stsDefault')
+      (
+        'Component = frmODActive'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,rOrders,fOrders,uOrders,
   fFrame,ORCtrls,fAutoSz;
+  fFrame,ORCtrls,fAutoSz, VA508AccessibilityManager;
 type
 …
 implementation
+uses
+  VA2006Utils;
 {$R *.DFM}
 …
   DoesDestEvtOccur:boolean;
 begin
+  try
+  self.btnOK.Enabled := false;
   DoesDestEvtOccur := False;
   uAutoAC := True;
 …
     uAutoAC := False;
   end;
+  finally
+    self.btnOK.Enabled := True;
+  end;
   Close;
 end;
 …
 procedure TfrmODActive.FormCreate(Sender: TObject);
 begin
+  FixHeaderControlDelphi2006Bug(hdControl);
   ActiveOrderList := TList.Create;
   FOrderView      := TOrderView.Create;
 …
     ARect := TheeRect;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);

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

-              r456
+              r829
   Height = 339
   HorzScrollBar.Range = 520
-  HorzScrollBar.Visible = True
   VertScrollBar.Range = 312
-  VertScrollBar.Visible = True
-  AutoScroll = False
   Caption = 'Enter Allergy Information'
+  ExplicitHeight = 339
   PixelsPerInch = 96
   TextHeight = 13
 …
     Top = 256
     TabOrder = 16
+    ExplicitLeft = 5
+    ExplicitTop = 256
   end
   inherited cmdAccept: TButton
 …
     Caption = 'Accept'
     TabOrder = 13
+    ExplicitLeft = 441
+    ExplicitTop = 256
   end
   inherited cmdQuit: TButton
 …
     Top = 283
     TabOrder = 14
+    ExplicitLeft = 441
+    ExplicitTop = 283
   end
   inherited pnlMessage: TPanel
 …
     Top = 253
     TabOrder = 15
+    ExplicitLeft = 20
+    ExplicitTop = 253
     inherited memMessage: TRichEdit
       Left = 41
+      ExplicitLeft = 41
     end
   end
   object cboReactionType: TORComboBox
+  object cboReactionType: TORComboBox [15]
     Left = 7
     Top = 96
 …
     CharsNeedMatch = 1
   end
   object grpObsHist: TRadioGroup
+  object grpObsHist: TRadioGroup [16]
     Left = 364
     Top = 11
 …
     OnClick = grpObsHistClick
   end
   object memComments: TRichEdit
+  object memComments: TRichEdit [17]
     Left = 282
     Top = 142
 …
     OnKeyUp = memCommentsKeyUp
   end
   object lstSelectedSymptoms: TORListBox
+  object lstSelectedSymptoms: TORListBox [18]
     Left = 147
     Top = 143
 …
     OnChange = ControlChange
   end
   object ckNoKnownAllergies: TCheckBox
+  object ckNoKnownAllergies: TCheckBox [19]
     Left = 8
     Top = 18
 …
     OnClick = ckNoKnownAllergiesClick
   end
   object cboOriginator: TORComboBox
+  object cboOriginator: TORComboBox [20]
     Left = 210
     Top = 22
 …
     CharsNeedMatch = 1
   end
   object cboSymptoms: TORComboBox
+  object cboSymptoms: TORComboBox [21]
     Left = 7
     Top = 143
 …
     CharsNeedMatch = 1
   end
   object btnCurrent: TButton
+  object btnCurrent: TButton [22]
     Left = 137
     Top = 14
 …
     OnClick = btnCurrentClick
   end
   object calObservedDate: TORDateBox
+  object calObservedDate: TORDateBox [23]
     Left = 365
     Top = 62
 …
     Caption = 'Reaction Date/Time'
   end
   object cboSeverity: TORComboBox
+  object cboSeverity: TORComboBox [24]
     Left = 365
     Top = 97
 …
     CharsNeedMatch = 1
   end
   object btnRemove: TButton
+  object btnRemove: TButton [25]
     Left = 210
     Top = 224
 …
     OnClick = btnRemoveClick
   end
   object btnDateTime: TButton
+  object btnDateTime: TButton [26]
     Left = 147
     Top = 224
 …
     OnClick = btnDateTimeClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstAllergy'
+        'Status = stsDefault')
+      (
+        'Component = cboReactionType'
+        'Status = stsDefault')
+      (
+        'Component = grpObsHist'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = lstSelectedSymptoms'
+        'Status = stsDefault')
+      (
+        'Component = ckNoKnownAllergies'
+        'Status = stsDefault')
+      (
+        'Component = cboOriginator'
+        'Status = stsDefault')
+      (
+        'Component = cboSymptoms'
+        'Status = stsDefault')
+      (
+        'Component = btnCurrent'
+        'Status = stsDefault')
+      (
+        'Component = calObservedDate'
+        'Status = stsDefault')
+      (
+        'Component = cboSeverity'
+        'Status = stsDefault')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnDateTime'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODAllergy'
+        'Status = stsDefault'))
+  end
   object dlgReactionDateTime: TORDateTimeDlg
     FMDateTime = 2981202
+    FMDateTime = 2981202.000000000000000000
     DateOnly = False
     RequireTime = False

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

-              r456
+              r829
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
   Menus, ORDtTm, Buttons;
+  Menus, ORDtTm, Buttons, VA508AccessibilityManager;
 type
 …
   AStringList := TStringList.Create;
   try
     AStringList.Assign(memComments.Lines);
+    FastAssign(memComments.Lines, AStringList);
     LimitStringLength(AStringList, 74);
     memComments.Lines.Assign(AstringList);
+    QuickCopy(AstringList, memComments);
     ControlChange(Self);
   finally

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

-              r456
+              r829
     WordWrap = True
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODAuto'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls;
+  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
 inherited frmODBBank: TfrmODBBank
   Left = 272
   Top = 171
   Width = 543
   Height = 507
+  Left = 409
+  Top = 244
+  HorzScrollBar.Range = 0
+  VertScrollBar.Range = 0
   Caption = 'Blood Component and Diagnostic Test Order Form'
+  ClientHeight = 600
+  ClientWidth = 709
+  ExplicitWidth = 717
+  ExplicitHeight = 634
   PixelsPerInch = 96
   TextHeight = 13
+  object pnlComments: TPanel [0]
+    Left = 12
+    Top = 25
+    Width = 534
+    Height = 368
+    TabOrder = 5
+    Visible = False
+    object lblOrdComment: TLabel
+      Left = 25
+      Top = 3
+      Width = 87
+      Height = 13
+      Caption = 'Order Comment'
+      Font.Charset = DEFAULT_CHARSET
+      Font.Color = clWindowText
+      Font.Height = -11
+      Font.Name = 'MS Sans Serif'
+      Font.Style = [fsBold]
+      ParentFont = False
+    end
+    object btnUpdateComments: TButton
+      Left = 372
+      Top = 174
+      Width = 115
+      Height = 25
+      Caption = 'Update Comments'
+      TabOrder = 0
+      OnClick = btnUpdateCommentsClick
+    end
+    object btnCancelComment: TButton
+      Left = 279
+      Top = 174
+      Width = 75
+      Height = 25
+      Caption = 'Cancel'
+      TabOrder = 1
+      OnClick = btnCancelCommentClick
+    end
+  end
   inherited memOrder: TCaptionMemo
+    Top = 431
+    Width = 423
+    Anchors = [akLeft, akRight, akBottom]
+    Left = 0
+    Top = 399
+    Width = 449
+    Height = 59
+    Visible = False
+    ExplicitLeft = 0
+    ExplicitTop = 399
+    ExplicitWidth = 449
+    ExplicitHeight = 59
   end
+  inherited cmdAccept: TButton
+    Left = 435
+    Top = 427
+    Anchors = [akRight, akBottom]
+  end
+  inherited cmdQuit: TButton
+    Left = 435
+    Top = 454
+    Anchors = [akRight, akBottom]
+  end
+  inherited pnlMessage: TPanel
+    Left = 12
+    Top = 433
+    Width = 389
+    Anchors = [akLeft, akRight, akBottom]
+  end
+  object pnlBB: TPanel
+    Left = 4
+    Top = 4
+    Width = 525
+    Height = 413
+    TabOrder = 5
+    object pnlFull: TPanel
+      Left = 1
+      Top = 1
+      Width = 523
+      Height = 411
+      Align = alClient
+      Caption = 'pnlFull'
+      TabOrder = 0
+      object pgeProduct: TPageControl
+  object pgeProduct: TPageControl [2]
+    Left = 0
+    Top = 0
+    Width = 709
+    Height = 393
+    ActivePage = TabDiag
+    Align = alTop
+    TabOrder = 6
+    TabStop = False
+    OnChange = pgeProductChange
+    object TabInfo: TTabSheet
+      Caption = 'Patient Information'
+      ImageIndex = 3
+      object edtInfo: TCaptionRichEdit
         Left = 0
+        Top = 4
+        Width = 521
+        Height = 411
+        ActivePage = TabDiag
+        Top = 8
+        Width = 556
+        Height = 337
+        TabStop = False
+        BevelInner = bvNone
+        BevelOuter = bvNone
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'Courier New'
+        Font.Style = []
+        ParentFont = False
+        ReadOnly = True
+        ScrollBars = ssBoth
+        TabOrder = 0
+        Caption = 'Patient Info'
+      end
+    end
+    object TabDiag: TTabSheet
+      Caption = 'Blood Bank Orders'
+      ImageIndex = 2
+      object lblReqComment: TOROffsetLabel
+        Left = 298
+        Top = 25
+        Width = 108
+        Height = 37
+        HorzOffset = 2
+        Transparent = False
+        VertOffset = 2
+        WordWrap = False
+      end
+      object pnlFields: TPanel
+        Left = 0
+        Top = 163
+        Width = 701
+        Height = 99
+        Hint = 'Data entered into these fields apply to the entire order.'
+        Align = alTop
+        BevelEdges = []
+        BevelOuter = bvNone
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 2
+        object lblDiagComment: TOROffsetLabel
+          Left = 257
+          Top = 35
+          Width = 46
+          Height = 15
+          Caption = 'Comment'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          HorzOffset = 2
+          ParentFont = False
+          Transparent = False
+          VertOffset = 2
+          WordWrap = True
+        end
+        object lblUrgency: TLabel
+          Left = 8
+          Top = -2
+          Width = 44
+          Height = 13
+          Caption = 'Urgency*'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
+        end
+        object lblReason: TLabel
+          Left = 10
+          Top = 35
+          Width = 99
+          Height = 13
+          Caption = 'Reason for Request*'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
+        end
+        object lblSurgery: TLabel
+          Left = 115
+          Top = -2
+          Width = 36
+          Height = 13
+          Hint =
+            'Enter the name of the surgical procedure that this request is fo' +
+            'r.'
+          Caption = 'Surgery'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
+        end
+        object lblRequiredField: TLabel
+          Left = 10
+          Top = 75
+          Width = 122
+          Height = 13
+          Caption = '* Indicates a required field'
+        end
+        object cboUrgency: TORComboBox
+          Left = 12
+          Top = 12
+          Width = 98
+          Height = 21
+          Style = orcsDropDown
+          AutoSelect = True
+          Caption = 'Urgency'
+          Color = clWindow
+          DropDownCount = 8
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ItemHeight = 13
+          ItemTipColor = clWindow
+          ItemTipEnable = True
+          ListItemsOnly = True
+          LongList = False
+          LookupPiece = 0
+          MaxLength = 0
+          ParentFont = False
+          Pieces = '2'
+          Sorted = False
+          SynonymChars = '<>'
+          TabOrder = 0
+          OnChange = cboUrgencyChange
+          OnExit = cboUrgencyExit
+          CharsNeedMatch = 1
+        end
+        object chkConsent: TCheckBox
+          Left = 351
+          Top = 10
+          Width = 112
+          Height = 17
+          Hint = 'Informed Consent Signed On Chart?'
+          Alignment = taLeftJustify
+          Caption = 'Informed Consent?'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
+          ParentShowHint = False
+          ShowHint = True
+          TabOrder = 3
+          Visible = False
+          OnClick = chkConsentClick
+        end
+        object cboSurgery: TORComboBox
+          Left = 115
+          Top = 12
+          Width = 218
+          Height = 21
+          Style = orcsDropDown
+          AutoSelect = True
+          Caption = 'Surgery'
+          Color = clWindow
+          DropDownCount = 8
+          Enabled = False
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ItemHeight = 13
+          ItemTipColor = clWindow
+          ItemTipEnable = True
+          ListItemsOnly = False
+          LongList = False
+          LookupPiece = 0
+          MaxLength = 0
+          ParentFont = False
+          Pieces = '2'
+          Sorted = False
+          SynonymChars = '<>'
+          TabOrder = 1
+          OnChange = cboSurgeryChange
+          OnClick = cboSurgeryClick
+          CharsNeedMatch = 1
+        end
+        object cboReasons: TORComboBox
+          Left = 12
+          Top = 51
+          Width = 239
+          Height = 21
+          Style = orcsDropDown
+          AutoSelect = True
+          Color = clWindow
+          DropDownCount = 8
+          ItemHeight = 13
+          ItemTipColor = clWindow
+          ItemTipEnable = True
+          ListItemsOnly = False
+          LongList = False
+          LookupPiece = 0
+          MaxLength = 0
+          Sorted = False
+          SynonymChars = '<>'
+          TabOrder = 2
+          OnChange = cboReasonsChange
+          OnEnter = cboReasonsEnter
+          OnExit = cboReasonsExit
+          CharsNeedMatch = 1
+        end
+        object memDiagComment: TRichEdit
+          Left = 257
+          Top = 51
+          Width = 250
+          Height = 48
+          TabOrder = 4
+          OnChange = memDiagCommentChange
+        end
+      end
+      object pnlSelect: TPanel
+        Left = 0
+        Top = 35
+        Width = 701
+        Height = 128
+        Align = alTop
+        BevelEdges = []
+        BevelOuter = bvNone
+        TabOrder = 1
+        object lblTNS: TLabel
+          Left = 298
+          Top = 109
+          Width = 14
+          Height = 13
+          Caption = 'tns'
+          Color = clActiveBorder
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clMaroon
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentColor = False
+          ParentFont = False
+          Visible = False
+        end
+        object pnlDiagnosticTests: TGroupBox
+          Left = 256
+          Top = 0
+          Width = 267
+          Height = 110
+          Caption = 'Diagnostic Tests'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = [fsBold]
+          ParentFont = False
+          TabOrder = 1
+          object lblCollType: TLabel
+            Left = 13
+            Top = 33
+            Width = 77
+            Height = 13
+            Caption = 'Collection Type*'
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+          end
+          object lblCollTime: TLabel
+            Left = 12
+            Top = 70
+            Width = 104
+            Height = 13
+            Caption = 'Collection Date/Time*'
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+          end
+          object cmdImmedColl: TSpeedButton
+            Left = 148
+            Top = 89
+            Width = 21
+            Height = 11
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -16
+            Font.Name = 'MS Sans Serif'
+            Font.Style = [fsBold]
+            Glyph.Data = {
+              D6000000424DD60000000000000076000000280000000C0000000C0000000100
+              0400000000006000000000000000000000001000000010000000000000000000
+              80000080000000808000800000008000800080800000C0C0C000808080000000
+              FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
+              0000333333333333000033333333333300003333333333330000300330033003
+              0000300330033003000033333333333300003333333333330000333333333333
+              0000333333333333000033333333333300003333333333330000}
+            ParentFont = False
+            ParentShowHint = False
+            ShowHint = False
+            OnClick = cmdImmedCollClick
+          end
+          object pnlCollTimeButton: TKeyClickPanel
+            Left = 85
+            Top = 89
+            Width = 20
+            Height = 13
+            BevelOuter = bvNone
+            Caption = 'Select collection time'
+            TabOrder = 5
+            TabStop = True
+          end
+          object cboAvailTest: TORComboBox
+            Left = 13
+            Top = 13
+            Width = 234
+            Height = 21
+            Style = orcsDropDown
+            AutoSelect = True
+            Caption = 'Diagnostic Tests'
+            Color = clWindow
+            DropDownCount = 8
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ItemHeight = 13
+            ItemTipColor = clWindow
+            ItemTipEnable = True
+            ListItemsOnly = False
+            LongList = True
+            LookupPiece = 0
+            MaxLength = 0
+            ParentFont = False
+            Pieces = '2'
+            Sorted = False
+            SynonymChars = '<>'
+            TabOrder = 0
+            TabStop = True
+            OnExit = cboAvailTestExit
+            OnMouseClick = cboAvailTestSelect
+            OnNeedData = cboAvailTestNeedData
+            CharsNeedMatch = 1
+          end
+          object cboCollType: TORComboBox
+            Left = 12
+            Top = 46
+            Width = 165
+            Height = 21
+            Style = orcsDropDown
+            AutoSelect = True
+            Caption = 'Collection Type'
+            Color = clWindow
+            DropDownCount = 8
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ItemHeight = 13
+            ItemTipColor = clWindow
+            ItemTipEnable = True
+            ListItemsOnly = True
+            LongList = False
+            LookupPiece = 0
+            MaxLength = 0
+            ParentFont = False
+            Pieces = '2'
+            Sorted = False
+            SynonymChars = '<>'
+            TabOrder = 1
+            OnChange = cboCollTypeChange
+            CharsNeedMatch = 1
+          end
+          object cboCollTime: TORComboBox
+            Left = 12
+            Top = 82
+            Width = 165
+            Height = 21
+            Style = orcsDropDown
+            AutoSelect = True
+            Caption = 'Collection Date/Time'
+            Color = clWindow
+            DropDownCount = 8
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ItemHeight = 13
+            ItemTipColor = clWindow
+            ItemTipEnable = True
+            ListItemsOnly = False
+            LongList = False
+            LookupPiece = 0
+            MaxLength = 0
+            ParentFont = False
+            Pieces = '2'
+            Sorted = False
+            SynonymChars = '<>'
+            TabOrder = 2
+            OnChange = cboCollTimeChange
+            CharsNeedMatch = 1
+          end
+          object calCollTime: TORDateBox
+            Left = 12
+            Top = 82
+            Width = 165
+            Height = 21
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+            TabOrder = 3
+            OnChange = calCollTimeChange
+            DateOnly = False
+            RequireTime = False
+          end
+          object txtImmedColl: TCaptionEdit
+            Left = 12
+            Top = 82
+            Width = 165
+            Height = 21
+            Color = clBtnFace
+            ReadOnly = True
+            TabOrder = 4
+            Text = 'txtImmedColl'
+          end
+        end
+        object pnlBloodComponents: TGroupBox
+          Left = 4
+          Top = 0
+          Width = 246
+          Height = 110
+          Caption = 'Blood Components'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = [fsBold]
+          ParentFont = False
+          TabOrder = 0
+          object lblQuantity: TLabel
+            Left = 198
+            Top = 0
+            Width = 43
+            Height = 13
+            Caption = 'Quantity*'
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+          end
+          object lblModifiers: TLabel
+            Left = 7
+            Top = 33
+            Width = 42
+            Height = 13
+            Caption = 'Modifiers'
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+          end
+          object lblWanted: TLabel
+            Left = 7
+            Top = 70
+            Width = 96
+            Height = 13
+            Caption = 'Date/Time Wanted*'
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+          end
+          object cboAvailComp: TORComboBox
+            Left = 11
+            Top = 13
+            Width = 181
+            Height = 21
+            Style = orcsDropDown
+            AutoSelect = True
+            Caption = 'Blood Components'
+            Color = clWindow
+            DropDownCount = 8
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ItemHeight = 13
+            ItemTipColor = clWindow
+            ItemTipEnable = True
+            ListItemsOnly = False
+            LongList = False
+            LookupPiece = 0
+            MaxLength = 0
+            ParentFont = False
+            Pieces = '2'
+            Sorted = False
+            SynonymChars = '<>'
+            TabOrder = 0
+            TabStop = True
+            OnChange = cboAvailCompChange
+            OnExit = cboAvailCompExit
+            OnMouseClick = cboAvailCompSelect
+            OnNeedData = cboAvailCompNeedData
+            CharsNeedMatch = 1
+          end
+          object tQuantity: TEdit
+            Left = 198
+            Top = 13
+            Width = 25
+            Height = 21
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+            TabOrder = 1
+            OnChange = tQuantityChange
+            OnClick = tQuantityClick
+            OnEnter = tQuantityEnter
+          end
+          object cboModifiers: TORComboBox
+            Left = 11
+            Top = 46
+            Width = 133
+            Height = 21
+            Style = orcsDropDown
+            AutoSelect = True
+            Caption = 'Modifier'
+            Color = clWindow
+            DropDownCount = 8
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ItemHeight = 13
+            ItemTipColor = clWindow
+            ItemTipEnable = True
+            ListItemsOnly = True
+            LongList = False
+            LookupPiece = 0
+            MaxLength = 0
+            ParentFont = False
+            Sorted = False
+            SynonymChars = '<>'
+            TabOrder = 2
+            OnChange = cboModifiersChange
+            CharsNeedMatch = 1
+          end
+          object calWantTime: TORDateBox
+            Left = 11
+            Top = 82
+            Width = 149
+            Height = 21
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'MS Sans Serif'
+            Font.Style = []
+            ParentFont = False
+            TabOrder = 3
+            OnChange = calWantTimeChange
+            DateOnly = False
+            RequireTime = False
+          end
+        end
+      end
+      object GroupBox1: TGroupBox
+        Left = 0
+        Top = 0
+        Width = 701
+        Height = 35
+        Align = alTop
+        Caption = ' Personal Quick Orders'
         Font.Charset = DEFAULT_CHARSET
         Font.Color = clWindowText
 …
         Font.Name = 'MS Sans Serif'
         Font.Style = []
-        Images = ImageList1
         ParentFont = False
-        TabIndex = 1
         TabOrder = 0
+        OnChange = pgeProductChange
+        object tabInfo: TTabSheet
+          Caption = 'Patient Information'
+          ImageIndex = 3
+          object edtInfo: TCaptionRichEdit
+            Left = 0
+            Top = 8
+            Width = 513
+            Height = 369
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'Courier New'
+            Font.Style = []
+            ParentFont = False
+            ReadOnly = True
+            ScrollBars = ssBoth
+            TabOrder = 0
+            Caption = 'Patient Info'
+          end
+        end
+        object TabDiag: TTabSheet
+          Caption = 'Orders'
+          ImageIndex = 2
+          object lblReqComment: TOROffsetLabel
+            Left = 300
+            Top = 25
+            Width = 104
+            Height = 33
+            HorzOffset = 2
+            Transparent = False
+            VertOffset = 2
+            WordWrap = False
+          end
+          object pnlFields: TPanel
+            Left = 0
+            Top = 87
+            Width = 513
+            Height = 162
+            Hint = 'Data entered into these fields apply to the entire order.'
+            ParentShowHint = False
+            ShowHint = True
+            TabOrder = 0
+            object lblDiagComment: TOROffsetLabel
+              Left = 8
+              Top = 114
+              Width = 46
+              Height = 15
+              Caption = 'Comment'
+              HorzOffset = 2
+              Transparent = False
+              VertOffset = 2
+              WordWrap = True
+            end
+            object lblUrgency: TLabel
+              Left = 8
+              Top = 80
+              Width = 40
+              Height = 13
+              Caption = 'Urgency'
+            end
+            object lblCollType: TLabel
+              Left = 8
+              Top = 41
+              Width = 73
+              Height = 13
+              Caption = 'Collection Type'
+            end
+            object lblPreparation: TLabel
+              Left = 352
+              Top = 41
+              Width = 54
+              Height = 13
+              Caption = 'Preparation'
+              Enabled = False
+              Visible = False
+            end
+            object lblWanted: TLabel
+              Left = 352
+              Top = 5
+              Width = 90
+              Height = 13
+              Caption = 'Date Time Wanted'
+            end
+            object lblReason: TLabel
+              Left = 332
+              Top = 114
+              Width = 95
+              Height = 13
+              Caption = 'Reason for Request'
+            end
+            object lblSurgery: TLabel
+              Left = 352
+              Top = 80
+              Width = 36
+              Height = 13
+              Hint =
+                'Enter the name of the surgical procedure that this request is fo' +
+                'r.'
+              Caption = 'Surgery'
+            end
+            object lblCollTime: TLabel
+              Left = 8
+              Top = 5
+              Width = 100
+              Height = 13
+              Caption = 'Collection Date/Time'
+            end
+            object cmdImmedColl: TSpeedButton
+              Left = 132
+              Top = 21
+              Width = 24
+              Height = 17
+              Font.Charset = DEFAULT_CHARSET
+              Font.Color = clWindowText
+              Font.Height = -16
+              Font.Name = 'MS Sans Serif'
+              Font.Style = [fsBold]
+              Glyph.Data = {
+                D6000000424DD60000000000000076000000280000000C0000000C0000000100
+                0400000000006000000000000000000000001000000010000000000000000000
+                80000080000000808000800000008000800080800000C0C0C000808080000000
+                FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
+                0000333333333333000033333333333300003333333333330000300330033003
+                0000300330033003000033333333333300003333333333330000333333333333
+                0000333333333333000033333333333300003333333333330000}
+              ParentFont = False
+              ParentShowHint = False
+              ShowHint = False
+              OnClick = cmdImmedCollClick
+            end
+            object txtDiagComment: TCaptionEdit
+              Left = 8
+              Top = 132
+              Width = 293
+              Height = 21
+              MaxLength = 240
+              TabOrder = 6
+              OnChange = txtDiagCommentChange
+            end
+            object cboUrgency: TORComboBox
+              Left = 8
+              Top = 96
+              Width = 112
+              Height = 21
+              Style = orcsDropDown
+              AutoSelect = True
+              Caption = 'Urgency'
+              Color = clWindow
+              DropDownCount = 8
+              ItemHeight = 13
+              ItemTipColor = clWindow
+              ItemTipEnable = True
+              ListItemsOnly = True
+              LongList = False
+              LookupPiece = 0
+              MaxLength = 0
+              Pieces = '2'
+              Sorted = False
+              SynonymChars = '<>'
+              TabOrder = 5
+              OnChange = cboUrgencyChange
+              CharsNeedMatch = 1
+            end
+            object cboCollType: TORComboBox
+              Left = 8
+              Top = 57
+              Width = 149
+              Height = 21
+              Style = orcsDropDown
+              AutoSelect = True
+              Caption = 'Collection Type'
+              Color = clWindow
+              DropDownCount = 8
+              ItemHeight = 13
+              ItemTipColor = clWindow
+              ItemTipEnable = True
+              ListItemsOnly = True
+              LongList = False
+              LookupPiece = 0
+              MaxLength = 0
+              Pieces = '2'
+              Sorted = False
+              SynonymChars = '<>'
+              TabOrder = 4
+              OnChange = cboCollTypeChange
+              CharsNeedMatch = 1
+            end
+            object chkConsent: TCheckBox
+              Left = 192
+              Top = 21
+              Width = 112
+              Height = 17
+              Hint = 'Informed Consent Signed On Chart?'
+              Alignment = taLeftJustify
+              Caption = 'Informed Consent?'
+              ParentShowHint = False
+              ShowHint = True
+              TabOrder = 11
+              OnClick = chkConsentClick
+            end
+            object calWantTime: TORDateBox
+              Left = 352
+              Top = 17
+              Width = 149
+              Height = 21
+              TabOrder = 7
+              OnChange = calWantTimeChange
+              DateOnly = False
+              RequireTime = False
+            end
+            object tReason: TEdit
+              Left = 332
+              Top = 132
+              Width = 169
+              Height = 21
+              MaxLength = 80
+              TabOrder = 10
+              OnChange = tReasonChange
+            end
+            object cboSurgery: TORComboBox
+              Left = 352
+              Top = 92
+              Width = 149
+              Height = 21
+              Style = orcsDropDown
+              AutoSelect = True
+              Caption = 'Surgery'
+              Color = clWindow
+              DropDownCount = 8
+              ItemHeight = 13
+              ItemTipColor = clWindow
+              ItemTipEnable = True
+              ListItemsOnly = False
+              LongList = False
+              LookupPiece = 0
+              MaxLength = 0
+              Pieces = '2'
+              Sorted = False
+              SynonymChars = '<>'
+              TabOrder = 9
+              OnChange = cboSurgeryChange
+              CharsNeedMatch = 1
+            end
+            object txtImmedColl: TCaptionEdit
+              Left = 12
+              Top = 17
+              Width = 145
+              Height = 21
+              Color = clBtnFace
+              ReadOnly = True
+              TabOrder = 2
+              Text = 'txtImmedColl'
+            end
+            object cboCollTime: TORComboBox
+              Left = 8
+              Top = 17
+              Width = 149
+              Height = 21
+              Style = orcsDropDown
+              AutoSelect = True
+              Caption = 'Collection Date/Time'
+              Color = clWindow
+              DropDownCount = 8
+              ItemHeight = 13
+              ItemTipColor = clWindow
+              ItemTipEnable = True
+              ListItemsOnly = False
+              LongList = False
+              LookupPiece = 0
+              MaxLength = 0
+              Pieces = '2'
+              Sorted = False
+              SynonymChars = '<>'
+              TabOrder = 0
+              CharsNeedMatch = 1
+            end
+            object pnlCollTimeButton: TKeyClickPanel
+              Left = 137
+              Top = 19
+              Width = 20
+              Height = 19
+              BevelOuter = bvNone
+              Caption = 'Select collection time'
+              TabOrder = 3
+              TabStop = True
+            end
+            object calCollTime: TORDateBox
+              Left = 8
+              Top = 17
+              Width = 149
+              Height = 21
+              TabOrder = 1
+              OnChange = calCollTimeChange
+              DateOnly = False
+              RequireTime = False
+            end
+            object cboPreparation: TORComboBox
+              Left = 352
+              Top = 56
+              Width = 149
+              Height = 21
+              Style = orcsDropDown
+              AutoSelect = True
+              Color = clWindow
+              DropDownCount = 8
+              Enabled = False
+              Items.Strings = (
+                'I^Immediate'
+                'H^Hold')
+              ItemHeight = 13
+              ItemTipColor = clWindow
+              ItemTipEnable = True
+              ListItemsOnly = False
+              LongList = False
+              LookupPiece = 0
+              MaxLength = 0
+              Pieces = '2'
+              Sorted = False
+              SynonymChars = '<>'
+              TabOrder = 8
+              Visible = False
+              OnChange = cboPreparationChange
+              CharsNeedMatch = 1
+            end
+          end
+          object pnlTop: TPanel
+            Left = 0
+            Top = 1
+            Width = 513
+            Height = 84
+            TabOrder = 1
+            object pnlSelect: TPanel
+              Left = 5
+              Top = 1
+              Width = 511
+              Height = 76
+              TabOrder = 0
+              object pnlDiagTests: TGroupBox
+                Left = 8
+                Top = 0
+                Width = 245
+                Height = 73
+                Caption = 'Diagnostic Tests'
+                Font.Charset = DEFAULT_CHARSET
+                Font.Color = clWindowText
+                Font.Height = -11
+                Font.Name = 'MS Sans Serif'
+                Font.Style = []
+                ParentFont = False
+                TabOrder = 0
+                object lblTNS: TLabel
+                  Left = 8
+                  Top = 52
+                  Width = 3
+                  Height = 13
+                  Color = clActiveBorder
+                  Font.Charset = DEFAULT_CHARSET
+                  Font.Color = clMaroon
+                  Font.Height = -11
+                  Font.Name = 'MS Sans Serif'
+                  Font.Style = []
+                  ParentColor = False
+                  ParentFont = False
+                end
+                object cboAvailTest: TORComboBox
+                  Left = 7
+                  Top = 18
+                  Width = 226
+                  Height = 21
+                  Style = orcsDropDown
+                  AutoSelect = True
+                  Caption = 'Available Lab Tests'
+                  Color = clWindow
+                  DropDownCount = 8
+                  ItemHeight = 13
+                  ItemTipColor = clWindow
+                  ItemTipEnable = True
+                  ListItemsOnly = True
+                  LongList = True
+                  LookupPiece = 0
+                  MaxLength = 0
+                  Pieces = '2'
+                  Sorted = False
+                  SynonymChars = '<>'
+                  TabOrder = 0
+                  OnClick = cboAvailTestSelect
+                  OnExit = cboAvailTestExit
+                  OnNeedData = cboAvailTestNeedData
+                  CharsNeedMatch = 1
+                end
+              end
+              object pnlBloodComponents: TGroupBox
+                Left = 252
+                Top = 0
+                Width = 253
+                Height = 73
+                Caption = 'Blood Components'
+                TabOrder = 1
+                object lblQuantity: TLabel
+                  Left = 198
+                  Top = 0
+                  Width = 39
+                  Height = 13
+                  Caption = 'Quantity'
+                end
+                object lblModifiers: TLabel
+                  Left = 10
+                  Top = 48
+                  Width = 42
+                  Height = 13
+                  Caption = 'Modifiers'
+                end
+                object cboAvailComp: TORComboBox
+                  Left = 8
+                  Top = 18
+                  Width = 181
+                  Height = 21
+                  Style = orcsDropDown
+                  AutoSelect = True
+                  Caption = 'Available Lab Tests'
+                  Color = clWindow
+                  DropDownCount = 8
+                  ItemHeight = 13
+                  ItemTipColor = clWindow
+                  ItemTipEnable = True
+                  ListItemsOnly = True
+                  LongList = True
+                  LookupPiece = 0
+                  MaxLength = 0
+                  Pieces = '2'
+                  Sorted = False
+                  SynonymChars = '<>'
+                  TabOrder = 0
+                  OnClick = cboAvailCompSelect
+                  OnExit = cboAvailCompExit
+                  OnNeedData = cboAvailCompNeedData
+                  CharsNeedMatch = 1
+                end
+                object tQuantity: TEdit
+                  Left = 200
+                  Top = 16
+                  Width = 25
+                  Height = 21
+                  TabOrder = 1
+                  Text = '0'
+                end
+                object upQuantity: TUpDown
+                  Left = 225
+                  Top = 16
+                  Width = 15
+                  Height = 21
+                  Associate = tQuantity
+                  Min = 0
+                  Position = 0
+                  TabOrder = 2
+                  Wrap = False
+                end
+                object cboModifiers: TORComboBox
+                  Left = 56
+                  Top = 44
+                  Width = 133
+                  Height = 21
+                  Style = orcsDropDown
+                  AutoSelect = True
+                  Caption = 'Modifier'
+                  Color = clWindow
+                  DropDownCount = 8
+                  ItemHeight = 13
+                  ItemTipColor = clWindow
+                  ItemTipEnable = True
+                  ListItemsOnly = True
+                  LongList = False
+                  LookupPiece = 0
+                  MaxLength = 0
+                  Sorted = False
+                  SynonymChars = '<>'
+                  TabOrder = 3
+                  CharsNeedMatch = 1
+                end
+              end
+            end
+          end
+        end
+        object TabResults: TTabSheet
+          Caption = 'Lab Results'
+          Enabled = False
+          object edtResults: TCaptionRichEdit
+            Left = 0
+            Top = 8
+            Width = 513
+            Height = 369
+            Font.Charset = DEFAULT_CHARSET
+            Font.Color = clWindowText
+            Font.Height = -11
+            Font.Name = 'Courier New'
+            Font.Style = []
+            ParentFont = False
+            TabOrder = 0
+          end
+        object cboQuick: TORComboBox
+          Left = 15
+          Top = 11
+          Width = 488
+          Height = 21
+          Style = orcsDropDown
+          AutoSelect = True
+          Color = clWindow
+          DropDownCount = 8
+          ItemHeight = 13
+          ItemTipColor = clWindow
+          ItemTipEnable = True
+          ListItemsOnly = False
+          LongList = True
+          LookupPiece = 0
+          MaxLength = 0
+          Pieces = '2'
+          Sorted = False
+          SynonymChars = '<>'
+          TabOrder = 0
+          OnClick = cboQuickClick
+          CharsNeedMatch = 1
         end
       end
       object pnlSelectedTests: TGroupBox
+        Left = 4
+        Top = 292
+        Width = 518
+        Height = 117
+        Left = 0
+        Top = 262
+        Width = 701
+        Height = 112
+        Align = alTop
         Caption = 'Selected Components and Tests'
+        TabOrder = 1
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'MS Sans Serif'
+        Font.Style = [fsBold]
+        ParentFont = False
+        TabOrder = 3
         Visible = False
-        object btnAddTests: TORAlignSpeedButton
-          Left = 426
-          Top = 17
-          Width = 75
-          Height = 21
-          Caption = 'Add'
-          Font.Charset = DEFAULT_CHARSET
-          Font.Color = clWindowText
-          Font.Height = -11
-          Font.Name = 'MS Sans Serif'
-          Font.Style = []
-          Glyph.Data = {
-            F6000000424DF600000000000000760000002800000010000000100000000100
-            0400000000008000000000000000000000001000000000000000000000000000
-            8000008000000080800080000000800080008080000080808000C0C0C0000000
-            FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
-            3333333333333333333333333333333333333333333003333333333333300333
-            3333333333300333333333333330033333333330000000000333333000000000
-            0333333333300333333333333330033333333333333003333333333333300333
-            3333333333333333333333333333333333333333333333333333}
-          ParentFont = False
-          OnClick = btnAddTestsClick
-        end
         object lvSelectionList: TCaptionListView
+          Left = 4
+          Top = 16
+          Width = 409
+          Height = 93
+          Left = 5
+          Top = 12
+          Width = 417
+          Height = 91
+          Color = clBtnFace
           Columns = <
             item
 …
             end
             item
+              Caption = 'ID'
+              Caption = 'ModifierItemIndex'
+              Width = 0
+            end
+            item
+              Caption = 'TestIEN'
               Width = 0
             end>
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = [fsBold]
+          ReadOnly = True
           RowSelect = True
+          ParentFont = False
           TabOrder = 0
+          TabStop = False
           ViewStyle = vsReport
+          OnClick = lvSelectionListClick
           Caption = 'lvSelectionList'
         end
         object btnRemove: TButton
           Left = 426
           Top = 42
+          Left = 428
+          Top = 37
           Width = 75
           Height = 21
           Caption = 'Remove'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
           TabOrder = 1
           OnClick = btnRemoveClick
         end
         object btnRemoveAll: TButton
           Left = 426
           Top = 68
+          Left = 428
+          Top = 64
           Width = 75
           Height = 21
           Caption = 'Remove All'
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = []
+          ParentFont = False
           TabOrder = 2
           OnClick = btnRemoveAllClick
         end
+      end
+    end
+    object TabResults: TTabSheet
+      Caption = 'Lab Results'
+      object edtResults: TCaptionRichEdit
+        Left = -4
+        Top = 57
+        Width = 517
+        Height = 290
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'Courier New'
+        Font.Style = []
+        ParentFont = False
+        TabOrder = 0
       end
     end
   end
+  inherited cmdAccept: TButton
+    Left = 455
+    Top = 399
+    TabOrder = 2
+    Visible = False
+    ExplicitLeft = 455
+    ExplicitTop = 399
+  end
+  inherited cmdQuit: TButton
+    Left = 455
+    Top = 426
+    Width = 52
+    TabOrder = 3
+    ExplicitLeft = 455
+    ExplicitTop = 426
+    ExplicitWidth = 52
+  end
+  inherited pnlMessage: TPanel
+    Left = 8
+    Top = 409
+    Width = 409
+    Height = 49
+    TabOrder = 1
+    ExplicitLeft = 8
+    ExplicitTop = 409
+    ExplicitWidth = 409
+    ExplicitHeight = 49
+    inherited memMessage: TRichEdit
+      Left = 42
+      Top = 5
+      Width = 360
+      ExplicitLeft = 42
+      ExplicitTop = 5
+      ExplicitWidth = 360
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODBBank'
+        'Status = stsDefault')
+      (
+        'Component = pnlComments'
+        'Status = stsDefault')
+      (
+        'Component = btnUpdateComments'
+        'Status = stsDefault')
+      (
+        'Component = btnCancelComment'
+        'Status = stsDefault')
+      (
+        'Component = pgeProduct'
+        'Status = stsDefault')
+      (
+        'Component = TabInfo'
+        'Status = stsDefault')
+      (
+        'Component = edtInfo'
+        'Status = stsDefault')
+      (
+        'Component = TabDiag'
+        'Status = stsDefault')
+      (
+        'Component = TabResults'
+        'Status = stsDefault')
+      (
+        'Component = edtResults'
+        'Status = stsDefault')
+      (
+        'Component = pnlFields'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = chkConsent'
+        'Status = stsDefault')
+      (
+        'Component = cboSurgery'
+        'Status = stsDefault')
+      (
+        'Component = pnlSelect'
+        'Status = stsDefault')
+      (
+        'Component = pnlDiagnosticTests'
+        'Status = stsDefault')
+      (
+        'Component = cboAvailTest'
+        'Status = stsDefault')
+      (
+        'Component = pnlBloodComponents'
+        'Status = stsDefault')
+      (
+        'Component = cboAvailComp'
+        'Status = stsDefault')
+      (
+        'Component = tQuantity'
+        'Status = stsDefault')
+      (
+        'Component = cboModifiers'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox1'
+        'Status = stsDefault')
+      (
+        'Component = cboQuick'
+        'Status = stsDefault')
+      (
+        'Component = pnlSelectedTests'
+        'Status = stsDefault')
+      (
+        'Component = lvSelectionList'
+        'Status = stsDefault')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnRemoveAll'
+        'Status = stsDefault')
+      (
+        'Component = cboReasons'
+        'Text = Applies to entire order'
+        'Status = stsOK')
+      (
+        'Component = memDiagComment'
+        'Status = stsDefault')
+      (
+        'Component = cboCollType'
+        'Status = stsDefault')
+      (
+        'Component = cboCollTime'
+        'Status = stsDefault')
+      (
+        'Component = calWantTime'
+        'Status = stsDefault')
+      (
+        'Component = calCollTime'
+        'Status = stsDefault')
+      (
+        'Component = txtImmedColl'
+        'Status = stsDefault')
+      (
+        'Component = pnlCollTimeButton'
+        'Status = stsDefault'))
+  end
   object dlgLabCollTime: TORDateTimeDlg
     FMDateTime = 2980923
+    FMDateTime = 2980923.000000000000000000
     DateOnly = False
     RequireTime = True
     Left = 435
     Top = 12
+    Top = 72
   end
   object ORWanted: TORDateTimeDlg
     FMDateTime = 2980923
+    FMDateTime = 2980923.000000000000000000
     DateOnly = False
     RequireTime = True
+    Left = 335
+    Top = 12
+  end
+  object ImageList1: TImageList
+    Left = 388
+    Top = 12
+    Bitmap = {
+C010104000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      0000000000003600000028000000400000003000000001002000000000000030
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000A0A0A002F2F2F00222222000C0C
+C0015151500262626002A2A2A001F1F1F0001010100171717001C1C1C001313
+B1B1B00181818001616160000000000CFCFD000D9D9D900E2E2E200E9EA
+      EA00F1F1F300FAFDF600FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0017171700A2A2A200FFFFFF00FAFA
+      FA00A7B8110045BC3B0032C32100E0ED4B00DEF65200D8E34600B0B81800C4CC
+B00E3F45100D0F14900D5E34500AFA31D000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000700040005D0250006D6320006D8
+F9070012FC0E0008FC000008FB0C000311ED000000FD00100ADF000000
+      110000000000000000000000000002020200DDDEDF00E5E5E600E8E8ED009896
+      A6004B4992004240BC003734BE003734C4003F3DCB005250D50079779700FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0056151700B2A09F00FAFAFA00F5F5
+      F500BD9E070036E1370096D53200DEEE4300E8E73F00D5EE4600B99D1000BEB7
+E9E74200C7D12300AFD73B00D28229000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000600040001FF000001FF000001FF
+FF000001FF000001FF000000FF05000EC4360004ED000004E119000000
+      270000000000000000000000000002020200E4E4E500E9EAE80063606B005C59
+      CB00544FCD004E48CD004944BC004540C800433FCD004A48D3006060DE009695
+      BD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BF191800EDA6A300FCFCFC00FCFC
+      FC00A4A103005ECF770080D32A0046BD140081DD36009CE03500F2F54B007FCF
+FCE2900EFF55400BAA81B00C78F20000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000500030001FF000001FF000001FF
+FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
+      000000000000000000000000000002020200E9EAE7009D99BF007773EC007A75
+      F6007C75F700756EF4006D66E800635DDA00514DD0004A47D3005451D8006E6C
+      DB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CF292800F2ABA800FCFCFC00FCFC
+      FC00C2B91600CFC8250066C61B0036DB340021AB0600DCEF4C00F0F8510047BB
+BE1900F4F34F00C2911700B7B415000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000801060001FF000001FF000001FF
+FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
+      000000000000000000000000000002020200EBEBED00A9A6D7009691F6009B95
+      FB00AAA3FF00A79EFF009B93FF00837AF2006761D5005651C3005753D6006C6A
+      DE00FDFEFF00FFFFFF00FFFFFF00FFFFFF00D57C2C00F2CAAE00FEFEFE00FCFC
+      FC00F4FC5500E4F14F0057C41A003EE33C0043BD1500C0E94000F2F14900B0DD
+A000DB60C00EFF24800D0F04500E1AD7E000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000500030001FF000001FF000001FF
+FF000001FF000001FF000001FF000001FF000010FD020005FF05000500
+      000000000000000000000000000002020200EDEDEE00EAEAEE00ABA5F600BAB5
+      FB00E9E6FC00FFFFFF00D4D1FF009A92FD007770E400615CCB005F5BD400726F
+      D900FFFFFF00FFFFFF00FFFFFF00FFFFFF00CFCF2900F0ECA500FCFCFC00FCFC
+      FC0042F0450019B215001CBC160017B70B0079D42B0025D52A00E9F64E004BC0
+FC31700D9F34C003FB90F00FFFFF3000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000D060B0001FF000000EB110000FF
+B000DFE070001FF000001FF000001FF000000EE0F000AFD080006F806000802
+      030000000000000000000000000002020200EDEDEE00F1F1F200EDECEF00B9B3
+      F800C1BBFC00D1D0FE00BEB6FF00968DFF007973EC006863D4006B67CA008381
+      B800FFFFFF00FFFFFF00FFFFFF00FFFFFF009ED52A00D5EFA300FCFCFC00FCFC
+      FC005DE8610050F57C009FDE3A003FE33E001EBA150027C017008AD92E003EC3
+F0026BB14007FDE3A0037BB1000FFF2FA000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000500030001FF000000DC1D0001FF
+FF000001FF000001FF000001FF00000BFF070010FD020001FF00000500
+      000000000000000000000000000002020200EBEBEC00EFEFEF00F2F1F300F4F3
+      F300ABA7F100A39DF7009E8EFE00887AFF006D69E2006965CF007471C500E9EB
+      F900FFFFFF00FFFFFF00FFFFFF00FFFFFF001DBF2A00A2E79E00FCFCFC00FCFC
+      FC00BAAA670078EBD80034DE48004FF6870034D6360086CB2E00A1E032009FE2
+D931007DF96900E2F2F900FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000801060001FF000000E1220001FF
+FF000001FF000000FE000001FF000009FF070010FD020001FF00000500
+      000000000000000000000000000002020200E5E5E500E9E9EA00ECECED00EFEF
+      F000EFEEF1008A85E200736EF600635EF700615EC9006B68B000BCBCDC00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050FB9F00B0FFD800F9F9F900FBFB
+      FB00FCFCFC00FAFAFA006EB247002FFF860017AD13009BD53A000FB0000025C1
+DCE2D100FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000C00030001FF000000E1220001FF
+FF000001FF00000EFC000007FC02000AE4210010FF000002FF00000901
+      010000000000000000000000000002020200DBDBDB00E0E0E100E5E5E600E8E8
+      E900EAE9EA00E7EBE6005F5EDE005858EF005F60A2008989B300FCFBFD00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0042DBEA00ACECF700FFFFFF00FBFB
+      FB00FCFCFC00FDFDFD00FFE9FF00EEDDC200127DBA0035D73C0043C70800E2C5
+      A000FFFEFF00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000500030003FF000000DD2A0001FF
+FF000002FD020005FF000000FF000000180A0004FF07001ECB16000002
+      000000000000000000000000000002020200C9C9CA00D0D0D100D7D8D800DCDC
+      DD00DEDFE000E0E1E100E1E0E0005353E3005A5D7500EDF0F100F6F9F900FAFB
+      FB00FDFDFE00FEFEFE00FFFFFF00FFFFFF006393E500BAD2EE00FCFCFC00FCFC
+      FC00FCFCFC00FCFCFC00FCFCFC00FFFFF800DE39D600167EB90044D8EE00F5FA
+      FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000902070000FF000000DD2A0001FF
+FF00000DF6060015751A0007FF00000806060003FF0000001000000005
+      000000000000000000000000000002020200B7B8B800BCBDBD00C4C5C500CCCD
+      CD00D1D1D100D4D5D500D7D7D800C6C5D0004D4EA900E5E6E300EDEEED00F3F4
+      F400F8F8F800FBFBFB00FCFCFC00FCFDFD00DC3BD300F0AAF000FDFDFD00FCFC
+      FC00FCFCFC00FCFCFC00FCFCFC00F1F2FF00C820B9001EA8B4005BCAFA00EAEC
+      FF00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000500030000FF000000DD2A0001FF
+FF00000DB0000020001C0000F500001300140025000D00000200000401
+      000000000000000000000000000002020200A5A5A600A5A5A600ACADAD00B5B5
+      B500BDBCBD0000000000C6C7C800CBC8CB00B1B0C400BDBDC100DDDDDB00E4E4
+      E400EAEAEA00EEEFEF00F1F2F200F2F3F300E03FD700F3ADF300F8F8F800FCFC
+      FC00FCFCFC00FCFCFC00FCFCFC00CCC7C600AD68C900515ADA0035C83600B185
+FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000A03080000FF000000D7240001FF
+      0000000600001D3F160000010000219024000000070000000000020103000000
+      0000000000000000000000000000020202008F8F8F008F8F8F008F8F8F009596
+D9E9E00A5A5A600AAABAB00B0B0B100B6B6B700BAB8BA009C9DA100C5C6
+      C700CDCECE00D2D2D300D5D5D600D6D6D600A71BC200DE9FE500FCFCFC00FCFC
+      FC00FCFCFC00FCFCFC00FCFCFC00DA971200AFB91300CEA42100E86B2100677E
+      AE00FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000903000014F70600130830000BED
+      00000200010008000A0003020400000700000000070000000000020103000000
+      0000000000000000000000000000020202007C7D7D007C7D7D007C7D7D007C7D
+D007E7E7E00848585008B8B8C0091919200979798009C9D9D00A1A1A000A3A4
+      A200A8A9A900AEAEAE00B1B1B100B2B2B3003A2EFF00B0ADFD00FEFEFE00FFFF
+      FF00FCFCFC00FCFCFC00FFFCFF00AAD83100FAF8FE00511C1900FAE7F000EDD8
+      E000FCFCFC00FCFCFC00FCFCFC00FCFCFC000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000000013131300161616000A0D11000000
+      0000030408000101010001010100010101000000030001010100000100000101
+      0100010101000101010001010100020202006B6B6C006B6B6C006B6B6C006B6B
+C006B6B6C006B6B6C006B6B6C006D6D6E0072727200767677007A7B7B007E7E
+E00818182008484840087878700888889000C04F10099A0F000F7F7F700FBFB
+      FB00FCFCFC00FCFCFC00FDFFFF00FFF7FF0057262400CE5C45009A252200B8C9
+      C600FCFCFC00FCFCFC00FCFCFC00FCFCFC00424D3E000000000000003E000000
+      2800000040000000300000000100010000000000800100000000000000000000
+      000000000000000000000000FFFFFF0000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      00000000000000000000000000000000FFFF000000000000FFFF000000000000
+      FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000
+      FFFF000000000000FFFF000000000000FFFF000000000000FFFF000000000000
+      FFFF000000000000FFFF000000000000FFFF000004000000FFFF000000000000
+      FFFF000000000000FFFF00000000000000000000000000000000000000000000
+      000000000000}
+    Left = 343
+    Top = 72
   end
 end

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

-              r456
+              r829
 unit fODBBank;
 interface
 …
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
   ORDtTm, Buttons, Menus, ImgList;
+  ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
 type
   TfrmODBBank = class(TfrmODBase)
+    pnlBB: TPanel;
+    pnlFull: TPanel;
+    dlgLabCollTime: TORDateTimeDlg;
+    ORWanted: TORDateTimeDlg;
+    pnlComments: TPanel;
+    btnUpdateComments: TButton;
+    btnCancelComment: TButton;
+    lblOrdComment: TLabel;
     pgeProduct: TPageControl;
     tabInfo: TTabSheet;
+    TabInfo: TTabSheet;
     edtInfo: TCaptionRichEdit;
     TabDiag: TTabSheet;
     lblReqComment: TOROffsetLabel;
+    TabResults: TTabSheet;
+    edtResults: TCaptionRichEdit;
     pnlFields: TPanel;
-    dlgLabCollTime: TORDateTimeDlg;
-    ORWanted: TORDateTimeDlg;
     lblDiagComment: TOROffsetLabel;
-    txtDiagComment: TCaptionEdit;
-    pnlSelectedTests: TGroupBox;
-    lvSelectionList: TCaptionListView;
     lblUrgency: TLabel;
+    lblReason: TLabel;
+    lblSurgery: TLabel;
     cboUrgency: TORComboBox;
-    lblCollType: TLabel;
-    cboCollType: TORComboBox;
     chkConsent: TCheckBox;
-    lblPreparation: TLabel;
-    calWantTime: TORDateBox;
-    lblWanted: TLabel;
-    tReason: TEdit;
-    lblReason: TLabel;
     cboSurgery: TORComboBox;
-    lblSurgery: TLabel;
-    txtImmedColl: TCaptionEdit;
-    cboCollTime: TORComboBox;
-    lblCollTime: TLabel;
-    cmdImmedColl: TSpeedButton;
-    pnlCollTimeButton: TKeyClickPanel;
-    calCollTime: TORDateBox;
-    cboPreparation: TORComboBox;
-    btnRemove: TButton;
-    btnRemoveAll: TButton;
-    pnlTop: TPanel;
     pnlSelect: TPanel;
     pnlDiagTests: TGroupBox;
+    pnlDiagnosticTests: TGroupBox;
     cboAvailTest: TORComboBox;
     pnlBloodComponents: TGroupBox;
     lblQuantity: TLabel;
+    lblModifiers: TLabel;
     cboAvailComp: TORComboBox;
     tQuantity: TEdit;
-    upQuantity: TUpDown;
-    TabResults: TTabSheet;
-    edtResults: TCaptionRichEdit;
-    btnAddTests: TORAlignSpeedButton;
-    ImageList1: TImageList;
-    lblModifiers: TLabel;
     cboModifiers: TORComboBox;
+    GroupBox1: TGroupBox;
+    cboQuick: TORComboBox;
+    pnlSelectedTests: TGroupBox;
+    lvSelectionList: TCaptionListView;
+    btnRemove: TButton;
+    btnRemoveAll: TButton;
+    cboReasons: TORComboBox;
+    lblRequiredField: TLabel;
+    memDiagComment: TRichEdit;
+    lblCollType: TLabel;
+    cboCollType: TORComboBox;
+    lblCollTime: TLabel;
+    cboCollTime: TORComboBox;
+    calWantTime: TORDateBox;
+    lblWanted: TLabel;
+    calCollTime: TORDateBox;
+    txtImmedColl: TCaptionEdit;
+    pnlCollTimeButton: TKeyClickPanel;
+    cmdImmedColl: TSpeedButton;
     lblTNS: TLabel;
     procedure FormCreate(Sender: TObject);
 …
     procedure pgeProductChange(Sender: TObject);
     procedure cboCollTypeChange(Sender: TObject);
-    procedure btnAddTestsClick(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure btnRemoveClick(Sender: TObject);
 …
     procedure chkConsentClick(Sender: TObject);
     procedure cboUrgencyChange(Sender: TObject);
-    procedure txtDiagCommentChange(Sender: TObject);
-    procedure cboPreparationChange(Sender: TObject);
     procedure cboSurgeryChange(Sender: TObject);
-    procedure tReasonChange(Sender: TObject);
     procedure calCollTimeChange(Sender: TObject);
+    procedure cboQuickClick(Sender: TObject);
+    procedure tQuantityEnter(Sender: TObject);
+    procedure btnUpdateCommentsClick(Sender: TObject);
+    procedure btnCancelCommentClick(Sender: TObject);
+    procedure cboSurgeryClick(Sender: TObject);
+    procedure cboReasonsEnter(Sender: TObject);
+    procedure cboReasonsExit(Sender: TObject);
+    procedure tQuantityClick(Sender: TObject);
+    procedure tQuantityChange(Sender: TObject);
+    procedure cboReasonsChange(Sender: TObject);
+    procedure cboModifiersChange(Sender: TObject);
+    procedure lvSelectionListClick(Sender: TObject);
+    procedure cboAvailCompChange(Sender: TObject);
+    procedure cboCollTimeChange(Sender: TObject);
+    procedure memDiagCommentChange(Sender: TObject);
+    procedure cboUrgencyExit(Sender: TObject);
   protected
     FCmtTypes: TStringList ;
 …
     procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
     procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
+    procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
     procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
+    procedure ExtractReasons(OutList:TStrings; AList:TStrings);
     procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
     procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
+    procedure ExtractOther(OutList:TStrings; AList:TStrings);
     procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
     procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
 …
     procedure LoadUrgencies(AComboBox:TORComboBox);
     procedure LoadModifiers(AComboBox:TORComboBox);
+    procedure LoadReasons(AComboBox:TORComboBox);
   private
     FLastCollType: string;
 …
     FEvtDivision: integer;
     FVbecLookup: string;
+    FQuickList:  Integer;
+    FQuickItems: TStringList;
+    FOrderAction: Integer;
     procedure ReadServerVariables;
+    procedure SetOnQuickOrder;
   public
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
 …
     CollSamp: Integer;                    { index into CollSampList }
     Specimen: Integer;                    { IEN of specimen }
+    Urgency: Integer;                     { IEN of urgency }
     Comment: TStringList;                 { text of comment }
     TestReqComment: string;               { Name of required comment }
 …
     SpecimenList: TStringList;            { Strings: IEN^Specimen Name }
     SpecListCount: integer;               { count of original contents of SpecimenList}
+    UrgencyList: TStringList;             { Strings: IEN^Urgency Name }
+    ForceUrgency: Boolean;                { true if not prompt Urgency }
     SurgeryList: TStringList;             { Strings: Surgeries}
     PatientInfo: TStringList;             { Text of Patient Information}
 …
     procedure LoadCollSamp(AComboBox: TORComboBox);
     procedure LoadSpecimen(AComboBox: TORComboBox);
+    procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
     function  NameOfCollSamp: string;
     function  NameOfSpecimen: string;
+    function  NameOfUrgency: string;
     function  ObtainCollSamp: Boolean;
     function  ObtainSpecimen: Boolean;
+    function  ObtainUrgency: Boolean;
     function  ObtainComment: Boolean;
   end;
 …
 var
   uSelectedItems: TStringList;   //Selected Items in ListView- if TestYes =1 then test else component
                                  //TestYes(1)^Test-Component(2)^Qty(3)^Sample(4,5)^Specimen(6,7)^Modifier(8)
+                                 //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
   uVBECList: TStringList;        //List of items from VBEC api
   uTestsForResults: TStringList; //List of tests to show results
   uUrgencyList: TStringList;     //List of Urgencies
+  uTNSOrders: TStringList;       //List of Current orders for Type & Screen
   uModifierList: TStringList;    //List of Modifiers
+  uReasonsList: TStringList;     //List of Reasons for Request
   uRaw: TStringList;             //Results Array
   uTestSelected, uComponentSelected: Boolean;  //Used on Validate
+  uDfltUrgency: Integer;
+  uDfltUrgency: Integer;         //Default Urgency
+  uSelUrgency: String;          //Previously Selected Urgency - Used when components have been added for specific urgency
+  uSelSurgery: Integer;          //Selected Surgery for Blood order
   uSpecimen, uGetTnS: Integer;            //Set to 1 if a specimen for test is already in lab... no need to collect
   uDfltCollType: string;
+  uDfltCollType, uReason: string;
   ALabTest: TLabTest;
   UserHasLRLABKey: boolean;
 …
   TI_INFO = 0;    //Corresponds with pgeProduct TabIndex
   TI_ORDER = 1;
+  TI_COMPONENT = 1;
   TI_RESULTS = 2;
 …
   i: integer;
   AList, ATests: TStringList;
+  ListCount: Integer;
+  x: string;
 begin
   AutoSizeDisabled := True;
 …
   uTestsForResults := TStringList.Create;
   uUrgencyList := TStringList.Create;
+  uTNSOrders := TStringList.Create;
   uModifierList := TStringList.Create;
+  uReasonsList := TStringList.Create;
   uRaw := TStringList.Create;
   uSpecimen := 0;
   uGetTnS := 0;
+  uReason := '';
   lblTNS.Caption := '';
   lblTNS.Visible := false;
+  pnlMessage.Visible := false;
   uDfltUrgency := 9;
+  TabResults.ImageIndex := 0;
+  uSelUrgency := '';
+  uSelSurgery := 0;
+  TabResults.Caption := 'Lab Results';
+  edtResults.Lines.Clear;
+  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.');
   Responses.Clear;
   try
 …
     LRFSCH   := '';
     LRORDERMODE := TORDER_MODE_INFO;
-    DisableComponentControls;
-    DisableDiagTestControls;
     FLastColltime := '';
     FLastLabCollTime := '';
 …
     AllowQuickOrder := True;
     StatusText('Loading Dialog Definition');
-    lblReqComment.Visible := False ;
-    lblModifiers.Enabled := False;
-    cboModifiers.Enabled := False;
     FCmtTypes := TStringList.Create;
     for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
 …
       EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
       if EvtDelayLoc>0 then
         AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
+        FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
       else
         AList.Assign(ODForLab(Encounter.Location,EvtDivision));
+        FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
     end else
       AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
+      FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
     CtrlInits.LoadDefaults(AList);
     InitDialog;
+    GroupBox1.Visible := True;
     with CtrlInits do
     begin
 …
       StatusText('Initializing List of Tests');
       FVbecLookup := 'S.VBT';
       cboAvailTest.InitLongList('');
+      cboAvailTest.InitLongList('');      //Populates cboAvailTest control based on S.VBT xref
     end;
     cboAvailComp.Clear;
 …
     AList.Clear;
     ExtractUrgencies(uUrgencyList, uVBECList);
+    ExtractTNSOrders(uTNSOrders, uVBECList);
     LoadUrgencies(cboUrgency);
-    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     ExtractModifiers(uModifierList, uVBECList);
+    ExtractReasons(uReasonsList, uVBECList);
     LoadModifiers(cboModifiers);
+    calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
+    //cboPreparation.SelectByID('I');
+    memMessage.Visible := false;
+    memOrder.Visible := false;
+    cmdAccept.Visible := false;
+    LoadReasons(cboReasons);
+    calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
     pgeProduct.TabIndex := TI_INFO;
+    lvSelectionList.Column[0].Width := 200;
+    lvSelectionList.Column[1].Width := 40;
+    lvSelectionList.Column[0].Width := 240;
+    lvSelectionList.Column[1].Width := 30;
+    lvSelectionList.Column[2].Width := 100;
+    DisableComponentControls;
+    DisableDiagTestControls;
     pgeProduct.ActivePageIndex := TI_INFO;
-    PreserveControl(cboAvailTest);
-    PreserveControl(cboAvailComp);
-    PreserveControl(cboCollType);
-    PreserveControl(cboCollTime);
-    PreserveControl(calCollTime);
-    PreserveControl(calWantTime);
     StatusText('');
+    x := 'VBEC';
+    FQuickItems := TStringList.Create;
+    ListForQuickOrders(FQuickList, ListCount, x);
+    if ListCount > 0 then
+      begin
+        SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
+      end else
+      begin
+        ListCount := 1;
+        FQuickItems.Add('0^(No quick orders available)');
+      end;
+    FastAssign(FQuickItems, cboQuick.Items);
+    if lvSelectionList.Items.Count > 0 then
+      begin
+        memOrder.Visible := true;
+        cmdAccept.Visible := true;
+      end;
   finally
     AList.Free;
 …
 procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
 var
+  tmpResp: TResponse;
+  AnInstance, CurAdd: Integer;
+  AResponse: TResponse;
+  i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer;
+  aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string;
+  ListItem: TListItem;
+  aList: TStringList;
+  aTests: TStringList;
+begin
+  inherited;
+  aList := TStringList.Create;
+  aTests:= TStringList.Create;
+  try
+  FOrderAction := OrderAction;
+  ReadServerVariables;
+  sub1 := '';
+  aTypeScreen := '';
+  aSpecimen := '^';
+  aModifier := '';
+  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
+    begin
+      AnInstance := NextInstance('ORDERABLE', 0);
+      while AnInstance > 0 do
+        begin
+          AResponse := FindResponseByName('ORDERABLE', AnInstance);
+          if AResponse <> nil then
+            begin
+              sub := GetSubtype(AResponse.EValue);
+              if sub = 't' then
+                begin
+                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
+                  ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
+                end
+              else
+                begin
+                  SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
+                  ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
+                end;
+              if ALabTest = nil then Exit;  // Causes access violation
+              if AnInstance = 1 then
+                begin
+                  SetControl(cboReasons,         'REASON' , AnInstance);
+                  SetControl(calWantTime,        'DATETIME', AnInstance);
+                  SetControl(memDiagComment,     'COMMENT', AnInstance);
+                  SetControl(chkConsent,         'YN', AnInstance);
+                  //DetermineCollectionDefaults(Responses);
+                  SetControl(cboCollType,        'COLLECT', AnInstance);
+                  SetControl(cboCollTime,        'START', AnInstance);
+                  SetupCollTimes(cboCollType.ItemID);
+                  SetControl(cboUrgency,         'URGENCY', AnInstance);
+                  SetControl(cboSurgery,         'MISC', AnInstance);
+                  Urgency := cboUrgency.ItemIEN;
+                  if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
+                    begin
+                      cboUrgency.ItemIndex := 0;
+                      Urgency := cboUrgency.ItemIEN;
+                    end;
+                  i := 1 ;
+                  AResponse := Responses.FindResponseByName('COMMENT',i);
+                  while AResponse <> nil do
+                    begin
+                      Comment.Add(AResponse.EValue);
+                      Inc(i);
+                      AResponse := Responses.FindResponseByName('COMMENT',i);
+                    end ;
+                end;
+              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
+                begin
+                  Changing := True;
+                  DisableComponentControls;
+                  EnableDiagTestControls;
+                  LRORDERMODE := TORDER_MODE_DIAG;
+                  aList.Clear;
+                  aTestYes := '1';
+                  ExtractTypeScreen(aList, uVBECList);
+                  if aList.Count > 0 then aTypeScreen := aList[0];
+                  aList.Clear;
+                  with lvSelectionList do
+                    begin
+                      ListItem := Items.Add;
+                      ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
+                      ListItem.SubItems.Add('');
+                      ListItem.SubItems.Add('');
+                      ListItem.SubItems.Add('');
+                      ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
+                      if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
+                        begin
+                          lblTNS.Caption := '';
+                          lblTNS.Visible := false;
+                          memMessage.Text := '';
+                          pnlMessage.Visible := false;
+                          uGetTnS := 0;
+                          pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+                        end;
+                    end;
+                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
+                  uSelectedItems.Add(aStr);
+                  if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+                  {with cboCollType do if Length(ItemID) > 0 then
+                    begin
+                      Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+                      FLastCollType := ItemID;
+                    end;  }
+                  if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+                  if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+                  if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
+                  LoadCollType(cboCollType);
+                  if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
+                    if not(ALabTest.LabCanCollect) and OrderForInpatient then
+                      cboCollType.SelectByID('WC')
+                    else if not(ALabTest.LabCanCollect) then
+                      cboCollType.SelectByID('SP');
+                  SetupCollTimes(cboCollType.ItemID);
+                  if cboCollType.ItemID = 'LC' then
+                    begin
+                      with cboCollTime do
+                        if Length(ItemID) > 0 then
+                          begin
+                            Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
+                            FLastLabCollTime := ItemID + U + Text;
+                          end
+                        else if Length(Text) > 0 then
+                          begin
+                            Responses.Update('START', 1, ValidCollTime(Text), Text) ;
+                            FLastLabCollTime := ValidCollTime(Text);
+                          end;
+                    end
+                  else
+                    begin
+                      with calCollTime do
+                        if FMDateTime > 0 then
+                          begin
+                            Responses.Update('START', 1, ValidCollTime(Text), Text);
+                            FLastColltime := ValidCollTime(Text);
+                          end
+                        else
+                          begin
+                            Responses.Update('START', 1, '', '') ;
+                            FLastCollTime := '';
+                          end;
+                    end;
+                  with cboCollType do if Length(ItemID) > 0 then
+                    begin
+                      Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+                      FLastCollType := ItemID;
+                    end;
+                  //if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
+                  memOrder.Text := Responses.OrderText;
+                  Changing := False;
+                  if ObtainCollSamp then
+                    begin
+                      //For BloodBank orders, this condition should never occur
+                    end
+                  else
+                    begin
+                      with ALabTest do
+                        with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                          begin
+                            x := '' ;
+                            for i := 0 to WardComment.Count-1 do
+                            x := x + WardComment.strings[i]+#13#10 ;
+                            pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                            OrderMessage(x) ;
+                          end ;
+                    end;
+                end;
+              if sub = 'c' then with ALabTest do  //COMPONENT
+                begin
+                  Changing := True;
+                  DisableDiagTestControls;
+                  EnableComponentControls;
+                  aTestYes := '0';
+                  LRORDERMODE := TORDER_MODE_COMP;
+                  SetControl(cboModifiers,       'MODIFIER', AnInstance);
+                  SetControl(tQuantity,          'QTY', AnInstance);
+                  uComponentSelected := true;
+                  aList.Clear;
+                  TestAdded := 0;
+                  getTest := 0;
+                  ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
+                    for j := 0 to aList.Count - 1 do
+                      begin
+                        if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
+                          begin
+                            if uTestsForResults.Count < 1 then getTest := 1;
+                            for k := 0 to uTestsForResults.Count - 1 do
+                              begin
+                                if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
+                                  begin
+                                    getTest := 0;
+                                    break;
+                                  end
+                                else getTest := 1;
+                              end;
+                            if getTest = 1 then
+                              begin
+                                uTestsForResults.Add(piece(aList[j],'^',3));
+                                TestAdded := 1;
+                              end;
+                          end;
+                      end;
+                    if TestAdded = 1 then
+                      begin
+                        edtResults.Clear;
+                        aTests.Clear;
+                        GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
+                        QuickCopy(ATests,edtResults);
+                        if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
+                        uRaw.Clear;
+                        GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
+                      end;
+                    CurAdd := 1;
+                    if uRaw.Count > 0 then
+                    for j := 0 to uRaw.Count - 1 do
+                      begin
+                        if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
+                        Inc(CurAdd);
+                      end;
+                  with lvSelectionList do
+                    begin
+                      ListItem := Items.Add;
+                      ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
+                      ListItem.SubItems.Add(tQuantity.Text);
+                      if length(cboModifiers.ItemID) > 0 then
+                        begin
+                          ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
+                          ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
+                        end
+                        else
+                          begin
+                            ListItem.SubItems.Add('');
+                            ListItem.SubItems.Add('');
+                          end;
+                      ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+                    end;
+                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
+                  uSelectedItems.Add(aStr);
+                  memOrder.Text := Responses.OrderText;
+                  Changing := False;
+                end;
+            end;
+          StatusText('');
+          AnInstance := NextInstance('ORDERABLE', AnInstance);
+        end;  //while AnInstance - ORDERABLE
+      DisableComponentControls;
+      DisableDiagTestControls;
+    end;
+    CurAdd := 1;
+    for i := 0 to uSelectedItems.Count - 1 do
+      begin
+        aName := lvSelectionList.Items[i].Caption;
+        x := uSelectedItems[i];
+        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+          end
+        else
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
+            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+            if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+            if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
+              else
+                begin
+                  cboUrgency.ItemIndex := 1;
+                  Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+                  cboUrgencyChange(self);
+                end;
+          end;
+        Inc(CurAdd);
+      end;
+    for i := 0 to lvSelectionList.Items.Count - 1 do
+      begin
+        if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
+          begin
+            if uTNSOrders.Count > 0 then
+              begin
+                for j := 0 to uTNSOrders.Count - 1 do
+                  aTNSString := aTNSString + CRLF + uTNSOrders[j];
+                with Application do
+                  begin
+                    NormalizeTopMosts;
+                    aTNSDays := TNSDaysBack;
+                    aTNS :=
+                      MessageBox(PChar(aTNSString + CRLF + CRLF +
+                                 'Do you wish to continue with this request for Type & Screen?'),
+                                 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
+                                 MB_YESNO);
+                    RestoreTopMosts;
+                    if aTNS = 7 then
+                      begin
+                        lvSelectionList.ItemIndex := i;
+                        lvSelectionListClick(self);
+                        btnRemoveClick(self);
+                        break;
+                      end;
+                  end;
+              end;
+            break;
+          end;
+      end;
+  {if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
+    begin
+      if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1;
+      AnInstance := NextInstance('ORDERABLE', 0);
+      while AnInstance > 0 do
+        begin
+          AResponse := FindResponseByName('ORDERABLE', AnInstance);
+          if AResponse <> nil then
+            begin
+              sub := GetSubtype(AResponse.EValue);
+              if sub = 't' then
+                begin
+                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
+                  ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
+                end
+              else
+                begin
+                  SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
+                  ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
+                end;
+              //SetControl(cboTests,           'ORDERABLE', AnInstance);
+              //ALabTest := TLabTest.Create(cboTests.ItemID, Responses);
+              if ALabTest = nil then Exit;  // Causes access violation
+              //sub := GetSubtype(ALabTest.TestName);
+              if AnInstance = 1 then
+                begin
+                  DetermineCollectionDefaults(Responses);
+                  SetControl(cboReasons,         'REASON', AnInstance);
+                  SetControl(chkConsent,         'YN', AnInstance);
+                  SetControl(cboSurgery,         'MISC', AnInstance);
+                  //SetControl(cboCollType,        'COLLECT', AnInstance);
+                  //SetControl(cboCollTime,        'START', AnInstance);
+                  SetControl(calWantTime,        'DATETIME', AnInstance);
+                  //LoadUrgency(cboCollType.ItemID, cboUrgency);
+                  SetControl(cboUrgency,         'URGENCY', AnInstance);
+                  Urgency := cboUrgency.ItemIEN;
+                  if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
+                    begin
+                      cboUrgency.ItemIndex := 0;
+                      Urgency := cboUrgency.ItemIEN;
+                    end;
+                  i := 1 ;
+                  AResponse := Responses.FindResponseByName('COMMENT',i);
+                  while AResponse <> nil do
+                      begin
+                        if Length(AResponse.Evalue) > 0 then
+                          Comment.Add(AResponse.EValue);
+                        Inc(i);
+                        AResponse := Responses.FindResponseByName('COMMENT',i);
+                      end ;
+                end;
+              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
+                begin
+                  Changing := True;
+                  DisableComponentControls;
+                  EnableDiagTestControls;
+                  LRORDERMODE := TORDER_MODE_DIAG;
+                  with Responses do
+                    begin
+                      StatusText('Initializing Order');
+                      AResponse := FindResponseByName('ORDERABLE', AnInstance);
+                      if AResponse <> nil then
+                        sub1 := GetSubtype(AResponse.EValue);
+                      if sub1 = 't' then
+                        begin
+                          SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
+                          //SetControl(cboTests,           'ORDERABLE', AnInstance);
+                          //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
+                          cboAvailTestSelect(self);
+                        end;
+                    end;
+                  Changing := False;
+                  if ObtainCollSamp then
+                    begin
+                      //For BloodBank orders, this condition should never occur
+                    end
+                  else
+                    begin
+                      with ALabTest do
+                        with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                          begin
+                            x := '' ;
+                            for i := 0 to WardComment.Count-1 do
+                            x := x + WardComment.strings[i]+#13#10 ;
+                            pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                            OrderMessage(x) ;
+                          end ;
+                    end;
+                end;
+              if sub = 'c' then with ALabTest do  //COMPONENT
+                begin
+                  Changing := True;
+                  DisableDiagTestControls;
+                  EnableComponentControls;
+                  LRORDERMODE := TORDER_MODE_COMP;
+                  with Responses do
+                    begin
+                      StatusText('Initializing Order');
+                      AResponse := FindResponseByName('ORDERABLE', AnInstance);
+                      if AResponse <> nil then
+                        sub1 := GetSubtype(AResponse.EValue);
+                      if sub1 = 'c' then
+                        begin
+                          SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
+                          //SetControl(cboTests,           'ORDERABLE', AnInstance);
+                          SetControl(cboModifiers,       'MODIFIER', AnInstance);
+                          SetControl(tQuantity,          'QTY', AnInstance);
+                          //DetermineCollectionDefaults(Responses);
+                          cboAvailCompSelect(self);
+                        end;
+                    end;
+                  Changing := False;
+                end;
+              with ALabTest do
+                begin
+                  if ObtainComment then
+                    LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
+                  else
+                    DisableCommentPanels;
+                  x := '' ;
+                  for i := 0 to CurWardComment.Count-1 do
+                    x := x + CurWardComment.strings[i]+#13#10 ;
+                  i :=  IndexOfCollSamp(CollSamp);
+                  if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                    for i := 0 to WardComment.Count-1 do
+                      x := x + WardComment.strings[i]+#13#10 ;
+                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                  if Length(x) > 0 then
+                    begin
+                      OrderMessage(x) ;
+                    end;
+                end;
+              StatusText('');
+              Changing := True;
+              //if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses);
+              Changing := False;
+            end;
+          AnInstance := NextInstance('ORDERABLE', AnInstance);
+        end; //while AnInstance - ORDERABLE
+      DisableComponentControls;
+      DisableDiagTestControls;
+      uQuickInProcess := 0;
+    end;  }
+  finally
+    aList.Free;
+    aTests.Free;
+  end;
+  edtResults.Height := 247;
+  edtInfo.Height := 247;
+  if lvSelectionList.Items.Count > 0 then
+    begin
+      pnlSelectedTests.Visible := True;
+      cmdAccept.Visible := True;
+      memOrder.Visible := True;
+      GroupBox1.Visible := False;
+    end;
+end;
+procedure TfrmODBBank.SetOnQuickOrder;
+  var
+  AnInstance: Integer;
+  AResponse: TResponse;
   i: integer;
+  x,sub,sub1,aTNSString: string;
+  aList: TStringList;
+  aGotIt: boolean;
+  aTests: TStringList;
+  ListItem: TListItem;
+  aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String;
+  CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer;
 begin
   inherited;
+  ReadServerVariables;
+  if LRFZX <> '' then
+    begin
+      cboCollType.SelectByID(LRFZX);
+      if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
+    end;
+  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
+   begin
+      SetControl(cboAvailTest,       'ORDERABLE', 1);
+      cboAvailTestSelect(Self);
+      if ALabTest = nil then Exit;  // Causes access violation in FillCollSampleList
+      Changing := True;
+      DetermineCollectionDefaults(Responses);
+      i := 1 ;
+      tmpResp := Responses.FindResponseByName('COMMENT',i);
+      while tmpResp <> nil do
+        begin
+          Comment.Add(tmpResp.EValue);
+          Inc(i);
+          tmpResp := Responses.FindResponseByName('COMMENT',i);
+        end ;
+      Changing := False;
+   end;
+  aList := TStringList.Create;
+  aTests := TStringList.Create;
+  try
+    aModifier := '';
+    aReason := '';
+    aSurgery := '';
+    aCollTime := '';
+    aTestYes := '0';
+    aTypeScreen := '';
+    aSpecimen := '';
+    sub1 := '';
+    ExtractTypeScreen(aList, uVBECList);
+    if aList.Count > 0 then aTypeScreen := aList[0];
+    aList.Clear;
+    Extractspecimen(aList, uVBECList);
+    if aList.Count > 0 then aSpecimen := aList[0];
+    with Responses, ALabTest do
+      begin
+        Changing := True;
+        aGotIt := False;
+        FLastItemID := cboQuick.ItemID;
+        QuickOrder := ExtractInteger(cboQuick.ItemID);
+        with Responses do
+          begin
+            StatusText('Initializing Quick Order');
+            AnInstance := NextInstance('ORDERABLE', 0);
+            while AnInstance > 0 do
+              begin
+                AResponse := FindResponseByName('ORDERABLE', AnInstance);
+                sub := GetSubtype(AResponse.EValue);
+                if sub = 't' then
+                  begin
+                    SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
+                    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
+                  end
+                else
+                  begin
+                    SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
+                    ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
+                  end;
+                for i := 0 to aList.Count - 1 do
+                  if aList[i] = ALabTest.TestName then
+                    begin
+                      aGotIt := true;
+                      break;
+                    end;
+                if aGotIt = true then
+                  begin
+                    aGotIt := false;
+                    AnInstance := NextInstance('ORDERABLE', AnInstance);
+                    Continue;
+                  end
+                  else
+                    begin
+                      aList.Add(ALabTest.TestName);
+                    end;
+                if AResponse <> nil then
+                  sub1 := GetSubtype(AResponse.EValue);
+                if AnInstance = 1 then
+                  begin
+                    SetControl(cboReasons,         'REASON', AnInstance);
+                    SetControl(calWantTime,        'DATETIME', AnInstance);
+                    SetControl(memDiagComment,     'COMMENT', AnInstance);
+                    SetControl(chkConsent,         'YN', AnInstance);
+                    //DetermineCollectionDefaults(Responses);
+                    SetControl(cboCollType,        'COLLECT', AnInstance);
+                    SetupCollTimes(cboCollType.ItemID);
+                    //SetControl(cboCollTime,        'START', AnInstance);
+                    //LoadUrgency(cboCollType.ItemID, cboUrgency);
+                    SetControl(cboUrgency,         'URGENCY', AnInstance);
+                    Urgency := cboUrgency.ItemIEN;
+                    if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
+                      begin
+                        cboUrgency.ItemIndex := 0;
+                        Urgency := cboUrgency.ItemIEN;
+                        cboUrgencyChange(self);
+                      end;
+                    SetControl(cboSurgery,         'MISC', AnInstance);
+                    if not(ALabTest = nil) then
+                      begin
+                        Urgency := cboUrgency.ItemIEN;
+                        if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
+                          begin
+                            cboUrgency.ItemIndex := 0;
+                            Urgency := cboUrgency.ItemIEN;
+                          end;
+                        i := 1 ;
+                        AResponse := Responses.FindResponseByName('COMMENT',i);
+                        while AResponse <> nil do
+                          begin
+                            Comment.Add(AResponse.EValue);
+                            Inc(i);
+                            AResponse := Responses.FindResponseByName('COMMENT',i);
+                          end ;
+                      end;
+                    if not(cboCollType.ItemID = 'LC') then
+                      begin
+                        if Length(cboCollTime.Text) > 0 then
+                          begin
+                            calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text);
+                            FLastCollTime := cboCollTime.Text;
+                          end
+                        else
+                          begin
+                            FLastCollTime := '';
+                          end;
+                      end;
+                  end;
+                if sub1 = 'c' then
+                  begin
+                    DisableDiagTestControls;
+                    EnableComponentControls;
+                    LRORDERMODE := TORDER_MODE_COMP;
+                    SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
+                    SetControl(cboModifiers,       'MODIFIER', AnInstance);
+                    SetControl(tQuantity,          'QTY', AnInstance);
+                    //DetermineCollectionDefaults(Responses);
+                    //Check for and display any associated Lab Results
+                    aList.Clear;
+                    TestAdded := 0;
+                    getTest := 0;
+                    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
+                      for j := 0 to aList.Count - 1 do
+                        begin
+                          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
+                            begin
+                              if uTestsForResults.Count < 1 then getTest := 1;
+                              for k := 0 to uTestsForResults.Count - 1 do
+                                begin
+                                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
+                                    begin
+                                      getTest := 0;
+                                      break;
+                                    end
+                                  else getTest := 1;
+                                end;
+                              if getTest = 1 then
+                                begin
+                                  uTestsForResults.Add(piece(aList[j],'^',3));
+                                  TestAdded := 1;
+                                end;
+                            end;
+                        end;
+                      if TestAdded = 1 then
+                        begin
+                          edtResults.Clear;
+                          aTests.Clear;
+                          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
+                          QuickCopy(ATests,edtResults);
+                          if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
+                          uRaw.Clear;
+                          GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
+                        end;
+                      CurAdd := 1;
+                      if uRaw.Count > 0 then
+                      for j := 0 to uRaw.Count - 1 do
+                        begin
+                          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
+                          Inc(CurAdd);
+                        end;
+                    aSpecimen := '^';
+                    aTestYes := '0';
+                    aReason := '';
+                    aSurgery := '';
+                    aCollTime := '';
+                    ExtractSpecimen(aList, uVBECList);
+                    if aList.Count > 0 then aSpecimen := aList[0];
+                    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
+                    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
+                    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
+                    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
+                    if Length(cboSurgery.ItemID) > 0 then
+                      begin
+                        aList.Clear;
+                        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
+                        for i := 0 to aList.Count - 1 do
+                          begin
+                            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+                             and (piece(aList[i],'^',3) = cboSurgery.Text) then
+                              begin
+                                aMSBOS := StrToInt(piece(aList[i],'^',4));
+                                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
+                                  begin
+                                    with Application do
+                                    begin
+                                      NormalizeTopMosts;
+                                      aMSBOSContinue :=
+                                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
+                                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
+                                                   + IntToStr(aMSBOS) +
+                                                   ') for the ' + cboSurgery.text +
+                                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
+                                                   PChar('Maximum Number of Units Exceeded'),
+                                                   MB_YESNO);
+                                      RestoreTopMosts;
+                                    end;
+                                    if aMSBOSContinue = 7 then
+                                      begin
+                                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
+                                        exit;
+                                      end;
+                                  end;
+                              end;
+                          end;
+                      end;
+                    if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
+                      begin
+                        uGetTnS := 1;
+                      end;
+                    aList.Clear;
+                    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
+                    for i := 0 to aList.Count - 1 do
+                      begin
+                        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
+                          begin
+                            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
+                            break;
+                          end;
+                      end;
+                    uComponentSelected := true;
+                    with lvSelectionList do
+                      begin
+                        ListItem := Items.Add;
+                        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
+                        ListItem.SubItems.Add(tQuantity.Text);
+                        if length(cboModifiers.ItemID) > 0 then
+                          begin
+                            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
+                            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
+                          end
+                          else
+                            begin
+                              ListItem.SubItems.Add('');
+                              ListItem.SubItems.Add('');
+                            end;
+                        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+                      end;
+                    CurAdd := 1;
+                    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
+                    uSelectedItems.Add(aStr);
+                    for i := 0 to uSelectedItems.Count - 1 do
+                      begin
+                        aName := lvSelectionList.Items[i].Caption;
+                        x := uSelectedItems[i];
+                        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+                          begin
+                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+                          end
+                        else
+                          begin
+                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+                            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+                            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
+                            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+                            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+                          end;
+                        Inc(CurAdd);
+                      end;
+                    memOrder.Text := Responses.OrderText;
+                    GroupBox1.Visible := False;
+                  aMsg := '';
+                  LRORDERMODE := TORDER_MODE_INFO;
+                  {if uGetTnS = 1 then
+                    begin
+                      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+                      lblTNS.Visible := true;
+                      memMessage.Text := 'TYPE + SCREEN must be added to order';
+                      memMessage.Visible := false;
+                      pnlMessage.Visible := true;
+                      pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
+                    end;  }
+                  {if uGetTnS = 1 then
+                    begin
+                      if responses.QuickOrder < 1 then
+                        begin
+                          for i := 1 to cboAvailTest.Items.Count - 1 do
+                            begin
+                              if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
+                                begin
+                                  if piece(aSpecimen,'^',1) = '1' then
+                                    begin
+                                      cboCollTime.Text := calWantTime.Text;
+                                      aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
+                                      cboCollTime.Text := '';
+                                      cboCollType.Text := '';
+                                      uSpecimen := 1;
+                                    end;
+                                  cboModifiers.Text := '';
+                                  cboAvailTest.SelectByID(aTypeScreen);
+                                  cboTests.SelectByID(aTypeScreen);
+                                  cboTestsClick(self);
+                                  //cboAvailTestSelect(Self);
+                                  uSpecimen := 0;
+                                  cboCollTime.Text := piece(aCollSave,'^',1);
+                                  cboCollType.Text := piece(aCollSave,'^',3);
+                                  aCollSave := '';
+                                  break;
+                                end;
+                            end;
+                          aMsg := 'An order for Type and Screen has been added to this request' + '.';
+                        end
+                        else
+                          begin
+                            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+                            lblTNS.Visible := true;
+                            memMessage.Text := 'TYPE + SCREEN must be added to order';
+                            memMessage.Visible := false;
+                            pnlMessage.Visible := true;
+                          end;
+                    end;
+                  if (uGetTnS = 1) then
+                    begin
+                      if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
+                      ShowMsg(aMsg);
+                    end;  }
+                  //cboModifiers.Text := '';
+                  edtResults.Height := 247;
+                  edtInfo.Height := 247;
+                  if lvSelectionList.Items.Count > 0 then
+                    begin
+                      pnlSelectedTests.Visible := True;
+                      cmdAccept.Visible := True;
+                      memOrder.Visible := True;
+                      GroupBox1.Visible := False;
+                    end;
+                  end
+                  else
+                    begin
+                      if sub1 = 't' then
+                      begin
+                        DisableComponentControls;
+                        EnableDiagTestControls;
+                        LRORDERMODE := TORDER_MODE_DIAG;
+                        aTestYes := '1';
+                        SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
+                        //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
+                        i := 1 ;
+                        AResponse := Responses.FindResponseByName('COMMENT',i);
+                        while AResponse <> nil do
+                          begin
+                            Comment.Add(AResponse.EValue);
+                            Inc(i);
+                            AResponse := Responses.FindResponseByName('COMMENT',i);
+                          end ;
+                        if ObtainCollSamp then
+                          begin
+                          //For BloodBank orders, this condition should never occur
+                          end
+                        else
+                          begin
+                            with ALabTest do
+                              with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                                begin
+                                  x := '' ;
+                                  for i := 0 to WardComment.Count-1 do
+                                  x := x + WardComment.strings[i]+#13#10 ;
+                                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                                  OrderMessage(x) ;
+                                end ;
+                          end;
+                        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+                        with cboCollType do if Length(ItemID) > 0 then
+                          begin
+                            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+                            FLastCollType := ItemID;
+                          end;
+                        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
+                          else
+                            begin
+                              cboUrgency.ItemIndex := 1;
+                              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+                              cboUrgencyChange(self);
+                            end;
+                        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+                        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
+                        LoadCollType(cboCollType);
+                        if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
+                          if not(ALabTest.LabCanCollect) and OrderForInpatient then
+                            cboCollType.SelectByID('WC')
+                          else if not(ALabTest.LabCanCollect) then
+                            cboCollType.SelectByID('SP');
+                        SetupCollTimes(cboCollType.ItemID);
+                        if cboCollType.ItemID = 'LC' then
+                          begin
+                            with cboCollTime do
+                              if Length(ItemID) > 0 then
+                                begin
+                                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
+                                  FLastLabCollTime := ItemID + U + Text;
+                                end
+                              else if Length(Text) > 0 then
+                                begin
+                                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
+                                  FLastLabCollTime := ValidCollTime(Text);
+                                end;
+                          end
+                        else
+                          begin
+                            with calCollTime do
+                              if FMDateTime > 0 then
+                                begin
+                                  Responses.Update('START', 1, ValidCollTime(Text), Text);
+                                  FLastColltime := ValidCollTime(Text);
+                                end
+                              else
+                                begin
+                                  Responses.Update('START', 1, '', '') ;
+                                  FLastCollTime := '';
+                                end;
+                          end;
+                        if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
+                        with cboCollType do if Length(ItemID) > 0 then
+                          begin
+                            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+                            FLastCollType := ItemID;
+                          end;
+                        uTestSelected := true;
+                        with lvSelectionList do
+                          begin
+                            ListItem := Items.Add;
+                            ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
+                            ListItem.SubItems.Add('');
+                            ListItem.SubItems.Add('');
+                            ListItem.SubItems.Add('');
+                            ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
+                          end;
+                        CurAdd := 1;
+                        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
+                        uSelectedItems.Add(aStr);
+                        for i := 0 to uSelectedItems.Count - 1 do
+                          begin
+                            aName := lvSelectionList.Items[i].Caption;
+                            x := uSelectedItems[i];
+                            if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+                              begin
+                                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+                              end;
+                            Inc(CurAdd);
+                          end;
+                        memOrder.Text := Responses.OrderText;
+                      edtResults.Height := 247;
+                      edtInfo.Height := 247;
+                      if lvSelectionList.Items.Count > 0 then
+                        begin
+                          pnlSelectedTests.Visible := True;
+                          cmdAccept.Visible := True;
+                          memOrder.Visible := True;
+                          GroupBox1.Visible := False;
+                        end;
+                      end;
+                    end;
+                  AnInstance := NextInstance('ORDERABLE', AnInstance);
+              end;
+              //Quick Order
+          end;
+        for i := 0 to lvSelectionList.Items.Count - 1 do
+          begin
+            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
+              begin
+                uGetTnS := 0;
+                uDfltUrgency := cboUrgency.ItemID;
+                lblTNS.Caption := '';
+                lblTNS.Visible := false;
+                memMessage.Text := '';
+                pnlMessage.Visible := false;
+                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+                if uTNSOrders.Count > 0 then
+                  begin
+                    for j := 0 to uTNSOrders.Count - 1 do
+                      aTNSString := aTNSString + CRLF + uTNSOrders[j];
+                    with Application do
+                      begin
+                        NormalizeTopMosts;
+                        aTNSDays := TNSDaysBack;
+                        aTNS :=
+                          MessageBox(PChar(aTNSString + CRLF + CRLF +
+                                     'Do you wish to continue with this request for Type & Screen?'),
+                                     PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
+                                     MB_YESNO);
+                        RestoreTopMosts;
+                        if aTNS = 7 then
+                          begin
+                            lvSelectionList.ItemIndex := i;
+                            lvSelectionListClick(self);
+                            btnRemoveClick(self);
+                            break;
+                          end;
+                      end;
+                  end;
+                break;
+              end;
+          end;
+        if uGetTnS = 1 then
+          begin
+            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+            lblTNS.Visible := true;
+            memMessage.Text := 'TYPE + SCREEN must be added to order';
+            pnlMessage.Visible := true;
+            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
+          end;
+        if ALabTest <> nil then
+          begin
+            if ObtainCollSamp then
+              begin
+               //For BloodBank orders, this condition should never occur
+              end
+            else
+              begin
+                with ALabTest do
+                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                    begin
+                      x := '' ;
+                      for i := 0 to WardComment.Count-1 do
+                      x := x + WardComment.strings[i]+#13#10 ;
+                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                      OrderMessage(x) ;
+                    end ;
+              end;
+            with ALabTest do
+              begin
+                if ObtainComment then
+                  LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
+                else
+                  DisableCommentPanels;
+                x := '' ;
+                for i := 0 to CurWardComment.Count-1 do
+                  x := x + CurWardComment.strings[i]+#13#10 ;
+                i :=  IndexOfCollSamp(CollSamp);
+                if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                  for i := 0 to WardComment.Count-1 do
+                    x := x + WardComment.strings[i]+#13#10 ;
+                pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                OrderMessage(x) ;
+              end;
+            GroupBox1.Visible := False;
+          end;
+        StatusText('');
+        Changing := False;
+      end;
+  finally                      //**SubTest
+    alist.Free;
+    aTests.Free;
+  end;
 end;
 …
       LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
       TestReqComment := ExtractDefault(LoadData, 'ReqCom');
+      UniqueCollSamp := false;
       if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
       x := ExtractDefault(LoadData, 'Unique CollSamp');
 …
       ExtractItems(SpecimenList, LoadData, 'Specimens');
       if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
+      UrgencyList := TStringList.Create;
+      if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then  { forced urgency }
+        begin
+          ForceUrgency := True;
+          UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
+          Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
+          uDfltUrgency := Urgency;
+        end
+      else
+        begin                 { list of urgencies }
+          ExtractItems(UrgencyList, LoadData, 'Urgencies');
+          if StrToIntDef(LRFURG, 0) > 0 then
+            Urgency := StrToInt(LRFURG)
+          else
+            Urgency := uDfltUrgency;
+        end;
       Comment := TStringList.Create ;
       CurWardComment := TStringList.Create;
 …
           OneSamp := TStringList.Create;
           try
             OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
+            FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
             FillCollSampList(OneSamp, CollSampList.Count);
           finally
 …
   CollSampList.Free;
   SpecimenList.Free;
+  UrgencyList.Free;
   CurWardComment.Free;
   Comment.Free;
 …
     begin
       if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
       AComboBox.Items.Assign(SpecimenList);
+      FastAssign(SpecimenList, AComboBox.Items);
       AComboBox.Items.Add('0^Other...');
       with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
 …
 end;
+procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
+var
+  i: integer;
+begin
+  if UrgencyList.Count < 1 then Exit;
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to UrgencyList.Count - 1 do
+         if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
+           Continue
+         else
+           Items.Add(UrgencyList[i]);
+      if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
+        SelectByID(LRFURG)
+      else
+        SelectByIEN(uDfltUrgency);
+      Urgency := AComboBox.ItemIEN;
+    end;
+end;
 function TLabTest.NameOfCollSamp: string;
 var
 …
 end;
+function TLabTest.NameOfUrgency: string;
+var
+  i: Integer;
+begin
+  Result := '';
+  with UrgencyList do for i := 0 to Count - 1 do
+  begin
+    if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
+      then Result := Piece(Strings[i], '^', 2);
+    break;
+  end;
+end;
 function TLabTest.ObtainCollSamp: Boolean;
 begin
 …
 end;
+function TLabTest.ObtainUrgency: Boolean;
+begin
+  Result := not ForceUrgency;
+end;
 function TLabTest.ObtainComment: Boolean;
 begin
 …
 end;
+procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
+begin
+  ExtractItems(Outlist, AList,'REASONS');
+end;
 procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
 begin
 …
 end;
+procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
+begin
+  ExtractItems(Outlist, AList,'TNS ORDERS');
+end;
 procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
 begin
 …
 begin
   ExtractItems(OutList, AList, 'TYPE AND SCREEN');
+end;
+procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
+begin
+  ExtractItems(OutList, AList, 'OTHER');
 end;
 …
   inherited;
   if uSelectedItems.Count < 1 then
+    SetError(TX_NO_TESTS);
+    begin
+      SetError(TX_NO_TESTS);
+      Exit;
+    end;
   if uGetTns = 1 then
+    SetError(TX_TNS_REQUIRED);
+    begin
+      SetError(TX_TNS_REQUIRED);
+      Exit;
+    end;
+  ValidateAdd(AnErrMsg);
 end;
 …
 var
+  i, CmtType, DaysofFuturePast: integer;
+  aList: TStringList;
+  i, DaysofFuturePast: integer;
   d1, d2: TDateTime;
   x: string;
+  x,test,aOther: string;
 const
   {Diagnostic Test Errors}
   TX_NO_TIME        = 'Collection Time is required.' ;
   TX_NO_TCOLLTYPE   = 'Collection Type is required.' ;
   TX_NO_TESTS       = 'A Lab Test or tests must be selected.' ;
+  TX_NO_TIME        = 'Collection Time is required' ;
+  TX_NO_TCOLLTYPE   = 'Collection Type is required' ;
+  TX_NO_TESTS       = 'A Lab Test or tests must be selected' ;
   TX_BAD_TIME       = 'Collection times must be chosen from the drop down list or entered as valid' +
                       ' Fileman date/times (T@1700, T+1@0800, etc.).' ;
   TX_PAST_TIME      = 'Collection times in the past are not allowed.';
   TX_NO_DAYS        = 'A number of days must be entered for continuous orders.';
   TX_NO_TIMES       = 'A number of times must be entered for continuous orders.';
   TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days".';
+                      ' Fileman date/times (T@1700, T+1@0800, etc.)' ;
+  TX_PAST_TIME      = 'Collection times in the past are not allowed';
+  TX_NO_DAYS        = 'A number of days must be entered for continuous orders';
+  TX_NO_TIMES       = 'A number of times must be entered for continuous orders';
+  TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days"';
   TX_TOO_MANY_DAYS  = 'Maximum number of days allowed is ';
   TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is:  X';
   //TX_NO_COMMENT     = 'A comment is required for this test and collection sample.';
   TX_NUMERIC_REQD   = 'A numeric value is required for urine volume.';
   TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order.';
   TX_TDM_REQD       = 'A value for LEVEL is required for this order.';
+  TX_NUMERIC_REQD   = 'A numeric value is required for urine volume';
+  TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order';
+  TX_TDM_REQD       = 'A value for LEVEL is required for this order';
   //TX_ANTICOAG_REQD  = 'You must specify an anticoagulant on this order.' ;
   TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified.';
   TX_NO_SPECIMEN    = 'A specimen MUST be specified.';
   TX_NO_URGENCY     = 'An urgency MUST be specified.';
   TX_NO_FREQUENCY   = 'A collection frequency MUST be specified.';
   TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
   TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
+  TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified';
+  TX_NO_SPECIMEN    = 'A specimen MUST be specified';
+  TX_NO_URGENCY     = 'An urgency MUST be specified';
+  TX_NO_FREQUENCY   = 'A collection frequency MUST be specified';
+  TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
+  TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
   TX_BADTIME_CAP    = 'Invalid Immediate Collect Time';
   {Component/Type & Screen Errors}
   TX_NO_COMPONENTS  = 'A Blood Product MUST be selected.';
   TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity".';
   TX_HIGH_QUANTITY  = 'Quantity too high.';
+  TX_NO_COMPONENTS  = 'A Blood Product MUST be selected';
+  TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity"';
+  TX_HIGH_QUANTITY  = 'Quantity too high';
   TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
-  //TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';
   TX_NO_SURGERY     = 'A Surgery MUST be specified for Pre-Op orders';         //only if Pre-op selected
   TX_NO_REASON      = 'A Reason for Request MUST be entered';
+  TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
+  TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
   TX_NO_COMMENT     = 'A Comment MUST be entered for this Component';
   TX_DUPLICATE      = 'Duplicate Test/Component not allowed';
 …
   inherited;
   AnErrMsg := '';
+  if aLabTest = nil then
+    begin
+      AnErrMsg := TX_NO_TEST_SELECTED;
+      Exit;
+    end;
+  for i := 0 to uSelectedItems.Count - 1 do
+    if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then
+  aList := TStringList.Create;
+  try
+    ExtractOther(aList, uVBECList);
+    if aList.Count > 0 then aOther := aList[0];
+    aList.Clear;
+    if uSelectedItems.Count < 1 then
       begin
         AnErrMsg := TX_DUPLICATE;
+        AnErrMsg := TX_NO_TEST_SELECTED;
         Exit;
       end;
+  if LRORDERMODE = TORDER_MODE_DIAG then
+    begin
+      with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
+      if ALabTest <> nil then
+        if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
+    for i := 0 to uSelectedItems.Count - 1 do
+      begin
+        x := uSelectedItems[i];
+        test := lvSelectionList.Items[i].Caption;
+        if piece(x,'^',1) = '1' then    //Diagnostic Test
           begin
+            SetError(TX_NO_IMMED);
+            cboCollType.ItemIndex := -1;
+            if uSpecimen = 0 then
+              if cboCollType.ItemID = '' then
+                SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
+              else if cboCollType.ItemID = 'LC' then
+                begin
+                 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
+                 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
+                   begin
+                     if StrToFMDateTime(Text) < 0 then
+                       SetError(TX_BAD_TIME + ' (' + test + ')')
+                     else if StrToFMDateTime(Text) < FMNow then
+                       SetError(TX_PAST_TIME + ' (' + test + ')')
+                     else if OrderForInpatient then
+                       begin
+                         d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
+                         d2 := FMDateTimeToDateTime(FMToday);
+                         if EvtDelayLoc > 0 then
+                           DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
+                         else
+                           DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
+                         if DaysofFuturePast = 0 then DaysofFuturePast := 7;
+                         if ((d1 - d2) > DaysofFuturePast) then
+                           SetError('A lab collection cannot be ordered more than '
+                             + IntToStr(DaysofFuturePast) + ' days in advance');
+                       end
+                     else if EvtDelayLoc > 0 then
+                       begin
+                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
+                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
+                       end
+                     else if EvtDelayLoc <= 0 then
+                       begin
+                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
+                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
+                       end;
+                   end;
+                end
+              else
+                begin
+                  if cboCollType.ItemID = 'I' then
+                    begin
+                      calCollTime.Text := txtImmedColl.Text;
+                      x := ValidImmCollTime(calCollTime.FMDateTime);
+                      if (Piece(x, U, 1) <> '1') then
+                        SetError(Piece(x, U, 2));
+                    end;
+                  with calColltime do
+                    begin
+                      if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
+                      else
+                        begin
+                          // date only was entered
+                          if (FMDateTime - Trunc(FMDateTime) = 0) then
+                            begin
+                              if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
+                            end
+                          // date/time was entered
+                          else
+                            begin
+                              if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
+                            end;
+                        end;
+                    end;
+                end;
+            with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
+          end
+        else                            //Component
+          begin
+            if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
+              else
+                begin
+                  if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
+                  if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
+                end;
+            if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
+            if (cboReasons.Text = '') and not(uReason = '') then
+              begin
+                SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
+                cboReasons.Text := uReason; //reset reason back to previous value
+              end;
+              if (cboReasons.Text = '') then
+                begin
+                  SetError(TX_NO_REASON + ' (' + test + ').');
+                end;
+            if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
+            if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
+            if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
+            if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
           end;
+      if uSpecimen = 0 then
+        if cboCollType.ItemID = '' then
+          SetError(TX_NO_TCOLLTYPE)
+        else if cboCollType.ItemID = 'LC' then
+          begin
+           if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
+           with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
+             begin
+               if StrToFMDateTime(Text) < 0 then
+                 SetError(TX_BAD_TIME)
+               else if StrToFMDateTime(Text) < FMNow then
+                 SetError(TX_PAST_TIME)
+               else if OrderForInpatient then
+                 begin
+                   d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
+                   d2 := FMDateTimeToDateTime(FMToday);
+                   if EvtDelayLoc > 0 then
+                     DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
+                   else
+                     DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
+                   if DaysofFuturePast = 0 then DaysofFuturePast := 7;
+                   if ((d1 - d2) > DaysofFuturePast) then
+                     SetError('A lab collection cannot be ordered more than '
+                       + IntToStr(DaysofFuturePast) + ' days in advance');
+                 end
+               else if EvtDelayLoc > 0 then
+                 begin
+                   if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
+                     SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
+                 end
+               else if EvtDelayLoc <= 0 then
+                 begin
+                   if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
+                     SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
+                 end;
+             end;
+          end
+        else
+          begin
+            if cboCollType.ItemID = 'I' then
+              begin
+                calCollTime.Text := txtImmedColl.Text;
+                x := ValidImmCollTime(calCollTime.FMDateTime);
+                if (Piece(x, U, 1) <> '1') then
+                  SetError(Piece(x, U, 2));
+              end;
+            with calColltime do
+              begin
+                if FMDateTime = 0 then SetError(TX_BAD_TIME)
+                else
+                  begin
+                    // date only was entered
+                    if (FMDateTime - Trunc(FMDateTime) = 0) then
+                      begin
+                        if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
+                      end
+                    // date/time was entered
+                    else
+                      begin
+                        if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
+                      end;
+                  end;
+              end;
+          end;
+      with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY);
+      if ALabTest <> nil then
+        begin
+          CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
+          with ALabTest do
+          case CmtType of
+: {ANTICOAGULATION}         {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
+                                         SetError(TX_ANTICOAG_REQD)};
+: {DOSE/DRAW TIMES}         if (Pos('Last dose:',Comment.Text)=0) or
+                                          (Pos('draw time:',Comment.Text)=0) then
+                                         SetError(TX_DOSEDRAW_REQD);
+: {ORDER COMMENT}           {if (Length(Comment.Text)=0) then
+                                         SetError(TX_NO_COMMENT)};
+: {ORDER COMMENT MODIFIED}  {if (Length(Comment.Text)=0) then
+                                         SetError(TX_NO_COMMENT)};
+: {TDM (PEAK-TROUGH}        if (Pos('Dose is expected',Comment.Text)=0) then
+                                         SetError(TX_TDM_REQD);
+: {TRANSFUSION}             {if (Length(Comment.Text)=0) then
+                                         SetError(TX_NO_COMMENT)};
+: {URINE VOLUME}            if (Length(Comment.Text)>0) and
+                                       (ExtractInteger(Comment.Text)<=0) then
+                                          Comment.Text := '?';
+                                         {SetError(TX_NUMERIC_REQD);}
+          end;
+        end;
+    end
+  else if LRORDERMODE = TORDER_MODE_COMP then
+    begin
+      with cboAvailComp do
+        begin
+          if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS);
+        end;
+      if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY);
+      if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED);
+      //if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION);
+      if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY);
+      if tReason.Text = '' then SetError(TX_NO_REASON);
+      if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT);
+      if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY);
+    end;
+      end;
+  finally
+    aList.Free;
+  end;
 end;
 …
 end;
+procedure TfrmODBBank.cboQuickClick(Sender: TObject);
+begin
+  inherited;
+  SetOnQuickOrder;
+end;
+procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
+begin
+  inherited;
+  if (length(cboReasons.Text) > 75) then
+    begin
+      ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
+      cboReasons.Text := Copy(cboReasons.Text,0,75);
+      Exit;
+    end;
+  if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
+  memOrder.Text := Responses.OrderText;
+end;
+procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
+begin
+  inherited;
+  if Length(cboReasons.Text) > 0 then
+    uReason := cboReasons.Text;
+end;
+procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
+begin
+  inherited;
+  if Length(cboReasons.Text) > 0 then
+    uReason := cboReasons.Text;
+end;
 procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
 var
-  x: string;
   i: integer;
+begin
+  DisableComponentControls;
+  EnableDiagTestControls;
+  LRORDERMODE := TORDER_MODE_DIAG;
+  with cboAvailTest do
+    begin
+      if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
+  text : string;
+  ListItem: TListItem;
+  aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string;
+  aList: TStringList;
+  curAdd,AnInstance,aTNS,aTNSDays: Integer;
+  sub,sub1: string;
+  AResponse: TResponse;
+begin
+  if cboAvailTest.ItemID = '' then Exit;
+  aList := TStringList.Create;
+  try
+    ALabTest := nil;
+    aTypeScreen := '';
+    aSpecimen := '^';
+    aTestYes := '1';
+    aModifier := '';
+    changing := true;
+    tQuantity.Text := '';
+    sub1 := '';
+    cboModifiers.ItemIndex := -1;
+    DisableComponentControls;
+    EnableDiagTestControls;
+    LRORDERMODE := TORDER_MODE_DIAG;
+    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
+    sub := GetSubtype(ALabTest.TestName);
+    with CtrlInits do
+        begin
+          SetControl(cboCollType, 'Collection Types');
+          LoadCollType(cboCollType);
+          if FLastCollType <> '' then
+            cboCollType.SelectByID(FLastCollType)
+          else if uDfltCollType <> '' then
+            cboCollType.SelectByID(uDfltCollType)
+          else if OrderForInpatient then
+            if (ALabTest.LabCanCollect) then
+              cboCollType.SelectByID('LC')
+            else
+              cboCollType.SelectByID('WC')
+          else
+            cboCollType.SelectByID('SP');
+          SetupCollTimes(cboCollType.ItemID);
+        end;
+    with cboAvailTest do
+      begin
+        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
+        FLastLabID := ItemID ;
+        FLastItemID := ItemID;
+        for i := 0 to uSelectedItems.Count - 1 do
+          if ItemID = piece(uSelectedItems[i],'^',2) then
+            begin
+              ItemIndex := -1;
+              lvSelectionList.Items[i].Selected := true;
+              lvSelectionListClick(self);
+              Exit;
+            end;
+        Changing := True;
+        Changing := False;
+        ExtractTypeScreen(aList, uVBECList);
+        if aList.Count > 0 then aTypeScreen := aList[0];
+        aList.Clear;
+        aTNSString := '';
+        if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
+          begin
+            for i := 0 to uTNSOrders.Count - 1 do
+              aTNSString := aTNSString + CRLF + uTNSOrders[i];
+            with Application do
+              begin
+                NormalizeTopMosts;
+                aTNSDays := TNSDaysBack;
+                aTNS :=
+                  MessageBox(PChar(aTNSString + CRLF + CRLF +
+                             'Do you wish to continue?'),
+                             PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
+                             MB_YESNO);
+                RestoreTopMosts;
+                if aTNS = 7 then
+                  begin
+                    cboAvailTest.ItemIndex := -1;
+                    exit;
+                  end;
+              end;
+          end;
+        if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
+          begin
+            if ObtainCollSamp then
+              begin
+              //For BloodBank orders, this condition should never occur
+              end
+            else
+              begin
+                with ALabTest do
+                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+                    begin
+                      x := '' ;
+                      for i := 0 to WardComment.Count-1 do
+                      x := x + WardComment.strings[i]+#13#10 ;
+                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+                      OrderMessage(x) ;
+                    end ;
+              end;
+        end;
+        Changing := False;
+      end;
+    if LRORDERMODE = TORDER_MODE_DIAG then
+      begin
+        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+        with cboCollType do if Length(ItemID) > 0 then
+          begin
+            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+            FLastCollType := ItemID;
+          end;
+        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
+        else
+          begin
+            cboUrgency.ItemIndex := 1;
+            Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+          end;
+        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
+        if cboCollType.ItemID = 'LC' then
+          begin
+            with cboCollTime do
+              if Length(ItemID) > 0 then
+                begin
+                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
+                  FLastLabCollTime := ItemID + U + Text;
+                end
+              else if Length(Text) > 0 then
+                begin
+                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
+                  FLastLabCollTime := ValidCollTime(Text);
+                end;
+          end
+          else
+            begin
+              with calCollTime do
+                if FMDateTime > 0 then
+                  begin
+                    Responses.Update('START', 1, ValidCollTime(Text), Text);
+                    FLastColltime := ValidCollTime(Text);
+                  end
+                else
+                  begin
+                    Responses.Update('START', 1, '', '') ;
+                    FLastCollTime := '';
+                  end;
+            end;
+          if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
+      end;
+    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
+    uTestSelected := true;
+    with lvSelectionList do
+      begin
+        ListItem := Items.Add;
+        ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
+        ListItem.SubItems.Add('');
+        ListItem.SubItems.Add('');
+        ListItem.SubItems.Add('');
+        ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
+        if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
+          begin
+            lblTNS.Caption := '';
+            lblTNS.Visible := false;
+            memMessage.Text := '';
+            pnlMessage.Visible := false;
+            uGetTnS := 0;
+            pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+          end;
+      end;
+    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
+    uSelectedItems.Add(aStr);
+    CurAdd := 1;
+    for i := 0 to uSelectedItems.Count - 1 do
+      begin
+        aName := lvSelectionList.Items[i].Caption;
+        x := uSelectedItems[i];
+        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+          end;
+        Inc(CurAdd);
+      end;
+    memOrder.Text := Responses.OrderText;
+  finally
+    aList.Free;
+  end;
+  edtResults.Height := 247;
+  edtInfo.Height := 247;
+  if lvSelectionList.Items.Count > 0 then
+    begin
+      pnlSelectedTests.Visible := True;
+      cmdAccept.Visible := True;
+      memOrder.Visible := True;
+      GroupBox1.Visible := False;
+    end;
+end;
+procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
+ var
+  aList,aTests: TStringList;
+  i,j,k,getTest,TestAdded: integer;
+  text : string;
+  aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
+  sub,sub1: string;
+  AResponse: TResponse;
+  ListItem: TListItem;
+  aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String;
+begin
+  if cboAvailComp.ItemID = '' then Exit;
+  aList := TStringList.Create;
+  aTests := TStringList.Create;
+  sub1 := '';
+  try
+    DisableDiagTestControls;
+    EnableComponentControls;
+    if not(changing = true) then
+      begin
+        changing := true;
+        tQuantity.Text := '';
+        cboModifiers.ItemIndex := -1;
+        changing := false;
+      end;
+    LRORDERMODE := TORDER_MODE_COMP;
+    with cboAvailComp do
+      begin
+        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
+        FLastLabID := ItemID ;
+        FLastItemID := ItemID;
+        for i := 0 to uSelectedItems.Count - 1 do
+          if ItemID = piece(uSelectedItems[i],'^',2) then
+            begin
+              ItemIndex := -1;
+              lvSelectionList.Items[i].Selected := true;
+              lvSelectionListClick(self);
+              Exit;
+            end;
+        ALabTest := TLabTest.Create(ItemID, Responses);
+        sub := GetSubtype(ALabTest.TestName);
+        Changing := False;
+        StatusText('');
+      end;
+    //Check for and display any associated Lab Results
+    aList.Clear;
+    TestAdded := 0;
+    getTest := 0;
+    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
+      for j := 0 to aList.Count - 1 do
+        begin
+          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
+            begin
+              if uTestsForResults.Count < 1 then getTest := 1;
+              for k := 0 to uTestsForResults.Count - 1 do
+                begin
+                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
+                    begin
+                      getTest := 0;
+                      break;
+                    end
+                  else getTest := 1;
+                end;
+              if getTest = 1 then
+                begin
+                  uTestsForResults.Add(piece(aList[j],'^',3));
+                  TestAdded := 1;
+                end;
+            end;
+        end;
+      if TestAdded = 1 then
+        begin
+          edtResults.Clear;
+          aTests.Clear;
+          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
+          QuickCopy(ATests,edtResults);
+          if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available';
+          uRaw.Clear;
+          GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
+        end;
+      CurAdd := 1;
+      if uRaw.Count > 0 then
+      for j := 0 to uRaw.Count - 1 do
+        begin
+          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
+          Inc(CurAdd);
+        end;
+    aTypeScreen := '';
+    aSpecimen := '^';
+    aTestYes := '0';
+    aReason := '';
+    aSurgery := '';
+    aCollTime := '';
+    aList.Clear;
+    ExtractTypeScreen(aList, uVBECList);
+    if aList.Count > 0 then aTypeScreen := aList[0];
+    aList.Clear;
+    ExtractSpecimen(aList, uVBECList);
+    if aList.Count > 0 then aSpecimen := aList[0];
+    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
+    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
+    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
+    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
+    if Length(cboSurgery.ItemID) > 0 then
+      begin
+        aList.Clear;
+        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
+        for i := 0 to aList.Count - 1 do
+          begin
+            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+             and (piece(aList[i],'^',3) = cboSurgery.Text) then
+              begin
+                aMSBOS := StrToInt(piece(aList[i],'^',4));
+                if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
+                  begin
+                    with Application do
+                    begin
+                      NormalizeTopMosts;
+                      aMSBOSContinue :=
+                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
+                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
+                                   + IntToStr(aMSBOS) +
+                                   ') for the ' + cboSurgery.text +
+                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
+                                   PChar('Maximum Number of Units Exceeded'),
+                                   MB_YESNO);
+                      RestoreTopMosts;
+                    end;
+                    if aMSBOSContinue = 7 then
+                      begin
+                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
+                        exit;
+                      end;
+                  end;
+              end;
+          end;
+      end;
+    if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
+      begin
+        uGetTnS := 1;
+        for i := 0 to lvSelectionList.Items.Count - 1 do
+          begin
+            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
+              begin
+                uGetTnS := 0;
+                if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
+                lblTNS.Caption := '';
+                lblTNS.Visible := false;
+                memMessage.Text := '';
+                pnlMessage.Visible := false;
+                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+                break;
+              end;
+          end;
+      end;
+    aList.Clear;
+    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
+    for i := 0 to aList.Count - 1 do
+      begin
+        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
+          begin
+            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
+            break;
+          end;
+      end;
+    uComponentSelected := true;
+    with lvSelectionList do
+      begin
+        ListItem := Items.Add;
+        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
+        ListItem.SubItems.Add(tQuantity.Text);
+        if length(cboModifiers.ItemID) > 0 then
+          begin
+            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
+            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
+          end
+          else
+            begin
+              ListItem.SubItems.Add('');
+              ListItem.SubItems.Add('');
+            end;
+        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+      end;
+      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
+      uSelectedItems.Add(aStr);
+      CurAdd := 1;
       for i := 0 to uSelectedItems.Count - 1 do
+        if ItemID = piece(uSelectedItems[i],'^',1) then
+        begin
+          aName := lvSelectionList.Items[i].Caption;
+          x := uSelectedItems[i];
+          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+            begin
+              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+            end
+          else
+            begin
+              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+              if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+              if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
+              if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+              if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+              if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+              if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
+                else
+                  begin
+                    cboUrgency.ItemIndex := 1;
+                    Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+                  end;
+            end;
+          Inc(CurAdd);
+        end;
+      memOrder.Text := Responses.OrderText;
+  finally
+    alist.Free;
+    aTests.Free;
+  end;
+  aMsg := '';
+  LRORDERMODE := TORDER_MODE_INFO;
+  if uGetTnS = 1 then
+    begin
+      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+      lblTNS.Visible := true;
+      memMessage.Text := 'TYPE + SCREEN must be added to order';
+      pnlMessage.Visible := true;
+      pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
+    end;
+  {if uGetTnS = 1 then
+    begin
+      if responses.QuickOrder < 1 then
+        begin
+          for i := 1 to cboAvailTest.Items.Count - 1 do
+            begin
+              if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
+                begin
+                  if piece(aSpecimen,'^',1) = '1' then
+                    begin
+                      cboCollTime.Text := calWantTime.Text;
+                      aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
+                      cboCollTime.Text := '';
+                      cboCollType.Text := '';
+                      uSpecimen := 1;
+                    end;
+                  cboModifiers.Text := '';
+                  cboAvailTest.SelectByID(aTypeScreen);
+                  cboTests.SelectByID(aTypeScreen);
+                  cboTestsClick(self);
+                  //cboAvailTestSelect(Self);
+                  uSpecimen := 0;
+                  cboCollTime.Text := piece(aCollSave,'^',1);
+                  cboCollType.Text := piece(aCollSave,'^',3);
+                  aCollSave := '';
+                  break;
+                end;
+            end;
+          aMsg := 'An order for Type and Screen has been added to this request' + '.';
+        end
+        else
           begin
+            ShowMessage('This test has already been selected!');
+            Exit;
+            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+            lblTNS.Visible := true;
+            memMessage.Text := 'TYPE + SCREEN must be added to order';
+            memMessage.Visible := false;
+            pnlMessage.Visible := true;
           end;
+      FLastLabID := ItemID ;
+      FLastItemID := ItemID;
+      Changing := True;
+      if Sender <> Self then
+        Responses.Clear;       // Sender=Self when called from SetupDialog
+      if CharAt(ItemID, 1) = 'Q' then
+        with Responses do
+          begin
+            FLastItemID := ItemID;
+            QuickOrder := ExtractInteger(ItemID);
+            SetControl(cboAvailTest, 'ORDERABLE', 1);
+            if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
+            FLastLabID := ItemID;
+          end;
+      ALabTest := TLabTest.Create(ItemID, Responses);
+    end;
+  with ALabTest do
+  begin
+    {with Responses do if QuickOrder > 0 then
+     begin
+      StatusText('Initializing Quick Order');
+      Changing := True;
+      SetControl(cboAvailTest,       'ORDERABLE', 1);
+      DetermineCollectionDefaults(Responses);
+      LoadUrgency(cboCollType.ItemID, cboUrgency);
+      SetControl(cboUrgency,         'URGENCY', 1);
+      Urgency := cboUrgency.ItemIEN;
+      if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
+        begin
+          cboUrgency.ItemIndex := 0;
+          Urgency := cboUrgency.ItemIEN;
+        end;
+      tmpResp := FindResponseByName('SPECIMEN'  ,1);
+      i := 1 ;
+      tmpResp := Responses.FindResponseByName('COMMENT',i);
+      while tmpResp <> nil do
+        begin
+          Comment.Add(tmpResp.EValue);
+          Inc(i);
+          tmpResp := Responses.FindResponseByName('COMMENT',i);
+        end ;
+      end;  //  Quick Order}
+    if ObtainCollSamp then
+      begin
+        //For BloodBank orders, this condition should never occur
+      end
+      end;
+  if (uGetTnS = 1) then
+    begin
+      if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
+      ShowMsg(aMsg);
+    end;  }
+  edtResults.Height := 247;
+  edtInfo.Height := 247;
+  if lvSelectionList.Items.Count > 0 then
+    begin
+      pnlSelectedTests.Visible := True;
+      cmdAccept.Visible := True;
+      memOrder.Visible := True;
+      GroupBox1.Visible := False;
+    end;
+  if tQuantity.CanFocus = true then tQuantity.SetFocus;
+end;
+procedure TfrmODBBank.DisableCommentPanels;
+begin
+  lblReqComment.Visible := False;
+end;
+procedure TfrmODBBank.DisableComponentControls;
+begin
+  lblQuantity.Enabled := false;
+  tQuantity.Enabled := false;
+  lblModifiers.Enabled := false;
+  cboModifiers.Enabled := false;
+  cboAvailComp.ItemIndex := -1;
+end;
+procedure TfrmODBBank.EnableComponentControls;
+begin
+  lblQuantity.Enabled := true;
+  tQuantity.Enabled := true;
+  lblModifiers.Enabled := true;
+  cboModifiers.Enabled := true;
+  if not(changing) then
+    if not(uSelUrgency = 'PRE-OP') then
+      if uSelUrgency = '' then
+        if lvSelectionList.Items.Count < 1 then
+          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
+  if cboUrgency.Text = 'PRE-OP' then
+    begin
+      lblSurgery.Enabled := true;
+      cboSurgery.Enabled := true;
+      lblSurgery.Caption := 'Surgery*';
+    end
     else
       begin
+        with ALabTest do
+          with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
+            begin
+              x := '' ;
+              for i := 0 to WardComment.Count-1 do
+                x := x + WardComment.strings[i]+#13#10 ;
+              pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
+              OrderMessage(x) ;
+            end ;
+        lblSurgery.Enabled := false;
+        cboSurgery.Enabled := false;
+        lblSurgery.Caption := 'Surgery';
       end;
-    if ObtainComment then
-      LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
-    else
-      DisableCommentPanels;
-    x := '' ;
-    for i := 0 to CurWardComment.Count-1 do
-      x := x + CurWardComment.strings[i]+#13#10 ;
-    i :=  IndexOfCollSamp(CollSamp);
-    if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
-       for i := 0 to WardComment.Count-1 do
-         x := x + WardComment.strings[i]+#13#10 ;
-    pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
-    OrderMessage(x) ;
-   end; { with }
-  StatusText('');
-  Changing := False;
-end;
-procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
-var
-  x: string;
-  i: integer;
-begin
-  DisableDiagTestControls;
-  EnableComponentControls;
-  LRORDERMODE := TORDER_MODE_COMP;
-  with cboAvailComp do
-    begin
-      if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
-      for i := 0 to uSelectedItems.Count - 1 do
-        if ItemID = piece(uSelectedItems[i],'^',1) then
-          begin
-            ShowMessage('This component has already been selected!');
-            Exit;
-          end;
-      FLastLabID := ItemID ;
-      FLastItemID := ItemID;
-      Changing := True;
-      if Sender <> Self then
-        Responses.Clear;       // Sender=Self when called from SetupDialog
-      if CharAt(ItemID, 1) = 'Q' then
-        with Responses do
-          begin
-            FLastItemID := ItemID;
-            QuickOrder := ExtractInteger(ItemID);
-            SetControl(cboAvailComp, 'ORDERABLE', 1);
-            if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
-            FLastLabID := ItemID;
-          end;
-      ALabTest := TLabTest.Create(ItemID, Responses);
-    end;
-  with ALabTest do
-  begin
-    {with Responses do if QuickOrder > 0 then
-     begin
-      StatusText('Initializing Quick Order');
-      Changing := True;
-      SetControl(cboAvailTest,       'ORDERABLE', 1);
-      DetermineCollectionDefaults(Responses);
-      LoadUrgency(cboCollType.ItemID, cboUrgency);
-      SetControl(cboUrgency,         'URGENCY', 1);
-      Urgency := cboUrgency.ItemIEN;
-      if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
-        begin
-          cboUrgency.ItemIndex := 0;
-          Urgency := cboUrgency.ItemIEN;
-        end;
-      tmpResp := FindResponseByName('SPECIMEN'  ,1);
-      i := 1 ;
-      tmpResp := Responses.FindResponseByName('COMMENT',i);
-      while tmpResp <> nil do
-        begin
-          Comment.Add(tmpResp.EValue);
-          Inc(i);
-          tmpResp := Responses.FindResponseByName('COMMENT',i);
-        end ;
-      end;  //  Quick Order}
-    {if ObtainCollSamp then
-      begin
-        // should not occur with Blood orders
-      end
-    else
-      begin
-        with ALabTest do
-          with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
-            begin
-              x := '' ;
-              for i := 0 to WardComment.Count-1 do
-                x := x + WardComment.strings[i]+#13#10 ;
-              pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
-              OrderMessage(x) ;
-            end ;
-      end;
+     }
-    if ObtainComment then
-      LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
-    else
-      DisableCommentPanels;
-    x := '' ;
-    for i := 0 to CurWardComment.Count-1 do
-      x := x + CurWardComment.strings[i]+#13#10 ;
-    i :=  IndexOfCollSamp(CollSamp);
-    if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
-       for i := 0 to WardComment.Count-1 do
-         x := x + WardComment.strings[i]+#13#10 ;
-    pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;
-    OrderMessage(x) ;
-   end; { with }
-  StatusText('');
-  Changing := False;
-end;
-procedure TfrmODBBank.DisableCommentPanels;
-begin
-  lblReqComment.Visible := False;
-end;
-procedure TfrmODBBank.DisableComponentControls;
-begin
-  lblModifiers.Enabled := false;
-  cboModifiers.Enabled := false;
-  lblWanted.Enabled := false;
-  calWantTime.Enabled := false;
-  //lblPreparation.Enabled := false;
-  //cboPreparation.Enabled := false;
-  lblSurgery.Enabled := false;
-  cboSurgery.Enabled := false;
-  lblReason.Enabled := false;
-  tReason.Enabled := false;
-  chkConsent.Enabled := false;
-  lblQuantity.Enabled := false;
-  tQuantity.Enabled := false;
-  upQuantity.Enabled := false;
-  cboAvailComp.ItemIndex := -1;
-  tQuantity.Text := '0';
-end;
-procedure TfrmODBBank.EnableComponentControls;
-begin
-  lblModifiers.Enabled := true;
-  cboModifiers.Enabled := true;
-  lblWanted.Enabled := true;
-  calWantTime.Enabled := true;
-  //lblPreparation.Enabled := true;
-  //cboPreparation.Enabled := true;
-  if cboUrgency.Text = 'PRE-OP' then
-    begin
-      lblSurgery.Enabled := true;
-      cboSurgery.Enabled := true;
-    end;
-  lblReason.Enabled := true;
-  tReason.Enabled := true;
-  chkConsent.Enabled := true;
-  lblQuantity.Enabled := true;
-  tQuantity.Enabled := true;
-  upQuantity.Enabled := true;
-  txtDiagComment.Enabled := true;
   lblDiagComment.Enabled := true;
 end;
 …
   calCollTime.Enabled := false;
   cboCollTime.Enabled := false;
-  cboAvailTest.ItemIndex := -1;
   lblCollType.Enabled := false;
   cboCollType.Enabled := false;
   cmdImmedColl.Enabled := false;
+  cboAvailTest.ItemIndex := -1;
+  cboAvailTest.InitLongList('');
 end;
 procedure TfrmODBBank.EnableDiagTestControls;
 begin
-  calWantTime.Enabled := true;
-  lblWanted.Enabled := true;
   lblCollTime.Enabled := true;
   calCollTime.Enabled := true;
 …
   lblCollType.Enabled := true;
   cboCollType.Enabled := true;
-  lblUrgency.Enabled := true;
-  cboUrgency.Enabled := true;
-  txtDiagComment.Enabled := true;
-  lblDiagComment.Enabled := true;
   cmdImmedColl.Enabled := true;
+  if not(changing) then
+    if not(uSelUrgency = 'PRE-OP') then
+      if uSelUrgency = '' then
+        if lvSelectionList.Items.Count < 1 then
+          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
 end;
 …
 begin
   if ALabTest = nil then exit;
+  if ALabTest.LabSubscript = 'BB' then exit;
   calCollTime.Clear;
   cboCollTime.Clear;
 …
 end;
+procedure TfrmODBBank.cboAvailCompChange(Sender: TObject);
+begin
+  inherited;
+  changing := true;
+  changing := false;
+end;
 procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
 begin
 …
   inherited;
   case pgeProduct.TabIndex of
+  TI_ORDER :     begin
+                  memMessage.Visible := true;
+  TI_COMPONENT :     begin
                   memOrder.Visible := true;
                   cmdAccept.Visible := true;
                   pnlSelectedTests.Visible := true;
                   pgeProduct.Height := 281;
+                  lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
                 end;
   TI_INFO :     begin
+                  if lvSelectionList.Items.Count > 0 then exit;
+                  LRORDERMODE := TORDER_MODE_INFO;
+                  memMessage.Visible := false;
+                  memOrder.Visible := false;
+                  cmdAccept.Visible := false;
+                  pnlSelectedTests.Visible := false;
+                  pgeProduct.Height := 411;
+                  if lvSelectionList.Items.Count > 0 then
+                  begin
+                    memOrder.Visible := true;
+                    cmdAccept.Visible := true;
+                    pnlSelectedTests.Visible := true;
+                  end
+                  else
+                  begin
+                    memOrder.Visible := false;
+                    cmdAccept.Visible := false;
+                    pnlSelectedTests.Visible := false;
+                  end;
                 end;
   TI_RESULTS :  begin
+                  if lvSelectionList.Items.Count > 0 then exit;
+                  memMessage.Visible := false;
+                  memOrder.Visible := false;
+                  cmdAccept.Visible := false;
+                  pnlSelectedTests.Visible := false;
+                  pgeProduct.Height := 411;
+                  if lvSelectionList.Items.Count > 0 then
+                  begin
+                    memOrder.Visible := true;
+                    cmdAccept.Visible := true;
+                    pnlSelectedTests.Visible := true;
+                  end
+                  else
+                  begin
+                    memOrder.Visible := false;
+                    cmdAccept.Visible := false;
+                    pnlSelectedTests.Visible := false;
+                  end;
                 end;
   end; {case}
 end;
+procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
+begin
+  if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
+  if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
+    begin
+      InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
+      cboCollType.ItemIndex := -1;
+      Exit;
+    end;
+  SetupCollTimes(cboCollType.ItemID);
+end;
+procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
+procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
 var
+  i: integer;
+begin
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to uModifierList.Count - 1 do
+           Items.Add(uModifierList[i]);
+    end;
+end;
+procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
+var
+  i: integer;
+begin
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to uUrgencyList.Count - 1 do
+         if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
+           Continue
+         else
+           Items.Add(uUrgencyList[i]);
+    end;
+end;
+procedure TfrmODBBank.btnAddTestsClick(Sender: TObject);
+var
+  aList, aTests, aRaw: TStringList;
+  ListItem: TListItem;
+  aStr, aMsg: String;                  //add independent structures for components, Tests, and associated fields.
+  aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String;
+  CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer;
+  x, name, aTypeScreen: String;
+begin
+  if not ValidAdd then Exit;
+  aList := TStringList.Create;
+  aTests := TStringList.Create;
+  aRaw := TStringList.Create;
+  try
+    aCollType := '';
+    aModifier := '';
+    aPreparation := '';
+    aSurgery := '';
+    aCollTime := '';
+    aTestYes := '0';
+    aTypeScreen := '';
+    uGetTnS := 0;
+    aSpecimen := '';
+    ExtractTypeScreen(aList, uVBECList);
+    if aList.Count > 0 then aTypeScreen := aList[0];
+    aList.Clear;
+    ExtractSpecimen(aList, uVBECList);
+    if aList.Count > 0 then aSpecimen := aList[0];
+    if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1';
+    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
+    //if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex];
+    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
+    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
+    if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then
+      begin
+        uTestSelected := true;
+        with lvSelectionList do
+          begin
+            ListItem := Items.Add;
+            ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
+            ListItem.SubItems.Add('');
+            if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
+              else ListItem.SubItems.Add('');
+            ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
+            if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
+              begin
+                lblTNS.Caption := '';
+                lblTNS.Visible := false;
+              end;
+          end;
+        lblCollTime.Enabled := false;
+        calCollTime.Enabled := false;
+        cboCollTime.Enabled := false;
+        lblCollType.Enabled := false;
+        cboCollType.Enabled := false;
+        cboAvailTest.ItemIndex := -1;
+      end;
+    if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then
+      begin
+        if Length(cboSurgery.ItemID) > 0 then
+          begin
+            aList.Clear;
+            ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
+            for i := 0 to aList.Count - 1 do
+              begin
+                if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+                 and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then
+                  begin
+                    aMSBOS := StrToInt(piece(aList[i],'^',4));
+                    if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
+                      begin
+                        with Application do
+                        begin
+                          NormalizeTopMosts;
+                          aMSBOSContinue :=
+                            MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
+                                       ') exceeds the maximum number of units (' + IntToStr(aMSBOS) +
+                                       ') for the ' + cboSurgery.text +
+                                       ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
+                                       PChar('Maximum Number of Units Exceeded'),
+                                       MB_YESNO);
+                          RestoreTopMosts;
+                        end;
+                        if aMSBOSContinue = 7 then
+                          begin
+                            ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.');
+                            exit;
+                          end;
+                      end;
+                  end;
+              end;
+          end;
+        if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
+          begin
+            uGetTnS := 1;
+            for i := 0 to lvSelectionList.Items.Count - 1 do
+              begin
+                if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
+                  begin
+                    uGetTnS := 0;
+                    uDfltUrgency := cboUrgency.ItemID;
+                    lblTNS.Caption := '';
+                    lblTNS.Visible := false;
+                    break;
+                  end;
+              end;
+          end;
+        aList.Clear;
+        ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
+        for i := 0 to aList.Count - 1 do
+          begin
+            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
+              begin
+                aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
+                break;
+              end;
+          end;
+        uComponentSelected := true;
+        with lvSelectionList do
+          begin
+            ListItem := Items.Add;
+            ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
+            ListItem.SubItems.Add(tQuantity.Text);
+            if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
+              else ListItem.SubItems.Add('');
+            ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+          end;
+        lblWanted.Enabled := false;
+        calWantTime.Enabled := false;
+        //lblPreparation.Enabled := false;
+        //cboPreparation.Enabled := false;
+        lblSurgery.Enabled := false;
+        cboSurgery.Enabled := false;
+        lblReason.Enabled := false;
+        tReason.Enabled := false;
+        chkConsent.Enabled := false;
+        cboAvailComp.ItemIndex := -1;
+      end;
+    if Sender <> Self then
+      Responses.Clear;       // Sender=Self when called from SELF
+    CurAdd := 1;
+    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen;  //aSpecimen has 2 pieces
+    uSelectedItems.Add(aStr);
+    for i := 0 to uSelectedItems.Count - 1 do
+      begin
+        name := lvSelectionList.Items[i].Caption;
+        x := uSelectedItems[i];
+        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
+          end
+        else
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
+            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
+            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+          end;
+        Inc(CurAdd);
+        aList.Clear;
+        TestAdded := 0;
+        getTest := 0;
+        ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
+        for j := 0 to aList.Count - 1 do
+          begin
+            if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
+              begin
+                if uTestsForResults.Count < 1 then getTest := 1;
+                for k := 0 to uTestsForResults.Count - 1 do
+                  begin
+                    if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
+                      begin
+                        getTest := 0;
+                        break;
+                      end
+                    else getTest := 1;
+                  end;
+                if getTest = 1 then
+                  begin
+                    uTestsForResults.Add(piece(aList[j],'^',3));
+                    TestAdded := 1;
+                  end;
+              end;
+          end;
+        if TestAdded = 1 then
+          begin
+            edtResults.Clear;
+            aTests.Clear;
+            GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
+            QuickCopy(ATests,edtResults);
+            if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1;
+            uRaw.Clear;
+            GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
+          end;
+      end;
+    if LRORDERMODE = TORDER_MODE_DIAG then
+      begin
+        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+        with cboCollType do if Length(ItemID) > 0 then
+          begin
+            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+            FLastCollType := ItemID;
+          end;
+        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+        if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
+        if cboCollType.ItemID = 'LC' then
+          begin
+            with cboCollTime do
+              if Length(ItemID) > 0 then
+                begin
+                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
+                  FLastLabCollTime := ItemID + U + Text;
+                end
+              else if Length(Text) > 0 then
+                begin
+                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
+                  FLastLabCollTime := ValidCollTime(Text);
+                end;
+          end
+        else
+          begin
+            with calCollTime do
+              if FMDateTime > 0 then
+                begin
+                  Responses.Update('START', 1, ValidCollTime(Text), Text);
+                  FLastColltime := ValidCollTime(Text);
+                end
+              else
+                begin
+                  Responses.Update('START', 1, '', '') ;
+                  FLastCollTime := '';
+                end;
+          end;
+      end;
+    if LRORDERMODE = TORDER_MODE_COMP then
+      begin
+        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+        if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
+        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+        //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
+        if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+        if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
+        if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
+      end;
+    memOrder.Text := Responses.OrderText;
+    CurAdd := 1;
+    if uRaw.Count > 0 then
+      for j := 0 to uRaw.Count - 1 do
+  CollType: string;
+const
+  TX_BAD_TIME         = ' is not a routine lab collection time.' ;
+  TX_BAD_TIME_CAP     = 'Invalid Time';
+begin
+  CollType := 'LC';
+  with cboCollTime do
+    begin
+      if ItemID = 'LO' then
         begin
           if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
           Inc(CurAdd);
+          ItemIndex := -1;
+          Text := GetFutureLabTime(FMToday);
         end;
+    tQuantity.Text := '0';
+    ALabTest := nil;
+  finally
+    aList.Free;
+    aTests.Free;
+    aRaw.Free;
+  end;
+  aMsg := '';
+  if UgetTnS = 1 then
+    begin
+      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
+      lblTNS.Visible := true;
+      cboAvailTest.SelectByID(aTypeScreen);
+      cboAvailTestSelect(self);
+    end;
+  {if getTnS = 1 then
+    begin
+      for i := 1 to cboAvailTest.Items.Count - 1 do
+        begin
+          if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
+            begin
+              if piece(aSpecimen,'^',1) = '1' then
+                begin
+                  cboCollTime.Text := calWantTime.Text;
+                  aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
+                  cboCollTime.Text := '';
+                  cboCollType.Text := '';
+                  uSpecimen := 1;
+                end;
+              cboModifiers.Text := '';
+              cboAvailTest.SelectByID(aTypeScreen);
+              cboAvailTestSelect(Self);
+              btnAddTestsClick(Self);
+              uSpecimen := 0;
+              cboCollTime.Text := piece(aCollSave,'^',1);
+              cboCollType.Text := piece(aCollSave,'^',3);
+              aCollSave := '';
+              break;
+            end;
+        end;
+      aMsg := 'An order for Type and Screen has been added to this request' + '.';
+    end;
+  if (getTns = 1) then
+    begin
+      if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
+      ShowMessage(aMsg);
+    end;}
+  cboModifiers.Text := '';
+  edtResults.Height := 247;
+  edtInfo.Height := 247;
+end;
+procedure TfrmODBBank.FormDestroy(Sender: TObject);
+begin
+  inherited;
+  uSelectedItems.Free;
+  uVBECList.Free;
+  uTestsForResults.Free;
+  uUrgencyList.Free;
+  uModifierList.Free;
+  uRaw.Free;
+end;
+procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
+var
+  i,j,curAdd: integer;
+  x, name, aModifier, aTypeScreen: string;
+  aList: TStringList;
+begin
+  inherited;
+  aList := TStringList.Create;
+  curAdd := 1;
+  aModifier := '';
+  aTypeScreen := '';
+  ExtractTypeScreen(aList, uVBECList);
+  if aList.Count > 0 then aTypeScreen := aList[0];
+  aList.Clear;
+  if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
+  with lvSelectionList do
+    begin
+      for i := lvSelectionList.Items.Count - 1 downto 0 do
+        begin
+          if lvSelectionList.Items[i].Selected = true then
+            for j := uSelectedItems.Count - 1 downto 0 do
+            if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then
+              begin
+                if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
+                  begin
+                    uGetTnS := 1;
+                    lblTNS.Caption := 'TYPE+SCREEN must be added to order';
+                    lblTNS.Visible := true;
+                  end;
+                uSelectedItems.Delete(j);
+                lvSelectionList.Items[i].Delete;
+                break;
+              end;
+        end;
+    end;
+  Responses.Clear;
+  for i := 0 to uSelectedItems.Count - 1 do
+    begin
+      name := lvSelectionList.Items[i].Caption;
+      x := uSelectedItems[i];
+      if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+        begin
+          if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
+        end
+      else
+        begin
+          if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
+          if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+          if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
+          if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+        end;
+      Inc(CurAdd);
+    end;
+  if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+  if cboCollType.ItemID = 'LC' then
+    end;
+  cboCollType.SelectByID(CollType);
+  if uSelectedItems.Count > 0 then
     begin
       with cboCollTime do
 …
             FLastLabCollTime := ValidCollTime(Text);
           end;
+    end;
+end;
+procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
+begin
+  if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
+  if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
+    begin
+      InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
+      cboCollType.ItemIndex := -1;
+      Exit;
+    end;
+  if cboCollType.ItemID = 'I' then
+  begin
+    cboCollTime.ItemIndex := -1;
+    cboCollTime.Text := 'NOW';
+    calCollTime.Text := 'NOW';
+  end;
+  SetupCollTimes(cboCollType.ItemID);
+  if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
+  FLastCollType := cboCollType.ItemID;
+  calCollTimeChange(self);
+end;
+procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
+var
+  i: integer;
+  ListItem: TListItem;
+  x,q,m: string;
+begin
+  inherited;
+  if changing = true then Exit;
+  if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
+    begin
+      for i := 0 to lvSelectionList.Items.Count - 1 do
+        begin
+          x := uSelectedItems[i];
+          m := piece(x,'^',4);
+          q := piece(x,'^',3);
+          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
+            begin
+              ListItem := lvSelectionList.Items[i];
+              ListItem.SubItems.Clear;
+              ListItem.SubItems.Add(q);
+              if length(cboModifiers.ItemID) > 0 then
+                begin
+                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
+                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
+                end
+                else
+                  begin
+                    ListItem.SubItems.Add('');
+                    ListItem.SubItems.Add('');
+                  end;
+              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+              Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
+              Break;
+            end;
+        end;
+    end;
+  if Length(cboModifiers.Text) > 0 then
+    begin
+      memOrder.Text := Responses.OrderText;
+    end;
+end;
+procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
+var
+  i: integer;
+begin
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to uModifierList.Count - 1 do
+           Items.Add(uModifierList[i]);
+    end;
+end;
+procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
+var
+  i: integer;
+begin
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to uReasonsList.Count - 1 do
+           Items.Add(uReasonsList[i]);
+    end;
+end;
+procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
+var
+  i: integer;
+begin
+  with AComboBox do
+    begin
+      Clear;
+      for i := 0 to uUrgencyList.Count - 1 do
+         if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
+           Continue
+         else
+           Items.Add(uUrgencyList[i]);
+    end;
+end;
+procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
+var
+  ListItem: TListItem;
+  x,y: string;
+  i,j: integer;
+begin
+  inherited;
+  if lvSelectionList.Selected = nil then Exit;
+  ListItem := lvSelectionList.Selected;
+  changing := true;
+  tQuantity.Text := '';
+  cboModifiers.ItemIndex := -1;
+  i := lvSelectionList.ItemIndex;
+  j := 0;
+  if cboCollType.ItemID = 'LC' then
+    begin
+      if FLastLabCollTime <> '' then
+        cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
     end
   else
     begin
+      with calCollTime do
+        if FMDateTime > 0 then
+      if FLastCollTime = 'TODAY' then
+        calCollTime.Text := FLastCollTime
+      else if FLastCollTime = 'NOW' then
+        calCollTime.Text := FLastCollTime
+      else if FLastCollTime <> '' then
+        calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
+    end;
+  if FLastCollType <> '' then
+    cboCollType.SelectByID(FLastCollType);
+  if uSelectedItems.Count > 0 then
+    begin
+      x := uSelectedItems[i];
+      ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses);
+      if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2));
+      if not(piece(x,'^',1) = '1') and (j > 0) then //Components
+        begin
+          DisableDiagTestControls;
+          EnableComponentControls;
+          y := ListItem.SubItems[2];
+          changing := true;
+          cboModifiers.Text := '';
+          cboAvailComp.SelectByIEN(j);
+          tQuantity.Text := ListItem.SubItems[0];
+          changing := false;
+          if y <> '' then cboModifiers.ItemIndex := StrToInt(y);
+        end
+      else                            //Diagnostic Tests
+        begin
+          DisableComponentControls;
+          EnableDiagTestControls;
+          cboAvailTest.SelectByIEN(j);
+        end;
+    end;
+  changing := false;
+end;
+procedure TfrmODBBank.memDiagCommentChange(Sender: TObject);
+begin
+  inherited;
+  if (length(memDiagComment.Text) > 250) then
+    begin
+      ShowMsg('COMMENT cannot be longer than 250 characters');
+      memDiagComment.Text := Copy(memDiagComment.Text,0,250);
+      Exit;
+    end;
+  if lvSelectionList.Items.Count < 1 then Exit;
+  if uSelectedItems = nil then Exit;
+  if uSelectedItems.Count > 0 then
+    Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+  memOrder.Text := Responses.OrderText;
+end;
+procedure TfrmODBBank.FormDestroy(Sender: TObject);
+begin
+  inherited;
+  uSelectedItems.Free;
+  uVBECList.Free;
+  uTestsForResults.Free;
+  uUrgencyList.Free;
+  uTNSOrders.Free;
+  uModifierList.Free;
+  uReasonsList.Free;
+  uRaw.Free;
+end;
+procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
+var
+  i,j,curAdd: integer;
+  x, aName, aModifier, aReason, aTypeScreen: string;
+  aList: TStringList;
+  aSel, aSelTst : boolean;
+begin
+  inherited;
+  aList := TStringList.Create;
+  try
+    curAdd := 1;
+    aModifier := '';
+    aReason := '';
+    aTypeScreen := '';
+    aSel := false;
+    aSelTst := false;
+    ExtractTypeScreen(aList, uVBECList);
+    if aList.Count > 0 then aTypeScreen := aList[0];
+    aList.Clear;
+    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
+    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
+    if lvSelectionList.Items.Count < 1 then
+      begin
+        ShowMsg('There is nothing in the list to remove.');
+        exit;
+      end;
+    cboAvailComp.ItemIndex := -1;
+    tQuantity.Text := '';
+    cboAvailTest.ItemIndex := -1;
+    uGetTnS := 0;
+    lblTNS.Caption := '';
+    lblTNS.Visible := false;
+    memMessage.Text := '';
+    pnlMessage.Visible := false;
+    pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+    with lvSelectionList do
+      begin
+        for i := lvSelectionList.Items.Count - 1 downto 0 do
           begin
+            Responses.Update('START', 1, ValidCollTime(Text), Text);
+            FLastColltime := ValidCollTime(Text);
+            if lvSelectionList.Items[i].Selected = true then
+              begin
+                aSel := true;
+                for j := uSelectedItems.Count - 1 downto 0 do
+                  if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
+                    begin
+                      {if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then
+                        begin
+                          uGetTnS := 1;
+                          lblTNS.Caption := 'TYPE+SCREEN must be added to order';
+                          lblTNS.Visible := true;
+                          memMessage.Text := 'TYPE + SCREEN must be added to order';
+                          //memMessage.Visible := true;
+                          pnlMessage.Visible := true;
+                          pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
+                        end; }
+                      uSelectedItems.Delete(j);
+                      lvSelectionList.Items[i].Delete;
+                      break;
+                    end;
+              end;
+          end;
+      end;
+    for i := uSelectedItems.Count - 1 downto 0 do
+      begin
+        if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then
+          begin
+            uGetTnS := 1;
+            lblTNS.Caption := 'TYPE+SCREEN must be added to order';
+            lblTNS.Visible := true;
+            memMessage.Text := 'TYPE + SCREEN must be added to order';
+            //memMessage.Visible := true;
+            pnlMessage.Visible := true;
+            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
+            break;
+          end;
+      end;
+    if (aSel = false) and (lvSelectionList.Items.Count > 0) then
+      begin
+        ShowMsg('Please select an item from the list to be removed.');
+        exit;
+      end;
+    Responses.Clear;
+    if lvSelectionList.Items.Count < 1 then
+      begin
+        cboReasons.ItemIndex := -1;
+        memDiagComment.Text := '';
+        cboSurgery.ItemIndex := -1;
+        cboUrgency.ItemIndex := -1;
+        cboCollType.ItemIndex := -1;
+        cboCollTime.ItemIndex := -1;
+        cboQuick.ItemIndex := -1;
+        calCollTime.Text := '';
+      end;
+    for i := 0 to uSelectedItems.Count - 1 do
+      begin
+        aName := lvSelectionList.Items[i].Caption;
+        x := uSelectedItems[i];
+        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
+          begin
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+            aSelTst := true;
           end
         else
           begin
+            Responses.Update('START', 1, '', '') ;
+            FLastCollTime := '';
+            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
+            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
+            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
+            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
+            cboModifiers.ItemIndex := -1;
+            cboAvailComp.ItemIndex := -1;
+            tQuantity.Text := '';
           end;
-    end;
-  with cboCollType do if Length(ItemID) > 0 then
-    begin
-      Responses.Update('COLLECT', 1, ItemID, ItemID) ;
-      FLastCollType := ItemID;
-    end;
-  if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
-  if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
-  //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
-  if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
-  if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
-  if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
-  memOrder.Text := Responses.OrderText;
-  CurAdd := 1;
-  if uRaw.Count > 0 then
-    for j := 0 to uRaw.Count - 1 do
-      begin
-        if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
         Inc(CurAdd);
       end;
+  if uSelectedItems.Count < 1 then
+    begin
+      uGetTnS := 0;
+      lblTNS.Caption := '';
+      lblTNS.Visible := false;
+    end;
+  aList.Free;
+    if aSelTst = false then
+      begin
+        cboCollType.ItemIndex := -1;
+        cboCollTime.ItemIndex := -1;
+        calCollTime.Text := '';
+      end;
+    if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+    if cboCollType.ItemID = 'LC' then
+      begin
+        with cboCollTime do
+          if Length(ItemID) > 0 then
+            begin
+              Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
+              FLastLabCollTime := ItemID + U + Text;
+            end
+          else if Length(Text) > 0 then
+            begin
+              Responses.Update('START', 1, ValidCollTime(Text), Text) ;
+              FLastLabCollTime := ValidCollTime(Text);
+            end;
+      end
+    else
+      begin
+        with calCollTime do
+          if FMDateTime > 0 then
+            begin
+              Responses.Update('START', 1, ValidCollTime(Text), Text);
+              FLastColltime := ValidCollTime(Text);
+            end
+          else
+            begin
+              Responses.Update('START', 1, '', '') ;
+              FLastCollTime := '';
+            end;
+      end;
+    with cboCollType do if Length(ItemID) > 0 then
+      begin
+        Responses.Update('COLLECT', 1, ItemID, ItemID) ;
+        FLastCollType := ItemID;
+      end;
+    if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+    if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+    if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+    if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
+    if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
+    memOrder.Text := Responses.OrderText;
+    CurAdd := 1;
+    if uRaw.Count > 0 then
+      for j := 0 to uRaw.Count - 1 do
+        begin
+          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
+          Inc(CurAdd);
+        end;
+    if uSelectedItems.Count < 1 then
+      begin
+        uGetTnS := 0;
+        lblTNS.Caption := '';
+        lblTNS.Visible := false;
+        memMessage.Text := '';
+        pnlMessage.Visible := false;
+        GroupBox1.Visible := true;
+        pnlDiagnosticTests.Caption := 'Diagnostic Tests';
+      end;
+  finally
+    aList.Free;
+  end;
+end;
+procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
+begin
+  inherited;
+  pnlComments.Visible := false;
+  pnlComments.SendToBack;
+  Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
+  memOrder.Text := Responses.OrderText;
+end;
+procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
+begin
+  inherited;
+  pnlComments.Visible := false;
+  pnlComments.SendToBack;
 end;
 …
 begin
   inherited;
+  if lvSelectionList.Items.Count < 1 then
+    begin
+      ShowMsg('There is nothing in the list to remove.');
+      exit;
+    end;
   lvSelectionList.Clear;
   uSelectedItems.Clear;
 …
   lblTNS.Caption := '';
   lblTNS.Visible := false;
+  memMessage.Text := '';
+  pnlMessage.Visible := false;
   InitDialog;
+  cboModifiers.ItemIndex := -1;
+  cboAvailTest.ItemIndex := -1;
+  cboAvailComp.ItemIndex := -1;
+  cboSurgery.ItemIndex := -1;
+  cboUrgency.ItemIndex := -1;
+  cboReasons.ItemIndex := -1;
+  cboCollType.ItemIndex := -1;
+  cboCollTime.ItemIndex := -1;
+  cboQuick.ItemIndex := -1;
+  calWantTime.Text := '';
+  memDiagComment.Text := '';
+  GroupBox1.Visible := true;
+  tQuantity.Text := '';
+  FLastCollType := '';
+  FLastCollTime := '';
+  FLastLabCollTime := '';
+  txtImmedColl.Text := '';
 end;
 …
   Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
 begin
+  if not ValidAdd then Exit;
   if uGetTnS = 1 then
     begin
 …
     end;
   if Comp = true then
+    ShowMessage('The nursing blood administration order must be entered separately' + '.');
+    begin
+      if NursAdminSuppress = true then
+        ShowMsg('The nursing blood administration order must be entered separately' + '.');
+    end;
   inherited;
 end;
 …
   inherited;
   if uSelectedItems.Count > 0 then
+    if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+    begin
+      with calWantTime do if not Changing then
+        begin
+          if FMDateTime = 0 then
+            begin
+              ShowMsg('Invalid Date/Time entered');
+              Changing := true;
+              calWantTime.Text := '';
+              Changing := false;
+              Exit;
+            end
+          else
+            begin
+              // date/time was entered
+              if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then
+                begin
+                  ShowMsg('Date/Time Wanted must be a future Date/Time');
+                  Changing := true;
+                  calWantTime.Text := '';
+                  Changing := false;
+                  Exit;
+                end;
+            end;
+        end;
+      if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
+      memOrder.Text := Responses.OrderText;
+    end;
 end;
 …
   if uSelectedItems.Count > 0 then
     begin
       if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes')
       else Responses.Update('YN',1,'0','No');
+      if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
+      memOrder.Text := Responses.OrderText;
     end;
 end;
 …
     begin
       Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
+      uSelUrgency := cboUrgency.Text;
       if cboUrgency.Text = 'PRE-OP' then
         begin
           lblSurgery.Enabled := true;
           cboSurgery.Enabled := true;
+          lblSurgery.Caption := 'Surgery*';
         end
       else
 …
           lblSurgery.Enabled := false;
           cboSurgery.Enabled := false;
           cboSurgery.Text := '';
           if uSelectedItems.Count > 0 then
             Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+          lblSurgery.Caption := 'Surgery';
+          cboSurgery.ItemIndex := -1;
+          Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
         end;
+    end;
+end;
+procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject);
+    end
+  else
+    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
+  memOrder.Text := Responses.OrderText;
+end;
+procedure TfrmODBBank.cboUrgencyExit(Sender: TObject);
 begin
   inherited;
+  if uSelectedItems.Count > 0 then
+    Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
+end;
+procedure TfrmODBBank.cboPreparationChange(Sender: TObject);
+  if Length(cboUrgency.Text) < 1 then
+    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
+end;
+procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
+var
+  aList: TStringList;
+  i,j,aMSBOS,aMSBOSContinue: integer;
+  x: string;
+  handled: boolean;
 begin
   inherited;
+  Exit;  // disable Preparation, since it is no longer needed by VBECS
+  if uSelectedItems.Count > 0 then
+    if Length(cboPreparation.Text) > 0 then
+      Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
+end;
+procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
+  aList := TStringList.Create;
+  handled := false;
+  try
+    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
+      begin
+        aList.Clear;
+        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
+        for i := 0 to aList.Count - 1 do
+          begin
+            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+             and (piece(aList[i],'^',3) = cboSurgery.Text) then
+              begin
+                aMSBOS := StrToInt(piece(aList[i],'^',4));
+                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
+                  begin
+                    with Application do
+                    begin
+                      NormalizeTopMosts;
+                      aMSBOSContinue :=
+                        MessageBox(PChar('The number of unit Quantity selected (' + tQuantity.Text +
+                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
+                                   + IntToStr(aMSBOS) +
+                                   ') for the ' + cboSurgery.text +
+                                   ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'),
+                                   PChar('Maximum Number of Units Exceeded'),
+                                   MB_YESNO);
+                      RestoreTopMosts;
+                    end;
+                    if aMSBOSContinue = 7 then
+                      begin
+                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
+                        tQuantity.Text := '0';
+                        tQuantity.SelLength := 2;
+                        tQuantity.SelectAll;
+                        break;
+                      end;
+                  end;
+                handled := true;
+                break;
+              end;
+          end;
+      end;
+    if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then
+      begin
+        aList.Clear;
+        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
+        for j := 0 to uSelectedItems.Count - 1 do
+          begin
+            ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
+            for i := 0 to aList.Count - 1 do
+              begin
+                if (piece(uSelectedItems[j],'^',1) = '0')
+                 and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+                 and (piece(aList[i],'^',3) = cboSurgery.Text) then
+                  begin
+                    aMSBOS := StrToInt(piece(aList[i],'^',4));
+                    if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
+                      begin
+                        with Application do
+                        begin
+                          NormalizeTopMosts;
+                          aMSBOSContinue :=
+                            MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) +
+                               ') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units ('
+                               + IntToStr(aMSBOS) +
+                               ') for the ' + cboSurgery.text +
+                               ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'),
+                               PChar('Maximum Number of Units Exceeded'),
+                               MB_YESNO);
+                          RestoreTopMosts;
+                        end;
+                        if aMSBOSContinue = 7 then
+                          begin
+                            ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption);
+                            tQuantity.Text := '0';
+                            tQuantity.SelLength := 2;
+                            tQuantity.SelectAll;
+                            x := uSelectedItems[j];
+                            SetPiece(x,U,3,'');
+                            uSelectedItems[j] := x;
+                            lvSelectionList.Items[j].SubItems[0] := '';
+                            RePaint;
+                            break;
+                          end;
+                      end;
+                    break;
+                  end;
+              end;
+          end;
+      end;
+    if uSelectedItems.Count > 0 then
+      if Length(cboSurgery.Text) > 0 then
+        Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+    uSelSurgery := 0;
+    if Length(cboSurgery.Text) > 0 then
+      begin
+        if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID;
+        cboReasons.Text := cboSurgery.Text;
+        Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
+      end;
+    memOrder.Text := Responses.OrderText;
+    finally
+      aList.Free;
+    end;
+end;
+procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
 begin
   inherited;
+  if uSelectedItems.Count > 0 then
+    if Length(cboSurgery.Text) > 0 then
+      Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
+end;
+procedure TfrmODBBank.tReasonChange(Sender: TObject);
+  if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
+end;
+procedure TfrmODBBank.tQuantityChange(Sender: TObject);
+var
+  aList: TStringList;
+  i,aMSBOS,aMSBOSContinue: integer;
+  ListItem: TListItem;
+  x,m: string;
 begin
   inherited;
+  if uSelectedItems.Count > 0 then
+    if Length(tReason.Text) > 0 then
+      Responses.Update('REASON',1,tReason.Text,tReason.Text);
+  if changing = true then Exit;
+  aList := TStringList.Create;
+  if Length(tQuantity.Text) > 0 then
+    begin
+      if Length(tQuantity.Text) > 2 then
+        begin
+          ShowMsg('Invalid entry. Please select a numeric value <100');
+          tQuantity.Text := '';
+          Exit;
+        end;
+      if StrToInt(tQuantity.Text) > 100 then
+        begin
+          ShowMsg('Quantity too high. Please select a value <100');
+          tQuantity.Text := Copy(tQuantity.Text,0,1);
+          Exit;
+        end;
+    end;
+  try
+    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
+      begin
+        aList.Clear;
+        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgery
+        for i := 0 to aList.Count - 1 do
+          begin
+            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
+             and (piece(aList[i],'^',3) = cboSurgery.Text) then
+              begin
+                aMSBOS := StrToInt(piece(aList[i],'^',4));
+                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
+                  begin
+                    with Application do
+                    begin
+                      NormalizeTopMosts;
+                      aMSBOSContinue :=
+                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
+                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
+                                   + IntToStr(aMSBOS) +
+                                   ') for the ' + cboSurgery.text +
+                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
+                                   PChar('Maximum Number of Units Exceeded'),
+                                   MB_YESNO);
+                      RestoreTopMosts;
+                    end;
+                    if aMSBOSContinue = 7 then
+                      begin
+                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
+                        tQuantity.Text := '0';
+                        tQuantity.SelLength := 2;
+                        tQuantity.SelectAll;
+                        break;
+                      end;
+                  end;
+                break;
+              end;
+          end;
+      end;
+    if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
+      for i := 0 to lvSelectionList.Items.Count - 1 do
+        begin
+          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
+            begin
+              x := uSelectedItems[i];
+              m := piece(x,'^',4);
+              ListItem := lvSelectionList.Items[i];
+              ListItem.SubItems.Clear;
+              ListItem.SubItems.Add(tQuantity.Text);
+              SetPiece(x,U,3,tQuantity.Text);
+              Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
+              uSelectedItems[i] := x;
+              if length(cboModifiers.ItemID) > 0 then
+                begin
+                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
+                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
+                end
+                else
+                  begin
+                    ListItem.SubItems.Add('');
+                    ListItem.SubItems.Add('');
+                  end;
+              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
+              Break;
+            end;
+        end;
+    if Length(tQuantity.Text) > 0 then
+      begin
+        memOrder.Text := Responses.OrderText;
+      end;
+  finally
+    aList.Free;
+  end;
+end;
+procedure TfrmODBBank.tQuantityClick(Sender: TObject);
+begin
+  inherited;
+  tQuantity.SelLength := 2;
+  tQuantity.SelectAll;
+end;
+procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
+begin
+  inherited;
+  tQuantity.SelLength := 2;
+  tQuantity.SelectAll;
 end;
 …
               end;
         end;
+      memOrder.Text := Responses.OrderText;
     end;
 end;

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

-              r456
+              r829
   VertScrollBar.Range = 225
   VertScrollBar.Visible = True
-  AutoScroll = False
   BorderIcons = [biSystemMenu]
   Caption = ''
   FormStyle = fsStayOnTop
-  KeyPreview = True
   OnClose = FormClose
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   OnKeyPress = FormKeyPress
+  ExplicitWidth = 528
+  ExplicitHeight = 275
   PixelsPerInch = 96
   TextHeight = 13
   object memOrder: TCaptionMemo
+  object memOrder: TCaptionMemo [0]
     Left = 6
     Top = 194
 …
     Caption = 'Order'
   end
   object cmdAccept: TButton
+  object cmdAccept: TButton [1]
     Left = 442
     Top = 194
 …
     OnClick = cmdAcceptClick
   end
   object cmdQuit: TButton
+  object cmdQuit: TButton [2]
     Left = 442
     Top = 221
 …
     OnClick = cmdQuitClick
   end
   object pnlMessage: TPanel
+  object pnlMessage: TPanel [3]
     Left = 24
     Top = 176
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODBase'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls,
   ORCtrls, ORFn, uConst, rOrders, rODBase, uCore, ComCtrls, ExtCtrls, Menus, Mask,
   Buttons, UBAGlobals, UBACore;
+  Buttons, UBAGlobals, UBACore, VA508AccessibilityManager;
 type
 …
     procedure SetDialogIEN(Value: Integer); virtual;
     procedure Validate(var AnErrMsg: string); virtual;
+    procedure updateSig; virtual;
     function ValidSave: Boolean;
     procedure ShowOrderMessage(Show: boolean);
 …
 var
   frmODBase: TfrmODBase;
+  frmODBase: TfrmODBase = nil;
   XfInToOutNow :boolean = False;       // it's used only for transfering Inpatient Meds to OutPatient Med for
                                        // immediately release (NO EVENT DELAY)
 …
 uses fOCAccept, uODBase, rCore, rMisc, fODMessage,
   fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders,
   fFrame, uTemplateFields, fClinicWardMeds;
+  fFrame, uTemplateFields, fClinicWardMeds, fODDietLT, rODDiet, VAUtils;
 const
 …
   else if AControl is TButton then with TButton(AControl) do Caption := CtrlInit.Text
   else if AControl is TEdit then with TEdit(AControl) do Text := CtrlInit.Text
   else if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)
   else if AControl is TRichEdit then with TRichEdit(AControl) do Lines.Assign(CtrlInit.List)
   else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)
   else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)
+  else if AControl is TMemo then FastAssign(CtrlInit.List, TMemo(AControl).Lines)
+  else if AControl is TRichEdit then QuickCopy(CtrlInit.List, TRichEdit(AControl))
+  else if AControl is TORListBox then FastAssign(CtrlInit.List, TORListBox(AControl).Items)
+  else if AControl is TListBox then FastAssign(CtrlInit.List, TListBox(AControl).Items)
   else if AControl is TComboBox then with TComboBox(AControl) do
   begin
     Items.Assign(CtrlInit.List);
+    FastAssign(CtrlInit.List, TComboBox(AControl).Items);
     Text := CtrlInit.Text;
   end
   else if AControl is TORComboBox then with TORComboBox(AControl) do
   begin
     Items.Assign(CtrlInit.List);
+    FastAssign(CtrlInit.List, TORComboBox(AControl).Items);
     if LongList then InitLongList(Text) else Text := CtrlInit.Text;
     SelectByID(CtrlInit.ListID);
 …
   CtrlInit := FindInitByName(ASection);
   if CtrlInit = nil then Exit;
   if      AControl is TMemo       then with TMemo(AControl)       do Lines.Assign(CtrlInit.List)
   else if AControl is TORListBox  then with TORListBox(AControl)  do Items.Assign(CtrlInit.List)
   else if AControl is TListBox    then with TListBox(AControl)    do Items.Assign(CtrlInit.List)
   else if AControl is TComboBox   then with TComboBox(AControl)   do Items.Assign(CtrlInit.List)
   else if AControl is TORComboBox then with TORComboBox(AControl) do Items.Assign(CtrlInit.List);
+  if      AControl is TMemo       then FastAssign(CtrlInit.List, TMemo(AControl).Lines)
+  else if AControl is TORListBox  then FastAssign(CtrlInit.List, TORListBox(AControl).Items)
+  else if AControl is TListBox    then FastAssign(CtrlInit.List, TListBox(AControl).Items)
+  else if AControl is TComboBox   then FastAssign(CtrlInit.List, TComboBox(AControl).Items)
+  else if AControl is TORComboBox then FastAssign(CtrlInit.List, TORComboBox(AControl).Items);
 end;
 …
     //AGP Text orders are only treated as IMO if the order display group is a nursing display group
     if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
        (((pos('OR GXTEXT WORD PROCESSING ORDE',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
+       (((pos('OR GXTEXT WORD PROCESSING ORDER',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
        ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or
        ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757
 …
         //  CheckBoilerplate4Fields(tmp, cptn)
         //else
+          ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo);
+        // CQ #11669 - changing an existing order shouldn't restart template - JM
+          if assigned(frmODBase) and (frmODBase.FOrderAction = ORDER_EDIT) then
+            CheckBoilerplate4Fields(tmp, cptn)
+          else
+            ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo);
       end
     else
 …
 begin
   inherited;
   memOrder.Color := ReadOnlyColor;
+  frmODBase   := Self;
   FAcceptOK   := False;
   FAutoAccept := False;
 …
   FEvtType   := OrderEventTypeOnCreate;
   FEvtName   := OrderEventNameOnCreate;
+  DefaultButton := cmdAccept;
 end;
 procedure TfrmODBase.FormDestroy(Sender: TObject);
 begin
+  frmODBase := nil;
   FCtrlInits.Free;
   FResponses.Free;
 …
   NewOrder: TOrder;
   CanSign, OrderAction: Integer;
+  IsDelayOrder: boolean;
   //thisSourceOrder: TOrder;
 begin
   Result := True;
   Validate(ErrMsg);
+  IsDelayOrder := False;
   if Length(ErrMsg) > 0 then
   begin
 …
         else CanSign := CH_SIGN_NA;
       if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
+      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign);
+      if NewOrder.EventPtr <> '' then IsDelayOrder := True;
+      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign,'',0, NewOrder.DGroupName, False,IsDelayOrder);
     UBAGlobals.TargetOrderID := NewOrder.ID;
 …
   theGrpName: string;
   alreadyClosed: boolean;
+  LateTrayFields: TLateTrayFields;
+  x, CxMsg: string;
 begin
   FAcceptOK := False;
 …
     end;
   end;
+  // check for diet orders that will be auto-DCd because of start/stop overlaps
+  if Responses.Dialog = 'FHW1' then
+  begin
+    if (Self.EvtID <> 0) then
+    begin
+      CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept);
+      if CxMsg <> '' then
+      begin
+        if InfoBox(CxMsg + CRLF + CRLF +
+           'Have you done either of the above?', 'Possible delayed order conflict',
+           MB_ICONWARNING or MB_YESNO) = ID_NO
+           then exit;
+      end;
+    end
+    else if FAutoAccept then
+    begin
+      x := CurrentDietText;
+      CheckForAutoDCDietOrders(0, Self.DisplayGroup, x, CxMsg, nil);
+      if CxMsg <> '' then
+      begin
+        if InfoBox(CxMsg + CRLF +
+                  'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
+        begin
+          //AbortOrder := True;
+          FAcceptOK := FALSE;
+          //cmdQuitClick(Self);
+          exit;
+        end;
+      end;
+    end;
+  end;
   if ValidSave then
   begin
 …
         else
         begin
+          LateTrayFields.LateMeal := #0;
+          with Responses do
+            if FAutoAccept and ((Dialog = 'FHW1') or (Dialog = 'FHW OP MEAL') or (Dialog ='FHW SPECIAL MEAL')) then
+            begin
+              LateTrayCheck(Responses, Self.EvtID, not OrderForInpatient, LateTrayFields);
+            end;
           ClearDialogControls;    // to allow form to close without prompting to save order
+          with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient);
           Close;
           alreadyClosed := True;
 …
 begin
   inherited;
+  FFromQuit := True;
   Close;
 end;
 …
       exit;
     end;
+  if FFromQuit = False then updateSig;
   if Length(memOrder.Text) > 0 then
   begin
 …
       if not ValidSave then CanClose := False;
   if CanClose then InitDialog;
+end;
+procedure TfrmODBase.updateSig;
+begin
 end;
 …
         if Length(TempMSG)>0 then
         begin
           ShowMessage(TempMSG);
+          ShowMsg(TempMSG);
           Result := False;
         end;

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

-              r456
+              r829
 object frmChangeEventDisp: TfrmChangeEventDisp
+inherited frmChangeEventDisp: TfrmChangeEventDisp
   Left = 344
   Top = 230
-  Width = 408
-  Height = 444
   Caption = 'Change release event'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 417
+  ClientWidth = 400
   OldCreateOrder = False
   Position = poDesktopCenter
+  ExplicitWidth = 408
+  ExplicitHeight = 444
   PixelsPerInch = 96
   TextHeight = 13
   object lblTop: TMemo
+  object lblTop: TMemo [0]
     Left = 0
     Top = 0
 …
     TabOrder = 2
   end
   object pnlTop: TPanel
+  object pnlTop: TPanel [1]
     Left = 0
     Top = 37
 …
       Width = 394
       Height = 333
+      Style = lbOwnerDrawVariable
       Align = alClient
       ItemHeight = 13
-      Style = lbOwnerDrawVariable
       TabOrder = 0
       OnDrawItem = lstCVOrdersDrawItem
 …
     end
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [2]
     Left = 0
     Top = 376
 …
     Align = alBottom
     TabOrder = 1
+    DesignSize = (
+)
     object cmdOK: TButton
       Left = 230
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblTop'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lstCVOrders'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmChangeEventDisp'
+        'Status = stsDefault'))
+  end
 end

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

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

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

-              r456
+              r829
 object frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew
+inherited frmODChangeUnreleasedRenew: TfrmODChangeUnreleasedRenew
   Left = 240
   Top = 163
-  Width = 537
-  Height = 198
   Caption = 'Change Unreleased Renewed Order'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 171
+  ClientWidth = 529
   OldCreateOrder = False
   OnCreate = FormCreate
+  ExplicitWidth = 537
+  ExplicitHeight = 198
   PixelsPerInch = 96
   TextHeight = 13
   object Panel2: TPanel
+  object Panel2: TPanel [0]
     Left = 0
     Top = 57
     Width = 529
     Height = 81
+    Height = 82
     Align = alClient
     TabOrder = 0
+    ExplicitHeight = 81
     object lblRefill: TLabel
       Left = 9
 …
       SynonymChars = '<>'
       TabOrder = 1
+      CharsNeedMatch = 1
     end
   end
   object Panel3: TPanel
+  object Panel3: TPanel [1]
     Left = 0
     Top = 57
     Width = 529
     Height = 81
+    Height = 82
     Align = alClient
     TabOrder = 3
+    ExplicitHeight = 81
     object Label1: TLabel
       Left = 61
 …
     end
   end
   object memOrder: TCaptionMemo
+  object memOrder: TCaptionMemo [2]
     Left = 0
     Top = 0
 …
     TabOrder = 2
   end
   object Panel1: TPanel
+  object Panel1: TPanel [3]
     Left = 0
     Top = 138
+    Top = 139
     Width = 529
     Height = 32
     Align = alBottom
     TabOrder = 1
+    ExplicitTop = 138
     object btnOK: TButton
       Left = 348
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = edtRefill'
+        'Status = stsDefault')
+      (
+        'Component = cboPickup'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = txtStart'
+        'Status = stsDefault')
+      (
+        'Component = txtStop'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmODChangeUnreleasedRenew'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders;
+  Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
 object frmODChild: TfrmODChild
+inherited frmODChild: TfrmODChild
   Left = 433
   Top = 271
-  Width = 512
-  Height = 453
   Caption = 'Associated Complex Orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 426
+  ClientWidth = 504
   OldCreateOrder = False
   Position = poMainFormCenter
   OnCreate = FormCreate
+  ExplicitWidth = 512
+  ExplicitHeight = 453
   PixelsPerInch = 96
   TextHeight = 13
   object lblWarning: TLabel
+  object lblWarning: TLabel [0]
     Left = 0
     Top = 0
 …
     WordWrap = True
   end
   object Panel1: TPanel
+  object Panel1: TPanel [1]
     Left = 0
     Top = 59
     Width = 504
     Height = 325
+    Height = 326
     Align = alClient
     BevelOuter = bvNone
 …
       Top = 3
       Width = 494
       Height = 315
+      Height = 316
       Style = lbOwnerDrawVariable
       Align = alClient
 …
     end
   end
   object Panel2: TPanel
+  object Panel2: TPanel [2]
     Left = 0
     Top = 384
+    Top = 385
     Width = 504
     Height = 41
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = lstODComplex'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmODChild'
+        'Status = stsDefault'))
+  end
 end

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

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

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

-              r456
+              r829
   Height = 291
   Caption = 'Diet Order'
+  OnKeyDown = FormKeyDown
+  ExplicitWidth = 532
+  ExplicitHeight = 291
   PixelsPerInch = 96
   TextHeight = 13
 …
     ActivePage = pgeOutPt
     Align = alTop
-    TabIndex = 1
     TabOrder = 4
     TabStop = False
 …
   inherited memOrder: TCaptionMemo
     Top = 208
+    ExplicitTop = 208
   end
   inherited cmdAccept: TButton
 …
     Top = 208
     TabOrder = 2
+    ExplicitLeft = 445
+    ExplicitTop = 208
   end
   inherited cmdQuit: TButton
 …
     Top = 235
     TabOrder = 3
+    ExplicitLeft = 445
+    ExplicitTop = 235
   end
   inherited pnlMessage: TPanel
 …
     Height = 57
     TabOrder = 1
+    ExplicitTop = 197
+    ExplicitHeight = 57
     inherited imgMessage: TImage
       Top = 10
+      ExplicitTop = 10
     end
     inherited memMessage: TRichEdit
       Height = 45
+      ExplicitHeight = 45
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = nbkDiet'
+        'Status = stsDefault')
+      (
+        'Component = pgeDiet'
+        'Status = stsDefault')
+      (
+        'Component = cboDietAvail'
+        'Status = stsDefault')
+      (
+        'Component = lstDietSelect'
+        'Status = stsDefault')
+      (
+        'Component = cmdRemove'
+        'Status = stsDefault')
+      (
+        'Component = txtDietComment'
+        'Status = stsDefault')
+      (
+        'Component = calDietStart'
+        'Status = stsDefault')
+      (
+        'Component = calDietStop'
+        'Status = stsDefault')
+      (
+        'Component = cboDelivery'
+        'Status = stsDefault')
+      (
+        'Component = chkCancelTubefeeding'
+        'Status = stsDefault')
+      (
+        'Component = pgeOutPt'
+        'Status = stsDefault')
+      (
+        'Component = grpOPMeal'
+        'Status = stsDefault')
+      (
+        'Component = grpOPDoW'
+        'Status = stsDefault')
+      (
+        'Component = chkOPMonday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPTuesday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPWednesday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPThursday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPFriday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPSaturday'
+        'Status = stsDefault')
+      (
+        'Component = chkOPSunday'
+        'Status = stsDefault')
+      (
+        'Component = calOPStart'
+        'Status = stsDefault')
+      (
+        'Component = calOPStop'
+        'Status = stsDefault')
+      (
+        'Component = cboOPDietAvail'
+        'Status = stsDefault')
+      (
+        'Component = txtOPDietComment'
+        'Status = stsDefault')
+      (
+        'Component = cboOPDelivery'
+        'Status = stsDefault')
+      (
+        'Component = lstOPDietSelect'
+        'Status = stsDefault')
+      (
+        'Component = cmdOPRemove'
+        'Status = stsDefault')
+      (
+        'Component = chkOPCancelTubefeeding'
+        'Status = stsDefault')
+      (
+        'Component = pgeTubefeeding'
+        'Status = stsDefault')
+      (
+        'Component = cboProduct'
+        'Status = stsDefault')
+      (
+        'Component = txtTFComment'
+        'Status = stsDefault')
+      (
+        'Component = grdSelected'
+        'Status = stsDefault')
+      (
+        'Component = cmdTFRemove'
+        'Status = stsDefault')
+      (
+        'Component = chkCancelTrays'
+        'Status = stsDefault')
+      (
+        'Component = txtQuantity'
+        'Status = stsDefault')
+      (
+        'Component = cboStrength'
+        'Status = stsDefault')
+      (
+        'Component = calOPTFStart'
+        'Status = stsDefault')
+      (
+        'Component = cboOPTFRecurringMeals'
+        'Status = stsDefault')
+      (
+        'Component = pgeEarlyLate'
+        'Status = stsDefault')
+      (
+        'Component = grpMeal'
+        'Status = stsDefault')
+      (
+        'Component = grpMealTime'
+        'Status = stsDefault')
+      (
+        'Component = radET1'
+        'Status = stsDefault')
+      (
+        'Component = radET2'
+        'Status = stsDefault')
+      (
+        'Component = radET3'
+        'Status = stsDefault')
+      (
+        'Component = radLT1'
+        'Status = stsDefault')
+      (
+        'Component = radLT2'
+        'Status = stsDefault')
+      (
+        'Component = radLT3'
+        'Status = stsDefault')
+      (
+        'Component = calELStart'
+        'Status = stsDefault')
+      (
+        'Component = calELStop'
+        'Status = stsDefault')
+      (
+        'Component = grpDoW'
+        'Status = stsDefault')
+      (
+        'Component = chkMonday'
+        'Status = stsDefault')
+      (
+        'Component = chkTuesday'
+        'Status = stsDefault')
+      (
+        'Component = chkWednesday'
+        'Status = stsDefault')
+      (
+        'Component = chkThursday'
+        'Status = stsDefault')
+      (
+        'Component = chkFriday'
+        'Status = stsDefault')
+      (
+        'Component = chkSaturday'
+        'Status = stsDefault')
+      (
+        'Component = chkSunday'
+        'Status = stsDefault')
+      (
+        'Component = chkBagged'
+        'Status = stsDefault')
+      (
+        'Component = cboOPELRecurringMeals'
+        'Status = stsDefault')
+      (
+        'Component = pgeIsolations'
+        'Status = stsDefault')
+      (
+        'Component = lstIsolation'
+        'Status = stsDefault')
+      (
+        'Component = txtIPComment'
+        'Status = stsDefault')
+      (
+        'Component = txtIPCurrent'
+        'Status = stsDefault')
+      (
+        'Component = pgeAdditional'
+        'Status = stsDefault')
+      (
+        'Component = txtAOComment'
+        'Status = stsDefault')
+      (
+        'Component = calOPAOStart'
+        'Status = stsDefault')
+      (
+        'Component = cboOPAORecurringMeals'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODDiet'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst;
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst,
+  VA508AccessibilityManager;
 type
 …
     FIsolationID: string;
     FTabChanging: Boolean;
+    FGiveMultiTabMessage: boolean;
     procedure DietCheckForNPO;
     procedure DietCheckForTF;
 …
     procedure OPDietCheckForNPO;
     procedure OPDietCheckForTF;
+    function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
+    function  PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
+    //procedure CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
   protected
     procedure InitDialog; override;
 …
 {$R *.DFM}
+uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
+uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, DateUtils,
+  fOrders, uODBase, VA508AccessibilityRouter;
 const
 …
 begin
   inherited;
+  FGiveMultiTabMessage := ScreenReaderSystemActive;
   AbortOrder := False;
   uRecurringMealList := TStringList.Create;
 …
         end;
     end;
-  TAccessibleStringGrid.WrapControl(grdSelected);
 end;
 procedure TfrmODDiet.FormDestroy(Sender: TObject);
 begin
-  TAccessibleStringGrid.UnwrapControl(grdSelected);
   TFClearGrid;
   uRecurringMealList.Free;
 …
 end;
+procedure TfrmODDiet.nbkDietChange(Sender: TObject);
+var
+  x, CxMsg: string ;
+  i: integer;
+  AStringList: TStringList;
+(*procedure TfrmODDiet.CheckForAutoDCOrders(EvtID: integer; CurrentText: string; var CancelText: string; Sender: TObject);
 const
-//  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
   TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
               'you specify a start date for when the new diet should replace the current' + CRLF +
               'diet:' + CRLF + CRLF;
   TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
+  TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
+  TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
+                    'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
+                    '1. Specify an expiration date/time for this order that will' + CRLF +
+                    '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
+                    '2. Specify a later start date/time for this order for when you' + CRLF +
+                    '   would like it to cancel and replace those other orders.';
+var
+  i: integer;
+  AStringList: TStringList;
+  AList: TList;
+  x, PtEvtIFN, PtEvtName: string;
+  //AResponse: TResponse;
+begin
+  if Self.EvtID = 0 then   // check current and future released diets
+  begin
+    x := CurrentText;
+    if Piece(x, #13, 1) <> 'Current Diet:  ' then
+    begin
+      AStringList := TStringList.Create;
+      try
+        AStringList.Text := x;
+        CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
+                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
+        if AStringList.Count > 1 then
+        begin
+          CancelText := CancelText + CRLF + CRLF +
+                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
+                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
+          if AStringList.Count > 2 then
+          for i := 2 to AStringList.Count - 1 do
+            CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
+        end;
+      finally
+        AStringList.Free;
+      end;
+    end;
+  end
+  else if Sender is TButton then     // delayed orders code here - on accept only
+  begin
+    //AResponse := Responses.FindResponseByName('STOP', 1);
+    //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
+    AList := TList.Create;
+    try
+      PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
+      PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
+      LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
+      for i := AList.Count - 1 downto 0 do
+      begin
+        if TOrder(Alist.Items[i]).DGroup <> Self.DisplayGroup then
+        begin
+          TOrder(AList.Items[i]).Free;
+          AList.Delete(i);
+        end;
+      end;
+      if AList.Count > 0 then
+      begin
+        x := '';
+        RetrieveOrderFields(AList, 0, 0);
+        CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName;
+        for i := 0 to AList.Count - 1 do
+          with TOrder(AList.Items[i]) do
+          begin
+            x := x + #9 + Text + CRLF;
+(*            if StartTime <> '' then
+              x := #9 + x + 'Start:   ' + StartTime + CRLF
+            else
+              x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
+(*          end;
+        CancelText := CancelText + CRLF + CRLF + x;
+        CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
+      end;
+    finally
+      with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
+      AList.Free;
+    end;
+  end;
+end;*)
+procedure TfrmODDiet.nbkDietChange(Sender: TObject);
+var
+  x: string ;
+  CxMsg: string;
 begin
   inherited;
 …
     AllowQuickOrder := True;
     x := CurrentDietText;
+    if Piece(x, #13, 1) <> 'Current Diet:  ' then
+    begin
+      AStringList := TStringList.Create;
+      try
+        AStringList.Text := x;
+        CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
+                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
+        if AStringList.Count > 1 then
+        begin
+          CxMsg := CxMsg + CRLF + CRLF +
+                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
+                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
+          if AStringList.Count > 2 then
+          for i := 2 to AStringList.Count - 1 do
+            CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
+        end;
+      finally
+        AStringList.Free;
+      end;
+    end;
+    CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, x, CxMsg, nbkDiet);
     if CxMsg <> '' then
     begin
 …
           end
         else
           cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
+          FastAssign(uRecurringMealList, cboOPTFRecurringMeals.Items);
     end;
     cboOPTFRecurringMeals.Visible := not OrderForInpatient;
 …
           end
         else
           cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
+          FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
       end
     else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
 …
         end
       else
         cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
+        FastAssign(uRecurringMealList, cboOPAORecurringMeals.Items);
     end;
     cboOPAORecurringMeals.Visible := not OrderForInpatient;
 …
        AllowQuickOrder := False;
        ResetControlsOP;
        cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
+       FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items);
        { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
        chkOPCancelTubefeeding.State := cbGrayed;
 …
        LoadDietQuickList(cboOPDietAvail.Items, 'MEAL');              // use D.G. short name here
        cboOPDietAvail.InsertSeparator;
        cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
+       FastAddStrings(SubsetOfOPDiets, cboOPDietAvail.Items);
        cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
        { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
 …
   Changing := False;                                       // Changing reset
   StatusText('');
+  if FGiveMultiTabMessage then  // CQ#15483
+  begin
+    FGiveMultiTabMessage := FALSE;
+    GetScreenReader.Speak('Multi Tab Form');
+  end;
 end;
 …
         end
       else
         cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
+        FastAssign(uRecurringMealList, cboOPELRecurringMeals.Items);
     end;
   Changing := False;
 …
 var
   DCOrder: TOrder;
-  AResponse, AnotherResponse: TResponse;
   LateTrayFields: TLateTrayFields;
+  NewOrder: TOrder;
+  CanSign: Integer;
+  //CxMsg: string;
 begin
   // these actions should be before inherited, so that InitDialog doesn't clear properties
 …
   if nbkDiet.ActivePage = pgeDiet then
   begin
+(*    if Self.EvtID <> 0 then
+    begin
+      CheckForAutoDCDietOrders(Self.EvtID, Self.DisplayGroup, '', CxMsg, cmdAccept);
+      if CxMsg <> '' then
+      begin
+        if InfoBox(CxMsg + CRLF + CRLF +
+           'Have you done either of the above?', 'Possible delayed order conflict',
+           MB_ICONWARNING or MB_YESNO) = ID_NO
+           then exit;
+      end;
+    end;*)
     // create dc tubefeeding order
     if chkCancelTubeFeeding.State = cbChecked then
 …
     end;
     // check if late tray should be ordered
+    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
+    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
+    begin
+      AResponse := Responses.FindResponseByName('START', 1);
+      if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
+    end;
+    LateTrayCheck(Responses, Self.EvtID, FALSE, LateTrayFields);
   end;
 { TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
 …
     end;
     // check if late tray should be ordered
+    AResponse := Responses.FindResponseByName('ORDERABLE', 1);
+    if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
+    begin
+      AResponse := Responses.FindResponseByName('START', 1);
+      AnotherResponse := Responses.FindResponseByName('MEAL', 1);
+      if (AResponse <> nil) and (AnotherResponse <> nil) then
+        CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
+    end;
+  end;
+  inherited;
+  with LateTrayFields do if LateMeal <> #0 then
+  begin
+    NewOrder := TOrder.Create;
+    OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
+    if NewOrder.ID <> '' then
+    begin
+      if OrderForInpatient then
+        begin
+          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
+            then CanSign := CH_SIGN_YES
+            else CanSign := CH_SIGN_NA;
+        end
+      else
+        begin
+          CanSign := CH_SIGN_NA;
+        end;
+      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
+      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
+    end
+    else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
+    NewOrder.Free;
+  end;
+    LateTrayCheck(Responses, Self.EvtID, TRUE, LateTrayFields);
+  end;
+  inherited;
+  with LateTrayFields do if LateMeal <> #0 then LateTrayOrder(LateTrayFields, OrderForInpatient);
 end;

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

-              r456
+              r829
   Left = 398
   Top = 254
-  Width = 304
-  Height = 188
   Caption = 'Late Tray?'
+  ClientHeight = 161
+  ClientWidth = 296
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 304
+  ExplicitHeight = 188
   PixelsPerInch = 96
   TextHeight = 13
   object Bevel1: TBevel
+  object Bevel1: TBevel [0]
     Left = 0
     Top = 66
 …
     Height = 2
   end
   object lblMealCutoff: TStaticText
+  object lblMealCutoff: TStaticText [1]
     Left = 8
     Top = 16
 …
     TabOrder = 4
   end
   object Label2: TStaticText
+  object Label2: TStaticText [2]
     Left = 8
     Top = 34
 …
     TabOrder = 5
   end
   object GroupBox1: TGroupBox
+  object GroupBox1: TGroupBox [3]
     Left = 109
     Top = 76
 …
     end
   end
   object cmdYes: TButton
+  object cmdYes: TButton [4]
     Left = 216
     Top = 8
 …
     OnClick = cmdYesClick
   end
   object cmdNo: TButton
+  object cmdNo: TButton [5]
     Left = 216
     Top = 37
 …
     OnClick = cmdNoClick
   end
   object chkBagged: TCheckBox
+  object chkBagged: TCheckBox [6]
     Left = 8
     Top = 76
 …
     TabOrder = 3
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblMealCutoff'
+        'Status = stsDefault')
+      (
+        'Component = Label2'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox1'
+        'Status = stsDefault')
+      (
+        'Component = radLT1'
+        'Status = stsDefault')
+      (
+        'Component = radLT2'
+        'Status = stsDefault')
+      (
+        'Component = radLT3'
+        'Status = stsDefault')
+      (
+        'Component = cmdYes'
+        'Status = stsDefault')
+      (
+        'Component = cmdNo'
+        'Status = stsDefault')
+      (
+        'Component = chkBagged'
+        'Status = stsDefault')
+      (
+        'Component = frmODDietLT'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, ExtCtrls, StdCtrls, ORFn;
+  fAutoSz, ExtCtrls, StdCtrls, ORFn, fODBase, rODBase, VA508AccessibilityManager;
 type
 …
 procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
+procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
+procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
 implementation
 …
 end;
+procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
+var
+  AResponse, AnotherResponse: TResponse;
+begin
+  if IsOutpatient then
+  begin
+    AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
+    if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
+    begin
+      AResponse := SomeResponses.FindResponseByName('START', 1);
+      AnotherResponse := SomeResponses.FindResponseByName('MEAL', 1);
+      if (AResponse <> nil) and (AnotherResponse <> nil) then
+        CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
+    end;
+  end
+  else
+  begin
+    AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
+    if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
+    begin
+      AResponse := SomeResponses.FindResponseByName('START', 1);
+      if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
+    end;
+  end;
+end;
+procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
+const
+  TX_EL_SAVE_ERR    = 'An error occurred while saving this late tray order.';
+  TC_EL_SAVE_ERR    = 'Error Saving Late Tray Order';
+var
+  NewOrder: TOrder;
+  CanSign: integer;
+begin
+  NewOrder := TOrder.Create;
+  try
+    with LateTrayFields do OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
+    if NewOrder.ID <> '' then
+    begin
+      if IsInpatient then
+        begin
+          if (Encounter.Provider = User.DUZ) and User.CanSignOrders
+            then CanSign := CH_SIGN_YES
+            else CanSign := CH_SIGN_NA;
+        end
+      else
+        begin
+          CanSign := CH_SIGN_NA;
+        end;
+      Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
+      SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
+    end
+    else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
+  finally
+    NewOrder.Free;
+  end;
+end;
 // ---------- frmODDietLT procedures ---------------
 procedure TfrmODDietLT.FormCreate(Sender: TObject);

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

-              r456
+              r829
 inherited frmODGen: TfrmODGen
   Left = 314
   Top = 410
+  Left = 223
+  Top = 290
   Caption = 'frmODGen'
+  ExplicitLeft = 223
+  ExplicitTop = 290
   PixelsPerInch = 96
   TextHeight = 13
 …
     TabOrder = 4
   end
+  inherited cmdAccept: TButton
+    Anchors = [akRight, akBottom]
+  inherited cmdQuit: TButton
+    Top = 219
+    ExplicitTop = 219
   end
+  inherited cmdQuit: TButton
+    Anchors = [akRight, akBottom]
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = sbxMain'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODGen'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase;
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORDtTm, ORCtrls, ORFn, rODBase, fBase508Form,
+  VA508AccessibilityManager;
 type
 …
     procedure FormCreate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
+    procedure cmdAcceptClick(Sender: TObject);
   private
     FilterOut: boolean;
 …
     procedure PlaceMemo(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
     procedure PlaceLabel(DialogCtrl: TDialogCtrl; DialogItem: TDialogItem);
+    procedure TrimAllMemos;
   protected
+    FFormCloseCalled : Boolean;
     FCharHt: Integer;
     FCharWd: Integer;
 …
     procedure SetDialogIEN(Value: Integer); override;
     procedure Validate(var AnErrMsg: string); override;
+    procedure UpdateAccessabilityActions(var Actions: TAccessibilityActions); override;
   public
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
 …
   IDs,TSstr, AttendStr: string;
 begin
+  FFormCloseCalled := false;
   inherited;
   FilterOut := True;
 …
   FDialogItemList.Free;
   FDialogCtrlList.Free;
+  FFormCloseCalled := true;
   inherited;
 end;
 …
           theEvtInfo := EventInfo1(AResponse.IValue);
           AResponse.EValue := Piece(theEvtInfo,'^',4);
         end;
+        end;
         if AResponse = nil then
         begin
 …
     Changing := False;
   end; {if OrderAction}
+  UpdateColorsFor508Compliance(Self);
   ControlChange(Self);
   if (FFirstCtrl <> nil) and (FFirstCtrl.Enabled) then SetFocusedControl(FFirstCtrl);
+end;
+procedure TfrmODGen.UpdateAccessabilityActions(
+  var Actions: TAccessibilityActions);
+begin
+  exclude(Actions, aaColorConversion);
 end;
 …
         with TORComboBox(Editor) do
         begin
           Items.AddStrings(TStrings(TopTSList));
+          FastAddStrings(TStrings(TopTSList), TORComboBox(Editor).Items);
           LongList := false;
         end;
 …
 end;
+procedure TfrmODGen.TrimAllMemos;
+var
+  i : integer;
+  Memo : TMemo;
+begin
+  if FFormCloseCalled then Exit; //it is possible for TrimAllMemos to get called after FormClose
+  if Not Assigned(FDialogCtrlList) then Exit;
+  for i := 0 to FDialogCtrlList.Count - 1 do
+    if TDialogCtrl(FDialogCtrlList.Items[i]).Editor is TMemo then begin
+      Memo := TMemo(TDialogCtrl(FDialogCtrlList.Items[i]).Editor);
+      Memo.Lines.Text := Trim(Memo.Lines.Text);
+    end;
+end;
+procedure TfrmODGen.cmdAcceptClick(Sender: TObject);
+begin
+  inherited;
+  Application.ProcessMessages;
+  TrimAllMemos;
+end;
 procedure TfrmODGen.ControlChange(Sender: TObject);
 var

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

-              r456
+              r829
   Height = 271
   Caption = 'Order a Lab Test'
+  ExplicitWidth = 523
+  ExplicitHeight = 271
   PixelsPerInch = 96
   TextHeight = 13
 …
     Left = 443
     TabOrder = 18
+    ExplicitLeft = 443
   end
   inherited cmdQuit: TButton
 …
     Height = 56
     TabOrder = 21
+    ExplicitLeft = 18
+    ExplicitTop = 192
+    ExplicitHeight = 56
     inherited imgMessage: TImage
       Top = 11
+      ExplicitTop = 11
     end
     inherited memMessage: TRichEdit
 …
       Height = 43
       PopupMenu = MessagePopup
+    end
+  end
+  object pnlCollTimeButton: TKeyClickPanel
+      ExplicitLeft = 41
+      ExplicitTop = 5
+      ExplicitHeight = 43
+    end
+  end
+  object pnlCollTimeButton: TKeyClickPanel [24]
     Left = 288
     Top = 167
 …
     end
   end
   object cboAvailTest: TORComboBox
+  object cboAvailTest: TORComboBox [25]
     Left = 6
     Top = 18
 …
     CharsNeedMatch = 1
   end
   object cboFrequency: TORComboBox
+  object cboFrequency: TORComboBox [26]
     Left = 326
     Top = 166
 …
     CharsNeedMatch = 1
   end
   object cboCollSamp: TORComboBox
+  object cboCollSamp: TORComboBox [27]
     Left = 269
     Top = 28
 …
     CharsNeedMatch = 1
   end
   object cboSpecimen: TORComboBox
+  object cboSpecimen: TORComboBox [28]
     Left = 269
     Top = 55
 …
     CharsNeedMatch = 1
   end
   object cboUrgency: TORComboBox
+  object cboUrgency: TORComboBox [29]
     Left = 269
     Top = 82
 …
     CharsNeedMatch = 1
   end
   object txtAddlComment: TCaptionEdit
+  object txtAddlComment: TCaptionEdit [30]
     Left = 187
     Top = 122
 …
     Caption = 'Additional Comment'
   end
   object txtDays: TCaptionEdit
+  object txtDays: TCaptionEdit [31]
     Left = 430
     Top = 166
 …
     Caption = 'How Long?'
   end
   object FLabCommonCombo: TORListBox
+  object FLabCommonCombo: TORListBox [32]
     Left = 440
     Top = 247
 …
     LongList = False
   end
   object cboCollTime: TORComboBox
+  object cboCollTime: TORComboBox [33]
     Left = 149
     Top = 166
 …
     CharsNeedMatch = 1
   end
   object cboCollType: TORComboBox
+  object cboCollType: TORComboBox [34]
     Left = 6
     Top = 166
 …
     CharsNeedMatch = 1
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = txtImmedColl'
+        'Status = stsDefault')
+      (
+        'Component = calCollTime'
+        'Status = stsDefault')
+      (
+        'Component = pnlUrineVolume'
+        'Status = stsDefault')
+      (
+        'Component = txtUrineVolume'
+        'Status = stsDefault')
+      (
+        'Component = pnlAntiCoagulation'
+        'Status = stsDefault')
+      (
+        'Component = txtAntiCoagulant'
+        'Status = stsDefault')
+      (
+        'Component = pnlOrderComment'
+        'Status = stsDefault')
+      (
+        'Component = txtOrderComment'
+        'Status = stsDefault')
+      (
+        'Component = pnlHide'
+        'Status = stsDefault')
+      (
+        'Component = pnlDoseDraw'
+        'Status = stsDefault')
+      (
+        'Component = txtDoseTime'
+        'Status = stsDefault')
+      (
+        'Component = txtDrawTime'
+        'Status = stsDefault')
+      (
+        'Component = pnlPeakTrough'
+        'Status = stsDefault')
+      (
+        'Component = grpPeakTrough'
+        'Status = stsDefault')
+      (
+        'Component = pnlCollTimeButton'
+        'Status = stsDefault')
+      (
+        'Component = cboAvailTest'
+        'Status = stsDefault')
+      (
+        'Component = cboFrequency'
+        'Status = stsDefault')
+      (
+        'Component = cboCollSamp'
+        'Status = stsDefault')
+      (
+        'Component = cboSpecimen'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = txtAddlComment'
+        'Status = stsDefault')
+      (
+        'Component = txtDays'
+        'Status = stsDefault')
+      (
+        'Component = FLabCommonCombo'
+        'Status = stsDefault')
+      (
+        'Component = cboCollTime'
+        'Status = stsDefault')
+      (
+        'Component = cboCollType'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODLab'
+        'Status = stsDefault'))
+  end
   object dlgLabCollTime: TORDateTimeDlg
     FMDateTime = 2980923
+    FMDateTime = 2980923.000000000000000000
     DateOnly = False
     RequireTime = True

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

-              r456
+              r829
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
   ORDtTm, Buttons, Menus;
+  ORDtTm, Buttons, Menus, VA508AccessibilityManager;
 type
 …
     FEvtDivision: integer;
     procedure ReadServerVariables;
+    procedure DisplayChangedOrders(ACollType: string);
   public
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
 …
       EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
       if EvtDelayLoc>0 then
         AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
+        FastAssign(ODForLab(EvtDelayLoc, EvtDivision), AList)
       else
         AList.Assign(ODForLab(Encounter.Location,EvtDivision));
+        FastAssign(ODForLab(Encounter.Location, EvtDivision), AList);
     end else
       AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
+      FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
     CtrlInits.LoadDefaults(AList);
     InitDialog;
 …
           OneSamp := TStringList.Create;
           try
             OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
+            FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
             FillCollSampList(OneSamp, CollSampList.Count);
           finally
 …
     begin
       if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
       AComboBox.Items.Assign(SpecimenList);
+      FastAssign(SpecimenList, AComboBox.Items);
       AComboBox.Items.Add('0^Other...');
       with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
 …
   Days, MsgTxt: Double;
   x: string;
+  ACollType: string;
 const
   TX_NO_TIME        = 'Collection Time is required.' ;
 …
         end;
     end;
+  if (AnErrMsg <> '') or (Self.EvtID > 0) then exit;
+  // add check and display for auto-change from LC to WC - v27.1 - CQ #10226
+  ACollType := Responses.FindResponseByName('COLLECT', 1).EValue;
+  if ((ACollType = 'LC') or (ACollType = 'I')) then DisplayChangedOrders(ACollType);
+end;
+procedure TfrmODLab.DisplayChangedOrders(ACollType: string);
+var
+  AStartDate, ASchedule, ADuration: string;
+  ChangedOrdersList, AList: TStringlist;
+  i, j, k: integer;
+begin
+  ChangedOrdersList := TStringList.Create;
+  try
+    AStartDate := Responses.FindResponseByName('START', 1).IValue;
+    ASchedule  := Responses.FindResponseByName('SCHEDULE', 1).IValue;
+    if txtDays.Enabled then ADuration := Responses.FindResponseByName('DAYS', 1).EValue else ADuration := '';
+    CheckForChangeFromLCtoWCOnAccept(ChangedOrdersList, Encounter.Location, AStartDate, ACollType, ASchedule, ADuration);
+    if ChangedOrdersList.Text <> '' then
+    begin
+      AList := TStringList.Create;
+      try
+        AList.Text := Responses.OrderText;
+        with ChangedOrdersList do
+        begin
+          Insert(5, 'Order   :' + #9 + AList[0]);
+          k := Length(ChangedOrdersList[5]);
+          i := 0;
+          if AList.Count > 1 then
+            for j := 1 to AList.Count - 1 do
+            begin
+              Insert(5 + j, StringOfChar(' ', 9) + #9 + AList[j]);
+              k := HigherOf(k, Length(ChangedOrdersList[5 + j]));
+              i := j;
+            end;
+          Insert(5 + i + 1, StringOfChar('-', k + 4));
+        end;
+        ReportBox(ChangedOrdersList, 'Changed Orders', TRUE);
+      finally
+        AList.Free;
+      end;
+    end;
+  finally
+    ChangedOrdersList.Free;
+  end;
 end;

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

-              r456
+              r829
 object frmODLabImmedColl: TfrmODLabImmedColl
+inherited frmODLabImmedColl: TfrmODLabImmedColl
   Left = 146
   Top = 150
-  Width = 524
-  Height = 286
   Caption = 'Immediate Collection Times'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 259
+  ClientWidth = 516
   OldCreateOrder = True
   OnShow = FormShow
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = memImmedCollect'
+        'Status = stsDefault')
+      (
+        'Component = calImmedCollect'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmODLabImmedColl'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn;
+  StdCtrls, ORCtrls, ORDtTm, ExtCtrls, ORFn, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmODLabImmedColl = class(TForm)
+  TfrmODLabImmedColl = class(TfrmBase508Form)
     memImmedCollect: TCaptionMemo;
     calImmedCollect: TORDateBox;
 …
 procedure TfrmODLabImmedColl.FormShow(Sender: TObject);
 begin
   memImmedCollect.Lines.Assign(ImmediateCollectTimes);
+  FastAssign(ImmediateCollectTimes, memImmedCollect.Lines);
   if Length(FCollTime) > 0 then
     calImmedCollect.Text := FCollTime

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

-              r456
+              r829
 object frmODLabOthCollSamp: TfrmODLabOthCollSamp
+inherited frmODLabOthCollSamp: TfrmODLabOthCollSamp
   Left = 321
   Top = 136
-  Width = 236
-  Height = 359
   BorderIcons = []
   Caption = 'Select Collection Sample'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 332
+  ClientWidth = 228
   OldCreateOrder = True
   Position = poScreenCenter
+  ExplicitWidth = 236
+  ExplicitHeight = 359
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       TabOrder = 0
       OnDblClick = cboOtherCollSampDblClick
+      CharsNeedMatch = 1
     end
     object cmdOK: TButton
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cboOtherCollSamp'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmODLabOthCollSamp'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, ORCtrls, StdCtrls, ORFn;
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODLabOthCollSamp = class(TForm)
+  TfrmODLabOthCollSamp = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     cboOtherCollSamp: TORComboBox;

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

-              r456
+              r829
 object frmODLabOthSpec: TfrmODLabOthSpec
+inherited frmODLabOthSpec: TfrmODLabOthSpec
   Left = 240
   Top = 136
-  Width = 317
-  Height = 359
   BorderIcons = []
   Caption = 'Select Specimen'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 332
+  ClientWidth = 309
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = True
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       OnDblClick = cboOtherSpecDblClick
       OnNeedData = cboOtherSpecNeedData
+      CharsNeedMatch = 1
     end
     object cmdOK: TButton
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cboOtherSpec'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmODLabOthSpec'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, ORCtrls, StdCtrls, ORFn;
+  ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODLabOthSpec = class(TForm)
+  TfrmODLabOthSpec = class(TfrmBase508Form)
     pnlBase: TORAutoPanel;
     cboOtherSpec: TORComboBox;
 …
       with cboOtherSpec do
         begin
           {MItems.Assign(SpecimenList);
+          {FastAssign(SpecimenList, MItems);
           InsertSeparator; }
           InitLongList('');

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

-              r456
+              r829
   Left = 291
   Top = 307
-  Width = 453
-  Height = 254
   BorderIcons = []
   Caption = 'Complex Dose'
+  ClientHeight = 227
+  ClientWidth = 445
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 453
+  ExplicitHeight = 254
   PixelsPerInch = 96
   TextHeight = 13
   object Bevel1: TBevel
+  object Bevel1: TBevel [0]
     Left = 6
     Top = 174
 …
     Height = 2
   end
   object grdDoses: TStringGrid
+  object grdDoses: TStringGrid [1]
     Left = 6
     Top = 6
 …
 )
   end
   object cmdOK: TButton
+  object cmdOK: TButton [2]
     Left = 290
     Top = 184
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [3]
     Left = 368
     Top = 184
 …
     OnClick = cmdCancelClick
   end
   object cboRoute: TORComboBox
+  object cboRoute: TORComboBox [4]
     Left = 170
     Top = 200
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnClick = cboRouteClick
     OnExit = cboRouteExit
+  end
+  object cboSchedule: TORComboBox
+    CharsNeedMatch = 1
+  end
+  object cboSchedule: TORComboBox [5]
     Left = 169
     Top = 176
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Sorted = False
 …
     Visible = False
     OnExit = cboScheduleExit
+  end
+  object pnlInstruct: TPanel
+    CharsNeedMatch = 1
+  end
+  object pnlInstruct: TPanel [6]
     Left = 6
     Top = 177
 …
       ListItemsOnly = False
       LongList = False
+      LookupPiece = 0
       MaxLength = 80
       Sorted = False
       SynonymChars = '<>'
       TabOrder = 0
+    end
+  end
+  object pnlDays: TPanel
+      CharsNeedMatch = 1
+    end
+  end
+  object pnlDays: TPanel [7]
     Left = 6
     Top = 201
 …
       Height = 21
       Associate = txtDays
-      Min = 0
       Max = 999
-      Position = 0
       TabOrder = 1
+      Wrap = False
+    end
+  end
+  object cmdInsert: TButton
+    end
+  end
+  object cmdInsert: TButton [8]
     Left = 6
     Top = 149
 …
     OnClick = cmdInsertClick
   end
   object cmdRemove: TButton
+  object cmdRemove: TButton [9]
     Left = 92
     Top = 149
 …
     OnClick = cmdRemoveClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = grdDoses'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = pnlInstruct'
+        'Status = stsDefault')
+      (
+        'Component = cboInstruct'
+        'Status = stsDefault')
+      (
+        'Component = pnlDays'
+        'Status = stsDefault')
+      (
+        'Component = txtDays'
+        'Status = stsDefault')
+      (
+        'Component = UpDown2'
+        'Status = stsDefault')
+      (
+        'Component = cmdInsert'
+        'Status = stsDefault')
+      (
+        'Component = cmdRemove'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedComplex'
+        'Status = stsDefault'))
+  end
   object popUnits: TPopupMenu
     AutoPopup = False

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

r456	r829
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7	7	fAutoSz, StdCtrls, Grids, Buttons, ExtCtrls, ORCtrls, Menus, ORFn, fODBase, uConst,
8		ComCtrls;
	8	ComCtrls, VA508AccessibilityManager;
9	9
10	10	type

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

-              r456
+              r829
   Left = 333
   Top = 258
-  Width = 316
-  Height = 205
   Caption = 'Formulary Alternatives'
+  ClientHeight = 178
+  ClientWidth = 308
   FormStyle = fsStayOnTop
   OnCreate = FormCreate
+  ExplicitWidth = 316
+  ExplicitHeight = 205
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
     Caption = 'The selected drug is not in the formulary.  Alternatives are:'
   end
   object Label2: TStaticText
+  object Label2: TStaticText [1]
     Left = 8
     Top = 127
 …
     TabOrder = 3
   end
   object lstFormAlt: TORListBox
+  object lstFormAlt: TORListBox [2]
     Left = 8
     Top = 22
 …
     Pieces = '2'
   end
   object cmdYes: TButton
+  object cmdYes: TButton [3]
     Left = 74
     Top = 148
 …
     OnClick = cmdYesClick
   end
   object cmdNo: TButton
+  object cmdNo: TButton [4]
     Left = 162
     Top = 148
 …
     OnClick = cmdNoClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Label2'
+        'Status = stsDefault')
+      (
+        'Component = lstFormAlt'
+        'Status = stsDefault')
+      (
+        'Component = cmdYes'
+        'Status = stsDefault')
+      (
+        'Component = cmdNo'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedFA'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORCtrls, ORFn;
+  fAutoSz, StdCtrls, ORCtrls, ORFn, VA508AccessibilityManager;
 type
 …
         with frmODMedFA do
         begin
           lstFormAlt.Items.Assign(FormAltList);
+          FastAssign(FormAltList, lstFormAlt.Items);
           ShowModal;
           if Length(FSelected) > 0 then

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

-              r456
+              r829
 inherited frmODMedIV: TfrmODMedIV
   Left = 587
   Top = 331
   Width = 610
   Height = 341
+  Left = 246
+  Top = 256
+  Width = 668
+  Height = 465
   Caption = 'Infusion Order'
+  OnKeyDown = FormKeyDown
+  Constraints.MinHeight = 350
+  Constraints.MinWidth = 500
+  ExplicitWidth = 668
+  ExplicitHeight = 465
   PixelsPerInch = 96
   TextHeight = 13
   object lblInfusionRate: TLabel [0]
     Left = 6
     Top = 196
     Width = 96
     Height = 13
     Caption = 'Infusion Rate (ml/hr)'
+    Left = 486
+    Top = 197
+    Width = 100
+    Height = 13
+    Caption = 'Infusion Rate (ml/hr)*'
   end
   object lblPriority: TLabel [1]
     Left = 134
     Top = 196
     Width = 31
     Height = 13
     Caption = 'Priority'
+    Left = 8
+    Top = 238
+    Width = 35
+    Height = 13
+    Caption = 'Priority*'
   end
   object lblComponent: TLabel [2]
     Left = 214
     Top = 6
     Width = 81
     Height = 13
     Caption = 'Solution/Additive'
+    Top = 7
+    Width = 85
+    Height = 13
+    Caption = 'Solution/Additive*'
   end
   object lblAmount: TLabel [3]
     Left = 328
     Top = 6
     Width = 80
     Height = 13
     Caption = 'Volume/Strength'
+    Top = 7
+    Width = 84
+    Height = 13
+    Caption = 'Volume/Strength*'
     WordWrap = True
   end
   object lblComments: TLabel [4]
     Left = 214
     Top = 106
+    Top = 107
     Width = 49
     Height = 13
 …
   end
   object lblLimit: TLabel [5]
+    Left = 230
+    Top = 196
+    Width = 117
+    Height = 13
+    Caption = 'Duration or Total Volume'
+  end
+  object txtRate: TCaptionEdit [6]
+    Left = 6
+    Top = 210
+    Left = 185
+    Top = 238
+    Width = 165
+    Height = 13
+    Caption = 'Duration or Total Volume (Optional)'
+  end
+  object Label1: TLabel [6]
+    Left = 8
+    Top = 344
+    Width = 133
+    Height = 13
+    Caption = ' * Indicates a Required Field'
+  end
+  object lblRoute: TLabel [7]
+    Left = 8
+    Top = 197
+    Width = 33
+    Height = 13
+    Caption = 'Route*'
+  end
+  object lblSchedule: TLabel [8]
+    Left = 304
+    Top = 197
+    Width = 52
+    Height = 13
+    Caption = 'Schedule *'
+  end
+  object lblType: TLabel [9]
+    Left = 184
+    Top = 197
+    Width = 28
+    Height = 13
+    Caption = 'Type*'
+    ParentShowHint = False
+    ShowHint = True
+  end
+  object txtNSS: TLabel [10]
+    Left = 361
+    Top = 197
+    Width = 69
+    Height = 13
+    Caption = '(Day-of-Week)'
+    Color = clBtnFace
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -11
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentColor = False
+    ParentFont = False
+    OnClick = txtNSSClick
+  end
+  object txtAllIVRoutes: TLabel [11]
+    Left = 47
+    Top = 197
+    Width = 129
+    Height = 13
+    Caption = '(Expanded Med Route List)'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -11
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentFont = False
+    Visible = False
+    OnClick = txtAllIVRoutesClick
+  end
+  object lblTypeHelp: TLabel [12]
+    Left = 219
+    Top = 197
+    Width = 68
+    Height = 13
+    Caption = '(IV Type Help)'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clBlue
+    Font.Height = -11
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentFont = False
+    ParentShowHint = False
+    ShowHint = False
+    OnClick = lblTypeHelpClick
+  end
+  object txtRate: TCaptionEdit [13]
+    Left = 486
+    Top = 211
     Width = 91
     Height = 21
     AutoSelect = False
+    TabOrder = 5
+    OnChange = ControlChange
+    OnExit = txtRateExit
+    TabOrder = 8
+    OnChange = txtRateChange
     Caption = 'Infusion Rate'
   end
   object cboPriority: TORComboBox [7]
     Left = 134
     Top = 210
+  object cboPriority: TORComboBox [14]
+    Left = 8
+    Top = 252
     Width = 72
     Height = 21
 …
     Sorted = False
     SynonymChars = '<>'
+    TabOrder = 6
+    OnChange = ControlChange
+    TabOrder = 10
+    OnChange = cboPriorityChange
+    OnExit = cboPriorityExit
     CharsNeedMatch = 1
   end
   object grdSelected: TCaptionStringGrid [8]
+  object grdSelected: TCaptionStringGrid [15]
     Left = 214
     Top = 20
     Width = 384
+    Top = 21
+    Width = 437
     Height = 76
     ColCount = 3
 …
     Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected]
     ScrollBars = ssVertical
     TabOrder = 2
+    TabOrder = 1
     OnDrawCell = grdSelectedDrawCell
     OnKeyPress = grdSelectedKeyPress
 …
     Caption = 'Selected Solution and Additives'
   end
   object cmdRemove: TButton [9]
+  object cmdRemove: TButton [16]
     Left = 443
     Top = 99
+    Top = 100
     Width = 72
     Height = 18
     Caption = 'Remove'
     TabOrder = 3
+    TabOrder = 2
     OnClick = cmdRemoveClick
   end
   object memComments: TCaptionMemo [10]
+  object memComments: TCaptionMemo [17]
     Left = 214
     Top = 120
     Width = 384
+    Top = 121
+    Width = 437
     Height = 66
     Lines.Strings = (
       'memComments')
     ScrollBars = ssVertical
     TabOrder = 4
+    TabOrder = 13
     OnChange = ControlChange
     Caption = 'Comments'
   end
   object txtSelected: TCaptionEdit [11]
+  object txtSelected: TCaptionEdit [18]
     Tag = -1
     Left = 416
     Top = 44
+    Top = 45
     Width = 45
     Height = 19
 …
     Caption = 'Volume'
   end
   object cboSelected: TCaptionComboBox [12]
+  object cboSelected: TCaptionComboBox [19]
     Tag = -1
     Left = 460
     Top = 44
+    Top = 45
     Width = 53
     Height = 21
 …
     ItemHeight = 13
     ParentCtl3D = False
     TabOrder = 1
+    TabOrder = 4
     Visible = False
     OnChange = cboSelectedChange
 …
   end
   inherited memOrder: TCaptionMemo
     Top = 255
+    Top = 359
     Width = 475
+    TabOrder = 10
+  end
+  inherited cmdAccept: TButton
+    Left = 495
+    Top = 255
+    TabOrder = 8
+  end
+  inherited cmdQuit: TButton
+    Left = 495
+    Top = 282
+    TabOrder = 9
+  end
+  inherited pnlMessage: TPanel
+    Top = 237
+    TabStop = True
+    TabOrder = 16
+    ExplicitTop = 359
+    ExplicitWidth = 475
+  end
+  object pnlXDuration: TPanel [21]
+    Left = 184
+    Top = 252
+    Width = 150
+    Height = 21
+    BevelOuter = bvNone
     TabOrder = 11
-  end
-  object pnlXDuration: TPanel
-    Left = 229
-    Top = 210
-    Width = 121
-    Height = 21
-    BevelOuter = bvNone
-    TabOrder = 7
     OnEnter = pnlXDurationEnter
-    DesignSize = (
-)
-    object btnXDuration: TBitBtn
-      Left = 69
-      Top = 1
-      Width = 50
-      Height = 20
-      Anchors = [akLeft, akTop, akRight, akBottom]
-      Caption = 'days'
-      TabOrder = 1
-      OnClick = btnXDurationClick
-      Glyph.Data = {
-        AE000000424DAE0000000000000076000000280000000E000000070000000100
-        0400000000003800000000000000000000001000000000000000000000000000
-        8000008000000080800080000000800080008080000080808000C0C0C0000000
-        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
-        330033333333333333003330333333733300330003333F87330030000033FFFF
-        F30033333333333333003333333333333300}
-      Layout = blGlyphRight
-      NumGlyphs = 2
-      Spacing = 0
-    end
     object txtXDuration: TCaptionEdit
       Left = 0
 …
       Caption = 'Duration'
     end
+  end
+  object pnlCombo: TPanel
+    Left = 8
+    Top = 1
+    object cboDuration: TComboBox
+      Left = 70
+      Top = 0
+      Width = 75
+      Height = 21
+      ItemHeight = 13
+      TabOrder = 2
+      OnChange = cboDurationChange
+      OnEnter = cboDurationEnter
+    end
+  end
+  object pnlCombo: TPanel [22]
+    Left = 8
+    Top = 2
     Width = 200
     Height = 185
     BevelOuter = bvNone
     TabOrder = 17
+    TabOrder = 25
     object cboAdditive: TORComboBox
       Left = 0
 …
       Align = alTop
       TabHeight = 15
       TabOrder = 1
+      TabOrder = 2
       Tabs.Strings = (
         '   Solutions   '
 …
       SynonymChars = '<>'
       TabPositions = '20'
       TabOrder = 2
+      TabOrder = 1
       OnExit = cboSolutionExit
       OnMouseClick = cboSolutionMouseClick
 …
     end
   end
+  object popDuration: TPopupMenu
+    AutoHotkeys = maManual
+    Left = 387
+    Top = 91
+    object popL: TMenuItem
+      Tag = 1
+      Caption = 'L'
+      OnClick = popDurationClick
+    end
+    object popML: TMenuItem
+      Tag = 2
+      Caption = 'ml'
+      OnClick = popDurationClick
+    end
+    object popDays: TMenuItem
+      Tag = 3
+      Caption = 'days'
+      OnClick = popDurationClick
+    end
+    object popHours: TMenuItem
+      Tag = 4
+      Caption = 'hours'
+      OnClick = popDurationClick
+    end
+  object cboRoute: TORComboBox [23]
+    Left = 8
+    Top = 211
+    Width = 168
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Color = clWindow
+    DropDownCount = 8
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 0
+    MaxLength = 0
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 3
+    OnChange = cboRouteChange
+    OnClick = cboRouteClick
+    OnExit = cboRouteExit
+    CharsNeedMatch = 1
+    UniqueAutoComplete = True
+  end
+  object cboSchedule: TORComboBox [24]
+    Left = 304
+    Top = 211
+    Width = 129
+    Height = 21
+    Style = orcsDropDown
+    AutoSelect = True
+    Color = clWindow
+    DropDownCount = 8
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 1
+    MaxLength = 0
+    Pieces = '1'
+    Sorted = True
+    SynonymChars = '<>'
+    TabOrder = 6
+    OnChange = cboScheduleChange
+    OnClick = cboScheduleClick
+    OnExit = cboScheduleExit
+    CharsNeedMatch = 1
+    UniqueAutoComplete = True
+  end
+  object cboType: TComboBox [25]
+    Left = 184
+    Top = 211
+    Width = 114
+    Height = 21
+    ItemHeight = 13
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 5
+    OnChange = cboTypeChange
+  end
+  object chkPRN: TCheckBox [26]
+    Left = 436
+    Top = 213
+    Width = 45
+    Height = 21
+    Caption = 'PRN'
+    TabOrder = 7
+    OnClick = chkPRNClick
+  end
+  object chkDoseNow: TCheckBox [27]
+    Left = 8
+    Top = 279
+    Width = 147
+    Height = 17
+    Anchors = [akLeft]
+    Caption = 'Give Additional Dose Now'
+    Constraints.MinWidth = 147
+    TabOrder = 12
+    OnClick = chkDoseNowClick
+  end
+  object cboInfusionTime: TComboBox [28]
+    Left = 576
+    Top = 211
+    Width = 74
+    Height = 21
+    ItemHeight = 13
+    TabOrder = 9
+    OnChange = cboInfusionTimeChange
+    OnEnter = cboInfusionTimeEnter
+  end
+  object lblAdminTime: TVA508StaticText [29]
+    Name = 'lblAdminTime'
+    Left = 8
+    Top = 308
+    Width = 4
+    Height = 4
+    Alignment = taLeftJustify
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 14
+    TabStop = True
+    Visible = False
+    ShowAccelChar = True
+  end
+  object lblFirstDose: TVA508StaticText [30]
+    Name = 'lblFirstDose'
+    Left = 8
+    Top = 323
+    Width = 4
+    Height = 4
+    Alignment = taLeftJustify
+    TabOrder = 15
+    TabStop = True
+    Visible = False
+    ShowAccelChar = True
+  end
+  inherited cmdAccept: TButton
+    Left = 495
+    Top = 359
+    TabOrder = 17
+    ExplicitLeft = 495
+    ExplicitTop = 359
+  end
+  inherited cmdQuit: TButton
+    Left = 495
+    Top = 386
+    TabOrder = 18
+    ExplicitLeft = 495
+    ExplicitTop = 386
+  end
+  inherited pnlMessage: TPanel
+    Left = 56
+    Top = 349
+    TabOrder = 19
+    ExplicitLeft = 56
+    ExplicitTop = 349
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = txtRate'
+        'Status = stsDefault')
+      (
+        'Component = cboPriority'
+        'Status = stsDefault')
+      (
+        'Component = grdSelected'
+        'Status = stsDefault')
+      (
+        'Component = cmdRemove'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = txtSelected'
+        'Status = stsDefault')
+      (
+        'Component = cboSelected'
+        'Status = stsDefault')
+      (
+        'Component = pnlXDuration'
+        'Status = stsDefault')
+      (
+        'Component = txtXDuration'
+        'Status = stsDefault')
+      (
+        'Component = pnlCombo'
+        'Status = stsDefault')
+      (
+        'Component = cboAdditive'
+        'Status = stsDefault')
+      (
+        'Component = tabFluid'
+        'Status = stsDefault')
+      (
+        'Component = cboSolution'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = cboType'
+        'Status = stsDefault')
+      (
+        'Component = chkPRN'
+        'Status = stsDefault')
+      (
+        'Component = chkDoseNow'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedIV'
+        'Status = stsDefault')
+      (
+        'Component = cboInfusionTime'
+        'Status = stsDefault')
+      (
+        'Component = cboDuration'
+        'Status = stsDefault')
+      (
+        'Component = lblAdminTime'
+        'Status = stsDefault')
+      (
+        'Component = lblFirstDose'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal;
+  fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal, strUtils,
+  VA508AccessibilityManager, VAUtils, fIVRoutes;
 type
 …
     txtSelected: TCaptionEdit;
     cboSelected: TCaptionComboBox;
-    popDuration: TPopupMenu;
-    popML: TMenuItem;
-    popDays: TMenuItem;
-    popHours: TMenuItem;
-    popL: TMenuItem;
     pnlXDuration: TPanel;
     txtXDuration: TCaptionEdit;
     lblLimit: TLabel;
-    btnXDuration: TBitBtn;
     pnlCombo: TPanel;
     cboAdditive: TORComboBox;
 …
     lblPriority: TLabel;
     cboPriority: TORComboBox;
+    Label1: TLabel;
+    cboRoute: TORComboBox;
+    cboSchedule: TORComboBox;
+    lblRoute: TLabel;
+    lblSchedule: TLabel;
+    cboType: TComboBox;
+    lblType: TLabel;
+    chkPRN: TCheckBox;
+    txtNSS: TLabel;
+    chkDoseNow: TCheckBox;
+    cboInfusionTime: TComboBox;
+    cboDuration: TComboBox;
+    lblAdminTime: TVA508StaticText;
+    lblFirstDose: TVA508StaticText;
+    txtAllIVRoutes: TLabel;
+    lblTypeHelp: TLabel;
     procedure FormCreate(Sender: TObject);
     procedure tabFluidChange(Sender: TObject);
     procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
+    procedure  cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
       InsertAt: Integer);
     procedure cboSolutionNeedData(Sender: TObject; const StartFrom: string; Direction,
 …
     procedure grdSelectedMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
-    procedure btnXDurationClick(Sender: TObject);
-    procedure popDurationClick(Sender: TObject);
     procedure txtXDurationChange(Sender: TObject);
     procedure pnlXDurationEnter(Sender: TObject);
     procedure txtXDurationExit(Sender: TObject);
+    procedure txtRateExit(Sender: TObject);
+    procedure cboScheduleChange(Sender: TObject);
+    procedure cboTypeChange(Sender: TObject);
+    procedure cboRouteChange(Sender: TObject);
+    procedure txtRateChange(Sender: TObject);
+    procedure cboPriorityChange(Sender: TObject);
+    procedure cboPriorityExit(Sender: TObject);
+    procedure cboRouteExit(Sender: TObject);
+    procedure txtNSSClick(Sender: TObject);
+    procedure cboScheduleClick(Sender: TObject);
+    procedure chkPRNClick(Sender: TObject);
+    procedure chkDoseNowClick(Sender: TObject);
+    procedure loadExpectFirstDose;
+    procedure SetSchedule(const x: string);
+    procedure cboScheduleExit(Sender: TObject);
+    procedure cboInfusionTimeChange(Sender: TObject);
+    procedure cboDurationChange(Sender: TObject);
+    procedure cboDurationEnter(Sender: TObject);
+    procedure cboInfusionTimeEnter(Sender: TObject);
+    procedure txtAllIVRoutesClick(Sender: TObject);
+    procedure cboRouteClick(Sender: TObject);
+    procedure lblTypeHelpClick(Sender: TObject);
   private
     FInpatient: Boolean;
+    FNSSAdminTime: string;
+    FNSSScheduleType: string;
+    OSolIEN: integer;
+    OAddIEN: integer;
+    OSchedule: string;
+    oAdmin: string;
+    Action: integer;
+    OrderIEN: string;
+    FAdminTimeText: string;
+    JAWSON: boolean;
+    FOriginalDurationType: integer;
+    FOriginalInfusionType: integer;
+    FInitialOrderID: boolean;
     procedure SetValuesFromResponses;
     procedure DoSetFontSize( FontSize: integer);
     procedure ClickOnGridCell;
     procedure SetLimitationControl(aValue: string);
+    function CreateOtherSchedule: string;
+    function CreateOtherRoute: string;
+    procedure UpdateRoute;
+    procedure DisplayDoseNow(Status: boolean);
+    procedure UpdateDuration(SchType: string);
+    procedure ClearAllFields;
   public
     procedure InitDialog; override;
 …
     procedure Validate(var AnErrMsg: string); override;
     procedure SetFontSize( FontSize: integer); override;
+    function ValidateInfusionRate(Rate: string): string;
+    function IVTypeHelpText: string;
+    property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
+    property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
   end;
 …
 {$R *.DFM}
 uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid, fFrame;
+uses ORFn, uConst, rODMeds, rODBase, fFrame, uCore, fOtherSchedule, rCore;
 const
 …
   TX_NO_UNITS  = 'Units must be entered for ';
   TX_NO_RATE   = 'An infusion rate must be entered.';
+  TX_BAD_RATE  = 'The infusion rate must be:  # ml/hr  or  text@labels per day';
+  //TX_BAD_RATE  = 'The infusion rate must be:  # ml/hr  or  text@labels per day';
+  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';
+  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.';
+  TX_NO_SCHEDULE = 'A schedule is required for an intermittent order.';
+  TX_BAD_SCHEDULE = 'Unable to resolve non-standard schedule.';
+  TX_NO_INFUSION_UNIT = 'Invalid Unit of Time, select either "Minutes" or "Hours" for the Infusion Length';
+  TX_BAD_ROUTE = 'Route cannot be free-text';
+  TX_LEADING_NUMERIC = 'this additive must start with a leading numeric value';
 (*
 …
 begin
   frmFrame.pnlVisit.Enabled := false;
+  //AutoSizeDisabled := true;
   inherited;
   AllowQuickOrder := True;
 …
   CtrlInits.LoadDefaults(ODForIVFluids);         // ODForIVFluids returns TStrings with defaults
   InitDialog;
-  TAccessibleStringGrid.WrapControl(grdSelected);
 end;
 …
   i: Integer;
 begin
-  TAccessibleStringGrid.UnwrapControl(grdSelected);
   with grdSelected do for i := 0 to RowCount - 1 do TIVComponent(Objects[0, i]).Free;
   inherited;
 …
 procedure TfrmODMedIV.FormResize(Sender: TObject);
+var
+bottom: integer;
 begin
   inherited;
 …
   end;
   lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0];
+  self.cboType.SelLength := 0;
+  self.cboInfusionTime.SelLength := 0;
+  self.cboDuration.SelLength := 0;
+  bottom := self.cboPriority.Top + self.cboPriority.Height;
+  if self.chkDoseNow.Top < bottom then self.chkDoseNow.Top := bottom + 5;
+  self.txtRate.Height := self.cboInfusionTime.Height;
+  self.txtXDuration.Height := self.cboDuration.Height;
+  self.lblAdminTime.Height := TextHeightByFont(self.lblAdminTime.Font.Handle, 'A');
+  self.lblFirstDose.Height := TextHeightByFont(self.lblFirstDose.Font.Handle, 'A');
+  self.lblAdminTime.Width := TextWidthByFont(self.lblAdminTime.Font.Handle, self.lblAdminTime.Caption + '  ');
+  self.lblFirstDose.Width := TextWidthByFont(self.lblFirstDose.Font.Handle, self.lblFirstDose.Caption + '  ');
+  self.lblAdminTime.Top := self.chkDoseNow.Top + self.chkDoseNow.Height + 2;
+  self.lblFirstDose.Top := self.lblAdminTime.Top + self.lblAdminTime.Height + 2;
+  if self.Label1.Top < (self.lblFirstDose.Top + self.lblFirstDose.Height) then
+    begin
+      self.Label1.Top := self.lblFirstDose.Top + self.lblFirstDose.Height + 2;
+      self.memOrder.Top := self.Label1.Top + self.Label1.Height;
+    end;
 end;
 …
   inherited;
   //grdSelected.Selection := NOSELECTION;
+  //FRouteConflict := False;
+  //lblTypeHelp.Hint := IVTypeHelpText;
+  lblType.Hint := IVTypeHelpText;
+  cboType.Hint := IVTYpeHelpText;
   with grdSelected do for i := 0 to RowCount - 1 do
   begin
 …
     cboSolution.InsertSeparator;
     SetControl(cboPriority, 'Priorities');
+    cboType.Items.Add('Continuous');
+    cboType.Items.Add('Intermittent');
+    cboType.ItemIndex := -1;
+    cboType.SelLength := 0;
+    //SetControl(cboRoute, 'Route');
+    if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := '';
+    //SetControl(cboSchedule, 'Schedules');
+    LoadSchedules(cboSchedule.Items, patient.Inpatient);
+    //if (Patient.Inpatient) and (cboSchedule.Items.IndexOfName('Other')<0) then
+    if cboSchedule.Items.IndexOf('Other') = -1 then cboSchedule.Items.Add('OTHER');
+    cboSchedule.Enabled := False;
+    lblschedule.Enabled := False;
+    if cboInfusionTime.Items.Count = 0 then
+       begin
+        cboInfusionTime.Items.add('Minutes');
+        cboInfusionTime.Items.Add('Hours');
+       end;
+    cboInfusionTime.Enabled := false;
+    updateDuration('');
+    if cboDuration.Items.Count = 0 then
+      begin
+        cboDuration.Items.Add('L');
+        cboDuration.Items.Add('ml');
+        cboDuration.Items.Add('days');
+        cboDuration.Items.Add('hours');
+      end;
+    cboDuration.ItemIndex := -1;
+    cboDuration.Text := '';
+    if self.txtXDuration.Text <> '' then self.txtXDuration.Text := '';
+    txtNSS.Visible := false;
+    if (chkDoseNow.Visible = true) and (chkDoseNow.Checked = true) then chkDoseNow.Checked := false;
+    chkDoseNow.Visible := false;
+    chkPRN.Enabled := false;
   end;
   tabFluid.TabIndex := 0;
 …
   cboSolution.InitLongList('');
   cboAdditive.InitLongList('');
+  JAWSON := true;
+  if ScreenReaderActive = false then
+    begin
+      lblAdminTime.TabStop := false;
+      lblFirstDose.TabStop := false;
+      memOrder.TabStop := false;
+      JAWSON := false;
+    end;
   ActiveControl := cboSolution;  //SetFocusedControl(cboSolution);
   StatusText('');
+  OSolIEN := 0;
+  OAddIEN := 0;
+  OSchedule := '';
+  oAdmin := '';
+  self.txtAllIVRoutes.Visible := false;
+end;
+function TfrmODMedIV.IVTypeHelpText: string;
+begin
+   result := 'Continuous Type:' + CRLF + '     IVs that run at a specified Rate ( __ml/hr, __mcg/kg/min, etc)' +
+             CRLF + CRLF + 'Intermittent Type:' + CRLF +
+             '     IVs administered at scheduled intervals (Q4H, QDay) or One-Time only, ' +
+             CRLF + '     over a specified time period (e.g. Infuse over 30 min.).' + CRLF + CRLF +
+             'Examples:' + CRLF + 'Continuous = Infusion/drip' + CRLF + 'Intermittent = IVP/IVPB';
+end;
+procedure TfrmODMedIV.lblTypeHelpClick(Sender: TObject);
+var
+str: string;
+begin
+  inherited;
+    str := IVTypeHelpText;
+    infoBox(str, 'Informational Help Text', MB_OK);
+end;
+procedure TfrmODMedIV.loadExpectFirstDose;
+var
+i: integer;
+AnIVComponent: TIVComponent;
+fAddIEN, fSolIEN, Interval, idx: integer;
+AdminTime:    TFMDateTime;
+Admin, Duration, ShowText, SchTxt, SchType, IVType: string;
+doseNow, calFirstDose: boolean;
+begin
+  idx := self.cboSchedule.ItemIndex;
+  IVType := self.cboType.Items.Strings[self.cboType.itemindex];
+  if idx = -1 then
+    begin
+      if IVType = 'Continuous' then
+        begin
+          self.lblFirstDose.Caption := '';
+          self.lblFirstDose.Visible := false;
+        end;
+      exit;
+    end;
+  doseNow := true;
+  SchType := Piece(self.cboSchedule.Items.Strings[idx],U,3);
+  if self.EvtID > 0 then doseNow := false;
+  if (IVType = 'Continuous') or ((idx > -1) and ((SchType = 'P') or (SchType = 'O') or (SchType = 'OC')) or
+     (self.chkPRN.Checked = True))  then
+     begin
+       self.lblFirstDose.Caption := '';
+       self.lblAdminTime.Caption := '';
+       self.lblFirstDose.Visible := false;
+       self.lblAdminTime.Visible := false;
+       self.lblAdminTime.TabStop := false;
+       self.lblFirstDose.TabStop := false;
+       if (self.cboType.Text = 'Continuous') or (Piece(self.cboSchedule.Items.Strings[idx],U,3) = 'O') then doseNow := false;
+       if chkDoseNow.Checked = true then lblFirstDose.Visible := false;
+       if idx > -1 then oSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1);
+       if (self.chkPRN.Checked = True) and (idx > -1) and (LeftStr(Piece(self.cboSchedule.Items.Strings[idx],U,1),3)<> 'PRN') then
+          OSchedule := Piece(self.cboSchedule.Items.Strings[idx],U,1) + ' PRN';
+       DisplayDoseNow(doseNow);
+       exit;
+       //  end;
+     end
+  else if SchType <> 'O' then
+    begin
+      self.lblAdminTime.Visible := true;
+      if FAdminTimeText <> '' then self.lblAdminTime.Caption := 'Admin. Time: ' + FAdminTimeText
+      else if Piece(self.cboSchedule.Items[idx],U,4) <> '' then
+           self.lblAdminTime.Caption := 'Admin. Time: ' + Piece(self.cboSchedule.Items[idx],U,4)
+      else self.lblAdminTime.Caption := 'Admin. Time: Not Defined';
+    end;
+ DisplayDoseNow(doseNow);
+ if chkDoseNow.Checked = true then
+   begin
+     lblFirstDose.Visible := false;
+     Exit;
+   end;
+ self.lblFirstDose.Visible := True;
+ fSolIEN := 0;
+ fAddIEN := 0;
+ for i := 0 to self.grdSelected.RowCount - 1 do
+  begin
+   AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]);
+   if AnIVComponent = nil then Continue;
+   if (AnIVComponent.Fluid = 'B') and (fSolIEN = 0) then fSolIEN := AnIVComponent.IEN;
+   if (AnIVComponent.Fluid = 'A') and (fAddIEN = 0) then fAddIEN := AnIVComponent.IEN;
+   if (fSolIEN > 0) and (fAddIEN > 0) then break;
+  end;
+  SchTxt := self.cboSchedule.Text;
+  Admin := '';
+  if (self.lblAdminTime.visible = True) and (self.lblAdminTime.Caption <> '') then
+    begin
+      Admin := Copy(self.lblAdminTime.Caption,  14, (Length(self.lblAdminTime.Caption)-1));
+      if not (Admin[1] in ['0'..'9']) then Admin := '';
+    end;
+  if (fSolIEN = oSolIEN) and (fAddIEN = oAddIEN) and (OSchedule = SchTxt) and (oAdmin = Admin) then CalFirstDose := false
+  else
+    begin
+      CalFirstDose := True;
+      oSolIEN := fSolIEN;
+      oAddIEN := fAddIEN;
+      oSchedule := SchTxt;
+      oAdmin := Admin;
+    end;
+  if CalFirstDose = True then
+  begin
+    if fAddIEN > 0 then LoadAdminInfo(';' + schTxt, fAddIEN, ShowText, AdminTime, Duration, Admin)
+    else LoadAdminInfo(';' + schTxt, fSolIEN, ShowText, AdminTime, Duration, Admin);
+    if AdminTime > 0 then
+      begin
+        ShowText := 'Expected First Dose: ';
+        Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
+        case Interval of
+: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
+: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
+        else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
+      end;
+    end;
+    self.lblFirstDose.Caption := ShowText;
+  end;
+  if (self.lblFirstDose.Visible = true) and (self.lblFirstDose.Caption <> '') and (JAWSON = true) then self.lblFirstDose.TabStop := true
+  else self.lblFirstDose.TabStop := false;
+  if (self.lblAdminTime.Visible = true) and (self.lblAdminTime.Caption <> '') and (JAWSON = true) then self.lblAdminTime.TabStop := true
+  else self.lblAdminTime.TabStop := false;
 end;
 procedure TfrmODMedIV.Validate(var AnErrMsg: string);
 var
   ItemOK: Boolean;
   x: string;
   i: Integer;
+  DispWarning, ItemOK, Result: Boolean;
+  LDec,RDec,x, tempStr, iunit, infError: string;
+  digits, i, j, Len, temp, Value: Integer;
   procedure SetError(const x: string);
 …
     ItemOK := False;
     for i := 0 to RowCount - 1 do
+      if TIVComponent(Objects[0, i]).Fluid = 'B' then ItemOK := True;
+    if not ItemOK then SetError(TX_NO_BASE);
+      if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'B') then ItemOK := True;
+    if (not ItemOK) and ((self.cboType.ItemIndex = -1) or (MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous')) then
+        SetError(TX_NO_BASE);
     for i := 0 to RowCount - 1 do
     begin
 …
       if (Objects[0, i] <> nil) and (Length(Cells[2, i]) = 0)
         then SetError(TX_NO_UNITS + Cells[0, i]);
+    end;
+  end;
+  if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else
+  begin
+    x := Trim(txtRate.Text);
+    ValidateIVRate(x);
+    if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x);
+  end;
+      if (Objects[0,i] <> nil) and (TIVComponent(Objects[0, i]).Fluid = 'A') then
+        begin
+          temp := Pos('.', Cells[1, i]);
+          if temp > 0 then
+            begin
+              tempStr := Cells[1, i];
+               if temp = 1 then
+                 begin
+                   SetError(cells[0, i] + TX_LEADING_NUMERIC);
+                   Exit;
+                 end;
+              for j := 1 to temp -1 do if not (tempStr[j] in ['0'..'9']) then
+                begin
+                  SetError(cells[0, i] + TX_LEADING_NUMERIC);
+                  Exit;
+                end;
+            end;
+        end;
+  end;
+  end;
+  if Pos(U, self.memComments.Text) > 0 then SetError('Comments cannot contain a "^".');
+  if cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3));
+  if self.cboPriority.Text = '' then SetError('Priority is required');
+  if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then SetError(TX_BAD_ROUTE);
+  if (cboRoute.ItemIndex > -1) and (cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER')) then
+      SetError('A valid route must be selected');
+  if self.cboRoute.Text = '' then SetError('Route is required');
+  if (self.txtXDuration.Text <> '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) = -1) then
+      SetError('A valid duration type is required');
+  if (self.txtXDuration.Text = '') and (self.cboduration.Items.IndexOf(SELF.cboDuration.Text) > -1) then
+     SetError('Cannot have a duration type without a duration value');
+  if self.cboType.ItemIndex = -1 then
+    begin
+      SetError('IV Type is required');
+      Exit;
+    end;
+  if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Continuous' then
+     begin
+      if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else
+        begin
+          x := Trim(txtRate.Text);
+          if pos('@', X) > 0 then
+            begin
+            LDec := Piece(x, '@', 1);
+            RDec := Piece(x, '@', 2);
+            if (Length(RDec) = 0) or (Length(RDec) > 2) then x := '';
+            end
+          else if Pos('.',X)>0 then
+            begin
+              LDec := Piece(x, '.', 1);
+              RDec := Piece(x, '.', 2);
+              if Length(LDec) = 0 then SetError('Infusion Rate required a leading numeric value');
+              if Length(RDec) > 1 then SetError('Infusion Rate cannot exceed one decimal place');
+            end
+            else if LeftStr(txtRate.Text, 1) = '0' then
+               SetError('Infusion Rate cannot start with a zero.');
+          if ( Pos('@',x)=0) then
+            begin
+              if (Length(x) > 4) then
+                begin
+                  seterror(TX_BAD_RATE);
+                  exit;
+                end;
+              for i := 1 to Length(x) do
+                begin
+                  if  not (x[i] in ['0'..'9']) and (x[i] <> '.') then
+                    begin
+                      SetError(TX_BAD_RATE);
+                      exit;
+                    end;
+                end;
+            end;
+          if (pos('ml/hr', X) = 0) and (Length(x) > 0) and (pos('@', X) = 0) then X := X + ' ml/hr';
+          if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x);
+        end;
+      if cboduration.text = 'doses' then SetError('Continuous Orders cannot have "doses" as a duration type');
+    end
+  else if MixedCase(self.cboType.Items.Strings[self.cboType.ItemIndex]) = 'Intermittent' then
+     begin
+      if (cboInfusionTime.ItemIndex = -1) and (txtRate.Text <> '') then SetError(TX_NO_INFUSION_UNIT);
+      if (txtRate.Text = '') and (cboInfusionTime.ItemIndex > -1) then SetError(TX_NO_INFUSION_TIME);
+      if (txtRate.Text <> '') then
+        begin
+          infError := '';
+          InfError := ValidateInfusionRate(txtRate.Text);
+          if infError <> '' then SetError(InfError);
+          Len := Length(txtRate.Text);
+          iunit := MixedCase(self.cboInfusionTime.Items.Strings[cboInfusionTime.ItemIndex]);
+          if (iunit = 'Minutes') and (Len > 4) then setError('Infuse Over Time cannot exceed 4 spaces for ' + iunit)
+          else if (iunit = 'Hours') and (Len > 2) then setError('Infuse Over Time cannot exceed 2 spaces for ' + iunit);
+        end;
+      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text = '')  then SetError(TX_NO_SCHEDULE);
+      if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then SetError(TX_BAD_SCHEDULE);
+    end;
+  if txtXDuration.Text = '' then
+    begin
+      if AnErrMsg = '' then self.FInitialOrderID := True;
+      exit;
+    end;
+  Len := Length(txtXDuration.Text);
+  if LeftStr(txtXDuration.Text,1) <> '.' then
+    begin
+      DispWarning := false;
+      Digits := 2;
+      if cboDuration.text = 'ml' then digits := 4;
+      if ((cboDuration.text = 'days') or (cboDuration.text = 'hours')) and (Len > digits) then
+          DispWarning := true
+      else if (cboduration.text = 'ml') and (Len > digits) then  DispWarning := true
+      else if (cboduration.text = 'L') and (Len > digits) and (Pos('.',txtXDuration.Text) = 0) then DispWarning := True;
+      if DispWarning = true then SetError('Duration for ' + cboduration.text + ' cannot be greater than ' + InttoStr(digits) + ' digits.');
+    end;
+  if (Pos('.', txtXDuration.Text)>0)  then
+  begin
+    SetError('Invalid Duration, please enter a whole numbers for a duration.');
+  end
+  else if LeftStr(txtXDuration.text, 1) = '0' then
+       SetError('Duration cannot start with a zero.');
+  if (cboduration.text = 'doses') then
+     begin
+       if TryStrToInt(txtXDuration.Text, Value) = false then
+         SetError('Duration with a unit of "doses" must be a whole number between 0 and 2000000')
+       else if (Value < 0) or (Value > 2000000) then
+         SetError('Duration with a unit of "doses" must be greater then 0 and less then 2000000');
+     end;
+  if AnErrMsg = '' then self.FInitialOrderID := True;
+end;
+function TFrmODMedIV.ValidateInfusionRate(Rate: string): string;
+var
+Temp: Boolean;
+i: integer;
+begin
+  Temp := False;
+  if Pos('.',Rate) >0 then
+    begin
+      Result := 'Infuse Over Time can only be a whole number';
+      exit;
+    end
+  else if LeftStr(Rate, 1) = '0' then Result := 'Infuse Over Time cannot start with a zero.';
+  for i := 1 to Length(Rate) do if not (Rate[i] in ['0'..'9']) then Temp := True;
+  if Temp = True then Result := 'The Infusion time can only be a whole number';
 end;
 procedure TfrmODMedIV.SetValuesFromResponses;
 var
   x: string;
   AnInstance: Integer;
+  x, addRoute, tempSch, AdminTime, TempOrder, tmpSch, tempIRoute, tempRoute: string;
+  AnInstance, i, idx: Integer;
   AResponse: TResponse;
   AnIVComponent: TIVComponent;
+  AllIVRoute: TStringList;
+  PQO: boolean;
 begin
   Changing := True;
+  self.FInitialOrderID := false;
   with Responses do
   begin
 …
             InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
             cboAdditive.Text := '';
+            AbortOrder := True;
             Exit;
           end;
 …
             InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
             cboAdditive.Text := '';
+            AbortOrder := True;
             Exit;
           end;
 …
             InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
             cboAdditive.Text := '';
+            AbortOrder := True;
             Exit;
           end;
 …
             InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
             cboAdditive.Text := '';
+            AbortOrder := true;
             Exit;
           end;
 …
       AnInstance := NextInstance('ADDITIVE', AnInstance);
     end; {while AnInstance - ADDITIVE}
+    SetControl(txtRate,     'RATE',    1);
+    if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm '             {*kcm*}
+      then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
+    SetControl(cboType, 'TYPE', 1);
+    if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
+    updateRoute;
+    AResponse := FindResponseByName('ROUTE', 1);
+    if AResponse <> nil then
+      begin
+        tempRoute := AResponse.EValue;
+        if tempRoute <> '' then
+          begin
+           idx := self.cboRoute.Items.IndexOf(tempRoute);
+           if idx > -1 then self.cboRoute.ItemIndex := idx
+           else begin
+             tempIRoute := AResponse.IValue;
+             if tempIRoute <> '' then
+               begin
+                AllIVRoute := TStringList.Create;
+                LoadAllIVRoutes(AllIVRoute);
+                idx := -1;
+                for i := 0 to AllIVRoute.Count - 1 do
+                  begin
+                    if Piece(AllIVRoute.Strings[i], U, 1) = tempIRoute then
+                      begin
+                        idx := i;
+                        break;
+                      end;
+                  end;
+                if idx > -1 then
+                  begin
+                    self.cboRoute.Items.Add(AllIVRoute.Strings[idx]);
+                    idx := self.cboRoute.Items.IndexOf(tempRoute);
+                    if idx > -1 then self.cboRoute.ItemIndex := idx;
+                  end;
+                  AllIVRoute.Free;
+                //if Pos(U, tempIRoute) = 0 then tempIRoute := tempIRoute + U + tempRoute;
+                //self.cboRoute.Items.Add(tempIRoute);
+                //idx := self.cboRoute.Items.IndexOf(tempRoute);
+                //if idx > -1 then self.cboRoute.ItemIndex := idx;
+               end;
+           end;
+          end;
+      end;
+    //SetControl(cboRoute, 'ROUTE', 1);
+    if (cboRoute.ItemIndex = -1) and (cboRoute.Text <> '') then cboRoute.Text := '';
+    if self.cboType.Text = 'Intermittent' then
+      begin
+         lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
+         lblSchedule.Enabled := True;
+         cboschedule.Enabled := True;
+         //if popDuration.Items.IndexOf(popDoses) = -1 then popDuration.Items.Add(popDoses);
+         if cboDuration.Items.IndexOf('doses') = -1 then cboDuration.Items.Add('doses');
+         txtNss.Visible := true;
+         chkDoseNow.Visible := true;
+         chkPRN.Enabled := True;
+         tempSch := '';
+         AdminTime := '';
+         AResponse := FindResponseByName('SCHEDULE', 1);
+         if AResponse <> nil then tempSch := AResponse.EValue;
+         lblAdminTime.Visible := True;
+         lblAdminTime.Hint := AdminTimeHelpText;
+         lblAdminTime.ShowHint := True;
+         //AResponse := Responses.FindResponseByName('ADMIN', 1);
+         //if AResponse <> nil then AdminTime := AResponse.EValue;
+         //if Action = Order_Copy then FOriginalAdminTime := AdminTime;
+         SetSchedule(tempSch);
+         //if (cboSchedule.ItemIndex > -1) then lblAdminTime.Caption := 'Admin. Time: ' + Piece(cboSchedule.Items.strings[cboSchedule.itemindex],U,5);
+         //if (cboSchedule.ItemIndex > -1) and (Piece(lblAdminTime.Caption, ':' ,2) = ' ') then lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
+         if (Action in [ORDER_COPY, ORDER_EDIT])  then
+           begin
+            TempOrder := Piece(OrderIEN,';',1);
+            TempOrder := Copy(tempOrder, 2, Length(tempOrder));
+             if DifferentOrderLocations(tempOrder, Patient.Location) = false then
+              begin
+                AResponse := Responses.FindResponseByName('ADMIN', 1);
+                if AResponse <> nil then AdminTime := AResponse.EValue;
+                //lblAdminTime.Caption := 'Admin. Time: ' + AdminTime;
+                if cboSchedule.ItemIndex > -1 then
+                  begin
+                    tmpSch := cboSchedule.Items.Strings[cboSchedule.itemindex];
+                    setPiece(tmpSch,U,4,AdminTime);
+                    cboSchedule.Items.Strings[cboSchedule.ItemIndex] := tmpSch;
+                  end;
+              end;
+           end;
+         //if Piece(lblAdminTime.Caption, ':' ,2) = ' ' then lblAdminTime.Caption := 'Admin. Time: Not Defined';
+         SetControl(txtRate,     'RATE',    1);
+         cboInfusionTime.Enabled := true;
+         PQO := false;
+         if Pos('INFUSE OVER',UpperCase(txtRate.Text)) > 0 then
+           begin
+             txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
+             PQO := True;
+           end;
+         if Pos('MINUTE',UpperCase(txtRate.Text))>0 then
+           begin
+             cboInfusionTime.Text := 'Minutes';
+             cboInfusionTime.itemindex := 0;
+             //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
+             txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 8);
+           end
+         else if Pos('HOUR',UpperCase(txtRate.Text))>0 then
+           begin
+             cboInfusionTime.Text := 'Hours';
+             cboInfusionTime.ItemIndex := 1;
+             //txtRate.Text := Copy(txtRate.Text,Length('Infuse over ')+1,Length(txtRate.text));
+             txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
+           end
+         else if (txtRate.Text <> '') and (PQO = false) and (ValidateInfusionRate(txtRate.Text) ='') then
+           begin
+             cboInfusionTime.Text := 'Minutes';
+             cboInfusionTime.itemindex := 0;
+           end;
+      end
+    else
+      begin
+        lblSchedule.Enabled := false;
+        cboSchedule.ItemIndex := -1;
+        cboSchedule.Enabled := false;
+        if chkDoseNow.Visible = true then  chkDoseNow.Checked := false;
+        chkDoseNow.Visible := false;
+        txtNSS.Visible := false;
+        cboInfusionTime.ItemIndex := -1;
+        cboInfusionTime.Text := '';
+        cboInfusionTime.Enabled := false;
+        chkPRN.Checked := false;
+        chkPRN.Enabled := false;
+        txtRate.Text := '';
+        cboDuration.ItemIndex := -1;
+        cboDuration.Text := '';
+        txtXDuration.Text := '';
+        SetControl(txtRate,     'RATE',    1);
+        if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm '             {*kcm*}
+          then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
+      end;
     SetControl(cboPriority, 'URGENCY', 1);
     SetControl(memComments, 'COMMENT', 1);
 …
   end; {if...with Responses}
   Changing := False;
+  if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
+  loadExpectFirstDose;
   ControlChange(Self);
 end;
 …
 begin
   inherited;
+  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then SetValuesFromResponses;
+  Action := OrderAction;
+  OrderIEN := id;
+  self.FInitialOrderID := True;
+  if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
+  if (isIMO) or ((patient.Inpatient = true) and (encounter.Location <> patient.Location)) and (FAdminTimeText = '') then
+      FAdminTimeText := 'Not defined for Clinic Locations';
+  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
+    begin
+      SetValuesFromResponses;
+    end;
 end;
 …
 end;
+procedure TfrmODMedIV.cbotypeChange(Sender: TObject);
+begin
+  inherited;
+  //if (self.cbotype.Text = 'Intermittent') or (self.cboType.itemIndex = 1) then
+  if (self.cboType.itemIndex = 1) then
+    begin
+      cboSchedule.ItemIndex := -1;
+      lblAdminTime.Caption := '';
+      lblAdminTime.Visible := false;
+      lblschedule.Enabled := True;
+      cboSchedule.Enabled := True;
+      txtNSS.Visible := true;
+      chkDoseNow.Checked := false;
+      chkDoseNow.Visible := true;
+      chkPRN.Checked := false;
+      chkPRN.Enabled := True;
+      lblInfusionRate.Caption := 'Infuse Over Time (Optional)';
+      cboInfusionTime.Enabled := true;
+      cboDuration.Items.Add('doses');
+    end
+  //else if (self.cbotype.Text = 'Continuous') or (self.cboType.itemIndex = 0) then
+  else
+    begin
+      lblschedule.Enabled := False;
+      cboSchedule.ItemIndex := -1;
+      cboSchedule.Enabled := False;
+      txtNSS.Visible := false;
+      chkPRN.Checked := false;
+      chkPRN.Enabled := false;
+      if chkDoseNow.Visible = true then chkDoseNow.Checked := false;
+      chkDoseNow.Visible := false;
+      lblInfusionRate.Caption := 'Infusion Rate (ml/hr)*';
+      cboInfusionTime.ItemIndex := -1;
+      cboInfusionTime.Text := '';
+      cboInfusionTime.Enabled := false;
+      lblAdminTime.Visible := false;
+      updateDuration('');
+      cboduration.Items.Delete(cboDuration.Items.IndexOf('doses'));
+    end;
+  self.txtRate.Text := '';
+  ControlChange(Sender);
+end;
+procedure TfrmODMedIV.chkDoseNowClick(Sender: TObject);
+Const
+  T  = '"';
+  T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication.';
+  T2 = #13#13'The first order''s administrative schedule is "';
+  T3 = #13'The second order''s administrative schedule is "';
+  T4 = #13#13'Do you want to continue?';
+  T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
+  T2A = ' in addition to the one you are placing for the same medication.';
+var
+  medNm: string;
+  theSch: string;
+  //SchID: integer;
+begin
+  inherited;
+  if (chkDoseNow.Checked) then
+  begin
+    medNm := 'Test';
+    //SchID := cboSchedule.ItemIndex;
+    theSch := cboSchedule.Text;
+    if length(theSch)>0 then
+    begin
+      //if (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
+      if (InfoBox(T1+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL)then
+      begin
+        chkDoseNow.Checked := False;
+        Exit;
+      end;
+    end else
+    begin
+      //if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
+      if InfoBox(T1A+T2A+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
+      begin
+        chkDoseNow.Checked := False;
+        Exit;
+      end;
+    end;
+  end;
+  ControlChange(self);
+end;
+procedure TfrmODMedIV.chkPRNClick(Sender: TObject);
+begin
+  inherited;
+  ControlChange(Self);
+end;
 procedure TfrmODMedIV.cboSolutionMouseClick(Sender: TObject);
 var
   AnIVComponent: TIVComponent;
+  x: string;
+  x,routeIEN: string;
+  i: integer;
 begin
   inherited;
   if CharAt(cboSolution.ItemID, 1) = 'Q' then              // setup quick order
   begin
+    //Clear pre-existing values
+    for i := 0 to self.grdSelected.RowCount do
+      begin
+         if self.grdSelected.Objects[0,i] <> nil then
+           begin
+             TIVComponent(self.grdSelected.Objects[0,i]).Free;
+             self.grdSelected.Rows[i].Clear;
+           end
+         else self.grdSelected.Rows[i].clear;
+      end;
+    self.grdSelected.RowCount := 0;
+    ControlChange(Sender);
     Responses.QuickOrder := ExtractInteger(cboSolution.ItemID);
     SetValuesFromResponses;
 …
     end;
   end;
+  RouteIEN := Piece(cboSolution.Items.Strings[cboSolution.itemindex],U,4);
   x := AmountsForIVFluid(cboSolution.ItemIEN, 'B');
   AnIVComponent := TIVComponent.Create;
 …
   Application.ProcessMessages;         //CQ: 10157
   ClickOnGridCell;
+  updateRoute;
   ControlChange(Sender);
+  //updateRoute(routeIEN);
 end;
 …
 begin
   inherited;
+  if cboSolution.ItemIEN > 0 then cboSolutionMouseClick(Self);
+  if EnterIsPressed then //CQ: 15097
+    if (cboSolution.ItemIEN > 0) or
+       ((cboSolution.ItemIEN = 0) and (CharAt(cboSolution.ItemID, 1) = 'Q')) then
+      cboSolutionMouseClick(Self);
 end;
 …
 end;
+procedure TfrmODMedIV.cboDurationChange(Sender: TObject);
+begin
+  inherited;
+  if (FOriginalDurationType > -1) and (FOriginalDurationType <> cboDuration.ItemIndex) then
+    begin
+      self.txtXDuration.Text := '';
+      FOriginalDurationType := cboDuration.ItemIndex;
+    end;
+  if (FOriginalDurationType = -1) and (cboDuration.ItemIndex > -1) then FOriginalDurationType := cboDuration.ItemIndex;
+  controlchange(sender);
+end;
+procedure TfrmODMedIV.cboDurationEnter(Sender: TObject);
+begin
+  inherited;
+  FOriginalDurationType := cboDuration.ItemIndex;
+end;
+procedure TfrmODMedIV.cboInfusionTimeChange(Sender: TObject);
+begin
+  inherited;
+  if (FOriginalInfusionType > -1) and (FOriginalInfusionType <> cboInfusionTime.ItemIndex) then
+     begin
+       self.txtRate.Text := '';
+       FOriginalInfusionType := cboInfusionTime.ItemIndex;
+     end;
+  if (FOriginalInfusionType = -1) and (cboInfusionTime.ItemIndex > -1) then FOriginalInfusionType := cboInfusionTime.ItemIndex;
+  ControlChange(Sender);
+end;
+procedure TfrmODMedIV.cboInfusionTimeEnter(Sender: TObject);
+begin
+  inherited;
+  FOriginalInfusionType := self.cboInfusionTime.ItemIndex;
+end;
+procedure TfrmODMedIV.cboPriorityChange(Sender: TObject);
+begin
+  inherited;
+  ControlChange(sender);
+end;
+procedure TfrmODMedIV.cboPriorityExit(Sender: TObject);
+begin
+  inherited;
+  if cboPriority.Text = '' then
+    begin
+      infoBox('Priority must have a value assigned to it', 'Warning', MB_OK);
+      cboPriority.SetFocus;
+    end;
+end;
+procedure TfrmODMedIV.cboRouteChange(Sender: TObject);
+begin
+  inherited;
+  if cboRoute.ItemIndex = cboRoute.Items.IndexOf('OTHER') then cboRouteClick(cboRoute);
+  ControlChange(sender);
+end;
+procedure TfrmODMedIV.cboRouteClick(Sender: TObject);
+var
+otherRoute, temp: string;
+idx, oidx: integer;
+begin
+  inherited;
+  oidx := cboRoute.Items.IndexOf('OTHER');
+  if oidx = -1 then exit;
+  if cboRoute.ItemIndex = oidx then
+    begin
+      otherRoute := CreateOtherRoute;
+      if length(otherRoute) > 1 then
+        begin
+          idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2));
+          if idx > -1 then
+            begin
+              temp := cboRoute.Items.Strings[idx];
+              //setPiece(temp,U,5,'1');
+              cboRoute.Items.Strings[idx] := temp;
+            end
+          else
+          begin
+             cboRoute.Items.Add(otherRoute);
+             idx := cboRoute.Items.IndexOf(Piece(OtherRoute, U, 2));
+          end;
+          cboRoute.ItemIndex := idx;
+        end
+      else
+        begin
+          cboRoute.ItemIndex := -1;
+          cboRoute.SetFocus;
+        end;
+    end;
+end;
+procedure TfrmODMedIV.cboRouteExit(Sender: TObject);
+begin
+  inherited;
+(*  if (cboRoute.Text <> '') and (cboRoute.ItemIndex = -1)  then
+    begin
+      infoBox(TX_BAD_ROUTE,'Warning',MB_OK);
+      cboRoute.SetFocus;
+    end; *)
+end;
 procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject);
 var
   AnIVComponent: TIVComponent;
   x: string;
+  x, routeIEN: string;
 begin
   inherited;
 …
     end;
   end;
+  routeIEN := Piece(cboAdditive.Items.Strings[cboAdditive.itemindex],U,4);
   x := AmountsForIVFluid(cboAdditive.ItemIEN, 'A');
   AnIVComponent := TIVComponent.Create;
 …
   Application.ProcessMessages;         //CQ: 10157
   ClickOnGridCell;
+  updateRoute;
   ControlChange(Sender);
+  //UpdateRoute(RouteIEN);
 end;
 …
 begin
   inherited;
+  if cboAdditive.ItemIEN > 0 then cboAdditiveMouseClick(Self);
+  if (cboAdditive.ItemIEN > 0) and (EnterIsPressed) then
+    cboAdditiveMouseClick(Self);
 end;
 { grdSelected events }
+procedure TfrmODMedIV.ClearAllFields;
+begin
+  self.cboType.ItemIndex := -1;
+  self.cboType.Text := '';
+  self.memComments.Text := '';
+  self.txtRate.Text := '';
+  self.txtXDuration.text := '';
+  self.cboDuration.ItemIndex := -1;
+  self.cboDuration.Text := '';
+  self.txtAllIVRoutes.Visible := false;
+  self.FInitialOrderID := True;
+  cbotypeChange(self.cboType);
+  if self.cboroute.Items.Count > 0 then self.cboRoute.Clear;
+end;
 procedure TfrmODMedIV.ClickOnGridCell;
 …
 end;
+procedure TfrmODMedIV.cboScheduleChange(Sender: TObject);
+begin
+  inherited;
+   if self.txtXDuration.Enabled = true then
+     begin
+       self.txtXDuration.Text := '';
+       self.cboDuration.ItemIndex := -1;
+     end;
+   if self.cboSchedule.ItemIndex > -1 then updateDuration(Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,3));
+  ControlChange(sender);
+end;
+procedure TfrmODMedIV.cboScheduleClick(Sender: TObject);
+var
+  othSch: string;
+  idx, i : integer;
+begin
+  inherited;
+  if cboSchedule.ItemIndex = cboSchedule.Items.IndexOf('Other') then
+    begin
+      othSch := CreateOtherSchedule;
+      if length(trim(othSch)) > 1 then
+        begin
+          cboSchedule.Items.Add(othSch + U + U + NSSScheduleType + U + NSSAdminTime);
+          idx := -1;
+          for I := 0 to cboSchedule.Items.Count - 1 do
+            if Piece(cboSchedule.Items.Strings[i], U, 1) = othSch then
+              begin
+                idx := i;
+                break;
+              end;
+          //idx := cboSchedule.Items.IndexOfName(othSch);
+          cboSchedule.ItemIndex := idx;
+        end;
+    end
+  else
+    begin
+      NSSAdminTime := '';
+      NSSScheduleType := '';
+    end;
+end;
+procedure TfrmODMedIV.cboScheduleExit(Sender: TObject);
+begin
+  inherited;
+    if (cboSchedule.ItemIndex = -1) and (cboSchedule.Text <> '') then
+    begin
+      infoBox('Please select a valid schedule from the list.'+ CRLF + CRLF +
+              'If you would like to create a Day-of-Week schedule please select ''OTHER'' from the list.',
+              'Incorrect Schedule.', MB_OK);
+      cboSchedule.Text := '';
+      cboSchedule.SetFocus;
+    end;
+end;
 procedure TfrmODMedIV.cboSelectedChange(Sender: TObject);   // combo editor for grid
 begin
 …
 procedure TfrmODMedIV.cmdRemoveClick(Sender: TObject);  // remove button for grid
 var
   i: Integer;
+  i, stRow, stRowCount: Integer;
 begin
   inherited;
 …
   begin
     if Row < 0 then Exit;
+    stRow := Row;
+    stRowCount := RowCount;
     if Objects[0, Row] <> nil then TIVComponent(Objects[0, Row]).Free;
     for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
 …
     RowCount := RowCount - 1;
   end;
+  updateRoute;
+  if (stRowCount = 1) and (stRow = 0) then
+    begin
+      //self.cboRoute.ItemIndex := -1;
+      ClearAllFields;
+    end;
   ControlChange(Sender);
 end;
 …
 procedure TfrmODMedIV.ControlChange(Sender: TObject);
 var
   i, CurAdd, CurBase: Integer;
   x,xlimIn,xLimEx,eSch,iSch: string;
+  i, CurAdd, CurBase, idx: Integer;
+  adminTime,x,xlimIn,xLimEx,eSch,iSch,iType, tmpdur, tmpSch, tmpRate: string;
   AnIVComponent: TIVComponent;
   FQOSchedule: TResponse;
 …
   inherited;
   if Changing then Exit;
+  loadExpectFirstDose;
 //  FQOSchedule := TResponse.Create;
   FQOSchedule := Responses.FindResponseByName('SCHEDULE',1);
 …
   Responses.Clear;   // want this to clear even after SetupDialog in case instances don't match
   CurAdd := 1; CurBase := 1;
+  tmpRate := '';
   with grdSelected do for i := 0 to RowCount - 1 do
   begin
 …
   if length(txtXDuration.Text) > 0 then
   begin
+    if (btnXDuration.Caption = 'L') or (btnXDuration.Caption = 'ml') then
+    begin
+      xlimEx := 'with total volume ' +  txtXDuration.Text + btnXDuration.Caption;
+      xlimIn := 'with total volume ' +  txtXDuration.Text + btnXDuration.Caption;
+    tmpDur := LowerCase(cboDuration.Text);
+    if (tmpDur = 'l') or (tmpDur = 'ml') then
+    begin
+      xlimEx := 'with total volume ' +  txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex];
+      xlimIn := 'with total volume ' +  txtXDuration.Text + self.cboDuration.items.strings[self.cboDuration.itemindex];
     end
+    else if (btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') then
+    begin
+      xlimEx := 'for ' + txtXDuration.Text + ' ' +  btnXDuration.Caption;
+      xlimIn := 'for ' + txtXDuration.Text + ' ' +  btnXDuration.Caption;
+    end  else
+    begin
+    else if (tmpDur = 'days') or (tmpDur = 'hours') then
+    begin
+      xlimEx := 'for ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
+      xlimIn := 'for ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
+    end
+    else if tmpDur = 'doses' then
+      begin
+         xlimEx := 'for a total of ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
+         xlimIn := 'for a total of ' + txtXDuration.Text + ' ' +  self.cboDuration.items.strings[self.cboDuration.itemindex];
+      end
+   else  begin
       xlimIn := '';
       xlimEx := '';
     end;
   end;
+  //if x = IntToStr(StrToIntDef(x, -1)) then x := x + ' ml/hr';
+  if IsNumericRate(x) then x := x + ' ml/hr';
+  if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1)))
+    then x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x));
+  with txtRate     do if (Length(Text) > 0) then Responses.Update('RATE', 1, x, x);
+  if cboType.Text = 'Intermittent' then iType := 'I'
+  else iType := 'C';
+  Responses.Update('TYPE',1,iType,cboType.Text);
+  Responses.Update('ROUTE',1,cboRoute.ItemID,cboRoute.Text);
+  tmpSch := UpperCase(Trim(cboSchedule.Text));
+  if chkPRN.Checked then tmpSch := tmpSch + ' PRN';
+  if UpperCase(Copy(tmpSch, Length(tmpSch) - 6, Length(tmpSch))) = 'PRN PRN'
+  then tmpSch := Copy(tmpSch, 1, Length(tmpSch) - 4);
+  Responses.Update('SCHEDULE',1,tmpSch,tmpSch);
+  (*adminTime := Piece(lblAdminTime.Caption,':',2);
+  adminTime := Copy(adminTime,1,Length(adminTime));
+  if (Action in [ORDER_COPY, ORDER_EDIT]) and ((FAdminTimeDelay <> '') or (FAdminTimeClinic <> '')) and
+      (cboSchedule.ItemIndex = FOriginalScheduleIndex) then  Responses.Update('ADMIN',1,FOriginalAdminTime,FOriginalAdminTime)
+  else Responses.Update('ADMIN',1,adminTime,adminTime);*)
+  idx := self.cboSchedule.ItemIndex;
+  if idx > -1 then
+     begin
+       adminTime := Piece(lblAdminTime.Caption,':',2);
+       adminTime := Copy(adminTime,2,Length(adminTime));
+       if FAdminTimeText <> '' then AdminTime :=  '';
+       if AdminTime = 'Not Defined' then AdminTime := '';
+       Responses.Update('ADMIN',1,adminTime,adminTime);
+     end;
+  if IsNumericRate(x) then
+    begin
+      if cboInfusionTime.Enabled = true then
+        begin
+           idx := cboInfusionTime.Items.IndexOf(cboInfusionTime.Text);
+           if idx > -1 then x := x + ' ' + cboInfusionTime.Items.Strings[idx];
+           tmpRate := 'Infuse Over ' + x;
+        end
+      else
+        if pos('ml/hr', x)= 0 then  x := x + ' ml/hr';
+    end;
+  if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1))) and (cboInfusionTime.Enabled = false) then
+    begin
+      if Pos('ml/hr', x) = 0 then
+         x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x));
+    end;
+  with txtRate     do if (Length(Text) > 0) then
+    begin
+      if tmpRate = '' then Responses.Update('RATE', 1, x, x)
+      else Responses.Update('RATE', 1, 'INFUSE OVER ' + x, tmpRate);
+    end;
   with cboPriority do if ItemIndex > -1     then Responses.Update('URGENCY', 1, ItemID, Text);
   if Length(xlimIn)>0 then Responses.Update('DAYS',1, xlimIn, xlimEx);
   with memComments do if GetTextLen > 0     then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
+  if (chkDoseNow.Visible = True) and (chkDoseNow.Checked = True) then
+    Responses.Update('NOW', 1, '1', 'NOW')
+  else Responses.Update('NOW', 1, '', '');
   memOrder.Text := Responses.OrderText;
+  if (Length(eSch)>0) or (Length(iSch)>0) then
+    Responses.Update('SCHEDULE',1,iSch,eSch);
+  (* (Length(eSch)>0) or (Length(iSch)>0) then
+    Responses.Update('SCHEDULE',1,iSch,eSch);  *)
+end;
+function TfrmODMedIV.CreateOtherRoute: string;
+var
+  aRoute: string;
+begin
+  aRoute := '';
+  Result := '';
+  if not ShowOtherRoutes(aRoute) then
+    begin
+      cboRoute.ItemIndex := -1;
+      cboRoute.Text := '';
+    end
+  else
+    begin
+      Result := aRoute;
+    end;
+end;
+function TfrmODMedIV.CreateOtherSchedule: string;
+var
+  aSchedule: string;
+begin
+  aSchedule := '';
+  if not ShowOtherSchedule(aSchedule) then
+  begin
+    cboSchedule.ItemIndex := -1;
+    cboSchedule.Text      := '';
+  end
+  else
+    begin
+        Result := Piece(aSchedule,U,1);
+        NSSAdminTime := Piece(aschedule,u,2);
+        NSSScheduleType := Piece(ASchedule, U, 3);
+    end;
 end;
 …
   inherited SetFontSize( FontSize );
   DoSetFontSize( FontSize );
+end;
+procedure TfrmODMedIV.DisplayDoseNow(Status: boolean);
+begin
+  if self.EvtID > 0 then Status := false;
+  if status = false then
+    begin
+      if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false;
+      self.chkDoseNow.Visible := false;
+    end;
+  if status = true then self.chkDoseNow.Visible := true;
 end;
 …
 end;
-procedure TfrmODMedIV.btnXDurationClick(Sender: TObject);
-var
-  APoint: TPoint;
-begin
-  inherited;
-  txtXDuration.SetFocus;
-  with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
-  popDuration.Popup(APoint.X, APoint.Y);
-end;
-procedure TfrmODMedIV.popDurationClick(Sender: TObject);
-var
-  x: string;
-begin
-  inherited;
-  with TMenuItem(Sender) do
-  begin
-    x := Caption;
-    {if Length(Trim(txtXDuration.Text)) > 0 then
-      if AnsiCompareStr(btnXduration.Caption,x) <> 0 then
-        txtXDuration.Text := '';}
-  end;
-  btnXDuration.Caption := x;
-  txtXDurationChange(Sender);
-  ControlChange(Sender);
-end;
 procedure TfrmODMedIV.txtXDurationChange(Sender: TObject);
 begin
 …
   ControlChange(Sender);
 end;
 procedure TfrmODMedIV.pnlXDurationEnter(Sender: TObject);
 …
   limitValue := '';
   tempVal := '';
+  if ( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F') then  //days, hours
+  if pos('dose',AValue)>0 then
+    begin
+      limitValue := Piece(aValue,' ',5);
+      limitUnit := 'doses';
+    end;
+  if (( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F')) and (pos('dose',aValue)=0) then  //days, hours
   begin
      limitValue := Piece(aValue,' ',2);
 …
   if isNumeric(CharAt(aValue,1)) then
   begin
+    if LeftStr(avalue,1) = '0' then AValue := Copy(aValue,2,Length(aValue));
     limitValue := FloatToStr(ExtractFloat(aValue));
     limitUnit  := Copy(aValue,length(limitValue)+1,Length(aValue));
 …
     if Trim(UpperCase(limitUnit))='CC' then
       limitUnit := 'ml';
+    btnXDuration.Caption := limitUnit;
+  end;
+end;
+    cboduration.text := limitUnit;
+    if cboDuration.Text <> '' then cboDuration.ItemIndex := cboDuration.Items.IndexOf(cboDuration.Text)
+  end;
+end;
+procedure TfrmODMedIV.SetSchedule(const x: string);
+var
+NonPRNPart,tempSch: string;
+idx: integer;
+begin
+    cboSchedule.ItemIndex := -1;
+    chkPRN.Checked := False;
+    //Check to see if schedule is already define in the schedule list
+    idx := cboSchedule.Items.IndexOf(X);
+    if idx > -1 then
+      begin
+        cboSchedule.ItemIndex := idx;
+        exit;
+      end;
+      //Check to see if schedule is a Day-of-Week Schedule (MO-WE-FR@BID)
+      if (Pos('@', x) > 0) then
+        begin
+          tempSch := Piece(x, '@', 2);
+          idx := cboSchedule.Items.IndexOf(tempSch);
+          if idx > -1 then
+            begin
+             //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
+             tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
+             cboSchedule.Items.Add(tempSch);
+             cboSchedule.Text := (Piece(tempSch,U,1));
+             cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch,U,1));
+             EXIT;
+            end;
+          //Check to see if schedule is a Day-of-Week PRN Schedule (MO-WE-FR@BID PRN)
+          if Pos('PRN', tempSch) > 0 then
+            begin
+              NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
+              idx := cboSchedule.Items.IndexOf(NonPRNPart);
+              if idx > -1 then
+                begin
+                  //tempSch := U + Piece(x, '@', 1) + '@' + Pieces(cboSchedule.Items.Strings[idx], U, 2, 5);
+                  tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[idx];
+                  cboSchedule.Items.Add(tempSch);
+                  cboSchedule.Text := (Piece(tempSch,U,1));
+                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(Piece(tempSch, U, 1));
+                  chkPRN.Checked := True;
+                  EXIT;
+                end
+              else
+               //Add Day-of-Week PRN schedule built off Time Prompt (MO-WE-FR@0800-1000 PRN)
+               begin
+                  NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1));
+                  chkPRN.Checked := True;
+                  //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + AdminTime);
+                  //cboSchedule.Items.Add(U + NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2));
+                  cboSchedule.Items.Add(NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2));
+                  cboSchedule.Text := NonPRNPart;
+                  cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(NonPRNPart);
+                  EXIT;
+               end;
+            end;
+         //Add Non PRN Day-of-Week Schedule built off Time Prompt (MO-WE-FR@0800-1000)
+         //cboSchedule.Items.Add(U + x + U + U + U + AdminTime);
+         //cboSchedule.Items.Add(U + x + U + U + U + tempSch);
+         cboSchedule.Items.Add(x + U + U + U + tempSch);
+         cboSchedule.Text := x;
+         cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(X);
+        end
+        else
+          begin
+            //Handle standard schedule mark as PRN (Q4H PRN)
+            if Pos('PRN', X) > 0 then
+              begin
+                NonPRNPart := Trim(Copy(X, 1, Pos('PRN', X) - 1));
+                idx := cboSchedule.Items.IndexOf(NonPRNPart);
+                if idx > -1 then
+                  begin
+                    cboSchedule.ItemIndex := idx;
+                    tempSch := cboSchedule.Items.Strings[idx];
+                    //setPiece(tempSch,U,5,AdminTime);
+                    cboSchedule.Items.Strings[idx] := tempSch;
+                    chkPRN.Checked := True;
+                    exit;
+                  end;
+              end;
+          end;
+end;
 procedure TfrmODMedIV.txtXDurationExit(Sender: TObject);
 var
-  Len: Integer;
   Code: double;
+  Digits, Warning: string;
+begin
+  inherited;
+  if Changing then Exit;
+  //AGP Change 26.15 HIN-1203-42283 Added additional check to make sure the user can only enter the correct duration
+  Len := Length(txtXDuration.Text);
+  if (Len > 0) and (Pos('.', txtXDuration.Text)=0) then
+    begin
+      Warning := '0';
+      Digits := '2';
+      if ((btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') or (btnXDuration.Caption = 'L')) and (Len > 2) then  Warning := '1';
+      if (btnXDuration.Caption = 'ml') and (Len > 4) then  Warning := '1';
+      if Warning = '1' then
+          begin
+             if btnXduration.Caption = 'ml' then Digits := '4';
+             ShowMessage('Invalid Value.' + #13#10 + 'Reason: Duration for ' + btnXDuration.Caption + ' cannot be greater than ' + digits + ' digits.');
+             txtXDuration.Text := '';
+             txtXDuration.SetFocus;
+             Exit;
+          end;
+      end;
+  if (Pos('.', txtXDuration.Text)>0) and
+     ((btnXduration.Caption = 'days') or (btnXduration.Caption = 'hours')) then
+  begin
+    ShowMessage('Can not save order.' + #13#10
+       + 'Reason: Invalid Duration, please enter an integer value for days or hours.');
+    txtXDuration.Text := '';
+    txtXDuration.SetFocus;
+    Exit;
+  end;
+begin
+  inherited;
   if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then
   begin
 …
     if code < 0.0001 then
     begin
       ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');
+      ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');
       txtXDuration.Text := '';
       txtXDuration.SetFocus;
 …
     if (Length(txtXDuration.Text)>0) and (StrToFloat(txtXDuration.Text)<0) then
     begin
       ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');
+      ShowMsg('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');
       txtXDuration.Text := '';
       txtXDuration.SetFocus;
 …
 end;
+procedure TfrmODMedIV.txtRateExit(Sender: TObject);
+var
+ErrorText, LDec,RDec: string;
+i: Integer;
+Result: boolean;
+begin
+  inherited;
+  //AGP Change 26.28 for CQ # 7598 add infusion rate check for valid value
+  ErrorText := 'The Infusion Rate must be in one of the following formats:' + CRLF + CRLF + 'nnnn.nn ml/hr or text@per labels per day';
+  Result := False;
+  if pos('@',Self.txtRate.Text)>0 then exit;
+  if pos('.',Self.txtRate.Text)>0 then
+      begin
+         LDec := Piece(Self.txtRate.Text,'.',1);
+         RDec := Piece(Self.txtRate.Text,'.',2);
+         if Length(LDec)>4 then Result := True;
+         if Length(RDec)>2 then Result := True;
+      end
+  else if Length(Self.txtRate.Text)>4 then Result := True;
+  if (Result = False) and (pos('.',Self.txtRate.Text)=0) then
+    begin
+    for i := 1 to Length(Self.txtRate.Text) do if not (Self.txtRate.Text[i] in ['0'..'9']) then Result := True
+    end;
+  if Result = True then
+    begin
+       InfoBox(ErrorText,'Warning - Invalid Infusion Rate', MB_OK);
+       Self.txtRate.Text := '';
+       Self.txtRate.SetFocus;
+    end;
+procedure TfrmODMedIV.UpdateDuration(SchType: string);
+begin
+if SchType = 'O' then
+   begin
+     self.cboDuration.ItemIndex := -1;
+     self.txtXDuration.Text := '';
+     self.cboDuration.Enabled := false;
+     self.txtXDuration.Enabled := false;
+     self.lblLimit.Enabled := false;
+   end
+else
+  begin
+     self.cboDuration.Enabled := true;
+     self.txtXDuration.Enabled := true;
+     self.lblLimit.Enabled := true;
+  end;
+end;
+procedure TfrmODMedIV.UpdateRoute;
+var
+AnIVComponent: TIVComponent;
+i: integer;
+OrderIds, TempIVRoute: TStringList;
+Default: boolean;
+begin
+  if self.grdSelected.RowCount > 0 then self.txtAllIVRoutes.Visible := True;
+  TempIVRoute := TStringList.Create;
+  for I := (self.cboRoute.Items.Count -1) downto 0 do
+    begin
+      if Piece(self.cboRoute.Items.Strings[i], U, 5) = '1' then
+        TempIVRoute.Add(self.cboRoute.Items.Strings[i]);
+        self.cboRoute.Items.Delete(i);
+    end;
+  if self.cboRoute.ItemIndex = -1 then self.cboRoute.Text := '';
+  OrderIds := TStringList.Create;
+  for i := 0 to self.grdSelected.RowCount -1  do
+    begin
+      AniVComponent := TIVComponent(self.grdSelected.Objects[0, i]);
+      if AnIVComponent <> nil then  orderIds.Add(InttoStr(AniVComponent.IEN));
+    end;
+ if OrderIds.Count > 0 then
+   begin
+     if (self.FInitialOrderID = True) and (self.grdSelected.RowCount = 1) then Default := True
+     else Default := False;
+     LoadDosageFormIVRoutes(self.cboRoute.Items, OrderIds, Default);
+     if default = True then
+       begin
+         for I := 0 to cboRoute.items.Count - 1 do
+           if Piece(cboRoute.Items.Strings[i], U, 5) = 'D' then
+             begin
+               cboRoute.ItemIndex := i;
+               break;
+             end;
+         self.FInitialOrderID := false;
+       end;
+     OrderIds.Free;
+   end;
+ if TempIVRoute.Count > 0 then
+   begin
+     for I := 0 to tempIVRoute.Count - 1 do cboRoute.Items.Add(tempIVRoute.Strings[i]);
+     TempIVRoute.Free;
+   end;
+ cboRoute.Items.Add(U + 'OTHER');
+end;
+procedure TfrmODMedIV.txtAllIVRoutesClick(Sender: TObject);
+var
+i: integer;
+begin
+  inherited;
+  if MessageDlg('You can also select "OTHER" from the Route list'
+     + ' to select a Route from the Expanded Med Route List.'
+     + #13#10 + 'Click OK to launch the Expanded Med Route List.',
+     mtInformation, [mbOK, mbCancel],0) = mrOK then
+  begin
+      for I := 0 to cboRoute.Items.Count - 1 do if cboRoute.Items.Strings[i] = U + 'OTHER' then break;
+      cboRoute.ItemIndex := i;
+      cboRouteClick(self);
+      cboRouteChange(self.cboRoute);
+  end;
+end;
+procedure TfrmODMedIV.txtNSSClick(Sender: TObject);
+var
+i: integer;
+begin
+  inherited;
+  if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
+    + ' to create a day-of-week schedule.'
+    + #13#10 + 'Click OK to launch schedule builder',
+    mtInformation, [mbOK, mbCancel],0) = mrOK then
+  begin
+      //cboSchedule.Items.Add(U + 'OTHER');
+      for I := 0 to cboSchedule.Items.Count - 1 do if cboSchedule.Items.Strings[i] = 'OTHER' then break;
+      cboSchedule.ItemIndex := i;
+      //cboSchedule.SelectByID(U+'OTHER');
+      cboScheduleClick(Self);
+      cboScheduleChange(self.cboSchedule);
+  end;
+end;
+procedure TfrmODMedIV.txtRateChange(Sender: TObject);
+begin
+  inherited;
+  if Changing then Exit;
+  ControlChange(Sender);
 end;

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

-              r456
+              r829
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     ParentShowHint = False
 …
     OnExit = cboDispenseExit
     OnMouseClick = cboDispenseMouseClick
+    CharsNeedMatch = 1
   end
   object cboMedication: TORComboBox [9]
 …
     ListItemsOnly = False
     LongList = True
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnMouseClick = cboMedicationSelect
     OnNeedData = cboMedicationNeedData
+  end
+  inherited memOrder: TMemo
+    CharsNeedMatch = 1
+  end
+  inherited memOrder: TCaptionMemo
     TabOrder = 10
   end
 …
     TabOrder = 8
   end
+  inherited cmdQuit: TButton
+    TabOrder = 9
+  end
+  object cboRoute: TORComboBox [13]
+  object cboRoute: TORComboBox [12]
     Left = 364
     Top = 18
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     TabOrder = 4
     OnChange = ControlChange
+  end
+  object cboSchedule: TORComboBox [14]
+    CharsNeedMatch = 1
+  end
+  object cboSchedule: TORComboBox [13]
     Left = 442
     Top = 18
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Sorted = False
 …
     TabOrder = 5
     OnChange = ControlChange
+  end
+  object memComments: TMemo [15]
+    CharsNeedMatch = 1
+  end
+  object memComments: TMemo [14]
     Left = 223
     Top = 128
 …
     OnChange = ControlChange
   end
   object cboPriority: TORComboBox [16]
+  object cboPriority: TORComboBox [15]
     Left = 442
     Top = 128
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     TabOrder = 7
     OnChange = ControlChange
+  end
+  object txtDosage: TCaptionEdit [17]
+    CharsNeedMatch = 1
+  end
+  object txtDosage: TCaptionEdit [16]
     Left = 224
     Top = 18
 …
     Caption = 'Dosage'
   end
+  inherited cmdQuit: TButton
+    TabOrder = 9
+  end
   inherited pnlMessage: TPanel
     TabOrder = 11
   end
   object cboMedAlt: TORComboBox
+  object cboMedAlt: TORComboBox [19]
     Left = 6
     Top = 18
 …
     ListItemsOnly = False
     LongList = True
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnMouseClick = cboMedicationSelect
     OnNeedData = cboMedicationNeedData
+    CharsNeedMatch = 1
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboDispense'
+        'Status = stsDefault')
+      (
+        'Component = cboMedication'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = cboPriority'
+        'Status = stsDefault')
+      (
+        'Component = txtDosage'
+        'Status = stsDefault')
+      (
+        'Component = cboMedAlt'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedIn'
+        'Status = stsDefault'))
   end
 end

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

r456	r829
8	8	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9	9	fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore,
10		Menus;
	10	Menus, VA508AccessibilityManager;
11	11
12	12	type

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

-              r456
+              r829
 inherited frmODMedNVA: TfrmODMedNVA
   Left = 100
   Top = 167
+  Left = 203
+  Top = 183
   Width = 632
   Height = 536
   Caption = 'Document Herbal/OTC/Non-VA Medications'
   Constraints.MinHeight = 365
+  ExplicitWidth = 632
+  ExplicitHeight = 536
   PixelsPerInch = 96
   TextHeight = 13
 …
     Constraints.MinWidth = 25
     TabOrder = 4
+  end
+  inherited cmdAccept: TButton
+    Left = 540
+    Top = 463
+    Width = 69
+    Anchors = [akRight, akBottom]
+    TabOrder = 6
+    Visible = False
+  end
+  inherited cmdQuit: TButton
+    Left = 546
+    Top = 489
+    Width = 49
+    Anchors = [akRight, akBottom]
+    TabOrder = 7
+  end
+  inherited pnlMessage: TPanel
+    Top = 240
+  end
+  object pnlMeds: TPanel
+    ExplicitLeft = 0
+    ExplicitTop = 461
+    ExplicitWidth = 525
+  end
+  object pnlMeds: TPanel [1]
     Left = 6
     Top = 34
 …
         end>
       ColumnClick = False
+      Constraints.MaxHeight = 165
       HideSelection = False
       HotTrack = True
 …
     end
   end
   object txtMed: TEdit
+  object txtMed: TEdit [2]
     Left = 5
     Top = 6
 …
     OnKeyUp = txtMedKeyUp
   end
   object pnlFields: TPanel
+  object pnlFields: TPanel [3]
     Left = 3
     Top = 30
 …
         TabStop = True
         Visible = False
+        OnClick = lblGuidelineClick
       end
       object tabDose: TTabControl
 …
     end
   end
   object btnSelect: TButton
+  object btnSelect: TButton [4]
     Left = 539
     Top = 463
 …
     OnClick = btnSelectClick
   end
+  inherited cmdAccept: TButton
+    Left = 540
+    Top = 463
+    Width = 69
+    Anchors = [akRight, akBottom]
+    TabOrder = 6
+    Visible = False
+    ExplicitLeft = 540
+    ExplicitTop = 463
+    ExplicitWidth = 69
+  end
+  inherited cmdQuit: TButton
+    Left = 546
+    Top = 489
+    Width = 49
+    Anchors = [akRight, akBottom]
+    TabOrder = 7
+    ExplicitLeft = 546
+    ExplicitTop = 489
+    ExplicitWidth = 49
+  end
+  inherited pnlMessage: TPanel
+    Top = 240
+    ExplicitTop = 240
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlMeds'
+        'Status = stsDefault')
+      (
+        'Component = lstQuick'
+        'Status = stsDefault')
+      (
+        'Component = lstAll'
+        'Status = stsDefault')
+      (
+        'Component = txtMed'
+        'Status = stsDefault')
+      (
+        'Component = pnlFields'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lblGuideline'
+        'Status = stsDefault')
+      (
+        'Component = tabDose'
+        'Status = stsDefault')
+      (
+        'Component = cboDosage'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = chkPRN'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = memComment'
+        'Status = stsDefault')
+      (
+        'Component = lblAdminTime'
+        'Status = stsDefault')
+      (
+        'Component = calStart'
+        'Status = stsDefault')
+      (
+        'Component = lbStatements'
+        'Status = stsDefault')
+      (
+        'Component = memDrugMsg'
+        'Status = stsDefault')
+      (
+        'Component = btnSelect'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedNVA'
+        'Status = stsDefault'))
+  end
   object dlgStart: TORDateTimeDlg
     FMDateTime = 3001101
+    FMDateTime = 3001101.000000000000000000
     DateOnly = False
     RequireTime = True

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
+  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn;
+  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn, contnrs,
+  VA508AccessibilityManager;
 const
 …
   private
     {selection}
+    FAllItems:   TStringList;
+    FAllFirst:   Integer;
+    FAllLast:    Integer;
+    FAllList:    Integer;
+    FNVAMedCache:   TObjectList;
+    FCacheIEN:   integer;
     FQuickList:  Integer;
     FQuickItems: TStringList;
 …
     FQOInitial: boolean;
     FRemoveText : Boolean;
+    FMedName: string;
     {selection}
     procedure ChangeDelayed;
 …
     function FindQuickOrder(const x: string): Integer;
     function isUniqueQuickOrder(iText: string): Boolean;
+    function GetCacheChunkIndex(idx: integer): integer;
     procedure ScrollToVisible(AListView: TListView);
     procedure StartKeyTimer;
 …
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
     procedure CheckDecimal(var AStr: string);
+    property MedName: string read FMedName write FMedName;
   end;
 …
 uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
   uAccessibleStringGrid, fFrame, ORNet;
+  fFrame, ORNet, VAUtils;
 const
 …
   TIMER_FROM_DAYS = 1;
   TIMER_FROM_QTY  = 2;
+  MED_CACHE_CHUNK_SIZE = 100;
   {text constants}
   TX_ADMIN      = 'Requested Start: ';
 …
   FRowHeight := MainFontHeight + 1;
   x := 'NV RX';  // CLA 6/3/03
   ListForOrderable(FAllList, ListCount, x);
+  ListForOrderable(FCacheIEN, ListCount, x);
   lstAll.Items.Count := ListCount;
+  FAllItems := TStringList.Create;
+  FAllFirst := -1;
+  FAllLast  := -1;
+  FNVAMedCache := TObjectList.Create;
   FQuickItems := TStringList.Create;
   ListForQuickOrders(FQuickList, ListCount, x);
 …
     then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
   pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
+  cmdAccept.Left := cmdQuit.Left;
+  cmdaccept.Anchors := cmdQuit.anchors;
   FNoZero := False;
   FShrinked := False;
 …
   {selection}
   FQuickItems.Free;
   FAllItems.Free;
+  FNVAMedCache.Free;
   {edit}
   FGuideline.Free;
 …
    end;
   end;
+  if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
 end;
 …
   UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
   QuickIndex := FindQuickOrder(UserText);
   AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
+  AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
   if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
   if AllIndex > -1 then
 …
 { lstAll Methods (lstAll is TListView) }
+// Cache is a list of 100 string lists, starting at idx 0
 procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
+const
+  MAX_CACHE_ITEMS = 1000;
+begin
+  // if range is within cache range we don't need to update anything
+  if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
+  // if range is outside of cache or a superset of cache, start over
+  if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
+     ((First < FAllFirst) and (Last > FAllLast)) or
+     (FAllItems.Count > MAX_CACHE_ITEMS) then
+  begin
+    FAllItems.Clear;
+    FAllFirst := -1;
+    FAllLast  := -1;
+  end;
+  // if getting items immediately before cache range
+  if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
+  // if getting items immediately after cache range
+  if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
+  // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
+  SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
+  // reset FAllFirst & FAllLast indexes to reflect current FAllItems
+  if FAllFirst < 0     then FAllFirst := First;
+  if FAllLast  < 0     then FAllLast  := Last;
+  if First < FAllFirst then FAllFirst := First;
+  if Last > FAllLast   then FAllLast := Last;
+var
+  firstChunk, lastchunk, i: integer;
+  list: TStringList;
+  firstMed, LastMed: integer;
+begin
+  firstChunk := GetCacheChunkIndex(First);
+  lastChunk := GetCacheChunkIndex(Last);
+  for i := firstChunk to lastChunk do
+  begin
+    if (FNVAMedCache.Count <= i) or (not assigned(FNVAMedCache[i])) then
+    begin
+      while FNVAMedCache.Count <= i do
+        FNVAMedCache.add(nil);
+      list := TStringList.Create;
+      FNVAMedCache[i] := list;
+      firstMed := i * MED_CACHE_CHUNK_SIZE;
+      LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
+      if LastMed >= lstAll.Items.Count then
+        LastMed := lstAll.Items.Count - 1;
+      SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
+    end;
+  end;
 end;
 …
 var
   x: string;
+begin
+  if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
+    then LoadNonVAMedCache(Item.Index, Item.Index);
+  x := FAllItems[Item.Index - FAllFirst];
+  chunk: integer;
+  list: TStringList;
+begin
+  LoadNonVAMedCache(Item.Index, Item.Index);
+  chunk := GetCacheChunkIndex(Item.Index);
+  list := TStringList(FNVAMedCache[chunk]);
+  x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
   Item.Caption := Piece(x, U, 2);
   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
 …
 var
   MedIEN: Integer;
   MedName: string;
+  //MedName: string;
   QOQuantityStr: string;
   ErrMsg: string;
+  ErrMsg, temp: string;
 begin
   inherited;
   QOQuantityStr := '';
+  btnSelect.SetFocus;                             // let the exit events finish
+  btnSelect.SetFocus;
+  self.MedName := '';                             // let the exit events finish
   if pnlMeds.Visible then                         // display the medication fields
   begin
 …
         //btnSelect.Visible := False;
         btnSelect.Enabled := False;
         ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
 …
     begin
       MedIEN := Integer(lstAll.Selected.Data);
       MedName := lstAll.Selected.Caption;
+      self.MedName := lstAll.Selected.Caption;
       txtMed.Tag := MedIEN;
       ErrMsg := '';
 …
       begin
         btnSelect.Enabled := False;
         ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
 …
       begin
         txtMed.Tag := MedIEN;
+        txtMed.Text := MedName;
+        temp := self.MedName;
+        self.MedName := txtMed.Text;
+        txtMed.Text := Temp;
       end;
       SetOnMedSelect;
 …
 var
   i,j: Integer;
   x: string;
+  temp,x: string;
   QOPiUnChk: boolean;
   PKIEnviron: boolean;
 …
     // set up lists & initial values based on orderable item
     SetControl(txtMed,       'Medication');
+    if (self.MedName <> '') then
+       begin
+         if (txtMed.Text <> self.MedName) then
+           begin
+             temp := self.MedName;
+             self.MedName := txtMed.Text;
+             txtMed.Text := temp;
+           end
+         else MedName := '';
+       end;
     SetControl(cboDosage,    'Dosage');
     SetControl(cboRoute,     'Route');
 …
       else
         SetDosage(IValueFor('INSTR', 1));
+        SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
+        SetSchedule(IValueFor('SCHEDULE',  1));
+      SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
+      SetControl(cboRoute,  'ROUTE',     1);  //AGP ADDED ROUTE FOR CQ 11252
+      SetSchedule(IValueFor('SCHEDULE',  1));
       if (cboSchedule.Text = '') and FIsQuickOrder then
       begin
 …
   FUpdated := FALSE;
   Responses.Clear;
+  Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
+  if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
+  else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
   DoseList := TStringList.Create;
   case tabDose.TabIndex of
 …
     Schedule  <TAB> (nothing)
     Duration  <TAB> Duration^Units }
+  // the following functions were created to get rid of a compile warning saying the
+  // return value may be undefined - too much branching logic in the case statements
+  // for the compiler to handle
+  function GetSchedule: string;
+  begin
+    Result := UpperCase(cboSchedule.Text);
+    if chkPRN.Checked then Result := Result + ' PRN';
+    if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
+      then Result := Copy(Result, 1, Length(Result) - 4);
+  end;
+  function GetScheduleEX: string;
+  begin
+    Result := '';
+    with cboSchedule do
+      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
+    if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
+    if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+      then Result := Copy(Result, 1, Length(Result) - 10);
+  end;
 begin
   Result := '';
 …
                      if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
     FLD_SCHEDULE  : begin
+                      Result := UpperCase(cboSchedule.Text);
+                      if chkPRN.Checked then Result := Result + ' PRN';
+                      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
+                        then Result := Copy(Result, 1, Length(Result) - 4);
+                      Result := GetSchedule;
                     end;
     FLD_SCHED_EX  : begin
+                      with cboSchedule do
+                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
+                      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
+                      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+                        then Result := Copy(Result, 1, Length(Result) - 10);
+                      Result := GetScheduleEX;
                     end;
     FLD_SCHED_TYP : with cboSchedule do
 …
 end;
+function TfrmODMedNVA.GetCacheChunkIndex(idx: integer): integer;
+begin
+  Result := idx div MED_CACHE_CHUNK_SIZE;
+end;
 procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
 var
 …
             tmplst.Strings[i] := Piece(s,U,2);
         end;
         Dest.Assign(tmplst);
+        FastAssign(tmplst, Dest);
     end;
  end;

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

-              r456
+              r829
 object frmODMedOIFA: TfrmODMedOIFA
+inherited frmODMedOIFA: TfrmODMedOIFA
   Left = 0
   Top = 0
-  Width = 313
-  Height = 205
   Caption = 'Formulary Alternatives'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 178
+  ClientWidth = 305
   FormStyle = fsStayOnTop
   OldCreateOrder = True
 …
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 0
     Top = 0
 …
     Align = alTop
     Caption = 'The selected drug is not in the formulary.  Alternatives are:'
+    ExplicitWidth = 273
   end
   object Label2: TStaticText
+  object Label2: TStaticText [1]
     Left = 0
     Top = 134
 …
     Caption = 'Do you wish to use the selected alternative instead?'
     TabOrder = 1
+    ExplicitWidth = 250
   end
   object lstFormAlt: TORListBox
+  object lstFormAlt: TORListBox [2]
     Left = 0
     Top = 13
 …
     Pieces = '2'
   end
   object btnPanel: TPanel
+  object btnPanel: TPanel [3]
     Left = 0
     Top = 151
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Label2'
+        'Status = stsDefault')
+      (
+        'Component = lstFormAlt'
+        'Status = stsDefault')
+      (
+        'Component = btnPanel'
+        'Status = stsDefault')
+      (
+        'Component = cmdYes'
+        'Status = stsDefault')
+      (
+        'Component = cmdNo'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedOIFA'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORCtrls, ExtCtrls, fAutoSz;
+  StdCtrls, ORCtrls, ExtCtrls, fAutoSz, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODMedOIFA = class(TForm)
+  TfrmODMedOIFA = class(TfrmBase508Form)
     Label1: TLabel;
     lstFormAlt: TORListBox;
 …
         with frmODMedOIFA do
         begin
           lstFormAlt.Items.Assign(FormAltList);
+          FastAssign(FormAltList, lstFormAlt.Items);
           ShowModal;
           if Length(FSelected) > 0 then
 …
         with frmODMedOIFA do
         begin
           lstFormAlt.Items.Assign(FormAltList);
+          FastAssign(FormAltList, lstFormAlt.Items);
           ShowModal;
           if Length(FSelected) > 0 then

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

-              r456
+              r829
   Height = 316
   Caption = 'Outpatient Medication Order'
+  ExplicitHeight = 316
   PixelsPerInch = 96
   TextHeight = 13
 …
     Top = 235
     TabOrder = 15
+  end
+  inherited cmdAccept: TButton
+    Top = 235
+    TabOrder = 13
+  end
+  object cboRoute: TORComboBox [20]
+    ExplicitTop = 235
+  end
+  object cboRoute: TORComboBox [19]
     Left = 314
     Top = 59
 …
     CharsNeedMatch = 1
   end
   object cboSchedule: TORComboBox [21]
+  object cboSchedule: TORComboBox [20]
     Left = 392
     Top = 59
 …
     CharsNeedMatch = 1
   end
   object memComments: TMemo [22]
+  object memComments: TMemo [21]
     Left = 202
     Top = 197
 …
     OnEnter = memCommentsEnter
   end
   object cboPriority: TORComboBox [23]
+  object cboPriority: TORComboBox [22]
     Left = 392
     Top = 156
 …
     CharsNeedMatch = 1
   end
   object cboMedAlt: TORComboBox [24]
+  object cboMedAlt: TORComboBox [23]
     Left = 6
     Top = 18
 …
     CharsNeedMatch = 1
   end
   object cboInstructions: TORComboBox [25]
+  object cboInstructions: TORComboBox [24]
     Left = 203
     Top = 59
 …
     CharsNeedMatch = 1
   end
   object cboPickup: TORComboBox [26]
+  object cboPickup: TORComboBox [25]
     Left = 202
     Top = 156
 …
     CharsNeedMatch = 1
   end
   object cboSC: TORComboBox [27]
+  object cboSC: TORComboBox [26]
     Left = 314
     Top = 156
 …
     CharsNeedMatch = 1
   end
   object txtQuantity: TCaptionEdit [28]
+  object txtQuantity: TCaptionEdit [27]
     Left = 470
     Top = 59
 …
     Caption = 'Quantity'
   end
   object txtRefills: TCaptionEdit [29]
+  object txtRefills: TCaptionEdit [28]
     Left = 470
     Top = 105
 …
     Caption = 'Refills'
   end
   object spnRefills: TUpDown [30]
+  object spnRefills: TUpDown [29]
     Left = 501
     Top = 105
 …
     Height = 21
     Associate = txtRefills
-    Min = 0
     Max = 11
-    Position = 0
     TabOrder = 8
+    Wrap = False
+  end
+  object cmdComplex: TButton [31]
+  end
+  object cmdComplex: TButton [30]
     Left = 202
     Top = 18
 …
     OnClick = cmdComplexClick
   end
+  inherited cmdAccept: TButton
+    Top = 235
+    TabOrder = 13
+    ExplicitTop = 235
+  end
   inherited cmdQuit: TButton
     Top = 262
     TabOrder = 14
+    ExplicitTop = 262
   end
   inherited pnlMessage: TPanel
 …
     Top = 190
     TabOrder = 16
+    ExplicitLeft = 6
+    ExplicitTop = 190
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memComplex'
+        'Status = stsDefault')
+      (
+        'Component = txtSIG'
+        'Status = stsDefault')
+      (
+        'Component = cboDispense'
+        'Status = stsDefault')
+      (
+        'Component = cboMedication'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = cboPriority'
+        'Status = stsDefault')
+      (
+        'Component = cboMedAlt'
+        'Status = stsDefault')
+      (
+        'Component = cboInstructions'
+        'Status = stsDefault')
+      (
+        'Component = cboPickup'
+        'Status = stsDefault')
+      (
+        'Component = cboSC'
+        'Status = stsDefault')
+      (
+        'Component = txtQuantity'
+        'Status = stsDefault')
+      (
+        'Component = txtRefills'
+        'Status = stsDefault')
+      (
+        'Component = spnRefills'
+        'Status = stsDefault')
+      (
+        'Component = cmdComplex'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMedOut'
+        'Status = stsDefault'))
   end
   object popUnits: TPopupMenu

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

r456	r829
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7	7	fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask,
8		Menus, Buttons;
	8	Menus, Buttons, VA508AccessibilityManager;
9	9
10	10	type

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

-              r456
+              r829
 inherited frmODMeds: TfrmODMeds
   Left = 519
   Top = 204
+  Left = 321
+  Top = 183
   Width = 584
   Height = 515
+  Height = 572
   HorzScrollBar.Range = 558
   VertScrollBar.Range = 399
   Caption = 'Medication Order'
   Constraints.MinHeight = 325
-  OnKeyDown = FormKeyDown
   OnShow = FormShow
+  ExplicitWidth = 584
+  ExplicitHeight = 572
   DesignSize = (
 )
+)
   PixelsPerInch = 96
   TextHeight = 13
 …
     Top = 34
     Width = 580
     Height = 413
+    Height = 470
     Anchors = [akLeft, akTop, akRight, akBottom]
     BevelOuter = bvNone
-    Caption = 'pnlMeds'
     TabOrder = 1
     object sptSelect: TSplitter
 …
       Top = 137
       Width = 580
       Height = 276
+      Height = 333
       Align = alClient
       BevelInner = bvLowered
 …
   end
   inherited memOrder: TCaptionMemo
+    Top = 448
+    Tag = 13
+    Top = 505
     Width = 502
+    TabStop = True
     Anchors = [akLeft, akRight, akBottom]
     TabOrder = 4
+    ExplicitTop = 505
+    ExplicitWidth = 502
   end
   object txtMed: TEdit [2]
 …
   object btnSelect: TButton [3]
     Left = 515
     Top = 448
+    Top = 505
     Width = 72
     Height = 21
 …
     OnClick = btnSelectClick
   end
+  inherited cmdAccept: TButton
+    Left = 514
+    Top = 448
+    Anchors = [akRight, akBottom]
+    TabOrder = 6
+    TabStop = False
+    Visible = False
+  end
+  inherited cmdQuit: TButton
+    Left = 514
+    Top = 473
+    Width = 51
+    Anchors = [akRight, akBottom]
+    TabOrder = 7
+  end
+  inherited pnlMessage: TPanel
+    Left = 36
+    Top = 156
+    OnEnter = pnlMessageEnter
+    inherited memMessage: TRichEdit
+      OnKeyDown = memMessageKeyDown
+    end
+  end
+  object pnlFields: TPanel
+  object pnlFields: TPanel [4]
     Left = 6
     Top = 34
     Width = 580
     Height = 413
+    Height = 470
     Anchors = [akLeft, akTop, akRight, akBottom]
     BevelOuter = bvNone
 …
       Top = 0
       Width = 580
       Height = 184
+      Height = 197
       Align = alClient
       Constraints.MinHeight = 80
 …
       DesignSize = (
 )
+)
       object lblRoute: TLabel
         Left = 280
 …
         Top = 36
         Width = 580
         Height = 143
+        Height = 156
         Anchors = [akLeft, akTop, akRight, akBottom]
         ColCount = 6
+        ColCount = 7
         DefaultColWidth = 76
         DefaultRowHeight = 21
 …
 )
       end
 …
         Top = 36
         Width = 279
         Height = 143
+        Height = 155
         Anchors = [akLeft, akTop, akRight, akBottom]
         Style = orcsSimple
 …
         Top = 36
         Width = 113
         Height = 143
+        Height = 156
         Anchors = [akTop, akRight, akBottom]
         Style = orcsSimple
 …
         Top = 36
         Width = 178
         Height = 143
+        Height = 156
         Anchors = [akTop, akRight, akBottom]
         Style = orcsSimple
 …
         TabOrder = 2
         OnClick = btnXRemoveClick
+      end
+      object pnlXAdminTime: TPanel
+        Left = 432
+        Top = 149
+        Width = 65
+        Height = 17
+        Caption = 'pnlXAdminTime'
+        TabOrder = 9
+        Visible = False
+        OnClick = pnlXAdminTimeClick
       end
     end
 …
         Anchors = [akLeft, akTop, akBottom]
         Associate = txtXDuration
-        Min = 0
         Max = 999
-        Position = 0
         TabOrder = 1
-        Wrap = False
-      end
-    end
-    object pnlXSequence: TKeyClickPanel
-      Left = 396
-      Top = 122
-      Width = 37
-      Height = 21
-      Caption = 'Then/And box'
-      TabOrder = 5
-      TabStop = True
-      Visible = False
-      OnClick = btnXSequenceClick
-      OnEnter = pnlXSequenceEnter
-      OnExit = pnlXSequenceExit
-      object btnXSequence: TSpeedButton
-        Left = 1
-        Top = 1
-        Width = 38
-        Height = 19
-        Hint = 'A duration must be defined if using "Then" as a sequence.'
-        Caption = 'then'
-        Glyph.Data = {
-          AE000000424DAE0000000000000076000000280000000E000000070000000100
-          0400000000003800000000000000000000001000000000000000000000000000
-          8000008000000080800080000000800080008080000080808000C0C0C0000000
-          FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
-          330033333333333333003330333333733300330003333F87330030000033FFFF
-          F30033333333333333003333333333333300}
-        Layout = blGlyphRight
-        NumGlyphs = 2
-        ParentShowHint = False
-        ShowHint = True
-        Spacing = 1
-        OnClick = btnXSequenceClick
-      end
-      object SpeedButton1: TSpeedButton
-        Left = 16
-        Top = 16
-        Width = 23
-        Height = 22
       end
     end
 …
     object pnlBottom: TPanel
       Left = 0
       Top = 184
+      Top = 197
       Width = 580
       Height = 229
+      Height = 273
       Align = alBottom
       TabOrder = 6
+      TabOrder = 5
       DesignSize = (
 )
+)
       object lblComment: TLabel
         Left = 4
 …
       object Image1: TImage
         Left = 5
         Top = 177
+        Top = 221
         Width = 31
         Height = 31
         Anchors = [akLeft, akBottom]
         Visible = False
+        ExplicitTop = 177
       end
       object chkDoseNow: TCheckBox
 …
         Height = 21
         Caption = 'Give additional dose now'
         TabOrder = 9
+        TabOrder = 8
         OnClick = chkDoseNowClick
       end
 …
         Height = 17
         Caption = '>> Quantity Dispensed: Multiples of 100 <<'
         TabOrder = 12
+        TabOrder = 13
       end
       object txtSupply: TCaptionEdit
 …
         Height = 21
         Associate = txtSupply
-        Min = 0
-        Position = 0
         TabOrder = 2
-        Wrap = False
       end
       object txtQuantity: TCaptionEdit
 …
         Width = 16
         Height = 21
         Min = -32766
+        Associate = txtQuantity
         Max = 32766
-        Position = 0
         TabOrder = 4
-        Wrap = False
-        OnChangingEx = spnQuantityChangingEx
       end
       object txtRefills: TCaptionEdit
 …
         TabOrder = 5
         Text = '0'
         OnChange = ControlChange
+        OnChange = txtRefillsChange
         OnClick = txtRefillsClick
         Caption = 'Refills'
 …
         Height = 21
         Associate = txtRefills
-        Min = 0
         Max = 11
-        Position = 0
         TabOrder = 6
-        Wrap = False
       end
       object grpPickup: TGroupBox
 …
         Sorted = False
         SynonymChars = '<>'
         TabOrder = 10
+        TabOrder = 9
         OnChange = ControlChange
         CharsNeedMatch = 1
-      end
-      object chkSC: TCheckBox
-        Left = 3
-        Top = 106
-        Width = 175
-        Height = 17
-        Caption = 'for Service Connected condition'
-        ParentShowHint = False
-        ShowHint = True
-        TabOrder = 8
-        OnClick = chkSCClick
-        OnEnter = chkSCEnter
-      end
-      object lblAdminTime: TStaticText
-        Left = 262
-        Top = 120
-        Width = 4
-        Height = 4
-        TabOrder = 16
       end
       object stcPI: TStaticText
 …
       object memDrugMsg: TMemo
         Left = 37
         Top = 176
+        Top = 220
         Width = 533
         Height = 51
 …
         Visible = False
       end
+    end
+      object lblAdminSch: TMemo
+        Left = 344
+        Top = 120
+        Width = 68
+        Height = 15
+        Anchors = [akLeft, akTop, akRight]
+        Color = clCream
+        ParentShowHint = False
+        ReadOnly = True
+        ScrollBars = ssVertical
+        ShowHint = True
+        TabOrder = 10
+        Visible = False
+      end
+      object lblAdminTime: TVA508StaticText
+        Name = 'lblAdminTime'
+        Left = 164
+        Top = 116
+        Width = 64
+        Height = 15
+        Alignment = taLeftJustify
+        Caption = 'lblAdminTime'
+        TabOrder = 11
+        TabStop = True
+        ShowAccelChar = True
+      end
+    end
+    object cboXSequence: TORComboBox
+      Left = 438
+      Top = 122
+      Width = 64
+      Height = 21
+      Style = orcsDropDown
+      AutoSelect = True
+      Caption = 'Sequence'
+      Color = clWindow
+      DropDownCount = 8
+      Items.Strings = (
+        'and'
+        'then')
+      ItemHeight = 13
+      ItemTipColor = clWindow
+      ItemTipEnable = True
+      ListItemsOnly = False
+      LongList = False
+      LookupPiece = 0
+      MaxLength = 0
+      Sorted = False
+      SynonymChars = '<>'
+      TabOrder = 6
+      Visible = False
+      OnChange = cboXSequenceChange
+      OnEnter = cboXSequenceEnter
+      OnExit = cboXSequenceExit
+      OnKeyDown = memMessageKeyDown
+      CharsNeedMatch = 1
+    end
+  end
+  inherited cmdAccept: TButton
+    Left = 514
+    Top = 505
+    Anchors = [akRight, akBottom]
+    TabOrder = 6
+    TabStop = False
+    Visible = False
+    ExplicitLeft = 514
+    ExplicitTop = 505
+  end
+  inherited cmdQuit: TButton
+    Left = 514
+    Top = 530
+    Width = 51
+    Anchors = [akRight, akBottom]
+    TabOrder = 7
+    ExplicitLeft = 514
+    ExplicitTop = 530
+    ExplicitWidth = 51
+  end
+  inherited pnlMessage: TPanel
+    Left = 31
+    Top = 200
+    OnEnter = pnlMessageEnter
+    ExplicitLeft = 31
+    ExplicitTop = 200
+    inherited imgMessage: TImage
+      Left = 2
+      ExplicitLeft = 2
+    end
+    inherited memMessage: TRichEdit
+      OnKeyDown = memMessageKeyDown
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlMeds'
+        'Status = stsDefault')
+      (
+        'Component = lstQuick'
+        'Text = Quick Orders'
+        'Status = stsOK')
+      (
+        'Component = lstAll'
+        'Text = Medications'
+        'Status = stsOK')
+      (
+        'Component = txtMed'
+        'Text = Medication'
+        'Status = stsOK')
+      (
+        'Component = btnSelect'
+        'Status = stsDefault')
+      (
+        'Component = pnlFields'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = grdDoses'
+        'Status = stsDefault')
+      (
+        'Component = lblGuideline'
+        'Status = stsDefault')
+      (
+        'Component = tabDose'
+        'Status = stsDefault')
+      (
+        'Component = cboDosage'
+        'Status = stsDefault')
+      (
+        'Component = cboRoute'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = chkPRN'
+        'Status = stsDefault')
+      (
+        'Component = btnXInsert'
+        'Status = stsDefault')
+      (
+        'Component = btnXRemove'
+        'Status = stsDefault')
+      (
+        'Component = pnlXAdminTime'
+        'Status = stsDefault')
+      (
+        'Component = cboXDosage'
+        'Status = stsDefault')
+      (
+        'Component = cboXRoute'
+        'Status = stsDefault')
+      (
+        'Component = pnlXDuration'
+        'Status = stsDefault')
+      (
+        'Component = pnlXDurationButton'
+        'Status = stsDefault')
+      (
+        'Component = txtXDuration'
+        'Status = stsDefault')
+      (
+        'Component = spnXDuration'
+        'Status = stsDefault')
+      (
+        'Component = pnlXSchedule'
+        'Status = stsDefault')
+      (
+        'Component = cboXSchedule'
+        'Status = stsDefault')
+      (
+        'Component = chkXPRN'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = chkDoseNow'
+        'Status = stsDefault')
+      (
+        'Component = memComment'
+        'Status = stsDefault')
+      (
+        'Component = lblQtyMsg'
+        'Status = stsDefault')
+      (
+        'Component = txtSupply'
+        'Status = stsDefault')
+      (
+        'Component = spnSupply'
+        'Status = stsDefault')
+      (
+        'Component = txtQuantity'
+        'Status = stsDefault')
+      (
+        'Component = spnQuantity'
+        'Status = stsDefault')
+      (
+        'Component = txtRefills'
+        'Status = stsDefault')
+      (
+        'Component = spnRefills'
+        'Status = stsDefault')
+      (
+        'Component = grpPickup'
+        'Status = stsDefault')
+      (
+        'Component = radPickWindow'
+        'Status = stsDefault')
+      (
+        'Component = radPickMail'
+        'Status = stsDefault')
+      (
+        'Component = radPickClinic'
+        'Status = stsDefault')
+      (
+        'Component = cboPriority'
+        'Status = stsDefault')
+      (
+        'Component = stcPI'
+        'Status = stsDefault')
+      (
+        'Component = chkPtInstruct'
+        'Status = stsDefault')
+      (
+        'Component = memPI'
+        'Status = stsDefault')
+      (
+        'Component = memDrugMsg'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMeds'
+        'Status = stsDefault')
+      (
+        'Component = cboXSequence'
+        'Status = stsDefault')
+      (
+        'Component = lblAdminSch'
+        'Status = stsDefault')
+      (
+        'Component = lblAdminTime'
+        'Status = stsDefault'))
   end
   object dlgStart: TORDateTimeDlg
     FMDateTime = 3001101
+    FMDateTime = 3001101.000000000000000000
     DateOnly = False
     RequireTime = True
 …
     end
   end
-  object popXSequence: TPopupMenu
-    AutoHotkeys = maManual
-    Left = 448
-    Top = 145
-    object and1: TMenuItem
-      Tag = 1
-      Caption = 'and'
-      OnClick = popXSequenceClick
-    end
-    object then1: TMenuItem
-      Tag = 2
-      Caption = 'then'
-      OnClick = popXSequenceClick
-    end
-  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
   Menus, XUDIGSIGSC_TLB;
+  Menus, XUDIGSIGSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs;
 const
 …
     cboXRoute: TORComboBox;
     pnlXDuration: TPanel;
-    pnlXSequence: TKeyClickPanel;
-    btnXSequence: TSpeedButton;
     timCheckChanges: TTimer;
     popDuration: TPopupMenu;
 …
     hours1: TMenuItem;
     minutes1: TMenuItem;
-    popXSequence: TPopupMenu;
-    and1: TMenuItem;
-    then1: TMenuItem;
     months1: TMenuItem;
     weeks1: TMenuItem;
 …
     radPickClinic: TRadioButton;
     cboPriority: TORComboBox;
-    chkSC: TCheckBox;
-    lblAdminTime: TStaticText;
     stcPI: TStaticText;
     chkPtInstruct: TCheckBox;
 …
     memDrugMsg: TMemo;
     txtNSS: TLabel;
+    SpeedButton1: TSpeedButton;
+    pnlXAdminTime: TPanel;
+    cboXSequence: TORComboBox;
+    lblAdminSch: TMemo;
+    lblAdminTime: TVA508StaticText;
     procedure FormCreate(Sender: TObject);
     procedure btnSelectClick(Sender: TObject);
 …
     procedure cboXRouteChange(Sender: TObject);
     procedure cboXScheduleChange(Sender: TObject);
-    procedure pnlXSequenceExit(Sender: TObject);
-    procedure btnXSequenceClick(Sender: TObject);
     procedure grdDosesExit(Sender: TObject);
     procedure ListViewEnter(Sender: TObject);
     procedure timCheckChangesTimer(Sender: TObject);
     procedure popDurationClick(Sender: TObject);
-    procedure popXSequenceClick(Sender: TObject);
-    procedure chkSCEnter(Sender: TObject);
-    procedure chkSCClick(Sender: TObject);
     procedure cmdAcceptClick(Sender: TObject);
     procedure btnXInsertClick(Sender: TObject);
 …
       Shift: TShiftState);
     procedure cboXRouteEnter(Sender: TObject);
-    procedure pnlXSequenceEnter(Sender: TObject);
     procedure pnlMessageEnter(Sender: TObject);
     procedure pnlMessageExit(Sender: TObject);
 …
     procedure memPIClick(Sender: TObject);
     procedure FormResize(Sender: TObject);
-    procedure spnQuantityChangingEx(Sender: TObject;
-      var AllowChange: Boolean; NewValue: Smallint;
-      Direction: TUpDownDirection);
     procedure memPIKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
 …
     procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
     procedure cboXScheduleEnter(Sender: TObject);
+    procedure pnlXAdminTimeClick(Sender: TObject);
+    procedure cboXSequenceChange(Sender: TObject);
+    procedure cboXSequence1Exit(Sender: TObject);
+    procedure cboXSequenceExit(Sender: TObject);
+    procedure cboXSequenceEnter(Sender: TObject);
+    procedure txtRefillsChange(Sender: TObject);
     //procedure btnNSSClick(Sender: TObject);
   private
+    FCloseCalled : Boolean;
     FScheduleChanged : Boolean;
     {selection}
+    FAllItems:   TStringList;
+    FAllFirst:   Integer;
+    FAllLast:    Integer;
+    FAllList:    Integer;
+    FMedCache:   TObjectList;
+    FCacheIEN:   Integer;
     FQuickList:  Integer;
     FQuickItems: TStringList;
 …
     FNoZERO: boolean;
     FIsQuickOrder: boolean;
-    FAdminTimeLbl: string;
     FDisabledDefaultButton: TButton;
     FDisabledCancelButton: TButton;
 …
     FRemoveText : Boolean;
     FSmplPRNChkd: Boolean;
+    {Admin Time}
+    FAdminTimeLbl: string;
+    FMedName: String;
+    FNSSAdminTime: string;
+    FNSSScheduleType: string;
+    FAdminTimeText: string;
+    //FOriginalAdminTime: string;
+    //FOriginalScheduleIndex: integer;
+    FOrderAction: integer;
+    JAWSON: boolean;
     procedure ChangeDelayed;
     function FindQuickOrder(const x: string): Integer;
     function isUniqueQuickOrder(iText: string): Boolean;
+    function GetCacheChunkIndex(idx: integer): integer;
     procedure LoadMedCache(First, Last: Integer);
     procedure ScrollToVisible(AListView: TListView);
 …
     procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
     procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
-    procedure UpdateSC(const CurDispDrug: string);
     procedure UpdateStartExpires(const CurSchedule: string);
     procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
 …
     function IsSupplyAndOutPatient : boolean;
     function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
+    procedure DisplayDoseNow(Status: boolean);
+    function lblAdminSchGetText: string;
+    procedure lblAdminSchSetText(str: string);
   protected
+    procedure Loaded; override;
     procedure InitDialog; override;
     procedure Validate(var AnErrMsg: string); override;
+    procedure updateSig; override;
   public
     ARow1: integer;
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
     procedure CheckDecimal(var AStr: string);
+    property MedName: string read FMedName write FMedName;
+    property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
+    property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
   end;
 …
 uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
   uAccessibleStringGrid, uOrders, fOtherSchedule, StrUtils, fFrame;
+  uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter;
 const
   {grid columns for complex dosing}
+  COL_SELECT   =  0;
+  COL_DOSAGE   =  1;
+  COL_ROUTE    =  2;
+  COL_SCHEDULE =  3;
+  COL_DURATION =  4;
+  COL_SEQUENCE =  5;
+  COL_CHKXPRN  =  6;
+  VAL_DOSAGE   = 10;
+  VAL_ROUTE    = 20;
+  VAL_SCHEDULE = 30;
+  VAL_DURATION = 40;
+  VAL_SEQUENCE = 50;
+  VAL_CHKXPRN  = 60;
+  TAB          = #9;
+  COL_SELECT    =  0;
+  COL_DOSAGE    =  1;
+  COL_ROUTE     =  2;
+  COL_SCHEDULE  =  3;
+  COL_DURATION  =  4;
+  COL_ADMINTIME =  5;
+  COL_SEQUENCE  =  6;
+  COL_CHKXPRN   =  7;
+  VAL_DOSAGE    = 10;
+  VAL_ROUTE     = 20;
+  VAL_SCHEDULE  = 30;
+  VAL_DURATION  = 40;
+  VAL_ADMINTIME = 50;
+  VAL_SEQUENCE  = 60;
+  VAL_CHKXPRN   = 70;
+  TAB           = #9;
   {field identifiers}
   FLD_LOCALDOSE =  1;
 …
   TIMER_FROM_DAYS = 1;
   TIMER_FROM_QTY  = 2;
+  MED_CACHE_CHUNK_SIZE = 100;
   {text constants}
   TX_ADMIN      = 'Requested Start: ';
 …
   AutoSizeDisabled := True;
   inherited;
+  FAdminTimeText := '';
   btnXDuration.Align := alClient;
   AllowQuickOrder := True;
 …
   //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
   //else LoadSchedules(cboSchedule.Items, FInptDlg);
   LoadSchedules(cboSchedule.Items, FInptDlg);
+  LoadSchedules(cboSchedule.Items, FInptDlg);
   StatusText('');
   if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
 …
   FOrigiMsgDisp := FSuppressMsg;
   InitDialog;
+  isIMO := IfisIMODialog;
+  if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then
+      FAdminTimeText := 'Not defined for Clinic Locations';
   if FInptDlg then
   begin
 …
   end;
   with grdDoses do
   begin
+  begin
     ColWidths[0] := 8;  // select
     ColWidths[1] := 160; // dosage
 …
     ColWidths[3] := 102;  // schedule
     ColWidths[4] := 70;  // duration
+    ColWidths[5] := 58;  // and/then
+    if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then
+      begin
+        ColWidths[5] := 102;  // administration times
+        ColWidths[6] := 58;  // and/then
+      end
+    else
+        ColWidths[5] := 0;
+        ColWidths[6] := 58;
     Cells[1, 0]  := 'Dosage';
     Cells[2, 0]  := 'Route';
     Cells[3, 0]  := 'Schedule';
     Cells[4, 0]  := 'Duration (optional)';
     Cells[5, 0]  := 'then/and';
   end;
   TAccessibleStringGrid.WrapControl(grdDoses);
+    Cells[5, 0]  := 'Admin. Times';
+    Cells[6, 0]  := 'then/and';
+  end;
   // medication selection
   FRowHeight := MainFontHeight + 1;
   IsIMO := IfIsIMODialog; //IMO
+  //IsIMO := IfIsIMODialog; //IMO
   if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order.
   if FInptDlg then x := 'UD RX'
 …
     x := 'IVM RX';
   end;
+  ListForOrderable(FAllList, ListCount, x);
+  if self.EvtID > 0  then FAdminTimeText := 'To Be Determined';
+  ListForOrderable(FCacheIEN, ListCount, x);
   lstAll.Items.Count := ListCount;
+  FAllItems := TStringList.Create;
+  FAllFirst := -1;
+  FAllLast  := -1;
+  FMedCache := TObjectList.Create;
   FQuickItems := TStringList.Create;
   ListForQuickOrders(FQuickList, ListCount, x);
 …
   FShowPnlXScheduleOk := True;
   FRemoveText := True;
+  JAWSON := True;
+  if ScreenReaderActive = false then
+    begin
+      lblAdminTime.TabStop := false;
+      lblAdminSch.TabStop := false;
+      memOrder.TabStop := false;
+      JAWSON := false;
+    end;
 end;
 …
   {selection}
   FQuickItems.Free;
   FAllItems.Free;
+  FMedCache.Free;
   {edit}
   FGuideline.Free;
   FAllDoses.Free;
   FAllDrugs.Free;
-  TAccessibleStringGrid.UnwrapControl(grdDoses);
   frmFrame.pnlVisit.Enabled := true;
   inherited;
 …
 procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
 var
   AnInstr, OrderID, nsSch, Text: string;
+  AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime: string;
   ix: integer;
+begin
+  inherited;
+  LocChange: boolean;
+  AResponse: TResponse;
+begin
+  inherited;
+  FOrderAction := OrderAction;
+  if self.EvtID > 0 then DisplayDoseNow(false);
   if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
   if CharAt(ID,1)='X' then
+  if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then
   begin
     OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
     CheckExistingPI(OrderID, FPtInstruct);
   end;
+  if OrderAction = ORDER_QUICK then
+  //AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
+  //this is not the best approach but this should fix the problem with order edit losing the quantity value.
+  if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
   begin
     FIsQuickOrder := True;
 …
     Changing := True;
     txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
+    if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
+     (uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
+    if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
+     ((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit;
+  (*  if (OrderAction = ORDER_QUICK) then
+      begin
+        tempAltIEN := GetQOAltOI;
+        if tempAltIEN > 0 then txtMed.Tag := tempAltIEN;
+      end; *)
     SetOnMedSelect;                               // set up for this medication
     SetOnQuickOrder;                              // insert quick order responses
 …
        end;
     end;  //nss
+    //if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
+    if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT])  then
+      begin
+        TempOrder := Piece(id,';',1);
+        TempOrder := Copy(tempOrder, 2, Length(tempOrder));
+        LocChange := DifferentOrderLocations(tempOrder, Patient.Location);
+          if LocChange = false then
+            begin
+              AResponse := Responses.FindResponseByName('ADMIN', 1);
+              if AResponse <> nil then AdminTime := AResponse.EValue;
+              if self.cboSchedule.ItemIndex > -1 then
+                begin
+                  tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
+                  SetPiece(tempSchString,U,4,AdminTime);
+                  self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
+                end;
+              if self.tabDose.TabIndex = TI_COMPLEX then
+                begin
+                  if self.cboXSchedule.ItemIndex > -1 then
+                    begin
+                      tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
+                      SetPiece(tempSchString,U,4,AdminTime);
+                      self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
+                    end;
+                end;
+              AResponse := Responses.FindResponseByName('SCHTYPE', 1);
+              if AResponse <> nil then tempSchType := AResponse.EValue;
+              if self.cboSchedule.ItemIndex > -1 then
+                begin
+                  if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
+                     self.chkPRN.Checked := True
+                  else
+                     begin
+                       tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
+                       SetPiece(tempSchString,U,3,tempSchType);
+                       self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
+                     end;
+                  end;
+               if self.tabDose.TabIndex = TI_COMPLEX then
+                begin
+                  if self.cboXSchedule.ItemIndex > -1 then
+                    begin
+                      if  (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
+                          self.chkXPRN.Checked := True
+                      else
+                        begin
+                          tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
+                          SetPiece(tempSchString,U,3,tempSchType);
+                          self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
+                        end;
+                    end;
+                end;
+            end;
+        if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then
+            lblAdminSchSetText('');
+        if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
+      end;
     if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
     (XfInToOutNow = true) then UpdateRelated(FALSE); //AGP Change
+    (XfInToOutNow = true) or (FIsQuickOrder) then UpdateRelated(FALSE); //AGP Change
     Changing := False;
+    if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
+        (self.cboSchedule.ItemIndex > -1) then
+          UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1));
   end;
   { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
 …
 procedure TfrmODMeds.Validate(var AnErrMsg: string);
 var
+  i,ie,code: Integer;
+  i,ie,code, curSupply, tempRefills: Integer;
+  curDispDrug, tmpError, temp, x: string;
   procedure SetError(const x: string);
 …
   if txtMed.Tag = 0 then SetError(TX_NO_MED);
   if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
+  if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
   i := Responses.NextInstance('INSTR', 0);
   while i > 0 do
 …
     i := Responses.NextInstance('INSTR', i);
   end;
+  if self.tabDose.TabIndex = TI_DOSE then
+     begin
+         if (LeftStr(cboDosage.Text,1)='.') then
+       begin
+         SetError('Dosage must have a leading numeric value');
+         Exit;
+       end;
+     end;
   //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
   if self.tabDose.TabIndex = 1 then
     begin
        for i := 2 to self.grdDoses.RowCount do
+  if self.tabDose.TabIndex = TI_COMPLEX then
+    begin
+       for i := 1 to self.grdDoses.RowCount do
          begin
+           if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
+           temp := ValFor(COL_DOSAGE, i);
+           if (LeftStr(temp,1) = '.') then
              begin
               SetError(TX_NO_SEQ);
               Exit;
+                SetError('All dosage must have a leading numeric value');
+                Exit;
              end;
+           if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
+              begin
+                SetError(TX_NO_SEQ);
+                Exit;
+              end;
          end;
     end;
 …
   begin
     if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK);
+    if StrToIntDef(Responses.IValueFor('REFILLS', 1), 99) > spnRefills.Max
+    temp := Responses.IValueFor('REFILLS', 1);
+    for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then
+      begin
+        SetError('Refills can only be a number');
+        Exit;
+      end;
+    tempRefills := StrToIntDef(temp, 0);
+    if (spnRefills.Max > 0) and (tempRefills > 0) then
+      begin
+        i := Responses.NextInstance('DOSE', 0);
+        while i > 0 do
+        begin
+          x := ValueOfResponse(FLD_DRUG_ID,   i);
+          CurDispDrug := CurDispDrug + x + U;
+          i := Responses.NextInstance('DOSE', i);
+        end;
+        CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
+        UpdateRefills(CurDispDrug, CurSupply);
+      end;
+    if tempRefills > spnRefills.Max
       then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
     with txtQuantity do
+      if not ValidQuantity(Responses.IValueFor('QTY', 1)) then SetError(TX_QTY_NV);
+      begin
+        if not ValidQuantity(Responses.IValueFor('QTY', 1)) then
+          SetError(TX_QTY_NV);
+      (*  else
+          begin
+            Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
+            if Quantity <> '' then SetError(Quantity);
+          end; *)
+      end;
     with txtSupply do
     begin
 …
       if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM);
       if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1)  then SetError(TX_SUPPLY_LIM1);
+    end;
+      //Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)));
+      //if Supply <> '' then  SetError(Supply);
+    end;
+    tmpError :=  ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
+    if tmpError <> '' then SetError(tmpError)
+    else ClearMaxData;
   end;
 end;
 …
   lblPriority.Visible := True;
   cboPriority.Visible := True;
-  chkSC.Visible := False;
   chkDoseNow.Visible := True;
   lblAdminTime.Visible := True;
+  lblAdminSch.Visible := True;
+  lblAdminSch.Hint := AdminTimeHelpText;
+  if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except'));
 end;
 procedure TfrmODMeds.SetControlsOutpatient;
-var
-  ExceptItem: TMenuItem;
 begin
   FillerID := 'PSO';
 …
   lblQuantity.Visible := True;
   txtQuantity.Visible := True;
+  //if IsClozapineOrder = True then txtQuantity.Enabled := false;
   spnQuantity.Visible := True;
   lblQtyMsg.Visible := True;
 …
   lblPriority.Visible := True;
   cboPriority.Visible := True;
-  chkSC.Visible := True;
   chkDoseNow.Visible := False;
   lblAdminTime.Visible := False;
+  ExceptItem := TMenuItem.Create(Self);
+  ExceptItem.Caption := 'except';
+  ExceptItem.Tag := 3;
+  ExceptItem.OnClick := popXSequenceClick;
+  popXSequence.Items.Add(ExceptItem);
+  lblAdminSch.Visible := False;
+  if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except');
 end;
 …
   x: string;
 begin
+  if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then             // navigation
+  if txtMed.ReadOnly then    // v27.50 - RV - CQ #15365
+  begin
+    if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then           // navigation
+    begin
+      Key := 0;
+      Exit;
+    end;
+  end
+  else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then             // navigation
   begin
     FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
 …
   Shift: TShiftState);
 begin
+  if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
+end;
+  if txtMed.ReadOnly then exit;    // v27.50 - RV - CQ #15365
+  if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer;
+end;
 procedure TfrmODMeds.txtMedChange(Sender: TObject);
 …
   UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
   QuickIndex := FindQuickOrder(UserText);            // look in quick list first
   AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
+  AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
   if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
   if AllIndex > -1 then
 …
 begin
   StopKeyTimer;
+  if txtMed.ReadOnly then exit;        // v27.50 - RV - CQ #15365
   if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
 end;
 …
 { lstAll Methods (lstAll is TListView) }
+procedure TfrmODMeds.Loaded;
+begin
+  inherited;
+  if ScreenReaderSystemActive then
+    tabDose.TabStop := TRUE;
+end;
+// Cache is a list of 100 string lists, starting at idx 0
 procedure TfrmODMeds.LoadMedCache(First, Last: Integer);
+const
+  MAX_CACHE_ITEMS = 1000;
+begin
+  // if range is within cache range we don't need to update anything
+  if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
+  // if range is outside of cache or a superset of cache, start over
+  if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
+     ((First < FAllFirst) and (Last > FAllLast)) or
+     (FAllItems.Count > MAX_CACHE_ITEMS) then
+  begin
+    FAllItems.Clear;
+    FAllFirst := -1;
+    FAllLast  := -1;
+  end;
+  // if getting items immediately before cache range
+  if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
+  // if getting items immediately after cache range
+  if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
+  // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
+  SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
+  // reset FAllFirst & FAllLast indexes to reflect current FAllItems
+  if FAllFirst < 0     then FAllFirst := First;
+  if FAllLast  < 0     then FAllLast  := Last;
+  if First < FAllFirst then FAllFirst := First;
+  if Last > FAllLast   then FAllLast := Last;
+var
+  firstChunk, lastchunk, i: integer;
+  list: TStringList;
+  firstMed, LastMed: integer;
+begin
+  firstChunk := GetCacheChunkIndex(First);
+  lastChunk := GetCacheChunkIndex(Last);
+  for i := firstChunk to lastChunk do
+  begin
+    if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then
+    begin
+      while FMedCache.Count <= i do
+        FMedCache.add(nil);
+      list := TStringList.Create;
+      FMedCache[i] := list;
+      firstMed := i * MED_CACHE_CHUNK_SIZE;
+      LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
+      if LastMed >= lstAll.Items.Count then
+        LastMed := lstAll.Items.Count - 1;
+      SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
+    end;
+  end;
 end;
 …
 var
   x: string;
+begin
+  if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
+    then LoadMedCache(Item.Index, Item.Index);
+  x := FAllItems[Item.Index - FAllFirst];
+  chunk: integer;
+  list: TStringList;
+begin
+  LoadMedCache(Item.Index, Item.Index);
+  chunk := GetCacheChunkIndex(Item.Index);
+  list := TStringList(FMedCache[chunk]);
+  x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
   Item.Caption := Piece(x, U, 2);
   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
 …
 var
   MedIEN: Integer;
   MedName: string;
+  //MedName: string;
   QOQuantityStr: string;
   ErrMsg: string;
+  ErrMsg, Temp: string;
 begin
   inherited;
   QOQuantityStr := '';
   btnSelect.SetFocus;                             // let the exit events finish
+  self.MedName := '';
   if pnlMeds.Visible then                         // display the medication fields
   begin
 …
       Responses.QuickOrder := Integer(lstQuick.Selected.Data);
       txtMed.Tag  := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
+      if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit;
+      if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit;
       IsActivateOI(ErrMsg, txtMed.Tag);
       if Length(ErrMsg)>0 then
 …
         //btnSelect.Visible := False;
         btnSelect.Enabled := False;
         ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
 …
         Exit;
       end;
+   (*   temp := self.MedName;
+      tempIEN := txtMed.Tag;
+      QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder));
+      if QOIEN > 0 then
+        begin
+          CheckFormularyOI(tempIEN, temp, FInptDlg);
+          if tempIEN <> txtMed.Tag then
+            begin
+              txtMed.Tag := tempIEN;
+              txtMed.Text := temp;
+            end;
+        end; *)
+      FAltChecked := True;
+      ;
       SetOnMedSelect;   // set up for this medication
       SetOnQuickOrder;  // insert quick order responses
 …
          QOQuantityStr := txtQuantity.Text;
       ShowMedFields;
+      if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
       if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
         txtQuantity.Text := QOQuantityStr;
 …
     begin
       MedIEN := Integer(lstAll.Selected.Data);
+      MedName := lstAll.Selected.Caption;
+      self.MedName := lstAll.Selected.Caption;
+      if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit;
+      if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit;
       txtMed.Tag := MedIEN;
       ErrMsg := '';
 …
         //btnSelect.Visible := False;
         btnSelect.Enabled := False;
         ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
 …
         Exit;
       end;
+      if Pos(' NF', MedName) > 0 then
+      begin
+        CheckFormularyOI(MedIEN, MedName, FInptDlg);
+      if Pos(' NF', self.MedName) > 0 then
+      begin
+        temp := self.MedName;
+        CheckFormularyOI(MedIEN, temp, FInptDlg);
         FAltChecked := True;
       end;
 …
       begin
         txtMed.Tag := MedIEN;
+        txtMed.Text := MedName;
+        temp := self.MedName;
+        self.MedName := txtMed.Text;
+        txtMed.Text := Temp;
       end;
       SetOnMedSelect;
 …
   cboSchedule.ItemIndex := -1;
   cboSchedule.Text := '';  // leave items intact
+  if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText('');
   txtSupply.Text := '';
   txtSupply.Tag := 0;
 …
 var
   i,j: Integer;
   x: string;
+  temp,x: string;
   QOPiUnChk: boolean;
   PKIEnviron: boolean;
+  AResponse: TResponse;
 begin
   // clear controls?
 …
   txtQuantity.Tag := 0;
   spnQuantity.Tag := 0;
+  chkSC.Tag := 0;
+  QOPiUnChk := False;
+   QOPiUnChk := False;
   PKIEnviron := False;
   if GetPKISite then PKIEnviron := True;
 …
     // set up lists & initial values based on orderable item
     SetControl(txtMed,       'Medication');
+    if (self.MedName <> '') then
+       begin
+         if (txtMed.Text <> self.MedName) then
+           begin
+             temp := self.MedName;
+             self.MedName := txtMed.Text;
+             txtMed.Text := temp;
+           end
+         else MedName := '';
+       end;
     SetControl(cboDosage,    'Dosage');
     SetControl(cboRoute,     'Route');
 …
     cboRouteChange(Self);
     x := DefaultText('Schedule');
+    if x <> '' then
+    //AGP Change 27.72 trying to centralized the schedule setting code
+    AResponse := Responses.FindResponseByName('SCHEDULE',1);
+    if (AResponse <> nil) and (AResponse.EValue <> '') then  x := AResponse.EValue;
+    SetSchedule(x);
+   (* if x <> '' then
     begin
       cboSchedule.SelectByID(x);
+      if cboSchedule.ItemIndex > -1 then
+        AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4);
+      if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN')  then
+        begin
+          self.chkPRN.Checked := true;
+          x := Copy(x,1,(Length(x)-3));
+          if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1))
+        end;
       cboSchedule.Text := x;
     end;
+    end; *)
     if Length(ValueOf(FLD_QTYDISP))>10 then
     begin
 …
       lblPriority.Top := memcomment.Top + memComment.Height + 1;
       cboPriority.Top := lblPriority.Top + lblPriority.Height;
+      lblAdminTime.Left := chkDoseNow.Left;
+      lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
+      lblAdminSch.Left := chkDoseNow.Left;
+      lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
+      lblAdminSch.Height := (MainFontHeight * 3) + 3;
+      lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5;
+      lblAdminTime.Left := lblAdminSch.Left;
+      lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1;
+      if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('')
+      else
+        begin
+          if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText)
+          else self.lblAdminSch.Visible := False;
+        end;
     end else
     begin
 …
       end;
       //if Length(FPtInstruct) = 0 then
       FPtInstruct := TextOf('PtInstr');
+      if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr');
       for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
       FPtInstruct := TrimRight(FPtInstruct);
 …
         if FIsQuickOrder then TempSch := cboSchedule.Text;
         SetSchedule(IValueFor('SCHEDULE', i));
         if (cboSchedule.Text = '') and FIsQuickOrder then
+        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
         begin
           cboSchedule.SelectByID(TempSch);
           cboSchedule.Text := TempSch;
         end;
+        if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
         x := cboSchedule.Text;
         if chkPRN.Checked then x := x + ' PRN';
 …
         if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
         grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
+        if FInptDlg then
+          begin
+            if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
+            else if cboSchedule.ItemIndex > -1 then
+               grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
+            else grdDoses.Cells[COL_ADMINTIME, i] := '';
+            if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
+            if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
+          end;
         if      IValueFor('CONJ', i) = 'A' then x := 'AND'
         else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
 …
       SetControl(cboRoute,  'ROUTE',     1);
       SetSchedule(IValueFor('SCHEDULE',  1));
       if (cboSchedule.Text = '') and FIsQuickOrder then
+      if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
       begin
         cboSchedule.SelectByID(TempSch);
         cboSchedule.Text := TempSch;
       end;
+      if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
       if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder)  then
          FNSSOther := True;
 …
       AResponse := Responses.FindResponseByName('PICKUP', 1);
       if AResponse <> nil then SetPickup(AResponse.IValue);
       if FIsQuickOrder then
+      if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then
       begin
         if not QOHasRouteDefined(Responses.QuickOrder) then
 …
       end;
       if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup);
       AResponse := Responses.FindResponseByName('SC',     1);
       if AResponse <> nil then chkSC.Checked := AResponse.IValue = '1';
+//      AResponse := Responses.FindResponseByName('SC',     1);
+      Responses.FindResponseByName('SC',     1);
     end; {if FInptDlg..else}
   end; {with}
   if FInptDlg then
+ if FInptDlg then
   begin
     x := ValueOfResponse(FLD_SCHEDULE, 1);
 …
   lblSchedule.Visible := True;
   cboSchedule.Visible := True;
+  if FInptDlg = True then lblAdminSch.Visible := True
+  else lblAdminSch.Visible := false;
   chkPRN.Visible := True;
   ActiveControl := cboDosage;
 …
     begin
       DestCombo.Items.Clear;
       DestCombo.Items.Assign(SrcCombo.Items);
+      FastAssign(SrcCombo.Items, DestCombo.Items);
       DestCombo.ItemIndex := SrcCombo.ItemIndex;
       DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
 …
         else cnt := cnt+1;
       end;
+    if (index = -1) and (Text <> '') then
+       begin
+         for I := 0 to DestCombo.Items.Count - 1 do
+         if Piece(DestCombo.Items.Strings[i],U,1) = Text then
+            begin
+               DestCombo.ItemIndex := i;
+               DestCombo.Text := Text;
+               Exit;
+            end;
+       end;
     end;
   end;
 …
 procedure TfrmODMeds.SetSchedule(const x: string);
 var
+NonPRNPart: string;
+begin
+  cboSchedule.ItemIndex := -1;
+  //AGP change CQ 10593, remove code to match the new expected first dose code
+  //PSI-05-026
+ (* if Pos('PRN', x) > 0 then
+  begin
+    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
+    cboSchedule.SelectByID(NonPRNPart);
+    if cboSchedule.ItemIndex < 0 then
+    begin
+      if NSSchedule then
+      begin
+        chkPRN.Checked := False;
+        cboSchedule.Text := '';
+      end else
+      begin
+        chkPRN.Checked := True;
+        cboSchedule.Items.Add(NonPRNPart);
+        cboSchedule.Text := NonPRNPart;
+NonPRNPart,tempSch, tempText: string;
+begin
+    //AGP Change 27.72 if schedule matches why goes through and reprocess the same info?
+    if cboSchedule.ItemIndex > -1 then
+      begin
+        tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1);
+        if tempText = x then exit;
+        if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then
+          begin
+             NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
+             if nonPRNPart = tempText then exit;
+          end;
       end;
+    end else
+      chkPRN.Checked := True;
+  end else
+  begin  *)
+    chkPRN.Checked := False;
+    cboSchedule.ItemIndex := -1;
+    if chkPRN.Checked = True then chkPRN.Checked := False;
     cboSchedule.SelectByID(x);
+    if cboSchedule.ItemIndex < 0 then
+    begin
+      if NSSchedule then
+      begin
+        cboSchedule.Text := '';
+    if cboSchedule.ItemIndex > -1 then exit;
+   // if cboSchedule.ItemIndex < 0 then
+    //begin
+      //if NSSchedule then
+      //begin
+      //  cboSchedule.Text := '';
+      //end
+      if FInptDlg then
+        begin
+          if (Pos('@', x) > 0) then
+            begin
+            tempSch := Piece(x, '@', 2);
+            cboSchedule.SelectByID(tempSch);
+            if cboSchedule.ItemIndex > -1 then
+              begin
+                tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
+                cboSchedule.Items.Add(tempSch);
+                cboSchedule.Text := (Piece(tempSch,U,1));
+                cboSchedule.SelectByID(Piece(tempSch,u,1));
+                EXIT;
+              end;
+            if Pos('PRN', tempSch) > 0 then
+              begin
+                NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
+                cboSchedule.SelectByID(NonPRNPart);
+                if cboSchedule.ItemIndex > -1 then
+                  begin
+                    tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
+                    cboSchedule.Items.Add(tempSch);
+                    cboSchedule.Text := (Piece(tempSch,U,1));
+                    cboSchedule.SelectByID(Piece(tempSch,u,1));
+                    chkPRN.Checked := True;
+                    EXIT;
+                  end
+                else
+                  begin
+                    NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
+                    chkPRN.Checked := true;
+                    tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2);
+                    cboSchedule.Items.Add(tempSch);
+                    cboSchedule.SelectByID(Piece(tempSch, U, 1));
+                    EXIT;
+                  end;
+              end;
+              cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2));
+              cboSchedule.Text := x;
+              cboSchedule.SelectByID(x);
+              EXIT;
+            end
+        else if Pos('PRN', x) > 0 then
+          begin
+            NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
+            chkPRN.Checked := True;
+            cboSchedule.SelectByID(NonPRNPart);
+            if cboSchedule.ItemIndex > -1 then  EXIT;
+          end;
       end
+      else
+      begin
+      if Pos('PRN', x) > 0 then
+      else if Pos('PRN', x) > 0 then
         begin
          NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
 …
          EXIT;
         end;
+         cboSchedule.Items.Add(x);
+         cboSchedule.Text := x;
+         cboSchedule.SelectByID(x);
+      end;
+  end;
+      cboSchedule.Items.Add(x);
+      cboSchedule.Text := x;
+      cboSchedule.SelectByID(x);
 end;
 …
 var
   //text,x, tmpsch: string;
   text, x: string;
+  text, tmpAdmin, x: string;
   reset: integer;
 begin
 …
   TI_DOSE:    begin
                 cboXSchedule.Clear;                       // Added to Fix CQ: 9603
+                cboXDosage.Clear;
                 // clean up responses?
                 FSuppressMsg := FOrigiMsgDisp;
 …
                 FSuppressMsg := FOrigiMsgDisp;
                 if reset = 1 then exit;
+               (*  AGP Change admin wrap 27.73
+                tmpAdmin := Piece(self.lblAdminSch.text, ':', 2);
+                tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *)
+                tmpAdmin := lblAdminSchGetText;
+                if FAdminTimeText <> '' then
+                  begin
+                    tmpAdmin := FAdminTimeText;
+                    if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False;
+                  end;
                 ShowControlsComplex;
                 ResetOnTabChange;
 …
                 txtNss.Visible := False;
                 x := cboXDosage.Text + TAB;
+                if LeftStr(x,1) = '.' then x := '';
                 with cboXDosage   do if ItemIndex > -1 then x := x + Items[ItemIndex];
                 grdDoses.Cells[COL_DOSAGE,   1] := x;
 …
                 with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
                 grdDoses.Cells[COL_SCHEDULE, 1] := x;
+                UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
+                //AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected.
+                if FSmplPRNChkd then
+                  begin
+                    pnlXSchedule.Tag := 1;
+                    self.chkXPRN.Checked := True;
+                  end;
+                if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
                 ControlChange(Self);
              end; {TI_COMPLEX}
   end; {case}
+end;
+  if ScreenReaderSystemActive then
+    GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab');
+end;
+function TfrmODMeds.lblAdminSchGetText: string;
+var
+tempstr: string;
+i: integer;
+begin
+  result := '';
+  if self.lblAdminSch.Text = '' then exit;
+  tempstr := '';
+  if self.lblAdminSch.Lines.Count > 1 then
+    begin
+      for i := 0 to self.lblAdminSch.Lines.Count - 1 do
+        tempstr := tempStr + self.lblAdminSch.Lines.Strings[i];
+    end
+  else if self.lblAdminSch.Lines.Count = 1 then
+       begin
+         tempstr := self.lblAdminSch.Text;
+       end;
+  Result := Piece(tempStr,':',2);
+  Result := Copy(Result,2,Length(Result));
+end;
+procedure TfrmODMeds.lblAdminSchSetText(str: string);
+var
+cutoff: integer;
+begin
+  cutoff := lblAdminSch.width div MainFontWidth;
+  if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF +
+                                              Copy(str, cutoff + 1, Length(str))
+  else self.lblAdminSch.Text := str;
+end;
 procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
 …
 procedure TfrmODMeds.cboDosageChange(Sender: TObject);
+begin
+  inherited;
+var
+temp1,temp2: string;
+Count: integer;
+begin
+  inherited;
+  Count := Pos(U,cboDosage.Text);
+  if Count > 0 then
+    begin
+      temp1 := copy(cboDosage.Text,0,count-1);
+      temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text));
+      infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
+      cboDosage.Text := temp1 + temp2;
+    end;
   UpdateRelated;
 end;
 procedure TfrmODMeds.cboDosageExit(Sender: TObject);
+begin
+  inherited;
+var
+str: string;
+begin
+  inherited;
+  str := cboDosage.Text;
   if (length(cboDosage.Text)<1) then
+    cboDosage.ItemIndex := -1;
+      cboDosage.ItemIndex := -1;
+ (* Probably not needed here since this on validation check on accept
+  if (LeftStr(cboDosage.Text,1)='.') then
+       begin
+         infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
+         if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus;
+         Exit;
+       end; *)
+  if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and
+    (Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5) <> Piece(cboDosage.Text,tab,1)) then
+    begin
+      cboDosage.ItemIndex := -1;
+      cboDosage.Text := Piece(str, tab, 1);
+      UpdateRelated(false);
+    end;
   if ActiveControl = memMessage then
   begin
 …
     if length(trim(othSch)) > 1 then
     begin
+      othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
+      cboSchedule.Items.Add(othSch);
+      idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
+      cboSchedule.ItemIndex := idx;
+    end;
+  end
+  else
+    begin
+      NSSAdminTime := '';
+      FNSSScheduleType := '';
+    end;
+  UpdateRelated(False);
+end;
+procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
+var
+  othSch: string;
+  idx : integer;
+begin
+  inherited;
+  if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
+  begin
+    othSch := CreateOtherScheduel;
+    if length(trim(othSch)) > 1 then
+    begin
       cboSchedule.Items.Add(othSch);
       idx := cboSchedule.Items.IndexOf(OthSch);
 …
     end;
   end;
-  UpdateRelated(False);
-end;
-procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
-var
-  othSch: string;
-  idx : integer;
-begin
-  inherited;
-  if  (FInptDlg) and (cboSchedule.Text = 'OTHER') then
-  begin
-    othSch := CreateOtherScheduel;
-    if length(trim(othSch)) > 1 then
-    begin
-      cboSchedule.Items.Add(othSch);
-      idx := cboSchedule.Items.IndexOf(OthSch);
-      cboSchedule.ItemIndex := idx;
-    end;
-  end;
-//Remove Deletion of Text, since we are changing the validation to be on exit of the control.
-{  if (Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0) and FInptDlg then
-    cboSchedule.Text := '';}
   FScheduleChanged := true;
   UpdateRelated;
 …
   inherited;
   if Changing then Exit;
+  if not Showing then Exit;
+  if not Showing then
+    begin
+       if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then
+         begin
+           Changing := True;
+           txtQuantity.Text := FloattoStr(FLastQuantity);
+           Changing := False;
+         end;
+       Exit;
+    end;
   if FNoZERO = False then FNoZERO := True;
   // if value = 0, change probably caused by the spin button
   if txtQuantity.Text <> '0' then txtQuantity.Tag := 1;
   UpdateRelated;
-end;
-procedure TfrmODMeds.chkSCEnter(Sender: TObject);
-begin
-  inherited;
-  pnlMessage.TabOrder := chkSC.TabOrder+1;
-  DispOrderMessage(RatedDisabilities);
-end;
-procedure TfrmODMeds.chkSCClick(Sender: TObject);
-begin
-  inherited;
-  chkSC.Tag := 1;
 end;
 …
 end;
 function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
 var
 …
 begin
   Result := '';
   if FInptDlg then                                // inpatient dialog
+ if FInptDlg then                                // inpatient dialog
   begin
     DrugOK := True;
 …
             end
             else DoseUnits := Piece(DoseFields, '&', 2);
             if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
+            if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False;
           end;
           if not DrugOK then
 …
   FUpdated := FALSE;
   Responses.Clear;
+  Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
+  if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
+  else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
   DoseList := TStringList.Create;
   case tabDose.TabIndex of
 …
                                 else Responses.Update('ROUTE',    1, '', x);
       x := ValueOf(FLD_SCHEDULE);    Responses.Update('SCHEDULE', 1, x,  x);
+      if FInptDlg then
+        begin
+        (* AGP Change Admin Time Wrap 27.73
+          x := Piece(self.lblAdminSch.text,':',2);
+          x := Copy(x,2,Length(x));  *)
+          x := lblAdminSchGetText;
+          if FAdminTimeText <> '' then x := '';
+          if x = 'Not Defined' then x := '';
+          Responses.Update('ADMIN',1,x,x);
+          X := Valueof(FLD_SCHED_TYP);
+          if self.chkPRN.Checked = true then x := 'P';
+          Responses.Update('SCHTYPE',1,x,x);
+        end;
     end;
   TI_COMPLEX:
 …
         end;
         x := ValueOf(FLD_DURATION, i);  Responses.Update('DAYS',     i, UpperCase(x), x);
+        if FInptDlg then
+          begin
+            x := ValFor(VAL_ADMINTIME,i);
+            if FAdminTimeText <> '' then x := '';
+            if x = 'Not Defined' then x := '';
+            Responses.Update('ADMIN',i,x,x);
+            x := Valueof(FLD_SCHED_TYP, i);
+            if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P';
+            Responses.Update('SCHTYPE', i, x, x);
+          end;
         x := ValueOf(FLD_SEQUENCE, i);
         if      Uppercase(x) = 'THEN'   then x := 'T'
 …
   with grdDoses do
     case FieldID of
+    COL_DOSAGE   : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 1);
+    COL_ROUTE    : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 1);
+    COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+    COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
+    COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
+    VAL_DOSAGE   : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 2);
+    VAL_ROUTE    : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 2);
+    VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+    VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
+    VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
+    VAL_CHKXPRN  : Result := Cells[COL_CHKXPRN, ARow];
+    COL_DOSAGE    : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 1);
+    COL_ROUTE     : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 1);
+    COL_SCHEDULE  : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+    COL_DURATION  : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
+    COL_SEQUENCE  : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
+    VAL_DOSAGE    : Result := Piece(Cells[COL_DOSAGE,   ARow], TAB, 2);
+    VAL_ROUTE     : Result := Piece(Cells[COL_ROUTE,    ARow], TAB, 2);
+    VAL_SCHEDULE  : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+    VAL_DURATION  : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
+    VAL_ADMINTIME : Result := Piece(Cells[COL_ADMINTIME, ARow], TAB, 1);
+    VAL_SEQUENCE  : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
+    VAL_CHKXPRN   : Result := Cells[COL_CHKXPRN, ARow];
     end;
 end;
 …
 function TfrmODMeds.DurationToDays: Integer;
 var
   i, DoseMinutes, TotalMinutes: Integer;
+  i, DoseMinutes, AndMinutes, TotalMinutes: Integer;
   AllRows: Boolean;
   Days: Extended;
 …
   if not AllRows then Exit;
+  AndMinutes := 0;
   TotalMinutes := 0;
   with grdDoses do for i := 1 to Pred(RowCount) do
 …
       if Piece(x, ' ', 2) = 'HOURS'   then DoseMinutes := ExtractInteger(x) * 60;
       if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
+      TotalMinutes := TotalMinutes + DoseMinutes;
+    end;
+      // Determine how TotalMinutes should be calculated based on conjunction
+      if ValFor(COL_SEQUENCE, i) <> 'AND' then  // 'THEN', 'EXCEPT', or ''
+      begin
+        if AndMinutes = 0 then TotalMinutes := TotalMinutes + DoseMinutes;
+        if AndMinutes > 0 then
+        begin
+          if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
+          TotalMinutes := TotalMinutes + AndMinutes;
+          AndMinutes := 0;
+        end;
+        if ValFor(COL_SEQUENCE, i) = 'EXCEPT' then break;  //quit out of For Loop to stop counting TotalMinutes
+      end;
+      if (ValFor(COL_SEQUENCE, i) = 'AND') then
+        if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
+    end;
+  if AndMinutes > 0 then TotalMinutes := TotalMinutes + AndMinutes;
   Days := TotalMinutes / 1440;
   if Days > Int(Days) then Days := Days + 1;
 …
   REL_DURATION = 0.16;
   REL_ANDTHEN  = 0.10;
+  REL_ADMINTIME = 0.16;
 var
   i, ht, RowCountShowing: Integer;
 …
     i := grdDoses.Width - 12;                 // 12 = 4 pixel margin + 8 pixel column 0
     i := i - GetSystemMetrics(SM_CXVSCROLL);  // compensate for appearance of scroll bar
+    ColWidths[1] := Round(REL_DOSAGE   * i);  // dosage
+    ColWidths[2] := Round(REL_ROUTE    * i);  // route
+    ColWidths[3] := Round(REL_SCHEDULE * i);  // schedule
+    ColWidths[4] := Round(REL_DURATION * i);  // duration
+    ColWidths[5] := Round(REL_ANDTHEN  * i);  // and/then
+    if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
+      begin
+        ColWidths[1] := Round(REL_DOSAGE   * i);  // dosage
+        ColWidths[2] := Round(REL_ROUTE    * i);  // route
+        ColWidths[3] := Round(REL_SCHEDULE * i);  // schedule
+        ColWidths[4] := Round(REL_DURATION * i);  // duration
+        ColWidths[5] := Round(0  * i);  // administration time
+        grdDoses.TabStops[5] := False;
+        ColWidths[6] := Round(REL_ANDTHEN  * i);  // and/then
+      end
+    else
+      begin
+        ColWidths[1] := Round(0.35    * i);  // dosage
+        ColWidths[2] := Round(0.10     * i);  // route
+        ColWidths[3] := Round(0.19  * i);  // schedule
+        ColWidths[4] := Round(0.12  * i);  // duration
+        ColWidths[5] := Round(0.16 * i);  // administration time
+        grdDoses.TabStops[5] := True;
+        ColWidths[6] := Round(0.08   * i);  // and/then
+      end;
     // adjust height of grid to not show partial rows
     ht := pnlBottom.Top - Top - 6;
 …
       COL_SCHEDULE:ColControl := pnlXSchedule;
       COL_DURATION:ColControl := pnlXDuration;
+      COL_SEQUENCE:ColControl := pnlXSequence;
+      COL_ADMINTIME:ColControl := pnlXAdminTime;
+      COL_SEQUENCE:ColControl := cboXSequence;
     end; {case}
 …
   COL_ROUTE:    with cboXRoute    do if Items.Count > 0 then DroppedDown := True;
   COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True;
+  COL_SEQUENCE: with cboXSequence do if Items.Count > 0 then DroppedDown := True;
   end;
   FDropColumn := -1;
 …
                   end; *)
                   Changing := FALSE;
                   pnlXSequence.Tag := ARow;
+                  cboXSequence.Tag := ARow;
                   PlaceControl(pnlXSchedule);
-                  //cboXSchedule.SetFocus;
                   FDropColumn := COL_SCHEDULE;
                   if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE);
 …
                 end;
   COL_SEQUENCE: begin
+                  x := ValFor(COL_SEQUENCE, ARow);
+                  //if x = '' then x := 'and';  AGP Change 26.46 remove for CQ 9535
+                  btnXSequence.Caption := x;
+                  pnlXSequence.Caption := btnXSequence.Caption;
+                  pnlXSequence.Tag := ARow;
+                  SynchCombo(cboXSequence, ValFor(VAL_SEQUENCE, ARow), ValFor(COL_SEQUENCE, ARow));
+                  cboXSequence.Tag := ARow;
                   ARow1 := ARow;
+                  PlaceControl(pnlXSequence);
+                  btnXSequence.Width := pnlXSequence.Width;
+                  PlaceControl(cboXSequence);
+                  FDropColumn := COL_SEQUENCE;
+                  if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SEQUENCE);
                 end;
+  COL_ADMINTIME: BEGIN
+                 pnlXAdminTime.OnClick(pnlXAdminTime);
+                 end;
   end; {case ACol}
 end;
 …
                    txtXDuration.SelStart := 1;
                  end;
+  COL_SEQUENCE : FindInCombo(Chr(Message.WParam), cboXSequence);
   end;
 end;
 …
 procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
+var
+temp1,temp2: string;
+count: integer;
 begin
   inherited;
   if not Changing and (cboXDosage.ItemIndex < 0) then
   begin
+    Count := Pos(U,cboXDosage.Text);
+    if Count > 0 then
+      begin
+        temp1 := copy(cboXDosage.Text,0,count-1);
+        temp2 := copy(cboXDosage.Text,count+1,Length(cboXDosage.text));
+        infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
+        cboXDosage.Text := temp1 + temp2;
+      end;
     grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
     UpdateRelated;
 …
 procedure TfrmODMeds.cboXDosageExit(Sender: TObject);
+begin
+  inherited;
+  cboXDosageClick(Self);
+  cboXDosage.Tag := -1;
+  cboXDosage.Hide;
+  UpdateRelated;
+  RestoreDefaultButton;
+  RestoreCancelButton;
+  if (pnlMessage.Visible) and (memMessage.TabStop)  then
+  begin
+    pnlMessage.Parent := grdDoses.Parent;
+    pnlMessage.TabOrder := grdDoses.TabOrder;
+    ActiveControl := memMessage;
+  end
+  else if grdDoses.Showing then
+    ActiveControl := grdDoses
+  else
+    ActiveControl := cboDosage;
+end;
+var
+//tempTag: integer;
+str: string;
+begin
+  inherited;
+  if cboXDosage.Showing then
+  begin
+    cboXDosageClick(Self);
+    str := cboXDosage.Text;
+    //tempTag := cboXDosage.Tag;
+    //cboXDosage.Tag := -1;
+    cboXDosage.Hide;
+    UpdateRelated;
+    RestoreDefaultButton;
+    RestoreCancelButton;
+   (*Probably not needed here since on validation check on accept
+    if (LeftStr(cboXDosage.Text,1)='.') and (self.tabDose.TabIndex = TI_COMPLEX) then
+         begin
+           infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
+           //cboXDosage.Tag := tempTag;
+           cboXDosage.Show;
+           cboXDosage.SetFocus;
+           Exit;
+         end;  *)
+    if (length(cboxdosage.Text)>0) and (cboxDosage.ItemIndex > -1) and
+      (Piece(cboxDosage.Items.Strings[cboxDosage.ItemIndex],U,5) <> Piece(cboxDosage.Text,'#',1)) then
+      begin
+        cboXDosage.ItemIndex := -1;
+        cboXDosage.Text := Piece(str, '#', 1);
+        self.grdDoses.Cells[COL_DOSAGE,self.grdDoses.row] := cboXDosage.Text;
+        UpdateRelated(false);
+      end;
+    if (pnlMessage.Visible) and (memMessage.TabStop)  then
+    begin
+      pnlMessage.Parent := grdDoses.Parent;
+      pnlMessage.TabOrder := grdDoses.TabOrder;
+      ActiveControl := memMessage;
+    end
+    else if grdDoses.Showing then
+      ActiveControl := grdDoses
+    else
+      ActiveControl := cboDosage;
+    end
+    else
+       cmdQuit.Click;
+  end;
 procedure TfrmODMeds.cboXRouteChange(Sender: TObject);
 …
     if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then
     begin
+      cboXSchedule.SelectByID('OTHER');
       othSch := CreateOtherScheduelComplex;
       if length(trim(othSch)) > 1 then
       begin
+        othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
         cboXSchedule.Items.Add(othSch);
         idx := cboXSchedule.Items.IndexOf(OthSch);
+        idx := cboXSchedule.Items.IndexOf(Piece(OthSch, U, 1));
         cboXSchedule.ItemIndex := idx;
       end;
     end;
+  (* if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
+    with cboXSchedule do if ItemIndex > -1
+      then x := Text + PRN + TAB + Items[ItemIndex]
+      else x := Text + PRN; *)
+  if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
+    //if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
     with cboXSchedule do if ItemIndex > -1
       then x := Text + TAB + Items[ItemIndex]
 …
     grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
     self.cboSchedule.Text := x;
+     //AGP Start Expired uncommented out the line
+    if FInptDlg then UpdateStartExpires(Piece(x, tab, 1));
     UpdateRelated;
   end;
 …
 procedure TfrmODMeds.cboXScheduleClick(Sender: TObject);
 var
+  x: string;
+begin
+  inherited;
+  //if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
+  PRN,x: string;
+begin
+  inherited;
+  //agp change CQ 11015
+  if (chkXPRN.Checked) then PRN := ' PRN' else PRN := '';
+  with cboXSchedule do
+    begin
+      if RightStr(Text,3) = 'PRN' then PRN := '';
+      if ItemIndex > -1 then x := Text + PRN + TAB + Items[ItemIndex]
+      else x := Text + PRN;
+    end;
  (* with cboXSchedule do if ItemIndex > -1
-    then x := Text + PRN + TAB + Items[ItemIndex]
-    else x := Text + PRN;  *)
-  with cboXSchedule do if ItemIndex > -1
     then x := Text + TAB + Items[ItemIndex]
+    else x := Text;
+   (* if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then
+    if lblAdmintime.visible then
+      lblAdmintime.Caption := ''; *)
+    else x := Text;  *)
   grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
+  UpdateStartExpires(x);
+  //AGP Start Expired uncommented out the line
+  UpdateStartExpires(Piece(x, tab, 1));
   UpdateRelated;
 end;
 …
   else
     ActiveControl := cboDosage;
+  //AGP Start Expired commented out the line
+  //updateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
+end;
+procedure TfrmODMeds.pnlXAdminTimeClick(Sender: TObject);
+var
+Str: string;
+begin
+  inherited;
+  if not FInptDlg then Exit;
+  str := 'The Administration Times for this dose are: ' + CRLF + CRLF + VALFOR(VAL_ADMINTIME,grddoses.Row);
+  str := str + CRLF + CRLF + AdminTimeHelpText;
+  infoBox(str,'Administration Time Information',MB_OK);
 end;
 …
     if (Code <> 0) {and (I=0)} then
     begin
       ShowMessage('Please use numeric characters only.');
+      ShowMsg('Please use numeric characters only.');
       with txtXDuration do
       begin
 …
                     begin
                         grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
                         pnlXSequence.Tag := ARow1;
                         pnlXSequence.Caption := '';
                         grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := '';
                         btnXSequence.Click;
+                        cboXSequence.Tag := ARow1;
+                        grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := '';
+                        cboXSequence.Text := '';
+                        cboXSequence.ItemIndex := -1;
                     end
                     else
 …
 end;
-procedure TfrmODMeds.btnXSequenceClick(Sender: TObject);
-var
-  APoint: TPoint;
-begin
-  inherited;
-  inherited;
-  with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
-  popXSequence.Popup(APoint.X, APoint.Y);
-  pnlXSequence.Caption := btnXSequence.Caption;
+  {
-  with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
-  popXSequence.Popup(APoint.X, APoint.Y);
-  pnlXSequence.Caption := btnXSequence.Caption;
-  if (pnlXSequence.Caption = 'then') and
-      ((ValFor(COL_DURATION, ARow1) = '') or
-       (ValFor(COL_DURATION, ARow1) = '0')) then
-     begin
-       InfoBox('A duration is required when using "Then" as a conjunction','Duration Warning',MB_OK);
-       pnlXSequence.Caption := '';
-       btnXSequence.Caption := '';
-     end;
+     }
-end;
-procedure TfrmODMeds.popXSequenceClick(Sender: TObject);
-var
-  x: string;
-begin
-  inherited;
-  with TMenuItem(Sender) do if Tag > 0 then x := Caption else x := '';
- //AGP Changes 26.12 PSI-04-63
- //if ((x = 'then') and (FInptDlg)) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
- //AGP change 26.32 Then/And conjunction requiring a duration to include outpatient orders
- if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
-     begin
-       InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
-           'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
-       x := '';
-     end;
-  btnXSequence.Caption := x;
-  pnlXSequence.Caption := btnXSequence.Caption;
-  grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(x);
-  ControlChange(Sender);
-end;
-procedure TfrmODMeds.pnlXSequenceExit(Sender: TObject);
-begin
-  inherited;
-  grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(btnXSequence.Caption);
-  if ActiveControl = grdDoses then
-  begin
-    //This next condition seldom occurs, since entering the dosage on the last
-    // row adds another row
-    if grdDoses.Row = grdDoses.RowCount - 1 then
-      grdDoses.RowCount := grdDoses.RowCount + 1;
-  end;
-  pnlXSequence.Tag := -1;
-  pnlXSequence.Hide;
-  RestoreDefaultButton;
-  RestoreCancelButton;
-  if (pnlMessage.Visible) and (memMessage.TabStop) then
-  begin
-    pnlMessage.Parent := grdDoses.Parent;
-    pnlMessage.TabOrder := grdDoses.TabOrder;
-    ActiveControl := memMessage;
-  end
-  else if grdDoses.Showing then
-    ActiveControl := grdDoses
-  else
-    ActiveControl := cboDosage;
-end;
 procedure TfrmODMeds.btnXInsertClick(Sender: TObject);
 …
     Schedule  <TAB> (nothing)
     Duration  <TAB> Duration^Units }
+  // the following functions were created to get rid of a compile warning saying the
+  // return value may be undefined - too much branching logic in the case statements
+  // for the compiler to handle
+  function GetSingleDoseSchedule: string;
+  begin
+    Result := UpperCase(Trim(cboSchedule.Text));
+    if chkPRN.Checked then Result := Result + ' PRN';
+    if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
+      then Result := Copy(Result, 1, Length(Result) - 4);
+  end;
+  function GetSingleDoseScheduleEX: string;
+  begin
+    Result := '';
+    with cboSchedule do
+    begin
+      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
+(*     if (Length(Result)=0) and (ItemIndex > -1) then
+        begin
+          Result := Piece(Items[ItemIndex], U, 1);
+          if Piece(Items[ItemIndex], U, 3) = 'P' then
+          begin
+            if RightStr(Result,3) = 'PRN' then
+              begin
+                Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+                if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+                Result := Copy(Result,1,Length(Result)-1);
+              end;
+           Result := Result + ' AS NEEDED';
+          end;
+        end;
+    end; *)
+      if RightStr(Result,3) = 'PRN' then
+      begin
+        Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+        if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+          Result := Copy(Result,1,Length(Result)-1);
+        Result := Result + ' AS NEEDED'
+      end;
+      if (Length(Result) > 0) and chkPRN.Checked then
+        Result := Result + ' AS NEEDED';
+      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then
+        Result := Copy(Result, 1, Length(Result) - 10);
+      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
+      begin
+        Result := Copy(Result, 1, Length(Result) - 13);
+        if RightStr(Result,1)=' ' then
+          Result := Result + 'AS NEEDED'
+        else
+          Result := Result + ' AS NEEDED';
+      end;
+    end;
+  end;
+  function GetComplexDoseSchedule: string;
+  begin
+    with grdDoses do
+    begin
+      Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
+      if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+      if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
+      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
+      Result := Copy(Result, 1, Length(Result) - 4);
+    end;
+  end;
+  function GetComplexDoseScheduleEX: string;
+  begin
+    with grdDoses do
+    begin
+      (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
+      if Result = '' then //Added for CQ: 7639
+      begin
+        Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+        if RightStr(Result,4) = ' PRN' then
+          Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
+      end;
+      if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
+         Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
+         (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
+         then Result := Result + ' AS NEEDED';
+    end;*)
+      Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
+      if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
+      if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+      if RightStr(Result,3) = 'PRN' then
+      begin
+        Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+        if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+        Result := Copy(Result,1,Length(Result)-1);
+        Result := Result + ' AS NEEDED';
+      end;
+      if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
+      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+      then Result := Copy(Result, 1, Length(Result) - 10);
+      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
+      begin
+        Result := Copy(Result, 1, Length(Result) - 13);
+        if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
+        else Result := Result + ' AS NEEDED';
+      end;
+    end;
+  end;
 begin
   Result := '';
 …
     FLD_ROUTE_EX  : with cboRoute do
                      if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
+    FLD_SCHEDULE  : begin        //gary)
+                      Result := UpperCase(Trim(cboSchedule.Text));
+                      if chkPRN.Checked then Result := Result + ' PRN';
+                      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
+                        then Result := Copy(Result, 1, Length(Result) - 4);
+    FLD_SCHEDULE  : begin
+                      Result := GetSingleDoseSchedule;
                     end;
     FLD_SCHED_EX  : begin
+                      with cboSchedule do
+                        begin
+                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
+                   (*     if (Length(Result)=0) and (ItemIndex > -1) then
+                            begin
+                              Result := Piece(Items[ItemIndex], U, 1);
+                              if Piece(Items[ItemIndex], U, 3) = 'P' then
+                              begin
+                                if RightStr(Result,3) = 'PRN' then
+                                  begin
+                                    Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+                                    if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+                                    Result := Copy(Result,1,Length(Result)-1);
+                                  end;
+                               Result := Result + ' AS NEEDED';
+                              end;
+                            end;
+                        end; *)
+                      if RightStr(Result,3) = 'PRN' then
+                           begin
+                              Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+                              if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+                              Result := Copy(Result,1,Length(Result)-1);
+                              Result := Result + ' AS NEEDED'
+                           end;
+                      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
+                      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+                        then Result := Copy(Result, 1, Length(Result) - 10);
+                      if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
+                          begin
+                            Result := Copy(Result, 1, Length(Result) - 13);
+                            if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
+                            else Result := Result + ' AS NEEDED';
+                          end;
+                    end;
+                      Result := GetSingleDoseScheduleEX;
                     end;
     FLD_SCHED_TYP : with cboSchedule do
 …
       FLD_ROUTE_EX  : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4);
       FLD_SCHEDULE  : begin
+                         Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
+                         if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+                         if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
+                         if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
+                         Result := Copy(Result, 1, Length(Result) - 4);
+                        Result := GetComplexDoseSchedule;
                       end;
       FLD_SCHED_EX  : begin
+                        (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
+                        if Result = '' then //Added for CQ: 7639
+                        begin
+                          Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+                          if RightStr(Result,4) = ' PRN' then
+                            Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
+                        end;
+                        if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
+                           Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
+                           (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
+                           then Result := Result + ' AS NEEDED';
+                      end;*)
+                        Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
+                        if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
+                        if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
+                        if RightStr(Result,3) = 'PRN' then
+                           begin
+                              Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
+                              if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
+                              Result := Copy(Result,1,Length(Result)-1);
+                              Result := Result + ' AS NEEDED';
+                           end;
+                        if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
+                        if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+                        then Result := Copy(Result, 1, Length(Result) - 10);
+                        if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
+                          begin
+                            Result := Copy(Result, 1, Length(Result) - 13);
+                            if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
+                            else Result := Result + ' AS NEEDED';
+                          end;
+                        Result := GetComplexDoseScheduleEX;
                       end;
       FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3);
 …
     FLD_PRIOR_NM  : Result := cboPriority.Text;
     FLD_COMMENT   : Result := memComment.Text;
+    FLD_SC        : if chkSC.Visible then
+                    begin
+                      if chkSC.Checked then Result := '1' else Result := '0';
+                    end;
     FLD_NOW_ID    : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1'   else Result := '';
     FLD_NOW_NM    : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := '';
 …
 var
   ADrug: string;
+begin
+  Checked: boolean;
+  tmpSupply: integer;
+begin
+  Checked := false;
   if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
      (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
+     or ((cboDosage.ItemIndex < 0) and not FIsQuickOrder ) then
+  begin
+     or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or
+     ((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial))  then
+  begin
+    Checked := True;
     ADrug := Piece(CurDispDrug, U, 1);
     CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
 …
       if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply)  then
         txtSupply.Text := IntToStr(CurSupply);
       if (FIsQuickOrder and FQOInitial) then
+      if (FIsQuickOrder) and (FQOInitial) and (IsClozapineOrder = false) then
       begin
         if StrToFloatDef(txtSupply.Text,0) > 0 then
 …
       SkipQtyCheck := TRUE;
     end;
+  end;
+    if FQOInitial = true then FQOInitial := False;
+  end;
+  if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
+    begin
+      ADrug := Piece(CurDispDrug, U, 1);
+      tmpSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
+      if (tmpSupply > 0) and (CurSupply > tmpSupply) then
+        begin
+          CurSupply := tmpSupply;
+          spnSupply.Position := CurSupply;
+          if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply)  then
+          txtSupply.Text := IntToStr(CurSupply);
+        end;
+      CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
+      if CurQuantity >= 0 then
+      begin
+       //spnQuantity.Position := CurQuantity;
+       if (txtQuantity.Text <> '') and (CurQuantity > 0) then
+        txtQuantity.Text := FloatToStr(CurQuantity);
+       if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) and (CurQuantity > 0)  then
+         txtQuantity.Text := FloatToStr(CurQuantity);
+      end;
+    end;
 end;
 …
 end;
+procedure TfrmODMeds.UpdateSC(const CurDispDrug: string);
+var
+  Dispense: Integer;
+begin
+  Dispense := StrToIntDef(Piece(CurDispDrug, U, 1), 0);  // just use first dispense drug for now
+  if Patient.ServiceConnected and RequiresCopay(Dispense) then
+  begin
+    chkSC.Visible := True;
+    if chkSC.Tag = 0 then chkSC.Checked := Patient.SCPercent > 50;
+    if chkSC.Hint = '' then chkSC.Hint := RatedDisabilities;
+  end
+  else chkSC.Visible := False;
+  FUpdated := True;
+procedure TfrmODMeds.updateSig;
+begin
+  inherited;
+  if self.tabDose.TabIndex = TI_DOSE then self.cboDosage.OnExit(cboDosage);
+  if self.tabDose.TabIndex = TI_COMPLEX then self.cboxDosage.OnExit(cboxDosage);
 end;
 procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string);
 var
   CompSch, ShowText, Duration, ASchedule: string;
+  CompSch, CompDose, LastSch, ShowText, Duration, ASchedule, TempSch, schType, Admin, tempAdmin: string;
   AdminTime:    TFMDateTime;
+  i, j, Interval, PrnPos: Integer;
+begin
+  j, r, Interval, PrnPos, SchID: Integer;
+  EndCheck, rowCheck, DoseNow: boolean;
+begin
+  if not FInptDlg then Exit;
   if Length(CurSchedule)=0 then Exit;
   ASchedule := Trim(CurSchedule);
+  DoseNow := True;
+  if self.EvtID > 0 then DoseNow := false;
   if (Pos('^',ASchedule)>0) then
   begin
 …
       Delete(ASchedule, PrnPos-1, 4);
   end;
+  if (FAdminTimeText = '') and (self.EvtID > 0) then FAdminTimeText := 'To Be Determined';
+  AdminTime := 0;
   ASchedule := Trim(ASchedule);
+  //AGP Change for CQ 9906
+  EndCheck := False;
+  lastSch := '';
   if self.tabDose.TabIndex = TI_COMPLEX then
     begin
+      CompSch := valFor(VAL_SCHEDULE,1);
+      if CompSch = '' then
+        begin
+          ASchedule := '';
+          AdminTime := -1;
+        end;
+      if CompSch <> '' then
+        begin
+          for i := 0 to self.cboXSchedule.Items.Count-1 do
+            begin
+              if (Piece(self.cboXSchedule.Items.Strings[i],U,1) = CompSch) and (Piece(self.cboXSchedule.Items.Strings[i],U,3)='P') then
+    tempSch := ASchedule;
+    ASchedule := '';
+    for r := 1 to self.grdDoses.RowCount-1 do
+      begin
+        CompSch := valFor(VAL_SCHEDULE,r);
+        CompDose := valFor(VAL_DOSAGE,r);
+        RowCheck := valFor(VAL_CHKXPRN,r)='1';
+        if (RowCheck = True) then
+          begin
+            if EndCheck = false then AdminTime := -1;
+            if FAdminTimeText = '' then self.grdDoses.cells[COL_ADMINTIME, r] := ''
+            else Self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText;
+          end
+        else
+          begin
+            if CompSch <> '' then
+               begin
+                 //cboXSchedule.Items.IndexOfName(CompSch);
+                 //cboXSchedule.SelectByID(CompSch);
+                 SchID := -1;
+                 for j := 0 to cboXSchedule.Items.Count - 1 do
+                    begin
+                      if Piece(cboXSchedule.Items.Strings[j], U, 1) = CompSch then
+                        begin
+                          schID := j;
+                          break;
+                        end;
+                    end;
+                 //if cboXSchedule.ItemIndex > -1 then
+                 if SchID > -1 then
+                   begin
+                     //SchID := cboXSchedule.ItemIndex;
+                     if (Piece(self.cboXSchedule.Items.Strings[SchID],U,1) = CompSch) then
+                       begin
+                         SchType := Piece(self.cboXSchedule.Items.Strings[SchID],U,3);
+                         if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') then
+                             self.grdDoses.Cells[COL_ADMINTIME, r] := ''
+                         else if FAdminTimeText <> '' then self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText
+                         else
+                           begin
+                             self.grdDoses.Cells[COL_ADMINTIME, r] := Piece(self.cboXSchedule.Items.Strings[SchID],U,4);
+                             if self.grdDoses.Cells[COL_ADMINTIME, r] = '' then self.grdDoses.Cells[COL_ADMINTIME, r] := 'Not Defined';
+                           end;
+                         if CompDose <> '' then
+                           begin
+                             lastSch := CompSch;
+                             if (EndCheck = False) and ((SchType = 'P') or (SchType = 'O')) then AdminTime := -1
+                             //else Aschedule := ';' + CompSch;
+                           end;
+                       end;
+                   end;
+               end;
+          end;
+        if ((valFor(VAL_SEQUENCE,r) = 'AND') or (valFor(VAL_SEQUENCE,r) = '')) and (AdminTime > -1) and (EndCheck = false) then
+          begin
+            //if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
+            if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
+            if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
+          end
+        else if ValFor(VAL_SEQUENCE, r) = 'THEN' then
+          begin
+           // if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
+            if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
+            if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
+            EndCheck := True;
+          end
+      end;
+    end;
+  if self.tabDose.TabIndex = TI_DOSE then
+    begin
+     if LeftStr(ASchedule, 1) = ';' then tempSch := Piece(ASchedule, ';', 2)
+     else tempSch := ASchedule;
+     if self.chkPRN.Checked = True then
+       begin
+         AdminTime := -1;
+         lblAdminSchSetText('');
+         if (cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3) = 'O') then
+           DoseNow := false;
+       end
+     else begin
+         //cboSchedule.SelectByID(tempSch);
+         SchID := -1;
+         for j := 0 to cboSchedule.Items.Count - 1 do
+           begin
+             if Piece(cboSchedule.Items.Strings[j], U, 1) = tempSch then
                 begin
                   AdminTime := -1;
                   Aschedule := '';
+                  schID := j;
+                  break;
                 end;
+            end;
+        end;
+        if valFor(VAL_CHKXPRN,1)='1' then
+          begin
+            AdminTime := -1;
+            Aschedule := '';
+          end;
+      if (ASchedule <> '') and (CompSch <> '') then ASchedule := ';' + CompSch;
+    end;
+  if Length(ASchedule)>0 then
+      LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration);
+  //else Exit;
+  if (AdminTime > 0) and (self.tabDose.TabIndex = TI_DOSE) then
+    begin
+     if self.cboSchedule.ItemIndex = -1 then
+       begin
+         for j := 0 to self.cboSchedule.items.Count -1 do
+           end;
+         if schID > -1 then
            begin
+             if (Piece(self.cboSchedule.Items.Strings[j],U,1) = Piece(Aschedule,';',2)) and (Piece(self.cboSchedule.Items.Strings[j],U,3)='P') then
+             SchType := Piece(self.cboSchedule.Items.Strings[schID], U, 3);
+             if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then
                begin
+                 AdminTime := -1;
+                 break;
+                 lblAdminSchSetText('');
+                 if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then AdminTime := -1;
+                 if SchType = 'O' then DoseNow := false;
+               end
+             else
+               begin
+                 if FAdminTimeText <> '' then tempAdmin := 'Admin. Time: ' + FAdminTimeText
+                 else
+                   begin
+                      if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
+                          tempAdmin := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
+                      else tempAdmin := 'Admin. Time: Not Defined';
+                   end;
+                  lblAdminSchSetText(tempAdmin);
+             (*    if FAdminTimeText <> '' then self.lblAdminSch.text := 'Admin. Time: ' + FAdminTimeText
+                 else
+                   begin
+                      if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
+                          self.lblAdminSch.text := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
+                      else self.lblAdminSch.text := 'Admin. Time: Not Defined';
+                   end;   *)
                end;
            end;
        end;
+     if (self.cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.ItemIndex],U,3)='P') then
+       AdminTime := -1;
+     if self.chkPRN.Checked = true then AdminTime := -1
+    end;
+    end;
+  if (Length(ASchedule)>0) and (AdminTime > -1) then
+     begin
+      if LeftStr(Aschedule, 1) <> ';' then ASchedule := ';'+ASchedule;
+      Admin := '';
+      if (self.lblAdminSch.visible = True) and (self.lblAdminSch.text <> '') and (self.tabDose.TabIndex = TI_DOSE) then
+        begin
+          //AGP Change Admin Time Wrap 27.73
+          //Admin := Copy(self.lblAdminSch.text,  14, (Length(self.lblAdminSch.text)-1));
+          Admin := lblAdminSchGetText;
+          if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
+        end
+      else if self.tabDose.TabIndex = TI_COMPLEX then
+        begin
+          Admin := Self.grdDoses.Cells[COL_ADMINTIME, 1];
+          if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
+        end;
+      LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration, Admin);
+     end;
   if AdminTime > 0 then
   begin
 …
   end
   else lblAdminTime.Caption := '';
+  if (lblAdminTime.Caption <> '') and (lblAdminTime.Visible = True) and (JAWSON = true) then lblAdminTime.TabStop := true
+  else lblAdminTime.TabStop := false;
+  if (lblAdminSch.text <> '') and (lblAdminSch.Visible = True) and (JAWSON = true) then lblAdminSch.TabStop := true
+  else lblAdminSch.TabStop := false;
+  DisplayDoseNow(DoseNow);
 end;
 …
   else
     spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D');
   if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then
+  if (StrToIntDef(txtRefills.Text, 0) > spnRefills.Max) then
   begin
     txtRefills.Text := IntToStr(spnRefills.Max);
 …
   CurSupply, i, pNum, j: Integer;
   CurQuantity: double;
   LackQtyInfo, SaveChanging, DispFirstDose: Boolean;
+  LackQtyInfo, SaveChanging: Boolean;
 begin
   inherited;
 …
   SaveChanging := Changing;
   Changing := TRUE;
-  DispFirstDose := FALSE;
   // don't allow Exit procedure so Changing gets reset appropriately
   CurUnits    := '';
 …
   CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0);
   CurSupply   := StrToIntDef(ValueOfResponse(FLD_SUPPLY)   ,0);
+  //CurRefill  := StrToIntDef(ValueOfResponse(FLD_REFILLS) , 0);
   if FInptDlg then
   begin
 …
           lblAdminTime.Caption := '';
     end;
+    if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
+    if (ValueOf(FLD_SCHED_TYP) = 'O')
+   if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then UpdateStartExpires(CurSchedule);
+   //AGP remove this code for CQ 11772
+  (*if (ValueOf(FLD_SCHED_TYP) = 'O')
       or (Responses.EventType in ['A','D','T','M','O'])
       or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
 …
         chkDoseNow.Checked := False;
       end;
-      for i := 0 to cboSchedule.Items.Count-1 do
-        begin
-                  if Piece(cboSchedule.Items.Strings[i],U,1) = Uppercase(cboSchedule.Text) then
-            begin
-              DispFirstDose := True;
-              break;
-            end;
-        end;
-      if not DispFirstDose then
-        begin
           chkDoseNow.Visible := False;
           lblAdminTime.Visible := False;
-        end;
     end
     else
 …
         chkDoseNow.Visible := TRUE;
         lblAdminTime.Visible := not chkDoseNow.Checked;
       end;
+      end;  *)
     if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
   end;
 …
   begin
     CurSchedule := CurScheduleOut;
     if (CurInstruct <> FLastInstruct) and (CurUnits <> U) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
+    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
       then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
                                LackQtyInfo);
 …
     else
       UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity);
     if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
     if (CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply) then
+   // if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
+    if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0))  then
       UpdateRefills(CurDispDrug, CurSupply);
   end;
 …
     then DisplayGroup := DisplayGroupByName('UD RX')
   else DisplayGroup := DisplayGroupByName('O RX');
+ (* if (Not FInptDlg) then
+    begin
+      if (ValidateDaySupplyandQuantity(strtoInt(txtSupply.Text), strtoInt(txtQuantity.text)) = false) then Exit
+      else ClearMaxData;
+    end;   *)
+  //if (Not FInptDlg) and (ValidateMaxQuantity(strtoInt(txtQuantity.Text)) = false) then Exit;
   //timCheckChangesTimer(Self);
   DropLastSequence;
 …
     if length(theSch)>0 then
     begin
+      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
+      //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
+      if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
       begin
         chkDoseNow.Checked := False;
 …
   if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked  then
   begin
     if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
+    if (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
                  'Please adjust the duration of the first row, if necessary.',
                  'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) ) then
+                 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then
     begin
       chkDoseNow.Checked := False;
 …
   case Key of
 //  VK_RETURN:   //moved to form key press
+  VK_RIGHT:
+    begin
+      if (not FInptDlg) and (self.grdDoses.Col = COL_DURATION) then
+        begin
+          self.grdDoses.Col := COL_SEQUENCE;
+          Key := 0;
+        end;
+    end;
+  VK_LEFT:
+    begin
+      if (not FInptDlg) and (self.grdDoses.Col = COL_SEQUENCE) then
+        begin
+          self.grdDoses.Col := COL_DURATION;
+          Key := 0;
+        end;
+    end;
   VK_ESCAPE:
     begin
 …
 procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
 begin
   if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
+ (* if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
   begin
     ShowEditor(grdDoses.Col, grdDoses.Row, #0);
     Key := #0;  //Don't let the base class turn it into a forward tab!
+  end
+  else if (Key = #13) and (ActiveControl = txtMed) then
+  end *)
+  //else
+  if (Key = #13) and (ActiveControl = txtMed) then
     Key := #0;   //Don't let the base class turn it into a forward tab!
 end;
 …
 end;
 procedure TfrmODMeds.pnlXSequenceEnter(Sender: TObject);
+procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
 begin
   inherited;
 …
 end;
-procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
-begin
-  inherited;
-  DisableDefaultButton(self);
-  DisableCancelButton(self);
-end;
 procedure TfrmODMeds.pnlMessageExit(Sender: TObject);
 begin
 …
 begin
   inherited;
   ShowMessage('The patient instruction field may not be edited.');
+  ShowMsg('The patient instruction field may not be edited.');
   chkPtInstruct.SetFocus;
 end;
 …
 var
   aftHeight: integer;
+  tempAdmin: string;
 begin
   inherited;
 …
   if pnlMessage.Visible then
     pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
+end;
+procedure TfrmODMeds.spnQuantityChangingEx(Sender: TObject;
+  var AllowChange: Boolean; NewValue: Smallint;
+  Direction: TUpDownDirection);
+var
+  tempQuant: double;
+begin
+  inherited;
+  if Direction = updUp then
+  begin
+    tempQuant := StrToFloatDef(txtQuantity.Text,0) + 1;
+    txtQuantity.Text := FloatToStr(tempQuant);
+  end else if Direction = updDown then
+  begin
+    tempQuant := StrToFloatDef(txtQuantity.Text,0) - 1 ;
+    if tempQuant < 0 then tempQuant := 0;
+    txtQuantity.Text := FloatToStr(tempQuant);
+  end;
+  spnQuantity.Tag := 1;
+  txtQuantity.Tag := 1;
+  tempAdmin := lblAdminSchGetText;
+  if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin);
 end;
 …
 begin
   inherited;
   ShowMessage('The patient instruction field may not be edited.');
+  ShowMsg('The patient instruction field may not be edited.');
   chkPtInstruct.SetFocus;
 end;
 …
     cboSchedule.ItemIndex := -1;
     cboSchedule.Text      := '';
+  end;
+  Result := aSchedule;
+  end
+  else
+    begin
+        Result := Piece(aSchedule,U,1);
+        NSSAdminTime := Piece(aschedule,u,2);
+        NSSScheduleType := Piece(aSchedule, U, 3);
+        if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
+    end;
 end;
 …
                        (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
                        (Integer(lstQuick.Selected.Data) > 0)) ;
+  if (btnSelect.Enabled) and (FOrderAction = ORDER_EDIT) then btnSelect.Enabled := false;
   if (btnSelect.Enabled) and (FRemoveText) then
     txtMed.Text := '';
 end;
+procedure TfrmODMeds.DisplayDoseNow(Status: boolean);
+begin
+  if not FinptDlg then Status := False;
+  if Status = false then
+    begin
+      if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false;
+      self.chkDoseNow.Visible := false;
+    end;
+  if status = true then self.chkDoseNow.Visible := true;
+end;
 procedure TfrmODMeds.DispOrderMessage(const AMessage: string);
 …
 procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
+  if FCloseCalled then Exit; //Temporary Hack: Close is called 2x for some reason & errors out
+  FCloseCalled := true;
   FResizedAlready := False;
   inherited;
 …
     cboXSchedule.ItemIndex := -1;
     cboXSchedule.Text      := '';
+  end;
+  Result := aSchedule;
+  end
+  else
+    begin
+        Result := Piece(aSchedule,U,1);
+        NSSAdminTime := Piece(aschedule,u,2);
+        NSSScheduleType := Piece(ASchedule, U, 3);
+        if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
+    end;
 end;
 …
 procedure TfrmODMeds.FormShow(Sender: TObject);
 begin
+  FCloseCalled := false;
   inherited;
   if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then
     PostMessage(Handle, UM_NSSOTHER, 0, 0);
+  //I was using btnSelect.Top for the following, but it gets moved around
+  Constraints.MinHeight := Constraints.MinHeight + ((Self.Height - cmdQuit.Top) * 2);
 end;
 …
       ScheduleCombo.ItemIndex := tmpIndex;
   end;
   if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
   begin
     FShowPnlXScheduleOk := False; //Added for CQ: 7370
     Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
+    if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
+        begin
+          FShowPnlXScheduleOk := False; //Added for CQ: 7370
+          Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
                            'If you would like to create a Day-of-Week schedule please'+
                            ' select ''OTHER'' from the list.',
 …
 // CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
+function TfrmODMeds.GetCacheChunkIndex(idx: integer): integer;
+begin
+  Result := idx div MED_CACHE_CHUNK_SIZE;
+end;
 function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
 var i: integer;
 …
 end;
+procedure TfrmODMeds.cboXSequenceChange(Sender: TObject);
+var
+x: string;
+begin
+  inherited;
+ x := cboXSequence.Text;
+ if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
+     begin
+       InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
+           'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
+       x := '';
+     end;
+  cboXSequence.text := x;
+  cboXSequence.ItemIndex := cboXSequence.Items.IndexOf(x);
+  grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(x);
+  //AGP Start Expire add line
+  UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
+  ControlChange(Sender);
+end;
+procedure TfrmODMeds.cboXSequenceEnter(Sender: TObject);
+begin
+  inherited;
+  DisableDefaultButton(self);
+  DisableCancelButton(self);
+end;
+procedure TfrmODMeds.cboXSequenceExit(Sender: TObject);
+begin
+  inherited;
+  grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(cboXSequence.Text);
+  if ActiveControl = grdDoses then
+  begin
+    //This next condition seldom occurs, since entering the dosage on the last
+    // row adds another row
+    if grdDoses.Row = grdDoses.RowCount - 1 then
+      grdDoses.RowCount := grdDoses.RowCount + 1;
+  end;
+  cboXSequence.Tag := -1;
+  cboXSequence.Hide;
+  RestoreDefaultButton;
+  RestoreCancelButton;
+  if (pnlMessage.Visible) and (memMessage.TabStop) then
+  begin
+    pnlMessage.Parent := grdDoses.Parent;
+    pnlMessage.TabOrder := grdDoses.TabOrder;
+    ActiveControl := memMessage;
+  end
+  else if grdDoses.Showing then
+    ActiveControl := grdDoses
+  else
+    ActiveControl := cboDosage;
+  //AGP Start Expire commented out line
+  //UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
+end;
+procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject);
+begin
+  inherited;
+  cboxSequence.Hide;
+end;
 procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 …
   //Fix for CQ: 7545
   if cboDosage.ItemIndex > -1 then
+    cboDosageClick(Sender);
+    cboDosageClick(Sender)
+  else
+    UpdateRelated;
 end;
 …
   //Fix for CQ: 7545
   if cboXDosage.ItemIndex > -1 then
+    cboXDosageClick(Sender);
+    cboXDosageClick(Sender)
+  else
+    begin
+      grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
+      UpdateRelated;
+    end;
 end;
 …
   inherited;
    self.txtQuantity.SelectAll;
+end;
+procedure TfrmODMeds.txtRefillsChange(Sender: TObject);
+begin
+  inherited;
+  ControlChange(sender);
 end;
 …
 begin
   inherited;
   //agp Change CQ 10719
+  //agp Change CQ 10719
    self.chkXPRN.OnClick(self.chkXPRN);
 end;
 end.

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

-              r456
+              r829
 object frmODMessage: TfrmODMessage
+inherited frmODMessage: TfrmODMessage
   Left = 271
   Top = 515
 …
   ClientHeight = 39
   ClientWidth = 374
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   FormStyle = fsStayOnTop
-  OldCreateOrder = False
   Position = poOwnerFormCenter
   Visible = True
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  DesignSize = (
+)
   PixelsPerInch = 96
   TextHeight = 13
   object imgMessage: TImage
+  object imgMessage: TImage [0]
     Left = 4
     Top = 4
 …
     Height = 32
   end
   object memMessage: TRichEdit
+  object memMessage: TRichEdit [1]
     Left = 40
     Top = 4
 …
     TabOrder = 0
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMessage'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, ComCtrls;
+  ExtCtrls, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODMessage = class(TForm)
+  TfrmODMessage = class(TfrmBase508Form)
     memMessage: TRichEdit;
     imgMessage: TImage;

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

-              r456
+              r829
     TabOrder = 7
   end
   object cboCare: TORComboBox
+  object cboCare: TORComboBox [8]
     Left = 6
     Top = 20
 …
     ListItemsOnly = True
     LongList = True
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnMouseClick = ControlChange
     OnNeedData = cboCareNeedData
+    CharsNeedMatch = 1
   end
   object calStart: TORDateBox
+  object calStart: TORDateBox [9]
     Left = 6
     Top = 114
 …
     Caption = 'Start Date/Time'
   end
   object calStop: TORDateBox
+  object calStop: TORDateBox [10]
     Left = 158
     Top = 114
 …
     Caption = 'Stop Date/Time'
   end
   object txtComment: TCaptionEdit
+  object txtComment: TCaptionEdit [11]
     Left = 6
     Top = 67
 …
     Caption = 'Instructions'
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboCare'
+        'Status = stsDefault')
+      (
+        'Component = calStart'
+        'Status = stsDefault')
+      (
+        'Component = calStop'
+        'Status = stsDefault')
+      (
+        'Component = txtComment'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODMisc'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst;
+  fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
   Left = 282
   Top = 225
   Width = 576
   Height = 361
+  Width = 586
+  Height = 404
   Caption = 'Order an Imaging Procedure'
+  Constraints.MinHeight = 344
+  Constraints.MinWidth = 576
+  Constraints.MinHeight = 404
+  Constraints.MinWidth = 586
+  ExplicitLeft = 282
+  ExplicitTop = 225
+  ExplicitWidth = 586
+  ExplicitHeight = 404
   PixelsPerInch = 96
   TextHeight = 13
   inherited memOrder: TCaptionMemo
     Left = 0
     Top = 283
     Width = 480
+    Top = 326
+    Width = 490
     Anchors = [akLeft, akRight, akBottom]
     TabOrder = 6
+    ExplicitLeft = 0
+    ExplicitTop = 326
+    ExplicitWidth = 490
   end
   object FRadCommonCombo: TORListBox [1]
     Left = 443
     Top = 346
+    Left = 419
+    Top = 362
     Width = 121
     Height = 11
 …
     Top = 0
     Width = 215
     Height = 281
+    Height = 321
     Anchors = [akLeft, akTop, akBottom]
     BevelOuter = bvNone
 …
     object lblDrug: TLabel
       Left = 0
       Top = 38
+      Top = 34
       Width = 89
       Height = 13
 …
     end
     object lblImType: TLabel
       Left = 1
       Top = 1
+      Left = 0
+      Top = 0
       Width = 64
       Height = 13
 …
     object cboImType: TORComboBox
       Left = 0
       Top = 15
+      Top = 13
       Width = 212
       Height = 21
 …
     object cboProcedure: TORComboBox
       Left = 0
       Top = 53
+      Top = 47
       Width = 212
       Height = 114
+      Height = 122
       Style = orcsSimple
       AutoSelect = True
 …
     end
   end
+  object pnlRight: TORAutoPanel [3]
+    Left = 214
+    Top = 85
+    Width = 355
+    Height = 195
+    Anchors = [akLeft, akRight, akBottom]
+    BevelOuter = bvNone
+  inherited cmdAccept: TButton
+    Left = 497
+    Top = 326
+    Anchors = [akRight, akBottom]
     TabOrder = 3
+    object lblRequestDate: TLabel
+      Left = 4
+      Top = 5
+      Width = 78
+      Height = 13
+      Caption = 'Requested Date'
+    end
+    object lblUrgency: TLabel
+      Left = 104
+      Top = 5
+      Width = 40
+      Height = 13
+      Caption = 'Urgency'
+    end
+    object lblTransport: TLabel
+      Left = 204
+      Top = 5
+      Width = 45
+      Height = 13
+      Caption = 'Transport'
+    end
+    object lblCategory: TLabel
+      Left = 4
+      Top = 42
+      Width = 42
+      Height = 13
+      Caption = 'Category'
+    end
+    object lblSubmit: TLabel
+      Left = 154
+      Top = 42
+      Width = 48
+      Height = 13
+      Caption = 'Submit To'
+    end
+    object lblLastExam: TLabel
+      Left = 4
+      Top = 82
+      Width = 134
+      Height = 13
+      Caption = 'Exams Over the Last 7 Days'
+    end
+    object lblAskSubmit: TLabel
+      Left = 446
+      Top = 103
+      Width = 3
+      Height = 13
+      Visible = False
+    end
+    object lblPreOp: TLabel
+      Left = 198
+      Top = 156
+      Width = 84
+      Height = 13
+      Caption = 'PreOp Scheduled'
+    end
+    object calPreOp: TORDateBox
+      Left = 198
+      Top = 170
+      Width = 96
+      Height = 21
+      TabOrder = 8
+      OnChange = calPreOpChange
+      OnExit = calPreOpExit
+      DateOnly = False
+      RequireTime = False
+      Caption = 'PreOp Scheduled'
+    end
+    object chkIsolation: TCheckBox
+      Left = 198
+      Top = 94
+      Width = 97
+      Height = 17
+      Hint = 'Is patient on isolation procedures?'
+      Caption = 'Isolation'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 6
+      OnClick = ControlChange
+      OnExit = chkIsolationExit
+    end
+    object calRequestDate: TORDateBox
+      Left = 4
+      Top = 18
+      Width = 92
+      Height = 21
+      TabOrder = 0
+      Text = 'TODAY'
+      OnChange = ControlChange
+      DateOnly = False
+      RequireTime = False
+      Caption = 'Requested Date'
+    end
+    object cboUrgency: TORComboBox
+      Left = 104
+      Top = 18
+      Width = 92
+      Height = 21
+      Style = orcsDropDown
+      AutoSelect = True
+      Caption = 'Urgency'
+      Color = clWindow
+      DropDownCount = 8
+      ItemHeight = 13
+      ItemTipColor = clWindow
+      ItemTipEnable = True
+      ListItemsOnly = True
+      LongList = False
+      LookupPiece = 0
+      MaxLength = 0
+      Pieces = '2'
+      Sorted = False
+      SynonymChars = '<>'
+      TabOrder = 1
+      OnChange = ControlChange
+      CharsNeedMatch = 1
+    end
+    object cboTransport: TORComboBox
+      Left = 204
+      Top = 18
+      Width = 92
+      Height = 21
+      Style = orcsDropDown
+      AutoSelect = True
+      Caption = 'Transport'
+      Color = clWindow
+      DropDownCount = 8
+      ItemHeight = 13
+      ItemTipColor = clWindow
+      ItemTipEnable = True
+      ListItemsOnly = True
+      LongList = False
+      LookupPiece = 0
+      MaxLength = 0
+      Pieces = '2'
+      Sorted = False
+      SynonymChars = '<>'
+      TabOrder = 2
+      OnChange = ControlChange
+      CharsNeedMatch = 1
+    end
+    object cboCategory: TORComboBox
+      Left = 4
+      Top = 57
+      Width = 140
+      Height = 21
+      Style = orcsDropDown
+      AutoSelect = True
+      Caption = 'Category'
+      Color = clWindow
+      DropDownCount = 8
+      ItemHeight = 13
+      ItemTipColor = clWindow
+      ItemTipEnable = True
+      ListItemsOnly = True
+      LongList = False
+      LookupPiece = 0
+      MaxLength = 0
+      Pieces = '2'
+      Sorted = False
+      SynonymChars = '<>'
+      TabOrder = 3
+      OnChange = cboCategoryChange
+      CharsNeedMatch = 1
+    end
+    object chkPreOp: TCheckBox
+      Left = 146
+      Top = 233
+      Width = 61
+      Height = 17
+      Caption = 'Pre-Op'
+      TabOrder = 9
+      Visible = False
+      OnClick = ControlChange
+    end
+    object cboSubmit: TORComboBox
+      Left = 154
+      Top = 57
+      Width = 142
+      Height = 21
+      Style = orcsDropDown
+      AutoSelect = True
+      Caption = 'Submit To'
+      Color = clWindow
+      DropDownCount = 8
+      ItemHeight = 13
+      ItemTipColor = clWindow
+      ItemTipEnable = True
+      ListItemsOnly = True
+      LongList = False
+      LookupPiece = 0
+      MaxLength = 0
+      Pieces = '2'
+      Sorted = False
+      SynonymChars = '<>'
+      TabOrder = 4
+      OnChange = ControlChange
+      CharsNeedMatch = 1
+    end
+    object lstLastExam: TORListBox
+      Left = 4
+      Top = 95
+      Width = 187
+      Height = 98
+      Color = clBtnFace
+      ExtendedSelect = False
+      ItemHeight = 13
+      MultiSelect = True
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 5
+      Caption = 'Exams Over the Last 7 Days'
+      ItemTipColor = clWindow
+      LongList = False
+      Pieces = '2'
+    end
+    object grpPregnant: TGroupBox
+      Left = 196
+      Top = 112
+      Width = 158
+      Height = 41
+      Caption = 'Pregnant'
+      TabOrder = 7
+      object radPregnant: TRadioButton
+        Left = 2
+        Top = 17
+        Width = 39
+        Height = 17
+        Caption = 'Yes'
+        TabOrder = 0
+        OnClick = ControlChange
+      end
+      object radPregnantNo: TRadioButton
+        Left = 47
+        Top = 17
+        Width = 35
+        Height = 17
+        Caption = 'No'
+        TabOrder = 1
+        OnClick = ControlChange
+      end
+      object radPregnantUnknown: TRadioButton
+        Left = 87
+        Top = 16
+        Width = 66
+        Height = 17
+        Caption = 'Unknown'
+        TabOrder = 2
+        OnClick = ControlChange
+      end
+    end
+  end
+  object pnlHandR: TPanel [4]
+    ExplicitLeft = 497
+    ExplicitTop = 326
+  end
+  object pnlRightBase: TORAutoPanel [4]
     Left = 215
     Top = 0
     Width = 353
     Height = 84
+    Width = 362
+    Height = 322
     Anchors = [akLeft, akTop, akRight, akBottom]
     BevelOuter = bvNone
+    TabOrder = 2
+    DesignSize = (
+)
+    object lblReason: TLabel
+      Left = 3
+    Caption = 'pnlRightBase'
+    TabOrder = 1
+    object pnlRight: TORAutoPanel
+      Left = 0
+      Top = 127
+      Width = 362
+      Height = 195
+      Align = alBottom
+      Anchors = [akLeft, akTop, akRight, akBottom]
+      BevelOuter = bvNone
+      TabOrder = 1
+      object lblRequestDate: TLabel
+        Left = 4
+        Top = 5
+        Width = 62
+        Height = 13
+        Caption = 'Date Desired'
+      end
+      object lblUrgency: TLabel
+        Left = 104
+        Top = 5
+        Width = 40
+        Height = 13
+        Caption = 'Urgency'
+      end
+      object lblTransport: TLabel
+        Left = 204
+        Top = 5
+        Width = 45
+        Height = 13
+        Caption = 'Transport'
+      end
+      object lblCategory: TLabel
+        Left = 4
+        Top = 42
+        Width = 42
+        Height = 13
+        Caption = 'Category'
+      end
+      object lblSubmit: TLabel
+        Left = 154
+        Top = 42
+        Width = 48
+        Height = 13
+        Caption = 'Submit To'
+      end
+      object lblLastExam: TLabel
+        Left = 4
+        Top = 82
+        Width = 134
+        Height = 13
+        Caption = 'Exams Over the Last 7 Days'
+      end
+      object lblAskSubmit: TLabel
+        Left = 446
+        Top = 103
+        Width = 3
+        Height = 13
+        Visible = False
+      end
+      object lblPreOp: TLabel
+        Left = 198
+        Top = 156
+        Width = 84
+        Height = 13
+        Caption = 'PreOp Scheduled'
+      end
+      object calPreOp: TORDateBox
+        Left = 198
+        Top = 170
+        Width = 96
+        Height = 21
+        TabOrder = 8
+        OnChange = calPreOpChange
+        OnExit = calPreOpExit
+        DateOnly = False
+        RequireTime = False
+        Caption = 'PreOp Scheduled'
+      end
+      object chkIsolation: TCheckBox
+        Left = 198
+        Top = 94
+        Width = 97
+        Height = 17
+        Hint = 'Is patient on isolation procedures?'
+        Caption = 'Isolation'
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 6
+        OnClick = ControlChange
+        OnExit = chkIsolationExit
+      end
+      object calRequestDate: TORDateBox
+        Left = 4
+        Top = 18
+        Width = 92
+        Height = 21
+        TabOrder = 0
+        OnChange = ControlChange
+        DateOnly = False
+        RequireTime = False
+        Caption = 'Date Desired'
+      end
+      object cboUrgency: TORComboBox
+        Left = 104
+        Top = 18
+        Width = 92
+        Height = 21
+        Style = orcsDropDown
+        AutoSelect = True
+        Caption = 'Urgency'
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = True
+        LongList = False
+        LookupPiece = 0
+        MaxLength = 0
+        Pieces = '2'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 1
+        OnChange = ControlChange
+        CharsNeedMatch = 1
+      end
+      object cboTransport: TORComboBox
+        Left = 204
+        Top = 18
+        Width = 92
+        Height = 21
+        Style = orcsDropDown
+        AutoSelect = True
+        Caption = 'Transport'
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = True
+        LongList = False
+        LookupPiece = 0
+        MaxLength = 0
+        Pieces = '2'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 2
+        OnChange = ControlChange
+        CharsNeedMatch = 1
+      end
+      object cboCategory: TORComboBox
+        Left = 4
+        Top = 57
+        Width = 140
+        Height = 21
+        Style = orcsDropDown
+        AutoSelect = True
+        Caption = 'Category'
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = True
+        LongList = False
+        LookupPiece = 0
+        MaxLength = 0
+        Pieces = '2'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 3
+        OnChange = cboCategoryChange
+        CharsNeedMatch = 1
+      end
+      object chkPreOp: TCheckBox
+        Left = 146
+        Top = 233
+        Width = 61
+        Height = 17
+        Caption = 'Pre-Op'
+        TabOrder = 9
+        Visible = False
+        OnClick = ControlChange
+      end
+      object cboSubmit: TORComboBox
+        Left = 154
+        Top = 57
+        Width = 142
+        Height = 21
+        Style = orcsDropDown
+        AutoSelect = True
+        Caption = 'Submit To'
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = True
+        LongList = False
+        LookupPiece = 0
+        MaxLength = 0
+        Pieces = '2'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 4
+        OnChange = ControlChange
+        CharsNeedMatch = 1
+      end
+      object lstLastExam: TORListBox
+        Left = 4
+        Top = 95
+        Width = 187
+        Height = 98
+        Color = clBtnFace
+        ExtendedSelect = False
+        ItemHeight = 13
+        MultiSelect = True
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 5
+        Caption = 'Exams Over the Last 7 Days'
+        ItemTipColor = clWindow
+        LongList = False
+        Pieces = '2'
+      end
+      object grpPregnant: TGroupBox
+        Left = 196
+        Top = 112
+        Width = 158
+        Height = 41
+        Caption = 'Pregnant'
+        TabOrder = 7
+        object radPregnant: TRadioButton
+          Left = 2
+          Top = 17
+          Width = 39
+          Height = 17
+          Caption = 'Yes'
+          TabOrder = 0
+          OnClick = ControlChange
+        end
+        object radPregnantNo: TRadioButton
+          Left = 47
+          Top = 17
+          Width = 35
+          Height = 17
+          Caption = 'No'
+          TabOrder = 1
+          OnClick = ControlChange
+        end
+        object radPregnantUnknown: TRadioButton
+          Left = 87
+          Top = 16
+          Width = 66
+          Height = 17
+          Caption = 'Unknown'
+          TabOrder = 2
+          OnClick = ControlChange
+        end
+      end
+    end
+    object pnlHandR: TPanel
+      Left = 0
       Top = 0
+      Width = 125
+      Height = 13
+      Caption = 'History && Reason for Exam'
+    end
+    object memReason: TCaptionMemo
+      Left = 3
+      Top = 15
+      Width = 346
+      Height = 68
+      Anchors = [akLeft, akTop, akRight, akBottom]
+      ScrollBars = ssVertical
+      Width = 362
+      Height = 127
+      Align = alClient
+      BevelOuter = bvNone
       TabOrder = 0
+      OnChange = ControlChange
+      OnExit = memReasonExit
+      Caption = 'History && Reason for Exam'
+    end
+  end
+  inherited cmdAccept: TButton
+    Left = 487
+    Top = 283
+      object lblHistory: TLabel
+        Left = 0
+        Top = 34
+        Width = 362
+        Height = 13
+        Align = alTop
+        Caption = 'Clinical History (Optional)'
+        ExplicitWidth = 116
+      end
+      object lblReason: TLabel
+        Left = 0
+        Top = 0
+        Width = 362
+        Height = 13
+        Align = alTop
+        Caption = 'Reason for Study (REQUIRED - 64 characters maximum)'
+        ExplicitWidth = 268
+      end
+      object memHistory: TCaptionMemo
+        Left = 0
+        Top = 47
+        Width = 362
+        Height = 80
+        Align = alClient
+        ScrollBars = ssVertical
+        TabOrder = 3
+        OnChange = ControlChange
+        OnExit = memHistoryExit
+        Caption = 'Clinical History (Optional)'
+      end
+      object txtReason: TCaptionEdit
+        Left = 0
+        Top = 13
+        Width = 362
+        Height = 21
+        Align = alTop
+        MaxLength = 64
+        TabOrder = 0
+        OnChange = ControlChange
+        Caption = 'Reason for Study (REQUIRED)'
+      end
+    end
+  end
+  inherited cmdQuit: TButton
+    Left = 498
+    Top = 353
     Anchors = [akRight, akBottom]
     TabOrder = 4
+  end
+  inherited cmdQuit: TButton
+    Left = 488
+    Top = 310
+    Anchors = [akRight, akBottom]
+    TabOrder = 5
+    ExplicitLeft = 498
+    ExplicitTop = 353
   end
   inherited pnlMessage: TPanel
     Left = 13
     Top = 262
+    Left = 5
+    Top = 318
     Width = 408
     Height = 55
+    TabOrder = 1
+    TabOrder = 2
+    ExplicitLeft = 5
+    ExplicitTop = 318
+    ExplicitWidth = 408
+    ExplicitHeight = 55
     inherited imgMessage: TImage
       Left = 10
       Top = 9
+      ExplicitLeft = 10
+      ExplicitTop = 9
     end
     inherited memMessage: TRichEdit
 …
       Width = 344
       Height = 43
+    end
+      ExplicitLeft = 55
+      ExplicitWidth = 344
+      ExplicitHeight = 43
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = FRadCommonCombo'
+        'Status = stsDefault')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = cboImType'
+        'Status = stsDefault')
+      (
+        'Component = lstSelectMod'
+        'Status = stsDefault')
+      (
+        'Component = cboProcedure'
+        'Status = stsDefault')
+      (
+        'Component = cboAvailMod'
+        'Status = stsDefault')
+      (
+        'Component = cmdRemove'
+        'Status = stsDefault')
+      (
+        'Component = pnlRightBase'
+        'Status = stsDefault')
+      (
+        'Component = pnlRight'
+        'Status = stsDefault')
+      (
+        'Component = calPreOp'
+        'Status = stsDefault')
+      (
+        'Component = chkIsolation'
+        'Status = stsDefault')
+      (
+        'Component = calRequestDate'
+        'Status = stsDefault')
+      (
+        'Component = cboUrgency'
+        'Status = stsDefault')
+      (
+        'Component = cboTransport'
+        'Status = stsDefault')
+      (
+        'Component = cboCategory'
+        'Status = stsDefault')
+      (
+        'Component = chkPreOp'
+        'Status = stsDefault')
+      (
+        'Component = cboSubmit'
+        'Status = stsDefault')
+      (
+        'Component = lstLastExam'
+        'Status = stsDefault')
+      (
+        'Component = grpPregnant'
+        'Status = stsDefault')
+      (
+        'Component = radPregnant'
+        'Status = stsDefault')
+      (
+        'Component = radPregnantNo'
+        'Status = stsDefault')
+      (
+        'Component = radPregnantUnknown'
+        'Status = stsDefault')
+      (
+        'Component = pnlHandR'
+        'Status = stsDefault')
+      (
+        'Component = memHistory'
+        'Status = stsDefault')
+      (
+        'Component = txtReason'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODRad'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
   ComCtrls, uConst, ORDtTm;
+  ComCtrls, uConst, ORDtTm, VA508AccessibilityManager;
 type
 …
     cboSubmit: TORComboBox;
     lstLastExam: TORListBox;
     lblReason: TLabel;
     memReason: TCaptionMemo;
+    lblHistory: TLabel;
+    memHistory: TCaptionMemo;
     lstSelectMod: TORListBox;
     lblSelectMod: TLabel;
 …
     radPregnantNo: TRadioButton;
     radPregnantUnknown: TRadioButton;
+    lblReason: TLabel;
+    txtReason: TCaptionEdit;
+    pnlRightBase: TORAutoPanel;
     procedure cboProcedureNeedData(Sender: TObject;
               const StartFrom: string; Direction, InsertAt: Integer);
 …
     procedure FormCreate(Sender: TObject);
     procedure cboImTypeChange(Sender: TObject);
     procedure memReasonExit(Sender: TObject);
+    procedure memHistoryExit(Sender: TObject);
     procedure FormResize(Sender: TObject);
     procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
 …
   TX_NO_PROC          = 'An Imaging Procedure must be specified.'    ;
   TX_NO_MODE          = 'A mode of transport must be selected.';
+  TX_NO_REASON        = 'A History & Reason for Exam must be entered.'  ;
+  TX_NO_DATE          = 'Unable to evaluate request date.' ;
+  TX_NO_REASON        = 'A Reason for Study must be entered.'  ;
+  TX_BAD_HISTORY      = 'An incomplete or invalid Clinical History has been entered.' + CRLF +
+                        'Please correct or clear.';
+  TX_NO_DATE          = 'A "Date Desired" must be specified.' ;
+  TX_BAD_DATE         = 'The "Date Desired" you have entered is invalid.';
+  TX_PAST_DATE        = '"Date Desired" must not be in the past.';
   TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ;
   TX_NO_SOURCE        = 'A source must be specified for Contract/Sharing/Research patients.';
 …
     with cboImType do
       begin
         Items.Assign(SubsetOfImagingTypes);
+        FastAssign(SubsetOfImagingTypes, cboImType.Items);
         for i := 0 to Items.Count-1 do
           if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
 …
     SetControl(cboSubmit,          'IMLOC', 1);
     SetControl(cboCategory,        'CLASS', 1);
+    SetControl(memReason,          'COMMENT', 1);
+    SetControl(txtReason,           'REASON', 1);
+    SetControl(memHistory,         'COMMENT', 1);
     SetControl(chkIsolation,       'YN', 1);
     SetControl(radPregnant,        'PREGNANT', 1);
 …
    tmplst: TStringList;
 begin
+  if not FEditCopy then inherited;
+  if not FEditCopy then
+  begin
+    inherited;
+    if not ReasonForStudyCarryOn then txtReason.text := '';
+  end;
   FPreOpDate := '';
 …
     if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
     calRequestDate.Text := 'TODAY';
+    //calRequestDate.Text := 'TODAY';     default removed per E3R #19834 - v27.10 - RV
     SetControl(cboAvailMod, 'Modifiers');
     SetControl(cboUrgency, 'Urgencies');
 …
             tmplst := TStringList.Create;
             try
               tmplst.Assign(cboSubmit.Items);
+              FastAssign(cboSubmit.Items, tmplst);
               SortByPiece(tmplst, U, 2);
               cboSubmit.Items.Assign(tmplst);
+              FastAssign(tmplst, cboSubmit.Items);
             finally
               tmplst.Free;
 …
   cboProcedure.InitLongList('') ;
   StatusText('');
 end;
 …
                                              else Responses.Update('YN',        1, '0'   , 'No');
   with calPreOp do if Length(Text) > 0       then Responses.Update('PREOP',     1, FPreOpDate, Text);
+  with memReason do if GetTextLen        > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
+  with txtReason  do if GetTextLen        > 0 then Responses.Update('REASON',    1, Text, Text);
+  with memHistory do if GetTextLen       > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
   with lstSelectMod do for i := 0 to Items.Count - 1 do
                                                   Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
 …
         end ;
     end;
+  if Length(txtReason.Text) < 3 then
+    SetError(TX_NO_REASON)
+  else
+    begin
+      j := 0;
+      for i := 1 to Length(txtReason.Text) do
+        begin
+          if txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
+          if not (txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
+          if j = 2 then break;
+        end;
+      if j < 2 then SetError(TX_NO_REASON);
+    end;
+  if Length(memHistory.Text) > 0 then
+  begin
+    j := 0;
+    for i := 1 to Length(memHistory.Text) do
+      begin
+        if memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
+        if not (memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
+        if j = 2 then break;
+      end;
+    if j < 2 then SetError(TX_BAD_HISTORY);
+  end;
   with cboCategory do
     begin
       AskLoc := True;
+      AskLoc := (ALocation = 0);
       if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
         AskLoc := False;
 …
   if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
-  if Length(memReason.Text) < 2 then
-    SetError(TX_NO_REASON)
-  else
-    begin
-      j := 0;
-      for i := 1 to Length(memReason.Text) do
-        begin
-          if memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
-          if not (memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
-          if j = 2 then break;
-        end;
-      if j < 2 then SetError(TX_NO_REASON);
-    end;
   with cboSubmit do
     if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
   with calRequestDate do
+    if FMDateTime = 0 then SetError(TX_NO_DATE);
+  begin
+    if FMDateTime = 0 then
+      SetError(TX_NO_DATE)
+    else if FMDateTime < 0 then
+      SetError(TX_BAD_DATE)
+    else if FMDateTime < FMToday then
+      SetError(TX_PAST_DATE);
+  end;
 end;
 …
     ClearControl(lstSelectMod);
     ClearControl(lstLastExam);
     //ClearControl(memReason);    {WPB-1298-30758}
+    //ClearControl(memHistory);    {WPB-1298-30758}
     Changing := False;
     if CharAt(ItemID, 1) = 'Q' then
 …
     SetControl(cboTransport,       'MODE', 1);
     SetControl(cboCategory,        'CLASS', 1);
+    SetControl(memReason,          'COMMENT', 1);
+    SetControl(txtReason,           'REASON', 1);
+    SetControl(memHistory,         'COMMENT', 1);
     SetControl(chkIsolation,       'YN', 1);
     SetControl(radPregnant,        'PREGNANT', 1);
 …
   AutoSizeDisabled := True;
   inherited;
   memReason.Width := pnlHandR.ClientWidth;
   memReason.Height := pnlHandR.ClientHeight - memReason.Top;
+  memHistory.Width := pnlHandR.ClientWidth;
+  memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
   FillerID := 'RA';                     // does 'on Display' order check **KCM**
   StatusText('Loading Dialog Definition');
 …
   Responses.Dialog := 'RA OERR EXAM';              // loads formatting info
   StatusText('Loading Default Values');
   cboImType.Items.Assign(SubsetOfImagingTypes);
+  FastAssign(SubsetOfImagingTypes, cboImType.Items);
   if Self.EvtID>0 then
     FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
 …
   PreserveControl(cboCategory);
   PreserveControl(calPreOp);
+  PreserveControl(memReason);      {WPB-1298-30758}
+  PreserveControl(txtReason);
+  PreserveControl(memHistory);      {WPB-1298-30758}
   if (Patient.Sex <> 'F') then
   begin
 …
 end;
 procedure TfrmODRad.memReasonExit(Sender: TObject);
+procedure TfrmODRad.memHistoryExit(Sender: TObject);
 var
   AStringList: TStringList;
 …
   AStringList := TStringList.Create;
   try
     AStringList.Assign(memReason.Lines);
+    FastAssign(memHistory.Lines, AStringList);
     LimitStringLength(AStringList, 74);
     memReason.Lines.Assign(AstringList);
+    FastAssign(AstringList, memHistory.Lines);
     ControlChange(Self);
   finally
 …
 begin
   inherited;
   memReason.Width := pnlHandR.ClientWidth;
   memReason.Height := pnlHandR.ClientHeight - memReason.Top;
+  memHistory.Width := pnlHandR.ClientWidth;
+  memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
 end;

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

-              r456
+              r829
 object frmODRadApproval: TfrmODRadApproval
+inherited frmODRadApproval: TfrmODRadApproval
   Left = 295
   Top = 167
 …
   ClientHeight = 262
   ClientWidth = 259
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       SynonymChars = '<>'
       TabOrder = 0
+      CharsNeedMatch = 1
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboRadiologist'
+        'Status = stsDefault')
+      (
+        'Component = frmODRadApproval'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
   Buttons, ORCtrls, ORfn, ExtCtrls;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODRadApproval = class(TForm)
+  TfrmODRadApproval = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;
 …
       ClientHeight := H; pnlBase.Height := H;
       FChanged := False;
       cboRadiologist.Items.Assign(SubsetOfRadiologists);
+      FastAssign(SubsetOfRadiologists, cboRadiologist.Items);
       ShowModal;
       Radiologist := FRadiologist ;

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

-              r456
+              r829
 object frmODRadConShRes: TfrmODRadConShRes
+inherited frmODRadConShRes: TfrmODRadConShRes
   Left = 308
   Top = 206
 …
   ClientHeight = 121
   ClientWidth = 288
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       SynonymChars = '<>'
       TabOrder = 0
+      CharsNeedMatch = 1
     end
     object txtResearch: TCaptionEdit
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboSource'
+        'Status = stsDefault')
+      (
+        'Component = txtResearch'
+        'Status = stsDefault')
+      (
+        'Component = frmODRadConShRes'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
   Buttons, ORCtrls, ORfn, ExtCtrls;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODRadConShRes = class(TForm)
+  TfrmODRadConShRes = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;
 …
       if SrcType in ['C','S'] then with cboSource do
          begin
            Items.Assign(SubsetOfRadSources(SrcType));
+           FastAssign(SubsetOfRadSources(SrcType), cboSource.Items);
            if Items.Count > 0 then
             begin

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

-              r456
+              r829
 object frmODRadImType: TfrmODRadImType
+inherited frmODRadImType: TfrmODRadImType
   Left = 308
   Top = 206
 …
   ClientHeight = 189
   ClientWidth = 259
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
       ListItemsOnly = True
       LongList = False
+      LookupPiece = 0
       MaxLength = 0
       Pieces = '2'
 …
       TabOrder = 0
       OnDblClick = cboImTypeDblClick
+      CharsNeedMatch = 1
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboImType'
+        'Status = stsDefault')
+      (
+        'Component = frmODRadImType'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
   Buttons, ORCtrls, ORfn, ExtCtrls;
+  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmODRadImType = class(TForm)
+  TfrmODRadImType = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;
 …
       ClientHeight := H; pnlBase.Height := H;
       FChanged := False;
       cboImType.Items.Assign(SubsetOfImagingTypes);
+      FastAssign(SubsetOfImagingTypes, cboImType.Items);
       if cboImType.Items.Count > 1 then
          ShowModal

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

-              r456
+              r829
 object frmOrdersReleaseEvent: TfrmOrdersReleaseEvent
+inherited frmOrdersReleaseEvent: TfrmOrdersReleaseEvent
   Left = 410
   Top = 145
-  Width = 494
-  Height = 488
   Caption = 'Release to Service'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 461
+  ClientWidth = 486
   Position = poScreenCenter
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  ExplicitWidth = 494
+  ExplicitHeight = 488
   PixelsPerInch = 96
   TextHeight = 13
   object lblRelease: TLabel
+  object lblRelease: TLabel [0]
     Left = 0
     Top = 0
 …
     Layout = tlCenter
     WordWrap = True
+    ExplicitWidth = 3
   end
   object pnlMiddle: TPanel
+  object pnlMiddle: TPanel [1]
     Left = 0
     Top = 13
 …
     end
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [2]
     Left = 0
     Top = 426
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlMiddle'
+        'Status = stsDefault')
+      (
+        'Component = cklstOrders'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmOrdersReleaseEvent'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz;
+  StdCtrls, ExtCtrls, ORFn, CheckLst, ORCtrls, fAutoSz, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmOrdersReleaseEvent = class(TForm)
+  TfrmOrdersReleaseEvent = class(TfrmBase508Form)
     pnlMiddle: TPanel;
     pnlBottom: TPanel;
 …
 {$R *.DFM}
+uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders;
+uses rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, fOrders, rODLab, fRptBox,
+  VAUtils;
 const
   TX_SAVERR1 = 'The error, ';
 …
   OrderText, LastCheckedPtEvt, SpeCap: string;
   frmOrdersReleaseEvent: TfrmOrdersReleaseEvent;
+  AList: TStringList;
   function FindOrderText(const AnID: string): string;
 …
         begin
           OrderText := FindOrderText(Piece(OrdersLst[i], U, 1));
+          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,TC_SAVERR, MB_OK);
+          if Piece(OrdersLst[i],U,4) = 'Invalid Pharmacy order number' then
+          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
+                  'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
+                  TC_SAVERR, MB_OK)
+          else
+          InfoBox(TX_SAVERR1 + Piece(OrdersLst[i], U, 4) + TX_SAVERR2 + OrderText,
+                  TC_SAVERR, MB_OK);
         end;
+      end;
+      //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
+      AList := TStringList.Create;
+      try
+        CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, OrdersLst);
+        if AList.Text <> '' then
+          ReportBox(AList, 'Changed Orders', TRUE);
+      finally
+        AList.Free;
       end;
       PrintOrdersOnSignRelease(OrdersLst, NO_PROVIDER);
 …
   if not beSelected then
   begin
     ShowMessage('You have to select at least one order!');
+    ShowMsg('You have to select at least one order!');
     Exit;
   end;
 …
   begin
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(0, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);

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

-              r456
+              r829
   Left = 371
   Top = 203
-  Width = 304
-  Height = 290
   Caption = 'frmODQuick'
+  ClientHeight = 263
+  ClientWidth = 296
+  ExplicitWidth = 304
+  ExplicitHeight = 290
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
     Caption = 'Enter the name that should be used for this quick order.'
   end
   object Label2: TLabel
+  object Label2: TLabel [1]
     Left = 8
     Top = 61
 …
     Caption = 'Meds, Inpatient Common List'
   end
   object SpeedButton1: TSpeedButton
+  object SpeedButton1: TSpeedButton [2]
     Left = 263
     Top = 108
 …
       33333333333C3333333333333333333333333333333333333333}
   end
   object SpeedButton2: TSpeedButton
+  object SpeedButton2: TSpeedButton [3]
     Left = 263
     Top = 144
 …
       333333333CCCCC33333333333333333333333333333333333333}
   end
   object Bevel1: TBevel
+  object Bevel1: TBevel [4]
     Left = 8
     Top = 224
 …
     Height = 2
   end
   object Bevel2: TBevel
+  object Bevel2: TBevel [5]
     Left = 8
     Top = 51
 …
     Height = 2
   end
   object Edit1: TCaptionEdit
+  object Edit1: TCaptionEdit [6]
     Left = 8
     Top = 22
 …
     Caption = 'Enter the name that should be used for this quick order.'
   end
   object ORListBox1: TORListBox
+  object ORListBox1: TORListBox [7]
     Left = 8
     Top = 75
 …
     LongList = False
   end
   object Button1: TButton
+  object Button1: TButton [8]
     Left = 136
     Top = 234
 …
     TabOrder = 2
   end
   object Button2: TButton
+  object Button2: TButton [9]
     Left = 216
     Top = 234
 …
     TabOrder = 3
   end
   object BitBtn1: TBitBtn
+  object BitBtn1: TBitBtn [10]
     Left = 263
     Top = 191
 …
     Kind = bkAbort
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Edit1'
+        'Status = stsDefault')
+      (
+        'Component = ORListBox1'
+        'Status = stsDefault')
+      (
+        'Component = Button1'
+        'Status = stsDefault')
+      (
+        'Component = Button2'
+        'Status = stsDefault')
+      (
+        'Component = BitBtn1'
+        'Status = stsDefault')
+      (
+        'Component = frmODQuick'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls;
	7	fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
     Caption = 'Stop Date/Time'
   end
   inherited memOrder: TMemo
+  inherited memOrder: TCaptionMemo
     TabOrder = 6
   end
 …
     TabOrder = 3
   end
+  inherited cmdQuit: TButton
+    TabOrder = 4
+  end
+  object memText: TMemo [6]
+  object memText: TMemo [5]
     Left = 6
     Top = 18
 …
     OnChange = ControlChange
   end
   object txtStart: TORDateBox [7]
+  object txtStart: TORDateBox [6]
     Left = 226
     Top = 164
 …
     Caption = 'Start Date/Time'
   end
   object txtStop: TORDateBox [8]
+  object txtStop: TORDateBox [7]
     Left = 374
     Top = 164
 …
     Caption = 'Stop Date/Time'
   end
+  inherited cmdQuit: TButton
+    TabOrder = 4
+  end
   inherited pnlMessage: TPanel
     TabOrder = 5
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = memText'
+        'Status = stsDefault')
+      (
+        'Component = txtStart'
+        'Status = stsDefault')
+      (
+        'Component = txtStop'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODText'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm;
+  fODBase, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, ORFn, uConst, ORDtTm,
+  VA508AccessibilityManager;
 type
 …
     procedure FormCreate(Sender: TObject);
     procedure ControlChange(Sender: TObject);
+    procedure cmdAcceptClick(Sender: TObject);
   public
     procedure InitDialog; override;
 …
   FillerID := 'OR';                     // does 'on Display' order check **KCM**
   StatusText('Loading Dialog Definition');
   Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDE';  // loads formatting info
+  Responses.Dialog := 'OR GXTEXT WORD PROCESSING ORDER';  // loads formatting info
   //StatusText('Loading Default Values');                // there are no defaults for text only
   //CtrlInits.LoadDefaults(ODForText);
 …
 end;
+procedure TfrmODText.cmdAcceptClick(Sender: TObject);
+begin
+  inherited;
+  Application.ProcessMessages; //CQ 14670
+  memText.Lines.Text := Trim(memText.Lines.Text); //CQ 14670
+end;
 procedure TfrmODText.ControlChange(Sender: TObject);
 begin

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

-              r456
+              r829
 object frmInvalidActionList: TfrmInvalidActionList
+inherited frmInvalidActionList: TfrmInvalidActionList
   Left = 445
   Top = 142
-  Width = 534
-  Height = 553
   Caption = 'Invalidated action orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 519
+  ClientWidth = 526
   Position = poScreenCenter
   OnCreate = FormCreate
 …
   PixelsPerInch = 96
   TextHeight = 13
   object pnlTop: TPanel
+  object pnlTop: TPanel [0]
     Left = 0
     Top = 0
 …
       Width = 524
       Height = 176
+      Style = lbOwnerDrawVariable
       Align = alClient
       ItemHeight = 16
-      Style = lbOwnerDrawVariable
       TabOrder = 0
       OnDrawItem = lstActDeniedOrdersDrawItem
 …
       Width = 524
       Height = 27
-      DragReorder = False
       Sections = <
         item
 …
     end
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 229
     Width = 526
     Height = 256
+    Height = 249
     Align = alClient
     TabOrder = 1
+    ExplicitHeight = 256
     object Label2: TLabel
       Left = 1
 …
       Top = 41
       Width = 524
+      Height = 214
+      Height = 207
+      Style = lbOwnerDrawVariable
       Align = alClient
       ItemHeight = 16
-      Style = lbOwnerDrawVariable
       TabOrder = 0
       OnDrawItem = lstValidOrdersDrawItem
 …
     end
   end
   object Panel1: TPanel
+  object Panel1: TPanel [2]
     Left = 0
     Top = 485
+    Top = 478
     Width = 526
     Height = 41
     Align = alBottom
     TabOrder = 2
+    ExplicitTop = 485
+    DesignSize = (
+)
     object btnOK: TButton
       Left = 440
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lstActDeniedOrders'
+        'Status = stsDefault')
+      (
+        'Component = hdrAction'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = lstValidOrders'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = frmInvalidActionList'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls;
+  ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmInvalidActionList = class(TForm)
+  TfrmInvalidActionList = class(TfrmBase508Form)
     pnlTop: TPanel;
     lstActDeniedOrders: TCaptionListBox;
 …
 implementation
+uses
+  VA2006Utils;
 {$R *.DFM}
 …
     ARect := TheRect;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
 …
 procedure TfrmInvalidActionList.FormCreate(Sender: TObject);
 begin
+  FixHeaderControlDelphi2006Bug(hdrAction);
   TheInvaList := TStringList.Create;
 end;
 …
     ARect := TheRect;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     SaveColor := Canvas.Brush.Color;
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

-              r456
+              r829
     Caption = 'Additional Instructions'
   end
   object cboMeasurement: TORComboBox
+  object cboMeasurement: TORComboBox [10]
     Left = 6
     Top = 21
 …
     CharsNeedMatch = 1
   end
   object cboSchedule: TORComboBox
+  object cboSchedule: TORComboBox [11]
     Left = 144
     Top = 21
 …
     CharsNeedMatch = 1
   end
   object calStart: TORDateBox
+  object calStart: TORDateBox [12]
     Left = 282
     Top = 21
 …
     Caption = 'Start Date'
   end
   object calStop: TORDateBox
+  object calStop: TORDateBox [13]
     Left = 282
     Top = 64
 …
     Caption = 'Stop Date'
   end
   object grpCallHO: TGroupBox
+  object grpCallHO: TGroupBox [14]
     Left = 407
     Top = 9
 …
       Height = 21
       Associate = txtBPsys
-      Min = 0
       Max = 300
       Position = 100
       TabOrder = 5
-      Wrap = False
     end
     object spnBPdia: TUpDown
 …
       Height = 21
       Associate = txtBPDia
-      Min = 0
       Max = 300
       Position = 120
       TabOrder = 6
-      Wrap = False
     end
     object spnPulseLT: TUpDown
 …
       Height = 21
       Associate = txtPulseLT
-      Min = 0
       Max = 500
       Position = 60
       TabOrder = 7
-      Wrap = False
     end
     object spnPulseGT: TUpDown
 …
       Height = 21
       Associate = txtPulGT
-      Min = 0
       Max = 300
       Position = 120
       TabOrder = 8
-      Wrap = False
     end
     object spnTemp: TUpDown
 …
       Height = 21
       Associate = txtTemp
-      Min = 0
       Max = 120
       Position = 101
       TabOrder = 9
+      Wrap = False
+    end
+  end
+  object chkCallHO: TCheckBox
+    end
+  end
+  object chkCallHO: TCheckBox [15]
     Left = 414
     Top = 8
 …
     Visible = False
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = txtComment'
+        'Status = stsDefault')
+      (
+        'Component = cboMeasurement'
+        'Status = stsDefault')
+      (
+        'Component = cboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = calStart'
+        'Status = stsDefault')
+      (
+        'Component = calStop'
+        'Status = stsDefault')
+      (
+        'Component = grpCallHO'
+        'Status = stsDefault')
+      (
+        'Component = txtBPsys'
+        'Status = stsDefault')
+      (
+        'Component = txtBPDia'
+        'Status = stsDefault')
+      (
+        'Component = txtPulseLT'
+        'Status = stsDefault')
+      (
+        'Component = txtPulGT'
+        'Status = stsDefault')
+      (
+        'Component = txtTemp'
+        'Status = stsDefault')
+      (
+        'Component = spnBPsys'
+        'Status = stsDefault')
+      (
+        'Component = spnBPdia'
+        'Status = stsDefault')
+      (
+        'Component = spnPulseLT'
+        'Status = stsDefault')
+      (
+        'Component = spnPulseGT'
+        'Status = stsDefault')
+      (
+        'Component = spnTemp'
+        'Status = stsDefault')
+      (
+        'Component = chkCallHO'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdQuit'
+        'Status = stsDefault')
+      (
+        'Component = pnlMessage'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = frmODVitals'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm;
+  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
 inherited frmOMAction: TfrmOMAction
   Caption = 'frmOMAction'
+  ExplicitWidth = 320
+  ExplicitHeight = 240
   PixelsPerInch = 96
   TextHeight = 13
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = frmOMAction'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, rOrders;
	7	fAutoSz, rOrders, VA508AccessibilityManager;
8	8
9	9

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

-              r456
+              r829
   Left = 390
   Top = 242
-  Width = 520
-  Height = 320
   Caption = 'HTML Ordering'
+  ClientHeight = 293
+  ClientWidth = 512
   OnClose = FormClose
   OnCreate = FormCreate
+  ExplicitWidth = 520
+  ExplicitHeight = 320
   PixelsPerInch = 96
   TextHeight = 13
   object btnOK: TButton
+  object btnOK: TButton [0]
     Left = 352
     Top = 268
 …
     OnClick = btnOKClick
   end
   object btnCancel: TButton
+  object btnCancel: TButton [1]
     Left = 433
     Top = 268
 …
     OnClick = btnCancelClick
   end
   object btnBack: TButton
+  object btnBack: TButton [2]
     Left = 6
     Top = 268
 …
     OnClick = btnBackClick
   end
   object pnlWeb: TPanel
+  object pnlWeb: TPanel [3]
     Left = 6
     Top = 6
 …
     end
   end
   object btnShow: TButton
+  object btnShow: TButton [4]
     Left = 55
     Top = 268
 …
     OnClick = btnShowClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnBack'
+        'Status = stsDefault')
+      (
+        'Component = pnlWeb'
+        'Status = stsDefault')
+      (
+        'Component = webView'
+        'Status = stsDefault')
+      (
+        'Component = btnShow'
+        'Status = stsDefault')
+      (
+        'Component = frmOMHTML'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fOMAction, StdCtrls, OleCtrls, SHDocVw, MSHTML, activex, rOrders, uConst,
   ExtCtrls;
+  ExtCtrls, VA508AccessibilityManager;
 type
 …
   end; {for i}
   CallBroker;
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   CallBroker;
   WPText.Free;
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;

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

-              r456
+              r829
+object frmOMNavA: TfrmOMNavA
+  Left = 265
+  Top = 445
+  Width = 491
+  Height = 305
+inherited frmOMNavA: TfrmOMNavA
+  Left = 212
+  Top = 354
   BorderIcons = []
+  Caption = 'frmOMNavA'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  Caption = 'Order Menu'
+  ClientHeight = 278
+  ClientWidth = 483
   OldCreateOrder = True
   OnActivate = FormActivate
 …
   OnDestroy = FormDestroy
   OnResize = FormResize
+  ExplicitLeft = 212
+  ExplicitTop = 354
+  ExplicitWidth = 491
+  ExplicitHeight = 312
   PixelsPerInch = 96
   TextHeight = 13
   object pnlTool: TPanel
+  object pnlTool: TPanel [0]
     Left = 0
     Top = 0
 …
     Color = clHighlight
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWhite
+    Font.Color = clHighlightText
     Font.Height = -11
     Font.Name = 'MS Sans Serif'
 …
       Width = 50
       Height = 17
+      Align = alRight
       Caption = 'Done'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWhite
+      Font.Color = clBtnText
       Font.Height = -11
       Font.Name = 'MS Sans Serif'
 …
       TabOrder = 0
       OnClick = cmdDoneClick
-      Align = alRight
     end
     object cmdPrev: TBitBtn
 …
     end
   end
   object grdMenu: TCaptionStringGrid
+  object grdMenu: TCaptionStringGrid [1]
     Left = 0
     Top = 19
 …
     Caption = 'Menu or Dialog Name'
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Left = 8
+    Top = 40
+    Data = (
+      (
+        'Component = pnlTool'
+        'Status = stsDefault')
+      (
+        'Component = cmdDone'
+        'Status = stsDefault')
+      (
+        'Component = cmdPrev'
+        'Status = stsDefault')
+      (
+        'Component = cmdNext'
+        'Status = stsDefault')
+      (
+        'Component = grdMenu'
+        'Status = stsDefault')
+      (
+        'Component = frmOMNavA'
+        'Status = stsDefault'))
+  end
+  object accEventsGrdMenu: TVA508ComponentAccessibility
+    Component = grdMenu
+    OnCaptionQuery = accEventsGrdMenuCaptionQuery
+    OnValueQuery = accEventsGrdMenuValueQuery
+    Left = 40
+    Top = 40
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame;
+  Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmOMNavA = class(TForm)
+  TfrmOMNavA = class(TfrmBase508Form)
     pnlTool: TPanel;
     cmdDone: TORAlignButton;
 …
     cmdPrev: TBitBtn;
     cmdNext: TBitBtn;
+    accEventsGrdMenu: TVA508ComponentAccessibility;
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
 …
       Shift: TShiftState);
     procedure FormResize(Sender: TObject);
+    procedure accEventsGrdMenuCaptionQuery(Sender: TObject;
+      var Text: string);
+    procedure accEventsGrdMenuValueQuery(Sender: TObject;
+      var Text: string);
   private
     FOrderingMenu: Integer;
 …
 uses rODBase, ORFn, fODBase,fODGen, fODAuto, fOMVerify, uCore, rMisc, uODBase,
   fOrders, uAccessibleStringGrid;
+  fOrders, VAUtils;
 const
 …
   NoFresh := True;
   ResizeFont;
   TAccessibleStringGrid.WrapControl(grdMenu);
+//  TAccessibleStringGrid.WrapControl(grdMenu);
 end;
 …
 end;
+procedure TfrmOMNavA.accEventsGrdMenuCaptionQuery(Sender: TObject;
+  var Text: string);
+begin
+  Text := pnlTool.Caption;
+end;
 procedure TfrmOMNavA.FormDestroy(Sender: TObject);
 var
 …
   OrderMenuItem: TOrderMenuItem;
 begin
   TAccessibleStringGrid.UnwrapControl(grdMenu);
+//  TAccessibleStringGrid.UnwrapControl(grdMenu);
   ClearMenuGrid;
   for i := 0 to FMenuHits.Count - 1 do
 …
       if Selected    then
       begin
+         if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
+          Font.Color := clBlue;
+        Font.Color := Get508CompliantColor(clBlue);
         Font.Style := Font.Style + [fsUnderline];
       end;
 …
     //frmFrame.UpdatePtInfoOnRefresh;
     FOrderMenuItem := TOrderMenuItem(Objects[Col, Row]);
+    if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil;          // display only
+    if Assigned(FOrderMenuItem) then
+      if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil;          // display only
     if FOrderMenuItem <> nil then
     begin
 …
     Result := False;
     InfoBox(x, TC_DISABLED, MB_OK);
+  end;
+end;
+procedure TfrmOMNavA.accEventsGrdMenuValueQuery(Sender: TObject;
+  var Text: string);
+var
+  OrderMenuItem : TOrderMenuItem;
+begin
+  inherited;
+  if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin
+    OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]);
+    if OrderMenuItem.AutoAck then
+      Text := 'Auto Accept, '+ OrderMenuItem.ItemText;
   end;
 end;
 …
        end; {'M'}
   'Q': ActivateOrderDialog(IntToStr(AnItem.IEN), FDelayEvent, Self, 0);
   'P': ShowMessage('Order Dialogs of type "Prompt" cannot be processed.');
+  'P': ShowMsg('Order Dialogs of type "Prompt" cannot be processed.');
   'O': begin
          // disable initially, since the 1st item in the set may be a menu
 …
            then Self.Enabled := True;
        end;
   else ShowMessage('Unknown Order Dialog type: ' + AnItem.DlgType);
+  else ShowMsg('Unknown Order Dialog type: ' + AnItem.DlgType);
   end; {case}
 end;

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

-              r456
+              r829
   Left = 221
   Top = 542
-  Width = 167
-  Height = 215
   BorderIcons = []
   Caption = 'Order Set Progress'
+  OnCreate = FormCreate
+  ClientHeight = 188
+  ClientWidth = 159
+  ExplicitWidth = 167
+  ExplicitHeight = 215
   PixelsPerInch = 96
   TextHeight = 13
   object lstItems: TCheckListBox
+  object lstItems: TCheckListBox [0]
     Left = 0
     Top = 0
 …
     Height = 167
     Align = alClient
     Color = 15793151
+    Color = clCream
     ItemHeight = 13
     TabOrder = 0
   end
   object cmdStop: TORAlignButton
+  object cmdStop: TORAlignButton [1]
     Left = 0
     Top = 167
     Width = 159
     Height = 21
+    Align = alBottom
     Caption = 'Stop Order Set'
     TabOrder = 1
+    Align = alBottom
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstItems'
+        'Status = stsDefault')
+      (
+        'Component = cmdStop'
+        'Status = stsDefault')
+      (
+        'Component = frmOMProgress'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn;
+  fAutoSz, StdCtrls, ORCtrls, CheckLst, ORFn, VA508AccessibilityManager;
 type
 …
     lstItems: TCheckListBox;
     cmdStop: TORAlignButton;
-    procedure FormCreate(Sender: TObject);
   private
     { Private declarations }
 …
 end;
-procedure TfrmOMProgress.FormCreate(Sender: TObject);
-begin
-  inherited;
-  lstItems.Color := ReadOnlyColor;
-end;
 end.

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

-              r456
+              r829
 object frmOMSet: TfrmOMSet
+inherited frmOMSet: TfrmOMSet
   Left = 209
   Top = 191
-  Width = 113
-  Height = 229
   BorderIcons = []
   Caption = 'Selected Orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 202
+  ClientWidth = 105
   FormStyle = fsStayOnTop
-  OldCreateOrder = False
   OnClose = FormClose
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  ExplicitWidth = 113
+  ExplicitHeight = 229
   DesignSize = (
 …
   PixelsPerInch = 96
   TextHeight = 13
   object lstSet: TCheckListBox
+  object lstSet: TCheckListBox [0]
     Left = 0
     Top = 0
 …
     TabOrder = 0
   end
   object cmdInterupt: TButton
+  object cmdInterupt: TButton [1]
     Left = 4
     Top = 172
 …
     OnClick = cmdInteruptClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstSet'
+        'Status = stsDefault')
+      (
+        'Component = cmdInterupt'
+        'Status = stsDefault')
+      (
+        'Component = frmOMSet'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe;
+  StdCtrls, CheckLst, rOrders, uConst, ORFn, rODMeds, fODBase,uCore,fOrders, fframe, fBase508Form,
+  VA508AccessibilityManager;
 type
 …
   end;
   TfrmOMSet = class(TForm)
+  TfrmOMSet = class(TfrmBase508Form)
     lstSet: TCheckListBox;
     cmdInterupt: TButton;
 …
     'D', 'Q': if not ActivateOrderDialog(IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex) then
                 begin
+                  if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
+                    lstSet.Checked[lstSet.ItemIndex] := True
+                  else SkipToNext;
+                  if Not FClosing then
+                  begin
+                    if IsCreatedByMenu(SetItem) and (lstSet.ItemIndex < lstSet.Items.Count - 1) then
+                      lstSet.Checked[lstSet.ItemIndex] := True
+                    else SkipToNext;
+                  end;
                 end;
     'M':      if ActivateOrderMenu(  IntToStr(SetItem.DialogIEN), FDelayEvent, Self, ItemIndex)

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

-              r456
+              r829
   Left = 328
   Top = 243
-  Width = 587
-  Height = 208
   BorderIcons = []
   Caption = 'New Order'
+  ClientHeight = 181
+  ClientWidth = 579
   OnClose = FormClose
   OnCreate = FormCreate
+  ExplicitWidth = 587
+  ExplicitHeight = 208
   PixelsPerInch = 96
   TextHeight = 13
   object cmdAccept: TButton
+  object cmdAccept: TButton [0]
     Left = 165
     Top = 154
 …
     OnClick = cmdAcceptClick
   end
   object cmdEdit: TButton
+  object cmdEdit: TButton [1]
     Left = 253
     Top = 154
 …
     OnClick = cmdEditClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [2]
     Left = 341
     Top = 154
 …
     OnClick = cmdCancelClick
   end
   object memText: TRichEdit
+  object memText: TRichEdit [3]
     Left = 6
     Top = 6
 …
     OnKeyUp = memTextKeyUp
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cmdAccept'
+        'Status = stsDefault')
+      (
+        'Component = cmdEdit'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = memText'
+        'Status = stsDefault')
+      (
+        'Component = frmOMVerify'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ComCtrls;
	7	fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 334
   Top = 234
-  Height = 289
   Caption = 'Comments for Order'
+  ClientHeight = 262
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 289
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 80
 …
     Caption = 'Comments:'
   end
   object cmdOK: TButton
+  object cmdOK: TButton [1]
     Left = 267
     Top = 233
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [2]
     Left = 347
     Top = 233
 …
     OnClick = cmdCancelClick
   end
   object memOrder: TMemo
+  object memOrder: TMemo [3]
     Left = 8
     Top = 8
 …
     WantReturns = False
   end
   object memComments: TRichEdit
+  object memComments: TRichEdit [4]
     Left = 8
     Top = 94
 …
     OnKeyUp = memCommentsKeyUp
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = memComments'
+        'Status = stsDefault')
+      (
+        'Component = frmWardComments'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders;
	7	fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 334
   Top = 234
-  Height = 191
   Caption = 'Flag Order'
+  ClientHeight = 264
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitLeft = 334
+  ExplicitTop = 234
+  ExplicitWidth = 320
+  ExplicitHeight = 291
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 80
     Width = 75
+    Width = 199
     Height = 13
     Caption = 'Reason for Flag'
+    Caption = 'Reason for Flag    (Enter or select from list)'
   end
   object lblAlertRecipient: TLabel
+  object lblAlertRecipient: TLabel [1]
     Left = 8
     Top = 123
+    Top = 211
     Width = 69
     Height = 13
     Caption = 'Alert Recipient'
   end
+  object txtReason: TCaptionEdit
+    Left = 8
+    Top = 94
+    Width = 411
+    Height = 21
+    MaxLength = 80
+    TabOrder = 0
+    Caption = 'Reason for Flag'
+  end
+  object cmdOK: TButton
+  object cmdOK: TButton [2]
     Left = 267
     Top = 139
+    Top = 227
     Width = 72
     Height = 21
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [3]
     Left = 347
     Top = 139
+    Top = 227
     Width = 72
     Height = 21
 …
     OnClick = cmdCancelClick
   end
   object memOrder: TMemo
+  object memOrder: TMemo [4]
     Left = 8
     Top = 8
 …
     WantReturns = False
   end
   object cboAlertRecipient: TORComboBox
+  object cboAlertRecipient: TORComboBox [5]
     Left = 7
     Top = 139
+    Top = 227
     Width = 226
     Height = 21
 …
     CharsNeedMatch = 1
   end
+  object cboFlagReason: TORComboBox [6]
+    Left = 8
+    Top = 99
+    Width = 411
+    Height = 106
+    Style = orcsSimple
+    AutoSelect = True
+    Color = clWindow
+    DropDownCount = 8
+    ItemHeight = 13
+    ItemTipColor = clWindow
+    ItemTipEnable = True
+    ListItemsOnly = False
+    LongList = False
+    LookupPiece = 0
+    MaxLength = 80
+    Pieces = '2'
+    Sorted = False
+    SynonymChars = '<>'
+    TabOrder = 0
+    CharsNeedMatch = 1
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = cboAlertRecipient'
+        'Status = stsDefault')
+      (
+        'Component = cboFlagReason'
+        'Status = stsDefault')
+      (
+        'Component = frmFlagOrder'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls;
+  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
 type
   TfrmFlagOrder = class(TfrmAutoSz)
-    txtReason: TCaptionEdit;
     Label1: TLabel;
     cmdOK: TButton;
 …
     lblAlertRecipient: TLabel;
     cboAlertRecipient: TORComboBox;
+    cboFlagReason: TORComboBox;
     procedure FormCreate(Sender: TObject);
     procedure cmdOKClick(Sender: TObject);
 …
       if OKPressed then
       begin
         FlagOrder(AnOrder, txtReason.Text, AlertRecip);
+        FlagOrder(AnOrder, cboFlagReason.Text, AlertRecip);
         Result := True;
       end;
 …
 procedure TfrmFlagOrder.FormCreate(Sender: TObject);
+var
+  tmpList: TStringList;
 begin
   inherited;
   OKPressed := False;
+  tmpList := TStringList.Create;
+  try
+    GetUserListParam(tmpList, 'OR FLAGGED ORD REASONS');
+    FastAssign(tmpList, cboFlagReason.Items);
+  finally
+    tmpList.Free;
+  end;
   cboAlertRecipient.InitLongList('');
   //cboAlertRecipient.SelectByIEN(User.DUZ);
 …
 begin
   inherited;
+  if txtReason.Text = '' then
+  if cboFlagReason.Text = '' then
+  //if txtReason.Text = '' then
   begin
     InfoBox(TX_REASON_REQ, TC_REASON_REQ, MB_OK);

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

-              r456
+              r829
   Left = 308
   Top = 171
-  Width = 363
-  Height = 362
   Caption = 'Add to Common List (Meds, Inpatient)'
+  ClientHeight = 335
+  ClientWidth = 355
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitLeft = 308
+  ExplicitTop = 171
+  ExplicitWidth = 363
+  ExplicitHeight = 362
   PixelsPerInch = 96
   TextHeight = 13
   object Panel1: TPanel
+  object Panel1: TPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
   object Panel2: TPanel
+  object Panel2: TPanel [1]
     Left = 0
     Top = 113
 …
     end
   end
   object Panel3: TPanel
+  object Panel3: TPanel [2]
     Left = 0
     Top = 294
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = txtDisplayName'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = lstQuickList'
+        'Status = stsDefault')
+      (
+        'Component = pnlUpButton'
+        'Status = stsDefault')
+      (
+        'Component = pnlDownButton'
+        'Status = stsDefault')
+      (
+        'Component = cmdRename'
+        'Status = stsDefault')
+      (
+        'Component = cmdDelete'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmSaveQuickOrder'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders;
+  fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, ORFn, fODBase, uOrders,
+  VA508AccessibilityManager;
 type
 …
   TX_NO_TEXT     = 'No fields have been entered - cannot save as quick order.';
   TC_NO_TEXT     = 'Save as Quick Order';
+  TX_DUP_NAME = 'There is already a quick order with that name.' + CRLF +
+                'Please either delete the original or enter a different name.';
+  TC_DUP_NAME = 'Unable to save quick order';
+  TC_DUP_RENAME = 'Unable to rename quick order';
 function EditCommonList(ADisplayGroup: Integer): Boolean;
 …
         ItemIndex := 0;
       end;
+      ActiveControl := lstQuickList;
       ShowModal;
       if OKPressed then
 …
       else
         DGroupName := NameOfDGroup(ResponseSet.DisplayGroup);
+      if DGroupName = 'Inpt. Meds' then
+        begin
+          ResponseSet.DisplayGroup := InptDisp;
+          DGroupName := NameOfDGroup(InptDisp);
+        end;
       Caption := 'Add Quick Order (' + DGroupName + ')';
       lblQuickList.Caption := 'Common List for ' + DGroupName;
 …
         ItemIndex := 0;
       end;
+      ActiveControl := txtDisplayName;
       ShowModal;
       if OKPressed then
 …
 var
   AName: string;
+  i: integer;
 begin
   inherited;
 …
     if ItemIndex < 0 then Exit;
     AName := Piece(Items[ItemIndex], U, 2);
+    if ExecuteRename(AName, TX_QO_RENAME)
+      then Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
+  end;
+    if ExecuteRename(AName, TX_QO_RENAME) then
+    begin
+      i := Items.IndexOf(AName);
+      if (i > -1) and (i <> ItemIndex) then
+        InfoBox(TX_DUP_NAME, TC_DUP_RENAME, MB_ICONERROR or MB_OK)
+      else
+        Items[ItemIndex] := Piece(Items[ItemIndex], U, 1) + U + AName;
+    end;
+  end;
 end;
 …
 procedure TfrmSaveQuickOrder.cmdOKClick(Sender: TObject);
+begin
+  inherited;
+  if txtDisplayName.Enabled and (txtDisplayName.Text = '') then
+  begin
+    InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
+    Exit;
+var
+  i: integer;
+begin
+  inherited;
+  if txtDisplayName.Enabled then
+  begin
+    if (txtDisplayName.Text = '') then
+    begin
+      InfoBox(TX_DNAME_REQ, TC_DNAME_REQ, MB_OK);
+      Exit;
+    end;
+    for i := 0 to lstQuickList.Count - 1 do
+      if (UpperCase(lstQuickList.DisplayText[i]) = UpperCase(txtDisplayName.Text)) and (i > 0) then
+      begin
+        InfoBox(TX_DUP_NAME, TC_DUP_NAME, MB_ICONERROR or MB_OK);
+        lstQuickList.ItemIndex := i;
+        Exit;
+      end;
   end;
   OKPressed := True;

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

-              r456
+              r829
   Left = 365
   Top = 389
-  Height = 230
   Caption = 'Unflag Order'
+  ClientHeight = 203
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 230
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 123
 …
     Caption = 'Comment (optional)'
   end
   object txtComment: TCaptionEdit
+  object txtComment: TCaptionEdit [1]
     Left = 8
     Top = 137
 …
     Caption = 'Comment (optional)'
   end
   object cmdOK: TButton
+  object cmdOK: TButton [2]
     Left = 267
     Top = 174
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [3]
     Left = 347
     Top = 174
 …
     OnClick = cmdCancelClick
   end
   object memReason: TMemo
+  object memReason: TMemo [4]
     Left = 8
     Top = 80
 …
     WantReturns = False
   end
   object memOrder: TMemo
+  object memOrder: TMemo [5]
     Left = 8
     Top = 8
 …
     WantReturns = False
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = txtComment'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = memReason'
+        'Status = stsDefault')
+      (
+        'Component = memOrder'
+        'Status = stsDefault')
+      (
+        'Component = frmUnflagOrder'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls;
	7	fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 340
   Top = 165
-  Width = 429
-  Height = 440
   Caption = 'Custom Order View'
+  ClientHeight = 413
+  ClientWidth = 421
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitLeft = 340
+  ExplicitTop = 165
+  ExplicitWidth = 429
+  ExplicitHeight = 440
   PixelsPerInch = 96
   TextHeight = 13
   object pnlView: TPanel
+  object pnlView: TPanel [0]
     Left = 0
     Top = 0
 …
       Caption = 'All Services, Active Orders'
       Layout = tlCenter
+    end
+  end
+  object Panel1: TPanel
+      ExplicitWidth = 153
+      ExplicitHeight = 13
+    end
+  end
+  object Panel1: TPanel [1]
     Left = 0
     Top = 21
     Width = 421
     Height = 277
+    Height = 278
     Align = alClient
     BevelOuter = bvNone
 …
       Left = 211
       Top = 0
+      Width = 3
+      Height = 277
+      Cursor = crHSplit
+      Height = 278
       MinSize = 1
       OnMoved = Splitter1Moved
 …
       Top = 0
       Width = 211
       Height = 277
+      Height = 278
       Align = alLeft
       Constraints.MinWidth = 15
 …
         Caption = 'Order Status'
         Layout = tlCenter
+        ExplicitWidth = 59
       end
       object trFilters: TCaptionTreeView
 …
         Top = 14
         Width = 209
         Height = 262
+        Height = 263
         Align = alClient
+        HideSelection = False
         Indent = 19
         TabOrder = 0
 …
       Top = 0
       Width = 207
       Height = 277
+      Height = 278
       Align = alClient
       Constraints.MinWidth = 15
 …
         Caption = 'Service/Section'
         Layout = tlCenter
+        ExplicitWidth = 77
       end
       object treService: TCaptionTreeView
 …
         Top = 14
         Width = 205
         Height = 262
+        Height = 263
         Align = alClient
+        HideSelection = False
         Indent = 19
         TabOrder = 0
 …
     end
   end
   object Panel4: TPanel
+  object Panel4: TPanel [2]
     Left = 0
     Top = 298
+    Top = 299
     Width = 421
     Height = 114
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlView'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = trFilters'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = treService'
+        'Status = stsDefault')
+      (
+        'Component = Panel4'
+        'Status = stsDefault')
+      (
+        'Component = chkDateRange'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox1'
+        'Status = stsDefault')
+      (
+        'Component = calFrom'
+        'Status = stsDefault')
+      (
+        'Component = calThru'
+        'Status = stsDefault')
+      (
+        'Component = chkInvChrono'
+        'Status = stsDefault')
+      (
+        'Component = chkByService'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmOrderView'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm;
+  fAutoSz, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, ORFn, rOrders, ORDtTm,
+  VA508AccessibilityManager;
 type
 …
     Item[i].Expanded := True;
     Item[i].Selected := True;
+    FDGroupName := Item[i].Text;
+    FFilter := Integer(Item[i].Data);
+    FFilterName := Item[i].Text;
     Break;
   end;
 …
     FFilter := Integer(Node.Data);
     FFilterName := Node.Text;
+    chkDateRange.Enabled := True;
     if FFilter = 2 then                          // disallow date range for active orders view
     begin
 …
       chkDateRangeClick(Self);
     end;
+    if FFilter = 5 then                          // disallow date range for expiring orders view
+    begin
+      chkDateRange.Checked := False;
+      chkDateRangeClick(Self);
+      chkDateRange.Enabled := False;
+    end;
     if FFilter in [8, 9, 10, 20] then chkDateRange.Checked := True else
     begin

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

-              r456
+              r829
 inherited frmOrders: TfrmOrders
   Left = 451
+  Top = 250
+  Width = 774
+  Height = 579
+  Top = 177
   HelpContext = 4000
   Caption = 'Orders Page'
+  ClientHeight = 571
+  ClientWidth = 766
   HelpFile = 'overvw'
   Menu = mnuOrders
   OnDestroy = FormDestroy
   OnShow = FormShow
+  ExplicitWidth = 774
+  ExplicitHeight = 617
   PixelsPerInch = 96
   TextHeight = 13
   inherited shpPageBottom: TShape
     Top = 528
+    Top = 566
     Width = 766
+    ExplicitTop = 528
+    ExplicitWidth = 766
   end
   inherited sptHorz: TSplitter
     Left = 117
     Height = 528
+    Height = 566
     OnMoved = sptHorzMoved
+    ExplicitLeft = 117
+    ExplicitHeight = 528
   end
   inherited pnlLeft: TPanel
     Width = 117
+    Height = 528
+    Height = 566
+    ExplicitWidth = 117
+    ExplicitHeight = 566
     object OROffsetLabel1: TOROffsetLabel
       Left = 0
 …
       Top = 116
       Width = 117
       Height = 412
+      Height = 450
       Align = alClient
       ItemHeight = 13
 …
       Width = 117
       Height = 18
+      Align = alTop
       Caption = 'Write Delayed Orders'
       TabOrder = 1
       OnClick = btnDelayedOrderClick
-      Align = alTop
       Alignment = taLeftJustify
     end
 …
     Left = 121
     Width = 645
     Height = 528
+    Height = 566
     ParentColor = True
     ParentCtl3D = False
     ParentFont = False
     OnResize = pnlRightResize
+    ExplicitLeft = 121
+    ExplicitWidth = 645
+    ExplicitHeight = 566
     object lblOrders: TOROffsetLabel
       Left = 0
 …
       Width = 645
       Height = 17
-      DragReorder = False
       Sections = <
         item
 …
       Top = 36
       Width = 645
       Height = 492
+      Height = 530
       Style = lbOwnerDrawVariable
       Align = alClient
 …
       OnDrawItem = lstOrdersDrawItem
       OnMeasureItem = lstOrdersMeasureItem
-      RightClickSelect = True
       Caption = 'Active Orders'
     end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstSheets'
+        'Status = stsDefault')
+      (
+        'Component = lstWrite'
+        'Status = stsDefault')
+      (
+        'Component = btnDelayedOrder'
+        'Status = stsDefault')
+      (
+        'Component = hdrOrders'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = pnlLeft'
+        'Status = stsDefault')
+      (
+        'Component = pnlRight'
+        'Status = stsDefault')
+      (
+        'Component = frmOrders'
+        'Status = stsDefault'))
   end
   object mnuOrders: TMainMenu

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls,
   ExtCtrls, Menus, ORCtrls, ComCtrls, ORFn, rOrders, fODBase, uConst, uCore, uOrders,UBACore,
   UBAGlobals;
+  UBAGlobals, VA508AccessibilityManager, fBase508Form;
 type
 …
   private
     { Private declarations }
+    OrderListClickProcessing : Boolean;
     FDfltSort: Integer;
     FCurrentView: TOrderView;
 …
     FDontCheck: boolean;
     FParentComplexOrderID: string;
+    FHighContrast2Mode: boolean;
     function CanChangeOrderView: Boolean;
     function GetEvtIFN(AnIndex: integer): string;
 …
     procedure UseDefaultSort;
     procedure SynchListToOrders;
 //    procedure ActivateDeactiveRenew;
+    procedure ActivateDeactiveRenew;
     procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
     procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
 …
     function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
     function GetPlainText(AnOrder: TOrder; index: integer):string;
     function PatientStatusChanged: boolean;
+    //function PatientStatusChanged: boolean;
     procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR;
     function CheckOrderStatus: boolean;
+    procedure RightClickMessageHandler(var Msg: TMessage; var Handled: Boolean);
   public
     procedure setSectionWidths; //CQ6170
 …
      fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild,
      fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses,
+     fODConsult, fClinicWardMeds, fActivateDeactivate;
+     fODConsult, fClinicWardMeds, fActivateDeactivate, VA2006Utils, rodMeds,
+     VA508AccessibilityRouter, VAUtils;
 {$R *.DFM}
 …
   AChildList: TStringlist;
   CplxOrderID: string;
+  DCNewOrder: boolean;
+  DCChangeItem: TChangeItem;
   procedure RemoveFromOrderList(ChildOrderID: string);
 …
                   then CanSign := CH_SIGN_YES
                   else CanSign := CH_SIGN_NA;
+                DCOrder(OrderForList, GetReqReason, ReturnedType);
+                DCNEwOrder := false;
+                if Changes.Orders.Count > 0 then
+                  begin
+                    for j := 0 to Changes.Orders.Count - 1 do
+                      begin
+                        DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
+                        if DCChangeItem.ID = OrderForList.ID then
+                          begin
+                            if (Pos('DC', OrderForList.ActionOn) = 0) then
+                            DCNewOrder := True;
+                            //else DCNewOrder := False;
+                          end;
+                      end;
+                  end;
+                DCOrder(OrderForList, GetReqReason, DCNewOrder, ReturnedType);
                 Changes.Add(CH_ORD, OrderForList.ID, OrderForList.Text, '', CanSign);
                 FCompress := True;
 …
 begin
   inherited;
+  OrderListClickProcessing := false;
+  FixHeaderControlDelphi2006Bug(hdrOrders);
   PageID             := CT_ORDERS;
-  lstOrders.Color    := ReadOnlyColor;
   uOrderList         := TList.Create;
   uEvtDCList         := TList.Create;
 …
   FDontCheck := False;
   FParentComplexOrderID := '';
+  // 508 black color scheme that causes problems
+  FHighContrast2Mode := BlackColorScheme and (ColorToRGB(clInfoBk) <> ColorToRGB(clBlack));
+  AddMessageHandler(lstOrders, RightClickMessageHandler);
 end;
 …
 begin
   inherited;
+  RemoveMessageHandler(lstOrders, RightClickMessageHandler);
   ClearOrders(uOrderList);
   uEvtDCList.Clear;
 …
     SaveTop := TopIndex;
     Clear;
+    repaint;
     for i := 0 to uOrderList.Count - 1 do
     begin
 …
   inherited;
   if not CanChangeOrderView then Exit;
+  AnOrderView := TOrderView.Create;
+  AnOrderView.Filter    := STS_ACTIVE;
+  AnOrderView.DGroup    := DGroupAll;
+  AnOrderView.ViewName  := 'All Services, Active';
+  AnOrderView.InvChrono := True;
+  AnOrderView.ByService := True;
+  AnOrderView.CtxtTime  := 0;
+  AnOrderView.TextView  := 0;
+  AnOrderView.EventDelay.EventType := 'C';
+  AnOrderView.EventDelay.Specialty := 0;
+  AnOrderView.EventDelay.Effective := 0;
+  AnOrderView.EventDelay.EventIFN  := 0;
+  AnOrderView.EventDelay.EventName := 'All Services, Active';
+  SelectOrderView(AnOrderView);
+  with AnOrderView do if Changed then
+  begin
+    FCurrentView := AnOrderView;
+    if FCurrentView.Filter in [15,16,17,24] then
+    begin
+      FCompress      := False;
+      mnuActRel.Visible   := True;
+      popOrderRel.Visible := True;
+    end else
+    begin
+      mnuActRel.Visible   := False;
+      popOrderRel.Visible := False;
+    end;
+    lstSheets.ItemIndex := -1;
+    lblWrite.Caption := 'Write Orders';
+    lstWrite.Clear;
+    lstWrite.Caption := lblWrite.Caption;
+    LoadWriteOrders(lstWrite.Items);
+    RefreshOrderList(FROM_SERVER);
+    if ByService then
+    begin
+      if InvChrono then FDfltSort := OVS_CATINV  else FDfltSort := OVS_CATFWD;
+    end else
+    begin
+      if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
+    end;
+  AnOrderView := TOrderView.Create;              //       - this starts fresh instead, since CPRS v22
+  try
+    AnOrderView.Assign(FCurrentView);              // RV - v27.1 - preload form with current view params
+  (*  AnOrderView.Filter    := STS_ACTIVE;                    - CQ #11261
+    AnOrderView.DGroup    := DGroupAll;
+    AnOrderView.ViewName  := 'All Services, Active';
+    AnOrderView.InvChrono := True;
+    AnOrderView.ByService := True;
+    AnOrderView.CtxtTime  := 0;
+    AnOrderView.TextView  := 0;
+    AnOrderView.EventDelay.EventType := 'C';
+    AnOrderView.EventDelay.Specialty := 0;
+    AnOrderView.EventDelay.Effective := 0;
+    AnOrderView.EventDelay.EventIFN  := 0;
+    AnOrderView.EventDelay.EventName := 'All Services, Active';*)
+    SelectOrderView(AnOrderView);
+    with AnOrderView do if Changed then
+    begin
+      FCurrentView.Assign(AnOrderView);
+      if FCurrentView.Filter in [15,16,17,24] then
+      begin
+        FCompress      := False;
+        mnuActRel.Visible   := True;
+        popOrderRel.Visible := True;
+      end else
+      begin
+        mnuActRel.Visible   := False;
+        popOrderRel.Visible := False;
+      end;
+      //lstSheets.ItemIndex := -1;
+      lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName;   // v27.5 - RV
+      lblWrite.Caption := 'Write Orders';
+      lstWrite.Clear;
+      lstWrite.Caption := lblWrite.Caption;
+      LoadWriteOrders(lstWrite.Items);
+      RefreshOrderList(FROM_SERVER);
+      if ByService then
+      begin
+        if InvChrono then FDfltSort := OVS_CATINV  else FDfltSort := OVS_CATFWD;
+      end else
+      begin
+        if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
+      end;
+    end;
+  finally
+    AnOrderView.free;
   end;
 end;
 …
       AnOrderID := Piece(BigOrderID, ';', 1);
       if StrToIntDef(AnOrderID,0) = 0 then
         ShowMessage('Detail view is not available for selected order.')
+        ShowMsg('Detail view is not available for selected order.')
       else
         begin
           tmpList.Assign(DetailOrder(BigOrderID));
+          FastAssign(DetailOrder(BigOrderID), tmpList);
           if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or
               (TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or
               (TOrder(Items.Objects[i]).DGroupName = 'Clin. Orders') or
+              (TOrder(Items.Objects[i]).DGroupName = 'Clinic Orders') or
               (TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then
             begin
 …
               tmpList.Add(StringOfChar('=', 74));
               tmpList.Add('');
               tmpList.AddStrings(MedAdminHistory(AnOrderID));
+              FastAddStrings(MedAdminHistory(AnOrderID), tmpList);
             end;
 …
 end;
+procedure TfrmOrders.RightClickMessageHandler(var Msg: TMessage;
+  var Handled: Boolean);
+begin
+  if Msg.Msg = WM_RBUTTONUP then
+    lstOrders.RightClickSelect := (lstOrders.SelCount < 1);
+end;
 function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string;
 var
 …
   else
     FirstColumnDisplayed := 1;
   for i:= FirstColumnDisplayed to 8 do begin
+  for i:= FirstColumnDisplayed to 9 do begin
     x := GetOrderText(AnOrder, index, i);
     if x <> '' then
 …
     {measure height of start/stop times}
     NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 3));
     if NewHeight > 255 then NewHeight := 255;
+    if NewHeight > 255 then NewHeight := 255;  // This is maximum allowed by a Windows
     if NewHeight <  13 then NewHeight := 13;
   end;
 …
 function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string;
+var
+  AReason:  TStringlist;
+  i: integer;
 begin
   if AnOrder <> nil then with AnOrder do
 …
         result := Text;
         if Flagged then
+          result := result + ' *Flagged*';
+        begin
+          if Notifications.Active then
+          begin
+            AReason := TStringList.Create;
+            try
+              result := result + crlf;
+              LoadFlagReason(AReason, ID);
+              for i := 0 to AReason.Count - 1 do
+                result :=  result + AReason[i] + CRLF;
+            finally
+              AReason.Free;
+            end;
+          end
+          else
+            result := result + '  *Flagged*';
+        end;
       end;
 : result := GetStartStopText( StartTime, StopTime);
 …
     end;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
 …
         if i = FirstColumnDisplayed then
         begin
           if Flagged and (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) then
+          if Flagged then
           begin
             Canvas.Brush.Color := clRed;
+            Canvas.Brush.Color := Get508CompliantColor(clRed);
             Canvas.FillRect(ARect);
           end;
 …
           if not (odSelected in State) and (AnOrder.Signature = OSS_UNSIGNED) then
           begin
+            if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
+              Canvas.Font.Color := clBlue;
+            if FHighContrast2Mode then
+              Canvas.Font.Color := clBlue
+            else
+              Canvas.Font.Color := Get508CompliantColor(clBlue);
           end;
         end;
 …
   inherited;
   FEvtColWidth := hdrOrders.Sections[0].Width;
-  RedrawSuspend(Self.Handle);
   RedrawOrderList;
-  RedrawActivate(Self.Handle);
   lstOrders.Invalidate;
   pnlRight.Refresh;
 …
   NextIndex: Integer;
 begin
+  if PatientStatusChanged then exit;
+  if OrderListClickProcessing then Exit;
+  OrderListClickProcessing := true;   //Make sure this gets set to false prior to exiting.
+  //if PatientStatusChanged then exit;
   if BILLING_AWARE then //CQ5114
      fODConsult.displayDXCode := ''; //CQ5114
 …
   NextIndex := lstWrite.ItemIndex;
   if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
+  begin
+    OrderListClickProcessing := false;
     Exit;
+  end;
   if not ReadyForNewOrder(FCurrentView.EventDelay) then
   begin
     lstWrite.ItemIndex := RefNumFor(Self);
+    OrderListClickProcessing := false;
     Exit;
   end;
   // don't write delayed orders for non-VA meds:
   if (FCurrentView.EventDelay.EventIFN>0) and (Piece(lstWrite.ItemID,';',2) = '145') then
     begin
       InfoBox('Delayed orders cannot be written for Non-VA Medications.', 'Meds, Non-VA', MB_OK);
+      OrderListClickProcessing := false;
       Exit;
     end;
 …
       begin
         lstWrite.ItemIndex := -1;
+        OrderListClickProcessing := false;
         Exit;
       end;
+  if frmFrame.CCOWDrivedChange then
+  if frmFrame.CCOWDrivedChange then begin
+    OrderListClickProcessing := false;
     Exit;
+  end;
   PositionTopOrder(StrToIntDef(Piece(lstWrite.ItemID, ';', 3), 0));  // position Display Group
   case CharAt(Piece(lstWrite.ItemID, ';', 4), 1) of
 …
     lstSheetsClick(Self);
   end;
+  OrderListClickProcessing := false;
   if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and
     (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
 …
     begin
       AnOrder := TOrder(Items.Objects[i]);
+      if (AnAction = 'RN') and (PassDrugTest(StrtoINT(Piece(AnOrder.ID, ';',1)), 'E', True, True)=True) then
+        begin
+          ShowMsg('Cannot renew Clozapine orders.');
+          Selected[i] := false;
+        end;
       if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
          begin
 …
         begin
           if (AnAction = 'RN') then
             ShowMessage('The order contains invalid schedule and can not be renewed.')
+            ShowMsg('The order contains invalid schedule and can not be renewed.')
           else if (AnAction = 'EV') then
             ShowMessage('The order contains invalid schedule and can not be changed to event delayed order.');
+            ShowMsg('The order contains invalid schedule and can not be changed to event delayed order.');
           Selected[i] := False;
 …
     //if CheckOrderStatus = True then Exit;
     ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order
     //ActivateDeactiveRenew;   AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
+    ActivateDeactiveRenew;   //AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
     MakeSelectedList(SelectedList);                     // build list of orders that remain
     // updating the Changes object happens in ExecuteDCOrders, based on individual order
 …
   if not CanManualRelease then
   begin
     ShowMessage('You are not authorized to manual release delayed orders.');
+    ShowMsg('You are not authorized to manual release delayed orders.');
     Exit;
   end;
 …
     ChangeIFNList.Free;
   end;
+  if frmFrame.TimedOut then Exit;
   RedrawOrderList;
 end;
 …
   if (User.OrderRole <> 2) and (User.OrderRole <> 3) then
   begin
     ShowMessage('Sorry, You don''t have the permission to release selected orders manually');
+    ShowMsg('Sorry, You don''t have the permission to release selected orders manually');
     Exit;
   end;
 …
     if i > 0 then
       IsDefaultDlg := False;
     ADest.ItemIndex := -1;
     for j := 0 to ADest.Items.Count - 1 do
 …
 begin
   inherited;
   if PatientStatusChanged then exit;
+  //if PatientStatusChanged then exit;
   //frmFrame.UpdatePtInfoOnRefresh;
 end;
 …
 begin
   inherited;
   if PatientStatusChanged then exit;
+  //if PatientStatusChanged then exit;
   //frmFrame.UpdatePtInfoOnRefresh;
 end;
 …
 begin
   inherited;
   if PatientStatusChanged then exit;
+  //if PatientStatusChanged then exit;
   //frmFrame.UpdatePtInfoOnRefresh;
 end;
 …
 begin
   inherited;
   if PatientStatusChanged then exit;
+  //if PatientStatusChanged then exit;
   //frmFrame.UpdatePtInfoOnRefresh;
 end;
 …
 end;
 function TfrmOrders.PatientStatusChanged: boolean;
+{function TfrmOrders.PatientStatusChanged: boolean;
 const
 …
     Result := True;
   end;
 end;
+end;}
 function TfrmOrders.CheckOrderStatus: boolean;
 …
 i: integer;
 AnOrder: TOrder;
+OrderArray: TStringList;
 begin
     Result := False;
+    OrderArray := TStringList.Create;
     with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
     begin
       AnOrder := TOrder(Items.Objects[i]);
+      if AnORder.Status <> GetOrderStatus(AnOrder.ID) then
+         begin
+           MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
+           frmFrame.mnuFileRefreshClick(Application);
+           Result := True;
+           EXIT;
+         end;
+    end;
+end;
+(*procedure TfrmOrders.ActivateDeactiveRenew;
+      OrderArray.Add(AnOrder.ID + U + InttoStr(AnOrder.Status));
+    end;
+    if (OrderArray <> nil) and (not DoesOrderStatusMatch(OrderArray)) then
+      begin
+        MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
+        frmFrame.mnuFileRefreshClick(Application);
+        Result := True;
+      end;
+    ORderArray.Free;
+end;
+procedure TfrmOrders.ActivateDeactiveRenew;
 var
   i: Integer;
 …
     end;
     if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr);
 end;  *)
+end;
 procedure TfrmOrders.ViewInfo(Sender: TObject);
 …
 end;
+initialization
+  SpecifyFormIsNotADialog(TfrmOrders);
 end.

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

-              r456
+              r829
   Left = 374
   Top = 193
-  Height = 278
   Caption = 'Alert when Results Available'
+  ClientHeight = 251
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 278
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
       ' -'
   end
   object lblAlertRecipient: TLabel
+  object lblAlertRecipient: TLabel [1]
     Left = 8
     Top = 208
 …
     Caption = 'Alert Recipient:'
   end
   object lstOrders: TCaptionListBox
+  object lstOrders: TCaptionListBox [2]
     Left = 8
     Top = 22
 …
       ' -'
   end
   object cmdOK: TButton
+  object cmdOK: TButton [3]
     Left = 267
     Top = 222
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [4]
     Left = 347
     Top = 222
 …
     OnClick = cmdCancelClick
   end
   object cboAlertRecipient: TORComboBox
+  object cboAlertRecipient: TORComboBox [5]
     Left = 7
     Top = 226
 …
     OnExit = cboOnExit
     OnNeedData = cboAlertRecipientNeedData
+    CharsNeedMatch = 1
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cboAlertRecipient'
+        'Status = stsDefault')
+      (
+        'Component = frmAlertOrders'
+        'Status = stsDefault'))
   end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
 object frmChgEvent: TfrmChgEvent
+inherited frmChgEvent: TfrmChgEvent
   Left = 256
   Top = 148
-  Width = 562
-  Height = 428
   Caption = 'Change Release Event'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 401
+  ClientWidth = 554
   OldCreateOrder = False
   OnClose = FormClose
   OnCreate = FormCreate
+  ExplicitWidth = 562
+  ExplicitHeight = 428
   PixelsPerInch = 96
   TextHeight = 13
   object pnlTop: TPanel
+  object pnlTop: TPanel [0]
     Left = 0
     Top = 0
 …
       Left = 1
       Top = 1
       Width = 552
+      Width = 3
       Height = 36
       Align = alTop
 …
     end
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 38
     Width = 554
     Height = 362
+    Height = 363
     Align = alClient
     TabOrder = 1
+    ExplicitHeight = 362
     DesignSize = (
 )
+)
     object cboSpecialty: TORComboBox
       Left = 12
 …
       OnChange = cboSpecialtyChange
       OnDblClick = cboSpecialtyDblClick
+      CharsNeedMatch = 1
     end
     object btnCancel: TButton
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cboSpecialty'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnAction'
+        'Status = stsDefault')
+      (
+        'Component = frmChgEvent'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders;
+  StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
   Left = 327
   Top = 169
-  Height = 284
   Caption = 'Complete Orders'
+  ClientHeight = 257
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 284
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
     Caption = 'The following orders will be marked as complete -'
   end
   object lblESCode: TLabel
+  object lblESCode: TLabel [1]
     Left = 8
     Top = 214
 …
     Caption = 'Electronic Signature Code'
   end
   object lstOrders: TCaptionListBox
+  object lstOrders: TCaptionListBox [2]
     Left = 8
     Top = 22
 …
     Caption = 'The following orders will be marked as complete -'
   end
   object cmdOK: TButton
+  object cmdOK: TButton [3]
     Left = 267
     Top = 228
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [4]
     Left = 347
     Top = 228
 …
     OnClick = cmdCancelClick
   end
   object txtESCode: TCaptionEdit
+  object txtESCode: TCaptionEdit [5]
     Left = 8
     Top = 228
 …
     Caption = 'Electronic Signature Code'
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = txtESCode'
+        'Status = stsDefault')
+      (
+        'Component = frmCompleteOrders'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
 object frmCopyOrders: TfrmCopyOrders
+inherited frmCopyOrders: TfrmCopyOrders
   Left = 319
   Top = 139
-  AutoScroll = False
   Caption = 'Copy Orders'
   ClientHeight = 419
   ClientWidth = 441
-  Color = clBtnFace
   Constraints.MinHeight = 100
   Constraints.MinWidth = 330
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = True
   OnCreate = FormCreate
+  OnKeyDown = FormKeyDown
+  ExplicitWidth = 449
+  ExplicitHeight = 446
   PixelsPerInch = 96
   TextHeight = 13
   object pnlInfo: TPanel
+  object pnlRadio: TPanel [0]
     Left = 0
     Top = 41
+    Top = 80
     Width = 441
     Height = 50
+    Height = 65
     Align = alTop
     TabOrder = 1
-    object Image1: TImage
-      Left = 1
-      Top = 1
-      Width = 24
-      Height = 22
-      AutoSize = True
-      Enabled = False
-      Picture.Data = {
-        07544269746D61707E010000424D7E0100000000000076000000280000001800
-        000016000000010004000000000008010000C40E0000C40E0000100000000000
-        0000000000000000800000800000008080008000000080008000808000008080
-C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
-        FF008000000000000000000000080777777777777777777777700F7777777777
-        7777777777700F88888888888888888887700F88888888888888888887700F88
-        888808888888888887700F88888800888888888887700F8888880B0888888888
-F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC
-        CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F88
-BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB088
-F888800BBBBBBB0088887700F88888800000008888887700F8888888888
-        8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF708000
-        00000000000000000008}
-      Transparent = True
-    end
-    object Label2: TStaticText
-      Left = 31
-      Top = 30
-      Width = 365
-      Height = 17
-      Caption =
-        'Use Transfer: if inpatient will move from one ward or treating t' +
-        'eam to another.'
-      TabOrder = 1
-      TabStop = True
-    end
-    object Label1: TStaticText
-      Left = 31
-      Top = 4
-      Width = 331
-      Height = 17
-      Caption =
-        'Use Admit: if patient is newly admitted to the hospital or nursi' +
-        'ng home.'
-      TabOrder = 0
-      TabStop = True
-    end
-  end
-  inline fraEvntDelayList: TfraEvntDelayList
-    Left = 0
-    Top = 154
-    Width = 441
-    Height = 265
-    Align = alClient
-    TabOrder = 3
-    Visible = False
-    inherited pnlDate: TPanel
-      Left = 336
-      Height = 265
-      inherited lblEffective: TLabel
-        Left = 451
-      end
-      inherited orDateBox: TORDateBox
-        Left = 451
-      end
-    end
-    inherited pnlList: TPanel
-      Width = 336
-      Height = 265
-      inherited lblEvntDelayList: TLabel
-        Width = 334
-      end
-      inherited mlstEvents: TORListBox
-        Width = 334
-        Height = 229
-        OnDblClick = cmdOKClick
-        OnChange = fraEvntDelayListmlstEventsChange
-      end
-      inherited edtSearch: TCaptionEdit
-        Width = 334
-      end
-    end
-  end
-  object pnlRadio: TPanel
-    Left = 0
-    Top = 91
-    Width = 441
-    Height = 63
-    Align = alTop
-    TabOrder = 2
     object GroupBox1: TGroupBox
       Left = 1
       Top = 1
       Width = 439
       Height = 61
+      Height = 63
       Align = alClient
       Constraints.MinHeight = 50
 …
         OnClick = radEvtDelayClick
       end
+    end
+  end
+  object pnlTop: TPanel
+      object cmdOK: TButton
+        Left = 345
+        Top = 14
+        Width = 72
+        Height = 19
+        Caption = 'OK'
+        Constraints.MaxWidth = 73
+        Default = True
+        TabOrder = 2
+        OnClick = cmdOKClick
+      end
+      object cmdCancel: TButton
+        Left = 345
+        Top = 38
+        Width = 72
+        Height = 18
+        Cancel = True
+        Caption = 'Cancel'
+        Constraints.MaxWidth = 73
+        TabOrder = 3
+        OnClick = cmdCancelClick
+      end
+    end
+  end
+  object pnlTop: TPanel [1]
     Left = 0
     Top = 0
     Width = 441
     Height = 41
+    Height = 80
     Align = alTop
     BevelOuter = bvNone
     TabOrder = 0
+    object lblPtInfo: TStaticText
+    object lblPtInfo: TVA508StaticText
+      Name = 'lblPtInfo'
       Left = 0
+      Top = 0
+      Top = 5
+      Width = 400
+      Height = 35
+      Alignment = taLeftJustify
+      AutoSize = True
+      Caption = ' '
+      Constraints.MinHeight = 15
+      TabOrder = 0
+      ShowAccelChar = True
+    end
+    object pnlInfo: TPanel
+      Left = 0
+      Top = 46
       Width = 441
+      Height = 41
+      Align = alTop
+      Anchors = [akLeft, akTop, akRight, akBottom]
+      AutoSize = False
+      Constraints.MinHeight = 40
+      Height = 34
+      Align = alBottom
+      TabOrder = 1
+      object Image1: TImage
+        Left = 1
+        Top = 1
+        Width = 24
+        Height = 22
+        AutoSize = True
+        Enabled = False
+        Picture.Data = {
+          07544269746D61707E010000424D7E0100000000000076000000280000001800
+          000016000000010004000000000008010000C40E0000C40E0000100000000000
+          0000000000000000800000800000008080008000000080008000808000008080
+C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
+          FF008000000000000000000000080777777777777777777777700F7777777777
+          7777777777700F88888888888888888887700F88888888888888888887700F88
+          888808888888888887700F88888800888888888887700F8888880B0888888888
+F8888880BB00008888887700F888800BBCCBBB0088887700F8880BBBCCC
+          CBBBB08887700F880BBBBBBBBBBBBB0887700F880BBBBBCCBBBBBB0887700F88
+BBBBBCCBBBBBB0887700F880BBBBBCCBBBBBB0887700F8880BBBBCCBBBBB088
+F888800BBBBBBB0088887700F88888800000008888887700F8888888888
+          8888888887700F88888888888888888887700FFFFFFFFFFFFFFFFFFFFF708000
+          00000000000000000008}
+        Transparent = True
+      end
+      object lblInstruction2: TVA508StaticText
+        Name = 'lblInstruction2'
+        Left = 31
+        Top = 17
+        Width = 363
+        Height = 15
+        Alignment = taLeftJustify
+        Caption =
+          'Use Transfer: if inpatient will move from one ward or treating t' +
+          'eam to another.'
+        TabOrder = 1
+        ShowAccelChar = True
+      end
+      object lblInstruction: TVA508StaticText
+        Name = 'lblInstruction'
+        Left = 31
+        Top = 1
+        Width = 329
+        Height = 15
+        Alignment = taLeftJustify
+        Caption =
+          'Use Admit: if patient is newly admitted to the hospital or nursi' +
+          'ng home.'
+        TabOrder = 0
+        ShowAccelChar = True
+      end
+    end
+  end
+  object pnlBottom: TPanel [2]
+    Left = 0
+    Top = 145
+    Width = 441
+    Height = 274
+    Align = alClient
+    TabOrder = 2
+    ExplicitLeft = 8
+    ExplicitTop = 165
+    ExplicitWidth = 425
+    ExplicitHeight = 236
+    inline fraEvntDelayList: TfraEvntDelayList
+      Left = 1
+      Top = 1
+      Width = 439
+      Height = 272
+      Align = alBottom
+      AutoScroll = True
       TabOrder = 0
       TabStop = True
+    end
+  end
+  object pnlBtns: TPanel
+    Left = 334
+    Top = 91
+    Width = 107
+    Height = 63
+    Align = alCustom
+    Anchors = [akTop, akRight]
+    TabOrder = 4
+    object gbBtns: TGroupBox
+      Left = 1
+      Top = 1
+      Width = 105
+      Height = 61
+      Align = alClient
+      TabOrder = 0
+      DesignSize = (
+)
+      object cmdOK: TButton
+        Left = 17
+        Top = 13
+        Width = 72
+        Height = 19
+        Anchors = [akTop, akRight]
+        Caption = 'OK'
+        Constraints.MaxWidth = 73
+        Default = True
+        TabOrder = 0
+        OnClick = cmdOKClick
+      end
+      object cmdCancel: TButton
+        Left = 17
+        Top = 34
+        Width = 72
+        Height = 18
+        Anchors = [akRight, akBottom]
+        Cancel = True
+        Caption = 'Cancel'
+        Constraints.MaxWidth = 73
+        TabOrder = 1
+        OnClick = cmdCancelClick
+      end
+    end
+      Visible = False
+      ExplicitTop = 145
+      ExplicitWidth = 441
+      ExplicitHeight = 274
+      inherited pnlDate: TPanel
+        Left = 334
+        Height = 272
+        ExplicitLeft = 336
+        ExplicitHeight = 274
+        inherited lblEffective: TLabel
+          Left = 451
+          Width = 71
+          ExplicitLeft = 451
+          ExplicitWidth = 71
+        end
+        inherited orDateBox: TORDateBox
+          Left = 451
+          ExplicitLeft = 451
+        end
+      end
+      inherited pnlList: TPanel
+        Width = 334
+        Height = 272
+        ExplicitWidth = 336
+        ExplicitHeight = 274
+        inherited lblEvntDelayList: TLabel
+          Width = 332
+          ExplicitWidth = 80
+        end
+        inherited mlstEvents: TORListBox
+          Width = 332
+          Height = 236
+          OnDblClick = cmdOKClick
+          OnChange = fraEvntDelayListmlstEventsChange
+          ExplicitWidth = 334
+          ExplicitHeight = 238
+        end
+        inherited edtSearch: TCaptionEdit
+          Width = 332
+          ExplicitWidth = 334
+        end
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlInfo'
+        'Status = stsDefault')
+      (
+        'Component = lblInstruction2'
+        'Status = stsDefault')
+      (
+        'Component = lblInstruction'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.pnlDate'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.orDateBox'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.pnlList'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.mlstEvents'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.edtSearch'
+        'Status = stsDefault')
+      (
+        'Component = pnlRadio'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox1'
+        'Status = stsDefault')
+      (
+        'Component = radRelease'
+        'Status = stsDefault')
+      (
+        'Component = radEvtDelay'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lblPtInfo'
+        'Status = stsDefault')
+      (
+        'Component = frmCopyOrders'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz;
+  StdCtrls, ORCtrls, ExtCtrls, mEvntDelay, uCore, fODBase, UConst, fAutoSz, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmCopyOrders = class(TForm)
+  TfrmCopyOrders = class(TfrmBase508Form)
     pnlInfo: TPanel;
     fraEvntDelayList: TfraEvntDelayList;
 …
     radEvtDelay: TRadioButton;
     Image1: TImage;
     Label2: TStaticText;
     Label1: TStaticText;
+    lblInstruction2: TVA508StaticText;
+    lblInstruction: TVA508StaticText;
     pnlTop: TPanel;
+    lblPtInfo: TStaticText;
+    pnlBtns: TPanel;
+    gbBtns: TGroupBox;
+    lblPtInfo: TVA508StaticText;
     cmdOK: TButton;
     cmdCancel: TButton;
+    pnlBottom: TPanel;
     procedure cmdOKClick(Sender: TObject);
     procedure cmdCancelClick(Sender: TObject);
 …
   private
     OKPressed: Boolean;
+    procedure AdjustFormSize;
   public
   end;
 …
   frmCopyOrders := TfrmCopyOrders.Create(Application);
   try
+    ResizeFormToFont(TForm(frmCopyOrders));
+    ResizeAnchoredFormToFont(TForm(frmCopyOrders));
+    frmCopyOrders.AdjustFormSize;
     CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
     if Length(CurrTS)>0 then
 …
         frmCopyOrders.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.'  + SpeCap;
     end;
+    frmCopyOrders.AdjustFormSize;
     frmCopyOrders.ShowModal;
     if (frmCopyOrders.OKPressed) and (frmCopyOrders.radRelease.Checked) then
 …
   begin
     pnlInfo.Visible := False;
+    pnlBtns.Top := pnlRadio.Top;
+  end;
+  if not radEvtDelay.Checked then
+  begin
+    if not pnlInfo.Visible then
+      Height := Height - fraEvntDelayList.Height - pnlInfo.Height
+    else
+          Height := Height - fraEvntDelayList.Height;
+  end;
+  end;
+  AdjustFormSize;
 end;
 …
 end;
+procedure TfrmCopyOrders.AdjustFormSize;
+var
+  y: integer;
+begin
+  y := lblPtInfo.Height + 8; // allow for font changes
+  if pnlInfo.Visible then
+  begin
+    lblInstruction2.top := lblInstruction.Height; // allow for font change
+    pnlInfo.Height := lblInstruction2.top + lblInstruction2.Height;
+    inc(y,pnlInfo.Height);
+  end;
+  pnlTop.Height := y;
+  inc(y, pnlRadio.Height);
+  if fraEvntDelayList.Visible then
+  begin
+    inc(y, fraEvntDelayList.Height);
+  end;
+  VertScrollBar.Range := y;
+  ClientHeight := y;
+end;
 procedure TfrmCopyOrders.cmdCancelClick(Sender: TObject);
 begin
 …
     radRelease.Checked  := False;
   radEvtDelay.Checked := True;
-  Height := Height + fraEvntDelayList.Height;
   fraEvntDelayList.Visible := True;
   frmCopyOrders.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
   fraEvntDelayList.DisplayEvntDelayList;
+  AdjustFormSize;
 end;
 …
   radRelease.Checked  := True;
   fraEvntDelayList.Visible := False;
   Height := Height - fraEvntDelayList.Height;
+  AdjustFormSize;
 end;
 …
   Shift: TShiftState);
 begin
+  inherited;
   if Key = VK_RETURN then
     cmdOKClick(Self);

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

-              r456
+              r829
   Left = 316
   Top = 226
-  Width = 433
-  Height = 316
   Caption = 'Discontinue / Cancel Orders'
+  ClientHeight = 289
+  ClientWidth = 425
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitLeft = 316
+  ExplicitTop = 226
+  ExplicitWidth = 433
+  ExplicitHeight = 323
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 0
     Top = 0
 …
     Caption = 'The following orders will be discontinued -'
     WordWrap = True
+    ExplicitWidth = 196
   end
   object Panel1: TPanel
+  object Panel1: TPanel [1]
     Left = 0
     Top = 13
 …
     end
   end
   object Panel2: TPanel
+  object Panel2: TPanel [2]
     Left = 0
     Top = 201
 …
     Height = 88
     Align = alBottom
+    Constraints.MinHeight = 88
     TabOrder = 1
     DesignSize = (
 …
       Align = alTop
       Caption = 'Reason for Discontinue (select one)'
+      ExplicitWidth = 169
     end
     object lstReason: TORListBox
 …
       ParentShowHint = False
       ShowHint = True
-      Sorted = True
       TabOrder = 0
       Caption = 'Reason for Discontinue (select one)'
 …
       Width = 72
       Height = 21
       Anchors = [akLeft, akBottom]
+      Anchors = [akRight, akBottom]
       Caption = 'OK'
       Default = True
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = lstReason'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmDCOrders'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fBase508Form,
+  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, ORNet, VA508AccessibilityManager;
 type
   TfrmDCOrders = class(TfrmAutoSz)
+  TfrmDCOrders = class(TfrmBase508Form)
     Label1: TLabel;
     Panel1: TPanel;
 …
     procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
       var AHeight: Integer);
+    procedure FormDestroy(Sender: TObject);
+    procedure unMarkedOrignalOrderDC(OrderArr: TStringList);
   private
     OKPressed: Boolean;
     DCReason: Integer;
+    function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
+    function MeasureColumnHeight(TheOrderText: string; Index: Integer):integer;
+  public
+    OrderIDArr: TStringList;
   end;
 …
   frmDCOrders: TfrmDCOrders;
   AnOrder: TOrder;
   i,CanSign, DCType: Integer;
   NeedReason,NeedRefresh,OnCurrent: Boolean;
+  i, j, CanSign, DCType: Integer;
+  NeedReason,NeedRefresh,OnCurrent, DCNewOrder: Boolean;
   OriginalID,APtEvtID,APtEvtName,AnEvtInfo,tmpPtEvt:  string;
   PtEvtList: TStringList;
+  DCChangeItem: TChangeItem;
 begin
   Result := False;
 …
   OnCurrent := False;
   NeedRefresh := False;
+  DCNewOrder := false;
   PtEvtList := TStringList.Create;
   if SelectedList.Count = 0 then Exit;
 …
       AnOrder    := TOrder(Items[i]);
       frmDCOrders.lstOrders.Items.Add(AnOrder.Text);
+      frmDCOrders.OrderIDArr.Add(AnOrder.ID);
       if not ((AnOrder.Status = 11) and (AnOrder.Signature = 2)) then NeedReason := True;
+      if (NeedReason = True) and (AnOrder.Status = 10) and (AnOrder.Signature = 2) then  NeedReason := False;
     end;
     if NeedReason then
 …
         OriginalID := AnOrder.ID;
         PtEvtList.Add(AnOrder.EventPtr + '^' + AnOrder.EventName);
+        DCOrder(AnOrder, frmDCOrders.DCReason, DCType);
+        if Changes.Orders.Count = 0 then DCNewOrder := false
+        else
+          begin
+            for j := 0 to Changes.Orders.Count - 1 do
+              begin
+                DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
+                if DCChangeItem.ID = AnOrder.ID then
+                  begin
+                    if (Pos('DC', AnOrder.ActionOn) = 0) then
+                       DCNewOrder := True
+                    else DCNewOrder := False;
+                  end;
+              end;
+          end;
+        DCOrder(AnOrder, frmDCOrders.DCReason, DCNewOrder, DCType);
         case DCType of
         DCT_NEWORDER:  begin
                          Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID);
+                         Changes.Add(CH_ORD, AnOrder.ID, AnOrder.Text, '', CanSign, AnOrder.ParentID, user.DUZ, AnOrder.DGroupName, True);
                          AnOrder.ActionOn := OriginalID + '=DC';
                        end;
 …
   inherited;
   OKPressed := False;
+  OrderIDArr := TStringList.Create;
   ListDCReasons(lstReason.Items, DefaultIEN);
   lstReason.SelectByIEN(DefaultIEN);
 …
 begin
   inherited;
+  unMarkedOrignalOrderDC(Self.OrderIDArr);
   Close;
 end;
 …
   begin
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(0, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
 …
 end;
+procedure TfrmDCOrders.FormDestroy(Sender: TObject);
+begin
+  inherited;
+  if self.OrderIDArr <> nil then self.OrderIDArr.Free;
+end;
+procedure TfrmDCOrders.unMarkedOrignalOrderDC(OrderArr: TStringList);
+begin
+ CallV('ORWDX1 UNDCORIG', [OrderArr]);
+end;
 end.

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

-              r456
+              r829
 object frmOrdersEvntRelease: TfrmOrdersEvntRelease
+inherited frmOrdersEvntRelease: TfrmOrdersEvntRelease
   Left = 196
   Top = 66
-  Width = 451
-  Height = 355
   Caption = 'Auto DC/Release Event Orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 328
+  ClientWidth = 443
   OldCreateOrder = False
   OnClose = FormClose
   OnCreate = FormCreate
-  OnDestroy = FormDestroy
   OnShow = FormShow
+  ExplicitWidth = 451
+  ExplicitHeight = 355
   PixelsPerInch = 96
   TextHeight = 13
   object pnlTop: TPanel
+  object pnlTop: TPanel [0]
     Left = 0
     Top = 0
 …
           Position = 5
           TabOrder = 1
-          Wrap = False
           OnClick = updown1Click
         end
 …
           Left = 1
           Top = 1
           Width = 290
+          Width = 244
           Height = 13
           Align = alTop
 …
           Left = 1
           Top = 14
           Width = 290
+          Width = 156
           Height = 13
           Align = alTop
 …
     end
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 85
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = lblPtInfo'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = btnApply'
+        'Status = stsDefault')
+      (
+        'Component = updown1'
+        'Status = stsDefault')
+      (
+        'Component = edtNumber'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = grdEvtList'
+        'Status = stsDefault')
+      (
+        'Component = frmOrdersEvntRelease'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
   ,ORFn, uCore, rOrders, fOrders, StdCtrls, ORCtrls, ExtCtrls, Grids,fAutoSz,
   Spin, ComCtrls;
+  Spin, ComCtrls, VA508AccessibilityManager;
 type
 …
     procedure updown1Click(Sender: TObject; Button: TUDBtnType);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
-    procedure FormDestroy(Sender: TObject);
   private
     { Private declarations }
 …
 implementation
 uses rMisc, Accessibility_TLB, uAccessibleStringGrid;
+uses rMisc, VAUtils;
 {$R *.DFM}
 …
   grdEvtList.Cells[1,0] := 'Date/Time Occured';
   SetPtEvtList(TStrings(fevtList),Patient.DFN, ATotal);
-  TAccessibleStringGrid.WrapControl(grdEvtList);
 end;
 …
   if grdEvtList.Row < 1 then
   begin
     ShowMessage('You need to select an event first.');
+    ShowMsg('You need to select an event first.');
     FOkPressed := False;
     Exit;
 …
 end;
-procedure TfrmOrdersEvntRelease.FormDestroy(Sender: TObject);
-begin
-  TAccessibleStringGrid.UnwrapControl(grdEvtList);
-  inherited;
-end;
 end.

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

-              r456
+              r829
   Left = 386
   Top = 413
-  Height = 270
   Caption = 'Hold Orders'
+  ClientHeight = 243
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 270
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
     Caption = 'The following orders will be placed on hold -'
   end
   object lstOrders: TCaptionListBox
+  object lstOrders: TCaptionListBox [1]
     Left = 8
     Top = 22
 …
     Caption = 'The following orders will be placed on hold -'
   end
   object cmdOK: TButton
+  object cmdOK: TButton [2]
     Left = 267
     Top = 214
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [3]
     Left = 347
     Top = 214
 …
     OnClick = cmdCancelClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmHoldOrders'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 292
   Top = 149
-  Width = 470
-  Height = 368
   Caption = 'Signature on Chart'
+  ClientHeight = 341
+  ClientWidth = 462
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 470
+  ExplicitHeight = 368
   PixelsPerInch = 96
   TextHeight = 13
   object Panel2: TPanel
+  object Panel2: TPanel [0]
     Left = 0
     Top = 0
 …
         'ed -'
       Layout = tlBottom
+      ExplicitWidth = 318
     end
     object lstOrders: TCaptionListBox
 …
     end
   end
   object Panel1: TPanel
+  object Panel1: TPanel [1]
     Left = 0
     Top = 305
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmOnChartOrders'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
+  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
 type
 …
 uses rCore, rOrders, uConst, fOrdersPrint, uOrders, fFrame, UCore,
   fClinicWardMeds;
+  fClinicWardMeds, rODLab, fRptBox;
 const
 …
   SignList: TStringList;
   OrderText: string;
+  AList: TStringList;
   function FindOrderText(const AnID: string): string;
 …
               begin
                 OrderText := FindOrderText(Piece(SignList[i], U, 1));
+                if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
+                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
+                        'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
+                        TC_SAVERR, MB_OK)
+                else
                 InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
                         TC_SAVERR, MB_OK);
 …
           end;
         StatusText('');
+          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
+        AList := TStringList.Create;
+        try
+          CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
+          if AList.Text <> '' then
+            ReportBox(AList, 'Changed Orders', TRUE);
+        finally
+          AList.Free;
+        end;
         PrintOrdersOnSignRelease(SignList, NO_WRITTEN, PrintLoc);
 //        SetupOrdersPrint(SignList, DeviceInfo, NO_WRITTEN, False, PrintIt);  //*KCM*
 …
     x := FilteredString(Items[Index]);
     AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
-    //if AHeight > 255 then AHeight := 255;
     if AHeight <  13 then AHeight := 15;
   end;
 …
     ARect.Left := ARect.Left + 2;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     SaveColor := Canvas.Brush.Color;
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

-              r456
+              r829
 object frmOrdersPrint: TfrmOrdersPrint
+inherited frmOrdersPrint: TfrmOrdersPrint
   Left = 353
   Top = 194
-  Width = 364
-  Height = 315
   Caption = 'Print orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  KeyPreview = True
+  ClientHeight = 288
+  ClientWidth = 356
   OldCreateOrder = True
   Position = poScreenCenter
 …
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBase: TORAutoPanel
+  object pnlBase: TORAutoPanel [0]
     Left = 0
     Top = 0
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBase'
+        'Status = stsDefault')
+      (
+        'Component = lblPartOne'
+        'Status = stsDefault')
+      (
+        'Component = lblPart2'
+        'Status = stsDefault')
+      (
+        'Component = ckChartCopy'
+        'Status = stsDefault')
+      (
+        'Component = ckLabels'
+        'Status = stsDefault')
+      (
+        'Component = ckRequisitions'
+        'Status = stsDefault')
+      (
+        'Component = ckWorkCopy'
+        'Status = stsDefault')
+      (
+        'Component = lstChartDevice'
+        'Status = stsDefault')
+      (
+        'Component = lstLabelDevice'
+        'Status = stsDefault')
+      (
+        'Component = lstReqDevice'
+        'Status = stsDefault')
+      (
+        'Component = lstWorkDevice'
+        'Status = stsDefault')
+      (
+        'Component = cmdChart'
+        'Status = stsDefault')
+      (
+        'Component = cmdLabels'
+        'Status = stsDefault')
+      (
+        'Component = cmdReqs'
+        'Status = stsDefault')
+      (
+        'Component = cmdWork'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmOrdersPrint'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame;
+  StdCtrls, ORCtrls, ORfn, ExtCtrls, rOrders, fFrame, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmOrdersPrint = class(TForm)
+  TfrmOrdersPrint = class(TfrmBase508Form)
     ckChartCopy: TCheckBox;
     ckLabels: TCheckBox;
 …
   NO_WIN_PRINT = False;
+procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean);
+procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
+                           PrintTitle: string = ''; PrintLoc: Integer = 0);
 implementation
 …
   fDeviceSelect, uCore, ORNet, fOrders;
+procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean);
+procedure SetupOrdersPrint(OrderList: TStringList; var DeviceInfo: string; Nature: Char; SelectAll: Boolean; var PrintIt: Boolean;
+                           PrintTitle: string = ''; PrintLoc: Integer = 0);
 {displays device and copy selection form for printing orders, and returns a record of the selections}
 var
 …
 begin
   frmOrdersPrint := TfrmOrdersPrint.Create(Application);
+  if PrintTitle <> '' then frmOrdersPrint.Caption := 'Print Orders for ' + PrintTitle;
   try
     frmFrame.CCOWBusy := True;
 …
           lblPart2.Text := 'Greyed out items are not available.';
         end;
       OrderPrintDeviceInfo(OrderList, PrintParams, Nature);
+      OrderPrintDeviceInfo(OrderList, PrintParams, Nature, PrintLoc);
       SetupControls(PrintParams);
       if (PrintParams.AnyPrompts) {or FSelectAll} then ShowModal;

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

-              r456
+              r829
 object frmRefillOrders: TfrmRefillOrders
+inherited frmRefillOrders: TfrmRefillOrders
   Left = 181
   Top = 267
-  Width = 435
-  Height = 311
   Caption = 'Refill Orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = True
+  ClientHeight = 284
   OnClose = FormClose
   OnCreate = FormCreate
   OnShow = FormShow
+  ExplicitHeight = 311
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [0]
     Left = 0
     Top = 200
 …
     end
   end
   object pnlClient: TPanel
+  object pnlClient: TPanel [1]
     Left = 0
     Top = 0
 …
       Left = 0
       Top = 0
       Width = 427
       Height = 17
+      Width = 181
+      Height = 13
       Align = alTop
       Caption = 'Request refills for the following orders -'
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = grbPickUp'
+        'Status = stsDefault')
+      (
+        'Component = radWindow'
+        'Status = stsDefault')
+      (
+        'Component = radMail'
+        'Status = stsDefault')
+      (
+        'Component = radClinic'
+        'Status = stsDefault')
+      (
+        'Component = pnlClient'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = frmRefillOrders'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 318
   Top = 186
-  Height = 370
   Caption = 'Release Orders to Service(s)'
+  ClientHeight = 343
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitLeft = 318
+  ExplicitTop = 186
+  ExplicitHeight = 377
   PixelsPerInch = 96
   TextHeight = 13
   object Panel1: TPanel
+  object Panel1: TPanel [0]
     Left = 0
     Top = 0
 …
       Align = alTop
       Caption = 'The following orders will be released -'
+      ExplicitWidth = 176
     end
     object lstOrders: TCaptionListBox
 …
     end
   end
   object Panel2: TPanel
+  object Panel2: TPanel [1]
     Left = 0
     Top = 296
 …
     Height = 47
     Align = alBottom
-    BiDiMode = bdRightToLeft
-    ParentBiDiMode = False
     TabOrder = 1
     object grpRelease: TGroupBox
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = grpRelease'
+        'Status = stsDefault')
+      (
+        'Component = radVerbal'
+        'Status = stsDefault')
+      (
+        'Component = radPhone'
+        'Status = stsDefault')
+      (
+        'Component = radPolicy'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmReleaseOrders'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals;
+  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, UBACore, UBAGlobals,
+  VA508AccessibilityManager;
 type
 …
 uses Hash, rCore, rOrders, uConst, fSignItem, fOrdersPrint, uCore, uOrders, fRptBox,
   fFrame, fClinicWardMeds;
+  fFrame, fClinicWardMeds, rODLab;
 const
 …
   OrderText: string;
   AnOrder: TOrder;
+  AList: TStringList;
   function FindOrderText(const AnID: string): string;
 …
           begin
             OrderText := FindOrderText(Piece(SignList[i], U, 1));
+            InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText, TC_SAVERR, MB_OK);
+                if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
+                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
+                        'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
+                        TC_SAVERR, MB_OK)
+                else
+                InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
+                        TC_SAVERR, MB_OK);
           end;
           if Pos('R', Piece(SignList[i], U, 2)) > 0 then
 …
         end;
         StatusText('');
+          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
+        AList := TStringList.Create;
+        try
+          CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
+          if AList.Text <> '' then
+            ReportBox(AList, 'Changed Orders', TRUE);
+        finally
+          AList.Free;
+        end;
         PrintOrdersOnSignRelease(SignList, frmReleaseOrders.FNature, PrintLoc);
 //        SetupOrdersPrint(SignList, DeviceInfo, frmReleaseOrders.FNature, False, PrintIt); //*KCM*
 …
     ARect.Left := ARect.Left + 2;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     SaveColor := Canvas.Brush.Color;
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
 …
     x := FilteredString(Items[Index]);
     AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
-    //if AHeight > 255 then AHeight := 255;
     if AHeight <  13 then AHeight := 15;
   end;

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

-              r456
+              r829
   HorzScrollBar.Visible = True
   VertScrollBar.Tracking = True
-  AutoScroll = False
   Caption = 'Renew Orders'
   ClientHeight = 416
 …
   OnClose = FormClose
   OnCreate = FormCreate
+  OnShow = FormShow
+  ExplicitWidth = 600
+  ExplicitHeight = 443
   PixelsPerInch = 96
   TextHeight = 13
   object hdrOrders: THeaderControl
+  object hdrOrders: THeaderControl [0]
     Left = 0
     Top = 0
     Width = 592
     Height = 17
-    DragReorder = False
     Constraints.MinHeight = 17
     Sections = <
 …
     OnSectionResize = hdrOrdersSectionResize
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 393
 …
     end
   end
   object lstOrders: TCaptionListBox
+  object lstOrders: TCaptionListBox [2]
     Left = 0
     Top = 17
 …
     HintOnItem = True
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = hdrOrders'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdChange'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = frmRenewOrders'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORFn, ComCtrls, uConst, rODMeds, uOrders, fOCAccept,
   ExtCtrls, uODBase, ORCtrls;
+  ExtCtrls, uODBase, ORCtrls, VA508AccessibilityManager;
 type
 …
     procedure cmdChangeClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
-    procedure FormShow(Sender: TObject);
     procedure hdrOrdersSectionResize(HeaderControl: THeaderControl;
       Section: THeaderSection);
+    procedure FormResize(Sender: TObject);
   private
     OKPressed: Boolean;
 …
 {$R *.DFM}
+uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals;
+uses rOrders, fDateRange, fRenewOutMed, uCore, rCore, rMisc, UBAGlobals,
+  VA2006Utils;
 const
 …
   try
     frmRenewOrders.OrderList := SelectedList;
-    ResizeFormToFont(TForm(frmRenewOrders));
     IsInpt := OrderForInpatient;
 …
 begin
   inherited;
   lstOrders.Color := ReadOnlyColor;
+  FixHeaderControlDelphi2006Bug(hdrOrders);
   OKPressed := False;
+  ResizeFormToFont(Self);
+  SetFormPosition(Self);
+end;
+procedure TfrmRenewOrders.FormResize(Sender: TObject);
+var
+i: integer;
+Height: integer;
+begin
+  inherited;
+  if lstorders.Count = 0 then exit;
+  for I := 0 to lstOrders.Count - 1 do
+    begin
+       Height := lstOrders.ItemRect(i).Bottom - lstOrders.ItemRect(i).Top;
+       lstOrdersMeasureItem(lstOrders,i,Height);
+       //ListGridDrawCell(lstOrders, hdrOrders, i, TEXT_COLUMN, x, WORD_WRAPPED);
+    end;
 end;
 …
   Index: Integer; var Height: Integer);
 var
   x: string;
+  x, tmp: string;
   DateHeight, TextHeight: Integer;
   AnOrder: TOrder;
 …
 begin
   inherited;
+  AnOrder := TOrder(OrderList.Items[Index]);
+  if AnOrder <> nil then
+  begin
+    RenewFields := TOrderRenewFields(AnOrder.LinkObject);
+    with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
+    TextHeight := MeasureColumnHeight(RenewFields.NewText,Index,TEXT_COLUMN);
+    DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
+    Height := HigherOf(TextHeight, DateHeight);
+    if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
+  end
+      AnOrder := TOrder(OrderList.Items[Index]);
+      if (AnOrder <> nil) then
+        begin
+          RenewFields := TOrderRenewFields(AnOrder.LinkObject);
+          with RenewFields do x := 'Start: ' + StartTime + CRLF + 'Stop: ' + StopTime;
+          //tmp := RenewFields.NewText;
+          tmp := LstOrders.Items.Strings[index];
+          TextHeight := MeasureColumnHeight(tmp,Index,TEXT_COLUMN);
+          DateHeight := MeasureColumnHeight(x, Index, DATE_COLUMN);
+          Height := HigherOf(TextHeight, DateHeight);
+          if Height > 255 then Height := 255;  //This is maximum allowed by a windows listbox item.
+        end
 end;
 …
 end;
-procedure TfrmRenewOrders.FormShow(Sender: TObject);
-begin
-  inherited;
-  SetFormPosition(Self);
-end;
 procedure TfrmRenewOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
 begin

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

-              r456
+              r829
+object frmSignOrders: TfrmSignOrders
+  Left = 400
+  Top = 159
+  Width = 585
+  Height = 511
+inherited frmSignOrders: TfrmSignOrders
+  Left = 337
+  Top = 142
   Caption = 'Sign Orders'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  KeyPreview = True
+  ClientHeight = 487
+  ClientWidth = 833
   OldCreateOrder = True
   Position = poScreenCenter
   OnCreate = FormCreate
   OnDestroy = FormDestroy
-  OnKeyDown = FormKeyDown
   OnMouseDown = clstOrdersMouseDown
   OnMouseMove = FormMouseMove
+  OnResize = FormResize
   OnShow = FormShow
+  ExplicitWidth = 841
+  ExplicitHeight = 514
   DesignSize = (
 )
+)
   PixelsPerInch = 96
   TextHeight = 13
   object lblESCode: TLabel
+  object lblESCode: TLabel [0]
     Left = 8
     Top = 441
+    Top = 449
     Width = 123
     Height = 13
     Anchors = [akLeft, akBottom]
     Caption = 'Electronic Signature Code'
+  end
+  object laDiagnosis: TLabel
+    ExplicitTop = 446
+  end
+  object laDiagnosis: TLabel [1]
     Left = 184
     Top = 185
 …
     Visible = False
   end
   object Label2: TStaticText
+  object lblOrderList: TStaticText [2]
     Left = 8
     Top = 147
     Width = 171
+    Top = 163
+    Width = 205
     Height = 17
     Caption = 'The following orders will be signed -'
+    Caption = 'Signature will be Applied to Checked Items'
     TabOrder = 3
     TabStop = True
   end
   object cmdOK: TButton
     Left = 417
     Top = 455
+  object cmdOK: TButton [3]
+    Left = 673
+    Top = 458
     Width = 72
     Height = 21
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
     Left = 497
     Top = 455
+  object cmdCancel: TButton [4]
+    Left = 753
+    Top = 458
     Width = 72
     Height = 21
 …
     OnClick = cmdCancelClick
   end
   object txtESCode: TCaptionEdit
+  object txtESCode: TCaptionEdit [5]
     Left = 8
     Top = 455
+    Top = 463
     Width = 137
     Height = 21
 …
     Caption = 'Electronic Signature Code'
   end
+  inline fraCoPay: TfraCoPayDesc
+    Left = 0
+    Top = 0
+    Width = 577
+    Height = 132
+    Align = alTop
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 5
+    Visible = False
+    inherited pnlRight: TPanel
+      Left = 328
+      inherited lblCaption: TStaticText
+        Caption = 'Patient Orders Related To:'
+      end
+      inherited pnlMain: TPanel
+        inherited Panel7: TPanel
+          inherited lblHNC2: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited lblHNC: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel8: TPanel
+          inherited Label12: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited Label11: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel9: TPanel
+          inherited Label14: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited Label13: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel10: TPanel
+          inherited Label16: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited Label15: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel11: TPanel
+          inherited Label18: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited Label17: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel12: TPanel
+          inherited Label24: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited Label23: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+        inherited Panel1: TPanel
+          inherited StaticText4: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+          inherited StaticText1: TORStaticText
+            OnEnter = fraCoPayLabel23Enter
+            OnExit = fraCoPayLabel23Exit
+          end
+        end
+      end
+    end
+    inherited pnlSC: TPanel
+      Width = 328
+      inherited lblSCDisplay: TLabel
+        Width = 328
+      end
+      inherited memSCDisplay: TCaptionMemo
+        Width = 328
+      end
+    end
+  end
+  object clstOrders: TCaptionCheckListBox
+  object clstOrders: TCaptionCheckListBox [6]
     Left = 8
     Top = 162
     Width = 564
     Height = 277
+    Top = 181
+    Width = 820
+    Height = 262
     OnClickCheck = clstOrdersClickCheck
     Anchors = [akLeft, akTop, akRight, akBottom]
 …
     Caption = 'The following orders will be signed -'
   end
   object gbdxLookup: TGroupBox
+  object gbdxLookup: TGroupBox [7]
     Left = 7
     Top = 139
+    Top = 157
     Width = 99
     Height = 43
     Caption = 'Lookup Diagnosis'
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clBlack
+    Font.Color = clWindowText
     Font.Height = -11
     Font.Name = 'MS Sans Serif'
 …
     end
   end
+  inline fraCoPay: TfraCoPayDesc [8]
+    Left = 0
+    Top = 0
+    Width = 833
+    Height = 157
+    Align = alTop
+    AutoSize = True
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 5
+    TabStop = True
+    Visible = False
+    ExplicitWidth = 833
+    inherited pnlRight: TPanel
+      Left = 545
+      ExplicitLeft = 545
+      inherited pnlMain: TPanel
+        inherited pnlHNC: TPanel
+          inherited lblHNC2: TVA508StaticText
+            Width = 129
+            ExplicitWidth = 129
+          end
+          inherited lblHNC: TVA508StaticText
+            Width = 31
+            ExplicitWidth = 31
+          end
+        end
+        inherited pnlMST: TPanel
+          inherited lblMST2: TVA508StaticText
+            Width = 25
+            ExplicitWidth = 25
+          end
+          inherited lblMST: TVA508StaticText
+            Width = 31
+            ExplicitWidth = 31
+          end
+        end
+        inherited pnlSWAC: TPanel
+          inherited lblSWAC2: TVA508StaticText
+            Width = 127
+            ExplicitWidth = 127
+          end
+          inherited lblSWAC: TVA508StaticText
+            Width = 40
+            ExplicitWidth = 40
+          end
+        end
+        inherited pnlIR: TPanel
+          inherited lblIR2: TVA508StaticText
+            Width = 133
+            ExplicitWidth = 133
+          end
+          inherited lblIR: TVA508StaticText
+            Width = 19
+            ExplicitWidth = 19
+          end
+        end
+        inherited pnlAO: TPanel
+          inherited lblAO2: TVA508StaticText
+            Width = 115
+            ExplicitWidth = 115
+          end
+          inherited lblAO: TVA508StaticText
+            Width = 23
+            ExplicitWidth = 23
+          end
+        end
+        inherited pnlCV: TPanel
+          inherited lblCV2: TVA508StaticText
+            Width = 142
+            ExplicitWidth = 142
+          end
+        end
+        inherited pnlSHD: TPanel
+          inherited lblSHAD: TVA508StaticText
+            Width = 33
+            ExplicitWidth = 33
+          end
+          inherited lblSHAD2: TVA508StaticText
+            Width = 159
+            ExplicitWidth = 159
+          end
+        end
+      end
+    end
+    inherited pnlSCandRD: TPanel
+      Width = 545
+      ExplicitWidth = 545
+      inherited lblSCDisplay: TLabel
+        Width = 545
+        ExplicitWidth = 311
+      end
+      inherited memSCDisplay: TCaptionMemo
+        Width = 545
+        ExplicitWidth = 545
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblOrderList'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = txtESCode'
+        'Status = stsDefault')
+      (
+        'Component = clstOrders'
+        'Status = stsDefault')
+      (
+        'Component = gbdxLookup'
+        'Status = stsDefault')
+      (
+        'Component = buOrdersDiagnosis'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlRight'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblCaption'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlMain'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlHNC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblHNC2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblHNC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlMST'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblMST2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblMST'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlSWAC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSWAC2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSWAC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlIR'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblIR2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblIR'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlAO'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblAO2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblAO'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlSC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSC2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSC'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlCV'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblCV2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblCV'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlSHD'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSHAD'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.lblSHAD2'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.pnlSCandRD'
+        'Status = stsDefault')
+      (
+        'Component = fraCoPay.memSCDisplay'
+        'Status = stsDefault')
+      (
+        'Component = frmSignOrders'
+        'Status = stsDefault'))
+  end
   object poBACopyPaste: TPopupMenu
     Left = 344

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

-              r456
+              r829
   fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
   ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
   Menus, ORClasses;
+  Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;
 type
   TfrmSignOrders = class(TForm)
+  TfrmSignOrders = class(TfrmBase508Form)
     cmdOK: TButton;
     cmdCancel: TButton;
     lblESCode: TLabel;
     txtESCode: TCaptionEdit;
-    fraCoPay: TfraCoPayDesc;
     clstOrders: TCaptionCheckListBox;
     laDiagnosis: TLabel;
 …
     Diagnosis1: TMenuItem;
     Exit1: TMenuItem;
+    Label2: TStaticText;
+    lblOrderList: TStaticText;
+    fraCoPay: TfraCoPayDesc;
     procedure FormCreate(Sender: TObject);
     procedure cmdOKClick(Sender: TObject);
 …
     procedure clstOrdersKeyUp(Sender: TObject; var Key: Word;
       Shift: TShiftState);
+    procedure FormResize(Sender: TObject);
   private
     OKPressed: Boolean;
 …
     function ItemsAreChecked: Boolean;
     function GetNumberOfSelectedOrders : byte;
     procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
+    procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
     procedure SetItemTextToState;
     procedure FormatListForScreenReader;
 …
 {Begin BillingAware}
+  { TODO 3 -oKW -cRefinement : Change to dynamic array or other dynamic structure for Billing Awareness Phase II. }
+  TarRect = array[MIN_RECT..MAX_RECT] of TRect;
+    TarRect = array[MIN_RECT..MAX_RECT] of TRect;
   var
 …
     srcIndex: integer;
     CopyBuffer: TBADxRecord;
-    //CopyActive: boolean;  //CQ6225
   {End BillingAware}
 …
 uses
   Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders,
+  fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame;
+  fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame, rODLab, fRptBox,
+  VAUtils;
 const
 …
            on EListError do
               begin
               {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
+              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
               raise;
               end;
 …
   itemsList.Clear;
   itemsList := uSigItems.GetSigItems; //Get FItems list
   if BILLING_AWARE then
      begin
 …
            on EListError do
               begin
               {$ifdef debug}ShowMessage('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
+              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
               raise;
               end;
 …
 function ExecuteSignOrders(SelectedList: TList): Boolean;
+var
+  i, cidx,cnt, theSts: Integer;
+const
+  VERT_SPACING = 6;
+var
+  i, cidx,cnt, theSts, WardIEN: Integer;
   ShrinkHeight: integer;
   SignList: TStringList;
   Obj: TOrder;
   DigSigErr, DigStoreErr: Boolean;
+  DigSigErr, DigStoreErr, ContainsIMOOrders, DoNotPrint: Boolean;
   x, SigData, SigUser, SigDrugSch, SigDEA: string;
   cSignature, cHashData, cCrlUrl, cErr: string;
+  cSignature, cHashData, cCrlUrl, cErr, WardName: string;
   cProvDUZ: Int64;
   OrderText: string;
+  OrderText, ASvc: string;
   PrintLoc: Integer;
+ // tempOrderID: string;
+  AList, ClinicList, DCList, OrderPrintList, WardList: TStringList;
+  EncLocName, EncLocText: string;
+  EncLocIEN: integer;
+  EncDT: TFMDateTime;
+  EncVC: Char;
   function FindOrderText(const AnID: string): string;
 …
   DigSigErr := True;
   PrintLoc := 0;
+  EncLocIEN := 0;
+  DoNotPrint := False;
   if SelectedList.Count = 0 then Exit;
   if BILLING_AWARE then
 …
         cidx := frmSignOrders.clstOrders.Items.AddObject(Obj.Text,Obj);
         SigItems.Add(CH_ORD,Obj.ID, cidx);
+         //HDS6205 allows dx entry for NON CIDC Consult orders
+   //    if BILLING_AWARE then  //HDS6205
+   //        if UBAGlobals.BAConsultOrdersRequireDx.Count > 0 then  //HDS6205
+   //        begin
+  //            tempOrderID := UBACore.SetOrderIDConsultDxRequired(Piece(Obj.ID,';',1) + ';1');  //HDS6205
+  //            tempOrderList.Add(tempOrderID);  //HDS6205
+  //         end
+  //         else
+         if BILLING_AWARE then
+            tempOrderList.Add(Obj.ID);
+        if BILLING_AWARE then
+           tempOrderList.Add(Obj.ID);
         frmSignOrders.clstOrders.Checked[cidx] := TRUE;
 …
        {End BillingAware}
+        ShrinkHeight := frmSignOrders.fraCoPay.Height + 9;
+        frmSignOrders.Height := frmSignOrders.Height - ShrinkHeight;
+        frmSignOrders.Label2.Top := frmSignOrders.Label2.Top - ShrinkHeight;
+        frmSignOrders.clstOrders.Top := frmSignOrders.clstOrders.Top - ShrinkHeight;
+        frmSignOrders.clstOrders.Height := frmSignOrders.clstOrders.Height + ShrinkHeight;
+        with frmSignOrders do begin
+          ShrinkHeight := lblOrderList.Top - VERT_SPACING;
+          Height := Height - ShrinkHeight;
+          lblOrderList.Top := lblOrderList.Top - ShrinkHeight;
+          clstOrders.Top := clstOrders.Top - ShrinkHeight;
+          clstOrders.Height := clstOrders.Height + ShrinkHeight;
+        end;
       end;
 …
     end;
      frmSignOrders.ShowModal;
+      frmSignOrders.ShowModal;
       if frmSignOrders.OKPressed then
       begin
         Result := True;
         SignList := TStringList.Create;
+        ClinicList := TStringList.Create;
+        OrderPrintList := TStringList.Create;
+        WardList := TStringList.Create;
+        ContainsIMOOrders := false;
         try
           with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
 …
                   if Length(SigData) < 1 then
                     begin
                       ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
+                      ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
                       DigStoreErr := true;
                     end;
 …
                     else
                       begin
                         ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
+                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
                         DigStoreErr := true;
                       end;
 …
                     on  E: Exception do
                       begin
                         ShowMessage(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
+                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
                         DigStoreErr := true;
                       end;
 …
                   if GetPKISite and (Copy(TOrder(SelectedList.Items[i]).DigSigReq,1,1) = '2') then
                     begin
                       ShowMessage('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
+                      ShowMsg('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
                         'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
                         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.');
 …
           if SignList.Count > 0 then
           begin
+          //hds7591  Clinic/Ward movement.  Patient Admission IMO
+          if not frmFrame.TimedOut then
+          begin
+             if IsValidIMOLoc(uCore.TempEncounterLoc,Patient.DFN) then
+                frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,uCore.Encounter.LocationName, PrintLoc)
+             else
+                if (IsValidIMOLoc(Encounter.Location,Patient.DFN)) and ((frmClinicWardMeds.rpcIsPatientOnWard(patient.DFN)) and (Patient.Inpatient = false)) then
+                   frmClinicWardMeds.ClinicOrWardLocation(SignList, Encounter.Location,Encounter.LocationName, PrintLoc);
+          end;
+          uCore.TempEncounterLoc := 0;
+          uCore.TempEncounterLocName := '';
+          //hds7591  Clinic/Ward movement  Patient Admission IMO
+            //hds7591  Clinic/Ward movement.  Patient Admission IMO
+            if not frmFrame.TimedOut then
+            begin
+               if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
+                   begin
+                     DCList := TStringList.Create;
+                     EncLocName := Encounter.LocationName;
+                     EncLocIEN  := Encounter.Location;
+                     EncLocText := Encounter.LocationText;
+                     EncDT := Encounter.DateTime;
+                     EncVC := Encounter.VisitCategory;
+                     for i := 0 to SelectedList.Count - 1 do
+                       begin
+                         cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(SelectedList.Items[i]));
+                         if frmSignOrders.clstOrders.Checked[cidx] = false then continue;
+                         if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true;
+                         if TOrder(SelectedList.Items[i]).DGroupName = '' then continue;
+                         if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue;
+                         if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then
+                           begin
+                             DCList.Add(TOrder(SelectedList.Items[i]).ID);
+                             Continue;
+                           end;
+                         OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text);
+                       end;
+                      if OrderPrintList.Count > 0 then
+                        begin
+                          frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
+                                                        WardList, WardIen,WardName, ContainsIMOOrders, true);
+                          fframe.frmFrame.OrderPrintForm := false;
+                        end
+                      else DoNotPrint := True;
+                      if (DCList <> nil) and (DCList.Count > 0) then
+                        begin
+                          for i := 0 to DCList.Count - 1 do
+                             WardList.Add(DCList.Strings[i]);
+                          if (WardIEN = 0) and (WardName = '') then
+                          CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
+                        end;
+                      if DCList <> nil then DCList.Free;
+                   end;
+            end;
+            uCore.TempEncounterLoc := 0;
+            uCore.TempEncounterLocName := '';
+            //hds7591  Clinic/Ward movement  Patient Admission IMO
             SigItems.SaveSettings; // Save CoPay FIRST!
             SendOrders(SignList, frmSignOrders.ESCode);
+        end;
+          end;
             with SignList do if Count > 0 then for i := 0 to Count - 1 do
 …
                 begin
                   OrderText := FindOrderText(Piece(SignList[i], U, 1));
+                  if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
+                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
+                        'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
+                        TC_SAVERR, MB_OK)
+                  else
                   InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
                           TC_SAVERR, MB_OK);
+                        TC_SAVERR, MB_OK);
                 end;
               if Pos('R', Piece(SignList[i], U, 2)) > 0 then
 …
               if theSts = 10 then  SignList.Delete(cnt);  //signed delayed order should not be printed.
           end;
+          PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
+          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
+          AList := TStringList.Create;
+          try
+            CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
+            if AList.Text <> '' then
+              ReportBox(AList, 'Changed Orders', TRUE);
+          finally
+            AList.Free;
+          end;
+          if(ClinicList.Count > 0) or (WardList.count > 0) then
+              PrintOrdersOnSignReleaseMult(SignList, CLinicList, WardList, NO_PROVIDER, EncLocIEN, WardIEN, EncLocName, wardName)
+            else if DoNotPrint = False then PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
         finally
           SignList.Free;
+          OrderPrintList.free;
+          WardList.free;
+          ClinicList.free;
         end;
       end; {if frmSignOrders.OKPressed}
 …
   if  BILLING_AWARE then
       begin
         clstOrders.Height := 234;
+        clstOrders.Height := 228;
         clstOrders.Top :=  (gbdxLookup.top + 65);
         gbDxLookup.Visible := TRUE;
         label2.Top := (gbdxLookup.Top +  48);
         laDiagnosis.Top :=  Label2.Top;
+        lblOrderList.Top := (gbdxLookup.Top +  gbdxLookup.Height);
+        laDiagnosis.Top :=  lblOrderList.Top;
         laDiagnosis.Left := 270;
         laDiagnosis.Visible := TRUE;
 …
    else
       begin
          label2.Top := 145;
          label2.Left := 8;
+         lblOrderList.Top := 158;
+         lblOrderList.Left := 8;
      end;
  {End BillingAware}
 …
        begin
           Canvas.FillRect(ARect);
           Canvas.Pen.Color := clSilver;
+          Canvas.Pen.Color := Get508CompliantColor(clSilver);
           Canvas.MoveTo(ARect.Left, ARect.Bottom);
           Canvas.LineTo(ARect.Right, ARect.Bottom);
 …
           //Adjust position of 'Diagnosis' column label for font size
           laDiagnosis.Left := ARect.Right + 14;
+              //ARect.Right below controls the right-hand side of the Dx Column
+              //Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
+              //two rectangles overlap each other.
+          if uSignItems.GetAllBtnLeftPos > 0 then
+             laDiagnosis.left := uSignItems.GetAllBtnLeftPos - (laDiagnosis.Width +5);
+              // ARect.Right below controls the right-hand side of the Dx Column
+              // Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
+              // two rectangles overlap each other.
            if  BILLING_AWARE then
            begin
 …
               //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code
                DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
+       {v25 BA}
+        if  BILLING_AWARE then
+       if  BILLING_AWARE then
          begin
              if Assigned(UBAGlobals.tempDxList) then
                 begin
                 tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
+                   tempID := TOrder(clstOrders.Items.Objects[Index]).ID;
                 if UBAGlobals.tempDxNodeExists(tempID) then
 …
                        str := Piece(str,':',1);
                        DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
+                       if Not UBACore.IsOrderBillable(tempID) then //and
+                      //    Not UBAGlobals.tempDxNodeExists(tempID) then   // if consult is non cidc but requires dx, show it.
+                       if Not UBACore.IsOrderBillable(tempID) then
                        begin
                             Canvas.Font.Color := clBlue;
 …
              if Index < Items.Count then
                 begin
                 Canvas.FillRect(ARect);
                 Canvas.Pen.Color := clSilver;
                 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
                 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
                 X := FilteredString(Items[Index]);
                 DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
+                  Canvas.FillRect(ARect);
+                  Canvas.Pen.Color := Get508CompliantColor(clSilver);
+                  Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
+                  Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
+                  X := FilteredString(Items[Index]);
+                  DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
                 end;
            end;
 …
         if Checked[i] then
            begin
            Result := True;
            break;
+             Result := True;
+             break;
            end;
 end;
 …
                       for i := 0 to (tempDxList.Count - 1) do
                          begin
                           thisRec := TBADxRecord(tempDxList.Items[i]);
+                           thisRec := TBADxRecord(tempDxList.Items[i]);
                           if Assigned(thisRec) then
 …
                     on EListError do
                        begin
                        {$ifdef debug}ShowMessage('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
+                       {$ifdef debug}Show508Message('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
                        raise;
                        end;
 …
 {Begin BillingAware}
+  if (clstOrders.Top + clstOrders.Height) > (lblESCode.Top - 4) then
+      clstOrders.Height := lblESCode.Top - clstOrders.Top - 4;
   //INITIALIZATIONS
   Paste1.Enabled := false;
 …
          with fraCoPay do
            begin
             Label24.Caption := 'Service &Connected Condition';
             StaticText4.Caption := 'Combat &Vet (Combat Related)';
             Label18.Caption := 'Agent &Orange Exposure';
             Label16.Caption := 'Ionizing &Radiation Exposure';
             Label14.Caption := '&Environmental Contaminants';
             Label12.Caption := '&MST';
+            lblSC2.Caption := 'Service &Connected Condition';
+            lblCV2.Caption := 'Combat &Vet (Combat Related)';
+            lblAO2.Caption := 'Agent &Orange Exposure';
+            lblIR2.Caption := 'Ionizing &Radiation Exposure';
+            lblSWAC2.Caption := '&Environmental Contaminants';
+            lblMST2.Caption := '&MST';
             lblHNC2.Caption := '&Head and/or Neck Cancer';
+            Label24.ShowAccelChar := true;
+            StaticText4.ShowAccelChar := true;
+            Label18.ShowAccelChar := true;
+            Label16.ShowAccelChar := true;
+            Label14.ShowAccelChar := true;
+            Label12.ShowAccelChar := true;
+            lblSHAD2.Caption := 'Shi&pboard Hazard and Defense';
+            lblSC2.ShowAccelChar := true;
+            lblCV2.ShowAccelChar := true;
+            lblAO2.ShowAccelChar := true;
+            lblIR2.ShowAccelChar := true;
+            lblSWAC2.ShowAccelChar := true;
+            lblMST2.ShowAccelChar := true;
             lblHNC2.ShowAccelChar := true;
+            lblSHAD2.ShowAccelChar := true;
            end;
         end;  //BILLING_AWARE
 …
   match := false;
   allBlank := false;
-  //orderIDList := TStringList.Create;
   if Assigned (orderIDList) then orderIDList.Clear;
   if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear;
 …
                  {$ifdef debug}
                  with UBAGlobals.globalDxRec do
                     //ShowMessage('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
+                    //Show508Message('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
                  {$endif}
                   end;
 …
      except
         on E: Exception  do
            ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
+           ShowMsg(E.ClassName+' error raised, with message : '+E.Message);
    end;
 …
   if numSelected = 0 then
      begin
      ShowMessage(UBAMessages.BA_NO_ORDERS_SELECTED);
+     ShowMsg(UBAMessages.BA_NO_ORDERS_SELECTED);
      Exit;
      end
 …
   if ((match and allBlank) or (match and (not allBlank))) then  // All selected are blank or matching-not-blank
+//     begin
+     { TODO 3 -oKW -cRefinement : Define a const to replace string literal }
+       frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
+        frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
    else
      begin
 …
               Exit
          else
-//              begin
               if Assigned(UBAGlobals.globalDxRec) then
                  InitializeNewDxRec(UBAGlobals.globalDxRec);
 …
          if numSelected > 1 then
            begin
            ShowMessage('Only 1 order at a time may be selected for ''Copying''');
+           ShowMsg('Only 1 order at a time may be selected for ''Copying''');
            Exit;
            end;
 …
                //*************************************************************************
                if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and
              //    (NOT tempDxNodeExists(fOrdersSign.srcOrderID)) then   // added to allow copy to NON CIDC consult order the requires a DX. then
+               // added to allow copy to NON CIDC consult order the requires a DX. then
                  begin
                  ShowMessage(BA_NA_COPY_DISALLOWED);
                  fOrdersSign.srcOrderID := '';
                  Exit;
+                   ShowMsg(BA_NA_COPY_DISALLOWED);
+                   fOrdersSign.srcOrderID := '';
+                   Exit;
                  end;
                //*************************************************************************
 …
      on EListError do
         begin
         ShowMessage('EListError in frmSignOrders.Copy1Click()');
+          ShowMsg('EListError in frmSignOrders.Copy1Click()');
         raise;
         end;
    end;
-  //CopyActive := true; //CQ6225
-  //Paste1.Enabled := true; //CQ6225
 end;
 …
                if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
                  begin
                  fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
+                   fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
                   if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself
 …
                      if Not UBACore.IsOrderBillable(targetOrderID) then
                        begin
                        ShowMessage(BA_NA_PASTE_DISALLOWED);
                        fOrdersSign.targetOrderID := '';
                        Continue;
+                         ShowMsg(BA_NA_PASTE_DISALLOWED);
+                         fOrdersSign.targetOrderID := '';
+                         Continue;
                        end;
                      //***************************************************************
 …
                      with newRec do
                        begin
                        FOrderID :=  fOrdersSign.targetOrderID;
                        FBADxCode := CopyBuffer.FBADxCode;
                        FBASecDx1 := CopyBuffer.FBASecDx1;
                        FBASecDx2 := CopyBuffer.FBASecDx2;
                        FBASecDx3 := CopyBuffer.FBASecDx3;
+                         FOrderID :=  fOrdersSign.targetOrderID;
+                         FBADxCode := CopyBuffer.FBADxCode;
+                         FBASecDx1 := CopyBuffer.FBASecDx1;
+                         FBASecDx2 := CopyBuffer.FBASecDx2;
+                         FBASecDx3 := CopyBuffer.FBASecDx3;
                        end;
 …
         on EListError do
            begin
            ShowMessage('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
+             ShowMsg('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
            raise;
            end;
 …
          clstOrders.Refresh; //Update grid to show pasted Dx
      end;
+{
-  //CQ6225
-  if CopyActive then
-     begin
-     Paste1.Enabled := false;
-     CopyActive := false;
-     end;
-  //end CQ6225
+}
 end;
 …
            if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
               begin
               Copy1.Enabled := false;
               Paste1.Enabled := false
+                Copy1.Enabled := false;
+                Paste1.Enabled := false
               end
            else
               begin
+              Copy1.Enabled := true;
+              //Paste1.Enabled := true; //commented out for CQ6225
+                Copy1.Enabled := true;
               end;
            //End CQ3325
 …
         on EListError do
            begin
            ShowMessage('EListError in frmSignOrders.clstOrdersMouseDown()');
+             ShowMsg('EListError in frmSignOrders.clstOrdersMouseDown()');
            raise;
            end;
 …
            if clstOrders.Selected[i] then
               begin
               thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
               //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
+                thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
+                //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
               if thisChangeItem = nil then
                  begin
                  Copy1.Enabled := false;
                  buOrdersDiagnosis.Enabled := false;
                  Exit;
+                   Copy1.Enabled := false;
+                   buOrdersDiagnosis.Enabled := false;
+                   Exit;
                  end;
               if (thisChangeItem <> nil) then //Blank row - not an order item
                  begin
                  thisOrderList.Clear;
                  thisOrderList.Add(thisChangeItem.ID);
                  if IsAllOrdersNA(thisOrderList) then
                  begin
                     Diagnosis1.Enabled := false;
                     buOrdersDiagnosis.Enabled := false;
                  end
+                   thisOrderList.Clear;
+                   thisOrderList.Add(thisChangeItem.ID);
+                   if IsAllOrdersNA(thisOrderList) then
+                   begin
+                     Diagnosis1.Enabled := false;
+                     buOrdersDiagnosis.Enabled := false;
+                  end
                  else
                  begin
 …
   j: integer; //CQ5054
 begin
+       if FOSTFHintWndActive then
+       begin
+          FOSTFhintWindow.ReleaseHandle ;
+          FOSTFHintWndActive := False ;
+       end;
+       case Key of
+,99:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.Label24); //C,c
+,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.staticText4); //V,v
+,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.Label18); //O,o
+,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.Label16); //R,r
+,101: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.Label14); //E,e
+,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.Label12); //M,m
+,104: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //H,h
+           //CQ5054
+,115: if (ssAlt in Shift) then
+                begin
+                for j := 0 to clstOrders.Items.Count-1 do
+                      clstOrders.Selected[j] := false;
+                clstOrders.Selected[0] := true;
+                clstOrders.SetFocus;
+                end;
+           //end CQ5054
+       end;
+  inherited;
+  if FOSTFHintWndActive then
+  begin
+    FOSTFhintWindow.ReleaseHandle ;
+    FOSTFHintWndActive := False ;
+  end;
+  case Key of
+,99:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.lblSC2); //C,c
+,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.lblCV2); //V,v
+,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.lblAO2); //O,o
+,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.lblIR2); //R,r
+,97:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.lblSWAC2); //A,a
+,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.lblMST2); //M,m
+,110: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //N,n
+,104: if (ssALT in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSHAD,fraCopay.lblSHAD2); // H,h
+     //CQ5054
+,115: if (ssAlt in Shift) then
+          begin
+            for j := 0 to clstOrders.Items.Count-1 do
+                clstOrders.Selected[j] := false;
+            clstOrders.Selected[0] := true;
+            clstOrders.SetFocus;
+          end;
+     //end CQ5054
+  end;
 end;
 //BILLING AWARE Procedure
 procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TORStaticText); // 508
+procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
 var
  HRect: TRect;
 …
      if FOSTFhintWndActive then
         begin
         FOSTFhintWindow.ReleaseHandle;
         FOSTFhintWndActive := False;
+          FOSTFhintWindow.ReleaseHandle;
+          FOSTFhintWndActive := False;
         end;
   except
      on E: Exception do
         begin
         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
+        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
         raise;
         end;
 …
       hrect.Bottom := hrect.Bottom + Y;
+  if FOSTFHintWndActive then
+     begin
+     with fraCoPay do
+        begin
+        //Abbreviated captions
+        Label23.ShowHint := false;
+        StaticText1.ShowHint := false;
+        Label17.ShowHint := false;
+        Label15.ShowHint := false;
+        Label13.ShowHint := false;
+        Label11.ShowHint := false;
+        lblHNC.ShowHint := false;
+        //Long captions
+        staticText4.ShowHint := false;
+        Label17.ShowHint := false;
+        Label18.ShowHint := false;
+        Label15.ShowHint := false;
+        Label16.ShowHint := false;
+        Label13.ShowHint := false;
+        Label14.ShowHint := false;
+        Label11.ShowHint := false;
+        Label12.ShowHint := false;
+        lblHNC.ShowHint := false;
+        lblHNC2.ShowHint := false;
+        end;
+     end
+  else
+     begin
+     with fraCoPay do
+        begin
+        //Abbreviated captions
+        Label23.ShowHint := true;
+        StaticText1.ShowHint := true;
+        Label17.ShowHint := true;
+        Label15.ShowHint := true;
+        Label13.ShowHint := true;
+        Label11.ShowHint := true;
+        lblHNC.ShowHint := true;
+        //Long captions
+        staticText4.ShowHint := true;
+        Label17.ShowHint := true;
+        Label18.ShowHint := true;
+        Label15.ShowHint := true;
+        Label16.ShowHint := true;
+        Label13.ShowHint := true;
+        Label14.ShowHint := true;
+        Label11.ShowHint := true;
+        Label12.ShowHint := true;
+        lblHNC.ShowHint := true;
+        lblHNC2.ShowHint := true;
+        end;
+     end;
+      fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive);
       FOSTFhintWindow.ActivateHint(hrect, pHintText);
 …
      on E: Exception do
         begin
         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
+        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
         raise;
         end;
 …
      on E: Exception do
         begin
         {$ifdef debug}ShowMessage('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
+        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
         raise;
         end;
 …
 end;
+procedure TfrmSignOrders.FormResize(Sender: TObject);
+begin
+  inherited;
+  clstOrders.invalidate;
+end;
 procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 begin
+  if FOSTFHintWndActive then
+     begin
+     with fraCoPay do
+        begin
+        //Abbreviated captions
+        Label23.ShowHint := false;
+        StaticText1.ShowHint := false;
+        Label17.ShowHint := false;
+        Label15.ShowHint := false;
+        Label13.ShowHint := false;
+        Label11.ShowHint := false;
+        lblHNC.ShowHint := false;
+        //Long captions
+        Label24.ShowHint := false;
+        staticText4.ShowHint := false;
+        Label17.ShowHint := false;
+        Label18.ShowHint := false;
+        Label15.ShowHint := false;
+        Label16.ShowHint := false;
+        Label13.ShowHint := false;
+        Label14.ShowHint := false;
+        Label11.ShowHint := false;
+        Label12.ShowHint := false;
+        lblHNC.ShowHint := false;
+        lblHNC2.ShowHint := false;
+        end;
+     end
+  else
+     begin
+     with fraCoPay do
+        begin
+        //Abbreviated captions
+        Label23.ShowHint := true;
+        StaticText1.ShowHint := true;
+        Label17.ShowHint := true;
+        Label15.ShowHint := true;
+        Label13.ShowHint := true;
+        Label11.ShowHint := true;
+        lblHNC.ShowHint := true;
+        //Long captions
+        Label24.ShowHint := true;
+        staticText4.ShowHint := true;
+        Label17.ShowHint := true;
+        Label18.ShowHint := true;
+        Label15.ShowHint := true;
+        Label16.ShowHint := true;
+        Label13.ShowHint := true;
+        Label14.ShowHint := true;
+        Label11.ShowHint := true;
+        Label12.ShowHint := true;
+        lblHNC.ShowHint := true;
+        lblHNC2.ShowHint := true;
+        end;
+     end;
+  fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive)
 end;
 procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
 begin
     (Sender as TORStaticText).Font.Style := [fsBold];
+    (Sender as TVA508StaticText).Font.Style := [fsBold];
 end;
 procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
 begin
     (Sender as TORStaticText).Font.Style := [];
+    (Sender as TVA508StaticText).Font.Style := [];
 end;
 …
 procedure TfrmSignOrders.FormatListForScreenReader;
+var
+  ListStateOn : longbool;
+  Success: longbool;
+begin
+  //Determine if a screen reader is currently being used.
+  Success := SystemParametersInfo(SPI_GETSCREENREADER, 0, @ListStateOn,0);
+  if Success and ListStateOn then
+begin
+  if ScreenReaderActive then
     SetItemTextToState;
 end;

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

-              r456
+              r829
   Left = 84
   Top = 77
-  Width = 464
-  Height = 385
   Caption = 'Release Orders'
+  ClientHeight = 351
+  ClientWidth = 456
   Constraints.MinHeight = 365
   Constraints.MinWidth = 310
   OnClose = FormClose
   OnCreate = FormCreate
+  OnKeyDown = FormKeyDown
+  ExplicitLeft = 84
+  ExplicitTop = 77
+  ExplicitWidth = 464
+  ExplicitHeight = 385
   PixelsPerInch = 96
   TextHeight = 13
   object pnlMiddle: TPanel
+  object pnlMiddle: TPanel [0]
     Left = 0
     Top = 78
 …
         Width = 333
         Height = 17
-        BiDiMode = bdRightToLeft
         Caption = '  &Release new orders immediately'
         Enabled = False
-        ParentBiDiMode = False
         TabOrder = 0
         OnClick = radReleaseNowClick
 …
     end
   end
   object pnlTop: TPanel
+  object pnlTop: TPanel [1]
     Left = 0
     Top = 0
 …
       Left = 1
       Top = 1
       Width = 450
+      Width = 3
       Height = 34
       Align = alTop
 …
         Top = 1
         Width = 24
         Height = 36
+        Height = 22
         Align = alLeft
         AutoSize = True
 …
           00000000000000000008}
         Transparent = True
+        ExplicitHeight = 36
       end
       object Label1: TLabel
 …
     end
   end
   object Panel1: TPanel
+  object Panel1: TPanel [2]
     Left = 0
     Top = 134
     Width = 456
     Height = 224
+    Height = 217
     Align = alClient
     TabOrder = 2
 …
       Top = 1
       Width = 454
       Height = 222
+      Height = 215
       Align = alClient
       AutoScroll = False
+      AutoScroll = True
       TabOrder = 0
+      TabStop = True
       Visible = False
+      ExplicitLeft = 1
+      ExplicitTop = 1
+      ExplicitWidth = 454
+      ExplicitHeight = 215
       inherited pnlDate: TPanel
         Left = 349
+        Height = 222
+        Height = 215
+        ExplicitLeft = 349
+        ExplicitHeight = 215
         inherited lblEffective: TLabel
           Left = 453
+          Width = 71
+          ExplicitLeft = 453
+          ExplicitWidth = 71
         end
         inherited orDateBox: TORDateBox
           Left = 453
+          ExplicitLeft = 453
         end
       end
       inherited pnlList: TPanel
         Width = 349
+        Height = 222
+        Height = 215
+        ExplicitWidth = 349
+        ExplicitHeight = 215
         inherited lblEvntDelayList: TLabel
           Width = 347
+          ExplicitWidth = 80
         end
         inherited mlstEvents: TORListBox
           Width = 347
           Height = 186
+          Height = 179
           OnDblClick = cmdOKClick
+          ExplicitWidth = 347
+          ExplicitHeight = 179
         end
         inherited edtSearch: TCaptionEdit
           Width = 347
+        end
+      end
+    end
+          ExplicitWidth = 347
+        end
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlMiddle'
+        'Status = stsDefault')
+      (
+        'Component = grpChoice'
+        'Status = stsDefault')
+      (
+        'Component = radReleaseNow'
+        'Status = stsDefault')
+      (
+        'Component = radDelayed'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = pnldif'
+        'Status = stsDefault')
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.pnlDate'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.orDateBox'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.pnlList'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.mlstEvents'
+        'Status = stsDefault')
+      (
+        'Component = fraEvntDelayList.edtSearch'
+        'Status = stsDefault')
+      (
+        'Component = frmOrdersTS'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst;
+  fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
+  VA508AccessibilityManager;
 type

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

-              r456
+              r829
   Left = 269
   Top = 192
-  Height = 270
   Caption = 'Release Orders from Hold'
+  ClientHeight = 243
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 270
   PixelsPerInch = 96
   TextHeight = 13
   object Label1: TLabel
+  object Label1: TLabel [0]
     Left = 8
     Top = 8
 …
     Caption = 'The following orders will be released from hold -'
   end
   object lstOrders: TCaptionListBox
+  object lstOrders: TCaptionListBox [1]
     Left = 8
     Top = 22
 …
     Caption = 'The following orders will be released from hold '
   end
   object cmdOK: TButton
+  object cmdOK: TButton [2]
     Left = 267
     Top = 214
 …
     OnClick = cmdOKClick
   end
   object cmdCancel: TButton
+  object cmdCancel: TButton [3]
     Left = 347
     Top = 214
 …
     OnClick = cmdCancelClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmUnholdOrders'
+        'Status = stsDefault'))
+  end
 end

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

r456	r829
5	5	uses
6	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7		fAutoSz, StdCtrls, ORFn, ORCtrls;
	7	fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
8	8
9	9	type

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

-              r456
+              r829
   Left = 341
   Top = 182
-  Height = 367
   Caption = 'Verify Orders'
+  ClientHeight = 340
   Position = poScreenCenter
   OnCreate = FormCreate
+  ExplicitWidth = 320
+  ExplicitHeight = 367
   PixelsPerInch = 96
   TextHeight = 13
   object Panel1: TPanel
+  object Panel1: TPanel [0]
     Left = 0
     Top = 0
 …
       Align = alTop
       Caption = 'The following orders will be marked as verified -'
+      ExplicitWidth = 222
     end
     object lstOrders: TCaptionListBox
 …
     end
   end
   object Panel2: TPanel
+  object Panel2: TPanel [1]
     Left = 0
     Top = 293
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = lstOrders'
+        'Status = stsDefault')
+      (
+        'Component = Panel2'
+        'Status = stsDefault')
+      (
+        'Component = txtESCode'
+        'Status = stsDefault')
+      (
+        'Component = cmdOK'
+        'Status = stsDefault')
+      (
+        'Component = cmdCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmVerifyOrders'
+        'Status = stsDefault'))
+  end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
+  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
 type
 …
     x := FilteredString(Items[Index]);
     AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
-    //if AHeight > 255 then AHeight := 255;
     if AHeight <  13 then AHeight := 15;
   end;
 …
     ARect.Left := ARect.Left + 2;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     SaveColor := Canvas.Brush.Color;
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);

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

-              r456
+              r829
 object frmOtherSchedule: TfrmOtherSchedule
+inherited frmOtherSchedule: TfrmOtherSchedule
   Left = 544
   Top = 262
-  AutoScroll = False
   Caption = 'Order with schedule '#39'OTHER'#39
   ClientHeight = 362
+  ClientWidth = 369
+  Color = clBtnFace
+  ClientWidth = 592
   Constraints.MinHeight = 70
   Constraints.MinWidth = 280
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   OldCreateOrder = False
   Position = poOwnerFormCenter
   OnClose = FormClose
   OnCreate = FormCreate
+  ExplicitWidth = 600
+  ExplicitHeight = 389
   PixelsPerInch = 96
   TextHeight = 13
   object Splitter1: TSplitter
+  object Splitter1: TSplitter [0]
     Left = 0
     Top = 82
     Width = 369
+    Width = 592
     Height = 8
     Cursor = crVSplit
 …
     Beveled = True
     MinSize = 1
+    ExplicitWidth = 369
   end
   object Panel1: TPanel
+  object Panel1: TPanel [1]
     Left = 0
     Top = 0
     Width = 369
+    Width = 592
     Height = 82
     Align = alTop
 …
       Left = 52
       Top = 4
       Width = 313
+      Width = 536
       Height = 74
       Align = alClient
 …
     end
   end
   object Panel3: TPanel
+  object Panel3: TPanel [2]
     Left = 0
     Top = 90
     Width = 369
+    Width = 592
     Height = 272
     Align = alClient
 …
       Width = 188
       Height = 202
-      Align = alRight
       Caption = 'Set Administration Time'
       TabOrder = 1
 …
       Left = 1
       Top = 203
       Width = 367
+      Width = 590
       Height = 68
       Align = alBottom
       TabOrder = 2
+      TabOrder = 3
       DesignSize = (
 )
       object Label1: TLabel
 …
       end
       object btn0k1: TButton
         Left = 204
+        Left = 427
         Top = 43
         Width = 75
 …
       end
       object btnCancel: TButton
         Left = 285
+        Left = 508
         Top = 42
         Width = 75
 …
         OnClick = btnCancelClick
       end
-      object txtSchedule: TEdit
-        Left = 64
-        Top = 8
-        Width = 296
-        Height = 21
-        Anchors = [akLeft, akTop, akRight]
-        Color = clInfoBk
-        Enabled = False
-        Font.Charset = DEFAULT_CHARSET
-        Font.Color = clWindowText
-        Font.Height = -11
-        Font.Name = 'MS Sans Serif'
-        Font.Style = [fsBold]
-        ParentFont = False
-        ReadOnly = True
-        TabOrder = 0
-        OnChange = txtScheduleChange
-      end
       object btnReset: TButton
         Left = 8
 …
         OnClick = btnResetClick
       end
+    end
+      object txtSchedule: TEdit
+        Left = 63
+        Top = 6
+        Width = 520
+        Height = 21
+        Color = clInfoBk
+        ReadOnly = True
+        TabOrder = 0
+      end
+    end
+    object GroupBox3: TGroupBox
+      Left = 374
+      Top = -2
+      Width = 211
+      Height = 202
+      Caption = 'Schedule'
+      TabOrder = 2
+      object NSScboSchedule: TORComboBox
+        Left = 5
+        Top = 16
+        Width = 121
+        Height = 180
+        Style = orcsSimple
+        AutoSelect = True
+        Color = clWindow
+        DropDownCount = 8
+        ItemHeight = 13
+        ItemTipColor = clWindow
+        ItemTipEnable = True
+        ListItemsOnly = False
+        LongList = False
+        LookupPiece = 1
+        MaxLength = 0
+        Pieces = '1'
+        Sorted = False
+        SynonymChars = '<>'
+        TabOrder = 0
+        CharsNeedMatch = 1
+        UniqueAutoComplete = True
+      end
+      object btnSchAdd: TButton
+        Left = 132
+        Top = 64
+        Width = 60
+        Height = 19
+        Caption = 'Add'
+        TabOrder = 1
+        OnClick = btnSchAddClick
+      end
+      object btnSchRemove: TButton
+        Left = 132
+        Top = 94
+        Width = 60
+        Height = 19
+        Caption = 'Remove'
+        TabOrder = 2
+        OnClick = btnSchRemoveClick
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = Panel1'
+        'Status = stsDefault')
+      (
+        'Component = memMessage'
+        'Status = stsDefault')
+      (
+        'Component = Panel3'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox1'
+        'Status = stsDefault')
+      (
+        'Component = cbo7'
+        'Status = stsDefault')
+      (
+        'Component = cbo1'
+        'Status = stsDefault')
+      (
+        'Component = cbo2'
+        'Status = stsDefault')
+      (
+        'Component = cbo3'
+        'Status = stsDefault')
+      (
+        'Component = cbo4'
+        'Status = stsDefault')
+      (
+        'Component = cbo5'
+        'Status = stsDefault')
+      (
+        'Component = cbo6'
+        'Status = stsDefault')
+      (
+        'Component = Button1'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox2'
+        'Status = stsDefault')
+      (
+        'Component = lstHour'
+        'Status = stsDefault')
+      (
+        'Component = lstMinute'
+        'Status = stsDefault')
+      (
+        'Component = btnRemove'
+        'Status = stsDefault')
+      (
+        'Component = btnAdd'
+        'Status = stsDefault')
+      (
+        'Component = Panel4'
+        'Status = stsDefault')
+      (
+        'Component = btn0k1'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnReset'
+        'Status = stsDefault')
+      (
+        'Component = GroupBox3'
+        'Status = stsDefault')
+      (
+        'Component = NSScboSchedule'
+        'Status = stsDefault')
+      (
+        'Component = btnSchAdd'
+        'Status = stsDefault')
+      (
+        'Component = btnSchRemove'
+        'Status = stsDefault')
+      (
+        'Component = frmOtherSchedule'
+        'Status = stsDefault')
+      (
+        'Component = txtSchedule'
+        'Status = stsDefault'))
   end
 end

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc;
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc, ORCtrls, rODMeds,
+  VA508AccessibilityManager, VAUtils;
 const
 …
     btn0k1: TButton;
     btnCancel: TButton;
-    txtSchedule: TEdit;
     Label1: TLabel;
     btnReset: TButton;
 …
     btnAdd: TButton;
     Button1: TButton;
+    GroupBox3: TGroupBox;
+    NSScboSchedule: TORComboBox;
+    btnSchAdd: TButton;
+    btnSchRemove: TButton;
+    txtSchedule: TEdit;
     procedure FormCreate(Sender: TObject);
     procedure btnCancelClick(Sender: TObject);
 …
       Shift: TShiftState);
     procedure Button1Click(Sender: TObject);
+    procedure btnSchAddClick(Sender: TObject);
+    procedure btnSchRemoveClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
   private
     FDaySchedule: array [1..7] of string;
     FTimeSchedule: TStringList;
+    FSchedule: String;
     FOtherSchedule: String;
     FFromCheckBox: boolean;
 …
     procedure SetDaySchedule(Sender: TObject);
     procedure SetTimeSchedule;
+    procedure SetScheduleSelection;
     procedure UpdateOnFreeTextInput;
+    procedure EnabledTime(TF: boolean);
+    procedure EnabledSch(TF: boolean);
     function CheckDay(ADayStr: string): string;
 …
 function ShowOtherSchedule(var ASchedule: string): boolean;
+var
+   frmOtherSchedule: TfrmOtherSchedule;
 implementation
 …
 {$R *.dfm}
+function ShowOtherSchedule(var ASchedule: string): boolean;
+var
+  frmOtherSchedule: TfrmOtherSchedule;
+function ShowOtherSchedule(var ASchedule: string):
+boolean;
+var
+  AdminTime, SchType: string;
 begin
   Result := False;
   try
+   ASchedule := '';
    frmOtherSchedule := TfrmOtherSchedule.Create(Application);
    ResizeFormToFont(TForm(frmOtherSchedule));
 …
    begin
      ASchedule := UpperCase(frmOtherSchedule.FOtherSchedule);
+     if frmOtherSchedule.GroupBox3.Enabled = True then
+       begin
+         AdminTime := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,4);
+         schType := Piece(frmOtherSchedule.NSScboSchedule.Items.Strings[frmOtherSchedule.NSScboSchedule.itemindex],U,3);
+         ASchedule := ASchedule + U + AdminTime + U + schType;
+         //if (schType = 'P') or (schType = 'OC') then ASchedule := ASchedule + U + '1'
+         //else ASchedule := ASchedule + U + '0';
+       end
+     else if frmOtherSchedule.GroupBox2.Enabled = true then
+       begin
+         AdminTime := Piece(ASchedule,'@',2);
+         ASchedule := ASchedule + U + AdminTime + U + 'C';
+       end;
      Result := True;
    end;
   except
    ShowMessage('Error happen when building other schedule');
+   ShowMsg('Error happen when building other schedule');
   end;
 end;
 …
   nssMsg: string;
 begin
+  frmOtherSchedule := nil;
   FFromCheckBox := False;
   FFromEditBox := False;
 …
    FDaySchedule[i] := '';
   FTimeSchedule := TStringlist.Create;
+  FSchedule := '';
   FOtherSchedule := '';
   nssMsg := GetSiteMessage;
 …
     nssMsg := NSS_TXT;
   memMessage.Lines.Add(nssMsg);
+  LoadDOWSchedules(NSScboSchedule.Items);
+  if ScreenReaderActive = false then txtSchedule.TabStop := false;
+end;
+procedure TfrmOtherSchedule.FormDestroy(Sender: TObject);
+begin
+  inherited;
+    //FDaySchedule
+    FTimeSchedule.Free;
+    frmOtherSchedule := nil;
+    //FSchedule: String;
+    //FOtherSchedule: String;
 end;
 procedure TfrmOtherSchedule.btnCancelClick(Sender: TObject);
 begin
   modalResult := mrCancel;
+  frmOtherSchedule.Release;
 end;
 …
     (cbo6.Checked = false) and (cbo7.Checked = false) then
     begin
       ShowMessage('A day of week must be selected!');
+      ShowMsg('A day of week must be selected!');
       Exit;
     end;
+  if not IsValidSchStr(FOtherSchedule) then
+  begin
+    ShowMessage('The schedule you entered is invalid!');
+  if Pos('@', self.txtSchedule.Text) = 0 then
+    begin
+      ShowMsg('An Administation Time or a schedule needs to be selected');
+      exit;
+    end;
+(*  if not IsValidSchStr(FOtherSchedule) then
+  begin
+    Show508Message('The schedule you entered is invalid!');
     Exit;
   end;
+  end;  *)
   modalResult := mrOK;
 end;
 …
 var
   i : integer;
   TimePart, DayPart: string;
+  TimePart, DayPart, Schedule: string;
 begin
   with (Sender as TCheckBox) do
 …
         FDaySchedule[TCheckBox(Sender).Tag] := '';
     except
       ShowMessage('Error happened when building day schedule.');
+      ShowMsg('Error happened when building day schedule.');
       Exit;
     end;
 …
   TimePart := '';
   DayPart := '';
+  for i := 0 to FTimeSchedule.Count - 1 do
+  begin
+    if i = 0 then TimePart := TimePart + FTimeSchedule[i]
+    else TimePart := TimePart + '-' + FTimeSchedule[i];
+  end;
+  schedule := '';
+  if Self.GroupBox2.Enabled = True then
+    begin
+        for i := 0 to FTimeSchedule.Count - 1 do
+          begin
+            if i = 0 then TimePart := TimePart + FTimeSchedule[i]
+            else TimePart := TimePart + '-' + FTimeSchedule[i];
+          end;
+    end;
+  if (self.GroupBox3.Enabled = True) and (FSchedule <> '') then schedule := FSchedule;
   for i := Low(FDaySchedule) to High(FDaySchedule) do
   begin
 …
       FOtherSchedule := TimePart;
   end
+  else if Length(schedule) > 0 then
+    begin
+      if length(DayPart) > 0 then
+      FOtherSchedule := DayPart + '@' + Schedule
+    else if Length(DayPart) = 0 then
+      FOtherSchedule := Schedule;
+    end
   else FOtherSchedule := DayPart;
+  txtSchedule.Text := FOtherSchedule;
+end;
+procedure TfrmOtherSchedule.SetScheduleSelection;
+var
+  i: integer;
+  DayPart: string;
+begin
+  DayPart := '';
+  for i := Low(FDaySchedule) to High(FDaySchedule) do
+  begin
+    if Length(FDaySchedule[i])>0 then
+    begin
+      if DayPart = '' then DayPart := FDaySchedule[i]
+      else DayPart := DayPart + '-' + FDaySchedule[i];
+    end;
+  end;
+  if Length(DayPart) > 0 then
+  begin
+    if FSchedule <> '' then
+      FOtherSchedule := DayPart + '@' + FSchedule
+    else
+      FOtherSchedule := DayPart;
+  end
+  else FOtherSchedule := FSchedule;
+  //if Length(APRN) > 0 then FOtherSchedule := FOtherSchedule;
   txtSchedule.Text := FOtherSchedule;
 end;
 …
   hour, min: string;
 begin
+  if FSchedule <> '' then Exit;
   if lstHour.ItemIndex < 0 then exit;
   hour := lstHour.Items[lstHour.ItemIndex];
 …
   FTimeSchedule.Sort;
   SetTimeSchedule;
+  if FTimeSchedule.Count > 0 then EnabledSch(False);
 end;
 …
   lstHour.ItemIndex := -1;
   lstMinute.ItemIndex := -1;
+  NSScboSchedule.ItemIndex := -1;
   for i := low(FDaySchedule) to high(FDaySchedule) do
     FDaySchedule[i] := '';
 …
   FOtherSchedule := '';
   txtSchedule.Text := '';
+  FSchedule := '';
+  EnabledTime(True);
+  EnabledSch(True);
+end;
+procedure TfrmOtherSchedule.btnSchAddClick(Sender: TObject);
+begin
+  inherited;
+  if self.NSScboSchedule.ItemIndex < 0 then Exit;
+  if FSchedule <> '' then
+    begin
+      infoBox('A Day-of-week schedule can only contain one schedule','Warning',MB_OK);
+      Exit;
+    end;
+  FSchedule := self.NSScboSchedule.Text;
+  SetScheduleSelection;
+  Self.NSScboSchedule.Enabled := False;
+  EnabledTime(False);
+end;
+procedure TfrmOtherSchedule.btnSchRemoveClick(Sender: TObject);
+begin
+  inherited;
+  if (FSchedule = '') or (self.NSScboSchedule.ItemIndex < 0) then exit;
+  if self.NSScboSchedule.Text <> FSchedule then exit;
+  Fschedule := '';
+  SetScheduleSelection;
+  self.NSScboSchedule.Enabled := True;
+  EnabledTime(True);
 end;
 …
   SetTimeSchedule;
   FFromCheckBox := False;
+  if FTimeSchedule.Count = 0 then EnabledSch(True);
 end;
 …
     Action := caFree;
   end;
+  //frmOtherSchedule := nil;
 end;
 …
 end;
+procedure TfrmOtherSchedule.EnabledSch(TF: boolean);
+begin
+   self.GroupBox3.Enabled := TF;
+   self.NSScboSchedule.Enabled := TF;
+   self.btnSchAdd.Enabled := TF;
+   self.btnSchRemove.Enabled := TF;
+//   if TF = False then self.NSScboSchedule.Color := cl3DLight
+//   else self.NSScboSchedule.Color := clWindow;
+   if TF = False then self.NSScboSchedule.ItemIndex := -1;
+end;
+procedure TfrmOtherSchedule.EnabledTime(TF: boolean);
+begin
+  self.GroupBox2.Enabled := TF;
+  self.lstHour.Enabled := TF;
+  self.lstMinute.Enabled := TF;
+  self.btnAdd.Enabled := TF;
+  self.btnRemove.Enabled := TF;
+  if TF = False then
+    begin
+      self.lstHour.ItemIndex := -1;
+      self.lstMinute.ItemIndex := -1;
+    end;
+end;
 procedure TfrmOtherSchedule.lstMinuteMouseUp(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

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

-              r456
+              r829
 interface
 uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc ;
+uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, rMisc,fNotes ;
 type
 …
 function EnableErrorComments: boolean;
 function IsARTClinicalUser(var AMessage: string): boolean;
+function GetAllergyTitleText: string;
 implementation
 …
   i: integer;
 begin
   with RPCBrokerV, EditRec do
     begin
 …
                     Mult['"GMRAERRCMTS",' + IntToStr(i+1)] := Strings[i];
                 end;
             end ;
           with ChartMarked do if Count > 0 then
 …
             end;
         end;
+      CallBroker;
+      Result := Results[0];
+    end;
+        CallBroker;
+        Result := Results[0];
+        // Include "Allergy Entered in Error" items require signature list.
+        //cq-8002  -piece 2 is Allergy Entered in Error (IEN)
+       // code added allowing v27 GUI changes to continue if M change is not released prior.
+       //cq-14842 -  add observed/drug allergies to the fReview/fSignOrders forms for signature.
+       if Length(Piece(Result,'^',2))> 0 then
+         Changes.Add(10, Piece(Result,'^',2), GetAllergyTitleText, '', 1)
+       else
+          exit;
+        end;
 end;
 …
 end;
+function GetAllergyTitleText: string;
+begin
+    Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(floatToStr(FMToday))) +
+              '  ' + 'Adverse React/Allergy' + ', ' + Encounter.LocationName + ', ' + User.Name;
+end;
 end.

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

-              r456
+              r829
 unit rODBase;
 interface
+interface
 uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders;
 …
 implementation
 uses TRPCB, uOrders, uODBase;
+uses TRPCB, uOrders, uODBase, fODBase;
 var
 …
         begin
           IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
           TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'hours';
+          TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours';
         end
         else if (Pos('D',upperCase(IVDuration))>0) then
         begin
+          IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
+          TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days';
+          if Pos('DOSES', upperCase(IVDuration)) > 0 then
+            begin
+              IVDurVal := Copy(IVDuration, 1, length(IVDuration)-5);
+              TResponse(ResponseList.Items[j]).IValue := 'for a total of ' + IVDurVal + ' doses';
+            end
+          else
+            begin
+              IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
+              TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' days';
+            end;
         end
         else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
 …
 begin
   CallV('ORWDXQ GETQLST', [DGroup]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   HasObjects := FALSE;
   TempBroker := TStringlist.Create;
   TempBroker.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, TempBroker);
   try
   with TempBroker do while i < Count do
 …
 procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
+begin
+  CallV('ORWDX LOADRSP', [OrderID]);
+var
+Transfer: boolean;
+begin
+  if ((XferOuttoInOnMeds = True) or (XfInToOutNow = True)) and (CharAt(OrderID,1)='C') then Transfer := true
+  else Transfer := false;
+  CallV('ORWDX LOADRSP', [OrderID, Transfer]);
   ExtractToResponses(Dest, HasObjects);
 end;
 …
     begin
       uMedRoutes := TStringList.Create;
       uMedRoutes.Assign(Results);
+      FastAssign(RPCBrokerV.Results, uMedRoutes);
       for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
       begin
 …
     end; {with RPCBrokerV}
   end; {if uMedRoutes}
   Dest.AddStrings(uMedRoutes);
+  FastAddStrings(uMedRoutes, Dest);
 end;
 …
 begin
   CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
   AList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, AList);
 end;
 …
 { Returns init values for inpatient meds dialog.  The results must be used immediately. }
 begin
   CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE]);
+  CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE, patient.dfn, patient.location]);
   Result := RPCBrokerV.Results;
 end;
 …
 { Returns init values for IV Fluids dialog.  The results must be used immediately. }
 begin
   CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS]);
+  CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS, patient.dfn, patient.location]);
   Result := RPCBrokerV.Results;
 end;
 …
 { Returns init values for outpatient meds dialog.  The results must be used immediately. }
 begin
   CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT]);
+  CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT, patient.dfn, patient.location]);
   Result := RPCBrokerV.Results;
 end;

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

-              r456
+              r829
 begin
   CallV('ORWDFH TFPROD', [nil]);
   Dest.AddStrings(RPCBrokerV.Results);
+  FastAddStrings(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORWDFH ISOLIST', [nil]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORWDXQ GETQLST', [GroupID, 'Q']);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORWDFH CURRENT MEALS', [Patient.DFN, MealType]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
   MixedCaseList(Dest);
 end;

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

-              r456
+              r829
 function  GetLastCollectionTime: string;
 procedure GetPatientBBInfo(Dest: TStrings; PatientID: string; Loc: integer);
+procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
+procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
 procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList);
 procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList);
 function  StatAllowed(PatientID: string): boolean;
 procedure GetBloodComponents(Dest: TStrings);
+function  NursAdminSuppress: boolean;
+function  GetSubtype(TestName: string): string;
+function  TNSDaysBack: integer;
+procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
+procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
+function  GetLCtoWCInstructions(Alocation: integer): string;
+procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
+procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
+const
+  TX0 = 'The following Lab orders will be changed to Ward Collect:';
+  TX2 = 'Order Date' + #9 +#9 + 'Reason Changed to Ward Collect';
+  TX5 = 'Please contact the ward staff to insure the specimen is collected.';
+  TX6 = 'You can print this screen for reference.';
+  TX_BLANK = '';
 implementation
 uses  rODBase;
-(*    fODBase, rODBase, fODLab;*)
 procedure GetBloodComponents(Dest: TStrings);
 …
 end;
+function NursAdminSuppress: boolean;
+begin
+  Result := (StrToInt(sCallV('ORWDXVB NURSADMN',[nil])) < 1);
+end;
 function  StatAllowed(PatientID: string): boolean;
 begin
 …
 begin
   tCallV(Dest, 'ORWDXVB GETALL', [PatientID, Loc]);
+end;
+function GetSubtype(TestName: string): string;
+begin
+  Result := sCallV('ORWDXVB SUBCHK', [TestName]);
+end;
+function TNSDaysBack: integer;
+begin
+  Result := StrToIntDef(sCallV('ORWDXVB VBTNS', [nil]),3);
+end;
+procedure ListForQuickOrders(var AListIEN, ACount: Integer; const DGrpNm: string);
+begin
+  CallV('ORWUL QV4DG', [DGrpNm]);
+  AListIEN := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 1), 0);
+  ACount   := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
+end;
+procedure SubsetOfQuickOrders(Dest: TStringList; AListIEN, First, Last: Integer);
+var
+  i: Integer;
+begin
+ CallV('ORWUL QVSUB', [AListIEN,'','']);
+ for i := 0 to RPCBrokerV.Results.Count -1 do
+   Dest.Add(RPCBrokerV.Results[i]);
 end;
 …
 end;
+procedure CheckForChangeFromLCtoWCOnAccept(Dest: TStrings; ALocation: integer; AStartDate, ACollType, ASchedule, ADuration: string);
+var
+  AList: TStringList;
+begin
+  AList := TStringList.Create;
+  try
+    CallV('ORCDLR2 CHECK ONE LC TO WC', [ALocation, '', AStartDate, ACollType, ASchedule, ADuration]);
+    FastAssign(RPCBrokerV.Results, AList);
+    FormatLCtoWCDisplayTextOnAccept(AList, Dest);
+  finally
+    AList.Free;
+  end;
+end;
+procedure CheckForChangeFromLCtoWCOnRelease(Dest: TStrings; ALocation: integer; OrderList: TStringList);
+var
+  AList: TStringList;
+begin
+  AList := TStringList.Create;
+  try
+    CallV('ORCDLR2 CHECK ALL LC TO WC', [ALocation, OrderList]);
+    FastAssign(RPCBrokerV.Results, AList);
+    FormatLCtoWCDisplayTextOnRelease(AList, Dest);
+  finally
+    AList.Free;
+  end;
+end;
+procedure FormatLCtoWCDisplayTextOnAccept(InputList, OutputList: TStrings);
+var
+  i: integer;
+  x: string;
+begin
+  OutputList.Clear;
+  for i := InputList.Count - 1 downto 0 do
+    if Piece(InputList[i], U, 2) = '1' then InputList.Delete(i);
+  if InputList.Count > 0 then
+  begin
+    SetListFMDateTime('mmm dd, yyyy@hh:nn', TStringList(InputList), U, 1);
+    with OutputList do
+    begin
+      Add(TX0);
+      Add(TX_BLANK);
+      Add('Patient :' + #9 + Patient.Name);
+      Add('SSN     :' + #9 + Patient.SSN);
+      Add('Location:' + #9 + Encounter.LocationName + CRLF);
+      for i := 0 to InputList.Count - 1 do
+        Add(Piece(InputList[i], U, 1) + #9 + Piece(InputList[i], U, 3));
+      Add(TX_BLANK);
+      x := GetLCtoWCInstructions(Encounter.Location);
+      if x = '' then x := TX5;
+      Add(x);
+      Add(TX6);
+    end;
+  end;
+end;
+procedure FormatLCtoWCDisplayTextOnRelease(InputList, OutputList: TStrings);
+var
+  i, j, k, Changed: integer;
+  AList: TStringlist;
+  x: string;
+begin
+  OutputList.Clear;
+  Changed := StrToIntDef(ExtractDefault(InputList, 'COUNT'), 0);
+  if Changed > 0 then
+  begin
+    AList := TStringList.Create;
+    try
+      with OutputList do
+      begin
+        Add(TX0);
+        Add(TX_BLANK);
+        Add('Patient :' + #9 + Patient.Name);
+        Add('SSN     :' + #9 + Patient.SSN);
+        Add('Location:' + #9 + Encounter.LocationName);
+        for i := 1 to Changed do
+        begin
+          Add(TX_BLANK);
+          AList.Clear;
+          ExtractText(AList, InputList, 'ORDER_' + IntToStr(i));
+          Add('Order   :' + #9 + AList[0]);
+          k := Length(OutputList[Count-1]);
+          if AList.Count > 1 then
+            for j := 1 to AList.Count - 1 do
+            begin
+              Add(StringOfChar(' ', 9) + #9 + AList[j]);
+              k := HigherOf(k, Length(OutputList[Count - 1]));
+            end;
+          Add(StringOfChar('-', k + 4));
+          AList.Clear;
+          ExtractItems(AList, InputList, 'ORDER_' + IntToStr(i));
+          SetListFMDateTime('mmm dd, yyyy@hh:nn', AList, U, 1);
+          for j := 0 to AList.Count - 1 do
+            OutputList.Add(Piece(AList[j], U, 1) + #9 + Piece(AList[j], U, 3));
+        end;
+        Add(TX_BLANK);
+        x := GetLCtoWCInstructions(Encounter.Location);
+        if x = '' then x := TX5;
+        Add(x);
+        Add(TX6);
+      end;
+    finally
+      AList.Free;
+    end;
+  end;
+end;
+function GetLCtoWCInstructions(Alocation: integer): string;
+begin
+  Result := sCallV('ORWDLR33 LC TO WC', [Encounter.Location]);
+end;
 end.

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

-              r456
+              r829
 interface
+uses SysUtils, Classes, ORNet, ORFn, uCore, uConst;
+uses SysUtils, Classes, ORNet, ORFn, uCore, uConst, Windows;
+type
+   TAdminTimeHelpText = record
+    HelpText: string;
+  end;
+  TInpatientClozapineText = record
+    dispText: string;
+  end;
+  TDrugHasMaxData = record
+    CaptureMaxData: boolean;
+    MaxSupply: integer;
+    MaxQuantity: integer;
+    MaxRefills: integer;
+  end;
 function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean;
 …
 procedure LoadFormularyAltDose(AList: TStringList; DispDrug, OI: Integer; ForInpatient: Boolean);
 procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string;
   var AdminTime: TFMDateTime; var Duration: string);
+  var AdminTime: TFMDateTime; var Duration: string; Admin: string = '');
 function GetAdminTime(const StartText, Schedule: string; OrdItem: Integer): TFMDateTime;
 procedure LoadSchedules(Dest: TStrings; IsInptDlg: boolean = False);
+procedure LoadDOWSchedules(Dest: TStrings);
+procedure LoadAllIVRoutes(Dest: TStrings);
+procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
 function QtyToDays(Quantity: Double;   const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
 function DaysToQty(DaysSupply: Integer; const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
 …
 function QOHasRouteDefined(AQOID: integer): boolean;
 procedure CheckExistingPI(AOrderId: string; var APtI: string);
+function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean;
+function AdminTimeHelpText(): string;
+//function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean;
+//function ValidateMaxQuantity(Quantity: integer): boolean;
+function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean;
+function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String;
+procedure ClearMaxData;
+function DifferentOrderLocations(ID: string; Loc: integer): boolean;
+function IsClozapineOrder: boolean;
+//function ValidateQuantityErrorMsg(Quantity: integer): String;
+function GetQOOrderableItem(DialogIEN: string): integer;
 implementation
+ var
+  uAdminTimeHelpText: TAdminTimeHelpText;
+  uDrugHasMaxData: TDrugHasMaxData;
+  uInpatientClozapineText : TInpatientClozapineText;
 function DEACheckFailed(AnOI: Integer; ForInpatient: Boolean): Boolean;
 …
 begin
   CallV('ORWUL FVSUB', [ListIEN, First+1, Last+1]);  // M side not 0-based
   if Append then Dest.AddStrings(RPCBrokerV.Results) else
+  if Append then FastAddStrings(RPCBrokerV.Results, Dest) else
   begin
     for i := Pred(RPCBrokerV.Results.Count) downto 0 do Dest.Insert(0, RPCBrokerV.Results[i]);
 …
   if ForInpatient then PtType := 'I' else PtType := 'O';
   CallV('ORWDPS1 FORMALT', [AnIEN, PtType]);
   AList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, AList);
 end;
 …
   if ForInpatient then PtType := 'I' else PtType := 'O';
   CallV('ORWDPS1 DOSEALT', [DispDrug, OI, PtType]);
   AList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, AList);
 end;
 procedure LoadAdminInfo(const Schedule: string; OrdItem: Integer; var StartText: string;
   var AdminTime: TFMDateTime; var Duration: string);
+  var AdminTime: TFMDateTime; var Duration: string; Admin: string = '');
 var
   x: string;
 begin
   x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location]);
+  x := sCallV('ORWDPS2 ADMIN', [Patient.DFN, Schedule, OrdItem, Encounter.Location, Admin]);
   StartText := Piece(x, U, 1);
   AdminTime := MakeFMDateTime(Piece(x, U, 4));
 …
 begin
   // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...);
   CallV('ORWDPS1 SCHALL', [nil]);
   Dest.Assign(RPCBrokerV.Results);
+  CallV('ORWDPS1 SCHALL', [patient.dfn, patient.location]);
+  FastAssign(RPCBrokerV.Results, Dest);
   If (Dest.IndexOfName('OTHER') < 0) and IsInptDlg then
     Dest.Add('OTHER');
 end;
+procedure LoadAllIVRoutes(Dest: TStrings);
+begin
+  CallV('ORWDPS32 ALLIVRTE', []);
+  FastAssign(RPCBrokerV.Results, Dest);
+end;
+procedure LoadDosageFormIVRoutes(Dest: TStrings; OrderIDs: TStringList; Default: boolean);
+begin
+  CallV('ORWDPS33 IVDOSFRM', [OrderIDs, Default, False]);
+  FastAssign(RPCBrokerV.Results, Dest);
+end;
+procedure LoadDOWSchedules(Dest: TStrings);
+begin
+  // if uMedSchedules = nil then CallV('ORWDPS ALLSCHD', [nil]); uMedSchedules.Assign(...);
+  CallV('ORWDPS1 DOWSCH', [patient.dfn, patient.location]);
+  FastAssign(RPCBrokerV.Results, Dest);
+end;
 function QtyToDays(Quantity: Double;   const UnitsPerDose, Schedule, Duration, Drug: string): Integer;
 begin
 …
   Result := StrToIntDef(sCallV('ORWDPS2 DAY2QTY',
     [DaysSupply, UnitsPerDose, Schedule, Duration, Patient.DFN, Drug]), 0);
+  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxQuantity := Result;
 end;
 …
 begin
   Result := StrToIntDef(sCallV('ORWDPS1 DFLTSPLY', [UnitStr, SchedStr, Patient.DFN, ADrug]), 0);
+  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxSupply := Result;
 end;
 …
 begin
   Result := StrToIntDef(sCallV('ORWDPS2 MAXREF', [Patient.DFN, Drug, Days, OrdItem, Discharge]), 0);
+  if uDrugHasMaxData.CaptureMaxData = True then uDrugHasMaxData.MaxRefills := Result;
 end;
 …
 end;
+function PassDrugTest(OI: integer; OrderType: string; InptOrder: boolean; CheckForClozapineOnly: boolean = false): boolean;
+var
+MessCap, MessText: string;
+i: integer;
+begin
+  result := false;
+  MessText := '';
+  uDrugHasMaxData.CaptureMaxData := false;
+  uDrugHasMaxData.MaxSupply := 0;
+  uDrugHasMaxData.MaxQuantity := 0;
+  uDrugHasMaxData.MaxRefills := 0;
+  CallV('ORALWORD ALLWORD', [Patient.DFN, OI, OrderType, Encounter.Provider]);
+  for i := 0 to RPCBrokerV.Results.Count -1 do
+    begin
+      if i = 0 then
+        begin
+          MessCap := Piece(RPCBrokerV.Results.strings[i],U,1);
+          if Piece(RPCBrokerV.Results.strings[i],U,2) = '1' then uDrugHasMaxData.CaptureMaxData := True;
+        end;
+      if i >0 then MessText := MessText + RPCBrokerV.Results.Strings[i] + CRLF;
+    end;
+  if CheckForClozapineOnly = True then
+    begin
+      Result := uDrugHasMaxData.CaptureMaxData = True;
+      Exit;
+    end;
+  if (MessText = '') and (MessCap = '') then
+    begin
+      Result := True;
+      if (InptOrder = true) and (uDrugHasMaxData.CaptureMaxData = true) then
+        begin
+          uDrugHasMaxData.CaptureMaxData := false;
+          if uInpatientClozapineText.dispText = '' then
+            begin
+              CallV('ORDDPAPI CLOZMSG', []);
+              for i := 0 to RPCBrokerV.Results.Count -1 do
+                 if i = 0 then uInpatientClozapineText.dispText := RPCBrokerV.Results.Strings[i]
+                 else uInpatientClozapineText.dispText := uInpatientClozapineText.dispText + CRLF + RPCBrokerV.Results.Strings[i];
+            end;
+          if uInpatientClozapineText.dispText <> '' then infoBox(uInpatientClozapineText.dispText, 'Inpatient Drug Warning', MB_OK);
+        end;
+      exit;
+    end;
+  infoBox(MessText, MessCap,MB_OK);
+end;
+function AdminTimeHelpText(): string;
+var
+i: integer;
+begin
+      if uAdminTimeHelpText.HelpText = '' then
+       begin
+          CallV('ORDDPAPI ADMTIME',[]);
+          for I := 0 to RPCBrokerV.Results.Count - 1 do
+            if I = 0 then uAdminTimeHelpText.HelpText := RPCBrokerV.Results.Strings[i]
+            else uAdminTimeHelpText.HelpText := uAdminTimeHelpText.HelpText + CRLF +RPCBrokerV.Results.Strings[i];
+       end;
+   Result := uAdminTimeHelpText.helpText
+end;
+function ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur: string; OI, tempSupply, tempQuantity, tempRefills: integer): boolean;
+var
+daySupply, Quantity, Refills: integer;
+begin
+  Result := True;
+  if uDrugHasMaxData.CaptureMaxData = false then exit;
+  daySupply := DefaultDays(tempDrug, tempUnit, tempSch);
+  if (tempSupply > daySupply) and (uDrugHasMaxData.MaxSupply > 0) then
+    begin
+      infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply), 'Cannot Save Error', MB_OK);
+      Result := false;
+      uDrugHasMaxData.CaptureMaxData := false;
+      Exit;
+    end;
+  Quantity := DaysToQty(daySupply, tempUnit, tempSch, tempDur, tempDrug);
+  if (tempQuantity > Quantity) and (uDrugHasMaxData.MaxQuantity > 0) then
+    begin
+      infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK);
+      Result := false;
+      uDrugHasMaxData.CaptureMaxData := false;
+      Exit;
+    end;
+  Refills := CalcMaxRefills(tempDrug, daySupply, OI, false);
+  if tempRefills > Refills then
+    begin
+      infoBox('For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxRefills), 'Cannot Save Error', MB_OK);
+      Result := false;
+      uDrugHasMaxData.CaptureMaxData := false;
+      Exit;
+    end;
+end;
+function ValidateDaySupplyandQuantity(DaySupply, Quantity: integer): boolean;
+var
+str: string;
+begin
+  Result := True;
+  str := '';
+  if uDrugHasMaxData.CaptureMaxData = false then exit;
+  if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then
+    begin
+      str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply);
+      Result := false;
+    end;
+  if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then
+    begin
+      if str <> '' then str := str + CRLF + 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity)
+      else str := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
+      result := false;
+    end;
+ if str <> '' then infoBox(str, 'Cannot Save Error', MB_OK);
+ //uDrugHasMaxData.CaptureMaxData := false;
+end;
+function ValidateMaxQuantity(Quantity: integer): boolean;
+begin
+  Result := True;
+  if uDrugHasMaxData.CaptureMaxData = false then exit;
+  if uDrugHasMaxData.MaxQuantity = 0 then exit;
+  if Quantity > uDrugHasMaxData.MaxQuantity then
+    begin
+      infoBox('For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity), 'Cannot Save Error', MB_OK);
+      Result := false;
+    end;
+end;
+function ValidateDaySupplyandQuantityErrorMsg(DaySupply, quantity: integer): String;
+begin
+  Result := '';
+  if uDrugHasMaxData.CaptureMaxData = false then exit;
+  if (daySupply > uDrugHasMaxData.MaxSupply) and (uDrugHasMaxData.MaxSupply > 0) then
+    begin
+      Result := 'For this medication Day Supply cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxSupply);
+    end;
+  if (Quantity > uDrugHasMaxData.MaxQuantity) and (uDrugHasMaxData.MaxQuantity > 0) then
+    begin
+      if Result <> '' then Result := Result + CRLF + 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity)
+      else Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
+    end;
+  //uDrugHasMaxData.CaptureMaxData := false;
+end;
+function ValidateQuantityErrorMsg(Quantity: integer): String;
+begin
+  Result := '';
+  if uDrugHasMaxData.CaptureMaxData = false then exit;
+  if uDrugHasMaxData.MaxQuantity = 0 then exit;
+  if Quantity > uDrugHasMaxData.MaxQuantity then
+    begin
+      Result := 'For this medication Quantity cannot be greater then ' + InttoStr(uDrugHasMaxData.MaxQuantity);
+    end;
+end;
+procedure ClearMaxData;
+begin
+  uDrugHasMaxData.CaptureMaxData := false;
+end;
+function DifferentOrderLocations(ID: string; Loc: integer): boolean;
+begin
+   Result := (sCallV('ORWDPS33 COMPLOC', [ID, Loc])='1');
+end;
+function IsClozapineOrder: boolean;
+begin
+   if uDrugHasMaxData.CaptureMaxData = true then result := true
+   else result := false;
+end;
+function GetQOOrderableItem(DialogIEN: string): integer;
+begin
+  Result := StrtoInt(SCallV('ORWDPS1 QOMEDALT',[DialogIEN]))
+end;
 end.

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

-              r456
+              r829
 function SubsetOfImagingTypes: TStrings;
 function SubsetOfRadSources(SrcType: string): TStrings;
+function LocationType(Location: integer): string;
+function LocationType(Location: integer): string;
+function ReasonForStudyCarryOn: Boolean;
 implementation
 …
 begin
   Result := sCallV('ORWDRA32 LOCTYPE',[Location]);
+end;
+function ReasonForStudyCarryOn: Boolean;
+begin
+  Result := sCallV('ORWDXM1 SVRPC',['']) = '1';
 end;

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

-              r456
+              r829
     LinkObject:   TObject;
     EnteredInError:     Integer; //AGP Changes 26.12 PSI-04-053
+    DCOriginalOrder: boolean;
     procedure Assign(Source: TOrder);
     procedure Clear;
 …
 procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
 procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
 procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);  {*KCM*}
 procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char); {*KCM*}
+procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);  {*KCM*}
+procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
+procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {*KCM*}
 function UseNewMedDialogs: Boolean;
 …
 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
 function GetREQReason: Integer;
 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
+procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
 procedure ReleaseOrderHold(AnOrder: TOrder);
 procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
 …
 function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
 procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
+function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
 //function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
 …
 implementation
 uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore;
+uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils;
 var
 …
 procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
 {           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18
 { Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig}
+{           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18    19     20
+{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder}
 begin
   with AnOrder do
 …
     Retrieved := True;
     OrderLocIEN  := Piece(Piece(x,U,19),':',2);   //imo
+    OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
+    if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown'
+    else OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
     Text := y;
     XMLText := z;
 …
     else AnOrder.EnteredInError := 0;
     //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA  ' + Text;
+    if Piece(x,U,20) = '1' then DCOriginalOrder := True
+    else DCOriginalOrder := False;
   end;
 end;
 …
   AnOrder: TOrder;
   FilterTS: string;
+  AlertedUserOnly: boolean;
 begin
   ClearOrders(Dest);
   if uDGroupMap = nil then LoadDGroupMap;  // to make sure broker not called while looping thru Results
   FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
+  CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
+  AlertedUserOnly := (Notifications.Active and (AView.Filter = 12));
+  CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]);
   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)
   begin
 …
   CallV('ORWOR SHEETS', [Patient.DFN]);
   MixedCaseByPiece(RPCBrokerV.Results, U, 2);
   Dest.Assign(RPCBrokerV.Results);
 end;
+  FastAssign(RPCBrokerV.Results, Dest);
+ end;
 procedure LoadOrderSheetsED(Dest: TStrings);
 …
     for i := 0 to RPCbrokerV.Results.Count - 1 do
       RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders';
     Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end;
 end;
 …
     for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := '';
     CallBroker;
     IDList.Assign(Results);
+    FastAssign(RPCBrokerV.Results,IDList);
   end;
 end;
 …
 begin
   CallV('ORWORDG ALLTREE', [nil]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   CallV('ORWOR TSALL', [nil]);
   MixedCaseList(RPCBrokerV.Results);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   otherEvts: TStringList;
   commonList: TStringList;
+  IsObservation: boolean;
 begin
   if Encounter <> nil then
 …
   else
     Currloc := 0;
+  IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1');
   commonList := TStringList.Create;
   CallV('OREVNTX1 CMEVTS',[Currloc]);
 …
       commonList.Add(Results[i]);
     end
+    else if IsObservation then
+    begin
+      if (Piece(Results[i],'^',3) = 'T') then
+        Continue;
+      commonList.Add(Results[i]);
+    end
     else
     begin
 …
   if commonList.Count > 0 then
   begin
     Dest.AddStrings(TStrings(commonList));
+    FastAddStrings(TStrings(commonList), Dest);
     Dest.Add('^^^^^^^^___________________________________________________________________________________________');
     Dest.Add(LLS_SPACE);
 …
     begin
       RPCBrokerV.Results.Delete(0);
       admitEvts.AddStrings(RPCBrokerV.Results);
+      FastAddStrings(RPCBrokerV.Results, admitEvts);
     end;
+    CallV('OREVNTX ACTIVE',['T^O^M^D']);
+    if IsObservation then
+      CallV('OREVNTX ACTIVE',['O^M^D'])
+    else
+      CallV('OREVNTX ACTIVE',['T^O^M^D']);
     //MixedCaseList(RPCBrokerV.Results);
     if RPCBrokerV.Results.Count > 0 then
     begin
       RPCBrokerV.Results.Delete(0);
       otherEvts.AddStrings(RPCBrokerV.Results);
+      FastAddStrings(RPCBrokerV.Results, otherEvts);
     end;
     Dest.AddStrings(TStrings(otherEvts));
+    FastAddStrings(TStrings(otherEvts), Dest);
     Dest.Add('^^^^^^^^_____________________________________________________________________________________________');
     Dest.Add(LLS_SPACE);
     Dest.AddStrings(TStrings(admitEvts));
+    FastAddStrings(TStrings(admitEvts), Dest);
     admitEvts.Free;
     otherEvts.Free;
 …
     if RPCBrokerV.Results.Count > 0 then
       RPCBrokerV.Results.Delete(0);
     Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end
   else
 …
     if RPCBrokerV.Results.Count > 0 then
       RPCBrokerV.Results.Delete(0);
     Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end;
 end;
 …
 begin
   CallV('ORWORDG REVSTS', [nil]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORWORDG REVSTS', [nil]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
        RESERVED_PIECE               + U +   // 10
        KeyVars;
   CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses]);
+  CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]);
   // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp
   with RPCBrokerV do
 …
     RPCBrokerV.Results.Delete(0);
   end;
   SetItems.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, SetItems);
 end;
 …
 begin
   CallV('ORWDX WRLST', [Encounter.Location]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
   begin
     Dest.Clear;
     Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
   end
 end;
 …
       then Results[i] := Piece(Results[i], U, 1);
   OrderList.Clear;
   OrderList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, OrderList);
 end;
 …
   CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]);
   OrderList.Clear;
   OrderList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, OrderList);
 end;
 …
 end;
+procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);
+begin
+  CallV('ORWD1 RVPRINT',  [Encounter.Location, DeviceInfo, OrderList]);
+end;
+procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
+begin
+  CallV('ORWD1 SVONLY',  [Encounter.Location, OrderList]);
+procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);
+var
+Loc: Integer;
+begin
+  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
+  else Loc := Encounter.Location;
+  CallV('ORWD1 RVPRINT',  [Loc, DeviceInfo, OrderList]);
+end;
+procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
+var
+Loc: Integer;
+begin
+  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
+  else Loc := Encounter.Location;
+  CallV('ORWD1 SVONLY',  [Loc, OrderList]);
 end;
 …
   CallV('ORWOR ACTION TEXT',[ID]);
   if RPCBrokerV.Results.Count > 0 then
     Errlist.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, Errlist);
 end;
 …
 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
 begin
   CallV('ORWDXA DCREASON', [nil]);
+  CallV('ORWDX2 DCREASON', [nil]);
   ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
   //AGP Change 26.15 for PSI-04-63
 …
 end;
 procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
 var
   AParentID : string;
+procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
+var
+  AParentID, DCOrigOrder: string;
 begin
   AParentID := AnOrder.ParentID;
+  CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason]);
+  if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1'
+  else DCOrigOrder := '0';
+  CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]);
   UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID);
   DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0);
 …
 begin
   CallV('ORWDXA FLAGTXT', [ID]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
 begin
   CallV('ORWDXA WCGET', [ID]);
   Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 …
       if piece(Results[0],'^',1) = '-1' then
         begin
           ShowMessage('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
+          ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
             'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF +
             '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.');
 …
   SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
   SetOrderFromResults(AnOrder);
+end;
+function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
+begin
+ Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1;
 end;
 …
   CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
   if RPCBrokerV.Results.Count > 0 then
     RejectedReason.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, RejectedReason);
 end;
 …
       MixedCaseList( RPCBrokerV.Results );
       RPCBrokerV.Results.Delete(0);
       Dest.Assign(RPCBrokerV.Results);
+      FastAssign(RPCBrokerV.Results, Dest);
     end;
   end;
 …
   begin
     SortByPiece(TStringList(RPCBrokerV.Results),'^',2);
     Dest.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, Dest);
   end;
 end;
 …
     then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
     else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
   ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 …
     then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList])
     else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
   ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 …
 begin
   CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
   ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 …
                                   (PromptForWorkCopy     in ['1','2']));
         RPCBrokerV.Results.Delete(0);
         OrdersToPrint.Assign(RPCBrokerV.Results);
+        FastAssign(RPCBrokerV.Results, OrdersToPrint);
       end;
     Result := TempParams;
 …
 *)
 procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char);
+procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0);
 var
   x: string;
 begin
   if Nature <> #0 then
+    CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList])
+    begin
+       if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList])
+       else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]);
+    end
   else
+    CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
+    begin
+      if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList])
+      else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
+    end;
   x := RPCBrokerV.Results[0];
   FillChar(PrintParams, SizeOf(PrintParams), #0);
 …
       RPCBrokerV.Results.Delete(0);
       OrderList.Clear;
       OrderList.Assign(RPCBrokerV.Results);
+      FastAssign(RPCBrokerV.Results, OrderList);
     end;
 end;

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

-              r456
+              r829
 procedure PushKeyVars(const NewVals: string);
 procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
+procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
+            var CancelText: string; Sender: TObject);
 implementation
 uses
   dShared, Windows, rTemplates;
+  dShared, Windows, rTemplates, SysUtils, StdCtrls, fOrders, rOrders;
 var
 …
 end;
+// Check for diet orders that will be auto-DCd on release because of start/stop overlaps.
+// Moved here for visibility because it also needs to be checked on an auto-accept order.
+procedure CheckForAutoDCDietOrders(EvtID: integer; DispGrp: integer; CurrentText: string;
+            var CancelText: string; Sender: TObject);
+const
+  TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
+              'you specify a start date for when the new diet should replace the current' + CRLF +
+              'diet:' + CRLF + CRLF;
+  TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
+  TX_CX_DELAYED1 =  'There are other delayed diet orders for this release event:';
+  TX_CX_DELAYED2 =  'This new diet order may cancel and replace those other diets' + CRLF +
+                    'IMMEDIATELY ON RELEASE, unless you either:' + CRLF + CRLF +
+                    '1. Specify an expiration date/time for this order that will' + CRLF +
+                    '   be prior to the start date/time of those other orders; or' + CRLF + CRLF +
+                    '2. Specify a later start date/time for this order for when you' + CRLF +
+                    '   would like it to cancel and replace those other orders.';
+var
+  i: integer;
+  AStringList: TStringList;
+  AList: TList;
+  x, PtEvtIFN, PtEvtName: string;
+  //AResponse: TResponse;
+begin
+  if EvtID = 0 then   // check current and future released diets
+  begin
+    x := CurrentText;
+    if Piece(x, #13, 1) <> 'Current Diet:  ' then
+    begin
+      AStringList := TStringList.Create;
+      try
+        AStringList.Text := x;
+        CancelText := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
+                 + #9 + Copy(AStringList[0], 16, 99) + CRLF;
+        if AStringList.Count > 1 then
+        begin
+          CancelText := CancelText + CRLF + CRLF +
+                   TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
+                   + #9 + Copy(AStringList[1], 22, 99) + CRLF;
+          if AStringList.Count > 2 then
+          for i := 2 to AStringList.Count - 1 do
+            CancelText := CancelText + #9 + TrimLeft(AStringList[i]) + CRLF;
+        end;
+      finally
+        AStringList.Free;
+      end;
+    end;
+  end
+  else if Sender is TButton then     // delayed orders code here - on accept only
+  begin
+    //AResponse := Responses.FindResponseByName('STOP', 1);
+    //if (AResponse <> nil) and (AResponse.EValue <> '') then exit;
+    AList := TList.Create;
+    try
+      PtEvtIFN := IntToStr(frmOrders.TheCurrentView.EventDelay.PtEventIFN);
+      PtEvtName := frmOrders.TheCurrentView.EventDelay.EventName;
+      LoadOrdersAbbr(AList, frmOrders.TheCurrentView, PtEvtIFN);
+      for i := AList.Count - 1 downto 0 do
+      begin
+        if TOrder(Alist.Items[i]).DGroup <> DispGrp then
+        begin
+          TOrder(AList.Items[i]).Free;
+          AList.Delete(i);
+        end;
+      end;
+      if AList.Count > 0 then
+      begin
+        x := '';
+        RetrieveOrderFields(AList, 0, 0);
+        CancelText := TX_CX_DELAYED1 + CRLF + CRLF + 'Release event: ' + PtEvtName;
+        for i := 0 to AList.Count - 1 do
+          with TOrder(AList.Items[i]) do
+          begin
+            x := x + #9 + Text + CRLF;
+(*            if StartTime <> '' then
+              x := #9 + x + 'Start:   ' + StartTime + CRLF
+            else
+              x := #9 + x + 'Ordered: ' + FormatFMDateTime('mmm dd,yyyy@hh:nn', OrderTime) + CRLF;*)
+          end;
+        CancelText := CancelText + CRLF + CRLF + x;
+        CancelText := CancelText + CRLF + CRLF + TX_CX_DELAYED2;
+      end;
+    finally
+      with AList do for i := 0 to Count - 1 do TOrder(Items[i]).Free;
+      AList.Free;
+    end;
+  end;
+end;
 initialization
   uOrderEventType := #0;

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

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Controls, Forms, uConst, rOrders, ORFn,
   Dialogs, ORCtrls, stdCtrls, strUtils, fODBase;
+  Dialogs, ORCtrls, stdCtrls, strUtils, fODBase, fODMedOIFA;
 type
   EOrderDlgFail = class(Exception);
+  //FQOAltOI = record
+  //OI: integer;
+  //end;
 { Ordering Environment }
 …
 procedure QuickOrderListEdit;
 function RefNumFor(AnOwner: TComponent): Integer;
+procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
+procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer; EncLocName, WardLocName: string);
+procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
 procedure SetFontSize( FontSize: integer);
 procedure NextMove(var NMRec: TNextMoveRec; LastIndex: Integer; NewIndex: Integer);
+//function GetQOAltOI: integer;
 { Inpatient medication for Outpatient}
 …
 ProcDisp : Integer;
 ImgDisp  : Integer;
+DietDisp : Integer;
 NonVADisp: Integer;
 MedsInDlgIen  : Integer;
 …
 OriginalMedsInHeight: Integer;
 OriginalNonVAMedsHeight: Integer;
+PassDrugTstCall: boolean;
 implementation
 …
      fLkUpLocation, fOrdersPrint, fOMAction, fARTAllgy, fOMHTML, fOrders, rODBase,
      fODChild, fMeds, rMeds, rPCE, frptBox, fODMedNVA, fODChangeUnreleasedRenew, rODAllergy,
      UBAGlobals, fClinicWardMeds, uTemplateFields;
+     UBAGlobals, fClinicWardMeds, uTemplateFields, VAUtils;
 var
 …
   uOrderSetTime: TFMDateTime;
   uNewMedDialog: Integer;
+  //QOALTOI: FQOAltOI;
 const
 …
     tmpList.Add('Cannot be released to service(s) because of the following happened action(s):');
     tmpList.Add(' ');
     tmpList.AddStrings(TStrings(AnErrLst));
+    FastAddStrings(TStrings(AnErrLst), tmpList);
     ReportBox(tmpList,'Cannot be released to service(s)',False);
     tmpList.Free;
 …
   ProcDisp := DisplayGroupByName('PROC');
   ImgDisp  := DisplayGroupByName('XRAY');
+  DietDisp := DisplayGroupByName('DO');
   NonVADisp := DisplayGroupByName('NV RX');
   MedsInDlgIen  := DlgIENForName('PSJ OR PAT OE');
 …
   end else
   begin
     //ShowMessage('Order Dialogs of type "Action" are available in List Manager only.');
+    //Show508Message('Order Dialogs of type "Action" are available in List Manager only.');
     Result := False;
   end;
 …
   TC_NO_DEA     = 'DEA# Required';
   TC_IMO_ERROR  = 'Inpatient medication order on outpatient authorization required';
+  TX_EVTDEL_DIET_CONFLICT = 'Have you done either of the above?';
+  TC_EVTDEL_DIET_CONFLICT = 'Possible delayed order conflict';
 var
   ResolvedDialog: TOrderDialogResolved;
+  x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr: string;
+  ODItem: integer;
+  IsInpatient, IsAnIMOOrder: boolean;
+  IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO: boolean;
+  x, EditedOrder, chkCopay, OrderID, PkgInfo,OrderPtEvtID,OrderEvtID,NssErr, tempUnit, tempSupply, tempDrug, tempSch: string;
+  temp,tempDur,tempQuantity, tempRefills: string;
+  i, ODItem, tempOI, ALTOI: integer;
+  DrugCheck, IsInpatient, IsAnIMOOrder, DrugTestDlgType: boolean;
+  IsPsoSupply,IsDischargeOrPass,IsPharmacyOrder,IsConsultOrder,ForIMO, IsNewOrder: boolean;
   tmpResp: TResponse;
+  CxMsg: string;
+  AButton: TButton;
 begin
   IsPsoSupply := False;
 …
   IsAnIMOOrder  := False;
   ForIMO := False;
+  IsNewOrder := True;
+  PassDrugTstCall := False;
+  DrugCheck := false;
+  DrugTestDlgType := false;
+  //QOAltOI.OI := 0;
   // double check environment before continuing with order
   if uOrderDialog <> nil then uOrderDialog.Close; // then x := uOrderDialog.Name else x := '';
 …
   if CharAt(AnID, 1) = 'X' then
   begin
+    IsNewOrder := False;
+   // if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
     ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_CHANGE,   x);
     if ( Length(x)<1 ) and not (AnEvent.EventIFN > 0) then
 …
       x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
     if ShowMsgOn(Length(x) > 0, x, TC_NO_CHANGE) then Exit;
+    DrugCheck := true;
   end;
   if CharAt(AnID, 1) = 'C' then
   begin
+    IsNewOrder := False;
+    //if PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E')=false then Exit;
     ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_COPY,     x);
     if Length(x) > 0 then
       x := RetrieveOrderText(Copy(AnID, 2, Length(AnID))) + #13#10 + x;
+    if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY)   then Exit;
+    if ShowMsgOn(Length(x) > 0, x, TC_NO_COPY) then Exit;
+    DrugCheck := true;
  end;
   if CharAt(AnID, 1) = 'T' then
   begin
+    IsNewOrder := False;
+    if (XfInToOutNow = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
+    if (XfInToOutNow = false) then
+      begin
+       if (XferOuttoInOnMeds = True) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
+       if (XferOuttoInOnMeds = False) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', False)=false) then Exit;
+      end;
     ValidateOrderAction(Copy(AnID, 2, Length(AnID)), OA_TRANSFER, x);
     if Length(x) > 0 then
 …
   else if ( (IsAnIMOOrder) and (AnEvent.EventIFN <= 0) ) then
     ForIMO := True;
   OrderPtEvtID := GetOrderPtEvtID(Copy(AnID, 2, Length(AnID)));
   OrderEvtID := Piece(EventInfo(OrderPtEvtID),'^',2);
 …
   ResolvedDialog.InputID := AnID;
   BuildResponses(ResolvedDialog, GetKeyVars, AnEvent, ForIMO);
+  if (ResolvedDialog.DisplayGroup = InPtDisp) or (ResolvedDialog.DisplayGroup = ClinDisp) then DrugTestDlgType := true;
+  if (DrugCheck = true) and (ResolvedDialog.DisplayGroup = OutPtDisp) and
+  (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', false)=false) then Exit;
+  if (DrugCheck = true) and (DrugTestDlgType = true) and (PassDrugTest(StrtoINT(Copy(AnID, 2, Length(AnID)-3)), 'E', true)=false) then Exit;
+  if (IsNewOrder = True) and (ResolvedDialog.DialogType = 'Q') and
+     ((ResolvedDialog.DisplayGroup = OutptDisp) or (DrugTestDlgType = true)) then
+    begin
+      if (PassDrugTest(ResolvedDialog.DialogIEN, 'Q', DrugTestDlgType)=false) then Exit
+      else PassDrugTstCall := True;
+    end;
   if (ForIMO and ( (ResolvedDialog.DialogIEN = MedsInDlgIen)
     or (ResolvedDialog.DialogIEN = MedsIVDlgIen)) ) then
 …
      if (Length(NssErr) > 1) then
      begin
        if (NssErr <> 'OTHER') then
          ShowMessage('The order contains invalid non-standard schedule.');
+       if (NssErr <> 'OTHER') and (NssErr <> 'schedule is not defined.') then
+         ShowMsg('The order contains invalid non-standard schedule.');
        NSSchedule := True;
        ResolvedDialog.QuickLevel := 0;
 …
       if not IsValidSchedule(Copy(AnID, 2, Length(AnID))) then
       begin
         ShowMessage('The order contains invalid non-standard schedule.');
+        ShowMsg('The order contains invalid non-standard schedule.');
         NSSchedule := True;
       end;
 …
     if NSSchedule then ResolvedDialog.QuickLevel := 0;
   end;
+ (* if (ResolvedDialog.DialogType = 'Q') and ((ResolvedDialog.FormID = OD_MEDINPT) or (ResolvedDialog.FormID = OD_MEDOUTPT)) then
+    begin
+      temp := '';
+      tempOI := GetQOOrderableItem(ResolvedDialog.InputID);
+      if tempOI >0 then
+        begin
+          ALTOI := tempOI;
+          CheckFormularyOI(AltOI,temp,True);
+          if ALTOI <> tempOI then
+            begin
+              ResolvedDialog.QuickLevel := 0;
+              QOAltOI.OI := ALTOI;
+            end;
+        end;
+    end; *)
+  //   ((ResolvedDialog.DisplayGroup = InptDisp) or (ResolvedDialog.DisplayGroup = OutptDisp) or (ResolvedDialog.DisplayGroup = MedsDisp)) then
+ //    ResolvedDialog.QuickLevel := 0;
   with ResolvedDialog do if (QuickLevel = QL_VERIFY) and (HasTemplateField(ShowText)) then QuickLevel := QL_DIALOG;
+  // Check for potential conflicting auto-accept delayed-release diet orders (CQ #10946 - v27.36 - RV)
+  with ResolvedDialog do if (QuickLevel = QL_AUTO) and (DisplayGroup = DietDisp) and (AnEvent.EventType <> 'C') then
+  begin
+    AButton := TButton.Create(Application);
+    try
+      CheckForAutoDCDietOrders(AnEvent.EventIFN, DisplayGroup, '', CxMsg, AButton);
+      if CxMsg <> '' then
+      begin
+        if InfoBox(CxMsg + CRLF + CRLF + TX_EVTDEL_DIET_CONFLICT,
+           TC_EVTDEL_DIET_CONFLICT,
+           MB_ICONWARNING or MB_YESNO) = ID_NO
+           then QuickLevel := QL_DIALOG;
+      end;
+    finally
+      AButton.Free;
+    end;
+  end;
   with ResolvedDialog do
   begin
 …
           else
              begin
+             if uOrderDialog.DisplayGroup = OutptDisp then
+               begin
+                 tempUnit := '';
+                 tempSupply := '';
+                 tempDrug := '';
+                 tempSch := '';
+                 tempDur := '';
+                 tmpResp := uOrderDialog.Responses.FindResponseByName('SUPPLY', 1);
+                 if tmpResp = nil then tempSupply := '0'
+                 else tempSupply := tmpResp.EValue;
+                 tmpResp := uOrderDialog.Responses.FindResponseByName('QTY', 1);
+                 if tmpResp = nil then tempQuantity := '0'
+                 else tempQuantity := tmpResp.EValue;
+                 tmpResp := uOrderDialog.Responses.FindResponseByName('REFILLS', 1);
+                 if tmpResp = nil then tempRefills := '0'
+                 else tempRefills := tmpResp.EValue;
+                 tmpResp := uOrderDialog.Responses.FindResponseByName('ORDERABLE', 1);
+                 tempOI := StrToIntDef(tmpResp.IValue,0);
+                 i := uORderDialog.Responses.NextInstance('DOSE',0);
+                 while i > 0 do
+                   begin
+                      x := Piece(uOrderDialog.Responses.IValueFor('DOSE',i), '&', 3);
+                      tempUnit := tempUnit + X + U;
+                      x := uOrderDialog.Responses.IValueFor('SCHEDULE',i);
+                      tempSch := tempSch + x + U;
+                      x := uOrderDialog.Responses.IValueFor('DRUG', i);
+                      tempDrug := Piece(x, U, 1);
+                      i := Responses.NextInstance('DOSE', i);
+                      x := UORderDialog.Responses.IValueFor('DAYS', i);
+                      tempDur := tempDur + x + '~';
+                      x := uOrderDialog.Responses.IValueFor('CONJ', i);
+                      tempDur := tempDur + x + U;
+                   end;
+                 if ValidateDrugAutoAccept(tempDrug, tempUnit, tempSch, tempDur, tempOI, StrtoInt(tempSupply), StrtoInt(tempQuantity), StrtoInt(tempRefills)) = false then Exit;
+               end;
              cmdAcceptClick(Application);  // auto-accept order
              Result := uOrderDialog.AcceptOK;
              //BAPHII 1.3.2
              //showmessage('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
+             //Show508Message('DEBUG: About to copy BA CI''s to copied order from Order: '+AnID+'#13'+' in uOrders.ActivateOrderDialog()');
              //End BAPHII 1.3.2
 …
   if (ResolvedDialog.DialogType = 'X') and not Changes.ExistForOrder(EditedOrder)
     then UnlockOrder(EditedOrder);
+  //QOAltOI.OI := 0;
 end;
 …
   uOrderHTML.ShowModal;
   ASetList := TStringList.Create;
   ASetList.Assign(uOrderHTML.SetList);
+  FastAssign(uOrderHTML.SetList, ASetList);
   uOrderHTML.Release;
   if ASetList.Count = 0 then Exit;
 …
 end;
+procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0);
+procedure PrintOrdersOnSignReleaseMult(OrderList, ClinicLst, WardLst: TStringList; Nature: Char; EncLoc, WardLoc: integer;
+EncLocName, WardLocName: string);
+var
+i,j: integer;
+tempOrder: string;
+tempOrderList: TStringList;
+begin
+  tempOrderList := TStringList.Create;
+  if (ClinicLst <> nil) and (ClinicLst.Count > 0) then
+    begin
+      for i := 0 to ClinicLst.Count - 1 do
+        begin
+          tempOrder := ClinicLst.Strings[i];
+          for j := 0 to OrderList.Count - 1 do
+            if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
+        end;
+      if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, EncLoc, EncLocName);
+    end;
+  if (WardLst <> nil) and (WardLst.Count > 0) then
+    begin
+      if tempOrderList.Count > 0 then
+        begin
+          tempOrderList.Free;
+          tempOrderList := TStringList.Create;
+        end;
+      for i := 0 to WardLst.Count - 1 do
+        begin
+          tempOrder := WardLst.Strings[i];
+          for j := 0 to OrderList.Count - 1 do
+            if Piece(OrderList.Strings[j], U,1) = tempOrder then tempOrderList.Add(OrderList.Strings[j]);
+        end;
+      if tempOrderList.Count > 0 then PrintOrdersOnSignRelease(tempOrderList, Nature, WardLoc, WardLocName);
+    end;
+    tempOrderList.Free;
+end;
+procedure PrintOrdersOnSignRelease(OrderList: TStringList; Nature: Char; PrintLoc : Integer =0; PrintName: string = '');
 const
   TX_NEW_LOC1   = 'The patient''s location has changed to ';
 …
           then Encounter.Location := ALocation;
         end;
+    end
+  else
+    Encounter.Location := PrintLoc;
+    end;
+  //else
+  //Encounter.Location := PrintLoc;
+  if PrintLoc = 0
+    then PrintLoc := CommonLocationForOrders(OrderList);
+  if (PrintLoc = 0) and (Encounter.Location > 0) then PrintLoc := Encounter.Location;
+  if PrintLoc = 0 then                      // location required for DEVINFO
+  begin
+    LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
+    if ALocation > 0 then
+      begin
+        PrintLoc := ALocation;
+        Encounter.Location := ALocation;
+      end;
+  end;
+  if printLoc = 0 then frmFrame.DisplayEncounterText;
+  if PrintLoc <> 0 then
+  begin
+    SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName, PrintLoc);
+    if PrintIt then
+      PrintOrdersOnReview(OrderList, DeviceInfo, PrintLoc)
+    else
+      PrintServiceCopies(OrderList, PrintLoc);
+  end
+  else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
+ (*   Encounter.Location := PrintLoc;
   if Encounter.Location = 0
     then Encounter.Location := CommonLocationForOrders(OrderList);
 …
     if ALocation > 0 then Encounter.Location := ALocation;
   end;
   frmFrame.DisplayEncounterText;
+  if printLoc = 0 then frmFrame.DisplayEncounterText;
   if Encounter.Location <> 0 then
   begin
     SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt);
+    SetupOrdersPrint(OrderList, DeviceInfo, Nature, False, PrintIt, PrintName);
     if PrintIt then
       PrintOrdersOnReview(OrderList, DeviceInfo)
 …
       PrintServiceCopies(OrderList);
   end
   else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
+  else InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);  *)
 end;
 …
    NMRec.LastIndex := NewIndex;
 end;
+(*function GetQOAltOI: integer;
+begin
+  Result := QOAltOI.OI;
+end; *)
 function IsIMODialog(DlgID: integer): boolean; //IMO

cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.dfm

-              r456
+              r829
 object frmTemplateAutoGen: TfrmTemplateAutoGen
+inherited frmTemplateAutoGen: TfrmTemplateAutoGen
   Left = 361
   Top = 230
 …
   ClientHeight = 213
   ClientWidth = 415
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
-  OldCreateOrder = False
   Position = poScreenCenter
   OnShow = FormShow
   PixelsPerInch = 96
   TextHeight = 13
   object lblTop: TMemo
+  object lblTop: TMemo [0]
     Left = 256
     Top = 8
 …
     TabOrder = 5
   end
   object lblSelect: TStaticText
+  object lblSelect: TStaticText [1]
     Left = 0
     Top = 0
 …
     TabOrder = 6
   end
   object rgSource: TKeyClickRadioGroup
+  object rgSource: TKeyClickRadioGroup [2]
     Left = 256
     Top = 88
 …
     OnClick = rgSourceClick
   end
   object cbxObjects: TORComboBox
+  object cbxObjects: TORComboBox [3]
     Left = 0
     Top = 0
 …
     ListItemsOnly = False
     LongList = False
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '1'
 …
     Visible = False
     OnDblClick = cbxObjectsDblClick
+    CharsNeedMatch = 1
   end
   object btnOK: TButton
+  object btnOK: TButton [4]
     Left = 257
     Top = 190
 …
     TabOrder = 3
   end
   object btnCancel: TButton
+  object btnCancel: TButton [5]
     Left = 337
     Top = 190
 …
     TabOrder = 4
   end
   object cbxTitles: TORComboBox
+  object cbxTitles: TORComboBox [6]
     Left = 0
     Top = 0
 …
     ListItemsOnly = True
     LongList = True
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2'
 …
     OnDblClick = cbxTitlesDblClick
     OnNeedData = cbxTitlesNeedData
+    CharsNeedMatch = 1
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblTop'
+        'Status = stsDefault')
+      (
+        'Component = lblSelect'
+        'Status = stsDefault')
+      (
+        'Component = rgSource'
+        'Status = stsDefault')
+      (
+        'Component = cbxObjects'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = cbxTitles'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateAutoGen'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORCtrls, ExtCtrls, ORFn;
+  StdCtrls, ORCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
 type
   TfrmTemplateAutoGen = class(TForm)
+  TfrmTemplateAutoGen = class(TfrmBase508Form)
     rgSource: TKeyClickRadioGroup;
     cbxObjects: TORComboBox;
 …
           end;
       if DoIt then
         cbxObjects.Items.Assign(dmodShared.TIUObjects);
+        FastAssign(dmodShared.TIUObjects, cbxObjects.Items);
       FObjectsDone := TRUE;
     end;

cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm

-              r456
+              r829
 object frmTemplateDialog: TfrmTemplateDialog
+inherited frmTemplateDialog: TfrmTemplateDialog
   Left = 268
   Top = 155
-  Width = 640
-  Height = 440
   BorderIcons = [biSystemMenu, biMaximize]
   Caption = 'Text Dialog'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 413
+  ClientWidth = 632
   Position = poScreenCenter
   OnClose = FormClose
 …
   OnDestroy = FormDestroy
   OnPaint = FormPaint
+  OnShow = FormShow
+  ExplicitWidth = 640
+  ExplicitHeight = 440
   PixelsPerInch = 96
   TextHeight = 13
   object sbMain: TScrollBox
+  object sbMain: TScrollBox [0]
     Left = 0
     Top = 0
 …
     TabOrder = 0
   end
   object pnlBottom: TScrollBox
+  object pnlBottom: TScrollBox [1]
     Left = 0
     Top = 375
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = sbMain'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = lblFootnote'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnAll'
+        'Status = stsDefault')
+      (
+        'Component = btnNone'
+        'Status = stsDefault')
+      (
+        'Component = btnPreview'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateDialog'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates;
+  StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst,
+  VA508AccessibilityManager;
 type
   TfrmTemplateDialog = class(TForm)
+  TfrmTemplateDialog = class(TfrmBase508Form)
     sbMain: TScrollBox;
     pnlBottom: TScrollBox;
 …
     procedure btnPreviewClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
+    procedure FormShow(Sender: TObject);
   private
+    FFirstBuild: boolean;
     SL: TStrings;
     BuildIdx: TStringList;
 …
     procedure ParentCBEnter(Sender: TObject);
     procedure ParentCBExit(Sender: TObject);
+    procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC;
+    procedure InitScreenReaderSetup;
   public
     property Silent: boolean read FSilent write FSilent ;
 …
 implementation
+uses dShared, uConst, uTemplateFields, fRptBox, uInit, rMisc;
+uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents,
+  VA508AccessibilityRouter, VAUtils;
 {$R *.DFM}
 …
   Result := FALSE;
   CancelDlg := FALSE;
+  SetTemplateDialogCanceled(FALSE);
   frmTemplateDialog := TfrmTemplateDialog.Create(Application);
   try
 …
   end;
+  if not Result then
+  if Result then
+    SetTemplateDialogCanceled(TRUE)
+  else
+  begin
+    SetTemplateDialogCanceled(FALSE);
     CheckBoilerplate4Fields(SL, CaptionText, PreviewMode);
+  end;
 end;
 …
       SL.Clear;
   end;
+  StripScreenReaderCodes(SL);
 end;
 …
 end;
+procedure TfrmTemplateDialog.InitScreenReaderSetup;
+var
+  ctrl: TWinControl;
+  list: TList;
+begin
+  if ScreenReaderSystemActive then
+  begin
+    list := TList.Create;
+    try
+      sbMain.GetTabOrderList(list);
+      if list.Count > 0 then
+      begin
+        ctrl := TWinControl(list[0]);
+        PostMessage(Handle, UM_MISC, WParam(ctrl), 0);
+      end;
+    finally
+      list.free;
+    end;
+  end;
+end;
 function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean;
 begin
 …
   KillCtrl, doHint, dsp, noTextParent: boolean;
   Entry: TTemplateDialogEntry;
+  StringIn, StringOut: string;
+//  StringIn, StringOut: string;
+  cb: TCPRSDialogParentCheckBox;
   procedure NextTabCtrl(ACtrl: TControl);
 …
       Entry := TTemplateDialogEntry(Entries.Objects[idx]);
+    pnl := Entry.GetPanel(FMaxPnlWidth, sbMain);
+    if(dsp or OneOnly) then
+      cb := nil
+    else
+      cb := TCPRSDialogParentCheckBox.Create(Self);
+    pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb);
     pnl.Show;
     if(doHint and (not pnl.ShowHint)) then
 …
       Entry.OnChange := FieldChanged;
     end;
     if(dsp or OneOnly) then
+    if not assigned(cb) then
       ctrl := pnl
     else
     begin
       ctrl := TORCheckBox.Create(Self);
+      ctrl := cb;
       ctrl.Parent := sbMain;
 …
       TORCheckBox(ctrl).AutoSize := false;
       TORCheckBox(ctrl).Associate := pnl;
+      pnl.Tag := Integer(ctrl);
       tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place}
+      if Templates.IndexOf(tmpID) > -1 then
+        StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
+      else
+        StringIn := 'Sub-Template:';
+      StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
+      TORCheckBox(ctrl).Caption := StringOut;
+//      if Templates.IndexOf(tmpID) > -1 then
+//        StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
+//      else
+//        StringIn := 'Sub-Template:';
+//      StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
+//      TORCheckBox(ctrl).Caption := StringOut;
+      UpdateColorsFor508Compliance(ctrl);
     end;
 …
     for i := 1 to Count do
       BuildCB(i, Y, FirstTime);
+    if ScreenReaderSystemActive then
+    begin
+      amgrMain.RefreshComponents;
+      Application.ProcessMessages;
+    end;
   finally
     FBuilding := FALSE;
 …
     RepaintBuild := FALSE;
     BuildAllControls;
+    InitScreenReaderSetup;
+  end;
+end;
+procedure TfrmTemplateDialog.FormShow(Sender: TObject);
+begin
+  inherited;
+  if FFirstBuild then
+  begin
+    FFirstBuild := FALSE;
+    InitScreenReaderSetup;
   end;
 end;
 …
 procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
 begin
+  FFirstBuild := TRUE;
   BuildIdx := TStringList.Create;
   Entries := TStringList.Create;
 …
       if not CanClose then
       begin
         ShowMessage(MissingFieldsTxt);
+        ShowMsg(MissingFieldsTxt);
         break;
       end;
 …
   TmpSL := TStringList.Create;
   try
     TmpSL.Assign(SL);
+    FastAssign(SL, TmpSL);
     GetText(TmpSL, FALSE);  {FALSE = Do not include embedded fields}
+    StripScreenReaderCodes(TmpSL);
     ReportBox(TmpSL, 'Dialog Preview', FALSE);
   finally
 …
 end;
+procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage);
+var
+  ctrl: TWinControl;
+  item: TVA508AccessibilityItem;
+begin
+  ctrl := TWinControl(Message.WParam);
+  // Refresh the accessibility manager entry -
+  // fixes bug where first focusable check boxes weren't working correctly
+  if ctrl is TCPRSDialogParentCheckBox then
+  begin
+    item := amgrMain.AccessData.FindItem(ctrl, FALSE);
+    if assigned(item) then
+      item.free;
+    amgrMain.AccessData.EnsureItemExists(ctrl);
+  end;
+end;
 end.

cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm

-              r456
+              r829
+object frmTemplateEditor: TfrmTemplateEditor
+  Left = 135
+  Top = 239
+  Width = 748
+  Height = 470
+inherited frmTemplateEditor: TfrmTemplateEditor
+  Left = 321
+  Top = 119
   HelpContext = 10000
   ActiveControl = tvPersonal
   BorderIcons = [biSystemMenu, biMaximize]
   Caption = 'Template Editor'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 450
+  ClientWidth = 740
   Position = poScreenCenter
   Scaled = False
+  OnClose = FormClose
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnShow = FormShow
+  ExplicitWidth = 748
+  ExplicitHeight = 477
   PixelsPerInch = 96
   TextHeight = 13
   object splMain: TSplitter
+  object splMain: TSplitter [0]
     Left = 0
     Top = 239
 …
     OnMoved = splMainMoved
   end
   object splNotes: TSplitter
+  object splNotes: TSplitter [1]
     Left = 0
     Top = 371
+    Top = 377
     Width = 740
     Height = 3
 …
     Visible = False
     OnMoved = splBoilMoved
+    ExplicitTop = 371
   end
   object pnlBottom: TORAutoPanel
+  object pnlBottom: TPanel [2]
     Left = 0
     Top = 416
+    Top = 423
     Width = 740
     Height = 27
 …
     BevelOuter = bvNone
     TabOrder = 4
+    ExplicitTop = 416
     DesignSize = (
 …
     end
   end
   object pnlBoilerplate: TPanel
+  object pnlBoilerplate: TPanel [3]
     Left = 0
     Top = 284
     Width = 740
     Height = 87
+    Height = 93
     Align = alClient
     BevelOuter = bvNone
 …
     object splBoil: TSplitter
       Left = 0
       Top = 43
+      Top = 14
       Width = 740
       Height = 3
       Cursor = crVSplit
       Align = alBottom
+      Align = alTop
       AutoSnap = False
       Beveled = True
       Visible = False
       OnMoved = splBoilMoved
+      ExplicitTop = 43
     end
     object reBoil: TRichEdit
       Left = 0
       Top = 14
+      Top = 17
       Width = 740
       Height = 29
+      Height = 30
       Align = alClient
       Font.Charset = ANSI_CHARSET
 …
       Font.Name = 'Courier New'
       Font.Style = []
+      Constraints.MinHeight = 30
       ParentFont = False
       PlainText = True
 …
       OnResizeRequest = reResizeRequest
       OnSelectionChange = reBoilSelectionChange
+      ExplicitTop = 14
     end
     object pnlGroupBP: TPanel
       Left = 0
       Top = 46
+      Top = 47
       Width = 740
       Height = 41
+      Height = 46
       Align = alBottom
       BevelOuter = bvNone
 …
         Align = alTop
         Caption = 'Group Boilerplate'
+        ExplicitWidth = 81
       end
       object lblGroupRow: TLabel
 …
         Top = 16
         Width = 740
         Height = 25
+        Height = 30
         Align = alClient
         Color = clCream
 …
         Font.Name = 'Courier New'
         Font.Style = []
+        Constraints.MinHeight = 30
         ParentFont = False
         PlainText = True
 …
     end
   end
   object pnlTop: TPanel
+  object pnlTop: TPanel [4]
     Left = 0
     Top = 0
 …
       Left = 297
       Top = 24
-      Width = 3
       Height = 215
-      Cursor = crHSplit
       Align = alRight
       AutoSnap = False
 …
         Left = 216
         Top = 0
-        Width = 3
         Height = 215
-        Cursor = crHSplit
         Align = alRight
         AutoSnap = False
 …
           FocusControl = tvPersonal
           PopupMenu = popTemplates
+          ExplicitWidth = 93
         end
         object tvPersonal: TORTreeView
 …
             ShowHint = True
             TabOrder = 5
+            WordWrap = True
             OnClick = cbExcludeClick
-            WordWrap = True
             AutoSize = True
           end
 …
               'erplate, between each item'#39's boilerplate.'
             Associate = edtGap
-            Min = 0
             Max = 3
             ParentShowHint = False
-            Position = 0
             ShowHint = True
             TabOrder = 8
-            Wrap = False
           end
           object edtName: TCaptionEdit
 …
             ShowHint = True
             TabOrder = 4
+            WordWrap = True
             OnClick = cbHideItemsClick
-            WordWrap = True
             AutoSize = True
           end
 …
             TabOrder = 2
             OnChange = cbxRemDlgsChange
+            CharsNeedMatch = 1
           end
           object cbLock: TORCheckBox
 …
         FocusControl = tvShared
         PopupMenu = popTemplates
+        ExplicitWidth = 86
       end
       object tvShared: TORTreeView
 …
         OnChange = cboOwnerChange
         OnNeedData = cboOwnerNeedData
+        CharsNeedMatch = 1
       end
       object btnNew: TORAlignButton
 …
         Width = 182
         Height = 22
+        Align = alRight
         Caption = '&New Template'
         TabOrder = 2
         OnClick = btnNewClick
-        Align = alRight
       end
       object pnlMenu: TPanel
 …
           Left = 1
           Top = 1
           Width = 69
+          Width = 107
           Height = 20
           Align = alLeft
 …
           ButtonWidth = 43
           Caption = 'mbMain'
-          Flat = True
           Menu = mnuMain
           ShowCaptions = True
 …
     end
   end
   object pnlNotes: TPanel
+  object pnlNotes: TPanel [5]
     Left = 0
     Top = 374
+    Top = 380
     Width = 740
     Height = 42
+    Height = 43
     Align = alBottom
     BevelOuter = bvNone
 …
       Align = alTop
       Caption = 'Template Notes:'
+      ExplicitWidth = 78
     end
     object reNotes: TRichEdit
 …
       Top = 13
       Width = 740
       Height = 29
+      Height = 30
       Align = alClient
       Font.Charset = ANSI_CHARSET
 …
       Font.Name = 'Courier New'
       Font.Style = []
+      Constraints.MinHeight = 30
       ParentFont = False
       PlainText = True
 …
     end
   end
   object pnlCOM: TPanel
+  object pnlCOM: TPanel [6]
     Left = 0
     Top = 263
 …
       Caption = '  Passed Value: '
       Layout = tlCenter
+      ExplicitHeight = 13
     end
     object lblCOMObj: TLabel
 …
       Caption = ' COM Object: '
       Layout = tlCenter
+      ExplicitHeight = 13
     end
     object edtCOMParam: TCaptionEdit
 …
       Width = 380
       Height = 21
+      Align = alClient
       TabOrder = 0
       OnChange = edtCOMParamChange
-      Align = alClient
       Caption = 'Passed Value'
     end
 …
       TabOrder = 1
       OnChange = cbxCOMObjChange
+      CharsNeedMatch = 1
     end
   end
   object pnlLink: TPanel
+  object pnlLink: TPanel [7]
     Left = 0
     Top = 242
 …
       Caption = ' Associated Consult Service: '
       Layout = tlCenter
+      ExplicitHeight = 13
     end
     object cbxLink: TORComboBox
 …
       LookupPiece = 0
       MaxLength = 0
       Pieces = '2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,1'
+      Pieces = '2'
       HideSynonyms = True
       Sorted = False
 …
       OnChange = cbxLinkChange
       OnNeedData = cbxLinkNeedData
+      OnSynonymCheck = cbxLinkSynonymCheck
+    end
+      CharsNeedMatch = 1
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnApply'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = cbEditShared'
+        'Status = stsDefault')
+      (
+        'Component = cbNotes'
+        'Status = stsDefault')
+      (
+        'Component = cbEditUser'
+        'Status = stsDefault')
+      (
+        'Component = pnlBoilerplate'
+        'Status = stsDefault')
+      (
+        'Component = reBoil'
+        'Label = lblBoilerplate'
+        'Status = stsOK')
+      (
+        'Component = pnlGroupBP'
+        'Status = stsDefault')
+      (
+        'Component = reGroupBP'
+        'Label = lblGroupBP'
+        'Status = stsOK')
+      (
+        'Component = pnlGroupBPGap'
+        'Status = stsDefault')
+      (
+        'Component = pnlBP'
+        'Status = stsDefault')
+      (
+        'Component = cbLongLines'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = pnlRightTop'
+        'Status = stsDefault')
+      (
+        'Component = pnlCopyBtns'
+        'Status = stsDefault')
+      (
+        'Component = sbCopyRight'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = sbCopyLeft'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = pnlPersonal'
+        'Status = stsDefault')
+      (
+        'Component = tvPersonal'
+        'Status = stsDefault')
+      (
+        'Component = pnlPersonalBottom'
+        'Status = stsDefault')
+      (
+        'Component = sbPerUp'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = sbPerDown'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = sbPerDelete'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = cbPerHide'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = pnlPersonalGap'
+        'Status = stsDefault')
+      (
+        'Component = pnlPerSearch'
+        'Status = stsDefault')
+      (
+        'Component = btnPerFind'
+        'Text = Find Personal Template'
+        'Status = stsOK')
+      (
+        'Component = edtPerSearch'
+        'Status = stsDefault')
+      (
+        'Component = cbPerMatchCase'
+        'Status = stsDefault')
+      (
+        'Component = cbPerWholeWords'
+        'Status = stsDefault')
+      (
+        'Component = pnlProperties'
+        'Status = stsDefault')
+      (
+        'Component = gbProperties'
+        'Status = stsDefault')
+      (
+        'Component = cbExclude'
+        'Status = stsDefault')
+      (
+        'Component = cbActive'
+        'Status = stsDefault')
+      (
+        'Component = edtGap'
+        'Status = stsDefault')
+      (
+        'Component = udGap'
+        'Status = stsDefault')
+      (
+        'Component = edtName'
+        'Status = stsDefault')
+      (
+        'Component = gbDialogProps'
+        'Status = stsDefault')
+      (
+        'Component = cbDisplayOnly'
+        'Status = stsDefault')
+      (
+        'Component = cbOneItemOnly'
+        'Status = stsDefault')
+      (
+        'Component = cbFirstLine'
+        'Status = stsDefault')
+      (
+        'Component = cbHideDlgItems'
+        'Status = stsDefault')
+      (
+        'Component = cbIndent'
+        'Status = stsDefault')
+      (
+        'Component = cbHideItems'
+        'Status = stsDefault')
+      (
+        'Component = cbxType'
+        'Status = stsDefault')
+      (
+        'Component = cbxRemDlgs'
+        'Status = stsDefault')
+      (
+        'Component = cbLock'
+        'Status = stsDefault')
+      (
+        'Component = pnlShared'
+        'Status = stsDefault')
+      (
+        'Component = tvShared'
+        'Status = stsDefault')
+      (
+        'Component = pnlSharedBottom'
+        'Status = stsDefault')
+      (
+        'Component = sbShUp'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = sbShDown'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = sbShDelete'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = cbShHide'
+        'Property = Hint'
+        'Status = stsOK')
+      (
+        'Component = pnlSharedGap'
+        'Status = stsDefault')
+      (
+        'Component = pnlShSearch'
+        'Status = stsDefault')
+      (
+        'Component = btnShFind'
+        'Text = Find Shared Template'
+        'Status = stsOK')
+      (
+        'Component = edtShSearch'
+        'Status = stsDefault')
+      (
+        'Component = cbShMatchCase'
+        'Status = stsDefault')
+      (
+        'Component = cbShWholeWords'
+        'Status = stsDefault')
+      (
+        'Component = pnlMenuBar'
+        'Status = stsDefault')
+      (
+        'Component = cboOwner'
+        'Status = stsDefault')
+      (
+        'Component = btnNew'
+        'Status = stsDefault')
+      (
+        'Component = pnlMenu'
+        'Status = stsDefault')
+      (
+        'Component = mbMain'
+        'Status = stsDefault')
+      (
+        'Component = pnlNotes'
+        'Status = stsDefault')
+      (
+        'Component = reNotes'
+        'Label = lblNotes'
+        'Status = stsOK')
+      (
+        'Component = pnlCOM'
+        'Status = stsDefault')
+      (
+        'Component = edtCOMParam'
+        'Label = lblCOMParam'
+        'Status = stsOK')
+      (
+        'Component = cbxCOMObj'
+        'Property = Caption'
+        'Status = stsOK')
+      (
+        'Component = pnlLink'
+        'Status = stsDefault')
+      (
+        'Component = cbxLink'
+        'Label = lblLink'
+        'Status = stsOK')
+      (
+        'Component = frmTemplateEditor'
+        'Status = stsDefault'))
   end
   object popTemplates: TPopupMenu
 …
     Top = 136
   end
+  object imgLblTemplates: TVA508ImageListLabeler
+    Components = <
+      item
+        Component = tvPersonal
+      end
+      item
+        Component = tvShared
+      end>
+    Labels = <>
+    RemoteLabeler = dmodShared.imgLblHealthFactorLabels
+    Left = 104
+    Top = 144
+  end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet,
+  uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB;
+  uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form,
+  VA508AccessibilityManager, VA508ImageListLabeler;
 type
 …
   TTemplateTreeType = (ttShared, ttPersonal);
   TfrmTemplateEditor = class(TForm)
+  TfrmTemplateEditor = class(TfrmBase508Form)
     splMain: TSplitter;
     pnlBottom: TORAutoPanel;
+    pnlBottom: TPanel;
     btnApply: TButton;
     btnCancel: TButton;
 …
     cbxLink: TORComboBox;
     lblLink: TLabel;
+    imgLblTemplates: TVA508ImageListLabeler;
     procedure btnNewClick(Sender: TObject);
     procedure btnApplyClick(Sender: TObject);
 …
       Direction, InsertAt: Integer);
     procedure cbxLinkChange(Sender: TObject);
-    procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String;
-      var IsSynonym: Boolean);
     procedure reBoilKeyUp(Sender: TObject; var Key: Word;
       Shift: TShiftState);
 …
     procedure reBoilKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
     FLastRect: TRect;
 …
     FCanDoReminders: boolean;
     FCanDoCOMObjects: boolean;
     FPersonalObjects: TStringList;
+    //FPersonalObjects: TStringList;
     FShowingTemplate: TTemplate;
     FConsultServices: TStringList;
 …
     procedure UpdateInsertsDialogs;
     procedure AutoLongLines(Sender: TObject);
     procedure UpdatePersonalObjects;
+    //procedure UpdatePersonalObjects;
     procedure UpdateApply(Template: TTemplate);
     procedure TemplateLocked(Sender: TObject);
     procedure InitTrees;
+    procedure AdjustControls4FontChange;
+    procedure ShowGroupBoilerplate(Visible: boolean);
     function GetLinkType(const ANode: TTreeNode): TTemplateLinkType;
   end;
 procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE);
+const
+  TemplateEditorSplitters = 'frmTempEditSplitters';
+  TemplateEditorSplitters2 = 'frmTempEditSplitters2';
+var
+  tmplEditorSplitterMiddle: integer = 0;
+  tmplEditorSplitterProperties: integer = 0;
+  tmplEditorSplitterMain: integer = 0;
+  tmplEditorSplitterBoil: integer = 0;
+  tmplEditorSplitterNotes: integer = 0;
 implementation
 …
 uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView,
   fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils,
+  fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults;
+  fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils,
+  rMisc, fFindingTemplates;
 const
 …
       Drawers := TFrmDrawers(Form)
     else
     if IsPublishedProp(Form, 'Drawers') then
       Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers'));
+    if IsPublishedProp(Form, DrawersProperty) then
+      Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty));
   end;
 …
   BtnApply.Enabled := BackupDiffers;
+  SetFormPosition(Self);
 end;
 …
   end;
   lblNotes.Enabled := (not reNotes.ReadOnly);
+  if(reNotes.ReadOnly) then
+    reNotes.Color := ReadOnlyColor
+  else
+    reNotes.Color := clWindow;
+  UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly);
   cbxType.Enabled := ok;
   lblType.Enabled := ok;
 …
   lblLines.Enabled := ok;
   reBoil.ReadOnly := not ok;
+  if(ok) then
+    reBoil.Color := clWindow
+  else
+    reBoil.Color := ReadOnlyColor;
+  UpdateReadOnlyColorScheme(reBoil, not ok);
   lblLink.Enabled := ok;
   cbxLink.Enabled := ok;
 …
 end;
+procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean);
+begin
+  pnlGroupBP.Visible := Visible;
+  splBoil.Visible := Visible;
+  if Visible then
+  begin
+    reBoil.Align := alTop;
+    pnlGroupBP.Align := alClient;
+    reBoil.Height := tmplEditorSplitterBoil;
+    splBoil.Top := pnlGroupBP.Top - splBoil.Height;
+  end
+  else
+  begin
+    pnlGroupBP.Align := alBottom;
+    reBoil.Align := alClient;
+  end;
+end;
 procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode);
 var
 …
   Idx: TTypeIndex;
   CanDoCOM: boolean;
-  LinkTemplate: TTemplate;
   lt: TTemplateLinkType;
   lts: string;
-  i: integer;
 begin
 …
             begin
               FConsultServices := TStringList.Create;
               FConsultServices.Assign(LoadServiceListWithSynonyms(1));
+              FastAssign(LoadServiceListWithSynonyms(1), FConsultServices);
               SortByPiece(FConsultServices, U, 2);
             end;
+            for i := 0 to FConsultServices.Count-1 do
+            begin
+              LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult);
+              if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then
+                cbxLink.Items.Add(FConsultServices[i]);
+            end;
+            FastAssign(FConsultServices, cbxLink.Items);
           end
           else
 …
       edtGap.Text := '0';
       reBoil.Clear;
+      pnlGroupBP.Visible := FALSE;
+      splBoil.Visible := FALSE;
+      ShowGroupBoilerplate(False);
       pnlBoilerplateResize(Self);
       pnlCOM.Visible := FALSE;
 …
 begin
   if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then
+  begin
     pnlGroupBP.Height := pnlBoilerplate.Height-29;
+  end;
   if cbLongLines.checked then
     Max := 240
 …
       begin
         reBoil.ReadOnly := TRUE;
         reBoil.Color := ReadOnlyColor;
+        UpdateReadOnlyColorScheme(reBoil, TRUE);
         UpdateInsertsDialogs;
       end;
+      pnlGroupBP.Visible := ItemOK;
+      splBoil.Visible := ItemOK;
+      ShowGroupBoilerplate(ItemOK);
       if(not ItemOK) and (IsReminderDialog or IsCOMObject) then
         BPOK := FALSE;
-      if(ItemOK) then
-        splBoil.Top := pnlGroupBP.Top - splBoil.Height;
       pnlBoilerplateResize(Self);
       pnlBoilerplate.Visible := BPOK;
 …
     frmTemplateFields := nil;
   end;
+  KillObj(@FPersonalObjects);
+  //---------- CQ #8665 - RV --------
+  //KillObj(@FPersonalObjects);
+  if (assigned(uPersonalObjects)) then
+  begin
+    KillObj(@uPersonalObjects);
+    uPersonalObjects.Free;
+    uPersonalObjects := nil;
+  end;
+  // ----  end CQ #8665 -------------
   dmodShared.OnTemplateLock := nil;
   dmodShared.InEditor := FALSE;
 …
 end;
+procedure TfrmTemplateEditor.AdjustControls4FontChange;
+var
+  x: integer;
+  procedure Adjust(Control: TWinControl);
+  begin
+    x := x - Control.Width - 2;
+    Control.Left := x;
+  end;
+begin
+  if FCanEditShared then
+  begin
+    x := pnlSharedBottom.Width;
+    Adjust(sbSHDelete);
+    Adjust(sbSHDown);
+    Adjust(sbSHUp);
+    cbSHHide.Width := x;
+  end;
+  x := pnlBottom.Width;
+  Adjust(btnApply);
+  Adjust(btnCancel);
+  Adjust(btnOK);
+  cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25;
+  cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60;
+  cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25;
+end;
 function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean;
 var
 …
   MoveCopyButtons;
   tvTreeChange(FCurTree, FCurTree.Selected);
+  if FCanEditShared then
+    AdjustControls4FontChange;
 end;
 …
 procedure TfrmTemplateEditor.btnFindClick(Sender: TObject);
 var
   Found: boolean;
+  Found: TTreeNode;
   edtSearch: TEdit;
+  IsNext: boolean;
   FindNext: boolean;
   FindWholeWords: boolean;
 …
   Tree: TTreeView;
   LastFoundNode, TmpNode: TTreeNode;
   S1,S2: string;
+//  S1,S2: string;
 begin
 …
     FindCase := cbShMatchCase.Checked;
     LastFoundNode := FLastFoundShNode;
-    if(FSharedEmptyNodeCount > 0) then
-    begin
-      FInternalHiddenExpand := TRUE;
-      try
-        tvShared.Items.GetFirstNode.Expand(TRUE);
-      finally
-        FInternalHiddenExpand := FALSE;
-      end;
-    end;
   end
   else
 …
     FindCase := cbPerMatchCase.Checked;
     LastFoundNode := FLastFoundPerNode;
-    if(FPersonalEmptyNodeCount > 0) then
-    begin
-      FInternalHiddenExpand := TRUE;
-      try
-        tvPersonal.Items.GetFirstNode.Expand(TRUE);
-      finally
-        FInternalHiddenExpand := FALSE;
-      end;
-    end;
   end;
   if(edtSearch.text <> '') then
   begin
+    if((FindNext) and assigned (LastFoundNode)) then
+      TmpNode := LastFoundNode.GetNext
+    IsNext := ((FindNext) and assigned (LastFoundNode));
+    if IsNext then
+      TmpNode := LastFoundNode
     else
       TmpNode := Tree.Items.GetFirstNode;
+    Found := FALSE;
+    if(assigned(TmpNode)) then
+    begin
+      S1 := edtSearch.Text;
+      if(not FindCase) then
+        S1 := UpperCase(S1);
+      while (assigned(TmpNode) and (not Found)) do
+      begin
+        S2 := TmpNode.Text;
+        if(not FindCase) then
+          S2 := UpperCase(S2);
+        Found := SearchMatch(S1, S2, FindWholeWords);
+        if(not Found) then
+          TmpNode := TmpNode.GetNext;
+      end;
+    end;
+    if(Found) then
+    begin
+    FInternalHiddenExpand := TRUE;
+    try
+      Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode,
+                            IsNext, not FindCase, FindWholeWords);
+    finally
+      FInternalHiddenExpand := FALSE;
+    end;
+    if Assigned(Found) then
+    begin
+      Tree.Selected := Found;
       if(Tree = tvShared) then
         FLastFoundShNode := TmpNode
+        FLastFoundShNode := Found
       else
         FLastFoundPerNode := TmpNode;
+        FLastFoundPerNode := Found;
       SetFindNext(Tree, TRUE);
-      Tree.Selected := TmpNode;
-    end
-    else
-    begin
-      if(FindNext) then
-        S1 := ''
-      else
-        S1 := '  "' + edtSearch.Text + '" was not Found.';
-      SetFindNext(Tree, FALSE);
-      InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION);
     end;
   end;
 …
     end;
     pnlBoilerplateResize(Self);
+    AdjustControls4FontChange;
+    MoveCopyButtons;
   end;
 end;
 …
     begin
       UpdatePersonalObjects;
       if FPersonalObjects.Count > 0 then
+      if uPersonalObjects.Count > 0 then                                                  // -------- CQ #8665 - RV ------------
       begin
         DoIt := FALSE;
         for i := 0 to dmodShared.TIUObjects.Count-1 do
           if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
+          if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then      // -------- CQ #8665 - RV ------------
             frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]);
       end;
     end;
     if DoIt then
       frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects);
+      FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items);
     frmTemplateObjects.Font := Font;
     frmTemplateObjects.re := reBoil;
 …
 end;
+procedure TfrmTemplateEditor.FormClose(Sender: TObject;
+  var Action: TCloseAction);
+begin
+  SaveUserBounds(Self);
+end;
 procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject;
   var CanClose: Boolean);
 …
 procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject);
 begin
+  if pnlBoilerplate.Visible and pnlGroupBP.Visible then
+    tmplEditorSplitterBoil := reBoil.Height;
+  if pnlNotes.Visible then
+    tmplEditorSplitterNotes := pnlNotes.Height;
   pnlBoilerplateResize(Self);
 end;
 …
 procedure TfrmTemplateEditor.mbMainResize(Sender: TObject);
 begin
+  pnlMenu.Width := mbMain.Width + 3;
+  pnlMenu.Width := mbMain.Width + 4;
+  mbMain.Width := pnlMenu.Width - 3;
 end;
 …
   dmodShared.LoadTIUObjects;
   UpdatePersonalObjects;
   GetAutoGenText(AName, AText, FPersonalObjects);
+  GetAutoGenText(AName, AText, uPersonalObjects);   // -------- CQ #8665 - RV ------------
   if(AName <> '') and (AText <> '') then
   begin
 …
   pnlNotes.Visible := cbNotes.Checked;
   splNotes.Visible := cbNotes.Checked;
+  splNotes.Top := pnlNotes.Top-3;
+  if cbNotes.Checked then
+  begin
+    pnlNotes.Height := tmplEditorSplitterNotes;
+    pnlNotes.Top := pnlBottom.Top - pnlNotes.Height;
+    splNotes.Top := pnlNotes.Top-3;
+  end;
   pnlBoilerplateResize(Self);
 end;
 …
             if (Flds.Count > 0) then begin
               ExpandEmbeddedFields(Flds);
               Flds.Assign(ExportTemplateFields(Flds));
+              FastAssign(ExportTemplateFields(Flds), Flds);
               for i := 0 to Flds.Count-1 do
                 Flds[i] := '  ' + Flds[i];
               Tmpl.AddStrings(Flds);
+              FastAddStrings(Flds, Tmpl);
             end; {if}
             Tmpl.Add('</'+XMLHeader+'>');
 …
             FUpdating := FALSE;
           end;
           ShowMessage('Can not assign a Reminder Dialog to a Reason for Request');
+          ShowMsg('Can not assign a Reminder Dialog to a Reason for Request');
         end
         else
 …
 end;
 procedure TfrmTemplateEditor.UpdatePersonalObjects;
+(*procedure TfrmTemplateEditor.UpdatePersonalObjects;
 var
   i: integer;
 …
     FPersonalObjects.Sorted := TRUE;
   end;
 end;
+end;*)
 (*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean;
 …
 begin
   Resync([TTemplate(Sender)]);
   ShowMessage(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
+  ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
 end;
 …
   try
     case TTemplateLinkType(pnlLink.Tag) of
       ltTitle:     tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction));
+      ltTitle:     FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL);
 //      ltConsult:
       ltProcedure:
         begin
           tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction));
+          FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL);
           for i := 0 to tmpSL.Count-1 do
           begin
 …
 var
   Template,LinkTemplate: TTemplate;
+  update: boolean;
 begin
 …
     if assigned(Template) and Template.CanModify then
     begin
+      update := true;
       if cbxLink.ItemIEN > 0 then
       begin
 …
         if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then
         begin
           ShowMessage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
+          ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
                       ' is already assigned to another template.');
+          cbxLink.ItemIndex := -1;
+          cbxLink.SelectByID(Template.LinkIEN);
+          update := False;
+        end
+        else
+        begin
+          Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
+          if Template.LinkName <> '' then
+            edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
         end;
-        Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
-        if Template.LinkName <> '' then
-          edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
       end
       else
         Template.FileLink := '';
+      UpdateApply(Template);
+    end;
+  end;
+end;
+procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject;
+  const Text: String; var IsSynonym: Boolean);
+var
+  LinkTemplate: TTemplate;
+  var IEN: string;
+begin
+  IsSynonym := FALSE;
+  if pnlLink.Visible and assigned(FShowingTemplate) then
+  begin
+    IEN := Piece(Text,#9,30);
+    if IEN <> '' then
+    begin
+      LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag));
+      IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate));
+    end
+    else
+      IsSynonym := FALSE;
+      if update then
+        UpdateApply(Template);
+    end;
   end;
 end;

cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm

-              r456
+              r829
 object frmTemplateFieldEditor: TfrmTemplateFieldEditor
+inherited frmTemplateFieldEditor: TfrmTemplateFieldEditor
   Left = 294
   Top = 211
-  Width = 640
-  Height = 447
   BorderIcons = [biSystemMenu, biMaximize]
   Caption = 'Template Field Editor'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 420
+  ClientWidth = 788
   Position = poScreenCenter
   OnCloseQuery = FormCloseQuery
 …
   OnDestroy = FormDestroy
   OnResize = FormResize
+  ExplicitWidth = 796
+  ExplicitHeight = 454
   PixelsPerInch = 96
   TextHeight = 13
   object splLeft: TSplitter
     Left = 273
+  object splLeft: TSplitter [0]
+    Left = 429
     Top = 25
-    Width = 3
     Height = 366
-    Cursor = crHSplit
     Beveled = True
+    ExplicitLeft = 273
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 391
     Width = 632
+    Width = 788
     Height = 29
     Align = alBottom
     TabOrder = 2
     DesignSize = (
 )
     object lblReq: TStaticText
 …
     end
     object btnOK: TButton
       Left = 392
+      Left = 548
       Top = 4
       Width = 75
 …
     end
     object btnCancel: TButton
       Left = 472
+      Left = 628
       Top = 4
       Width = 75
 …
     end
     object btnApply: TButton
       Left = 552
+      Left = 708
       Top = 4
       Width = 75
 …
     end
     object btnPreview: TButton
       Left = 279
+      Left = 435
       Top = 4
       Width = 75
 …
     end
   end
   object pnlObjs: TPanel
+  object pnlObjs: TPanel [2]
     Left = 0
     Top = 25
     Width = 273
+    Width = 429
     Height = 366
     Align = alLeft
 …
       Left = 1
       Top = 1
       Width = 271
+      Width = 427
       Height = 13
       Align = alTop
       Caption = 'Template Fields'
+      ExplicitWidth = 74
     end
     object cbxObjs: TORComboBox
       Left = 1
       Top = 14
       Width = 271
+      Width = 427
       Height = 351
       Style = orcsSimple
 …
       Sorted = False
       SynonymChars = '<Inactive>'
       TabPositions = '34,45,55,65,75'
+      TabPositions = '50,60,70,80,90'
       TabOrder = 0
       OnChange = cbxObjsChange
 …
       OnNeedData = cbxObjsNeedData
       OnSynonymCheck = cbxObjsSynonymCheck
+      CharsNeedMatch = 1
     end
   end
   object pnlRight: TPanel
     Left = 276
+  object pnlRight: TPanel [3]
+    Left = 432
     Top = 25
     Width = 356
 …
         Align = alTop
         Caption = 'Notes:'
+        ExplicitWidth = 31
       end
       object reNotes: TRichEdit
 …
         TabOrder = 1
         OnChange = cbxTypeChange
+        CharsNeedMatch = 1
       end
       object edtTextLen: TCaptionEdit
 …
         Anchors = [akTop, akRight]
         Associate = edtTextLen
-        Min = 0
         Max = 240
-        Position = 0
         TabOrder = 5
-        Wrap = False
       end
       object pnlSwap: TPanel
 …
           Width = 300
           Height = 22
+          Align = alTop
           Font.Charset = ANSI_CHARSET
           Font.Color = clWindowText
 …
           OnEnter = edtpopControlEnter
           OnExit = ControlExit
-          Align = alTop
           Caption = 'Default Value'
         end
 …
             Min = -9999
             Max = 9999
-            Position = 0
             TabOrder = 1
             Thousands = False
-            Wrap = False
           end
           object edtDefNum: TCaptionEdit
 …
             Min = -9999
             Max = 9999
-            Position = 0
             TabOrder = 3
             Thousands = False
-            Wrap = False
           end
           object edtMinVal: TCaptionEdit
 …
             Position = 1
             TabOrder = 7
-            Wrap = False
           end
           object edtInc: TCaptionEdit
 …
             Min = -9999
             Max = 9999
-            Position = 0
             TabOrder = 5
             Thousands = False
-            Wrap = False
           end
         end
 …
           Width = 300
           Height = 22
+          Align = alTop
           Font.Charset = ANSI_CHARSET
           Font.Color = clWindowText
 …
           OnChange = edtURLChange
           OnEnter = edtpopControlEnter
-          Align = alTop
           Caption = 'URL'
         end
 …
           TabStop = True
           OnChange = cbxDefaultChange
+          CharsNeedMatch = 1
         end
         object pnlDate: TPanel
 …
             TabOrder = 1
             OnChange = cbxDateTypeChange
+            CharsNeedMatch = 1
           end
         end
 …
         Position = 1
         TabOrder = 3
-        Wrap = False
       end
       object gbIndent: TGroupBox
 …
           Height = 21
           Associate = edtIndent
-          Min = 0
           Max = 30
-          Position = 0
           TabOrder = 1
           Thousands = False
-          Wrap = False
         end
         object udPad: TUpDown
 …
           Height = 21
           Associate = edtPad
-          Min = 0
           Max = 30
-          Position = 0
           TabOrder = 2
           Thousands = False
-          Wrap = False
         end
         object edtPad: TCaptionEdit
 …
     end
   end
   object pnlTop: TPanel
+  object pnlTop: TPanel [4]
     Left = 0
     Top = 0
     Width = 632
+    Width = 788
     Height = 25
     Align = alTop
 …
     TabOrder = 3
     DesignSize = (
 )
     object MenuBar1: TMenuBar
       Left = 0
       Top = 0
       Width = 23
+      Width = 41
       Height = 25
       Align = alLeft
 …
       ButtonWidth = 43
       Caption = 'MenuBar1'
-      Flat = True
       Menu = mnuMain
       ShowCaptions = True
 …
     end
     object btnNew: TButton
       Left = 557
+      Left = 711
       Top = 2
       Width = 75
 …
     end
     object btnCopy: TButton
       Left = 478
+      Left = 632
       Top = 2
       Width = 75
 …
     end
     object btnDelete: TButton
       Left = 399
+      Left = 553
       Top = 2
       Width = 75
 …
       OnClick = mnuDeleteClick
     end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = lblReq'
+        'Status = stsDefault')
+      (
+        'Component = btnOK'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnApply'
+        'Status = stsDefault')
+      (
+        'Component = btnPreview'
+        'Status = stsDefault')
+      (
+        'Component = cbHide'
+        'Status = stsDefault')
+      (
+        'Component = pnlObjs'
+        'Status = stsDefault')
+      (
+        'Component = cbxObjs'
+        'Status = stsDefault')
+      (
+        'Component = pnlRight'
+        'Status = stsDefault')
+      (
+        'Component = pnlPreview'
+        'Status = stsDefault')
+      (
+        'Component = reNotes'
+        'Status = stsDefault')
+      (
+        'Component = pnlObjInfo'
+        'Status = stsDefault')
+      (
+        'Component = edtName'
+        'Status = stsDefault')
+      (
+        'Component = edtLMText'
+        'Status = stsDefault')
+      (
+        'Component = cbxType'
+        'Status = stsDefault')
+      (
+        'Component = edtTextLen'
+        'Status = stsDefault')
+      (
+        'Component = udTextLen'
+        'Status = stsDefault')
+      (
+        'Component = pnlSwap'
+        'Status = stsDefault')
+      (
+        'Component = edtDefault'
+        'Status = stsDefault')
+      (
+        'Component = pnlNum'
+        'Status = stsDefault')
+      (
+        'Component = udDefNum'
+        'Status = stsDefault')
+      (
+        'Component = edtDefNum'
+        'Status = stsDefault')
+      (
+        'Component = udMinVal'
+        'Status = stsDefault')
+      (
+        'Component = edtMinVal'
+        'Status = stsDefault')
+      (
+        'Component = udInc'
+        'Status = stsDefault')
+      (
+        'Component = edtInc'
+        'Status = stsDefault')
+      (
+        'Component = edtMaxVal'
+        'Status = stsDefault')
+      (
+        'Component = udMaxVal'
+        'Status = stsDefault')
+      (
+        'Component = edtURL'
+        'Status = stsDefault')
+      (
+        'Component = reItems'
+        'Status = stsDefault')
+      (
+        'Component = cbxDefault'
+        'Status = stsDefault')
+      (
+        'Component = pnlDate'
+        'Status = stsDefault')
+      (
+        'Component = edtDateDef'
+        'Status = stsDefault')
+      (
+        'Component = cbxDateType'
+        'Status = stsDefault')
+      (
+        'Component = edtLen'
+        'Status = stsDefault')
+      (
+        'Component = udLen'
+        'Status = stsDefault')
+      (
+        'Component = gbIndent'
+        'Status = stsDefault')
+      (
+        'Component = edtIndent'
+        'Status = stsDefault')
+      (
+        'Component = udIndent'
+        'Status = stsDefault')
+      (
+        'Component = udPad'
+        'Status = stsDefault')
+      (
+        'Component = edtPad'
+        'Status = stsDefault')
+      (
+        'Component = gbMisc'
+        'Status = stsDefault')
+      (
+        'Component = cbActive'
+        'Status = stsDefault')
+      (
+        'Component = cbRequired'
+        'Status = stsDefault')
+      (
+        'Component = cbSepLines'
+        'Status = stsDefault')
+      (
+        'Component = cbExclude'
+        'Status = stsDefault')
+      (
+        'Component = pnlTop'
+        'Status = stsDefault')
+      (
+        'Component = MenuBar1'
+        'Status = stsDefault')
+      (
+        'Component = btnNew'
+        'Status = stsDefault')
+      (
+        'Component = btnCopy'
+        'Status = stsDefault')
+      (
+        'Component = btnDelete'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateFieldEditor'
+        'Status = stsDefault'))
   end
   object mnuMain: TMainMenu

cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas

-              r456
+              r829
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ORCtrls, StdCtrls, ExtCtrls, Menus, ComCtrls, uTemplateFields, ORFn,
   ToolWin, MenuBar, ORClasses, ORDtTm;
+  ToolWin, MenuBar, ORClasses, ORDtTm, fBase508Form, VA508AccessibilityManager;
 type
   TfrmTemplateFieldEditor = class(TForm)
+  TfrmTemplateFieldEditor = class(TfrmBase508Form)
     pnlBottom: TPanel;
     btnOK: TButton;
 …
 uses rTemplates, fTemplateDialog, Clipbrd, uSpell, uConst,
      fTemplateFields;
+     fTemplateFields, VAUtils;
 {$R *.DFM}
 …
   FUpdating := TRUE;
   try
     cbxDefault.Items.Assign(reItems.Lines);
+    QuickCopy(reItems, cbxDefault);
     idx := -1;
     if(assigned(FFld)) and reItems.Visible and cbxDefault.Visible then
 …
   tmp := TORStringList.Create;
   try
     tmp.Assign(SubSetOfTemplateFields(StartFrom, Direction));
+    FastAssign(SubSetOfTemplateFields(StartFrom, Direction), tmp);
     for i := 0 to FDeleted.Count-1 do
     begin
 …
         tmp.delete(idx);
     end;
     ConvertCodes2Text(tmp, TRUE);
+    ConvertCodes2Text(tmp, FALSE);
     cbxObjs.ForDataUse(tmp);
   finally
 …
     if FDeleted.IndexOfPiece(FFld.FldName, U, 2) >= 0 then
     begin
       ShowMessage('Template field can not be named the same as a deleted' + CRLF +
+      ShowMsg('Template field can not be named the same as a deleted' + CRLF +
                   'field until OK or Apply has been pressed.');
       bad := TRUE;

cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm

-              r456
+              r829
 object frmTemplateFields: TfrmTemplateFields
+inherited frmTemplateFields: TfrmTemplateFields
   Left = 212
   Top = 155
-  Width = 418
-  Height = 300
   Caption = 'Insert Template Field'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 319
+  ClientWidth = 450
   FormStyle = fsStayOnTop
-  OldCreateOrder = False
   Position = poOwnerFormCenter
   OnClose = FormClose
   OnCreate = FormCreate
   OnShow = FormShow
+  ExplicitWidth = 458
+  ExplicitHeight = 346
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [0]
     Left = 0
     Top = 246
     Width = 410
     Height = 27
+    Top = 226
+    Width = 450
+    Height = 28
     Align = alBottom
     BevelOuter = bvNone
     TabOrder = 0
+    TabOrder = 1
     DesignSize = (
+)
+    object lblReq: TStaticText
+      Left = 21
+      Top = 8
+      Width = 134
+      Height = 17
+      Caption = '* Indicates a Required Field'
+      TabOrder = 3
+    end
+)
     object btnCancel: TButton
       Left = 335
+      Left = 371
       Top = 4
       Width = 75
 …
       Caption = '&Done'
       ModalResult = 2
       TabOrder = 2
+      TabOrder = 3
       OnClick = btnCancelClick
     end
     object btnInsert: TButton
       Left = 255
+      Left = 291
       Top = 4
       Width = 75
 …
       Default = True
       ModalResult = 4
       TabOrder = 1
+      TabOrder = 2
       OnClick = btnInsertClick
     end
     object btnPreview: TButton
       Left = 175
+      Left = 211
       Top = 4
       Width = 75
       Height = 21
+      Anchors = [akTop, akRight]
       Caption = '&Preview'
       Enabled = False
+      TabOrder = 1
+      OnClick = btnPreviewClick
+    end
+    object lblReq: TVA508StaticText
+      Name = 'lblReq'
+      AlignWithMargins = True
+      Left = 10
+      Top = 12
+      Width = 132
+      Height = 15
+      Alignment = taLeftJustify
+      Anchors = [akLeft, akBottom]
+      Caption = '* Indicates a Required Field'
       TabOrder = 0
       OnClick = btnPreviewClick
     end
   end
   object cboObjects: TORComboBox
+      ShowAccelChar = True
+    end
+  end
+  object cboObjects: TORComboBox [1]
     Left = 0
     Top = 0
     Width = 410
     Height = 246
+    Width = 450
+    Height = 226
     Style = orcsSimple
     Align = alClient
 …
     ListItemsOnly = True
     LongList = True
+    LookupPiece = 0
     MaxLength = 0
     Pieces = '2,3'
 …
     SynonymChars = '<Inactive>'
     TabPositions = '50,60,70,80,90'
+    TabOrder = 1
+    TabOrder = 0
+    TabStop = True
     OnChange = cboObjectsChange
     OnDblClick = cboObjectsDblClick
     OnNeedData = cboObjectsNeedData
+    CharsNeedMatch = 1
+  end
+  object pnlBottomSR: TPanel [2]
+    Left = 0
+    Top = 254
+    Width = 450
+    Height = 65
+    Align = alBottom
+    BevelOuter = bvNone
+    TabOrder = 2
+    object lblSRCont2: TVA508StaticText
+      Name = 'lblSRCont2'
+      AlignWithMargins = True
+      Left = 24
+      Top = 45
+      Width = 423
+      Height = 15
+      Margins.Left = 24
+      Margins.Top = 0
+      Margins.Bottom = 0
+      Align = alTop
+      Alignment = taLeftJustify
+      Caption =
+        'speaking text that follows the template field, when the field re' +
+        'ceives focus.'
+      TabOrder = 3
+      ShowAccelChar = True
+    end
+    object lblSRCont1: TVA508StaticText
+      Name = 'lblSRCont1'
+      AlignWithMargins = True
+      Left = 10
+      Top = 30
+      Width = 437
+      Height = 15
+      Margins.Left = 10
+      Margins.Top = 0
+      Margins.Bottom = 0
+      Align = alTop
+      Alignment = taLeftJustify
+      Caption =
+        '*** Place this code after a template field to allow the screen r' +
+        'eader to continue'
+      TabOrder = 2
+      ShowAccelChar = True
+    end
+    object lblSRStop: TVA508StaticText
+      Name = 'lblSRStop'
+      AlignWithMargins = True
+      Left = 10
+      Top = 15
+      Width = 437
+      Height = 15
+      Margins.Left = 10
+      Margins.Top = 0
+      Margins.Bottom = 0
+      Align = alTop
+      Alignment = taLeftJustify
+      Caption = '** Screen reader will stop speaking at this point'
+      TabOrder = 1
+      ShowAccelChar = True
+    end
+    object pnlSRIntro: TPanel
+      Left = 0
+      Top = 0
+      Width = 450
+      Height = 15
+      Align = alTop
+      BevelOuter = bvNone
+      TabOrder = 0
+      object lblSRIntro1: TVA508StaticText
+        Name = 'lblSRIntro1'
+        AlignWithMargins = True
+        Left = 10
+        Top = 0
+        Width = 127
+        Height = 15
+        Margins.Left = 10
+        Margins.Top = 0
+        Margins.Bottom = 0
+        Align = alLeft
+        Alignment = taLeftJustify
+        Caption = 'Screen Reader Codes'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'MS Sans Serif'
+        Font.Style = [fsBold]
+        ParentFont = False
+        TabOrder = 0
+        ShowAccelChar = True
+      end
+      object lblSRIntro2: TVA508StaticText
+        Name = 'lblSRIntro2'
+        Left = 140
+        Top = 0
+        Width = 310
+        Height = 15
+        Align = alClient
+        Alignment = taLeftJustify
+        Caption = '(make templates user friendly for those using screen readers)'
+        TabOrder = 1
+        ShowAccelChar = True
+      end
+    end
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnInsert'
+        'Status = stsDefault')
+      (
+        'Component = btnPreview'
+        'Status = stsDefault')
+      (
+        'Component = cboObjects'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateFields'
+        'Status = stsDefault')
+      (
+        'Component = lblReq'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottomSR'
+        'Status = stsDefault')
+      (
+        'Component = lblSRCont2'
+        'Status = stsDefault')
+      (
+        'Component = lblSRCont1'
+        'Status = stsDefault')
+      (
+        'Component = lblSRStop'
+        'Status = stsDefault')
+      (
+        'Component = pnlSRIntro'
+        'Status = stsDefault')
+      (
+        'Component = lblSRIntro1'
+        'Status = stsDefault')
+      (
+        'Component = lblSRIntro2'
+        'Status = stsDefault'))
   end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ORCtrls, ComCtrls, StdCtrls, ExtCtrls;
+  ORCtrls, ComCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmTemplateFields = class(TForm)
+  TfrmTemplateFields = class(TfrmBase508Form)
     pnlBottom: TPanel;
     btnCancel: TButton;
     cboObjects: TORComboBox;
     btnInsert: TButton;
-    lblReq: TStaticText;
     btnPreview: TButton;
+    lblReq: TVA508StaticText;
+    pnlBottomSR: TPanel;
+    lblSRCont2: TVA508StaticText;
+    lblSRCont1: TVA508StaticText;
+    lblSRStop: TVA508StaticText;
+    pnlSRIntro: TPanel;
+    lblSRIntro1: TVA508StaticText;
+    lblSRIntro2: TVA508StaticText;
     procedure FormShow(Sender: TObject);
     procedure FormCreate(Sender: TObject);
 …
 {    Fre: TRichEdit;}
     Fre: TCustomEdit;
+    FInsertAllowed: boolean;
+    FInitialized: boolean;
     FAutoLongLines: TNotifyEvent;
     procedure InsertField;
 {    procedure Setre(const Value: TRichEdit);}
     procedure Setre(const Value: TCustomEdit);
+    function ValidPreview: boolean;
+    function ValidInsert: boolean;
   public
     procedure UpdateStatus;
 …
 procedure TfrmTemplateFields.FormShow(Sender: TObject);
+begin
+var
+  i: integer;
+begin
+  if not FInitialized then
+  begin
+    with cboObjects do
+    begin
+      for i := low(ScreenReaderCodeLines) to high(ScreenReaderCodeLines) do
+        Items.Add(ScreenReaderCodeLines[i]);
+      InsertSeparator;
+      InitLongList('');
+    end;
+    FInitialized := TRUE;
+  end;
   cboObjects.SelectAll;
   cboObjects.SetFocus;
 …
 procedure TfrmTemplateFields.FormCreate(Sender: TObject);
 begin
   cboObjects.InitLongList('');
   cboObjects.ItemHeight := 15;
   ResizeAnchoredFormToFont(self);
   //ResizeAnchoredFormToFont doesn't work right on the button positions for some reason.
   btnCancel.Left := pnlBottom.ClientWidth - btnCancel.Width;
   btnInsert.Left := btnCancel.Left - btnInsert.Width - 8;
+  ResizeFormToFont(self);
+  cboObjects.ItemHeight := lblReq.Height - 1;
+  FInsertAllowed := TRUE;
+  lblReq.Top := (pnlBottom.Height - lblReq.Height);
+  pnlSRIntro.Height := lblSRStop.Height;
+  pnlBottomSR.Height := lblSRCont1.Height * 4 + 5;
 end;
 …
 var
   cnt: integer;
+begin
+  p1, p2: string;
+  check: boolean;
+  i: integer;
+begin
+  p1 := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
+  if p1 = '' then exit;
   if assigned(Fre) and (not TORExposedCustomEdit(Fre).ReadOnly) and (cboObjects.ItemIndex >= 0) then
   begin
 …
       cnt := TRichEdit(FRe).Lines.Count
     else
+      cnt :=0;
+    Fre.SelText := TemplateFieldBeginSignature +
+                   Piece(cboObjects.Items[cboObjects.ItemIndex],U,2)+
+                   TemplateFieldEndSignature;
+      cnt := 0;
+    if StrToIntDef(p1, 0) < 0 then
+    begin
+      check := true;
+      for i := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
+      begin
+        if p1 = ScreenReaderCodeIDs[i] then
+        begin
+          p2 := ScreenReaderCodes[i];
+          check := FALSE;
+          break;
+        end;
+      end;
+    end
+    else
+      check := TRUE;
+    if check then
+      p2 := TemplateFieldBeginSignature + Piece(cboObjects.Items[cboObjects.ItemIndex],U,2) +
+            TemplateFieldEndSignature;
+    Fre.SelText := p2;
     if Fre is TRichEdit then
       if(assigned(FAutoLongLines) and (cnt <> TRichEdit(FRe).Lines.Count)) then
 …
 procedure TfrmTemplateFields.cboObjectsDblClick(Sender: TObject);
 begin
   if btnInsert.Enabled then
+  if ValidInsert then
     InsertField;
 end;
 …
 procedure TfrmTemplateFields.UpdateStatus;
 begin
+  btnInsert.Enabled := (not TORExposedCustomEdit(re).ReadOnly);
+  FInsertAllowed := (not TORExposedCustomEdit(re).ReadOnly);
+  btnInsert.Enabled := ValidInsert and FInsertAllowed;
+end;
+function TfrmTemplateFields.ValidInsert: boolean;
+begin
+  Result := (cboObjects.ItemIndex >= 0);
+  if Result then
+    Result := (Piece(cboObjects.Items[cboObjects.ItemIndex],U,1) <> '');
+end;
+function TfrmTemplateFields.ValidPreview: boolean;
+var
+  i: integer;
+  code: string;
+begin
+  Result := ValidInsert;
+  if Result then
+  begin
+    code := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
+    for I := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
+    begin
+      if code = ScreenReaderCodeIDs[i] then
+      begin
+        Result := FALSE;
+        break;
+      end;
+    end;
+  end;
 end;
 procedure TfrmTemplateFields.btnInsertClick(Sender: TObject);
 begin
+  InsertField;
+  if ValidInsert then
+    InsertField;
 end;
 …
 procedure TfrmTemplateFields.cboObjectsChange(Sender: TObject);
 begin
+  btnPreview.Enabled := (cboObjects.ItemIndex >= 0)
+  btnPreview.Enabled := ValidPreview;
+  btnInsert.Enabled := ValidInsert and FInsertAllowed;
 end;

cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm

-              r456
+              r829
 object frmTemplateImport: TfrmTemplateImport
+inherited frmTemplateImport: TfrmTemplateImport
   Left = 273
   Top = 195
 …
   ClientHeight = 132
   ClientWidth = 288
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'MS Sans Serif'
-  Font.Style = []
   FormStyle = fsStayOnTop
-  OldCreateOrder = False
   Position = poScreenCenter
   PixelsPerInch = 96
   TextHeight = 13
   object gaugeImport: TGauge
+  object gaugeImport: TGauge [0]
     Left = 8
     Top = 82
     Width = 272
     Height = 21
+    ForeColor = clNavy
+    BackColor = clHighlightText
+    ForeColor = clHighlight
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clCaptionText
+    Font.Height = -11
+    Font.Name = 'MS Sans Serif'
+    Font.Style = []
+    ParentFont = False
     Progress = 0
   end
   object lblImporting: TStaticText
+  object lblImporting: TStaticText [1]
     Left = 8
     Top = 4
 …
     TabOrder = 0
   end
   object animImport: TAnimate
+  object animImport: TAnimate [2]
     Left = 8
     Top = 20
 …
     Active = True
     CommonAVI = aviCopyFile
     StopFrame = 26
+    StopFrame = 20
   end
   object btnCancel: TButton
+  object btnCancel: TButton [3]
     Left = 106
     Top = 106
 …
     OnClick = btnCancelClick
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = lblImporting'
+        'Status = stsDefault')
+      (
+        'Component = animImport'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateImport'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Gauges, StdCtrls, ComCtrls;
+  Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
 type
   TfrmTemplateImport = class(TForm)
+  TfrmTemplateImport = class(TfrmBase508Form)
     animImport: TAnimate;
     btnCancel: TButton;

cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm

-              r456
+              r829
 object frmTemplateObjects: TfrmTemplateObjects
+inherited frmTemplateObjects: TfrmTemplateObjects
   Left = 215
   Top = 343
-  Width = 247
-  Height = 300
   ActiveControl = cboObjects
   Caption = 'Insert Patient Data (Object)'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  ClientHeight = 273
+  ClientWidth = 239
   FormStyle = fsStayOnTop
-  OldCreateOrder = False
   Position = poOwnerFormCenter
   OnClose = FormClose
   OnShow = FormShow
+  ExplicitWidth = 247
+  ExplicitHeight = 300
   PixelsPerInch = 96
   TextHeight = 13
   object cboObjects: TORComboBox
+  object cboObjects: TORComboBox [0]
     Left = 0
     Top = 0
 …
     TabOrder = 0
     OnDblClick = cboObjectsDblClick
+    CharsNeedMatch = 1
   end
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [1]
     Left = 0
     Top = 246
 …
     end
   end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = cboObjects'
+        'Status = stsDefault')
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnCancel'
+        'Status = stsDefault')
+      (
+        'Component = btnInsert'
+        'Status = stsDefault')
+      (
+        'Component = btnRefresh'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateObjects'
+        'Status = stsDefault'))
+  end
 end

cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared;
+  ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared, uTemplates, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmTemplateObjects = class(TForm)
+  TfrmTemplateObjects = class(TfrmBase508Form)
     cboObjects: TORComboBox;
     pnlBottom: TPanel;
 …
 procedure TfrmTemplateObjects.btnRefreshClick(Sender: TObject);
+var
+  i: integer;
+  DoIt: boolean;
 begin
+cboObjects.SelectAll;
+cboObjects.Clear;
+dmodShared.RefreshObject := true;
+dmodShared.LoadTIUObjects;
+CboOBJECTS.Items.AddStrings(dmodShared.TIUObjects);
+  cboObjects.Clear;
+  dmodShared.RefreshObject := true;
+  dmodShared.LoadTIUObjects;
+  //---------- CQ #8665 - RV ----------------
+  DoIt := TRUE;
+  UpdatePersonalObjects;
+  if uPersonalObjects.Count > 0 then
+  begin
+    DoIt := FALSE;
+    for i := 0 to dmodShared.TIUObjects.Count-1 do
+      if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
+        cboObjects.Items.Add(dmodShared.TIUObjects[i]);
+  end;
+  if DoIt then
+  //---------- end CQ #8665 ------------------
+    cboObjects.Items.Assign(dmodShared.TIUObjects);
 end;
 end.

cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm

-              r456
+              r829
 object frmTemplateView: TfrmTemplateView
+inherited frmTemplateView: TfrmTemplateView
   Left = 257
   Top = 105
-  Width = 578
-  Height = 372
   Caption = 'View Template'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  ClientHeight = 343
+  ClientWidth = 568
   Position = poScreenCenter
   OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnShow = FormShow
+  ExplicitWidth = 576
+  ExplicitHeight = 370
   PixelsPerInch = 96
   TextHeight = 13
   object pnlBottom: TPanel
+  object pnlBottom: TPanel [0]
     Left = 0
     Top = 315
     Width = 570
+    Top = 313
+    Width = 568
     Height = 30
     Align = alBottom
 …
     TabOrder = 1
     DesignSize = (
 )
     object btnClose: TButton
       Left = 494
+      Left = 492
       Top = 6
       Width = 75
 …
     end
     object btnPrint: TButton
       Left = 414
+      Left = 412
       Top = 6
       Width = 75
 …
     end
   end
   object reMain: TRichEdit
+  object reMain: TRichEdit [1]
     Left = 0
     Top = 0
     Width = 570
     Height = 315
+    Width = 568
+    Height = 313
     Align = alClient
     Color = clCream
 …
     WantReturns = False
     WordWrap = False
+  end
+  inherited amgrMain: TVA508AccessibilityManager
+    Data = (
+      (
+        'Component = pnlBottom'
+        'Status = stsDefault')
+      (
+        'Component = btnClose'
+        'Status = stsDefault')
+      (
+        'Component = cbStayOnTop'
+        'Status = stsDefault')
+      (
+        'Component = btnPrint'
+        'Status = stsDefault')
+      (
+        'Component = reMain'
+        'Status = stsDefault')
+      (
+        'Component = frmTemplateView'
+        'Status = stsDefault'))
   end
   object popView: TPopupMenu

cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn;
+  StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn, fBase508Form,
+  VA508AccessibilityManager;
 type
   TfrmTemplateView = class(TForm)
+  TfrmTemplateView = class(TfrmBase508Form)
     pnlBottom: TPanel;
     reMain: TRichEdit;
 …
     procedure SelectAll1Click(Sender: TObject);
     procedure btnPrintClick(Sender: TObject);
+    procedure AlignButtons();
     procedure FormCreate(Sender: TObject);
-    procedure FormShow(Sender: TObject);
   private
   end;
 …
   if(not assigned(frmTemplateView)) then
     frmTemplateView := TfrmTemplateView.Create(Application);
+  ResizeAnchoredFormToFont(frmTemplateView);
+  //Quick fix to work around glich in resize algorithm
+  frmTemplateView.AlignButtons();
   frmTemplateView.reMain.Lines.Clear;
   frmTemplateView.Caption := 'Template: ' + Title;
 …
   SaveUserBounds(frmTemplateView);
   Action := caFree;
+end;
+procedure TfrmTemplateView.FormCreate(Sender: TObject);
+begin
+  inherited;
+  ResizeAnchoredFormToFont(Self);
+  SetFormPosition(Self);
 end;
 …
 end;
+procedure TfrmTemplateView.FormCreate(Sender: TObject);
+procedure TfrmTemplateView.AlignButtons;
+Const
+  BtnSpace = 8;
 begin
+  reMain.Color := ReadOnlyColor;
+end;
+procedure TfrmTemplateView.FormShow(Sender: TObject);
+begin
+  SetFormPosition(frmTemplateView);
+  btnClose.Left := frmTemplateView.Width - btnClose.Width - BtnSpace;
+  btnPrint.Left := btnClose.Left - BtnSpace - btnPrint.Width;
 end;

cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm

-              r456
+              r829
   Left = 0
   Top = 0
   Width = 109
+  Width = 136
   Height = 14
+  AutoScroll = True
   Font.Charset = ANSI_CHARSET
   Font.Color = clWindowText
 …
   TabOrder = 0
   TabStop = True
   OnEnter = pnlBtnEnter
   OnExit = pnlBtnExit
+  OnEnter = FrameEnter
+  OnExit = FrameExit
   object pnlBtn: TPanel
     Left = 0
     Top = 0
     Width = 109
+    Width = 136
     Height = 14
     Align = alClient
     TabOrder = 0
+    OnExit = FrameExit
     OnMouseDown = pnlBtnMouseDown
     OnMouseUp = pnlBtnMouseUp
+    DesignSize = (
+)
     object lblText: TLabel
       Left = 2
       Top = -1
       Width = 105
+      Width = 132
       Height = 14
       Alignment = taCenter
 …
       OnMouseDown = pnlBtnMouseDown
       OnMouseUp = pnlBtnMouseUp
+      ExplicitWidth = 105
     end
     object pbFocus: TPaintBox
       Left = 1
       Top = 1
       Width = 107
+      Width = 134
       Height = 12
       Align = alClient
 …
       OnMouseUp = pnlBtnMouseUp
       OnPaint = pbFocusPaint
+      ExplicitWidth = 107
     end
   end

cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls;
+  StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
 type
   TfraTemplateFieldButton = class(TFrame)
+  TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent)
     pnlBtn: TPanel;
     lblText: TLabel;
 …
     procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure pnlBtnEnter(Sender: TObject);
     procedure pnlBtnExit(Sender: TObject);
+    procedure FrameEnter(Sender: TObject);
+    procedure FrameExit(Sender: TObject);
     procedure pbFocusPaint(Sender: TObject);
   private
+    FCPRSDialogData: ICPRSDialogComponent;
     FBtnDown: boolean;
     FItems: TStringList;
 …
     property Items: TStringList read FItems;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent;
   end;
 …
 uses
   ORFn;
+  ORFn, VA508AccessibilityRouter;
 procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 …
         idx := 0;
       ButtonText := FItems[idx];
+      if ScreenReaderSystemActive then
+      begin
+        txt := FItems[idx];
+        if Trim(txt) = '' then
+          txt := 'blank';
+        GetScreenReader.Speak(txt);
+      end;
       if assigned(FOnChange) then
         FOnChange(Self);
 …
 end;
+procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject);
+type
+  TWinControlFriend = class(TWinControl);
+procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
 begin
   pbFocus.Invalidate;
 end;
 procedure TfraTemplateFieldButton.pnlBtnExit(Sender: TObject);
+procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
 begin
   pbFocus.Invalidate;
 …
 constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
 begin
+  inherited;
+  inherited Create(AOwner);
+  TabStop := TRUE;
   FItems := TStringList.Create;
   OnKeyDown := ButtonKeyDown;
   OnKeyUp := ButtonKeyUp;
   Font.Size := MainFontSize;
+  FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button');
 end;
 …
 begin
   FItems.Free;
+  FCPRSDialogData := nil;
   inherited;
 end;
+initialization
+  SpecifyFormIsNotADialog(TfraTemplateFieldButton);
 end.

cprs/trunk/CPRS-Chart/Templates/rTemplates.pas

-              r456
+              r829
     CallBroker;
     RPCBrokerV.Results.Delete(0);
     BoilerPlate.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, BoilerPlate);
     RPCBrokerV.Results.Clear;
   end;
 …
   TmpList := TStringList.Create;
   try
     TmpList.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, TmpList);
     SortByPiece(TmpList, U, 2);
     MixedCaseList(TmpList);
     RPCBrokerV.Results.Assign(TmpList);
+    FastAssign(TmpList, RPCBrokerV.Results);
   finally
     TmpList.Free;
 …
 begin
   CallV('TIU FIELD CHECK',[nil]);
   ResultString.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ResultString);
 end;
 …
     CallBroker;
   end;
   Text.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Text);
 end;
 …
   Result := TRUE;
   CallV('TIU FIELD LIST IMPORT',[nil]);
   ResultSet.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ResultSet);
   if ResultSet.Count < 1 then
     Result := FALSE;

cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas

-              r456
+              r829
 uses
   Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
   Graphics, ORClasses, ComCtrls, ORDtTm;
+  Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils;
 type
   TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
+                        dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
+    dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText,
+// keep dftScreenReader as last entry - users can not create this type of field
+    dftScreenReader);
   TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
 …
     FID: string;
     FFont: TFont;
     FPanel: TPanel;
+    FPanel: TDlgFieldPanel;
     FControls: TStringList;
     FIndents: TStringList;
 …
     procedure SetFieldValues(const Value: string);
     procedure SetAutoDestroyOnPanelFree(const Value: boolean);
+    function StripCode(var txt: string; code: char): boolean;
   protected
     procedure UpDownChange(Sender: TObject);
 …
     constructor Create(AParent: TWinControl; AID, Text: string);
     destructor Destroy; override;
+    function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
+    function GetPanel(MaxLen: integer; AParent: TWinControl;
+                      OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
     function GetText: string;
     property Text: string read FText write FText;
 …
 procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
 function StripEmbedded(iItems: string): string;
+procedure StripScreenReaderCodes(var Text: string); overload;
+procedure StripScreenReaderCodes(SL: TStrings); overload;
+function HasScreenReaderBreakCodes(SL: TStrings): boolean;
 const
+  TemplateFieldBeginSignature = '{FLD:';
+  TemplateFieldSignature = '{FLD';
+  TemplateFieldBeginSignature = TemplateFieldSignature + ':';
   TemplateFieldEndSignature = '}';
+  ScreenReaderCodeSignature = '{SR-';
+  ScreenReaderCodeType = '  Screen Reader Code';
+  ScreenReaderCodeCount = 2;
+  ScreenReaderShownCount = 1;
+  ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature;
+  ScreenReaderStopCodeLen = Length(ScreenReaderStopCode);
+  ScreenReaderStopCodeID = '-43';
+  ScreenReaderStopName = 'SCREEN READER STOP CODE **';
+  ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType;
+  ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature;
+  ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode);
+  ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature;
+  ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld);
+  ScreenReaderContinueCodeID = '-44';
+  ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***';
+  ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType;
   MissingFieldsTxt = 'One or more required fields must still be entered.';
+  ScreenReaderCodes:     array[0..ScreenReaderCodeCount] of string  =
+      (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld);
+  ScreenReaderCodeLens:  array[0..ScreenReaderCodeCount] of integer =
+      (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen);
+  ScreenReaderCodeIDs:   array[0..ScreenReaderShownCount] of string  =
+      (ScreenReaderStopCodeID, ScreenReaderContinueCodeID);
+  ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string  =
+      (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine);
   TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
 …
                          {  dftHyperlink    }  'H',
                          {  dftWP           }  'W',
+                         {  dftText         }  'T');
+                         {  dftText         }  'T',
+                         {  dftScreenReader }  'S');
   TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
                          {  dftUnknown      } (('',''),
+                         {  dftEditBox      }  ('Edit Box',       'Edit'),
+                         {  dftComboBox     }  ('Combo Box',      'Combo'),
+                         {  dftButton       }  ('Button',         'Button'),
+                         {  dftCheckBoxes   }  ('Check Boxes',    'Check'),
+                         {  dftRadioButtons }  ('Radio Buttons',  'Radio'),
+                         {  dftDate         }  ('Date',           'Date'),
+                         {  dftNumber       }  ('Number',         'Num'),
+                         {  dftHyperlink    }  ('Hyperlink',      'Link'),
+                         {  dftWP           }  ('Word Processing','WP'),
+                         {  dftWP           }  ('Display Text',   'Text'));
+                         {  dftEditBox      }  ('Edit Box',           'Edit'),
+                         {  dftComboBox     }  ('Combo Box',          'Combo'),
+                         {  dftButton       }  ('Button',             'Button'),
+                         {  dftCheckBoxes   }  ('Check Boxes',        'Check'),
+                         {  dftRadioButtons }  ('Radio Buttons',      'Radio'),
+                         {  dftDate         }  ('Date',               'Date'),
+                         {  dftNumber       }  ('Number',             'Num'),
+                         {  dftHyperlink    }  ('Hyperlink',          'Link'),
+                         {  dftWP           }  ('Word Processing',    'WP'),
+                         {  dftText         }  ('Display Text',       'Text'),
+                         {  dftScreenReader }  ('Screen Reader Stop', 'SRStop'));
   TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
 …
                    { dftHyperlink    }  'LINK',
                    { dftWP           }  'WRDP',
+                   { dftTExt         }  'TEXT');
+                   { dftTExt         }  'TEXT',
+                   { dftScreenReader }  'SRST');
   TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
 …
   MaxTFWPLines = 20;
   MaxTFEdtLen = 70;
+type
+  TFieldPanel = class(TPanel)  {This is the panel associated with the child}
+  private                      {dialog checkboxes in reminders dialogs}
+    FOnDestroy: TNotifyEvent;
+    FCanvas: TControlCanvas;    {used to draw focus rect}
+    function GetFocus: boolean;
+    procedure SetTheFocus(const Value: boolean);
+  protected                     {used to draw focus rect}
+    procedure Paint; override;  {used to draw focus rect}
+  public
+    destructor Destroy; override;
+    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+    property Focus:  boolean read GetFocus write SetTheFocus; {to draw focus rect}
+    property OnKeyPress;        {to click the checkbox when spacebar is pressed}
+  end;
 implementation
 uses
+  ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows;
+  rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
+  VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter;
 const
 …
   FieldIDLen = 6;
   NewLine = 'NL';
-type
-  TFieldLabel = class(TLabel)
-  private
-    FExclude: boolean;
-  public
-    property Exclude: boolean read FExclude;
-  end;
-  TWebLabel = class(TFieldLabel)
-  private
-    FAddr: string;
-    procedure Clicked(Sender: TObject);
-  public
-    procedure Init(Addr: string);
-  end;
 function GetNewFieldID: string;
 …
   Result := (msg <> '');
   if(Result) then
     ShowMessage(msg);
+    ShowMsg(msg);
 end;
 …
           AList.Add('');
         AList.Add('The following inactive template fields were found:');
         AList.AddStrings(InactiveList);
+        FastAddStrings(InactiveList, AList);
       end;
       if(AList.Count > 0) then
 …
   dbox: TORDateBox;
   dcbo: TORDateCombo;
   lbl: TFieldLabel;
+  lbl: TCPRSTemplateFieldLabel;
   re: TRichEdit;
+  pnl: TPanel;
+  ud: TUpDown;
+  pnl: TCPRSDialogNumber;
   DefDate: TFMDateTime;
   ctrl: TControl;
 …
       dftEditBox:
         begin
+          edt := TEdit.Create(nil);
+          edt := TCPRSDialogFieldEdit.Create(nil);
+          (edt as ICPRSDialogComponent).RequiredField := Required;
           edt.Parent := Entry.FPanel;
           edt.BorderStyle := bsNone;
 …
           edt.Tag := CtrlID;
           edt.OnChange := Entry.DoChange;
+          UpdateColorsFor508Compliance(edt, TRUE);
           ctrl := edt;
         end;
 …
       dftComboBox:
         begin
+          cbo := TORComboBox.Create(nil);
+          cbo := TCPRSDialogComboBox.Create(nil);
+          (cbo as ICPRSDialogComponent).RequiredField := Required;
           cbo.Parent := Entry.FPanel;
           cbo.TemplateField := TRUE;
 …
             cbo.DropDownCount := cbo.Items.Count;
           end;
+          UpdateColorsFor508Compliance(cbo, TRUE);
           ctrl := cbo;
         end;
 …
         begin
           btn := TfraTemplateFieldButton.Create(nil);
+          (btn as ICPRSDialogComponent).RequiredField := Required;
           btn.Parent := Entry.FPanel;
           {Clear out embedded fields}
 …
           btn.Tag := CtrlID;
           btn.OnChange := Entry.DoChange;
+          UpdateColorsFor508Compliance(btn);
           ctrl := btn;
         end;
 …
             for i := 0 to TmpSL.Count-1 do
             begin
+              cb := TORCheckBox.Create(nil);
+              cb := TCPRSDialogCheckBox.Create(nil);
+              if i = 0 then
+                (cb as ICPRSDialogComponent).RequiredField := Required;
               cb.Parent := Entry.FPanel;
               cb.Caption := TmpSL[i];
 …
                 cb.StringData := NewLine;
               cb.OnClick := Entry.DoChange;
+              UpdateColorsFor508Compliance(cb);
               inc(Index);
               Entry.FControls.InsertObject(Index, '', cb);
 …
           if FDateType in DateComboTypes then
           begin
+            dcbo := TORDateCombo.Create(nil);
+            dcbo := TCPRSDialogDateCombo.Create(nil);
+            (dcbo as ICPRSDialogComponent).RequiredField := Required;
             dcbo.Parent := Entry.FPanel;
             dcbo.Tag := CtrlID;
 …
             dcbo.TemplateField := TRUE;
             dcbo.OnChange := Entry.DoChange;
+            UpdateColorsFor508Compliance(dcbo, TRUE);
             ctrl := dcbo;
           end
           else
           begin
+            dbox := TORDateBox.Create(nil);
+            dbox := TCPRSDialogDateBox.Create(nil);
+            (dbox as ICPRSDialogComponent).RequiredField := Required;
             dbox.Parent := Entry.FPanel;
             dbox.Tag := CtrlID;
 …
             dbox.Width := (wdth * tmp) + 18;
             dbox.OnChange := Entry.DoChange;
+            UpdateColorsFor508Compliance(dbox, TRUE);
             ctrl := dbox;
           end;
 …
       dftNumber:
         begin
+          pnl := TPanel.Create(nil);
+          pnl := TCPRSDialogNumber.CreatePanel(nil);
+          (pnl as ICPRSDialogComponent).RequiredField := Required;
           pnl.Parent := Entry.FPanel;
           pnl.BevelOuter := bvNone;
           pnl.Tag := CtrlID;
+          edt := TEdit.Create(pnl);
+          edt.Parent := pnl;
+          edt.BorderStyle := bsNone;
+          edt.Height := ht;
+          edt.Width := (wdth * 5 + 4);
+          edt.Top := 0;
+          edt.Left := 0;
+          edt.AutoSelect := True;
+          ud := TUpDown.Create(pnl);
+          ud.Parent := pnl;
+          ud.Associate := edt;
+          ud.Min := MinVal;
+          ud.Max := MaxVal;
+          ud.Min := MinVal; // Both ud.Min settings are needeed!
+          pnl.Edit.Height := ht;
+          pnl.Edit.Width := (wdth * 5 + 4);
+          pnl.UpDown.Min := MinVal;
+          pnl.UpDown.Max := MaxVal;
+          pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed!
           i := Increment;
           if i < 1 then i := 1;
+          ud.Increment := i;
+          ud.Thousands := FALSE;
+          ud.Position := StrToIntDef(EditDefault, 0);
+          edt.Tag := Integer(ud);
+          edt.OnChange := Entry.UpDownChange;
+          pnl.Height := edt.Height;
+          pnl.Width := edt.Width + ud.Width;
+          pnl.UpDown.Increment := i;
+          pnl.UpDown.Position := StrToIntDef(EditDefault, 0);
+          pnl.Edit.OnChange := Entry.UpDownChange;
+          pnl.Height := pnl.Edit.Height;
+          pnl.Width := pnl.Edit.Width + pnl.UpDown.Width;
+          UpdateColorsFor508Compliance(pnl, TRUE);
           ctrl := pnl;
         end;
 …
         begin
           if (FFldType = dftHyperlink) and User.WebAccess then
             lbl := TWebLabel.Create(nil)
+            lbl := TCPRSDialogHyperlinkLabel.Create(nil)
           else
             lbl := TFieldLabel.Create(nil);
+            lbl := TCPRSTemplateFieldLabel.Create(nil);
           lbl.Parent := Entry.FPanel;
           lbl.ShowAccelChar := FALSE;
           lbl.FExclude := FSepLines;
+          lbl.Exclude := FSepLines;
           if (FFldType = dftHyperlink) then
           begin
 …
             lbl.Caption := STmp;
           end;
           if lbl is TWebLabel then
             TWebLabel(lbl).Init(FURL);
+          if lbl is TCPRSDialogHyperlinkLabel then
+            TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
           lbl.Tag := CtrlID;
+          UpdateColorsFor508Compliance(lbl);
           ctrl := lbl;
         end;
 …
       dftWP:
         begin
+          re := TRichEdit.Create(nil);
+          re := TCPRSDialogRichEdit.Create(nil);
+          (re as ICPRSDialogComponent).RequiredField := Required;
           re.Parent := Entry.FPanel;
           re.Tag := CtrlID;
 …
           re.Lines.Text := Items;
           re.OnChange := Entry.DoChange;
+          UpdateColorsFor508Compliance(re, TRUE);
           ctrl := re;
         end;
 …
     Result := FLocked;
     if(not FLocked) then
       ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.');
+      ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
   end
   else
 …
 const
   EOL_MARKER = #182;
+  SR_BREAK   = #186;
 procedure PanelDestroy(AData: Pointer; Sender: TObject);
 …
   FControls.Text := Text;
   if(FControls.Count > 1) then
+  begin
     for i := 1 to FControls.Count-1 do
       FControls[i] := EOL_MARKER + FControls[i];
+    if not ScreenReaderSystemActive then
+      StripScreenReaderCodes(FControls);
+  end;
   FFirstBuild := TRUE;
   FPanel := TFieldPanel.Create(AParent.Owner);
+  FPanel := TDlgFieldPanel.Create(AParent.Owner);
   FPanel.Parent := AParent;
   FPanel.BevelOuter := bvNone;
   FPanel.Caption := '';
   FPanel.Font.Assign(FFont);
+  UpdateColorsFor508Compliance(FPanel, TRUE);
   idx := 0;
   while (idx < FControls.Count) do
 …
           FControls[idx] := copy(txt,1,i-1);
           if(Fld.Required) then
+          begin
+            if ScreenReaderSystemActive then
+            begin
+              if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
+                FControls[idx] := FControls[idx] + ScreenReaderStopCode;
+            end;
             FControls[idx] := FControls[idx] + '*';
+          end;
           Fld.CreateDialogControls(Self, idx, CtrlID);
           FControls.Insert(idx+1,copy(txt,i,MaxInt));
 …
     end;
     inc(idx);
+  end;
+  if ScreenReaderSystemActive then
+  begin
+    idx := 0;
+    while (idx < FControls.Count) do
+    begin
+      txt := FControls[idx];
+      i := pos(ScreenReaderStopCode, txt);
+      if i > 0 then
+      begin
+        FControls[idx] := copy(txt, 1, i-1);
+        txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt);
+        FControls.Insert(idx+1, SR_BREAK + txt);
+      end;
+      inc(idx);
+    end;
   end;
 end;
 …
           ind := 0;
       end;
       if(Ctrl is TFieldLabel) then
       begin
         if not TFieldLabel(Ctrl).Exclude then begin
+      if(Ctrl is TCPRSTemplateFieldLabel) then
+      begin
+        if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
           if emField <> '' then begin
             iField := GetTemplateField(emField,FALSE);
 …
                             end;
             else {case}
               Result := TFieldLabel(Ctrl).Caption
+              Result := TCPRSTemplateFieldLabel(Ctrl).Caption
             end; {case iField.FldType}
             end {if emField}
           else
             Result := TFieldLabel(Ctrl).Caption;
+            Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
         end;
       end
 …
 end;
+function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
+var
+  i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
+function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
+                                       OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
+var
+  i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
   MaxTextLen: integer;  {Max num of chars per line in pixels}
   MaxChars: integer;    {Max num of chars per line}
 …
   ctrl: TControl;
   LastLineBlank: boolean;
+  sLbl: TCPRSDialogStaticLabel;
+  nLbl: TVA508ChainedLabel;
+  sLblHeight: integer;
+  TabOrdr: integer;
 const
   FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
                         overlay the focus rect on its parent panel.}
+  procedure Add2TabOrder(ctrl: TWinControl);
+  begin
+    ctrl.TabOrder := TabOrdr;
+    inc(TabOrdr);
+  end;
+  function StripSRCode(var txt: string; code: string; len: integer): integer;
+  begin
+    Result := pos(code, txt);
+    if Result > 0 then
+    begin
+      delete(txt,Result,len);
+      dec(Result);
+    end
+    else
+      Result := -1;
+  end;
   procedure DoLabel(Atxt: string);
   var
+    lbl: TLabel;
+  begin
+    lbl := TLabel.Create(nil);
+    lbl.Parent := FPanel;
+    lbl.ShowAccelChar := FALSE;
+    lbl.Caption := Atxt;
+    lbl.Left := x;
+    lbl.Top := y;
+    inc(x, lbl.Width);
+  end;
+  procedure NextLine;
+  begin
+    if(MaxX < x) then
+      MaxX := x;
+    x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
+    inc(y, yinc);
+    yinc := ybase;
+  end;
+begin
+  MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
+  if(FFirstBuild or (FPanel.Width <> MaxLen)) then
+    ctrl: TControl;
+    tempLbl: TVA508ChainedLabel;
+  begin
+    if ScreenReaderSystemActive then
+    begin
+      if assigned(sLbl) then
+      begin
+        tempLbl := TVA508ChainedLabel.Create(nil);
+        if assigned(nLbl) then
+          nLbl.NextLabel := tempLbl
+        else
+          sLbl.NextLabel := tempLbl;
+        nLbl := tempLbl;
+        ctrl := nLbl;
+      end
+      else
+      begin
+        sLbl := TCPRSDialogStaticLabel.Create(nil);
+        ctrl := sLbl;
+      end;
+    end
+    else
+      ctrl := TLabel.Create(nil);
+    SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE));
+    SetStrProp(ctrl, CaptionProperty, Atxt);
+    ctrl.Parent := FPanel;
+    ctrl.Left := x;
+    ctrl.Top := y;
+    if ctrl = sLbl then
+    begin
+      Add2TabOrder(sLbl);
+      sLbl.Height := sLblHeight;
+      ScreenReaderSystem_CurrentLabel(sLbl);
+    end;
+    if ScreenReaderSystemActive then
+      ScreenReaderSystem_AddText(Atxt);
+    UpdateColorsFor508Compliance(ctrl);
+    inc(x, ctrl.Width);
+  end;
+  procedure Init;
+  var
+    lbl : TLabel;
   begin
     if(FFirstBuild) then
 …
     //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2);  AGP commentout line for
                                                                            //reminder spacing
     ybase := FontHeightPixel(FFont.Handle);
+    ybase := FontHeightPixel(FFont.Handle) + 2;
     yinc := ybase;
     LastLineBlank := FALSE;
+    sLbl := nil;
+    nLbl := nil;
+    TabOrdr := 0;
+    if ScreenReaderSystemActive then
+    begin
+      ScreenReaderSystem_CurrentCheckBox(OwningCheckBox);
+      lbl := TLabel.Create(nil);
+      try
+        lbl.Parent := FPanel;
+        sLblHeight := lbl.Height + 2;
+      finally
+        lbl.Free;
+      end;
+    end;
+  end;
+  procedure Text508Work;
+  var
+    ContinueCode: boolean;
+  begin
+    if StripCode(txt, SR_BREAK) then
+    begin
+      ScreenReaderSystem_Stop;
+      nLbl := nil;
+      sLbl := nil;
+    end;
+    ContinueCode := FALSE;
+    while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do
+      ContinueCode := TRUE;
+    while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do
+      ContinueCode := TRUE;
+    if ContinueCode then
+      ScreenReaderSystem_Continue;
+  end;
+  procedure Ctrl508Work(ctrl: TControl);
+  var
+    lbl: TCPRSTemplateFieldLabel;
+  begin
+    if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then
+    begin
+      lbl := Ctrl as TCPRSTemplateFieldLabel;
+      if trim(lbl.Caption) <> '' then
+      begin
+        ScreenReaderSystem_CurrentLabel(lbl);
+        ScreenReaderSystem_AddText(lbl.Caption);
+      end
+      else
+      begin
+        lbl.TabStop := FALSE;
+        ScreenReaderSystem_Stop;
+      end;
+    end
+    else
+    begin
+      if ctrl is TWinControl then
+        Add2TabOrder(TWinControl(ctrl));
+      if Supports(ctrl, ICPRSDialogComponent) then
+        ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent);
+    end;
+    sLbl := nil;
+    nLbl := nil;
+  end;
+  procedure NextLine;
+  begin
+    if(MaxX < x) then
+      MaxX := x;
+    x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
+    inc(y, yinc);
+    yinc := ybase;
+  end;
+begin
+  MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
+  if(FFirstBuild or (FPanel.Width <> MaxLen)) then
+  begin
+    Init;
     for i := 0 to FControls.Count-1 do
     begin
       txt := FControls[i];
+      if(copy(txt,1,1) = EOL_MARKER) then
+      if ScreenReaderSystemActive then
+        Text508Work;
+      if StripCode(txt,EOL_MARKER) then
       begin
         if((x <> 0) or LastLineBlank) then
           NextLine;
-        delete(txt,1,1);
         LastLineBlank := (txt = '');
       end;
 …
         if(assigned(ctrl)) then
         begin
+          if ScreenReaderSystemActive then
+            Ctrl508Work(ctrl);
           idx := FIndents.IndexOfObject(Ctrl);
           if idx >= 0 then
 …
           inc(x, Ctrl.Width + 4);
           if yinc <= Ctrl.Height then
             yinc := Ctrl.Height + 1;
+            yinc := Ctrl.Height + 2;
           if (x < MaxLen) and ((Ctrl is TRichEdit) or
              ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
 …
   if(FFieldValues <> '') then
     SetFieldValues(FFieldValues);
+  if ScreenReaderSystemActive then
+    ScreenReaderSystem_Stop;
   Result := FPanel;
 end;
 …
   i, idx: integer;
   obj: TObject;
+  max: integer;
 begin
   if(assigned(FPanel)) then
   begin
+    for i := FPanel.ControlCount-1 downto 0 do
+      if(FPanel.Controls[i] is TLabel) then
+    max := FPanel.ControlCount-1;
+    for i := max downto 0 do
+    begin
+// deleting TVA508StaticText can delete several TVA508ChainedLabel components
+      if i < FPanel.ControlCount then
       begin
         obj := FPanel.Controls[i];
+        idx := FControls.IndexOfObject(obj);
+        if idx < 0 then
+          obj.Free;
+      end;
+        if (not (obj is TVA508ChainedLabel)) and
+           ((obj is TLabel) or (obj is TVA508StaticText)) then
+        begin
+          idx := FControls.IndexOfObject(obj);
+          if idx < 0 then
+            obj.Free;
+        end;
+      end;
+    end;
   end;
 end;
 …
     M.Data := Self;
     M.Code := @PanelDestroy;
     TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
+    FPanel.OnDestroy := TNotifyEvent(M);
   end
   else
     TFieldPanel(FPanel).OnDestroy := nil;
+    FPanel.OnDestroy := nil;
 end;
 …
         begin
           Done := FALSE;
+          TORCheckBox(Ctrl).Checked := FALSE;        //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
           if(cnt = 0) then
             cnt := DelimCount(AText, '|') + 1;
 …
 end;
+function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
+var
+  p: integer;
+begin
+  p := pos(code, txt);
+  Result := (p > 0);
+  if Result then
+  begin
+    while p > 0 do
+    begin
+      delete(txt, p, 1);
+      p := pos(code, txt);
+    end;
+  end;
+end;
 procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
 begin
   EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
   DoChange(Sender);
-end;
-{ TFieldPanel }
-destructor TFieldPanel.Destroy;
-begin
-  if(assigned(FOnDestroy)) then
-    FOnDestroy(Self);
-  inherited;
-end;
-{intercept the paint event to draw the focus rect if FFocused is true}
-function TFieldPanel.GetFocus: boolean;
-begin
-  result := Focused;
-end;
-procedure TFieldPanel.Paint;
-var
-  DC: HDC;
-  R: TRect;
-begin
-  inherited;
-  if(Focused) then
-  begin
-    if(not assigned(FCanvas)) then
-      FCanvas := TControlCanvas.Create;
-    DC := GetWindowDC(Handle);
-    try
-      FCanvas.Handle := DC;
-      R := ClientRect;
-      InflateRect(R, -1, -1);
-      FCanvas.DrawFocusRect(R);
-    finally
-      ReleaseDC(Handle, DC);
-    end;
-  end;
-end;
-procedure TFieldPanel.SetTheFocus(const Value: boolean);
-begin
-  if Value then
-    SetFocus;
-end;
-{ TWebLabel }
-procedure TWebLabel.Clicked(Sender: TObject);
-begin
-  GotoWebPage(FAddr);
-end;
-procedure TWebLabel.Init(Addr: string);
-begin
-  FAddr := Addr;
-  OnClick := Clicked;
-  Font.Assign(TORExposedControl(Parent).Font);
-  Font.Color := clActiveCaption;
-  Font.Style := Font.Style + [fsUnderline];
-  AdjustBounds; // make sure we have the right width
-  AutoSize := FALSE;
-  Height := Height + 1; // Courier New doesn't support underline unless it's higher
-  Cursor := crHandPoint;
 end;
 …
 end;
+procedure StripScreenReaderCodes(var Text: string);
+var
+  p, j: integer;
+begin
+  for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do
+  begin
+    p := 1;
+    while (p > 0) do
+    begin
+      p := posex(ScreenReaderCodes[j], Text, p);
+      if p > 0 then
+        delete(Text, p, ScreenReaderCodeLens[j]);
+    end;
+  end;
+end;
+procedure StripScreenReaderCodes(SL: TStrings);
+var
+  temp: string;
+  i: integer;
+begin
+  for i := 0 to SL.Count - 1 do
+  begin
+    temp := SL[i];
+    StripScreenReaderCodes(temp);
+    SL[i] := temp;
+  end;
+end;
+function HasScreenReaderBreakCodes(SL: TStrings): boolean;
+var
+  i: integer;
+begin
+  Result := TRUE;
+  for i := 0 to SL.Count - 1 do
+  begin
+    if pos(ScreenReaderCodeSignature, SL[i]) > 0 then
+      exit;
+  end;
+  Result := FALSE;
+end;
 initialization

cprs/trunk/CPRS-Chart/Templates/uTemplates.pas

-              r456
+              r829
 function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string;  overload;
 function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
+procedure UpdatePersonalObjects;
+procedure SetTemplateDialogCanceled(value: Boolean);
+function WasTemplateDialogCanceled: Boolean;
+procedure SetTemplateBPHasObjects(value: Boolean);
+function TemplateBPHasObjects: Boolean;
 const
 …
   ConsultsTemplate: TTemplate = nil;
   ProceduresTemplate: TTemplate = nil;
+  uPersonalObjects: TStringList = nil;   // -------- CQ #8665 - RV ------------
 implementation
 …
 uses
   Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
+  XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks,
+  fReminderDialog, rODBase;
+  XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks,
+  fReminderDialog, rODBase
+  {$IFDEF VER140}
+  , Word97;
+  {$ELSE}
+  , WordXP, VAUtils;
+  {$ENDIF}
 const
 …
   uDGroupConsults: integer = 0;
   uDGroupProcedures: integer = 0;
+  uTemplateDialogCanceled: Boolean = FALSE;
+  uTemplateBPHasObjects: Boolean = FALSE;
 type
 …
       try
         GetTemplateRoots;
         TmpSL.Assign(RPCBrokerV.Results);
+        FastAssign(RPCBrokerV.Results, TmpSL);
         for i := 0 to TmpSL.Count-1 do
           AddTemplate(TmpSL[i]);
 …
         try
           GetTemplateChildren(tmpl.FID);
           TmpSL.Assign(RPCBrokerV.Results);
+          FastAssign(RPCBrokerV.Results, TmpSL);
           for i := 0 to TmpSL.Count-1 do
             AddTemplate(TmpSL[i], tmpl);
 …
     TempSL := nil;
   end;
+  // -------- CQ #8665 - RV ------------
+  if (assigned(uPersonalObjects)) then
+  begin
+    KillObj(@uPersonalObjects);
+    uPersonalObjects.Free;
+    uPersonalObjects := nil;
+  end;
+  // ------end CQ #8665 ------------
   if(assigned(Deleted)) then
   begin
 …
 begin
   if(assigned(Errors)) then
     ShowMessage(Errors.text)
+    ShowMsg(Errors.text)
   else
     ShowMessage(SingleError);
+    ShowMsg(SingleError);
 end;
 …
         else
           DescSL.Add('5,1=@');
         TempSL.AddStrings(DescSL)
+        FastAddStrings(DescSL, TempSL)
       finally
         DescSL.Free;
 …
               WApp.Connect;
               TmpVar := AFileName;
+              {$IFDEF VER140}
               WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
+              {$ELSE}
+              WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
+              {$ENDIF}
               ffTotal := WDoc.FormFields.Count;
 …
                             if tmp <> '' then
                               AddField(tfDefault, tmp);
                             Fields.AddStrings(PendingAdd);
+                            FastAddStrings(PendingAdd, Fields);
                             PendingAdd.Clear;
                             AddFieldHeader(tmpType, FALSE);
 …
                           begin
                             Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
                             Data.AddStrings(Fields);
+                            FastAddStrings(Fields, Data);
                           end;
                         end;
 …
 begin
+  SetTemplateDialogCanceled(FALSE);
+  SetTemplateBPHasObjects(FALSE);
   Template := GetLinkedTemplate(IntToStr(IEN), LType);
   if assigned(Template) then
 …
       try
         TmpSL.Text := FullBoilerPlate;
+        if Pos('|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE);
       finally
         if(IsDialog) then
 …
         dmodShared.OnTemplateLock(Self)
       else
         ShowMessage(Format(TemplateLockedText, [FPrintName]));
+        ShowMsg(Format(TemplateLockedText, [FPrintName]));
     end;
   end
 …
 end;
+// -------- CQ #8665 - RV ------------
+procedure UpdatePersonalObjects;
+var
+  i: integer;
+begin
+  if not assigned(uPersonalObjects) then
+  begin
+    uPersonalObjects := TStringList.Create;
+    GetAllowedPersonalObjects;
+    for i := 0 to RPCBrokerV.Results.Count-1 do
+      uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1));
+    uPersonalObjects.Sorted := TRUE;
+  end;
+end;
+// -----end CQ #8665 ------------
+procedure SetTemplateDialogCanceled(value: Boolean);
+begin
+  uTemplateDialogCanceled := value;
+end;
+function WasTemplateDialogCanceled: Boolean;
+begin
+  Result := uTemplateDialogCanceled;
+end;
+procedure SetTemplateBPHasObjects(value: Boolean);
+begin
+  uTemplateBPHasObjects := value;
+end;
+function TemplateBPHasObjects: Boolean;
+begin
+  Result := uTemplateBPHasObjects;
+end;
 initialization
 finalization
   ReleaseTemplates;
 end.

cprs/trunk/CPRS-Lib/ORCtrls.pas

-              r456
+              r829
 uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms,
      ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst,
      Accessibility_TLB, Variants;
+     Variants, VAClasses;
 const
 …
 type
+  TORStaticText = class(TStaticText)
+  private
+     FOnEnter: TNotifyEvent;
+     FOnExit: TNotifyEvent;
+  published
+     property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
+     property OnExit: TNotifyEvent read FOnExit write FOnExit;
+     procedure DoEnter; override;
+     procedure DoExit; override;
+  IORBlackColorModeCompatible = interface(IInterface)
+  ['{3554985C-F524-45FA-8C27-4CDD8357DB08}']
+    procedure SetBlackColorMode(Value: boolean);
   end;
 …
   end;
   TORListBox = class(TListBox)
+  TORListBox = class(TListBox, IVADynamicProperty, IORBlackColorModeCompatible)
   private
     FFocusIndex: Integer;                        // item with focus when using navigation keys
 …
     FMItems: TORStrings;                         // Used to save corresponding M strings ("the pieces")
     FCaption: TStaticText;                       // Used to supply a title to IAccessible interface
-    FAccessible: IAccessible;
     FCaseChanged: boolean;                       // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case
     FLookupPiece: integer;                       // If zero, list look-up comes from display string; if non-zero, indicates which piece of the item needs to be used for list lookup
+    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
+    FIsPartOfComboBox: boolean;
+    FBlackColorMode: boolean;
+    FHideSelection: boolean;
     procedure AdjustScrollBar;
     procedure CreateScrollBar;
 …
     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
     function GetIndexFromY(YPos :integer) :integer;
+    property isPartOfComboBox: boolean read FIsPartOfComboBox write FIsPartOfComboBox default False;
     property HideSynonyms: boolean read FHideSynonyms write SetHideSynonyms default FALSE;
     property SynonymChars: string read FSynonymChars write SetSynonymChars;
 …
     property CheckedState[Index: Integer]: TCheckBoxState read GetCheckedState write SetCheckedState;
     property MItems: TStrings read GetMItems write SetMItems;
-    procedure MakeAccessible(Accessible: IAccessible);
     function VerifyUnique(SelectIndex: Integer; iText: String): integer;
+    procedure SetBlackColorMode(Value: boolean);
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
+    property HideSelection: boolean read FHideSelection write FHideSelection;
   published
     property AllowGrayed: boolean read FAllowGrayed write FAllowGrayed default FALSE;
 …
   end;
   TORComboBox = class(TWinControl)
+  TORComboBox = class(TWinControl, IVADynamicProperty, IORBlackColorModeCompatible)
   private
     FItems: TStrings;                            // points to Items in FListBox
 …
     FCharsNeedMatch: integer;                    // how many text need to be matched for auto selection
     FUniqueAutoComplete: Boolean;                // If true only perform autocomplete for unique list items.
+    FBlackColorMode: boolean;
+    FDisableHints: boolean;                      // true if hints have been disabled because drop down window was opened
+    FDropDownStatusChangedCount: integer;        // prevents multiple calls to disabling hint window
+    procedure DropDownStatusChanged(opened: boolean);
+    procedure ClearDropDownStatus;
     function EditControl: TWinControl;
     procedure AdjustSizeOfSelf;
 …
     procedure SetLookupPiece(const Value: integer);
     procedure SetUniqueAutoComplete(const Value: Boolean);
+    procedure LoadComboBoxImage;
   protected
     procedure DropPanelBtnPressed(OKBtn, AutoClose: boolean);
 …
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     function AddReference(const S: string; AReference: Variant): Integer;
     procedure Clear;
 …
     procedure InitLongList(S: string);
     procedure InsertSeparator;
+    procedure Invalidate; override;
     procedure SetTextAutoComplete(TextToMatch : String);
     function GetIEN(AnIndex: Integer): Int64;
 …
     procedure InsertReference(Index: Integer; const S: string; AReference: Variant);
     procedure SelectAll;
+    function MakeAccessible( Accessible: IAccessible): TORListBox;
+    procedure SetBlackColorMode(Value: boolean);
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
     property DisplayText[Index: Integer]: string read GetDisplayText;
     property DroppedDown: Boolean read FDroppedDown write SetDroppedDown;
 …
   TCaptionTreeView = class(TTreeView)
+  TCaptionTreeView = class(TTreeView, IVADynamicProperty)
   private
     procedure SetCaption(const Value: string);
 …
   protected
     FCaptionComponent: TStaticText;
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Align;
 …
     FTag: integer;
     FStringData: string;
-    FAccessible: IAccessible;
     FCaption: string;
-    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
     function GetParent: TORTreeNode;
     procedure SetCaption(const Value: string);
 …
     function GetORTreeView: TORTreeView;
   public
-    procedure MakeAccessible(Accessible: IAccessible);
     procedure SetPiece(PieceNum: Integer; const NewPiece: string);
     procedure EnsureVisible;
-    property Accessible: IAccessible read FAccessible write MakeAccessible;
     property Bold: boolean read GetBold write SetBold;
     property Tag: integer read FTag write FTag;
 …
     FPiece: integer;
     FOnAddition: TTVExpandedEvent;
-    FAccessible: IAccessible;
     FShortNodeCaptions: boolean;
     FOnNodeCaptioning: TNodeCaptioningEvent;
-    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
     procedure SetShortNodeCaptions(const Value: boolean);
   protected
 …
   public
     constructor Create(AOwner: TComponent); override;
-    procedure MakeAccessible(Accessible: IAccessible);
     function FindPieceNode(Value: string;
                            ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload;
 …
   TGrayedStyle = (gsNormal, gsQuestionMark, gsBlueQuestionMark);
   TORCheckBox = class(TCheckBox)
+  TORCheckBox = class(TCheckBox, IORBlackColorModeCompatible)
   private
     FStringData: string;
 …
     FAssociate: TControl;
     FFocusOnBox: boolean;
+    FBlackColorMode: boolean;
     procedure SetFocusOnBox(value: boolean);
     procedure CNMeasureItem    (var Message: TWMMeasureItem);   message CN_MEASUREITEM;
 …
     destructor Destroy; override;
     procedure AutoAdjustSize;
+    procedure SetBlackColorMode(Value: boolean);
     property SingleLine: boolean read FSingleLine;
     property StringData: string read FStringData write FStringData;
 …
   end;
   TCaptionListBox = class(TListBox)
+  TCaptionListBox = class(TListBox, IVADynamicProperty)
   private
     FHoverItemPos: integer;
-    FAccessible: IAccessible;
     FRightClickSelect: boolean;                  // When true, a right click selects teh item
     FHintOnItem: boolean;
     procedure SetCaption(const Value: string);
     function GetCaption: string;
-    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
+    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
+    procedure MoveFocusDown;
+    procedure MoveFocusUp;
   protected
     FCaptionComponent: TStaticText;
     procedure DoEnter; override;
   public
+    procedure MakeAccessible( Accessible: IAccessible);
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE;
 …
   end;
   TCaptionCheckListBox = class(TCheckListBox)
+  TCaptionCheckListBox = class(TCheckListBox, IVADynamicProperty)
   private
     procedure SetCaption(const Value: string);
 …
   protected
     FCaptionComponent: TStaticText;
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Caption: string read GetCaption write SetCaption;
   end;
   TCaptionMemo = class(TMemo)
+  TCaptionMemo = class(TMemo, IVADynamicProperty)
   private
     procedure SetCaption(const Value: string);
 …
   protected
     FCaptionComponent: TStaticText;
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Caption: string read GetCaption write SetCaption;
   end;
   TCaptionEdit = class(TEdit)
+  TCaptionEdit = class(TEdit, IVADynamicProperty)
   private
     procedure SetCaption(const Value: string);
 …
   protected
     FCaptionComponent: TStaticText;
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Align;
 …
   end;
   TCaptionRichEdit = class(TRichEdit)
+  TCaptionRichEdit = class(TRichEdit, IVADynamicProperty)
   private
-    FAccessible: IAccessible;
-    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
   protected
     FCaption: string;
   public
+    procedure MakeAccessible(Accessible: IAccessible);
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Align;
 …
   end;
   TCaptionComboBox = class(TComboBox)
+  TCaptionComboBox = class(TComboBox, IVADynamicProperty)
   private
     procedure SetCaption(const Value: string);
 …
   protected
     FCaptionComponent: TStaticText;
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Caption: string read GetCaption write SetCaption;
   end;
+  TCaptionListView = class(TListView)
+  TCaptionListView = class(TListView, IVADynamicProperty)
+  public
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Caption;
   end;
   TCaptionStringGrid = class(TStringGrid)
+  TCaptionStringGrid = class(TStringGrid, IVADynamicProperty)
   private
     FJustToTab: boolean;
     FCaption: string;
-    FAccessible: IAccessible;
-    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
   protected
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
   public
-    procedure MakeAccessible( Accessible: IAccessible);
     procedure IndexToColRow( index: integer; var Col: integer; var Row: integer);
     function ColRowToIndex( Col: integer; Row: Integer): integer;
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
   published
     property Caption: string read FCaption write FCaption;
 …
 uses
   uAccessAPI;
+  VAUtils;
 const
 …
     'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED');
+var
+  ORCBImages: array[TORCBImgIdx] of TBitMap;
+function GetORCBBitmap(Idx: TORCBImgIdx): TBitmap;
+begin
+  if(not assigned(ORCBImages[Idx])) then
+  begin
+    ORCBImages[Idx] := TBitMap.Create;
+    ORCBImages[Idx].LoadFromResourceName(HInstance, CheckBoxImageResNames[Idx]);
+  end;
+  Result := ORCBImages[Idx];
+   BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
+    'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
+    'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK',
+    'BLACK_ORCB_DISABLED_UNCHECKED', 'BLACK_ORCB_DISABLED_CHECKED',
+    'BLACK_ORCB_DISABLED_GRAYED', 'BLACK_ORCB_DISABLED_QUESTIONMARK',
+    'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
+    'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED',
+    'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED');
+var
+  ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap;
+function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap;
+var
+  ResName: string;
+begin
+  if(not assigned(ORCBImages[Idx, BlackMode])) then
+  begin
+    ORCBImages[Idx, BlackMode] := TBitMap.Create;
+    if BlackMode then
+      ResName := BlackCheckBoxImageResNames[Idx]
+    else
+      ResName := CheckBoxImageResNames[Idx];
+    ORCBImages[Idx, BlackMode].LoadFromResourceName(HInstance, ResName);
+  end;
+  Result := ORCBImages[Idx, BlackMode];
 end;
 …
 var
   i: TORCBImgIdx;
+  mode: boolean;
 begin
   for i := low(TORCBImgIdx) to high(TORCBImgIdx) do
   begin
+    if(assigned(ORCBImages[i])) then
+      ORCBImages[i].Free;
+  end;
+end;
+{ TORStaticText }
+procedure TORStaticText.DoEnter;
+begin
+  inherited DoEnter;
+  if Assigned(FOnEnter) then
+     FOnEnter(Self);
+end;
+procedure TORStaticText.DoExit;
+begin
+  inherited DoExit;
+  if Assigned(FOnExit) then
+     FOnExit(Self);
+    for Mode := false to true do
+    begin
+      if(assigned(ORCBImages[i, Mode])) then
+        ORCBImages[i, Mode].Free;
+    end;
+  end;
 end;
 …
   FCaseChanged := TRUE;
   FLookupPiece := 0;
+  FIsPartOfComboBox := False;
 end;
 …
     SetString(Result, Buf, Len);
   end;
+end;
+function TORListBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
 end;
 …
   case Message.CharCode of
     VK_LBUTTON, VK_RETURN, VK_SPACE:
+    if FocusIndex > -1 then
+    begin
+      if MultiSelect then
+    begin
+      if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance
+        SetFocusIndex(0);
+      if FocusIndex > -1 then
       begin
+        IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0));
+        Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex);
+      end
+      else Perform(LB_SETCURSEL, FocusIndex, 0);
+      // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL
+      // and LBN_SELCHANGE is what eventually triggers the Click event.
+      // The LBN_SELCHANGE documentation implies we should send the control id, which is
+      // 32 bits long, in the high word of WPARAM (16 bits).  Since that won't work - we'll
+      // try sending the item index instead.
+      //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't
+      //Allow the Checkbox state on the control to be updated
+      if CheckBoxes then
+        PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle))
+      else
+        SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle));
+        if MultiSelect then
+        begin
+          IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0));
+          Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex);
+        end
+        else Perform(LB_SETCURSEL, FocusIndex, 0);
+        // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL
+        // and LBN_SELCHANGE is what eventually triggers the Click event.
+        // The LBN_SELCHANGE documentation implies we should send the control id, which is
+        // 32 bits long, in the high word of WPARAM (16 bits).  Since that won't work - we'll
+        // try sending the item index instead.
+        //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't
+        //Allow the Checkbox state on the control to be updated
+        if CheckBoxes then
+          PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle))
+        else
+          SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle));
+      end;
     end;
     VK_PRIOR:          SetFocusIndex(FocusIndex - FLargeChange);
 …
   begin
     FLastItemIndex := ItemIndex;
+    if (not isPartOfComboBox) and (ItemIndex <> -1) then
+      SetFocusIndex(ItemIndex);
     if Assigned(FOnChange) then FOnChange(Self);
   end;
 …
 {  if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then
     SetFocusIndex(TopIndex);//ItemIndex := TopIndex; }
+  if FHideSelection and (ItemIndex < 0) and (FFocusIndex >= 0) then
+    ItemIndex := FFocusIndex;
   inherited DoEnter;
 end;
 procedure TORListBox.DoExit;
+var
+  SaveIndex: integer;
 { make sure item tip is hidden for this listbox when focus shifts to something else }
 begin
+  if FHideSelection then
+  begin
+    SaveIndex := ItemIndex;
+    ItemIndex := -1;
+    FFocusIndex := SaveIndex;
+  end;
   uItemTip.Hide;
   FItemTipActive := False;
 …
 procedure TORListBox.KeyPress(var Key: Char);
 begin
+  {inherited KeyPress is changing the ' ' into #0, had to move conditional before inherited.}
+  if (Key = ' ') then begin
+    ToggleCheckBox(ItemIndex);
+    {The space bar causes the focus to jump to an item in the list that starts with
+     a space. Disable that function.}
+    Key := #0;
+  end;
   inherited;
-  if (Key = ' ') then ToggleCheckBox(ItemIndex);
 end;
 …
               begin
                 if(FFlatCheckBoxes) then
                   BMap := GetORCBBitmap(iiFlatUnChecked)
+                  BMap := GetORCBBitmap(iiFlatUnChecked, FBlackColorMode)
                 else
                   BMap := GetORCBBitmap(iiUnchecked);
+                  BMap := GetORCBBitmap(iiUnchecked, FBlackColorMode);
               end;
             cbChecked:
               begin
                 if(FFlatCheckBoxes) then
                   BMap := GetORCBBitmap(iiFlatChecked)
+                  BMap := GetORCBBitmap(iiFlatChecked, FBlackColorMode)
                 else
                   BMap := GetORCBBitmap(iiChecked);
+                  BMap := GetORCBBitmap(iiChecked, FBlackColorMode);
               end;
             else // cbGrayed:
               begin
                 if(FFlatCheckBoxes) then
                   BMap := GetORCBBitmap(iiFlatGrayed)
+                  BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
                 else
                   BMap := GetORCBBitmap(iiGrayed);
+                  BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
               end;
           end;
 …
         begin
           if(FFlatCheckBoxes) then
             BMap := GetORCBBitmap(iiFlatGrayed)
+            BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
           else
             BMap := GetORCBBitmap(iiGrayed);
+            BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
         end;
         TmpR := Rect;
 …
     end;
   end;                                              // -- special long list processing - end
+  if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;
   if (Value = SFI_TOP) or (Value < 0) then Value := 0;
-  if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;
   FFocusIndex := Value;
+  ItemIndex := Value;
+  if Focused or (not FHideSelection) then
+    ItemIndex := Value;
   if MultiSelect then Perform(LB_SETCARETINDEX, FFocusIndex, 0) // LPARAM=0, scrolls into view
   else
 …
 end;
+function TORListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 procedure TORListBox.SetHideSynonyms(Value :boolean);
 var
 …
   Strings: TStringList;
   i, Pos: Integer;
   ItemRec: PItemRec;
+  ItemRec, ItemRec2: PItemRec;
   SaveListMode: Boolean;
   RealVerify: Boolean;
 …
       begin
         Pos := Items.AddObject(Strings[i], ItemRec^.UserObject);
+        References[Pos] := ItemRec^.Reference;
+        // CQ 11491 - Changing TabPositions, etc. was wiping out check box status.
+        FFromSelf := True;
+        ItemRec2 := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Pos, 0));
+        FFromSelf := False;
+        if(assigned(ItemRec2)) then
+        begin
+          ItemRec2^.Reference := ItemRec^.Reference;
+          ItemRec2^.CheckedState := ItemRec^.CheckedState;
+        end;
       end;
     end;
 …
 end;
+procedure TORListBox.SetBlackColorMode(Value: boolean);
+begin
+  FBlackColorMode := Value;
+end;
 procedure TORListBox.SetCaption(const Value: string);
 begin
 …
 end;
+procedure TORListBox.MakeAccessible(Accessible: IAccessible);
+begin
+  if Assigned(FAccessible) and Assigned(Accessible) then
+    raise Exception.Create(Caption + ' List Box is already Accessible!')
+  else
+    FAccessible := Accessible;
+end;
+procedure TORListBox.WMGetObject(var Message: TMessage);
+begin
+  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
+    Message.Result := GetLResult(Message.wParam, FAccessible)
+  else
+    inherited;
+// In Delphi 2006, hint windows will cause the TORComboBox drop down list to
+// move behind a Stay on Top form.  Hints are also problematic with item tips in
+// the drop down list, so we disable them when ever a drop down list is open,
+// on all forms, not just stay on top forms.
+var
+  uDropPanelOpenCount: integer = 0;
+  uOldShowHintsSetting: boolean;
+procedure DropDownPanelOpened;
+begin
+  if uDropPanelOpenCount=0 then
+    uOldShowHintsSetting := Application.ShowHint;
+  Application.ShowHint := FALSE;
+  inc(uDropPanelOpenCount);
+end;
+procedure DropDownPanelClosed;
+begin
+  dec(uDropPanelOpenCount);
+  if uDropPanelOpenCount<=0 then
+  begin
+    uDropPanelOpenCount := 0;
+    if not Application.ShowHint then
+      Application.ShowHint := uOldShowHintsSetting
+  end;
 end;
 …
 const
   ComboBoxImages: array[boolean] of string = ('BMP_CBODOWN_DISABLED', 'BMP_CBODOWN');
+  BlackComboBoxImages: array[boolean] of string = ('BLACK_BMP_CBODOWN_DISABLED', 'BLACK_BMP_CBODOWN');
 procedure TORComboEdit.CreateParams(var Params: TCreateParams);
 { sets a one line edit box to multiline style so the editing rectangle can be changed }
 …
   FCheckBoxEditColor := clBtnFace;
   FListBox := TORListBox.Create(Self);
+  FListBox.isPartOfComboBox := True;
   FListBox.Parent := Self;
   FListBox.TabStop := False;
 …
 end;
+procedure TORComboBox.DropDownStatusChanged(opened: boolean);
+begin
+  if opened then
+  begin
+    if not FDropPanel.Visible then
+    begin
+      if FDropDownStatusChangedCount = 0 then
+      begin
+        FDisableHints := TRUE;
+        DropDownPanelOpened;
+      end;
+      inc(FDropDownStatusChangedCount);
+    end;
+  end
+  else
+  begin
+    dec(FDropDownStatusChangedCount);
+    if FDropDownStatusChangedCount <= 0 then
+    begin
+      if FDisableHints then
+      begin
+        DropDownPanelClosed;
+        FDisableHints := FALSE;
+      end;
+      FDropDownStatusChangedCount := 0;
+    end;
+  end;
+end;
+procedure TORComboBox.ClearDropDownStatus;
+begin
+  FDropDownStatusChangedCount := 1;
+  DropDownStatusChanged(FALSE);
+end;
+destructor TORComboBox.Destroy;
+begin
+  ClearDropDownStatus;
+  inherited;
+end;
 procedure TORComboBox.DoEnter;
 {var
 …
   end;
   inherited DoExit;
+end;
+procedure TORComboBox.LoadComboBoxImage;
+var
+  imageName: string;
+begin
+  if assigned(FDropBtn) then
+  begin
+    if FBlackColorMode then
+      imageName := BlackComboBoxImages[inherited Enabled]
+    else
+      imageName := ComboBoxImages[inherited Enabled];
+    FDropBtn.Glyph.LoadFromResourceName(hInstance, imageName);
+  end;
 end;
 …
 procedure TORComboBox.FwdKeyPress(Sender: TObject; var Key: Char);
+var
+  KeyCode: integer;
 { prevents return from being used by editbox (otherwise sends a newline & text vanishes) }
 begin
+  // may want to make the tab beep if tab key (#9) - can't tab until list raised
+  if (Key in [#9, #13]) or (FListBox.FCheckBoxes and (Key = #32)) then
+  begin
+  KeyCode := ord(Key);
+  if (KeyCode = VK_RETURN) and (Style = orcsDropDown) and DroppedDown then
+  begin
+    DroppedDown := FALSE;
     Key := #0;
+    Exit;
+  end;
+  if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
+  end
+  else
+  begin
+    // may want to make the tab beep if tab key (#9) - can't tab until list raised
+    if (KeyCode = VK_RETURN) or (KeyCode = VK_TAB) or (FListBox.FCheckBoxes and (KeyCode = VK_SPACE)) then
+    begin
+      Key := #0;
+      Exit;
+    end;
+    if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
+  end;
 end;
 …
       FCheckedState := FListBox.GetCheckedString;
     end;
+    DropDownStatusChanged(TRUE);
     FDropPanel.Visible := True;
     FDropPanel.BringToFront;
 …
     uItemTip.Hide;
     FDropPanel.Hide;
+    DropDownStatusChanged(FALSE);
     if(FListBox.FCheckBoxes) and (assigned(FOnChange)) and
       (FCheckedState <> FListBox.GetCheckedString) then
 …
     begin
       if FDropBtn <> nil then FDropBtn.Free;
+      if FDropPanel <> nil then FDropPanel.Free;
+      if FDropPanel <> nil then
+      begin
+        ClearDropDownStatus;
+        FDropPanel.Free;
+      end;
       FDropBtn := nil;
       FDropPanel := nil;
 …
       if(assigned(FEditPanel) and (csDesigning in ComponentState)) then
         FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls];
+      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]);
+      LoadComboBoxImage;
+//      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]);
       FDropBtn.OnMouseDown := DropButtonDown;
       FDropBtn.OnMouseUp := DropButtonUp;
 …
         FListBox.FParentCombo := Self;
         FListBox.Parent := FDropPanel;
+        ClearDropDownStatus;
         if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel;  // if long
       end else
 …
 end;
+function TORComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 // Since TORComboBox is composed of several controls (FEditBox, FListBox, FDropBtn), the
 // following functions and procedures map public and published properties to their related
 …
 end;
+procedure TORComboBox.Invalidate;
+begin
+  inherited;
+  FEditBox.Invalidate;
+  FListBox.Invalidate;
+  if assigned(FEditPanel) then
+    FEditPanel.Invalidate;
+  if assigned(FDropBtn) then
+    FDropBtn.Invalidate;
+  if assigned(FDropPanel) then
+    FDropPanel.Invalidate;
+end;
 function TORComboBox.GetAutoSelect: Boolean;
 begin
 …
 end;
+function TORComboBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
+end;
 function TORComboBox.GetItemHeight: Integer;
 begin
 …
 begin
   FEditBox.AutoSelect := Value;
+end;
+procedure TORComboBox.SetBlackColorMode(Value: boolean);
+begin
+  if FBlackColorMode <> Value then
+  begin
+    FBlackColorMode := Value;
+    FListBox.SetBlackColorMode(Value);
+    LoadComboBoxImage;
+  end;
 end;
 …
   if (inherited GetEnabled <> Value) then
   begin
+    DroppedDown := FALSE;
     inherited SetEnabled(Value);
     if assigned(FDropBtn) then
+      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]);
+      LoadComboBoxImage;
+//      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]);
   end;
 end;
 …
 begin
   result := FListBox.Caption;
-end;
-function TORComboBox.MakeAccessible(Accessible: IAccessible): TORListBox;
-begin
-  FListBox.MakeAccessible(Accessible);
-  result := FListBox;
 end;
 …
         ORCtrls.SetPiece(FStringData, FDelim, FPiece, Value);
     end;
-end;
-procedure TORTreeNode.MakeAccessible(Accessible: IAccessible);
-begin
-  if Assigned(FAccessible) and Assigned(Accessible) then
-    raise Exception.Create(Text + ' Tree Node is already Accessible!')
-  else
-  begin
-    FAccessible := Accessible;
-  end;
-end;
-procedure TORTreeNode.WMGetObject(var Message: TMessage);
-begin
-  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
-    Message.Result := GetLResult(Message.wParam, FAccessible)
-  else
-    inherited;
 end;
 …
   else
     Result := '';
-end;
-procedure TORTreeView.MakeAccessible(Accessible: IAccessible);
-begin
-  if Assigned(FAccessible) and Assigned(Accessible) then
-    raise Exception.Create(Text + ' Tree View is already Accessible!')
-  else
-  begin
-    FAccessible := Accessible;
-  end;
-end;
-procedure TORTreeView.WMGetObject(var Message: TMessage);
-begin
-  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
-    Message.Result := GetLResult(Message.wParam, FAccessible)
-  else
-    inherited;
 end;
 …
               end;
             end;
             Bitmap := GetORCBBitmap(ImgIdx);
+            Bitmap := GetORCBBitmap(ImgIdx, FBlackColorMode);
           end
           else
 …
             R.Top:= FocusRect.Top
           else
+          begin
             R.Top:= ((ClientHeight - Bitmap.Height + 1) div 2) - 1;
+            if R.Top < 0 then R.Top := 0
+          end;
           Draw(R.Left, R.Top, Bitmap);
         end;
 …
 end;
+procedure TORCheckBox.SetBlackColorMode(Value: boolean);
+begin
+  if FBlackColorMode <> Value then
+  begin
+    FBlackColorMode := Value;
+    Invalidate;
+  end;
+end;
 procedure TORCheckBox.AutoAdjustSize;
 var
 …
     if DoCtrl then
       Ctrl.Enabled := Checked;
+    if(Ctrl is TWinControl) then
+    // added (csAcceptsControls in Ctrl.ControlStyle) below to prevent disabling of
+    // child sub controls, like the TBitBtn in the TORComboBox.  If the combo box is
+    // already disabled, we don't want to disable the button as well - when we do, we
+    // lose the disabled glyph that is stored on that button for the combo box.
+    if(Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then
     begin
       for i := 0 to TWinControl(Ctrl).ControlCount-1 do
 …
 end;
 procedure TCaptionListBox.MakeAccessible(Accessible: IAccessible);
 begin
   if Assigned(FAccessible) and Assigned(Accessible) then
     raise Exception.Create(Caption + ' List Box is already Accessible!')
+function TCaptionListBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
   else
+    FAccessible := Accessible;
+    Result := '';
+end;
+procedure TCaptionListBox.MoveFocusUp;
+begin
+  if ItemIndex > 0 then
+    Perform(LB_SETCARETINDEX, ItemIndex - 1, 0);
+end;
+procedure TCaptionListBox.MoveFocusDown;
+begin
+  if ItemIndex < (Items.Count-1) then
+    Perform(LB_SETCARETINDEX, ItemIndex + 1, 0);
 end;
 …
 end;
+procedure TCaptionListBox.WMGetObject(var Message: TMessage);
+begin
+  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
+    Message.Result := GetLResult(Message.wParam, FAccessible)
+  else
+    inherited;
+function TCaptionListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
+procedure TCaptionListBox.WMKeyDown(var Message: TWMKeyDown);
+var
+  IsSelected: LongBool;
+begin
+  if Boolean(Hi(GetKeyState(VK_CONTROL))) and MultiSelect then
+    case Message.CharCode of
+      VK_SPACE:
+        begin
+          IsSelected := LongBool(Perform(LB_GETSEL, ItemIndex, 0));
+          Perform(LB_SETSEL, Longint(not IsSelected), ItemIndex);
+        end;
+      VK_LEFT, VK_UP: MoveFocusUp;
+      VK_RIGHT, VK_DOWN: MoveFocusDown;
+      else inherited;
+    end
+  else inherited;
 end;
 …
 end;
+function TCaptionCheckListBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
+end;
 procedure TCaptionCheckListBox.SetCaption(const Value: string);
 begin
 …
 end;
+function TCaptionCheckListBox.SupportsDynamicProperty(
+  PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 { TCaptionMemo }
 …
   else
     result := FCaptionComponent.Caption;
+end;
+function TCaptionMemo.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
 end;
 …
 end;
+function TCaptionMemo.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 { TCaptionEdit }
 …
   else
     result := FCaptionComponent.Caption;
+end;
+function TCaptionEdit.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
 end;
 …
 end;
+function TCaptionEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 { TCaptionRichEdit }
 procedure TCaptionRichEdit.MakeAccessible(Accessible: IAccessible);
 begin
   if Assigned(FAccessible) and Assigned(Accessible) then
     raise Exception.Create(Caption + ' Rich Edit is already Accessible!')
+function TCaptionRichEdit.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := FCaption
   else
+    FAccessible := Accessible;
+end;
+procedure TCaptionRichEdit.WMGetObject(var Message: TMessage);
+begin
+  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
+    Message.Result := GetLResult(Message.wParam, FAccessible)
+    Result := '';
+end;
+function TCaptionRichEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
+{ TCaptionTreeView}
+function TCaptionTreeView.GetCaption: string;
+begin
+    result := inherited Caption;
+end;
+function TCaptionTreeView.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
   else
+    inherited;
+end;
+{ TCaptionTreeView}
+function TCaptionTreeView.GetCaption: string;
+begin
+    result := inherited Caption;
+    Result := '';
 end;
 …
 end;
+function TCaptionTreeView.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 { TCaptionComboBox }
 …
   else
     result := FCaptionComponent.Caption;
+end;
+function TCaptionComboBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
 end;
 …
 end;
+function TCaptionComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 { TORAlignSpeedButton }
 …
   result := (ColCount - FixedCols) * (Row - FixedRows) +
       (Col - FixedCols) + 1;
+end;
+function TCaptionStringGrid.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := FCaption
+  else
+    Result := '';
 end;
 …
 end;
+procedure TCaptionStringGrid.MakeAccessible(Accessible: IAccessible);
+begin
+  if Assigned(FAccessible) and Assigned(Accessible) then
+    raise Exception.Create(Caption + 'String Grid is already Accessible!')
+  else
+    FAccessible := Accessible;
+end;
+procedure TCaptionStringGrid.WMGetObject(var Message: TMessage);
+begin
+  if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
+    Message.Result := GetLResult(Message.wParam, FAccessible)
+  else
+    inherited;
+function TCaptionStringGrid.SupportsDynamicProperty(
+  PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
 end;
 …
     if LongList then
     begin
+      //Currently Do nothing for LongLists
+     { if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then
+        Result := -1;}
+      //Implemented for CQ: 10092, PSI-04-057
+      //asume long lists are alphabetically ordered...
+      if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then
+        Result := -1;
     end
     else //Not a LongList
 …
 end;
+{ TCaptionListView }
+function TCaptionListView.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := Caption
+  else
+    Result := '';
+end;
+function TCaptionListView.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 initialization
   //uItemTip := TItemTip.Create(Application);  // all listboxes share a single ItemTip window

cprs/trunk/CPRS-Lib/ORCtrlsDsgn.pas

r456	r829
153	153	begin
154	154	RegisterComponents('CPRS',
155		[TOR~~StaticText, TOR~~ListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit,
	155	[TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit,
156	156	TORAlignButton, TORAlignSpeedButton, TORTreeView, TORCheckBox, TORListView,
157	157	TKeyClickPanel, TKeyClickRadioGroup, TCaptionListBox, TCaptionCheckListBox,

cprs/trunk/CPRS-Lib/ORDtTm.dfm

-              r456
+              r829
 object ORfrmDtTm: TORfrmDtTm
   Left = 550
   Top = 474
+  Left = 586
+  Top = 483
   BorderIcons = []
   BorderStyle = bsDialog

cprs/trunk/CPRS-Lib/ORDtTm.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
+  Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, ORCtrls;
+  Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, OR2006Compatibility,
+  ORCtrls, VAClasses;
 type
   TORfrmDtTm = class(TForm)
+  TORfrmDtTm = class(Tfrm2006Compatibility)
     bvlFrame: TBevel;
     lblDate: TPanel;
 …
     FNowPressed:  Boolean;
     TimeIsRequired: Boolean;
+  protected
+    procedure Loaded; override;
   end;
 …
   end;
+  // 508 class
+  TORDateButton = class (TBitBtn);
   { TORDateBox }
 …
   end;
   TORDateBox = class(TORDateEdit)
+  TORDateBox = class(TORDateEdit, IVADynamicProperty, IORBlackColorModeCompatible)
   private
     FFMDateTime: TFMDateTime;
     FDateOnly: Boolean;
     FRequireTime: Boolean;
     FButton: TBitBtn;
+    FButton: TORDateButton;
     FFormat: string;
     FTimeIsNow: Boolean;
     FTemplateField: boolean;
     FCaption: TStaticText;
+    FBlackColorMode: boolean;
     procedure ButtonClick(Sender: TObject);
     function GetFMDateTime: TFMDateTime;
 …
     procedure SetCaption(const Value: string);
     function  GetCaption(): string;
   protected
     procedure Change; override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    property DateButton: TORDateButton read FButton;
   public
     constructor Create(AOwner: TComponent); override;
     function IsValid: Boolean;
     procedure Validate(var ErrMsg: string);
+    procedure SetBlackColorMode(Value: boolean);
+    function SupportsDynamicProperty(PropertyID: integer): boolean;
+    function GetDynamicProperty(PropertyID: integer): string;
     property Format: string read FFormat write FFormat;
     property RelativeTime: string     read GetRelativeTime;
 …
   end;
+  TORDateCombo = class(TCustomPanel)
+  // 508 classes
+  TORDayCombo = class (TORComboBox);
+  TORMonthCombo = class (TORComboBox);
+  TORYearEdit = class(TMaskEdit)
+  private
+    FTemplateField: boolean;
+    procedure SetTemplateField(const Value: boolean);
+  protected
+    property TemplateField: boolean read FTemplateField write SetTemplateField;
+  end;
+  TORYearEditClass = Class of TORYearEdit;
+  TORDateCombo = class(TCustomPanel, IORBlackColorModeCompatible)
   private
     FYearChanging: boolean;
     FMonthCombo: TORComboBox;
     FDayCombo: TORComboBox;
     FYearEdit: TMaskEdit;
+    FMonthCombo: TORMonthCombo;
+    FDayCombo: TORDayCombo;
+    FYearEdit: TORYearEdit;
     FYearUD: TUpDown;
     FCalBtn: TSpeedButton;
+    FCalBtn: TORDateButton;
     FIncludeMonth: boolean;
     FIncludeDay: boolean;
 …
     FRebuilding: boolean;
     FTemplateField: boolean;
+    FBlackColorMode: boolean;
+    FORYearEditClass: TORYearEditClass;
     procedure SetIncludeBtn(const Value: boolean);
     procedure SetIncludeDay(Value: boolean);
 …
     procedure SetTemplateField(const Value: boolean);
   protected
     procedure Rebuild;
+    procedure Rebuild; virtual;
     function InitDays(GetSize: boolean): integer;
     function InitMonths(GetSize: boolean): integer;
 …
     procedure Paint; override;
     procedure Resized(Sender: TObject);
+    property MonthCombo: TORMonthCombo read FMonthCombo;
+    property DayCombo: TORDayCombo read FDayCombo;
+    property YearEdit: TORYearEdit read FYearEdit;
+    property YearUD: TUpDown read FYearUD;
+    property CalBtn: TORDateButton read FCalBtn;
+    property ORYearEditClass: TORYearEditClass read FORYearEditClass write FORYearEditClass;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function DateText: string;
+    procedure SetBlackColorMode(Value: boolean);
     property TemplateField: boolean read FTemplateField write SetTemplateField;
     property FMDate: TFMDateTime read GetFMDate write SetFMDate;
 …
 end;
+procedure LoadEllipsis(bitmap: TBitMap; BlackColorMode: boolean);
+var
+  ResName: string;
+begin
+  if BlackColorMode then
+    ResName := 'BLACK_BMP_ELLIPSIS'
+  else
+    ResName := 'BMP_ELLIPSIS';
+  bitmap.LoadFromResourceName(hInstance, ResName);
+end;
 { TfrmORDtTm -------------------------------------------------------------------------------- }
 …
 procedure TORfrmDtTm.lstHourClick(Sender: TObject);
 begin
+  if lstHour.ItemIndex = 0 then lstMinute.Items[0] := ':01  --' else lstMinute.Items[0] := ':00  --'; //<------ NEW CODE
   if lstMinute.ItemIndex < 0 then lstMinute.ItemIndex := 0;
   lstMinuteClick(Self);
 …
   AMinute := lstMinute.ItemIndex * 5;
+  if (AnHour = 0) and (AMinute = 0) then AMinute := 1;  //<-------------- NEW CODE
   FFromSelf := True;
   // if ampm time -
 …
   begin
     x := Trim(txtTime.Text);
+    if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
+    //if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
+    if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:01';  //<------- CHANGED CODE
     StrToTime(x);
     txtTime.Text := x;
 …
 begin
   ModalResult := mrCancel;
+end;
+procedure TORfrmDtTm.Loaded;
+begin
+  inherited Loaded;
+  UpdateColorsFor508Compliance(Self);
 end;
 …
 begin
   inherited Create(AOwner);
   FButton := TBitBtn.Create(Self);
+  FButton := TORDateButton.Create(Self);
   FButton.Parent := Self;
   FButton.Width := 18;
 …
   FButton.OnClick := ButtonClick;
   FButton.TabStop := False;
+  FButton.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS');
+  FBlackColorMode := False;
+  LoadEllipsis(FButton.Glyph, FALSE);
   FButton.Visible := True;
   FFormat := FMT_DATETIME;
 …
 end;
+function TORDateBox.SupportsDynamicProperty(PropertyID: integer): boolean;
+begin
+  Result := (PropertyID = DynaPropAccesibilityCaption);
+end;
 procedure TORDateBox.ButtonClick(Sender: TObject);
 var
 …
   if Length(x) = 0 then Result := True else Result := False;
   if Length(Text) = 0 then Result := False;
+end;
+procedure TORDateBox.SetBlackColorMode(Value: boolean);
+begin
+  if FBlackColorMode <> Value then
+  begin
+    FBlackColorMode := Value;
+    LoadEllipsis(FButton.Glyph, FBlackColorMode);
+  end;
 end;
 …
 end;
+function TORDateBox.GetDynamicProperty(PropertyID: integer): string;
+begin
+  if PropertyID = DynaPropAccesibilityCaption then
+    Result := GetCaption
+  else
+    Result := '';
+end;
 function IsLeapYear(AYear: Integer): Boolean;
 begin
 …
   LastYear = 2200;
-type
-  TORDateComboEdit = class(TMaskEdit)
-  private
-    FTemplateField: boolean;
-    procedure SetTemplateField(const Value: boolean);
-  protected
-    property TemplateField: boolean read FTemplateField write SetTemplateField;
-  end;
 { TORDateComboEdit }
 procedure TORDateComboEdit.SetTemplateField(const Value: boolean);
+procedure TORYearEdit.SetTemplateField(const Value: boolean);
 begin
   if(FTemplateField <> Value) then
 …
   FIncludeBtn := TRUE;
   OnResize := Resized;
+  FORYearEditClass := TORYearEdit;
 end;
 …
           if(not assigned(FMonthCombo)) then
           begin
             FMonthCombo := TORComboBox.Create(Self);
+            FMonthCombo := TORMonthCombo.Create(Self);
             FMonthCombo.Parent := Self;
             FMonthCombo.Top := 0;
 …
             FMonthCombo.Style := orcsDropDown;
             FMonthCombo.DropDownCount := 13;
+            FMonthCombo.ListItemsOnly := True;
             FMonthCombo.OnChange := MonthChanged;
           end;
 …
             if(not assigned(FDayCombo)) then
             begin
               FDayCombo := TORComboBox.Create(Self);
+              FDayCombo := TORDayCombo.Create(Self);
               FDayCombo.Parent := Self;
               FDayCombo.Top := 0;
               FDayCombo.Style := orcsDropDown;
+              FDayCombo.ListItemsOnly := True;
               FDayCombo.OnChange := DayChanged;
               FDayCombo.DropDownCount := 11;
 …
         if(not assigned(FYearEdit)) then
         begin
           FYearEdit := TORDateComboEdit.Create(Self);
+          FYearEdit := FORYearEditClass.Create(Self);
           FYearEdit.Parent := Self;
           FYearEdit.Top := 0;
 …
         end;
         FYearEdit.Font := Font;
         TORDateComboEdit(FYearEdit).TemplateField := FTemplateField;
+        FYearEdit.TemplateField := FTemplateField;
         Wide := GetYearSize;
         FYearEdit.Width := Wide;
 …
           if(not assigned(FCalBtn)) then
           begin
+            FCalBtn := TSpeedButton.Create(Self);
+            FCalBtn := TORDateButton.Create(Self);
+            FCalBtn.TabStop := FALSE;
             FCalBtn.Parent := Self;
             FCalBtn.Top := 0;
             FCalBtn.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS');
+            LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
             FCalBtn.OnClick := BtnClicked;
           end;
 …
       FRebuilding := FALSE;
     end;
+  end;
+end;
+procedure TORDateCombo.SetBlackColorMode(Value: boolean);
+begin
+  if FBlackColorMode <> Value then
+  begin
+    FBlackColorMode := Value;
+    if assigned(FCalBtn) then
+      LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
   end;
 end;

cprs/trunk/CPRS-Lib/ORDtTmRng.dfm

-              r456
+              r829
     Left = 8
     Top = 44
     Width = 53
+    Width = 52
     Height = 13
     Caption = 'Begin Date'
 …
     Left = 145
     Top = 44
     Width = 45
+    Width = 44
     Height = 13
     Caption = 'End Date'

cprs/trunk/CPRS-Lib/ORDtTmRng.pas

-              r456
+              r829
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ORFn, ORDtTm;
+  StdCtrls, ORFn, OR2006Compatibility, ORDtTm;
 type
   TORfrmDateRange = class(TForm)
+  TORfrmDateRange = class(Tfrm2006Compatibility)
     lblStart: TLabel;
     lblStop: TLabel;
 …
     FCalStart: TORDateBox;
     FCalStop:  TORDateBox;
+  protected
+    procedure Loaded; override;
   end;
 …
   FCalStop.TabOrder := 1;
   ResizeAnchoredFormToFont(self);
+  UpdateColorsFor508Compliance(self);
 end;
 …
 end;
+procedure TORfrmDateRange.Loaded;
+begin
+  inherited Loaded;
+  UpdateColorsFor508Compliance(Self);
+end;
 end.

cprs/trunk/CPRS-Lib/ORFn.pas

-              r456
+              r829
 uses SysUtils, Windows, Messages, Classes, Controls, StdCtrls, ExtCtrls, ComCtrls, Forms,
      Graphics, Menus, RichEdit;
+     Graphics, Menus, RichEdit, Buttons;
 const
 …
   BOOLCHAR: array[Boolean] of Char = ('0', '1');
   UM_STATUSTEXT = (WM_USER + 302);               // used to send update status msg to main form
+  COLOR_CREAM   = $F0FBFF;
+var
+  ScrollBarHeight: integer = 0;
 type
 …
 function DelimCount(const Str, Delim: string): integer;
 procedure QuickCopy(AFrom, ATo: TObject);
+procedure QuickAdd(AFrom, ATo: TObject);
+procedure FastAssign(source, destination: TStrings);
+procedure FastAddStrings(source, destination: TStrings);
 function ValidFileName(const InitialFileName: string): string;
 …
 procedure ResizeFormToFont(AForm: TForm);
 procedure ResizeAnchoredFormToFont( AForm: TForm);
+procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm);
 function ResizeWidth( OldFont: TFont; NewFont: TFont; OldWidth: integer): integer;
 function ResizeHeight( OldFont: TFont; NewFont: TFont; OldHeight: integer): integer;
 …
 function PopupComponent(Sender: TObject; PopupMenu: TPopupMenu): TComponent;
 procedure ReformatMemoParagraph(AMemo: TCustomMemo);
+function ReadOnlyColor: TColor;
+function BlackColorScheme: Boolean;
+function NormalColorScheme: Boolean;
+function Get508CompliantColor(Color: TColor): TColor;
+procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE);
+procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean);
 { ListBox Grid functions }
 …
 function TabIsPressed : Boolean;
 function ShiftTabIsPressed : Boolean;
+function EnterIsPressed : Boolean;
 implementation  // ---------------------------------------------------------------------------
 uses
   ORCtrls, Grids, Chart, CheckLst;
+  ORCtrls, Grids, Chart, CheckLst, VAUtils;
 const
 …
 function Piece(const S: string; Delim: char; PieceNum: Integer): string;
 { returns the Nth piece (PieceNum) of a string delimited by Delim }
+var
+  i: Integer;
+  Strt, Next: PChar;
+begin
+  i := 1;
+  Strt := PChar(S);
+  Next := StrScan(Strt, Delim);
+  while (i < PieceNum) and (Next <> nil) do
+  begin
+    Inc(i);
+    Strt := Next + 1;
+    Next := StrScan(Strt, Delim);
+  end;
+  if Next = nil then Next := StrEnd(Strt);
+  if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt);
+begin
+  Result := VAUtils.Piece(S, Delim, PieceNum);
 end;
 function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string;
+{ returns several contiguous pieces }
+var
+  PieceNum: Integer;
+begin
+  Result := '';
+  for PieceNum := FirstNum to LastNum do Result := Result + Piece(S, Delim, PieceNum) + Delim;
+  if Length(Result) > 0 then Delete(Result, Length(Result), 1);
+begin
+  Result := VAUtils.Pieces(S, Delim, FirstNum, LastNum);
 end;
 …
     if obj is TListBox then
       str[idx] := TListBox(obj).Items
+    else
+    if obj is TORComboBox then
+      str[idx] := TORComboBox(obj).Items
+    else
+    if obj is TComboBox then
+      str[idx] := TComboBox(obj).Items
     else
     if obj is TRichEdit then
 …
   if fix[0] then TRichEdit(AFrom).PlainText := FALSE;
   if fix[1] then TRichEdit(ATo).PlainText := FALSE;
+  if ATo is TRichEdit then
+    TRichEdit(ATo).SelStart := Length(TRichEdit(ATo).Lines.Text); //CQ: 16461
+end;
+type
+  QuickAddError = class(Exception);
+procedure QuickAdd(AFrom, ATo: TObject);
+var
+  ms: TMemoryStream;
+  idx: integer;
+  str: array[0..1] of TStrings;
+  fix: array[0..1] of boolean;
+  procedure GetStrings(obj: TObject);
+  begin
+    if (CompareText(obj.ClassName, 'TRichEditStrings') = 0) then
+      raise QuickCopyError.Create('You must pass the TRichEdit object into QuickAdd, NOT it''s Lines property.');
+    if obj is TStrings then
+      str[idx] := TStrings(obj)
+    else
+    if obj is TMemo then
+      str[idx] := TMemo(obj).Lines
+    else
+    if obj is TORListBox then
+      str[idx] := TORListBox(obj).Items
+    else
+    if obj is TListBox then
+      str[idx] := TListBox(obj).Items
+    else
+    if obj is TORComboBox then
+      str[idx] := TORComboBox(obj).Items
+    else
+    if obj is TComboBox then
+      str[idx] := TComboBox(obj).Items
+    else
+    if obj is TRichEdit then
+    begin
+      with TRichEdit(obj) do
+      begin
+        str[idx] := Lines;
+        if not PlainText then
+        begin
+          fix[idx] := TRUE;
+          PlainText := TRUE;
+        end;
+      end;
+    end
+    else
+      raise QuickAddError.Create('Unsupported object type (' + obj.ClassName +
+                                  ') passed into QuickAdd.');
+    inc(idx);
+  end;
+begin
+  fix[0] := FALSE;
+  fix[1] := FALSE;
+  idx := 0;
+  GetStrings(AFrom);
+  GetStrings(ATo);
+  ms := TMemoryStream.Create;
+  try
+    str[1].SaveToStream(ms);
+    ms.Seek(0, soFromEnd);
+    str[0].SaveToStream(ms);
+    ms.Seek(0, soFromBeginning);
+    str[1].Clear;
+    str[1].LoadFromStream(ms);
+  finally
+    ms.Free;
+  end;
+  if fix[0] then TRichEdit(AFrom).PlainText := FALSE;
+  if fix[1] then TRichEdit(ATo).PlainText := FALSE;
+end;
+procedure FastAssign(source, destination: TStrings);
+// do not use this with RichEdit Lines unless source is RichEdit with PlainText
+var
+  ms: TMemoryStream;
+begin
+  destination.Clear;
+  if (source is TStringList) and (destination is TStringList) then
+    destination.Assign(source)
+  else
+  if (CompareText(source.ClassName, 'TRichEditStrings') = 0) then
+    destination.Assign(source)
+  else
+  begin
+    ms := TMemoryStream.Create;
+    try
+      source.SaveToStream(ms);
+      ms.Seek(0, soFromBeginning);
+      destination.LoadFromStream(ms);
+    finally
+      ms.Free;
+    end;
+  end;
+end;
+procedure FastAddStrings(source, destination: TStrings);
+// do not use this with RichEdit Lines unless source and destination are RichEdit with PlainText
+var
+  ms: TMemoryStream;
+begin
+  if (source is TStringList) and (destination is TStringList) then
+    destination.AddStrings(source)
+  else
+  begin
+    ms := TMemoryStream.Create;
+    try
+      destination.SaveToStream(ms);
+      ms.Seek(0, soFromEnd);
+      source.SaveToStream(ms);
+      ms.Seek(0, soFromBeginning);
+      destination.Clear;
+      destination.LoadFromStream(ms);
+    finally
+      ms.Free;
+    end;
+  end;
 end;
 …
     end; {for i}
     AList.Clear;
     AList.Assign(NewList);
+    FastAssign(NewList, AList);
   finally
     NewList.Free;
 …
 end;
+var
+  AlignList, AnchorList: TStringList;
+function AnchorsToStr(Control: TControl): string;
+var
+  j: TAnchorKind;
+begin
+  Result := '';
+  for j := low(TAnchorKind) to high(TAnchorKind) do
+    if j in Control.Anchors then
+      Result := result + '1'
+    else
+      Result := result + '0'
+end;
+function StrToAnchors(i: integer): TAnchors;
+var
+  j: TAnchorKind;
+  value: string;
+  idx : integer;
+begin
+  Result := [];
+  value := AnchorList[i];
+  idx := 1;
+  for j := low(TAnchorKind) to high(TAnchorKind) do
+  begin
+    if copy(value,idx,1) = '1' then
+      include(Result, j);
+    inc(idx);
+  end;
+end;
+procedure SuspendAlign(AForm: TForm);
+var
+  i: integer;
+  control: TControl;
+begin
+  AForm.DisableAlign;
+  AlignList.Clear;
+  AnchorList.Clear;
+  for i := 0 to AForm.ControlCount-1 do
+  begin
+    control := AForm.Controls[i];
+    AlignList.Add(IntToStr(ord(control.align)));
+    control.Align := alNone;
+    AnchorList.Add(AnchorsToStr(control));
+    control.Anchors := [];
+  end;
+end;
+procedure RestoreAlign(AForm: TForm);
+var
+  i: integer;
+  control: TControl;
+begin
+  try
+    for i := 0 to AForm.ControlCount-1 do
+    begin
+      control := AForm.Controls[i];
+      control.Align := TAlign(StrToIntDef(AlignList[i],0));
+      control.Anchors := StrToAnchors(i);
+    end;
+    AlignList.Clear;
+    AnchorList.Clear;
+  finally
+    AForm.EnableAlign;
+  end;
+end;
 procedure ResizeFormToFont(AForm: TForm);
 var
   Rect: TRect;
+begin
+  OldResize: TNotifyEvent;
+begin
+// CQ# 11481 apply size changes to form all at once, instead of piece by piece.  Otherwise,
+// multiple calls to fAutoSz.FormResize, even if the form has not resized, can distort
+// the controls beyond the size of the form.
   with AForm do begin
+    ClientWidth := ResizeWidth( Font, MainFont, ClientWidth);
+    ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
+    HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
+    VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
+    Rect := BoundsRect;
+    ForceInsideWorkArea(Rect);
+    BoundsRect := Rect;
+    ResizeFontsInDescendants( Font, MainFont, AForm);
+    //Important: We are using the font to calculate everything, so don't
+    //change font until now.
+    Font.Size := MainFont.Size;
+    OldResize := AForm.OnResize;
+    AForm.OnResize := nil;
+    try
+      SuspendAlign(AForm);
+      try
+        HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
+        VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
+        ClientWidth := ResizeWidth( Font, MainFont, ClientWidth);
+        ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
+        Rect := BoundsRect;
+        ForceInsideWorkArea(Rect);
+        BoundsRect := Rect;
+      finally
+        RestoreAlign(AForm);
+      end;
+      ResizeFontsInDescendants( Font, MainFont, AForm);
+      //Important: We are using the font to calculate everything, so don't
+      //change font until now.
+      Font.Size := MainFont.Size;
+    finally
+      if(Assigned(OldResize)) then
+      begin
+        AForm.OnResize := OldResize;
+        OldResize(AForm);
+      end;
+    end;
   end;
 end;
 …
 var
   Rect: TRect;
+  OldResize: TNotifyEvent;
 begin
   with AForm do begin
+    ClientWidth  := ResizeWidth( Font, MainFont, ClientWidth);
+    ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
+    HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
+    VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
+    Rect := BoundsRect;
+    ForceInsideWorkArea(Rect);
+    BoundsRect := Rect;
+    ResizeDescendants( Font, MainFont, AForm);
+    ResizeFontsInDescendants( Font, MainFont, AForm);
+    //Important: We are using the font to calculate everything, so don't
+    //change font until now.
+    Font.Size := MainFont.Size;
+  // CQ# 11481 - see ResizeFormToFont
+    OldResize := AForm.OnResize;
+    AForm.OnResize := nil;
+    try
+      HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
+      VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
+      ClientWidth  := ResizeWidth( Font, MainFont, ClientWidth);
+      ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
+      Rect := BoundsRect;
+      ForceInsideWorkArea(Rect);
+      BoundsRect := Rect;
+      ResizeDescendants( Font, MainFont, AForm);
+      ResizeFontsInDescendants( Font, MainFont, AForm);
+      //Important: We are using the font to calculate everything, so don't
+      //change font until now.
+      Font.Size := MainFont.Size;
+    finally
+      if(Assigned(OldResize)) then
+      begin
+        AForm.OnResize := OldResize;
+        OldResize(AForm);
+      end;
+    end;
+  end;
+end;
+// CQ 11485 - Adjusts all forms  - adds additional height to the form to
+// adjust for Windows XP style title bars, and for large fonts in title bar
+procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm);
+const
+  DEFAULT_CAPTION_HEIGHT = 19;
+  DEFAULT_MENU_HEIGHT = 19;
+var
+  dxsb, dysb, dy, menuDY: integer;
+begin
+// Call GetSystemMetrics each time because values can change between calls
+  dy := GetSystemMetrics(SM_CYCAPTION) - DEFAULT_CAPTION_HEIGHT;
+  if (AForm.Menu <> nil) then
+  begin
+    menuDY := GetSystemMetrics(SM_CYMENU) - DEFAULT_MENU_HEIGHT;
+    inc(dy, menuDY);
+  end;
+  if dy <> 0 then
+  begin
+    SuspendAlign(AForm);
+    try
+    // Assitional adjustment to allow scroll bars to dissappear
+      dxsb := GetSystemMetrics(SM_CXVSCROLL);
+      dysb := GetSystemMetrics(SM_CYHSCROLL);
+      AForm.Height := AForm.Height + dy + dysb;
+      AForm.Width := AForm.Width + dxsb;
+      AForm.Height := AForm.Height - dysb;
+      AForm.Width := AForm.Width - dxsb;
+    finally
+      RestoreAlign(AForm);
+    end;
   end;
 end;
 …
 begin
   DC := GetDC(0);
+  SaveFont := SelectObject(DC, AFontHandle);
+  GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
+  Result := TextSize.cx;
+  SelectObject(DC, SaveFont);
+  ReleaseDC(0, DC);
+  try
+    SaveFont := SelectObject(DC, AFontHandle);
+    try
+      GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
+      Result := TextSize.cx;
+    finally
+      SelectObject(DC, SaveFont);
+    end;
+  finally
+    ReleaseDC(0, DC);
+  end;
 end;
 …
 begin
   DC := GetDC(0);
+  SaveFont := SelectObject(DC, AFontHandle);
+  GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
+  Result := TextSize.cy;
+  SelectObject(DC, SaveFont);
+  ReleaseDC(0, DC);
+  try
+    SaveFont := SelectObject(DC, AFontHandle);
+    try
+      GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
+      Result := TextSize.cy;
+    finally
+      SelectObject(DC, SaveFont);
+    end;
+  finally
+    ReleaseDC(0, DC);
+  end;
+  if Result > 255 then // CQ 11493
+    Result := 255; // This is maximum allowed by a Windows
 end;
 …
     end;
   end;
+  if Result > 255 then // CQ 11492
+    Result := 255; // This is maximum allowed by a Windows
 end;
 …
 var
+  uReadOnlyColor: TColor;
+  uHaveReadOnlyColor: boolean = FALSE;
+function ReadOnlyColor: TColor;
+begin
+  if not uHaveReadOnlyColor then
+  begin
+    uHaveReadOnlyColor := TRUE;
+    if ColorToRGB(clWindow) = ColorToRGB(clWhite) then
+      uReadOnlyColor := $00F0FBFF
+  uNormalColorScheme: boolean = false;
+  uBlackColorScheme: boolean = false;
+  uWhiteColorScheme: boolean = false;
+  uMaroonColorWhenBlack: TColor = clMaroon;
+  uCheckColorScheme: boolean = true;
+  PURE_BLACK: longint = 0;
+const
+  uBorderlessWindowColorWhenBlack: TColor = clNavy;
+procedure CheckColorScheme;
+begin
+  if uCheckColorScheme then
+  begin
+    uNormalColorScheme :=
+      ((ColorToRGB(clWindow)      = ColorToRGB(clWhite)) and
+       (ColorToRGB(clWindowText)  = ColorToRGB(clBlack)) and
+       (ColorToRGB(clInfoText)    = ColorToRGB(clBlack)) and
+       (ColorToRGB(clInfoBk)     <> ColorToRGB(clWhite)));
+    uBlackColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clBlack)) and
+                          (ColorToRGB(clWindow) = ColorToRGB(clBlack)));
+    uWhiteColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clWhite)) and
+                          (ColorToRGB(clWindow) = ColorToRGB(clWhite)));
+    if uBlackColorScheme then
+    begin
+      if(ColorToRGB(clGrayText) = ColorToRGB(clWindowText)) then
+        uMaroonColorWhenBlack := clHighlightText
+      else
+        uMaroonColorWhenBlack := clGrayText;
+    end;
+    uCheckColorScheme := FALSE;
+  end;
+end;
+function BlackColorScheme: Boolean;
+begin
+  if uCheckColorScheme then CheckColorScheme;
+  Result := uBlackColorScheme;
+end;
+function NormalColorScheme: Boolean;
+begin
+  if uCheckColorScheme then CheckColorScheme;
+  Result := uNormalColorScheme;
+end;
+function Get508CompliantColor(Color: TColor): TColor;
+begin
+  Result := Color;
+  if NormalColorScheme then exit;
+  case Color of
+    clCream:    Result := clInfoBk;
+    clBlack:    Result := clWindowText;
+    clWhite:    Result := clWindow;
+  end;
+  if uBlackColorScheme then
+  begin
+    case Color of
+      clBlue:     Result := clAqua;
+      clMaroon:   Result := uMaroonColorWhenBlack;
+  //    clRed:      Result := clFuchsia;
+    end;
+  end;
+  if uWhiteColorScheme then
+  begin
+    case Color of
+      clGrayText: Result := clGray;
+    end;
+  end;
+end;
+type
+  TExposedControl = class(TControl)
+  public
+    property Color;
+    property Font;
+  end;
+  TExposedCustomEdit = class(TCustomEdit)
+  public
+    property BorderStyle;
+    property ReadOnly;
+  end;
+procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE);
+var
+  BitMapLevelCheck: integer;
+  Level: integer;
+  procedure BlackColorSchemeUpdate(control: TControl);
+  var
+    bitmap: TBitMap;
+    edit: TExposedCustomEdit;
+    x,y: integer;
+    cbmCtrl: IORBlackColorModeCompatible;
+  begin
+    if uBlackColorScheme then
+    begin
+      if Level < BitMapLevelCheck then
+      begin
+        if control.GetInterface(IORBlackColorModeCompatible, cbmCtrl) then
+        begin
+          cbmCtrl.SetBlackColorMode(TRUE);
+          BitMapLevelCheck := Level;
+          cbmCtrl := nil;
+        end
+        else
+        begin
+          if (control is TBitBtn) then
+          begin
+            bitmap := TBitBtn(control).Glyph;
+            for x := 0 to bitmap.Width-1 do
+            begin
+              for y := 0 to bitmap.Height-1 do
+              begin
+                if ColorToRGB(bitmap.Canvas.Pixels[x,y]) = PURE_BLACK then
+                  bitmap.Canvas.Pixels[x,y] := clWindowText;
+              end;
+            end;
+          end;
+        end;
+      end;
+      if (control is TCustomEdit) and InputEditControl then
+      begin
+        edit := TExposedCustomEdit(control);
+        if (edit.BorderStyle = bsNone) then
+          edit.Color := uBorderlessWindowColorWhenBlack;
+      end;
+    end;
+  end;
+  procedure ComponentUpdateColorsFor508Compliance(control: TControl);
+  var
+    OldComponentColor, OldFontColor, NewComponentColor, NewFontColor: TColor;
+  begin
+    OldComponentColor := TExposedControl(control).Color;
+    OldFontColor := TExposedControl(control).Font.Color;
+    NewComponentColor := Get508CompliantColor(OldComponentColor);
+    if NewComponentColor = clInfoBk then
+    begin
+      if (OldFontColor = clInfoBk) or (OldFontColor = clCream) then
+        NewFontColor := clInfoBk // used for hiding text
+      else
+        NewFontColor := clInfoText;
+    end
     else
+      uReadOnlyColor := clWindow;
+  end;
+  Result := uReadOnlyColor;
+      NewFontColor := Get508CompliantColor(OldFontColor);
+    if NewComponentColor <> OldComponentColor then
+      TExposedControl(control).Color := NewComponentColor;
+    if NewFontColor <> OldFontColor then
+      TExposedControl(control).Font.Color := NewFontColor;
+    BlackColorSchemeUpdate(control);
+  end;
+  procedure ScanAllComponents(control: TControl);
+  var
+    i: integer;
+  begin
+    ComponentUpdateColorsFor508Compliance(Control);
+    if control is TWinControl then
+    begin
+      inc(Level);
+      try
+        for i := 0 to TWinControl(Control).ControlCount-1 do
+        begin
+          ScanAllComponents(TWinControl(Control).Controls[i]);
+        end;
+      finally
+        dec(Level);
+        if BitMapLevelCheck = Level then
+          BitMapLevelCheck := MaxInt;
+      end;
+    end;
+  end;
+begin
+  if NormalColorScheme then exit;
+  BitMapLevelCheck := MaxInt;
+  Level := 0;
+  ScanAllComponents(control);
+end;
+procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean);
+begin
+  with TExposedControl(Control) do
+  begin
+    if ReadOnly then
+    begin
+      Color := Get508CompliantColor(clCream);
+      Font.Color := clInfoText;
+    end
+    else
+    begin
+      Color := clWindow;
+      Font.Color := clWindowText;
+    end;
+  end;
 end;
 …
     end;
     Canvas.FillRect(ARect);
     Canvas.Pen.Color := clSilver;
+    Canvas.Pen.Color := Get508CompliantColor(clSilver);
     Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
     Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
 …
 begin
   Result := Boolean(Hi(GetKeyState(VK_TAB))) and not Boolean(Hi(GetKeyState(VK_SHIFT)));
+  Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL)));
 end;
 …
 begin
   Result := Boolean(Hi(GetKeyState(VK_TAB))) and Boolean(Hi(GetKeyState(VK_SHIFT)));
+end;
+  Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL)));
+end;
+function EnterIsPressed : Boolean;
+begin
+  Result := Boolean(Hi(GetKeyState(VK_RETURN)));
+end;
 initialization
 …
   FBaseFont.Name := BaseFontName;
   FBaseFont.Size := BaseFontSize;
+  ScrollBarHeight := GetSystemMetrics(SM_CYHSCROLL);
+  AlignList := TStringList.Create;
+  AnchorList := TStringList.Create;
+  PURE_BLACK := ColorToRGB(clBlack);
 finalization
   FBaseFont.Free;
   KillObj(@IdleCaller);
+  FreeAndNil(AlignList);
+  FreeAndNil(AnchorList);
 end.

cprs/trunk/CPRS-Lib/ORNet.pas

-              r456
+              r829
 {$ENDIF}
   RPCLastCall: string;
+  AppStartedCursorForm: TForm = nil;
 implementation
 …
   AStringList.Add(' ');
   AStringList.Add('Results -----------------------------------------------------------------');
   AStringList.AddStrings(RPCBrokerV.Results);
+  FastAddStrings(RPCBrokerV.Results, AStringList);
   uCallList.Add(AStringList);
   if uShowRPCs then StatusText('');
 …
 end;
+function GetRPCCursor: TCursor;
+var
+  pt: TPoint;
+begin
+  Result := crHourGlass;
+  if assigned(AppStartedCursorForm) and (AppStartedCursorForm.Visible) then
+  begin
+    pt := Mouse.CursorPos;
+    if PtInRect(AppStartedCursorForm.BoundsRect, pt) then
+      Result := crAppStart;
+  end;
+end;
 procedure CallV(const RPCName: string; const AParam: array of const);
 { calls the broker leaving results in results property which must be read by caller }
 …
 begin
   SavedCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
+  Screen.Cursor := GetRPCCursor;
   SetParams(RPCName, AParam);
   CallBroker;  //RPCBrokerV.Call;
 …
 begin
   SavedCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
+  Screen.Cursor := GetRPCCursor;
   SetParams(RPCName, AParam);
   CallBroker;  //RPCBrokerV.Call;
 …
   if ReturnData = nil then raise Exception.Create('TString not created');
   SavedCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
+  Screen.Cursor := GetRPCCursor;
   SetParams(RPCName, AParam);
   CallBroker;  //RPCBrokerV.Call;
   ReturnData.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ReturnData);
   Screen.Cursor := SavedCursor;
 end;
 …
 begin
   SavedCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
+  Screen.Cursor := GetRPCCursor;
   SetParams(RPCName, AParam);
   RPCBrokerV.Call;
 …
 procedure LoadRPCData(Dest: TStrings; ID: Integer);
 begin
   if (ID > -1) and (ID < uCallList.Count) then Dest.Assign(TStringList(uCallList.Items[ID]));
+  if (ID > -1) and (ID < uCallList.Count) then FastAssign(TStringList(uCallList.Items[ID]), Dest);
 end;

cprs/trunk/CPRS-Lib/ORSystem.pas

-              r456
+              r829
 {$O-}
+{$WARN SYMBOL_PLATFORM OFF}
 interface
 …
   CPRS_LAST_DATE = 'Software\Vista\CPRS\DateUpdated';
-  { values that can be passed to FileVersionValue }
-  FILE_VER_COMPANYNAME      = '\StringFileInfo\040904E4\CompanyName';
-  FILE_VER_FILEDESCRIPTION  = '\StringFileInfo\040904E4\FileDescription';
-  FILE_VER_FILEVERSION      = '\StringFileInfo\040904E4\FileVersion';
-  FILE_VER_INTERNALNAME     = '\StringFileInfo\040904E4\InternalName';
-  FILE_VER_LEGALCOPYRIGHT   = '\StringFileInfo\040904E4\LegalCopyright';
-  FILE_VER_ORIGINALFILENAME = '\StringFileInfo\040904E4\OriginalFilename';
-  FILE_VER_PRODUCTNAME      = '\StringFileInfo\040904E4\ProductName';
-  FILE_VER_PRODUCTVERSION   = '\StringFileInfo\040904E4\ProductVersion';
-  FILE_VER_COMMENTS         = '\StringFileInfo\040904E4\Comments';
 function AppOutOfDate(AppName: string): Boolean;
 function ClientVersion(const AFileName: string): string;
 …
 //procedure FileCopy(const FromFileName, ToFileName: string);
 //procedure FileCopyWithDate(const FromFileName, ToFileName: string);
-function FileVersionValue(const AFileName, AValueName: string): string;
 function FullToFilePart(const AFileName: string): string;
 function FullToPathPart(const AFileName: string): string;
 …
 procedure RunProgram(const AppName: string);
 function UpdateSelf: Boolean;
+function BorlandDLLVersionOK: boolean;
 implementation
 …
   // check for different file date in the gold directory
   GoldName := RegReadStr(CPRS_REG_GOLD);
+  if Length(GoldName) = 0 then Exit;
+  if (Length(GoldName) = 0)  then exit;
+  if not DirectoryExists(GoldName) then
+  begin
+    if Pos('"', Goldname) > 0 then
+    begin
+      Goldname := Copy(GoldName, 2, MaxInt);
+      if Pos('"', Goldname) > 0 then
+        Goldname := Copy(GoldName, 1, Length(GoldName) - 1);
+    end;
+  end;
+  if (not DirectoryExists(GoldName)) then Exit;
   GoldName := GoldName + FullToFilePart(AppName);
   if FileExists(GoldName) then
 …
                                                      IntToStr(HIWORD(dwFileVersionLS)) + '.' +
                                                      IntToStr(LOWORD(dwFileVersionLS));
-  end;
-end;
-function FileVersionValue(const AFileName, AValueName: string): string;
-type
-  PValBuf = ^TValBuf;
-  TValBuf = array[0..255] of Char;
-var
-  VerSize, ValSize, AHandle: DWORD;
-  VerBuf: Pointer;
-  ValBuf: PValBuf;
-begin
-  Result := '';
-  VerSize:=GetFileVersionInfoSize(PChar(AFileName), AHandle);
-  if VerSize > 0 then
-  begin
-    GetMem(VerBuf, VerSize);
-    try
-      GetFileVersionInfo(PChar(AFileName), AHandle, VerSize, VerBuf);
-      VerQueryValue(VerBuf, PChar(AValueName), Pointer(ValBuf), ValSize);
-      SetString(Result, ValBuf^, ValSize);
-    finally
-      FreeMem(VerBuf);
-    end;
   end;
 end;
 …
 *)
+function BorlandDLLVersionOK: boolean;
+const
+  DLL_CURRENT_VERSION = 10;
+  TC_DLL_ERR   = 'ERROR - BORLNDMM.DLL';
+  TX_NO_RUN    = 'This version of CPRS is unable to run because' + CRLF;
+  TX_NO_DLL    = 'no copy of BORLNDMM.DLL can be found' + CRLF +
+                 'in your workstation''s current PATH.';
+  TX_OLD_DLL1  = 'the copy of BORLNDMM.DLL located at:' + CRLF + CRLF;
+  TX_OLD_DLL2  = CRLF + CRLF + 'is out of date  (Version ';
+  TX_CALL_IRM  = CRLF + CRLF +'Please contact IRM for assistance.';
+var
+  DLLHandle: HMODULE;
+  DLLNamePath: array[0..261] of Char;
+  DLLVersion: string;
+begin
+  Result := TRUE;
+  DLLHandle := GetModuleHandle('BORLNDMM.DLL');
+  if DLLHandle <=0 then
+  begin
+    InfoBox(TX_NO_RUN + TX_NO_DLL + TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
+    Result := FALSE;
+    Exit;
+  end;
+  Windows.GetModuleFileName(DLLHandle, DLLNamePath, 261);
+  DLLVersion := ClientVersion(DLLNamePath);
+  if StrToIntDef(Piece(DLLVersion, '.', 1), 0) < DLL_CURRENT_VERSION then
+  begin
+    InfoBox(TX_NO_RUN + TX_OLD_DLL1 + '   ' + DLLNamePath + TX_OLD_DLL2 + DLLVersion + ')' +
+            TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
+    Result := false;
+  end;
+end;
 end.

Context Navigation

Legend: