Changeset 829 for cprs/trunk/CPRS-Chart/Orders/rOrders.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/rOrders.pas (modified) (46 diffs)

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

@@ -39 +39 @@
     LinkObject:   TObject;
     EnteredInError:     Integer; //AGP Changes 26.12 PSI-04-053
+    DCOriginalOrder: boolean;
     procedure Assign(Source: TOrder);
     procedure Clear;
@@ -200 +201 @@
 procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
 procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
-procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);  {*KCM*}
-procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
-procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char); {*KCM*}
+procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);  {*KCM*}
+procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
+procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0); {*KCM*}
 function UseNewMedDialogs: Boolean;
 
@@ -221 +222 @@
 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
 function GetREQReason: Integer;
-procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
+procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
 procedure ReleaseOrderHold(AnOrder: TOrder);
 procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
@@ -238 +239 @@
 function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
 procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
+function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
 //function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
 
@@ -340 +342 @@
 implementation
 
-uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore;
+uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore, VAUtils;
 
 var
@@ -576 +578 @@
 
 procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
-{           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18
-{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig}
+{           1   2    3     4      5     6   7   8   9    10    11    12    13    14     15     16  17    18    19     20
+{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig^IMO^DCOrigOrder}
 begin
   with AnOrder do
@@ -600 +602 @@
     Retrieved := True;
     OrderLocIEN  := Piece(Piece(x,U,19),':',2);   //imo
-    OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
+    if Piece(Piece(x,U,19),':',1) = '0;SC(' then OrderLocName := 'Unknown'
+    else OrderLocName := Piece(Piece(x,U,19),':',1);   //imo
     Text := y;
     XMLText := z;
@@ -609 +612 @@
     else AnOrder.EnteredInError := 0;
     //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA  ' + Text;
+    if Piece(x,U,20) = '1' then DCOriginalOrder := True
+    else DCOriginalOrder := False;
   end;
 end;
@@ -655 +660 @@
   AnOrder: TOrder;
   FilterTS: string;
+  AlertedUserOnly: boolean;
 begin
   ClearOrders(Dest);
   if uDGroupMap = nil then LoadDGroupMap;  // to make sure broker not called while looping thru Results
   FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
-  CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
+  AlertedUserOnly := (Notifications.Active and (AView.Filter = 12));
+  CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID, AlertedUserOnly]);
   if ((Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '')) and (AView.Filter = 5) then      // if no expiring orders found display expired orders)
   begin
@@ -756 +763 @@
   CallV('ORWOR SHEETS', [Patient.DFN]);
   MixedCaseByPiece(RPCBrokerV.Results, U, 2);
-  Dest.Assign(RPCBrokerV.Results);
-end;
+  FastAssign(RPCBrokerV.Results, Dest);
+ end;
 
 procedure LoadOrderSheetsED(Dest: TStrings);
@@ -771 +778 @@
     for i := 0 to RPCbrokerV.Results.Count - 1 do
       RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders';
-    Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end;
 end;
@@ -812 +819 @@
     for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := '';
     CallBroker;
-    IDList.Assign(Results);
+    FastAssign(RPCBrokerV.Results,IDList);
   end;
 end;
