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