Changeset 829 for cprs/trunk/CPRS-Chart/Orders/fODMedNVA.pas

Timestamp:

Jul 7, 2010, 4:31:10 PM (14 years ago)

Author:

Kevin Toppenberg

Message:

Upgrade to version 27

File:

• cprs/trunk/CPRS-Chart/Orders/fODMedNVA.pas (modified) (27 diffs)

cprs/trunk/CPRS-Chart/Orders/fODMedNVA.pas

@@ -6 +6 @@
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
-  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn;
+  Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn, contnrs,
+  VA508AccessibilityManager;
 
 const
@@ -94 +95 @@
   private
     {selection}
-    FAllItems:   TStringList;
-    FAllFirst:   Integer;
-    FAllLast:    Integer;
-    FAllList:    Integer;
+    FNVAMedCache:   TObjectList;
+    FCacheIEN:   integer;
     FQuickList:  Integer;
     FQuickItems: TStringList;
@@ -135 +134 @@
     FQOInitial: boolean;
     FRemoveText : Boolean;
+    FMedName: string;
     {selection}
     procedure ChangeDelayed;
@@ -140 +140 @@
     function FindQuickOrder(const x: string): Integer;
     function isUniqueQuickOrder(iText: string): Boolean;
+    function GetCacheChunkIndex(idx: integer): integer;
     procedure ScrollToVisible(AListView: TListView);
     procedure StartKeyTimer;
@@ -180 +181 @@
     procedure SetupDialog(OrderAction: Integer; const ID: string); override;
     procedure CheckDecimal(var AStr: string);
+    property MedName: string read FMedName write FMedName;
   end;
 
@@ -194 +196 @@
 
 uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
-  uAccessibleStringGrid, fFrame, ORNet;
+  fFrame, ORNet, VAUtils;
 
 const
@@ -259 +261 @@
   TIMER_FROM_DAYS = 1;
   TIMER_FROM_QTY  = 2;
+
+  MED_CACHE_CHUNK_SIZE = 100;  
   {text constants}
   TX_ADMIN      = 'Requested Start: ';
@@ -346 +350 @@
   FRowHeight := MainFontHeight + 1;
   x := 'NV RX';  // CLA 6/3/03
-  ListForOrderable(FAllList, ListCount, x);
+  ListForOrderable(FCacheIEN, ListCount, x);
   lstAll.Items.Count := ListCount;
-  FAllItems := TStringList.Create;
-  FAllFirst := -1;
-  FAllLast  := -1;
+  FNVAMedCache := TObjectList.Create;
   FQuickItems := TStringList.Create;
   ListForQuickOrders(FQuickList, ListCount, x);
@@ -370 +372 @@
     then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
   pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
+  cmdAccept.Left := cmdQuit.Left;
+  cmdaccept.Anchors := cmdQuit.anchors;
   FNoZero := False;
   FShrinked := False;
@@ -382 +386 @@
   {selection}
   FQuickItems.Free;
-  FAllItems.Free;
+  FNVAMedCache.Free;
   {edit}
   FGuideline.Free;
@@ -553 +557 @@
    end;
   end;
+  if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
 end;
 
@@ -659 +664 @@
   UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
   QuickIndex := FindQuickOrder(UserText);
-  AllIndex := IndexOfOrderable(FAllList, UserText);  // but always synch the full list
+  AllIndex := IndexOfOrderable(FCacheIEN, UserText);  // but always synch the full list
   if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit;  // if typing during lookup
   if AllIndex > -1 then
@@ -772 +777 @@
 { lstAll Methods (lstAll is TListView) }
 
+// Cache is a list of 100 string lists, starting at idx 0
 procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
-const
-  MAX_CACHE_ITEMS = 1000;
-begin
-  // if range is within cache range we don't need to update anything
-  if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
-  // if range is outside of cache or a superset of cache, start over
-  if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
-     ((First < FAllFirst) and (Last > FAllLast)) or
-     (FAllItems.Count > MAX_CACHE_ITEMS) then
-  begin
-    FAllItems.Clear;
-    FAllFirst := -1;
-    FAllLast  := -1;
-  end;
-  // if getting items immediately before cache range
-  if (First < FAllFirst) and (Last  >= FAllFirst) then Last  := Pred(FAllFirst);
-  // if getting items immediately after cache range
-  if (Last  > FAllLast)  and (First <= FAllLast)  then First := Succ(FAllLast);
-  // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
-  SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
-  // reset FAllFirst & FAllLast indexes to reflect current FAllItems
-  if FAllFirst < 0     then FAllFirst := First;
-  if FAllLast  < 0     then FAllLast  := Last;
-  if First < FAllFirst then FAllFirst := First;
-  if Last > FAllLast   then FAllLast := Last;
+var
+  firstChunk, lastchunk, i: integer;
+  list: TStringList;
+  firstMed, LastMed: integer;
+
+begin
+  firstChunk := GetCacheChunkIndex(First);
+  lastChunk := GetCacheChunkIndex(Last);
+  for i := firstChunk to lastChunk do
+  begin
+    if (FNVAMedCache.Count <= i) or (not assigned(FNVAMedCache[i])) then
+    begin
+      while FNVAMedCache.Count <= i do
+        FNVAMedCache.add(nil);
+      list := TStringList.Create;
+      FNVAMedCache[i] := list;
+      firstMed := i * MED_CACHE_CHUNK_SIZE;
+      LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
+      if LastMed >= lstAll.Items.Count then
+        LastMed := lstAll.Items.Count - 1;
+      SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
+    end;
+  end;
 end;
 
