Changeset 829 for cprs


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

Upgrade to version 27

Location:
cprs/trunk
Files:
407 added
46 deleted
252 edited

Legend:

Unmodified
Added
Removed
  • cprs/trunk/CPRS-Chart/BA/UBAConst.pas

    r456 r829  
    3030  MILITARY_SEXUAL_TRAUMA  = 'MST';
    3131  COMBAT_VETERAN          = 'CV';
     32  SHIPBOARD_HAZARD_DEFENSE= 'SHD';
    3233
    3334  MAX_DX = 4;
  • cprs/trunk/CPRS-Chart/BA/UBACore.pas

    r456 r829  
    112112  end;
    113113
    114    BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing
     114   FastAssign(holdOrderList, BAOrderList); //assign signable orders to BAOrderList for further processing
    115115   holdOrderList.Clear; // CQ5025
    116116
    117117    //call with passList determine if LRMP
    118118     if rpcOrderRequiresDx(passList) then
    119       BAOrderList.Assign(updatedBAOrderList);
     119      FastAssign(updatedBAOrderList, BAOrderList);
    120120
    121121    // check of all orders dx columns are flagged with N/A.....
     
    165165    end
    166166    else
    167        updatedList.Assign(pList);
     167       FastAssign(pList, updatedList);
    168168
    169169    // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0
     
    213213     on EListError do
    214214        begin
    215         {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif}
     215        {$ifdef debug}Show508Message('EListError in UBACore.IsOrderBillable()');{$endif}
    216216        raise;
    217217        end;
     
    334334        begin
    335335           // Verify Patient is Insured
     336           // OR Switch = 2 ask questions for all patients.
    336337           if  rpcIsPatientInsured(pPatientDFN)  then
    337338              BILLING_AWARE := TRUE;
     
    407408       on EListError do
    408409       begin
    409          {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
     410         {$ifdef debug}Show508Message('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif}
    410411         raise;
    411412     end;
     
    419420procedure rpcGetSC4Orders;
    420421begin
     422//  ****** RPC Logic returning SC/TF codes for COPAY  ********
     423//     if (CIDC is ON) and (PatientInsured is True) then
     424//        return SC/TF for OutPatient Meds, Labs, Prosthetics, Imaging.
     425//     else
     426//       return SC/TF for Outpatient Meds only.
    421427   RPCBrokerV.Param[0].PType := literal;
    422428   RPCBrokerV.Param[0].Value := Patient.DFN;
     
    434440    uDxLst.Clear;
    435441    tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]);
    436     UBACore.UDxLst.Assign(tmplst);
     442    FastAssign(tmplst, UBACore.UDxLst);
    437443    tmplst.clear;
    438444end;
     
    511517function  rpcIsPatientInsured(pPatientDFN: string):boolean;
    512518begin
    513    Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1');
     519   Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) > '0');
    514520     
    515521end;
     
    552558     on EListError do
    553559        begin
    554         {$ifdef debug}ShowMessage('EListError in UBACore.OrdersHaveDx()');{$endif}
     560        {$ifdef debug}Show508Message('EListError in UBACore.OrdersHaveDx()');{$endif}
    555561        raise;
    556562        end;
     
    634640   UBAGlobals.MST := Copy(x,5,1);
    635641   UBAGlobals.HNC := Copy(x,6,1);
    636    UBAGlobals.CV :=  Copy(x,7,1);
     642   UBAGlobals.CV  := Copy(x,7,1);
     643   UBAGlobals.SHD := Copy(x,8,1);
    637644end;
    638645
     
    693700             UBAGlobals.HNC := 'C';
    694701
     702       if UBAGlobals.SHD <> 'N' then
     703          if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
     704             UBAGlobals.SHD := 'C';
     705
    695706       //  Build Treatment Factor List to be passed to fOrdersSign form
    696        strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV);
     707       strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV + SHD);
    697708       UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut );
    698709     end;
     
    724735     on EListError do
    725736        begin
    726         {$ifdef debug}ShowMessage('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
     737        {$ifdef debug}Show508Message('EListError in UBACore.AddProviderPatientDaysDx()');{$endif}
    727738        raise;
    728739        end;
     
    751762     on EListError do
    752763        begin
    753         {$ifdef debug}ShowMessage('EListError in UBACore.OrderRequiresSCEI()');{$endif}
     764        {$ifdef debug}Show508Message('EListError in UBACore.OrderRequiresSCEI()');{$endif}
    754765        raise;
    755766        end;
     
    875886     on EListError do
    876887        begin
    877         {$ifdef debug}ShowMessage('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
     888        {$ifdef debug}Show508Message('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif}
    878889        raise;
    879890        end;
     
    898909     on EListError do
    899910        begin
    900         {$ifdef debug}ShowMessage('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
     911        {$ifdef debug}Show508Message('EListError in UBACore.GetUnsignedOrderFlags()');{$endif}
    901912        raise;
    902913        end;
     
    972983                 if piece(x,U,1) = COMBAT_VETERAN then
    973984                 begin
    974                   if piece(x,U,2) = '1' then
    975                      UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
    976                   else
    977                      UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
    978                end;
    979          end;
     985                   if piece(x,U,2) = '1' then
     986                      UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3)
     987                   else
     988                      UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) );
     989                 end
     990                 else
     991                    if piece(x,U,1) = SHIPBOARD_HAZARD_DEFENSE then
     992                    begin
     993                       if piece(x,U,2) = '1' then
     994                          UBAGlobals.BAFactorsRec.FBAFactorSHAD := Piece(x,U,3)
     995                      else
     996                         UBAGlobals.BAFactorsRec.FBAFactorSHAD := (UBAGlobals.BAFactorsRec.FBAFactorSHAD + CRLF + Piece(x,U,3) );
     997                  end;
     998            end;
    980999  except
    9811000     on EListError do
    9821001        begin
    983         {$ifdef debug}ShowMessage('EListError in UBACore.BuileTFHintRec()');{$endif}
     1002        {$ifdef debug}Show508Message('EListError in UBACore.BuileTFHintRec()');{$endif}
    9841003        raise;
    9851004        end;
     
    10471066     on EListError do
    10481067        begin
    1049            {$ifdef debug}ShowMessage('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
     1068           {$ifdef debug}Show508Message('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif}
    10501069           raise;
    10511070        end;
     
    11331152     on EListError do
    11341153        begin
    1135         {$ifdef debug}ShowMessage('EListError in UBACore.LoadConsultOrderRec()');{$endif}
     1154        {$ifdef debug}Show508Message('EListError in UBACore.LoadConsultOrderRec()');{$endif}
    11361155        raise;
    11371156        end;
     
    11531172     with thisRetVal do
    11541173     begin
    1155         FBAOrderID := pOrderID;
     1174        FBAOrderID    := pOrderID;
    11561175        FBAEligible   := pEligible;
    11571176        FBATFactors   := pTFactors;
     
    11661185  tmpOrderList: TStringList;
    11671186begin
    1168     orderList := TStringList.Create;
     1187    orderList    := TStringList.Create;
    11691188    tmpOrderList := TStringList.Create;
    11701189    orderList.Clear;
     
    12411260    strTFactors   :=  pPLFactors;  // value selected from problem list
    12421261    strFlagsOut   := '';   // flags updated with selected values from problem list
    1243     x := strFlagsAsIs;
    1244     Result := '';
     1262    x             := strFlagsAsIs;
     1263    Result        := '';
    12451264
    12461265    UBAGlobals.SC  := Copy(x,1,1);
     
    12501269    UBAGlobals.MST := Copy(x,5,1);
    12511270    UBAGlobals.HNC := Copy(x,6,1);
    1252     UBAGlobals.CV :=  Copy(x,7,1); // load factors to global vars;
     1271    UBAGlobals.CV  :=  Copy(x,7,1); // load factors to global vars;
     1272    UBAGlobals.SHD := Copy(x,8,1);
    12531273
    12541274  if UBAGlobals.SC  <> 'N' then
     
    12841304          UBAGlobals.CV := 'C';
    12851305
     1306    if UBAGlobals.SHD <> 'N' then
     1307       if StrPos(PChar(strTFactors),PChar(SHIPBOARD_HAZARD_DEFENSE)) <> nil then
     1308          UBAGlobals.SHD := 'C';
     1309
    12861310     strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR +
    12871311                     UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC +
    1288                      UBAGlobals.CV);
     1312                     UBAGlobals.CV + UBAGlobals.SHD);
    12891313  Result := strFlagsOut;
    12901314end;
     
    13851409   holdList := TStringList.Create;
    13861410   holdList.Clear;
    1387    holdList.Assign(UBAGlobals.BACopiedOrderFlags);
     1411   FastAssign(UBAGlobals.BACopiedOrderFlags, holdList);
    13881412   UBAGlobals.BACopiedOrderFlags.Clear;
    13891413   for i := 0 to holdList.Count-1 do
     
    14121436      holdList := TStringList.Create;
    14131437      holdList.Clear;
    1414       holdList.Assign(UBAGlobals.BAConsultPLFlags);
     1438      FastAssign(UBAGlobals.BAConsultPLFlags, holdList);
    14151439      UBAGlobals.BAConsultPLFlags.Clear;
    14161440      for i := 0 to holdList.Count-1 do
  • cprs/trunk/CPRS-Chart/BA/UBAGlobals.pas

    r456 r829  
    3131   PtHNC:boolean;
    3232   PtMST:boolean;
     33   PtSHAD:boolean;
    3334   constructor Create(Alist:TStringList);
    3435   function GetGMPDFN(dfn:string;name:String):string;
     
    111112     FBAFactorHNC       : string;
    112113     FBAFactorCV        : string;
     114     FBAFactorSHAD       : string;
    113115  end;
    114116
     
    131133     CB_HNC             :string;
    132134     CB_CV              :string;
     135     CB_SHAD             :string;
    133136  end;
    134137
     
    205208  TFactors          : string;
    206209  SC,AO,IR          : string;
    207   MST,HNC,CV,EC    : string;
     210  MST,HNC,CV,SHD,EC : string;
    208211  PLFactorsIndexes  : TStringList;
    209212  BAHoldPrimaryDx   : string;     //  used to verify primart dx has been changed.
    210213  BAPrimaryDxChanged: boolean;
    211 //  OrdersReqDxLst    : TStringList;  // List of selected Orders flagged collect DX Y/N
    212214  NonBillableOrderList : TStringList;  // contains reference to those selected orders that are non billable
    213215  OrderListSCEI    : TSTringList;  //   OrderID Exists SCEI are required.
     
    220222  BAFWarningShown: boolean;       // flag used to determine if Inactive ICD Code has been shown.
    221223  BAPersonalDX:  boolean;
    222 //  BAConsultOrdersRequireDx: TStringList; //orderid  -  if orderid exists - consult order that requires dx...
    223224  BADeltedOrders: TStringList;
    224225
    225226implementation
    226227
    227 uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore;
     228uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore,
     229  VAUtils;
    228230
    229231procedure RemoveOrderFromDxList(thisOrderID: string);
     
    390392        on EListError do
    391393           begin
    392            {$ifdef debug}ShowMessage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
     394           {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
    393395           raise;
    394396           end;
     
    489491                           on EListError do
    490492                             begin
    491                               {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
     493                              {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
    492494                              raise;
    493495                             end;
     
    506508                           on EListError do
    507509                             begin
    508                               {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
     510                              {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
    509511                              raise;
    510512                             end;
     
    534536      on EListError do
    535537        begin
    536          {$ifdef debug}ShowMessage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
     538         {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
    537539         raise;
    538540        end;
     
    565567      on EListError do
    566568        begin
    567          {$ifdef debug}ShowMessage('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
     569         {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
    568570         raise;
    569571        end;
     
    588590                          on EListError do
    589591                             begin
    590                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
     592                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
    591593                             raise;
    592594                             end;
     
    601603                          on EListError do
    602604                             begin
    603                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
     605                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
    604606                             raise;
    605607                             end;
     
    643645                          on EListError do
    644646                             begin
    645                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
     647                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
    646648                             raise;
    647649                             end;
     
    659661                          on EListError do
    660662                             begin
    661                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
     663                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
    662664                             raise;
    663665                             end;
     
    704706                          on EListError do
    705707                             begin
    706                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
     708                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
    707709                             raise;
    708710                             end;
     
    736738                          on EListError do
    737739                             begin
    738                              {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
     740                             {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
    739741                             raise;
    740742                             end;
     
    858860              on EListError do
    859861                 begin
    860                  {$ifdef debug}ShowMessage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
     862                 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
    861863                 raise;
    862864                 end;
     
    890892        on EListError do
    891893           begin
    892            {$ifdef debug}ShowMessage('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
     894           {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
    893895           raise;
    894896           end;
     
    923925     on EListError do
    924926        begin
    925         {$ifdef debug}ShowMessage('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
     927        {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
    926928        raise;
    927929        end;
     
    10681070      7: PtHNC              := (AList[i] = '1');
    10691071      8: PtMST              := (AList[i] = '1');
     1072      9: PtSHAD              := (AList[i] = '1');
    10701073    end;
    10711074end;
     
    10781081procedure TBAPLPt.LoadPatientParams(AList:TstringList);
    10791082begin
    1080   AList.Assign(rpcInitPt(Patient.DFN));
     1083  FastAssign(rpcInitPt(Patient.DFN), AList);
    10811084  BAPLPt := TBAPLPt.create(Alist);
    10821085end;
     
    11111114        on EListError do
    11121115           begin
    1113            {$ifdef debug}ShowMessage('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
     1116           {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
    11141117           raise;
    11151118           end;
     
    11591162  BANurseConsultOrders := TStringList.Create;
    11601163  BADeltedOrders       := TStringList.Create;
    1161  // BAConsultOrdersRequireDx := TStringList.Create;
    11621164  BAConsultDxList.Clear;
    11631165  NonBillableOrderList.Clear;
     
    11751177  BANurseConsultOrders.Clear;
    11761178  BADeltedOrders.Clear;
    1177   //BAConsultOrdersRequireDx.Clear;
    1178  
     1179
    11791180end.
    11801181
  • cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.dfm

    r456 r829  
    1 object frmBALocalDiagnoses: TfrmBALocalDiagnoses
    2   Left = 192
    3   Top = 61
    4   Width = 620
    5   Height = 544
     1inherited frmBALocalDiagnoses: TfrmBALocalDiagnoses
     2  Left = 272
     3  Top = 142
    64  Caption = 'Assign Diagnoses to Order(s)'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   KeyPreview = True
     5  ClientHeight = 517
     6  ClientWidth = 612
    147  OldCreateOrder = False
    158  Position = poScreenCenter
     
    1710  OnActivate = FormActivate
    1811  OnCreate = FormCreate
    19   OnDestroy = FormDestroy
     12  OnKeyPress = FormKeyPress
    2013  OnShow = FormShow
     14  ExplicitWidth = 620
     15  ExplicitHeight = 551
    2116  PixelsPerInch = 96
    2217  TextHeight = 13
    23   object pnlTop: TPanel
     18  object pnlTop: TPanel [0]
    2419    Left = 0
    2520    Top = 0
     
    3328      96)
    3429    object lbOrders: TListBox
    35       Left = 7
     30      Left = 8
    3631      Top = 25
    37       Width = 599
     32      Width = 602
    3833      Height = 69
    3934      Anchors = [akLeft, akTop, akRight, akBottom]
    4035      IntegralHeight = True
    4136      ItemHeight = 13
    42       TabOrder = 2
     37      TabOrder = 1
    4338      OnMouseMove = lbOrdersMouseMove
    4439    end
    45     object ORStaticText1: TORStaticText
    46       Left = 216
     40    object lblPatientName: TStaticText
     41      Left = 8
    4742      Top = 8
    48       Width = 169
    49       Height = 14
    50       AutoSize = False
    51       Caption = 'Selected Orders'
    52       TabOrder = 1
    53       TabStop = True
    54       OnEnter = ORStaticText1Enter
    55       OnExit = ORStaticText1Exit
    56     end
    57     object lblPatientName: TStaticText
    58       Left = 11
    59       Top = 9
    6043      Width = 76
    6144      Height = 17
     
    6851      ParentFont = False
    6952      TabOrder = 0
    70       TabStop = True
    71     end
    72   end
    73   object pnlMain: TPanel
     53    end
     54  end
     55  object pnlMain: TPanel [1]
    7456    Left = 0
    7557    Top = 96
     
    7860    Align = alClient
    7961    TabOrder = 1
     62    object lblDiagSect: TLabel
     63      Left = 9
     64      Top = 1
     65      Width = 241
     66      Height = 17
     67      AutoSize = False
     68      Caption = 'Diagnosis Section'
     69    end
     70    object lblDiagCodes: TLabel
     71      Left = 253
     72      Top = 1
     73      Width = 353
     74      Height = 17
     75      AutoSize = False
     76      Caption = 'Diagnosis Codes'
     77    end
    8078    object lbSections: TORListBox
    8179      Left = 9
    82       Top = 16
     80      Top = 14
    8381      Width = 238
    84       Height = 201
    85       Style = lbOwnerDrawVariable
     82      Height = 199
    8683      IntegralHeight = True
    8784      ItemHeight = 13
     
    9592      LongList = False
    9693      Pieces = '3'
    97       CheckEntireLine = True
    9894    end
    9995    object btnOther: TButton
     
    107103    end
    108104    object lbDiagnosis: TORListBox
    109       Left = 248
     105      Left = 253
    110106      Top = 16
    111107      Width = 353
     
    122118      Pieces = '1,2,3'
    123119    end
    124     object ORStaticText2: TORStaticText
    125       Left = 8
    126       Top = 1
    127       Width = 241
    128       Height = 17
    129       AutoSize = False
    130       BevelKind = bkFlat
    131       Caption = 'Diagnosis Section'
    132       TabOrder = 0
    133       TabStop = True
    134       OnEnter = ORStaticText1Enter
    135       OnExit = ORStaticText1Exit
    136     end
    137     object ORStaticText3: TORStaticText
    138       Left = 248
    139       Top = 1
    140       Width = 353
    141       Height = 17
    142       AutoSize = False
    143       BevelKind = bkFlat
    144       Caption = 'Diagnosis Codes'
    145       TabOrder = 3
    146       TabStop = True
    147       OnEnter = ORStaticText1Enter
    148       OnExit = ORStaticText1Exit
    149     end
    150   end
    151   object pnlBottom: TORAutoPanel
     120  end
     121  object pnlBottom: TORAutoPanel [2]
    152122    Left = 0
    153123    Top = 355
     
    159129      612
    160130      162)
    161     object lvDxGrid: TListView
    162       Left = 12
    163       Top = 19
    164       Width = 445
    165       Height = 85
    166       Color = clInfoBk
    167       Columns = <
    168         item
    169           Caption = 'Add To PL/PD'
    170           Width = 85
    171         end
    172         item
    173           Caption = 'Primary'
    174           MinWidth = 65
    175           Width = 65
    176         end
    177         item
    178           Caption = 'Diagnosis for Selected Orders'
    179           MinWidth = 275
    180           Width = 290
    181         end>
    182       Ctl3D = False
    183       HideSelection = False
    184       MultiSelect = True
    185       ReadOnly = True
    186       RowSelect = True
    187       TabOrder = 1
    188       ViewStyle = vsReport
    189       OnClick = lvDxGridClick
    190       OnKeyDown = lvDxGridKeyDown
    191       OnKeyUp = lvDxGridKeyUp
    192     end
    193131    object cbAddToPDList: TCheckBox
    194132      Left = 459
     
    197135      Height = 17
    198136      Caption = 'Add to Personal Dx List'
    199       TabOrder = 3
     137      TabOrder = 2
    200138      OnClick = cbAddToPDListClick
    201139    end
     
    207145      Anchors = [akLeft, akTop, akRight, akBottom]
    208146      Caption = 'Add To Problem List'
    209       TabOrder = 2
     147      TabOrder = 0
    210148      OnClick = cbAddToPLClick
    211149    end
     
    216154      Height = 19
    217155      Caption = '&Primary'
    218       TabOrder = 4
     156      TabOrder = 3
    219157      OnClick = btnPrimaryClick
    220158    end
     
    225163      Height = 19
    226164      Caption = '&Remove'
    227       TabOrder = 5
     165      TabOrder = 4
    228166      OnClick = btnRemoveClick
    229167    end
     
    234172      Height = 18
    235173      Caption = '&Select All'
    236       TabOrder = 6
     174      TabOrder = 5
    237175      OnClick = btnSelectAllClick
    238176    end
     
    243181      Height = 21
    244182      Caption = '&OK'
    245       TabOrder = 7
     183      TabOrder = 6
    246184      OnClick = buOKClick
    247185    end
     
    252190      Height = 21
    253191      Caption = '&Cancel'
    254       TabOrder = 8
     192      TabOrder = 7
    255193      OnClick = buCancelClick
    256194    end
    257     object ORStaticText4: TORStaticText
    258       Left = 14
    259       Top = 3
    260       Width = 219
    261       Height = 14
    262       AutoSize = False
     195    object gbProvDiag: TGroupBox
     196      Left = 8
     197      Top = 0
     198      Width = 449
     199      Height = 105
    263200      Caption = 'Provisional Diagnosis'
    264       TabOrder = 0
    265       TabStop = True
    266       OnEnter = ORStaticText1Enter
    267       OnExit = ORStaticText1Exit
    268     end
     201      TabOrder = 1
     202      object lvDxGrid: TListView
     203        Left = 2
     204        Top = 15
     205        Width = 445
     206        Height = 88
     207        Align = alClient
     208        Color = clInfoBk
     209        Columns = <
     210          item
     211            Caption = 'Add To PL/PD'
     212            Width = 85
     213          end
     214          item
     215            Caption = 'Primary'
     216            MinWidth = 65
     217            Width = 65
     218          end
     219          item
     220            Caption = 'Diagnosis for Selected Orders'
     221            MinWidth = 275
     222            Width = 290
     223          end>
     224        Ctl3D = False
     225        HideSelection = False
     226        MultiSelect = True
     227        ReadOnly = True
     228        RowSelect = True
     229        TabOrder = 0
     230        ViewStyle = vsReport
     231        OnClick = lvDxGridClick
     232        OnKeyDown = lvDxGridKeyDown
     233        OnKeyUp = lvDxGridKeyUp
     234      end
     235    end
     236  end
     237  inherited amgrMain: TVA508AccessibilityManager
     238    Data = (
     239      (
     240        'Component = pnlTop'
     241        'Status = stsDefault')
     242      (
     243        'Component = lbOrders'
     244        'Status = stsDefault')
     245      (
     246        'Component = lblPatientName'
     247        'Status = stsDefault')
     248      (
     249        'Component = pnlMain'
     250        'Status = stsDefault')
     251      (
     252        'Component = lbSections'
     253        'Label = lblDiagSect'
     254        'Status = stsOK')
     255      (
     256        'Component = btnOther'
     257        'Status = stsDefault')
     258      (
     259        'Component = lbDiagnosis'
     260        'Label = lblDiagCodes'
     261        'Status = stsOK')
     262      (
     263        'Component = pnlBottom'
     264        'Status = stsDefault')
     265      (
     266        'Component = cbAddToPDList'
     267        'Status = stsDefault')
     268      (
     269        'Component = cbAddToPL'
     270        'Status = stsDefault')
     271      (
     272        'Component = btnPrimary'
     273        'Status = stsDefault')
     274      (
     275        'Component = btnRemove'
     276        'Status = stsDefault')
     277      (
     278        'Component = btnSelectAll'
     279        'Status = stsDefault')
     280      (
     281        'Component = buOK'
     282        'Status = stsDefault')
     283      (
     284        'Component = buCancel'
     285        'Status = stsDefault')
     286      (
     287        'Component = gbProvDiag'
     288        'Status = stsDefault')
     289      (
     290        'Component = lvDxGrid'
     291        'Status = stsDefault')
     292      (
     293        'Component = frmBALocalDiagnoses'
     294        'Status = stsDefault'))
    269295  end
    270296end
  • cprs/trunk/CPRS-Chart/BA/fBALocalDiagnoses.pas

    r456 r829  
    77  Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls,fPCELex, uConsults, ORFn,
    88  rPCE,DBCtrls, DB, DBClient, uPCE, fEncounterFrame, ComCtrls, Grids, UBAGlobals,
    9   Buttons, Menus, UBACore, UCore;
     9  Buttons, Menus, UBACore, UCore, VA508AccessibilityManager;
    1010
    1111type
     
    2323    lbSections: TORListBox;
    2424    pnlBottom: TORAutoPanel;
    25     lvDxGrid: TListView;
    2625    cbAddToPDList: TCheckBox;
    2726    cbAddToPL: TCheckBox;
     
    3332    btnOther: TButton;
    3433    lbDiagnosis: TORListBox;
    35     ORStaticText1: TORStaticText;
    36     ORStaticText2: TORStaticText;
    37     ORStaticText3: TORStaticText;
    38     ORStaticText4: TORStaticText;
     34    lblDiagSect: TLabel;
     35    lblDiagCodes: TLabel;
    3936    lblPatientName: TStaticText;
     37    gbProvDiag: TGroupBox;
     38    lvDxGrid: TListView;
    4039    procedure buOKClick(Sender: TObject);
    4140    procedure buCancelClick(Sender: TObject);
     
    6564    procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X,
    6665      Y: Integer);
    67     procedure ORStaticText1Enter(Sender: TObject);
    68     procedure ORStaticText1Exit(Sender: TObject);
    69     procedure ORStaticText3Enter(Sender: TObject);
    70     procedure ORStaticText3Exit(Sender: TObject);
     66    procedure FormKeyPress(Sender: TObject; var Key: Char);
    7167
    7268  private
     
    105101    function  PersonalListDxFound(pDxCode:string):boolean;
    106102    procedure ReSetCheckBoxStatus(pDxCode:String);
     103    procedure DeleteSelectedDx;
     104    function  IsCtrlDown: boolean;
    107105
    108106  public
     
    110108     procedure Enter(theCaller: smallint; pOrderIDList: TStringList);
    111109     procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string);
     110
    112111  end;
    113112
     
    137136
    138137uses rCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
    139   uAccessibleStringGrid,ORNet, fProbs, fOrdersSign, UBAConst,
    140   UBAMessages, fReview, uSignItems, fODConsult, fFrame;
     138  ORNet, fProbs, fOrdersSign, UBAConst,
     139  UBAMessages, fReview, uSignItems, fODConsult, fFrame, VAUtils;
    141140
    142141var
     
    176175end;
    177176
     177procedure TfrmBALocalDiagnoses.FormKeyPress(Sender: TObject; var Key: Char);
     178begin
     179  inherited;
     180   if frmBALocalDiagnoses.IsCtrlDown then
     181   begin
     182     if ( Key = #10 ) then
     183        frmBALocalDiagnoses.buOK.Click;
     184   end;
     185   
     186end;
     187
    178188procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings);
    179189{ return section names in format: ListIndex^SectionName (sections begin with '^') }
     
    195205    ECFDiagnosis := TStringList.Create;
    196206    uProblems := TStringList.Create;
    197     lblPatientName.Caption := Patient.Name;
     207    lblPatientName.Caption := Patient.Name + ' Selected Orders';
    198208    DeselectGridItems;
    199209   
     
    501511      begin
    502512         a :=  Piece(BADiagnosis[j], U, 2) + U + Piece(BADiagnosis[j], U, 1) + U + '        ' + Piece(BADiagnosis[j], U, 3) ;
    503          if a = '' then showmessage('found nothing');
     513         if a = '' then ShowMsg('found nothing');
    504514            lbDiagnosis.Items.Add(a);
    505515      end;
     
    578588  inherited;
    579589  deleteDX := True;
    580   lvDxGrid.DeleteSelected;
     590  frmBALocalDiagnoses.DeleteSelectedDX;
    581591  ClearAndDisableCBoxes;
    582592  DeselectGridItems;
    583593  EnsurePrimary;
    584594  deleteDX := False;
    585                                 // if all dx's removed, clear out displaycode
     595  // if all dx's removed, clear out displaycode
    586596  if lvDxGrid.items.Count = 0 then FODConsult.displayDXCode := '';
    587597end;
     
    627637    begin
    628638       DeselectGridItems;
    629        ShowMessage(BA_MAX_DX); //** max  4 diagnoses per order
     639       ShowMsg(BA_MAX_DX); //** max  4 diagnoses per order
    630640    end;
    631641end;
     
    812822    NewList.Clear;
    813823    // ** Add Diagnosis to Problem List if flagged with 'Add' in First Col.
    814     with lvDxGrid do
     824    with frmBALocalDiagnoses.lvDxGrid do
    815825    begin
    816826       for i := 0 to Items.Count-1 do
     
    861871   i : integer;
    862872   tempStr1,tempStr2, tempStr3: string;
    863    tempFactor1,x: string;
     873   tempFactor1: string;
    864874   tempStrList: TStringList;
    865875begin
     
    877887   tempFactor1 := '';
    878888
    879    if lvDxGrid.Items.Count > 0 then
    880    with lvDxGrid do
     889   if frmBALocalDiagnoses.lvDxGrid.Items.Count > 0 then
     890   with frmBALocalDiagnoses.lvDxGrid do
    881891   begin
    882892      for i := 0 to Items.Count-1 do
    883893      begin
    884          x := lvDxGrid.Items[i].Subitems[0];
    885          x := lvDxGrid.Items[i].Subitems[1];
    886          x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
     894     //    x := lvDxGrid.Items[i].Subitems[0];
     895     //    x := lvDxGrid.Items[i].Subitems[1];
     896     //    x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1];
    887897         tempStrList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]);
    888898      end;
     
    11211131      on EListError do
    11221132         begin
    1123          {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}
     1133         {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif}
    11241134         raise;
    11251135         end;
     
    11481158      on EListError do
    11491159         begin
    1150          {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}
     1160         {$ifdef debug}Show508Message('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif}
    11511161         raise;
    11521162         end;
     
    11561166       if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
    11571167       begin
    1158           ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
     1168          ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED);
    11591169          LoadEncounterForm;
    11601170          Refresh;
     
    11791189  if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then
    11801190  begin
    1181      ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED);
     1191     ShowMsg(UBAMessages.BA_PERSONAL_LIST_UPDATED);
    11821192     LoadEncounterForm;
    11831193     Refresh;
     
    12671277  (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
    12681278              TListBox).Items[Index]); {** display the text }
     1279
    12691280end;
    12701281
     
    15261537end;
    15271538
    1528 procedure TfrmBALocalDiagnoses.ORStaticText1Enter(Sender: TObject);
    1529 begin
    1530   inherited;
    1531   (Sender as TORStaticText).Font.Style := [fsBold];
    1532 end;
    1533 
    1534 procedure TfrmBALocalDiagnoses.ORStaticText1Exit(Sender: TObject);
    1535 begin
    1536   inherited;
    1537   (Sender as TORStaticText).Font.Style := [];
    1538 end;
    1539 
    1540 procedure TfrmBALocalDiagnoses.ORStaticText3Enter(Sender: TObject);
    1541 begin
    1542   inherited;
    1543   (Sender as TORStaticText).Font.Style := [fsBold];
    1544 end;
    1545 
    1546 procedure TfrmBALocalDiagnoses.ORStaticText3Exit(Sender: TObject);
    1547 begin
    1548   inherited;
    1549   (Sender as TORStaticText).Font.Style := [];
    1550 end;
    1551 
    15521539procedure TfrmBALocalDiagnoses.ResetCheckBoxStatus(pDxCode:string);
    15531540begin
     
    15561543 if  Not PersonalListDxFound(pDxCode) then
    15571544    cbAddToPDList.Enabled  := True;
    1558 
    1559 
    1560 end;
     1545end;
     1546
     1547procedure TfrmBALocalDiagnoses.DeleteSelectedDx;
     1548var
     1549  I: Integer;
     1550begin
     1551  frmBALocalDiagnoses.lvDxGrid.Items.BeginUpdate;
     1552  try
     1553    for I := frmBALocalDiagnoses.lvDxGrid.Items.Count - 1 downto 0 do
     1554      if  frmBALocalDiagnoses.lvDxGrid.Items[I].Selected then
     1555        frmBALocalDiagnoses.lvdxGrid.Items[I].delete;
     1556  finally
     1557    lvDxGrid.Items.EndUpdate;
     1558  end;
     1559
     1560end;
     1561
     1562function  TfrmBALocalDiagnoses.IsCtrlDown: boolean;
     1563var
     1564  State: TKeyboardState;
     1565begin { isCtrlDown }
     1566  GetKeyboardState(State);
     1567  Result := ((State[VK_CONTROL] and 128)<>0); // Ctrl-button
     1568end; { isCtrlDown }
     1569
     1570
    15611571
    15621572
  • cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.dfm

    r456 r829  
    22  Left = 231
    33  Top = 183
    4   Width = 747
    5   Height = 557
    64  Caption = 'Personal Diagnoses List'
     5  ClientHeight = 530
     6  ClientWidth = 739
    77  Constraints.MinHeight = 100
    88  Constraints.MinWidth = 200
     
    1010  OnCreate = FormCreate
    1111  OnShow = FormShow
     12  ExplicitWidth = 747
     13  ExplicitHeight = 557
    1214  PixelsPerInch = 96
    1315  TextHeight = 13
    14   object Panel1: TPanel
     16  object Panel1: TPanel [0]
    1517    Left = 0
    1618    Top = 0
     
    3436        Width = -3
    3537        Height = 463
    36         Cursor = crHSplit
    3738      end
    3839      object Splitter2: TSplitter
     
    4142        Width = 7
    4243        Height = 463
    43         Cursor = crHSplit
    4444      end
    4545      object Splitter3: TSplitter
     
    4848        Width = 1
    4949        Height = 463
    50         Cursor = crHSplit
    5150      end
    5251      object Splitter5: TSplitter
     
    5554        Width = 2
    5655        Height = 463
    57         Cursor = crHSplit
    5856      end
    5957      object pnlBottom: TPanel
     
    142140          Width = 168
    143141          Height = 17
    144           DragReorder = False
    145142          Sections = <
    146143            item
     
    190187          Width = 201
    191188          Height = 17
    192           DragReorder = False
    193189          Sections = <
    194190            item
     
    233229          Width = 257
    234230          Height = 17
    235           DragReorder = False
    236231          Sections = <
    237232            item
     
    310305    end
    311306  end
     307  inherited amgrMain: TVA508AccessibilityManager
     308    Data = (
     309      (
     310        'Component = Panel1'
     311        'Status = stsDefault')
     312      (
     313        'Component = Panel2'
     314        'Status = stsDefault')
     315      (
     316        'Component = pnlBottom'
     317        'Status = stsDefault')
     318      (
     319        'Component = btnOther'
     320        'Status = stsDefault')
     321      (
     322        'Component = btnOK'
     323        'Status = stsDefault')
     324      (
     325        'Component = Button1'
     326        'Status = stsDefault')
     327      (
     328        'Component = Panel3'
     329        'Status = stsDefault')
     330      (
     331        'Component = lbSections'
     332        'Status = stsDefault')
     333      (
     334        'Component = hdrCntlDxSections'
     335        'Status = stsDefault')
     336      (
     337        'Component = Panel4'
     338        'Status = stsDefault')
     339      (
     340        'Component = lbDiagnosis'
     341        'Status = stsDefault')
     342      (
     343        'Component = hdrCntlDxAdd'
     344        'Status = stsDefault')
     345      (
     346        'Component = Panel5'
     347        'Status = stsDefault')
     348      (
     349        'Component = lbPersonalDx'
     350        'Status = stsDefault')
     351      (
     352        'Component = hdrCntlDx'
     353        'Status = stsDefault')
     354      (
     355        'Component = pnlTop'
     356        'Status = stsDefault')
     357      (
     358        'Component = StaticText3'
     359        'Status = stsDefault')
     360      (
     361        'Component = Panel7'
     362        'Status = stsDefault')
     363      (
     364        'Component = btnAdd'
     365        'Status = stsDefault')
     366      (
     367        'Component = btnDelete'
     368        'Status = stsDefault')
     369      (
     370        'Component = frmBAOptionsDiagnoses'
     371        'Status = stsDefault'))
     372  end
    312373end
  • cprs/trunk/CPRS-Chart/BA/fBAOptionsDiagnoses.pas

    r456 r829  
    77  Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet,
    88  UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst,
    9   ComCtrls;
     9  ComCtrls, VA508AccessibilityManager;
    1010
    1111type
  • cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.dfm

    r456 r829  
    1 object frmConsMedRslt: TfrmConsMedRslt
     1inherited frmConsMedRslt: TfrmConsMedRslt
    22  Left = 468
    33  Top = 172
     
    66  ClientHeight = 242
    77  ClientWidth = 505
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = True
    158  Position = poScreenCenter
    16   OnDestroy = FormDestroy
     9  ExplicitWidth = 320
     10  ExplicitHeight = 240
    1711  PixelsPerInch = 96
    1812  TextHeight = 13
    19   object pnlBase: TORAutoPanel
     13  object pnlBase: TORAutoPanel [0]
    2014    Left = 0
    2115    Top = 0
     
    178172      TabOrder = 3
    179173      OnNeedData = NewPersonNeedData
    180     end
     174      CharsNeedMatch = 1
     175    end
     176  end
     177  inherited amgrMain: TVA508AccessibilityManager
     178    Data = (
     179      (
     180        'Component = pnlBase'
     181        'Status = stsDefault')
     182      (
     183        'Component = cmdOK'
     184        'Status = stsDefault')
     185      (
     186        'Component = cmdCancel'
     187        'Status = stsDefault')
     188      (
     189        'Component = lstMedResults'
     190        'Status = stsDefault')
     191      (
     192        'Component = cmdDetails'
     193        'Status = stsDefault')
     194      (
     195        'Component = ckAlert'
     196        'Status = stsDefault')
     197      (
     198        'Component = calDateofAction'
     199        'Status = stsDefault')
     200      (
     201        'Component = cboPerson'
     202        'Status = stsDefault')
     203      (
     204        'Component = frmConsMedRslt'
     205        'Status = stsDefault'))
    181206  end
    182207end
  • cprs/trunk/CPRS-Chart/Consults/fConsMedRslt.pas

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fAutoSz, ORDtTm, fConsultAlertTo, fRptBox,
     7  VA508AccessibilityManager;
    78
    89type
     
    8283      if MedResult.Action = 'ATTACH' then
    8384        begin
    84           lstMedResults.Items.Assign(GetAssignableMedResults(ConsultIEN));
     85          FastAssign(GetAssignableMedResults(ConsultIEN), lstMedResults.Items);
    8586          ckAlert.Visible := True;
    8687        end
    8788      else if MedResult.Action = 'REMOVE' then
    8889        begin
    89           lstMedResults.Items.Assign(GetRemovableMedResults(ConsultIEN));
     90          FastAssign(GetRemovableMedResults(ConsultIEN), lstMedResults.Items);
    9091          ckAlert.Visible := False;
    9192        end;
     
    134135var
    135136  x: string;
     137  //MsgString, HasImages: string;
    136138begin
    137139  inherited;
    138140  if lstMedResults.ItemIndex = -1 then exit;
    139141  x := Piece(Piece(Piece(lstMedResults.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstMedResults.ItemID, ';', 1);
     142  // ---------------------------------------------------------------
     143  // Don't do this until MED API is changed for new/unassigned results, or false '0' will be broadcast
     144(*  MsgString := 'MED^' + x;
     145  HasImages := BOOLCHAR[StrToIntDef(Piece(x, U, 5), 0) > 0];
     146  SetPiece(HasImages, U, 10, HasImages);
     147  NotifyOtherApps(NAE_REPORT, MsgString);*)
     148  // ---------------------------------------------------------------
    140149  NotifyOtherApps(NAE_REPORT, 'MED^' + x);
    141150  if(not assigned(FShowDetails)) then
  • cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.dfm

    r456 r829  
    1 object frm513Print: Tfrm513Print
     1inherited frm513Print: Tfrm513Print
    22  Left = 116
    33  Top = 375
    4   AutoScroll = False
    54  Caption = 'Print SF 513'
    6   ClientHeight = 308
    7   ClientWidth = 427
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = True
     5  ClientHeight = 306
    156  Position = poScreenCenter
    16   OnCreate = FormCreate
    17   OnDestroy = FormDestroy
     7  ExplicitHeight = 340
    188  PixelsPerInch = 96
    199  TextHeight = 13
    20   object lblPrintTo: TLabel
     10  object lblPrintTo: TLabel [0]
    2111    Left = 7
    2212    Top = 265
     
    2414    Height = 13
    2515  end
    26   object lblConsultTitle: TMemo
     16  object lblConsultTitle: TMemo [1]
    2717    Left = 10
    2818    Top = 8
     
    3626    TabOrder = 0
    3727  end
    38   object grpChooseCopy: TGroupBox
     28  object grpChooseCopy: TGroupBox [2]
    3929    Left = 321
    4030    Top = 4
     
    6454    end
    6555  end
    66   object grpDevice: TGroupBox
     56  object grpDevice: TGroupBox [3]
    6757    Left = 8
    6858    Top = 69
     
    131121      OnChange = cboDeviceChange
    132122      OnNeedData = cboDeviceNeedData
     123      CharsNeedMatch = 1
    133124    end
    134125  end
    135   object cmdOK: TButton
     126  object cmdOK: TButton [4]
    136127    Left = 267
    137128    Top = 272
     
    143134    OnClick = cmdOKClick
    144135  end
    145   object cmdCancel: TButton
     136  object cmdCancel: TButton [5]
    146137    Left = 347
    147138    Top = 272
     
    153144    OnClick = cmdCancelClick
    154145  end
    155   object chkDefault: TCheckBox
     146  object chkDefault: TCheckBox [6]
    156147    Left = 7
    157148    Top = 288
     
    161152    TabOrder = 3
    162153  end
     154  inherited amgrMain: TVA508AccessibilityManager
     155    Data = (
     156      (
     157        'Component = lblConsultTitle'
     158        'Status = stsDefault')
     159      (
     160        'Component = grpChooseCopy'
     161        'Status = stsDefault')
     162      (
     163        'Component = radChartCopy'
     164        'Status = stsDefault')
     165      (
     166        'Component = radWorkCopy'
     167        'Status = stsDefault')
     168      (
     169        'Component = grpDevice'
     170        'Status = stsDefault')
     171      (
     172        'Component = txtRightMargin'
     173        'Status = stsDefault')
     174      (
     175        'Component = txtPageLength'
     176        'Status = stsDefault')
     177      (
     178        'Component = cboDevice'
     179        'Status = stsDefault')
     180      (
     181        'Component = cmdOK'
     182        'Status = stsDefault')
     183      (
     184        'Component = cmdCancel'
     185        'Status = stsDefault')
     186      (
     187        'Component = chkDefault'
     188        'Status = stsDefault')
     189      (
     190        'Component = frm513Print'
     191        'Status = stsDefault'))
     192  end
    163193  object dlgWinPrinter: TPrintDialog
    164194    Left = 268
  • cprs/trunk/CPRS-Chart/Consults/fConsult513Prt.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls;
     7  fAutoSz, ORCtrls, StdCtrls, Mask, ORNet, ORFn, ComCtrls,
     8  VA508AccessibilityManager, uReports;
    89
    910type
     
    2627    procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
    2728      Direction, InsertAt: Integer);
    28     procedure FormCreate(Sender: TObject);
    2929    procedure cboDeviceChange(Sender: TObject);
    3030    procedure radChartCopyClick(Sender: TObject);
     
    3232    procedure cmdOKClick(Sender: TObject);
    3333    procedure cmdCancelClick(Sender: TObject);
    34     procedure FormDestroy(Sender: TObject);
     34
    3535  private
    3636    { Private declarations }
     
    9898end;
    9999
    100 procedure Tfrm513Print.FormCreate(Sender: TObject);
    101 begin
    102   inherited;
    103   FReportText := TRichEdit.Create(Self);
    104   with FReportText do
    105     begin
    106       Parent := Self;
    107       Visible := False;
    108       Width := 600;
    109     end;
    110 end;
    111 
    112100procedure Tfrm513Print.DisplaySelectDevice;
    113101begin
     
    157145begin
    158146  inherited;
     147  FReportText := CreateReportTextComponent(Self);
    159148  RemoteSiteID := '';
    160149  RemoteQuery := '';
     
    169158      if dlgWinPrinter.Execute then with FReportText do
    170159        begin
    171           FReportText.Lines.Assign(GetFormattedSF513(FConsult, ChartCopy));
     160          QuickCopy(GetFormattedSF513(FConsult, ChartCopy), FReportText);
    172161          PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg);
    173162          if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK);
     
    183172  if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
    184173  User.CurrentPrinter := cboDevice.ItemID;
     174  FReportText.Free;
    185175  Close;
    186176end;
     
    192182end;
    193183
    194 procedure Tfrm513Print.FormDestroy(Sender: TObject);
    195 begin
    196   FReportText.Free;
    197   inherited;
    198 end;
    199 
    200184end.
  • cprs/trunk/CPRS-Chart/Consults/fConsultAct.dfm

    r456 r829  
    1 object frmConsultAction: TfrmConsultAction
     1inherited frmConsultAction: TfrmConsultAction
    22  Left = 277
    33  Top = 217
    4   Width = 600
    5   Height = 406
    64  BorderIcons = []
    75  Caption = 'frmConsultAction'
    8   Color = clBtnFace
     6  ClientHeight = 379
     7  ClientWidth = 592
    98  Constraints.MinHeight = 406
    109  Constraints.MinWidth = 600
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    1610  OldCreateOrder = True
    1711  Position = poScreenCenter
    1812  PixelsPerInch = 96
    1913  TextHeight = 13
    20   object pnlBase: TPanel
     14  object pnlBase: TPanel [0]
    2115    Left = 0
    2216    Top = 0
     
    360354    end
    361355  end
     356  inherited amgrMain: TVA508AccessibilityManager
     357    Data = (
     358      (
     359        'Component = pnlBase'
     360        'Status = stsDefault')
     361      (
     362        'Component = pnlForward'
     363        'Status = stsDefault')
     364      (
     365        'Component = Label1'
     366        'Status = stsDefault')
     367      (
     368        'Component = cboAttentionOf'
     369        'Status = stsDefault')
     370      (
     371        'Component = cboUrgency'
     372        'Status = stsDefault')
     373      (
     374        'Component = treService'
     375        'Status = stsDefault')
     376      (
     377        'Component = cboService'
     378        'Status = stsDefault')
     379      (
     380        'Component = pnlOther'
     381        'Status = stsDefault')
     382      (
     383        'Component = pnlSigFind'
     384        'Status = stsDefault')
     385      (
     386        'Component = grpSigFindings'
     387        'Status = stsDefault')
     388      (
     389        'Component = pnlComments'
     390        'Status = stsDefault')
     391      (
     392        'Component = memComments'
     393        'Status = stsDefault')
     394      (
     395        'Component = pnlAlert'
     396        'Status = stsDefault')
     397      (
     398        'Component = lblAutoAlerts'
     399        'Status = stsDefault')
     400      (
     401        'Component = ckAlert'
     402        'Status = stsDefault')
     403      (
     404        'Component = pnlAllActions'
     405        'Status = stsDefault')
     406      (
     407        'Component = calDateofAction'
     408        'Status = stsDefault')
     409      (
     410        'Component = cmdOK'
     411        'Status = stsDefault')
     412      (
     413        'Component = cmdCancel'
     414        'Status = stsDefault')
     415      (
     416        'Component = cboPerson'
     417        'Status = stsDefault')
     418      (
     419        'Component = frmConsultAction'
     420        'Status = stsDefault'))
     421  end
    362422end
  • cprs/trunk/CPRS-Chart/Consults/fConsultAct.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
    7   StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm;
     7  StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmConsultAction = class(TForm)
     11  TfrmConsultAction = class(TfrmBase508Form)
    1112    lblActionBy: TOROffsetLabel;
    1213    calDateofAction: TORDateBox;
     
    160161   begin
    161162     OrdItmIEN := GetOrderableIEN(IntToStr(ConsultRec.ORFileNumber));
    162      SvcList.Assign(GetProcedureServices(OrdItmIEN));
    163      //SvcList.Assign(GetProcedureServices(ProcIEN));   RPC expects pointer to 101.43, NOT 123.3  (RV)
     163     FastAssign(GetProcedureServices(OrdItmIEN), SvcList);
     164     //FastAssign(GetProcedureServices(ProcIEN), SvcList);   RPC expects pointer to 101.43, NOT 123.3  (RV)
    164165     i := SvcList.IndexOf(IntToStr(ConsultRec.ToService) + U + Trim(ExternalName(ConsultRec.ToService, 123.5)));
    165166     if i > -1 then SvcList.Delete(i);
     
    167168   end
    168169 else
    169    SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN));           {RV}
     170   FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN), SvcList);           {RV}
    170171 if (IsProcedure and (SvcList.Count <= 0)) then
    171172   begin
     
    204205 FToService := cboService.ItemIEN;
    205206 cboAttentionOf.InitLongList('') ;
    206  with cboUrgency do       
    207   begin       
    208     Items.Assign(SubsetofUrgencies(ConsultRec.IEN)) ;
     207 with cboUrgency do
     208  begin
     209    FastAssign(SubsetofUrgencies(ConsultRec.IEN), cboUrgency.Items) ;
    209210    MixedCaseList(Items) ;
    210211    SelectByIEN(ConsultRec.Urgency);
     
    562563end;                                                                     
    563564
    564 procedure TfrmConsultAction.ShowAutoAlertText;
     565(*procedure TfrmConsultAction.ShowAutoAlertText;      ****  SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan
    565566const
    566567  TX_ALERT1          = 'An alert will automatically be sent to ';
     
    588589   end;
    589590   lblAutoAlerts.Caption := x;
    590 end;
     591end;*)
     592
     593procedure TfrmConsultAction.ShowAutoAlertText;
     594const
     595  TX_ALERT1          = 'An alert will automatically be sent to ';
     596  TX_ALERT_PROVIDER  = 'the ordering provider';
     597  TX_ALERT_SVC_USERS = 'notification recipients for this service.';
     598  TX_ALERT_NOBODY    = 'No automatic alerts will be sent.';  // this should be rare to never
     599var
     600  x: string;
     601begin
     602  case FUserLevel of
     603    UL_NONE, UL_REVIEW:
     604      begin
     605        if FUserIsRequester then
     606          x := TX_ALERT1 + TX_ALERT_SVC_USERS
     607        else
     608          x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
     609      end;
     610    UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
     611      begin
     612        if FUserIsRequester then
     613          //x := TX_ALERT_NOBODY   Replace with following line
     614          x := TX_ALERT1 + TX_ALERT_SVC_USERS
     615        else
     616          x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
     617      end;
     618    UL_UNRESTRICTED:
     619      begin
     620        if FUserIsRequester then
     621          x := TX_ALERT1 + TX_ALERT_SVC_USERS
     622        else
     623          x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
     624      end;
     625  end;
     626  lblAutoAlerts.Caption := x;
     627end;
     628
    591629
    592630initialization
  • cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.dfm

    r456 r829  
    1 object frmConsultAlertsTo: TfrmConsultAlertsTo
     1inherited frmConsultAlertsTo: TfrmConsultAlertsTo
    22  Left = 297
    33  Top = 206
     
    55  Caption = 'Send Alert'
    66  ClientHeight = 262
    7   ClientWidth = 358
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     7  ClientWidth = 371
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
    21     Width = 358
     15    Width = 371
    2216    Height = 262
    2317    Align = alClient
    2418    BevelOuter = bvNone
    2519    TabOrder = 0
     20    ExplicitWidth = 358
    2621    object SrcLabel: TLabel
    2722      Left = 12
     
    3227    end
    3328    object DstLabel: TLabel
    34       Left = 196
     29      Left = 217
    3530      Top = 14
    3631      Width = 132
     
    4540      Caption = 'OK'
    4641      ModalResult = 1
    47       TabOrder = 2
     42      TabOrder = 4
    4843      OnClick = cmdOKClick
    4944    end
     
    5651      Caption = 'Cancel'
    5752      ModalResult = 2
    58       TabOrder = 3
     53      TabOrder = 5
    5954      OnClick = cmdCancelClick
    6055    end
     
    8378      OnMouseClick = cboSrcListMouseClick
    8479      OnNeedData = cboSrcListNeedData
     80      CharsNeedMatch = 1
    8581    end
    8682    object DstList: TORListBox
    87       Left = 196
     83      Left = 217
    8884      Top = 30
    8985      Width = 144
     
    9389      ParentShowHint = False
    9490      ShowHint = True
    95       TabOrder = 1
     91      TabOrder = 2
    9692      OnClick = DstListClick
    9793      Caption = 'Currently selected recipients'
     
    10096      Pieces = '2'
    10197    end
     98    object btnAdd: TButton
     99      Left = 160
     100      Top = 109
     101      Width = 51
     102      Height = 25
     103      Caption = 'Add'
     104      TabOrder = 1
     105      OnClick = cboSrcListMouseClick
     106    end
     107    object btnRemove: TButton
     108      Left = 160
     109      Top = 140
     110      Width = 51
     111      Height = 25
     112      Caption = 'Remove'
     113      TabOrder = 3
     114      OnClick = DstListClick
     115    end
     116  end
     117  inherited amgrMain: TVA508AccessibilityManager
     118    Data = (
     119      (
     120        'Component = pnlBase'
     121        'Status = stsDefault')
     122      (
     123        'Component = cmdOK'
     124        'Status = stsDefault')
     125      (
     126        'Component = cmdCancel'
     127        'Status = stsDefault')
     128      (
     129        'Component = cboSrcList'
     130        'Status = stsDefault')
     131      (
     132        'Component = DstList'
     133        'Status = stsDefault')
     134      (
     135        'Component = btnAdd'
     136        'Status = stsDefault')
     137      (
     138        'Component = btnRemove'
     139        'Status = stsDefault')
     140      (
     141        'Component = frmConsultAlertsTo'
     142        'Status = stsDefault'))
    102143  end
    103144end
  • cprs/trunk/CPRS-Chart/Consults/fConsultAlertTo.pas

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmConsultAlertsTo = class(TForm)
     9  TfrmConsultAlertsTo = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;
     
    1515    DstLabel: TLabel;
    1616    pnlBase: TORAutoPanel;
     17    btnAdd: TButton;
     18    btnRemove: TButton;
    1719    procedure cboSrcListNeedData(Sender: TObject; const StartFrom: String;
    1820      Direction, InsertAt: Integer);
  • cprs/trunk/CPRS-Chart/Consults/fConsultBD.dfm

    r456 r829  
    1 object frmConsultsByDate: TfrmConsultsByDate
     1inherited frmConsultsByDate: TfrmConsultsByDate
    22  Left = 372
    33  Top = 217
    4   Width = 259
    5   Height = 178
    64  BorderIcons = []
    75  Caption = 'List Consults by Date Range'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 151
     7  ClientWidth = 251
    148  OldCreateOrder = True
    159  Position = poScreenCenter
     10  ExplicitWidth = 259
     11  ExplicitHeight = 178
    1612  PixelsPerInch = 96
    1713  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     14  object pnlBase: TORAutoPanel [0]
    1915    Left = 0
    2016    Top = 0
     
    9086    end
    9187  end
     88  inherited amgrMain: TVA508AccessibilityManager
     89    Data = (
     90      (
     91        'Component = pnlBase'
     92        'Status = stsDefault')
     93      (
     94        'Component = calBeginDate'
     95        'Status = stsDefault')
     96      (
     97        'Component = calEndDate'
     98        'Status = stsDefault')
     99      (
     100        'Component = radSort'
     101        'Status = stsDefault')
     102      (
     103        'Component = cmdOK'
     104        'Status = stsDefault')
     105      (
     106        'Component = cmdCancel'
     107        'Status = stsDefault')
     108      (
     109        'Component = frmConsultsByDate'
     110        'Status = stsDefault'))
     111  end
    92112end
  • cprs/trunk/CPRS-Chart/Consults/fConsultBD.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
    7   StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults;
     7  StdCtrls, ExtCtrls, ORCtrls, ORDtTm, uConsults, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmConsultsByDate = class(TForm)
     11  TfrmConsultsByDate = class(TfrmBase508Form)
    1112    pnlBase: TORAutoPanel;
    1213    lblBeginDate: TLabel;
  • cprs/trunk/CPRS-Chart/Consults/fConsultBS.dfm

    r456 r829  
    1 object frmConsultsByService: TfrmConsultsByService
     1inherited frmConsultsByService: TfrmConsultsByService
    22  Left = 339
    33  Top = 175
    4   Width = 328
    5   Height = 412
    64  BorderIcons = []
    75  Caption = 'List Consults by Service'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 385
     7  ClientWidth = 320
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
     
    9084      ListItemsOnly = True
    9185      LongList = False
     86      LookupPiece = 0
    9287      MaxLength = 0
    9388      Pieces = '2'
     
    9792      OnKeyPause = cboServiceSelect
    9893      OnMouseClick = cboServiceSelect
     94      CharsNeedMatch = 1
    9995    end
    10096  end
     97  inherited amgrMain: TVA508AccessibilityManager
     98    Data = (
     99      (
     100        'Component = pnlBase'
     101        'Status = stsDefault')
     102      (
     103        'Component = radSort'
     104        'Status = stsDefault')
     105      (
     106        'Component = cmdOK'
     107        'Status = stsDefault')
     108      (
     109        'Component = cmdCancel'
     110        'Status = stsDefault')
     111      (
     112        'Component = treService'
     113        'Status = stsDefault')
     114      (
     115        'Component = cboService'
     116        'Status = stsDefault')
     117      (
     118        'Component = frmConsultsByService'
     119        'Status = stsDefault'))
     120  end
    101121end
  • cprs/trunk/CPRS-Chart/Consults/fConsultBS.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults;
     7  ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmConsultsByService = class(TForm)
     11  TfrmConsultsByService = class(TfrmBase508Form)
    1112    pnlBase: TORAutoPanel;
    1213    lblService: TLabel;
     
    7172      ClientHeight := H; pnlBase.Height := H;
    7273      FChanged := False;
    73       //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP));                         {RV}
    74       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP));             {RV}
     74      //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
     75      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);             {RV}
    7576      SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
    7677      for i := 0 to SvcList.Count - 1 do
  • cprs/trunk/CPRS-Chart/Consults/fConsultBSt.dfm

    r456 r829  
    1 object frmConsultsByStatus: TfrmConsultsByStatus
     1inherited frmConsultsByStatus: TfrmConsultsByStatus
    22  Left = 286
    33  Top = 202
    4   Width = 316
    5   Height = 232
    64  BorderIcons = []
    75  Caption = 'List Consults by Status'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 205
     7  ClientWidth = 308
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
     
    7872    end
    7973  end
     74  inherited amgrMain: TVA508AccessibilityManager
     75    Data = (
     76      (
     77        'Component = pnlBase'
     78        'Status = stsDefault')
     79      (
     80        'Component = radSort'
     81        'Status = stsDefault')
     82      (
     83        'Component = lstStatus'
     84        'Status = stsDefault')
     85      (
     86        'Component = cmdOK'
     87        'Status = stsDefault')
     88      (
     89        'Component = cmdCancel'
     90        'Status = stsDefault')
     91      (
     92        'Component = frmConsultsByStatus'
     93        'Status = stsDefault'))
     94  end
    8095end
  • cprs/trunk/CPRS-Chart/Consults/fConsultBSt.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults;
     7  ExtCtrls, ORCtrls, StdCtrls, ORFn, uConsults, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmConsultsByStatus = class(TForm)
     11  TfrmConsultsByStatus = class(TfrmBase508Form)
    1112    pnlBase: TORAutoPanel;
    1213    lblStatus: TLabel;
     
    6263      FChanged := False;
    6364      with radSort do {if SortConsultsAscending then ItemIndex := 0 else} ItemIndex := 1;
    64       lstStatus.Items.Assign(SubSetOfStatus);
     65      FastAssign(SubSetOfStatus, lstStatus.Items);
    6566      CurrentStatus := CurrentContext.Status;
    6667      if CurrentStatus <> '' then with lstStatus do
  • cprs/trunk/CPRS-Chart/Consults/fConsults.dfm

    r456 r829  
    11inherited frmConsults: TfrmConsults
    2   Left = 247
    3   Top = 174
    4   Width = 723
    5   Height = 467
     2  Left = 402
     3  Top = 80
    64  HelpContext = 6000
    75  Caption = 'Consults Page'
     6  ClientHeight = 421
     7  ClientWidth = 715
    88  Menu = mnuConsults
    99  OnDestroy = FormDestroy
    1010  OnHide = FormHide
    11   OnMouseMove = FormMouseMove
    1211  OnShow = FormShow
     12  ExplicitWidth = 723
     13  ExplicitHeight = 467
    1314  PixelsPerInch = 96
    1415  TextHeight = 13
     
    1617    Top = 416
    1718    Width = 715
     19    ExplicitTop = 416
     20    ExplicitWidth = 715
    1821  end
    1922  inherited sptHorz: TSplitter
     
    2225    Height = 416
    2326    OnCanResize = sptHorzCanResize
     27    ExplicitLeft = 83
     28    ExplicitWidth = 2
     29    ExplicitHeight = 416
    2430  end
    2531  inherited pnlRight: TPanel [2]
     
    2733    Width = 630
    2834    Height = 416
     35    OnExit = pnlRightExit
    2936    OnResize = pnlRightResize
     37    ExplicitLeft = 85
     38    ExplicitWidth = 630
     39    ExplicitHeight = 416
    3040    object sptVert: TSplitter
    3141      Left = 0
     
    4454      BevelOuter = bvNone
    4555      TabOrder = 0
    46       OnExit = pnlResultsExit
    4756      object lblTitle: TOROffsetLabel
    4857        Left = 0
     
    91100        WantReturns = False
    92101        WordWrap = False
    93         OnMouseMove = FormMouseMove
    94102      end
    95103    end
     
    112120      BevelOuter = bvNone
    113121      TabOrder = 1
    114       OnExit = pnlResultsExit
    115122      OnResize = pnlResultsResize
    116123      object memResults: TRichEdit
     
    132139        OnChange = memResultChange
    133140        OnKeyDown = memResultsKeyDown
    134         OnMouseMove = FormMouseMove
    135141      end
    136142      object pnlFields: TPanel
     
    240246          TabOrder = 0
    241247          OnClick = cmdChangeClick
    242           OnMouseMove = FormMouseMove
    243248        end
    244249        object txtSubject: TCaptionEdit
     
    254259          TabOrder = 1
    255260          Text = 'txtSubject'
    256           OnMouseMove = FormMouseMove
    257261          Caption = 'Subject'
    258262        end
     
    263267    Width = 83
    264268    Height = 416
     269    OnExit = pnlLeftExit
    265270    OnResize = pnlLeftResize
     271    ExplicitWidth = 83
     272    ExplicitHeight = 416
    266273    object splConsults: TSplitter
    267274      Left = 0
     
    280287      BevelOuter = bvNone
    281288      TabOrder = 1
    282       OnExit = pnlActionExit
    283289      object splDrawers: TSplitter
    284290        Left = 0
     
    294300        Width = 83
    295301        Height = 21
     302        Align = alTop
    296303        Caption = 'New Consult'
    297304        Constraints.MinHeight = 21
    298         TabOrder = 2
     305        Default = True
     306        TabOrder = 1
    299307        OnClick = cmdNewConsultClick
    300         OnMouseMove = FormMouseMove
    301         Align = alTop
     308        OnExit = cmdNewConsultExit
    302309      end
    303310      object cmdNewProc: TORAlignButton
     
    306313        Width = 83
    307314        Height = 21
     315        Align = alTop
    308316        Caption = 'New Procedure'
    309317        Constraints.MinHeight = 21
    310         TabOrder = 3
     318        TabOrder = 2
    311319        OnClick = cmdNewProcClick
    312         OnMouseMove = FormMouseMove
    313         Align = alTop
    314320      end
    315321      object cmdEditResubmit: TORAlignButton
     
    318324        Width = 83
    319325        Height = 21
     326        Align = alTop
    320327        Caption = 'Edit/Resubmit'
    321328        Constraints.MinHeight = 21
     
    326333        Font.Style = []
    327334        ParentFont = False
    328         TabOrder = 1
     335        TabOrder = 0
    329336        Visible = False
    330337        OnClick = cmdEditResubmitClick
    331         OnMouseMove = FormMouseMove
    332         Align = alTop
     338        OnExit = cmdEditResubmitExit
    333339      end
    334340      object lstNotes: TORListBox
     
    345351        Visible = False
    346352        OnClick = lstNotesClick
    347         OnMouseMove = FormMouseMove
    348353        ItemTipColor = clWindow
    349354        LongList = False
     
    359364        Constraints.MinWidth = 30
    360365        HideSelection = False
     366        Images = dmodShared.imgNotes
    361367        Indent = 19
    362368        PopupMenu = popNoteList
    363369        ReadOnly = True
    364         TabOrder = 0
     370        StateImages = dmodShared.imgImages
     371        TabOrder = 3
    365372        OnChange = tvCsltNotesChange
    366373        OnClick = tvCsltNotesClick
     
    369376        OnDragOver = tvCsltNotesDragOver
    370377        OnExpanded = tvCsltNotesExpanded
    371         OnMouseMove = FormMouseMove
    372378        OnStartDrag = tvCsltNotesStartDrag
    373379        Caption = 'Consult Notes'
     
    380386      Width = 83
    381387      Height = 21
     388      Align = alBottom
    382389      Caption = 'Encounter'
    383390      Enabled = False
     
    385392      Visible = False
    386393      OnClick = cmdPCEClick
    387       OnExit = pnlActionExit
    388       OnMouseMove = FormMouseMove
    389       Align = alBottom
    390394    end
    391395    object pnlConsultList: TPanel
     
    436440        Align = alClient
    437441        HideSelection = False
    438         Indent = 15
     442        Images = dmodShared.imgConsults
     443        Indent = 19
    439444        PopupMenu = popNoteList
    440445        ReadOnly = True
    441446        TabOrder = 0
    442         OnAddition = tvConsultsAddition
    443447        OnClick = tvConsultsClick
    444448        OnCollapsed = tvConsultsCollapsed
    445         OnDeletion = tvConsultsDeletion
    446449        OnExit = tvConsultsExit
    447450        OnExpanded = tvConsultsExpanded
    448451        OnKeyUp = tvConsultsKeyUp
    449         OnMouseMove = FormMouseMove
    450452        Caption = 'Consults'
    451453        NodePiece = 0
     
    453455      end
    454456    end
     457  end
     458  inherited amgrMain: TVA508AccessibilityManager
     459    Data = (
     460      (
     461        'Component = pnlRead'
     462        'Status = stsDefault')
     463      (
     464        'Component = memConsult'
     465        'Status = stsDefault')
     466      (
     467        'Component = memPCEShow'
     468        'Status = stsDefault')
     469      (
     470        'Component = pnlResults'
     471        'Status = stsDefault')
     472      (
     473        'Component = memResults'
     474        'Status = stsDefault')
     475      (
     476        'Component = pnlFields'
     477        'Status = stsDefault')
     478      (
     479        'Component = lblRefDate'
     480        'Status = stsDefault')
     481      (
     482        'Component = lblAuthor'
     483        'Status = stsDefault')
     484      (
     485        'Component = lblVisit'
     486        'Status = stsDefault')
     487      (
     488        'Component = lblCosigner'
     489        'Status = stsDefault')
     490      (
     491        'Component = lblSubject'
     492        'Status = stsDefault')
     493      (
     494        'Component = lblNewTitle'
     495        'Status = stsDefault')
     496      (
     497        'Component = cmdChange'
     498        'Status = stsDefault')
     499      (
     500        'Component = txtSubject'
     501        'Status = stsDefault')
     502      (
     503        'Component = pnlAction'
     504        'Status = stsDefault')
     505      (
     506        'Component = cmdNewConsult'
     507        'Status = stsDefault')
     508      (
     509        'Component = cmdNewProc'
     510        'Status = stsDefault')
     511      (
     512        'Component = cmdEditResubmit'
     513        'Status = stsDefault')
     514      (
     515        'Component = lstNotes'
     516        'Status = stsDefault')
     517      (
     518        'Component = tvCsltNotes'
     519        'Status = stsDefault')
     520      (
     521        'Component = cmdPCE'
     522        'Status = stsDefault')
     523      (
     524        'Component = pnlConsultList'
     525        'Status = stsDefault')
     526      (
     527        'Component = lstConsults'
     528        'Status = stsDefault')
     529      (
     530        'Component = tvConsults'
     531        'Status = stsDefault')
     532      (
     533        'Component = pnlLeft'
     534        'Status = stsDefault')
     535      (
     536        'Component = pnlRight'
     537        'Status = stsDefault')
     538      (
     539        'Component = frmConsults'
     540        'Status = stsDefault'))
    455541  end
    456542  object popNoteMemo: TPopupMenu
     
    10441130    Top = 303
    10451131  end
     1132  object imgLblNotes: TVA508ImageListLabeler
     1133    Components = <
     1134      item
     1135        Component = tvCsltNotes
     1136      end>
     1137    Labels = <>
     1138    RemoteLabeler = dmodShared.imgLblNotes
     1139    Left = 16
     1140    Top = 48
     1141  end
     1142  object imgLblImages: TVA508ImageListLabeler
     1143    Components = <
     1144      item
     1145        Component = tvCsltNotes
     1146      end>
     1147    Labels = <>
     1148    RemoteLabeler = dmodShared.imgLblImages
     1149    Left = 8
     1150    Top = 88
     1151  end
     1152  object imgLblConsults: TVA508ImageListLabeler
     1153    Components = <
     1154      item
     1155        Component = tvConsults
     1156      end>
     1157    Labels = <>
     1158    RemoteLabeler = dmodShared.imgLblConsults
     1159    Left = 56
     1160    Top = 96
     1161  end
    10461162end
  • cprs/trunk/CPRS-Chart/Consults/fConsults.pas

    r456 r829  
    11unit fConsults;
    2 
     2{Notes of Intent:
     3  Tab Order:
     4    The tab order has been custom coded to place the pnlRight in the Tab order
     5    right after the tvConsults. 
     6}
    37
    48interface
     
    711  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm,
    812  fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE,
    9   ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList;
     13  ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList,
     14  VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
    1015
    1116type
     
    172177    mnuViewRemoteData: TMenuItem;
    173178    mnuViewPostings: TMenuItem;
     179    imgLblNotes: TVA508ImageListLabeler;
     180    imgLblImages: TVA508ImageListLabeler;
     181    imgLblConsults: TVA508ImageListLabeler;
    174182    procedure mnuChartTabClick(Sender: TObject);
    175183    procedure lstConsultsClick(Sender: TObject);
     
    268276    procedure popNoteMemoPreviewClick(Sender: TObject);
    269277    procedure popNoteMemoInsTemplateClick(Sender: TObject);
    270     procedure tvConsultsAddition(Sender: TObject; Node: TTreeNode);
    271     procedure tvConsultsDeletion(Sender: TObject; Node: TTreeNode);
    272278    procedure tvConsultsExit(Sender: TObject);
    273     procedure pnlResultsExit(Sender: TObject);
    274     procedure pnlActionExit(Sender: TObject);
    275279    procedure FormHide(Sender: TObject);
    276280    procedure FormShow(Sender: TObject);
    277     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
    278       Y: Integer);
    279281    procedure ViewInfo(Sender: TObject);
    280282    procedure mnuViewInformationClick(Sender: TObject);
     283    procedure pnlLeftExit(Sender: TObject);
     284    procedure pnlRightExit(Sender: TObject);
     285    procedure cmdEditResubmitExit(Sender: TObject);
     286    procedure cmdNewConsultExit(Sender: TObject);
    281287  private
     288    FocusToRightPanel : Boolean;
    282289    FEditingIndex: Integer;      // TIU index of document being currently edited
    283290    FChanged: Boolean;
     
    300307    FNotifPending: boolean;
    301308    FOldFramePnlPatientExit: TNotifyEvent;
    302     FOldDrawerPnlTemplatesButtonExit: TNotifyEvent;
    303     FOldDrawerPnlEncounterButtonExit: TNotifyEvent;
    304     FOldDrawerEdtSearchExit: TNotifyEvent;
    305     FMousing: TDateTime;
     309    //FMousing: TDateTime;
     310    procedure DoLeftPanelCustomShiftTab;
    306311    procedure frmFramePnlPatientExit(Sender: TObject);
    307     procedure frmDrawerPnlTemplatesButtonExit(Sender: TObject);
    308     procedure frmDrawerPnlEncounterButtonExit(Sender: TObject);
    309     procedure frmDrawerEdtSearchExit(Sender: TObject);
    310312    procedure DoAutoSave(Suppress: integer = 1);
    311313    function GetTitleText(AnIndex: Integer): string;
     
    395397     fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor,
    396398     dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields,
    397      uTemplates,  uAccessibleTreeView, uAccessibleTreeNode, fTemplateDialog, DateUtils;
     399     uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter;
    398400
    399401const
     
    906908      DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote);
    907909      ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
    908       memResults.Lines.Assign(TmpBoilerPlate);
     910      QuickCopyWith508Msg(TmpBoilerPlate, memResults);
    909911      TmpBoilerPlate.Free;
    910912    end;
     
    11071109      DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
    11081110      ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
    1109       memResults.Lines.Assign(TmpBoilerPlate);
     1111      QuickCopyWith508Msg(TmpBoilerPlate, memResults);
    11101112      TmpBoilerPlate.Free;
    11111113    end;
     
    12211223
    12221224{ Form events -----------------------------------------------------------------}
     1225
     1226procedure TfrmConsults.pnlRightExit(Sender: TObject);
     1227begin
     1228  inherited;
     1229  if TabIsPressed then
     1230    FindNextControl(tvConsults, True, True, False).SetFocus
     1231  else if ShiftTabIsPressed then
     1232    FindNextControl(pnlLeft, True, True, False).SetFocus;
     1233end;
    12231234
    12241235procedure TfrmConsults.pnlRightResize(Sender: TObject);
     
    13831394end;
    13841395
     1396procedure TfrmConsults.cmdNewConsultExit(Sender: TObject);
     1397begin
     1398  inherited;
     1399  if Not cmdEditResubmit.Visible then
     1400    DoLeftPanelCustomShiftTab;
     1401end;
     1402
    13851403procedure TfrmConsults.cmdNewProcClick(Sender: TObject);
    13861404begin
     
    23382356         mnuActPrintSF513.Enabled     :=  True;
    23392357         mnuActConsultResults.Enabled :=  (lstConsults.ItemIEN > 0) and
    2340                                           (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN)) and
     2358                                          (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and
    23412359                                          ((status<>ST_DISCONTINUED) and
    23422360                                           (status<>ST_CANCELLED)))
     
    23652383  mnuActComplete.Enabled           :=   mnuActConsultResults.Enabled and
    23662384                                        ((MenuAccessRec.UserLevel = UL_UPDATE) or
    2367                                         (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN))
     2385                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
     2386                                        (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
    23682387                                        and
    23692388                                       ((ConsultRec.ORStatus=ST_PENDING) or
     
    23742393  mnuActMakeAddendum.Enabled       :=  mnuActConsultResults.Enabled and
    23752394                                        ((MenuAccessRec.UserLevel = UL_UPDATE) or
    2376                                         (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN))
     2395                                        (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
     2396                                        (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
    23772397                                        and
    23782398                                        (ConsultRec.ORStatus=ST_COMPLETE) and
     
    26312651       if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then
    26322652         begin
    2633            memConsult.Lines.Assign(GetDetailedMedicineResults(lstNotes.ItemID));
     2653           QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult);
    26342654           x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1);
    2635            NotifyOtherApps(NAE_REPORT, 'MED^' + x);
     2655           x := 'MED^' + x;
     2656           SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
     2657           NotifyOtherApps(NAE_REPORT, x);
    26362658         end
    26372659       else
     
    26402662           mnuActChange.Enabled     := False;
    26412663           mnuActLoadBoiler.Enabled := False;
    2642            NotifyOtherApps(NAE_REPORT, 'TIU^' + lstNotes.ItemID);
     2664           x := 'TIU^' + lstNotes.ItemID;
     2665           SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
     2666           NotifyOtherApps(NAE_REPORT, x);
    26432667         end;
    26442668       memConsult.SelStart := 0;
     
    28142838end;
    28152839
     2840{for printing multiple notes}
    28162841procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
    28172842var
     
    28192844  i: integer;
    28202845begin
    2821   inherited;
    28222846  with AForm.lbIDParents do
    2823   begin
    2824     for i := 0 to Items.Count - 1 do
    2825      begin
    2826        if Selected[i] then
    2827         begin
    2828          NoteIEN := StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
    2829          if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else
    2830           begin
    2831            if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
    2832            if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
    2833           end;
    2834         end; {if selected}
    2835      end; {for}
    2836   end; {with}
     2847  for i := 0 to Items.Count - 1 do
     2848  if Selected[i] then
     2849  begin
     2850    NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
     2851    if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
     2852    else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
     2853    else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
     2854  end;
    28372855end;
    28382856
     
    28522870  memConsult.SelStart := 0;
    28532871  SetResultMenus;
     2872  if memConsult.CanFocus then
     2873    memConsult.SetFocus;
    28542874end;
    28552875
     
    28832903  LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1);
    28842904  memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
    2885   pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
     2905  //CQ13181     508 Consults--Splitter bar doesn't retain size
     2906 //CQ13181  pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
    28862907end;
    28872908
    28882909procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
     2910var
     2911  SavedCsltID: string;
    28892912begin
    28902913  if ViewContext = 0 then exit;     // form has not yet been displayed, so nothing to update
    28912914  if EditingIndex <> -1 then exit;  // do not rebuild list until after save
     2915  with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID;
    28922916  case OrderAction of
    28932917  ORDER_NEW:  UpdateList ;
    28942918  ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil}
    28952919  end;
     2920  if SavedCsltID <> '' then with tvConsults do
     2921  begin
     2922    Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
     2923    tvConsultsChange(Self, Selected);
     2924  end;
    28962925end;
    28972926
     
    29252954begin
    29262955  inherited;
     2956  FocusToRightPanel := False;
    29272957  PageID := CT_CONSULTS;
    2928   memConsult.Color := ReadOnlyColor;
    2929   memPCEShow.Color := ReadOnlyColor;
    2930   lblNewTitle.Color := ReadOnlyColor;
    29312958  EditingIndex := -1;
    29322959  FLastNoteID := '';
     
    29402967  frmDrawers.Splitter := splDrawers;
    29412968  frmDrawers.DefTempPiece := 2;
    2942   tvCsltNotes.Images := dmodShared.imgNotes;
    2943   tvCsltNotes.StateImages := dmodShared.imgImages;
    2944   tvConsults.Images := dmodShared.imgConsults;
    29452969  FImageFlag := TBitmap.Create;
    29462970  FDocList := TStringList.Create;
     
    29522976    end;
    29532977  FCsltList := TStringList.Create;
    2954   TAccessibleTreeView.WrapControl(tvConsults);
    29552978end;
    29562979
     
    29682991  tvConsultsChange(Self, tvConsults.Selected);
    29692992  //lstConsultsClick(Self);
     2993  if memConsult.CanFocus then
     2994    memConsult.SetFocus;
    29702995end;
    29712996
     
    32553280end;
    32563281
     3282procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject);
     3283begin
     3284  inherited;
     3285  DoLeftPanelCustomShiftTab;
     3286end;
     3287
    32573288procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject);
    32583289begin
     
    32913322  inherited;
    32923323  EditTemplates(Self, True);
     3324end;
     3325
     3326procedure TfrmConsults.pnlLeftExit(Sender: TObject);
     3327begin
     3328  inherited;
     3329  if (Not FocusToRightPanel) then
     3330    if ShiftTabIsPressed then
     3331      frmFrame.tabPage.SetFocus
     3332    else if TabIsPressed then
     3333      frmFrame.pnlPatient.SetFocus;
     3334
     3335  if FocusToRightPanel then
     3336    FocusToRightPanel := False;
    32933337end;
    32943338
     
    33873431procedure TfrmConsults.FormDestroy(Sender: TObject);
    33883432begin
    3389   TAccessibleTreeView.UnwrapControl(tvConsults);
    33903433  FDocList.Free;
    33913434  FCsltList.Free;
     
    35783621    if (DocType = TYP_ADDENDUM) then
    35793622    begin
    3580       if AskCosignerForDocument(Addend, Author) and (Cosigner <= 0) then Result := True;
     3623      if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True;
    35813624    end else
    35823625    begin
     
    36953738  ErrMsg: string;
    36963739begin
     3740  if fFrame.frmFrame.DLLActive = True then Exit; 
    36973741  if (EditingIndex > -1) and FChanged then
    36983742  begin
     
    37113755    InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
    37123756  //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
     3757end;
     3758
     3759procedure TfrmConsults.DoLeftPanelCustomShiftTab;
     3760begin
     3761  if ShiftTabIsPressed then begin
     3762    FocusToRightPanel := True;
     3763    FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus;
     3764  end;
    37133765end;
    37143766
     
    38283880  begin
    38293881    ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
    3830     memResults.Lines.Assign(BoilerText);
     3882    QuickCopyWith508Msg(BoilerText, memResults);
    38313883    FChanged := False;
    38323884  end;
     
    38493901        1: begin
    38503902             ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
    3851              memResults.Lines.AddStrings(BoilerText);  // append
     3903             QuickCopyWith508Msg(BoilerText, memResults);  // append
    38523904           end;
    38533905        2: AssignBoilerText;                         // replace
     
    42834335        CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending);
    42844336        UpdateConsultsTreeView(FCsltList, tvConsults);
    4285         lstConsults.Items.Assign(tmpList);
     4337        FastAssign(tmpList, lstConsults.Items);
    42864338      end;
    42874339    with tvConsults do
     
    43094361      uChanging := True;
    43104362      Items.BeginUpdate;
    4311       lstConsults.Items.AddStrings(DocList);
     4363      FastAddStrings(DocList, lstConsults.Items);
    43124364      BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext);
    43134365      Items.EndUpdate;
     
    45394591  Signers := TStringList.Create;
    45404592  try
    4541     Signers.Assign(GetCurrentSigners(NoteIEN));
     4593    FastAssign(GetCurrentSigners(NoteIEN), Signers);
    45424594    for i := 0 to Signers.Count - 1 do
    45434595      if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then
     
    45944646end;
    45954647
    4596 procedure TfrmConsults.tvConsultsAddition(Sender: TObject;
    4597   Node: TTreeNode);
    4598 begin
    4599   inherited;
    4600   TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
    4601 end;
    4602 
    4603 procedure TfrmConsults.tvConsultsDeletion(Sender: TObject;
    4604   Node: TTreeNode);
    4605 begin
    4606   inherited;
    4607   TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
    4608 end;
    4609 
    46104648procedure TfrmConsults.lstConsultsToPrint;     
    46114649var
     
    46304668end;
    46314669
    4632 
    4633 {Tab Order tricks.  Need to change
    4634   tvConsult
    4635 
    4636   tvCsltNotes
    4637   cmdEditResubmit
    4638   cmdNewConsult
    4639   cmdNewProc
    4640   frmDrawers.pnlTemplateButton
    4641   frmDrawers.pnlEncounterButton
    4642   cmdPCE
    4643 
    4644   cmdChange
    4645   txtSubject
    4646   memResults
    4647 
    4648 to
    4649   tvConsult
    4650 
    4651   cmdChange
    4652   txtSubject
    4653   memResults
    4654 
    4655   tvCsltNotes
    4656   cmdEditResubmit
    4657   cmdNewConsult
    4658   cmdNewProc
    4659   frmDrawers.pnlTemplateButton
    4660   frmDrawers.pnlEncounterButton
    4661   cmdPCE
    4662 }
    4663 
    46644670procedure TfrmConsults.tvConsultsExit(Sender: TObject);
    46654671begin
    46664672  inherited;
    4667   if IncSecond(FMousing,1) < Now then
    4668   begin
    4669     if (Screen.ActiveControl = tvCsltNotes) or
    4670         (Screen.ActiveControl = cmdEditResubmit) or
    4671         (Screen.ActiveControl = cmdNewConsult) or
    4672         (Screen.ActiveControl = cmdNewProc) or
    4673         (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or
    4674         (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or
    4675         (Screen.ActiveControl = cmdPCE) then
    4676       FindNextControl( cmdPCE, True, True, False).SetFocus;
    4677   end;
    4678   FMousing := 0;
    4679 end;
    4680 
    4681 procedure TfrmConsults.pnlResultsExit(Sender: TObject);
    4682 begin
    4683   inherited;
    4684   if IncSecond(FMousing,1) < Now then
    4685   begin
    4686     if (Screen.ActiveControl = frmFrame.pnlPatient) then
    4687       FindNextControl( tvConsults, True, True, False).SetFocus
    4688     else
    4689     if (Screen.ActiveControl = tvCsltNotes) or
    4690         (Screen.ActiveControl = cmdEditResubmit) or
    4691         (Screen.ActiveControl = cmdNewConsult) or
    4692         (Screen.ActiveControl = cmdNewProc) or
    4693         (Screen.ActiveControl = frmDrawers.pnlTemplatesButton) or
    4694         (Screen.ActiveControl = frmDrawers.pnlEncounterButton) or
    4695         (Screen.ActiveControl = cmdPCE) then
    4696       FindNextControl( tvCsltNotes, False, True, False).SetFocus;
    4697   end;
    4698   FMousing := 0;
    4699 end;
    4700 
    4701 procedure TfrmConsults.pnlActionExit(Sender: TObject);
    4702 begin
    4703   inherited;
    4704   if IncSecond(FMousing,1) < Now then
    4705   begin
    4706     if (Screen.ActiveControl = memConsult) or
    4707         (Screen.ActiveControl = cmdChange) or
    4708         (Screen.ActiveControl = txtSubject) or
    4709         (Screen.ActiveControl = memResults) then
    4710       begin
    4711         //frmFrame.pnlPatient.SetFocus  //COMMENTED OUT FOR CQ6498
    4712         if memResults.CanFocus then
    4713           memResults.SetFocus //ADDED THIS LINE FOR CQ6498
    4714         else
    4715           memConsult.SetFocus;
    4716       end
    4717     else
    4718     if (Screen.ActiveControl = tvConsults) then
    4719       FindNextControl( frmFrame.pnlPatient, False, True, False).SetFocus;
    4720   end;
    4721   FMousing := 0;
     4673  FocusToRightPanel := True;
     4674  if TabIsPressed then
     4675    FindNextControl(pnlLeft, False, True, False).SetFocus;
    47224676end;
    47234677
     
    47254679begin
    47264680  FOldFramePnlPatientExit(Sender);
    4727   if IncSecond(FMousing,1) < Now then
    4728   begin
    4729     if (Screen.ActiveControl = memConsult) or
    4730         (Screen.ActiveControl = cmdChange) or
    4731         (Screen.ActiveControl = txtSubject) or
    4732         (Screen.ActiveControl = memResults) then
    4733       FindNextControl( memConsult, False, True, False).SetFocus;
    4734   end;
    4735   FMousing := 0;
     4681  if ShiftTabIsPressed then
     4682    FindNextControl( pnlRight, False, True, False).SetFocus;
    47364683end;
    47374684
     
    47404687  inherited;
    47414688  frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit;
    4742   frmDrawers.pnlTemplatesButton.OnExit := FOldDrawerPnlTemplatesButtonExit;
    4743   frmDrawers.pnlEncounterButton.OnExit := FOldDrawerPnlEncounterButtonExit;
    4744   frmDrawers.edtSearch.OnExit := FOldDrawerEdtSearchExit;
    47454689end;
    47464690
     
    47524696  FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit;
    47534697  frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit;
    4754   FOldDrawerPnlTemplatesButtonExit := frmDrawers.pnlTemplatesButton.OnExit;
    4755   frmDrawers.pnlTemplatesButton.OnExit := frmDrawerPnlTemplatesButtonExit;
    4756   FOldDrawerPnlEncounterButtonExit := frmDrawers.pnlEncounterButton.OnExit;
    4757   frmDrawers.pnlEncounterButton.OnExit := frmDrawerPnlEncounterButtonExit;
    4758   FOldDrawerEdtSearchExit := frmDrawers.edtSearch.OnExit;
    4759   frmDrawers.edtSearch.OnExit := frmDrawerEdtSearchExit;
    47604698  {Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked
    47614699  and looked for side effects and a better solution and this was the best!}
     
    47734711  end
    47744712  {End of ClearQuest Defect HDS0000948 Fixes}
    4775 end;
    4776 
    4777 procedure TfrmConsults.frmDrawerEdtSearchExit(Sender: TObject);
    4778 begin
    4779   FOldDrawerEdtSearchExit(Sender);
    4780   pnlActionExit(Sender);
    4781 end;
    4782 
    4783 procedure TfrmConsults.frmDrawerPnlTemplatesButtonExit(Sender: TObject);
    4784 begin
    4785   FOldDrawerPnlTemplatesButtonExit(Sender);
    4786   pnlActionExit(Sender);
    4787 end;
    4788 
    4789 procedure TfrmConsults.frmDrawerPnlEncounterButtonExit(Sender: TObject);
    4790 begin
    4791   FOldDrawerPnlEncounterButtonExit(Sender);
    4792   pnlActionExit(Sender);
    4793 end;
    4794 
    4795 procedure TfrmConsults.FormMouseMove(Sender: TObject; Shift: TShiftState;
    4796   X, Y: Integer);
    4797 begin
    4798   inherited;
    4799   FMousing := Now;
    48004713end;
    48014714
     
    48214734
    48224735initialization
     4736  SpecifyFormIsNotADialog(TfrmConsults);
    48234737  uPCEEdit := TPCEData.Create;
    48244738  uPCEShow := TPCEData.Create;
  • cprs/trunk/CPRS-Chart/Consults/fConsultsView.dfm

    r456 r829  
    1 object frmConsultsView: TfrmConsultsView
     1inherited frmConsultsView: TfrmConsultsView
    22  Left = 320
    33  Top = 172
    4   Width = 414
    5   Height = 400
    64  BorderIcons = []
    75  Caption = 'List Selected Consults'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 373
     7  ClientWidth = 406
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
     
    154148      ListItemsOnly = True
    155149      LongList = False
     150      LookupPiece = 0
    156151      MaxLength = 0
    157152      Pieces = '2'
     
    161156      OnKeyPause = cboServiceSelect
    162157      OnMouseClick = cboServiceSelect
     158      CharsNeedMatch = 1
    163159    end
    164160    object cboGroupBy: TORComboBox
     
    182178      ListItemsOnly = False
    183179      LongList = False
     180      LookupPiece = 0
    184181      MaxLength = 0
    185182      Pieces = '2'
     
    187184      SynonymChars = '<>'
    188185      TabOrder = 5
    189     end
     186      CharsNeedMatch = 1
     187    end
     188  end
     189  inherited amgrMain: TVA508AccessibilityManager
     190    Data = (
     191      (
     192        'Component = pnlBase'
     193        'Status = stsDefault')
     194      (
     195        'Component = calBeginDate'
     196        'Status = stsDefault')
     197      (
     198        'Component = calEndDate'
     199        'Status = stsDefault')
     200      (
     201        'Component = lstStatus'
     202        'Status = stsDefault')
     203      (
     204        'Component = radSort'
     205        'Status = stsDefault')
     206      (
     207        'Component = cmdOK'
     208        'Status = stsDefault')
     209      (
     210        'Component = cmdCancel'
     211        'Status = stsDefault')
     212      (
     213        'Component = treService'
     214        'Status = stsDefault')
     215      (
     216        'Component = cboService'
     217        'Status = stsDefault')
     218      (
     219        'Component = cboGroupBy'
     220        'Status = stsDefault')
     221      (
     222        'Component = frmConsultsView'
     223        'Status = stsDefault'))
    190224  end
    191225  object popStatus: TPopupMenu
  • cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
    7   StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus;
     7  StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmConsultsView = class(TForm)
     11  TfrmConsultsView = class(TfrmBase508Form)
    1112    pnlBase: TORAutoPanel;
    1213    lblBeginDate: TLabel;
     
    8283      FChanged := False;
    8384      with radSort do ItemIndex := 1;
    84       //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP));                         {RV}
    85       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP));           {RV}
     85      //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
     86      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);           {RV}
    8687      SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
    8788      for i := 0 to SvcList.Count - 1 do
     
    103104          cboServiceSelect(frmConsultsView);
    104105        end;
    105       lstStatus.Items.Assign(SubSetOfStatus);
     106      FastAssign(SubSetOfStatus, lstStatus.Items);
    106107      CurrentStatus := CurrentContext.Status;
    107108      if CurrentStatus <> '' then with lstStatus do
  • cprs/trunk/CPRS-Chart/Consults/fCsltNote.dfm

    r456 r829  
    1 object frmCsltNote: TfrmCsltNote
     1inherited frmCsltNote: TfrmCsltNote
    22  Left = 147
    33  Top = 206
     
    66  ClientHeight = 189
    77  ClientWidth = 398
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    148  OldCreateOrder = True
    159  Position = poScreenCenter
    1610  PixelsPerInch = 96
    1711  TextHeight = 13
    18   object pnlBase: TORAutoPanel
     12  object pnlBase: TORAutoPanel [0]
    1913    Left = 0
    2014    Top = 0
     
    6963      ListItemsOnly = True
    7064      LongList = False
     65      LookupPiece = 0
    7166      MaxLength = 0
    7267      Pieces = '2,3'
     
    7469      SynonymChars = '<>'
    7570      TabOrder = 0
     71      CharsNeedMatch = 1
    7672    end
    7773  end
     74  inherited amgrMain: TVA508AccessibilityManager
     75    Data = (
     76      (
     77        'Component = pnlBase'
     78        'Status = stsDefault')
     79      (
     80        'Component = cmdOK'
     81        'Status = stsDefault')
     82      (
     83        'Component = cmdCancel'
     84        'Status = stsDefault')
     85      (
     86        'Component = cboCsltNote'
     87        'Status = stsDefault')
     88      (
     89        'Component = frmCsltNote'
     90        'Status = stsDefault'))
     91  end
    7892end
  • cprs/trunk/CPRS-Chart/Consults/fCsltNote.pas

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmCsltNote = class(TForm)
     9  TfrmCsltNote = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;
  • cprs/trunk/CPRS-Chart/Consults/fEditConsult.dfm

    r456 r829  
    1 object frmEditCslt: TfrmEditCslt
     1inherited frmEditCslt: TfrmEditCslt
    22  Tag = 110
    33  Left = 409
    44  Top = 225
    5   Width = 569
    6   Height = 367
     5  Width = 599
     6  Height = 375
    77  HorzScrollBar.Range = 561
    88  VertScrollBar.Range = 340
    9   AutoScroll = False
    109  Caption = 'Edit/Resubmit a Cancelled Consult'
    11   Color = clBtnFace
    12   Font.Charset = DEFAULT_CHARSET
    13   Font.Color = clWindowText
    14   Font.Height = -11
    15   Font.Name = 'MS Sans Serif'
    16   Font.Style = []
     10  Constraints.MinHeight = 371
     11  Constraints.MinWidth = 573
    1712  OldCreateOrder = True
    1813  Position = poScreenCenter
     14  ExplicitLeft = 409
     15  ExplicitTop = 225
     16  ExplicitWidth = 599
     17  ExplicitHeight = 375
    1918  DesignSize = (
    20     561
    21     340)
     19    591
     20    341)
    2221  PixelsPerInch = 96
    2322  TextHeight = 13
    24   object lblService: TLabel
     23  object lblService: TLabel [0]
    2524    Left = 4
    2625    Top = 4
     
    2928    Caption = 'Consult to Service/Specialty'
    3029  end
    31   object lblReason: TLabel
     30  object lblReason: TLabel [1]
    3231    Left = 4
    3332    Top = 166
     
    3635    Caption = 'Reason for Consult'
    3736  end
    38   object lblComment: TLabel
     37  object lblComment: TLabel [2]
    3938    Left = 4
    4039    Top = 105
     
    4342    Caption = 'New Comments:'
    4443  end
    45   object lblComments: TLabel
     44  object lblComments: TLabel [3]
    4645    Left = 4
    4746    Top = 51
     
    5049    Caption = 'Display Comments:'
    5150  end
    52   object lblUrgency: TStaticText
     51  object lblUrgency: TStaticText [4]
    5352    Left = 196
    5453    Top = 4
     
    5857    TabOrder = 16
    5958  end
    60   object lblPlace: TStaticText
     59  object lblPlace: TStaticText [5]
    6160    Left = 376
    6261    Top = 41
     
    6665    TabOrder = 17
    6766  end
    68   object lblAttn: TStaticText
     67  object lblAttn: TStaticText [6]
    6968    Left = 376
    7069    Top = 4
     
    7473    TabOrder = 18
    7574  end
    76   object lblProvDiag: TStaticText
     75  object lblProvDiag: TStaticText [7]
    7776    Left = 195
    7877    Top = 82
     
    8281    TabOrder = 19
    8382  end
    84   object lblInpOutp: TStaticText
     83  object lblInpOutp: TStaticText [8]
    8584    Left = 197
    8685    Top = 47
     
    9089    TabOrder = 20
    9190  end
    92   object memReason: TRichEdit
     91  object memReason: TRichEdit [9]
    9392    Left = 4
    9493    Top = 179
    95     Width = 552
    96     Height = 129
     94    Width = 589
     95    Height = 137
    9796    Anchors = [akLeft, akTop, akRight, akBottom]
    9897    Font.Charset = DEFAULT_CHARSET
     
    111110    OnKeyPress = memCommentKeyPress
    112111    OnKeyUp = memCommentKeyUp
    113   end
    114   object pnlMessage: TPanel
    115     Left = 21
    116     Top = 292
    117     Width = 381
     112    ExplicitHeight = 136
     113  end
     114  object pnlMessage: TPanel [10]
     115    Left = 16
     116    Top = 294
     117    Width = 418
    118118    Height = 44
    119119    Anchors = [akLeft, akRight, akBottom]
     
    146146    end
    147147  end
    148   object cboService: TORComboBox
     148  object cboService: TORComboBox [11]
    149149    Left = 4
    150150    Top = 19
     
    176176    CharsNeedMatch = 1
    177177  end
    178   object cboUrgency: TORComboBox
     178  object cboUrgency: TORComboBox [12]
    179179    Left = 196
    180180    Top = 19
     
    200200    CharsNeedMatch = 1
    201201  end
    202   object radInpatient: TRadioButton
     202  object radInpatient: TRadioButton [13]
    203203    Left = 197
    204204    Top = 61
     
    209209    OnClick = radInpatientClick
    210210  end
    211   object radOutpatient: TRadioButton
     211  object radOutpatient: TRadioButton [14]
    212212    Left = 269
    213213    Top = 61
     
    218218    OnClick = radOutpatientClick
    219219  end
    220   object cboPlace: TORComboBox
     220  object cboPlace: TORComboBox [15]
    221221    Left = 376
    222222    Top = 54
    223     Width = 179
     223    Width = 216
    224224    Height = 21
    225225    Anchors = [akLeft, akTop, akRight]
     
    243243    CharsNeedMatch = 1
    244244  end
    245   object txtProvDiag: TCaptionEdit
     245  object txtProvDiag: TCaptionEdit [16]
    246246    Left = 195
    247247    Top = 95
    248     Width = 309
     248    Width = 346
    249249    Height = 21
    250250    Anchors = [akLeft, akTop, akRight]
     
    257257    Caption = 'Provisional Diagnosis'
    258258  end
    259   object txtAttn: TORComboBox
     259  object txtAttn: TORComboBox [17]
    260260    Left = 376
    261261    Top = 19
    262     Width = 181
     262    Width = 218
    263263    Height = 21
    264264    Anchors = [akLeft, akTop, akRight]
     
    283283    CharsNeedMatch = 1
    284284  end
    285   object cboCategory: TORComboBox
     285  object cboCategory: TORComboBox [18]
    286286    Left = 561
    287287    Top = 103
     
    305305    CharsNeedMatch = 1
    306306  end
    307   object cmdAccept: TButton
    308     Left = 407
    309     Top = 313
     307  object cmdAccept: TButton [19]
     308    Left = 437
     309    Top = 319
    310310    Width = 72
    311311    Height = 21
     
    315315    OnClick = cmdAcceptClick
    316316  end
    317   object cmdQuit: TButton
    318     Left = 484
    319     Top = 313
     317  object cmdQuit: TButton [20]
     318    Left = 514
     319    Top = 319
    320320    Width = 72
    321321    Height = 21
     
    326326    OnClick = cmdQuitClick
    327327  end
    328   object memComment: TRichEdit
     328  object memComment: TRichEdit [21]
    329329    Left = 4
    330330    Top = 121
    331     Width = 550
     331    Width = 587
    332332    Height = 41
    333333    Anchors = [akLeft, akTop, akRight]
     
    340340    OnKeyUp = memCommentKeyUp
    341341  end
    342   object btnCmtCancel: TButton
     342  object btnCmtCancel: TButton [22]
    343343    Left = 110
    344344    Top = 49
     
    349349    OnClick = btnCmtCancelClick
    350350  end
    351   object btnCmtOther: TButton
     351  object btnCmtOther: TButton [23]
    352352    Left = 110
    353353    Top = 75
     
    358358    OnClick = btnCmtOtherClick
    359359  end
    360   object cmdLexSearch: TButton
    361     Left = 508
     360  object cmdLexSearch: TButton [24]
     361    Left = 545
    362362    Top = 95
    363363    Width = 46
     
    367367    TabOrder = 9
    368368    OnClick = cmdLexSearchClick
     369  end
     370  inherited amgrMain: TVA508AccessibilityManager
     371    Data = (
     372      (
     373        'Component = lblUrgency'
     374        'Status = stsDefault')
     375      (
     376        'Component = lblPlace'
     377        'Status = stsDefault')
     378      (
     379        'Component = lblAttn'
     380        'Status = stsDefault')
     381      (
     382        'Component = lblProvDiag'
     383        'Status = stsDefault')
     384      (
     385        'Component = lblInpOutp'
     386        'Status = stsDefault')
     387      (
     388        'Component = memReason'
     389        'Status = stsDefault')
     390      (
     391        'Component = pnlMessage'
     392        'Status = stsDefault')
     393      (
     394        'Component = memMessage'
     395        'Status = stsDefault')
     396      (
     397        'Component = cboService'
     398        'Status = stsDefault')
     399      (
     400        'Component = cboUrgency'
     401        'Status = stsDefault')
     402      (
     403        'Component = radInpatient'
     404        'Status = stsDefault')
     405      (
     406        'Component = radOutpatient'
     407        'Status = stsDefault')
     408      (
     409        'Component = cboPlace'
     410        'Status = stsDefault')
     411      (
     412        'Component = txtProvDiag'
     413        'Status = stsDefault')
     414      (
     415        'Component = txtAttn'
     416        'Status = stsDefault')
     417      (
     418        'Component = cboCategory'
     419        'Status = stsDefault')
     420      (
     421        'Component = cmdAccept'
     422        'Status = stsDefault')
     423      (
     424        'Component = cmdQuit'
     425        'Status = stsDefault')
     426      (
     427        'Component = memComment'
     428        'Status = stsDefault')
     429      (
     430        'Component = btnCmtCancel'
     431        'Status = stsDefault')
     432      (
     433        'Component = btnCmtOther'
     434        'Status = stsDefault')
     435      (
     436        'Component = cmdLexSearch'
     437        'Status = stsDefault')
     438      (
     439        'Component = frmEditCslt'
     440        'Status = stsDefault'))
    369441  end
    370442  object mnuPopProvDx: TPopupMenu
  • cprs/trunk/CPRS-Chart/Consults/fEditConsult.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
    8   Menus ;
     8  Menus, fBase508Form, VA508AccessibilityManager;
    99
    1010type
    11   TfrmEditCslt = class(TForm)
     11  TfrmEditCslt = class(TfrmBase508Form)
    1212    cboService: TORComboBox;
    1313    cboUrgency: TORComboBox;
     
    169169begin
    170170  FChanging := True;
    171   Defaults.Assign(ODForConsults);
     171  FastAssign(ODForConsults, Defaults);
    172172  FLastServiceID := '';
    173173  cboService.Items.Clear;
     
    185185    end;
    186186  StatusText('Initializing Long List');
    187   SvcList.Assign(LoadServiceList(CN_SVC_LIST_ORD))   ;
     187  FastAssign(LoadServiceList(CN_SVC_LIST_ORD), SvcList)   ;
    188188  with cboService do
    189189    begin
     
    203203    ProvDx.CodeInactive := True;
    204204   end;
    205   memReason.Lines.Assign(OldRec.RequestReason);
     205  QuickCopy(OldRec.RequestReason, memReason);
    206206  memComment.Clear ;
    207207  btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
     
    388388          RequestReason.Clear
    389389        else
    390           RequestReason.Assign(Lines);
     390          QuickCopy(memReason, RequestReason);
    391391
    392392      with memComment do
    393393        if GetTextLen > 0 then
    394           NewComments.Assign(Lines)
     394          QuickCopy(memComment, NewComments)
    395395        else
    396396          NewComments.Clear;
     
    443443  AStringList := TStringList.Create;
    444444  try
    445     AStringList.Assign(memReason.Lines);
     445    //QuickCopy(memReason, AStringList);
     446    AStringList.Text := memReason.Text;
    446447    LimitStringLength(AStringList, 74);
    447     memReason.Lines.Assign(AstringList);
     448    //QuickCopy(AstringList, memReason);
     449    memReason.Text := AStringList.Text;
    448450    ControlChange(Self);
    449451  finally
  • cprs/trunk/CPRS-Chart/Consults/fEditProc.dfm

    r456 r829  
    1 object frmEditProc: TfrmEditProc
     1inherited frmEditProc: TfrmEditProc
    22  Tag = 112
    33  Left = 296
    44  Top = 245
    5   Width = 569
    6   Height = 335
     5  Width = 571
     6  Height = 359
    77  HorzScrollBar.Range = 561
    88  VertScrollBar.Range = 308
    9   AutoScroll = False
    109  Caption = 'Edit and resubmit a cancelled procedure'
    11   Color = clBtnFace
    12   Font.Charset = DEFAULT_CHARSET
    13   Font.Color = clWindowText
    14   Font.Height = -11
    15   Font.Name = 'MS Sans Serif'
    16   Font.Style = []
     10  Constraints.MinHeight = 359
     11  Constraints.MinWidth = 571
    1712  OldCreateOrder = True
    1813  Position = poScreenCenter
     14  ExplicitLeft = 296
     15  ExplicitTop = 245
     16  ExplicitWidth = 571
     17  ExplicitHeight = 359
    1918  DesignSize = (
    20     561
    21     308)
     19    563
     20    325)
    2221  PixelsPerInch = 96
    2322  TextHeight = 13
    24   object lblProc: TLabel
     23  object lblProc: TLabel [0]
    2524    Left = 3
    2625    Top = 7
     
    2928    Caption = 'Procedure'
    3029  end
    31   object lblReason: TLabel
     30  object lblReason: TLabel [1]
    3231    Left = 3
    3332    Top = 167
     
    3635    Caption = 'Reason for Consult'
    3736  end
    38   object lblService: TOROffsetLabel
     37  object lblService: TOROffsetLabel [2]
    3938    Left = 3
    4039    Top = 49
     
    4746    WordWrap = False
    4847  end
    49   object lblComment: TLabel
     48  object lblComment: TLabel [3]
    5049    Left = 106
    5150    Top = 109
     
    5453    Caption = 'New Comments'
    5554  end
    56   object lblComments: TLabel
     55  object lblComments: TLabel [4]
    5756    Left = 3
    5857    Top = 99
     
    6160    Caption = 'Display Comments:'
    6261  end
    63   object lblUrgency: TStaticText
     62  object lblUrgency: TStaticText [5]
    6463    Left = 190
    6564    Top = 7
     
    6968    TabOrder = 18
    7069  end
    71   object lblPlace: TStaticText
     70  object lblPlace: TStaticText [6]
    7271    Left = 362
    7372    Top = 50
     
    7776    TabOrder = 19
    7877  end
    79   object lblAttn: TStaticText
     78  object lblAttn: TStaticText [7]
    8079    Left = 362
    8180    Top = 7
     
    8584    TabOrder = 20
    8685  end
    87   object lblProvDiag: TStaticText
     86  object lblProvDiag: TStaticText [8]
    8887    Left = 190
    8988    Top = 81
     
    9392    TabOrder = 21
    9493  end
    95   object lblInpOutp: TStaticText
     94  object lblInpOutp: TStaticText [9]
    9695    Left = 192
    9796    Top = 48
     
    101100    TabOrder = 17
    102101  end
    103   object memReason: TRichEdit
     102  object memReason: TRichEdit [10]
    104103    Left = 2
    105104    Top = 181
    106     Width = 555
    107     Height = 95
     105    Width = 557
     106    Height = 119
    108107    Anchors = [akLeft, akTop, akRight, akBottom]
    109108    Font.Charset = DEFAULT_CHARSET
     
    123122    OnKeyUp = memCommentKeyUp
    124123  end
    125   object cmdAccept: TButton
    126     Left = 399
    127     Top = 282
     124  object cmdAccept: TButton [11]
     125    Left = 401
     126    Top = 303
    128127    Width = 72
    129128    Height = 21
     
    133132    OnClick = cmdAcceptClick
    134133  end
    135   object cmdQuit: TButton
    136     Left = 484
    137     Top = 282
     134  object cmdQuit: TButton [12]
     135    Left = 486
     136    Top = 303
    138137    Width = 72
    139138    Height = 21
     
    144143    OnClick = cmdQuitClick
    145144  end
    146   object cboUrgency: TORComboBox
     145  object cboUrgency: TORComboBox [13]
    147146    Left = 190
    148147    Top = 22
     
    168167    CharsNeedMatch = 1
    169168  end
    170   object radInpatient: TRadioButton
     169  object radInpatient: TRadioButton [14]
    171170    Left = 190
    172171    Top = 61
     
    177176    OnClick = radInpatientClick
    178177  end
    179   object radOutpatient: TRadioButton
     178  object radOutpatient: TRadioButton [15]
    180179    Left = 264
    181180    Top = 61
     
    186185    OnClick = radOutpatientClick
    187186  end
    188   object cboPlace: TORComboBox
     187  object cboPlace: TORComboBox [16]
    189188    Left = 362
    190189    Top = 63
    191     Width = 195
     190    Width = 197
    192191    Height = 21
    193192    Anchors = [akLeft, akTop, akRight]
     
    210209    OnChange = ControlChange
    211210    CharsNeedMatch = 1
    212   end
    213   object txtProvDiag: TCaptionEdit
     211    ExplicitWidth = 195
     212  end
     213  object txtProvDiag: TCaptionEdit [17]
    214214    Left = 190
    215215    Top = 94
    216     Width = 313
     216    Width = 315
    217217    Height = 21
    218218    Anchors = [akLeft, akTop, akRight]
     
    225225    Caption = 'Provisional Diagnosis'
    226226  end
    227   object txtAttn: TORComboBox
     227  object txtAttn: TORComboBox [18]
    228228    Left = 362
    229229    Top = 22
    230     Width = 195
     230    Width = 197
    231231    Height = 21
    232232    Anchors = [akLeft, akTop, akRight]
     
    250250    OnNeedData = txtAttnNeedData
    251251    CharsNeedMatch = 1
    252   end
    253   object cboProc: TORComboBox
     252    ExplicitWidth = 195
     253  end
     254  object cboProc: TORComboBox [19]
    254255    Left = 3
    255256    Top = 22
     
    283284    CharsNeedMatch = 1
    284285  end
    285   object cboCategory: TORComboBox
     286  object cboCategory: TORComboBox [20]
    286287    Left = 505
    287288    Top = -11
     
    306307    CharsNeedMatch = 1
    307308  end
    308   object cboService: TORComboBox
     309  object cboService: TORComboBox [21]
    309310    Left = 3
    310311    Top = 65
     
    337338    CharsNeedMatch = 1
    338339  end
    339   object memComment: TRichEdit
     340  object memComment: TRichEdit [22]
    340341    Left = 106
    341342    Top = 123
    342     Width = 449
     343    Width = 451
    343344    Height = 38
    344345    Anchors = [akLeft, akTop, akRight]
     
    349350    OnKeyUp = memCommentKeyUp
    350351  end
    351   object pnlMessage: TPanel
    352     Left = 29
    353     Top = 264
    354     Width = 381
     352  object pnlMessage: TPanel [23]
     353    Left = 19
     354    Top = 276
     355    Width = 383
    355356    Height = 44
    356357    Anchors = [akLeft, akRight, akBottom]
     
    383384    end
    384385  end
    385   object btnCmtCancel: TButton
     386  object btnCmtCancel: TButton [24]
    386387    Left = 11
    387388    Top = 116
     
    392393    OnClick = btnCmtCancelClick
    393394  end
    394   object btnCmtOther: TButton
     395  object btnCmtOther: TButton [25]
    395396    Left = 11
    396397    Top = 139
     
    401402    OnClick = btnCmtOtherClick
    402403  end
    403   object cmdLexSearch: TButton
    404     Left = 507
     404  object cmdLexSearch: TButton [26]
     405    Left = 509
    405406    Top = 94
    406407    Width = 49
     
    410411    TabOrder = 8
    411412    OnClick = cmdLexSearchClick
     413  end
     414  inherited amgrMain: TVA508AccessibilityManager
     415    Data = (
     416      (
     417        'Component = lblUrgency'
     418        'Status = stsDefault')
     419      (
     420        'Component = lblPlace'
     421        'Status = stsDefault')
     422      (
     423        'Component = lblAttn'
     424        'Status = stsDefault')
     425      (
     426        'Component = lblProvDiag'
     427        'Status = stsDefault')
     428      (
     429        'Component = lblInpOutp'
     430        'Status = stsDefault')
     431      (
     432        'Component = memReason'
     433        'Status = stsDefault')
     434      (
     435        'Component = cmdAccept'
     436        'Status = stsDefault')
     437      (
     438        'Component = cmdQuit'
     439        'Status = stsDefault')
     440      (
     441        'Component = cboUrgency'
     442        'Status = stsDefault')
     443      (
     444        'Component = radInpatient'
     445        'Status = stsDefault')
     446      (
     447        'Component = radOutpatient'
     448        'Status = stsDefault')
     449      (
     450        'Component = cboPlace'
     451        'Status = stsDefault')
     452      (
     453        'Component = txtProvDiag'
     454        'Status = stsDefault')
     455      (
     456        'Component = txtAttn'
     457        'Status = stsDefault')
     458      (
     459        'Component = cboProc'
     460        'Status = stsDefault')
     461      (
     462        'Component = cboCategory'
     463        'Status = stsDefault')
     464      (
     465        'Component = cboService'
     466        'Status = stsDefault')
     467      (
     468        'Component = memComment'
     469        'Status = stsDefault')
     470      (
     471        'Component = pnlMessage'
     472        'Status = stsDefault')
     473      (
     474        'Component = memMessage'
     475        'Status = stsDefault')
     476      (
     477        'Component = btnCmtCancel'
     478        'Status = stsDefault')
     479      (
     480        'Component = btnCmtOther'
     481        'Status = stsDefault')
     482      (
     483        'Component = cmdLexSearch'
     484        'Status = stsDefault')
     485      (
     486        'Component = frmEditProc'
     487        'Status = stsDefault'))
    412488  end
    413489  object mnuPopProvDx: TPopupMenu
  • cprs/trunk/CPRS-Chart/Consults/fEditProc.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
    8   Menus;
     8  Menus, fBase508Form, VA508AccessibilityManager;
    99
    1010type
    11   TfrmEditProc = class(TForm)
     11  TfrmEditProc = class(TfrmBase508Form)
    1212    cmdAccept: TButton;
    1313    cmdQuit: TButton;
     
    167167  FChanging := True;
    168168  Defaults := TStringList.Create;
    169   Defaults.Assign(ODForProcedures);
     169  FastAssign(ODForProcedures, Defaults);
    170170  FLastProcID := '';
    171171  cboProc.InitLongList(OldRec.ConsultProcName) ;
     
    206206    ProvDx.CodeInactive := True;
    207207   end;
    208   memReason.Lines.Assign(OldRec.RequestReason);
     208  QuickCopy(OldRec.RequestReason, memReason);
    209209  btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
    210210  btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
     
    394394          RequestReason.Clear
    395395        else
    396           RequestReason.Assign(Lines);
     396          QuickCopy(memReason, RequestReason);
    397397
    398398      with memComment do
    399399        if GetTextLen > 0 then
    400           NewComments.Assign(Lines)
     400          QuickCopy(memComment, NewComments)
    401401        else
    402402          NewComments.Clear;
     
    443443      begin
    444444        Clear;
    445         Items.Assign(GetProcedureServices(cboProc.ItemIEN));
     445        FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
    446446        if Items.Count > 0 then
    447447          begin
     
    471471  AStringList := TStringList.Create;
    472472  try
    473     AStringList.Assign(memReason.Lines);
     473    //QuickCopy(memReason, AStringList);
     474    AStringList.Text := memReason.Text;
    474475    LimitStringLength(AStringList, 74);
    475     memReason.Lines.Assign(AstringList);
     476    //QuickCopy(AstringList, memReason);
     477    memReason.Text := AStringList.Text;
    476478    ControlChange(Self);
    477479  finally
  • cprs/trunk/CPRS-Chart/Consults/fODConsult.dfm

    r456 r829  
    1111  Constraints.MinWidth = 606
    1212  Font.Charset = ANSI_CHARSET
     13  ExplicitWidth = 606
     14  ExplicitHeight = 376
    1315  PixelsPerInch = 96
    1416  TextHeight = 13
     
    2022    Caption = 'Consult to Service/Specialty'
    2123  end
    22   object pnlReason: TPanel [1]
     24  object lblProvDiag: TLabel [1]
     25    Left = 309
     26    Top = 81
     27    Width = 100
     28    Height = 13
     29    Anchors = [akTop, akRight]
     30    Caption = 'Provisional Diagnosis'
     31  end
     32  object lblUrgency: TLabel [2]
     33    Left = 309
     34    Top = 2
     35    Width = 40
     36    Height = 13
     37    Anchors = [akTop, akRight]
     38    Caption = 'Urgency'
     39  end
     40  object lblPlace: TLabel [3]
     41    Left = 454
     42    Top = 43
     43    Width = 100
     44    Height = 13
     45    Anchors = [akTop, akRight]
     46    Caption = 'Place of Consultation'
     47  end
     48  object lblAttn: TLabel [4]
     49    Left = 454
     50    Top = 2
     51    Width = 42
     52    Height = 13
     53    Anchors = [akTop, akRight]
     54    Caption = 'Attention'
     55  end
     56  object pnlReason: TPanel [5]
    2357    Left = 3
    24     Top = 154
     58    Top = 128
    2559    Width = 585
    26     Height = 135
     60    Height = 161
    2761    Anchors = [akLeft, akTop, akRight]
    2862    BevelOuter = bvNone
    29     TabOrder = 11
     63    TabOrder = 10
    3064    object lblReason: TLabel
    3165      Left = 0
     
    3569      Align = alTop
    3670      Caption = 'Reason for Request'
     71      ExplicitWidth = 95
    3772    end
    3873    object memReason: TRichEdit
     
    4075      Top = 13
    4176      Width = 585
    42       Height = 122
     77      Height = 148
    4378      Align = alClient
    4479      Font.Charset = ANSI_CHARSET
     
    6095    end
    6196  end
    62   object lblUrgency: TStaticText [2]
    63     Left = 309
    64     Top = 2
    65     Width = 44
    66     Height = 17
    67     Anchors = [akTop, akRight]
    68     Caption = 'Urgency'
    69     TabOrder = 17
    70   end
    71   object lblPlace: TStaticText [3]
    72     Left = 454
    73     Top = 43
    74     Width = 104
    75     Height = 17
    76     Anchors = [akTop, akRight]
    77     Caption = 'Place of Consultation'
    78     TabOrder = 18
    79   end
    80   object lblAttn: TStaticText [4]
    81     Left = 454
    82     Top = 2
    83     Width = 46
    84     Height = 17
    85     Anchors = [akTop, akRight]
    86     Caption = 'Attention'
    87     TabOrder = 19
    88   end
    89   object lblProvDiag: TStaticText [5]
    90     Left = 309
    91     Top = 81
    92     Width = 104
    93     Height = 17
    94     Anchors = [akTop, akRight]
    95     Caption = 'Provisional Diagnosis'
    96     TabOrder = 20
    97   end
    9897  inherited memOrder: TCaptionMemo
    9998    Left = 3
     
    101100    Width = 417
    102101    Height = 41
     102    TabStop = True
     103    Anchors = [akLeft, akBottom]
    103104    Lines.Strings = (
    104105      'The order text...'
     
    106107      '--------------------------------'
    107108      'An order message may be displayed here.')
    108     TabOrder = 1
    109   end
    110   inherited cmdAccept: TButton
    111     Left = 427
    112     Top = 315
    113     TabOrder = 12
    114   end
    115   inherited cmdQuit: TButton
    116     Left = 531
    117     Top = 315
    118     Width = 61
    119     TabOrder = 13
    120   end
    121   inherited pnlMessage: TPanel
    122     Left = 13
    123     Top = 295
    124     Width = 377
    125     Anchors = [akLeft, akRight, akBottom]
    126     TabOrder = 14
    127     inherited memMessage: TRichEdit
    128       Width = 292
    129     end
    130   end
    131   object cboService: TORComboBox
     109    TabOrder = 11
     110    ExplicitLeft = 3
     111    ExplicitTop = 305
     112    ExplicitWidth = 417
     113    ExplicitHeight = 41
     114  end
     115  object cboService: TORComboBox [7]
    132116    Left = 0
    133117    Top = 16
     
    151135    SynonymChars = '<>'
    152136    TabOrder = 0
     137    TabStop = True
    153138    OnChange = ControlChange
    154139    OnClick = cboServiceSelect
     
    158143    CharsNeedMatch = 1
    159144  end
    160   object cboUrgency: TORComboBox
     145  object cboUrgency: TORComboBox [8]
    161146    Left = 309
    162147    Top = 16
     
    166151    Style = orcsDropDown
    167152    AutoSelect = True
    168     Caption = 'Urgency'
    169153    Color = clWindow
    170154    DropDownCount = 8
     
    179163    Sorted = False
    180164    SynonymChars = '<>'
    181     TabOrder = 4
     165    TabOrder = 3
    182166    TabStop = True
    183167    OnChange = ControlChange
    184168    CharsNeedMatch = 1
    185169  end
    186   object cboPlace: TORComboBox
     170  object cboPlace: TORComboBox [9]
    187171    Left = 454
    188172    Top = 56
     
    192176    Style = orcsDropDown
    193177    AutoSelect = True
    194     Caption = 'Place of Consultation'
    195178    Color = clWindow
    196179    DropDownCount = 8
     
    205188    Sorted = False
    206189    SynonymChars = '<>'
    207     TabOrder = 7
     190    TabOrder = 6
    208191    OnChange = ControlChange
    209192    CharsNeedMatch = 1
    210193  end
    211   object txtProvDiag: TCaptionEdit
     194  object txtProvDiag: TCaptionEdit [10]
    212195    Left = 309
    213196    Top = 94
     
    219202    PopupMenu = mnuPopProvDx
    220203    ShowHint = True
    221     TabOrder = 9
     204    TabOrder = 8
    222205    OnChange = txtProvDiagChange
    223     Caption = 'Provisional Diagnosis'
    224   end
    225   object txtAttn: TORComboBox
     206  end
     207  object txtAttn: TORComboBox [11]
    226208    Left = 454
    227209    Top = 16
     
    231213    Style = orcsDropDown
    232214    AutoSelect = True
    233     Caption = 'Attention'
    234215    Color = clWindow
    235216    DropDownCount = 8
     
    244225    Sorted = False
    245226    SynonymChars = '<>'
    246     TabOrder = 5
     227    TabOrder = 4
    247228    OnChange = ControlChange
    248229    OnNeedData = txtAttnNeedData
    249230    CharsNeedMatch = 1
    250231  end
    251   object treService: TORTreeView
     232  object treService: TORTreeView [12]
    252233    Left = 0
    253234    Top = 38
     
    264245    ParentFont = False
    265246    ReadOnly = True
    266     TabOrder = 3
     247    TabOrder = 2
    267248    Visible = False
    268249    OnChange = treServiceChange
    269250    OnCollapsing = treServiceCollapsing
     251    OnEnter = treServiceEnter
    270252    OnExit = treServiceExit
    271253    OnKeyDown = treServiceKeyDown
    272254    OnKeyUp = treServiceKeyUp
    273255    OnMouseDown = treServiceMouseDown
    274     Caption = 'object lblService: TLabel'
    275256    NodePiece = 0
    276257  end
    277   object cboCategory: TORComboBox
     258  object cboCategory: TORComboBox [13]
    278259    Left = 225
    279260    Top = -5
     
    297278    CharsNeedMatch = 1
    298279  end
    299   object pnlServiceTreeButton: TKeyClickPanel
     280  object pnlServiceTreeButton: TKeyClickPanel [14]
    300281    Left = 274
    301282    Top = 14
     
    313294    Font.Style = []
    314295    ParentFont = False
    315     TabOrder = 2
     296    TabOrder = 1
    316297    TabStop = True
    317298    OnClick = btnServiceTreeClick
     
    323304      Width = 22
    324305      Height = 22
     306      Hint = 'View services/specialties hierarchically'
    325307      Glyph.Data = {
    326308        26050000424D26050000000000003604000028000000100000000F0000000100
     
    367349        FFFFFFFFFFFFFFFFFFFF}
    368350      Margin = 0
     351      ParentShowHint = False
     352      ShowHint = True
    369353      OnClick = btnServiceTreeClick
    370354    end
    371355  end
    372   object cmdLexSearch: TButton
     356  object cmdLexSearch: TButton [15]
    373357    Left = 543
    374358    Top = 94
     
    377361    Anchors = [akTop, akRight]
    378362    Caption = 'Lexicon'
    379     TabOrder = 10
     363    TabOrder = 9
    380364    OnClick = cmdLexSearchClick
    381365  end
    382   object gbInptOpt: TGroupBox
     366  object gbInptOpt: TGroupBox [16]
    383367    Left = 309
    384368    Top = 35
     
    387371    Anchors = [akTop, akRight]
    388372    Caption = 'Patient will be seen as an:'
    389     TabOrder = 6
     373    TabOrder = 5
    390374    object radInpatient: TRadioButton
    391375      Left = 3
     
    407391    end
    408392  end
    409   object btnDiagnosis: TButton
     393  object btnDiagnosis: TButton [17]
    410394    Left = 543
    411395    Top = 95
     
    414398    Anchors = [akTop, akRight]
    415399    Caption = 'Diagnosis'
    416     TabOrder = 8
     400    TabOrder = 7
    417401    OnClick = btnDiagnosisClick
     402  end
     403  inherited cmdAccept: TButton
     404    Left = 439
     405    Top = 315
     406    Anchors = [akLeft, akBottom]
     407    TabOrder = 12
     408    ExplicitLeft = 439
     409    ExplicitTop = 315
     410  end
     411  inherited cmdQuit: TButton
     412    Left = 531
     413    Top = 315
     414    Width = 61
     415    Anchors = [akLeft, akBottom]
     416    TabOrder = 13
     417    ExplicitLeft = 531
     418    ExplicitTop = 315
     419    ExplicitWidth = 61
     420  end
     421  inherited pnlMessage: TPanel
     422    Left = 13
     423    Top = 295
     424    Width = 377
     425    Anchors = [akLeft, akRight, akBottom]
     426    TabOrder = 14
     427    ExplicitLeft = 13
     428    ExplicitTop = 295
     429    ExplicitWidth = 377
     430    inherited memMessage: TRichEdit
     431      Width = 292
     432      ExplicitWidth = 292
     433    end
     434  end
     435  inherited amgrMain: TVA508AccessibilityManager
     436    Data = (
     437      (
     438        'Component = pnlReason'
     439        'Status = stsDefault')
     440      (
     441        'Component = memReason'
     442        'Label = lblReason'
     443        'Status = stsOK')
     444      (
     445        'Component = cboService'
     446        'Status = stsDefault')
     447      (
     448        'Component = cboUrgency'
     449        'Label = lblUrgency'
     450        'Status = stsOK')
     451      (
     452        'Component = cboPlace'
     453        'Label = lblPlace'
     454        'Status = stsOK')
     455      (
     456        'Component = txtProvDiag'
     457        'Label = lblProvDiag'
     458        'Status = stsOK')
     459      (
     460        'Component = txtAttn'
     461        'Label = lblAttn'
     462        'Status = stsOK')
     463      (
     464        'Component = treService'
     465        'Status = stsDefault')
     466      (
     467        'Component = cboCategory'
     468        'Status = stsDefault')
     469      (
     470        'Component = pnlServiceTreeButton'
     471        'Status = stsDefault')
     472      (
     473        'Component = cmdLexSearch'
     474        'Status = stsDefault')
     475      (
     476        'Component = gbInptOpt'
     477        'Status = stsDefault')
     478      (
     479        'Component = radInpatient'
     480        'Status = stsDefault')
     481      (
     482        'Component = radOutpatient'
     483        'Status = stsDefault')
     484      (
     485        'Component = btnDiagnosis'
     486        'Status = stsDefault')
     487      (
     488        'Component = memOrder'
     489        'Status = stsDefault')
     490      (
     491        'Component = cmdAccept'
     492        'Status = stsDefault')
     493      (
     494        'Component = cmdQuit'
     495        'Status = stsDefault')
     496      (
     497        'Component = pnlMessage'
     498        'Status = stsDefault')
     499      (
     500        'Component = memMessage'
     501        'Status = stsDefault')
     502      (
     503        'Component = frmODCslt'
     504        'Status = stsDefault'))
    418505  end
    419506  object mnuPopProvDx: TPopupMenu
  • cprs/trunk/CPRS-Chart/Consults/fODConsult.pas

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    99  fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
    10   Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet ;
     10  Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
     11  VA508AccessibilityManager ;
    1112
    1213type
     
    1819    txtAttn: TORComboBox;
    1920    lblService: TLabel;
    20     lblUrgency: TStaticText;
    21     lblPlace: TStaticText;
    22     lblAttn: TStaticText;
    23     lblProvDiag: TStaticText;
     21    lblUrgency: TLabel;
     22    lblPlace: TLabel;
     23    lblAttn: TLabel;
     24    lblProvDiag: TLabel;
    2425    treService: TORTreeView;
    2526    cboCategory: TORComboBox;
     
    8687    procedure cmdQuitClick(Sender: TObject);
    8788    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     89    procedure FormResize(Sender: TObject);
     90    procedure treServiceEnter(Sender: TObject);
    8891
    8992  private
     
    103106    procedure SaveConsultDxForNurse(pDiagnosis: string);  // save the dx entered by nurese if Master BA switch is ON
    104107    procedure SetUpCopyConsultDiagnoses(pOrderID:string);
     108    procedure AdjustMemReasonSize;
    105109  protected
    106110    procedure InitDialog; override;
     
    125129uses
    126130    rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
    127     ORClasses, clipbrd, uTemplates, fFrame, uODBase;
     131    ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility;
    128132
    129133var
     
    153157  TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
    154158
     159  TX_SVC_HRCHY = 'services/specialties hierarchy';
     160  TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
     161  TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
     162
    155163procedure TfrmODCslt.FormCreate(Sender: TObject);
    156164begin
     
    180188  Responses.Dialog := 'GMRCOR CONSULT';   // loads formatting info
    181189  StatusText('Loading Default Values');
    182   Defaults.Assign(ODForConsults);  // ODForConsults returns TStrings with defaults
     190  FastAssign(ODForConsults, Defaults);  // ODForConsults returns TStrings with defaults
    183191  CtrlInits.LoadDefaults(Defaults);
    184192  txtAttn.InitLongList('') ;
     
    229237  btnServiceTree.Enabled := True;
    230238  pnlServiceTreeButton.Enabled := True;
    231   ActiveControl := cboService;
    232239  SetProvDiagPromptingMode;
     240  ActiveControl := cboService; // set after call to SetProvDiagPromptingMode
    233241  Changing := False;
    234242  StatusText('');
     
    240248                    'Please contact your Clinical Coordinator/IRM staff to fix this order.';
    241249  TX_INACTIVE_SVC_CAP = 'Inactive Service';
     250  TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF +
     251              'Please contact your Clinical Coordinator/IRM staff to fix this order.';
     252  TC_NO_SVC = 'No service specified';
    242253var
    243254 i:integer;
     
    254265      Changing := True;
    255266      tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
    256       SvcIEN := GetServiceIEN(tmpResp.IValue);
     267      if tmpResp <> nil then
     268        SvcIEN := GetServiceIEN(tmpResp.IValue)
     269      else
     270        begin
     271          InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK);
     272          AbortOrder := True;
     273          Close;
     274          Exit;
     275        end;
    257276      if SvcIEN = '-1' then
    258277        begin
     
    284303      SetProvDiagPromptingMode;
    285304      GetProvDxandValidateCode(Responses);
     305      SetTemplateDialogCanceled(FALSE);
    286306      SetControl(memReason,     'COMMENT',   1);
     307      if WasTemplateDialogCanceled then
     308      begin
     309        AbortOrder := True;
     310        Close;
     311        Exit;
     312      end;
     313      SetTemplateDialogCanceled(FALSE);
    287314      SetupReasonForRequest(OrderAction);
     315      if WasTemplateDialogCanceled then
     316      begin
     317        AbortOrder := True;
     318        Close;
     319        Exit;
     320      end;
    288321      Changing := False;
    289322      ControlChange(Self);
     
    292325    begin
    293326      if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ;
    294       SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD));           {RV}
    295       AList.Assign(SvcList);
     327      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD), SvcList);           {RV}
     328      FastAssign(SvcList, AList);
    296329      SortByPiece(AList, U, 2);
    297330      BuildServiceTree(treService, SvcList, '0', nil) ;
     
    308341      if QuickList.Count > 0 then with cboService do
    309342        begin
    310           Items.Assign(QuickList);
     343          FastAssign(QuickList, cboService.Items);
    311344          Items.Add(LLS_LINE);
    312345          Items.Add(LLS_SPACE);
     
    338371              Exit;
    339372            end;
    340           memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     373          QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    341374        end;
    342375      PreserveControl(treService);
     
    555588      SetControl(cboPlace,      'PLACE',     1);
    556589      SetControl(txtAttn,       'PROVIDER',  1);
     590      SetTemplateDialogCanceled(FALSE);
    557591      SetControl(memReason,     'COMMENT',   1);
     592      if WasTemplateDialogCanceled and OrderContainsObjects then
     593      begin
     594        AbortOrder := TRUE;
     595        Close;
     596        Exit;
     597      end;
    558598      if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
    559         memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     599        QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    560600      SetupReasonForRequest(ORDER_QUICK);
    561601      GetProvDxandValidateCode(Responses);
     
    571611              Exit;
    572612            end;
    573           memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     613          QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    574614          SetupReasonForRequest(ORDER_NEW);
    575615        end;
     
    620660end;
    621661
     662procedure TfrmODCslt.treServiceEnter(Sender: TObject);
     663begin
     664  inherited;
     665  cmdQuit.Cancel := FALSE;
     666end;
     667
    622668procedure TfrmODCslt.treServiceExit(Sender: TObject);
    623669begin
    624670  inherited;
     671  cmdQuit.Cancel := TRUE;
    625672  with cboService do
    626673  begin
     
    688735  AStringList := TStringList.Create;
    689736  try
    690     AStringList.Assign(memReason.Lines);
     737    //QuickCopy(memReason, AStringList);
     738    AStringList.Text := memReason.Text;
    691739    LimitStringLength(AStringList, 74);
    692     memReason.Lines.Assign(AstringList);
     740    //QuickCopy(AstringList, memReason);
     741    memReason.Text := AStringList.Text;
    693742    ControlChange(Self);
    694743  finally
     
    762811              SetControl(cboPlace,      'PLACE',     1);
    763812              SetControl(txtAttn,       'PROVIDER',  1);
     813              SetTemplateDialogCanceled(FALSE);
    764814              SetControl(memReason,     'COMMENT',   1);
     815              if WasTemplateDialogCanceled and OrderContainsObjects then
     816              begin
     817                AbortOrder := TRUE;
     818                Close;
     819                Exit;
     820              end;
    765821//              if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
    766 //                memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     822//                QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    767823              SetupReasonForRequest(ORDER_QUICK);
    768824              GetProvDxandValidateCode(Responses);
     
    779835                      Exit;
    780836                    end;
    781                   memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     837                  QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    782838                  SetupReasonForRequest(ORDER_NEW);
    783839                  Changing := False;
     
    824880  if treService.Visible then
    825881  begin
     882  // for some reason screen reader is reading caption when tree view is not visible
     883    treService.Caption := TX_SVC_HRCHY;
     884    pnlServiceTreeButton.Caption := TX_CLOSE_SVC_HRCHY;
     885    btnServiceTree.Hint := TX_CLOSE_SVC_HRCHY;
    826886    treService.SetFocus;
    827887    with treService do for i := 0 to Items.Count-1 do
     
    834894        end;
    835895    end;
     896  end
     897  else
     898  begin
     899    treService.Caption := '';
     900    pnlServiceTreeButton.Caption := TX_VIEW_SVC_HRCHY;
     901    btnServiceTree.Hint := TX_VIEW_SVC_HRCHY;
     902    pnlServiceTreeButton.SetFocus;
    836903  end;
    837904  Changing := False;
     
    863930      txtProvDiag.Enabled    := False;
    864931      txtProvDiag.Font.Color := clGrayText;
    865       lblProvDiag.Enabled    := False;
    866932      txtProvDiag.ReadOnly   := True;
    867933      txtProvDiag.Color      := clBtnFace;
     
    9401006  txtProvDiag.Color      := clBtnFace;
    9411007  txtProvDiag.Font.Color := clBtnText;
    942   lblProvDiag.Enabled    := False;
    9431008  txtProvDiag.Hint       := '';
    9441009  if cboService.ItemIEN = 0 then Exit;
     
    9621027      txtProvDiag.Color      := clBtnFace;
    9631028      txtProvDiag.Font.Color := clBtnText;
    964       lblProvDiag.Enabled    := False;
    9651029    end
    9661030  else
     
    9721036              txtProvDiag.Color      := clWindow;
    9731037              txtProvDiag.Font.Color := clWindowText;
    974               lblProvDiag.Enabled    := True;
    9751038            end;
    9761039      'L':  begin
     
    9891052              txtProvDiag.Color      := clInfoBk;
    9901053              txtProvDiag.Font.Color := clInfoText;
    991               lblProvDiag.Enabled    := True;
    9921054           end;
    9931055    end;
     
    10371099begin
    10381100  if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then
    1039     memReason.Lines.Assign(DefaultReasonForRequest(cboService.ItemID, True));
     1101    QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
    10401102  EditReason := GMRCREAF;
    10411103  if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR);
     
    10651127      if ItemIEN > 0 then
    10661128        begin
    1067           Alist.Assign(GetServicePrerequisites(ItemID + CSLT_PTR));
     1129          FastAssign(GetServicePrerequisites(ItemID + CSLT_PTR), Alist);
    10681130          if AList.Count > 0 then
    10691131            begin
     
    11541216  try
    11551217    Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve);
    1156     TmpSL.Assign(Result);
     1218    FastAssign(Result, TmpSL);
    11571219    x := TmpSL.Text;
    11581220    ExpandOrderObjects(x, HasObjects);
     
    11601222    Responses.OrderContainsObjects := HasObjects;
    11611223    ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo);
    1162     if TmpSL.Text <> x then Responses.OrderContainsObjects := False;
    1163     Result.Assign(TmpSL);
     1224    AbortOrder := WasTemplateDialogCanceled;
     1225    Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects;
     1226    if AbortOrder then
     1227    begin
     1228      Result.Text := '';
     1229      Close;
     1230      Exit;
     1231    end
     1232    else
     1233      FastAssignWith508Msg(TmpSL, Result);
    11641234  finally
    11651235    TmpSL.Free;
     
    11901260      treServiceChange(Sender, treService.Selected);
    11911261    end;
     1262  VK_ESCAPE:
     1263    begin
     1264      key := 0;
     1265      btnServiceTreeClick(Self);
     1266    end   
    11921267  else
    11931268    FKeyBoarding := True;
     
    14061481end;
    14071482
     1483procedure TfrmODCslt.FormResize(Sender: TObject);
     1484begin
     1485  inherited;
     1486  AdjustMemReasonSize();
     1487end;
     1488
     1489procedure TfrmODCslt.AdjustMemReasonSize;
     1490const
     1491  PIXEL_SPACE = 3;
     1492begin
     1493  pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
     1494  pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
     1495end;
     1496
    14081497end.
    14091498
  • cprs/trunk/CPRS-Chart/Consults/fODProc.dfm

    r456 r829  
    1010  Constraints.MinHeight = 393
    1111  Constraints.MinWidth = 543
     12  ExplicitLeft = 208
     13  ExplicitTop = 188
     14  ExplicitWidth = 543
     15  ExplicitHeight = 393
    1216  PixelsPerInch = 96
    1317  TextHeight = 13
     
    119123      'An order message may be displayed here.')
    120124    TabOrder = 1
     125    ExplicitLeft = 0
     126    ExplicitTop = 321
     127    ExplicitWidth = 380
     128    ExplicitHeight = 41
    121129  end
    122130  object cboUrgency: TORComboBox [9]
     
    271279    CharsNeedMatch = 1
    272280  end
    273   inherited cmdAccept: TButton
    274     Left = 387
    275     Top = 339
    276     Anchors = [akRight, akBottom]
    277     TabOrder = 10
    278   end
    279   inherited cmdQuit: TButton
    280     Left = 469
    281     Top = 339
    282     Width = 64
    283     Anchors = [akRight, akBottom]
    284     TabOrder = 11
    285   end
    286   inherited pnlMessage: TPanel
    287     Left = 50
    288     Top = 320
    289     Width = 316
    290     Anchors = [akLeft, akRight, akBottom]
    291     TabOrder = 12
    292     inherited memMessage: TRichEdit
    293       Width = 254
    294     end
    295   end
    296   object cmdLexSearch: TButton
     281  object cmdLexSearch: TButton [15]
    297282    Left = 486
    298283    Top = 93
     
    304289    OnClick = cmdLexSearchClick
    305290  end
    306   object gbInptOpt: TGroupBox
     291  object gbInptOpt: TGroupBox [16]
    307292    Left = 249
    308293    Top = 36
     
    331316    end
    332317  end
    333   object txtProvDiag: TCaptionEdit
     318  object txtProvDiag: TCaptionEdit [17]
    334319    Left = 249
    335320    Top = 93
     
    344329    OnChange = txtProvDiagChange
    345330    Caption = 'Provisional Diagnosis'
     331  end
     332  inherited cmdAccept: TButton
     333    Left = 387
     334    Top = 339
     335    Anchors = [akRight, akBottom]
     336    TabOrder = 10
     337    ExplicitLeft = 387
     338    ExplicitTop = 339
     339  end
     340  inherited cmdQuit: TButton
     341    Left = 469
     342    Top = 339
     343    Width = 64
     344    Anchors = [akRight, akBottom]
     345    TabOrder = 11
     346    ExplicitLeft = 469
     347    ExplicitTop = 339
     348    ExplicitWidth = 64
     349  end
     350  inherited pnlMessage: TPanel
     351    Left = 50
     352    Top = 320
     353    Width = 316
     354    Anchors = [akLeft, akRight, akBottom]
     355    TabOrder = 12
     356    ExplicitLeft = 50
     357    ExplicitTop = 320
     358    ExplicitWidth = 316
     359    inherited memMessage: TRichEdit
     360      Width = 254
     361      ExplicitWidth = 254
     362    end
     363  end
     364  inherited amgrMain: TVA508AccessibilityManager
     365    Data = (
     366      (
     367        'Component = lblUrgency'
     368        'Status = stsDefault')
     369      (
     370        'Component = lblPlace'
     371        'Status = stsDefault')
     372      (
     373        'Component = lblAttn'
     374        'Status = stsDefault')
     375      (
     376        'Component = lblProvDiag'
     377        'Status = stsDefault')
     378      (
     379        'Component = pnlReason'
     380        'Status = stsDefault')
     381      (
     382        'Component = memReason'
     383        'Status = stsDefault')
     384      (
     385        'Component = cboUrgency'
     386        'Status = stsDefault')
     387      (
     388        'Component = cboPlace'
     389        'Status = stsDefault')
     390      (
     391        'Component = txtAttn'
     392        'Status = stsDefault')
     393      (
     394        'Component = cboProc'
     395        'Status = stsDefault')
     396      (
     397        'Component = cboCategory'
     398        'Status = stsDefault')
     399      (
     400        'Component = cboService'
     401        'Status = stsDefault')
     402      (
     403        'Component = cmdLexSearch'
     404        'Status = stsDefault')
     405      (
     406        'Component = gbInptOpt'
     407        'Status = stsDefault')
     408      (
     409        'Component = radInpatient'
     410        'Status = stsDefault')
     411      (
     412        'Component = radOutpatient'
     413        'Status = stsDefault')
     414      (
     415        'Component = txtProvDiag'
     416        'Status = stsDefault')
     417      (
     418        'Component = memOrder'
     419        'Status = stsDefault')
     420      (
     421        'Component = cmdAccept'
     422        'Status = stsDefault')
     423      (
     424        'Component = cmdQuit'
     425        'Status = stsDefault')
     426      (
     427        'Component = pnlMessage'
     428        'Status = stsDefault')
     429      (
     430        'Component = memMessage'
     431        'Status = stsDefault')
     432      (
     433        'Component = frmODProc'
     434        'Status = stsDefault'))
    346435  end
    347436  object mnuPopProvDx: TPopupMenu
  • cprs/trunk/CPRS-Chart/Consults/fODProc.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
    8   Menus;
     8  Menus, VA508AccessibilityManager;
    99
    1010type
     
    5959    procedure memReasonKeyUp(Sender: TObject; var Key: Word;
    6060      Shift: TShiftState);
    61     procedure FormDestroy(Sender: TObject);
    6261    procedure memReasonKeyDown(Sender: TObject; var Key: Word;
    6362      Shift: TShiftState);
     
    9089uses
    9190    rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
    92     clipbrd, fPreReq, uTemplates, uAccessibleRichEdit, fFrame, uODBase;
     91    clipbrd, fPreReq, uTemplates, fFrame, uODBase,
     92  uVA508CPRSCompatibility;
    9393
    9494var
     
    115115  inherited;
    116116  DoSetFontSize(MainFontSize);
    117   TAccessibleRichEdit.WrapControl(memReason);
    118117  AllowQuickOrder := True;
    119118  FillChar(ProvDx, SizeOf(ProvDx), 0);
     
    188187    SetControl(cboProc,       'ORDERABLE', 1);
    189188    if cboProc.ItemIndex < 0 then exit;
    190     cboService.Items.Assign(GetProcedureServices(cboProc.ItemIEN));
     189    FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
    191190    Changing := True;
    192191    tmpResp := TResponse(FindResponseByName('CLASS',1));
     
    226225    SetProvDiagPromptingMode;
    227226    GetProvDxandValidateCode(Responses);
     227    SetTemplateDialogCanceled(FALSE);
    228228    SetControl(memReason,     'COMMENT',   1);
     229    if WasTemplateDialogCanceled then
     230    begin
     231      AbortOrder := True;
     232      Close;
     233      Exit;
     234    end;
     235    SetTemplateDialogCanceled(FALSE);
    229236    SetupReasonForRequest(OrderAction);
     237    if WasTemplateDialogCanceled then
     238    begin
     239      AbortOrder := True;
     240      Close;
     241      Exit;
     242    end;
    230243    Changing := False;
    231244    OrderMessage(ConsultMessage(cboProc.ItemIEN));
     
    360373      begin
    361374        Clear;
    362         Items.Assign(GetProcedureServices(cboProc.ItemIEN));
     375        FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
    363376        if Items.Count > 1 then
    364377          ItemIndex := -1
     
    385398      with cboService do
    386399        begin
    387           Items.Assign(GetProcedureServices(cboProc.ItemIEN));
     400          FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
    388401          if Items.Count > 1 then
    389402            ItemIndex := -1
     
    402415      SetControl(cboPlace,      'PLACE',     1);
    403416      SetControl(txtAttn,       'PROVIDER',  1);
     417      SetTemplateDialogCanceled(FALSE);
    404418      SetControl(memReason,     'COMMENT',   1);
    405 //      if ((cboProc.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
    406 //        memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
     419      if WasTemplateDialogCanceled and OrderContainsObjects then
     420      begin
     421        AbortOrder := TRUE;
     422        Close;
     423        Exit;
     424      end;
    407425      SetupReasonForRequest(ORDER_QUICK);
    408426      GetProvDxandValidateCode(Responses);
     
    441459              Exit;
    442460            end;
    443           memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
     461          FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines);
    444462          SetupReasonForRequest(ORDER_NEW);
    445463        end;
     
    457475  AStringList := TStringList.Create;
    458476  try
    459     AStringList.Assign(memReason.Lines);
     477    AStringList.Text := memReason.Text;
    460478    LimitStringLength(AStringList, 74);
    461     memReason.Lines.Assign(AstringList);
     479    memReason.Text := AStringList.Text;
    462480    ControlChange(Self);
    463481  finally
     
    662680begin
    663681  if ((OrderAction = ORDER_QUICK) and (cboProc.ItemID <> '') and (Length(memReason.Text) = 0)) then
    664     memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
     682    FastAssign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True), memReason.Lines);
    665683  EditReason := GMRCREAF;
    666684  if EditReason = '' then EditReason := ReasonForRequestEditable(Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
     
    690708      if ItemIEN > 0 then
    691709        begin
    692           Alist.Assign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)));
     710          FastAssign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)), Alist);
    693711          if AList.Count > 0 then
    694712            begin
     
    708726end;
    709727
    710 function TfrmODProc.DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
     728function TfrmODProc.DefaultReasonForRequest(Service: string;
     729  Resolve: Boolean): TStrings;
    711730var
    712731  TmpSL: TStringList;
     
    720739  try
    721740    Result := GetDefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), Resolve);
    722     TmpSL.Assign(Result);
     741    FastAssign(Result, TmpSL);
    723742    x := TmpSL.Text;
    724743    ExpandOrderObjects(x, HasObjects);
    725744    TmpSL.Text := x;
    726745    Responses.OrderContainsObjects := HasObjects;
    727     ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(piece(piece(cboProc.Items[cboProc.ItemIndex],U,4),';',1),0),
     746    ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(Piece(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), ';', 1), 0),
    728747                   ltProcedure, nil, 'Reason for Request: ' + cboProc.DisplayText[cboProc.ItemIndex], DocInfo);
    729     if TmpSL.Text <> x then Responses.OrderContainsObjects := False;
    730     Result.Assign(TmpSL);
     748    AbortOrder := WasTemplateDialogCanceled;
     749    Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects;
     750    if AbortOrder then
     751    begin
     752      Result.Text := '';
     753      Close;
     754      Exit;
     755    end
     756    else
     757      FastAssignWith508Msg(TmpSL, Result);
    731758  finally
    732759    TmpSL.Free;
     
    780807end;
    781808
    782 procedure TfrmODProc.FormDestroy(Sender: TObject);
    783 begin
    784   inherited;
    785   TAccessibleRichEdit.UnwrapControl(memReason);
    786 end;
    787 
    788809procedure TfrmODProc.SetFontSize(FontSize: integer);
    789810begin
  • cprs/trunk/CPRS-Chart/Consults/fPreReq.dfm

    r456 r829  
    1 object frmPrerequisites: TfrmPrerequisites
     1inherited frmPrerequisites: TfrmPrerequisites
    22  Left = 337
    33  Top = 219
    4   Width = 377
    5   Height = 348
    64  BorderIcons = [biSystemMenu]
    75  Caption = 'frmPrerequisites'
    8   Color = clBtnFace
     6  ClientHeight = 319
     7  ClientWidth = 367
    98  Font.Charset = ANSI_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    149  OldCreateOrder = True
    1510  Position = poScreenCenter
     11  OnActivate = OnActivate
    1612  OnClose = FormClose
    1713  OnCreate = FormCreate
    18   OnShow = FormShow
     14  ExplicitWidth = 375
     15  ExplicitHeight = 346
    1916  PixelsPerInch = 96
    2017  TextHeight = 13
    21   object lblFontTest: TLabel
     18  object lblFontTest: TLabel [0]
    2219    Left = 148
    2320    Top = 208
     
    3229    ParentFont = False
    3330  end
    34   object memReport: TRichEdit
     31  object memReport: TRichEdit [1]
    3532    Left = 0
    3633    Top = 33
    37     Width = 369
    38     Height = 288
     34    Width = 367
     35    Height = 286
    3936    Align = alClient
    4037    Color = clCream
     
    5350    WordWrap = False
    5451  end
    55   object pnlButton: TPanel
     52  object pnlButton: TPanel [2]
    5653    Left = 0
    5754    Top = 0
    58     Width = 369
     55    Width = 367
    5956    Height = 33
    6057    Align = alTop
     
    6259    TabOrder = 2
    6360    DesignSize = (
    64       369
     61      367
    6562      33)
    6663    object cmdContinue: TButton
    67       Left = 209
     64      Left = 207
    6865      Top = 6
    6966      Width = 75
     
    7572    end
    7673    object cmdCancel: TButton
    77       Left = 292
     74      Left = 290
    7875      Top = 6
    7976      Width = 75
     
    8683    end
    8784  end
    88   object cmdPrint: TButton
     85  object cmdPrint: TButton [3]
    8986    Left = 2
    9087    Top = 6
     
    9592    OnClick = cmdPrintClick
    9693  end
     94  inherited amgrMain: TVA508AccessibilityManager
     95    Data = (
     96      (
     97        'Component = memReport'
     98        'Status = stsDefault')
     99      (
     100        'Component = pnlButton'
     101        'Status = stsDefault')
     102      (
     103        'Component = cmdContinue'
     104        'Status = stsDefault')
     105      (
     106        'Component = cmdCancel'
     107        'Status = stsDefault')
     108      (
     109        'Component = cmdPrint'
     110        'Status = stsDefault')
     111      (
     112        'Component = frmPrerequisites'
     113        'Status = stsDefault'))
     114  end
    97115  object dlgPrintReport: TPrintDialog
    98116    Left = 113
  • cprs/trunk/CPRS-Chart/Consults/fPreReq.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORFn, ComCtrls, ExtCtrls;
     7  StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager,
     8  uReports;
    89
    910type
    10   TfrmPrerequisites = class(TForm)
     11  TfrmPrerequisites = class(TfrmBase508Form)
    1112    lblFontTest: TLabel;
    1213    memReport: TRichEdit;
     
    2021    procedure cmdCancelClick(Sender: TObject);
    2122    procedure cmdPrintClick(Sender: TObject);
     23    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     24    procedure OnActivate(Sender: TObject);
    2225    procedure FormCreate(Sender: TObject);
    23     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    24     procedure FormShow(Sender: TObject);
    2526  private
    2627    procedure AlignButtons();
     
    3536
    3637uses
    37   uCore, rCore, rReports, Printers,rMisc;
     38  uCore, rCore, rReports, Printers, rMisc;
    3839
    3940{$R *.DFM}
     
    6667      ForceInsideWorkArea(Rect);
    6768      BoundsRect := Rect;
    68       memReport.Lines.Assign(ReportText);
    69       ResizeAnchoredFormToFont(result);
     69      QuickCopy(ReportText, memReport);
    7070      //Quick fix to work around glich in resize algorithim
    7171      AlignButtons();
     
    127127      AHeader := TStringList.Create;
    128128      CreatePatientHeader(AHeader, Self.Caption);
    129       memPrintReport := TRichEdit.Create(Self);
     129      memPrintReport := CreateReportTextComponent(Self);
    130130      try
    131131        MaxLines := 60 - AHeader.Count;
     
    134134        with memPrintReport do
    135135          begin
    136             Visible := False;
    137             Parent := Self;
    138             Font.Name := 'Courier New';
    139             Font.Size := MainFontSize;
    140             Width := Printer.Canvas.TextWidth(StringOfChar('-', 74));
    141             //Width := 600;
    142136            repeat
    143137              with Lines do
     
    174168end;
    175169
    176 procedure TfrmPrerequisites.FormCreate(Sender: TObject);
    177 begin
    178   memreport.Color := ReadOnlyColor;
    179 
    180 end;
    181 
    182170procedure TfrmPrerequisites.AlignButtons;
    183171Const
    184172  BtnSpace = 8;
    185173begin
    186   cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace;
     174  cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3;
    187175  cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width;
    188176end;
     
    194182end;
    195183
    196 procedure TfrmPrerequisites.FormShow(Sender: TObject);
     184procedure TfrmPrerequisites.FormCreate(Sender: TObject);
    197185begin
     186  inherited;
     187  ResizeAnchoredFormToFont(Self);
    198188  SetFormPosition(Self); //Get Saved Position & Size of Form
    199189end;
    200190
     191procedure TfrmPrerequisites.OnActivate(Sender: TObject);
     192begin
     193  if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0;
     194end;
    201195end.
  • cprs/trunk/CPRS-Chart/Consults/rConsults.pas

    r456 r829  
    285285           Results[i] := x;
    286286         end;
    287        Dest.Assign(Results);
     287       FastAssign(Results, Dest);
    288288     end
    289289    else
     
    299299begin
    300300  CallV('ORQQCN DETAIL', [IEN]);
    301   Dest.Assign(RPCBrokerV.Results);
     301  FastAssign(RPCBrokerV.Results, Dest);
    302302end;
    303303
     
    306306begin
    307307  CallV('ORQQCN MED RESULTS', [IEN]);
    308   Dest.Assign(RPCBrokerV.Results);
     308  FastAssign(RPCBrokerV.Results, Dest);
    309309end;
    310310
     
    327327  alist := TStringList.Create ;
    328328 try
    329   alist.Assign(RPCBrokerV.Results) ;
     329  FastAssign(RPCBrokerV.Results, aList);
    330330  x := alist[0] ;
    331331  if Piece(x,u,1) <> '-1' then
     
    459459begin
    460460  CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
    461   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     461  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    462462end;
    463463
     
    466466begin
    467467  CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
    468   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     468  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    469469end;
    470470
     
    473473begin
    474474  CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
    475   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     475  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    476476end;
    477477
     
    480480begin
    481481  CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
    482   Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     482  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    483483end;
    484484
     
    486486     ActionDate: TFMDateTime; Comments: TStrings);
    487487begin
    488      CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
    489      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     488  CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
     489  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    490490end ;
    491491
     
    493493AlertTo: string) ;
    494494begin
    495      CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
    496      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     495  CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
     496  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    497497end ;
    498498
     
    500500          RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
    501501begin
    502      CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
    503      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     502  CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
     503  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    504504end ;
    505505
     
    507507AlertTo: string) ;
    508508begin
    509      CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
    510      Dest.Assign(RPCBrokerV.Results);   {1^Error message' or '0'}
     509  CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
     510  FastAssign(RPCBrokerV.Results, Dest);   {1^Error message' or '0'}
    511511end ;
    512512
     
    831831      ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4));
    832832      Title := StrToIntDef(Piece(x, U, 5), 0);
     833      DateTime := StrToFloatDef(Piece(x, U, 6), 0);
    833834    end;
    834835  Result := AnEditRec;
  • cprs/trunk/CPRS-Chart/Consults/uConsults.pas

    r456 r829  
    3838    ProvDxCode: string;                     {  30.1}
    3939    RequestProcessingActivity: TStringList; {  40}
     40    //EarliestDate: TFMDateTime;
     41    //LatestDate: TFMDateTime;
    4042  end ;
    4143
     
    5153    Urgency: integer;
    5254    UrgencyName: string;
     55    //EarliestDate: TFMDateTime;
     56    //LatestDate: TFMDateTime;
    5357    Place: string;
    5458    PlaceName: string;
     
    134138   UL_ADMIN             = 3;
    135139   UL_UPDATE_AND_ADMIN  = 4;
     140   UL_UNRESTRICTED      = 5;
    136141
    137142   {Clinical Procedure statuses}
     
    297302  SrcList := TStringList.Create;
    298303  try
    299     SrcList.Assign(Source);
     304    FastAssign(Source, SrcList);
    300305    with SrcList do
    301306      begin
  • cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.dfm

    r456 r829  
    55  PixelsPerInch = 96
    66  TextHeight = 13
    7   object lblAdd2PL: TLabel [0]
    8     Left = 555
    9     Top = 255
    10     Width = 53
    11     Height = 26
    12     Caption = 'Add to Problem list'
    13     WordWrap = True
    14   end
    157  inherited lblSection: TLabel
    168    Width = 89
    179    Caption = 'Diagnoses Section'
     10    ExplicitWidth = 89
    1811  end
    1912  inherited btnOK: TBitBtn
     
    2619    Width = 523
    2720    TabOrder = 1
     21    ExplicitWidth = 523
    2822    inherited lbGrid: TORListBox
    2923      Tag = 20
    3024      Width = 523
    3125      Pieces = '1,2,3'
     26      ExplicitWidth = 523
    3227    end
    3328    inherited hcGrid: THeaderControl
     
    5247          Width = 110
    5348        end>
     49      ExplicitWidth = 523
    5450    end
    5551  end
    5652  inherited edtComment: TCaptionEdit
    5753    TabOrder = 3
     54  end
     55  object cmdDiagPrimary: TButton [8]
     56    Left = 536
     57    Top = 306
     58    Width = 75
     59    Height = 21
     60    Caption = 'Primary'
     61    Enabled = False
     62    TabOrder = 5
     63    OnClick = cmdDiagPrimaryClick
     64  end
     65  object ckbDiagProb: TCheckBox [9]
     66    Left = 535
     67    Top = 258
     68    Width = 76
     69    Height = 38
     70    Caption = 'Add to Problem list'
     71    TabOrder = 4
     72    WordWrap = True
     73    OnClick = ckbDiagProbClicked
    5874  end
    5975  inherited btnRemove: TButton
     
    6480    TabOrder = 2
    6581    TabStop = True
     82    ExplicitLeft = 454
    6683  end
    6784  inherited pnlMain: TPanel
     
    7289      IntegralHeight = True
    7390      Pieces = '2,3,4,5'
     91      ExplicitHeight = 196
    7492    end
    7593    inherited pnlLeft: TPanel
     
    85103    end
    86104  end
    87   object cmdDiagPrimary: TButton
    88     Left = 536
    89     Top = 306
    90     Width = 75
    91     Height = 21
    92     Caption = 'Primary'
    93     Enabled = False
    94     TabOrder = 5
    95     OnClick = cmdDiagPrimaryClick
    96   end
    97   object ckbDiagProb: TCheckBox
    98     Left = 536
    99     Top = 262
    100     Width = 13
    101     Height = 13
    102     Caption = 'Add to Problem list'
    103     TabOrder = 4
    104     OnClick = ckbDiagProbClicked
     105  inherited amgrMain: TVA508AccessibilityManager
     106    Data = (
     107      (
     108        'Component = cmdDiagPrimary'
     109        'Status = stsDefault')
     110      (
     111        'Component = ckbDiagProb'
     112        'Status = stsDefault')
     113      (
     114        'Component = edtComment'
     115        'Label = lblComment'
     116        'Status = stsOK')
     117      (
     118        'Component = btnRemove'
     119        'Status = stsDefault')
     120      (
     121        'Component = btnSelectAll'
     122        'Status = stsDefault')
     123      (
     124        'Component = pnlMain'
     125        'Status = stsDefault')
     126      (
     127        'Component = lbxSection'
     128        'Label = lblList'
     129        'Status = stsOK')
     130      (
     131        'Component = pnlLeft'
     132        'Status = stsDefault')
     133      (
     134        'Component = lbSection'
     135        'Label = lblSection'
     136        'Status = stsOK')
     137      (
     138        'Component = btnOther'
     139        'Status = stsDefault')
     140      (
     141        'Component = pnlGrid'
     142        'Status = stsDefault')
     143      (
     144        'Component = lbGrid'
     145        'Status = stsDefault')
     146      (
     147        'Component = hcGrid'
     148        'Status = stsDefault')
     149      (
     150        'Component = btnOK'
     151        'Status = stsDefault')
     152      (
     153        'Component = btnCancel'
     154        'Status = stsDefault')
     155      (
     156        'Component = frmDiagnoses'
     157        'Status = stsDefault'))
    105158  end
    106159end
  • cprs/trunk/CPRS-Chart/Encounter/fDiagnoses.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore;
     8  ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, VA508AccessibilityManager;
    99
    1010type
     
    1212    cmdDiagPrimary: TButton;
    1313    ckbDiagProb: TCheckBox;
    14     lblAdd2PL: TLabel;
    1514    procedure cmdDiagPrimaryClick(Sender: TObject);
    1615    procedure ckbDiagProbClicked(Sender: TObject);
     
    4948
    5049uses
    51   fEncounterFrame, uConst, UBACore;
     50  fEncounterFrame, uConst, UBACore, VA508AccessibilityRouter;
    5251
    5352procedure TfrmDiagnoses.EnsurePrimaryDiag;
     
    153152            PLItemCount := PLItemCount + 1;
    154153      OK := OK and (PLItemCount < lbGrid.SelCount);
    155       lblAdd2PL.Enabled := OK;
    156154      ckbDiagProb.Enabled := OK;
    157155      if(OK) then
     
    182180begin
    183181  inherited;
     182  if lbxSection.width = 0 then Exit;
    184183  FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
    185184  FSectionTabs[1] := -FSectionTabs[0]+2;
     
    257256end;
    258257
     258initialization
     259  SpecifyFormIsNotADialog(TfrmDiagnoses);
     260
    259261end.
  • cprs/trunk/CPRS-Chart/Encounter/fEncVitals.dfm

    r456 r829  
    33  Top = 210
    44  Caption = 'Vitals'
    5   KeyPreview = True
    65  OnActivate = FormActivate
    7   OnDestroy = FormDestroy
    8   OnKeyDown = FormKeyDown
    9   OnResize = FormResize
     6  OnShow = FormShow
     7  ExplicitWidth = 632
     8  ExplicitHeight = 427
    109  PixelsPerInch = 96
    1110  TextHeight = 13
     
    1514    Width = 624
    1615    Height = 368
    17     Hint = 'To sort, click on column headers|'
    1816    Align = alClient
    1917    Columns = <>
     
    3533    Align = alBottom
    3634    BevelOuter = bvNone
    37     TabOrder = 5
     35    TabOrder = 4
     36    object btnEnterVitals: TButton
     37      Left = 8
     38      Top = 6
     39      Width = 75
     40      Height = 21
     41      Caption = 'Enter Vitals'
     42      TabOrder = 0
     43      OnClick = btnEnterVitalsClick
     44    end
     45    object btnOKkludge: TButton
     46      Left = 434
     47      Top = 6
     48      Width = 75
     49      Height = 21
     50      Caption = 'OK'
     51      TabOrder = 1
     52      OnClick = btnOKClick
     53    end
     54    object btnCancelkludge: TButton
     55      Left = 522
     56      Top = 6
     57      Width = 75
     58      Height = 21
     59      Caption = 'Cancel'
     60      TabOrder = 2
     61      OnClick = btnCancelClick
     62    end
    3863  end
    3964  inherited btnOK: TBitBtn
    40     Left = 444
    41     Top = 377
    42     TabOrder = 3
     65    Left = 208
     66    Top = 374
     67    Caption = 'OK No Show'
     68    TabOrder = 2
     69    Visible = False
     70    ExplicitLeft = 208
     71    ExplicitTop = 374
    4372  end
    4473  inherited btnCancel: TBitBtn
    45     Left = 524
    46     Top = 377
    47     TabOrder = 4
     74    Left = 289
     75    Top = 374
     76    Caption = 'Cancel No Show'
     77    TabOrder = 3
     78    Visible = False
     79    ExplicitLeft = 289
     80    ExplicitTop = 374
    4881  end
    49   object pnlmain: TPanel
     82  object pnlmain: TPanel [4]
    5083    Left = 28
    5184    Top = 24
     
    443476    end
    444477  end
    445   object btnEnterVitals: TButton
    446     Left = 8
    447     Top = 377
    448     Width = 75
    449     Height = 21
    450     Caption = 'Enter Vitals'
    451     TabOrder = 2
    452     OnClick = btnEnterVitalsClick
     478  inherited amgrMain: TVA508AccessibilityManager
     479    Data = (
     480      (
     481        'Component = lvVitals'
     482        'Status = stsDefault')
     483      (
     484        'Component = pnlBottom'
     485        'Status = stsDefault')
     486      (
     487        'Component = btnEnterVitals'
     488        'Status = stsDefault')
     489      (
     490        'Component = btnOKkludge'
     491        'Status = stsDefault')
     492      (
     493        'Component = btnCancelkludge'
     494        'Status = stsDefault')
     495      (
     496        'Component = pnlmain'
     497        'Status = stsDefault')
     498      (
     499        'Component = lblDate'
     500        'Status = stsDefault')
     501      (
     502        'Component = lblDateBP'
     503        'Status = stsDefault')
     504      (
     505        'Component = lblDateTemp'
     506        'Status = stsDefault')
     507      (
     508        'Component = lblDateResp'
     509        'Status = stsDefault')
     510      (
     511        'Component = lblDatePulse'
     512        'Status = stsDefault')
     513      (
     514        'Component = lblDateHeight'
     515        'Status = stsDefault')
     516      (
     517        'Component = lblDateWeight'
     518        'Status = stsDefault')
     519      (
     520        'Component = lblLstMeas'
     521        'Status = stsDefault')
     522      (
     523        'Component = lbllastBP'
     524        'Status = stsDefault')
     525      (
     526        'Component = lblLastTemp'
     527        'Status = stsDefault')
     528      (
     529        'Component = lblLastResp'
     530        'Status = stsDefault')
     531      (
     532        'Component = lblLastPulse'
     533        'Status = stsDefault')
     534      (
     535        'Component = lblLastHeight'
     536        'Status = stsDefault')
     537      (
     538        'Component = lblLastWeight'
     539        'Status = stsDefault')
     540      (
     541        'Component = lblVital'
     542        'Status = stsDefault')
     543      (
     544        'Component = lblVitBP'
     545        'Status = stsDefault')
     546      (
     547        'Component = lnlVitTemp'
     548        'Status = stsDefault')
     549      (
     550        'Component = lblVitResp'
     551        'Status = stsDefault')
     552      (
     553        'Component = lblVitPulse'
     554        'Status = stsDefault')
     555      (
     556        'Component = lblVitHeight'
     557        'Status = stsDefault')
     558      (
     559        'Component = lblVitWeight'
     560        'Status = stsDefault')
     561      (
     562        'Component = lblVitPain'
     563        'Status = stsDefault')
     564      (
     565        'Component = lblLastPain'
     566        'Status = stsDefault')
     567      (
     568        'Component = lblDatePain'
     569        'Status = stsDefault')
     570      (
     571        'Component = txtMeasBP'
     572        'Status = stsDefault')
     573      (
     574        'Component = cboTemp'
     575        'Status = stsDefault')
     576      (
     577        'Component = txtMeasTemp'
     578        'Status = stsDefault')
     579      (
     580        'Component = txtMeasResp'
     581        'Status = stsDefault')
     582      (
     583        'Component = cboHeight'
     584        'Status = stsDefault')
     585      (
     586        'Component = txtMeasWt'
     587        'Status = stsDefault')
     588      (
     589        'Component = cboWeight'
     590        'Status = stsDefault')
     591      (
     592        'Component = txtMeasDate'
     593        'Status = stsDefault')
     594      (
     595        'Component = cboPain'
     596        'Status = stsDefault')
     597      (
     598        'Component = txtMeasPulse'
     599        'Status = stsDefault')
     600      (
     601        'Component = txtMeasHt'
     602        'Status = stsDefault')
     603      (
     604        'Component = btnOK'
     605        'Status = stsDefault')
     606      (
     607        'Component = btnCancel'
     608        'Status = stsDefault')
     609      (
     610        'Component = frmEncVitals'
     611        'Status = stsDefault'))
    453612  end
    454613end
  • cprs/trunk/CPRS-Chart/Encounter/fEncVitals.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, ORDtTm, StdCtrls, ORCtrls, ExtCtrls, Buttons, fAutoSz, ORFn,
    8   rvitals, ComCtrls, ORNet, uVitals
    9   , TRPCB // Vitals Lite 2004-05-21 ===========================================
    10   ;
    11 {== Vitals Lite 2004-05-21 ===================================================}
    12 type
    13   TGMV_GetInputPanel = function(
    14     var anApp: TApplication;
    15     aB: TRPCBroker;
    16     aP,         // Patient DFN
    17     aL,         // Hospitals IEN
    18     aSig,       // Application signature
    19     aTemplate   // Vitals Input template
    20         : String;
    21     aNow        // Input Date/Time
    22         :TDateTime):TCustomForm;
    23 {== Vitals Lite 2004-05-21 ===================================================}
     8  rvitals, ComCtrls, ORNet, uVitals, VAUtils, TRPCB, VA508AccessibilityManager;
    249
    2510type
     
    6348    txtMeasHt: TCaptionEdit;
    6449    pnlBottom: TPanel;
     50    lvVitals: TCaptionListView;
    6551    btnEnterVitals: TButton;
    66     lvVitals: TCaptionListView;
     52    btnOKkludge: TButton;
     53    btnCancelkludge: TButton;
    6754    procedure SetVitPointer(Sender: TObject);
    6855    procedure txtMeasBPExit(Sender: TObject);
     
    8774    procedure txtMeasHtExit(Sender: TObject);
    8875    procedure txtMeasWtExit(Sender: TObject);
    89     procedure FormKeyDown(Sender: TObject; var Key: Word;
    90       Shift: TShiftState);
    9176    procedure btnEnterVitalsClick(Sender: TObject); //vitals lite
    9277  private
     
    120105     fEncounterFrame, uInit
    121106  //   , fGMV_InputTemp // Vitals Lite 2004-05-21
    122      ;
     107     , VA508AccessibilityRouter;
    123108
    124109const
     
    418403
    419404{== Vitals Lite 2004-05-21 ===================================================}
    420   FreeLibrary(VitalsDLLHandle);
     405  if VitalsDLLHandle <> 0 then
     406  begin
     407    FreeLibrary(VitalsDLLHandle);
     408    VitalsDLLHandle := 0;
     409  end;
    421410{== Vitals Lite 2004-05-21 ===================================================}
    422411  inherited;
     
    448437  GMV_LibName :='GMV_VitalsViewEnter.dll';
    449438  GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
    450   VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
     439  if VitalsDLLHandle = 0 then
     440    VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
    451441  if VitalsDLLHandle = 0 then // No Handle found
    452442    MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0)
     
    555545  txtMeasWt.text    := '';
    556546  cboPain.text      := '';
    557 end;
    558 
    559 procedure TfrmEncVitals.FormKeyDown(Sender: TObject; var Key: Word;
    560   Shift: TShiftState);
    561 begin
    562   {capture return key press if on the vital screen}
    563   begin
    564     inherited;
    565     if (ActiveCtrl.tag in VitalDateTagSet)then
    566     begin
    567       if Key = VK_RETURN then
    568       begin
    569         Key := 0;
    570         if (ActiveCtrl.Tag = TAG_VITPAIN) then
    571           ChangeFocus(btnOK)
    572         else
    573         begin
    574           GetParentForm(Self).Perform(WM_NEXTDLGCTL,0,0);
    575           SetVitPointer(Sender);
    576         end;
    577       end;
    578     end;
    579   end;
    580547end;
    581548
     
    636603  end
    637604  else
    638     MessageDLG('Can not find function "'+GMV_FName+'".',mtError,[mbok],0);
     605    MessageDLG('Unable to find function "'+GMV_FName+'".',mtError,[mbok],0);
    639606  @VLPtVitals := nil;
    640607  LoadVitalsList;
     
    652619  if assigned(VLPtVitals) then
    653620  begin
    654     frmFrame.VitalsDLLActive := True;  // need this flag for CCOW (RV)
     621//    frmFrame.DLLActive := True;  // need this flag for CCOW (RV)
    655622    VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
    656623    if assigned(VitalsList) then
     
    660627    MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);
    661628  @VLPtVitals := nil;
    662   frmFrame.VitalsDLLActive := False;  // need this flag for CCOW (RV)
     629//  frmFrame.DLLActive := False;  // need this flag for CCOW (RV)
    663630end;
    664631//End Vitals Lite
    665632
     633initialization
     634  SpecifyFormIsNotADialog(TfrmEncVitals);
     635
    666636end.
  • cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.dfm

    r456 r829  
    1 object frmEncounterFrame: TfrmEncounterFrame
     1inherited frmEncounterFrame: TfrmEncounterFrame
    22  Left = 290
    33  Top = 108
    4   Width = 640
    5   Height = 451
    64  Caption = 'Encounter Frame'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 424
     6  ClientWidth = 632
    137  FormStyle = fsMDIForm
    14   KeyPreview = True
    158  OldCreateOrder = True
    169  Position = poScreenCenter
     
    2013  OnCreate = FormCreate
    2114  OnDestroy = FormDestroy
    22   OnKeyDown = FormKeyDown
    2315  OnResize = FormResize
     16  OnShow = FormShow
     17  ExplicitLeft = 290
     18  ExplicitTop = 108
     19  ExplicitWidth = 640
     20  ExplicitHeight = 458
    2421  PixelsPerInch = 96
    2522  TextHeight = 13
    26   object Bevel1: TBevel
     23  object Bevel1: TBevel [0]
    2724    Left = 0
    2825    Top = 0
     
    3128    Align = alTop
    3229  end
    33   object StatusBar1: TStatusBar
     30  object StatusBar1: TStatusBar [1]
    3431    Left = 0
    35     Top = 417
     32    Top = 424
    3633    Width = 632
    3734    Height = 0
    3835    Panels = <>
    39     SimplePanel = False
    4036  end
    41   object pnlPage: TPanel
     37  object pnlPage: TPanel [2]
    4238    Left = 0
    4339    Top = 24
    4440    Width = 632
    45     Height = 393
     41    Height = 400
    4642    Align = alClient
    4743    BevelOuter = bvNone
     
    5450    TabOrder = 1
    5551  end
    56   object TabControl: TTabControl
     52  object TabControl: TTabControl [3]
    5753    Left = 0
    5854    Top = 2
     
    6359    OnChange = TabControlChange
    6460    OnChanging = TabControlChanging
    65     OnExit = TabControlExit
     61    OnEnter = TabControlEnter
     62  end
     63  inherited amgrMain: TVA508AccessibilityManager
     64    Data = (
     65      (
     66        'Component = StatusBar1'
     67        'Status = stsDefault')
     68      (
     69        'Component = pnlPage'
     70        'Status = stsDefault')
     71      (
     72        'Component = TabControl'
     73        'Status = stsDefault')
     74      (
     75        'Component = frmEncounterFrame'
     76        'Status = stsDefault'))
    6677  end
    6778end
  • cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas

    r456 r829  
    77  Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase,
    88  fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd,
    9   fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals,rvitals;
     9  fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals, rvitals, fBase508Form,
     10  VA508AccessibilityManager;
    1011
    1112const
     
    5657
    5758type
    58   TfrmEncounterFrame = class(TForm)
     59  TfrmEncounterFrame = class(TfrmBase508Form)
    5960    StatusBar1: TStatusBar;
    6061    pnlPage: TPanel;
     
    7273    procedure TabControlChanging(Sender: TObject;
    7374      var AllowChange: Boolean);
    74     procedure TabControlExit(Sender: TObject);
    7575    procedure FormKeyDown(Sender: TObject; var Key: Word;
    7676      Shift: TShiftState);
     
    7878    procedure FormCanResize(Sender: TObject; var NewWidth,
    7979      NewHeight: Integer; var Resize: Boolean);
     80    procedure FormShow(Sender: TObject);
     81    procedure TabControlEnter(Sender: TObject);
    8082
    8183  private
     
    8890                            //in the frame.  They must be available at compile time
    8991    FLastPage: TfrmPCEBase;
     92    FGiveMultiTabMessage: boolean;
    9093    procedure CreateChildForms(Sender: TObject; Location: integer);
    9194    procedure SynchPCEData;
     
    124127  uCore,
    125128  fGAF, uConst,
    126   rCore, fPCEProvider, rMisc;
     129  rCore, fPCEProvider, rMisc, VA508AccessibilityRouter, VAUtils;
    127130
    128131{$R *.DFM}
     
    549552  FAbort := TRUE;
    550553  SetFormFonts;
     554  FGiveMultiTabMessage := ScreenReaderSystemActive;
    551555end;
    552556
     
    582586        if (Storemessage <> 'True') then
    583587        begin
    584           showmessage(storemessage);
     588          ShowMsg(storemessage);
    585589//        exit;
    586590        end;
     
    680684  if (sender as tTabControl).tabindex = -1 then exit;
    681685
     686  if TabControl.CanFocus and Assigned(FLastPage) and not TabControl.Focused then
     687    TabControl.SetFocus;  //CQ: 14845
     688
    682689  for i := CT_FIRST to CT_LAST do
    683690  begin
     
    688695        PageIDToForm(i).show;
    689696        SwitchToPage(PageIDToForm(i));
     697        Exit;
    690698      end;
    691699  end;
     
    736744end;
    737745
    738 procedure TfrmEncounterFrame.TabControlExit(Sender: TObject);
    739 var
    740   i: integer;
    741 begin
    742   //Keep the focus on the active page
    743   if (sender as tTabControl).tabindex = -1 then exit;
    744 
    745   for i := CT_FIRST to CT_LAST do
    746   begin
    747     with Formlist do
    748       with sender as tTabControl do
    749         if Tabindex = IndexOf(PageIdToTab(i)) then
    750       begin
    751         PageIDToForm(i).FocusFirstControl;
    752       end;
     746procedure TfrmEncounterFrame.TabControlEnter(Sender: TObject);
     747begin
     748  if FGiveMultiTabMessage then // CQ#15483
     749  begin
     750    FGiveMultiTabMessage := FALSE;
     751    GetScreenReader.Speak('Multi tab form');
    753752  end;
    754753end;
     
    759758  CanChange: boolean;
    760759begin
     760  inherited;
    761761  if (Key = VK_ESCAPE) then
    762762  begin
     
    788788    end;
    789789  end;
    790   if FLastPage = frmEncVitals then
    791     frmEncVitals.FormKeyDown(Sender, Key, Shift);
    792790end;
    793791
     
    836834end;
    837835
     836procedure TfrmEncounterFrame.FormShow(Sender: TObject);
     837begin
     838  inherited;
     839  if TabControl.CanFocus then
     840    TabControl.SetFocus;
     841end;
     842
    838843end.
  • cprs/trunk/CPRS-Chart/Encounter/fExam.dfm

    r456 r829  
    33  Top = 223
    44  Caption = 'Encounter Examinations'
     5  ExplicitLeft = 509
     6  ExplicitTop = 223
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    1517    Width = 65
    1618    Caption = 'Exam Section'
     19    ExplicitWidth = 65
    1720  end
    1821  inherited btnOK: TBitBtn
     
    4750    TabOrder = 3
    4851  end
     52  object cboExamResults: TORComboBox [9]
     53    Tag = 60
     54    Left = 490
     55    Top = 280
     56    Width = 121
     57    Height = 21
     58    Style = orcsDropDown
     59    AutoSelect = True
     60    Caption = 'Results'
     61    Color = clWindow
     62    DropDownCount = 8
     63    Enabled = False
     64    ItemHeight = 13
     65    ItemTipColor = clWindow
     66    ItemTipEnable = True
     67    ListItemsOnly = False
     68    LongList = False
     69    LookupPiece = 0
     70    MaxLength = 0
     71    Pieces = '2'
     72    Sorted = False
     73    SynonymChars = '<>'
     74    TabOrder = 4
     75    OnChange = cboExamResultsChange
     76    CharsNeedMatch = 1
     77  end
    4978  inherited btnRemove: TButton
    5079    TabOrder = 5
     
    71100    end
    72101  end
    73   object cboExamResults: TORComboBox
    74     Tag = 60
    75     Left = 490
    76     Top = 280
    77     Width = 121
    78     Height = 21
    79     Style = orcsDropDown
    80     AutoSelect = True
    81     Caption = 'Results'
    82     Color = clWindow
    83     DropDownCount = 8
    84     Enabled = False
    85     ItemHeight = 13
    86     ItemTipColor = clWindow
    87     ItemTipEnable = True
    88     ListItemsOnly = False
    89     LongList = False
    90     MaxLength = 0
    91     Pieces = '2'
    92     Sorted = False
    93     SynonymChars = '<>'
    94     TabOrder = 4
    95     OnChange = cboExamResultsChange
     102  inherited amgrMain: TVA508AccessibilityManager
     103    Data = (
     104      (
     105        'Component = cboExamResults'
     106        'Label = lblExamResults'
     107        'Status = stsOK')
     108      (
     109        'Component = edtComment'
     110        'Label = lblComment'
     111        'Status = stsOK')
     112      (
     113        'Component = btnRemove'
     114        'Status = stsDefault')
     115      (
     116        'Component = btnSelectAll'
     117        'Status = stsDefault')
     118      (
     119        'Component = pnlMain'
     120        'Status = stsDefault')
     121      (
     122        'Component = lbxSection'
     123        'Label = lblList'
     124        'Status = stsOK')
     125      (
     126        'Component = pnlLeft'
     127        'Status = stsDefault')
     128      (
     129        'Component = lbSection'
     130        'Label = lblSection'
     131        'Status = stsOK')
     132      (
     133        'Component = btnOther'
     134        'Status = stsDefault')
     135      (
     136        'Component = pnlGrid'
     137        'Status = stsDefault')
     138      (
     139        'Component = lbGrid'
     140        'Status = stsDefault')
     141      (
     142        'Component = hcGrid'
     143        'Status = stsDefault')
     144      (
     145        'Component = btnOK'
     146        'Status = stsDefault')
     147      (
     148        'Component = btnCancel'
     149        'Status = stsDefault')
     150      (
     151        'Component = frmExams'
     152        'Status = stsDefault'))
    96153  end
    97154end
  • cprs/trunk/CPRS-Chart/Encounter/fExam.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
     8  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
    99
    1010type
     
    2929
    3030uses
    31   fEncounterFrame;
     31  fEncounterFrame, VA508AccessibilityRouter;
    3232
    3333procedure TfrmExams.cboExamResultsChange(Sender: TObject);
     
    114114end;
    115115
     116initialization
     117  SpecifyFormIsNotADialog(TfrmExams);
     118
    116119end.
    117120
  • cprs/trunk/CPRS-Chart/Encounter/fGAF.dfm

    r456 r829  
    55  Caption = 'frmGAF'
    66  OnActivate = FormActivate
     7  ExplicitLeft = 8
     8  ExplicitTop = 8
    79  PixelsPerInch = 96
    810  TextHeight = 13
     
    3436    Height = 13
    3537    Align = alTop
     38    ExplicitWidth = 3
    3639  end
    3740  object Spacer2: TLabel [4]
     
    4144    Height = 13
    4245    Align = alTop
     46    ExplicitWidth = 3
    4347  end
    4448  object lblGAF: TStaticText [5]
     
    8892    Align = alTop
    8993    TabOrder = 0
     94    ExplicitLeft = 0
     95    ExplicitTop = 35
     96    ExplicitWidth = 624
    9097    inherited lbGrid: TORListBox
    9198      Width = 624
     
    94101      Caption = 'Most recent Global Assessment of Functioning (GAF) scores'
    95102      Pieces = '1,2,3,4'
     103      ExplicitWidth = 624
    96104    end
    97105    inherited hcGrid: THeaderControl
     
    122130          Width = 60
    123131        end>
     132      ExplicitWidth = 624
    124133    end
    125134  end
    126   object edtScore: TCaptionEdit
     135  object edtScore: TCaptionEdit [10]
    127136    Left = 226
    128137    Top = 171
     
    134143    Caption = 'Score'
    135144  end
    136   object udScore: TUpDown
     145  object udScore: TUpDown [11]
    137146    Left = 259
    138147    Top = 171
     
    140149    Height = 21
    141150    Associate = edtScore
    142     Min = 0
    143     Position = 0
    144151    TabOrder = 2
    145     Wrap = False
    146   end
    147   object dteGAF: TORDateBox
     152  end
     153  object dteGAF: TORDateBox [12]
    148154    Left = 226
    149155    Top = 202
     
    156162    Caption = 'Date Determined:'
    157163  end
    158   object cboGAFProvider: TORComboBox
     164  object cboGAFProvider: TORComboBox [13]
    159165    Left = 226
    160166    Top = 233
     
    179185    OnExit = cboGAFProviderExit
    180186    OnNeedData = cboGAFProviderNeedData
    181   end
    182   object btnURL: TButton
     187    CharsNeedMatch = 1
     188  end
     189  object btnURL: TButton [14]
    183190    Left = 3
    184191    Top = 376
     
    192199    OnClick = btnURLClick
    193200  end
     201  inherited amgrMain: TVA508AccessibilityManager
     202    Data = (
     203      (
     204        'Component = lblGAF'
     205        'Status = stsDefault')
     206      (
     207        'Component = lblEntry'
     208        'Status = stsDefault')
     209      (
     210        'Component = edtScore'
     211        'Status = stsDefault')
     212      (
     213        'Component = udScore'
     214        'Status = stsDefault')
     215      (
     216        'Component = dteGAF'
     217        'Status = stsDefault')
     218      (
     219        'Component = cboGAFProvider'
     220        'Status = stsDefault')
     221      (
     222        'Component = btnURL'
     223        'Status = stsDefault')
     224      (
     225        'Component = pnlGrid'
     226        'Status = stsDefault')
     227      (
     228        'Component = lbGrid'
     229        'Status = stsDefault')
     230      (
     231        'Component = hcGrid'
     232        'Status = stsDefault')
     233      (
     234        'Component = btnOK'
     235        'Status = stsDefault')
     236      (
     237        'Component = btnCancel'
     238        'Status = stsDefault')
     239      (
     240        'Component = frmGAF'
     241        'Status = stsDefault'))
     242  end
    194243end
  • cprs/trunk/CPRS-Chart/Encounter/fGAF.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls,
    8   ORDtTm, ComCtrls, fPCEBaseGrid, Menus;
     8  ORDtTm, ComCtrls, fPCEBaseGrid, Menus, VA508AccessibilityManager;
    99
    1010type
     
    4747implementation
    4848
    49 uses rPCE, rCore, uCore, uPCE, fEncounterFrame;
     49uses rPCE, rCore, uCore, uPCE, fEncounterFrame, VA508AccessibilityRouter;
    5050
    5151{$R *.DFM}
     
    202202  FTabName := CT_GAFNm;
    203203  btnURL.Visible := (User.WebAccess and (GAFURL <> ''));
    204 end;
     204  FormActivate(Sender);
     205end;
     206
     207initialization
     208  SpecifyFormIsNotADialog(TfrmGAF);
    205209
    206210end.
  • cprs/trunk/CPRS-Chart/Encounter/fHFSearch.dfm

    r456 r829  
    22  Left = 286
    33  Top = 248
    4   Width = 363
    5   Height = 417
    64  Caption = 'Other Health Factors'
     5  ClientHeight = 390
     6  ClientWidth = 355
    77  Position = poScreenCenter
    88  OnCreate = FormCreate
     9  ExplicitWidth = 363
     10  ExplicitHeight = 417
    911  PixelsPerInch = 96
    1012  TextHeight = 13
    11   object splMain: TSplitter
     13  object splMain: TSplitter [0]
    1214    Left = 0
    1315    Top = 131
     
    1719    Align = alTop
    1820  end
    19   object lblCat: TLabel
     21  object lblCat: TLabel [1]
    2022    Left = 0
    2123    Top = 0
     
    2426    Align = alTop
    2527    Caption = 'Category:'
     28    ExplicitWidth = 45
    2629  end
    27   object cbxSearch: TORComboBox
     30  object cbxSearch: TORComboBox [2]
    2831    Left = 0
    2932    Top = 13
     
    4144    ListItemsOnly = True
    4245    LongList = False
     46    LookupPiece = 0
    4347    MaxLength = 0
    4448    Pieces = '2'
     
    4953    OnChange = cbxSearchChange
    5054    OnDblClick = tvSearchDblClick
     55    CharsNeedMatch = 1
    5156  end
    52   object tvSearch: TORTreeView
     57  object tvSearch: TORTreeView [3]
    5358    Left = 0
    5459    Top = 134
     
    5762    Align = alClient
    5863    HideSelection = False
     64    Images = dmodShared.imgTemplates
    5965    Indent = 23
    6066    ReadOnly = True
    61     StateImages = dmodShared.imgTemplates
    6267    TabOrder = 1
    6368    OnChange = tvSearchChange
     
    6772    OnGetImageIndex = tvSearchGetImageIndex
    6873    OnGetSelectedIndex = tvSearchGetImageIndex
    69     Caption = 'Other Health Factors'
     74    Caption = 'Health Factors Category'
    7075    NodePiece = 2
     76    ExplicitTop = 137
    7177  end
    72   object pnlBottom: TPanel
     78  object pnlBottom: TPanel [4]
    7379    Left = 0
    7480    Top = 363
     
    7884    BevelOuter = bvNone
    7985    TabOrder = 2
     86    DesignSize = (
     87      355
     88      27)
    8089    object btnOK: TButton
    8190      Left = 196
     
    102111    end
    103112  end
     113  inherited amgrMain: TVA508AccessibilityManager
     114    Left = 176
     115    Data = (
     116      (
     117        'Component = cbxSearch'
     118        'Status = stsDefault')
     119      (
     120        'Component = tvSearch'
     121        'Status = stsDefault')
     122      (
     123        'Component = pnlBottom'
     124        'Status = stsDefault')
     125      (
     126        'Component = btnOK'
     127        'Status = stsDefault')
     128      (
     129        'Component = btnCancel'
     130        'Status = stsDefault')
     131      (
     132        'Component = frmHFSearch'
     133        'Status = stsDefault'))
     134  end
     135  object imgListHFtvSearch: TVA508ImageListLabeler
     136    Components = <
     137      item
     138        Component = tvSearch
     139      end>
     140    Labels = <>
     141    RemoteLabeler = dmodShared.imgLblHealthFactorLabels
     142    Left = 224
     143  end
    104144end
  • cprs/trunk/CPRS-Chart/Encounter/fHFSearch.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls;
     7  fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls,
     8  VA508AccessibilityManager, VA508ImageListLabeler;
    89
    910type
     
    1617    splMain: TSplitter;
    1718    lblCat: TLabel;
     19    imgListHFtvSearch: TVA508ImageListLabeler;
    1820    procedure FormCreate(Sender: TObject);
    1921    procedure btnOKClick(Sender: TObject);
     
    115117  HFList: TStringList;
    116118  i: integer;
    117   Node :TORTreeNode;
     119  Node, Child :TORTreeNode;
    118120  CAT: string;
    119121
     
    135137        begin
    136138          StringData := HFList[i];
    137           StateIndex := 2;
     139          ImageIndex := 2;
     140          SelectedIndex := 2;
    138141        end;
    139142      end;
     
    151154          Node := TORTreeNode(Node.GetNextSibling);
    152155        end;
    153         TORTreeNode(tvSearch.Items.AddChild(Node, '')).StringData := Pieces(HFList[i],U,1,2);
     156        Child := TORTreeNode(tvSearch.Items.AddChild(Node, ''));
     157        Child.StringData := Pieces(HFList[i],U,1,2);
     158        Child.ImageIndex := -1;
     159        Child.StateIndex := -1;
    154160      end;
    155161    end;
     
    181187  begin
    182188    if(Node.Expanded) then
    183       Node.StateIndex := 3
     189      Node.ImageIndex := 3
    184190    else
    185       Node.StateIndex := 2;
    186   end;
     191      Node.ImageIndex := 2;
     192  end
     193  else
     194    Node.ImageIndex := -1;
     195  Node.SelectedIndex := Node.ImageIndex;
    187196//  tvSearch.Invalidate;
    188197end;
  • cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.dfm

    r456 r829  
    33  Top = 205
    44  Caption = 'Health Factor page'
     5  ExplicitLeft = 374
     6  ExplicitTop = 205
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    1517    Width = 103
    1618    Caption = 'Health Factor Section'
     19    ExplicitWidth = 103
    1720  end
    1821  inherited btnOK: TBitBtn
     
    4952    TabOrder = 3
    5053  end
    51   inherited btnRemove: TButton
    52     TabOrder = 5
    53   end
    54   inherited btnSelectAll: TButton
    55     TabOrder = 2
    56     TabStop = True
    57   end
    58   inherited pnlMain: TPanel
    59     TabOrder = 0
    60     inherited lbxSection: TORListBox
    61       Tag = 70
    62     end
    63     inherited pnlLeft: TPanel
    64       inherited lbSection: TORListBox
    65         Tag = 70
    66         TabOrder = 0
    67         Caption = 'Health Factor Section'
    68       end
    69       inherited btnOther: TButton
    70         Tag = 23
    71         Caption = 'Other Health Factor...'
    72         TabOrder = 1
    73       end
    74     end
    75   end
    76   object cboHealthLevel: TORComboBox
     54  object cboHealthLevel: TORComboBox [9]
    7755    Tag = 50
    7856    Left = 490
     
    10078    CharsNeedMatch = 1
    10179  end
     80  inherited btnRemove: TButton
     81    TabOrder = 5
     82  end
     83  inherited btnSelectAll: TButton
     84    TabOrder = 2
     85    TabStop = True
     86  end
     87  inherited pnlMain: TPanel
     88    TabOrder = 0
     89    inherited lbxSection: TORListBox
     90      Tag = 70
     91      ExplicitLeft = 210
     92    end
     93    inherited pnlLeft: TPanel
     94      inherited lbSection: TORListBox
     95        Tag = 70
     96        TabOrder = 0
     97        Caption = 'Health Factor Section'
     98      end
     99      inherited btnOther: TButton
     100        Tag = 23
     101        Caption = 'Other Health Factor...'
     102        TabOrder = 1
     103      end
     104    end
     105  end
     106  inherited amgrMain: TVA508AccessibilityManager
     107    Data = (
     108      (
     109        'Component = cboHealthLevel'
     110        'Label = lblHealthLevel'
     111        'Status = stsOK')
     112      (
     113        'Component = edtComment'
     114        'Label = lblComment'
     115        'Status = stsOK')
     116      (
     117        'Component = btnRemove'
     118        'Status = stsDefault')
     119      (
     120        'Component = btnSelectAll'
     121        'Status = stsDefault')
     122      (
     123        'Component = pnlMain'
     124        'Status = stsDefault')
     125      (
     126        'Component = lbxSection'
     127        'Label = lblList'
     128        'Status = stsOK')
     129      (
     130        'Component = pnlLeft'
     131        'Status = stsDefault')
     132      (
     133        'Component = lbSection'
     134        'Label = lblSection'
     135        'Status = stsOK')
     136      (
     137        'Component = btnOther'
     138        'Status = stsDefault')
     139      (
     140        'Component = pnlGrid'
     141        'Status = stsDefault')
     142      (
     143        'Component = lbGrid'
     144        'Status = stsDefault')
     145      (
     146        'Component = hcGrid'
     147        'Status = stsDefault')
     148      (
     149        'Component = btnOK'
     150        'Status = stsDefault')
     151      (
     152        'Component = btnCancel'
     153        'Status = stsDefault')
     154      (
     155        'Component = frmHealthFactors'
     156        'Status = stsDefault'))
     157  end
    102158end
  • cprs/trunk/CPRS-Chart/Encounter/fHealthFactor.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
     8  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
    99
    1010type
     
    3030
    3131uses
    32   fEncounterFrame;
     32  fEncounterFrame, VA508AccessibilityRouter;
    3333
    3434procedure tfrmHealthFactors.cboHealthLevelChange(Sender: TObject);
     
    115115end;
    116116
     117initialization
     118  SpecifyFormIsNotADialog(TfrmHealthFactors);
     119
    117120end.
  • cprs/trunk/CPRS-Chart/Encounter/fImmunization.dfm

    r456 r829  
    33  Top = 169
    44  Caption = 'Encouner Immunization'
     5  ExplicitLeft = 373
     6  ExplicitTop = 169
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    2224    Width = 100
    2325    Caption = 'Immunization Section'
     26    ExplicitWidth = 100
    2427  end
    2528  object lblContra: TLabel [6]
     
    7578    TabOrder = 3
    7679  end
    77   inherited btnRemove: TButton
    78     TabOrder = 7
    79   end
    80   inherited btnSelectAll: TButton
    81     TabOrder = 2
    82     TabStop = True
    83   end
    84   inherited pnlMain: TPanel
    85     TabOrder = 0
    86     inherited lbxSection: TORListBox
    87       Tag = 40
    88     end
    89     inherited pnlLeft: TPanel
    90       inherited lbSection: TORListBox
    91         Tag = 40
    92         TabOrder = 0
    93         Caption = 'Immunization Section'
    94       end
    95       inherited btnOther: TButton
    96         Tag = 20
    97         Caption = 'Other Immunization...'
    98         TabOrder = 1
    99       end
    100     end
    101   end
    102   object cboImmReaction: TORComboBox
     80  object cboImmReaction: TORComboBox [11]
    10381    Tag = 20
    10482    Left = 490
     
    11795    ListItemsOnly = False
    11896    LongList = False
     97    LookupPiece = 0
    11998    MaxLength = 0
    12099    Pieces = '2'
     
    123102    TabOrder = 5
    124103    OnChange = cboImmReactionChange
    125   end
    126   object cboImmSeries: TORComboBox
     104    CharsNeedMatch = 1
     105  end
     106  object cboImmSeries: TORComboBox [12]
    127107    Tag = 10
    128108    Left = 490
     
    141121    ListItemsOnly = False
    142122    LongList = False
     123    LookupPiece = 0
    143124    MaxLength = 0
    144125    Pieces = '2'
     
    147128    TabOrder = 4
    148129    OnChange = cboImmSeriesChange
    149   end
    150   object ckbContra: TCheckBox
     130    CharsNeedMatch = 1
     131  end
     132  object ckbContra: TCheckBox [13]
    151133    Left = 490
    152134    Top = 319
     
    157139    OnClick = ckbContraClick
    158140  end
     141  inherited btnRemove: TButton
     142    TabOrder = 7
     143  end
     144  inherited btnSelectAll: TButton
     145    TabOrder = 2
     146    TabStop = True
     147  end
     148  inherited pnlMain: TPanel
     149    TabOrder = 0
     150    inherited lbxSection: TORListBox
     151      Tag = 40
     152    end
     153    inherited pnlLeft: TPanel
     154      inherited lbSection: TORListBox
     155        Tag = 40
     156        TabOrder = 0
     157        Caption = 'Immunization Section'
     158      end
     159      inherited btnOther: TButton
     160        Tag = 20
     161        Caption = 'Other Immunization...'
     162        TabOrder = 1
     163      end
     164    end
     165  end
     166  inherited amgrMain: TVA508AccessibilityManager
     167    Data = (
     168      (
     169        'Component = cboImmReaction'
     170        'Label = lblReaction'
     171        'Status = stsOK')
     172      (
     173        'Component = cboImmSeries'
     174        'Label = lblSeries'
     175        'Status = stsOK')
     176      (
     177        'Component = ckbContra'
     178        'Status = stsDefault')
     179      (
     180        'Component = edtComment'
     181        'Label = lblComment'
     182        'Status = stsOK')
     183      (
     184        'Component = btnRemove'
     185        'Status = stsDefault')
     186      (
     187        'Component = btnSelectAll'
     188        'Status = stsDefault')
     189      (
     190        'Component = pnlMain'
     191        'Status = stsDefault')
     192      (
     193        'Component = lbxSection'
     194        'Label = lblList'
     195        'Status = stsOK')
     196      (
     197        'Component = pnlLeft'
     198        'Status = stsDefault')
     199      (
     200        'Component = lbSection'
     201        'Label = lblSection'
     202        'Status = stsOK')
     203      (
     204        'Component = btnOther'
     205        'Status = stsDefault')
     206      (
     207        'Component = pnlGrid'
     208        'Status = stsDefault')
     209      (
     210        'Component = lbGrid'
     211        'Status = stsDefault')
     212      (
     213        'Component = hcGrid'
     214        'Status = stsDefault')
     215      (
     216        'Component = btnOK'
     217        'Status = stsDefault')
     218      (
     219        'Component = btnCancel'
     220        'Status = stsDefault')
     221      (
     222        'Component = frmImmunizations'
     223        'Status = stsDefault'))
     224  end
    159225end
  • cprs/trunk/CPRS-Chart/Encounter/fImmunization.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
     8  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
    99
    1010type
     
    3737
    3838uses
    39   fEncounterFrame;
     39  fEncounterFrame, VA508AccessibilityRouter;
    4040
    4141procedure TfrmImmunizations.cboImmSeriesChange(Sender: TObject);
     
    178178end;
    179179
     180initialization
     181  SpecifyFormIsNotADialog(TfrmImmunizations);
     182
    180183end.
    181  
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBase.dfm

    r456 r829  
    1 object frmPCEBase: TfrmPCEBase
     1inherited frmPCEBase: TfrmPCEBase
    22  Left = 194
    33  Top = 170
    4   AutoScroll = False
    54  Caption = 'Basic Page'
    65  ClientHeight = 400
    76  ClientWidth = 624
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = True
    157  OnClose = FormClose
    168  OnCreate = FormCreate
    17   OnShow = FormShow
     9  ExplicitWidth = 320
     10  ExplicitHeight = 240
    1811  DesignSize = (
    1912    624
     
    2114  PixelsPerInch = 96
    2215  TextHeight = 13
    23   object btnOK: TBitBtn
     16  object btnOK: TBitBtn [0]
    2417    Left = 467
    2518    Top = 376
     
    2720    Height = 21
    2821    Anchors = [akRight, akBottom]
    29     Caption = 'OK'
     22    Caption = '&OK'
    3023    ModalResult = 1
    3124    TabOrder = 0
     
    3326    NumGlyphs = 2
    3427  end
    35   object btnCancel: TBitBtn
     28  object btnCancel: TBitBtn [1]
    3629    Left = 547
    3730    Top = 376
     
    3932    Height = 21
    4033    Anchors = [akRight, akBottom]
    41     Caption = 'Cancel'
     34    Caption = '&Cancel'
    4235    ModalResult = 2
    4336    TabOrder = 1
     
    4538    NumGlyphs = 2
    4639  end
     40  inherited amgrMain: TVA508AccessibilityManager
     41    Data = (
     42      (
     43        'Component = btnOK'
     44        'Status = stsDefault')
     45      (
     46        'Component = btnCancel'
     47        'Status = stsDefault')
     48      (
     49        'Component = frmPCEBase'
     50        'Status = stsDefault'))
     51  end
    4752end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBase.pas

    r456 r829  
    1717  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
    1818  StdCtrls, fAutoSz, Buttons, ORCtrls, ORFn, uPCE, ORDtTm, Checklst,
    19   ComCtrls;
     19  ComCtrls, VA508AccessibilityManager, fBase508Form;
    2020
    2121type
     
    2727    procedure btnOKClick(Sender: TObject); virtual;
    2828    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    29     procedure FormShow(Sender: TObject);
    3029  private
    3130    FDisplayCount: Integer;                      // number of times page displayed
     
    7170
    7271uses
    73   fEncounterFrame;
     72  fEncounterFrame, VA508AccessibilityRouter;
    7473
    7574
     
    368367end;
    369368
    370 procedure TfrmPCEBase.FormShow(Sender: TObject);
    371 begin
    372   inherited;
    373   FocusFirstControl;
    374 end;
     369initialization
     370  SpecifyFormIsNotADialog(TfrmPCEBase);
     371
    375372
    376373end.
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.dfm

    r456 r829  
    11inherited frmPCEBaseGrid: TfrmPCEBaseGrid
    2   Left = 200
    3   Top = 303
     2  Left = 128
     3  Top = 192
    44  Caption = 'frmPCEBaseGrid'
     5  ExplicitLeft = 128
     6  ExplicitTop = 192
    57  PixelsPerInch = 96
    68  TextHeight = 13
    7   object pnlGrid: TPanel
     9  object pnlGrid: TPanel [2]
    810    Left = 6
    911    Top = 238
     
    1113    Height = 87
    1214    BevelOuter = bvNone
    13     Caption = 'pnlGrid'
    1415    TabOrder = 2
    1516    OnResize = pnlGridResize
     
    3435      Width = 451
    3536      Height = 17
    36       DragReorder = False
    3737      Sections = <
    3838        item
     
    4747    end
    4848  end
     49  inherited amgrMain: TVA508AccessibilityManager
     50    Data = (
     51      (
     52        'Component = pnlGrid'
     53        'Status = stsDefault')
     54      (
     55        'Component = lbGrid'
     56        'Status = stsDefault')
     57      (
     58        'Component = hcGrid'
     59        'Status = stsDefault')
     60      (
     61        'Component = btnOK'
     62        'Status = stsDefault')
     63      (
     64        'Component = btnCancel'
     65        'Status = stsDefault')
     66      (
     67        'Component = frmPCEBaseGrid'
     68        'Status = stsDefault'))
     69  end
    4970end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseGrid.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn;
     7  fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn,
     8  VA508AccessibilityManager;
    89
    910type
     
    3839implementation
    3940
     41uses
     42  VA2006Utils, VA508AccessibilityRouter;
     43
    4044{$R *.DFM}
    4145
     
    4650begin
    4751  inherited;
    48   lbGrid.Color := ReadOnlyColor;
    49   lbGrid.ItemTipColor := ReadOnlyColor;
     52  FixHeaderControlDelphi2006Bug(hcGrid);
    5053  FSectionGap := 15;
    5154  SyncGridHeader(TRUE);
     
    223226end;
    224227
     228initialization
     229  SpecifyFormIsNotADialog(TfrmPCEBaseGrid);
     230
    225231end.
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.dfm

    r456 r829  
    33  Top = 166
    44  Caption = 'frmPCEBaseMain'
    5   OnDestroy = FormDestroy
    6   OnResize = FormResize
     5  ExplicitWidth = 320
     6  ExplicitHeight = 240
    77  PixelsPerInch = 96
    88  TextHeight = 13
     
    3737    Left = 464
    3838    TabOrder = 1
     39    ExplicitLeft = 464
    3940  end
    4041  inherited btnCancel: TBitBtn
    4142    Left = 544
    4243    TabOrder = 2
     44    ExplicitLeft = 544
    4345  end
    4446  inherited pnlGrid: TPanel
    4547    Width = 475
    4648    TabOrder = 0
     49    ExplicitWidth = 475
    4750    inherited lbGrid: TORListBox
    4851      Width = 475
    4952      MultiSelect = True
    5053      OnClick = lbGridSelect
     54      OnExit = lbGridExit
    5155      OnChange = lbGridSelect
    5256      CheckEntireLine = True
     57      ExplicitWidth = 475
    5358    end
    5459    inherited hcGrid: THeaderControl
    5560      Width = 475
    56     end
    57   end
    58   object edtComment: TCaptionEdit
     61      ExplicitWidth = 475
     62    end
     63  end
     64  object edtComment: TCaptionEdit [7]
    5965    Left = 6
    6066    Top = 343
     
    6773    Caption = 'Comments'
    6874  end
    69   object btnRemove: TButton
     75  object btnRemove: TButton [8]
    7076    Left = 536
    7177    Top = 343
     
    7682    OnClick = btnRemoveClick
    7783  end
    78   object btnSelectAll: TButton
     84  object btnSelectAll: TButton [9]
    7985    Left = 406
    8086    Top = 326
     
    8692    OnClick = btnSelectAllClick
    8793  end
    88   object pnlMain: TPanel
     94  object pnlMain: TPanel [10]
    8995    Left = 6
    9096    Top = 20
     
    97103      Left = 204
    98104      Top = 0
    99       Width = 3
    100105      Height = 204
    101       Cursor = crHSplit
    102106      OnMoved = splLeftMoved
    103107    end
     
    115119      TabOrder = 1
    116120      OnClick = clbListClick
     121      OnExit = lbxSectionExit
    117122      OnMouseDown = clbListMouseDown
    118123      Caption = 'Section Name'
     
    147152        TabOrder = 1
    148153        OnClick = lbSectionClick
     154        OnExit = lbSectionExit
    149155        Caption = 'Section'
    150156        ItemTipColor = clWindow
     
    152158        Pieces = '3'
    153159        CheckEntireLine = True
     160        ExplicitLeft = -3
     161        ExplicitTop = -2
    154162      end
    155163      object btnOther: TButton
     
    162170        TabOrder = 0
    163171        OnClick = btnOtherClick
     172        OnExit = btnOtherExit
    164173      end
    165174    end
    166175  end
     176  inherited amgrMain: TVA508AccessibilityManager
     177    Left = 24
     178    Top = 24
     179    Data = (
     180      (
     181        'Component = edtComment'
     182        'Label = lblComment'
     183        'Status = stsOK')
     184      (
     185        'Component = btnRemove'
     186        'Status = stsDefault')
     187      (
     188        'Component = btnSelectAll'
     189        'Status = stsDefault')
     190      (
     191        'Component = pnlMain'
     192        'Status = stsDefault')
     193      (
     194        'Component = lbxSection'
     195        'Label = lblList'
     196        'Status = stsOK')
     197      (
     198        'Component = pnlLeft'
     199        'Status = stsDefault')
     200      (
     201        'Component = lbSection'
     202        'Label = lblSection'
     203        'Status = stsOK')
     204      (
     205        'Component = btnOther'
     206        'Status = stsDefault')
     207      (
     208        'Component = pnlGrid'
     209        'Status = stsDefault')
     210      (
     211        'Component = lbGrid'
     212        'Status = stsDefault')
     213      (
     214        'Component = hcGrid'
     215        'Status = stsDefault')
     216      (
     217        'Component = btnOK'
     218        'Status = stsDefault')
     219      (
     220        'Component = btnCancel'
     221        'Status = stsDefault')
     222      (
     223        'Component = frmPCEBaseMain'
     224        'Status = stsDefault'))
     225  end
    167226end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEBaseMain.pas

    r456 r829  
    11unit fPCEBaseMain;
     2{Warning: The tab order has been changed in the OnExit event of several controls.
     3 To change the tab order of lbSection, lbxSection, and btnOther you must do it programatically.}
    24
    35interface
     
    68  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    79  fPCEBaseGrid, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, rPCE, uPCE,
    8   CheckLst, ORFn;
     10  CheckLst, ORFn, VA508AccessibilityManager;
    911
    1012type
     
    4143    procedure splLeftMoved(Sender: TObject);
    4244    procedure edtCommentKeyPress(Sender: TObject; var Key: Char);
     45    procedure lbSectionExit(Sender: TObject);
     46    procedure btnOtherExit(Sender: TObject);
     47    procedure lbxSectionExit(Sender: TObject);
     48    procedure lbGridExit(Sender: TObject);
     49    procedure FormCreate(Sender: TObject);
    4350  private
    4451    FCommentItem: integer;
    4552    FCommentChanged: boolean;
    4653    FUpdateCount: integer;
     54    FSectionPopulated: boolean;
    4755    //FUpdatingGrid: boolean;  moved to 'protected' so frmDiagnoses can see it  (RV)
    4856  protected
     
    7785implementation
    7886
    79 uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch;
     87uses fPCELex, fPCEOther, fEncounterFrame, fHFSearch, VA508AccessibilityRouter,
     88  ORCtrlsVA508Compatibility, fBase508Form;
    8089
    8190{$R *.DFM}
     91
     92type
     93  TLBSectionManager = class(TORListBox508Manager)
     94  public
     95    function GetItemInstructions(Component: TWinControl): string; override;
     96    function GetState(Component: TWinControl): string; override;   
     97  end;
    8298
    8399procedure TfrmPCEBaseMain.lbSectionClick(Sender: TObject);
     
    87103  FPCEListCodesProc(lbxSection.Items, lbSection.ItemIEN);
    88104  CheckOffEntries;
     105  FSectionPopulated := TRUE;
     106end;
     107
     108procedure TfrmPCEBaseMain.lbSectionExit(Sender: TObject);
     109begin
     110  inherited;
     111  if TabIsPressed then
     112    if lbxSection.CanFocus then
     113      lbxSection.SetFocus;
    89114end;
    90115
     
    102127  try
    103128    SaveGridSelected;
    104     tmpList.Assign(lbGrid.Items);
     129    FastAssign(lbGrid.Items, tmpList);
    105130    for i := 0 to lbGrid.Items.Count-1 do
    106131    begin
     
    109134      tmpList.Objects[i] := lbGrid.Items.Objects[i];
    110135    end;
    111     lbGrid.Items.Assign(tmpList);
     136  //FastAssign(tmpList,lbGrid.Items); //cq: 13228  Causin a/v errors.
     137    lbGrid.Items.Assign(tmpList);    //cq: 13228
    112138    RestoreGridSelected;
    113139    SyncGridData;
     
    155181end;
    156182
     183procedure TfrmPCEBaseMain.btnOtherExit(Sender: TObject);
     184begin
     185  inherited;
     186  if TabIsPressed then begin
     187    if lbGrid.CanFocus then
     188      lbGrid.SetFocus
     189  end
     190  else if ShiftTabIsPressed then
     191    if lbxSection.CanFocus then
     192      lbxSection.SetFocus;
     193end;
     194
    157195procedure TfrmPCEBaseMain.edtCommentExit(Sender: TObject);
    158196begin
     
    240278end;
    241279
     280procedure TfrmPCEBaseMain.lbGridExit(Sender: TObject);
     281begin
     282  inherited;
     283  if ShiftTabIsPressed then
     284    if btnOther.CanFocus then
     285      btnOther.SetFocus;
     286end;
     287
    242288procedure TfrmPCEBaseMain.lbGridSelect(Sender: TObject);
    243289begin
     
    245291//  clbList.ItemIndex := -1;
    246292  UpdateControls;
     293end;
     294
     295procedure TfrmPCEBaseMain.FormCreate(Sender: TObject);
     296begin
     297  inherited FormCreate(Sender);
     298  lbxSection.HideSelection := TRUE;
     299  amgrMain.ComponentManager[lbSection] := TLBSectionManager.Create;
    247300end;
    248301
     
    413466end;
    414467
     468procedure TfrmPCEBaseMain.lbxSectionExit(Sender: TObject);
     469begin
     470  inherited;
     471  if TabIsPressed then begin
     472    if btnOther.CanFocus then
     473      btnOther.SetFocus
     474  end
     475  else if ShiftTabIsPressed then
     476    if lbSection.CanFocus then
     477      lbSection.SetFocus;
     478end;
     479
    415480procedure TfrmPCEBaseMain.UpdateTabPos;
    416481begin
     
    503568end;
    504569
     570{ TLBSectionManager }
     571
     572function TLBSectionManager.GetItemInstructions(Component: TWinControl): string;
     573var
     574  lb : TORListBox;
     575  idx: integer;
     576begin
     577  lb := TORListBox(Component);
     578  idx := lb.ItemIndex;
     579  if (idx >= 0) and lb.Selected[idx] then
     580    Result := 'Press space bar to populate ' +
     581        TfrmPCEBaseMain(Component.Owner).FTabName + ' section'
     582  else
     583    result := inherited GetItemInstructions(Component);
     584end;
     585
     586function TLBSectionManager.GetState(Component: TWinControl): string;
     587var
     588  frm: TfrmPCEBaseMain;
     589begin
     590  Result := '';
     591  frm := TfrmPCEBaseMain(Component.Owner);
     592  if frm.FSectionPopulated then
     593  begin
     594    frm.FSectionPopulated := FALSE;
     595    Result := frm.FTabName + ' section populated with ' +
     596        inttostr(frm.lbxSection.Count) + ' items';
     597  end;
     598end;
     599
     600initialization
     601  SpecifyFormIsNotADialog(TfrmPCEBaseMain);
     602
    505603end.
  • cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.dfm

    r456 r829  
    1 object frmPCEEdit: TfrmPCEEdit
     1inherited frmPCEEdit: TfrmPCEEdit
    22  Left = 214
    33  Top = 107
     
    66  ClientHeight = 128
    77  ClientWidth = 543
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = False
    158  Position = poScreenCenter
    169  OnCreate = FormCreate
     
    2013  PixelsPerInch = 96
    2114  TextHeight = 13
    22   object Label1: TStaticText
     15  object Label1: TStaticText [0]
    2316    Left = 0
    2417    Top = 0
     
    3528    ParentFont = False
    3629    TabOrder = 5
     30    ExplicitWidth = 201
    3731  end
    38   object lblNew: TMemo
     32  object lblNew: TMemo [1]
    3933    Left = 136
    4034    Top = 32
     
    4842    TabOrder = 3
    4943  end
    50   object lblNote: TMemo
     44  object lblNote: TMemo [2]
    5145    Left = 136
    5246    Top = 73
     
    6054    TabOrder = 4
    6155  end
    62   object btnNew: TButton
     56  object btnNew: TButton [3]
    6357    Left = 8
    6458    Top = 28
     
    6963    TabOrder = 0
    7064  end
    71   object btnNote: TButton
     65  object btnNote: TButton [4]
    7266    Left = 8
    7367    Top = 69
     
    7872    TabOrder = 1
    7973  end
    80   object btnCancel: TButton
     74  object btnCancel: TButton [5]
    8175    Left = 465
    8276    Top = 104
     
    8983    TabOrder = 2
    9084  end
     85  inherited amgrMain: TVA508AccessibilityManager
     86    Data = (
     87      (
     88        'Component = Label1'
     89        'Status = stsDefault')
     90      (
     91        'Component = lblNew'
     92        'Status = stsDefault')
     93      (
     94        'Component = lblNote'
     95        'Status = stsDefault')
     96      (
     97        'Component = btnNew'
     98        'Status = stsDefault')
     99      (
     100        'Component = btnNote'
     101        'Status = stsDefault')
     102      (
     103        'Component = btnCancel'
     104        'Status = stsDefault')
     105      (
     106        'Component = frmPCEEdit'
     107        'Status = stsDefault'))
     108  end
    91109end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEEdit.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORFn, uPCE;
     7  StdCtrls, ORFn, uPCE, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmPCEEdit = class(TForm)
     10  TfrmPCEEdit = class(TfrmBase508Form)
    1111    btnNew: TButton;
    1212    btnNote: TButton;
  • cprs/trunk/CPRS-Chart/Encounter/fPCELex.dfm

    r456 r829  
    55  BorderStyle = bsDialog
    66  Caption = 'Lookup Other Diagnosis'
     7  ClientHeight = 275
     8  ClientWidth = 429
    79  Position = poScreenCenter
    810  OnCreate = FormCreate
     11  ExplicitWidth = 320
     12  ExplicitHeight = 240
    913  PixelsPerInch = 96
    1014  TextHeight = 13
    11   object lblSearch: TLabel
     15  object lblSearch: TLabel [0]
    1216    Left = 6
    1317    Top = 16
     
    1620    Caption = 'Search for Diagnosis'
    1721  end
    18   object lblSelect: TLabel
     22  object lblSelect: TLabel [1]
    1923    Left = 6
    2024    Top = 67
     
    2428    Visible = False
    2529  end
    26   object txtSearch: TCaptionEdit
     30  object txtSearch: TCaptionEdit [2]
    2731    Left = 6
    2832    Top = 30
     
    3337    Caption = 'Search for Diagnosis'
    3438  end
    35   object cmdSearch: TButton
     39  object cmdSearch: TButton [3]
    3640    Left = 346
    3741    Top = 30
     
    4347    OnClick = cmdSearchClick
    4448  end
    45   object cmdOK: TButton
     49  object cmdOK: TButton [4]
    4650    Left = 263
    4751    Top = 245
     
    5256    OnClick = cmdOKClick
    5357  end
    54   object cmdCancel: TButton
     58  object cmdCancel: TButton [5]
    5559    Left = 346
    5660    Top = 245
     
    6266    OnClick = cmdCancelClick
    6367  end
    64   object lstSelect: TORListBox
     68  object lstSelect: TORListBox [6]
    6569    Left = 6
    6670    Top = 81
     
    7882    Pieces = '2'
    7983  end
     84  inherited amgrMain: TVA508AccessibilityManager
     85    Data = (
     86      (
     87        'Component = txtSearch'
     88        'Status = stsDefault')
     89      (
     90        'Component = cmdSearch'
     91        'Status = stsDefault')
     92      (
     93        'Component = cmdOK'
     94        'Status = stsDefault')
     95      (
     96        'Component = cmdCancel'
     97        'Status = stsDefault')
     98      (
     99        'Component = lstSelect'
     100        'Status = stsDefault')
     101      (
     102        'Component = frmPCELex'
     103        'Status = stsDefault'))
     104  end
    80105end
  • cprs/trunk/CPRS-Chart/Encounter/fPCELex.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Encounter/fPCEOther.dfm

    r456 r829  
    1 object frmPCEOther: TfrmPCEOther
     1inherited frmPCEOther: TfrmPCEOther
    22  Left = 451
    33  Top = 201
    4   Width = 279
    5   Height = 340
    64  ActiveControl = cboOther
    75  Caption = 'OtherItems'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = True
     6  ClientHeight = 313
     7  ClientWidth = 271
    158  Position = poScreenCenter
    169  OnCreate = FormCreate
     10  ExplicitWidth = 279
     11  ExplicitHeight = 340
    1712  PixelsPerInch = 96
    1813  TextHeight = 13
    19   object cmdCancel: TButton
     14  object cmdCancel: TButton [0]
    2015    Left = 190
    2116    Top = 287
     
    2722    OnClick = cmdCancelClick
    2823  end
    29   object cmdOK: TButton
     24  object cmdOK: TButton [1]
    3025    Left = 110
    3126    Top = 287
     
    3732    OnClick = cmdOKClick
    3833  end
    39   object cboOther: TORComboBox
     34  object cboOther: TORComboBox [2]
    4035    Left = 8
    4136    Top = 8
     
    5247    ListItemsOnly = False
    5348    LongList = False
     49    LookupPiece = 0
    5450    MaxLength = 0
    5551    Pieces = '2'
     
    5955    OnChange = cboOtherChange
    6056    OnDblClick = cboOtherDblClick
     57    CharsNeedMatch = 1
     58  end
     59  inherited amgrMain: TVA508AccessibilityManager
     60    Data = (
     61      (
     62        'Component = cmdCancel'
     63        'Status = stsDefault')
     64      (
     65        'Component = cmdOK'
     66        'Status = stsDefault')
     67      (
     68        'Component = cboOther'
     69        'Status = stsDefault')
     70      (
     71        'Component = frmPCEOther'
     72        'Status = stsDefault'))
    6173  end
    6274end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEOther.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, ORFn, ORCtrls, StdCtrls;
     7  fAutoSz, ORFn, ORCtrls, StdCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.dfm

    r456 r829  
    1 object frmPCEProvider: TfrmPCEProvider
     1inherited frmPCEProvider: TfrmPCEProvider
    22  Left = 192
    33  Top = 104
     
    77  ClientHeight = 254
    88  ClientWidth = 317
    9   Color = clBtnFace
    10   Font.Charset = DEFAULT_CHARSET
    11   Font.Color = clWindowText
    12   Font.Height = -11
    13   Font.Name = 'MS Sans Serif'
    14   Font.Style = []
    15   OldCreateOrder = False
    169  Position = poScreenCenter
    1710  OnCreate = FormCreate
    1811  PixelsPerInch = 96
    1912  TextHeight = 13
    20   object Spacer1: TLabel
     13  object Spacer1: TLabel [0]
    2114    Left = 0
    2215    Top = 0
     
    2417    Height = 13
    2518    Align = alTop
     19    ExplicitWidth = 3
    2620  end
    27   object lblMsg: TMemo
     21  object lblMsg: TMemo [1]
    2822    Left = 0
    2923    Top = 13
     
    4640    TabOrder = 4
    4741  end
    48   object cboPrimary: TORComboBox
     42  object cboPrimary: TORComboBox [2]
    4943    Left = 6
    5044    Top = 69
     
    7367    CharsNeedMatch = 1
    7468  end
    75   object btnYes: TButton
     69  object btnYes: TButton [3]
    7670    Left = 158
    7771    Top = 40
     
    8377    TabOrder = 1
    8478  end
    85   object btnNo: TButton
     79  object btnNo: TButton [4]
    8680    Left = 238
    8781    Top = 40
     
    9387    TabOrder = 2
    9488  end
    95   object btnSelect: TButton
     89  object btnSelect: TButton [5]
    9690    Left = 6
    9791    Top = 40
     
    10296    OnClick = btnSelectClick
    10397  end
     98  inherited amgrMain: TVA508AccessibilityManager
     99    Data = (
     100      (
     101        'Component = lblMsg'
     102        'Status = stsDefault')
     103      (
     104        'Component = cboPrimary'
     105        'Status = stsDefault')
     106      (
     107        'Component = btnYes'
     108        'Status = stsDefault')
     109      (
     110        'Component = btnNo'
     111        'Status = stsDefault')
     112      (
     113        'Component = btnSelect'
     114        'Status = stsDefault')
     115      (
     116        'Component = frmPCEProvider'
     117        'Status = stsDefault'))
     118  end
    104119end
  • cprs/trunk/CPRS-Chart/Encounter/fPCEProvider.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn;
     7  StdCtrls, ORCtrls, ExtCtrls, uPCE, ORFn, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmPCEProvider = class(TForm)
     11  TfrmPCEProvider = class(TfrmBase508Form)
    1112    cboPrimary: TORComboBox;
    1213    lblMsg: TMemo;
  • cprs/trunk/CPRS-Chart/Encounter/fPatientEd.dfm

    r456 r829  
    33  Top = 267
    44  Caption = 'Patient Education'
     5  ExplicitLeft = 275
     6  ExplicitTop = 267
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    1517    Width = 123
    1618    Caption = 'Patient Education Section'
     19    ExplicitWidth = 123
    1720  end
    1821  inherited btnOK: TBitBtn
     
    4851    TabOrder = 3
    4952  end
     53  object cboPatUnderstanding: TORComboBox [9]
     54    Tag = 40
     55    Left = 490
     56    Top = 280
     57    Width = 121
     58    Height = 21
     59    Style = orcsDropDown
     60    AutoSelect = True
     61    Caption = 'Level Of Understanding'
     62    Color = clWindow
     63    DropDownCount = 8
     64    Enabled = False
     65    ItemHeight = 13
     66    ItemTipColor = clWindow
     67    ItemTipEnable = True
     68    ListItemsOnly = False
     69    LongList = False
     70    LookupPiece = 0
     71    MaxLength = 0
     72    Pieces = '2'
     73    Sorted = False
     74    SynonymChars = '<>'
     75    TabOrder = 4
     76    OnChange = cboPatUnderstandingChange
     77    CharsNeedMatch = 1
     78  end
    5079  inherited btnRemove: TButton
    5180    TabOrder = 5
     
    73102    end
    74103  end
    75   object cboPatUnderstanding: TORComboBox
    76     Tag = 40
    77     Left = 490
    78     Top = 280
    79     Width = 121
    80     Height = 21
    81     Style = orcsDropDown
    82     AutoSelect = True
    83     Caption = 'Level Of Understanding'
    84     Color = clWindow
    85     DropDownCount = 8
    86     Enabled = False
    87     ItemHeight = 13
    88     ItemTipColor = clWindow
    89     ItemTipEnable = True
    90     ListItemsOnly = False
    91     LongList = False
    92     MaxLength = 0
    93     Pieces = '2'
    94     Sorted = False
    95     SynonymChars = '<>'
    96     TabOrder = 4
    97     OnChange = cboPatUnderstandingChange
     104  inherited amgrMain: TVA508AccessibilityManager
     105    Data = (
     106      (
     107        'Component = cboPatUnderstanding'
     108        'Status = stsDefault')
     109      (
     110        'Component = edtComment'
     111        'Label = lblComment'
     112        'Status = stsOK')
     113      (
     114        'Component = btnRemove'
     115        'Status = stsDefault')
     116      (
     117        'Component = btnSelectAll'
     118        'Status = stsDefault')
     119      (
     120        'Component = pnlMain'
     121        'Status = stsDefault')
     122      (
     123        'Component = lbxSection'
     124        'Label = lblList'
     125        'Status = stsOK')
     126      (
     127        'Component = pnlLeft'
     128        'Status = stsDefault')
     129      (
     130        'Component = lbSection'
     131        'Label = lblSection'
     132        'Status = stsOK')
     133      (
     134        'Component = btnOther'
     135        'Status = stsDefault')
     136      (
     137        'Component = pnlGrid'
     138        'Status = stsDefault')
     139      (
     140        'Component = lbGrid'
     141        'Status = stsDefault')
     142      (
     143        'Component = hcGrid'
     144        'Status = stsDefault')
     145      (
     146        'Component = btnOK'
     147        'Status = stsDefault')
     148      (
     149        'Component = btnCancel'
     150        'Status = stsDefault')
     151      (
     152        'Component = frmPatientEd'
     153        'Status = stsDefault'))
    98154  end
    99155end
  • cprs/trunk/CPRS-Chart/Encounter/fPatientEd.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, ORCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, ComCtrls, fPCEBaseMain;
     8  fPCELex, fPCEOther, ComCtrls, fPCEBaseMain, VA508AccessibilityManager;
    99
    1010type
     
    2929
    3030uses
    31   fEncounterFrame;
     31  fEncounterFrame, VA508AccessibilityRouter;
    3232
    3333{///////////////////////////////////////////////////////////////////////////////
     
    121121end;
    122122
     123initialization
     124  SpecifyFormIsNotADialog(TfrmPatientEd);
     125
    123126end.
  • cprs/trunk/CPRS-Chart/Encounter/fProcedure.dfm

    r456 r829  
    11inherited frmProcedures: TfrmProcedures
    2   Left = 295
    3   Top = 212
     2  Left = 548
     3  Top = 172
    44  Caption = 'Encounter Procedure'
     5  ExplicitWidth = 632
     6  ExplicitHeight = 427
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    1517    Width = 88
    1618    Caption = 'Procedure Section'
     19    ExplicitWidth = 88
    1720  end
    1821  inherited lblList: TLabel
    1922    Left = 154
     23    ExplicitLeft = 154
    2024  end
    2125  inherited bvlMain: TBevel
     
    2327    Width = 537
    2428    Height = 166
     29    ExplicitTop = 232
     30    ExplicitWidth = 537
     31    ExplicitHeight = 166
    2532  end
    2633  object lblMod: TLabel [5]
     
    4552    Top = 344
    4653    TabOrder = 8
     54    ExplicitLeft = 544
     55    ExplicitTop = 344
    4756  end
    4857  inherited btnCancel: TBitBtn
    4958    Top = 371
    5059    TabOrder = 9
     60    ExplicitTop = 371
    5161  end
    5262  inherited pnlGrid: TPanel
    5363    Width = 523
    5464    TabOrder = 1
     65    ExplicitWidth = 523
    5566    inherited lbGrid: TORListBox
    5667      Tag = 30
     
    5869      Caption = 'Selected Procedures'
    5970      Pieces = '1,2'
     71      ExplicitWidth = 523
    6072    end
    6173    inherited hcGrid: THeaderControl
     
    7486          Width = 112
    7587        end>
     88      ExplicitWidth = 523
    7689    end
    7790  end
     
    7992    TabOrder = 2
    8093  end
    81   inherited btnRemove: TButton
    82     Left = 454
    83     Top = 371
    84     TabOrder = 7
    85   end
    86   inherited btnSelectAll: TButton
    87     Left = 374
    88     Top = 371
    89     Height = 21
    90     TabOrder = 6
    91     TabStop = True
    92   end
    93   inherited pnlMain: TPanel
    94     TabOrder = 0
    95     inherited splLeft: TSplitter
    96       Left = 145
    97     end
    98     object splRight: TSplitter [1]
    99       Left = 349
    100       Top = 0
    101       Width = 3
    102       Height = 204
    103       Cursor = crHSplit
    104       Align = alRight
    105       OnMoved = splRightMoved
    106     end
    107     inherited lbxSection: TORListBox
    108       Tag = 30
    109       Left = 148
    110       Width = 201
    111       ItemHeight = 14
    112       Pieces = '2,3'
    113     end
    114     inherited pnlLeft: TPanel
    115       Width = 145
    116       inherited lbSection: TORListBox
    117         Tag = 30
    118         Width = 145
    119         TabOrder = 0
    120       end
    121       inherited btnOther: TButton
    122         Tag = 13
    123         Left = 3
    124         Caption = 'Other Procedure...'
    125         TabOrder = 1
    126       end
    127     end
    128     object lbMods: TORListBox
    129       Left = 352
    130       Top = 0
    131       Width = 260
    132       Height = 204
    133       Style = lbOwnerDrawFixed
    134       Align = alRight
    135       Font.Charset = DEFAULT_CHARSET
    136       Font.Color = clWindowText
    137       Font.Height = -11
    138       Font.Name = 'MS Sans Serif'
    139       Font.Style = []
    140       ItemHeight = 14
    141       ParentFont = False
    142       ParentShowHint = False
    143       ShowHint = True
    144       TabOrder = 2
    145       Caption = 'Modifiers'
    146       ItemTipColor = clWindow
    147       LongList = False
    148       Pieces = '2,3'
    149       TabPosInPixels = True
    150       CheckBoxes = True
    151       CheckEntireLine = True
    152       OnClickCheck = lbModsClickCheck
    153     end
    154   end
    155   object spnProcQty: TUpDown
     94  object spnProcQty: TUpDown [11]
    15695    Left = 348
    15796    Top = 371
     
    162101    Position = 1
    163102    TabOrder = 5
    164     Wrap = False
    165   end
    166   object txtProcQty: TCaptionEdit
     103  end
     104  object txtProcQty: TCaptionEdit [12]
    167105    Left = 288
    168106    Top = 371
     
    175113    Caption = 'Quantity'
    176114  end
    177   object cboProvider: TORComboBox
     115  object cboProvider: TORComboBox [13]
    178116    Left = 56
    179117    Top = 371
     
    199137    OnChange = cboProviderChange
    200138    OnNeedData = cboProviderNeedData
     139    CharsNeedMatch = 1
     140  end
     141  inherited btnRemove: TButton
     142    Left = 454
     143    Top = 371
     144    TabOrder = 7
     145    ExplicitLeft = 454
     146    ExplicitTop = 371
     147  end
     148  inherited btnSelectAll: TButton
     149    Left = 374
     150    Top = 371
     151    Height = 21
     152    TabOrder = 6
     153    TabStop = True
     154    ExplicitLeft = 374
     155    ExplicitTop = 371
     156    ExplicitHeight = 21
     157  end
     158  inherited pnlMain: TPanel
     159    TabOrder = 0
     160    inherited splLeft: TSplitter
     161      Left = 145
     162      ExplicitLeft = 145
     163    end
     164    object splRight: TSplitter [1]
     165      Left = 349
     166      Top = 0
     167      Height = 204
     168      Align = alRight
     169      OnMoved = splRightMoved
     170    end
     171    inherited lbxSection: TORListBox
     172      Tag = 30
     173      Left = 148
     174      Width = 201
     175      ItemHeight = 14
     176      Pieces = '2,3'
     177      ExplicitLeft = 148
     178      ExplicitWidth = 201
     179    end
     180    inherited pnlLeft: TPanel
     181      Width = 145
     182      ExplicitWidth = 145
     183      inherited lbSection: TORListBox
     184        Tag = 30
     185        Width = 145
     186        TabOrder = 0
     187        ExplicitWidth = 145
     188      end
     189      inherited btnOther: TButton
     190        Tag = 13
     191        Left = 3
     192        Caption = 'Other Procedure...'
     193        TabOrder = 1
     194        ExplicitLeft = 3
     195      end
     196    end
     197    object lbMods: TORListBox
     198      Left = 352
     199      Top = 0
     200      Width = 260
     201      Height = 204
     202      Style = lbOwnerDrawFixed
     203      Align = alRight
     204      Font.Charset = DEFAULT_CHARSET
     205      Font.Color = clWindowText
     206      Font.Height = -11
     207      Font.Name = 'MS Sans Serif'
     208      Font.Style = []
     209      ItemHeight = 14
     210      ParentFont = False
     211      ParentShowHint = False
     212      ShowHint = True
     213      TabOrder = 2
     214      OnExit = lbModsExit
     215      Caption = 'Modifiers'
     216      ItemTipColor = clWindow
     217      LongList = False
     218      Pieces = '2,3'
     219      TabPosInPixels = True
     220      CheckBoxes = True
     221      CheckEntireLine = True
     222      OnClickCheck = lbModsClickCheck
     223    end
     224  end
     225  inherited amgrMain: TVA508AccessibilityManager
     226    Data = (
     227      (
     228        'Component = lbMods'
     229        'Label = lblMod'
     230        'Status = stsOK')
     231      (
     232        'Component = spnProcQty'
     233        'Status = stsDefault')
     234      (
     235        'Component = txtProcQty'
     236        'Status = stsDefault')
     237      (
     238        'Component = cboProvider'
     239        'Status = stsDefault')
     240      (
     241        'Component = edtComment'
     242        'Label = lblComment'
     243        'Status = stsOK')
     244      (
     245        'Component = btnRemove'
     246        'Status = stsDefault')
     247      (
     248        'Component = btnSelectAll'
     249        'Status = stsDefault')
     250      (
     251        'Component = pnlMain'
     252        'Status = stsDefault')
     253      (
     254        'Component = lbxSection'
     255        'Label = lblList'
     256        'Status = stsOK')
     257      (
     258        'Component = pnlLeft'
     259        'Status = stsDefault')
     260      (
     261        'Component = lbSection'
     262        'Label = lblSection'
     263        'Status = stsOK')
     264      (
     265        'Component = btnOther'
     266        'Status = stsDefault')
     267      (
     268        'Component = pnlGrid'
     269        'Status = stsDefault')
     270      (
     271        'Component = lbGrid'
     272        'Status = stsDefault')
     273      (
     274        'Component = hcGrid'
     275        'Status = stsDefault')
     276      (
     277        'Component = btnOK'
     278        'Status = stsDefault')
     279      (
     280        'Component = btnCancel'
     281        'Status = stsDefault')
     282      (
     283        'Component = frmProcedures'
     284        'Status = stsDefault'))
    201285  end
    202286end
  • cprs/trunk/CPRS-Chart/Encounter/fProcedure.pas

    r456 r829  
    11unit fProcedure;
     2{Warning: The tab order has been changed in the OnExit event of several controls.
     3 To change the tab order of lbSection, lbxSection, lbMods, and btnOther you must do it programatically.}
    24
    35interface
     
    68  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    79  fPCEBase, StdCtrls, ComCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain;
     10  fPCELex, fPCEOther, fPCEBaseGrid, fPCEBaseMain, VA508AccessibilityManager;
    911
    1012type
     
    3335      Direction, InsertAt: Integer);
    3436    procedure cboProviderChange(Sender: TObject);
     37    procedure lbxSectionExit(Sender: TObject);
     38    procedure lbModsExit(Sender: TObject);
     39    procedure btnOtherExit(Sender: TObject);
    3540  private
    3641    FCheckingCode: boolean;
     
    3843    FLastCPTCodes: string;
    3944    FModsReadOnly: boolean;
     45    FProviderChanging: boolean;
    4046    FModsROChecked: string;
    4147    function MissingProvider: boolean;
     
    5864
    5965uses
    60   fEncounterFrame, uConst, rCore;
     66  fEncounterFrame, uConst, rCore, VA508AccessibilityRouter;
    6167
    6268const
     
    8894      if(lbGrid.Selected[i]) then
    8995        TPCEProc(lbGrid.Items.Objects[i]).Provider := cboProvider.ItemIEN;
    90     GridChanged;
     96    FProviderChanging := TRUE; // CQ 11707
     97    try
     98      GridChanged;
     99    finally
     100      FProviderChanging := FALSE;
     101    end;
    91102  end;
    92103end;
     
    102113  FSectionTabCount := 1;
    103114  FormResize(Self);
     115  lbMods.HideSelection := TRUE;
    104116end;
    105117
     
    170182          txtProcQty.Text := '';
    171183        end;
    172         if(SameProv) then
    173           cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200))
    174         else
    175           cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName);
    176           //cboProvider.ItemIndex := -1;     v22.8 - RV
     184        if not FProviderChanging then // CQ 11707
     185        begin
     186          if(SameProv) then
     187            cboProvider.SetExactByIEN(Prov, ExternalName(Prov, 200))
     188          else
     189            cboProvider.SetExactByIEN(uProviders.PCEProvider, uProviders.PCEProviderName);
     190            //cboProvider.ItemIndex := -1;     v22.8 - RV
     191        end;
    177192      end
    178193      else
     
    418433end;
    419434
     435procedure TfrmProcedures.lbModsExit(Sender: TObject);
     436begin
     437  inherited;
     438  if TabIsPressed then
     439    if btnOther.CanFocus then
     440      btnOther.SetFocus;
     441end;
     442
    420443procedure TfrmProcedures.lbSectionClick(Sender: TObject);
    421444begin
     
    434457    inherited;
    435458    Sync2Grid;
     459    lbxSection.Selected[Index] := True;
    436460    if(lbxSection.ItemIndex >= 0) and (lbxSection.ItemIndex = Index) and
    437461      (lbxSection.Checked[Index]) then
    438462    begin
    439       UpdateModifierList(lbxSection.Items, Index);
    440       lbxSection.Checked[Index] := TRUE;
     463      UpdateModifierList(lbxSection.Items, Index); // CQ#16439
     464      lbxSection.Checked[Index] := TRUE;   
    441465      for i := 0 to lbGrid.Items.Count-1 do
    442466      begin
     
    456480            Modifiers := Piece(lbxSection.Items[lbxSection.ItemIndex], U, 4);
    457481            GridChanged;
     482            lbxSection.Selected[Index] := True; // CQ#15493
    458483            exit;
    459484          end;
     
    466491end;
    467492
     493procedure TfrmProcedures.lbxSectionExit(Sender: TObject);
     494begin
     495  if TabIsPressed then begin
     496    if lbMods.CanFocus then
     497      lbMods.SetFocus;
     498  end
     499  else if ShiftTabIsPressed then
     500    if lbSection.CanFocus then
     501      lbSection.SetFocus;
     502end;
     503
    468504procedure TfrmProcedures.btnOtherClick(Sender: TObject);
    469505begin
     
    471507  Sync2Grid;
    472508  ShowModifiers;
     509end;
     510
     511procedure TfrmProcedures.btnOtherExit(Sender: TObject);
     512begin
     513  if TabIsPressed then begin
     514    if lbGrid.CanFocus then
     515      lbGrid.SetFocus;
     516  end
     517  else if ShiftTabIsPressed then
     518    if lbMods.CanFocus then
     519      lbMods.SetFocus;   
    473520end;
    474521
     
    537584end;
    538585
     586initialization
     587  SpecifyFormIsNotADialog(TfrmProcedures);
     588
    539589end.
  • cprs/trunk/CPRS-Chart/Encounter/fSkinTest.dfm

    r456 r829  
    33  Top = 163
    44  Caption = 'Encounter Skin Test form'
     5  ExplicitLeft = 213
     6  ExplicitTop = 163
    57  PixelsPerInch = 96
    68  TextHeight = 13
     
    3840    Width = 84
    3941    Caption = 'Skin Test Section'
     42    ExplicitWidth = 84
    4043  end
    4144  inherited btnOK: TBitBtn
     
    7679    TabOrder = 3
    7780  end
     81  object UpDnReading: TUpDown [12]
     82    Left = 531
     83    Top = 304
     84    Width = 15
     85    Height = 21
     86    Associate = EdtReading
     87    Max = 40
     88    TabOrder = 6
     89    OnChanging = UpDnReadingChanging
     90  end
     91  object EdtReading: TCaptionEdit [13]
     92    Left = 490
     93    Top = 304
     94    Width = 41
     95    Height = 21
     96    Enabled = False
     97    TabOrder = 5
     98    Text = '0'
     99    OnChange = EdtReadingChange
     100    Caption = 'Reading'
     101  end
     102  object edtDtRead: TCaptionEdit [14]
     103    Left = 104
     104    Top = 376
     105    Width = 97
     106    Height = 21
     107    TabOrder = 8
     108    Text = 'edtDtRead'
     109    Visible = False
     110    Caption = 'Date Read'
     111  end
     112  object edtDTGiven: TCaptionEdit [15]
     113    Left = 280
     114    Top = 376
     115    Width = 81
     116    Height = 21
     117    TabOrder = 9
     118    Text = 'edtDTGiven'
     119    Visible = False
     120    Caption = 'Date Given'
     121  end
     122  object cboSkinResults: TORComboBox [16]
     123    Tag = 30
     124    Left = 490
     125    Top = 260
     126    Width = 121
     127    Height = 21
     128    Style = orcsDropDown
     129    AutoSelect = True
     130    Caption = 'Results'
     131    Color = clWindow
     132    DropDownCount = 8
     133    Enabled = False
     134    ItemHeight = 13
     135    ItemTipColor = clWindow
     136    ItemTipEnable = True
     137    ListItemsOnly = False
     138    LongList = False
     139    LookupPiece = 0
     140    MaxLength = 0
     141    Pieces = '2'
     142    Sorted = False
     143    SynonymChars = '<>'
     144    TabOrder = 4
     145    OnChange = cboSkinResultsChange
     146    CharsNeedMatch = 1
     147  end
    78148  inherited btnRemove: TButton
    79149    TabOrder = 7
     
    101171    end
    102172  end
    103   object UpDnReading: TUpDown
    104     Left = 531
    105     Top = 304
    106     Width = 15
    107     Height = 21
    108     Associate = EdtReading
    109     Min = 0
    110     Max = 40
    111     Position = 0
    112     TabOrder = 6
    113     Wrap = False
    114     OnChanging = UpDnReadingChanging
    115   end
    116   object EdtReading: TCaptionEdit
    117     Left = 490
    118     Top = 304
    119     Width = 41
    120     Height = 21
    121     Enabled = False
    122     TabOrder = 5
    123     Text = '0'
    124     OnChange = EdtReadingChange
    125     Caption = 'Reading'
    126   end
    127   object edtDtRead: TCaptionEdit
    128     Left = 104
    129     Top = 376
    130     Width = 97
    131     Height = 21
    132     TabOrder = 8
    133     Text = 'edtDtRead'
    134     Visible = False
    135     Caption = 'Date Read'
    136   end
    137   object edtDTGiven: TCaptionEdit
    138     Left = 280
    139     Top = 376
    140     Width = 81
    141     Height = 21
    142     TabOrder = 9
    143     Text = 'edtDTGiven'
    144     Visible = False
    145     Caption = 'Date Given'
    146   end
    147   object cboSkinResults: TORComboBox
    148     Tag = 30
    149     Left = 490
    150     Top = 260
    151     Width = 121
    152     Height = 21
    153     Style = orcsDropDown
    154     AutoSelect = True
    155     Caption = 'Results'
    156     Color = clWindow
    157     DropDownCount = 8
    158     Enabled = False
    159     ItemHeight = 13
    160     ItemTipColor = clWindow
    161     ItemTipEnable = True
    162     ListItemsOnly = False
    163     LongList = False
    164     MaxLength = 0
    165     Pieces = '2'
    166     Sorted = False
    167     SynonymChars = '<>'
    168     TabOrder = 4
    169     OnChange = cboSkinResultsChange
     173  inherited amgrMain: TVA508AccessibilityManager
     174    Data = (
     175      (
     176        'Component = UpDnReading'
     177        'Status = stsDefault')
     178      (
     179        'Component = EdtReading'
     180        'Label = lblReading'
     181        'Status = stsOK')
     182      (
     183        'Component = edtDtRead'
     184        'Label = lblDTRead'
     185        'Status = stsOK')
     186      (
     187        'Component = edtDTGiven'
     188        'Label = lblDTGiven'
     189        'Status = stsOK')
     190      (
     191        'Component = cboSkinResults'
     192        'Label = lblSkinResults'
     193        'Status = stsOK')
     194      (
     195        'Component = edtComment'
     196        'Label = lblComment'
     197        'Status = stsOK')
     198      (
     199        'Component = btnRemove'
     200        'Status = stsDefault')
     201      (
     202        'Component = btnSelectAll'
     203        'Status = stsDefault')
     204      (
     205        'Component = pnlMain'
     206        'Status = stsDefault')
     207      (
     208        'Component = lbxSection'
     209        'Label = lblList'
     210        'Status = stsOK')
     211      (
     212        'Component = pnlLeft'
     213        'Status = stsDefault')
     214      (
     215        'Component = lbSection'
     216        'Label = lblSection'
     217        'Status = stsOK')
     218      (
     219        'Component = btnOther'
     220        'Status = stsDefault')
     221      (
     222        'Component = pnlGrid'
     223        'Status = stsDefault')
     224      (
     225        'Component = lbGrid'
     226        'Status = stsDefault')
     227      (
     228        'Component = hcGrid'
     229        'Status = stsDefault')
     230      (
     231        'Component = btnOK'
     232        'Status = stsDefault')
     233      (
     234        'Component = btnCancel'
     235        'Status = stsDefault')
     236      (
     237        'Component = frmSkinTests'
     238        'Status = stsDefault'))
    170239  end
    171240end
  • cprs/trunk/CPRS-Chart/Encounter/fSkinTest.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
    8   fPCELex, fPCEOther, rCore, fPCEBaseMain;
     8  fPCELex, fPCEOther, rCore, fPCEBaseMain, VA508AccessibilityManager;
    99
    1010type
     
    4141
    4242uses
    43   fEncounterFrame;
     43  fEncounterFrame, VA508AccessibilityRouter;
    4444
    4545procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject);
     
    137137      else
    138138      begin
    139         Showmessage('If the reading is over 9, the results are required to be positive.');
     139        Show508Message('If the reading is over 9, the results are required to be positive.');
    140140        cboSkinResults.SelectById('P');
    141141       end;
     
    245245end;
    246246
     247initialization
     248  SpecifyFormIsNotADialog(TfrmSkinTests);
     249
    247250end.
    248251 
  • cprs/trunk/CPRS-Chart/Encounter/fVisitType.dfm

    r456 r829  
    11inherited frmVisitType: TfrmVisitType
    2   Left = 255
    3   Top = 186
     2  Left = 260
    43  Caption = 'Encounter VisitType'
    5   ClientWidth = 620
     4  ClientHeight = 438
     5  ClientWidth = 592
     6  Constraints.MinHeight = 465
     7  Constraints.MinWidth = 600
    68  OnCloseQuery = FormCloseQuery
    7   OnResize = FormResize
     9  ExplicitLeft = 260
     10  ExplicitWidth = 600
     11  ExplicitHeight = 472
    812  PixelsPerInch = 96
    913  TextHeight = 13
    10   object lblVType: TLabel [0]
    11     Left = 150
    12     Top = 6
    13     Width = 67
    14     Height = 13
    15     Caption = 'Section Name'
     14  inherited btnOK: TBitBtn
     15    Left = 436
     16    Top = 414
     17    TabOrder = 3
     18    ExplicitLeft = 474
     19    ExplicitTop = 459
    1620  end
    17   object lblSCDisplay: TLabel [1]
    18     Left = 6
    19     Top = 123
    20     Width = 186
    21     Height = 13
    22     Caption = 'Service Connection && Rated Disabilities'
    23   end
    24   object lblVTypeSection: TLabel [2]
    25     Left = 6
    26     Top = 6
    27     Width = 58
    28     Height = 13
    29     Caption = 'Type of Visit'
    30   end
    31   object lblCurrentProv: TLabel [3]
    32     Left = 277
    33     Top = 249
    34     Width = 165
    35     Height = 13
    36     Caption = 'Current providers for this encounter'
    37   end
    38   object lblProvider: TLabel [4]
    39     Left = 6
    40     Top = 249
    41     Width = 89
    42     Height = 13
    43     Caption = 'Available providers'
    44   end
    45   object lblMod: TLabel [5]
    46     Left = 358
    47     Top = 6
    48     Width = 42
    49     Height = 13
    50     Hint = 'Modifiers'
    51     Caption = 'Modifiers'
    52     ParentShowHint = False
    53     ShowHint = True
    54   end
    55   inherited btnOK: TBitBtn
    56     Left = 463
    57     Top = 377
    58     TabOrder = 8
    59   end
    60   inherited btnCancel: TBitBtn
    61     Left = 543
    62     Top = 377
    63     TabOrder = 9
    64   end
    65   object pnlMain: TPanel
    66     Left = 2
    67     Top = 19
    68     Width = 615
    69     Height = 92
     21  object pnlTop: TPanel [1]
     22    Left = 0
     23    Top = 0
     24    Width = 592
     25    Height = 105
     26    Align = alTop
    7027    BevelOuter = bvNone
    7128    TabOrder = 0
     29    ExplicitWidth = 630
    7230    object splLeft: TSplitter
    7331      Left = 145
    7432      Top = 0
    75       Width = 3
    76       Height = 92
    77       Cursor = crHSplit
    78       OnMoved = splLeftMoved
     33      Height = 105
     34      ExplicitLeft = 154
     35      ExplicitTop = 7
     36      ExplicitHeight = 145
    7937    end
    8038    object splRight: TSplitter
    81       Left = 352
    82       Top = 0
    83       Width = 3
    84       Height = 92
    85       Cursor = crHSplit
    86       Align = alRight
    87       OnMoved = splRightMoved
     39      Left = 361
     40      Top = 0
     41      Height = 105
     42      ExplicitLeft = 634
    8843    end
    8944    object pnlLeft: TPanel
     
    9146      Top = 0
    9247      Width = 145
    93       Height = 92
     48      Height = 105
    9449      Align = alLeft
    9550      BevelOuter = bvNone
    9651      TabOrder = 0
     52      ExplicitHeight = 145
     53      object lblVTypeSection: TLabel
     54        Left = 0
     55        Top = 0
     56        Width = 145
     57        Height = 13
     58        Align = alTop
     59        Caption = 'Type of Visit'
     60        ExplicitWidth = 58
     61      end
    9762      object lstVTypeSection: TORListBox
    9863        Tag = 10
    9964        Left = 0
    100         Top = 0
     65        Top = 13
    10166        Width = 145
    10267        Height = 92
    103         Align = alTop
     68        Align = alClient
    10469        ItemHeight = 13
    10570        ParentShowHint = False
     
    11479      end
    11580    end
    116     object lbxVisits: TORListBox
    117       Tag = 10
     81    object pnlModifiers: TPanel
     82      Left = 364
     83      Top = 0
     84      Width = 228
     85      Height = 105
     86      Align = alClient
     87      BevelOuter = bvNone
     88      TabOrder = 2
     89      ExplicitLeft = 431
     90      ExplicitWidth = 199
     91      ExplicitHeight = 145
     92      object lblMod: TLabel
     93        Left = 0
     94        Top = 0
     95        Width = 228
     96        Height = 13
     97        Hint = 'Modifiers'
     98        Align = alTop
     99        Caption = 'Modifiers'
     100        ParentShowHint = False
     101        ShowHint = True
     102        ExplicitWidth = 42
     103      end
     104      object lbMods: TORListBox
     105        Left = 0
     106        Top = 13
     107        Width = 228
     108        Height = 92
     109        Style = lbOwnerDrawFixed
     110        Align = alClient
     111        Font.Charset = DEFAULT_CHARSET
     112        Font.Color = clWindowText
     113        Font.Height = -11
     114        Font.Name = 'MS Sans Serif'
     115        Font.Style = []
     116        ItemHeight = 14
     117        ParentFont = False
     118        ParentShowHint = False
     119        ShowHint = True
     120        TabOrder = 0
     121        Caption = 'Modifiers'
     122        ItemTipColor = clWindow
     123        LongList = False
     124        Pieces = '2,3'
     125        TabPosInPixels = True
     126        CheckBoxes = True
     127        CheckEntireLine = True
     128        OnClickCheck = lbModsClickCheck
     129        ExplicitWidth = 199
     130        ExplicitHeight = 132
     131      end
     132    end
     133    object pnlSection: TPanel
    118134      Left = 148
    119135      Top = 0
    120       Width = 204
    121       Height = 92
    122       Style = lbOwnerDrawFixed
     136      Width = 213
     137      Height = 105
     138      Align = alLeft
     139      BevelOuter = bvNone
     140      Caption = 'pnlSection'
     141      TabOrder = 1
     142      object lblVType: TLabel
     143        Left = 0
     144        Top = 0
     145        Width = 213
     146        Height = 13
     147        Align = alTop
     148        Caption = 'Section Name'
     149        ExplicitWidth = 67
     150      end
     151      object lbxVisits: TORListBox
     152        Tag = 10
     153        Left = 0
     154        Top = 13
     155        Width = 213
     156        Height = 92
     157        Style = lbOwnerDrawFixed
     158        Align = alClient
     159        ItemHeight = 16
     160        ParentShowHint = False
     161        ShowHint = True
     162        TabOrder = 0
     163        OnClick = lbxVisitsClick
     164        Caption = 'Section Name'
     165        ItemTipColor = clWindow
     166        LongList = False
     167        Pieces = '3,4,5'
     168        TabPosInPixels = True
     169        CheckBoxes = True
     170        CheckEntireLine = True
     171        OnClickCheck = lbxVisitsClickCheck
     172        ExplicitLeft = -3
     173        ExplicitTop = 7
     174        ExplicitWidth = 281
     175      end
     176    end
     177  end
     178  object pnlMiddle: TPanel [2]
     179    Left = 0
     180    Top = 105
     181    Width = 592
     182    Height = 164
     183    Align = alTop
     184    BevelOuter = bvNone
     185    TabOrder = 1
     186    ExplicitTop = 145
     187    ExplicitWidth = 630
     188    inline fraVisitRelated: TfraVisitRelated
     189      Left = 384
     190      Top = 0
     191      Width = 208
     192      Height = 164
     193      Align = alRight
     194      TabOrder = 1
     195      ExplicitLeft = 384
     196      ExplicitWidth = 208
     197      ExplicitHeight = 164
     198      inherited gbVisitRelatedTo: TGroupBox
     199        Width = 208
     200        Height = 164
     201        ExplicitWidth = 208
     202        ExplicitHeight = 164
     203        inherited chkMSTYes: TCheckBox
     204          Top = 127
     205          ExplicitTop = 127
     206        end
     207        inherited chkMSTNo: TCheckBox
     208          Top = 127
     209          ExplicitTop = 127
     210        end
     211        inherited chkHNCYes: TCheckBox
     212          Top = 143
     213          ExplicitTop = 143
     214        end
     215        inherited chkHNCNo: TCheckBox
     216          Top = 142
     217          Width = 150
     218          Height = 18
     219          Caption = 'Head and/or Neck Cancer     No'
     220          ExplicitTop = 142
     221          ExplicitWidth = 150
     222          ExplicitHeight = 18
     223        end
     224      end
     225    end
     226    object pnlSC: TPanel
     227      Left = 0
     228      Top = 0
     229      Width = 384
     230      Height = 164
    123231      Align = alClient
    124       ItemHeight = 16
    125       ParentShowHint = False
    126       ShowHint = True
     232      BevelOuter = bvNone
     233      TabOrder = 0
     234      ExplicitWidth = 422
     235      object lblSCDisplay: TLabel
     236        Left = 0
     237        Top = 0
     238        Width = 384
     239        Height = 13
     240        Align = alTop
     241        Caption = 'Service Connection && Rated Disabilities'
     242        ExplicitWidth = 186
     243      end
     244      object memSCDisplay: TCaptionMemo
     245        Left = 0
     246        Top = 13
     247        Width = 384
     248        Height = 151
     249        Align = alClient
     250        Color = clBtnFace
     251        Lines.Strings = (
     252          '')
     253        ReadOnly = True
     254        ScrollBars = ssVertical
     255        TabOrder = 0
     256        OnEnter = memSCDisplayEnter
     257        Caption = 'Service Connection && Rated Disabilities'
     258      end
     259    end
     260  end
     261  object pnlBottom: TPanel [3]
     262    Left = 0
     263    Top = 269
     264    Width = 592
     265    Height = 141
     266    Align = alTop
     267    BevelOuter = bvNone
     268    TabOrder = 2
     269    ExplicitTop = 309
     270    ExplicitWidth = 630
     271    object btnAdd: TButton
     272      Left = 260
     273      Top = 35
     274      Width = 75
     275      Height = 21
     276      Caption = 'Add'
    127277      TabOrder = 1
    128       OnClick = lbxVisitsClick
    129       Caption = 'Section Name'
    130       ItemTipColor = clWindow
    131       LongList = False
    132       Pieces = '3,4,5'
    133       TabPosInPixels = True
    134       CheckBoxes = True
    135       CheckEntireLine = True
    136       OnClickCheck = lbxVisitsClickCheck
    137     end
    138     object lbMods: TORListBox
    139       Left = 355
    140       Top = 0
    141       Width = 260
    142       Height = 92
    143       Style = lbOwnerDrawFixed
     278      OnClick = btnAddClick
     279    end
     280    object btnDelete: TButton
     281      Left = 260
     282      Top = 72
     283      Width = 75
     284      Height = 21
     285      Caption = 'Remove'
     286      TabOrder = 2
     287      OnClick = btnDeleteClick
     288    end
     289    object btnPrimary: TButton
     290      Left = 260
     291      Top = 112
     292      Width = 75
     293      Height = 21
     294      Caption = 'Primary'
     295      TabOrder = 3
     296      OnClick = btnPrimaryClick
     297    end
     298    object pnlBottomLeft: TPanel
     299      Left = 0
     300      Top = 0
     301      Width = 240
     302      Height = 141
     303      Align = alLeft
     304      BevelOuter = bvNone
     305      TabOrder = 0
     306      object lblProvider: TLabel
     307        Left = 0
     308        Top = 0
     309        Width = 240
     310        Height = 13
     311        Align = alTop
     312        Caption = 'Available providers'
     313        ExplicitWidth = 89
     314      end
     315      object cboPtProvider: TORComboBox
     316        Left = 0
     317        Top = 13
     318        Width = 240
     319        Height = 128
     320        Style = orcsSimple
     321        Align = alClient
     322        AutoSelect = True
     323        Caption = 'Available providers'
     324        Color = clWindow
     325        DropDownCount = 8
     326        ItemHeight = 13
     327        ItemTipColor = clWindow
     328        ItemTipEnable = True
     329        ListItemsOnly = True
     330        LongList = True
     331        LookupPiece = 2
     332        MaxLength = 0
     333        Pieces = '2,3'
     334        Sorted = False
     335        SynonymChars = '<>'
     336        TabOrder = 0
     337        CheckEntireLine = True
     338        OnChange = cboPtProviderChange
     339        OnDblClick = cboPtProviderDblClick
     340        OnNeedData = cboPtProviderNeedData
     341        CharsNeedMatch = 1
     342        ExplicitWidth = 260
     343      end
     344    end
     345    object pnlBottomRight: TPanel
     346      Left = 352
     347      Top = 0
     348      Width = 240
     349      Height = 141
    144350      Align = alRight
    145       Font.Charset = DEFAULT_CHARSET
    146       Font.Color = clWindowText
    147       Font.Height = -11
    148       Font.Name = 'MS Sans Serif'
    149       Font.Style = []
    150       ItemHeight = 14
    151       ParentFont = False
    152       ParentShowHint = False
    153       ShowHint = True
    154       TabOrder = 2
    155       Caption = 'Modifiers'
    156       ItemTipColor = clWindow
    157       LongList = False
    158       Pieces = '2,3'
    159       TabPosInPixels = True
    160       CheckBoxes = True
    161       CheckEntireLine = True
    162       OnClickCheck = lbModsClickCheck
     351      BevelOuter = bvNone
     352      TabOrder = 4
     353      object lblCurrentProv: TLabel
     354        Left = 0
     355        Top = 0
     356        Width = 240
     357        Height = 13
     358        Align = alTop
     359        Caption = 'Current providers for this encounter'
     360        ExplicitWidth = 165
     361      end
     362      object lbProviders: TORListBox
     363        Left = 0
     364        Top = 13
     365        Width = 240
     366        Height = 128
     367        Align = alClient
     368        ItemHeight = 13
     369        ParentShowHint = False
     370        ShowHint = True
     371        TabOrder = 0
     372        OnDblClick = lbProvidersDblClick
     373        Caption = 'Current providers for this encounter'
     374        ItemTipColor = clWindow
     375        LongList = False
     376        Pieces = '2'
     377        OnChange = lbProvidersChange
     378        CheckEntireLine = True
     379        ExplicitTop = 11
     380        ExplicitWidth = 220
     381      end
    163382    end
    164383  end
    165   object memSCDisplay: TCaptionMemo
    166     Left = 6
    167     Top = 137
    168     Width = 411
    169     Height = 107
    170     Color = clBtnFace
    171     Lines.Strings = (
    172       '')
    173     ScrollBars = ssVertical
    174     TabOrder = 1
    175     Caption = 'Service Connection && Rated Disabilities'
     384  inherited btnCancel: TBitBtn
     385    Left = 517
     386    Top = 414
     387    TabOrder = 4
     388    ExplicitLeft = 555
     389    ExplicitTop = 459
    176390  end
    177   object lbProviders: TORListBox
    178     Left = 277
    179     Top = 265
    180     Width = 183
    181     Height = 126
    182     ItemHeight = 13
    183     ParentShowHint = False
    184     ShowHint = True
    185     TabOrder = 7
    186     OnDblClick = lbProvidersDblClick
    187     Caption = 'Current providers for this encounter'
    188     ItemTipColor = clWindow
    189     LongList = False
    190     Pieces = '2'
    191     OnChange = lbProvidersChange
    192     CheckEntireLine = True
    193   end
    194   object cboPtProvider: TORComboBox
    195     Left = 6
    196     Top = 265
    197     Width = 183
    198     Height = 126
    199     Style = orcsSimple
    200     AutoSelect = True
    201     Caption = 'Available providers'
    202     Color = clWindow
    203     DropDownCount = 8
    204     ItemHeight = 13
    205     ItemTipColor = clWindow
    206     ItemTipEnable = True
    207     ListItemsOnly = True
    208     LongList = True
    209     LookupPiece = 2
    210     MaxLength = 0
    211     Pieces = '2,3'
    212     Sorted = False
    213     SynonymChars = '<>'
    214     TabOrder = 3
    215     TabStop = True
    216     CheckEntireLine = True
    217     OnChange = cboPtProviderChange
    218     OnDblClick = cboPtProviderDblClick
    219     OnNeedData = cboPtProviderNeedData
    220   end
    221   object btnAdd: TButton
    222     Left = 196
    223     Top = 275
    224     Width = 75
    225     Height = 21
    226     Caption = 'Add'
    227     TabOrder = 4
    228     OnClick = btnAddClick
    229   end
    230   object btnDelete: TButton
    231     Left = 196
    232     Top = 307
    233     Width = 75
    234     Height = 21
    235     Caption = 'Remove'
    236     TabOrder = 5
    237     OnClick = btnDeleteClick
    238   end
    239   object btnPrimary: TButton
    240     Left = 196
    241     Top = 355
    242     Width = 75
    243     Height = 21
    244     Caption = 'Primary'
    245     TabOrder = 6
    246     OnClick = btnPrimaryClick
    247   end
    248   inline fraVisitRelated: TfraVisitRelated
    249     Left = 426
    250     Top = 112
    251     Width = 192
    252     Height = 137
    253     TabOrder = 2
     391  inherited amgrMain: TVA508AccessibilityManager
     392    Left = 8
     393    Top = 24
     394    Data = (
     395      (
     396        'Component = btnOK'
     397        'Status = stsDefault')
     398      (
     399        'Component = btnCancel'
     400        'Status = stsDefault')
     401      (
     402        'Component = frmVisitType'
     403        'Status = stsDefault')
     404      (
     405        'Component = pnlTop'
     406        'Status = stsDefault')
     407      (
     408        'Component = pnlLeft'
     409        'Status = stsDefault')
     410      (
     411        'Component = lstVTypeSection'
     412        'Label = lblVTypeSection'
     413        'Status = stsOK')
     414      (
     415        'Component = pnlMiddle'
     416        'Status = stsDefault')
     417      (
     418        'Component = fraVisitRelated'
     419        'Status = stsDefault')
     420      (
     421        'Component = fraVisitRelated.gbVisitRelatedTo'
     422        'Status = stsDefault')
     423      (
     424        'Component = fraVisitRelated.chkSCYes'
     425        'Status = stsDefault')
     426      (
     427        'Component = fraVisitRelated.chkAOYes'
     428        'Status = stsDefault')
     429      (
     430        'Component = fraVisitRelated.chkIRYes'
     431        'Status = stsDefault')
     432      (
     433        'Component = fraVisitRelated.chkECYes'
     434        'Status = stsDefault')
     435      (
     436        'Component = fraVisitRelated.chkMSTYes'
     437        'Status = stsDefault')
     438      (
     439        'Component = fraVisitRelated.chkMSTNo'
     440        'Status = stsDefault')
     441      (
     442        'Component = fraVisitRelated.chkECNo'
     443        'Status = stsDefault')
     444      (
     445        'Component = fraVisitRelated.chkIRNo'
     446        'Status = stsDefault')
     447      (
     448        'Component = fraVisitRelated.chkAONo'
     449        'Status = stsDefault')
     450      (
     451        'Component = fraVisitRelated.chkSCNo'
     452        'Status = stsDefault')
     453      (
     454        'Component = fraVisitRelated.chkHNCYes'
     455        'Status = stsDefault')
     456      (
     457        'Component = fraVisitRelated.chkHNCNo'
     458        'Status = stsDefault')
     459      (
     460        'Component = fraVisitRelated.chkCVYes'
     461        'Status = stsDefault')
     462      (
     463        'Component = fraVisitRelated.chkCVNo'
     464        'Status = stsDefault')
     465      (
     466        'Component = fraVisitRelated.chkSHDYes'
     467        'Status = stsDefault')
     468      (
     469        'Component = fraVisitRelated.chkSHDNo'
     470        'Status = stsDefault')
     471      (
     472        'Component = fraVisitRelated.lblSCNo'
     473        'Status = stsDefault')
     474      (
     475        'Component = fraVisitRelated.lblSCYes'
     476        'Status = stsDefault')
     477      (
     478        'Component = pnlSC'
     479        'Status = stsDefault')
     480      (
     481        'Component = memSCDisplay'
     482        'Label = lblSCDisplay'
     483        'Status = stsOK')
     484      (
     485        'Component = pnlBottom'
     486        'Status = stsDefault')
     487      (
     488        'Component = btnAdd'
     489        'Status = stsDefault')
     490      (
     491        'Component = btnDelete'
     492        'Status = stsDefault')
     493      (
     494        'Component = btnPrimary'
     495        'Status = stsDefault')
     496      (
     497        'Component = pnlBottomLeft'
     498        'Status = stsDefault')
     499      (
     500        'Component = cboPtProvider'
     501        'Label = lblProvider'
     502        'Status = stsOK')
     503      (
     504        'Component = pnlBottomRight'
     505        'Status = stsDefault')
     506      (
     507        'Component = lbProviders'
     508        'Label = lblCurrentProv'
     509        'Status = stsOK')
     510      (
     511        'Component = pnlModifiers'
     512        'Status = stsDefault')
     513      (
     514        'Component = lbMods'
     515        'Label = lblMod'
     516        'Status = stsOK')
     517      (
     518        'Component = pnlSection'
     519        'Status = stsDefault')
     520      (
     521        'Component = lbxVisits'
     522        'Label = lblVType'
     523        'Status = stsOK'))
    254524  end
    255525end
  • cprs/trunk/CPRS-Chart/Encounter/fVisitType.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fPCEBase, StdCtrls, CheckLst, ORCtrls, ExtCtrls, Buttons, uPCE, rPCE, ORFn, rCore,
    8   ComCtrls, mVisitRelated;
     8  ComCtrls, mVisitRelated, VA508AccessibilityManager;
    99
    1010type
    1111  TfrmVisitType = class(TfrmPCEBase)
    12     lblVType: TLabel;
     12    pnlTop: TPanel;
     13    splLeft: TSplitter;
     14    splRight: TSplitter;
     15    pnlLeft: TPanel;
     16    lstVTypeSection: TORListBox;
     17    pnlMiddle: TPanel;
     18    fraVisitRelated: TfraVisitRelated;
     19    pnlSC: TPanel;
    1320    lblSCDisplay: TLabel;
    14     lblVTypeSection: TLabel;
    1521    memSCDisplay: TCaptionMemo;
    16     lbProviders: TORListBox;
    17     lblCurrentProv: TLabel;
    18     cboPtProvider: TORComboBox;
    19     lblProvider: TLabel;
     22    pnlBottom: TPanel;
    2023    btnAdd: TButton;
    2124    btnDelete: TButton;
    2225    btnPrimary: TButton;
    23     fraVisitRelated: TfraVisitRelated;
    24     lstVTypeSection: TORListBox;
    25     lbxVisits: TORListBox;
     26    pnlBottomLeft: TPanel;
     27    lblProvider: TLabel;
     28    cboPtProvider: TORComboBox;
     29    pnlBottomRight: TPanel;
     30    lbProviders: TORListBox;
     31    lblCurrentProv: TLabel;
     32    lblVTypeSection: TLabel;
     33    pnlModifiers: TPanel;
    2634    lbMods: TORListBox;
    2735    lblMod: TLabel;
    28     pnlMain: TPanel;
    29     pnlLeft: TPanel;
    30     splLeft: TSplitter;
     36    pnlSection: TPanel;
     37    lbxVisits: TORListBox;
     38    lblVType: TLabel;
    3139    procedure lstVTypeSectionClick(Sender: TObject);
    3240    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     
    4351    procedure FormResize(Sender: TObject);
    4452    procedure lbxVisitsClickCheck(Sender: TObject; Index: Integer);
    45     procedure splLeftMoved(Sender: TObject);
    46     procedure splRightMoved(Sender: TObject);
    4753    procedure lbModsClickCheck(Sender: TObject; Index: Integer);
    4854    procedure lbxVisitsClick(Sender: TObject);
     55    procedure memSCDisplayEnter(Sender: TObject);
    4956  protected
    5057    FSplitterMove: boolean;
     
    7683
    7784uses
    78   fEncounterFrame, uCore, uConst;
     85  fEncounterFrame, uCore, uConst, VA508AccessibilityRouter;
    7986
    8087const
     
    198205  RefreshProviders;
    199206  FLastMods := uEncPCEData.VisitType.Modifiers;
     207  fraVisitRelated.TabStop := FALSE;
    200208end;
    201209
     
    325333  v, i: integer;
    326334  s: string;
     335  padding, size: integer;
     336  btnOffset: integer;
    327337begin
    328338  if FSplitterMove then
    329339    FSplitterMove := FALSE
    330340  else
    331     begin
    332       inherited;
    333       FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth);
    334       FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth);
    335       if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2;
    336       lbxVisits.TabPositions := SectionString;
    337       v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth);
    338       s := '';
    339       for i := 1 to 20 do
    340       begin
    341         if s <> '' then s := s + ',';
    342         s := s + inttostr(v);
    343         if(v<0) then
    344           dec(v,32)
    345         else
    346           inc(v,32);
    347       end;
    348       lbMods.TabPositions := s;
    349     end;
     341  begin
     342//      inherited;
     343    FSectionTabs[0] := -(lbxVisits.width - LBCheckWidthSpace - MainFontWidth - ScrollBarWidth);
     344    FSectionTabs[1] := -(lbxVisits.width - (6*MainFontWidth) - ScrollBarWidth);
     345    if(FSectionTabs[0] <= FSectionTabs[1]) then FSectionTabs[0] := FSectionTabs[1]+2;
     346    lbxVisits.TabPositions := SectionString;
     347    v := (lbMods.width - LBCheckWidthSpace - (4*MainFontWidth) - ScrollBarWidth);
     348    s := '';
     349    for i := 1 to 20 do
     350    begin
     351      if s <> '' then s := s + ',';
     352      s := s + inttostr(v);
     353      if(v<0) then
     354        dec(v,32)
     355      else
     356        inc(v,32);
     357    end;
     358    lbMods.TabPositions := s;
     359  end;
     360  btnOffset := btnAdd.Width div 7;
     361  padding := btnAdd.Width + (btnOffset * 2);
     362  size := (ClientWidth - padding) div 2;
     363  pnlBottomLeft.Width := size;
     364  pnlBottomRight.Width := size;
     365  btnAdd.Left := size + btnOffset;
     366  btnDelete.Left := size + btnOffset;
     367  btnPrimary.Left := size + btnOffset;
     368  btnOK.top := ClientHeight - btnOK.Height - 4;
     369  btnCancel.top := btnOK.Top;
     370  btnCancel.Left := ClientWidth - btnCancel.Width - 4;
     371  btnOK.Left := btnCancel.Left - btnOK.Width - 4;
     372  size := ClientHeight - btnOK.Height - pnlMiddle.Height - pnlBottom.Height - 8;
     373  pnlTop.Height := size;
    350374end;
    351375
     
    479503end;
    480504
    481 procedure TfrmVisitType.splLeftMoved(Sender: TObject);
    482 begin
    483   inherited;
    484   lblVType.Left := lbxVisits.Left + pnlMain.Left;
    485   FSplitterMove := TRUE;
    486   FormResize(Sender);
    487 end;
    488 
    489 procedure TfrmVisitType.splRightMoved(Sender: TObject);
    490 begin
    491   inherited;
    492   lblMod.Left := lbMods.Left + pnlMain.Left;
    493   FSplitterMove := TRUE;
    494   FormResize(Sender);
    495 end;
    496 
    497505procedure TfrmVisitType.lbModsClickCheck(Sender: TObject; Index: Integer);
    498506var
     
    527535end;
    528536
     537procedure TfrmVisitType.memSCDisplayEnter(Sender: TObject);
     538begin
     539  inherited;
     540  memSCDisplay.SelStart := 0;
     541end;
     542
    529543initialization
     544  SpecifyFormIsNotADialog(TfrmVisitType);
     545
    530546//frmVisitType.CreateProviderList;
    531547
  • cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.dfm

    r456 r829  
    22  Left = 0
    33  Top = 0
    4   Width = 192
    5   Height = 136
     4  Width = 206
     5  Height = 172
    66  TabOrder = 0
    7   object bvlSCFrame: TBevel
     7  object gbVisitRelatedTo: TGroupBox
    88    Left = 0
    9     Top = 14
    10     Width = 191
    11     Height = 119
    12     Shape = bsFrame
    13   end
    14   object lblSCYes: TStaticText
    15     Left = 3
    169    Top = 0
    17     Width = 22
    18     Height = 13
    19     AutoSize = False
    20     Caption = 'Yes'
    21     TabOrder = 14
    22   end
    23   object lblSCNo: TStaticText
    24     Left = 26
    25     Top = 0
    26     Width = 18
    27     Height = 13
    28     AutoSize = False
    29     Caption = 'No'
    30     TabOrder = 15
    31   end
    32   object lblSCSelect: TStaticText
    33     Left = 44
    34     Top = 0
    35     Width = 131
    36     Height = 13
    37     Alignment = taCenter
    38     AutoSize = False
     10    Width = 206
     11    Height = 172
     12    Align = alClient
    3913    Caption = 'Visit Related To'
    40     TabOrder = 16
    41   end
    42   object chkSCYes: TCheckBox
    43     Tag = 1
    44     Left = 6
    45     Top = 17
    46     Width = 16
    47     Height = 17
    4814    TabOrder = 0
    49     OnClick = chkClick
    50   end
    51   object chkAOYes: TCheckBox
    52     Tag = 2
    53     Left = 6
    54     Top = 49
    55     Width = 16
    56     Height = 17
    57     TabOrder = 4
    58     OnClick = chkClick
    59   end
    60   object chkIRYes: TCheckBox
    61     Tag = 3
    62     Left = 6
    63     Top = 65
    64     Width = 16
    65     Height = 17
    66     TabOrder = 6
    67     OnClick = chkClick
    68   end
    69   object chkECYes: TCheckBox
    70     Tag = 4
    71     Left = 6
    72     Top = 81
    73     Width = 16
    74     Height = 17
    75     TabOrder = 8
    76     OnClick = chkClick
    77   end
    78   object chkMSTYes: TCheckBox
    79     Tag = 5
    80     Left = 6
    81     Top = 97
    82     Width = 16
    83     Height = 17
    84     TabOrder = 10
    85     OnClick = chkClick
    86   end
    87   object chkMSTNo: TCheckBox
    88     Tag = 15
    89     Left = 26
    90     Top = 97
    91     Width = 160
    92     Height = 17
    93     Caption = 'MST'
    94     TabOrder = 11
    95     OnClick = chkClick
    96   end
    97   object chkECNo: TCheckBox
    98     Tag = 14
    99     Left = 26
    100     Top = 81
    101     Width = 160
    102     Height = 17
    103     Caption = 'Environmental Contaminants'
    104     TabOrder = 9
    105     OnClick = chkClick
    106   end
    107   object chkIRNo: TCheckBox
    108     Tag = 13
    109     Left = 26
    110     Top = 65
    111     Width = 160
    112     Height = 17
    113     Caption = 'Ionizing Radiation Exposure'
    114     TabOrder = 7
    115     OnClick = chkClick
    116   end
    117   object chkAONo: TCheckBox
    118     Tag = 12
    119     Left = 26
    120     Top = 49
    121     Width = 160
    122     Height = 17
    123     Caption = 'Agent Orange Exposure'
    124     TabOrder = 5
    125     OnClick = chkClick
    126   end
    127   object chkSCNo: TCheckBox
    128     Tag = 11
    129     Left = 26
    130     Top = 17
    131     Width = 160
    132     Height = 17
    133     Caption = 'Service Connected Condition'
    134     TabOrder = 1
    135     OnClick = chkClick
    136   end
    137   object chkHNCYes: TCheckBox
    138     Tag = 6
    139     Left = 6
    140     Top = 113
    141     Width = 16
    142     Height = 17
    143     TabOrder = 12
    144     OnClick = chkClick
    145   end
    146   object chkHNCNo: TCheckBox
    147     Tag = 16
    148     Left = 26
    149     Top = 113
    150     Width = 160
    151     Height = 17
    152     Caption = 'Head and/or Neck Cancer'
    153     TabOrder = 13
    154     OnClick = chkClick
    155   end
    156   object chkCVYes: TCheckBox
    157     Tag = 7
    158     Left = 6
    159     Top = 33
    160     Width = 16
    161     Height = 17
    162     TabOrder = 2
    163     OnClick = chkClick
    164   end
    165   object chkCVNo: TCheckBox
    166     Tag = 17
    167     Left = 26
    168     Top = 33
    169     Width = 160
    170     Height = 17
    171     Caption = 'Combat Vet (Combat Related)'
    172     TabOrder = 3
    173     OnClick = chkClick
     15    object chkSCYes: TCheckBox
     16      Tag = 1
     17      Left = 7
     18      Top = 33
     19      Width = 14
     20      Height = 17
     21      Caption = 'Service Connected Condition     Yes'
     22      TabOrder = 0
     23      OnClick = chkClick
     24    end
     25    object chkAOYes: TCheckBox
     26      Tag = 2
     27      Left = 7
     28      Top = 65
     29      Width = 14
     30      Height = 17
     31      Caption = 'Agent Orange Exposure     Yes'
     32      TabOrder = 4
     33      OnClick = chkClick
     34    end
     35    object chkIRYes: TCheckBox
     36      Tag = 3
     37      Left = 7
     38      Top = 81
     39      Width = 14
     40      Height = 17
     41      Caption = 'Ionizing Radiation Exposure     Yes'
     42      TabOrder = 6
     43      OnClick = chkClick
     44    end
     45    object chkECYes: TCheckBox
     46      Tag = 4
     47      Left = 7
     48      Top = 97
     49      Width = 14
     50      Height = 17
     51      Caption = 'Southwest Asia Conditions     Yes'
     52      TabOrder = 8
     53      OnClick = chkClick
     54    end
     55    object chkMSTYes: TCheckBox
     56      Tag = 5
     57      Left = 7
     58      Top = 129
     59      Width = 14
     60      Height = 17
     61      Caption = 'MST     Yes'
     62      TabOrder = 12
     63      OnClick = chkClick
     64    end
     65    object chkMSTNo: TCheckBox
     66      Tag = 15
     67      Left = 27
     68      Top = 129
     69      Width = 40
     70      Height = 17
     71      Caption = 'MST     No'
     72      TabOrder = 13
     73      OnClick = chkClick
     74    end
     75    object chkECNo: TCheckBox
     76      Tag = 14
     77      Left = 27
     78      Top = 97
     79      Width = 148
     80      Height = 17
     81      Caption = 'Southwest Asia Conditions     No'
     82      TabOrder = 9
     83      OnClick = chkClick
     84    end
     85    object chkIRNo: TCheckBox
     86      Tag = 13
     87      Left = 27
     88      Top = 81
     89      Width = 154
     90      Height = 17
     91      Caption = 'Ionizing Radiation Exposure    No'
     92      TabOrder = 7
     93      OnClick = chkClick
     94    end
     95    object chkAONo: TCheckBox
     96      Tag = 12
     97      Left = 27
     98      Top = 65
     99      Width = 136
     100      Height = 17
     101      Caption = 'Agent Orange Exposure    No'
     102      TabOrder = 5
     103      OnClick = chkClick
     104    end
     105    object chkSCNo: TCheckBox
     106      Tag = 11
     107      Left = 27
     108      Top = 33
     109      Width = 158
     110      Height = 17
     111      Caption = 'Service Connected Condition    No'
     112      TabOrder = 1
     113      OnClick = chkClick
     114    end
     115    object chkHNCYes: TCheckBox
     116      Tag = 6
     117      Left = 7
     118      Top = 145
     119      Width = 14
     120      Height = 17
     121      Caption = 'Head and/or Neck Cancer    Yes'
     122      TabOrder = 14
     123      OnClick = chkClick
     124    end
     125    object chkHNCNo: TCheckBox
     126      Tag = 16
     127      Left = 27
     128      Top = 145
     129      Width = 144
     130      Height = 17
     131      Caption = 'Head and/or Neck Cancer    No'
     132      TabOrder = 15
     133      OnClick = chkClick
     134    end
     135    object chkCVYes: TCheckBox
     136      Tag = 7
     137      Left = 7
     138      Top = 49
     139      Width = 14
     140      Height = 17
     141      Caption = 'Combat Vet (Combat Related)     Yes'
     142      TabOrder = 2
     143      OnClick = chkClick
     144    end
     145    object chkCVNo: TCheckBox
     146      Tag = 17
     147      Left = 27
     148      Top = 49
     149      Width = 165
     150      Height = 17
     151      Caption = 'Combat Vet (Combat Related)    No'
     152      TabOrder = 3
     153      OnClick = chkClick
     154    end
     155    object chkSHDYes: TCheckBox
     156      Tag = 8
     157      Left = 7
     158      Top = 112
     159      Width = 14
     160      Height = 17
     161      Caption = 'Shipboard Hazard and Defense     Yes'
     162      TabOrder = 10
     163      OnClick = chkClick
     164    end
     165    object chkSHDNo: TCheckBox
     166      Tag = 18
     167      Left = 27
     168      Top = 112
     169      Width = 168
     170      Height = 17
     171      Caption = 'Shipboard Hazard and Defense     No'
     172      TabOrder = 11
     173      OnClick = chkClick
     174    end
     175    object lblSCNo: TStaticText
     176      Left = 27
     177      Top = 16
     178      Width = 18
     179      Height = 13
     180      AutoSize = False
     181      Caption = 'No'
     182      TabOrder = 17
     183    end
     184    object lblSCYes: TStaticText
     185      Left = 4
     186      Top = 16
     187      Width = 22
     188      Height = 13
     189      AutoSize = False
     190      Caption = 'Yes'
     191      TabOrder = 16
     192    end
    174193  end
    175194end
  • cprs/trunk/CPRS-Chart/Encounter/mVisitRelated.pas

    r456 r829  
    99type
    1010  TfraVisitRelated = class(TFrame)
    11     lblSCYes: TStaticText;
    12     lblSCNo: TStaticText;
    13     lblSCSelect: TStaticText;
    14     bvlSCFrame: TBevel;
     11    gbVisitRelatedTo: TGroupBox;
    1512    chkSCYes: TCheckBox;
    1613    chkAOYes: TCheckBox;
     
    2724    chkCVYes: TCheckBox;
    2825    chkCVNo: TCheckBox;
     26    chkSHDYes: TCheckBox;
     27    chkSHDNo: TCheckBox;
     28    lblSCNo: TStaticText;
     29    lblSCYes: TStaticText;
    2930    procedure chkClick(Sender: TObject);
    3031  private
     
    3334    procedure SetCheckState(CheckYes, CheckNo: TCheckBox; CheckState: Integer);
    3435    function GetCheckState(CheckYes, CheckNo: TCheckBox): Integer;
     36
    3537  public
    3638    constructor Create(AOwner: TComponent); override;
    3739    procedure GetRelated(PCEData: TPCEData); overload;
    3840    procedure GetRelated(var ASCRelated, AAORelated, AIRRelated,
    39                                 AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer); overload;
     41                                AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload;
    4042    procedure InitAllow(SCCond: TSCConditions);
    4143    procedure InitRelated(PCEData: TPCEData); overload;
    4244    procedure InitRelated(const ASCRelated, AAORelated, AIRRelated,
    43                                 AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer); overload;
     45                                AECRelated, AMSTRelated, AHNCRelated, ACVRelated,ASHDRelated: integer); overload;
     46
    4447  end;
    4548
    4649implementation
     50
     51uses VA508AccessibilityRouter;
    4752
    4853{$R *.DFM}
     
    5661  TAG_HNCYES     = 6;
    5762  TAG_CVYES      = 7;
     63  TAG_SHDYES     = 8;
    5864  TAG_SCNO       = 11;
    5965  TAG_AONO       = 12;
     
    6369  TAG_HNCNO      = 16;
    6470  TAG_CVNO       = 17;
     71  TAG_SHDNO      = 18;
     72
    6573
    6674procedure TfraVisitRelated.chkClick(Sender: TObject);
     
    7482  inherited;
    7583  if Sender is TCheckBox then with TCheckBox(Sender) do case Tag of
    76     TAG_SCYES:  if Checked then chkSCNo.Checked   := False;
    77     TAG_AOYES:  if Checked then chkAONo.Checked   := False;
    78     TAG_IRYES:  if Checked then chkIRNo.Checked   := False;
    79     TAG_ECYES:  if Checked then chkECNo.Checked   := False;
    80     TAG_MSTYES: if Checked then chkMSTNo.Checked  := False;
    81     TAG_HNCYES: if Checked then chkHNCNo.Checked  := False;
    82     TAG_CVYES:  if Checked then chkCVNo.Checked   := False;
    83     TAG_SCNO:   if Checked then chkSCYes.Checked  := False;
    84     TAG_AONO:   if Checked then chkAOYes.Checked  := False;
    85     TAG_IRNO:   if Checked then chkIRYes.Checked  := False;
    86     TAG_ECNO:   if Checked then chkECYes.Checked  := False;
    87     TAG_MSTNO:  if Checked then chkMSTYes.Checked := False;
    88     TAG_HNCNO:  if Checked then chkHNCYes.Checked := False;
    89     TAG_CVNO:   if Checked then chkCVYes.Checked  := False;
     84    TAG_SCYES:   if Checked then chkSCNo.Checked    := False;
     85    TAG_AOYES:   if Checked then chkAONo.Checked    := False;
     86    TAG_IRYES:   if Checked then chkIRNo.Checked    := False;
     87    TAG_ECYES:   if Checked then chkECNo.Checked    := False;
     88    TAG_MSTYES:  if Checked then chkMSTNo.Checked   := False;
     89    TAG_HNCYES:  if Checked then chkHNCNo.Checked   := False;
     90    TAG_CVYES:   if Checked then chkCVNo.Checked    := False;
     91    TAG_SHDYES:  if Checked then chkSHDNo.Checked   := False;
     92    TAG_SCNO:    if Checked then chkSCYes.Checked   := False;
     93    TAG_AONO:    if Checked then chkAOYes.Checked   := False;
     94    TAG_IRNO:    if Checked then chkIRYes.Checked   := False;
     95    TAG_ECNO:    if Checked then chkECYes.Checked   := False;
     96    TAG_MSTNO:   if Checked then chkMSTYes.Checked  := False;
     97    TAG_HNCNO:   if Checked then chkHNCYes.Checked  := False;
     98    TAG_CVNO:    if Checked then chkCVYes.Checked   := False;
     99    TAG_SHDNO:   if Checked then chkSHDYes.Checked := False;
    90100  end;
    91101  if chkSCYes.Checked then
     
    94104    DisableCheck(chkIRYes);
    95105    DisableCheck(chkECYes);
     106    DisableCheck(chkSHDYes);
    96107//    DisableCheck(chkMSTYes);
    97108    DisableCheck(chkAONo);
    98109    DisableCheck(chkIRNo);
    99110    DisableCheck(chkECNo);
     111    DisableCheck(chkSHDNo);
    100112//    DisableCheck(chkMSTNo);
    101113  end else
     
    105117    SetCheckEnable(chkIRYes,  chkIRNo,  FSCCond.IRAllow);
    106118    SetCheckEnable(chkECYes,  chkECNo,  FSCCond.ECAllow);
     119    SetCheckEnable(chkSHDYEs, chkSHDNo, FSCCond.SHDAllow);
    107120  end;
    108121  SetCheckEnable(chkMSTYes, chkMSTNo, FSCCond.MSTAllow);
    109122  SetCheckEnable(chkHNCYes, chkHNCNo, FSCCond.HNCAllow);
    110   SetCheckEnable(chkCVYes, chkCVNo, FSCCond.CVAllow);
    111   if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked then //or chkMSTYes.Checked then
    112   begin
    113     chkSCYes.Checked := False;
    114     chkSCNo.Checked := True;
     123  SetCheckEnable(chkCVYes, chkCVNo,   FSCCond.CVAllow);
     124
     125  if chkAOYes.Checked or chkIRYes.Checked or chkECYes.Checked or chkSHDYes.Checked then //or chkMSTYes.Checked then
     126  begin
     127    if FSCCond.SCAllow then
     128    begin
     129       chkSCYes.Checked := False;
     130       chkSCNo.Checked := True;
     131    end;
    115132  end;
    116133end;
     
    118135constructor TfraVisitRelated.Create(AOwner: TComponent);
    119136begin
    120   inherited;
    121 
     137  inherited Create(AOwner);
     138  TabStop := FALSE;
    122139  lblSCYes.Height := 13;
    123140  lblSCNo.Height := 13;
    124 //  chkHNCYes.Visible := HNCOK;
    125 //  chkHNCNo.Visible := HNCOK;
    126 //  if not HNCOK then
    127 //  begin
    128 //    height := height - chkHNCYes.height + 1;
    129 //    bvlSCFrame.height := bvlSCFrame.height - chkHNCYes.height + 1;
    130 //  end;
    131141end;
    132142
     
    147157  PCEData.HNCRelated := GetCheckState(chkHNCYes, chkHNCNo);
    148158  PCEData.CVRelated  := GetCheckState(chkCVYes,  chkCVNo);
     159  PCEData.SHADRelated := GetCheckState(chkSHDYes, chkSHDNo);
    149160end;
    150161
    151162procedure TfraVisitRelated.GetRelated(var ASCRelated, AAORelated,
    152   AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer);
     163  AIRRelated, AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer);
    153164begin
    154165  ASCRelated  := GetCheckState(chkSCYes,  chkSCNo);
     
    159170  AHNCRelated := GetCheckState(chkHNCYes, chkHNCNo);
    160171  ACVRelated  := GetCheckState(chkCVYes,  chkCVNo);
     172  ASHDRelated := GetCheckState(chkSHDYes, chkSHDNo);
    161173end;
    162174
     
    173185    SetCheckEnable(chkHNCYes, chkHNCNo, HNCAllow);
    174186    SetCheckEnable(chkCVYes,  chkCVNo,  CVAllow);
     187    SetCheckEnable(chkSHDYes, chkSHDNo, SHDAllow);
    175188  end;
    176189end;
     
    185198  SetCheckState(chkHNCYes, chkHNCNo, PCEData.HNCRelated);
    186199  SetCheckState(chkCVYes,  chkCVNo,  PCEData.CVRelated);
     200  SetCheckState(chkSHDYes, chkSHDNo, PCEData.SHADRelated);
     201   //HDS00015356: GWOT Default, if Related no specified default to "Yes"
     202  // -1=Null, 0=No, 1 = Yes
     203  if FSCCond.CVAllow then
     204  begin
     205    if PCEData.CVRelated = SCC_NA then
     206       chkCVYes.Checked := True;
     207  end;
    187208end;
    188209
    189210procedure TfraVisitRelated.InitRelated(const ASCRelated, AAORelated, AIRRelated,
    190   AECRelated, AMSTRelated, AHNCRelated, ACVRelated: integer);
     211  AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHDRelated: integer);
    191212begin
    192213  SetCheckState(chkSCYes,  chkSCNo,  ASCRelated);
     
    197218  SetCheckState(chkHNCYes, chkHNCNo, AHNCRelated);
    198219  SetCheckState(chkCVYes,  chkCVNo,  ACVRelated);
     220  SetCheckState(chkSHDYes, chkSHDNo, ASHDRelated);
     221   //HDS00015356: GWOT Default, if Related no specified default to "Yes"
     222   // -1=Null, 0=No, 1 = Yes
     223  if FSCCond.CVAllow then
     224  begin
     225    if ACVRelated = SCC_NA then
     226       chkCVYes.Checked := True;
     227  end;
    199228end;
    200229
     
    226255end;
    227256
     257
     258initialization
     259  SpecifyFormIsNotADialog(TfraVisitRelated);
     260
    228261end.
  • cprs/trunk/CPRS-Chart/Encounter/rPCE.pas

    r456 r829  
    4242    HNCAllow: Boolean;        // prompt for Head or Neck Cancer
    4343    HNCDflt:  Boolean;        // default if prompting Head or Neck Cancer
    44     CVAllow: Boolean;        // prompt for Combat Veteran Related
    45     CVDflt:  Boolean;        // default if prompting Comabt Veteran
     44    CVAllow:  Boolean;        // prompt for Combat Veteran Related
     45    CVDflt:   Boolean;        // default if prompting Comabt Veteran
     46    SHDAllow: Boolean;        // prompt for Shipboard Hazard and Defense
     47    SHDDflt:  Boolean;        // default if prompting Shipboard Hazard and Defense
    4648  end;
    4749
     
    149151                                             ANoteIEN: integer): string;
    150152function IsUserAProvider(AUser: Int64; ADate: TFMDateTime): boolean;
     153function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean;
    151154function IsCancelOrNoShow(ANote: integer): boolean;
    152155function IsNonCountClinic(ALocation: integer): boolean;
     
    242245  end;
    243246  CallV('ORWPCE LEX', [x, CodeSys, ADate]);
    244   Dest.Assign(RPCBrokerV.Results);
     247  FastAssign(RPCBrokerV.Results, Dest);
    245248end;
    246249
     
    405408    uVTypeLastDate := EncDt;
    406409  end;
    407   Dest.Assign(uVTypeForLoc);
     410  FastAssign(uVTypeForLoc, Dest);
    408411end;
    409412
     
    10721075    CVAllow  := Piece(Piece(x, ';', 7), U, 1) = '1';
    10731076    CVDflt   := Piece(Piece(x, ';', 7), U, 2) = '1';
     1077    SHDAllow := Piece(Piece(x, ';', 8), U, 1) = '1';
     1078    SHDDflt  := Piece(Piece(x, ';', 8), U, 2) = '1';
    10741079  end;
    10751080end;
     
    10791084begin
    10801085  CallV('ORWPCE SCDIS', [Patient.DFN]);
    1081   Dest.Assign(RPCBrokerV.Results);
     1086  FastAssign(RPCBrokerV.Results, Dest);
    10821087end;
    10831088
     
    10881093  else
    10891094    CallV('ORWPCE PCE4NOTE', [ANoteIEN]);
    1090   Dest.Assign(RPCBrokerV.Results);
     1095  FastAssign(RPCBrokerV.Results, Dest);
    10911096end;
    10921097
     
    11551160        end;
    11561161      end;
    1157       uHasCPT.AddStrings(RPCBrokerV.Results);
     1162      FastAddStrings(RPCBrokerV.Results, uHasCPT);
    11581163    end;
    11591164  end;
     
    12191224    begin
    12201225      if idx = 0 then
    1221         tCallV(TmpSL,RPC,[nil])
     1226      begin
     1227        if (typ = 1) or (typ = 2) then
     1228          tCallV(TmpSL,RPC,[uEncPCEData.VisitDateTime])
     1229        else
     1230          tCallV(TmpSL,RPC,[nil]);
     1231      end
    12221232      else
    12231233        tCallV(TmpSL,RPC,[idx]);
     
    12441254      end;
    12451255    end;
    1246     Dest.Assign(TmpSL);
     1256    FastAssign(TmpSL, Dest);
    12471257  finally
    12481258    TmpSL.Free;
     
    14541464end;
    14551465
     1466function IsUserAUSRProvider(AUser: Int64; ADate: TFMDateTime): boolean;
     1467begin
     1468  Result := (sCallV('TIU IS USER A USR PROVIDER', [AUser, ADate]) = '1');
     1469end;
     1470
    14561471//function HNCOK: boolean;
    14571472//begin
  • cprs/trunk/CPRS-Chart/Encounter/uPCE.pas

    r456 r829  
    11unit uPCE;
    2 
     2                                                                       
    33interface
    44
     
    220220    FHNCRelated:   Integer;                        //
    221221    FCVRelated:    Integer;                        //
     222    FSHADRelated:   Integer;                        //
    222223    FVisitType:    TPCEProc;                       //
    223224    FProviders:    TPCEProviderList;
     
    248249    procedure SetHNCRelated(Value: Integer);
    249250    procedure SetCVRelated(Value: Integer);
     251    procedure SetSHADRelated(Value: Integer);
    250252    procedure SetEncUseCurr(Value: Boolean);
    251253    function GetHasData: Boolean;
     
    286288    function StrExams: string;
    287289    function StrVisitType(const ASCRelated, AAORelated, AIRRelated, AECRelated,
    288                                 AMSTRelated, AHNCRelated, ACVRelated: Integer): string; overload;
     290                                AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string; overload;
    289291    function StrVisitType: string; overload;
    290292    function StandAlone: boolean;
     
    311313    property HNCRelated:   Integer  read FHNCRelated  write SetHNCRelated;
    312314    property CVRelated:    Integer  read FCVRelated  write SetCVRelated;
     315    property SHADRelated:   Integer  read FSHADRelated write SetSHADRelated;
    313316    property VisitType:    TPCEProc read FVisitType   write SetVisitType;
    314317    property VisitString:  string   read GetVisitString;
     
    596599      begin
    597600        Result := PCESetsOfCodes.Add(Hdr);
    598         PCESetsOfCodes.AddStrings(TempSL);
     601        FastAddStrings(TempSL, PCESetsOfCodes);
    599602      end;
    600603    finally
     
    618621      HistLocations.Insert(0,'0');
    619622    end;
    620     List.AddStrings(HistLocations);
     623    FastAddStrings(HistLocations, List);
    621624  end
    622625  else
     
    754757        begin
    755758          idx := PCESetsOfCodes.Add(Hdr);
    756           PCESetsOfCodes.AddStrings(TempSL);
     759          FastAddStrings(TempSL, PCESetsOfCodes);
    757760        end;
    758761      finally
     
    16391642  FHNCRelated  := SCC_NA;
    16401643  FCVRelated   := SCC_NA;
     1644  FSHADRelated := SCC_NA;
    16411645  FSCChanged   := False;
    16421646end;
     
    16951699  FHNCRelated := SCC_NA;
    16961700  FCVRelated  := SCC_NA;
     1701  FSHADRelated := SCC_NA;
    16971702
    16981703  ClearList(FDiagnoses);
     
    20752080      if(FileCat = 'E') and (FHistoricalLocation <> '') then
    20762081        Add('VST^OL^' + FHistoricalLocation);     // Outside Location
    2077 
    2078       //Add('PRV^' + IntToStr(FEncProvider));       // Encounter Provider
    2079       //Add('PRV^' + IntToStr(UProvider.IEN));      // Encounter Provider
    2080       {with FProviders do for i := 0 to Count - 1 do with TPCEProvider(Items[i]) do
    2081         begin
    2082           PCEList.Add(DelimitedStr);
    2083         end;}
    2084       PCEList.AddStrings(FProviders);
    2085      
     2082      FastAddStrings(FProviders, PCEList);
     2083
    20862084      if FSCChanged then
    20872085      begin
    2088         if FSCRelated <> SCC_NA then  Add('VST^SC^'  + IntToStr(FSCRelated));
    2089         if FAORelated <> SCC_NA then  Add('VST^AO^'  + IntToStr(FAORelated));
    2090         if FIRRelated <> SCC_NA then  Add('VST^IR^'  + IntToStr(FIRRelated));
    2091         if FECRelated <> SCC_NA then  Add('VST^EC^'  + IntToStr(FECRelated));
    2092         if FMSTRelated <> SCC_NA then Add('VST^MST^' + IntToStr(FMSTRelated));
    2093 //        if HNCOK and (FHNCRelated <> SCC_NA) then
    2094         if FHNCRelated <> SCC_NA then Add('VST^HNC^' + IntToStr(FHNCRelated));
    2095         if FCVRelated <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));                                     
     2086        if FSCRelated  <> SCC_NA then  Add('VST^SC^'  + IntToStr(FSCRelated));
     2087        if FAORelated  <> SCC_NA then  Add('VST^AO^'  + IntToStr(FAORelated));
     2088        if FIRRelated  <> SCC_NA then  Add('VST^IR^'  + IntToStr(FIRRelated));
     2089        if FECRelated  <> SCC_NA then  Add('VST^EC^'  + IntToStr(FECRelated));
     2090        if FMSTRelated <> SCC_NA then  Add('VST^MST^' + IntToStr(FMSTRelated));
     2091        if FHNCRelated  <> SCC_NA then Add('VST^HNC^'+ IntToStr(FHNCRelated));
     2092        if FCVRelated   <> SCC_NA then Add('VST^CV^' + IntToStr(FCVRelated));
     2093        if FSHADRelated <> SCC_NA then Add('VST^SHD^'+ IntToStr(FSHADRelated));
    20962094      end;
    20972095     with FDiagnoses  do for i := 0 to Count - 1 do with TPCEDiag(Items[i]) do
     
    22662264begin
    22672265  Result := -1;
    2268 //  with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
    22692266  with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) and MatchProvider(AnItem)then
    2270 //  with AList do for i := 0 to Count - 1 do with TPCEItem(Items[i]) do if Match(AnItem) then
    22712267  begin
    22722268    Result := i;
     
    22892285    begin
    22902286      PostItem := TPCEItem(Objects[j]);
    2291 //      if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
    22922287      if (PreItem.Match(PostItem) and (PreItem.MatchProvider(PostItem))) then MatchFound := True;
    2293 //      if (PreItem.Match(PostItem)) then MatchFound := True;
    22942288    end;
    22952289    if not MatchFound then
     
    24232417      if CurImmunization.Reaction = '' then CurImmunization.Reaction := NoPCEValue;
    24242418
    2425 //      if (SrcImmunization.Provider <> CurImmunization.Provider) or
    24262419      if(SrcImmunization.Series <> CurImmunization.Series) or
    24272420        (SrcImmunization.Reaction <> CurImmunization.Reaction) or
     
    24302423        (CurImmunization.Comment <> SrcImmunization.Comment)then 
    24312424      begin
    2432 //        CurImmunization.Provider        := SrcImmunization.Provider;
    24332425        CurImmunization.Series          := SrcImmunization.Series;
    24342426        CurImmunization.Reaction        := SrcImmunization.Reaction;
     
    24652457      if CurSkinTest.Results = '' then CurSkinTest.Results := NoPCEValue;
    24662458      if SrcSkinTest.Results = '' then SrcSkinTest.Results := NoPCEValue;
    2467 //      if (SrcSkinTest.Provider <> CurSkinTest.Provider) or
     2459
    24682460      if(SrcSkinTest.Results <> CurSkinTest.Results) or
    24692461        (SrcSkinTest.Reading <> CurSkinTest.Reading) or
    2470         (CurSkinTest.Comment <> SrcSkinTest.Comment) then 
    2471       begin
    2472 //        CurSkinTest.Provider := SrcSkinTest.Provider;
     2462        (CurSkinTest.Comment <> SrcSkinTest.Comment) then
     2463      begin
     2464
    24732465        CurSkinTest.Results := SrcSkinTest.Results;
    24742466        CurSkinTest.Reading := SrcSkinTest.Reading;
    2475         CurSkinTest.Comment := SrcSkinTest.Comment; 
     2467        CurSkinTest.Comment := SrcSkinTest.Comment;
    24762468        CurSkinTest.FSend := True;
    24772469      end;
     
    25022494      if CurPatientEd.level = '' then CurPatientEd.level := NoPCEValue;
    25032495      if SrcPatientEd.level = '' then SrcPatientEd.level := NoPCEValue;
    2504 //      if (SrcPatientEd.Provider <> CurPatientEd.Provider) or
    25052496      if(SrcPatientEd.Level <> CurPatientEd.Level) or
    25062497        (CurPatientEd.Comment <> SrcPatientEd.Comment) then
    25072498      begin
    2508 //        CurPatientEd.Provider := SrcPatientEd.Provider;
    25092499        CurPatientEd.Level  := SrcPatientEd.Level;
    25102500        CurPatientEd.Comment := SrcPatientEd.Comment; 
     
    25392529      if CurHealthFactor.level = '' then CurHealthFactor.level := NoPCEValue;
    25402530      if SrcHealthFactor.level = '' then SrcHealthFactor.level := NoPCEValue;
    2541 //      if (SrcHealthFactor.Provider <> CurHealthFactor.Provider) or
    25422531      if(SrcHealthFactor.Level <> CurHealthFactor.Level) or
    25432532        (CurHealthFactor.Comment <> SrcHealthFactor.Comment) then 
    25442533      begin
    2545 //        CurHealthFactor.Provider := SrcHealthFactor.Provider;
    25462534        CurHealthFactor.Level  := SrcHealthFactor.Level;
    25472535        CurHealthFactor.Comment := SrcHealthFactor.Comment; 
     
    25782566      if CurExam.Results = '' then CurExam.Results := NoPCEValue;
    25792567      if SrcExam.Results = '' then SrcExam.Results := NoPCEValue;
    2580 //      if (SrcExam.Provider <> CurExam.Provider) or
    25812568      if(SrcExam.Results <> CurExam.Results) or
    25822569        (CurExam.Comment <> SrcExam.Comment) then 
    25832570      begin
    2584 //        CurExam.Provider := SrcExam.Provider;
    25852571        CurExam.Results  := SrcExam.Results;
    25862572        CurExam.Comment := SrcExam.Comment; 
     
    26832669end;
    26842670
     2671procedure TPCEData.SetSHADRelated(Value: Integer);
     2672begin
     2673  if (Value <> FSHADRelated) then
     2674  begin
     2675    FSHADRelated := Value;
     2676    FSCChanged   := True;
     2677  end;
     2678end;
     2679
    26852680procedure TPCEData.SetEncUseCurr(Value: Boolean);
    26862681begin
     
    26942689    FStandAlone   := Encounter.StandAlone;
    26952690    FStandAloneLoaded := TRUE;
    2696     //FCPTRequired  := Encounter.StandAlone; 
    26972691    FEncInpatient := Encounter.Inpatient;
    2698     //if FEncInpatient then FCPTRequired := False;   
    2699     //SetDefaultProvider(FProviders, FEncLocation, FNoteIEN, PersonClassDate);
     2692
    27002693  end else
    27012694  begin
     
    27062699    FProviders.PrimaryIdx := -1;
    27072700    FEncSvcCat    := 'A';
    2708     //FCPTRequired  := False;   
    27092701    FEncInpatient := False;
    27102702  end;
    27112703  //
    27122704  SetRPCEncLocation(FEncLocation);
    2713 //  SetRPCEncDateTime(FEncDateTime);
    27142705end;
    27152706
     
    27982789
    27992790function TPCEData.StrVisitType(const ASCRelated, AAORelated, AIRRelated,
    2800   AECRelated, AMSTRelated, AHNCRelated, ACVRelated: Integer): string;
     2791  AECRelated, AMSTRelated, AHNCRelated, ACVRelated, ASHADRelated: Integer): string;
    28012792{ returns as a string the type of encounter (according to CPT) & related contitions treated }
    28022793
     
    28322823    end;
    28332824  Result := Trim(Result + StrVisitType(FSCRelated, FAORelated, FIRRelated,
    2834                                        FECRelated, FMSTRelated, FHNCRelated, FCVRelated));
     2825                                       FECRelated, FMSTRelated, FHNCRelated, FCVRelated, FSHADRelated));
    28352826end;
    28362827
     
    29012892  Dest.FHNCRelated   := FHNCRelated;
    29022893  Dest.FCVRelated    := FCVRelated;
     2894  Dest.FSHADRelated  := FSHADRelated;
    29032895  FVisitType.CopyProc(Dest.VisitType);
    29042896  Dest.FProviders.Assign(FProviders);
     
    29282920  if(not FutureEncounter(Self)) then
    29292921  begin
    2930 //    if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone) or CPTRequiredForNote(FNoteIEN)) then
    29312922    if(PromptForWorkload(FNoteIEN, FNoteTitle, FEncSvcCat, StandAlone)) then
    29322923    begin
     
    29592950//        if HNCOK and (EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
    29602951        if(EC.HNCAllow and (HNCRelated = SCC_NA)) then NeedSC := TRUE;
    2961         if(EC.CVAllow and (CVRelated = SCC_NA)) then NeedSC := TRUE;
     2952        if(EC.CVAllow and (CVRelated = SCC_NA) and (SHADRelated = SCC_NA)) then NeedSC := TRUE;
    29622953        if(NeedSC) then
    29632954          Include(Result, ndSC);
     
    32743265  if(Result) then Result := (FHNCRelated = SCC_NA);
    32753266  if(Result) then Result := (FCVRelated = SCC_NA);
     3267  if(Result) then Result := (FSHADRelated = SCC_NA);
    32763268  if(Result) then Result := (FDiagnoses.Count = 0);
    32773269  if(Result) then Result := (FProcedures.Count = 0);
  • cprs/trunk/CPRS-Chart/Orders/fOCAccept.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOCSession.dfm

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls;
     7  fODBase, StdCtrls, ComCtrls, ExtCtrls, ORFn, ORCtrls,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fODBBank.dfm

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    7   Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders;
     7  Dialogs, ExtCtrls, StdCtrls, ORCtrls, fAutoSz, uOrders, ORFn, ORDtTm, rOrders,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fODChild.dfm

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

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

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

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

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

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

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, ORCtrls, StdCtrls, ORFn;
     7  ExtCtrls, ORCtrls, StdCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODLabOthCollSamp = class(TForm)
     10  TfrmODLabOthCollSamp = class(TfrmBase508Form)
    1111    pnlBase: TORAutoPanel;
    1212    cboOtherCollSamp: TORComboBox;
  • cprs/trunk/CPRS-Chart/Orders/fODLabOthSpec.dfm

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

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

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fAutoSz, StdCtrls, Grids, Buttons, ExtCtrls, ORCtrls, Menus, ORFn, fODBase, uConst,
    8   ComCtrls;
     8  ComCtrls, VA508AccessibilityManager;
    99
    1010type
  • cprs/trunk/CPRS-Chart/Orders/fODMedFA.dfm

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

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

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

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

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

    r456 r829  
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    99  fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore,
    10   Menus;
     10  Menus, VA508AccessibilityManager;
    1111
    1212type
  • cprs/trunk/CPRS-Chart/Orders/fODMedNVA.dfm

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

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

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

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

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

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask,
    8   Menus, Buttons;
     8  Menus, Buttons, VA508AccessibilityManager;
    99
    1010type
  • cprs/trunk/CPRS-Chart/Orders/fODMeds.dfm

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ExtCtrls, StdCtrls, ComCtrls;
     7  ExtCtrls, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmODMessage = class(TForm)
     10  TfrmODMessage = class(TfrmBase508Form)
    1111    memMessage: TRichEdit;
    1212    imgMessage: TImage;
  • cprs/trunk/CPRS-Chart/Orders/fODMisc.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst;
     7  fODBase, StdCtrls, ORCtrls, ORDtTm, ComCtrls, ExtCtrls, ORFn, uConst,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fODRad.dfm

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

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

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

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

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls;
     7  fAutoSz, Buttons, ExtCtrls, StdCtrls, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fODText.dfm

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm;
     7  fODBase, ComCtrls, ExtCtrls, StdCtrls, ORCtrls, ORDtTm,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fOMAction.dfm

    r456 r829  
    11inherited frmOMAction: TfrmOMAction
    22  Caption = 'frmOMAction'
     3  ExplicitWidth = 320
     4  ExplicitHeight = 240
    35  PixelsPerInch = 96
    46  TextHeight = 13
     7  inherited amgrMain: TVA508AccessibilityManager
     8    Data = (
     9      (
     10        'Component = frmOMAction'
     11        'Status = stsDefault'))
     12  end
    513end
  • cprs/trunk/CPRS-Chart/Orders/fOMAction.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, rOrders;
     7  fAutoSz, rOrders, VA508AccessibilityManager;
    88
    99
  • cprs/trunk/CPRS-Chart/Orders/fOMHTML.dfm

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

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

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrderComment.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrderFlag.dfm

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls;
     7  fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrderVw.dfm

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersCV.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders;
     7  StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersComplete.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersCopy.dfm

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersOnChart.dfm

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersRelease.dfm

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

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

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

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

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

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

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst;
     7  fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
     8  VA508AccessibilityManager;
    89
    910type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersUnhold.dfm

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

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, ORCtrls;
     7  fAutoSz, StdCtrls, ORFn, ORCtrls, VA508AccessibilityManager;
    88
    99type
  • cprs/trunk/CPRS-Chart/Orders/fOrdersVerify.dfm

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

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

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

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

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

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

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

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

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

    r456 r829  
    1313function SubsetOfImagingTypes: TStrings;
    1414function SubsetOfRadSources(SrcType: string): TStrings;
    15 function LocationType(Location: integer): string;
     15function LocationType(Location: integer): string; 
     16function ReasonForStudyCarryOn: Boolean;
    1617
    1718implementation
     
    7374begin
    7475  Result := sCallV('ORWDRA32 LOCTYPE',[Location]);
     76end;   
     77
     78function ReasonForStudyCarryOn: Boolean;
     79begin
     80  Result := sCallV('ORWDXM1 SVRPC',['']) = '1';
    7581end;
    7682
  • cprs/trunk/CPRS-Chart/Orders/rOrders.pas

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

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

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

    r456 r829  
    1 object frmTemplateAutoGen: TfrmTemplateAutoGen
     1inherited frmTemplateAutoGen: TfrmTemplateAutoGen
    22  Left = 361
    33  Top = 230
     
    88  ClientHeight = 213
    99  ClientWidth = 415
    10   Color = clBtnFace
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    16   OldCreateOrder = False
    1710  Position = poScreenCenter
    1811  OnShow = FormShow
    1912  PixelsPerInch = 96
    2013  TextHeight = 13
    21   object lblTop: TMemo
     14  object lblTop: TMemo [0]
    2215    Left = 256
    2316    Top = 8
     
    3528    TabOrder = 5
    3629  end
    37   object lblSelect: TStaticText
     30  object lblSelect: TStaticText [1]
    3831    Left = 0
    3932    Top = 0
     
    4639    TabOrder = 6
    4740  end
    48   object rgSource: TKeyClickRadioGroup
     41  object rgSource: TKeyClickRadioGroup [2]
    4942    Left = 256
    5043    Top = 88
     
    5952    OnClick = rgSourceClick
    6053  end
    61   object cbxObjects: TORComboBox
     54  object cbxObjects: TORComboBox [3]
    6255    Left = 0
    6356    Top = 0
     
    7467    ListItemsOnly = False
    7568    LongList = False
     69    LookupPiece = 0
    7670    MaxLength = 0
    7771    Pieces = '1'
     
    8175    Visible = False
    8276    OnDblClick = cbxObjectsDblClick
     77    CharsNeedMatch = 1
    8378  end
    84   object btnOK: TButton
     79  object btnOK: TButton [4]
    8580    Left = 257
    8681    Top = 190
     
    9287    TabOrder = 3
    9388  end
    94   object btnCancel: TButton
     89  object btnCancel: TButton [5]
    9590    Left = 337
    9691    Top = 190
     
    10297    TabOrder = 4
    10398  end
    104   object cbxTitles: TORComboBox
     99  object cbxTitles: TORComboBox [6]
    105100    Left = 0
    106101    Top = 0
     
    117112    ListItemsOnly = True
    118113    LongList = True
     114    LookupPiece = 0
    119115    MaxLength = 0
    120116    Pieces = '2'
     
    125121    OnDblClick = cbxTitlesDblClick
    126122    OnNeedData = cbxTitlesNeedData
     123    CharsNeedMatch = 1
     124  end
     125  inherited amgrMain: TVA508AccessibilityManager
     126    Data = (
     127      (
     128        'Component = lblTop'
     129        'Status = stsDefault')
     130      (
     131        'Component = lblSelect'
     132        'Status = stsDefault')
     133      (
     134        'Component = rgSource'
     135        'Status = stsDefault')
     136      (
     137        'Component = cbxObjects'
     138        'Status = stsDefault')
     139      (
     140        'Component = btnOK'
     141        'Status = stsDefault')
     142      (
     143        'Component = btnCancel'
     144        'Status = stsDefault')
     145      (
     146        'Component = cbxTitles'
     147        'Status = stsDefault')
     148      (
     149        'Component = frmTemplateAutoGen'
     150        'Status = stsDefault'))
    127151  end
    128152end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateAutoGen.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORCtrls, ExtCtrls, ORFn;
     7  StdCtrls, ORCtrls, ExtCtrls, ORFn, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateAutoGen = class(TForm)
     10  TfrmTemplateAutoGen = class(TfrmBase508Form)
    1111    rgSource: TKeyClickRadioGroup;
    1212    cbxObjects: TORComboBox;
     
    121121          end;
    122122      if DoIt then
    123         cbxObjects.Items.Assign(dmodShared.TIUObjects);
     123        FastAssign(dmodShared.TIUObjects, cbxObjects.Items);
    124124      FObjectsDone := TRUE;
    125125    end;
  • cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.dfm

    r456 r829  
    1 object frmTemplateDialog: TfrmTemplateDialog
     1inherited frmTemplateDialog: TfrmTemplateDialog
    22  Left = 268
    33  Top = 155
    4   Width = 640
    5   Height = 440
    64  BorderIcons = [biSystemMenu, biMaximize]
    75  Caption = 'Text Dialog'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = False
     6  ClientHeight = 413
     7  ClientWidth = 632
    158  Position = poScreenCenter
    169  OnClose = FormClose
     
    1912  OnDestroy = FormDestroy
    2013  OnPaint = FormPaint
     14  OnShow = FormShow
     15  ExplicitWidth = 640
     16  ExplicitHeight = 440
    2117  PixelsPerInch = 96
    2218  TextHeight = 13
    23   object sbMain: TScrollBox
     19  object sbMain: TScrollBox [0]
    2420    Left = 0
    2521    Top = 0
     
    3632    TabOrder = 0
    3733  end
    38   object pnlBottom: TScrollBox
     34  object pnlBottom: TScrollBox [1]
    3935    Left = 0
    4036    Top = 375
     
    10096    end
    10197  end
     98  inherited amgrMain: TVA508AccessibilityManager
     99    Data = (
     100      (
     101        'Component = sbMain'
     102        'Status = stsDefault')
     103      (
     104        'Component = pnlBottom'
     105        'Status = stsDefault')
     106      (
     107        'Component = lblFootnote'
     108        'Status = stsDefault')
     109      (
     110        'Component = btnCancel'
     111        'Status = stsDefault')
     112      (
     113        'Component = btnOK'
     114        'Status = stsDefault')
     115      (
     116        'Component = btnAll'
     117        'Status = stsDefault')
     118      (
     119        'Component = btnNone'
     120        'Status = stsDefault')
     121      (
     122        'Component = btnPreview'
     123        'Status = stsDefault')
     124      (
     125        'Component = frmTemplateDialog'
     126        'Status = stsDefault'))
     127  end
    102128end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates;
     7  StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateDialog = class(TForm)
     11  TfrmTemplateDialog = class(TfrmBase508Form)
    1112    sbMain: TScrollBox;
    1213    pnlBottom: TScrollBox;
     
    2627    procedure btnPreviewClick(Sender: TObject);
    2728    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     29    procedure FormShow(Sender: TObject);
    2830  private
     31    FFirstBuild: boolean;
    2932    SL: TStrings;
    3033    BuildIdx: TStringList;
     
    5760    procedure ParentCBEnter(Sender: TObject);
    5861    procedure ParentCBExit(Sender: TObject);
     62    procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC;
     63    procedure InitScreenReaderSetup;
    5964  public
    6065    property Silent: boolean read FSilent write FSilent ;
     
    7277implementation
    7378
    74 uses dShared, uConst, uTemplateFields, fRptBox, uInit, rMisc;
     79uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents,
     80  VA508AccessibilityRouter, VAUtils;
    7581
    7682{$R *.DFM}
     
    187193  Result := FALSE;
    188194  CancelDlg := FALSE;
     195  SetTemplateDialogCanceled(FALSE);
    189196  frmTemplateDialog := TfrmTemplateDialog.Create(Application);
    190197  try
     
    272279  end;
    273280
    274   if not Result then
     281  if Result then
     282    SetTemplateDialogCanceled(TRUE)
     283  else
     284  begin
     285    SetTemplateDialogCanceled(FALSE);
    275286    CheckBoilerplate4Fields(SL, CaptionText, PreviewMode);
    276 
     287  end;
     288 
    277289end;
    278290
     
    289301      SL.Clear;
    290302  end;
     303  StripScreenReaderCodes(SL);
    291304end;
    292305
     
    380393end;
    381394
     395procedure TfrmTemplateDialog.InitScreenReaderSetup;
     396var
     397  ctrl: TWinControl;
     398  list: TList;
     399begin
     400  if ScreenReaderSystemActive then
     401  begin
     402    list := TList.Create;
     403    try
     404      sbMain.GetTabOrderList(list);
     405      if list.Count > 0 then
     406      begin
     407        ctrl := TWinControl(list[0]);
     408        PostMessage(Handle, UM_MISC, WParam(ctrl), 0);
     409      end;
     410    finally
     411      list.free;
     412    end;
     413  end;
     414end;
     415
    382416function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean;
    383417begin
     
    398432  KillCtrl, doHint, dsp, noTextParent: boolean;
    399433  Entry: TTemplateDialogEntry;
    400   StringIn, StringOut: string;
     434//  StringIn, StringOut: string;
     435  cb: TCPRSDialogParentCheckBox;
    401436
    402437  procedure NextTabCtrl(ACtrl: TControl);
     
    511546      Entry := TTemplateDialogEntry(Entries.Objects[idx]);
    512547
    513     pnl := Entry.GetPanel(FMaxPnlWidth, sbMain);
     548    if(dsp or OneOnly) then
     549      cb := nil
     550    else
     551      cb := TCPRSDialogParentCheckBox.Create(Self);
     552
     553    pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb);
    514554    pnl.Show;
    515555    if(doHint and (not pnl.ShowHint)) then
     
    521561      Entry.OnChange := FieldChanged;
    522562    end;
    523     if(dsp or OneOnly) then
     563    if not assigned(cb) then
    524564      ctrl := pnl
    525565    else
    526566    begin
    527       ctrl := TORCheckBox.Create(Self);
     567      ctrl := cb;
    528568      ctrl.Parent := sbMain;
    529569
     
    539579      TORCheckBox(ctrl).AutoSize := false;
    540580      TORCheckBox(ctrl).Associate := pnl;
     581      pnl.Tag := Integer(ctrl);
    541582      tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place}
    542       if Templates.IndexOf(tmpID) > -1 then
    543         StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
    544       else
    545         StringIn := 'Sub-Template:';
    546       StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
    547       TORCheckBox(ctrl).Caption := StringOut;
     583//      if Templates.IndexOf(tmpID) > -1 then
     584//        StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
     585//      else
     586//        StringIn := 'Sub-Template:';
     587//      StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
     588//      TORCheckBox(ctrl).Caption := StringOut;
     589      UpdateColorsFor508Compliance(ctrl);
    548590
    549591    end;
     
    615657    for i := 1 to Count do
    616658      BuildCB(i, Y, FirstTime);
     659    if ScreenReaderSystemActive then
     660    begin
     661      amgrMain.RefreshComponents;
     662      Application.ProcessMessages;
     663    end;
    617664  finally
    618665    FBuilding := FALSE;
     
    626673    RepaintBuild := FALSE;
    627674    BuildAllControls;
     675    InitScreenReaderSetup;
     676  end;
     677end;
     678
     679procedure TfrmTemplateDialog.FormShow(Sender: TObject);
     680begin
     681  inherited;
     682  if FFirstBuild then
     683  begin
     684    FFirstBuild := FALSE;
     685    InitScreenReaderSetup;
    628686  end;
    629687end;
     
    631689procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
    632690begin
     691  FFirstBuild := TRUE;
    633692  BuildIdx := TStringList.Create;
    634693  Entries := TStringList.Create;
     
    700759      if not CanClose then
    701760      begin
    702         ShowMessage(MissingFieldsTxt);
     761        ShowMsg(MissingFieldsTxt);
    703762        break;
    704763      end;
     
    719778  TmpSL := TStringList.Create;
    720779  try
    721     TmpSL.Assign(SL);
     780    FastAssign(SL, TmpSL);
    722781    GetText(TmpSL, FALSE);  {FALSE = Do not include embedded fields}
     782    StripScreenReaderCodes(TmpSL);
    723783    ReportBox(TmpSL, 'Dialog Preview', FALSE);
    724784  finally
     
    755815end;
    756816
     817procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage);
     818var
     819  ctrl: TWinControl;
     820  item: TVA508AccessibilityItem;
     821begin
     822  ctrl := TWinControl(Message.WParam);
     823  // Refresh the accessibility manager entry -
     824  // fixes bug where first focusable check boxes weren't working correctly 
     825  if ctrl is TCPRSDialogParentCheckBox then
     826  begin
     827    item := amgrMain.AccessData.FindItem(ctrl, FALSE);
     828    if assigned(item) then
     829      item.free;
     830    amgrMain.AccessData.EnsureItemExists(ctrl);
     831  end;
     832end;
     833
    757834end.
    758835
  • cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.dfm

    r456 r829  
    1 object frmTemplateEditor: TfrmTemplateEditor
    2   Left = 135
    3   Top = 239
    4   Width = 748
    5   Height = 470
     1inherited frmTemplateEditor: TfrmTemplateEditor
     2  Left = 321
     3  Top = 119
    64  HelpContext = 10000
    75  ActiveControl = tvPersonal
    86  BorderIcons = [biSystemMenu, biMaximize]
    97  Caption = 'Template Editor'
    10   Color = clBtnFace
    11   Font.Charset = DEFAULT_CHARSET
    12   Font.Color = clWindowText
    13   Font.Height = -11
    14   Font.Name = 'MS Sans Serif'
    15   Font.Style = []
    16   OldCreateOrder = False
     8  ClientHeight = 450
     9  ClientWidth = 740
    1710  Position = poScreenCenter
    1811  Scaled = False
     12  OnClose = FormClose
    1913  OnCloseQuery = FormCloseQuery
    2014  OnCreate = FormCreate
    2115  OnDestroy = FormDestroy
    2216  OnShow = FormShow
     17  ExplicitWidth = 748
     18  ExplicitHeight = 477
    2319  PixelsPerInch = 96
    2420  TextHeight = 13
    25   object splMain: TSplitter
     21  object splMain: TSplitter [0]
    2622    Left = 0
    2723    Top = 239
     
    3531    OnMoved = splMainMoved
    3632  end
    37   object splNotes: TSplitter
     33  object splNotes: TSplitter [1]
    3834    Left = 0
    39     Top = 371
     35    Top = 377
    4036    Width = 740
    4137    Height = 3
     
    4642    Visible = False
    4743    OnMoved = splBoilMoved
     44    ExplicitTop = 371
    4845  end
    49   object pnlBottom: TORAutoPanel
     46  object pnlBottom: TPanel [2]
    5047    Left = 0
    51     Top = 416
     48    Top = 423
    5249    Width = 740
    5350    Height = 27
     
    5552    BevelOuter = bvNone
    5653    TabOrder = 4
     54    ExplicitTop = 416
    5755    DesignSize = (
    5856      740
     
    130128    end
    131129  end
    132   object pnlBoilerplate: TPanel
     130  object pnlBoilerplate: TPanel [3]
    133131    Left = 0
    134132    Top = 284
    135133    Width = 740
    136     Height = 87
     134    Height = 93
    137135    Align = alClient
    138136    BevelOuter = bvNone
     
    142140    object splBoil: TSplitter
    143141      Left = 0
    144       Top = 43
     142      Top = 14
    145143      Width = 740
    146144      Height = 3
    147145      Cursor = crVSplit
    148       Align = alBottom
     146      Align = alTop
    149147      AutoSnap = False
    150148      Beveled = True
    151149      Visible = False
    152150      OnMoved = splBoilMoved
     151      ExplicitTop = 43
    153152    end
    154153    object reBoil: TRichEdit
    155154      Left = 0
    156       Top = 14
     155      Top = 17
    157156      Width = 740
    158       Height = 29
     157      Height = 30
    159158      Align = alClient
    160159      Font.Charset = ANSI_CHARSET
     
    163162      Font.Name = 'Courier New'
    164163      Font.Style = []
     164      Constraints.MinHeight = 30
    165165      ParentFont = False
    166166      PlainText = True
     
    175175      OnResizeRequest = reResizeRequest
    176176      OnSelectionChange = reBoilSelectionChange
     177      ExplicitTop = 14
    177178    end
    178179    object pnlGroupBP: TPanel
    179180      Left = 0
    180       Top = 46
     181      Top = 47
    181182      Width = 740
    182       Height = 41
     183      Height = 46
    183184      Align = alBottom
    184185      BevelOuter = bvNone
     
    192193        Align = alTop
    193194        Caption = 'Group Boilerplate'
     195        ExplicitWidth = 81
    194196      end
    195197      object lblGroupRow: TLabel
     
    211213        Top = 16
    212214        Width = 740
    213         Height = 25
     215        Height = 30
    214216        Align = alClient
    215217        Color = clCream
     
    219221        Font.Name = 'Courier New'
    220222        Font.Style = []
     223        Constraints.MinHeight = 30
    221224        ParentFont = False
    222225        PlainText = True
     
    281284    end
    282285  end
    283   object pnlTop: TPanel
     286  object pnlTop: TPanel [4]
    284287    Left = 0
    285288    Top = 0
     
    293296      Left = 297
    294297      Top = 24
    295       Width = 3
    296298      Height = 215
    297       Cursor = crHSplit
    298299      Align = alRight
    299300      AutoSnap = False
     
    319320        Left = 216
    320321        Top = 0
    321         Width = 3
    322322        Height = 215
    323         Cursor = crHSplit
    324323        Align = alRight
    325324        AutoSnap = False
     
    428427          FocusControl = tvPersonal
    429428          PopupMenu = popTemplates
     429          ExplicitWidth = 93
    430430        end
    431431        object tvPersonal: TORTreeView
     
    716716            ShowHint = True
    717717            TabOrder = 5
     718            WordWrap = True
    718719            OnClick = cbExcludeClick
    719             WordWrap = True
    720720            AutoSize = True
    721721          end
     
    760760              'erplate, between each item'#39's boilerplate.'
    761761            Associate = edtGap
    762             Min = 0
    763762            Max = 3
    764763            ParentShowHint = False
    765             Position = 0
    766764            ShowHint = True
    767765            TabOrder = 8
    768             Wrap = False
    769766          end
    770767          object edtName: TCaptionEdit
     
    871868            ShowHint = True
    872869            TabOrder = 4
     870            WordWrap = True
    873871            OnClick = cbHideItemsClick
    874             WordWrap = True
    875872            AutoSize = True
    876873          end
     
    913910            TabOrder = 2
    914911            OnChange = cbxRemDlgsChange
     912            CharsNeedMatch = 1
    915913          end
    916914          object cbLock: TORCheckBox
     
    943941        FocusControl = tvShared
    944942        PopupMenu = popTemplates
     943        ExplicitWidth = 86
    945944      end
    946945      object tvShared: TORTreeView
     
    11881187        OnChange = cboOwnerChange
    11891188        OnNeedData = cboOwnerNeedData
     1189        CharsNeedMatch = 1
    11901190      end
    11911191      object btnNew: TORAlignButton
     
    11941194        Width = 182
    11951195        Height = 22
     1196        Align = alRight
    11961197        Caption = '&New Template'
    11971198        TabOrder = 2
    11981199        OnClick = btnNewClick
    1199         Align = alRight
    12001200      end
    12011201      object pnlMenu: TPanel
     
    12121212          Left = 1
    12131213          Top = 1
    1214           Width = 69
     1214          Width = 107
    12151215          Height = 20
    12161216          Align = alLeft
     
    12191219          ButtonWidth = 43
    12201220          Caption = 'mbMain'
    1221           Flat = True
    12221221          Menu = mnuMain
    12231222          ShowCaptions = True
     
    12281227    end
    12291228  end
    1230   object pnlNotes: TPanel
     1229  object pnlNotes: TPanel [5]
    12311230    Left = 0
    1232     Top = 374
     1231    Top = 380
    12331232    Width = 740
    1234     Height = 42
     1233    Height = 43
    12351234    Align = alBottom
    12361235    BevelOuter = bvNone
     
    12441243      Align = alTop
    12451244      Caption = 'Template Notes:'
     1245      ExplicitWidth = 78
    12461246    end
    12471247    object reNotes: TRichEdit
     
    12491249      Top = 13
    12501250      Width = 740
    1251       Height = 29
     1251      Height = 30
    12521252      Align = alClient
    12531253      Font.Charset = ANSI_CHARSET
     
    12561256      Font.Name = 'Courier New'
    12571257      Font.Style = []
     1258      Constraints.MinHeight = 30
    12581259      ParentFont = False
    12591260      PlainText = True
     
    12691270    end
    12701271  end
    1271   object pnlCOM: TPanel
     1272  object pnlCOM: TPanel [6]
    12721273    Left = 0
    12731274    Top = 263
     
    12861287      Caption = '  Passed Value: '
    12871288      Layout = tlCenter
     1289      ExplicitHeight = 13
    12881290    end
    12891291    object lblCOMObj: TLabel
     
    12951297      Caption = ' COM Object: '
    12961298      Layout = tlCenter
     1299      ExplicitHeight = 13
    12971300    end
    12981301    object edtCOMParam: TCaptionEdit
     
    13011304      Width = 380
    13021305      Height = 21
     1306      Align = alClient
    13031307      TabOrder = 0
    13041308      OnChange = edtCOMParamChange
    1305       Align = alClient
    13061309      Caption = 'Passed Value'
    13071310    end
     
    13291332      TabOrder = 1
    13301333      OnChange = cbxCOMObjChange
     1334      CharsNeedMatch = 1
    13311335    end
    13321336  end
    1333   object pnlLink: TPanel
     1337  object pnlLink: TPanel [7]
    13341338    Left = 0
    13351339    Top = 242
     
    13481352      Caption = ' Associated Consult Service: '
    13491353      Layout = tlCenter
     1354      ExplicitHeight = 13
    13501355    end
    13511356    object cbxLink: TORComboBox
     
    13671372      LookupPiece = 0
    13681373      MaxLength = 0
    1369       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'
     1374      Pieces = '2'
    13701375      HideSynonyms = True
    13711376      Sorted = False
     
    13761381      OnChange = cbxLinkChange
    13771382      OnNeedData = cbxLinkNeedData
    1378       OnSynonymCheck = cbxLinkSynonymCheck
    1379     end
     1383      CharsNeedMatch = 1
     1384    end
     1385  end
     1386  inherited amgrMain: TVA508AccessibilityManager
     1387    Data = (
     1388      (
     1389        'Component = pnlBottom'
     1390        'Status = stsDefault')
     1391      (
     1392        'Component = btnApply'
     1393        'Status = stsDefault')
     1394      (
     1395        'Component = btnCancel'
     1396        'Status = stsDefault')
     1397      (
     1398        'Component = btnOK'
     1399        'Status = stsDefault')
     1400      (
     1401        'Component = cbEditShared'
     1402        'Status = stsDefault')
     1403      (
     1404        'Component = cbNotes'
     1405        'Status = stsDefault')
     1406      (
     1407        'Component = cbEditUser'
     1408        'Status = stsDefault')
     1409      (
     1410        'Component = pnlBoilerplate'
     1411        'Status = stsDefault')
     1412      (
     1413        'Component = reBoil'
     1414        'Label = lblBoilerplate'
     1415        'Status = stsOK')
     1416      (
     1417        'Component = pnlGroupBP'
     1418        'Status = stsDefault')
     1419      (
     1420        'Component = reGroupBP'
     1421        'Label = lblGroupBP'
     1422        'Status = stsOK')
     1423      (
     1424        'Component = pnlGroupBPGap'
     1425        'Status = stsDefault')
     1426      (
     1427        'Component = pnlBP'
     1428        'Status = stsDefault')
     1429      (
     1430        'Component = cbLongLines'
     1431        'Status = stsDefault')
     1432      (
     1433        'Component = pnlTop'
     1434        'Status = stsDefault')
     1435      (
     1436        'Component = pnlRightTop'
     1437        'Status = stsDefault')
     1438      (
     1439        'Component = pnlCopyBtns'
     1440        'Status = stsDefault')
     1441      (
     1442        'Component = sbCopyRight'
     1443        'Property = Hint'
     1444        'Status = stsOK')
     1445      (
     1446        'Component = sbCopyLeft'
     1447        'Property = Hint'
     1448        'Status = stsOK')
     1449      (
     1450        'Component = pnlPersonal'
     1451        'Status = stsDefault')
     1452      (
     1453        'Component = tvPersonal'
     1454        'Status = stsDefault')
     1455      (
     1456        'Component = pnlPersonalBottom'
     1457        'Status = stsDefault')
     1458      (
     1459        'Component = sbPerUp'
     1460        'Property = Hint'
     1461        'Status = stsOK')
     1462      (
     1463        'Component = sbPerDown'
     1464        'Property = Hint'
     1465        'Status = stsOK')
     1466      (
     1467        'Component = sbPerDelete'
     1468        'Property = Hint'
     1469        'Status = stsOK')
     1470      (
     1471        'Component = cbPerHide'
     1472        'Property = Hint'
     1473        'Status = stsOK')
     1474      (
     1475        'Component = pnlPersonalGap'
     1476        'Status = stsDefault')
     1477      (
     1478        'Component = pnlPerSearch'
     1479        'Status = stsDefault')
     1480      (
     1481        'Component = btnPerFind'
     1482        'Text = Find Personal Template'
     1483        'Status = stsOK')
     1484      (
     1485        'Component = edtPerSearch'
     1486        'Status = stsDefault')
     1487      (
     1488        'Component = cbPerMatchCase'
     1489        'Status = stsDefault')
     1490      (
     1491        'Component = cbPerWholeWords'
     1492        'Status = stsDefault')
     1493      (
     1494        'Component = pnlProperties'
     1495        'Status = stsDefault')
     1496      (
     1497        'Component = gbProperties'
     1498        'Status = stsDefault')
     1499      (
     1500        'Component = cbExclude'
     1501        'Status = stsDefault')
     1502      (
     1503        'Component = cbActive'
     1504        'Status = stsDefault')
     1505      (
     1506        'Component = edtGap'
     1507        'Status = stsDefault')
     1508      (
     1509        'Component = udGap'
     1510        'Status = stsDefault')
     1511      (
     1512        'Component = edtName'
     1513        'Status = stsDefault')
     1514      (
     1515        'Component = gbDialogProps'
     1516        'Status = stsDefault')
     1517      (
     1518        'Component = cbDisplayOnly'
     1519        'Status = stsDefault')
     1520      (
     1521        'Component = cbOneItemOnly'
     1522        'Status = stsDefault')
     1523      (
     1524        'Component = cbFirstLine'
     1525        'Status = stsDefault')
     1526      (
     1527        'Component = cbHideDlgItems'
     1528        'Status = stsDefault')
     1529      (
     1530        'Component = cbIndent'
     1531        'Status = stsDefault')
     1532      (
     1533        'Component = cbHideItems'
     1534        'Status = stsDefault')
     1535      (
     1536        'Component = cbxType'
     1537        'Status = stsDefault')
     1538      (
     1539        'Component = cbxRemDlgs'
     1540        'Status = stsDefault')
     1541      (
     1542        'Component = cbLock'
     1543        'Status = stsDefault')
     1544      (
     1545        'Component = pnlShared'
     1546        'Status = stsDefault')
     1547      (
     1548        'Component = tvShared'
     1549        'Status = stsDefault')
     1550      (
     1551        'Component = pnlSharedBottom'
     1552        'Status = stsDefault')
     1553      (
     1554        'Component = sbShUp'
     1555        'Property = Hint'
     1556        'Status = stsOK')
     1557      (
     1558        'Component = sbShDown'
     1559        'Property = Hint'
     1560        'Status = stsOK')
     1561      (
     1562        'Component = sbShDelete'
     1563        'Property = Hint'
     1564        'Status = stsOK')
     1565      (
     1566        'Component = cbShHide'
     1567        'Property = Hint'
     1568        'Status = stsOK')
     1569      (
     1570        'Component = pnlSharedGap'
     1571        'Status = stsDefault')
     1572      (
     1573        'Component = pnlShSearch'
     1574        'Status = stsDefault')
     1575      (
     1576        'Component = btnShFind'
     1577        'Text = Find Shared Template'
     1578        'Status = stsOK')
     1579      (
     1580        'Component = edtShSearch'
     1581        'Status = stsDefault')
     1582      (
     1583        'Component = cbShMatchCase'
     1584        'Status = stsDefault')
     1585      (
     1586        'Component = cbShWholeWords'
     1587        'Status = stsDefault')
     1588      (
     1589        'Component = pnlMenuBar'
     1590        'Status = stsDefault')
     1591      (
     1592        'Component = cboOwner'
     1593        'Status = stsDefault')
     1594      (
     1595        'Component = btnNew'
     1596        'Status = stsDefault')
     1597      (
     1598        'Component = pnlMenu'
     1599        'Status = stsDefault')
     1600      (
     1601        'Component = mbMain'
     1602        'Status = stsDefault')
     1603      (
     1604        'Component = pnlNotes'
     1605        'Status = stsDefault')
     1606      (
     1607        'Component = reNotes'
     1608        'Label = lblNotes'
     1609        'Status = stsOK')
     1610      (
     1611        'Component = pnlCOM'
     1612        'Status = stsDefault')
     1613      (
     1614        'Component = edtCOMParam'
     1615        'Label = lblCOMParam'
     1616        'Status = stsOK')
     1617      (
     1618        'Component = cbxCOMObj'
     1619        'Property = Caption'
     1620        'Status = stsOK')
     1621      (
     1622        'Component = pnlLink'
     1623        'Status = stsDefault')
     1624      (
     1625        'Component = cbxLink'
     1626        'Label = lblLink'
     1627        'Status = stsOK')
     1628      (
     1629        'Component = frmTemplateEditor'
     1630        'Status = stsDefault'))
    13801631  end
    13811632  object popTemplates: TPopupMenu
     
    17502001    Top = 136
    17512002  end
     2003  object imgLblTemplates: TVA508ImageListLabeler
     2004    Components = <
     2005      item
     2006        Component = tvPersonal
     2007      end
     2008      item
     2009        Component = tvShared
     2010      end>
     2011    Labels = <>
     2012    RemoteLabeler = dmodShared.imgLblHealthFactorLabels
     2013    Left = 104
     2014    Top = 144
     2015  end
    17522016end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas

    r456 r829  
    1818  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    1919  ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet,
    20   uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB;
     20  uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form,
     21  VA508AccessibilityManager, VA508ImageListLabeler;
    2122
    2223type
     
    2425  TTemplateTreeType = (ttShared, ttPersonal);
    2526
    26   TfrmTemplateEditor = class(TForm)
     27  TfrmTemplateEditor = class(TfrmBase508Form)
    2728    splMain: TSplitter;
    28     pnlBottom: TORAutoPanel;
     29    pnlBottom: TPanel;
    2930    btnApply: TButton;
    3031    btnCancel: TButton;
     
    209210    cbxLink: TORComboBox;
    210211    lblLink: TLabel;
     212    imgLblTemplates: TVA508ImageListLabeler;
    211213    procedure btnNewClick(Sender: TObject);
    212214    procedure btnApplyClick(Sender: TObject);
     
    339341      Direction, InsertAt: Integer);
    340342    procedure cbxLinkChange(Sender: TObject);
    341     procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String;
    342       var IsSynonym: Boolean);
    343343    procedure reBoilKeyUp(Sender: TObject; var Key: Word;
    344344      Shift: TShiftState);
     
    346346    procedure reBoilKeyDown(Sender: TObject; var Key: Word;
    347347      Shift: TShiftState);
     348    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    348349  private
    349350    FLastRect: TRect;
     
    386387    FCanDoReminders: boolean;
    387388    FCanDoCOMObjects: boolean;
    388     FPersonalObjects: TStringList;
     389    //FPersonalObjects: TStringList;
    389390    FShowingTemplate: TTemplate;
    390391    FConsultServices: TStringList;
     
    416417    procedure UpdateInsertsDialogs;
    417418    procedure AutoLongLines(Sender: TObject);
    418     procedure UpdatePersonalObjects;
     419    //procedure UpdatePersonalObjects;
    419420    procedure UpdateApply(Template: TTemplate);
    420421    procedure TemplateLocked(Sender: TObject);
    421422    procedure InitTrees;
     423    procedure AdjustControls4FontChange;
     424    procedure ShowGroupBoilerplate(Visible: boolean);
    422425    function GetLinkType(const ANode: TTreeNode): TTemplateLinkType;
    423426  end;
    424427
    425428procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE);
     429
     430const
     431  TemplateEditorSplitters = 'frmTempEditSplitters';
     432  TemplateEditorSplitters2 = 'frmTempEditSplitters2';
     433
     434var
     435  tmplEditorSplitterMiddle: integer = 0;
     436  tmplEditorSplitterProperties: integer = 0;
     437  tmplEditorSplitterMain: integer = 0;
     438  tmplEditorSplitterBoil: integer = 0;
     439  tmplEditorSplitterNotes: integer = 0;
    426440
    427441implementation
     
    431445uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView,
    432446  fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils,
    433   fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults;
     447  fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils,
     448  rMisc, fFindingTemplates;
    434449
    435450const
     
    499514      Drawers := TFrmDrawers(Form)
    500515    else
    501     if IsPublishedProp(Form, 'Drawers') then
    502       Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers'));
     516    if IsPublishedProp(Form, DrawersProperty) then
     517      Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty));
    503518  end;
    504519
     
    724739
    725740  BtnApply.Enabled := BackupDiffers;
     741  SetFormPosition(Self);
    726742end;
    727743
     
    873889  end;
    874890  lblNotes.Enabled := (not reNotes.ReadOnly);
    875   if(reNotes.ReadOnly) then
    876     reNotes.Color := ReadOnlyColor
    877   else
    878     reNotes.Color := clWindow;
     891  UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly);
    879892  cbxType.Enabled := ok;
    880893  lblType.Enabled := ok;
     
    894907  lblLines.Enabled := ok;
    895908  reBoil.ReadOnly := not ok;
    896   if(ok) then
    897     reBoil.Color := clWindow
    898   else
    899     reBoil.Color := ReadOnlyColor;
     909  UpdateReadOnlyColorScheme(reBoil, not ok);
    900910  lblLink.Enabled := ok;
    901911  cbxLink.Enabled := ok;
     
    937947end;
    938948
     949procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean);
     950begin
     951  pnlGroupBP.Visible := Visible;
     952  splBoil.Visible := Visible;
     953  if Visible then
     954  begin
     955    reBoil.Align := alTop;
     956    pnlGroupBP.Align := alClient;
     957    reBoil.Height := tmplEditorSplitterBoil;
     958    splBoil.Top := pnlGroupBP.Top - splBoil.Height;
     959  end
     960  else
     961  begin
     962    pnlGroupBP.Align := alBottom;
     963    reBoil.Align := alClient;
     964  end;
     965end;
     966
    939967procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode);
    940968var
     
    942970  Idx: TTypeIndex;
    943971  CanDoCOM: boolean;
    944   LinkTemplate: TTemplate;
    945972  lt: TTemplateLinkType;
    946973  lts: string;
    947   i: integer;
    948974
    949975begin
     
    9801006            begin
    9811007              FConsultServices := TStringList.Create;
    982               FConsultServices.Assign(LoadServiceListWithSynonyms(1));
     1008              FastAssign(LoadServiceListWithSynonyms(1), FConsultServices);
    9831009              SortByPiece(FConsultServices, U, 2);
    9841010            end;
    985             for i := 0 to FConsultServices.Count-1 do
    986             begin
    987               LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult);
    988               if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then
    989                 cbxLink.Items.Add(FConsultServices[i]);
    990             end;
     1011            FastAssign(FConsultServices, cbxLink.Items);
    9911012          end
    9921013          else
     
    11711192      edtGap.Text := '0';
    11721193      reBoil.Clear;
    1173       pnlGroupBP.Visible := FALSE;
    1174       splBoil.Visible := FALSE;
     1194      ShowGroupBoilerplate(False);
    11751195      pnlBoilerplateResize(Self);
    11761196      pnlCOM.Visible := FALSE;
     
    11961216begin
    11971217  if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then
     1218  begin
    11981219    pnlGroupBP.Height := pnlBoilerplate.Height-29;
     1220  end;
    11991221  if cbLongLines.checked then
    12001222    Max := 240
     
    14491471      begin
    14501472        reBoil.ReadOnly := TRUE;
    1451         reBoil.Color := ReadOnlyColor;
     1473        UpdateReadOnlyColorScheme(reBoil, TRUE);
    14521474        UpdateInsertsDialogs;
    14531475      end;
    1454       pnlGroupBP.Visible := ItemOK;
    1455       splBoil.Visible := ItemOK;
     1476      ShowGroupBoilerplate(ItemOK);
    14561477      if(not ItemOK) and (IsReminderDialog or IsCOMObject) then
    14571478        BPOK := FALSE;
    1458       if(ItemOK) then
    1459         splBoil.Top := pnlGroupBP.Top - splBoil.Height;
    14601479      pnlBoilerplateResize(Self);
    14611480      pnlBoilerplate.Visible := BPOK;
     
    14821501    frmTemplateFields := nil;
    14831502  end;
    1484   KillObj(@FPersonalObjects);
     1503  //---------- CQ #8665 - RV --------
     1504  //KillObj(@FPersonalObjects);
     1505  if (assigned(uPersonalObjects)) then
     1506  begin
     1507    KillObj(@uPersonalObjects);
     1508    uPersonalObjects.Free;
     1509    uPersonalObjects := nil;
     1510  end;
     1511  // ----  end CQ #8665 -------------
    14851512  dmodShared.OnTemplateLock := nil;
    14861513  dmodShared.InEditor := FALSE;
     
    20402067end;
    20412068
     2069procedure TfrmTemplateEditor.AdjustControls4FontChange;
     2070var
     2071  x: integer;
     2072
     2073  procedure Adjust(Control: TWinControl);
     2074  begin
     2075    x := x - Control.Width - 2;
     2076    Control.Left := x;
     2077  end;
     2078
     2079begin
     2080  if FCanEditShared then
     2081  begin
     2082    x := pnlSharedBottom.Width;
     2083    Adjust(sbSHDelete);
     2084    Adjust(sbSHDown);
     2085    Adjust(sbSHUp);
     2086    cbSHHide.Width := x;
     2087  end;
     2088  x := pnlBottom.Width;
     2089  Adjust(btnApply);
     2090  Adjust(btnCancel);
     2091  Adjust(btnOK);
     2092  cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25;
     2093  cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60;
     2094  cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25;
     2095end;
     2096
    20422097function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean;
    20432098var
     
    22052260  MoveCopyButtons;
    22062261  tvTreeChange(FCurTree, FCurTree.Selected);
     2262  if FCanEditShared then
     2263    AdjustControls4FontChange;
    22072264end;
    22082265
     
    23272384procedure TfrmTemplateEditor.btnFindClick(Sender: TObject);
    23282385var
    2329   Found: boolean;
     2386  Found: TTreeNode;
    23302387  edtSearch: TEdit;
     2388  IsNext: boolean;
    23312389  FindNext: boolean;
    23322390  FindWholeWords: boolean;
     
    23342392  Tree: TTreeView;
    23352393  LastFoundNode, TmpNode: TTreeNode;
    2336   S1,S2: string;
     2394//  S1,S2: string;
    23372395
    23382396begin
     
    23452403    FindCase := cbShMatchCase.Checked;
    23462404    LastFoundNode := FLastFoundShNode;
    2347     if(FSharedEmptyNodeCount > 0) then
    2348     begin
    2349       FInternalHiddenExpand := TRUE;
    2350       try
    2351         tvShared.Items.GetFirstNode.Expand(TRUE);
    2352       finally
    2353         FInternalHiddenExpand := FALSE;
    2354       end;
    2355     end;
    23562405  end
    23572406  else
     
    23632412    FindCase := cbPerMatchCase.Checked;
    23642413    LastFoundNode := FLastFoundPerNode;
    2365     if(FPersonalEmptyNodeCount > 0) then
    2366     begin
    2367       FInternalHiddenExpand := TRUE;
    2368       try
    2369         tvPersonal.Items.GetFirstNode.Expand(TRUE);
    2370       finally
    2371         FInternalHiddenExpand := FALSE;
    2372       end;
    2373     end;
    23742414  end;
    23752415  if(edtSearch.text <> '') then
    23762416  begin
    2377     if((FindNext) and assigned (LastFoundNode)) then
    2378       TmpNode := LastFoundNode.GetNext
     2417    IsNext := ((FindNext) and assigned (LastFoundNode));
     2418    if IsNext then
     2419   
     2420      TmpNode := LastFoundNode
    23792421    else
    23802422      TmpNode := Tree.Items.GetFirstNode;
    2381     Found := FALSE;
    2382     if(assigned(TmpNode)) then
    2383     begin
    2384       S1 := edtSearch.Text;
    2385       if(not FindCase) then
    2386         S1 := UpperCase(S1);
    2387       while (assigned(TmpNode) and (not Found)) do
    2388       begin
    2389         S2 := TmpNode.Text;
    2390         if(not FindCase) then
    2391           S2 := UpperCase(S2);
    2392         Found := SearchMatch(S1, S2, FindWholeWords);
    2393         if(not Found) then
    2394           TmpNode := TmpNode.GetNext;
    2395       end;
    2396     end;
    2397     if(Found) then
    2398     begin
     2423    FInternalHiddenExpand := TRUE;
     2424    try
     2425      Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode,
     2426                            IsNext, not FindCase, FindWholeWords);
     2427    finally
     2428      FInternalHiddenExpand := FALSE;
     2429    end;
     2430    if Assigned(Found) then
     2431    begin
     2432      Tree.Selected := Found;
    23992433      if(Tree = tvShared) then
    2400         FLastFoundShNode := TmpNode
     2434        FLastFoundShNode := Found
    24012435      else
    2402         FLastFoundPerNode := TmpNode;
     2436        FLastFoundPerNode := Found;
    24032437      SetFindNext(Tree, TRUE);
    2404       Tree.Selected := TmpNode;
    2405     end
    2406     else
    2407     begin
    2408       if(FindNext) then
    2409         S1 := ''
    2410       else
    2411         S1 := '  "' + edtSearch.Text + '" was not Found.';
    2412       SetFindNext(Tree, FALSE);
    2413       InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION);
    24142438    end;
    24152439  end;
     
    24992523    end;
    25002524    pnlBoilerplateResize(Self);
     2525    AdjustControls4FontChange;
     2526    MoveCopyButtons;
    25012527  end;
    25022528end;
     
    25162542    begin
    25172543      UpdatePersonalObjects;
    2518       if FPersonalObjects.Count > 0 then
     2544      if uPersonalObjects.Count > 0 then                                                  // -------- CQ #8665 - RV ------------
    25192545      begin
    25202546        DoIt := FALSE;
    25212547        for i := 0 to dmodShared.TIUObjects.Count-1 do
    2522           if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
     2548          if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then      // -------- CQ #8665 - RV ------------
    25232549            frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]);
    25242550      end;
    25252551    end;
    25262552    if DoIt then
    2527       frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects);
     2553      FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items);
    25282554    frmTemplateObjects.Font := Font;
    25292555    frmTemplateObjects.re := reBoil;
     
    26332659end;
    26342660
     2661procedure TfrmTemplateEditor.FormClose(Sender: TObject;
     2662  var Action: TCloseAction);
     2663begin
     2664  SaveUserBounds(Self);
     2665end;
     2666
    26352667procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject;
    26362668  var CanClose: Boolean);
     
    26662698procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject);
    26672699begin
     2700  if pnlBoilerplate.Visible and pnlGroupBP.Visible then
     2701    tmplEditorSplitterBoil := reBoil.Height;
     2702  if pnlNotes.Visible then
     2703    tmplEditorSplitterNotes := pnlNotes.Height;
    26682704  pnlBoilerplateResize(Self);
    26692705end;
     
    31053141procedure TfrmTemplateEditor.mbMainResize(Sender: TObject);
    31063142begin
    3107   pnlMenu.Width := mbMain.Width + 3;
     3143  pnlMenu.Width := mbMain.Width + 4;
     3144  mbMain.Width := pnlMenu.Width - 3;
    31083145end;
    31093146
     
    31793216  dmodShared.LoadTIUObjects;
    31803217  UpdatePersonalObjects;
    3181   GetAutoGenText(AName, AText, FPersonalObjects);
     3218  GetAutoGenText(AName, AText, uPersonalObjects);   // -------- CQ #8665 - RV ------------
    31823219  if(AName <> '') and (AText <> '') then
    31833220  begin
     
    32743311  pnlNotes.Visible := cbNotes.Checked;
    32753312  splNotes.Visible := cbNotes.Checked;
    3276   splNotes.Top := pnlNotes.Top-3;
     3313  if cbNotes.Checked then
     3314  begin
     3315    pnlNotes.Height := tmplEditorSplitterNotes;
     3316    pnlNotes.Top := pnlBottom.Top - pnlNotes.Height;
     3317    splNotes.Top := pnlNotes.Top-3;
     3318  end;
    32773319  pnlBoilerplateResize(Self);
    32783320end;
     
    33973439            if (Flds.Count > 0) then begin
    33983440              ExpandEmbeddedFields(Flds);
    3399               Flds.Assign(ExportTemplateFields(Flds));
     3441              FastAssign(ExportTemplateFields(Flds), Flds);
    34003442              for i := 0 to Flds.Count-1 do
    34013443                Flds[i] := '  ' + Flds[i];
    3402               Tmpl.AddStrings(Flds);
     3444              FastAddStrings(Flds, Tmpl);
    34033445            end; {if}
    34043446            Tmpl.Add('</'+XMLHeader+'>');
     
    37043746            FUpdating := FALSE;
    37053747          end;
    3706           ShowMessage('Can not assign a Reminder Dialog to a Reason for Request');
     3748          ShowMsg('Can not assign a Reminder Dialog to a Reason for Request');
    37073749        end
    37083750        else
     
    37903832end;
    37913833
    3792 procedure TfrmTemplateEditor.UpdatePersonalObjects;
     3834(*procedure TfrmTemplateEditor.UpdatePersonalObjects;
    37933835var
    37943836  i: integer;
     
    38033845    FPersonalObjects.Sorted := TRUE;
    38043846  end;
    3805 end;
     3847end;*)
    38063848
    38073849(*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean;
     
    38753917begin
    38763918  Resync([TTemplate(Sender)]);
    3877   ShowMessage(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
     3919  ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
    38783920end;
    38793921
     
    40744116  try
    40754117    case TTemplateLinkType(pnlLink.Tag) of
    4076       ltTitle:     tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction));
     4118      ltTitle:     FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL);
    40774119//      ltConsult:
    40784120      ltProcedure:
    40794121        begin
    4080           tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction));
     4122          FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL);
    40814123          for i := 0 to tmpSL.Count-1 do
    40824124          begin
     
    40964138var
    40974139  Template,LinkTemplate: TTemplate;
     4140  update: boolean;
    40984141
    40994142begin
     
    41044147    if assigned(Template) and Template.CanModify then
    41054148    begin
     4149      update := true;
    41064150      if cbxLink.ItemIEN > 0 then
    41074151      begin
     
    41094153        if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then
    41104154        begin
    4111           ShowMessage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
     4155          ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
    41124156                      ' is already assigned to another template.');
    4113           cbxLink.ItemIndex := -1;
     4157          cbxLink.SelectByID(Template.LinkIEN);
     4158          update := False;
     4159        end
     4160        else
     4161        begin
     4162          Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
     4163          if Template.LinkName <> '' then
     4164            edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41144165        end;
    4115         Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
    4116         if Template.LinkName <> '' then
    4117           edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41184166      end
    41194167      else
    41204168        Template.FileLink := '';
    4121       UpdateApply(Template);
    4122     end;
    4123   end;
    4124 end;
    4125 
    4126 procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject;
    4127   const Text: String; var IsSynonym: Boolean);
    4128 var
    4129   LinkTemplate: TTemplate;
    4130   var IEN: string;
    4131 
    4132 begin
    4133   IsSynonym := FALSE;
    4134   if pnlLink.Visible and assigned(FShowingTemplate) then
    4135   begin
    4136     IEN := Piece(Text,#9,30);
    4137     if IEN <> '' then
    4138     begin
    4139       LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag));
    4140       IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate));
    4141     end
    4142     else
    4143       IsSynonym := FALSE;
     4169      if update then
     4170        UpdateApply(Template);
     4171    end;
    41444172  end;
    41454173end;
  • cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.dfm

    r456 r829  
    1 object frmTemplateFieldEditor: TfrmTemplateFieldEditor
     1inherited frmTemplateFieldEditor: TfrmTemplateFieldEditor
    22  Left = 294
    33  Top = 211
    4   Width = 640
    5   Height = 447
    64  BorderIcons = [biSystemMenu, biMaximize]
    75  Caption = 'Template Field Editor'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
    14   OldCreateOrder = False
     6  ClientHeight = 420
     7  ClientWidth = 788
    158  Position = poScreenCenter
    169  OnCloseQuery = FormCloseQuery
     
    1811  OnDestroy = FormDestroy
    1912  OnResize = FormResize
     13  ExplicitWidth = 796
     14  ExplicitHeight = 454
    2015  PixelsPerInch = 96
    2116  TextHeight = 13
    22   object splLeft: TSplitter
    23     Left = 273
     17  object splLeft: TSplitter [0]
     18    Left = 429
    2419    Top = 25
    25     Width = 3
    2620    Height = 366
    27     Cursor = crHSplit
    2821    Beveled = True
     22    ExplicitLeft = 273
    2923  end
    30   object pnlBottom: TPanel
     24  object pnlBottom: TPanel [1]
    3125    Left = 0
    3226    Top = 391
    33     Width = 632
     27    Width = 788
    3428    Height = 29
    3529    Align = alBottom
    3630    TabOrder = 2
    3731    DesignSize = (
    38       632
     32      788
    3933      29)
    4034    object lblReq: TStaticText
     
    4741    end
    4842    object btnOK: TButton
    49       Left = 392
     43      Left = 548
    5044      Top = 4
    5145      Width = 75
     
    5852    end
    5953    object btnCancel: TButton
    60       Left = 472
     54      Left = 628
    6155      Top = 4
    6256      Width = 75
     
    7064    end
    7165    object btnApply: TButton
    72       Left = 552
     66      Left = 708
    7367      Top = 4
    7468      Width = 75
     
    8074    end
    8175    object btnPreview: TButton
    82       Left = 279
     76      Left = 435
    8377      Top = 4
    8478      Width = 75
     
    10296    end
    10397  end
    104   object pnlObjs: TPanel
     98  object pnlObjs: TPanel [2]
    10599    Left = 0
    106100    Top = 25
    107     Width = 273
     101    Width = 429
    108102    Height = 366
    109103    Align = alLeft
     
    114108      Left = 1
    115109      Top = 1
    116       Width = 271
     110      Width = 427
    117111      Height = 13
    118112      Align = alTop
    119113      Caption = 'Template Fields'
     114      ExplicitWidth = 74
    120115    end
    121116    object cbxObjs: TORComboBox
    122117      Left = 1
    123118      Top = 14
    124       Width = 271
     119      Width = 427
    125120      Height = 351
    126121      Style = orcsSimple
     
    141136      Sorted = False
    142137      SynonymChars = '<Inactive>'
    143       TabPositions = '34,45,55,65,75'
     138      TabPositions = '50,60,70,80,90'
    144139      TabOrder = 0
    145140      OnChange = cbxObjsChange
     
    147142      OnNeedData = cbxObjsNeedData
    148143      OnSynonymCheck = cbxObjsSynonymCheck
     144      CharsNeedMatch = 1
    149145    end
    150146  end
    151   object pnlRight: TPanel
    152     Left = 276
     147  object pnlRight: TPanel [3]
     148    Left = 432
    153149    Top = 25
    154150    Width = 356
     
    182178        Align = alTop
    183179        Caption = 'Notes:'
     180        ExplicitWidth = 31
    184181      end
    185182      object reNotes: TRichEdit
     
    370367        TabOrder = 1
    371368        OnChange = cbxTypeChange
     369        CharsNeedMatch = 1
    372370      end
    373371      object edtTextLen: TCaptionEdit
     
    389387        Anchors = [akTop, akRight]
    390388        Associate = edtTextLen
    391         Min = 0
    392389        Max = 240
    393         Position = 0
    394390        TabOrder = 5
    395         Wrap = False
    396391      end
    397392      object pnlSwap: TPanel
     
    408403          Width = 300
    409404          Height = 22
     405          Align = alTop
    410406          Font.Charset = ANSI_CHARSET
    411407          Font.Color = clWindowText
     
    420416          OnEnter = edtpopControlEnter
    421417          OnExit = ControlExit
    422           Align = alTop
    423418          Caption = 'Default Value'
    424419        end
     
    460455            Min = -9999
    461456            Max = 9999
    462             Position = 0
    463457            TabOrder = 1
    464458            Thousands = False
    465             Wrap = False
    466459          end
    467460          object edtDefNum: TCaptionEdit
     
    483476            Min = -9999
    484477            Max = 9999
    485             Position = 0
    486478            TabOrder = 3
    487479            Thousands = False
    488             Wrap = False
    489480          end
    490481          object edtMinVal: TCaptionEdit
     
    508499            Position = 1
    509500            TabOrder = 7
    510             Wrap = False
    511501          end
    512502          object edtInc: TCaptionEdit
     
    538528            Min = -9999
    539529            Max = 9999
    540             Position = 0
    541530            TabOrder = 5
    542531            Thousands = False
    543             Wrap = False
    544532          end
    545533        end
     
    549537          Width = 300
    550538          Height = 22
     539          Align = alTop
    551540          Font.Charset = ANSI_CHARSET
    552541          Font.Color = clWindowText
     
    560549          OnChange = edtURLChange
    561550          OnEnter = edtpopControlEnter
    562           Align = alTop
    563551          Caption = 'URL'
    564552        end
     
    615603          TabStop = True
    616604          OnChange = cbxDefaultChange
     605          CharsNeedMatch = 1
    617606        end
    618607        object pnlDate: TPanel
     
    678667            TabOrder = 1
    679668            OnChange = cbxDateTypeChange
     669            CharsNeedMatch = 1
    680670          end
    681671        end
     
    703693        Position = 1
    704694        TabOrder = 3
    705         Wrap = False
    706695      end
    707696      object gbIndent: TGroupBox
     
    743732          Height = 21
    744733          Associate = edtIndent
    745           Min = 0
    746734          Max = 30
    747           Position = 0
    748735          TabOrder = 1
    749736          Thousands = False
    750           Wrap = False
    751737        end
    752738        object udPad: TUpDown
     
    756742          Height = 21
    757743          Associate = edtPad
    758           Min = 0
    759744          Max = 30
    760           Position = 0
    761745          TabOrder = 2
    762746          Thousands = False
    763           Wrap = False
    764747        end
    765748        object edtPad: TCaptionEdit
     
    823806    end
    824807  end
    825   object pnlTop: TPanel
     808  object pnlTop: TPanel [4]
    826809    Left = 0
    827810    Top = 0
    828     Width = 632
     811    Width = 788
    829812    Height = 25
    830813    Align = alTop
     
    832815    TabOrder = 3
    833816    DesignSize = (
    834       632
     817      788
    835818      25)
    836819    object MenuBar1: TMenuBar
    837820      Left = 0
    838821      Top = 0
    839       Width = 23
     822      Width = 41
    840823      Height = 25
    841824      Align = alLeft
     
    844827      ButtonWidth = 43
    845828      Caption = 'MenuBar1'
    846       Flat = True
    847829      Menu = mnuMain
    848830      ShowCaptions = True
     
    850832    end
    851833    object btnNew: TButton
    852       Left = 557
     834      Left = 711
    853835      Top = 2
    854836      Width = 75
     
    860842    end
    861843    object btnCopy: TButton
    862       Left = 478
     844      Left = 632
    863845      Top = 2
    864846      Width = 75
     
    871853    end
    872854    object btnDelete: TButton
    873       Left = 399
     855      Left = 553
    874856      Top = 2
    875857      Width = 75
     
    881863      OnClick = mnuDeleteClick
    882864    end
     865  end
     866  inherited amgrMain: TVA508AccessibilityManager
     867    Data = (
     868      (
     869        'Component = pnlBottom'
     870        'Status = stsDefault')
     871      (
     872        'Component = lblReq'
     873        'Status = stsDefault')
     874      (
     875        'Component = btnOK'
     876        'Status = stsDefault')
     877      (
     878        'Component = btnCancel'
     879        'Status = stsDefault')
     880      (
     881        'Component = btnApply'
     882        'Status = stsDefault')
     883      (
     884        'Component = btnPreview'
     885        'Status = stsDefault')
     886      (
     887        'Component = cbHide'
     888        'Status = stsDefault')
     889      (
     890        'Component = pnlObjs'
     891        'Status = stsDefault')
     892      (
     893        'Component = cbxObjs'
     894        'Status = stsDefault')
     895      (
     896        'Component = pnlRight'
     897        'Status = stsDefault')
     898      (
     899        'Component = pnlPreview'
     900        'Status = stsDefault')
     901      (
     902        'Component = reNotes'
     903        'Status = stsDefault')
     904      (
     905        'Component = pnlObjInfo'
     906        'Status = stsDefault')
     907      (
     908        'Component = edtName'
     909        'Status = stsDefault')
     910      (
     911        'Component = edtLMText'
     912        'Status = stsDefault')
     913      (
     914        'Component = cbxType'
     915        'Status = stsDefault')
     916      (
     917        'Component = edtTextLen'
     918        'Status = stsDefault')
     919      (
     920        'Component = udTextLen'
     921        'Status = stsDefault')
     922      (
     923        'Component = pnlSwap'
     924        'Status = stsDefault')
     925      (
     926        'Component = edtDefault'
     927        'Status = stsDefault')
     928      (
     929        'Component = pnlNum'
     930        'Status = stsDefault')
     931      (
     932        'Component = udDefNum'
     933        'Status = stsDefault')
     934      (
     935        'Component = edtDefNum'
     936        'Status = stsDefault')
     937      (
     938        'Component = udMinVal'
     939        'Status = stsDefault')
     940      (
     941        'Component = edtMinVal'
     942        'Status = stsDefault')
     943      (
     944        'Component = udInc'
     945        'Status = stsDefault')
     946      (
     947        'Component = edtInc'
     948        'Status = stsDefault')
     949      (
     950        'Component = edtMaxVal'
     951        'Status = stsDefault')
     952      (
     953        'Component = udMaxVal'
     954        'Status = stsDefault')
     955      (
     956        'Component = edtURL'
     957        'Status = stsDefault')
     958      (
     959        'Component = reItems'
     960        'Status = stsDefault')
     961      (
     962        'Component = cbxDefault'
     963        'Status = stsDefault')
     964      (
     965        'Component = pnlDate'
     966        'Status = stsDefault')
     967      (
     968        'Component = edtDateDef'
     969        'Status = stsDefault')
     970      (
     971        'Component = cbxDateType'
     972        'Status = stsDefault')
     973      (
     974        'Component = edtLen'
     975        'Status = stsDefault')
     976      (
     977        'Component = udLen'
     978        'Status = stsDefault')
     979      (
     980        'Component = gbIndent'
     981        'Status = stsDefault')
     982      (
     983        'Component = edtIndent'
     984        'Status = stsDefault')
     985      (
     986        'Component = udIndent'
     987        'Status = stsDefault')
     988      (
     989        'Component = udPad'
     990        'Status = stsDefault')
     991      (
     992        'Component = edtPad'
     993        'Status = stsDefault')
     994      (
     995        'Component = gbMisc'
     996        'Status = stsDefault')
     997      (
     998        'Component = cbActive'
     999        'Status = stsDefault')
     1000      (
     1001        'Component = cbRequired'
     1002        'Status = stsDefault')
     1003      (
     1004        'Component = cbSepLines'
     1005        'Status = stsDefault')
     1006      (
     1007        'Component = cbExclude'
     1008        'Status = stsDefault')
     1009      (
     1010        'Component = pnlTop'
     1011        'Status = stsDefault')
     1012      (
     1013        'Component = MenuBar1'
     1014        'Status = stsDefault')
     1015      (
     1016        'Component = btnNew'
     1017        'Status = stsDefault')
     1018      (
     1019        'Component = btnCopy'
     1020        'Status = stsDefault')
     1021      (
     1022        'Component = btnDelete'
     1023        'Status = stsDefault')
     1024      (
     1025        'Component = frmTemplateFieldEditor'
     1026        'Status = stsDefault'))
    8831027  end
    8841028  object mnuMain: TMainMenu
  • cprs/trunk/CPRS-Chart/Templates/fTemplateFieldEditor.pas

    r456 r829  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  ORCtrls, StdCtrls, ExtCtrls, Menus, ComCtrls, uTemplateFields, ORFn,
    8   ToolWin, MenuBar, ORClasses, ORDtTm;
     8  ToolWin, MenuBar, ORClasses, ORDtTm, fBase508Form, VA508AccessibilityManager;
    99
    1010type
    11   TfrmTemplateFieldEditor = class(TForm)
     11  TfrmTemplateFieldEditor = class(TfrmBase508Form)
    1212    pnlBottom: TPanel;
    1313    btnOK: TButton;
     
    184184
    185185uses rTemplates, fTemplateDialog, Clipbrd, uSpell, uConst,
    186      fTemplateFields;
     186     fTemplateFields, VAUtils;
    187187
    188188{$R *.DFM}
     
    470470  FUpdating := TRUE;
    471471  try
    472     cbxDefault.Items.Assign(reItems.Lines);
     472    QuickCopy(reItems, cbxDefault);
    473473    idx := -1;
    474474    if(assigned(FFld)) and reItems.Visible and cbxDefault.Visible then
     
    509509  tmp := TORStringList.Create;
    510510  try
    511     tmp.Assign(SubSetOfTemplateFields(StartFrom, Direction));
     511    FastAssign(SubSetOfTemplateFields(StartFrom, Direction), tmp);
    512512    for i := 0 to FDeleted.Count-1 do
    513513    begin
     
    516516        tmp.delete(idx);
    517517    end;
    518     ConvertCodes2Text(tmp, TRUE);
     518    ConvertCodes2Text(tmp, FALSE);
    519519    cbxObjs.ForDataUse(tmp);
    520520  finally
     
    815815    if FDeleted.IndexOfPiece(FFld.FldName, U, 2) >= 0 then
    816816    begin
    817       ShowMessage('Template field can not be named the same as a deleted' + CRLF +
     817      ShowMsg('Template field can not be named the same as a deleted' + CRLF +
    818818                  'field until OK or Apply has been pressed.');
    819819      bad := TRUE;
  • cprs/trunk/CPRS-Chart/Templates/fTemplateFields.dfm

    r456 r829  
    1 object frmTemplateFields: TfrmTemplateFields
     1inherited frmTemplateFields: TfrmTemplateFields
    22  Left = 212
    33  Top = 155
    4   Width = 418
    5   Height = 300
    64  Caption = 'Insert Template Field'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
     5  ClientHeight = 319
     6  ClientWidth = 450
    137  FormStyle = fsStayOnTop
    14   OldCreateOrder = False
    158  Position = poOwnerFormCenter
    169  OnClose = FormClose
    1710  OnCreate = FormCreate
    1811  OnShow = FormShow
     12  ExplicitWidth = 458
     13  ExplicitHeight = 346
    1914  PixelsPerInch = 96
    2015  TextHeight = 13
    21   object pnlBottom: TPanel
     16  object pnlBottom: TPanel [0]
    2217    Left = 0
    23     Top = 246
    24     Width = 410
    25     Height = 27
     18    Top = 226
     19    Width = 450
     20    Height = 28
    2621    Align = alBottom
    2722    BevelOuter = bvNone
    28     TabOrder = 0
     23    TabOrder = 1
    2924    DesignSize = (
    30       410
    31       27)
    32     object lblReq: TStaticText
    33       Left = 21
    34       Top = 8
    35       Width = 134
    36       Height = 17
    37       Caption = '* Indicates a Required Field'
    38       TabOrder = 3
    39     end
     25      450
     26      28)
    4027    object btnCancel: TButton
    41       Left = 335
     28      Left = 371
    4229      Top = 4
    4330      Width = 75
     
    4734      Caption = '&Done'
    4835      ModalResult = 2
    49       TabOrder = 2
     36      TabOrder = 3
    5037      OnClick = btnCancelClick
    5138    end
    5239    object btnInsert: TButton
    53       Left = 255
     40      Left = 291
    5441      Top = 4
    5542      Width = 75
     
    5946      Default = True
    6047      ModalResult = 4
    61       TabOrder = 1
     48      TabOrder = 2
    6249      OnClick = btnInsertClick
    6350    end
    6451    object btnPreview: TButton
    65       Left = 175
     52      Left = 211
    6653      Top = 4
    6754      Width = 75
    6855      Height = 21
     56      Anchors = [akTop, akRight]
    6957      Caption = '&Preview'
    7058      Enabled = False
     59      TabOrder = 1
     60      OnClick = btnPreviewClick
     61    end
     62    object lblReq: TVA508StaticText
     63      Name = 'lblReq'
     64      AlignWithMargins = True
     65      Left = 10
     66      Top = 12
     67      Width = 132
     68      Height = 15
     69      Alignment = taLeftJustify
     70      Anchors = [akLeft, akBottom]
     71      Caption = '* Indicates a Required Field'
    7172      TabOrder = 0
    72       OnClick = btnPreviewClick
    73     end
    74   end
    75   object cboObjects: TORComboBox
     73      ShowAccelChar = True
     74    end
     75  end
     76  object cboObjects: TORComboBox [1]
    7677    Left = 0
    7778    Top = 0
    78     Width = 410
    79     Height = 246
     79    Width = 450
     80    Height = 226
    8081    Style = orcsSimple
    8182    Align = alClient
     
    8990    ListItemsOnly = True
    9091    LongList = True
     92    LookupPiece = 0
    9193    MaxLength = 0
    9294    Pieces = '2,3'
     
    9597    SynonymChars = '<Inactive>'
    9698    TabPositions = '50,60,70,80,90'
    97     TabOrder = 1
     99    TabOrder = 0
     100    TabStop = True
    98101    OnChange = cboObjectsChange
    99102    OnDblClick = cboObjectsDblClick
    100103    OnNeedData = cboObjectsNeedData
     104    CharsNeedMatch = 1
     105  end
     106  object pnlBottomSR: TPanel [2]
     107    Left = 0
     108    Top = 254
     109    Width = 450
     110    Height = 65
     111    Align = alBottom
     112    BevelOuter = bvNone
     113    TabOrder = 2
     114    object lblSRCont2: TVA508StaticText
     115      Name = 'lblSRCont2'
     116      AlignWithMargins = True
     117      Left = 24
     118      Top = 45
     119      Width = 423
     120      Height = 15
     121      Margins.Left = 24
     122      Margins.Top = 0
     123      Margins.Bottom = 0
     124      Align = alTop
     125      Alignment = taLeftJustify
     126      Caption =
     127        'speaking text that follows the template field, when the field re' +
     128        'ceives focus.'
     129      TabOrder = 3
     130      ShowAccelChar = True
     131    end
     132    object lblSRCont1: TVA508StaticText
     133      Name = 'lblSRCont1'
     134      AlignWithMargins = True
     135      Left = 10
     136      Top = 30
     137      Width = 437
     138      Height = 15
     139      Margins.Left = 10
     140      Margins.Top = 0
     141      Margins.Bottom = 0
     142      Align = alTop
     143      Alignment = taLeftJustify
     144      Caption =
     145        '*** Place this code after a template field to allow the screen r' +
     146        'eader to continue'
     147      TabOrder = 2
     148      ShowAccelChar = True
     149    end
     150    object lblSRStop: TVA508StaticText
     151      Name = 'lblSRStop'
     152      AlignWithMargins = True
     153      Left = 10
     154      Top = 15
     155      Width = 437
     156      Height = 15
     157      Margins.Left = 10
     158      Margins.Top = 0
     159      Margins.Bottom = 0
     160      Align = alTop
     161      Alignment = taLeftJustify
     162      Caption = '** Screen reader will stop speaking at this point'
     163      TabOrder = 1
     164      ShowAccelChar = True
     165    end
     166    object pnlSRIntro: TPanel
     167      Left = 0
     168      Top = 0
     169      Width = 450
     170      Height = 15
     171      Align = alTop
     172      BevelOuter = bvNone
     173      TabOrder = 0
     174      object lblSRIntro1: TVA508StaticText
     175        Name = 'lblSRIntro1'
     176        AlignWithMargins = True
     177        Left = 10
     178        Top = 0
     179        Width = 127
     180        Height = 15
     181        Margins.Left = 10
     182        Margins.Top = 0
     183        Margins.Bottom = 0
     184        Align = alLeft
     185        Alignment = taLeftJustify
     186        Caption = 'Screen Reader Codes'
     187        Font.Charset = DEFAULT_CHARSET
     188        Font.Color = clWindowText
     189        Font.Height = -11
     190        Font.Name = 'MS Sans Serif'
     191        Font.Style = [fsBold]
     192        ParentFont = False
     193        TabOrder = 0
     194        ShowAccelChar = True
     195      end
     196      object lblSRIntro2: TVA508StaticText
     197        Name = 'lblSRIntro2'
     198        Left = 140
     199        Top = 0
     200        Width = 310
     201        Height = 15
     202        Align = alClient
     203        Alignment = taLeftJustify
     204        Caption = '(make templates user friendly for those using screen readers)'
     205        TabOrder = 1
     206        ShowAccelChar = True
     207      end
     208    end
     209  end
     210  inherited amgrMain: TVA508AccessibilityManager
     211    Data = (
     212      (
     213        'Component = pnlBottom'
     214        'Status = stsDefault')
     215      (
     216        'Component = btnCancel'
     217        'Status = stsDefault')
     218      (
     219        'Component = btnInsert'
     220        'Status = stsDefault')
     221      (
     222        'Component = btnPreview'
     223        'Status = stsDefault')
     224      (
     225        'Component = cboObjects'
     226        'Status = stsDefault')
     227      (
     228        'Component = frmTemplateFields'
     229        'Status = stsDefault')
     230      (
     231        'Component = lblReq'
     232        'Status = stsDefault')
     233      (
     234        'Component = pnlBottomSR'
     235        'Status = stsDefault')
     236      (
     237        'Component = lblSRCont2'
     238        'Status = stsDefault')
     239      (
     240        'Component = lblSRCont1'
     241        'Status = stsDefault')
     242      (
     243        'Component = lblSRStop'
     244        'Status = stsDefault')
     245      (
     246        'Component = pnlSRIntro'
     247        'Status = stsDefault')
     248      (
     249        'Component = lblSRIntro1'
     250        'Status = stsDefault')
     251      (
     252        'Component = lblSRIntro2'
     253        'Status = stsDefault'))
    101254  end
    102255end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateFields.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ORCtrls, ComCtrls, StdCtrls, ExtCtrls;
     7  ORCtrls, ComCtrls, StdCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateFields = class(TForm)
     10  TfrmTemplateFields = class(TfrmBase508Form)
    1111    pnlBottom: TPanel;
    1212    btnCancel: TButton;
    1313    cboObjects: TORComboBox;
    1414    btnInsert: TButton;
    15     lblReq: TStaticText;
    1615    btnPreview: TButton;
     16    lblReq: TVA508StaticText;
     17    pnlBottomSR: TPanel;
     18    lblSRCont2: TVA508StaticText;
     19    lblSRCont1: TVA508StaticText;
     20    lblSRStop: TVA508StaticText;
     21    pnlSRIntro: TPanel;
     22    lblSRIntro1: TVA508StaticText;
     23    lblSRIntro2: TVA508StaticText;
    1724    procedure FormShow(Sender: TObject);
    1825    procedure FormCreate(Sender: TObject);
     
    2835{    Fre: TRichEdit;}
    2936    Fre: TCustomEdit;
     37    FInsertAllowed: boolean;
     38    FInitialized: boolean;
    3039    FAutoLongLines: TNotifyEvent;
    3140    procedure InsertField;
    3241{    procedure Setre(const Value: TRichEdit);}
    3342    procedure Setre(const Value: TCustomEdit);
     43    function ValidPreview: boolean;
     44    function ValidInsert: boolean;
    3445  public
    3546    procedure UpdateStatus;
     
    4758
    4859procedure TfrmTemplateFields.FormShow(Sender: TObject);
    49 begin
     60var
     61  i: integer;
     62begin
     63  if not FInitialized then
     64  begin
     65    with cboObjects do
     66    begin
     67      for i := low(ScreenReaderCodeLines) to high(ScreenReaderCodeLines) do
     68        Items.Add(ScreenReaderCodeLines[i]);
     69      InsertSeparator;
     70      InitLongList('');
     71    end;
     72    FInitialized := TRUE;
     73  end;
    5074  cboObjects.SelectAll;
    5175  cboObjects.SetFocus;
     
    5478procedure TfrmTemplateFields.FormCreate(Sender: TObject);
    5579begin
    56   cboObjects.InitLongList('');
    57   cboObjects.ItemHeight := 15;
    58   ResizeAnchoredFormToFont(self);
    59   //ResizeAnchoredFormToFont doesn't work right on the button positions for some reason.
    60   btnCancel.Left := pnlBottom.ClientWidth - btnCancel.Width;
    61   btnInsert.Left := btnCancel.Left - btnInsert.Width - 8;
     80  ResizeFormToFont(self);
     81  cboObjects.ItemHeight := lblReq.Height - 1;
     82  FInsertAllowed := TRUE;
     83  lblReq.Top := (pnlBottom.Height - lblReq.Height);
     84  pnlSRIntro.Height := lblSRStop.Height;
     85  pnlBottomSR.Height := lblSRCont1.Height * 4 + 5;
    6286end;
    6387
     
    76100var
    77101  cnt: integer;
    78 
    79 begin
     102  p1, p2: string;
     103  check: boolean;
     104  i: integer;
     105
     106begin
     107  p1 := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
     108  if p1 = '' then exit;
    80109  if assigned(Fre) and (not TORExposedCustomEdit(Fre).ReadOnly) and (cboObjects.ItemIndex >= 0) then
    81110  begin
     
    83112      cnt := TRichEdit(FRe).Lines.Count
    84113    else
    85       cnt :=0;
    86     Fre.SelText := TemplateFieldBeginSignature +
    87                    Piece(cboObjects.Items[cboObjects.ItemIndex],U,2)+
    88                    TemplateFieldEndSignature;
     114      cnt := 0;
     115    if StrToIntDef(p1, 0) < 0 then
     116    begin
     117      check := true;
     118      for i := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
     119      begin
     120        if p1 = ScreenReaderCodeIDs[i] then
     121        begin
     122          p2 := ScreenReaderCodes[i];
     123          check := FALSE;
     124          break;
     125        end;
     126      end;
     127    end
     128    else
     129      check := TRUE;
     130    if check then
     131      p2 := TemplateFieldBeginSignature + Piece(cboObjects.Items[cboObjects.ItemIndex],U,2) +
     132            TemplateFieldEndSignature;
     133    Fre.SelText := p2;
    89134    if Fre is TRichEdit then
    90135      if(assigned(FAutoLongLines) and (cnt <> TRichEdit(FRe).Lines.Count)) then
     
    95140procedure TfrmTemplateFields.cboObjectsDblClick(Sender: TObject);
    96141begin
    97   if btnInsert.Enabled then
     142  if ValidInsert then
    98143    InsertField;
    99144end;
     
    118163procedure TfrmTemplateFields.UpdateStatus;
    119164begin
    120   btnInsert.Enabled := (not TORExposedCustomEdit(re).ReadOnly);
     165  FInsertAllowed := (not TORExposedCustomEdit(re).ReadOnly);
     166  btnInsert.Enabled := ValidInsert and FInsertAllowed;
     167end;
     168
     169function TfrmTemplateFields.ValidInsert: boolean;
     170begin
     171  Result := (cboObjects.ItemIndex >= 0);
     172  if Result then
     173    Result := (Piece(cboObjects.Items[cboObjects.ItemIndex],U,1) <> '');
     174end;
     175
     176function TfrmTemplateFields.ValidPreview: boolean;
     177var
     178  i: integer;
     179  code: string;
     180begin
     181  Result := ValidInsert;
     182  if Result then
     183  begin
     184    code := Piece(cboObjects.Items[cboObjects.ItemIndex],U,1);
     185    for I := low(ScreenReaderCodeIDs) to high(ScreenReaderCodeIDs) do
     186    begin
     187      if code = ScreenReaderCodeIDs[i] then
     188      begin
     189        Result := FALSE;
     190        break;
     191      end;
     192    end;
     193  end;
    121194end;
    122195
    123196procedure TfrmTemplateFields.btnInsertClick(Sender: TObject);
    124197begin
    125   InsertField;
     198  if ValidInsert then
     199    InsertField;
    126200end;
    127201
     
    147221procedure TfrmTemplateFields.cboObjectsChange(Sender: TObject);
    148222begin
    149   btnPreview.Enabled := (cboObjects.ItemIndex >= 0)
     223  btnPreview.Enabled := ValidPreview;
     224  btnInsert.Enabled := ValidInsert and FInsertAllowed;
    150225end;
    151226
  • cprs/trunk/CPRS-Chart/Templates/fTemplateImport.dfm

    r456 r829  
    1 object frmTemplateImport: TfrmTemplateImport
     1inherited frmTemplateImport: TfrmTemplateImport
    22  Left = 273
    33  Top = 195
     
    77  ClientHeight = 132
    88  ClientWidth = 288
    9   Color = clBtnFace
    10   Font.Charset = DEFAULT_CHARSET
    11   Font.Color = clWindowText
    12   Font.Height = -11
    13   Font.Name = 'MS Sans Serif'
    14   Font.Style = []
    159  FormStyle = fsStayOnTop
    16   OldCreateOrder = False
    1710  Position = poScreenCenter
    1811  PixelsPerInch = 96
    1912  TextHeight = 13
    20   object gaugeImport: TGauge
     13  object gaugeImport: TGauge [0]
    2114    Left = 8
    2215    Top = 82
    2316    Width = 272
    2417    Height = 21
    25     ForeColor = clNavy
     18    BackColor = clHighlightText
     19    ForeColor = clHighlight
     20    Font.Charset = DEFAULT_CHARSET
     21    Font.Color = clCaptionText
     22    Font.Height = -11
     23    Font.Name = 'MS Sans Serif'
     24    Font.Style = []
     25    ParentFont = False
    2626    Progress = 0
    2727  end
    28   object lblImporting: TStaticText
     28  object lblImporting: TStaticText [1]
    2929    Left = 8
    3030    Top = 4
     
    3737    TabOrder = 0
    3838  end
    39   object animImport: TAnimate
     39  object animImport: TAnimate [2]
    4040    Left = 8
    4141    Top = 20
     
    4444    Active = True
    4545    CommonAVI = aviCopyFile
    46     StopFrame = 26
     46    StopFrame = 20
    4747  end
    48   object btnCancel: TButton
     48  object btnCancel: TButton [3]
    4949    Left = 106
    5050    Top = 106
     
    5757    OnClick = btnCancelClick
    5858  end
     59  inherited amgrMain: TVA508AccessibilityManager
     60    Data = (
     61      (
     62        'Component = lblImporting'
     63        'Status = stsDefault')
     64      (
     65        'Component = animImport'
     66        'Status = stsDefault')
     67      (
     68        'Component = btnCancel'
     69        'Status = stsDefault')
     70      (
     71        'Component = frmTemplateImport'
     72        'Status = stsDefault'))
     73  end
    5974end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateImport.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   Gauges, StdCtrls, ComCtrls;
     7  Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
    88
    99type
    10   TfrmTemplateImport = class(TForm)
     10  TfrmTemplateImport = class(TfrmBase508Form)
    1111    animImport: TAnimate;
    1212    btnCancel: TButton;
  • cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.dfm

    r456 r829  
    1 object frmTemplateObjects: TfrmTemplateObjects
     1inherited frmTemplateObjects: TfrmTemplateObjects
    22  Left = 215
    33  Top = 343
    4   Width = 247
    5   Height = 300
    64  ActiveControl = cboObjects
    75  Caption = 'Insert Patient Data (Object)'
    8   Color = clBtnFace
    9   Font.Charset = DEFAULT_CHARSET
    10   Font.Color = clWindowText
    11   Font.Height = -11
    12   Font.Name = 'MS Sans Serif'
    13   Font.Style = []
     6  ClientHeight = 273
     7  ClientWidth = 239
    148  FormStyle = fsStayOnTop
    15   OldCreateOrder = False
    169  Position = poOwnerFormCenter
    1710  OnClose = FormClose
    1811  OnShow = FormShow
     12  ExplicitWidth = 247
     13  ExplicitHeight = 300
    1914  PixelsPerInch = 96
    2015  TextHeight = 13
    21   object cboObjects: TORComboBox
     16  object cboObjects: TORComboBox [0]
    2217    Left = 0
    2318    Top = 0
     
    4237    TabOrder = 0
    4338    OnDblClick = cboObjectsDblClick
     39    CharsNeedMatch = 1
    4440  end
    45   object pnlBottom: TPanel
     41  object pnlBottom: TPanel [1]
    4642    Left = 0
    4743    Top = 246
     
    9187    end
    9288  end
     89  inherited amgrMain: TVA508AccessibilityManager
     90    Data = (
     91      (
     92        'Component = cboObjects'
     93        'Status = stsDefault')
     94      (
     95        'Component = pnlBottom'
     96        'Status = stsDefault')
     97      (
     98        'Component = btnCancel'
     99        'Status = stsDefault')
     100      (
     101        'Component = btnInsert'
     102        'Status = stsDefault')
     103      (
     104        'Component = btnRefresh'
     105        'Status = stsDefault')
     106      (
     107        'Component = frmTemplateObjects'
     108        'Status = stsDefault'))
     109  end
    93110end
  • cprs/trunk/CPRS-Chart/Templates/fTemplateObjects.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared;
     7  ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ORFn, dShared, uTemplates, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateObjects = class(TForm)
     11  TfrmTemplateObjects = class(TfrmBase508Form)
    1112    cboObjects: TORComboBox;
    1213    pnlBottom: TPanel;
     
    9394
    9495procedure TfrmTemplateObjects.btnRefreshClick(Sender: TObject);
     96var
     97  i: integer;
     98  DoIt: boolean;
    9599begin
    96 cboObjects.SelectAll;
    97 cboObjects.Clear;
    98 dmodShared.RefreshObject := true;
    99 dmodShared.LoadTIUObjects;
    100 CboOBJECTS.Items.AddStrings(dmodShared.TIUObjects);
     100  cboObjects.Clear;
     101  dmodShared.RefreshObject := true;
     102  dmodShared.LoadTIUObjects;
     103  //---------- CQ #8665 - RV ----------------
     104  DoIt := TRUE;
     105  UpdatePersonalObjects;
     106  if uPersonalObjects.Count > 0 then
     107  begin
     108    DoIt := FALSE;
     109    for i := 0 to dmodShared.TIUObjects.Count-1 do
     110      if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
     111        cboObjects.Items.Add(dmodShared.TIUObjects[i]);
     112  end;
     113  if DoIt then
     114  //---------- end CQ #8665 ------------------
     115    cboObjects.Items.Assign(dmodShared.TIUObjects);
    101116end;
    102117
    103118end.
     119
  • cprs/trunk/CPRS-Chart/Templates/fTemplateView.dfm

    r456 r829  
    1 object frmTemplateView: TfrmTemplateView
     1inherited frmTemplateView: TfrmTemplateView
    22  Left = 257
    33  Top = 105
    4   Width = 578
    5   Height = 372
    64  Caption = 'View Template'
    7   Color = clBtnFace
    8   Font.Charset = DEFAULT_CHARSET
    9   Font.Color = clWindowText
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    12   Font.Style = []
    13   OldCreateOrder = False
     5  ClientHeight = 343
     6  ClientWidth = 568
    147  Position = poScreenCenter
    158  OnClose = FormClose
    169  OnCreate = FormCreate
    1710  OnDestroy = FormDestroy
    18   OnShow = FormShow
     11  ExplicitWidth = 576
     12  ExplicitHeight = 370
    1913  PixelsPerInch = 96
    2014  TextHeight = 13
    21   object pnlBottom: TPanel
     15  object pnlBottom: TPanel [0]
    2216    Left = 0
    23     Top = 315
    24     Width = 570
     17    Top = 313
     18    Width = 568
    2519    Height = 30
    2620    Align = alBottom
     
    2822    TabOrder = 1
    2923    DesignSize = (
    30       570
     24      568
    3125      30)
    3226    object btnClose: TButton
    33       Left = 494
     27      Left = 492
    3428      Top = 6
    3529      Width = 75
     
    5246    end
    5347    object btnPrint: TButton
    54       Left = 414
     48      Left = 412
    5549      Top = 6
    5650      Width = 75
     
    6256    end
    6357  end
    64   object reMain: TRichEdit
     58  object reMain: TRichEdit [1]
    6559    Left = 0
    6660    Top = 0
    67     Width = 570
    68     Height = 315
     61    Width = 568
     62    Height = 313
    6963    Align = alClient
    7064    Color = clCream
     
    8276    WantReturns = False
    8377    WordWrap = False
     78  end
     79  inherited amgrMain: TVA508AccessibilityManager
     80    Data = (
     81      (
     82        'Component = pnlBottom'
     83        'Status = stsDefault')
     84      (
     85        'Component = btnClose'
     86        'Status = stsDefault')
     87      (
     88        'Component = cbStayOnTop'
     89        'Status = stsDefault')
     90      (
     91        'Component = btnPrint'
     92        'Status = stsDefault')
     93      (
     94        'Component = reMain'
     95        'Status = stsDefault')
     96      (
     97        'Component = frmTemplateView'
     98        'Status = stsDefault'))
    8499  end
    85100  object popView: TPopupMenu
  • cprs/trunk/CPRS-Chart/Templates/fTemplateView.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn;
     7  StdCtrls, ComCtrls, ExtCtrls, Menus, ORFn, fBase508Form,
     8  VA508AccessibilityManager;
    89
    910type
    10   TfrmTemplateView = class(TForm)
     11  TfrmTemplateView = class(TfrmBase508Form)
    1112    pnlBottom: TPanel;
    1213    reMain: TRichEdit;
     
    2627    procedure SelectAll1Click(Sender: TObject);
    2728    procedure btnPrintClick(Sender: TObject);
     29    procedure AlignButtons();
    2830    procedure FormCreate(Sender: TObject);
    29     procedure FormShow(Sender: TObject);
    3031  private
    3132  end;
     
    5253  if(not assigned(frmTemplateView)) then
    5354    frmTemplateView := TfrmTemplateView.Create(Application);
    54   ResizeAnchoredFormToFont(frmTemplateView);
     55  //Quick fix to work around glich in resize algorithm
     56  frmTemplateView.AlignButtons();
    5557  frmTemplateView.reMain.Lines.Clear;
    5658  frmTemplateView.Caption := 'Template: ' + Title;
     
    8082  SaveUserBounds(frmTemplateView);
    8183  Action := caFree;
     84end;
     85
     86procedure TfrmTemplateView.FormCreate(Sender: TObject);
     87begin
     88  inherited;
     89  ResizeAnchoredFormToFont(Self);
     90  SetFormPosition(Self);
    8291end;
    8392
     
    118127end;
    119128
    120 procedure TfrmTemplateView.FormCreate(Sender: TObject);
     129procedure TfrmTemplateView.AlignButtons;
     130Const
     131  BtnSpace = 8;
    121132begin
    122   reMain.Color := ReadOnlyColor;
    123 end;
    124 
    125 procedure TfrmTemplateView.FormShow(Sender: TObject);
    126 begin
    127   SetFormPosition(frmTemplateView);
     133  btnClose.Left := frmTemplateView.Width - btnClose.Width - BtnSpace;
     134  btnPrint.Left := btnClose.Left - BtnSpace - btnPrint.Width;
    128135end;
    129136
  • cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.dfm

    r456 r829  
    22  Left = 0
    33  Top = 0
    4   Width = 109
     4  Width = 136
    55  Height = 14
     6  AutoScroll = True
    67  Font.Charset = ANSI_CHARSET
    78  Font.Color = clWindowText
     
    1213  TabOrder = 0
    1314  TabStop = True
    14   OnEnter = pnlBtnEnter
    15   OnExit = pnlBtnExit
     15  OnEnter = FrameEnter
     16  OnExit = FrameExit
    1617  object pnlBtn: TPanel
    1718    Left = 0
    1819    Top = 0
    19     Width = 109
     20    Width = 136
    2021    Height = 14
    2122    Align = alClient
    2223    TabOrder = 0
     24    OnExit = FrameExit
    2325    OnMouseDown = pnlBtnMouseDown
    2426    OnMouseUp = pnlBtnMouseUp
     27    DesignSize = (
     28      136
     29      14)
    2530    object lblText: TLabel
    2631      Left = 2
    2732      Top = -1
    28       Width = 105
     33      Width = 132
    2934      Height = 14
    3035      Alignment = taCenter
     
    3540      OnMouseDown = pnlBtnMouseDown
    3641      OnMouseUp = pnlBtnMouseUp
     42      ExplicitWidth = 105
    3743    end
    3844    object pbFocus: TPaintBox
    3945      Left = 1
    4046      Top = 1
    41       Width = 107
     47      Width = 134
    4248      Height = 12
    4349      Align = alClient
     
    4551      OnMouseUp = pnlBtnMouseUp
    4652      OnPaint = pbFocusPaint
     53      ExplicitWidth = 107
    4754    end
    4855  end
  • cprs/trunk/CPRS-Chart/Templates/mTemplateFieldButton.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ExtCtrls;
     7  StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
    88
    99type
    10   TfraTemplateFieldButton = class(TFrame)
     10  TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent)
    1111    pnlBtn: TPanel;
    1212    lblText: TLabel;
     
    1616    procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
    1717      Shift: TShiftState; X, Y: Integer);
    18     procedure pnlBtnEnter(Sender: TObject);
    19     procedure pnlBtnExit(Sender: TObject);
     18    procedure FrameEnter(Sender: TObject);
     19    procedure FrameExit(Sender: TObject);
    2020    procedure pbFocusPaint(Sender: TObject);
    2121  private
     22    FCPRSDialogData: ICPRSDialogComponent;
    2223    FBtnDown: boolean;
    2324    FItems: TStringList;
     
    3334    property Items: TStringList read FItems;
    3435    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     36    property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent;
    3537  end;
    3638
     
    4042
    4143uses
    42   ORFn;
    43  
     44  ORFn, VA508AccessibilityRouter;
     45
    4446procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
    4547  Shift: TShiftState; X, Y: Integer);
     
    6971        idx := 0;
    7072      ButtonText := FItems[idx];
     73      if ScreenReaderSystemActive then
     74      begin
     75        txt := FItems[idx];
     76        if Trim(txt) = '' then
     77          txt := 'blank';
     78        GetScreenReader.Speak(txt);
     79      end;
    7180      if assigned(FOnChange) then
    7281        FOnChange(Self);
     
    8695end;
    8796
    88 procedure TfraTemplateFieldButton.pnlBtnEnter(Sender: TObject);
     97type
     98  TWinControlFriend = class(TWinControl);
     99 
     100procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
    89101begin
    90102  pbFocus.Invalidate;
    91103end;
    92104
    93 procedure TfraTemplateFieldButton.pnlBtnExit(Sender: TObject);
     105procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
    94106begin
    95107  pbFocus.Invalidate;
     
    98110constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
    99111begin
    100   inherited;
     112  inherited Create(AOwner);
     113  TabStop := TRUE;
    101114  FItems := TStringList.Create;
    102115  OnKeyDown := ButtonKeyDown;
    103116  OnKeyUp := ButtonKeyUp;
    104117  Font.Size := MainFontSize;
     118  FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button');
    105119end;
    106120
     
    142156begin
    143157  FItems.Free;
     158  FCPRSDialogData := nil;
    144159  inherited;
    145160end;
    146161
     162initialization
     163  SpecifyFormIsNotADialog(TfraTemplateFieldButton);
     164
    147165end.
  • cprs/trunk/CPRS-Chart/Templates/rTemplates.pas

    r456 r829  
    105105    CallBroker;
    106106    RPCBrokerV.Results.Delete(0);
    107     BoilerPlate.Assign(RPCBrokerV.Results);
     107    FastAssign(RPCBrokerV.Results, BoilerPlate);
    108108    RPCBrokerV.Results.Clear;
    109109  end;
     
    260260  TmpList := TStringList.Create;
    261261  try
    262     TmpList.Assign(RPCBrokerV.Results);
     262    FastAssign(RPCBrokerV.Results, TmpList);
    263263    SortByPiece(TmpList, U, 2);
    264264    MixedCaseList(TmpList);
    265     RPCBrokerV.Results.Assign(TmpList);
     265    FastAssign(TmpList, RPCBrokerV.Results);
    266266  finally
    267267    TmpList.Free;
     
    377377begin
    378378  CallV('TIU FIELD CHECK',[nil]);
    379   ResultString.Assign(RPCBrokerV.Results);
     379  FastAssign(RPCBrokerV.Results, ResultString);
    380380end;
    381381
     
    398398    CallBroker;
    399399  end;
    400   Text.Assign(RPCBrokerV.Results);
     400  FastAssign(RPCBrokerV.Results, Text);
    401401end;
    402402
     
    449449  Result := TRUE;
    450450  CallV('TIU FIELD LIST IMPORT',[nil]);
    451   ResultSet.Assign(RPCBrokerV.Results);
     451  FastAssign(RPCBrokerV.Results, ResultSet);
    452452  if ResultSet.Count < 1 then
    453453    Result := FALSE;
  • cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas

    r456 r829  
    55uses
    66  Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
    7   Graphics, ORClasses, ComCtrls, ORDtTm;
     7  Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils;
    88
    99type
    1010  TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
    11                         dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
     11    dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText,
     12// keep dftScreenReader as last entry - users can not create this type of field
     13    dftScreenReader);
    1214
    1315  TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
     
    3032    FID: string;
    3133    FFont: TFont;
    32     FPanel: TPanel;
     34    FPanel: TDlgFieldPanel;
    3335    FControls: TStringList;
    3436    FIndents: TStringList;
     
    4749    procedure SetFieldValues(const Value: string);
    4850    procedure SetAutoDestroyOnPanelFree(const Value: boolean);
     51    function StripCode(var txt: string; code: char): boolean;
    4952  protected
    5053    procedure UpDownChange(Sender: TObject);
     
    5760    constructor Create(AParent: TWinControl; AID, Text: string);
    5861    destructor Destroy; override;
    59     function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
     62    function GetPanel(MaxLen: integer; AParent: TWinControl;
     63                      OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
    6064    function GetText: string;
    6165    property Text: string read FText write FText;
     
    174178procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
    175179function StripEmbedded(iItems: string): string;
     180procedure StripScreenReaderCodes(var Text: string); overload;
     181procedure StripScreenReaderCodes(SL: TStrings); overload;
     182function HasScreenReaderBreakCodes(SL: TStrings): boolean;
    176183
    177184const
    178   TemplateFieldBeginSignature = '{FLD:';
     185  TemplateFieldSignature = '{FLD';
     186  TemplateFieldBeginSignature = TemplateFieldSignature + ':';
    179187  TemplateFieldEndSignature = '}';
     188  ScreenReaderCodeSignature = '{SR-';
     189  ScreenReaderCodeType = '  Screen Reader Code';
     190  ScreenReaderCodeCount = 2;
     191  ScreenReaderShownCount = 1;
     192  ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature;
     193  ScreenReaderStopCodeLen = Length(ScreenReaderStopCode);
     194  ScreenReaderStopCodeID = '-43';
     195  ScreenReaderStopName = 'SCREEN READER STOP CODE **';
     196  ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType;
     197  ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature;
     198  ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode);
     199  ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature;
     200  ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld);
     201  ScreenReaderContinueCodeID = '-44';
     202  ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***';
     203  ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType;
    180204  MissingFieldsTxt = 'One or more required fields must still be entered.';
     205
     206  ScreenReaderCodes:     array[0..ScreenReaderCodeCount] of string  =
     207      (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld);
     208  ScreenReaderCodeLens:  array[0..ScreenReaderCodeCount] of integer =
     209      (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen);
     210  ScreenReaderCodeIDs:   array[0..ScreenReaderShownCount] of string  =
     211      (ScreenReaderStopCodeID, ScreenReaderContinueCodeID);
     212  ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string  =
     213      (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine);
    181214
    182215  TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
     
    191224                         {  dftHyperlink    }  'H',
    192225                         {  dftWP           }  'W',
    193                          {  dftText         }  'T');
     226                         {  dftText         }  'T',
     227                         {  dftScreenReader }  'S');
    194228
    195229  TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
    196230                         {  dftUnknown      } (('',''),
    197                          {  dftEditBox      }  ('Edit Box',       'Edit'),
    198                          {  dftComboBox     }  ('Combo Box',      'Combo'),
    199                          {  dftButton       }  ('Button',         'Button'),
    200                          {  dftCheckBoxes   }  ('Check Boxes',    'Check'),
    201                          {  dftRadioButtons }  ('Radio Buttons',  'Radio'),
    202                          {  dftDate         }  ('Date',           'Date'),
    203                          {  dftNumber       }  ('Number',         'Num'),
    204                          {  dftHyperlink    }  ('Hyperlink',      'Link'),
    205                          {  dftWP           }  ('Word Processing','WP'),
    206                          {  dftWP           }  ('Display Text',   'Text'));
     231                         {  dftEditBox      }  ('Edit Box',           'Edit'),
     232                         {  dftComboBox     }  ('Combo Box',          'Combo'),
     233                         {  dftButton       }  ('Button',             'Button'),
     234                         {  dftCheckBoxes   }  ('Check Boxes',        'Check'),
     235                         {  dftRadioButtons }  ('Radio Buttons',      'Radio'),
     236                         {  dftDate         }  ('Date',               'Date'),
     237                         {  dftNumber       }  ('Number',             'Num'),
     238                         {  dftHyperlink    }  ('Hyperlink',          'Link'),
     239                         {  dftWP           }  ('Word Processing',    'WP'),
     240                         {  dftText         }  ('Display Text',       'Text'),
     241                         {  dftScreenReader }  ('Screen Reader Stop', 'SRStop'));
    207242
    208243  TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
     
    226261                   { dftHyperlink    }  'LINK',
    227262                   { dftWP           }  'WRDP',
    228                    { dftTExt         }  'TEXT');
     263                   { dftTExt         }  'TEXT',
     264                   { dftScreenReader }  'SRST');
    229265
    230266  TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
     
    239275  MaxTFWPLines = 20;
    240276  MaxTFEdtLen = 70;
    241 
    242 type
    243   TFieldPanel = class(TPanel)  {This is the panel associated with the child}
    244   private                      {dialog checkboxes in reminders dialogs}
    245     FOnDestroy: TNotifyEvent;
    246     FCanvas: TControlCanvas;    {used to draw focus rect}
    247     function GetFocus: boolean;
    248     procedure SetTheFocus(const Value: boolean);
    249   protected                     {used to draw focus rect}
    250     procedure Paint; override;  {used to draw focus rect}
    251   public
    252     destructor Destroy; override;
    253     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    254     property Focus:  boolean read GetFocus write SetTheFocus; {to draw focus rect}
    255     property OnKeyPress;        {to click the checkbox when spacebar is pressed}
    256   end;
    257 
     277 
    258278implementation
    259279
    260280uses
    261   ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows;
     281  rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
     282  VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter;
    262283
    263284const
     
    279300  FieldIDLen = 6;
    280301  NewLine = 'NL';
    281 
    282 type
    283   TFieldLabel = class(TLabel)
    284   private
    285     FExclude: boolean;
    286   public
    287     property Exclude: boolean read FExclude;
    288   end;
    289  
    290   TWebLabel = class(TFieldLabel)
    291   private
    292     FAddr: string;
    293     procedure Clicked(Sender: TObject);
    294   public
    295     procedure Init(Addr: string);
    296   end;
    297302
    298303function GetNewFieldID: string;
     
    694699  Result := (msg <> '');
    695700  if(Result) then
    696     ShowMessage(msg);
     701    ShowMsg(msg);
    697702end;
    698703
     
    861866          AList.Add('');
    862867        AList.Add('The following inactive template fields were found:');
    863         AList.AddStrings(InactiveList);
     868        FastAddStrings(InactiveList, AList);
    864869      end;
    865870      if(AList.Count > 0) then
     
    10791084  dbox: TORDateBox;
    10801085  dcbo: TORDateCombo;
    1081   lbl: TFieldLabel;
     1086  lbl: TCPRSTemplateFieldLabel;
    10821087  re: TRichEdit;
    1083   pnl: TPanel;
    1084   ud: TUpDown;
     1088  pnl: TCPRSDialogNumber;
    10851089  DefDate: TFMDateTime;
    10861090  ctrl: TControl;
     
    11231127      dftEditBox:
    11241128        begin
    1125           edt := TEdit.Create(nil);
     1129          edt := TCPRSDialogFieldEdit.Create(nil);
     1130          (edt as ICPRSDialogComponent).RequiredField := Required;
    11261131          edt.Parent := Entry.FPanel;
    11271132          edt.BorderStyle := bsNone;
     
    11351140          edt.Tag := CtrlID;
    11361141          edt.OnChange := Entry.DoChange;
     1142          UpdateColorsFor508Compliance(edt, TRUE);
    11371143          ctrl := edt;
    11381144        end;
     
    11401146      dftComboBox:
    11411147        begin
    1142           cbo := TORComboBox.Create(nil);
     1148          cbo := TCPRSDialogComboBox.Create(nil);
     1149          (cbo as ICPRSDialogComponent).RequiredField := Required;
    11431150          cbo.Parent := Entry.FPanel;
    11441151          cbo.TemplateField := TRUE;
     
    11651172            cbo.DropDownCount := cbo.Items.Count;
    11661173          end;
     1174          UpdateColorsFor508Compliance(cbo, TRUE);
    11671175          ctrl := cbo;
    11681176        end;
     
    11711179        begin
    11721180          btn := TfraTemplateFieldButton.Create(nil);
     1181          (btn as ICPRSDialogComponent).RequiredField := Required;
    11731182          btn.Parent := Entry.FPanel;
    11741183          {Clear out embedded fields}
     
    11791188          btn.Tag := CtrlID;
    11801189          btn.OnChange := Entry.DoChange;
     1190          UpdateColorsFor508Compliance(btn);
    11811191          ctrl := btn;
    11821192        end;
     
    11921202            for i := 0 to TmpSL.Count-1 do
    11931203            begin
    1194               cb := TORCheckBox.Create(nil);
     1204              cb := TCPRSDialogCheckBox.Create(nil);
     1205              if i = 0 then
     1206                (cb as ICPRSDialogComponent).RequiredField := Required;
    11951207              cb.Parent := Entry.FPanel;
    11961208              cb.Caption := TmpSL[i];
     
    12101222                cb.StringData := NewLine;
    12111223              cb.OnClick := Entry.DoChange;
     1224              UpdateColorsFor508Compliance(cb);
    12121225              inc(Index);
    12131226              Entry.FControls.InsertObject(Index, '', cb);
     
    12281241          if FDateType in DateComboTypes then
    12291242          begin
    1230             dcbo := TORDateCombo.Create(nil);
     1243            dcbo := TCPRSDialogDateCombo.Create(nil);
     1244            (dcbo as ICPRSDialogComponent).RequiredField := Required;
    12311245            dcbo.Parent := Entry.FPanel;
    12321246            dcbo.Tag := CtrlID;
     
    12371251            dcbo.TemplateField := TRUE;
    12381252            dcbo.OnChange := Entry.DoChange;
     1253            UpdateColorsFor508Compliance(dcbo, TRUE);
    12391254            ctrl := dcbo;
    12401255          end
    12411256          else
    12421257          begin
    1243             dbox := TORDateBox.Create(nil);
     1258            dbox := TCPRSDialogDateBox.Create(nil);
     1259            (dbox as ICPRSDialogComponent).RequiredField := Required;
    12441260            dbox.Parent := Entry.FPanel;
    12451261            dbox.Tag := CtrlID;
     
    12541270            dbox.Width := (wdth * tmp) + 18;
    12551271            dbox.OnChange := Entry.DoChange;
     1272            UpdateColorsFor508Compliance(dbox, TRUE);
    12561273            ctrl := dbox;
    12571274          end;
     
    12601277      dftNumber:
    12611278        begin
    1262           pnl := TPanel.Create(nil);
     1279          pnl := TCPRSDialogNumber.CreatePanel(nil);
     1280          (pnl as ICPRSDialogComponent).RequiredField := Required;
    12631281          pnl.Parent := Entry.FPanel;
    12641282          pnl.BevelOuter := bvNone;
    12651283          pnl.Tag := CtrlID;
    1266           edt := TEdit.Create(pnl);
    1267           edt.Parent := pnl;
    1268           edt.BorderStyle := bsNone;
    1269           edt.Height := ht;
    1270           edt.Width := (wdth * 5 + 4);
    1271           edt.Top := 0;
    1272           edt.Left := 0;
    1273           edt.AutoSelect := True;
    1274           ud := TUpDown.Create(pnl);
    1275           ud.Parent := pnl;
    1276           ud.Associate := edt;
    1277           ud.Min := MinVal;
    1278           ud.Max := MaxVal;
    1279           ud.Min := MinVal; // Both ud.Min settings are needeed!
     1284          pnl.Edit.Height := ht;
     1285          pnl.Edit.Width := (wdth * 5 + 4);
     1286          pnl.UpDown.Min := MinVal;
     1287          pnl.UpDown.Max := MaxVal;
     1288          pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed!
    12801289          i := Increment;
    12811290          if i < 1 then i := 1;
    1282           ud.Increment := i;
    1283           ud.Thousands := FALSE;
    1284           ud.Position := StrToIntDef(EditDefault, 0);
    1285           edt.Tag := Integer(ud);
    1286           edt.OnChange := Entry.UpDownChange;
    1287           pnl.Height := edt.Height;
    1288           pnl.Width := edt.Width + ud.Width;
     1291          pnl.UpDown.Increment := i;
     1292          pnl.UpDown.Position := StrToIntDef(EditDefault, 0);
     1293          pnl.Edit.OnChange := Entry.UpDownChange;
     1294          pnl.Height := pnl.Edit.Height;
     1295          pnl.Width := pnl.Edit.Width + pnl.UpDown.Width;
     1296          UpdateColorsFor508Compliance(pnl, TRUE);
    12891297          ctrl := pnl;
    12901298        end;
     
    12931301        begin
    12941302          if (FFldType = dftHyperlink) and User.WebAccess then
    1295             lbl := TWebLabel.Create(nil)
     1303            lbl := TCPRSDialogHyperlinkLabel.Create(nil)
    12961304          else
    1297             lbl := TFieldLabel.Create(nil);
     1305            lbl := TCPRSTemplateFieldLabel.Create(nil);
    12981306          lbl.Parent := Entry.FPanel;
    12991307          lbl.ShowAccelChar := FALSE;
    1300           lbl.FExclude := FSepLines;
     1308          lbl.Exclude := FSepLines;
    13011309          if (FFldType = dftHyperlink) then
    13021310          begin
     
    13131321            lbl.Caption := STmp;
    13141322          end;
    1315           if lbl is TWebLabel then
    1316             TWebLabel(lbl).Init(FURL);
     1323          if lbl is TCPRSDialogHyperlinkLabel then
     1324            TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
    13171325          lbl.Tag := CtrlID;
     1326          UpdateColorsFor508Compliance(lbl);
    13181327          ctrl := lbl;
    13191328        end;
     
    13211330      dftWP:
    13221331        begin
    1323           re := TRichEdit.Create(nil);
     1332          re := TCPRSDialogRichEdit.Create(nil);
     1333          (re as ICPRSDialogComponent).RequiredField := Required;
    13241334          re.Parent := Entry.FPanel;
    13251335          re.Tag := CtrlID;
     
    13391349          re.Lines.Text := Items;
    13401350          re.OnChange := Entry.DoChange;
     1351          UpdateColorsFor508Compliance(re, TRUE);
    13411352          ctrl := re;
    13421353        end;
     
    13581369    Result := FLocked;
    13591370    if(not FLocked) then
    1360       ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.');
     1371      ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
    13611372  end
    13621373  else
     
    17071718const
    17081719  EOL_MARKER = #182;
     1720  SR_BREAK   = #186;
    17091721
    17101722procedure PanelDestroy(AData: Pointer; Sender: TObject);
     
    17371749  FControls.Text := Text;
    17381750  if(FControls.Count > 1) then
     1751  begin
    17391752    for i := 1 to FControls.Count-1 do
    17401753      FControls[i] := EOL_MARKER + FControls[i];
     1754    if not ScreenReaderSystemActive then
     1755      StripScreenReaderCodes(FControls);
     1756  end;
    17411757  FFirstBuild := TRUE;
    1742   FPanel := TFieldPanel.Create(AParent.Owner);
     1758  FPanel := TDlgFieldPanel.Create(AParent.Owner);
    17431759  FPanel.Parent := AParent;
    17441760  FPanel.BevelOuter := bvNone;
    17451761  FPanel.Caption := '';
    17461762  FPanel.Font.Assign(FFont);
     1763  UpdateColorsFor508Compliance(FPanel, TRUE);
    17471764  idx := 0;
    17481765  while (idx < FControls.Count) do
     
    17711788          FControls[idx] := copy(txt,1,i-1);
    17721789          if(Fld.Required) then
     1790          begin
     1791            if ScreenReaderSystemActive then
     1792            begin
     1793              if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
     1794                FControls[idx] := FControls[idx] + ScreenReaderStopCode;
     1795            end;
    17731796            FControls[idx] := FControls[idx] + '*';
     1797          end;
    17741798          Fld.CreateDialogControls(Self, idx, CtrlID);
    17751799          FControls.Insert(idx+1,copy(txt,i,MaxInt));
     
    17891813    end;
    17901814    inc(idx);
     1815  end;
     1816  if ScreenReaderSystemActive then
     1817  begin
     1818    idx := 0;
     1819    while (idx < FControls.Count) do
     1820    begin
     1821      txt := FControls[idx];
     1822      i := pos(ScreenReaderStopCode, txt);
     1823      if i > 0 then
     1824      begin
     1825        FControls[idx] := copy(txt, 1, i-1);
     1826        txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt);
     1827        FControls.Insert(idx+1, SR_BREAK + txt);
     1828      end;
     1829      inc(idx);
     1830    end;
    17911831  end;
    17921832end;
     
    18671907          ind := 0;
    18681908      end;
    1869       if(Ctrl is TFieldLabel) then
    1870       begin
    1871         if not TFieldLabel(Ctrl).Exclude then begin
     1909      if(Ctrl is TCPRSTemplateFieldLabel) then
     1910      begin
     1911        if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
    18721912          if emField <> '' then begin
    18731913            iField := GetTemplateField(emField,FALSE);
     
    18841924                            end;
    18851925            else {case}
    1886               Result := TFieldLabel(Ctrl).Caption
     1926              Result := TCPRSTemplateFieldLabel(Ctrl).Caption
    18871927            end; {case iField.FldType}
    18881928            end {if emField}
    18891929          else
    1890             Result := TFieldLabel(Ctrl).Caption;
     1930            Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
    18911931        end;
    18921932      end
     
    20142054end;
    20152055
    2016 function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
    2017 var
    2018   i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
     2056function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
     2057                                       OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
     2058var
     2059  i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
    20192060  MaxTextLen: integer;  {Max num of chars per line in pixels}
    20202061  MaxChars: integer;    {Max num of chars per line}
     
    20222063  ctrl: TControl;
    20232064  LastLineBlank: boolean;
     2065  sLbl: TCPRSDialogStaticLabel;
     2066  nLbl: TVA508ChainedLabel;
     2067  sLblHeight: integer;
     2068  TabOrdr: integer;
     2069
    20242070const
    20252071  FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
    20262072                        overlay the focus rect on its parent panel.}
     2073
     2074  procedure Add2TabOrder(ctrl: TWinControl);
     2075  begin
     2076    ctrl.TabOrder := TabOrdr;
     2077    inc(TabOrdr);
     2078  end;
     2079
     2080  function StripSRCode(var txt: string; code: string; len: integer): integer;
     2081  begin
     2082    Result := pos(code, txt);
     2083    if Result > 0 then
     2084    begin
     2085      delete(txt,Result,len);
     2086      dec(Result);
     2087    end
     2088    else
     2089      Result := -1;
     2090  end;
     2091
    20272092  procedure DoLabel(Atxt: string);
    20282093  var
    2029     lbl: TLabel;
    2030 
    2031   begin
    2032     lbl := TLabel.Create(nil);
    2033     lbl.Parent := FPanel;
    2034     lbl.ShowAccelChar := FALSE;
    2035     lbl.Caption := Atxt;
    2036     lbl.Left := x;
    2037     lbl.Top := y;
    2038     inc(x, lbl.Width);
    2039   end;
    2040 
    2041   procedure NextLine;
    2042   begin
    2043     if(MaxX < x) then
    2044       MaxX := x;
    2045     x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
    2046     inc(y, yinc);
    2047     yinc := ybase;
    2048   end;
    2049 
    2050 begin
    2051   MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
    2052   if(FFirstBuild or (FPanel.Width <> MaxLen)) then
     2094    ctrl: TControl;
     2095    tempLbl: TVA508ChainedLabel;
     2096
     2097  begin
     2098    if ScreenReaderSystemActive then
     2099    begin
     2100      if assigned(sLbl) then
     2101      begin
     2102        tempLbl := TVA508ChainedLabel.Create(nil);
     2103        if assigned(nLbl) then
     2104          nLbl.NextLabel := tempLbl
     2105        else
     2106          sLbl.NextLabel := tempLbl;
     2107        nLbl := tempLbl;
     2108        ctrl := nLbl;
     2109      end
     2110      else
     2111      begin
     2112        sLbl := TCPRSDialogStaticLabel.Create(nil);
     2113        ctrl := sLbl;
     2114      end;
     2115    end
     2116    else
     2117      ctrl := TLabel.Create(nil);
     2118    SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE));
     2119    SetStrProp(ctrl, CaptionProperty, Atxt);
     2120    ctrl.Parent := FPanel;
     2121    ctrl.Left := x;
     2122    ctrl.Top := y;
     2123    if ctrl = sLbl then
     2124    begin
     2125      Add2TabOrder(sLbl);
     2126      sLbl.Height := sLblHeight;
     2127      ScreenReaderSystem_CurrentLabel(sLbl);
     2128    end;
     2129    if ScreenReaderSystemActive then
     2130      ScreenReaderSystem_AddText(Atxt);
     2131    UpdateColorsFor508Compliance(ctrl);
     2132    inc(x, ctrl.Width);
     2133  end;
     2134
     2135  procedure Init;
     2136  var
     2137    lbl : TLabel;
    20532138  begin
    20542139    if(FFirstBuild) then
     
    20612146    //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2);  AGP commentout line for
    20622147                                                                           //reminder spacing
    2063     ybase := FontHeightPixel(FFont.Handle);
     2148    ybase := FontHeightPixel(FFont.Handle) + 2;
    20642149    yinc := ybase;
    20652150    LastLineBlank := FALSE;
     2151    sLbl := nil;
     2152    nLbl := nil;
     2153    TabOrdr := 0;
     2154    if ScreenReaderSystemActive then
     2155    begin
     2156      ScreenReaderSystem_CurrentCheckBox(OwningCheckBox);
     2157      lbl := TLabel.Create(nil);
     2158      try
     2159        lbl.Parent := FPanel;
     2160        sLblHeight := lbl.Height + 2;
     2161      finally
     2162        lbl.Free;
     2163      end;
     2164
     2165    end;
     2166  end;
     2167
     2168  procedure Text508Work;
     2169  var
     2170    ContinueCode: boolean;
     2171  begin
     2172    if StripCode(txt, SR_BREAK) then
     2173    begin
     2174      ScreenReaderSystem_Stop;
     2175      nLbl := nil;
     2176      sLbl := nil;
     2177    end;
     2178
     2179    ContinueCode := FALSE;
     2180    while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do
     2181      ContinueCode := TRUE;
     2182    while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do
     2183      ContinueCode := TRUE;
     2184    if ContinueCode then
     2185      ScreenReaderSystem_Continue;
     2186  end;
     2187
     2188  procedure Ctrl508Work(ctrl: TControl);
     2189  var
     2190    lbl: TCPRSTemplateFieldLabel;
     2191  begin
     2192    if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then
     2193    begin
     2194      lbl := Ctrl as TCPRSTemplateFieldLabel;
     2195      if trim(lbl.Caption) <> '' then
     2196      begin
     2197        ScreenReaderSystem_CurrentLabel(lbl);
     2198        ScreenReaderSystem_AddText(lbl.Caption);
     2199      end
     2200      else
     2201      begin
     2202        lbl.TabStop := FALSE;
     2203        ScreenReaderSystem_Stop;
     2204      end;
     2205    end
     2206    else
     2207    begin
     2208      if ctrl is TWinControl then
     2209        Add2TabOrder(TWinControl(ctrl));
     2210      if Supports(ctrl, ICPRSDialogComponent) then
     2211        ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent);
     2212    end;
     2213    sLbl := nil;
     2214    nLbl := nil;
     2215  end;
     2216
     2217  procedure NextLine;
     2218  begin
     2219    if(MaxX < x) then
     2220      MaxX := x;
     2221    x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
     2222    inc(y, yinc);
     2223    yinc := ybase;
     2224  end;
     2225
     2226begin
     2227  MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
     2228  if(FFirstBuild or (FPanel.Width <> MaxLen)) then
     2229  begin
     2230    Init;
    20662231    for i := 0 to FControls.Count-1 do
    20672232    begin
    20682233      txt := FControls[i];
    2069       if(copy(txt,1,1) = EOL_MARKER) then
     2234      if ScreenReaderSystemActive then
     2235        Text508Work;
     2236      if StripCode(txt,EOL_MARKER) then
    20702237      begin
    20712238        if((x <> 0) or LastLineBlank) then
    20722239          NextLine;
    2073         delete(txt,1,1);
    20742240        LastLineBlank := (txt = '');
    20752241      end;
     
    21202286        if(assigned(ctrl)) then
    21212287        begin
     2288          if ScreenReaderSystemActive then
     2289            Ctrl508Work(ctrl);
    21222290          idx := FIndents.IndexOfObject(Ctrl);
    21232291          if idx >= 0 then
     
    21372305          inc(x, Ctrl.Width + 4);
    21382306          if yinc <= Ctrl.Height then
    2139             yinc := Ctrl.Height + 1;
     2307            yinc := Ctrl.Height + 2;
    21402308          if (x < MaxLen) and ((Ctrl is TRichEdit) or
    21412309             ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
     
    21502318  if(FFieldValues <> '') then
    21512319    SetFieldValues(FFieldValues);
     2320  if ScreenReaderSystemActive then
     2321    ScreenReaderSystem_Stop;
    21522322  Result := FPanel;
    21532323end;
     
    21622332  i, idx: integer;
    21632333  obj: TObject;
     2334  max: integer;
    21642335
    21652336begin
    21662337  if(assigned(FPanel)) then
    21672338  begin
    2168     for i := FPanel.ControlCount-1 downto 0 do
    2169       if(FPanel.Controls[i] is TLabel) then
     2339    max := FPanel.ControlCount-1;
     2340    for i := max downto 0 do
     2341    begin
     2342// deleting TVA508StaticText can delete several TVA508ChainedLabel components
     2343      if i < FPanel.ControlCount then
    21702344      begin
    21712345        obj := FPanel.Controls[i];
    2172         idx := FControls.IndexOfObject(obj);
    2173         if idx < 0 then
    2174           obj.Free;
    2175       end;
     2346        if (not (obj is TVA508ChainedLabel)) and
     2347           ((obj is TLabel) or (obj is TVA508StaticText)) then
     2348        begin
     2349          idx := FControls.IndexOfObject(obj);
     2350          if idx < 0 then
     2351            obj.Free;
     2352        end;
     2353      end;
     2354    end;
    21762355  end;
    21772356end;
     
    21882367    M.Data := Self;
    21892368    M.Code := @PanelDestroy;
    2190     TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
     2369    FPanel.OnDestroy := TNotifyEvent(M);
    21912370  end
    21922371  else
    2193     TFieldPanel(FPanel).OnDestroy := nil;
     2372    FPanel.OnDestroy := nil;
    21942373end;
    21952374
     
    22322411        begin
    22332412          Done := FALSE;
     2413          TORCheckBox(Ctrl).Checked := FALSE;        //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
    22342414          if(cnt = 0) then
    22352415            cnt := DelimCount(AText, '|') + 1;
     
    22782458end;
    22792459
     2460function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
     2461var
     2462  p: integer;
     2463begin
     2464  p := pos(code, txt);
     2465  Result := (p > 0);
     2466  if Result then
     2467  begin
     2468    while p > 0 do
     2469    begin
     2470      delete(txt, p, 1);
     2471      p := pos(code, txt);
     2472    end;
     2473  end;
     2474end;
     2475
    22802476procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
    22812477begin
    22822478  EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
    22832479  DoChange(Sender);
    2284 end;
    2285 
    2286 { TFieldPanel }
    2287 
    2288 destructor TFieldPanel.Destroy;
    2289 begin
    2290   if(assigned(FOnDestroy)) then
    2291     FOnDestroy(Self);
    2292   inherited;
    2293 end;
    2294 
    2295 {intercept the paint event to draw the focus rect if FFocused is true}
    2296 function TFieldPanel.GetFocus: boolean;
    2297 begin
    2298   result := Focused;
    2299 end;
    2300 
    2301 procedure TFieldPanel.Paint;
    2302 var
    2303   DC: HDC;
    2304   R: TRect;
    2305 
    2306 begin
    2307   inherited;
    2308   if(Focused) then
    2309   begin
    2310     if(not assigned(FCanvas)) then
    2311       FCanvas := TControlCanvas.Create;
    2312     DC := GetWindowDC(Handle);
    2313     try
    2314       FCanvas.Handle := DC;
    2315       R := ClientRect;
    2316       InflateRect(R, -1, -1);
    2317       FCanvas.DrawFocusRect(R);
    2318     finally
    2319       ReleaseDC(Handle, DC);
    2320     end;
    2321   end;
    2322 end;
    2323 
    2324 procedure TFieldPanel.SetTheFocus(const Value: boolean);
    2325 begin
    2326   if Value then
    2327     SetFocus;
    2328 end;
    2329 
    2330 { TWebLabel }
    2331 
    2332 procedure TWebLabel.Clicked(Sender: TObject);
    2333 begin
    2334   GotoWebPage(FAddr);
    2335 end;
    2336 
    2337 procedure TWebLabel.Init(Addr: string);
    2338 begin
    2339   FAddr := Addr;
    2340   OnClick := Clicked;
    2341   Font.Assign(TORExposedControl(Parent).Font);
    2342   Font.Color := clActiveCaption;
    2343   Font.Style := Font.Style + [fsUnderline];
    2344   AdjustBounds; // make sure we have the right width
    2345   AutoSize := FALSE;
    2346   Height := Height + 1; // Courier New doesn't support underline unless it's higher
    2347   Cursor := crHandPoint;
    23482480end;
    23492481
     
    23712503end;
    23722504
     2505procedure StripScreenReaderCodes(var Text: string);
     2506var
     2507  p, j: integer;
     2508begin
     2509  for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do
     2510  begin
     2511    p := 1;
     2512    while (p > 0) do
     2513    begin
     2514      p := posex(ScreenReaderCodes[j], Text, p);
     2515      if p > 0 then
     2516        delete(Text, p, ScreenReaderCodeLens[j]);
     2517    end;
     2518  end;
     2519end;
     2520
     2521procedure StripScreenReaderCodes(SL: TStrings);
     2522var
     2523  temp: string;
     2524  i: integer;
     2525
     2526begin
     2527  for i := 0 to SL.Count - 1 do
     2528  begin
     2529    temp := SL[i];
     2530    StripScreenReaderCodes(temp);
     2531    SL[i] := temp;
     2532  end;
     2533end;
     2534
     2535function HasScreenReaderBreakCodes(SL: TStrings): boolean;
     2536var
     2537  i: integer;
     2538
     2539begin
     2540  Result := TRUE;
     2541  for i := 0 to SL.Count - 1 do
     2542  begin
     2543    if pos(ScreenReaderCodeSignature, SL[i]) > 0 then
     2544      exit;
     2545  end;
     2546  Result := FALSE;
     2547end;
     2548
    23732549initialization
    23742550
  • cprs/trunk/CPRS-Chart/Templates/uTemplates.pas

    r456 r829  
    253253function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string;  overload;
    254254function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
     255procedure UpdatePersonalObjects;
     256procedure SetTemplateDialogCanceled(value: Boolean);
     257function WasTemplateDialogCanceled: Boolean;
     258procedure SetTemplateBPHasObjects(value: Boolean);
     259function TemplateBPHasObjects: Boolean;
    255260
    256261const
     
    278283  ConsultsTemplate: TTemplate = nil;
    279284  ProceduresTemplate: TTemplate = nil;
     285  uPersonalObjects: TStringList = nil;   // -------- CQ #8665 - RV ------------
    280286
    281287implementation
     
    283289uses
    284290  Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
    285   XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks,
    286   fReminderDialog, rODBase;
     291  XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks,
     292  fReminderDialog, rODBase
     293  {$IFDEF VER140}
     294  , Word97;
     295  {$ELSE}
     296  , WordXP, VAUtils;
     297  {$ENDIF}
    287298
    288299const
     
    311322  uDGroupConsults: integer = 0;
    312323  uDGroupProcedures: integer = 0;
     324  uTemplateDialogCanceled: Boolean = FALSE;
     325  uTemplateBPHasObjects: Boolean = FALSE;
    313326
    314327type
     
    531544      try
    532545        GetTemplateRoots;
    533         TmpSL.Assign(RPCBrokerV.Results);
     546        FastAssign(RPCBrokerV.Results, TmpSL);
    534547        for i := 0 to TmpSL.Count-1 do
    535548          AddTemplate(TmpSL[i]);
     
    559572        try
    560573          GetTemplateChildren(tmpl.FID);
    561           TmpSL.Assign(RPCBrokerV.Results);
     574          FastAssign(RPCBrokerV.Results, TmpSL);
    562575          for i := 0 to TmpSL.Count-1 do
    563576            AddTemplate(TmpSL[i], tmpl);
     
    597610    TempSL := nil;
    598611  end;
     612  // -------- CQ #8665 - RV ------------
     613  if (assigned(uPersonalObjects)) then
     614  begin
     615    KillObj(@uPersonalObjects);
     616    uPersonalObjects.Free;
     617    uPersonalObjects := nil;
     618  end;
     619  // ------end CQ #8665 ------------
    599620  if(assigned(Deleted)) then
    600621  begin
     
    721742begin
    722743  if(assigned(Errors)) then
    723     ShowMessage(Errors.text)
     744    ShowMsg(Errors.text)
    724745  else
    725     ShowMessage(SingleError);
     746    ShowMsg(SingleError);
    726747end;
    727748
     
    865886        else
    866887          DescSL.Add('5,1=@');
    867         TempSL.AddStrings(DescSL)
     888        FastAddStrings(DescSL, TempSL)
    868889      finally
    869890        DescSL.Free;
     
    11731194              WApp.Connect;
    11741195              TmpVar := AFileName;
     1196              {$IFDEF VER140}
    11751197              WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
     1198              {$ELSE}
     1199              WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
     1200              {$ENDIF}
    11761201              ffTotal := WDoc.FormFields.Count;
    11771202
     
    13071332                            if tmp <> '' then
    13081333                              AddField(tfDefault, tmp);
    1309                             Fields.AddStrings(PendingAdd);
     1334                            FastAddStrings(PendingAdd, Fields);
    13101335                            PendingAdd.Clear;
    13111336                            AddFieldHeader(tmpType, FALSE);
     
    13961421                          begin
    13971422                            Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
    1398                             Data.AddStrings(Fields);
     1423                            FastAddStrings(Fields, Data);
    13991424                          end;
    14001425                        end;
     
    14861511
    14871512begin
     1513  SetTemplateDialogCanceled(FALSE);
     1514  SetTemplateBPHasObjects(FALSE);
    14881515  Template := GetLinkedTemplate(IntToStr(IEN), LType);
    14891516  if assigned(Template) then
     
    18781905      try
    18791906        TmpSL.Text := FullBoilerPlate;
     1907        if Pos('|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE);
    18801908      finally
    18811909        if(IsDialog) then
     
    25502578        dmodShared.OnTemplateLock(Self)
    25512579      else
    2552         ShowMessage(Format(TemplateLockedText, [FPrintName]));
     2580        ShowMsg(Format(TemplateLockedText, [FPrintName]));
    25532581    end;
    25542582  end
     
    28752903end;
    28762904
     2905// -------- CQ #8665 - RV ------------
     2906procedure UpdatePersonalObjects;
     2907var
     2908  i: integer;
     2909begin
     2910  if not assigned(uPersonalObjects) then
     2911  begin
     2912    uPersonalObjects := TStringList.Create;
     2913    GetAllowedPersonalObjects;
     2914    for i := 0 to RPCBrokerV.Results.Count-1 do
     2915      uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1));
     2916    uPersonalObjects.Sorted := TRUE;
     2917  end;
     2918end;
     2919// -----end CQ #8665 ------------
     2920
     2921
     2922procedure SetTemplateDialogCanceled(value: Boolean);
     2923begin
     2924  uTemplateDialogCanceled := value;
     2925end; 
     2926
     2927function WasTemplateDialogCanceled: Boolean;
     2928begin
     2929  Result := uTemplateDialogCanceled;
     2930end;
     2931
     2932procedure SetTemplateBPHasObjects(value: Boolean);
     2933begin
     2934  uTemplateBPHasObjects := value;
     2935end; 
     2936
     2937function TemplateBPHasObjects: Boolean;
     2938begin
     2939  Result := uTemplateBPHasObjects;
     2940end;
     2941
    28772942initialization
    28782943
    28792944finalization
    28802945  ReleaseTemplates;
    2881 
    28822946end.
     2947
  • cprs/trunk/CPRS-Lib/ORCtrls.pas

    r456 r829  
    77uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms,
    88     ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst,
    9      Accessibility_TLB, Variants;
     9     Variants, VAClasses;
    1010
    1111const
     
    2121
    2222type
    23 
    24   TORStaticText = class(TStaticText)
    25   private
    26      FOnEnter: TNotifyEvent;
    27      FOnExit: TNotifyEvent;
    28   published
    29      property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    30      property OnExit: TNotifyEvent read FOnExit write FOnExit;
    31      procedure DoEnter; override;
    32      procedure DoExit; override;
     23  IORBlackColorModeCompatible = interface(IInterface)
     24  ['{3554985C-F524-45FA-8C27-4CDD8357DB08}']
     25    procedure SetBlackColorMode(Value: boolean);
    3326  end;
    3427
     
    8174  end;
    8275
    83   TORListBox = class(TListBox)
     76  TORListBox = class(TListBox, IVADynamicProperty, IORBlackColorModeCompatible)
    8477  private
    8578    FFocusIndex: Integer;                        // item with focus when using navigation keys
     
    127120    FMItems: TORStrings;                         // Used to save corresponding M strings ("the pieces")
    128121    FCaption: TStaticText;                       // Used to supply a title to IAccessible interface
    129     FAccessible: IAccessible;
    130122    FCaseChanged: boolean;                       // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case
    131123    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
    132     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
     124    FIsPartOfComboBox: boolean;
     125    FBlackColorMode: boolean;
     126    FHideSelection: boolean;
    133127    procedure AdjustScrollBar;
    134128    procedure CreateScrollBar;
     
    214208    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    215209    function GetIndexFromY(YPos :integer) :integer;
     210    property isPartOfComboBox: boolean read FIsPartOfComboBox write FIsPartOfComboBox default False;
    216211    property HideSynonyms: boolean read FHideSynonyms write SetHideSynonyms default FALSE;
    217212    property SynonymChars: string read FSynonymChars write SetSynonymChars;
     
    241236    property CheckedState[Index: Integer]: TCheckBoxState read GetCheckedState write SetCheckedState;
    242237    property MItems: TStrings read GetMItems write SetMItems;
    243     procedure MakeAccessible(Accessible: IAccessible);
    244238    function VerifyUnique(SelectIndex: Integer; iText: String): integer;
     239    procedure SetBlackColorMode(Value: boolean);
     240    function SupportsDynamicProperty(PropertyID: integer): boolean;
     241    function GetDynamicProperty(PropertyID: integer): string;
     242    property HideSelection: boolean read FHideSelection write FHideSelection;
    245243  published
    246244    property AllowGrayed: boolean read FAllowGrayed write FAllowGrayed default FALSE;
     
    303301  end;
    304302
    305   TORComboBox = class(TWinControl)
     303  TORComboBox = class(TWinControl, IVADynamicProperty, IORBlackColorModeCompatible)
    306304  private
    307305    FItems: TStrings;                            // points to Items in FListBox
     
    340338    FCharsNeedMatch: integer;                    // how many text need to be matched for auto selection
    341339    FUniqueAutoComplete: Boolean;                // If true only perform autocomplete for unique list items.
     340    FBlackColorMode: boolean;
     341    FDisableHints: boolean;                      // true if hints have been disabled because drop down window was opened
     342    FDropDownStatusChangedCount: integer;        // prevents multiple calls to disabling hint window
     343    procedure DropDownStatusChanged(opened: boolean);
     344    procedure ClearDropDownStatus;
    342345    function EditControl: TWinControl;
    343346    procedure AdjustSizeOfSelf;
     
    440443    procedure SetLookupPiece(const Value: integer);
    441444    procedure SetUniqueAutoComplete(const Value: Boolean);
     445    procedure LoadComboBoxImage;
    442446  protected
    443447    procedure DropPanelBtnPressed(OKBtn, AutoClose: boolean);
     
    452456  public
    453457    constructor Create(AOwner: TComponent); override;
     458    destructor Destroy; override;
    454459    function AddReference(const S: string; AReference: Variant): Integer;
    455460    procedure Clear;
     
    458463    procedure InitLongList(S: string);
    459464    procedure InsertSeparator;
     465    procedure Invalidate; override;
    460466    procedure SetTextAutoComplete(TextToMatch : String);
    461467    function GetIEN(AnIndex: Integer): Int64;
     
    466472    procedure InsertReference(Index: Integer; const S: string; AReference: Variant);
    467473    procedure SelectAll;
    468     function MakeAccessible( Accessible: IAccessible): TORListBox;
     474    procedure SetBlackColorMode(Value: boolean);
     475    function SupportsDynamicProperty(PropertyID: integer): boolean;
     476    function GetDynamicProperty(PropertyID: integer): string;
    469477    property DisplayText[Index: Integer]: string read GetDisplayText;
    470478    property DroppedDown: Boolean read FDroppedDown write SetDroppedDown;
     
    648656
    649657
    650   TCaptionTreeView = class(TTreeView)
     658  TCaptionTreeView = class(TTreeView, IVADynamicProperty)
    651659  private
    652660    procedure SetCaption(const Value: string);
     
    654662  protected
    655663    FCaptionComponent: TStaticText;
     664  public
     665    function SupportsDynamicProperty(PropertyID: integer): boolean;
     666    function GetDynamicProperty(PropertyID: integer): string;
    656667  published
    657668    property Align;
     
    665676    FTag: integer;
    666677    FStringData: string;
    667     FAccessible: IAccessible;
    668678    FCaption: string;
    669     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    670679    function GetParent: TORTreeNode;
    671680    procedure SetCaption(const Value: string);
     
    679688    function GetORTreeView: TORTreeView;
    680689  public
    681     procedure MakeAccessible(Accessible: IAccessible);
    682690    procedure SetPiece(PieceNum: Integer; const NewPiece: string);
    683691    procedure EnsureVisible;
    684     property Accessible: IAccessible read FAccessible write MakeAccessible;
    685692    property Bold: boolean read GetBold write SetBold;
    686693    property Tag: integer read FTag write FTag;
     
    700707    FPiece: integer;
    701708    FOnAddition: TTVExpandedEvent;
    702     FAccessible: IAccessible;
    703709    FShortNodeCaptions: boolean;
    704710    FOnNodeCaptioning: TNodeCaptioningEvent;
    705     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    706711    procedure SetShortNodeCaptions(const Value: boolean);
    707712  protected
     
    716721  public
    717722    constructor Create(AOwner: TComponent); override;
    718     procedure MakeAccessible(Accessible: IAccessible);
    719723    function FindPieceNode(Value: string;
    720724                           ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload;
     
    776780  TGrayedStyle = (gsNormal, gsQuestionMark, gsBlueQuestionMark);
    777781
    778   TORCheckBox = class(TCheckBox)
     782  TORCheckBox = class(TCheckBox, IORBlackColorModeCompatible)
    779783  private
    780784    FStringData: string;
     
    793797    FAssociate: TControl;
    794798    FFocusOnBox: boolean;
     799    FBlackColorMode: boolean;
    795800    procedure SetFocusOnBox(value: boolean);
    796801    procedure CNMeasureItem    (var Message: TWMMeasureItem);   message CN_MEASUREITEM;
     
    835840    destructor Destroy; override;
    836841    procedure AutoAdjustSize;
     842    procedure SetBlackColorMode(Value: boolean);
    837843    property SingleLine: boolean read FSingleLine;
    838844    property StringData: string read FStringData write FStringData;
     
    899905  end;
    900906
    901   TCaptionListBox = class(TListBox)
     907  TCaptionListBox = class(TListBox, IVADynamicProperty)
    902908  private
    903909    FHoverItemPos: integer;
    904     FAccessible: IAccessible;
    905910    FRightClickSelect: boolean;                  // When true, a right click selects teh item
    906911    FHintOnItem: boolean;
    907912    procedure SetCaption(const Value: string);
    908913    function GetCaption: string;
    909     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    910914    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    911915    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
     916    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
     917    procedure MoveFocusDown;
     918    procedure MoveFocusUp;
    912919  protected
    913920    FCaptionComponent: TStaticText;
    914921    procedure DoEnter; override;
    915922  public
    916     procedure MakeAccessible( Accessible: IAccessible);
     923    function SupportsDynamicProperty(PropertyID: integer): boolean;
     924    function GetDynamicProperty(PropertyID: integer): string;
    917925  published
    918926    property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE;
     
    922930  end;
    923931
    924   TCaptionCheckListBox = class(TCheckListBox)
     932  TCaptionCheckListBox = class(TCheckListBox, IVADynamicProperty)
    925933  private
    926934    procedure SetCaption(const Value: string);
     
    928936  protected
    929937    FCaptionComponent: TStaticText;
     938  public
     939    function SupportsDynamicProperty(PropertyID: integer): boolean;
     940    function GetDynamicProperty(PropertyID: integer): string;
    930941  published
    931942    property Caption: string read GetCaption write SetCaption;
    932943  end;
    933944
    934   TCaptionMemo = class(TMemo)
     945  TCaptionMemo = class(TMemo, IVADynamicProperty)
    935946  private
    936947    procedure SetCaption(const Value: string);
     
    938949  protected
    939950    FCaptionComponent: TStaticText;
     951  public
     952    function SupportsDynamicProperty(PropertyID: integer): boolean;
     953    function GetDynamicProperty(PropertyID: integer): string;
    940954  published
    941955    property Caption: string read GetCaption write SetCaption;
    942956  end;
    943957
    944   TCaptionEdit = class(TEdit)
     958  TCaptionEdit = class(TEdit, IVADynamicProperty)
    945959  private
    946960    procedure SetCaption(const Value: string);
     
    948962  protected
    949963    FCaptionComponent: TStaticText;
     964  public
     965    function SupportsDynamicProperty(PropertyID: integer): boolean;
     966    function GetDynamicProperty(PropertyID: integer): string;
    950967  published
    951968    property Align;
     
    953970  end;
    954971
    955   TCaptionRichEdit = class(TRichEdit)
     972  TCaptionRichEdit = class(TRichEdit, IVADynamicProperty)
    956973  private
    957     FAccessible: IAccessible;
    958     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    959974  protected
    960975    FCaption: string;
    961976  public
    962     procedure MakeAccessible(Accessible: IAccessible);
     977    function SupportsDynamicProperty(PropertyID: integer): boolean;
     978    function GetDynamicProperty(PropertyID: integer): string;
    963979  published
    964980    property Align;
     
    966982  end;
    967983
    968   TCaptionComboBox = class(TComboBox)
     984  TCaptionComboBox = class(TComboBox, IVADynamicProperty)
    969985  private
    970986    procedure SetCaption(const Value: string);
     
    972988  protected
    973989    FCaptionComponent: TStaticText;
     990  public
     991    function SupportsDynamicProperty(PropertyID: integer): boolean;
     992    function GetDynamicProperty(PropertyID: integer): string;
    974993  published
    975994    property Caption: string read GetCaption write SetCaption;
    976995  end;
    977996
    978   TCaptionListView = class(TListView)
     997  TCaptionListView = class(TListView, IVADynamicProperty)
     998  public
     999    function SupportsDynamicProperty(PropertyID: integer): boolean;
     1000    function GetDynamicProperty(PropertyID: integer): string;
    9791001  published
    9801002    property Caption;
    9811003  end;
    9821004
    983   TCaptionStringGrid = class(TStringGrid)
     1005  TCaptionStringGrid = class(TStringGrid, IVADynamicProperty)
    9841006  private
    9851007    FJustToTab: boolean;
    9861008    FCaption: string;
    987     FAccessible: IAccessible;
    988     procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    9891009  protected
    9901010    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    9911011  public
    992     procedure MakeAccessible( Accessible: IAccessible);
    9931012    procedure IndexToColRow( index: integer; var Col: integer; var Row: integer);
    9941013    function ColRowToIndex( Col: integer; Row: Integer): integer;
     1014    function SupportsDynamicProperty(PropertyID: integer): boolean;
     1015    function GetDynamicProperty(PropertyID: integer): string;
    9951016  published
    9961017    property Caption: string read FCaption write FCaption;
     
    10151036
    10161037uses
    1017   uAccessAPI;
     1038  VAUtils;
    10181039 
    10191040const
     
    14241445    'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED');
    14251446
    1426 var
    1427   ORCBImages: array[TORCBImgIdx] of TBitMap;
    1428 
    1429 function GetORCBBitmap(Idx: TORCBImgIdx): TBitmap;
    1430 begin
    1431   if(not assigned(ORCBImages[Idx])) then
    1432   begin
    1433     ORCBImages[Idx] := TBitMap.Create;
    1434     ORCBImages[Idx].LoadFromResourceName(HInstance, CheckBoxImageResNames[Idx]);
    1435   end;
    1436   Result := ORCBImages[Idx];
     1447   BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
     1448    'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
     1449    'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK',
     1450    'BLACK_ORCB_DISABLED_UNCHECKED', 'BLACK_ORCB_DISABLED_CHECKED',
     1451    'BLACK_ORCB_DISABLED_GRAYED', 'BLACK_ORCB_DISABLED_QUESTIONMARK',
     1452    'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
     1453    'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED',
     1454    'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED');
     1455 
     1456var
     1457  ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap;
     1458
     1459function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap;
     1460var
     1461  ResName: string;
     1462begin
     1463  if(not assigned(ORCBImages[Idx, BlackMode])) then
     1464  begin
     1465    ORCBImages[Idx, BlackMode] := TBitMap.Create;
     1466    if BlackMode then
     1467      ResName := BlackCheckBoxImageResNames[Idx]
     1468    else
     1469      ResName := CheckBoxImageResNames[Idx];
     1470    ORCBImages[Idx, BlackMode].LoadFromResourceName(HInstance, ResName);
     1471  end;
     1472  Result := ORCBImages[Idx, BlackMode];
    14371473end;
    14381474
     
    14401476var
    14411477  i: TORCBImgIdx;
     1478  mode: boolean;
    14421479
    14431480begin
    14441481  for i := low(TORCBImgIdx) to high(TORCBImgIdx) do
    14451482  begin
    1446     if(assigned(ORCBImages[i])) then
    1447       ORCBImages[i].Free;
    1448   end;
    1449 end;
    1450 
    1451 { TORStaticText }
    1452 
    1453 procedure TORStaticText.DoEnter;
    1454 begin
    1455   inherited DoEnter;
    1456   if Assigned(FOnEnter) then
    1457      FOnEnter(Self);
    1458 end;
    1459 
    1460 procedure TORStaticText.DoExit;
    1461 begin
    1462   inherited DoExit;
    1463   if Assigned(FOnExit) then
    1464      FOnExit(Self);
     1483    for Mode := false to true do
     1484    begin
     1485      if(assigned(ORCBImages[i, Mode])) then
     1486        ORCBImages[i, Mode].Free;
     1487    end;
     1488  end;
    14651489end;
    14661490
     
    16581682  FCaseChanged := TRUE;
    16591683  FLookupPiece := 0;
     1684  FIsPartOfComboBox := False;
    16601685end;
    16611686
     
    17681793    SetString(Result, Buf, Len);
    17691794  end;
     1795end;
     1796
     1797function TORListBox.GetDynamicProperty(PropertyID: integer): string;
     1798begin
     1799  if PropertyID = DynaPropAccesibilityCaption then
     1800    Result := GetCaption
     1801  else
     1802    Result := '';
    17701803end;
    17711804
     
    20162049  case Message.CharCode of
    20172050    VK_LBUTTON, VK_RETURN, VK_SPACE:
    2018     if FocusIndex > -1 then
    2019     begin
    2020       if MultiSelect then
     2051    begin
     2052      if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance
     2053        SetFocusIndex(0);
     2054      if FocusIndex > -1 then
    20212055      begin
    2022         IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0));
    2023         Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex);
    2024       end
    2025       else Perform(LB_SETCURSEL, FocusIndex, 0);
    2026       // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL
    2027       // and LBN_SELCHANGE is what eventually triggers the Click event.
    2028       // The LBN_SELCHANGE documentation implies we should send the control id, which is
    2029       // 32 bits long, in the high word of WPARAM (16 bits).  Since that won't work - we'll
    2030       // try sending the item index instead.
    2031       //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't
    2032       //Allow the Checkbox state on the control to be updated
    2033       if CheckBoxes then
    2034         PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle))
    2035       else
    2036         SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle));
     2056        if MultiSelect then
     2057        begin
     2058          IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0));
     2059          Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex);
     2060        end
     2061        else Perform(LB_SETCURSEL, FocusIndex, 0);
     2062        // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL
     2063        // and LBN_SELCHANGE is what eventually triggers the Click event.
     2064        // The LBN_SELCHANGE documentation implies we should send the control id, which is
     2065        // 32 bits long, in the high word of WPARAM (16 bits).  Since that won't work - we'll
     2066        // try sending the item index instead.
     2067        //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't
     2068        //Allow the Checkbox state on the control to be updated
     2069        if CheckBoxes then
     2070          PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle))
     2071        else
     2072          SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle));
     2073      end;
    20372074    end;
    20382075    VK_PRIOR:          SetFocusIndex(FocusIndex - FLargeChange);
     
    22362273  begin
    22372274    FLastItemIndex := ItemIndex;
     2275    if (not isPartOfComboBox) and (ItemIndex <> -1) then
     2276      SetFocusIndex(ItemIndex);
    22382277    if Assigned(FOnChange) then FOnChange(Self);
    22392278  end;
     
    22482287{  if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then
    22492288    SetFocusIndex(TopIndex);//ItemIndex := TopIndex; }
     2289  if FHideSelection and (ItemIndex < 0) and (FFocusIndex >= 0) then
     2290    ItemIndex := FFocusIndex;
    22502291  inherited DoEnter;
    22512292end;
    22522293
    22532294procedure TORListBox.DoExit;
     2295var
     2296  SaveIndex: integer;
    22542297{ make sure item tip is hidden for this listbox when focus shifts to something else }
    22552298begin
     2299  if FHideSelection then
     2300  begin
     2301    SaveIndex := ItemIndex;
     2302    ItemIndex := -1;
     2303    FFocusIndex := SaveIndex;
     2304  end;
     2305
    22562306  uItemTip.Hide;
    22572307  FItemTipActive := False;
     
    23212371procedure TORListBox.KeyPress(var Key: Char);
    23222372begin
     2373  {inherited KeyPress is changing the ' ' into #0, had to move conditional before inherited.}
     2374  if (Key = ' ') then begin
     2375    ToggleCheckBox(ItemIndex);
     2376    {The space bar causes the focus to jump to an item in the list that starts with
     2377     a space. Disable that function.}
     2378    Key := #0;
     2379  end;
    23232380  inherited;
    2324   if (Key = ' ') then ToggleCheckBox(ItemIndex);
    23252381end;
    23262382
     
    24592515              begin
    24602516                if(FFlatCheckBoxes) then
    2461                   BMap := GetORCBBitmap(iiFlatUnChecked)
     2517                  BMap := GetORCBBitmap(iiFlatUnChecked, FBlackColorMode)
    24622518                else
    2463                   BMap := GetORCBBitmap(iiUnchecked);
     2519                  BMap := GetORCBBitmap(iiUnchecked, FBlackColorMode);
    24642520              end;
    24652521            cbChecked:
    24662522              begin
    24672523                if(FFlatCheckBoxes) then
    2468                   BMap := GetORCBBitmap(iiFlatChecked)
     2524                  BMap := GetORCBBitmap(iiFlatChecked, FBlackColorMode)
    24692525                else
    2470                   BMap := GetORCBBitmap(iiChecked);
     2526                  BMap := GetORCBBitmap(iiChecked, FBlackColorMode);
    24712527              end;
    24722528            else // cbGrayed:
    24732529              begin
    24742530                if(FFlatCheckBoxes) then
    2475                   BMap := GetORCBBitmap(iiFlatGrayed)
     2531                  BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
    24762532                else
    2477                   BMap := GetORCBBitmap(iiGrayed);
     2533                  BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
    24782534              end;
    24792535          end;
     
    24822538        begin
    24832539          if(FFlatCheckBoxes) then
    2484             BMap := GetORCBBitmap(iiFlatGrayed)
     2540            BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
    24852541          else
    2486             BMap := GetORCBBitmap(iiGrayed);
     2542            BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
    24872543        end;
    24882544        TmpR := Rect;
     
    25842640    end;
    25852641  end;                                              // -- special long list processing - end
     2642  if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;
    25862643  if (Value = SFI_TOP) or (Value < 0) then Value := 0;
    2587   if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;
    25882644  FFocusIndex := Value;
    2589   ItemIndex := Value;
     2645  if Focused or (not FHideSelection) then
     2646    ItemIndex := Value;
    25902647  if MultiSelect then Perform(LB_SETCARETINDEX, FFocusIndex, 0) // LPARAM=0, scrolls into view
    25912648  else
     
    28502907end;
    28512908
     2909function TORListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
     2910begin
     2911  Result := (PropertyID = DynaPropAccesibilityCaption);
     2912end;
     2913
    28522914procedure TORListBox.SetHideSynonyms(Value :boolean);
    28532915var
     
    29302992  Strings: TStringList;
    29312993  i, Pos: Integer;
    2932   ItemRec: PItemRec;
     2994  ItemRec, ItemRec2: PItemRec;
    29332995  SaveListMode: Boolean;
    29342996  RealVerify: Boolean;
     
    29603022      begin
    29613023        Pos := Items.AddObject(Strings[i], ItemRec^.UserObject);
    2962         References[Pos] := ItemRec^.Reference;
     3024        // CQ 11491 - Changing TabPositions, etc. was wiping out check box status.
     3025        FFromSelf := True;
     3026        ItemRec2 := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Pos, 0));
     3027        FFromSelf := False;
     3028        if(assigned(ItemRec2)) then
     3029        begin
     3030          ItemRec2^.Reference := ItemRec^.Reference;
     3031          ItemRec2^.CheckedState := ItemRec^.CheckedState;
     3032        end;
    29633033      end;
    29643034    end;
     
    35053575end;
    35063576
     3577procedure TORListBox.SetBlackColorMode(Value: boolean);
     3578begin
     3579  FBlackColorMode := Value;
     3580end;
     3581
    35073582procedure TORListBox.SetCaption(const Value: string);
    35083583begin
     
    35273602end;
    35283603
    3529 procedure TORListBox.MakeAccessible(Accessible: IAccessible);
    3530 begin
    3531   if Assigned(FAccessible) and Assigned(Accessible) then
    3532     raise Exception.Create(Caption + ' List Box is already Accessible!')
    3533   else
    3534     FAccessible := Accessible;
    3535 end;
    3536 
    3537 procedure TORListBox.WMGetObject(var Message: TMessage);
    3538 begin
    3539   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    3540     Message.Result := GetLResult(Message.wParam, FAccessible)
    3541   else
    3542     inherited;
     3604// In Delphi 2006, hint windows will cause the TORComboBox drop down list to
     3605// move behind a Stay on Top form.  Hints are also problematic with item tips in
     3606// the drop down list, so we disable them when ever a drop down list is open,
     3607// on all forms, not just stay on top forms.
     3608var
     3609  uDropPanelOpenCount: integer = 0;
     3610  uOldShowHintsSetting: boolean;
     3611
     3612procedure DropDownPanelOpened;
     3613begin
     3614  if uDropPanelOpenCount=0 then
     3615    uOldShowHintsSetting := Application.ShowHint;
     3616  Application.ShowHint := FALSE;
     3617  inc(uDropPanelOpenCount);
     3618end;
     3619
     3620procedure DropDownPanelClosed;
     3621begin
     3622  dec(uDropPanelOpenCount);
     3623  if uDropPanelOpenCount<=0 then
     3624  begin
     3625    uDropPanelOpenCount := 0;
     3626    if not Application.ShowHint then
     3627      Application.ShowHint := uOldShowHintsSetting
     3628  end;
    35433629end;
    35443630
     
    36903776const
    36913777  ComboBoxImages: array[boolean] of string = ('BMP_CBODOWN_DISABLED', 'BMP_CBODOWN');
    3692  
     3778  BlackComboBoxImages: array[boolean] of string = ('BLACK_BMP_CBODOWN_DISABLED', 'BLACK_BMP_CBODOWN');
     3779
    36933780procedure TORComboEdit.CreateParams(var Params: TCreateParams);
    36943781{ sets a one line edit box to multiline style so the editing rectangle can be changed }
     
    37403827  FCheckBoxEditColor := clBtnFace;
    37413828  FListBox := TORListBox.Create(Self);
     3829  FListBox.isPartOfComboBox := True;
    37423830  FListBox.Parent := Self;
    37433831  FListBox.TabStop := False;
     
    38663954end;
    38673955
     3956procedure TORComboBox.DropDownStatusChanged(opened: boolean);
     3957begin
     3958  if opened then
     3959  begin
     3960    if not FDropPanel.Visible then
     3961    begin
     3962      if FDropDownStatusChangedCount = 0 then
     3963      begin
     3964        FDisableHints := TRUE;
     3965        DropDownPanelOpened;
     3966      end;
     3967      inc(FDropDownStatusChangedCount);
     3968    end;
     3969  end
     3970  else
     3971  begin
     3972    dec(FDropDownStatusChangedCount);
     3973    if FDropDownStatusChangedCount <= 0 then
     3974    begin
     3975      if FDisableHints then
     3976      begin
     3977        DropDownPanelClosed;
     3978        FDisableHints := FALSE;
     3979      end;
     3980      FDropDownStatusChangedCount := 0;
     3981    end;
     3982  end;
     3983end;
     3984
     3985procedure TORComboBox.ClearDropDownStatus;
     3986begin
     3987  FDropDownStatusChangedCount := 1;
     3988  DropDownStatusChanged(FALSE);
     3989end;
     3990
     3991destructor TORComboBox.Destroy;
     3992begin
     3993  ClearDropDownStatus;
     3994  inherited;
     3995end;
     3996
    38683997procedure TORComboBox.DoEnter;
    38693998{var
     
    39024031  end;
    39034032  inherited DoExit;
     4033end;
     4034
     4035procedure TORComboBox.LoadComboBoxImage;
     4036var
     4037  imageName: string;
     4038begin
     4039  if assigned(FDropBtn) then
     4040  begin
     4041    if FBlackColorMode then
     4042      imageName := BlackComboBoxImages[inherited Enabled]
     4043    else
     4044      imageName := ComboBoxImages[inherited Enabled];
     4045    FDropBtn.Glyph.LoadFromResourceName(hInstance, imageName);
     4046  end;
    39044047end;
    39054048
     
    40984241
    40994242procedure TORComboBox.FwdKeyPress(Sender: TObject; var Key: Char);
     4243var
     4244  KeyCode: integer;
    41004245{ prevents return from being used by editbox (otherwise sends a newline & text vanishes) }
    41014246begin
    4102   // may want to make the tab beep if tab key (#9) - can't tab until list raised
    4103   if (Key in [#9, #13]) or (FListBox.FCheckBoxes and (Key = #32)) then
    4104   begin
     4247  KeyCode := ord(Key);
     4248  if (KeyCode = VK_RETURN) and (Style = orcsDropDown) and DroppedDown then
     4249  begin
     4250    DroppedDown := FALSE;
    41054251    Key := #0;
    4106     Exit;
    4107   end;
    4108   if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
     4252  end
     4253  else
     4254  begin
     4255    // may want to make the tab beep if tab key (#9) - can't tab until list raised
     4256    if (KeyCode = VK_RETURN) or (KeyCode = VK_TAB) or (FListBox.FCheckBoxes and (KeyCode = VK_SPACE)) then
     4257    begin
     4258      Key := #0;
     4259      Exit;
     4260    end;
     4261    if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
     4262  end;
    41094263end;
    41104264
     
    41684322      FCheckedState := FListBox.GetCheckedString;
    41694323    end;
     4324    DropDownStatusChanged(TRUE);
    41704325    FDropPanel.Visible := True;
    41714326    FDropPanel.BringToFront;
     
    41784333    uItemTip.Hide;
    41794334    FDropPanel.Hide;
     4335    DropDownStatusChanged(FALSE);
    41804336    if(FListBox.FCheckBoxes) and (assigned(FOnChange)) and
    41814337      (FCheckedState <> FListBox.GetCheckedString) then
     
    42654421    begin
    42664422      if FDropBtn <> nil then FDropBtn.Free;
    4267       if FDropPanel <> nil then FDropPanel.Free;
     4423      if FDropPanel <> nil then
     4424      begin
     4425        ClearDropDownStatus;
     4426        FDropPanel.Free;
     4427      end;
    42684428      FDropBtn := nil;
    42694429      FDropPanel := nil;
     
    42804440      if(assigned(FEditPanel) and (csDesigning in ComponentState)) then
    42814441        FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls];
    4282       FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]);
     4442      LoadComboBoxImage;
     4443//      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]);
    42834444      FDropBtn.OnMouseDown := DropButtonDown;
    42844445      FDropBtn.OnMouseUp := DropButtonUp;
     
    42924453        FListBox.FParentCombo := Self;
    42934454        FListBox.Parent := FDropPanel;
     4455        ClearDropDownStatus;
    42944456        if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel;  // if long
    42954457      end else
     
    43284490end;
    43294491
     4492function TORComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
     4493begin
     4494  Result := (PropertyID = DynaPropAccesibilityCaption);
     4495end;
     4496
    43304497// Since TORComboBox is composed of several controls (FEditBox, FListBox, FDropBtn), the
    43314498// following functions and procedures map public and published properties to their related
     
    43734540end;
    43744541
     4542procedure TORComboBox.Invalidate;
     4543begin
     4544  inherited;
     4545  FEditBox.Invalidate;
     4546  FListBox.Invalidate;
     4547  if assigned(FEditPanel) then
     4548    FEditPanel.Invalidate;
     4549  if assigned(FDropBtn) then
     4550    FDropBtn.Invalidate;
     4551  if assigned(FDropPanel) then
     4552    FDropPanel.Invalidate;
     4553end;
     4554
    43754555function TORComboBox.GetAutoSelect: Boolean;
    43764556begin
     
    43934573end;
    43944574
     4575function TORComboBox.GetDynamicProperty(PropertyID: integer): string;
     4576begin
     4577  if PropertyID = DynaPropAccesibilityCaption then
     4578    Result := GetCaption
     4579  else
     4580    Result := '';
     4581end;
     4582
    43954583function TORComboBox.GetItemHeight: Integer;
    43964584begin
     
    45164704begin
    45174705  FEditBox.AutoSelect := Value;
     4706end;
     4707
     4708procedure TORComboBox.SetBlackColorMode(Value: boolean);
     4709begin
     4710  if FBlackColorMode <> Value then
     4711  begin
     4712    FBlackColorMode := Value;
     4713    FListBox.SetBlackColorMode(Value);
     4714    LoadComboBoxImage;
     4715  end;
    45184716end;
    45194717
     
    47744972  if (inherited GetEnabled <> Value) then
    47754973  begin
     4974    DroppedDown := FALSE;
    47764975    inherited SetEnabled(Value);
    47774976    if assigned(FDropBtn) then
    4778       FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]);
     4977      LoadComboBoxImage;
     4978//      FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]);
    47794979  end;
    47804980end;
     
    48375037begin
    48385038  result := FListBox.Caption;
    4839 end;
    4840 
    4841 function TORComboBox.MakeAccessible(Accessible: IAccessible): TORListBox;
    4842 begin
    4843   FListBox.MakeAccessible(Accessible);
    4844   result := FListBox;
    48455039end;
    48465040
     
    52615455        ORCtrls.SetPiece(FStringData, FDelim, FPiece, Value);
    52625456    end;
    5263 end;
    5264 
    5265 procedure TORTreeNode.MakeAccessible(Accessible: IAccessible);
    5266 begin
    5267   if Assigned(FAccessible) and Assigned(Accessible) then
    5268     raise Exception.Create(Text + ' Tree Node is already Accessible!')
    5269   else
    5270   begin
    5271     FAccessible := Accessible;
    5272   end;
    5273 end;
    5274 
    5275 procedure TORTreeNode.WMGetObject(var Message: TMessage);
    5276 begin
    5277   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    5278     Message.Result := GetLResult(Message.wParam, FAccessible)
    5279   else
    5280     inherited;
    52815457end;
    52825458
     
    55225698  else
    55235699    Result := '';
    5524 end;
    5525 
    5526 procedure TORTreeView.MakeAccessible(Accessible: IAccessible);
    5527 begin
    5528   if Assigned(FAccessible) and Assigned(Accessible) then
    5529     raise Exception.Create(Text + ' Tree View is already Accessible!')
    5530   else
    5531   begin
    5532     FAccessible := Accessible;
    5533   end;
    5534 end;
    5535 
    5536 procedure TORTreeView.WMGetObject(var Message: TMessage);
    5537 begin
    5538   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    5539     Message.Result := GetLResult(Message.wParam, FAccessible)
    5540   else
    5541     inherited;
    55425700end;
    55435701
     
    59086066              end;
    59096067            end;
    5910             Bitmap := GetORCBBitmap(ImgIdx);
     6068            Bitmap := GetORCBBitmap(ImgIdx, FBlackColorMode);
    59116069          end
    59126070          else
     
    60506208            R.Top:= FocusRect.Top
    60516209          else
     6210          begin
    60526211            R.Top:= ((ClientHeight - Bitmap.Height + 1) div 2) - 1;
    6053 
     6212            if R.Top < 0 then R.Top := 0           
     6213          end;
    60546214          Draw(R.Left, R.Top, Bitmap);
    60556215        end;
     
    61456305end;
    61466306
     6307procedure TORCheckBox.SetBlackColorMode(Value: boolean);
     6308begin
     6309  if FBlackColorMode <> Value then
     6310  begin
     6311    FBlackColorMode := Value;
     6312    Invalidate;
     6313  end;
     6314end;
     6315
    61476316procedure TORCheckBox.AutoAdjustSize;
    61486317var
     
    62766445    if DoCtrl then
    62776446      Ctrl.Enabled := Checked;
    6278     if(Ctrl is TWinControl) then
     6447
     6448    // added (csAcceptsControls in Ctrl.ControlStyle) below to prevent disabling of
     6449    // child sub controls, like the TBitBtn in the TORComboBox.  If the combo box is
     6450    // already disabled, we don't want to disable the button as well - when we do, we
     6451    // lose the disabled glyph that is stored on that button for the combo box.
     6452
     6453    if(Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then
    62796454    begin
    62806455      for i := 0 to TWinControl(Ctrl).ControlCount-1 do
     
    65006675end;
    65016676
    6502 procedure TCaptionListBox.MakeAccessible(Accessible: IAccessible);
    6503 begin
    6504   if Assigned(FAccessible) and Assigned(Accessible) then
    6505     raise Exception.Create(Caption + ' List Box is already Accessible!')
     6677function TCaptionListBox.GetDynamicProperty(PropertyID: integer): string;
     6678begin
     6679  if PropertyID = DynaPropAccesibilityCaption then
     6680    Result := GetCaption
    65066681  else
    6507     FAccessible := Accessible;
     6682    Result := '';
     6683end;
     6684
     6685
     6686procedure TCaptionListBox.MoveFocusUp;
     6687begin
     6688  if ItemIndex > 0 then
     6689    Perform(LB_SETCARETINDEX, ItemIndex - 1, 0);
     6690end;
     6691
     6692procedure TCaptionListBox.MoveFocusDown;
     6693begin
     6694  if ItemIndex < (Items.Count-1) then
     6695    Perform(LB_SETCARETINDEX, ItemIndex + 1, 0);
    65086696end;
    65096697
     
    65226710end;
    65236711
    6524 procedure TCaptionListBox.WMGetObject(var Message: TMessage);
    6525 begin
    6526   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    6527     Message.Result := GetLResult(Message.wParam, FAccessible)
    6528   else
    6529     inherited;
     6712function TCaptionListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
     6713begin
     6714  Result := (PropertyID = DynaPropAccesibilityCaption);
     6715end;
     6716
     6717procedure TCaptionListBox.WMKeyDown(var Message: TWMKeyDown);
     6718var
     6719  IsSelected: LongBool;
     6720begin
     6721  if Boolean(Hi(GetKeyState(VK_CONTROL))) and MultiSelect then
     6722    case Message.CharCode of
     6723      VK_SPACE:
     6724        begin
     6725          IsSelected := LongBool(Perform(LB_GETSEL, ItemIndex, 0));
     6726          Perform(LB_SETSEL, Longint(not IsSelected), ItemIndex);
     6727        end;
     6728      VK_LEFT, VK_UP: MoveFocusUp;
     6729      VK_RIGHT, VK_DOWN: MoveFocusDown;
     6730      else inherited;
     6731    end
     6732  else inherited;
    65306733end;
    65316734
     
    65916794end;
    65926795
     6796function TCaptionCheckListBox.GetDynamicProperty(PropertyID: integer): string;
     6797begin
     6798  if PropertyID = DynaPropAccesibilityCaption then
     6799    Result := GetCaption
     6800  else
     6801    Result := '';
     6802end;
     6803
    65936804procedure TCaptionCheckListBox.SetCaption(const Value: string);
    65946805begin
     
    66056816end;
    66066817
     6818function TCaptionCheckListBox.SupportsDynamicProperty(
     6819  PropertyID: integer): boolean;
     6820begin
     6821  Result := (PropertyID = DynaPropAccesibilityCaption);
     6822end;
     6823
    66076824{ TCaptionMemo }
    66086825
     
    66136830  else
    66146831    result := FCaptionComponent.Caption;
     6832end;
     6833
     6834function TCaptionMemo.GetDynamicProperty(PropertyID: integer): string;
     6835begin
     6836  if PropertyID = DynaPropAccesibilityCaption then
     6837    Result := GetCaption
     6838  else
     6839    Result := '';
    66156840end;
    66166841
     
    66296854end;
    66306855
     6856function TCaptionMemo.SupportsDynamicProperty(PropertyID: integer): boolean;
     6857begin
     6858  Result := (PropertyID = DynaPropAccesibilityCaption);
     6859end;
     6860
    66316861{ TCaptionEdit }
    66326862
     
    66376867  else
    66386868    result := FCaptionComponent.Caption;
     6869end;
     6870
     6871function TCaptionEdit.GetDynamicProperty(PropertyID: integer): string;
     6872begin
     6873  if PropertyID = DynaPropAccesibilityCaption then
     6874    Result := GetCaption
     6875  else
     6876    Result := '';
    66396877end;
    66406878
     
    66536891end;
    66546892
     6893function TCaptionEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
     6894begin
     6895  Result := (PropertyID = DynaPropAccesibilityCaption);
     6896end;
     6897
    66556898{ TCaptionRichEdit }
    66566899
    6657 procedure TCaptionRichEdit.MakeAccessible(Accessible: IAccessible);
    6658 begin
    6659   if Assigned(FAccessible) and Assigned(Accessible) then
    6660     raise Exception.Create(Caption + ' Rich Edit is already Accessible!')
     6900function TCaptionRichEdit.GetDynamicProperty(PropertyID: integer): string;
     6901begin
     6902  if PropertyID = DynaPropAccesibilityCaption then
     6903    Result := FCaption
    66616904  else
    6662     FAccessible := Accessible;
    6663 end;
    6664 
    6665 procedure TCaptionRichEdit.WMGetObject(var Message: TMessage);
    6666 begin
    6667   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    6668     Message.Result := GetLResult(Message.wParam, FAccessible)
     6905    Result := '';
     6906end;
     6907
     6908
     6909function TCaptionRichEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
     6910begin
     6911  Result := (PropertyID = DynaPropAccesibilityCaption);
     6912end;
     6913
     6914{ TCaptionTreeView}
     6915
     6916function TCaptionTreeView.GetCaption: string;
     6917begin
     6918    result := inherited Caption;
     6919end;
     6920
     6921function TCaptionTreeView.GetDynamicProperty(PropertyID: integer): string;
     6922begin
     6923  if PropertyID = DynaPropAccesibilityCaption then
     6924    Result := GetCaption
    66696925  else
    6670     inherited;
    6671 end;
    6672 
    6673 { TCaptionTreeView}
    6674 
    6675 function TCaptionTreeView.GetCaption: string;
    6676 begin
    6677     result := inherited Caption;
     6926    Result := '';
    66786927end;
    66796928
     
    66936942end;
    66946943
     6944function TCaptionTreeView.SupportsDynamicProperty(PropertyID: integer): boolean;
     6945begin
     6946  Result := (PropertyID = DynaPropAccesibilityCaption);
     6947end;
     6948
    66956949{ TCaptionComboBox }
    66966950
     
    67016955  else
    67026956    result := FCaptionComponent.Caption;
     6957end;
     6958
     6959function TCaptionComboBox.GetDynamicProperty(PropertyID: integer): string;
     6960begin
     6961  if PropertyID = DynaPropAccesibilityCaption then
     6962    Result := GetCaption
     6963  else
     6964    Result := '';
    67036965end;
    67046966
     
    67176979end;
    67186980
     6981function TCaptionComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
     6982begin
     6983  Result := (PropertyID = DynaPropAccesibilityCaption);
     6984end;
     6985
    67196986{ TORAlignSpeedButton }
    67206987
     
    67427009  result := (ColCount - FixedCols) * (Row - FixedRows) +
    67437010      (Col - FixedCols) + 1;
     7011end;
     7012
     7013function TCaptionStringGrid.GetDynamicProperty(PropertyID: integer): string;
     7014begin
     7015  if PropertyID = DynaPropAccesibilityCaption then
     7016    Result := FCaption
     7017  else
     7018    Result := '';
    67447019end;
    67457020
     
    67617036end;
    67627037
    6763 procedure TCaptionStringGrid.MakeAccessible(Accessible: IAccessible);
    6764 begin
    6765   if Assigned(FAccessible) and Assigned(Accessible) then
    6766     raise Exception.Create(Caption + 'String Grid is already Accessible!')
    6767   else
    6768     FAccessible := Accessible;
    6769 end;
    6770 
    6771 procedure TCaptionStringGrid.WMGetObject(var Message: TMessage);
    6772 begin
    6773   if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then
    6774     Message.Result := GetLResult(Message.wParam, FAccessible)
    6775   else
    6776     inherited;
     7038
     7039function TCaptionStringGrid.SupportsDynamicProperty(
     7040  PropertyID: integer): boolean;
     7041begin
     7042  Result := (PropertyID = DynaPropAccesibilityCaption);
    67777043end;
    67787044
     
    68107076    if LongList then
    68117077    begin
    6812       //Currently Do nothing for LongLists
    6813      { if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then
    6814         Result := -1;}
     7078      //Implemented for CQ: 10092, PSI-04-057
     7079      //asume long lists are alphabetically ordered...
     7080      if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then
     7081        Result := -1;
    68157082    end
    68167083    else //Not a LongList
     
    68367103end;
    68377104
     7105{ TCaptionListView }
     7106
     7107function TCaptionListView.GetDynamicProperty(PropertyID: integer): string;
     7108begin
     7109  if PropertyID = DynaPropAccesibilityCaption then
     7110    Result := Caption
     7111  else
     7112    Result := '';
     7113end;
     7114
     7115function TCaptionListView.SupportsDynamicProperty(PropertyID: integer): boolean;
     7116begin
     7117  Result := (PropertyID = DynaPropAccesibilityCaption);
     7118end;
     7119
    68387120initialization
    68397121  //uItemTip := TItemTip.Create(Application);  // all listboxes share a single ItemTip window
  • cprs/trunk/CPRS-Lib/ORCtrlsDsgn.pas

    r456 r829  
    153153begin
    154154  RegisterComponents('CPRS',
    155     [TORStaticText, TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit,
     155    [TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit,
    156156    TORAlignButton, TORAlignSpeedButton, TORTreeView, TORCheckBox, TORListView,
    157157    TKeyClickPanel, TKeyClickRadioGroup, TCaptionListBox, TCaptionCheckListBox,
  • cprs/trunk/CPRS-Lib/ORDtTm.dfm

    r456 r829  
    11object ORfrmDtTm: TORfrmDtTm
    2   Left = 550
    3   Top = 474
     2  Left = 586
     3  Top = 483
    44  BorderIcons = []
    55  BorderStyle = bsDialog
  • cprs/trunk/CPRS-Lib/ORDtTm.pas

    r456 r829  
    77uses
    88  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
    9   Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, ORCtrls;
     9  Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, OR2006Compatibility,
     10  ORCtrls, VAClasses;
    1011
    1112type
    12   TORfrmDtTm = class(TForm)
     13  TORfrmDtTm = class(Tfrm2006Compatibility)
    1314    bvlFrame: TBevel;
    1415    lblDate: TPanel;
     
    5152    FNowPressed:  Boolean;
    5253    TimeIsRequired: Boolean;
     54  protected
     55    procedure Loaded; override;
    5356  end;
    5457
     
    7578  end;
    7679
     80  // 508 class
     81  TORDateButton = class (TBitBtn);
     82
    7783  { TORDateBox }
    7884
     
    8288  end;
    8389
    84   TORDateBox = class(TORDateEdit)
     90  TORDateBox = class(TORDateEdit, IVADynamicProperty, IORBlackColorModeCompatible)
    8591  private
    8692    FFMDateTime: TFMDateTime;
    8793    FDateOnly: Boolean;
    8894    FRequireTime: Boolean;
    89     FButton: TBitBtn;
     95    FButton: TORDateButton;
    9096    FFormat: string;
    9197    FTimeIsNow: Boolean;
    9298    FTemplateField: boolean;
    9399    FCaption: TStaticText;
     100    FBlackColorMode: boolean;
    94101    procedure ButtonClick(Sender: TObject);
    95102    function GetFMDateTime: TFMDateTime;
     
    104111    procedure SetCaption(const Value: string);
    105112    function  GetCaption(): string;
    106                                                              
    107113  protected
    108114    procedure Change; override;
    109115    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     116    property DateButton: TORDateButton read FButton;
    110117  public
    111118    constructor Create(AOwner: TComponent); override;
    112119    function IsValid: Boolean;
    113120    procedure Validate(var ErrMsg: string);
     121    procedure SetBlackColorMode(Value: boolean);
     122    function SupportsDynamicProperty(PropertyID: integer): boolean;
     123    function GetDynamicProperty(PropertyID: integer): string;
    114124    property Format: string read FFormat write FFormat;
    115125    property RelativeTime: string     read GetRelativeTime;
     
    122132  end;
    123133
    124   TORDateCombo = class(TCustomPanel)
     134  // 508 classes
     135  TORDayCombo = class (TORComboBox);
     136  TORMonthCombo = class (TORComboBox);
     137  TORYearEdit = class(TMaskEdit)
     138  private
     139    FTemplateField: boolean;
     140    procedure SetTemplateField(const Value: boolean);
     141  protected
     142    property TemplateField: boolean read FTemplateField write SetTemplateField;
     143  end;
     144
     145  TORYearEditClass = Class of TORYearEdit;
     146
     147  TORDateCombo = class(TCustomPanel, IORBlackColorModeCompatible)
    125148  private
    126149    FYearChanging: boolean;
    127     FMonthCombo: TORComboBox;
    128     FDayCombo: TORComboBox;
    129     FYearEdit: TMaskEdit;
     150    FMonthCombo: TORMonthCombo;
     151    FDayCombo: TORDayCombo;
     152    FYearEdit: TORYearEdit;
    130153    FYearUD: TUpDown;
    131     FCalBtn: TSpeedButton;
     154    FCalBtn: TORDateButton;
    132155    FIncludeMonth: boolean;
    133156    FIncludeDay: boolean;
     
    141164    FRebuilding: boolean;
    142165    FTemplateField: boolean;
     166    FBlackColorMode: boolean;
     167    FORYearEditClass: TORYearEditClass;
    143168    procedure SetIncludeBtn(const Value: boolean);
    144169    procedure SetIncludeDay(Value: boolean);
     
    153178    procedure SetTemplateField(const Value: boolean);
    154179  protected
    155     procedure Rebuild;
     180    procedure Rebuild; virtual;
    156181    function InitDays(GetSize: boolean): integer;
    157182    function InitMonths(GetSize: boolean): integer;
     
    169194    procedure Paint; override;
    170195    procedure Resized(Sender: TObject);
     196    property MonthCombo: TORMonthCombo read FMonthCombo;
     197    property DayCombo: TORDayCombo read FDayCombo;
     198    property YearEdit: TORYearEdit read FYearEdit;
     199    property YearUD: TUpDown read FYearUD;
     200    property CalBtn: TORDateButton read FCalBtn;
     201    property ORYearEditClass: TORYearEditClass read FORYearEditClass write FORYearEditClass;
    171202  public
    172203    constructor Create(AOwner: TComponent); override;
    173204    destructor Destroy; override;
    174205    function DateText: string;
     206    procedure SetBlackColorMode(Value: boolean);
    175207    property TemplateField: boolean read FTemplateField write SetTemplateField;
    176208    property FMDate: TFMDateTime read GetFMDate write SetFMDate;
     
    280312end;
    281313
     314procedure LoadEllipsis(bitmap: TBitMap; BlackColorMode: boolean);
     315var
     316  ResName: string;
     317begin
     318  if BlackColorMode then
     319    ResName := 'BLACK_BMP_ELLIPSIS'
     320  else
     321    ResName := 'BMP_ELLIPSIS';
     322  bitmap.LoadFromResourceName(hInstance, ResName);
     323end;
     324
    282325{ TfrmORDtTm -------------------------------------------------------------------------------- }
    283326
     
    351394procedure TORfrmDtTm.lstHourClick(Sender: TObject);
    352395begin
     396  if lstHour.ItemIndex = 0 then lstMinute.Items[0] := ':01  --' else lstMinute.Items[0] := ':00  --'; //<------ NEW CODE
    353397  if lstMinute.ItemIndex < 0 then lstMinute.ItemIndex := 0;
    354398  lstMinuteClick(Self);
     
    374418
    375419  AMinute := lstMinute.ItemIndex * 5;
     420  if (AnHour = 0) and (AMinute = 0) then AMinute := 1;  //<-------------- NEW CODE
    376421  FFromSelf := True;
    377422  // if ampm time -
     
    410455  begin
    411456    x := Trim(txtTime.Text);
    412     if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
     457    //if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
     458    if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:01';  //<------- CHANGED CODE
    413459    StrToTime(x);
    414460    txtTime.Text := x;
     
    420466begin
    421467  ModalResult := mrCancel;
     468end;
     469
     470procedure TORfrmDtTm.Loaded;
     471begin
     472  inherited Loaded;
     473  UpdateColorsFor508Compliance(Self);
    422474end;
    423475
     
    515567begin
    516568  inherited Create(AOwner);
    517   FButton := TBitBtn.Create(Self);
     569  FButton := TORDateButton.Create(Self);
    518570  FButton.Parent := Self;
    519571  FButton.Width := 18;
     
    521573  FButton.OnClick := ButtonClick;
    522574  FButton.TabStop := False;
    523   FButton.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS');
     575  FBlackColorMode := False;
     576  LoadEllipsis(FButton.Glyph, FALSE);
    524577  FButton.Visible := True;
    525578  FFormat := FMT_DATETIME;
     
    567620end;
    568621
     622function TORDateBox.SupportsDynamicProperty(PropertyID: integer): boolean;
     623begin
     624  Result := (PropertyID = DynaPropAccesibilityCaption);
     625end;
     626
    569627procedure TORDateBox.ButtonClick(Sender: TObject);
    570628var
     
    696754  if Length(x) = 0 then Result := True else Result := False;
    697755  if Length(Text) = 0 then Result := False;
     756end;
     757
     758procedure TORDateBox.SetBlackColorMode(Value: boolean);
     759begin
     760  if FBlackColorMode <> Value then
     761  begin
     762    FBlackColorMode := Value;
     763    LoadEllipsis(FButton.Glyph, FBlackColorMode);
     764  end;
    698765end;
    699766
     
    717784end;
    718785
     786function TORDateBox.GetDynamicProperty(PropertyID: integer): string;
     787begin
     788  if PropertyID = DynaPropAccesibilityCaption then
     789    Result := GetCaption
     790  else
     791    Result := '';
     792end;
     793
    719794function IsLeapYear(AYear: Integer): Boolean;
    720795begin
     
    745820  LastYear = 2200;
    746821
    747 type
    748   TORDateComboEdit = class(TMaskEdit)
    749   private
    750     FTemplateField: boolean;
    751     procedure SetTemplateField(const Value: boolean);
    752   protected
    753     property TemplateField: boolean read FTemplateField write SetTemplateField;
    754   end;
    755 
    756822{ TORDateComboEdit }
    757823
    758 procedure TORDateComboEdit.SetTemplateField(const Value: boolean);
     824procedure TORYearEdit.SetTemplateField(const Value: boolean);
    759825begin
    760826  if(FTemplateField <> Value) then
     
    779845  FIncludeBtn := TRUE;
    780846  OnResize := Resized;
     847  FORYearEditClass := TORYearEdit;
    781848end;
    782849
     
    868935          if(not assigned(FMonthCombo)) then
    869936          begin
    870             FMonthCombo := TORComboBox.Create(Self);
     937            FMonthCombo := TORMonthCombo.Create(Self);
    871938            FMonthCombo.Parent := Self;
    872939            FMonthCombo.Top := 0;
     
    874941            FMonthCombo.Style := orcsDropDown;
    875942            FMonthCombo.DropDownCount := 13;
     943            FMonthCombo.ListItemsOnly := True;
    876944            FMonthCombo.OnChange := MonthChanged;
    877945          end;
     
    888956            if(not assigned(FDayCombo)) then
    889957            begin
    890               FDayCombo := TORComboBox.Create(Self);
     958              FDayCombo := TORDayCombo.Create(Self);
    891959              FDayCombo.Parent := Self;
    892960              FDayCombo.Top := 0;
    893961              FDayCombo.Style := orcsDropDown;
     962              FDayCombo.ListItemsOnly := True;
    894963              FDayCombo.OnChange := DayChanged;
    895964              FDayCombo.DropDownCount := 11;
     
    914983        if(not assigned(FYearEdit)) then
    915984        begin
    916           FYearEdit := TORDateComboEdit.Create(Self);
     985          FYearEdit := FORYearEditClass.Create(Self);
    917986          FYearEdit.Parent := Self;
    918987          FYearEdit.Top := 0;
     
    922991        end;
    923992        FYearEdit.Font := Font;
    924         TORDateComboEdit(FYearEdit).TemplateField := FTemplateField;
     993        FYearEdit.TemplateField := FTemplateField;
    925994        Wide := GetYearSize;
    926995        FYearEdit.Width := Wide;
     
    9471016          if(not assigned(FCalBtn)) then
    9481017          begin
    949             FCalBtn := TSpeedButton.Create(Self);
     1018            FCalBtn := TORDateButton.Create(Self);
     1019            FCalBtn.TabStop := FALSE;
    9501020            FCalBtn.Parent := Self;
    9511021            FCalBtn.Top := 0;
    952             FCalBtn.Glyph.LoadFromResourceName(hInstance, 'BMP_ELLIPSIS');
     1022            LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
    9531023            FCalBtn.OnClick := BtnClicked;
    9541024          end;
     
    9731043      FRebuilding := FALSE;
    9741044    end;
     1045  end;
     1046end;
     1047
     1048procedure TORDateCombo.SetBlackColorMode(Value: boolean);
     1049begin
     1050  if FBlackColorMode <> Value then
     1051  begin
     1052    FBlackColorMode := Value;
     1053    if assigned(FCalBtn) then   
     1054      LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
    9751055  end;
    9761056end;
  • cprs/trunk/CPRS-Lib/ORDtTmRng.dfm

    r456 r829  
    1818    Left = 8
    1919    Top = 44
    20     Width = 53
     20    Width = 52
    2121    Height = 13
    2222    Caption = 'Begin Date'
     
    2525    Left = 145
    2626    Top = 44
    27     Width = 45
     27    Width = 44
    2828    Height = 13
    2929    Caption = 'End Date'
  • cprs/trunk/CPRS-Lib/ORDtTmRng.pas

    r456 r829  
    55uses
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   StdCtrls, ORFn, ORDtTm;
     7  StdCtrls, ORFn, OR2006Compatibility, ORDtTm;
    88
    99type
    10   TORfrmDateRange = class(TForm)
     10  TORfrmDateRange = class(Tfrm2006Compatibility)
    1111    lblStart: TLabel;
    1212    lblStop: TLabel;
     
    2121    FCalStart: TORDateBox;
    2222    FCalStop:  TORDateBox;
     23  protected
     24    procedure Loaded; override;
    2325  end;
    2426
     
    217219  FCalStop.TabOrder := 1;
    218220  ResizeAnchoredFormToFont(self);
     221  UpdateColorsFor508Compliance(self);
    219222end;
    220223
     
    225228end;
    226229
     230procedure TORfrmDateRange.Loaded;
     231begin
     232  inherited Loaded;
     233  UpdateColorsFor508Compliance(Self);
     234end;
     235
    227236end.
  • cprs/trunk/CPRS-Lib/ORFn.pas

    r456 r829  
    66
    77uses SysUtils, Windows, Messages, Classes, Controls, StdCtrls, ExtCtrls, ComCtrls, Forms,
    8      Graphics, Menus, RichEdit;
     8     Graphics, Menus, RichEdit, Buttons;
    99
    1010const
     
    1313  BOOLCHAR: array[Boolean] of Char = ('0', '1');
    1414  UM_STATUSTEXT = (WM_USER + 302);               // used to send update status msg to main form
    15   COLOR_CREAM   = $F0FBFF;
     15
     16var
     17  ScrollBarHeight: integer = 0;
    1618
    1719type
     
    6668function DelimCount(const Str, Delim: string): integer;
    6769procedure QuickCopy(AFrom, ATo: TObject);
     70procedure QuickAdd(AFrom, ATo: TObject);
     71procedure FastAssign(source, destination: TStrings);
     72procedure FastAddStrings(source, destination: TStrings);
    6873function ValidFileName(const InitialFileName: string): string;
    6974
     
    8489procedure ResizeFormToFont(AForm: TForm);
    8590procedure ResizeAnchoredFormToFont( AForm: TForm);
     91procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm);
    8692function ResizeWidth( OldFont: TFont; NewFont: TFont; OldWidth: integer): integer;
    8793function ResizeHeight( OldFont: TFont; NewFont: TFont; OldHeight: integer): integer;
     
    96102function PopupComponent(Sender: TObject; PopupMenu: TPopupMenu): TComponent;
    97103procedure ReformatMemoParagraph(AMemo: TCustomMemo);
    98 function ReadOnlyColor: TColor;
     104
     105function BlackColorScheme: Boolean;
     106function NormalColorScheme: Boolean;
     107function Get508CompliantColor(Color: TColor): TColor;
     108procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE);
     109procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean);
    99110
    100111{ ListBox Grid functions }
     
    116127function TabIsPressed : Boolean;
    117128function ShiftTabIsPressed : Boolean;
     129function EnterIsPressed : Boolean;
    118130
    119131implementation  // ---------------------------------------------------------------------------
    120132
    121133uses
    122   ORCtrls, Grids, Chart, CheckLst;
     134  ORCtrls, Grids, Chart, CheckLst, VAUtils;
    123135
    124136const
     
    606618function Piece(const S: string; Delim: char; PieceNum: Integer): string;
    607619{ returns the Nth piece (PieceNum) of a string delimited by Delim }
    608 var
    609   i: Integer;
    610   Strt, Next: PChar;
    611 begin
    612   i := 1;
    613   Strt := PChar(S);
    614   Next := StrScan(Strt, Delim);
    615   while (i < PieceNum) and (Next <> nil) do
    616   begin
    617     Inc(i);
    618     Strt := Next + 1;
    619     Next := StrScan(Strt, Delim);
    620   end;
    621   if Next = nil then Next := StrEnd(Strt);
    622   if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt);
     620begin
     621  Result := VAUtils.Piece(S, Delim, PieceNum);
    623622end;
    624623
    625624function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string;
    626 { returns several contiguous pieces }
    627 var
    628   PieceNum: Integer;
    629 begin
    630   Result := '';
    631   for PieceNum := FirstNum to LastNum do Result := Result + Piece(S, Delim, PieceNum) + Delim;
    632   if Length(Result) > 0 then Delete(Result, Length(Result), 1);
     625begin
     626  Result := VAUtils.Pieces(S, Delim, FirstNum, LastNum);
    633627end;
    634628
     
    779773    if obj is TListBox then
    780774      str[idx] := TListBox(obj).Items
     775    else
     776    if obj is TORComboBox then
     777      str[idx] := TORComboBox(obj).Items
     778    else
     779    if obj is TComboBox then
     780      str[idx] := TComboBox(obj).Items
    781781    else
    782782    if obj is TRichEdit then
     
    815815  if fix[0] then TRichEdit(AFrom).PlainText := FALSE;
    816816  if fix[1] then TRichEdit(ATo).PlainText := FALSE;
     817  if ATo is TRichEdit then
     818    TRichEdit(ATo).SelStart := Length(TRichEdit(ATo).Lines.Text); //CQ: 16461
     819end;
     820
     821type
     822  QuickAddError = class(Exception);
     823
     824procedure QuickAdd(AFrom, ATo: TObject);
     825var
     826  ms: TMemoryStream;
     827  idx: integer;
     828  str: array[0..1] of TStrings;
     829  fix: array[0..1] of boolean;
     830
     831  procedure GetStrings(obj: TObject);
     832  begin
     833    if (CompareText(obj.ClassName, 'TRichEditStrings') = 0) then
     834      raise QuickCopyError.Create('You must pass the TRichEdit object into QuickAdd, NOT it''s Lines property.');
     835    if obj is TStrings then
     836      str[idx] := TStrings(obj)
     837    else
     838    if obj is TMemo then
     839      str[idx] := TMemo(obj).Lines
     840    else
     841    if obj is TORListBox then
     842      str[idx] := TORListBox(obj).Items
     843    else
     844    if obj is TListBox then
     845      str[idx] := TListBox(obj).Items
     846    else
     847    if obj is TORComboBox then
     848      str[idx] := TORComboBox(obj).Items
     849    else
     850    if obj is TComboBox then
     851      str[idx] := TComboBox(obj).Items
     852    else
     853    if obj is TRichEdit then
     854    begin
     855      with TRichEdit(obj) do
     856      begin
     857        str[idx] := Lines;
     858        if not PlainText then
     859        begin
     860          fix[idx] := TRUE;
     861          PlainText := TRUE;
     862        end;
     863      end;
     864    end
     865    else
     866      raise QuickAddError.Create('Unsupported object type (' + obj.ClassName +
     867                                  ') passed into QuickAdd.');
     868    inc(idx);
     869  end;
     870
     871
     872begin
     873  fix[0] := FALSE;
     874  fix[1] := FALSE;
     875  idx := 0;
     876  GetStrings(AFrom);
     877  GetStrings(ATo);
     878  ms := TMemoryStream.Create;
     879  try
     880    str[1].SaveToStream(ms);
     881    ms.Seek(0, soFromEnd);
     882    str[0].SaveToStream(ms);
     883    ms.Seek(0, soFromBeginning);
     884    str[1].Clear;
     885    str[1].LoadFromStream(ms);
     886  finally
     887    ms.Free;
     888  end;
     889  if fix[0] then TRichEdit(AFrom).PlainText := FALSE;
     890  if fix[1] then TRichEdit(ATo).PlainText := FALSE;
     891end;
     892
     893procedure FastAssign(source, destination: TStrings);
     894// do not use this with RichEdit Lines unless source is RichEdit with PlainText
     895var
     896  ms: TMemoryStream;
     897begin
     898  destination.Clear;
     899  if (source is TStringList) and (destination is TStringList) then
     900    destination.Assign(source)
     901  else
     902  if (CompareText(source.ClassName, 'TRichEditStrings') = 0) then
     903    destination.Assign(source)
     904  else
     905  begin
     906    ms := TMemoryStream.Create;
     907    try
     908      source.SaveToStream(ms);
     909      ms.Seek(0, soFromBeginning);
     910      destination.LoadFromStream(ms);
     911    finally
     912      ms.Free;
     913    end;
     914  end;
     915end;
     916
     917procedure FastAddStrings(source, destination: TStrings);
     918// do not use this with RichEdit Lines unless source and destination are RichEdit with PlainText
     919var
     920  ms: TMemoryStream;
     921begin
     922  if (source is TStringList) and (destination is TStringList) then
     923    destination.AddStrings(source)
     924  else
     925  begin
     926    ms := TMemoryStream.Create;
     927    try
     928      destination.SaveToStream(ms);
     929      ms.Seek(0, soFromEnd);
     930      source.SaveToStream(ms);
     931      ms.Seek(0, soFromBeginning);
     932      destination.Clear;
     933      destination.LoadFromStream(ms);
     934    finally
     935      ms.Free;
     936    end;
     937  end;
    817938end;
    818939
     
    861982    end; {for i}
    862983    AList.Clear;
    863     AList.Assign(NewList);
     984    FastAssign(NewList, AList);
    864985  finally
    865986    NewList.Free;
     
    12481369end;
    12491370
     1371var
     1372  AlignList, AnchorList: TStringList;
     1373
     1374function AnchorsToStr(Control: TControl): string;
     1375var
     1376  j: TAnchorKind;
     1377
     1378begin
     1379  Result := '';
     1380  for j := low(TAnchorKind) to high(TAnchorKind) do
     1381    if j in Control.Anchors then
     1382      Result := result + '1'
     1383    else
     1384      Result := result + '0'
     1385end;
     1386
     1387function StrToAnchors(i: integer): TAnchors;
     1388var
     1389  j: TAnchorKind;
     1390  value: string;
     1391  idx : integer;
     1392begin
     1393  Result := [];
     1394  value := AnchorList[i];
     1395  idx := 1;
     1396  for j := low(TAnchorKind) to high(TAnchorKind) do
     1397  begin
     1398    if copy(value,idx,1) = '1' then
     1399      include(Result, j);
     1400    inc(idx);
     1401  end;
     1402end;
     1403
     1404procedure SuspendAlign(AForm: TForm);
     1405var
     1406  i: integer;
     1407  control: TControl;
     1408begin
     1409  AForm.DisableAlign;
     1410  AlignList.Clear;
     1411  AnchorList.Clear;
     1412  for i := 0 to AForm.ControlCount-1 do
     1413  begin
     1414    control := AForm.Controls[i];
     1415    AlignList.Add(IntToStr(ord(control.align)));
     1416    control.Align := alNone;
     1417    AnchorList.Add(AnchorsToStr(control));
     1418    control.Anchors := [];
     1419  end;
     1420end;
     1421
     1422procedure RestoreAlign(AForm: TForm);
     1423var
     1424  i: integer;
     1425  control: TControl;
     1426begin
     1427  try
     1428    for i := 0 to AForm.ControlCount-1 do
     1429    begin
     1430      control := AForm.Controls[i];
     1431      control.Align := TAlign(StrToIntDef(AlignList[i],0));
     1432      control.Anchors := StrToAnchors(i);
     1433    end;
     1434    AlignList.Clear;
     1435    AnchorList.Clear;
     1436  finally
     1437    AForm.EnableAlign;
     1438  end;
     1439end;
     1440
    12501441procedure ResizeFormToFont(AForm: TForm);
    12511442var
    12521443  Rect: TRect;
    1253 begin
     1444  OldResize: TNotifyEvent;
     1445begin
     1446// CQ# 11481 apply size changes to form all at once, instead of piece by piece.  Otherwise,
     1447// multiple calls to fAutoSz.FormResize, even if the form has not resized, can distort
     1448// the controls beyond the size of the form.
    12541449  with AForm do begin
    1255     ClientWidth := ResizeWidth( Font, MainFont, ClientWidth);
    1256     ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
    1257     HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
    1258     VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
    1259     Rect := BoundsRect;
    1260     ForceInsideWorkArea(Rect);
    1261     BoundsRect := Rect;
    1262     ResizeFontsInDescendants( Font, MainFont, AForm);
    1263     //Important: We are using the font to calculate everything, so don't
    1264     //change font until now.
    1265     Font.Size := MainFont.Size;
     1450    OldResize := AForm.OnResize;
     1451    AForm.OnResize := nil;
     1452    try
     1453      SuspendAlign(AForm);
     1454      try
     1455        HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
     1456        VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
     1457        ClientWidth := ResizeWidth( Font, MainFont, ClientWidth);
     1458        ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
     1459        Rect := BoundsRect;
     1460        ForceInsideWorkArea(Rect);
     1461        BoundsRect := Rect;
     1462      finally
     1463        RestoreAlign(AForm);
     1464      end;
     1465      ResizeFontsInDescendants( Font, MainFont, AForm);
     1466      //Important: We are using the font to calculate everything, so don't
     1467      //change font until now.
     1468      Font.Size := MainFont.Size;
     1469    finally
     1470      if(Assigned(OldResize)) then
     1471      begin
     1472        AForm.OnResize := OldResize;
     1473        OldResize(AForm);
     1474      end;
     1475    end;
    12661476  end;
    12671477end;
     
    12701480var
    12711481  Rect: TRect;
     1482  OldResize: TNotifyEvent;
     1483
    12721484begin
    12731485  with AForm do begin
    1274     ClientWidth  := ResizeWidth( Font, MainFont, ClientWidth);
    1275     ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
    1276     HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
    1277     VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
    1278     Rect := BoundsRect;
    1279     ForceInsideWorkArea(Rect);
    1280     BoundsRect := Rect;
    1281     ResizeDescendants( Font, MainFont, AForm);
    1282     ResizeFontsInDescendants( Font, MainFont, AForm);
    1283     //Important: We are using the font to calculate everything, so don't
    1284     //change font until now.
    1285     Font.Size := MainFont.Size;
     1486  // CQ# 11481 - see ResizeFormToFont
     1487    OldResize := AForm.OnResize;
     1488    AForm.OnResize := nil;
     1489    try
     1490      HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range);
     1491      VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range);
     1492      ClientWidth  := ResizeWidth( Font, MainFont, ClientWidth);
     1493      ClientHeight := ResizeHeight( Font, MainFont, ClientHeight);
     1494      Rect := BoundsRect;
     1495      ForceInsideWorkArea(Rect);
     1496      BoundsRect := Rect;
     1497      ResizeDescendants( Font, MainFont, AForm);
     1498      ResizeFontsInDescendants( Font, MainFont, AForm);
     1499      //Important: We are using the font to calculate everything, so don't
     1500      //change font until now.
     1501      Font.Size := MainFont.Size;
     1502    finally
     1503      if(Assigned(OldResize)) then
     1504      begin
     1505        AForm.OnResize := OldResize;
     1506        OldResize(AForm);
     1507      end;
     1508    end;
     1509  end;
     1510end;
     1511
     1512// CQ 11485 - Adjusts all forms  - adds additional height to the form to
     1513// adjust for Windows XP style title bars, and for large fonts in title bar
     1514procedure AdjustForWindowsXPStyleTitleBar(AForm: TForm);
     1515const
     1516  DEFAULT_CAPTION_HEIGHT = 19;
     1517  DEFAULT_MENU_HEIGHT = 19;
     1518
     1519var
     1520  dxsb, dysb, dy, menuDY: integer;
     1521
     1522begin
     1523// Call GetSystemMetrics each time because values can change between calls
     1524  dy := GetSystemMetrics(SM_CYCAPTION) - DEFAULT_CAPTION_HEIGHT;
     1525  if (AForm.Menu <> nil) then
     1526  begin
     1527    menuDY := GetSystemMetrics(SM_CYMENU) - DEFAULT_MENU_HEIGHT;
     1528    inc(dy, menuDY);
     1529  end;
     1530  if dy <> 0 then
     1531  begin
     1532    SuspendAlign(AForm);
     1533    try
     1534    // Assitional adjustment to allow scroll bars to dissappear
     1535      dxsb := GetSystemMetrics(SM_CXVSCROLL);
     1536      dysb := GetSystemMetrics(SM_CYHSCROLL);
     1537      AForm.Height := AForm.Height + dy + dysb;
     1538      AForm.Width := AForm.Width + dxsb;
     1539      AForm.Height := AForm.Height - dysb;
     1540      AForm.Width := AForm.Width - dxsb;
     1541    finally
     1542      RestoreAlign(AForm);
     1543    end;
    12861544  end;
    12871545end;
     
    13291587begin
    13301588  DC := GetDC(0);
    1331   SaveFont := SelectObject(DC, AFontHandle);
    1332   GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
    1333   Result := TextSize.cx;
    1334   SelectObject(DC, SaveFont);
    1335   ReleaseDC(0, DC);
     1589  try
     1590    SaveFont := SelectObject(DC, AFontHandle);
     1591    try
     1592      GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
     1593      Result := TextSize.cx;
     1594    finally
     1595      SelectObject(DC, SaveFont);
     1596    end;
     1597  finally
     1598    ReleaseDC(0, DC);
     1599  end;
    13361600end;
    13371601
     
    13441608begin
    13451609  DC := GetDC(0);
    1346   SaveFont := SelectObject(DC, AFontHandle);
    1347   GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
    1348   Result := TextSize.cy;
    1349   SelectObject(DC, SaveFont);
    1350   ReleaseDC(0, DC);
     1610  try
     1611    SaveFont := SelectObject(DC, AFontHandle);
     1612    try
     1613      GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize);
     1614      Result := TextSize.cy;
     1615    finally
     1616      SelectObject(DC, SaveFont);
     1617    end;
     1618  finally
     1619    ReleaseDC(0, DC);
     1620  end;
     1621  if Result > 255 then // CQ 11493
     1622    Result := 255; // This is maximum allowed by a Windows
    13511623end;
    13521624
     
    13931665    end;
    13941666  end;
     1667  if Result > 255 then // CQ 11492
     1668    Result := 255; // This is maximum allowed by a Windows
    13951669end;
    13961670
     
    14711745
    14721746var
    1473   uReadOnlyColor: TColor;
    1474   uHaveReadOnlyColor: boolean = FALSE;
    1475 
    1476 function ReadOnlyColor: TColor;
    1477 begin
    1478   if not uHaveReadOnlyColor then
    1479   begin
    1480     uHaveReadOnlyColor := TRUE;
    1481     if ColorToRGB(clWindow) = ColorToRGB(clWhite) then
    1482       uReadOnlyColor := $00F0FBFF
     1747  uNormalColorScheme: boolean = false;
     1748  uBlackColorScheme: boolean = false;
     1749  uWhiteColorScheme: boolean = false;
     1750  uMaroonColorWhenBlack: TColor = clMaroon;
     1751  uCheckColorScheme: boolean = true;
     1752  PURE_BLACK: longint = 0;
     1753
     1754const
     1755  uBorderlessWindowColorWhenBlack: TColor = clNavy;
     1756
     1757
     1758procedure CheckColorScheme;
     1759begin
     1760  if uCheckColorScheme then
     1761  begin
     1762    uNormalColorScheme :=
     1763      ((ColorToRGB(clWindow)      = ColorToRGB(clWhite)) and
     1764       (ColorToRGB(clWindowText)  = ColorToRGB(clBlack)) and
     1765       (ColorToRGB(clInfoText)    = ColorToRGB(clBlack)) and
     1766       (ColorToRGB(clInfoBk)     <> ColorToRGB(clWhite)));
     1767
     1768    uBlackColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clBlack)) and
     1769                          (ColorToRGB(clWindow) = ColorToRGB(clBlack)));
     1770    uWhiteColorScheme := ((ColorToRGB(clBtnFace) = ColorToRGB(clWhite)) and
     1771                          (ColorToRGB(clWindow) = ColorToRGB(clWhite)));
     1772
     1773    if uBlackColorScheme then
     1774    begin
     1775      if(ColorToRGB(clGrayText) = ColorToRGB(clWindowText)) then
     1776        uMaroonColorWhenBlack := clHighlightText
     1777      else
     1778        uMaroonColorWhenBlack := clGrayText;
     1779    end;
     1780
     1781    uCheckColorScheme := FALSE;
     1782  end;
     1783end;
     1784
     1785function BlackColorScheme: Boolean;
     1786begin
     1787  if uCheckColorScheme then CheckColorScheme;
     1788  Result := uBlackColorScheme;
     1789end;
     1790
     1791function NormalColorScheme: Boolean;
     1792begin
     1793  if uCheckColorScheme then CheckColorScheme;
     1794  Result := uNormalColorScheme;
     1795end;
     1796
     1797function Get508CompliantColor(Color: TColor): TColor;
     1798begin
     1799  Result := Color;
     1800  if NormalColorScheme then exit;
     1801
     1802  case Color of
     1803    clCream:    Result := clInfoBk;
     1804    clBlack:    Result := clWindowText;
     1805    clWhite:    Result := clWindow;
     1806  end;
     1807
     1808  if uBlackColorScheme then
     1809  begin
     1810    case Color of
     1811      clBlue:     Result := clAqua;
     1812      clMaroon:   Result := uMaroonColorWhenBlack;
     1813  //    clRed:      Result := clFuchsia;
     1814    end;
     1815  end;
     1816
     1817  if uWhiteColorScheme then
     1818  begin
     1819    case Color of
     1820      clGrayText: Result := clGray;
     1821    end;
     1822  end;
     1823end;
     1824
     1825type
     1826  TExposedControl = class(TControl)
     1827  public
     1828    property Color;
     1829    property Font;
     1830  end;
     1831
     1832  TExposedCustomEdit = class(TCustomEdit)
     1833  public
     1834    property BorderStyle;
     1835    property ReadOnly;
     1836  end;
     1837
     1838procedure UpdateColorsFor508Compliance(control: TControl; InputEditControl: boolean = FALSE);
     1839var
     1840  BitMapLevelCheck: integer;
     1841  Level: integer;
     1842
     1843
     1844  procedure BlackColorSchemeUpdate(control: TControl);
     1845  var
     1846    bitmap: TBitMap;
     1847    edit: TExposedCustomEdit;
     1848    x,y: integer;
     1849    cbmCtrl: IORBlackColorModeCompatible;
     1850
     1851  begin
     1852    if uBlackColorScheme then
     1853    begin
     1854      if Level < BitMapLevelCheck then
     1855      begin
     1856        if control.GetInterface(IORBlackColorModeCompatible, cbmCtrl) then
     1857        begin
     1858          cbmCtrl.SetBlackColorMode(TRUE);
     1859          BitMapLevelCheck := Level;
     1860          cbmCtrl := nil;
     1861        end
     1862        else
     1863        begin
     1864          if (control is TBitBtn) then
     1865          begin
     1866            bitmap := TBitBtn(control).Glyph;
     1867            for x := 0 to bitmap.Width-1 do
     1868            begin
     1869              for y := 0 to bitmap.Height-1 do
     1870              begin
     1871                if ColorToRGB(bitmap.Canvas.Pixels[x,y]) = PURE_BLACK then
     1872                  bitmap.Canvas.Pixels[x,y] := clWindowText;
     1873              end;
     1874            end;
     1875          end;
     1876        end;
     1877      end;
     1878
     1879      if (control is TCustomEdit) and InputEditControl then
     1880      begin
     1881        edit := TExposedCustomEdit(control);
     1882        if (edit.BorderStyle = bsNone) then
     1883          edit.Color := uBorderlessWindowColorWhenBlack;
     1884      end;
     1885
     1886    end;
     1887  end;
     1888
     1889  procedure ComponentUpdateColorsFor508Compliance(control: TControl);
     1890  var
     1891    OldComponentColor, OldFontColor, NewComponentColor, NewFontColor: TColor;
     1892  begin
     1893    OldComponentColor := TExposedControl(control).Color;
     1894    OldFontColor := TExposedControl(control).Font.Color;
     1895    NewComponentColor := Get508CompliantColor(OldComponentColor);
     1896    if NewComponentColor = clInfoBk then
     1897    begin
     1898      if (OldFontColor = clInfoBk) or (OldFontColor = clCream) then
     1899        NewFontColor := clInfoBk // used for hiding text
     1900      else
     1901        NewFontColor := clInfoText;
     1902    end
    14831903    else
    1484       uReadOnlyColor := clWindow;
    1485   end;
    1486   Result := uReadOnlyColor;
     1904      NewFontColor := Get508CompliantColor(OldFontColor);
     1905    if NewComponentColor <> OldComponentColor then
     1906      TExposedControl(control).Color := NewComponentColor;
     1907    if NewFontColor <> OldFontColor then
     1908      TExposedControl(control).Font.Color := NewFontColor;
     1909    BlackColorSchemeUpdate(control);
     1910  end;
     1911
     1912  procedure ScanAllComponents(control: TControl);
     1913  var
     1914    i: integer;
     1915
     1916  begin
     1917    ComponentUpdateColorsFor508Compliance(Control);
     1918    if control is TWinControl then
     1919    begin
     1920      inc(Level);
     1921      try
     1922        for i := 0 to TWinControl(Control).ControlCount-1 do
     1923        begin
     1924          ScanAllComponents(TWinControl(Control).Controls[i]);
     1925        end;
     1926      finally
     1927        dec(Level);
     1928        if BitMapLevelCheck = Level then
     1929          BitMapLevelCheck := MaxInt;
     1930      end;
     1931    end;
     1932  end;
     1933
     1934begin
     1935  if NormalColorScheme then exit;
     1936  BitMapLevelCheck := MaxInt;
     1937  Level := 0;
     1938  ScanAllComponents(control);
     1939end;
     1940
     1941procedure UpdateReadOnlyColorScheme(Control: TControl; ReadOnly: boolean);
     1942begin
     1943  with TExposedControl(Control) do
     1944  begin
     1945    if ReadOnly then
     1946    begin
     1947      Color := Get508CompliantColor(clCream);
     1948      Font.Color := clInfoText;
     1949    end
     1950    else
     1951    begin
     1952      Color := clWindow;
     1953      Font.Color := clWindowText;
     1954    end;
     1955  end;
    14871956end;
    14881957
     
    15211990    end;
    15221991    Canvas.FillRect(ARect);
    1523     Canvas.Pen.Color := clSilver;
     1992    Canvas.Pen.Color := Get508CompliantColor(clSilver);
    15241993    Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    15251994    Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
     
    17142183begin
    17152184  Result := Boolean(Hi(GetKeyState(VK_TAB))) and not Boolean(Hi(GetKeyState(VK_SHIFT)));
     2185  Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL)));
    17162186end;
    17172187
     
    17192189begin
    17202190  Result := Boolean(Hi(GetKeyState(VK_TAB))) and Boolean(Hi(GetKeyState(VK_SHIFT)));
    1721 end;
    1722 
     2191  Result := Result and not Boolean(Hi(GetKeyState(VK_CONTROL)));
     2192end;
     2193
     2194function EnterIsPressed : Boolean;
     2195begin
     2196  Result := Boolean(Hi(GetKeyState(VK_RETURN)));
     2197end;
    17232198
    17242199initialization
     
    17262201  FBaseFont.Name := BaseFontName;
    17272202  FBaseFont.Size := BaseFontSize;
     2203  ScrollBarHeight := GetSystemMetrics(SM_CYHSCROLL);
     2204  AlignList := TStringList.Create;
     2205  AnchorList := TStringList.Create;
     2206  PURE_BLACK := ColorToRGB(clBlack);
    17282207
    17292208finalization
    17302209  FBaseFont.Free;
    17312210  KillObj(@IdleCaller);
     2211  FreeAndNil(AlignList);
     2212  FreeAndNil(AnchorList);
    17322213
    17332214end.
  • cprs/trunk/CPRS-Lib/ORNet.pas

    r456 r829  
    4343{$ENDIF}
    4444  RPCLastCall: string;
     45
     46  AppStartedCursorForm: TForm = nil;
    4547
    4648implementation
     
    263265  AStringList.Add(' ');
    264266  AStringList.Add('Results -----------------------------------------------------------------');
    265   AStringList.AddStrings(RPCBrokerV.Results);
     267  FastAddStrings(RPCBrokerV.Results, AStringList);
    266268  uCallList.Add(AStringList);
    267269  if uShowRPCs then StatusText('');
     
    347349end;
    348350
     351function GetRPCCursor: TCursor;
     352var
     353  pt: TPoint;
     354begin
     355  Result := crHourGlass;
     356  if assigned(AppStartedCursorForm) and (AppStartedCursorForm.Visible) then
     357  begin
     358    pt := Mouse.CursorPos;
     359    if PtInRect(AppStartedCursorForm.BoundsRect, pt) then
     360      Result := crAppStart;   
     361  end;
     362end;
     363
    349364procedure CallV(const RPCName: string; const AParam: array of const);
    350365{ calls the broker leaving results in results property which must be read by caller }
     
    353368begin
    354369  SavedCursor := Screen.Cursor;
    355   Screen.Cursor := crHourGlass;
     370  Screen.Cursor := GetRPCCursor;
    356371  SetParams(RPCName, AParam);
    357372  CallBroker;  //RPCBrokerV.Call;
     
    365380begin
    366381  SavedCursor := Screen.Cursor;
    367   Screen.Cursor := crHourGlass;
     382  Screen.Cursor := GetRPCCursor;
    368383  SetParams(RPCName, AParam);
    369384  CallBroker;  //RPCBrokerV.Call;
     
    379394  if ReturnData = nil then raise Exception.Create('TString not created');
    380395  SavedCursor := Screen.Cursor;
    381   Screen.Cursor := crHourGlass;
     396  Screen.Cursor := GetRPCCursor;
    382397  SetParams(RPCName, AParam);
    383398  CallBroker;  //RPCBrokerV.Call;
    384   ReturnData.Assign(RPCBrokerV.Results);
     399  FastAssign(RPCBrokerV.Results, ReturnData);
    385400  Screen.Cursor := SavedCursor;
    386401end;
     
    395410begin
    396411  SavedCursor := Screen.Cursor;
    397   Screen.Cursor := crHourGlass;
     412  Screen.Cursor := GetRPCCursor;
    398413  SetParams(RPCName, AParam);
    399414  RPCBrokerV.Call;
     
    450465procedure LoadRPCData(Dest: TStrings; ID: Integer);
    451466begin
    452   if (ID > -1) and (ID < uCallList.Count) then Dest.Assign(TStringList(uCallList.Items[ID]));
     467  if (ID > -1) and (ID < uCallList.Count) then FastAssign(TStringList(uCallList.Items[ID]), Dest);
    453468end;
    454469
  • cprs/trunk/CPRS-Lib/ORSystem.pas

    r456 r829  
    22
    33{$O-}
     4{$WARN SYMBOL_PLATFORM OFF}
    45
    56interface
     
    1920  CPRS_LAST_DATE = 'Software\Vista\CPRS\DateUpdated';
    2021
    21   { values that can be passed to FileVersionValue }
    22   FILE_VER_COMPANYNAME      = '\StringFileInfo\040904E4\CompanyName';
    23   FILE_VER_FILEDESCRIPTION  = '\StringFileInfo\040904E4\FileDescription';
    24   FILE_VER_FILEVERSION      = '\StringFileInfo\040904E4\FileVersion';
    25   FILE_VER_INTERNALNAME     = '\StringFileInfo\040904E4\InternalName';
    26   FILE_VER_LEGALCOPYRIGHT   = '\StringFileInfo\040904E4\LegalCopyright';
    27   FILE_VER_ORIGINALFILENAME = '\StringFileInfo\040904E4\OriginalFilename';
    28   FILE_VER_PRODUCTNAME      = '\StringFileInfo\040904E4\ProductName';
    29   FILE_VER_PRODUCTVERSION   = '\StringFileInfo\040904E4\ProductVersion';
    30   FILE_VER_COMMENTS         = '\StringFileInfo\040904E4\Comments';
    31 
    32 
    3322function AppOutOfDate(AppName: string): Boolean;
    3423function ClientVersion(const AFileName: string): string;
     
    4029//procedure FileCopy(const FromFileName, ToFileName: string);
    4130//procedure FileCopyWithDate(const FromFileName, ToFileName: string);
    42 function FileVersionValue(const AFileName, AValueName: string): string;
    4331function FullToFilePart(const AFileName: string): string;
    4432function FullToPathPart(const AFileName: string): string;
     
    6048procedure RunProgram(const AppName: string);
    6149function UpdateSelf: Boolean;
     50function BorlandDLLVersionOK: boolean;
    6251
    6352implementation
     
    11099  // check for different file date in the gold directory
    111100  GoldName := RegReadStr(CPRS_REG_GOLD);
    112   if Length(GoldName) = 0 then Exit;
     101  if (Length(GoldName) = 0)  then exit;
     102  if not DirectoryExists(GoldName) then
     103  begin
     104    if Pos('"', Goldname) > 0 then
     105    begin
     106      Goldname := Copy(GoldName, 2, MaxInt);
     107      if Pos('"', Goldname) > 0 then
     108        Goldname := Copy(GoldName, 1, Length(GoldName) - 1);
     109    end;
     110  end;
     111  if (not DirectoryExists(GoldName)) then Exit;
    113112  GoldName := GoldName + FullToFilePart(AppName);
    114113  if FileExists(GoldName) then
     
    139138                                                     IntToStr(HIWORD(dwFileVersionLS)) + '.' +
    140139                                                     IntToStr(LOWORD(dwFileVersionLS));
    141   end;
    142 end;
    143 
    144 function FileVersionValue(const AFileName, AValueName: string): string;
    145 type
    146   PValBuf = ^TValBuf;
    147   TValBuf = array[0..255] of Char;
    148 var
    149   VerSize, ValSize, AHandle: DWORD;
    150   VerBuf: Pointer;
    151   ValBuf: PValBuf;
    152 begin
    153   Result := '';
    154   VerSize:=GetFileVersionInfoSize(PChar(AFileName), AHandle);
    155   if VerSize > 0 then
    156   begin
    157     GetMem(VerBuf, VerSize);
    158     try
    159       GetFileVersionInfo(PChar(AFileName), AHandle, VerSize, VerBuf);
    160       VerQueryValue(VerBuf, PChar(AValueName), Pointer(ValBuf), ValSize);
    161       SetString(Result, ValBuf^, ValSize);
    162     finally
    163       FreeMem(VerBuf);
    164     end;
    165140  end;
    166141end;
     
    551526*)
    552527
     528function BorlandDLLVersionOK: boolean;
     529const
     530  DLL_CURRENT_VERSION = 10;
     531  TC_DLL_ERR   = 'ERROR - BORLNDMM.DLL';
     532  TX_NO_RUN    = 'This version of CPRS is unable to run because' + CRLF;
     533  TX_NO_DLL    = 'no copy of BORLNDMM.DLL can be found' + CRLF +
     534                 'in your workstation''s current PATH.';
     535  TX_OLD_DLL1  = 'the copy of BORLNDMM.DLL located at:' + CRLF + CRLF;
     536  TX_OLD_DLL2  = CRLF + CRLF + 'is out of date  (Version ';
     537  TX_CALL_IRM  = CRLF + CRLF +'Please contact IRM for assistance.';
     538var
     539  DLLHandle: HMODULE;
     540  DLLNamePath: array[0..261] of Char;
     541  DLLVersion: string;
     542begin
     543  Result := TRUE;
     544  DLLHandle := GetModuleHandle('BORLNDMM.DLL');
     545  if DLLHandle <=0 then
     546  begin
     547    InfoBox(TX_NO_RUN + TX_NO_DLL + TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
     548    Result := FALSE;
     549    Exit;
     550  end;
     551  Windows.GetModuleFileName(DLLHandle, DLLNamePath, 261);
     552  DLLVersion := ClientVersion(DLLNamePath);
     553  if StrToIntDef(Piece(DLLVersion, '.', 1), 0) < DLL_CURRENT_VERSION then
     554  begin
     555    InfoBox(TX_NO_RUN + TX_OLD_DLL1 + '   ' + DLLNamePath + TX_OLD_DLL2 + DLLVersion + ')' +
     556            TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
     557    Result := false;
     558  end;
     559end;
     560
    553561end.
Note: See TracChangeset for help on using the changeset viewer.