Module

rODBase

Path

C:\CPRS\CPRS30\Orders\rODBase.pas

Last Modified

7/15/2014 3:26:42 PM

Initialization Code

initialization
  uLastDispenseIEN := 0;
  uLastDispenseMsg := '';

Finalization Code

finalization
  if uMedRoutes <> nil then uMedRoutes.Free;

end.

Units Used in Interface

Name Comments
rOrders -
uConst -
uCore -

Units Used in Implementation

Name Comments
fODBase -
uODBase -
uOrders -

Classes

Name Comments
TDialogItem -
TPrompt -
TResponse -

Procedures

Name Owner Declaration Scope Comments
AppendMedRoutes - procedure AppendMedRoutes(Dest: TStrings); Interfaced Medication Calls
CheckAuthForMeds - procedure CheckAuthForMeds(var x: string); Interfaced -
ExtractToResponses - procedure ExtractToResponses(Dest: TList; var HasObjects: boolean); Global -
IdentifyDialog - procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer); Interfaced -
LoadDialogDefinition - procedure LoadDialogDefinition(Dest: TList; const DialogName: string); Interfaced
Loads a list of TPrompt records
  Pieces: PromptID[1]^PromptIEN[2]^FmtSeq[3]^Fmt[4]^Omit[5]^Lead[6]^Trail[7]^NwLn[8]^Wrap[9]^Children[10]^IsChild[11]
LoadFormularyAlt - procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char); Interfaced -
LoadOrderPrompting - procedure LoadOrderPrompting(Dest: TList; ADialog: Integer); Interfaced ID^REQ^HID^PROMPT^TYPE^DOMAIN^DEFAULT^IDFLT^HELP
LoadQuickListForOD - procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer); Interfaced -
LoadResponses - procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean); Interfaced Procedure LoadResponses(Dest: TList; const OrderID: string);
LookupRoute - procedure LookupRoute(const AName: string; var ID, Abbreviation: string); Interfaced -
PutNewOrder - procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string); Interfaced -
PutQuickOrder - procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer; ResponseList: TList); Interfaced
Procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
begin
  CallV('ORWDXQ PUTQNAM', [DialogIEN, DisplayName]);
  // ignore return value for now
end;
SaveQuickListForOD - procedure SaveQuickListForOD(Src: TStrings; DGroup: Integer); Interfaced -
SetDefaultCoPayToNewOrder - procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string); Interfaced -
SetupORDIALOG - procedure SetupORDIALOG(AParam: TParamRecord; ResponseList: TList; IsIV: boolean = False); Global Common Internal Calls
ValidateIVRate - procedure ValidateIVRate(var x: string); Interfaced Function ValidIVRate(const x: string): Boolean;
ValidateNumericStr - procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string); Interfaced -

Functions

Name Owner Declaration Scope Comments
AmountsForIVFluid - function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string; Interfaced Medication Calls
AskAnotherOrder - function AskAnotherOrder(ADialog: Integer): Boolean; Interfaced
General Calls
General Calls
DispenseMessage - function DispenseMessage(AnIEN: Integer): string; Interfaced -
DisplayGroupByName - function DisplayGroupByName(const AName: string): Integer; Interfaced -
DisplayGroupForDialog - function DisplayGroupForDialog(const DialogName: string): Integer; Interfaced -
GetDefaultCopay - function GetDefaultCopay(AnOrderID: string): String; Interfaced -
GetQuickName - function GetQuickName(const CRC: string): string; Interfaced
Quick Order Calls 
function DisplayNameForOD(const InternalName: string): string;
function DisplayNameForOD(const InternalName: string): string;
begin
  Result := sCallV('ORWDXQ DLGNAME', [InternalName]);
end;
IsPFSSActive - function IsPFSSActive: boolean; Interfaced -
MedIsSupply - function MedIsSupply(AnIEN: Integer): Boolean; Interfaced -
MedTypeIsIV - function MedTypeIsIV(AnIEN: Integer): Boolean; Interfaced -
ODForIVFluids - function ODForIVFluids: TStrings; Interfaced Returns init values for IV Fluids dialog. The results must be used immediately.
ODForMedIn - function ODForMedIn: TStrings; Interfaced Returns init values for inpatient meds dialog. The results must be used immediately.
ODForMedOut - function ODForMedOut: TStrings; Interfaced Returns init values for outpatient meds dialog. The results must be used immediately.
ODForVitals - function ODForVitals: TStrings; Interfaced
Vitals Calls
Returns init values for vitals dialog.  The results must be used immediately.
OIForMedIn - function OIForMedIn(AnIEN: Integer): TStrings; Interfaced Returns init values for inpatient meds order item. The results must be used immediately.
OIForMedOut - function OIForMedOut(AnIEN: Integer): TStrings; Interfaced Returns init values for outpatient meds order item. The results must be used immediately.
OIMessage - function OIMessage(IEN: Integer): string; Interfaced
Procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer); // no longer used
no longer used -
procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer);
var
  i: Integer;
  y: string;
begin
  CallV('ORWDXM AUTOACK', [Patient.DFN, Encounter.Provider, Encounter.Location, ADialog]);
  with RPCBrokerV do if Results.Count > 0 then
  begin
    y := '';
    for i := 1 to Results.Count - 1 do
      y := y + Copy(Results[i], 2, Length(Results[i])) + CRLF;
    if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2);  // take off last CRLF
    SetOrderFields(AnOrder, Results[0], y);
  end;