@@ -803 +807 @@
 var
   x: string;
-begin
-  if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
-    then LoadNonVAMedCache(Item.Index, Item.Index);
-  x := FAllItems[Item.Index - FAllFirst];
+  chunk: integer;
+  list: TStringList;
+begin
+  LoadNonVAMedCache(Item.Index, Item.Index);
+  chunk := GetCacheChunkIndex(Item.Index);
+  list := TStringList(FNVAMedCache[chunk]);
+  x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
   Item.Caption := Piece(x, U, 2);
   Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
@@ -822 +829 @@
 var
   MedIEN: Integer;
-  MedName: string;
+  //MedName: string;
   QOQuantityStr: string;
-  ErrMsg: string;
+  ErrMsg, temp: string;
 begin
   inherited;
   QOQuantityStr := '';
-  btnSelect.SetFocus;                             // let the exit events finish
+  btnSelect.SetFocus;
+  self.MedName := '';                             // let the exit events finish
   if pnlMeds.Visible then                         // display the medication fields
   begin
@@ -845 +853 @@
         //btnSelect.Visible := False;
         btnSelect.Enabled := False;
-        ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
@@ -862 +870 @@
     begin
       MedIEN := Integer(lstAll.Selected.Data);
-      MedName := lstAll.Selected.Caption;
+      self.MedName := lstAll.Selected.Caption;
       txtMed.Tag := MedIEN;
       ErrMsg := '';
@@ -869 +877 @@
       begin
         btnSelect.Enabled := False;
-        ShowMessage(ErrMsg);
+        ShowMsg(ErrMsg);
         Exit;
       end;
@@ -882 +890 @@
       begin
         txtMed.Tag := MedIEN;
-        txtMed.Text := MedName;
+        temp := self.MedName;
+        self.MedName := txtMed.Text;
+        txtMed.Text := Temp;
       end;
       SetOnMedSelect;
@@ -918 +928 @@
 var
   i,j: Integer;
-  x: string;
+  temp,x: string;
   QOPiUnChk: boolean;
   PKIEnviron: boolean;
@@ -933 +943 @@
     // set up lists & initial values based on orderable item
     SetControl(txtMed,       'Medication');
+    if (self.MedName <> '') then
+       begin
+         if (txtMed.Text <> self.MedName) then
+           begin
+             temp := self.MedName;
+             self.MedName := txtMed.Text;
+             txtMed.Text := temp;
+           end
+         else MedName := '';
+       end;
     SetControl(cboDosage,    'Dosage');
     SetControl(cboRoute,     'Route');
@@ -1044 +1064 @@
       else
         SetDosage(IValueFor('INSTR', 1));
-        SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
-        SetSchedule(IValueFor('SCHEDULE',  1));
+      SetControl(cboDosage, 'DOSAGE', 1); // CQ: HDS00007776
+      SetControl(cboRoute,  'ROUTE',     1);  //AGP ADDED ROUTE FOR CQ 11252
+      SetSchedule(IValueFor('SCHEDULE',  1));
       if (cboSchedule.Text = '') and FIsQuickOrder then
       begin
@@ -1613 +1634 @@
   FUpdated := FALSE;
   Responses.Clear;
-  Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text);
+  if self.MedName = '' then Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), txtMed.Text)
+  else Responses.Update('ORDERABLE',  1, IntToStr(txtMed.Tag), self.MedName);
   DoseList := TStringList.Create;
   case tabDose.TabIndex of
@@ -1729 +1751 @@
     Schedule  <TAB> (nothing)
     Duration  <TAB> Duration^Units }
+
+  // the following functions were created to get rid of a compile warning saying the
+  // return value may be undefined - too much branching logic in the case statements
+  // for the compiler to handle
+
+  function GetSchedule: string;
+  begin
+    Result := UpperCase(cboSchedule.Text);
+    if chkPRN.Checked then Result := Result + ' PRN';
+    if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
+      then Result := Copy(Result, 1, Length(Result) - 4);
+  end;
+
+  function GetScheduleEX: string;
+  begin
+    Result := '';
+    with cboSchedule do
+      if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
+    if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
+    if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
+      then Result := Copy(Result, 1, Length(Result) - 10);
+  end;
+
 begin
   Result := '';
@@ -1763 +1808 @@
                      if ItemIndex > -1  then Result := Piece(Items[ItemIndex], U, 4);
     FLD_SCHEDULE  : begin
-                      Result := UpperCase(cboSchedule.Text);
-                      if chkPRN.Checked then Result := Result + ' PRN';
-                      if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
-                        then Result := Copy(Result, 1, Length(Result) - 4);
+                      Result := GetSchedule;
                     end;
     FLD_SCHED_EX  : begin
-                      with cboSchedule do
-                        if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
-                      if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
-                      if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
-                        then Result := Copy(Result, 1, Length(Result) - 10);
+                      Result := GetScheduleEX;
                     end;
     FLD_SCHED_TYP : with cboSchedule do
@@ -2184 +2222 @@
 end;
 
+function TfrmODMedNVA.GetCacheChunkIndex(idx: integer): integer;
+begin
+  Result := idx div MED_CACHE_CHUNK_SIZE;
+end;
+
 procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
 var
@@ -2209 +2252 @@
             tmplst.Strings[i] := Piece(s,U,2);
         end;
-        Dest.Assign(tmplst);
+        FastAssign(tmplst, Dest);
     end;
  end;