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

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

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