source: cprs/trunk/CPRS-Chart/Orders/rODBase.pas@ 1695

Last change on this file since 1695 was 1679, checked in by healthsevak, 10 years ago

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