Changeset 1679 for cprs/trunk/CPRS-Chart/Consults/fODConsult.pas

Timestamp:

May 7, 2015, 12:34:29 PM (9 years ago)

Author:

healthsevak

Message:

Updating the working copy to CPRS version 28

File:

• cprs/trunk/CPRS-Chart/Consults/fODConsult.pas (modified) (34 diffs)

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

@@ -9 +9 @@
   fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
   Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
-  VA508AccessibilityManager ;
+  ORDtTm, VA508AccessibilityManager ;
 
 type
   TfrmODCslt = class(TfrmODBase)
+    pnlMain: TPanel;
+    lblService: TLabel;
+    lblProvDiag: TLabel;
+    lblUrgency: TLabel;
+    lblPlace: TLabel;
+    lblAttn: TLabel;
+    lblLatest: TStaticText;
+    lblEarliest: TStaticText;
+    pnlReason: TPanel;
+    lblReason: TLabel;
+    memReason: TRichEdit;
     cboService: TORComboBox;
     cboUrgency: TORComboBox;
@@ -18 +29 @@
     txtProvDiag: TCaptionEdit;
     txtAttn: TORComboBox;
-    lblService: TLabel;
-    lblUrgency: TLabel;
-    lblPlace: TLabel;
-    lblAttn: TLabel;
-    lblProvDiag: TLabel;
     treService: TORTreeView;
     cboCategory: TORComboBox;
     pnlServiceTreeButton: TKeyClickPanel;
     btnServiceTree: TSpeedButton;
+    gbInptOpt: TGroupBox;
+    radInpatient: TRadioButton;
+    radOutpatient: TRadioButton;
+    btnDiagnosis: TButton;
+    cmdLexSearch: TButton;
+    calEarliest: TORDateBox;
+    calLatest: TORDateBox;
     mnuPopProvDx: TPopupMenu;
     mnuPopProvDxDelete: TMenuItem;
-    cmdLexSearch: TButton;
     popReason: TPopupMenu;
     popReasonCut: TMenuItem;
@@ -36 +48 @@
     popReasonPaste2: TMenuItem;
     popReasonReformat: TMenuItem;
-    gbInptOpt: TGroupBox;
-    radInpatient: TRadioButton;
-    radOutpatient: TRadioButton;
-    pnlReason: TPanel;
-    lblReason: TLabel;
-    memReason: TRichEdit;
-    btnDiagnosis: TButton;
+    pnlCombatVet: TPanel;
+    txtCombatVet: TVA508StaticText;
+    servicelbl508: TVA508StaticText;
     procedure FormCreate(Sender: TObject);
     procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
@@ -96 +104 @@
     FEditCtrl: TCustomEdit;
     FNavigatingTab: boolean;
+    LLS_LINE_INDEX: integer;
     procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
     procedure ReadServerVariables;
@@ -107 +116 @@
     procedure SetUpCopyConsultDiagnoses(pOrderID:string);
     procedure AdjustMemReasonSize;
+    function NotinIndex(AList: TStringList; i: integer): boolean;
+    function GetItemIndex(Service: String; Index: integer): integer;
+    procedure SetUpCombatVet;
+    procedure SetUpEarliestDate; //wat v28
+    procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
   protected
     procedure InitDialog; override;
@@ -123 +137 @@
 
 
+function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
+
 implementation
 
@@ -129 +145 @@
 uses
     rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
-    ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility;
+    ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility,
+    VA508AccessibilityRouter;
 
 var
@@ -137 +154 @@
   BADxUpdated: boolean;
   quickCode: string;
-
+  AreGlobalsFree: boolean;
 
 
@@ -156 +173 @@
   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.';
 
   TX_SVC_HRCHY = 'services/specialties hierarchy';
   TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
   TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
+
+
+{************** Static Unit Methods ***************}
+
+function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
+begin
+  Result := true;
+  if (dialog is TfrmODCslt) then
+    Result := AreGlobalsFree;
+end;
+
+procedure InitializeGlobalLists;
+begin
+  Defaults := TStringList.Create;
+  SvcList := TStringList.Create;
+  QuickList := TStringList.Create;
+  AreGlobalsFree := false;
+end;
+
+function FreeGlobalLists : Boolean;
+begin
+  Result := false;
+  if AreGlobalsFree then
+    Exit;
+  Defaults.Free;
+  SvcList.Free;
+  QuickList.Free;
+  AreGlobalsFree := true;
+  Result := true;
+end;
+
+{*************** TfrmODCslt Methods ***********}
 
 procedure TfrmODCslt.FormCreate(Sender: TObject);
@@ -176 +227 @@
      cmdLexSearch.Visible := True;
   end;
-  Defaults  := TStringList.Create ;
-  SvcList   := TStringList.Create ;
-  QuickList := TStringList.Create ;
+  InitializeGlobalLists;
   AllowQuickOrder := True;
   LastNode := 0;
