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

Last change on this file since 837 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 27.8 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: Integer;
449 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) 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 end;
487 if ConstructOrder.DelayEvent in ['A','D','T','M','O'] then
488 Param[7].Mult['"OREVENT"'] := ConstructOrder.PTEventPtr;
489 if ConstructOrder.LogTime > 0
490 then Param[7].Mult['"ORSLOG"'] := FloatToStr(ConstructOrder.LogTime);
491 Param[7].Mult['"ORTS"'] := IntToStr(Patient.Specialty); // pass in treating specialty for ORTS
492 Param[8].PType := literal;
493 Param[8].Value := ConstructOrder.DigSig;
494 if Constructorder.IsIMODialog then
495 begin
496 Param[9].PType := literal; //IMO
497 Param[9].Value := FloatToStr(Encounter.DateTime);
498 end else
499 begin
500 Param[9].PType := literal; //IMO
501 Param[9].Value := '';
502 end;
503 Param[10].PType := literal;
504 Param[10].Value := OrderSource;
505 Param[11].PType := literal;
506 Param[11].Value := IntToStr(Constructorder.IsEventDefaultOR);
507
508 CallBroker;
509 if Results.Count = 0 then Exit; // error creating order
510 x := Results[0];
511 Results.Delete(0);
512 y := '';
513
514 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
515 begin
516 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
517 Results.Delete(0);
518 end;
519 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
520 z := '';
521 if (Results.Count > 0) and (Results[0] = '|') then
522 begin
523 Results.Delete(0);
524 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
525 begin
526 z := z + Copy(Results[0], 2, Length(Results[0]));
527 Results.Delete(0);
528 end;
529 end;
530 SetOrderFields(AnOrder, x, y, z);
531 end;
532end;
533
534{ no longer used -
535procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer);
536var
537 i: Integer;
538 y: string;
539begin
540 CallV('ORWDXM AUTOACK', [Patient.DFN, Encounter.Provider, Encounter.Location, ADialog]);
541 with RPCBrokerV do if Results.Count > 0 then
542 begin
543 y := '';
544 for i := 1 to Results.Count - 1 do
545 y := y + Copy(Results[i], 2, Length(Results[i])) + CRLF;
546 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
547 SetOrderFields(AnOrder, Results[0], y);
548 end;
549end;
550}
551
552function OIMessage(IEN: Integer): string;
553begin
554 CallV('ORWDX MSG', [IEN]);
555 with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
556end;
557
558function OrderMenuStyle: Integer;
559begin
560 Result := StrToIntDef(sCallV('ORWDXM MSTYLE', [nil]), 0);
561end;
562
563function ResolveScreenRef(const ARef: string): string;
564begin
565 Result := sCallV('ORWDXM RSCRN', [ARef]);
566end;
567
568function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
569 const XRef: string): TStrings;
570{ returns a pointer to a list of orderable items matching an S.xxx cross reference (for use in
571 a long list box) - The return value is a pointer to RPCBrokerV.Results, so the data must
572 be used BEFORE the next broker call! }
573begin
574 CallV('ORWDX ORDITM', [StartFrom, Direction, XRef]);
575 Result := RPCBrokerV.Results;
576end;
577
578function GetDefaultCopay(AnOrderID: string): String;
579begin
580 with RPCBrokerV do
581 begin
582 ClearParameters := True;
583 RemoteProcedure := 'ORWDPS4 CPLST';
584 Param[0].PType := literal;
585 Param[0].Value := Patient.DFN;
586 Param[1].PType := list;
587 Param[1].Mult['1'] := AnOrderID;
588 end;
589 CallBroker;
590 if RPCBrokerV.Results.Count > 0 then
591 Result := RPCBrokerV.Results[0]
592 else
593 Result := '';
594end;
595
596procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
597var
598 temp,CPExems: string;
599 CoPayValue: array [1..7] of Char;
600 i: integer;
601begin
602 // SC AO IR EC MST HNC CV
603 CoPayValue[1] := 'N';
604 CoPayValue[2] := 'N';
605 CoPayValue[3] := 'N';
606 CoPayValue[4] := 'N';
607 CoPayValue[5] := 'N';
608 CoPayValue[6] := 'N';
609 CoPayValue[7] := 'N';
610 temp := Pieces(CoPayInfo,'^',2,6);
611 i := 1;
612 while Length(Piece(temp,'^',i))>0 do
613 begin
614 if Piece(Piece(temp,'^',i),';',1) = 'SC' then
615 begin
616 if Piece( Piece(temp,'^',i),';',2) = '1' then
617 CoPayValue[1] := 'C'
618 else
619 CopayValue[1] := 'U';
620 end;
621 if Piece(Piece(temp,'^',i),';',1) = 'AO' then
622 begin
623 if Piece( Piece(temp,'^',i),';',2) = '1' then
624 CoPayValue[2] := 'C'
625 else
626 CopayValue[2] := 'U';
627 end;
628 if Piece(Piece(temp,'^',i),';',1) = 'IR' then
629 begin
630 if Piece( Piece(temp,'^',i),';',2) = '1' then
631 CoPayValue[3] := 'C'
632 else
633 CopayValue[3] := 'U';
634 end;
635 if Piece(Piece(temp,'^',i),';',1) = 'EC' then
636 begin
637 if Piece( Piece(temp,'^',i),';',2) = '1' then
638 CoPayValue[4] := 'C'
639 else
640 CopayValue[4] := 'U';
641 end;
642 if Piece(Piece(temp,'^',i),';',1) = 'MST' then
643 begin
644 if Piece( Piece(temp,'^',i),';',2) = '1' then
645 CoPayValue[5] := 'C'
646 else
647 CopayValue[5] := 'U';
648 end;
649 if Piece(Piece(temp,'^',i),';',1) = 'HNC' then
650 begin
651 if Piece( Piece(temp,'^',i),';',2) = '1' then
652 CoPayValue[6] := 'C'
653 else
654 CopayValue[6] := 'U';
655 end;
656 if Piece(Piece(temp,'^',i),';',1) = 'CV' then
657 begin
658 if Piece( Piece(temp,'^',i),';',2) = '1' then
659 CoPayValue[7] := 'C'
660 else
661 CopayValue[7] := 'U';
662 end;
663 i := i + 1;
664 end;
665 CPExems := CoPayValue[1] + CoPayValue[2] + CoPayValue[3] + CoPayValue[4]
666 + CoPayValue[5] + CoPayValue[6] + CoPayValue[7];
667 CPExems := AnOrderId + '^' + CPExems;
668 with RPCBrokerV do
669 begin
670 ClearParameters := True;
671 RemoteProcedure := 'ORWDPS4 CPINFO';
672 Param[0].PType := list;
673 Param[0].Mult['1'] := CPExems;
674 CallBroker;
675 end;
676end;
677
678function SubsetOfEntries(const StartFrom: string; Direction: Integer;
679 const XRef, GblRef, ScreenRef: string): TStrings;
680{ returns a pointer to a list of file entries (for use in a long list box) -
681 The return value is a pointer to RPCBrokerV.Results, so the data must
682 be used BEFORE the next broker call! }
683begin
684 CallV('ORWDOR LKSCRN', [StartFrom, Direction, XRef, GblRef, ScreenRef]);
685 Result := RPCBrokerV.Results;
686end;
687
688procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
689begin
690 ErrMsg := sCallV('ORWDOR VALNUM', [x, Dom]);
691 if ErrMsg = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
692end;
693
694function IsPFSSActive: boolean;
695begin
696 with uPFSSActive do
697 if not PFSSChecked then
698 begin
699 PFSSActive := (sCallV('ORWPFSS IS PFSS ACTIVE?', [nil]) = '1');
700 PFSSChecked := True;
701 end;
702 Result := uPFSSActive.PFSSActive
703end;
704
705{ Medication Calls }
706
707procedure AppendMedRoutes(Dest: TStrings);
708var
709 i: Integer;
710 x: string;
711begin
712 if uMedRoutes = nil then
713 begin
714 CallV('ORWDPS32 ALLROUTE', [nil]);
715 with RPCBrokerV do
716 begin
717 uMedRoutes := TStringList.Create;
718 FastAssign(RPCBrokerV.Results, uMedRoutes);
719 for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
720 begin
721 x := Piece(Results[i], U, 1) + U + Piece(Results[i], U, 3) +
722 ' (' + Piece(Results[i], U, 2) + ')' + U + Piece(Results[i], U, 3);
723 uMedRoutes.Add(x);
724 end; {if Length}
725 SortByPiece(uMedRoutes, U, 2);
726 end; {with RPCBrokerV}
727 end; {if uMedRoutes}
728 FastAddStrings(uMedRoutes, Dest);
729end;
730
731procedure CheckAuthForMeds(var x: string);
732begin
733 x := Piece(sCallV('ORWDPS32 AUTH', [Encounter.Provider]), U, 2);
734end;
735
736function DispenseMessage(AnIEN: Integer): string;
737var
738 x: string;
739begin
740 if AnIEN = uLastDispenseIEN then Result := uLastDispenseMsg else
741 begin
742 x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
743 uLastDispenseIEN := AnIEN;
744 uLastDispenseMsg := Piece(x, U, 1);
745 uLastQuantityMsg := Piece(x, U, 2);
746 Result := uLastDispenseMsg;
747 end;
748end;
749
750function QuantityMessage(AnIEN: Integer): string;
751var
752 x: string;
753begin
754 if AnIEN = uLastDispenseIEN then Result := uLastQuantityMsg else
755 begin
756 x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
757 uLastDispenseIEN := AnIEN;
758 uLastDispenseMsg := Piece(x, U, 1);
759 uLastQuantityMsg := Piece(x, U, 2);
760 Result := uLastQuantityMsg;
761 end;
762end;
763
764function RequiresCopay(DispenseDrug: Integer): Boolean;
765begin
766 Result := sCallV('ORWDPS32 SCSTS', [Patient.DFN, DispenseDrug]) = '1';
767end;
768
769procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
770begin
771 CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
772 FastAssign(RPCBrokerV.Results, AList);
773end;
774
775procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
776var
777 x: string;
778begin
779 x := sCallV('ORWDPS32 VALROUTE', [AName]);
780 ID := Piece(x, U, 1);
781 Abbreviation := Piece(x, U, 2);
782end;
783
784function MedIsSupply(AnIEN: Integer): Boolean;
785begin
786 Result := sCallV('ORWDPS32 ISSPLY', [AnIEN]) = '1';
787end;
788
789function MedTypeIsIV(AnIEN: Integer): Boolean;
790begin
791 Result := sCallV('ORWDPS32 MEDISIV', [AnIEN]) = '1';
792end;
793
794function ODForMedIn: TStrings;
795{ Returns init values for inpatient meds dialog. The results must be used immediately. }
796begin
797 CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE, patient.dfn, patient.location]);
798 Result := RPCBrokerV.Results;
799end;
800
801function ODForIVFluids: TStrings;
802{ Returns init values for IV Fluids dialog. The results must be used immediately. }
803begin
804 CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS, patient.dfn, patient.location]);
805 Result := RPCBrokerV.Results;
806end;
807
808function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
809begin
810 Result := sCallV('ORWDPS32 IVAMT', [AnIEN, FluidType]);
811end;
812
813function ODForMedOut: TStrings;
814{ Returns init values for outpatient meds dialog. The results must be used immediately. }
815begin
816 CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT, patient.dfn, patient.location]);
817 Result := RPCBrokerV.Results;
818end;
819
820function OIForMedIn(AnIEN: Integer): TStrings;
821{ Returns init values for inpatient meds order item. The results must be used immediately. }
822begin
823 CallV('ORWDPS32 OISLCT', [AnIEN, PST_UNIT_DOSE, Patient.DFN]);
824 Result := RPCBrokerV.Results;
825end;
826
827function OIForMedOut(AnIEN: Integer): TStrings;
828{ Returns init values for outpatient meds order item. The results must be used immediately. }
829begin
830 CallV('ORWDPS32 OISLCT', [AnIEN, PST_OUTPATIENT, Patient.DFN]);
831 Result := RPCBrokerV.Results;
832end;
833
834function RatedDisabilities: string;
835{ Returns a list of rated disabilities, if any, for a patient }
836begin
837 CallV('ORWPCE SCDIS', [Patient.DFN]);
838 Result := RPCBrokerV.Results.Text;
839end;
840
841procedure ValidateIVRate(var x: string);
842begin
843 x := sCallV('ORWDPS32 VALRATE', [x]);
844end;
845
846//function ValidIVRate(const x: string): Boolean;
847//{ returns true if the text entered as the IV rate is valid }
848//begin
849// Result := sCallV('ORWDPS32 VALRATE', [x]) = '1';
850//end;
851
852function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
853{ returns 1 if schedule is valid, 0 if schedule is not valid, -1 pharmacy routine not there }
854begin
855 Result := StrToIntDef(sCallV('ORWDPS32 VALSCH', [x, PSType]), -1);
856end;
857
858function ValidQuantity(const x: string): Boolean;
859{ returns true if the text entered as the quantity is valid }
860begin
861 Result := sCallV('ORWDPS32 VALQTY', [Trim(x)]) = '1';
862end;
863
864function ODForVitals: TStrings;
865{ Returns init values for vitals dialog. The results must be used immediately. }
866begin
867 CallV('ORWDOR VMSLCT', [nil]);
868 Result := RPCBrokerV.Results;
869end;
870
871initialization
872 uLastDispenseIEN := 0;
873 uLastDispenseMsg := '';
874
875finalization
876 if uMedRoutes <> nil then uMedRoutes.Free;
877
878end.
Note: See TracBrowser for help on using the repository browser.