end;
OrderMenuStyle - function OrderMenuStyle: Integer; Interfaced -
QuantityMessage - function QuantityMessage(AnIEN: Integer): string; Interfaced -
RatedDisabilities - function RatedDisabilities: string; Interfaced Returns a list of rated disabilities, if any, for a patient
RequiresCopay - function RequiresCopay(DispenseDrug: Integer): Boolean; Interfaced -
ResolveScreenRef - function ResolveScreenRef(const ARef: string): string; Interfaced -
SubsetOfEntries - function SubsetOfEntries(const StartFrom: string; Direction: Integer; const XRef, GblRef, ScreenRef: string): TStrings; Interfaced
Returns a pointer to a list of file entries (for use in a long list box) -
  The return value is  a pointer to RPCBrokerV.Results, so the data must
  be used BEFORE the next broker call!
SubSetOfOrderItems - function SubSetOfOrderItems(const StartFrom: string; Direction: Integer; const XRef: string): TStrings; Interfaced
Returns a pointer to a list of orderable items matching an S.xxx cross reference (for use in
  a long list box) -  The return value is  a pointer to RPCBrokerV.Results, so the data must
  be used BEFORE the next broker call!
ValidQuantity - function ValidQuantity(const x: string): Boolean; Interfaced Returns true if the text entered as the quantity is valid
ValidSchedule - function ValidSchedule(const x: string; PSType: Char = 'I'): Integer; Interfaced
Function ValidIVRate(const x: string): Boolean;
{returns true if the text entered as the IV rate is valid }
begin
  Result := sCallV('ORWDPS32 VALRATE', [x]) = '1';
end;

 returns 1 if schedule is valid, 0 if schedule is not valid, -1 pharmacy routine not there

Global Variables

Name Type Declaration Comments
uLastDispenseIEN Integer uLastDispenseIEN: Integer; -
uLastDispenseMsg UnicodeString uLastDispenseMsg: string; -
uLastQuantityMsg UnicodeString uLastQuantityMsg: string; -
uMedRoutes TStringList uMedRoutes: TStringList; -
uPFSSActive uPFSSActive: TPFSSActive; -


Module Source

