source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rOrders.~pas@ 1156

Last change on this file since 1156 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 80.9 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rOrders;
3{$OPTIMIZATION OFF}
4interface
5
6uses SysUtils, Classes, ORFn, ORNet, uCore, Dialogs, Controls;
7
8type
9 TOrder = class
10 public
11 ICD9Code: string;
12 ID: string;
13 DGroup: Integer;
14 OrderTime: TFMDateTime;
15 StartTime: string;
16 StopTime: string;
17 Status: Integer;
18 Signature: Integer;
19 VerNurse: string;
20 VerClerk: string;
21 ChartRev: string;
22 Provider: Int64;
23 ProviderName: string;
24 ProviderDEA: string;
25 ProviderVa: string;
26 DigSigReq: string;
27 XMLText: string;
28 Text: string;
29 DGroupSeq: Integer;
30 DGroupName: string;
31 Flagged: Boolean;
32 Retrieved: Boolean;
33 EditOf: string;
34 ActionOn: string;
35 EventPtr: string; //ptr to #100.2
36 EventName: string; //Event name in #100.5
37 OrderLocIEN: string; //imo
38 OrderLocName: string; //imo
39 ParentID : string;
40 LinkObject: TObject;
41 EnteredInError: Integer; //AGP Changes 26.12 PSI-04-053
42 procedure Assign(Source: TOrder);
43 procedure Clear;
44 end;
45
46 TParentEvent = class
47 public
48 ParentIFN: integer;
49 ParentName: string;
50 ParentType: Char;
51 ParentDlg: string;
52 constructor Create;
53 procedure Assign(AnEvtID: string);
54 end;
55
56 TOrderDelayEvent = record
57 EventType: Char; // A=admit, T=transfer, D=discharge, C=current
58 TheParent: TParentEvent; // Parent Event
59 EventIFN : Integer; // Pointer to OE/RR EVENTS file (#100.5)
60 EventName: String; // Event name from OR/RR EVENTS file (#100.5)
61 PtEventIFN: Integer; // Patient event IFN ptr to #100.2
62 Specialty: Integer; // pointer to facility treating specialty file
63 Effective: TFMDateTime; // effective date/time (estimated start time)
64 IsNewEvent: Boolean; // is new event for an patient
65 end;
66
67 TOrderDialogResolved = record
68 InputID: string; // can be dialog IEN or '#ORIFN'
69 QuickLevel: Integer; // 0=dialog,1=auto,2=verify,8=reject,9=cancel
70 ResponseID: string; // DialogID + ';' + $H
71 DialogIEN: Integer; // pointer to 101.41 for dialog (may be quick order IEN)
72 DialogType: Char; // type of dialog (Q or D)
73 FormID: Integer; // windows form to display
74 DisplayGroup: Integer; // pointer to 100.98, display group for dialog
75 ShowText: string; // text to show for verify or rejection
76 QOKeyVars: string; // from entry action of quick order
77 end;
78
79 TNextMoveRec = record
80 NextStep: Integer;
81 LastIndex: Integer;
82 end;
83
84 TOrderMenu = class
85 IEN: Integer;
86 NumCols: Integer;
87 Title: string;
88 KeyVars: string;
89 MenuItems: TList; {of TOrderMenuItem}
90 end;
91
92 TOrderMenuItem = class
93 IEN: Integer;
94 Row: Integer;
95 Col: Integer;
96 DlgType: Char;
97 FormID: Integer;
98 AutoAck: Boolean;
99 ItemText: string;
100 Mnemonic: string;
101 Display: Integer;
102 Selected: Boolean;
103 end;
104
105 TSelectedOrder = class
106 public
107 Position: Integer;
108 Order: TOrder;
109 end;
110
111 TOrderRenewFields = class
112 public
113 BaseType: Integer;
114 StartTime: string;
115 StopTime: string;
116 Refills: Integer;
117 Pickup: string;
118 Comments: string;
119 NewText: string;
120 end;
121
122 TPrintParams = record
123 PromptForChartCopy : char;
124 ChartCopyDevice : string;
125 PromptForLabels : char;
126 LabelDevice : string;
127 PromptForRequisitions : char;
128 RequisitionDevice : string;
129 PromptForWorkCopy : char;
130 WorkCopyDevice : string;
131 AnyPrompts : boolean;
132// OrdersToPrint : TStringList; {*KCM*}
133 end;
134
135 TOrderView = class
136 Changed: Boolean; // true when view has been modified
137 DGroup: Integer; // display group (pointer value)
138 Filter: Integer; // FLGS parameter passed to ORQ
139 InvChrono: Boolean; // true for inverse chronological order
140 ByService: Boolean; // true for grouping orders by service
141 TimeFrom: TFMDateTime; // beginning time for orders in list
142 TimeThru: TFMDateTime; // ending time for orders in list
143 CtxtTime: TFMDateTime; // set by server, context hours begin time
144 TextView: Integer; // set by server, 0 if mult views of same order
145 ViewName: string; // display name for the view
146 EventDelay: TOrderDelayEvent; // fields for event delay view
147 public
148 procedure Assign(Src: TOrderView);
149
150 end;
151
152{ Order List functions }
153function DetailOrder(const ID: string): TStrings;
154function ResultOrder(const ID: string): TStrings;
155function ResultOrderHistory(const ID: string): TStrings;
156function NameOfStatus(IEN: Integer): string;
157function GetOrderStatus(AnOrderId: string): integer;
158function ExpiredOrdersStartDT: TFMDateTime;
159procedure ClearOrders(AList: TList);
160procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
161procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string); overload;
162procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string); overload;
163procedure LoadOrderSheets(Dest: TStrings);
164procedure LoadOrderSheetsED(Dest: TStrings);
165procedure LoadOrderViewDefault(AView: TOrderView);
166procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
167procedure SaveOrderViewDefault(AView: TOrderView);
168procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
169procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
170procedure SetOrderFromResults(AnOrder: TOrder);
171procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
172
173{ Display Group & List functions }
174function DGroupAll: Integer;
175function DGroupIEN(AName: string): Integer;
176procedure ListDGroupAll(Dest: TStrings);
177procedure ListSpecialties(Dest: TStrings);
178procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
179procedure ListOrderFilters(Dest: TStrings);
180procedure ListOrderFiltersAll(Dest: TStrings);
181function NameOfDGroup(IEN: Integer): string;
182function ShortNameOfDGroup(IEN: Integer): string;
183function SeqOfDGroup(IEN: Integer): Integer;
184function CheckOrderGroup(AOrderID: string): integer;
185function CheckQOGroup(AQOId:string): Boolean;
186
187{ Write Orders }
188procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
189 AnEvent: TOrderDelayEvent; ForIMO: boolean = False);
190procedure ClearOrderRecall;
191function CommonLocationForOrders(OrderList: TStringList): Integer;
192function FormIDForDialog(IEN: Integer): Integer;
193function DlgIENForName(DlgName: string): Integer;
194procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
195procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
196procedure LoadWriteOrders(Dest: TStrings);
197procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
198function OrderDisabledMessage(DlgIEN: Integer): string;
199procedure SendOrders(OrderList: TStringList; const ESCode: string);
200procedure SendReleaseOrders(OrderList: TStringList);
201procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
202procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
203procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string); {*KCM*}
204procedure PrintServiceCopies(OrderList: TStringList); {*REV*}
205procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char); {*KCM*}
206function UseNewMedDialogs: Boolean;
207
208{ Order Actions }
209function DialogForOrder(const ID: string): Integer;
210procedure LockPatient(var ErrMsg: string);
211procedure UnlockPatient;
212procedure LockOrder(OrderID: string; var ErrMsg: string);
213procedure UnlockOrder(OrderID: string);
214function FormIDForOrder(const ID: string): Integer;
215procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
216procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
217procedure IsLatestAction(const ID: string; var ErrList: TStringList);
218procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
219procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer;
220 AnIMOOrderAppt: double; OCList: TStringList);
221procedure HoldOrder(AnOrder: TOrder);
222procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
223function GetREQReason: Integer;
224procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
225procedure ReleaseOrderHold(AnOrder: TOrder);
226procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
227procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
228procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
229procedure LoadFlagReason(Dest: TStrings; const ID: string);
230procedure LoadWardComments(Dest: TStrings; const ID: string);
231procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
232procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
233procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
234procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
235function GetOrderableIen(AnOrderId:string): integer;
236procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
237procedure UpdateOrderDGIfNeeded(AnID: string);
238function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
239function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
240procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
241//function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
242
243{ Order Information }
244procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
245procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
246procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
247procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
248function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
249function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
250function GetDlgData(ADlgID: string): string;
251function OrderIsReleased(const ID: string): Boolean;
252function TextForOrder(const ID: string): string;
253function GetConsultOrderNumber(ConsultIEN: string): string;
254function GetOrderByIFN(const ID: string): TOrder;
255function GetPackageByOrderID(const OrderID: string): string;
256function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
257function OrderRequiresSignature(const ID: string): Boolean;
258function OrderRequiresDigitalSignature(const ID: string): Boolean;
259function GetDrugSchedule(const ID: string): string;
260function GetExternalText(const ID: string): string;
261function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
262function GetDEA(const ID: string): string;
263function GetDigitalSignature(const ID: string): string;
264function GetPKIUse: Boolean;
265function GetPKISite: Boolean;
266function DoesOIPIInSigForQO(AnQOID: integer): integer;
267function GetDispGroupForLES: string;
268function GetOrderPtEvtID(AnOrderID: string): string;
269function VerbTelPolicyOrder(AnOrderID: string): boolean;
270function ForIVandUD(AnOrderID: string): boolean;
271
272{Event Delay Enhancement}
273function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean = True): boolean;
274function DispOrdersForEvent(AEvtId: string): boolean;
275function EventInfo(APtEvtID: string): string; // ptr to #100.2
276function EventInfo1(AnEvtID: string): string; // ptr to #100.5
277function EventExist(APtDFN:string; AEvt: integer): integer;
278function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean = True): boolean;
279function PtEvtEmpty(APtEvtID: string): Boolean;
280function GetEventIFN(const AEvntID: string): string;
281function GetEventName(const AEvntID: string): string;
282function GetEventLoc(const APtEvntID: string): string;
283function GetEventLoc1(const AnEvntID: string): string;
284function GetEventDiv(const APtEvntID: string): string;
285function GetEventDiv1(const AnEvntID: string): string;
286function GetCurrentSpec(const APtIFN: string): string;
287function GetDefaultEvt(const AProviderIFN: string): string;
288function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
289function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
290function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs: string): Boolean;
291function isDCedOrder(const AnOrderID: string): Boolean;
292function isOnholdMedOrder(AnOrderID: string): Boolean;
293function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
294function GetEventPromptID: integer;
295function GetDefaultTSForEvt(AnEvtID: integer): string;
296function GetPromptIDs: string;
297function GetEventDefaultDlg(AEvtID: integer): string;
298function CanManualRelease: boolean;
299function TheParentPtEvt(APtEvt: string): string;
300function IsCompletedPtEvt(APtEvtID: integer): boolean;
301function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
302function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
303procedure DeleteDefaultEvt;
304procedure TerminatePtEvt(APtEvtID: integer);
305procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
306procedure DeletePtEvent(APtEvtID: string);
307procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
308procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: integer);
309procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
310procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
311
312{ Order Checking }
313function FillerIDForDialog(IEN: Integer): string;
314function OrderChecksEnabled: Boolean;
315function OrderChecksOnDisplay(const FillerID: string): string;
316procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
317 OIList: TStringList; DupORIFN: string);
318procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
319 OIList: TStringList);
320procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
321procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
322function DeleteCheckedOrder(const OrderID: string): Boolean;
323function DataForOrderCheck(const OrderID: string): string;
324
325{ Copay }
326procedure GetCoPay4Orders;
327procedure SaveCoPayStatus(AList: TStrings);
328
329{IMO: inpatient medication for outpatient}
330function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
331function IsIMOOrder(OrderID: string): boolean;
332function IsInptQO(DlgID: integer): boolean;
333function IsIVQO(DlgID: integer): boolean;
334function IsClinicLoc(ALoc: integer): boolean;
335
336{None-standard Schedule} //nss
337function IsValidSchedule(AnOrderID: string): boolean; //NSS
338function IsValidQOSch(QOID: string): string; //NSS
339function IsValidSchStr(ASchStr: string): boolean;
340
341implementation
342
343uses Windows, rCore, uConst, TRPCB, ORCtrls, UBAGlobals, UBACore
344 ,DKLang //kt
345 ;
346
347var
348 uDGroupMap: TStringList; // each string is DGroupIEN=Sequence^TopName^Name
349 uDGroupAll: Integer;
350 uOrderChecksOn: Char;
351
352{ TOrderView methods }
353
354procedure TOrderView.Assign(Src: TOrderView);
355begin
356 Self.Changed := Src.Changed;
357 Self.DGroup := Src.DGroup;
358 Self.Filter := Src.Filter;
359 Self.InvChrono := Src.InvChrono;
360 Self.ByService := Src.ByService;
361 Self.TimeFrom := Src.TimeFrom;
362 Self.TimeThru := Src.TimeThru;
363 Self.CtxtTime := Src.CtxtTime;
364 Self.TextView := Src.TextView;
365 Self.ViewName := Src.ViewName;
366 Self.EventDelay.EventIFN := Src.EventDelay.EventIFN;
367 Self.EventDelay.EventName := Src.EventDelay.EventName;
368 Self.EventDelay.EventType := Src.EventDelay.EventType;
369 Self.EventDelay.Specialty := Src.EventDelay.Specialty;
370 Self.EventDelay.Effective := Src.EventDelay.Effective;
371end;
372
373{ TOrder methods }
374
375procedure TOrder.Assign(Source: TOrder);
376begin
377 ID := Source.ID;
378 DGroup := Source.DGroup;
379 OrderTime := Source.OrderTime;
380 StartTime := Source.StartTime;
381 StopTime := Source.StopTime;
382 Status := Source.Status;
383 Signature := Source.Signature;
384 VerNurse := Source.VerNurse;
385 VerClerk := Source.VerClerk;
386 ChartRev := Source.ChartRev;
387 Provider := Source.Provider;
388 ProviderName := Source.ProviderName;
389 ProviderDEA := Source.ProviderDEA;
390 ProviderVA := Source.ProviderVA;
391 DigSigReq := Source.DigSigReq;
392 XMLText := Source.XMLText;
393 Text := Source.Text;
394 DGroupSeq := Source.DGroupSeq;
395 DGroupName := Source.DGroupName;
396 Flagged := Source.Flagged;
397 Retrieved := Source.Retrieved;
398 EditOf := Source.EditOf;
399 ActionOn := Source.ActionOn;
400 EventPtr := Source.EventPtr;
401 EventName := Source.EventName;
402 OrderLocIEN := Source.OrderLocIEN;
403 OrderLocName := Source.OrderLocName;
404 ParentID := Source.ParentID;
405 LinkObject := Source.LinkObject;
406end;
407
408procedure TOrder.Clear;
409begin
410 ID := '';
411 DGroup := 0;
412 OrderTime := 0;
413 StartTime := '';
414 StopTime := '';
415 Status := 0;
416 Signature := 0;
417 VerNurse := '';
418 VerClerk := '';
419 ChartRev := '';
420 Provider := 0;
421 ProviderName := '';
422 ProviderDEA := '';
423 ProviderVA :='';
424 DigSigReq :='';
425 XMLText := '';
426 Text := '';
427 DGroupSeq := 0;
428 DGroupName := '';
429 Flagged := False;
430 Retrieved := False;
431 EditOf := '';
432 ActionOn := '';
433 OrderLocIEN := ''; //imo
434 OrderLocName := ''; //imo
435 ParentID := '';
436 LinkObject := nil;
437end;
438
439{ Order List functions }
440
441function DetailOrder(const ID: string): TStrings;
442begin
443 CallV('ORQOR DETAIL', [ID, Patient.DFN]);
444 Result := RPCBrokerV.Results;
445end;
446
447function ResultOrder(const ID: string): TStrings;
448begin
449 CallV('ORWOR RESULT', [Patient.DFN,ID,ID]);
450 Result := RPCBrokerV.Results;
451end;
452
453function ResultOrderHistory(const ID: string): TStrings;
454begin
455 CallV('ORWOR RESULT HISTORY', [Patient.DFN,ID,ID]);
456 Result := RPCBrokerV.Results;
457end;
458
459procedure LoadDGroupMap;
460begin
461 if uDGroupMap = nil then
462 begin
463 uDGroupMap := TStringList.Create;
464 tCallV(uDGroupMap, 'ORWORDG MAPSEQ', [nil]);
465 end;
466end;
467
468function NameOfStatus(IEN: Integer): string;
469begin
470 case IEN of
471// 0: Result := 'error'; <-- original line. //kt 8/8/2007
472 0: Result := DKLangConstW('rOrders_error'); //kt added 8/8/2007
473// 1: Result := 'discontinued'; <-- original line. //kt 8/8/2007
474 1: Result := DKLangConstW('rOrders_discontinued'); //kt added 8/8/2007
475// 2: Result := 'complete'; <-- original line. //kt 8/8/2007
476 2: Result := DKLangConstW('rOrders_complete'); //kt added 8/8/2007
477// 3: Result := 'hold'; <-- original line. //kt 8/8/2007
478 3: Result := DKLangConstW('rOrders_hold'); //kt added 8/8/2007
479// 4: Result := 'flagged'; <-- original line. //kt 8/8/2007
480 4: Result := DKLangConstW('rOrders_flagged'); //kt added 8/8/2007
481// 5: Result := 'pending'; <-- original line. //kt 8/8/2007
482 5: Result := DKLangConstW('rOrders_pending'); //kt added 8/8/2007
483// 6: Result := 'active'; <-- original line. //kt 8/8/2007
484 6: Result := DKLangConstW('rOrders_active'); //kt added 8/8/2007
485// 7: Result := 'expired'; <-- original line. //kt 8/8/2007
486 7: Result := DKLangConstW('rOrders_expired'); //kt added 8/8/2007
487// 8: Result := 'scheduled'; <-- original line. //kt 8/8/2007
488 8: Result := DKLangConstW('rOrders_scheduled'); //kt added 8/8/2007
489// 9: Result := 'partial results'; <-- original line. //kt 8/8/2007
490 9: Result := DKLangConstW('rOrders_partial_results'); //kt added 8/8/2007
491// 10: Result := 'delayed'; <-- original line. //kt 8/8/2007
492 10: Result := DKLangConstW('rOrders_delayed'); //kt added 8/8/2007
493// 11: Result := 'unreleased'; <-- original line. //kt 8/8/2007
494 11: Result := DKLangConstW('rOrders_unreleased'); //kt added 8/8/2007
495// 12: Result := 'dc/edit'; <-- original line. //kt 8/8/2007
496 12: Result := DKLangConstW('rOrders_dcxedit'); //kt added 8/8/2007
497// 13: Result := 'cancelled'; <-- original line. //kt 8/8/2007
498 13: Result := DKLangConstW('rOrders_cancelled'); //kt added 8/8/2007
499// 14: Result := 'lapsed'; <-- original line. //kt 8/8/2007
500 14: Result := DKLangConstW('rOrders_lapsed'); //kt added 8/8/2007
501// 15: Result := 'renewed'; <-- original line. //kt 8/8/2007
502 15: Result := DKLangConstW('rOrders_renewed'); //kt added 8/8/2007
503// 97: Result := ''; { null status, used for 'No Orders Found.' } <-- original line. //kt 8/8/2007
504 97: Result := ''; { null status, used for DKLangConstW('rOrders_No_Orders_Foundx') } //kt added 8/8/2007
505// 98: Result := 'new'; <-- original line. //kt 8/8/2007
506 98: Result := DKLangConstW('rOrders_new'); //kt added 8/8/2007
507// 99: Result := 'no status'; <-- original line. //kt 8/8/2007
508 99: Result := DKLangConstW('rOrders_no_status'); //kt added 8/8/2007
509 end;
510end;
511
512function GetOrderStatus(AnOrderId: string): integer;
513begin
514 Result := StrToIntDef(SCallV('OREVNTX1 GETSTS',[AnOrderId]),0);
515end;
516
517function ExpiredOrdersStartDT: TFMDateTime;
518//Return FM date/time to begin search for expired orders
519begin
520 Result := MakeFMDateTime(sCallV('ORWOR EXPIRED', [nil]));
521end;
522
523function DispOrdersForEvent(AEvtId: string): boolean;
524var
525 theResult: integer;
526begin
527 Result := False;
528 theResult := StrToIntDef(SCallV('OREVNTX1 CPACT',[AEvtId]),0);
529 if theResult > 0 then
530 Result := True;
531end;
532
533function EventInfo(APtEvtID: string): string;
534begin
535 Result := SCallV('OREVNTX1 GTEVT', [APtEvtID]);
536end;
537
538function EventInfo1(AnEvtID: string): string;
539begin
540 Result := SCallV('OREVNTX1 GTEVT1', [AnEvtID]);
541end;
542
543function NameOfDGroup(IEN: Integer): string;
544begin
545 if uDGroupMap = nil then LoadDGroupMap;
546 Result := uDGroupMap.Values[IntToStr(IEN)];
547 Result := Piece(Result, U, 3);
548end;
549
550function ShortNameOfDGroup(IEN: Integer): string;
551begin
552 if uDGroupMap = nil then LoadDGroupMap;
553 Result := uDGroupMap.Values[IntToStr(IEN)];
554 Result := Piece(Result, U, 4);
555end;
556
557function SeqOfDGroup(IEN: Integer): Integer;
558var
559 x: string;
560begin
561 if uDGroupMap = nil then LoadDGroupMap;
562 x := uDGroupMap.Values[IntToStr(IEN)];
563 Result := StrToIntDef(Piece(x, U, 1), 0);
564end;
565
566function CheckOrderGroup(AOrderID: string): integer;
567begin
568 // Result = 1 Inpatient Medication Display Group;
569 // Result = 2 OutPatient Medication Display Group;
570 // Result = 0 None of In or Out patient display group;
571 Result := StrToInt(SCallV('ORWDPS2 CHKGRP',[AOrderID]));
572end;
573
574function CheckQOGroup(AQOId:string): Boolean;
575var
576 rst: integer;
577begin
578 rst := StrToInt(SCallV('ORWDPS2 QOGRP',[AQOId]));
579 Result := False;
580 if rst > 0 then
581 Result := True;
582end;
583
584function TopNameOfDGroup(IEN: Integer): string;
585begin
586 if uDGroupMap = nil then LoadDGroupMap;
587 Result := uDGroupMap.Values[IntToStr(IEN)];
588 Result := Piece(Result, U, 2);
589end;
590
591procedure ClearOrders(AList: TList);
592var
593 i: Integer;
594begin
595 with AList do for i := 0 to Count - 1 do with TOrder(Items[i]) do Free;
596 AList.Clear;
597end;
598
599procedure SetOrderFields(AnOrder: TOrder; const x, y, z: string);
600{ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
601{ Pieces: ~IFN^Grp^ActTm^StrtTm^StopTm^Sts^Sig^Nrs^Clk^PrvID^PrvNam^ActDA^Flag^DCType^ChrtRev^DEA#^VA#^DigSig}
602begin
603 with AnOrder do
604 begin
605 Clear;
606 ID := Copy(Piece(x, U, 1), 2, Length(Piece(x, U, 1)));
607 DGroup := StrToIntDef(Piece(x, U, 2), 0);
608 OrderTime := MakeFMDateTime(Piece(x, U, 3));
609 StartTime := Piece(x, U, 4);
610 StopTime := Piece(x, U, 5);
611 Status := StrToIntDef(Piece(x, U, 6), 0);
612 Signature := StrToIntDef(Piece(x, U, 7), 0);
613 VerNurse := Piece(x, U, 8);
614 VerClerk := Piece(x, U, 9);
615 ChartRev := Piece(x, U, 15);
616 Provider := StrToInt64Def(Piece(x, U, 10), 0);
617 ProviderName := Piece(x, U, 11);
618 ProviderDEA := Piece(x, U, 16);
619 ProviderVA := Piece(x, U, 17);
620 DigSigReq := Piece(x, U, 18);
621 Flagged := Piece(x, U, 13) = '1';
622 Retrieved := True;
623 OrderLocIEN := Piece(Piece(x,U,19),':',2); //imo
624 OrderLocName := Piece(Piece(x,U,19),':',1); //imo
625 Text := y;
626 XMLText := z;
627 DGroupSeq := SeqOfDGroup(DGroup);
628 DGroupName := TopNameOfDGroup(DGroup);
629 //AGP Changes 26.15 PSI-04-063
630// if (pos('Entered in error',Text)>0) then AnOrder.EnteredInError := 1 <-- original line. //kt 8/8/2007
631 if (pos(DKLangConstW('rOrders_Entered_in_error'),Text)>0) then AnOrder.EnteredInError := 1 //kt added 8/8/2007
632 else AnOrder.EnteredInError := 0;
633 //if DGroupName = 'Non-VA Meds' then Text := 'Non-VA ' + Text;
634 end;
635end;
636
637procedure LoadOrders(Dest: TList; Filter, Groups: Integer);
638var
639 x, y, z: string;
640 AnOrder: TOrder;
641begin
642 ClearOrders(Dest);
643 if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results
644 CallV('ORWORR GET', [Patient.DFN, Filter, Groups]);
645 with RPCBrokerV do while Results.Count > 0 do
646 begin
647 x := Results[0];
648 Results.Delete(0);
649 if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
650 y := '';
651 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
652 begin
653 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
654 Results.Delete(0);
655 end;
656 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
657 z := '';
658 if (Results.Count > 0) and (Results[0] = '|') then
659 begin
660 Results.Delete(0);
661 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
662 begin
663 z := z + Copy(Results[0], 2, Length(Results[0]));
664 Results.Delete(0);
665 end;
666 end;
667 AnOrder := TOrder.Create;
668 SetOrderFields(AnOrder, x, y, z);
669 Dest.Add(AnOrder);
670 end;
671end;
672
673procedure LoadOrdersAbbr(Dest: TList; AView: TOrderView; APtEvtID: string);
674//Filter, Specialty, Groups: Integer; var TextView: Integer;
675// var CtxtTime: TFMDateTime);
676var
677 i: Integer;
678 AnOrder: TOrder;
679 FilterTS: string;
680begin
681 ClearOrders(Dest);
682 if uDGroupMap = nil then LoadDGroupMap; // to make sure broker not called while looping thru Results
683 FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
684 CallV('ORWORR AGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
685 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)
686 begin
687 CallV('ORWORR AGET', [Patient.DFN, '27^0', AView.DGroup, ExpiredOrdersStartDT, FMNow, APtEvtID]);
688// AView.ViewName := 'Recently Expired Orders (No Expiring Orders Found) -' + Piece(AView.ViewName, '-', 2); <-- original line. //kt 8/8/2007
689 AView.ViewName := DKLangConstW('rOrders_Recently_Expired_Orders_xNo_Expiring_Orders_Foundx_x') + Piece(AView.ViewName, '-', 2); //kt added 8/8/2007
690 end;
691 {if (Piece(RPCBrokerV.Results[0], U, 1) = '0') or (Piece(RPCBrokerV.Results[0], U, 1) = '') then // if no orders found (0 element is count)
692 begin
693 AnOrder := TOrder.Create;
694 with AnOrder do
695 begin
696 ID := '0';
697 DGroup := 0;
698 OrderTime := FMNow;
699 Status := 97;
700// Text := 'No orders found.'; <-- original line. //kt 8/8/2007
701 Text := DKLangConstW('rOrders_No_orders_foundx'); //kt added 8/8/2007
702 Retrieved := True;
703 end;
704 Dest.Add(AnOrder);
705 Exit;
706 end;}
707 AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
708 AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3));
709 with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element)
710 begin
711 if (Piece(RPCBrokerV.Results[i], U, 1) = '0') or (Piece(RPCBrokerV.Results[i], U, 1) = '') then Continue;
712 if (DelimCount(Results[i],U) = 2) then Continue;
713 AnOrder := TOrder.Create;
714 with AnOrder do
715 begin
716 ID := Piece(Results[i], U, 1);
717 DGroup := StrToIntDef(Piece(Results[i], U, 2), 0);
718 OrderTime := MakeFMDateTime(Piece(Results[i], U, 3));
719 EventPtr := Piece(Results[i],U,4);
720 EventName := Piece(Results[i],U,5);
721 DGroupSeq := SeqOfDGroup(DGroup);
722 end;
723 Dest.Add(AnOrder);
724 end;
725end;
726
727procedure LoadOrdersAbbr(DestDC,DestRL: TList; AView: TOrderView; APtEvtID: string);
728var
729 i: Integer;
730 AnOrder: TOrder;
731 FilterTS: string;
732 DCStart: boolean;
733begin
734 DCStart := False;
735 if uDGroupMap = nil then LoadDGroupMap;
736 FilterTS := IntToStr(AView.Filter) + U + IntToStr(AView.EventDelay.Specialty);
737 CallV('ORWORR RGET', [Patient.DFN, FilterTS, AView.DGroup, AView.TimeFrom, AView.TimeThru, APtEvtID]);
738 if RPCBrokerV.Results[0] = '0' then // if no orders found (0 element is count)
739 begin
740 AnOrder := TOrder.Create;
741 with AnOrder do
742 begin
743 ID := '0';
744 DGroup := 0;
745 OrderTime := FMNow;
746 Status := 97;
747// Text := 'No orders found.'; <-- original line. //kt 8/8/2007
748 Text := DKLangConstW('rOrders_No_orders_foundx'); //kt added 8/8/2007
749 Retrieved := True;
750 end;
751 DestDC.Add(AnOrder);
752 Exit;
753 end;
754 AView.TextView := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 2), 0);
755 AView.CtxtTime := MakeFMDateTime(Piece(RPCBrokerV.Results[0], U, 3));
756 with RPCBrokerV do for i := 1 to Results.Count - 1 do // if orders found (skip 0 element)
757 begin
758 if AnsiCompareText('DC START', Results[i]) = 0 then
759 begin
760 DCStart := True;
761 Continue;
762 end;
763 AnOrder := TOrder.Create;
764 with AnOrder do
765 begin
766 ID := Piece(Results[i], U, 1);
767 DGroup := StrToIntDef(Piece(Results[i], U, 2), 0);
768 OrderTime := MakeFMDateTime(Piece(Results[i], U, 3));
769 EventPtr := Piece(Results[i],U,4);
770 EventName := Piece(Results[i],U,5);
771 DGroupSeq := SeqOfDGroup(DGroup);
772 end;
773 if DCStart then
774 DestDC.Add(AnOrder)
775 else
776 DestRL.Add(AnOrder);
777 end;
778end;
779
780procedure LoadOrderSheets(Dest: TStrings);
781begin
782 CallV('ORWOR SHEETS', [Patient.DFN]);
783 MixedCaseByPiece(RPCBrokerV.Results, U, 2);
784 Dest.Assign(RPCBrokerV.Results);
785end;
786
787procedure LoadOrderSheetsED(Dest: TStrings);
788var
789 i: integer;
790begin
791 CallV('OREVNTX PAT', [Patient.DFN]);
792 MixedCaseByPiece(RPCBrokerV.Results, U, 2);
793//Dest.Add('C;O^Current View'); <-- original line. //kt 8/8/2007
794 Dest.Add(DKLangConstW('rOrders_CxOxCurrent_View')); //kt added 8/8/2007
795 if RPCBrokerV.Results.Count > 1 then
796 begin
797 RPCBrokerV.Results.Delete(0);
798 for i := 0 to RPCbrokerV.Results.Count - 1 do
799// RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + ' Orders'; <-- original line. //kt 8/8/2007
800 RPCBrokerV.Results[i] := RPCBrokerV.Results[i] + DKLangConstW('rOrders_Orders'); //kt added 8/8/2007
801 Dest.AddStrings(RPCBrokerV.Results);
802 end;
803end;
804
805procedure LoadOrderViewDefault(AView: TOrderView);
806var
807 x: string;
808begin
809 x := sCallV('ORWOR VWGET', [nil]);
810 with AView do
811 begin
812 Changed := False;
813 DGroup := StrToIntDef(Piece(x, ';', 4), 0);
814 Filter := StrToIntDef(Piece(x, ';', 3), 0);
815 InvChrono := Piece(x, ';', 6) = 'R';
816 ByService := Piece(x, ';', 7) = '1';
817 TimeFrom := StrToFloat(Piece(x, ';', 1));
818 TimeThru := StrToFloat(Piece(x, ';', 2));
819 CtxtTime := 0;
820 TextView := 0;
821 ViewName := Piece(x, ';', 8);
822 EventDelay.EventType := 'C';
823 EventDelay.Specialty := 0;
824 EventDelay.Effective := 0;
825 end;
826end;
827
828procedure LoadUnsignedOrders(IDList, HaveList: TStrings);
829var
830 i: Integer;
831begin
832 with RPCBrokerV do
833 begin
834 ClearParameters := True;
835 RemoteProcedure := 'ORWOR UNSIGN';
836 Param[0].PType := literal;
837 Param[0].Value := Patient.DFN;
838 Param[1].PType := list;
839 Param[1].Mult['0'] := ''; // (to prevent broker from hanging if empty list)
840 for i := 0 to Pred(HaveList.Count) do Param[1].Mult['"' + HaveList[i] + '"'] := '';
841 CallBroker;
842 IDList.Assign(Results);
843 end;
844end;
845
846procedure RetrieveOrderFields(OrderList: TList; ATextView: Integer; ACtxtTime: TFMDateTime);
847var
848 i, OrderIndex: Integer;
849 x, y, z: string;
850 AnOrder: TOrder;
851 IDList: TStringList;
852begin
853 IDList := TStringList.Create;
854 try
855 with OrderList do for i := 0 to Count - 1 do IDList.Add(TOrder(Items[i]).ID);
856 CallV('ORWORR GET4LST', [ATextView, ACtxtTime, IDList]);
857 finally
858 IDList.Free;
859 end;
860 OrderIndex := -1;
861 with RPCBrokerV do while Results.Count > 0 do
862 begin
863 Inc(OrderIndex);
864 if (OrderIndex >= OrderList.Count) then
865 begin
866 Results.Delete(0);
867 Continue;
868 end;
869 AnOrder := TOrder(OrderList.Items[OrderIndex]);
870 x := Results[0];
871 Results.Delete(0);
872 if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
873 if Piece(x, U, 1) <> '~' + AnOrder.ID then Continue; // only happens if out of synch
874 y := '';
875 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
876 begin
877 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
878 Results.Delete(0);
879 end;
880 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
881 z := '';
882 if (Results.Count > 0) and (Results[0] = '|') then
883 begin
884 Results.Delete(0);
885 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
886 begin
887 z := z + Copy(Results[0], 2, Length(Results[0]));
888 Results.Delete(0);
889 end;
890 end;
891 SetOrderFields(AnOrder, x, y, z);
892 end;
893end;
894
895procedure SaveOrderViewDefault(AView: TOrderView);
896var
897 x: string;
898begin
899 with AView do
900 begin
901 x := MakeRelativeDateTime(TimeFrom) + ';' + // 1
902 MakeRelativeDateTime(TimeThru) + ';' + // 2
903 IntToStr(Filter) + ';' + // 3
904 IntToStr(DGroup) + ';;'; // 4, skip 5
905 if InvChrono then x := x + 'R;' else x := x + 'F;'; // 6
906 if ByService then x := x + '1' else x := x + '0'; // 7
907 CallV('ORWOR VWSET', [x]);
908 end;
909end;
910
911{ MOVE THESE FUNCTIONS INTO UORDERS??? }
912
913{ < 0 if Item1 is less and Item2, 0 if they are equal and > 0 if Item1 is greater than Item2 }
914function InverseByGroup(Item1, Item2: Pointer): Integer;
915var
916 Order1, Order2: TOrder;
917 DSeq1, DSeq2, IFN1, IFN2: Integer;
918begin
919 Order1 := TOrder(Item1);
920 Order2 := TOrder(Item2);
921 if ( (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID)) )
922 and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then
923 DSeq1 := 0
924 else DSeq1 := Order1.DGroupSeq;
925 if ((Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID)))
926 and ( StrToIntDef(Order1.EventPtr,0) = 0 ) then
927 DSeq2 := 0
928 else DSeq2 := Order2.DGroupSeq;
929 if DSeq1 = DSeq2 then
930 begin
931 if Order1.OrderTime > Order2.OrderTime then Result := -1
932 else if Order1.OrderTime < Order2.OrderTime then Result := 1
933 else Result := 0;
934 if Result = 0 then
935 begin
936 IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
937 IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
938 if IFN1 < IFN2 then Result := -1;
939 if IFN1 > IFN2 then Result := 1;
940 end;
941 end
942 else if DSeq1 < DSeq2 then Result := -1
943 else Result := 1;
944end;
945
946function ForwardByGroup(Item1, Item2: Pointer): Integer;
947var
948 Order1, Order2: TOrder;
949 DSeq1, DSeq2, IFN1, IFN2: Integer;
950begin
951 Order1 := TOrder(Item1);
952 Order2 := TOrder(Item2);
953 if (Piece(Order1.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order1.ID))
954 then DSeq1 := 0
955 else DSeq1 := Order1.DGroupSeq;
956 if (Piece(Order2.ID, ';', 2) = '1') and (Changes.Exist(CH_ORD, Order2.ID))
957 then DSeq2 := 0
958 else DSeq2 := Order2.DGroupSeq;
959 if DSeq1 = DSeq2 then
960 begin
961 if Order1.OrderTime < Order2.OrderTime then Result := -1
962 else if Order1.OrderTime > Order2.OrderTime then Result := 1
963 else Result := 0;
964 if Result = 0 then
965 begin
966 IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
967 IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
968 if IFN1 < IFN2 then Result := -1;
969 if IFN1 > IFN2 then Result := 1;
970 end;
971 end
972 else if DSeq1 < DSeq2 then Result := -1
973 else Result := 1;
974end;
975
976function InverseChrono(Item1, Item2: Pointer): Integer;
977var
978 Order1, Order2: TOrder;
979 IFN1, IFN2: Integer;
980begin
981 Order1 := TOrder(Item1);
982 Order2 := TOrder(Item2);
983 if Order1.OrderTime > Order2.OrderTime then Result := -1
984 else if Order1.OrderTime < Order2.OrderTime then Result := 1
985 else Result := 0;
986 if Result = 0 then
987 begin
988 IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
989 IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
990 if IFN1 < IFN2 then Result := -1;
991 if IFN1 > IFN2 then Result := 1;
992 end;
993end;
994
995function ForwardChrono(Item1, Item2: Pointer): Integer;
996var
997 Order1, Order2: TOrder;
998 IFN1, IFN2: Integer;
999begin
1000 Order1 := TOrder(Item1);
1001 Order2 := TOrder(Item2);
1002 if Order1.OrderTime < Order2.OrderTime then Result := -1
1003 else if Order1.OrderTime > Order2.OrderTime then Result := 1
1004 else Result := 0;
1005 if Result = 0 then
1006 begin
1007 IFN1 := StrToIntDef(Piece(Order1.ID, ';', 1), 0);
1008 IFN2 := StrToIntDef(Piece(Order2.ID, ';', 1), 0);
1009 if IFN1 < IFN2 then Result := -1;
1010 if IFN1 > IFN2 then Result := 1;
1011 end;
1012end;
1013
1014procedure SortOrders(AList: TList; ByGroup, InvChron: Boolean);
1015begin
1016 if ByGroup then
1017 begin
1018 if InvChron then AList.Sort(InverseByGroup) else AList.Sort(ForwardByGroup);
1019 end else
1020 begin
1021 if InvChron then AList.Sort(InverseChrono) else AList.Sort(ForwardChrono);
1022 end;
1023end;
1024
1025function DGroupAll: Integer;
1026var
1027 x: string;
1028begin
1029 if uDGroupAll = 0 then
1030 begin
1031 x := sCallV('ORWORDG IEN', ['ALL']);
1032 uDGroupAll := StrToIntDef(x, 1);
1033 end;
1034 Result := uDGroupAll;
1035end;
1036
1037function DGroupIEN(AName: string): Integer;
1038begin
1039 Result := StrToIntDef(sCallV('ORWORDG IEN', [AName]), 0);
1040end;
1041
1042procedure ListDGroupAll(Dest: TStrings);
1043begin
1044 CallV('ORWORDG ALLTREE', [nil]);
1045 Dest.Assign(RPCBrokerV.Results);
1046end;
1047
1048procedure ListSpecialties(Dest: TStrings);
1049begin
1050 CallV('ORWOR TSALL', [nil]);
1051 MixedCaseList(RPCBrokerV.Results);
1052 Dest.Assign(RPCBrokerV.Results);
1053end;
1054
1055procedure ListSpecialtiesED(AType: Char; Dest: TStrings);
1056var
1057 i :integer;
1058 Currloc: integer;
1059 admitEvts: TStringList;
1060 otherEvts: TStringList;
1061 commonList: TStringList;
1062begin
1063 if Encounter <> nil then
1064 Currloc := Encounter.Location
1065 else
1066 Currloc := 0;
1067 commonList := TStringList.Create;
1068 CallV('OREVNTX1 CMEVTS',[Currloc]);
1069 //MixedCaseList(RPCBrokerV.Results);
1070 if RPCBrokerV.Results.Count > 0 then with RPCBrokerV do for i := 0 to Results.Count - 1 do
1071 begin
1072 if AType = 'D' then
1073 begin
1074 if AType = Piece(Results[i],'^',3) then
1075 commonList.Add(Results[i]);
1076 end
1077 else if AType = 'A' then
1078 begin
1079 if (Piece(Results[i],'^',3) = 'T') or (Piece(Results[i],'^',3) = 'D') then
1080 Continue;
1081 commonList.Add(Results[i]);
1082 end
1083 else
1084 begin
1085 if Length(Results[i])> 0 then
1086 commonList.Add(Results[i]);
1087 end;
1088 end;
1089 if commonList.Count > 0 then
1090 begin
1091 Dest.AddStrings(TStrings(commonList));
1092 Dest.Add('^^^^^^^^___________________________________________________________________________________________');
1093 Dest.Add(LLS_SPACE);
1094 end;
1095 if AType = #0 then
1096 begin
1097 admitEvts := TStringList.Create;
1098 otherEvts := TSTringList.Create;
1099 CallV('OREVNTX ACTIVE',['A']);
1100 //MixedCaseList(RPCBrokerV.Results);
1101 if RPCBrokerV.Results.Count > 0 then
1102 begin
1103 RPCBrokerV.Results.Delete(0);
1104 admitEvts.AddStrings(RPCBrokerV.Results);
1105 end;
1106 CallV('OREVNTX ACTIVE',['T^O^M^D']);
1107 //MixedCaseList(RPCBrokerV.Results);
1108 if RPCBrokerV.Results.Count > 0 then
1109 begin
1110 RPCBrokerV.Results.Delete(0);
1111 otherEvts.AddStrings(RPCBrokerV.Results);
1112 end;
1113 Dest.AddStrings(TStrings(otherEvts));
1114 Dest.Add('^^^^^^^^_____________________________________________________________________________________________');
1115 Dest.Add(LLS_SPACE);
1116 Dest.AddStrings(TStrings(admitEvts));
1117 admitEvts.Free;
1118 otherEvts.Free;
1119 end
1120 else if AType = 'A' then
1121 begin
1122 CallV('OREVNTX ACTIVE',['A^O^M']);
1123 //MixedCaseList(RPCBrokerV.Results);
1124 if RPCBrokerV.Results.Count > 0 then
1125 RPCBrokerV.Results.Delete(0);
1126 Dest.AddStrings(RPCBrokerV.Results);
1127 end
1128 else
1129 begin
1130 CallV('OREVNTX ACTIVE',[AType]);
1131 //MixedCaseList(RPCBrokerV.Results);
1132 if RPCBrokerV.Results.Count > 0 then
1133 RPCBrokerV.Results.Delete(0);
1134 Dest.AddStrings(RPCBrokerV.Results);
1135 end;
1136end;
1137
1138procedure ListOrderFilters(Dest: TStrings);
1139begin
1140 CallV('ORWORDG REVSTS', [nil]);
1141 Dest.Assign(RPCBrokerV.Results);
1142end;
1143
1144
1145procedure ListOrderFiltersAll(Dest: TStrings);
1146begin
1147 CallV('ORWORDG REVSTS', [nil]);
1148 Dest.Assign(RPCBrokerV.Results);
1149end;
1150
1151{ Write Orders }
1152
1153procedure BuildResponses(var ResolvedDialog: TOrderDialogResolved; const KeyVars: string;
1154 AnEvent: TOrderDelayEvent; ForIMO: boolean);
1155const
1156 BoolChars: array[Boolean] of Char = ('0', '1');
1157 RESERVED_PIECE = '';
1158
1159var
1160 DelayEvent, x, TheOrder: string;
1161 Idx, tmpOrderGroup, PickupIdx, ForIMOResponses: integer;
1162 IfUDGrp: Boolean;
1163 IfUDGrpForQO: Boolean;
1164 temp: string;
1165begin
1166 ForIMOResponses := 0;
1167 tmpOrderGroup := 0;
1168 temp := '';
1169 if ForIMO then ForIMOResponses := 1;
1170 PickupIdx := 0;
1171 IfUDGrp := False;
1172 TheOrder := ResolvedDialog.InputID;
1173 IfUDGrpForQO := CheckQOGroup(TheOrder);
1174 if (CharAt(TheOrder,1) in ['C','T']) then
1175 begin
1176 Delete(TheOrder,1,1);
1177 tmpOrderGroup := CheckOrderGroup(TheOrder);
1178 if tmpOrderGroup = 1 then IfUDGrp := True else IfUDGrp := False;
1179 end;
1180 if (not IfUDGrp) and (AnEvent.EventType in ['A','T']) then
1181 IfUDGrp := True;
1182 //FLDS=DFN^LOC^ORNP^INPT^SEX^AGE^EVENT^SC%^^^Key Variables
1183 if (Patient.Inpatient = true) and (tmpOrderGroup = 2) then temp := '0';
1184 if temp <> '0' then temp := BoolChars[Patient.Inpatient];
1185 with AnEvent do
1186 begin
1187 if isNewEvent then
1188 DelayEvent := '0;'+ EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective)
1189 else
1190 DelayEvent := IntToStr(AnEvent.PtEventIFN) + ';' + EventType + ';' + IntToStr(Specialty) + ';' + FloatToStr(Effective);
1191 end;
1192 x := Patient.DFN + U + // 1
1193 IntToStr(Encounter.Location) + U + // 2
1194 IntToStr(Encounter.Provider) + U + // 3
1195 BoolChars[Patient.Inpatient] + U + // 4
1196 Patient.Sex + U + // 5
1197 IntToStr(Patient.Age) + U + // 6
1198 DelayEvent + U + // 7 (for OREVENT)
1199 IntToStr(Patient.SCPercent) + U + // 8
1200 RESERVED_PIECE + U + // 9
1201 RESERVED_PIECE + U + // 10
1202 KeyVars;
1203 CallV('ORWDXM1 BLDQRSP', [ResolvedDialog.InputID, x, ForIMOResponses]);
1204 // LST(0)=QuickLevel^ResponseID(ORIT;$H)^Dialog^Type^FormID^DGrp
1205 with RPCBrokerV do
1206 begin
1207 x := Results[0];
1208 with ResolvedDialog do
1209 begin
1210 QuickLevel := StrToIntDef(Piece(x, U, 1), 0);
1211 ResponseID := Piece(x, U, 2);
1212 DialogIEN := StrToIntDef(Piece(x, U, 3), 0);
1213 DialogType := CharAt(Piece(x, U, 4), 1);
1214 FormID := StrToIntDef(Piece(x, U, 5), 0);
1215 DisplayGroup := StrToIntDef(Piece(x, U, 6), 0);
1216 QOKeyVars := Pieces(x, U, 7, 7 + MAX_KEYVARS);
1217 Results.Delete(0);
1218 if Results.Count > 0 then
1219 begin
1220 if (IfUDGrp) or (IfUDGrpForQO) then
1221 begin
1222 for Idx := 0 to Results.Count - 1 do
1223 begin
1224 if(Pos('PICK UP',UpperCase(Results[idx])) > 0) or (Pos('PICK-UP',UpperCase(Results[idx])) > 0) then
1225 begin
1226 PickupIdx := Idx;
1227 Break;
1228 end;
1229 end;
1230 end;
1231 if PickupIdx > 0 then
1232 Results.Delete(PickupIdx);
1233 SetString(ShowText, Results.GetText, StrLen(Results.GetText));
1234 end;
1235 end;
1236 end;
1237end;
1238
1239procedure ClearOrderRecall;
1240begin
1241 CallV('ORWDXM2 CLRRCL', [nil]);
1242end;
1243
1244function CommonLocationForOrders(OrderList: TStringList): Integer;
1245begin
1246 Result := StrToIntDef(sCallV('ORWD1 COMLOC', [OrderList]), 0);
1247end;
1248
1249function FormIDForDialog(IEN: Integer): Integer;
1250begin
1251 Result := StrToIntDef(sCallV('ORWDXM FORMID', [IEN]), 0);
1252end;
1253
1254function DlgIENForName(DlgName: string): Integer;
1255begin
1256 Result := StrToIntDef(sCallV('OREVNTX1 DLGIEN',[DlgName]),0);
1257end;
1258
1259procedure LoadOrderMenu(AnOrderMenu: TOrderMenu; AMenuIEN: Integer);
1260var
1261 OrderMenuItem: TOrderMenuItem;
1262 i: Integer;
1263begin
1264 CallV('ORWDXM MENU', [AMenuIEN]);
1265 with RPCBrokerV do if Results.Count > 0 then
1266 begin
1267 // Results[0] = Name^Cols^PathSwitch^^^LRFZX^LRFSAMP^LRFSPEC^LRFDATE^LRFURG^LRFSCH^PSJNPOC^
1268 // GMRCNOPD^GMRCNOAT^GMRCREAF^^^^^
1269 AnOrderMenu.Title := Piece(Results[0], U, 1);
1270 AnOrderMenu.NumCols := StrToIntDef(Piece(Results[0], U, 2), 1);
1271 AnOrderMenu.KeyVars := Pieces(Results[0], U, 6, 6 + MAX_KEYVARS);
1272 for i := 1 to Results.Count - 1 do
1273 begin
1274 OrderMenuItem := TOrderMenuItem.Create;
1275 with OrderMenuItem do
1276 begin
1277 Col := StrToIntDef(Piece(Results[i], U, 1), 0) - 1;
1278 Row := StrToIntDef(Piece(Results[i], U, 2), 0) - 1;
1279 DlgType := CharAt(Piece(Results[i], U, 3), 1);
1280 IEN := StrToIntDef(Piece(Results[i], U, 4), 0);
1281 FormID := StrToIntDef(Piece(Results[i], U, 5), 0);
1282 AutoAck := Piece(Results[i], U, 6) = '1';
1283 ItemText := Piece(Results[i], U, 7);
1284 Mnemonic := Piece(Results[i], U, 8);
1285 Display := StrToIntDef(Piece(Results[i], U, 9), 0);
1286 end; {with OrderItem}
1287 AnOrderMenu.MenuItems.Add(OrderMenuItem);
1288 end; {for i}
1289 end; {with RPCBrokerV}
1290end;
1291
1292procedure LoadOrderSet(SetItems: TStrings; AnIEN: Integer; var KeyVars, ACaption: string);
1293var
1294 x: string;
1295begin
1296 CallV('ORWDXM LOADSET', [AnIEN]);
1297 KeyVars := '';
1298 ACaption := '';
1299 if RPCBrokerV.Results.Count > 0 then
1300 begin
1301 x := RPCBrokerV.Results[0];
1302 ACaption := Piece(x, U, 1);
1303 KeyVars := Copy(x, Pos(U, x) + 1, Length(x));
1304 RPCBrokerV.Results.Delete(0);
1305 end;
1306 SetItems.Assign(RPCBrokerV.Results);
1307end;
1308
1309procedure LoadWriteOrders(Dest: TStrings);
1310begin
1311 CallV('ORWDX WRLST', [Encounter.Location]);
1312 Dest.Assign(RPCBrokerV.Results);
1313end;
1314
1315procedure LoadWriteOrdersED(Dest: TStrings; EvtID: string);
1316begin
1317 CallV('OREVNTX1 WRLSTED', [Encounter.Location,EvtID]);
1318 if RPCBrokerV.Results.count > 0 then
1319 begin
1320 Dest.Clear;
1321 Dest.Assign(RPCBrokerV.Results);
1322 end
1323end;
1324
1325function OrderDisabledMessage(DlgIEN: Integer): string;
1326begin
1327 Result := sCallV('ORWDX DISMSG', [DlgIEN]);
1328end;
1329
1330procedure SendOrders(OrderList: TStringList; const ESCode: string);
1331var
1332 i: Integer;
1333begin
1334 { prepending the space to ESCode is temporary way to keep broker from crashing }
1335 CallV('ORWDX SEND', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, OrderList]);
1336 { this is a stop gap way to prevent an undesired error message when user chooses not to sign }
1337 with RPCBrokerV do for i := 0 to Results.Count - 1 do
1338// if Piece(Results[i], U, 4) = 'This order requires a signature.' <-- original line. //kt 8/8/2007
1339 if Piece(Results[i], U, 4) = DKLangConstW('rOrders_This_order_requires_a_signaturex') //kt added 8/8/2007
1340 then Results[i] := Piece(Results[i], U, 1);
1341 OrderList.Clear;
1342 OrderList.Assign(RPCBrokerV.Results);
1343end;
1344
1345procedure SendReleaseOrders(OrderList: TStringList);
1346var
1347 loc: string;
1348 CurrTS: Integer;
1349 PtTS: string;
1350begin
1351 PtTS := Piece(GetCurrentSpec(Patient.DFN),'^',2);
1352 CurrTS := StrToIntDef(PtTS,0);
1353 Loc := IntToStr(Encounter.Location);
1354 CallV('ORWDX SENDED',[OrderList,CurrTS,Loc]);
1355 OrderList.Clear;
1356 OrderList.Assign(RPCBrokerV.Results);
1357end;
1358
1359procedure SendAndPrintOrders(OrderList, ErrList: TStrings; const ESCode: string; const DeviceInfo: string);
1360var
1361 i: Integer;
1362begin
1363 { prepending the space to ESCode is temporary way to keep broker from crashing }
1364 CallV('ORWDX SENDP', [Patient.DFN, Encounter.Provider, Encounter.Location, ' ' + ESCode, DeviceInfo, OrderList]);
1365 { this is a stop gap way to prevent an undesired error message when user chooses not to sign }
1366 with RPCBrokerV do for i := 0 to Results.Count - 1 do
1367// if Piece(Results[i], U, 3) <> 'This order requires a signature.' <-- original line. //kt 8/8/2007
1368 if Piece(Results[i], U, 3) <> DKLangConstW('rOrders_This_order_requires_a_signaturex') //kt added 8/8/2007
1369 then ErrList.Add(Results[i]);
1370end;
1371
1372procedure PrintOrdersOnReview(OrderList: TStringList; const DeviceInfo: string);
1373begin
1374 CallV('ORWD1 RVPRINT', [Encounter.Location, DeviceInfo, OrderList]);
1375end;
1376
1377procedure PrintServiceCopies(OrderList: TStringList); {*REV*}
1378begin
1379 CallV('ORWD1 SVONLY', [Encounter.Location, OrderList]);
1380end;
1381
1382procedure ExecutePrintOrders(SelectedList: TStringList; const DeviceInfo: string);
1383begin
1384 CallV('ORWD1 PRINTGUI', [Encounter.Location, DeviceInfo, SelectedList]);
1385end;
1386
1387{ Order Actions }
1388
1389function DialogForOrder(const ID: string): Integer;
1390begin
1391 Result := StrToIntDef(sCallV('ORWDX DLGID', [ID]), 0);
1392end;
1393
1394function FormIDForOrder(const ID: string): Integer;
1395begin
1396 Result := StrToIntDef(sCallV('ORWDX FORMID', [ID]), 0);
1397end;
1398
1399procedure SetOrderFromResults(AnOrder: TOrder);
1400var
1401 x, y, z: string;
1402begin
1403 with RPCBrokerV do while Results.Count > 0 do
1404 begin
1405 x := Results[0];
1406 Results.Delete(0);
1407 if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
1408 y := '';
1409 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
1410 begin
1411 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
1412 Results.Delete(0);
1413 end;
1414 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
1415 z := '';
1416 if (Results.Count > 0) and (Results[0] = '|') then
1417 begin
1418 Results.Delete(0);
1419 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
1420 begin
1421 z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change
1422 Results.Delete(0);
1423 end;
1424 end;
1425 SetOrderFields(AnOrder, x, y, z);
1426 end;
1427end;
1428
1429procedure LockPatient(var ErrMsg: string);
1430begin
1431 ErrMsg := sCallV('ORWDX LOCK', [Patient.DFN]);
1432 if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
1433end;
1434
1435procedure UnlockPatient;
1436begin
1437 sCallV('ORWDX UNLOCK', [Patient.DFN]);
1438end;
1439
1440procedure LockOrder(OrderID: string; var ErrMsg: string);
1441begin
1442 ErrMsg := sCallV('ORWDX LOCK ORDER', [OrderID]);
1443 if Piece(ErrMsg, U, 1) = '1' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
1444end;
1445
1446procedure UnlockOrder(OrderID: string);
1447begin
1448 sCallV('ORWDX UNLOCK ORDER', [OrderID]);
1449end;
1450
1451procedure ValidateOrderAction(const ID, Action: string; var ErrMsg: string);
1452begin
1453 ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider]);
1454end;
1455
1456procedure ValidateOrderActionNature(const ID, Action, Nature: string; var ErrMsg: string);
1457begin
1458 ErrMsg := sCallV('ORWDXA VALID', [ID, Action, Encounter.Provider, Nature]);
1459end;
1460
1461procedure IsLatestAction(const ID: string; var ErrList: TStringList);
1462begin
1463 CallV('ORWOR ACTION TEXT',[ID]);
1464 if RPCBrokerV.Results.Count > 0 then
1465 Errlist.Assign(RPCBrokerV.Results);
1466end;
1467
1468procedure ChangeOrder(AnOrder: TOrder; ResponseList: TList);
1469begin
1470end;
1471
1472procedure RenewOrder(AnOrder: TOrder; RenewFields: TOrderRenewFields; IsComplex: integer; AnIMOOrderAppt: double; OCList: TStringList);
1473{ put RenewFields into tmplst[0]=BaseType^Start^Stop^Refills^Pickup, tmplst[n]=comments }
1474var
1475 tmplst: TStringList;
1476 i: integer;
1477 y: string;
1478begin
1479
1480 tmplst := TStringList.Create;
1481
1482 {Begin Billing Aware}
1483 UBAGlobals.SourceOrderID := AnOrder.ID;
1484 {End Billing Aware}
1485
1486 try
1487 with RenewFields do
1488 begin
1489 tmplst.SetText(PChar(Comments));
1490 tmplst.Insert(0, IntToStr(BaseType) + U + StartTime + U + StopTime + U + IntToStr(Refills) + U + Pickup);
1491 end;
1492
1493 with RPCBrokerV do
1494 begin
1495 ClearParameters := True;
1496 RemoteProcedure := 'ORWDXR RENEW';
1497 Param[0].PType := literal;
1498 Param[0].Value := AnOrder.ID;
1499 Param[1].PType := literal;
1500 Param[1].Value := Patient.DFN;
1501 Param[2].PType := literal;
1502 Param[2].Value := IntToStr(Encounter.Provider);
1503 Param[3].PType := literal;
1504 Param[3].Value := IntToStr(Encounter.Location);
1505 Param[4].PType := list;
1506 for i := 0 to tmplst.Count - 1 do
1507 Param[4].Mult[IntToStr(i+1)] := tmplst[i];
1508 Param[4].Mult['"ORCHECK"'] := IntToStr(OCList.Count);
1509 for i := 0 to OCList.Count - 1 do
1510 begin
1511 // put quotes around everything to prevent broker from choking
1512 y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
1513 '","' + IntToStr(i+1) + '"';
1514 Param[4].Mult[y] := Pieces(OCList[i], U, 2, 4);
1515 end;
1516 Param[5].PType := literal;
1517 Param[5].Value := IntToStr(IsComplex);
1518 Param[6].PType := literal;
1519 Param[6].Value := FloatToStr(AnIMOOrderAppt);
1520 CallBroker;
1521 SetOrderFromResults(AnOrder);
1522
1523 {Begin Billing Aware}
1524 UBAGlobals.TargetOrderID := AnOrder.ID; //the ID of the renewed order
1525 UBAGlobals.CopyTreatmentFactorsDxsToRenewedOrder;
1526 {End Billing Aware}
1527
1528 end;
1529 finally
1530 tmplst.Free;
1531 end;
1532end;
1533
1534procedure HoldOrder(AnOrder: TOrder);
1535begin
1536 CallV('ORWDXA HOLD', [AnOrder.ID, Encounter.Provider]);
1537 SetOrderFromResults(AnOrder);
1538end;
1539
1540procedure ReleaseOrderHold(AnOrder: TOrder);
1541begin
1542 CallV('ORWDXA UNHOLD', [AnOrder.ID, Encounter.Provider]);
1543 SetOrderFromResults(AnOrder);
1544end;
1545
1546procedure ListDCReasons(Dest: TStrings; var DefaultIEN: Integer);
1547begin
1548 CallV('ORWDXA DCREASON', [nil]);
1549//ExtractItems(Dest, RPCBrokerV.Results, 'DCReason'); <-- original line. //kt 8/8/2007
1550 ExtractItems(Dest, RPCBrokerV.Results, DKLangConstW('rOrders_DCReason')); //kt added 8/8/2007
1551 //AGP Change 26.15 for PSI-04-63
1552 //DefaultIEN := StrToIntDef(Piece(ExtractDefault(RPCBrokerV.Results, 'DCReason'), U, 1), 0);
1553end;
1554
1555function GetREQReason: Integer;
1556begin
1557 Result := StrToIntDef(sCallV('ORWDXA DCREQIEN', [nil]), 0);
1558end;
1559
1560procedure DCOrder(AnOrder: TOrder; AReason: Integer; var DCType: Integer);
1561var
1562 AParentID : string;
1563begin
1564 AParentID := AnOrder.ParentID;
1565 CallV('ORWDXA DC', [AnOrder.ID, Encounter.Provider, Encounter.Location, AReason]);
1566 UBACore.DeleteDCOrdersFromCopiedList(AnOrder.ID);
1567 DCType := StrToIntDef(Piece(RPCBrokerV.Results[0], U, 14), 0);
1568 SetOrderFromResults(AnOrder);
1569 AnOrder.ParentID := AParentID;
1570end;
1571
1572procedure AlertOrder(AnOrder: TOrder; AlertRecip: Int64);
1573begin
1574 CallV('ORWDXA ALERT', [AnOrder.ID, AlertRecip]);
1575 // don't worry about results
1576end;
1577
1578procedure FlagOrder(AnOrder: TOrder; const FlagReason: string; AlertRecip: Int64);
1579begin
1580 CallV('ORWDXA FLAG', [AnOrder.ID, FlagReason, AlertRecip]);
1581 SetOrderFromResults(AnOrder);
1582end;
1583
1584procedure LoadFlagReason(Dest: TStrings; const ID: string);
1585begin
1586 CallV('ORWDXA FLAGTXT', [ID]);
1587 Dest.Assign(RPCBrokerV.Results);
1588end;
1589
1590procedure UnflagOrder(AnOrder: TOrder; const AComment: string);
1591begin
1592 CallV('ORWDXA UNFLAG', [AnOrder.ID, AComment]);
1593 SetOrderFromResults(AnOrder);
1594end;
1595
1596procedure LoadWardComments(Dest: TStrings; const ID: string);
1597begin
1598 CallV('ORWDXA WCGET', [ID]);
1599 Dest.Assign(RPCBrokerV.Results);
1600end;
1601
1602procedure PutWardComments(Src: TStrings; const ID: string; var ErrMsg: string);
1603begin
1604 ErrMsg := sCallV('ORWDXA WCPUT', [ID, Src]);
1605end;
1606
1607procedure CompleteOrder(AnOrder: TOrder; const ESCode: string);
1608begin
1609 CallV('ORWDXA COMPLETE', [AnOrder.ID, ESCode]);
1610 SetOrderFromResults(AnOrder);
1611end;
1612
1613procedure VerifyOrder(AnOrder: TOrder; const ESCode: string);
1614begin
1615 CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode]);
1616 SetOrderFromResults(AnOrder);
1617end;
1618
1619procedure VerifyOrderChartReview(AnOrder: TOrder; const ESCode: string);
1620begin
1621 CallV('ORWDXA VERIFY', [AnOrder.ID, ESCode, 'R']);
1622 SetOrderFromResults(AnOrder);
1623end;
1624
1625function GetOrderableIen(AnOrderId:string): integer;
1626begin
1627 Result := StrToIntDef(sCallV('ORWDXR GTORITM', [AnOrderId]),0);
1628end;
1629
1630procedure StoreDigitalSig(AID, AHash: string; AProvider: Int64; ASig, ACrlUrl: string; var AError: string);
1631var
1632 len, ix: integer;
1633 ASigAray: TStringList;
1634begin
1635 ASigAray := TStringList.Create;
1636 ix := 1;
1637 len := length(ASig);
1638 while len >= ix do
1639 begin
1640 ASigAray.Add(copy(ASig, ix, 240));
1641 inc(ix, 240);
1642 end; //while
1643 try
1644 CallV('ORWOR1 SIG', [AID, AHash, len, '100', AProvider, ASigAray, ACrlUrl]);
1645 with RPCBrokerV do
1646 if piece(Results[0],'^',1) = '-1' then
1647 begin
1648// ShowMessage('Storage of Digital Signature FAILED: ' + piece(Results[0],'^',2) + CRLF + CRLF + <-- original line. //kt 8/8/2007
1649 ShowMessage(DKLangConstW('rOrders_Storage_of_Digital_Signature_FAILEDx') + piece(Results[0],'^',2) + CRLF + CRLF + //kt added 8/8/2007
1650// 'This error will prevent this order from being sent to the service for processing. Please cancel the order and try again.' + CRLF + CRLF + <-- original line. //kt 8/8/2007
1651 DKLangConstW('rOrders_This_error_will_prevent_this_order_from_being_sent_to_the_service_for_processingx_Please_cancel_the_order_and_try_againx') + CRLF + CRLF + //kt added 8/8/2007
1652// '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.'); <-- original line. //kt 8/8/2007
1653 DKLangConstW('rOrders_If_this_problem_persistsx_then_there_is_a_problem_in_the_CPRS_PKI_interfacex_and_it_needs_to_be_reported_through_the_proper_channelsx_to_the_developer_Cary_Malmrosex')); //kt added 8/8/2007
1654 AError := '1';
1655 end;
1656 finally
1657 ASigAray.Free;
1658 end;
1659end;
1660
1661procedure UpdateOrderDGIfNeeded(AnID: string);
1662var
1663 NeedUpdate: boolean;
1664 tmpDFN: string;
1665begin
1666 tmpDFN := Patient.DFN;
1667 Patient.Clear;
1668 Patient.DFN := tmpDFN;
1669 NeedUpdate := SCallV('ORWDPS4 IPOD4OP', [AnID]) = '1';
1670 if Patient.Inpatient and needUpdate then
1671 SCallV('ORWDPS4 UPDTDG',[AnID]);
1672end;
1673
1674function CanEditSuchRenewedOrder(AnID: string; IsTxtOrder: integer): boolean;
1675begin
1676 Result := SCallV('ORWDXR01 CANCHG',[AnID,IsTxtOrder]) = '1';
1677end;
1678
1679function IsPSOSupplyDlg(DlgID, QODlg: integer): boolean;
1680begin
1681 Result := SCallV('ORWDXR01 ISSPLY',[DlgID,QODlg])='1';
1682end;
1683
1684procedure SaveChangesOnRenewOrder(var AnOrder: TOrder; AnID, TheRefills, ThePickup: string; IsTxtOrder: integer);
1685begin
1686 SCallV('ORWDXR01 SAVCHG',[AnID,TheRefills,ThePickup,IsTxtOrder]);
1687 SetOrderFromResults(AnOrder);
1688end;
1689
1690{ Order Information }
1691
1692function OrderIsReleased(const ID: string): Boolean;
1693begin
1694 Result := sCallV('ORWDXR ISREL', [ID]) = '1';
1695end;
1696
1697procedure LoadRenewFields(RenewFields: TOrderRenewFields; const ID: string);
1698var
1699 i: Integer;
1700begin
1701 CallV('ORWDXR RNWFLDS', [ID]);
1702 with RPCBrokerV, RenewFields do
1703 begin
1704 BaseType := StrToIntDef(Piece(Results[0], U, 1), 0);
1705 StartTime := Piece(Results[0], U, 2);
1706 StopTime := Piece(Results[0], U, 3);
1707 Refills := StrToIntDef(Piece(Results[0], U, 4), 0);
1708 Pickup := Piece(Results[0], U, 5);
1709 Comments := '';
1710 for i := 1 to Results.Count - 1 do Comments := Comments + CRLF + Results[i];
1711 if Copy(Comments, 1, 2) = CRLF then Delete(Comments, 1, 2);
1712 end;
1713end;
1714
1715procedure GetChildrenOfComplexOrder(AnParentID,CurrAct: string; var ChildList: TStringList); //PSI-COMPLEX
1716var
1717 i: integer;
1718begin
1719 CallV('ORWDXR ORCPLX',[AnParentID,CurrAct]);
1720 if RPCBrokerV.Results.Count = 0 then Exit;
1721 With RPCBrokerV do
1722 begin
1723 for i := 0 to Results.Count - 1 do
1724 begin
1725 if (Piece(Results[i],'^',1) <> 'E') and (Length(Results[i])>0) then
1726 ChildList.Add(Results[i]);
1727 end;
1728 end;
1729end;
1730
1731procedure LESValidationForChangedLabOrder(var RejectedReason: TStringList; AnOrderInfo: string);
1732begin
1733 CallV('ORWDPS5 LESAPI',[AnOrderInfo]);
1734 if RPCBrokerV.Results.Count > 0 then
1735 RejectedReason.Assign(RPCBrokerV.Results);
1736end;
1737
1738procedure ChangeEvent(AnOrderList: TStringList; APtEvtId: string);
1739begin
1740 SCallV('OREVNTX1 CHGEVT', [APtEvtId,AnOrderList]);
1741end;
1742
1743procedure DeletePtEvent(APtEvtID: string);
1744begin
1745 SCallV('OREVNTX1 DELPTEVT',[APtEvtID]);
1746end;
1747
1748function IsRenewableComplexOrder(AnParentID: string): boolean; //PSI-COMPLEX
1749var
1750 rst: integer;
1751begin
1752 Result := False;
1753 rst := StrToIntDef(SCallV('ORWDXR CANRN',[AnParentID]),0);
1754 if rst>0 then
1755 Result := True;
1756end;
1757
1758function IsComplexOrder(AnOrderID: string): boolean; //PSI-COMPLEX
1759var
1760 rst: integer;
1761begin
1762 Result := False;
1763 rst := StrToIntDef(SCallV('ORWDXR ISCPLX',[AnOrderID]),0);
1764 if rst > 0 then
1765 Result := True;
1766end;
1767
1768procedure ValidateComplexOrderAct(AnOrderID: string; var ErrMsg: string); //PSI-COMPLEX
1769begin
1770 ErrMsg := SCallV('ORWDXA OFCPLX',[AnOrderID]);
1771end;
1772
1773function GetDlgData(ADlgID: string): string;
1774begin
1775 Result := SCallV('OREVNTX1 GETDLG',[ADlgID]);
1776end;
1777
1778function PtEvtEmpty(APtEvtID: string): Boolean;
1779begin
1780 Result := False;
1781 if StrToIntDef(SCallV('OREVNTX1 EMPTY',[APtEvtID]),0)>0 then
1782 Result := True;
1783end;
1784
1785
1786function TextForOrder(const ID: string): string;
1787begin
1788 CallV('ORWORR GETTXT', [ID]);
1789 Result := RPCBrokerV.Results.Text;
1790end;
1791
1792function GetConsultOrderNumber(ConsultIEN: string): string;
1793begin
1794 Result := sCallv('ORQQCN GET ORDER NUMBER',[ConsultIEN]);
1795end;
1796
1797function GetOrderByIFN(const ID: string): TOrder;
1798var
1799 x, y, z: string;
1800 AnOrder: TOrder;
1801begin
1802 AnOrder := TOrder.Create;
1803 CallV('ORWORR GETBYIFN', [ID]);
1804 with RPCBrokerV do while Results.Count > 0 do
1805 begin
1806 x := Results[0];
1807 Results.Delete(0);
1808 if CharAt(x, 1) <> '~' then Continue; // only happens if out of synch
1809 y := '';
1810 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
1811 begin
1812 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
1813 Results.Delete(0);
1814 end;
1815 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
1816 z := '';
1817 if (Results.Count > 0) and (Results[0] = '|') then
1818 begin
1819 Results.Delete(0);
1820 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
1821 begin
1822 z := z + Copy(Results[0], 2, Length(Results[0])); //PKI Change
1823 Results.Delete(0);
1824 end;
1825 end;
1826 SetOrderFields(AnOrder, x, y, z);
1827 end;
1828 Result := AnOrder;
1829end;
1830
1831function GetPackageByOrderID(const OrderID: string): string;
1832begin
1833 Result := SCallV('ORWDXR GETPKG',[OrderID]);
1834end;
1835
1836function AnyOrdersRequireSignature(OrderList: TStringList): Boolean;
1837begin
1838 Result := sCallV('ORWD1 SIG4ANY', [OrderList]) = '1';
1839end;
1840
1841function OrderRequiresSignature(const ID: string): Boolean;
1842begin
1843 Result := sCallV('ORWD1 SIG4ONE', [ID]) = '1';
1844end;
1845
1846function OrderRequiresDigitalSignature(const ID: string): Boolean;
1847begin
1848 Result := sCallV('ORWOR1 CHKDIG', [ID]) = '1';
1849end;
1850
1851function GetDrugSchedule(const ID: string): string;
1852begin
1853 Result := sCallV('ORWOR1 GETDSCH', [ID]);
1854end;
1855
1856function GetExternalText(const ID: string): string;
1857var
1858 x,y: string;
1859begin
1860 CallV('ORWOR1 GETDTEXT', [ID]);
1861 y := '';
1862 with RPCBrokerV do while Results.Count > 0 do
1863 begin
1864 x := Results[0];
1865 Results.Delete(0);
1866 y := y + x;
1867 end;
1868 Result := y;
1869end;
1870
1871function SetExternalText(const ID: string; ADrugSch: string; AUser: Int64): string;
1872var
1873 x,y: string;
1874begin
1875 CallV('ORWOR1 SETDTEXT', [ID, ADrugSch, AUser]);
1876 y := '';
1877 with RPCBrokerV do while Results.Count > 0 do
1878 begin
1879 x := Results[0];
1880 Results.Delete(0);
1881 y := y + x;
1882 end;
1883 Result := y;
1884end;
1885
1886function GetDigitalSignature(const ID: string): string;
1887begin
1888 CallV('ORWORR GETDSIG', [ID]);
1889 Result := RPCBrokerV.Results.Text;
1890end;
1891
1892function GetDEA(const ID: string): string;
1893begin
1894 CallV('ORWORR GETDEA', [ID]);
1895 Result := RPCBrokerV.Results.Text;
1896end;
1897
1898function GetPKISite: Boolean;
1899begin
1900 Result := sCallV('ORWOR PKISITE', [nil]) = '1';
1901end;
1902
1903function GetPKIUse: Boolean;
1904begin
1905 Result := sCallV('ORWOR PKIUSE', [nil]) = '1';
1906end;
1907
1908function DoesOIPIInSigForQO(AnQOID: integer): integer;
1909begin
1910 Result := StrToIntDef(SCallV('ORWDPS1 HASOIPI',[AnQOID]),0);
1911end;
1912
1913function GetDispGroupForLES: string;
1914begin
1915 Result := SCallV('ORWDPS5 LESGRP',[nil]);
1916end;
1917
1918function GetOrderPtEvtID(AnOrderID: string): string;
1919begin
1920 Result := SCallV('OREVNTX1 ODPTEVID',[AnOrderID]);
1921end;
1922
1923function VerbTelPolicyOrder(AnOrderID: string): boolean;
1924begin
1925 Result := SCallV('ORWDPS5 ISVTP',[AnOrderID]) = '1';
1926end;
1927
1928function ForIVandUD(AnOrderID: string): boolean;
1929begin
1930 Result := SCallV('ORWDPS4 ISUDIV',[AnOrderID]) = '1';
1931end;
1932
1933function GetEventIFN(const AEvntID: string): string;
1934begin
1935 Result := sCallV('OREVNTX1 EVT',[AEvntID]);
1936end;
1937
1938function GetEventName(const AEvntID: string): string;
1939begin
1940 Result := sCallV('OREVNTX1 NAME',[AEvntID]);
1941end;
1942
1943function GetEventLoc(const APtEvntID: string): string;
1944begin
1945 Result := SCallV('OREVNTX1 LOC', [APtEvntID]);
1946end;
1947
1948function GetEventLoc1(const AnEvntID: string): string;
1949begin
1950 Result := SCallV('OREVNTX1 LOC1', [AnEvntID]);
1951end;
1952
1953function GetEventDiv(const APtEvntID: string): string;
1954begin
1955 Result := SCallV('OREVNTX1 DIV',[APtEvntID]);
1956end;
1957
1958function GetEventDiv1(const AnEvntID: string): string;
1959begin
1960 Result := SCallV('OREVNTX1 DIV1',[AnEvntID]);
1961end;
1962
1963function GetCurrentSpec(const APtIFN: string): string;
1964begin
1965 Result := SCallV('OREVNTX1 CURSPE', [APtIFN]);
1966end;
1967
1968function GetDefaultEvt(const AProviderIFN: string): string;
1969begin
1970 Result := SCallV('OREVNTX1 DFLTEVT',[AProviderIFN]);
1971end;
1972
1973procedure DeleteDefaultEvt;
1974begin
1975 SCallV('OREVNTX1 DELDFLT',[User.DUZ]);
1976end;
1977
1978function isExistedEvent(const APtDFN: string; const AEvtID: string; var APtEvtID: string): Boolean;
1979begin
1980 Result := False;
1981 APtEvtID := SCallV('OREVNTX1 EXISTS', [APtDFN,AEvtID]);
1982 if StrToIntDef(APtEvtID,0) > 0 then
1983 Result := True;
1984end;
1985
1986function TypeOfExistedEvent(APtDFN: string; AEvtID: Integer): Integer;
1987begin
1988 Result := StrToIntDef(SCallV('OREVNTX1 TYPEXT', [APtDFN,AEvtID]),0);
1989end;
1990
1991function isMatchedEvent(const APtDFN: string; const AEvtID: string; var ATs:string): Boolean;
1992var
1993 rst: string;
1994begin
1995 Result := False;
1996 rst := SCallV('OREVNTX1 MATCH',[APtDFN,AEvtID]);
1997 if StrToIntDef(Piece(rst,'^',1),0)>0 then
1998 begin
1999 ATs := Piece(rst,'^',2);
2000 Result := True;
2001 end;
2002end;
2003
2004function isDCedOrder(const AnOrderID: string): Boolean;
2005var
2006 rst: string;
2007begin
2008 Result := False;
2009 rst := SCAllV('OREVNTX1 ISDCOD',[AnOrderID]);
2010 if STrToIntDef(rst,0)>0 then
2011 Result := True;
2012end;
2013
2014function isOnholdMedOrder(AnOrderID: string): Boolean;
2015var
2016 rst: string;
2017begin
2018 Result := False;
2019 rst := SCAllV('OREVNTX1 ISHDORD',[AnOrderID]);
2020 if StrToIntDef(rst,0)>0 then
2021 Result := True;
2022end;
2023
2024function SetDefaultEvent(var AErrMsg: string; EvtID: string): Boolean;
2025begin
2026 AErrMsg := SCallV('OREVNTX1 SETDFLT',[EvtID]);
2027 Result := True;
2028end;
2029
2030function GetEventPromptID: integer;
2031var
2032 evtPrompt: string;
2033begin
2034 evtPrompt := SCallV('OREVNTX1 PRMPTID',[nil]);
2035 Result := StrToIntDef(evtPrompt,0);
2036end;
2037
2038function GetDefaultTSForEvt(AnEvtID: integer): string;
2039begin
2040 Result := SCallV('OREVNTX1 DEFLTS',[AnEvtID]);
2041end;
2042
2043function GetPromptIDs: string;
2044begin
2045 Result := SCallV('OREVNTX1 PROMPT IDS',[nil]);
2046end;
2047
2048function GetEventDefaultDlg(AEvtID: integer): string;
2049begin
2050 Result := SCallV('OREVNTX1 DFLTDLG',[AEvtID]);
2051end;
2052
2053function CanManualRelease: boolean;
2054var
2055 rst: integer;
2056begin
2057 Result := False;
2058 rst := StrToIntDef(SCallV('OREVNTX1 AUTHMREL',[nil]),0);
2059 if rst > 0 then
2060 Result := True;
2061end;
2062
2063function TheParentPtEvt(APtEvt: string): string;
2064begin
2065 Result := SCallV('OREVNTX1 HAVEPRT',[APtEvt]);
2066end;
2067
2068function IsCompletedPtEvt(APtEvtID: integer): boolean;
2069var
2070 rst : integer;
2071begin
2072 Result := False;
2073 rst := StrToIntDef(SCallV('OREVNTX1 COMP',[APtEvtID]),0);
2074 if rst > 0 then
2075 Result := True;
2076end;
2077
2078function IsPassEvt(APtEvtID: integer; APtEvtType: char): boolean;
2079var
2080 rst: integer;
2081begin
2082 Result := False;
2083 rst := StrToIntDef(SCallV('OREVNTX1 ISPASS',[APtEvtID, APtEvtType]),0);
2084 if rst = 1 then
2085 Result := True;
2086end;
2087
2088function IsPassEvt1(AnEvtID: integer; AnEvtType: char): boolean;
2089var
2090 rst: integer;
2091begin
2092 Result := False;
2093 rst := StrToIntDef(SCallV('OREVNTX1 ISPASS1',[AnEvtID, AnEvtType]),0);
2094 if rst = 1 then
2095 Result := True;
2096end;
2097
2098procedure TerminatePtEvt(APtEvtID: integer);
2099begin
2100 SCallV('OREVNTX1 DONE',[APtEvtID]);
2101end;
2102
2103procedure SetPtEvtList(Dest: TStrings; APtDFN: string; var ATotal: Integer);
2104begin
2105 CallV('OREVNTX LIST',[APtDFN]);
2106 if RPCBrokerV.Results.Count > 0 then
2107 begin
2108 ATotal := StrToIntDef(RPCBrokerV.Results[0],0);
2109 if ATotal > 0 then
2110 begin
2111 MixedCaseList( RPCBrokerV.Results );
2112 RPCBrokerV.Results.Delete(0);
2113 Dest.Assign(RPCBrokerV.Results);
2114 end;
2115 end;
2116end;
2117
2118procedure GetTSListForEvt(Dest: TStrings; AnEvtID:integer);
2119begin
2120 CallV('OREVNTX1 MULTS',[AnEvtID]);
2121 if RPCBrokerV.Results.Count > 0 then
2122 begin
2123 SortByPiece(TStringList(RPCBrokerV.Results),'^',2);
2124 Dest.Assign(RPCBrokerV.Results);
2125 end;
2126end;
2127
2128procedure GetChildEvent(var AChildList: TStringList; APtEvtID: string);
2129begin
2130//
2131end;
2132
2133function DeleteEmptyEvt(APtEvntID: string; var APtEvntName: string; Ask: boolean): boolean;
2134//const
2135//TX_EVTDEL1 = 'There are no orders tied to '; <-- original line. //kt 8/8/2007
2136//TX_EVTDEL2 = ', Would you like to cancel it?'; <-- original line. //kt 8/8/2007
2137var
2138 TX_EVTDEL1 : string; //kt
2139 TX_EVTDEL2 : string; //kt
2140
2141begin
2142 TX_EVTDEL1 := DKLangConstW('rOrders_There_are_no_orders_tied_to'); //kt added 8/8/2007
2143 TX_EVTDEL2 := DKLangConstW('rOrders_x_Would_you_like_to_cancel_itx'); //kt added 8/8/2007
2144 Result := false;
2145 if APtEvntID = '0' then
2146 begin
2147 Result := True;
2148 Exit;
2149 end;
2150 if PtEvtEmpty(APtEvntID) then
2151 begin
2152 if Length(APtEvntName)=0 then
2153 APtEvntName := GetEventName(APtEvntID);
2154 if Ask then
2155 begin
2156// if InfoBox(TX_EVTDEL1 + APtEvntName + TX_EVTDEL2, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then <-- original line. //kt 8/8/2007
2157 if InfoBox(TX_EVTDEL1 + APtEvntName + TX_EVTDEL2, DKLangConstW('rOrders_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES then //kt added 8/8/2007
2158 begin
2159 DeletePtEvent(APtEvntID);
2160 Result := True;
2161 end;
2162 end;
2163 if not Ask then
2164 begin
2165 DeletePtEvent(APtEvntID);
2166 Result := True;
2167 end;
2168
2169 end;
2170end;
2171
2172function CompleteEvt(APtEvntID: string; APtEvntName: string; Ask: boolean): boolean;
2173//const
2174//TX_EVTFIN1 = 'All of the orders tied to '; <-- original line. //kt 8/8/2007
2175//TX_EVTFIN2 = ' have been released to a service, ' + #13 + 'Would you like to terminate this event?'; <-- original line. //kt 8/8/2007
2176var
2177 ThePtEvtName: string;
2178 TX_EVTFIN1 : string; //kt
2179 TX_EVTFIN2 : string; //kt
2180begin
2181 TX_EVTFIN1 := DKLangConstW('rOrders_All_of_the_orders_tied_to'); //kt added 8/8/2007
2182 TX_EVTFIN2 := DKLangConstW('rOrders_have_been_released_to_a_servicex')+' ' + #13 + DKLangConstW('rOrders_Would_you_like_to_terminate_this_eventx'); //kt added 8/8/2007
2183 Result := false;
2184 if APtEvntID = '0' then
2185 begin
2186 Result := True;
2187 Exit;
2188 end;
2189 if PtEvtEmpty(APtEvntID) then
2190 begin
2191 if Length(APtEvntName)=0 then
2192 ThePtEvtName := GetEventName(APtEvntID)
2193 else
2194 ThePtEvtName := APtEvntName;
2195 if Ask then
2196 begin
2197// if InfoBox(TX_EVTFIN1 + ThePtEvtName + TX_EVTFIN2, 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then <-- original line. //kt 8/8/2007
2198 if InfoBox(TX_EVTFIN1 + ThePtEvtName + TX_EVTFIN2, DKLangConstW('rOrders_Confirmation'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK then //kt added 8/8/2007
2199 begin
2200 SCallV('OREVNTX1 DONE',[APtEvntID]);
2201 Result := True;
2202 end;
2203 end else
2204 begin
2205 SCallV('OREVNTX1 DONE',[APtEvntID]);
2206 Result := True;
2207 end;
2208 end;
2209end;
2210
2211{ Order Checking }
2212
2213function FillerIDForDialog(IEN: Integer): string;
2214begin
2215 Result := sCallV('ORWDXC FILLID', [IEN]);
2216end;
2217
2218function OrderChecksEnabled: Boolean;
2219begin
2220 if uOrderChecksOn = #0 then uOrderChecksOn := CharAt(sCallV('ORWDXC ON', [nil]), 1);
2221 Result := uOrderChecksOn = 'E';
2222end;
2223
2224function OrderChecksOnDisplay(const FillerID: string): string;
2225begin
2226 CallV('ORWDXC DISPLAY', [Patient.DFN, FillerID]);
2227 with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
2228end;
2229
2230procedure OrderChecksOnAccept(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
2231 OIList: TStringList; DupORIFN: string);
2232begin
2233 // don't pass OIList if no items, since broker pauses 5 seconds per order
2234 if OIList.Count > 0
2235 then CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList, DupORIFN])
2236 else CallV('ORWDXC ACCEPT', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
2237 ListOfChecks.Assign(RPCBrokerV.Results);
2238end;
2239
2240procedure OrderChecksOnDelay(ListOfChecks: TStringList; const FillerID, StartDtTm: string;
2241 OIList: TStringList);
2242begin
2243 // don't pass OIList if no items, since broker pauses 5 seconds per order
2244 if OIList.Count > 0
2245 then CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location, OIList])
2246 else CallV('ORWDXC DELAY', [Patient.DFN, FillerID, StartDtTm, Encounter.Location]);
2247 ListOfChecks.Assign(RPCBrokerV.Results);
2248end;
2249
2250procedure OrderChecksForSession(ListOfChecks, OrderList: TStringList);
2251begin
2252 CallV('ORWDXC SESSION', [Patient.DFN, OrderList]);
2253 ListOfChecks.Assign(RPCBrokerV.Results);
2254end;
2255
2256procedure SaveOrderChecksForSession(const AReason: string; ListOfChecks: TStringList);
2257begin
2258 CallV('ORWDXC SAVECHK', [Patient.DFN, AReason, ListOfChecks]);
2259 { no result used currently }
2260end;
2261
2262function DeleteCheckedOrder(const OrderID: string): Boolean;
2263begin
2264 Result := sCallV('ORWDXC DELORD', [OrderID]) = '1';
2265end;
2266
2267function DataForOrderCheck(const OrderID: string): string;
2268begin
2269 Result := sCallV('ORWDXR01 OXDATA',[OrderID]);
2270end;
2271
2272(*
2273 TEMPORARILY COMMENTED OUT WHILE TESTING
2274function GetPromptandDeviceParameters(Location: integer; OrderList: TStringList; Nature: string): TPrintParams;
2275var
2276 TempParams: TPrintParams;
2277 x: string;
2278begin
2279 tempParams.OrdersToPrint := TStringList.Create;
2280 try
2281 CallV('ORWD1 PARAM', [Location, Nature, OrderList]);
2282 x := RPCBrokerV.Results[0];
2283 with TempParams do
2284 begin
2285 PromptForChartCopy := CharAt(Piece(x, U, 1),1);
2286 if Piece(x, U, 5) <> '' then
2287 ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2);
2288 PromptForLabels := CharAt(Piece(x, U, 2),1);
2289 if Piece(x, U, 6) <> '' then
2290 LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2);
2291 PromptForRequisitions := CharAt(Piece(x, U, 3),1);
2292 if Piece(x, U, 7) <> '' then
2293 RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2);
2294 PromptForWorkCopy := CharAt(Piece(x, U, 4),1);
2295 if Piece(x, U, 8) <> '' then
2296 WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2);
2297 AnyPrompts := ((PromptForChartCopy in ['1','2']) or
2298 (PromptForLabels in ['1','2']) or
2299 (PromptForRequisitions in ['1','2']) or
2300 (PromptForWorkCopy in ['1','2']));
2301 RPCBrokerV.Results.Delete(0);
2302 OrdersToPrint.Assign(RPCBrokerV.Results);
2303 end;
2304 Result := TempParams;
2305 finally
2306 tempParams.OrdersToPrint.Free;
2307 end;
2308end;
2309*)
2310
2311procedure OrderPrintDeviceInfo(OrderList: TStringList; var PrintParams: TPrintParams; Nature: Char);
2312var
2313 x: string;
2314begin
2315 if Nature <> #0 then
2316 CallV('ORWD2 DEVINFO', [Encounter.Location, Nature, OrderList])
2317 else
2318 CallV('ORWD2 MANUAL', [Encounter.Location, OrderList]);
2319 x := RPCBrokerV.Results[0];
2320 FillChar(PrintParams, SizeOf(PrintParams), #0);
2321 with PrintParams do
2322 begin
2323 PromptForChartCopy := CharAt(Piece(x, U, 1),1);
2324 if Piece(x, U, 5) <> '' then
2325 ChartCopyDevice := Piece(Piece(x, U, 5),';',1) + '^' + Piece(Piece(x, U, 5),';',2);
2326 PromptForLabels := CharAt(Piece(x, U, 2),1);
2327 if Piece(x, U, 6) <> '' then
2328 LabelDevice := Piece(Piece(x, U, 6),';',1) + '^' + Piece(Piece(x, U, 6),';',2);
2329 PromptForRequisitions := CharAt(Piece(x, U, 3),1);
2330 if Piece(x, U, 7) <> '' then
2331 RequisitionDevice := Piece(Piece(x, U, 7),';',1) + '^' + Piece(Piece(x, U, 7),';',2);
2332 PromptForWorkCopy := CharAt(Piece(x, U, 4),1);
2333 if Piece(x, U, 8) <> '' then
2334 WorkCopyDevice := Piece(Piece(x, U, 8),';',1) + '^' + Piece(Piece(x, U, 8),';',2);
2335 AnyPrompts := ((PromptForChartCopy in ['1','2']) or
2336 (PromptForLabels in ['1','2']) or
2337 (PromptForRequisitions in ['1','2']) or
2338 (PromptForWorkCopy in ['1','2']));
2339 end;
2340 if Nature <> #0 then
2341 begin
2342 RPCBrokerV.Results.Delete(0);
2343 OrderList.Clear;
2344 OrderList.Assign(RPCBrokerV.Results);
2345 end;
2346end;
2347
2348procedure SaveEvtForOrder(APtDFN: string; AEvt: integer; AnOrderID: string);
2349var
2350 TheEventID: string;
2351begin
2352 TheEventID := SCallV('OREVNTX1 PUTEVNT',[APtDFN,IntToStr(AEvt),AnOrderID]);
2353end;
2354
2355function EventExist(APtDFN:string; AEvt: integer): integer;
2356var
2357 AOutCome: string;
2358begin
2359 AOutCome := SCallV('OREVNTX1 EXISTS', [APtDFN,IntToStr(AEvt)]);
2360 if AOutCome = '' then
2361 Result := 0
2362 else
2363 Result := StrToInt(AOutCome);
2364end;
2365
2366function UseNewMedDialogs: Boolean;
2367begin
2368 Result := sCallV('ORWDPS1 CHK94', [nil]) = '1';
2369end;
2370
2371{ Copay }
2372procedure GetCoPay4Orders;
2373begin
2374 RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPLST';
2375 RPCBrokerV.Param[0].PType := literal;
2376 RPCBrokerV.Param[0].Value := Patient.DFN;
2377 CallBroker;
2378end;
2379
2380procedure SaveCoPayStatus(AList: TStrings);
2381var
2382 i: integer;
2383
2384begin
2385 if AList.Count > 0 then
2386 begin
2387 RPCBrokerV.ClearParameters := True;
2388 RPCBrokerV.RemoteProcedure := 'ORWDPS4 CPINFO';
2389 RPCBrokerV.Param[0].PType := list;
2390 for i := 0 to AList.Count-1 do
2391 RPCBrokerV.Param[0].Mult[IntToStr(i+1)] := AList[i];
2392 CallBroker;
2393 end;
2394end;
2395
2396
2397
2398function IsValidIMOLoc(LocID: integer; PatientID: string): boolean; //IMO
2399var
2400 rst: string;
2401begin
2402 rst := SCallV('ORIMO IMOLOC',[LocID, PatientID]);
2403 Result := StrToIntDef(rst,-1) > -1;
2404end;
2405
2406function IsIMOOrder(OrderID: string): boolean; //IMO
2407begin
2408 Result := SCallV('ORIMO IMOOD',[OrderId])='1';
2409end;
2410
2411function IsInptQO(DlgID: integer): boolean;
2412begin
2413 Result := SCallV('ORWDXM3 ISUDQO', [DlgID]) = '1';
2414end;
2415
2416function IsIVQO(DlgID: integer): boolean;
2417begin
2418 Result := SCallV('ORIMO ISIVQO', [DlgID]) = '1';
2419end;
2420
2421function IsClinicLoc(ALoc: integer): boolean;
2422begin
2423 Result := SCallV('ORIMO ISCLOC', [ALoc]) = '1';
2424end;
2425
2426function IsValidSchedule(AnOrderID: string): boolean; //nss
2427begin
2428 result := SCallV('ORWNSS VALSCH', [AnOrderID]) = '1';
2429end;
2430
2431function IsValidQOSch(QOID: string): string; //nss
2432begin
2433 Result := SCallV('ORWNSS QOSCH',[QOID]);
2434end;
2435
2436function IsValidSchStr(ASchStr: string): boolean;
2437begin
2438 Result := SCallV('ORWNSS CHKSCH',[ASchStr]) = '1';
2439end;
2440
2441{ TParentEvent }
2442
2443procedure TParentEvent.Assign(AnEvtID: string);
2444var
2445 evtInfo: string;
2446begin
2447// ORY = EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
2448 evtInfo := EventInfo1(AnEvtID);
2449 ParentIFN := StrToInt(AnEvtID);
2450 if Length(Piece(evtInfo,'^',4)) < 1 then
2451 ParentName := Piece(evtInfo,'^',3)
2452 else
2453 ParentName := Piece(evtInfo,'^',4);
2454 ParentType := CharAt(Piece(evtInfo,'^',1),1);
2455 ParentDlg := Piece(evtInfo,'^',5);
2456end;
2457
2458constructor TParentEvent.Create;
2459begin
2460 ParentIFN := 0;
2461 ParentName := '';
2462 ParentType := #0;
2463 ParentDlg := '0';
2464end;
2465
2466initialization
2467 uDGroupAll := 0;
2468 uOrderChecksOn := #0;
2469
2470finalization
2471 if uDGroupMap <> nil then uDGroupMap.Free;
2472
2473end.
2474
Note: See TracBrowser for help on using the repository browser.