@@ -1015 +1022 @@
 begin
   CallV('ORWORDG ALLTREE', [nil]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1022 +1029 @@
   CallV('ORWOR TSALL', [nil]);
   MixedCaseList(RPCBrokerV.Results);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1032 +1039 @@
   otherEvts: TStringList;
   commonList: TStringList;
+  IsObservation: boolean;
 begin
   if Encounter <> nil then
@@ -1037 +1045 @@
   else
     Currloc := 0;
+  IsObservation := (Piece(GetCurrentSpec(Patient.DFN), U, 3) = '1');
   commonList := TStringList.Create;
   CallV('OREVNTX1 CMEVTS',[Currloc]);
@@ -1053 +1062 @@
       commonList.Add(Results[i]);
     end
+    else if IsObservation then
+    begin
+      if (Piece(Results[i],'^',3) = 'T') then
+        Continue;
+      commonList.Add(Results[i]);
+    end
     else
     begin
@@ -1061 +1076 @@
   if commonList.Count > 0 then
   begin
-    Dest.AddStrings(TStrings(commonList));
+    FastAddStrings(TStrings(commonList), Dest);
     Dest.Add('^^^^^^^^___________________________________________________________________________________________');
     Dest.Add(LLS_SPACE);
@@ -1074 +1089 @@
     begin
       RPCBrokerV.Results.Delete(0);
-      admitEvts.AddStrings(RPCBrokerV.Results);
+      FastAddStrings(RPCBrokerV.Results, admitEvts);
     end;
-    CallV('OREVNTX ACTIVE',['T^O^M^D']);
+    if IsObservation then
+      CallV('OREVNTX ACTIVE',['O^M^D'])
+    else
+      CallV('OREVNTX ACTIVE',['T^O^M^D']);
     //MixedCaseList(RPCBrokerV.Results);
     if RPCBrokerV.Results.Count > 0 then
     begin
       RPCBrokerV.Results.Delete(0);
-      otherEvts.AddStrings(RPCBrokerV.Results);
+      FastAddStrings(RPCBrokerV.Results, otherEvts);
     end;
-    Dest.AddStrings(TStrings(otherEvts));
+    FastAddStrings(TStrings(otherEvts), Dest);
     Dest.Add('^^^^^^^^_____________________________________________________________________________________________');
     Dest.Add(LLS_SPACE);
-    Dest.AddStrings(TStrings(admitEvts));
+    FastAddStrings(TStrings(admitEvts), Dest);
     admitEvts.Free;
     otherEvts.Free;
@@ -1096 +1114 @@
     if RPCBrokerV.Results.Count > 0 then
       RPCBrokerV.Results.Delete(0);
-    Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end
   else
@@ -1104 +1122 @@
     if RPCBrokerV.Results.Count > 0 then
       RPCBrokerV.Results.Delete(0);
-    Dest.AddStrings(RPCBrokerV.Results);
+    FastAddStrings(RPCBrokerV.Results, Dest);
   end;
 end;
@@ -1111 +1129 @@
 begin
   CallV('ORWORDG REVSTS', [nil]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1118 +1136 @@
 begin
   CallV('ORWORDG REVSTS', [nil]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1172 +1190 @@
        RESERVED_PIECE               + U +   // 10
        KeyVars;
-  CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses]);
+  CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses, Encounter.Location]);
   // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp
   with RPCBrokerV do
@@ -1275 +1293 @@
     RPCBrokerV.Results.Delete(0);
   end;
-  SetItems.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, SetItems);
 end;
 
@@ -1281 +1299 @@
 begin
   CallV('ORWDX WRLST', [Encounter.Location]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1290 +1308 @@
   begin
     Dest.Clear;
-    Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
   end
 end;
@@ -1310 +1328 @@
       then Results[i] := Piece(Results[i], U, 1);
   OrderList.Clear;
-  OrderList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, OrderList);
 end;
 
@@ -1324 +1342 @@
   CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]);
   OrderList.Clear;
-  OrderList.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, OrderList);
 end;
 
@@ -1339 +1357 @@
 end;
 
-procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);
-begin
-  CallV('ORWD1 RVPRINT',  [Encounter.Location, DeviceInfo, OrderList]);
-end;
-
-procedure PrintServiceCopies(OrderList: TStringList);  {*REV*}
-begin
-  CallV('ORWD1 SVONLY',  [Encounter.Location, OrderList]);
+procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string; PrintLoc: Integer = 0);
+var
+Loc: Integer;
+begin
+  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
+  else Loc := Encounter.Location;
+  CallV('ORWD1 RVPRINT',  [Loc, DeviceInfo, OrderList]);
+end;
+
+procedure PrintServiceCopies(OrderList: TStringList; PrintLoc: Integer = 0);  {*REV*}
+var
+Loc: Integer;
+begin
+  if (PrintLoc > 0) and (PrintLoc <> Encounter.Location) then Loc := PrintLoc
+  else Loc := Encounter.Location;
+  CallV('ORWD1 SVONLY',  [Loc, OrderList]);
 end;
 
@@ -1432 +1458 @@
   CallV('ORWOR ACTION TEXT',[ID]);
   if RPCBrokerV.Results.Count > 0 then