1     unit rODBase;
2     
3     interface                        
4     
5     uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders;
6     
7     type
8       TPrompt = class
9         ID:        string;
10        IEN:       Integer;
11        Sequence:  Double;
12        FmtCode:   string;
13        Omit:      string;
14        Leading:   string;
15        Trailing:  string;
16        NewLine:   Boolean;
17        WrapWP:    Boolean;
18        Children:  string;
19        IsChild:   Boolean;
20      end;
21    
22      TResponse = class
23        PromptIEN: Integer;
24        PromptID:  string;
25        Instance:  Integer;
26        IValue:    string;
27        EValue:    string;
28      end;
29    
30      TDialogItem = class
31        ID:        string;
32        Required:  Boolean;
33        Hidden:    Boolean;
34        Prompt:    string;
35        DataType:  Char;
36        Domain:    string;
37        EDefault:  string;
38        IDefault:  string;
39        HelpText:  string;
40        CrossRef:  string;
41        ScreenRef: string;
42      end;
43    
44      TDialogNames = record
45        Internal: string;
46        Display:  string;
47        BaseIEN:  Integer;
48        BaseName: string;
49      end;
50    
51      TConstructOrder = record
52        DialogName: string;
53        LeadText:   string;
54        TrailText:  string;
55        DGroup:     Integer;
56        OrderItem:  Integer;
57        DelayEvent: Char;
58        PTEventPtr: String;  // ptr to #100.2
59        EventPtr:   String;  // ptr to #100.5
60        Specialty:  Integer;
61        Effective:  TFMDateTime;
62        LogTime:    TFMDateTime;
63        OCList: TStringList;
64        DigSig:       string;
65        ResponseList: TList;
66        IsIMODialog:  boolean;  //imo
67        IsEventDefaultOR: Integer;
68      end;
69    
70      TPFSSActive = record
71        PFSSActive: boolean;
72        PFSSChecked: boolean;
73      end;
74    
75    { General Calls }
76    function AskAnotherOrder(ADialog: Integer): Boolean;
77    function DisplayGroupByName(const AName: string): Integer;
78    function DisplayGroupForDialog(const DialogName: string): Integer;
79    procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer);
80    procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
81    procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
82    //procedure LoadResponses(Dest: TList; const OrderID: string);
83    procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
84    procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
85    //procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer); // no longer used
86    function OIMessage(IEN: Integer): string;
87    function OrderMenuStyle: Integer;
88    function ResolveScreenRef(const ARef: string): string;
89    function SubsetOfEntries(const StartFrom: string; Direction: Integer;
90      const XRef, GblRef, ScreenRef: string): TStrings;
91    function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
92      const XRef: string): TStrings;
93    function GetDefaultCopay(AnOrderID: string): String;
94    procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
95    procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
96    function IsPFSSActive: boolean;
97    
98    { Quick Order Calls }
99    //function DisplayNameForOD(const InternalName: string): string;
100   function GetQuickName(const CRC: string): string;
101   procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer);
102   procedure SaveQuickListForOD(Src: TStrings;  DGroup: Integer);
103   //procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
104   procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer;
105     ResponseList: TList);
106   
107   { Medication Calls }
108   function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
109   procedure AppendMedRoutes(Dest: TStrings);
110   procedure CheckAuthForMeds(var x: string);
111   function DispenseMessage(AnIEN: Integer): string;
112   procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
113   function MedIsSupply(AnIEN: Integer): Boolean;
114   function QuantityMessage(AnIEN: Integer): string;
115   function RequiresCopay(DispenseDrug: Integer): Boolean;
116   procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
117   function MedTypeIsIV(AnIEN: Integer): Boolean;
118   function ODForMedIn: TStrings;
119   function OIForMedIn(AnIEN: Integer): TStrings;
120   function ODForIVFluids: TStrings;
121   function ODForMedOut: TStrings;
122   function OIForMedOut(AnIEN: Integer): TStrings;
123   function RatedDisabilities: string;
124   //function ValidIVRate(const x: string): Boolean;
125   procedure ValidateIVRate(var x: string);
126   function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
127   function ValidQuantity(const x: string): Boolean;
128   
129   { Vitals Calls }
130   function ODForVitals: TStrings;
131   
132   implementation
133   
134   uses TRPCB, uOrders, uODBase, fODBase;
135   
136   var
137     uLastDispenseIEN: Integer;
138     uLastDispenseMsg: string;
139     uLastQuantityMsg: string;
140     uMedRoutes: TStringList;
141     uPFSSActive: TPFSSActive;
142   
143   { Common Internal Calls }
144   
145   procedure SetupORDIALOG(AParam: TParamRecord; ResponseList: TList; IsIV: boolean = False);
146   const
147     MAX_STR_LEN = 74;
148   var
149     i,j,ALine,odIdx,piIdx : Integer;
150     Subs, x, ODtxt, thePI: string;
151     WPStrings: TStringList;
152     IVDuration, IVDurVal: string;
153   begin
154     piIdx := 0;
155     odIdx := 0;
156     IVDuration := '';
157     IVDurVal := '';
158     AParam.PType := list;
159     for j := 0 to ResponseList.Count - 1 do
160     begin
161       if TResponse(ResponseList.Items[j]).PromptID = 'SIG' then
162       begin
163         ODtxt := TResponse(ResponseList.Items[j]).EValue;
164         odIdx := j;
165       end;
166       if TResponse(ResponseList.Items[j]).PromptID = 'PI' then
167         thePI := TResponse(ResponseList.Items[j]).EValue;
168       if Length(Trim(thePI)) > 0 then
169         piIdx := Pos(thePI, ODtxt);
170       if piIdx > 0 then
171       begin
172         Delete(ODtxt,piIdx,Length(thePI));
173         TResponse(ResponseList.Items[odIdx]).EValue := ODtxt;
174       end;
175       if (IsIV and (TResponse(ResponseList.Items[j]).PromptID = 'DAYS')) then
176       begin
177         IVDuration := TResponse(ResponseList.Items[j]).EValue;
178         if (Length(IVDuration) > 1) then
179         begin
180           if (Pos('TOTAL',upperCase(IVDuration))>0) or (Pos('FOR',upperCase(IVDuration))>0) then continue;
181           if (Pos('H',upperCase(IVDuration))>0)  then
182           begin
183             IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
184             TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' hours';
185           end
186           else if (Pos('D',upperCase(IVDuration))>0) then
187           begin
188             if Pos('DOSES', upperCase(IVDuration)) > 0 then
189               begin
190                 IVDurVal := Copy(IVDuration, 1, length(IVDuration)-5);
191                 TResponse(ResponseList.Items[j]).IValue := 'for a total of ' + IVDurVal + ' doses';
192               end
193             else
194               begin
195                 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
196                 TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + ' days';
197               end;
198           end
199           else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
200           begin
201             IVDurVal := Copy(IVDuration,1,length(IVDuration)-2);
202             TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'ml';
203           end
204           else if (Pos('L',upperCase(IVDuration))>0) then
205           begin
206             IVDurVal := Copy(IVDuration,0,length(IVDuration)-1);
207             TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'L';
208           end;
209         end;
210       end;
211     end;
212   
213     with AParam, ResponseList do for i := 0 to Count - 1 do
214     begin
215       with TResponse(Items[i]) do
216       begin
217         Subs := IntToStr(PromptIEN) + ',' + IntToStr(Instance);
218         if IValue = TX_WPTYPE then
219         begin
220           WPStrings := TStringList.Create;
221           try
222             WPStrings.Text := EValue;
223             LimitStringLength(WPStrings, MAX_STR_LEN);
224             x := 'ORDIALOG("WP",' + Subs + ')';
225             Mult[Subs] := x;
226             for ALine := 0 to WPStrings.Count - 1 do
227             begin
228               x := '"WP",' + Subs + ',' + IntToStr(ALine+1) + ',0';
229               Mult[x] := WPStrings[ALine];
230             end; {for}
231           finally
232             WPStrings.Free;
233           end; {try}
234         end
235         else Mult[Subs] := IValue;
236       end; {with TResponse}
237     end; {with AParam}
238   end;
239   
240   { Quick Order Calls }
241   
242   //function DisplayNameForOD(const InternalName: string): string;
243   //begin
244   //  Result := sCallV('ORWDXQ DLGNAME', [InternalName]);
245   //end;
246   
247   function GetQuickName(const CRC: string): string;
248   begin
249     Result := sCallV('ORWDXQ GETQNAM', [CRC]);
250   end;
251   
252   procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer);
253   begin
254     CallV('ORWDXQ GETQLST', [DGroup]);
255     FastAssign(RPCBrokerV.Results, Dest);
256   end;
257   
258   procedure SaveQuickListForOD(Src: TStrings;  DGroup: Integer);
259   begin
260     CallV('ORWDXQ PUTQLST', [DGroup, Src]);
261     // ignore return value for now
262   end;
263   
264   //procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
265   //begin
266   //  CallV('ORWDXQ PUTQNAM', [DialogIEN, DisplayName]);
267   //  // ignore return value for now
268   //end;
269   
270   procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer;
271     ResponseList: TList);
272   begin
273     with RPCBrokerV do
274     begin
275       ClearParameters := True;
276       RemoteProcedure := 'ORWDXQ DLGSAVE';
277       Param[0].PType := literal;
278       Param[0].Value := CRC;
279       Param[1].PType := literal;
280       Param[1].Value := DisplayName;
281       Param[2].PType := literal;
282       Param[2].Value := IntToStr(DGroup);
283       SetupORDIALOG(Param[3], ResponseList);
284       CallBroker;
285       if Results.Count = 0 then Exit;  // error creating order
286       NewIEN := StrToIntDef(Results[0], 0);
287     end;
288   end;
289   
290   { General Calls }
291   
292   function AskAnotherOrder(ADialog: Integer): Boolean;
293   begin
294     Result := sCallV('ORWDX AGAIN', [ADialog]) = '1';
295   end;
296   
297   function DisplayGroupByName(const AName: string): Integer;
298   begin
299     Result := StrToIntDef(sCallV('ORWDX DGNM', [AName]), 0);
300   end;
301   
302   function DisplayGroupForDialog(const DialogName: string): Integer;
303   begin
304     Result := StrToIntDef(sCallV('ORWDX DGRP', [DialogName]),0);
305   end;
306   
307   procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer);
308   var
309     x: string;
310   begin
311     x := sCallV('ORWDXM DLGNAME', [ADialog]);
312     with DialogNames do
313     begin
314       Internal := Piece(x, U, 1);
315       Display  := Piece(x, U, 2);
316       BaseIEN  := StrToIntDef(Piece(x, U, 3), 0);
317       BaseName := Piece(x, U, 4);
318     end;
319   end;
320   
321   procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
322   { loads a list of TPrompt records
323     Pieces: PromptID[1]^PromptIEN[2]^FmtSeq[3]^Fmt[4]^Omit[5]^Lead[6]^Trail[7]^NwLn[8]^Wrap[9]^Children[10]^IsChild[11] }
324   var
325     i: Integer;
326     APrompt: TPrompt;
327   begin
328     CallV('ORWDX DLGDEF', [DialogName]);
329     with RPCBrokerV do for i := 0 to Results.Count - 1 do
330     begin
331       APrompt := TPrompt.Create;
332       with APrompt do
333       begin
334         ID        := Piece(Results[i], U, 1);
335         IEN       := StrToIntDef(Piece(Results[i], U, 2), 0);
336         if Length(Piece(Results[i], U, 3)) > 0
337           then Sequence := StrToFloat(Piece(Results[i], U, 3))
338           else Sequence := 0;
339         FmtCode   := Piece(Results[i], U, 4);
340         Omit      := Piece(Results[i], U, 5);
341         Leading   := Piece(Results[i], U, 6);
342         Trailing  := Piece(Results[i], U, 7);
343         NewLine   := Piece(Results[i], U, 8) = '1';
344         WrapWP    := Piece(Results[i], U, 9) = '1';
345         Children  := Piece(Results[i], U, 10);
346         IsChild   := Piece(Results[i], U, 11) = '1';
347       end;
348       Dest.Add(APrompt);
349     end;
350   end;
351   
352   procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
353   // ID^REQ^HID^PROMPT^TYPE^DOMAIN^DEFAULT^IDFLT^HELP
354   var
355     i: Integer;
356     DialogItem: TDialogItem;
357   begin
358     CallV('ORWDXM PROMPTS', [ADialog]);
359     DialogItem := nil;
360     with RPCBrokerV do for i := 0 to Results.Count - 1 do
361     begin
362       if CharAt(Results[i], 1) = '~' then
363       begin
364         DialogItem := TDialogItem.Create;                       // create a new dialog item
365         with DialogItem do
366         begin
367           Results[i] := Copy(Results[i], 2, Length(Results[i]));
368           ID         := Piece(Results[i], U, 1);
369           Required   := Piece(Results[i], U, 2) = '1';
370           Hidden     := Piece(Results[i], U, 3) = '1';
371           Prompt     := Piece(Results[i], U, 4);
372           DataType   := CharAt(Piece(Results[i], U, 5), 1);
373           Domain     := Piece(Results[i], U, 6);
374           EDefault   := Piece(Results[i], U, 7);
375           IDefault   := Piece(Results[i], U, 8);
376           HelpText   := Piece(Results[i], U, 9);
377           CrossRef   := Piece(Results[i], U, 10);
378           ScreenRef  := Piece(Results[i], U, 11);
379           if Hidden then DataType := 'H';                       // if hidden, use 'Hidden' type
380         end;
381         Dest.Add(DialogItem);
382       end;
383       if (CharAt(Results[i], 1) = 't') and (DialogItem <> nil) then  // use last DialogItem
384         with DialogItem do EDefault := EDefault + Copy(Results[i], 2, Length(Results[i])) + CRLF;
385     end;
386   end;
387   
388   procedure ExtractToResponses(Dest: TList; var HasObjects: boolean);
389   { load a list with TResponse records, assumes source strings are in RPCBrokerV.Results }
390   var
391     i: Integer;
392     AResponse: TResponse;
393     WPContainsObjects, TxContainsObjects: boolean;
394     TempBroker: TStrings;
395   begin
396     i := 0;
397     HasObjects := FALSE;
398     TempBroker := TStringlist.Create;
399     FastAssign(RPCBrokerV.Results, TempBroker);
400     try
401     with TempBroker do while i < Count do
402     begin
403       if CharAt(Strings[i], 1) = '~' then
404       begin
405         AResponse := TResponse.Create;
406         with AResponse do
407         begin
408           PromptIEN := StrToIntDef(Piece(Copy(Strings[i], 2, 255), U, 1), 0);
409           Instance := StrToIntDef(Piece(Strings[i], U, 2), 0);
410           PromptID := Piece(Strings[i], U, 3);
411           Inc(i);
412           while (i < Count) and (CharAt(Strings[i], 1) <> '~') do
413           begin
414             if CharAt(Strings[i], 1) = 'i' then IValue := Copy(Strings[i], 2, 255);
415             if CharAt(Strings[i], 1) = 'e' then EValue := Copy(Strings[i], 2, 255);
416             if CharAt(Strings[i], 1) = 't' then
417             begin
418               if Length(EValue) > 0 then EValue := EValue + CRLF;
419               EValue := EValue + Copy(Strings[i], 2, 255);
420               IValue := TX_WPTYPE;  // signals that this is a word processing field
421             end;
422             Inc(i);
423           end; {while i}
424           if IValue <> TX_WPTYPE then ExpandOrderObjects(IValue, TxContainsObjects);
425           ExpandOrderObjects(EValue, WPContainsObjects);
426           HasObjects := HasObjects or WPContainsObjects or TxContainsObjects;
427           Dest.Add(AResponse);
428         end; {with AResponse}
429       end; {if CharAt}
430     end; {With RPCBrokerV}
431     finally
432       TempBroker.Free;
433     end;
434   end;
435   
436   procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
437   var
438   Transfer: boolean;
439   begin
440     if ((XferOuttoInOnMeds = True) or (XfInToOutNow = True)) and (CharAt(OrderID,1)='C') then Transfer := true
441     else Transfer := false;
442     CallV('ORWDX LOADRSP', [OrderID, Transfer]);
443     ExtractToResponses(Dest, HasObjects);
444   end;
445   
446   procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
447   var
448     i, inc, len, numLoop, remain: Integer;
449     ocStr, tmpStr, x, y, z: string;
450   begin
451     with RPCBrokerV do
452     begin
453       ClearParameters := True;
454       RemoteProcedure := 'ORWDX SAVE';
455       Param[0].PType := literal;
456       Param[0].Value := Patient.DFN;  //*DFN*
457       Param[1].PType := literal;
458       Param[1].Value := IntToStr(Encounter.Provider);
459       Param[2].PType := literal;
460       (*if loc > 0 then Param[2].Value := IntToStr(Loc)
461       else Param[2].Value := IntToStr(Encounter.Location);*)
462       Param[2].Value := IntToStr(Encounter.Location);
463       Param[3].PType := literal;
464       Param[3].Value := ConstructOrder.DialogName;
465       Param[4].PType := literal;
466       Param[4].Value := IntToStr(ConstructOrder.DGroup);
467       Param[5].PType := literal;
468       Param[5].Value := IntToStr(ConstructOrder.OrderItem);
469       Param[6].PType := literal;
470       Param[6].Value := AnOrder.EditOf;        // null if new order, otherwise ORIFN of original
471       if (ConstructOrder.DGroup = IVDisp) or (ConstructOrder.DialogName = 'PSJI OR PAT FLUID OE') then
472         SetupORDIALOG(Param[7], ConstructOrder.ResponseList, True)
473       else
474         SetupORDIALOG(Param[7], ConstructOrder.ResponseList);
475       if Length(ConstructOrder.LeadText)  > 0
476         then Param[7].Mult['"ORLEAD"']  := ConstructOrder.LeadText;
477       if Length(ConstructOrder.TrailText) > 0
478         then Param[7].Mult['"ORTRAIL"'] := ConstructOrder.TrailText;
479       Param[7].Mult['"ORCHECK"'] := IntToStr(ConstructOrder.OCList.Count);
480       with ConstructOrder do for i := 0 to OCList.Count - 1 do
481       begin
482         // put quotes around everything to prevent broker from choking
483         y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
484           '","' + IntToStr(i+1) + '"';
485         //Param[7].Mult[y] := Pieces(OCList[i], U, 2, 4);
486         OCStr :=  Pieces(OCList[i], U, 2, 4);
487         len := Length(OCStr);
488         if len > 255 then
489           begin
490             numLoop := len div 255;
491             remain := len mod 255;
492             inc := 0;
493             while inc <= numLoop do
494               begin
495                 tmpStr := Copy(OCStr, 1, 255);
496                 OCStr := Copy(OCStr, 256, Length(OcStr));
497                 Param[7].Mult[y + ',' + InttoStr(inc)] := tmpStr;
498                 inc := inc +1;
499               end;
500             if remain > 0 then  Param[7].Mult[y + ',' + inttoStr(inc)] := OCStr;
501   
502           end
503         else
504          Param[7].Mult[y] := OCStr;
505       end;
506       if ConstructOrder.DelayEvent in ['A','D','T','M','O'] then
507         Param[7].Mult['"OREVENT"'] := ConstructOrder.PTEventPtr;
508       if ConstructOrder.LogTime > 0
509         then Param[7].Mult['"ORSLOG"'] := FloatToStr(ConstructOrder.LogTime);
510       Param[7].Mult['"ORTS"'] := IntToStr(Patient.Specialty);  // pass in treating specialty for ORTS
511       Param[8].PType := literal;
512       Param[8].Value := ConstructOrder.DigSig;
513       if Constructorder.IsIMODialog then
514       begin
515         Param[9].PType := literal;                       //IMO
516         Param[9].Value := FloatToStr(Encounter.DateTime);
517       end else
518       begin
519         Param[9].PType := literal;                       //IMO
520         Param[9].Value := '';
521       end;
522       Param[10].PType := literal;
523       Param[10].Value := OrderSource;
524       Param[11].PType := literal;
525       Param[11].Value := IntToStr(Constructorder.IsEventDefaultOR);
526   
527       CallBroker;
528       if Results.Count = 0 then Exit;          // error creating order
529       x := Results[0];
530       Results.Delete(0);
531       y := '';
532   
533       while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
534         begin
535           y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
536           Results.Delete(0);
537         end;
538       if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2);  // take off last CRLF
539       z := '';
540       if (Results.Count > 0) and (Results[0] = '|') then
541         begin
542           Results.Delete(0);
543           while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
544             begin
545               z := z + Copy(Results[0], 2, Length(Results[0]));
546               Results.Delete(0);
547             end;
548         end;
549       SetOrderFields(AnOrder, x, y, z);
550     end;
551   end;
552   
553   { no longer used -
554   procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer);
555   var
556     i: Integer;
557     y: string;
558   begin
559     CallV('ORWDXM AUTOACK', [Patient.DFN, Encounter.Provider, Encounter.Location, ADialog]);
560     with RPCBrokerV do if Results.Count > 0 then
561     begin
562       y := '';
563       for i := 1 to Results.Count - 1 do
564         y := y + Copy(Results[i], 2, Length(Results[i])) + CRLF;
565       if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2);  // take off last CRLF
566       SetOrderFields(AnOrder, Results[0], y);
567     end;
568   end;
569   }
570   
571   function OIMessage(IEN: Integer): string;
572   begin
573     CallV('ORWDX MSG', [IEN]);
574     with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
575   end;
576   
577   function OrderMenuStyle: Integer;
578   begin
579     Result := StrToIntDef(sCallV('ORWDXM MSTYLE', [nil]), 0);
580   end;
581   
582   function ResolveScreenRef(const ARef: string): string;
583   begin
584     Result := sCallV('ORWDXM RSCRN', [ARef]);
585   end;
586   
587   function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
588     const XRef: string): TStrings;
589   { returns a pointer to a list of orderable items matching an S.xxx cross reference (for use in
590     a long list box) -  The return value is  a pointer to RPCBrokerV.Results, so the data must
591     be used BEFORE the next broker call! }
592   begin
593     CallV('ORWDX ORDITM', [StartFrom, Direction, XRef]);
594     Result := RPCBrokerV.Results;
595   end;
596   
597   function GetDefaultCopay(AnOrderID: string): String;
598   begin
599     with RPCBrokerV do
600     begin
601       ClearParameters := True;
602       RemoteProcedure := 'ORWDPS4 CPLST';
603       Param[0].PType := literal;
604       Param[0].Value := Patient.DFN;
605       Param[1].PType := list;
606       Param[1].Mult['1'] := AnOrderID;
607     end;
608     CallBroker;
609     if RPCBrokerV.Results.Count > 0 then
610       Result := RPCBrokerV.Results[0]
611     else
612       Result := '';
613   end;
614   
615   procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
616   var
617     temp,CPExems: string;
618     CoPayValue: array [1..7] of Char;
619     i: integer;
620   begin
621     // SC AO IR EC MST HNC CV
622     CoPayValue[1] := 'N';
623     CoPayValue[2] := 'N';
624     CoPayValue[3] := 'N';
625     CoPayValue[4] := 'N';
626     CoPayValue[5] := 'N';
627     CoPayValue[6] := 'N';
628     CoPayValue[7] := 'N';
629     temp := Pieces(CoPayInfo,'^',2,6);
630     i := 1;
631     while Length(Piece(temp,'^',i))>0 do
632     begin
633       if Piece(Piece(temp,'^',i),';',1) = 'SC' then
634       begin
635         if Piece( Piece(temp,'^',i),';',2) = '1' then
636           CoPayValue[1] := 'C'
637         else
638           CopayValue[1] := 'U';
639       end;
640       if Piece(Piece(temp,'^',i),';',1) = 'AO' then
641       begin
642         if Piece( Piece(temp,'^',i),';',2) = '1' then
643           CoPayValue[2] := 'C'
644         else
645           CopayValue[2] := 'U';
646       end;
647       if Piece(Piece(temp,'^',i),';',1) = 'IR' then
648       begin
649         if Piece( Piece(temp,'^',i),';',2) = '1' then
650           CoPayValue[3] := 'C'
651         else
652           CopayValue[3] := 'U';
653       end;
654       if Piece(Piece(temp,'^',i),';',1) = 'EC' then
655       begin
656         if Piece( Piece(temp,'^',i),';',2) = '1' then
657           CoPayValue[4] := 'C'
658         else
659           CopayValue[4] := 'U';
660       end;
661       if Piece(Piece(temp,'^',i),';',1) = 'MST' then
662       begin
663         if Piece( Piece(temp,'^',i),';',2) = '1' then
664           CoPayValue[5] := 'C'
665         else
666           CopayValue[5] := 'U';
667       end;
668       if Piece(Piece(temp,'^',i),';',1) = 'HNC' then
669       begin
670         if Piece( Piece(temp,'^',i),';',2) = '1' then
671           CoPayValue[6] := 'C'
672         else
673           CopayValue[6] := 'U';
674       end;
675       if Piece(Piece(temp,'^',i),';',1) = 'CV' then
676       begin
677         if Piece( Piece(temp,'^',i),';',2) = '1' then
678           CoPayValue[7] := 'C'
679         else
680           CopayValue[7] := 'U';
681       end;
682       i := i + 1;
683     end;
684     CPExems := CoPayValue[1] + CoPayValue[2] + CoPayValue[3] + CoPayValue[4]
685              + CoPayValue[5] + CoPayValue[6] + CoPayValue[7];
686     CPExems := AnOrderId + '^' + CPExems;
687     with RPCBrokerV do
688     begin
689       ClearParameters := True;
690       RemoteProcedure := 'ORWDPS4 CPINFO';
691       Param[0].PType := list;
692       Param[0].Mult['1'] := CPExems;
693       CallBroker;
694     end;
695   end;
696   
697   function SubsetOfEntries(const StartFrom: string; Direction: Integer;
698     const XRef, GblRef, ScreenRef: string): TStrings;
699   { returns a pointer to a list of file entries (for use in a long list box) -
700     The return value is  a pointer to RPCBrokerV.Results, so the data must
701     be used BEFORE the next broker call! }
702   begin
703     CallV('ORWDOR LKSCRN', [StartFrom, Direction, XRef, GblRef, ScreenRef]);
704     Result := RPCBrokerV.Results;
705   end;
706   
707   procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
708   begin
709     ErrMsg := sCallV('ORWDOR VALNUM', [x, Dom]);
710     if ErrMsg = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
711   end;
712   
713   function IsPFSSActive: boolean;
714   begin
715     with uPFSSActive do
716       if not PFSSChecked then
717         begin
718           PFSSActive := (sCallV('ORWPFSS IS PFSS ACTIVE?', [nil]) = '1');
719           PFSSChecked := True;
720         end;
721     Result := uPFSSActive.PFSSActive
722   end;
723   
724   { Medication Calls }
725   
726   procedure AppendMedRoutes(Dest: TStrings);
727   var
728     i: Integer;
729     x: string;
730   begin
731     if uMedRoutes = nil then
732     begin
733       CallV('ORWDPS32 ALLROUTE', [nil]);
734       with RPCBrokerV do
735       begin
736         uMedRoutes := TStringList.Create;
737         FastAssign(RPCBrokerV.Results, uMedRoutes);
738         for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
739         begin
740           x := Piece(Results[i], U, 1) + U + Piece(Results[i], U, 3) +
741                ' (' + Piece(Results[i], U, 2) + ')' + U + Piece(Results[i], U, 3);
742           uMedRoutes.Add(x);
743         end; {if Length}
744         SortByPiece(uMedRoutes, U, 2);
745       end; {with RPCBrokerV}
746     end; {if uMedRoutes}
747     FastAddStrings(uMedRoutes, Dest);
748   end;
749   
750   procedure CheckAuthForMeds(var x: string);
751   begin
752     x := Piece(sCallV('ORWDPS32 AUTH', [Encounter.Provider]), U, 2);
753   end;
754   
755   function DispenseMessage(AnIEN: Integer): string;
756   var
757     x: string;
758   begin
759     if AnIEN = uLastDispenseIEN then Result := uLastDispenseMsg else
760     begin
761       x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
762       uLastDispenseIEN := AnIEN;
763       uLastDispenseMsg := Piece(x, U, 1);
764       uLastQuantityMsg := Piece(x, U, 2);
765       Result := uLastDispenseMsg;
766     end;
767   end;
768   
769   function QuantityMessage(AnIEN: Integer): string;
770   var
771     x: string;
772   begin
773     if AnIEN = uLastDispenseIEN then Result := uLastQuantityMsg else
774     begin
775       x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
776       uLastDispenseIEN := AnIEN;
777       uLastDispenseMsg := Piece(x, U, 1);
778       uLastQuantityMsg := Piece(x, U, 2);
779       Result := uLastQuantityMsg;
780     end;
781   end;
782   
783   function RequiresCopay(DispenseDrug: Integer): Boolean;
784   begin
785     Result := sCallV('ORWDPS32 SCSTS', [Patient.DFN, DispenseDrug]) = '1';
786   end;
787   
788   procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
789   begin
790     CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
791     FastAssign(RPCBrokerV.Results, AList);
792   end;
793   
794   procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
795   var
796     x: string;
797   begin
798     x := sCallV('ORWDPS32 VALROUTE', [AName]);
799     ID := Piece(x, U, 1);
800     Abbreviation := Piece(x, U, 2);
801   end;
802   
803   function MedIsSupply(AnIEN: Integer): Boolean;
804   begin
805     Result := sCallV('ORWDPS32 ISSPLY', [AnIEN]) = '1';
806   end;
807   
808   function MedTypeIsIV(AnIEN: Integer): Boolean;
809   begin
810     Result := sCallV('ORWDPS32 MEDISIV', [AnIEN]) = '1';
811   end;
812   
813   function ODForMedIn: TStrings;
814   { Returns init values for inpatient meds dialog.  The results must be used immediately. }
815   begin
816     CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE, patient.dfn, patient.location]);
817     Result := RPCBrokerV.Results;
818   end;
819   
820   function ODForIVFluids: TStrings;
821   { Returns init values for IV Fluids dialog.  The results must be used immediately. }
822   begin
823     CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS, patient.dfn, patient.location]);
824     Result := RPCBrokerV.Results;
825   end;
826   
827   function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
828   begin
829     Result := sCallV('ORWDPS32 IVAMT', [AnIEN, FluidType]);
830   end;
831   
832   function ODForMedOut: TStrings;
833   { Returns init values for outpatient meds dialog.  The results must be used immediately. }
834   begin
835     CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT, patient.dfn, patient.location]);
836     Result := RPCBrokerV.Results;
837   end;
838   
839   function OIForMedIn(AnIEN: Integer): TStrings;
840   { Returns init values for inpatient meds order item.  The results must be used immediately. }
841   begin
842     CallV('ORWDPS32 OISLCT', [AnIEN, PST_UNIT_DOSE, Patient.DFN]);
843     Result := RPCBrokerV.Results;
844   end;
845   
846   function OIForMedOut(AnIEN: Integer): TStrings;
847   { Returns init values for outpatient meds order item.  The results must be used immediately. }
848   begin
849     CallV('ORWDPS32 OISLCT', [AnIEN, PST_OUTPATIENT, Patient.DFN]);
850     Result := RPCBrokerV.Results;
851   end;
852   
853   function RatedDisabilities: string;
854   { Returns a list of rated disabilities, if any, for a patient }
855   begin
856     CallV('ORWPCE SCDIS', [Patient.DFN]);
857     Result := RPCBrokerV.Results.Text;
858   end;
859   
860   procedure ValidateIVRate(var x: string);
861   begin
862     x := sCallV('ORWDPS32 VALRATE', [x]);
863   end;
864   
865   //function ValidIVRate(const x: string): Boolean;
866   //{ returns true if the text entered as the IV rate is valid }
867   //begin
868   //  Result := sCallV('ORWDPS32 VALRATE', [x]) = '1';
869   //end;
870   
871   function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
872   { returns 1 if schedule is valid, 0 if schedule is not valid, -1 pharmacy routine not there }
873   begin
874     Result := StrToIntDef(sCallV('ORWDPS32 VALSCH', [x, PSType]), -1);
875   end;
876   
877   function ValidQuantity(const x: string): Boolean;
878   { returns true if the text entered as the quantity is valid }
879   begin
880     Result := sCallV('ORWDPS32 VALQTY', [Trim(x)]) = '1';
881   end;
882   
883   function ODForVitals: TStrings;
884   { Returns init values for vitals dialog.  The results must be used immediately. }
885   begin
886     CallV('ORWDOR VMSLCT', [nil]);
887     Result := RPCBrokerV.Results;
888   end;
889   
890   initialization
891     uLastDispenseIEN := 0;
892     uLastDispenseMsg := '';
893   
894   finalization
895     if uMedRoutes <> nil then uMedRoutes.Free;
896   
897   end.

