Changeset 460 for cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.pas

Timestamp:

Jul 6, 2008, 8:20:14 PM (16 years ago)

Author:

Kevin Toppenberg

Message:

Uploading from OR_30_258

File:

• cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.pas (modified) (20 diffs)

cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.pas

@@ -62 +62 @@
     FLogTime:   TFMDateTime;
     FViewName: string;
+    FCancel: boolean;
+    FOrderContainsObjects: boolean;
     function FindResponseByIEN(APromptIEN, AnInstance: Integer): TResponse;
     function GetOrderText: string;
@@ -83 +85 @@
     function GetIENForPrompt(const APromptID: string): Integer;
     function FindResponseByName(const APromptID: string; AnInstance: Integer): TResponse;
+    function PromptExists(const APromptID: string):boolean;
     function InstanceCount(const APromptID: string): Integer;
     function IValueFor(const APromptID: string; AnInstance: Integer): string;
@@ -96 +99 @@
       const AnIValue, AnEValue: string);
     property Dialog: string            read FDialog         write SetDialog;
-    property DisplayGroup: Integer     read FDisplayGroup;
+    property DisplayGroup: Integer     read FDisplayGroup   write FDisplayGroup;
     property CopyOrder:    string      read FCopyOrder      write SetCopyOrder;
     property EditOrder:    string      read FEditOrder;  //  write SetEditOrder;
@@ -110 +113 @@
     property VarTrailing:  string      read FVarTrailing    write FVarTrailing;
     property TheList:      TList       read FResponseList   write FResponseList;
+    property Cancel:       boolean     read FCancel         write FCancel;
+    property OrderContainsObjects: boolean read FOrderContainsObjects write FOrderContainsObjects;
   end;
 
@@ -241 +246 @@
 uses fOCAccept, uODBase, rCore, rMisc, fODMessage,
   fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders,
-  fFrame, uTemplateFields;
+  fFrame, uTemplateFields, fClinicWardMeds;
 
 const
@@ -583 +588 @@
 procedure TResponses.SetCopyOrder(const AnID: string);
 { sets responses to the values for an order that is created by copying }
+var
+  HasObjects: boolean;
 begin
   if AnID = '' then
@@ -590 +597 @@
   end;
   Clear;
-  LoadResponses(FResponseList, AnID);                      // Example AnID=C123456;1-3604
+  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=C123456;1-3604
   FCopyOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
+  FOrderContainsObjects := HasObjects;
 end;
 
 procedure TResponses.SetEditOrder(const AnID: string);
 { sets responses to the values for an order that is about to be edited }
+var
+  HasObjects: boolean;
 begin
   Clear;
-  LoadResponses(FResponseList, AnID);                      // Example AnID=X123456;1
+  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=X123456;1
   FEditOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
+  FOrderContainsObjects := HasObjects;
 end;
 
 procedure TResponses.SetQuickOrder(AnIEN: Integer);
 { sets responses to a quick order value - this is used by the QuickOrder property}
+var
+  HasObjects: boolean;
 begin
   Clear;
-  LoadResponses(FResponseList, IntToStr(AnIEN));           // Example AnIEN=134
+  LoadResponses(FResponseList, IntToStr(AnIEN), HasObjects);           // Example AnIEN=134
   FQuickOrder := AnIEN;
+  FOrderContainsObjects := HasObjects;
 end;
 
 procedure TResponses.SetQuickOrderByID(const AnID: string);
 { sets responses to a quick order value }
+var
+  HasObjects: boolean;
 begin
   Clear;
-  LoadResponses(FResponseList, AnID);                      // Example AnID=134-3645
+  LoadResponses(FResponseList, AnID, HasObjects);                      // Example AnID=134-3645
   FQuickOrder := StrToIntDef(Piece(AnID, '-', 1), 0);      // 2nd '-' piece is $H seconds
+  FOrderContainsObjects := HasObjects;
 end;
 
@@ -671 +688 @@
       break;
     end;