-    Errlist.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, Errlist);
 end;
 
@@ -1515 +1541 @@
 procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
 begin
-  CallV('ORWDXA DCREASON', [nil]);
+  CallV('ORWDX2 DCREASON', [nil]);
   ExtractItems(Dest, RPCBrokerV.Results, 'DCReason');
   //AGP Change 26.15 for PSI-04-63
@@ -1526 +1552 @@
 end;
 
-procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
-var
-  AParentID : string;
+procedure DCOrder(AnOrder: TOrder; AReason: Integer; NewOrder: boolean; var DCType: Integer);
+var
+  AParentID, DCOrigOrder: string;
 begin
   AParentID := AnOrder.ParentID;
-  CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason]);
+  if AnOrder.DCOriginalOrder = true then DCOrigOrder := '1'
+  else DCOrigOrder := '0';
+  CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason, DCOrigOrder, NewOrder]);
   UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID);
   DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0);
@@ -1553 +1581 @@
 begin
   CallV('ORWDXA FLAGTXT', [ID]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1565 +1593 @@
 begin
   CallV('ORWDXA WCGET', [ID]);
-  Dest.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, Dest);
 end;
 
@@ -1614 +1642 @@
       if piece(Results[0],'^',1) = '-1' then
         begin
-          ShowMessage('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
+          ShowMsg('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF +
             'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF +
             'If this problem persists, then there is a problem in the CPRS PKI interface, and it needs to be reported through the proper channels, to the developer Cary Malmrose.');
@@ -1651 +1679 @@
   SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
   SetOrderFromResults(AnOrder);
+end;
+
+function DoesOrderStatusMatch(OrderArray: TStringList): boolean;
+begin
+ Result := StrtoIntDef(SCallV('ORWDX1 ORDMATCH',[Patient.DFN, OrderArray]),0)=1;
 end;
 
@@ -1698 +1731 @@
   CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
   if RPCBrokerV.Results.Count > 0 then
-    RejectedReason.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, RejectedReason);
 end;
 
@@ -2076 +2109 @@
       MixedCaseList( RPCBrokerV.Results );
       RPCBrokerV.Results.Delete(0);
-      Dest.Assign(RPCBrokerV.Results);
+      FastAssign(RPCBrokerV.Results, Dest);
     end;
   end;
@@ -2087 +2120 @@
   begin
     SortByPiece(TStringList(RPCBrokerV.Results),'^',2);
-    Dest.Assign(RPCBrokerV.Results);
+    FastAssign(RPCBrokerV.Results, Dest);
   end;
 end;
@@ -2188 +2221 @@
     then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
     else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
-  ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 
@@ -2198 +2231 @@
     then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList])
     else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
-  ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 
@@ -2204 +2237 @@
 begin
   CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
-  ListOfChecks.Assign(RPCBrokerV.Results);
+  FastAssign(RPCBrokerV.Results, ListOfChecks);
 end;
 
@@ -2253 +2286 @@
                                   (PromptForWorkCopy     in ['1','2']));
         RPCBrokerV.Results.Delete(0);
-        OrdersToPrint.Assign(RPCBrokerV.Results);
+        FastAssign(RPCBrokerV.Results, OrdersToPrint);
       end;
     Result := TempParams;
@@ -2262 +2295 @@
 *)
 
-procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char);
+procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char; PrintLoc: Integer = 0);
 var
   x: string;
 begin
   if Nature <> #0 then
-    CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList])
+    begin
+       if PrintLoc > 0 then CallV('ORWD2 DEVINFO', [PrintLoc, Nature, OrderList])
+       else CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList]);
+    end
   else
-    CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
+    begin
+      if PrintLoc > 0 then CallV('ORWD2 MANUAL', [PrintLoc, OrderList])
+      else CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
+    end;
   x := RPCBrokerV.Results[0];
   FillChar(PrintParams, SizeOf(PrintParams), #0);
@@ -2295 +2334 @@
       RPCBrokerV.Results.Delete(0);
       OrderList.Clear;
-      OrderList.Assign(RPCBrokerV.Results);
+      FastAssign(RPCBrokerV.Results, OrderList);
     end;
 end;