@@ -190 +239 @@
   FastAssign(ODForConsults, Defaults);  // ODForConsults returns TStrings with defaults
   CtrlInits.LoadDefaults(Defaults);
+  calEarliest.Text := 'TODAY';
+  //calLatest.Text := 'TODAY+30';
   txtAttn.InitLongList('') ;
   PreserveControl(txtAttn);
+  PreserveControl(calEarliest);
+  //PreserveControl(calLatest);
+    if (patient.CombatVet.IsEligible = True) then
+   begin
+     SetUpCombatVet;
+   end
+   else
+    begin
+      txtCombatVet.Enabled := False;
+      pnlCombatVet.SendToBack;
+    end;
   InitDialog;
   //Calling virtual SetFontSize in constructor is a bad idea!
@@ -197 +259 @@
   FcboServiceKeyDownStopClick := false;
   consultQuickOrder := false;
-
-
 end;
 
@@ -233 +293 @@
   memReason.Clear;
   cboService.Enabled := True;
+  setup508Label(servicelbl508, cboService);
   cboService.Font.Color := clWindowText;
-  cboService.Height := 25 + (7 * cboService.ItemHeight);
+  cboService.Height := 25 + (11 * cboService.ItemHeight);
   btnServiceTree.Enabled := True;
   pnlServiceTreeButton.Enabled := True;
   SetProvDiagPromptingMode;
-  ActiveControl := cboService; // set after call to SetProvDiagPromptingMode
+  ActiveControl := cboService;
+
   Changing := False;
   StatusText('');
@@ -258 +320 @@
 begin
   inherited;
+  LLS_LINE_INDEX := -1;
   ReadServerVariables;
   AList := TStringList.Create;
@@ -281 +344 @@
           Exit;
         end;
+
       cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
       cboService.SelectByID(SvcIEN);
@@ -289 +353 @@
       else
         radOutpatient.Checked := True ;
-      SetControl(cboUrgency,    'URGENCY',     1);
+      SetUpEarliestDate;   //wat v28
+      SetControl(cboUrgency,    'URGENCY',   1);
       SetControl(cboPlace,      'PLACE',     1);
       SetControl(txtAttn,       'PROVIDER',  1);
+      SetControl(calEarliest,   'EARLIEST',  1);
+      //SetControl(calLatest,     'LATEST',    1);
       cboService.Enabled := False;
+      setup508Label(servicelbl508, cboService);
       cboService.Font.Color := clGrayText;
       btnServiceTree.Enabled := False;
@@ -308 +376 @@
       begin
         AbortOrder := True;
+                SetTemplateDialogCanceled(FALSE);
         Close;
         Exit;
@@ -316 +385 @@
       begin
         AbortOrder := True;
+                SetTemplateDialogCanceled(FALSE);
         Close;
         Exit;
@@ -343 +413 @@
           FastAssign(QuickList, cboService.Items);
           Items.Add(LLS_LINE);
+          LLS_LINE_INDEX := Items.IndexOf(Trim(Piece(LLS_LINE, U, 2))); {TP - HDS00015782: Used to determine if QO}
           Items.Add(LLS_SPACE);
         end;
       Changing := True;
       for i := 0 to AList.Count - 1 do
-        if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and   {RV}
+        //if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and   {RV}
+        if (NotinIndex(AList,i)) and   {TP - HDS00015782: Check if service is already in index (not including QO)}
         //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and
            (Piece(AList.Strings[i], U, 5) <> '1') then
@@ -410 +482 @@
         SetError(TX_SELECT_DIAG);
     end;
+  if (lblEarliest.Enabled) and (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;
 
@@ -548 +623 @@
         FLastServiceID := ItemID;
         cboService.Enabled := False;
+        setup508Label(servicelbl508, cboService);
         cboService.Font.Color := clGrayText;
         btnServiceTree.Enabled := False;
@@ -588 +664 @@
       SetControl(cboPlace,      'PLACE',     1);
       SetControl(txtAttn,       'PROVIDER',  1);
+      SetControl(calEarliest,   'EARLIEST',  1);
+      //SetControl(calLatest,     'LATEST',    1);
       SetTemplateDialogCanceled(FALSE);
       SetControl(memReason,     'COMMENT',   1);
@@ -593 +671 @@
       begin
         AbortOrder := TRUE;
+                SetTemplateDialogCanceled(FALSE);
         Close;
         Exit;
@@ -616 +695 @@
     end;
   SetProvDiagPromptingMode;
+  SetUpEarliestDate; //wat v28
   tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
   pnlMessage.TabOrder := treService.TabOrder + 1;
@@ -646 +726 @@
       else Responses.Update('ORDERABLE', 1, '', '');
     end;
-  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);
-  with cboUrgency    do if ItemIEN      > 0 then Responses.Update('URGENCY',   1, ItemID, Text);
-  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 memReason     do  Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
+  with cboCategory   do  Responses.Update('CLASS',     1, ItemID, Text);
+  with cboUrgency    do  Responses.Update('URGENCY',   1, ItemID, Text);
+  with cboPlace      do  Responses.Update('PLACE',     1, ItemID, Text);
+  with txtAttn       do  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);
   //with txtProvDiag   do if Length(Text) > 0 then Responses.Update('MISC',      1, Text,   Text);
   if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
