source: cprs/branches/foia-cprs/CPRS-Chart/Orders/rODBase.pas@ 667

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

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