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

Upgrade to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

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

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