@@ -758 +840 @@
   with cboService do
     begin
+      setup508Label(servicelbl508, cboService);
       if (ItemIndex < 0) or (ItemID = '') then
         begin
@@ -779 +862 @@
           Changing := True;
           Responses.QuickOrder := ExtractInteger(ItemID);
-          consultQuickOrder := True;   
+          consultQuickOrder := True;
           tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
           ItemIndex := Items.IndexOf(Trim(tmpSvc));
+          If ItemIndex < LLS_LINE_INDEX then       {TP - HDS00015782: Check if index is of a QO}
+            ItemIndex := GetItemIndex(tmpSvc,ItemIndex);
 (*          tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
           for i := 0 to Items.Count-1 do
@@ -793 +878 @@
           FLastServiceID := ItemID;
           Enabled := False;
+          setup508Label(servicelbl508, cboService);
           Font.Color := clGrayText;
           btnServiceTree.Enabled := False;
@@ -811 +897 @@
               SetControl(cboPlace,      'PLACE',     1);
               SetControl(txtAttn,       'PROVIDER',  1);
+              SetControl(calEarliest,   'EARLIEST',  1);
+              //SetControl(calLatest,     'LATEST',    1);
               SetTemplateDialogCanceled(FALSE);
               SetControl(memReason,     'COMMENT',   1);
@@ -816 +904 @@
               begin
                 AbortOrder := TRUE;
+                                SetTemplateDialogCanceled(FALSE);
                 Close;
                 Exit;
@@ -861 +950 @@
   //OrderMessage(ConsultMessage(cboService.ItemIEN));
   ControlChange(Self) ;
+  SetUpEarliestDate;    //wat v28
+  setup508Label(servicelbl508, cboService);
 end;
 
 procedure TfrmODCslt.FormDestroy(Sender: TObject);
 begin
-  Defaults.Free;
-  SvcList.Free ;
-  QuickList.Free;
+  if not FreeGlobalLists then
+    Exit;
   inherited;
 end;
@@ -986 +1076 @@
  ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
  txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
-
  ProvDx.CodeInactive := False;
 end;
@@ -1057 +1146 @@
 
 
+procedure TfrmODCslt.setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
+begin
+  if ScreenReaderSystemActive and not ctrl.Enabled then begin
+    lbl.Enabled := True;
+    lbl.Visible := True;
+    lbl.Caption := lblService.Caption + ', ' + ctrl.Text;
+    lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
+  end else
+    lbl.Visible := false;
+end;
+
 procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject);
 begin
@@ -1493 +1593 @@
   pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
   pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
+  if patient.CombatVet.IsEligible then pnlReason.Height := pnlReason.Height - PIXEL_SPACE*20;
+end;
+
+function TfrmODCslt.NotinIndex(AList: TStringList; i: integer): Boolean;   {TP - HDS00015782:}
+{This function determines if a Consult Service will be added to the cboService
+component.  If name does not exist or if name does not exist below the Quick
+Order listing, then it is added.}
+var
+  x: Integer;
+  y: String;
+begin
+  Result := False;
+  x := cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2)));
+  if (x = -1) then
+    Result := True;
+  if (x <> -1) and (x < LLS_LINE_INDEX) then
+  begin
+    y := cboService.Items[x];
+    cboService.Items.Delete(x);
+    if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) then
+      Result := True;
+    cboService.Items.Insert(x,y);
+  end;
+
+end;
+
+function TfrmODCslt.GetItemIndex(Service: String; Index: integer): integer;     {TP - HDS00015782:}
+{This function returns ItemIndexOf value for Service Consult when a Quick Order
+has the exact same name}
+var
+  y: String;
+
+begin
+  y := cboService.Items[Index];
+  cboService.Items.Delete(Index);
+  Result := (cboService.Items.IndexOf(Trim(Service)) + 1);
+  cboService.Items.Insert(Index,y);
+end;
+
+procedure TfrmODCslt.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];
+     treService.Anchors := [akLeft,akTop,akRight];
+     self.Height := self.Height + pnlCombatVet.Height;
+     treService.Anchors := [akLeft,akTop,akRight,akBottom];
+     pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
+end;
+
+procedure TfrmODCslt.SetUpEarliestDate;  //wat v28
+begin
+  if IsProstheticsService(cboService.ItemIEN) = '1' then
+    begin
+      lblEarliest.Enabled := False;
+      calEarliest.Enabled := False;
+      calEarliest.Text := '';
+      Responses.Update('EARLIEST',1,'','');
+    end
+  else
+    begin
+      lblEarliest.Enabled := True;
+      calEarliest.Enabled := True;
+      calEarliest.Text := 'TODAY';
+    end;
 end;