Ignore:
Timestamp:
May 7, 2015, 12:34:29 PM (9 years ago)
Author:
healthsevak
Message:

Updating the working copy to CPRS version 28

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r829 r1679  
    66  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    77  fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
    8   Menus, VA508AccessibilityManager;
     8  Menus, ORDtTm, VA508AccessibilityManager;
    99
    1010type
    1111  TfrmODProc = class(TfrmODBase)
    12     cboUrgency: TORComboBox;
    13     cboPlace: TORComboBox;
    14     txtAttn: TORComboBox;
     12    pnlMain: TPanel;
     13    pnlCombatVet: TPanel;
    1514    lblProc: TLabel;
    16     cboProc: TORComboBox;
     15    lblService: TOROffsetLabel;
     16    lblReason: TLabel;
    1717    lblUrgency: TStaticText;
    1818    lblPlace: TStaticText;
    1919    lblAttn: TStaticText;
    2020    lblProvDiag: TStaticText;
     21    pnlReason: TPanel;
     22    memReason: TCaptionRichEdit;
     23    cboUrgency: TORComboBox;
     24    cboPlace: TORComboBox;
     25    txtAttn: TORComboBox;
     26    cboProc: TORComboBox;
    2127    cboCategory: TORComboBox;
    2228    cboService: TORComboBox;
    23     lblService: TOROffsetLabel;
     29    cmdLexSearch: TButton;
     30    gbInptOpt: TGroupBox;
     31    radInpatient: TRadioButton;
     32    radOutpatient: TRadioButton;
     33    txtProvDiag: TCaptionEdit;
     34    lblEarliest: TStaticText;
     35    calEarliest: TORDateBox;
     36    lblLatest: TStaticText;
     37    calLatest: TORDateBox;
    2438    mnuPopProvDx: TPopupMenu;
    2539    mnuPopProvDxDelete: TMenuItem;
    26     cmdLexSearch: TButton;
    2740    popReason: TPopupMenu;
    2841    popReasonCut: TMenuItem;
    … …  
    3144    popReasonPaste2: TMenuItem;
    3245    popReasonReformat: TMenuItem;
    33     pnlReason: TPanel;
    34     memReason: TCaptionRichEdit;
    35     gbInptOpt: TGroupBox;
    36     radInpatient: TRadioButton;
    37     radOutpatient: TRadioButton;
    38     txtProvDiag: TCaptionEdit;
    39     lblReason: TLabel;
     46    txtCombatVet: TVA508StaticText;
     47    servicelbl508: TVA508StaticText;
    4048    procedure FormCreate(Sender: TObject);
    4149    procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
    … …  
    6472    procedure FormResize(Sender: TObject);
    6573    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     74    procedure FormShow(Sender: TObject);
    6675  private
    6776    FLastProcID: string;
    … …  
    7483    function ShowPrerequisites: boolean;
    7584    procedure DoSetFontSize( FontSize: integer);
     85    procedure SetUpCombatVet;
     86    procedure updateService;
     87    procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
    7688  protected
    7789    procedure InitDialog; override;
    … …  
    8395  end;
    8496
     97
     98function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
     99
    85100implementation
    86101
    … …  
    89104uses
    90105    rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
    91     clipbrd, fPreReq, uTemplates, fFrame, uODBase,
    92   uVA508CPRSCompatibility;
     106    clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter,
     107    uVA508CPRSCompatibility;
     108
    93109
    94110var
    95111  ProvDx:  TProvisionalDiagnosis;
    96112  GMRCREAF: string;
     113  OkToFreeProcDialog: boolean;
    97114
    98115const
    … …  
    108125  TX_INACTIVE_CODE_REQD     = 'Another code must be selected before the order can be saved.';
    109126  TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
     127  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
     128  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
     129
     130{ ********* Static Unit Methods ************ }
     131
     132function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
     133begin
     134  Result := true;
     135  if (dialog is TfrmODProc) then
     136    Result := OkToFreeProcDialog;
     137end;
     138
     139{ ********************* TfrmODProc Methods **************** }
    110140
    111141procedure TfrmODProc.FormCreate(Sender: TObject);
    … …  
    114144  AutoSizeDisabled := True;
    115145  inherited;
     146  OkToFreeProcDialog := False;
    116147  DoSetFontSize(MainFontSize);
    117148  AllowQuickOrder := True;
    … …  
    126157  cboProc.InitLongList('') ;
    127158  txtAttn.InitLongList('') ;
     159  calEarliest.Text := 'TODAY';
     160  //calLatest.Text := 'TODAY+30';
     161  PreserveControl(calEarliest);
     162  //PreserveControl(calLatest);
    128163  PreserveControl(txtAttn);
    129164  PreserveControl(cboProc);
     165  if (patient.CombatVet.IsEligible = True) then
     166   begin
     167     SetUpCombatVet;
     168   end
     169   else
     170    begin
     171      txtCombatVet.Enabled := False;
     172      pnlCombatVet.SendToBack;
     173    end;
    130174  InitDialog;
    131175end;
    … …  
    198242    SetControl(cboPlace,      'PLACE',     1);
    199243    SetControl(txtAttn,       'PROVIDER',  1);
     244    SetControl(calEarliest,   'EARLIEST',  1);
     245    //SetControl(calLatest,     'LATEST',    1);
    200246    cboProc.Enabled := False;
    201247    cboProc.Font.Color := clGrayText;
    … …  
    229275    if WasTemplateDialogCanceled then
    230276    begin
    231       AbortOrder := True;
     277      AbortOrder := True;   
     278      OkToFreeProcDialog := true;
     279      SetTemplateDialogCanceled(FALSE);
    232280      Close;
    233281      Exit;
    … …  
    238286    begin
    239287      AbortOrder := True;
     288      OkToFreeProcDialog := true;
     289      SetTemplateDialogCanceled(FALSE);
    240290      Close;
    241291      Exit;
    … …  
    258308  inherited;
    259309  if cboProc.ItemIEN = 0                  then SetError(TX_NO_PROC);
    260   if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
    261   if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
     310  if cboUrgency.ItemIEN = 0               then SetError(TX_NO_URGENCY);
     311  if cboPlace.ItemID = ''                 then SetError(TX_NO_PLACE);
    262312  if (not ContainsVisibleChar(memReason.Text))
    263313                                          then SetError(TX_NO_REASON);
    … …  
    265315  if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
    266316    begin
    267       if ProvDx.PromptMode = 'F' then
     317      if ProvDx.PromptMode = 'F'          then
    268318        SetError(TX_NO_DIAG)
    269319      else
    270320        SetError(TX_SELECT_DIAG);
    271321    end;
     322  if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
     323  //if calLatest.FMDateTime < FMToday       then SetError(TX_PAST_DATE);
     324  //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
    272325end;
    273326
    … …  
    337390      else Responses.Update('ORDERABLE', 1, '', '');
    338391    end;
    339 (*  with cboProc       do if ItemIEN      > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
    340                                             else Responses.Update('ORDERABLE', 1, '', '');*)
    341   with cboService    do if ItemIEN      > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
    342                                             else Responses.Update('SERVICE', 1, '', '');
     392  updateService();
    343393  with memReason     do if GetTextLen   > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
    344394  with cboCategory   do if ItemID     <> '' then Responses.Update('CLASS',     1, ItemID, Text);
    … …  
    346396  with cboPlace      do if ItemID     <> '' then Responses.Update('PLACE',     1, ItemID, Text);
    347397  with txtAttn       do if ItemIEN      > 0 then Responses.Update('PROVIDER',  1, ItemID, Text);
     398  with calEarliest   do if Length(Text) > 0 then Responses.Update('EARLIEST',  1, Text, Text);
     399  //with calLatest     do if Length(Text) > 0 then Responses.Update('LATEST',    1, Text,   Text);
    348400  if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
    349401   else Responses.Update('MISC',      1, '',   '');
    … …  
    415467      SetControl(cboPlace,      'PLACE',     1);
    416468      SetControl(txtAttn,       'PROVIDER',  1);
     469      SetControl(calEarliest,   'EARLIEST',  1);
     470      //SetControl(calLatest,     'LATEST',    1);
    417471      SetTemplateDialogCanceled(FALSE);
    418472      SetControl(memReason,     'COMMENT',   1);
    … …  
    588642end;
    589643
     644procedure TfrmODProc.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
     645begin
     646  if ScreenReaderSystemActive and not ctrl.Enabled then begin
     647    lbl.Enabled := True;
     648    lbl.Visible := True;
     649    lbl.Caption := lblService.Caption + ', ' + Text;
     650    lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
     651  end else
     652    lbl.Visible := false;
     653end;
     654
    590655procedure TfrmODProc.cboServiceChange(Sender: TObject);
    591656begin
    … …  
    813878end;
    814879
     880procedure TfrmODProc.updateService;
     881begin
     882  with cboService do
     883    if ItemIEN > 0 then
     884    begin
     885      setup508Label(Text, servicelbl508, cboService);
     886      Responses.Update('SERVICE', 1, ItemID, Text);
     887    end
     888    else begin
     889      Responses.Update('SERVICE', 1, '', '');
     890      setup508Label('No service selected.', servicelbl508, cboService);
     891    end;
     892end;
     893
    815894procedure TfrmODProc.DoSetFontSize(FontSize: integer);
    816895begin
    … …  
    840919begin
    841920  inherited;
    842   memOrder.Top := PnlReason.Top + PnlReason.Height + 5;
    843 
     921  if Patient.CombatVet.IsEligible then
     922  begin
     923    memOrder.Top := pnlCombatVet.Height + PnlReason.Top + PnlReason.Height + 7;
     924   end
     925  else
     926   begin
     927       memOrder.Top := PnlReason.Top + PnlReason.Height + 7;
     928   end;
     929
     930end;
     931
     932procedure TfrmODProc.FormShow(Sender: TObject);
     933begin
     934  inherited;
     935  setup508Label('No service selected.', servicelbl508, cboService);
    844936end;
    845937
    … …  
    850942end;
    851943
     944procedure TfrmODProc.SetUpCombatVet;
     945   begin
     946     pnlCombatVet.BringToFront;
     947     txtCombatVet.Enabled := True;
     948     txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
     949     pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
     950     pnlMain.Anchors := [akLeft,akTop,akRight];
     951     self.Height := self.Height + pnlCombatVet.Height;
     952     pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
     953  end;
     954
    852955end.
    853956
Note: See TracChangeset for help on using the changeset viewer.