Index: cprs/trunk/CPRS-Chart/Consults/fODProc.pas
===================================================================
--- cprs/trunk/CPRS-Chart/Consults/fODProc.pas	(revision 829)
+++ cprs/trunk/CPRS-Chart/Consults/fODProc.pas	(revision 1679)
@@ -6,23 +6,36 @@
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
-  Menus, VA508AccessibilityManager;
+  Menus, ORDtTm, VA508AccessibilityManager;
 
 type
   TfrmODProc = class(TfrmODBase)
-    cboUrgency: TORComboBox;
-    cboPlace: TORComboBox;
-    txtAttn: TORComboBox;
+    pnlMain: TPanel;
+    pnlCombatVet: TPanel;
     lblProc: TLabel;
-    cboProc: TORComboBox;
+    lblService: TOROffsetLabel;
+    lblReason: TLabel;
     lblUrgency: TStaticText;
     lblPlace: TStaticText;
     lblAttn: TStaticText;
     lblProvDiag: TStaticText;
+    pnlReason: TPanel;
+    memReason: TCaptionRichEdit;
+    cboUrgency: TORComboBox;
+    cboPlace: TORComboBox;
+    txtAttn: TORComboBox;
+    cboProc: TORComboBox;
     cboCategory: TORComboBox;
     cboService: TORComboBox;
-    lblService: TOROffsetLabel;
+    cmdLexSearch: TButton;
+    gbInptOpt: TGroupBox;
+    radInpatient: TRadioButton;
+    radOutpatient: TRadioButton;
+    txtProvDiag: TCaptionEdit;
+    lblEarliest: TStaticText;
+    calEarliest: TORDateBox;
+    lblLatest: TStaticText;
+    calLatest: TORDateBox;
     mnuPopProvDx: TPopupMenu;
     mnuPopProvDxDelete: TMenuItem;
-    cmdLexSearch: TButton;
     popReason: TPopupMenu;
     popReasonCut: TMenuItem;
@@ -31,11 +44,6 @@
     popReasonPaste2: TMenuItem;
     popReasonReformat: TMenuItem;
-    pnlReason: TPanel;
-    memReason: TCaptionRichEdit;
-    gbInptOpt: TGroupBox;
-    radInpatient: TRadioButton;
-    radOutpatient: TRadioButton;
-    txtProvDiag: TCaptionEdit;
-    lblReason: TLabel;
+    txtCombatVet: TVA508StaticText;
+    servicelbl508: TVA508StaticText;
     procedure FormCreate(Sender: TObject);
     procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
