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

Upgrade to version 27

Location:
cprs/trunk/CPRS-Chart/Consults
Files:
32 edited

Legend:

Unmodified
Added
Removed

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r456 r829  
    44
    55uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
    6   Buttons, ORCtrls, ORfn, ExtCtrls;
     6  Buttons, ORCtrls, ORfn, ExtCtrls, fBase508Form, VA508AccessibilityManager;
    77
    88type
    9   TfrmCsltNote = class(TForm)
     9  TfrmCsltNote = class(TfrmBase508Form)
    1010    cmdOK: TButton;
    1111    cmdCancel: TButton;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r456 r829  
    3838    ProvDxCode: string;                     {  30.1}
    3939    RequestProcessingActivity: TStringList; {  40}
     40    //EarliestDate: TFMDateTime;
     41    //LatestDate: TFMDateTime;
    4042  end ;
    4143
    … …  
    5153    Urgency: integer;
    5254    UrgencyName: string;
     55    //EarliestDate: TFMDateTime;
     56    //LatestDate: TFMDateTime;
    5357    Place: string;
    5458    PlaceName: string;
    … …  
    134138   UL_ADMIN             = 3;
    135139   UL_UPDATE_AND_ADMIN  = 4;
     140   UL_UNRESTRICTED      = 5;
    136141
    137142   {Clinical Procedure statuses}
    … …  
    297302  SrcList := TStringList.Create;
    298303  try
    299     SrcList.Assign(Source);
     304    FastAssign(Source, SrcList);
    300305    with SrcList do
    301306      begin
Note: See TracChangeset for help on using the changeset viewer.