source: cprs/trunk/CPRS-Chart/Orders/rOrders.pas@ 1806

Last change on this file since 1806 was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

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