Module Calls (2 levels)


rODBase
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├uConst
 ├rOrders...
 ├uOrders...
 ├uODBase
 │ ├uConst
 │ ├dShared
 │ ├rTemplates
 │ ├fOrders
 │ └rOrders...
 └fODBase
   ├fAutoSz
   ├uConst
   ├rOrders...
   ├rODBase...
   ├uCore...
   ├UBAGlobals
   ├UBACore
   ├fOCAccept
   ├uODBase...
   ├rCore...
   ├rMisc
   ├fTemplateDialog
   ├uEventHooks
   ├uTemplates
   ├rConsults...
   ├fOrders...
   ├uOrders...
   ├fFrame
   ├fODDietLT
   └rODDiet

Module Called-By (2 levels)


                      rODBase
                    uOrders┤ 
                    uCore┤ │ 
                  fODBase┤ │ 
               rODBase...┤ │ 
                   fFrame┤ │ 
                  fOrders┤ │ 
              fOrdersSign┤ │ 
                    fMeds┤ │ 
                fARTAllgy┤ │ 
                   fNotes┤ │ 
                fConsults┤ │ 
          fReminderDialog┤ │ 
                  fReview┤ │ 
             fOrdersRenew┤ │ 
                fOrdersCV┤ │ 
                  fODMeds┤ │ 
                  fOMNavA┤ │ 
          fOrderSaveQuick┤ │ 
                   fOMSet┤ │ 
           fOrdersRelease┤ │ 
                  fOMHTML┤ │ 
                fODMedNVA┤ │ 
 fODChangeUnreleasedRenew┤ │ 
           fOrdersOnChart┤ │ 
          fODReleaseEvent┤ │ 
                fODActive┘ │ 
                 fODBase...┤ 
                 uTemplates┤ 
               fODBase...┤ │ 
                  dShared┤ │ 
                 fDrawers┤ │ 
          fTemplateDialog┤ │ 
                fNotes...┤ │ 
             fConsults...┤ │ 
                  fDCSumm┤ │ 
          fTemplateEditor┤ │ 
       fReminderDialog...┤ │ 
                 fSurgery┤ │ 
               fODConsult┤ │ 
                  fODProc┤ │ 
                  fODAuto┤ │ 
        fFindingTemplates┤ │ 
         fTemplateObjects┤ │ 
         fTemplateAutoGen┘ │ 
                   fMeds...┤ 
                  fODDietLT┤ 
               fODBase...┤ │ 
                  fODDiet┘ │ 
                 fODDiet...┤ 
                    fODMisc┤ 
               uOrders...┘ │ 
                     fODGen┤ 
               uOrders...┘ │ 
                   fODMedIn┤ 
               uOrders...┘ │ 
                   fODMedFA┤ 
              fODMedIn...┤ │ 
                fODMedOut┘ │ 
               fODMedOut...┤ 
              fODMedComplex┤ 
             fODMedOut...┘ │ 
              fODConsult...┤ 
                 fODProc...┤ 
                     fODRad┤ 
               uOrders...┘ │ 
                     fODLab┤ 
               uOrders...┤ │ 
        fODLabOthCollSamp┘ │ 
                   fODBBank┤ 
               uOrders...┘ │ 
                 fODMeds...┤ 
                   fODMedIV┤ 
               uOrders...┘ │ 
                  fODVitals┤ 
               uOrders...┘ │ 
                 fODAuto...┤ 
                 fOMNavA...┤ 
         fOrderSaveQuick...┤ 
               fODMedNVA...┤ 
fODChangeUnreleasedRenew...┤ 
               fRenewOutMed┘ 
          fOrdersRenew...┘