+end;
+
+function TResponses.PromptExists(const APromptID: string): boolean;
+var
+  i: Integer;
+begin
+  Result := False;
+  with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
+    if (ID = APromptID) then Result :=  True;
 end;
 
@@ -958 +984 @@
   APtEvtPtr: string;
 begin
+  //IMOLoc := 0;
   NewPtEvtPtr := 0;
   QOUDGroup := False;
@@ -984 +1011 @@
     if IsIMODialog then
       DGroup := ClinDisp;
+    //AGP Change 26.35, 26.41 8518 added text order
+    //AGP Change 26.55 remove IMO functionality for inpatient
+    (*if (Patient.Inpatient = true) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
+      ((ConstructOrder.DialogName = 'PSJ OR PAT OE') or (ConstructOrder.DialogName = 'PSJI OR PAT FLUID OE') or
+      (ConstructOrder.DialogName = 'OR GXTEXT WORD PROCESSING ORDE')) and
+      ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
+      begin
+       if frmClinicWardMeds.ClinicOrWardLocation(Encounter.location) = Encounter.Location then
+          begin
+            ConstructOrder.IsIMODialog := True;
+            ConstructOrder.DGroup := ClinDisp;
+          end
+       else IMOLoc := Patient.Location;
+      end; *)
+    //AGP Change 26.51, change logic to set text orders to IMO for outpatients at an outpatient location.
+    //AGP Text orders are only treated as IMO if the order display group is a nursing display group
+    if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
+       (((pos('OR GXTEXT WORD PROCESSING ORDE',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
+       ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or
+       ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757
+      ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
+         begin
+            ConstructOrder.IsIMODialog := True;
+            ConstructOrder.DGroup := ClinDisp;
+          end;
     IsEventDefaultOR := EventDefaultOD;
     if IsUDGroup or QOUDGroup then
@@ -1003 +1055 @@
       APtEvtPtr   := IntToStr(EventExist(Patient.DFN, FEventIFN));
       PTEventPtr  := APtEvtPtr;
+      //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
       PutNewOrder(AnOrder, ConstructOrder, OrderSource);
       if not SaveAsCurrent then
@@ -1012 +1065 @@
     else
     begin
+      //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
       PutNewOrder(AnOrder, ConstructOrder, OrderSource);
       if not SaveAsCurrent then
@@ -1064 +1118 @@
   AResponse: TResponse;
   IEN: integer;
+  HasObjects: boolean;
 
   procedure AssignBPText(List: TStrings; const Value: string);
@@ -1080 +1135 @@
       else         IEN := 0;
     end;
+    ExpandOrderObjects(tmp, HasObjects);
+    FOrderContainsObjects := FOrderContainsObjects or HasObjects;
     if IEN <> 0 then
       begin
@@ -1091 +1148 @@
     else
       CheckBoilerplate4Fields(tmp, cptn);
-
     List.Text := tmp;
   end;
@@ -1326 +1382 @@
   if (Encounter.Provider = 0) or (PersonHasKey(Encounter.Provider, 'PROVIDER') = False)
     then AnErrMsg := TX_NO_PROVIDER;
+  if IsPFSSActive and Responses.PromptExists('VISITSTR') then
+    Responses.Update('VISITSTR', 1, Encounter.VisitStr, Encounter.VisitStr);
 end;
 
@@ -1432 +1490 @@
   if not AcceptOrderChecks then
   begin
+    if AskAnotherOrder(DialogIEN) then
+        InitDialog           // ClearDialogControls is in InitDialog
+      else
+        begin
+          ClearDialogControls;    // to allow form to close without prompting to save order
+          Close;
+        end;
     Result := False;
     Exit;
@@ -1497 +1562 @@
   CIDCOkToSave := False;
   alreadyClosed := False;
+  self.Responses.Cancel := False;
   if frmOrders <> nil then
   begin
@@ -1589 +1655 @@
 begin
   inherited;
+  //self.Responses.Cancel := False;
   if User.NoOrdering then Exit;
   if FAbortOrder then exit;
@@ -1726 +1793 @@
 end;
 
+
 end.