@@ -64,4 +72,5 @@
     procedure FormResize(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
+    procedure FormShow(Sender: TObject);
   private
     FLastProcID: string;
@@ -74,4 +83,7 @@
     function ShowPrerequisites: boolean;
     procedure DoSetFontSize( FontSize: integer);
+    procedure SetUpCombatVet;
+    procedure updateService;
+    procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
   protected
     procedure InitDialog; override;
@@ -83,4 +95,7 @@
   end;
 
+
+function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
+
 implementation
 
@@ -89,10 +104,12 @@
 uses
     rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
-    clipbrd, fPreReq, uTemplates, fFrame, uODBase,
-  uVA508CPRSCompatibility;
+    clipbrd, fPreReq, uTemplates, fFrame, uODBase, VA508AccessibilityRouter,
+    uVA508CPRSCompatibility;
+
 
 var
   ProvDx:  TProvisionalDiagnosis;
   GMRCREAF: string;
+  OkToFreeProcDialog: boolean;
 
 const
@@ -108,4 +125,17 @@
   TX_INACTIVE_CODE_REQD     = 'Another code must be selected before the order can be saved.';
   TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
+  TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
+  TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
+
+{ ********* Static Unit Methods ************ }
+
+function CanFreeProcDialog(dialog : TfrmODBase) : boolean;
+begin
+  Result := true;
+  if (dialog is TfrmODProc) then
+    Result := OkToFreeProcDialog;
+end;
+
+{ ********************* TfrmODProc Methods **************** }
 
 procedure TfrmODProc.FormCreate(Sender: TObject);
@@ -114,4 +144,5 @@
   AutoSizeDisabled := True;
   inherited;
+  OkToFreeProcDialog := False;
   DoSetFontSize(MainFontSize);
   AllowQuickOrder := True;
@@ -126,6 +157,19 @@
   cboProc.InitLongList('') ;
   txtAttn.InitLongList('') ;
+  calEarliest.Text := 'TODAY';
+  //calLatest.Text := 'TODAY+30';
+  PreserveControl(calEarliest);
+  //PreserveControl(calLatest);
   PreserveControl(txtAttn);
   PreserveControl(cboProc);
+  if (patient.CombatVet.IsEligible = True) then
+   begin
+     SetUpCombatVet;
+   end
+   else
+    begin
+      txtCombatVet.Enabled := False;
+      pnlCombatVet.SendToBack;
+    end;
   InitDialog;
 end;
@@ -198,4 +242,6 @@
     SetControl(cboPlace,      'PLACE',     1);
     SetControl(txtAttn,       'PROVIDER',  1);
+    SetControl(calEarliest,   'EARLIEST',  1);
+    //SetControl(calLatest,     'LATEST',    1);
     cboProc.Enabled := False;
     cboProc.Font.Color := clGrayText;
@@ -229,5 +275,7 @@
     if WasTemplateDialogCanceled then
     begin
-      AbortOrder := True;
+      AbortOrder := True;   
+      OkToFreeProcDialog := true;
+      SetTemplateDialogCanceled(FALSE);
       Close;
       Exit;
@@ -238,4 +286,6 @@
     begin
       AbortOrder := True;
+      OkToFreeProcDialog := true;
+      SetTemplateDialogCanceled(FALSE);
       Close;
       Exit;
@@ -258,6 +308,6 @@
   inherited;
   if cboProc.ItemIEN = 0                  then SetError(TX_NO_PROC);
-  if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
-  if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
+  if cboUrgency.ItemIEN = 0               then SetError(TX_NO_URGENCY);
+  if cboPlace.ItemID = ''                 then SetError(TX_NO_PLACE);
   if (not ContainsVisibleChar(memReason.Text))
                                           then SetError(TX_NO_REASON);
@@ -265,9 +315,12 @@
   if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
     begin
-      if ProvDx.PromptMode = 'F' then
+      if ProvDx.PromptMode = 'F'          then
         SetError(TX_NO_DIAG)
       else
         SetError(TX_SELECT_DIAG);
     end;
+  if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
+  //if calLatest.FMDateTime < FMToday       then SetError(TX_PAST_DATE);
+  //if calLatest.FMDateTime < calEarliest.FMDateTime then SetError(TX_BAD_DATES);
 end;
 
@@ -337,8 +390,5 @@
       else Responses.Update('ORDERABLE', 1, '', '');
     end;
-(*  with cboProc       do if ItemIEN      > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
-                                            else Responses.Update('ORDERABLE', 1, '', '');*)
-  with cboService    do if ItemIEN      > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
-                                            else Responses.Update('SERVICE', 1, '', '');
+  updateService();
   with memReason     do if GetTextLen   > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
   with cboCategory   do if ItemID     <> '' then Responses.Update('CLASS',     1, ItemID, Text);
@@ -346,4 +396,6 @@
   with cboPlace      do if ItemID     <> '' then Responses.Update('PLACE',     1, ItemID, Text);
   with txtAttn       do if ItemIEN      > 0 then Responses.Update('PROVIDER',  1, ItemID, Text);
+  with calEarliest   do if Length(Text) > 0 then Responses.Update('EARLIEST',  1, Text, Text);
+  //with calLatest     do if Length(Text) > 0 then Responses.Update('LATEST',    1, Text,   Text);
   if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
    else Responses.Update('MISC',      1, '',   '');
@@ -415,4 +467,6 @@
       SetControl(cboPlace,      'PLACE',     1);
       SetControl(txtAttn,       'PROVIDER',  1);
+      SetControl(calEarliest,   'EARLIEST',  1);
+      //SetControl(calLatest,     'LATEST',    1);
       SetTemplateDialogCanceled(FALSE);
       SetControl(memReason,     'COMMENT',   1);
@@ -588,4 +642,15 @@
 end;
 
+procedure TfrmODProc.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
+begin
+  if ScreenReaderSystemActive and not ctrl.Enabled then begin
+    lbl.Enabled := True;
+    lbl.Visible := True;
+    lbl.Caption := lblService.Caption + ', ' + Text;
+    lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
+  end else
+    lbl.Visible := false;
+end;
+
 procedure TfrmODProc.cboServiceChange(Sender: TObject);
 begin
@@ -813,4 +878,18 @@
 end;
 
+procedure TfrmODProc.updateService;
+begin
+  with cboService do
+    if ItemIEN > 0 then
+    begin
+      setup508Label(Text, servicelbl508, cboService);
+      Responses.Update('SERVICE', 1, ItemID, Text);
+    end
+    else begin
+      Responses.Update('SERVICE', 1, '', '');
+      setup508Label('No service selected.', servicelbl508, cboService);
+    end;
+end;
+
 procedure TfrmODProc.DoSetFontSize(FontSize: integer);
 begin
@@ -840,6 +919,19 @@
 begin
   inherited;
-  memOrder.Top := PnlReason.Top + PnlReason.Height + 5;
-
+  if Patient.CombatVet.IsEligible then
+  begin
+    memOrder.Top := pnlCombatVet.Height + PnlReason.Top + PnlReason.Height + 7;
+   end
+  else
+   begin
+       memOrder.Top := PnlReason.Top + PnlReason.Height + 7;
+   end;
+
+end;
+
+procedure TfrmODProc.FormShow(Sender: TObject);
+begin
+  inherited;
+  setup508Label('No service selected.', servicelbl508, cboService);
 end;
 
@@ -850,4 +942,15 @@
 end;
 
+procedure TfrmODProc.SetUpCombatVet;
+   begin
+     pnlCombatVet.BringToFront;
+     txtCombatVet.Enabled := True;
+     txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
+     pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
+     pnlMain.Anchors := [akLeft,akTop,akRight];
+     self.Height := self.Height + pnlCombatVet.Height;
+     pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
+  end;
+
 end.
 
