source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/rODBase.~pas@ 697

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 28.0 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rODBase;
3
4interface
5
6uses SysUtils, Windows, Classes, ORNet, ORFn, uCore, uConst, rOrders;
7
8type
9 TPrompt = class
10 ID: string;
11 IEN: Integer;
12 Sequence: Double;
13 FmtCode: string;
14 Omit: string;
15 Leading: string;
16 Trailing: string;
17 NewLine: Boolean;
18 WrapWP: Boolean;
19 Children: string;
20 IsChild: Boolean;
21 end;
22
23 TResponse = class
24 PromptIEN: Integer;
25 PromptID: string;
26 Instance: Integer;
27 IValue: string;
28 EValue: string;
29 end;
30
31 TDialogItem = class
32 ID: string;
33 Required: Boolean;
34 Hidden: Boolean;
35 Prompt: string;
36 DataType: Char;
37 Domain: string;
38 EDefault: string;
39 IDefault: string;
40 HelpText: string;
41 CrossRef: string;
42 ScreenRef: string;
43 end;
44
45 TDialogNames = record
46 Internal: string;
47 Display: string;
48 BaseIEN: Integer;
49 BaseName: string;
50 end;
51
52 TConstructOrder = record
53 DialogName: string;
54 LeadText: string;
55 TrailText: string;
56 DGroup: Integer;
57 OrderItem: Integer;
58 DelayEvent: Char;
59 PTEventPtr: String; // ptr to #100.2
60 EventPtr: String; // ptr to #100.5
61 Specialty: Integer;
62 Effective: TFMDateTime;
63 LogTime: TFMDateTime;
64 OCList: TStringList;
65 DigSig: string;
66 ResponseList: TList;
67 IsIMODialog: boolean; //imo
68 IsEventDefaultOR: Integer;
69 end;
70
71 TPFSSActive = record
72 PFSSActive: boolean;
73 PFSSChecked: boolean;
74 end;
75
76{ General Calls }
77function AskAnotherOrder(ADialog: Integer): Boolean;
78function DisplayGroupByName(const AName: string): Integer;
79function DisplayGroupForDialog(const DialogName: string): Integer;
80procedure IdentifyDialog(var DialogNames: TDialogNames; ADialog: Integer);
81procedure LoadDialogDefinition(Dest: TList; const DialogName: string);
82procedure LoadOrderPrompting(Dest: TList; ADialog: Integer);
83//procedure LoadResponses(Dest: TList; const OrderID: string);
84procedure LoadResponses(Dest: TList; const OrderID: string; var HasObjects: boolean);
85procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
86//procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer); // no longer used
87function OIMessage(IEN: Integer): string;
88function OrderMenuStyle: Integer;
89function ResolveScreenRef(const ARef: string): string;
90function SubsetOfEntries(const StartFrom: string; Direction: Integer;
91 const XRef, GblRef, ScreenRef: string): TStrings;
92function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
93 const XRef: string): TStrings;
94function GetDefaultCopay(AnOrderID: string): String;
95procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
96procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
97function IsPFSSActive: boolean;
98
99{ Quick Order Calls }
100//function DisplayNameForOD(const InternalName: string): string;
101function GetQuickName(const CRC: string): string;
102procedure LoadQuickListForOD(Dest: TStrings; DGroup: Integer);
103procedure SaveQuickListForOD(Src: TStrings; DGroup: Integer);
104//procedure PutQuickName(DialogIEN: Integer; const DisplayName: string);
105procedure PutQuickOrder(var NewIEN: Integer; const CRC, DisplayName: string; DGroup: Integer;
106 ResponseList: TList);
107
108{ Medication Calls }
109function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
110procedure AppendMedRoutes(Dest: TStrings);
111procedure CheckAuthForMeds(var x: string);
112function DispenseMessage(AnIEN: Integer): string;
113procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
114function MedIsSupply(AnIEN: Integer): Boolean;
115function QuantityMessage(AnIEN: Integer): string;
116function RequiresCopay(DispenseDrug: Integer): Boolean;
117procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
118function MedTypeIsIV(AnIEN: Integer): Boolean;
119function ODForMedIn: TStrings;
120function OIForMedIn(AnIEN: Integer): TStrings;
121function ODForIVFluids: TStrings;
122function ODForMedOut: TStrings;
123function OIForMedOut(AnIEN: Integer): TStrings;
124function RatedDisabilities: string;
125//function ValidIVRate(const x: string): Boolean;
126procedure ValidateIVRate(var x: string);
127function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
128function ValidQuantity(const x: string): Boolean;
129
130{ Vitals Calls }
131function ODForVitals: TStrings;
132
133implementation
134
135uses TRPCB, uOrders, uODBase
136 ,DKLang //kt
137 ;
138
139var
140 uLastDispenseIEN: Integer;
141 uLastDispenseMsg: string;
142 uLastQuantityMsg: string;
143 uMedRoutes: TStringList;
144 uPFSSActive: TPFSSActive;
145
146{ Common Internal Calls }
147
148procedure SetupORDIALOG(AParam: TParamRecord; ResponseList: TList; IsIV: boolean = False);
149const
150 MAX_STR_LEN = 74;
151
152var
153 i,j,ALine,odIdx,piIdx : Integer;
154 Subs, x, ODtxt, thePI: string;
155 WPStrings: TStringList;
156 IVDuration, IVDurVal: string;
157begin
158 piIdx := 0;
159 odIdx := 0;
160 IVDuration := '';
161 IVDurVal := '';
162 AParam.PType := list;
163 for j := 0 to ResponseList.Count - 1 do
164 begin
165 if TResponse(ResponseList.Items[j]).PromptID = 'SIG' then
166 begin
167 ODtxt := TResponse(ResponseList.Items[j]).EValue;
168 odIdx := j;
169 end;
170 if TResponse(ResponseList.Items[j]).PromptID = 'PI' then
171 thePI := TResponse(ResponseList.Items[j]).EValue;
172 if Length(Trim(thePI)) > 0 then
173 piIdx := Pos(thePI, ODtxt);
174 if piIdx > 0 then
175 begin
176 Delete(ODtxt,piIdx,Length(thePI));
177 TResponse(ResponseList.Items[odIdx]).EValue := ODtxt;
178 end;
179 if (IsIV and (TResponse(ResponseList.Items[j]).PromptID = 'DAYS')) then
180 begin
181 IVDuration := TResponse(ResponseList.Items[j]).EValue;
182 if (Length(IVDuration) > 1) then
183 begin
184 if (Pos('TOTAL',upperCase(IVDuration))>0) or (Pos('FOR',upperCase(IVDuration))>0) then continue;
185 if (Pos('H',upperCase(IVDuration))>0) then
186 begin
187 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
188// TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'hours'; <-- original line. //kt 8/8/2007
189 TResponse(ResponseList.Items[j]).IValue := DKLangConstW('rODBase_for') + IVDurVal + DKLangConstW('rODBase_hours'); //kt added 8/8/2007
190 end
191 else if (Pos('D',upperCase(IVDuration))>0) then
192 begin
193 IVDurVal := Copy(IVDuration,1,length(IVDuration)-1);
194// TResponse(ResponseList.Items[j]).IValue := 'for ' + IVDurVal + 'days'; <-- original line. //kt 8/8/2007
195 TResponse(ResponseList.Items[j]).IValue := DKLangConstW('rODBase_for') + IVDurVal + DKLangConstW('rODBase_days'); //kt added 8/8/2007
196 end
197 else if ((Pos('ML',upperCase(IVDuration))>0) or (Pos('CC',upperCase(IVDuration))>0)) then
198 begin
199 IVDurVal := Copy(IVDuration,1,length(IVDuration)-2);
200// TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'ml'; <-- original line. //kt 8/8/2007
201 TResponse(ResponseList.Items[j]).IValue := DKLangConstW('rODBase_with_total_volume') + IVDurVal + 'ml'; //kt added 8/8/2007
202 end
203 else if (Pos('L',upperCase(IVDuration))>0) then
204 begin
205 IVDurVal := Copy(IVDuration,0,length(IVDuration)-1);
206// TResponse(ResponseList.Items[j]).IValue := 'with total volume ' + IVDurVal + 'L'; <-- original line. //kt 8/8/2007
207 TResponse(ResponseList.Items[j]).IValue := DKLangConstW('rODBase_with_total_volume') + IVDurVal + 'L'; //kt added 8/8/2007
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 Dest.Assign(RPCBrokerV.Results);
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 TempBroker.Assign(RPCBrokerV.Results);
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);
437begin
438 CallV('ORWDX LOADRSP', [OrderID]);
439 ExtractToResponses(Dest, HasObjects);
440end;
441
442procedure PutNewOrder(var AnOrder: TOrder; ConstructOrder: TConstructOrder; OrderSource: string);
443var
444 i: Integer;
445 x, y, z: string;
446begin
447 with RPCBrokerV do
448 begin
449 ClearParameters := True;
450 RemoteProcedure := 'ORWDX SAVE';
451 Param[0].PType := literal;
452 Param[0].Value := Patient.DFN; //*DFN*
453 Param[1].PType := literal;
454 Param[1].Value := IntToStr(Encounter.Provider);
455 Param[2].PType := literal;
456 (*if loc > 0 then Param[2].Value := IntToStr(Loc)
457 else Param[2].Value := IntToStr(Encounter.Location);*)
458 Param[2].Value := IntToStr(Encounter.Location);
459 Param[3].PType := literal;
460 Param[3].Value := ConstructOrder.DialogName;
461 Param[4].PType := literal;
462 Param[4].Value := IntToStr(ConstructOrder.DGroup);
463 Param[5].PType := literal;
464 Param[5].Value := IntToStr(ConstructOrder.OrderItem);
465 Param[6].PType := literal;
466 Param[6].Value := AnOrder.EditOf; // null if new order, otherwise ORIFN of original
467 if (ConstructOrder.DGroup = IVDisp) then
468 SetupORDIALOG(Param[7], ConstructOrder.ResponseList, True)
469 else
470 SetupORDIALOG(Param[7], ConstructOrder.ResponseList);
471 if Length(ConstructOrder.LeadText) > 0
472 then Param[7].Mult['"ORLEAD"'] := ConstructOrder.LeadText;
473 if Length(ConstructOrder.TrailText) > 0
474 then Param[7].Mult['"ORTRAIL"'] := ConstructOrder.TrailText;
475 Param[7].Mult['"ORCHECK"'] := IntToStr(ConstructOrder.OCList.Count);
476 with ConstructOrder do for i := 0 to OCList.Count - 1 do
477 begin
478 // put quotes around everything to prevent broker from choking
479 y := '"ORCHECK","' + Piece(OCList[i], U, 1) + '","' + Piece(OCList[i], U, 3) +
480 '","' + IntToStr(i+1) + '"';
481 Param[7].Mult[y] := Pieces(OCList[i], U, 2, 4);
482 end;
483 if ConstructOrder.DelayEvent in ['A','D','T','M','O'] then
484 Param[7].Mult['"OREVENT"'] := ConstructOrder.PTEventPtr;
485 if ConstructOrder.LogTime > 0
486 then Param[7].Mult['"ORSLOG"'] := FloatToStr(ConstructOrder.LogTime);
487 Param[7].Mult['"ORTS"'] := IntToStr(Patient.Specialty); // pass in treating specialty for ORTS
488 Param[8].PType := literal;
489 Param[8].Value := ConstructOrder.DigSig;
490 if Constructorder.IsIMODialog then
491 begin
492 Param[9].PType := literal; //IMO
493 Param[9].Value := FloatToStr(Encounter.DateTime);
494 end else
495 begin
496 Param[9].PType := literal; //IMO
497 Param[9].Value := '';
498 end;
499 Param[10].PType := literal;
500 Param[10].Value := OrderSource;
501 Param[11].PType := literal;
502 Param[11].Value := IntToStr(Constructorder.IsEventDefaultOR);
503
504 CallBroker;
505 if Results.Count = 0 then Exit; // error creating order
506 x := Results[0];
507 Results.Delete(0);
508 y := '';
509
510 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
511 begin
512 y := y + Copy(Results[0], 2, Length(Results[0])) + CRLF;
513 Results.Delete(0);
514 end;
515 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
516 z := '';
517 if (Results.Count > 0) and (Results[0] = '|') then
518 begin
519 Results.Delete(0);
520 while (Results.Count > 0) and (CharAt(Results[0], 1) <> '~') and (CharAt(Results[0], 1) <> '|') do
521 begin
522 z := z + Copy(Results[0], 2, Length(Results[0]));
523 Results.Delete(0);
524 end;
525 end;
526 SetOrderFields(AnOrder, x, y, z);
527 end;
528end;
529
530{ no longer used -
531procedure PutNewOrderAuto(var AnOrder: TOrder; ADialog: Integer);
532var
533 i: Integer;
534 y: string;
535begin
536 CallV('ORWDXM AUTOACK', [Patient.DFN, Encounter.Provider, Encounter.Location, ADialog]);
537 with RPCBrokerV do if Results.Count > 0 then
538 begin
539 y := '';
540 for i := 1 to Results.Count - 1 do
541 y := y + Copy(Results[i], 2, Length(Results[i])) + CRLF;
542 if Length(y) > 0 then y := Copy(y, 1, Length(y) - 2); // take off last CRLF
543 SetOrderFields(AnOrder, Results[0], y);
544 end;
545end;
546}
547
548function OIMessage(IEN: Integer): string;
549begin
550 CallV('ORWDX MSG', [IEN]);
551 with RPCBrokerV.Results do SetString(Result, GetText, Length(Text));
552end;
553
554function OrderMenuStyle: Integer;
555begin
556 Result := StrToIntDef(sCallV('ORWDXM MSTYLE', [nil]), 0);
557end;
558
559function ResolveScreenRef(const ARef: string): string;
560begin
561 Result := sCallV('ORWDXM RSCRN', [ARef]);
562end;
563
564function SubSetOfOrderItems(const StartFrom: string; Direction: Integer;
565 const XRef: string): TStrings;
566{ returns a pointer to a list of orderable items matching an S.xxx cross reference (for use in
567 a long list box) - The return value is a pointer to RPCBrokerV.Results, so the data must
568 be used BEFORE the next broker call! }
569begin
570 CallV('ORWDX ORDITM', [StartFrom, Direction, XRef]);
571 Result := RPCBrokerV.Results;
572end;
573
574function GetDefaultCopay(AnOrderID: string): String;
575begin
576 with RPCBrokerV do
577 begin
578 ClearParameters := True;
579 RemoteProcedure := 'ORWDPS4 CPLST';
580 Param[0].PType := literal;
581 Param[0].Value := Patient.DFN;
582 Param[1].PType := list;
583 Param[1].Mult['1'] := AnOrderID;
584 end;
585 CallBroker;
586 if RPCBrokerV.Results.Count > 0 then
587 Result := RPCBrokerV.Results[0]
588 else
589 Result := '';
590end;
591
592procedure SetDefaultCoPayToNewOrder(AnOrderID, CoPayInfo:string);
593var
594 temp,CPExems: string;
595 CoPayValue: array [1..7] of Char;
596 i: integer;
597begin
598 // SC AO IR EC MST HNC CV
599 CoPayValue[1] := 'N';
600 CoPayValue[2] := 'N';
601 CoPayValue[3] := 'N';
602 CoPayValue[4] := 'N';
603 CoPayValue[5] := 'N';
604 CoPayValue[6] := 'N';
605 CoPayValue[7] := 'N';
606 temp := Pieces(CoPayInfo,'^',2,6);
607 i := 1;
608 while Length(Piece(temp,'^',i))>0 do
609 begin
610 if Piece(Piece(temp,'^',i),';',1) = 'SC' then
611 begin
612 if Piece( Piece(temp,'^',i),';',2) = '1' then
613 CoPayValue[1] := 'C'
614 else
615 CopayValue[1] := 'U';
616 end;
617 if Piece(Piece(temp,'^',i),';',1) = 'AO' then
618 begin
619 if Piece( Piece(temp,'^',i),';',2) = '1' then
620 CoPayValue[2] := 'C'
621 else
622 CopayValue[2] := 'U';
623 end;
624 if Piece(Piece(temp,'^',i),';',1) = 'IR' then
625 begin
626 if Piece( Piece(temp,'^',i),';',2) = '1' then
627 CoPayValue[3] := 'C'
628 else
629 CopayValue[3] := 'U';
630 end;
631 if Piece(Piece(temp,'^',i),';',1) = 'EC' then
632 begin
633 if Piece( Piece(temp,'^',i),';',2) = '1' then
634 CoPayValue[4] := 'C'
635 else
636 CopayValue[4] := 'U';
637 end;
638 if Piece(Piece(temp,'^',i),';',1) = 'MST' then
639 begin
640 if Piece( Piece(temp,'^',i),';',2) = '1' then
641 CoPayValue[5] := 'C'
642 else
643 CopayValue[5] := 'U';
644 end;
645 if Piece(Piece(temp,'^',i),';',1) = 'HNC' then
646 begin
647 if Piece( Piece(temp,'^',i),';',2) = '1' then
648 CoPayValue[6] := 'C'
649 else
650 CopayValue[6] := 'U';
651 end;
652 if Piece(Piece(temp,'^',i),';',1) = 'CV' then
653 begin
654 if Piece( Piece(temp,'^',i),';',2) = '1' then
655 CoPayValue[7] := 'C'
656 else
657 CopayValue[7] := 'U';
658 end;
659 i := i + 1;
660 end;
661 CPExems := CoPayValue[1] + CoPayValue[2] + CoPayValue[3] + CoPayValue[4]
662 + CoPayValue[5] + CoPayValue[6] + CoPayValue[7];
663 CPExems := AnOrderId + '^' + CPExems;
664 with RPCBrokerV do
665 begin
666 ClearParameters := True;
667 RemoteProcedure := 'ORWDPS4 CPINFO';
668 Param[0].PType := list;
669 Param[0].Mult['1'] := CPExems;
670 CallBroker;
671 end;
672end;
673
674function SubsetOfEntries(const StartFrom: string; Direction: Integer;
675 const XRef, GblRef, ScreenRef: string): TStrings;
676{ returns a pointer to a list of file entries (for use in a long list box) -
677 The return value is a pointer to RPCBrokerV.Results, so the data must
678 be used BEFORE the next broker call! }
679begin
680 CallV('ORWDOR LKSCRN', [StartFrom, Direction, XRef, GblRef, ScreenRef]);
681 Result := RPCBrokerV.Results;
682end;
683
684procedure ValidateNumericStr(const x, Dom: string; var ErrMsg: string);
685begin
686 ErrMsg := sCallV('ORWDOR VALNUM', [x, Dom]);
687 if ErrMsg = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
688end;
689
690function IsPFSSActive: boolean;
691begin
692 with uPFSSActive do
693 if not PFSSChecked then
694 begin
695 PFSSActive := (sCallV('ORWPFSS IS PFSS ACTIVE?', [nil]) = '1');
696 PFSSChecked := True;
697 end;
698 Result := uPFSSActive.PFSSActive
699end;
700
701{ Medication Calls }
702
703procedure AppendMedRoutes(Dest: TStrings);
704var
705 i: Integer;
706 x: string;
707begin
708 if uMedRoutes = nil then
709 begin
710 CallV('ORWDPS32 ALLROUTE', [nil]);
711 with RPCBrokerV do
712 begin
713 uMedRoutes := TStringList.Create;
714 uMedRoutes.Assign(Results);
715 for i := 0 to Results.Count - 1 do if Length(Piece(Results[i], U, 3)) > 0 then
716 begin
717 x := Piece(Results[i], U, 1) + U + Piece(Results[i], U, 3) +
718 ' (' + Piece(Results[i], U, 2) + ')' + U + Piece(Results[i], U, 3);
719 uMedRoutes.Add(x);
720 end; {if Length}
721 SortByPiece(uMedRoutes, U, 2);
722 end; {with RPCBrokerV}
723 end; {if uMedRoutes}
724 Dest.AddStrings(uMedRoutes);
725end;
726
727procedure CheckAuthForMeds(var x: string);
728begin
729 x := Piece(sCallV('ORWDPS32 AUTH', [Encounter.Provider]), U, 2);
730end;
731
732function DispenseMessage(AnIEN: Integer): string;
733var
734 x: string;
735begin
736 if AnIEN = uLastDispenseIEN then Result := uLastDispenseMsg else
737 begin
738 x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
739 uLastDispenseIEN := AnIEN;
740 uLastDispenseMsg := Piece(x, U, 1);
741 uLastQuantityMsg := Piece(x, U, 2);
742 Result := uLastDispenseMsg;
743 end;
744end;
745
746function QuantityMessage(AnIEN: Integer): string;
747var
748 x: string;
749begin
750 if AnIEN = uLastDispenseIEN then Result := uLastQuantityMsg else
751 begin
752 x := sCallV('ORWDPS32 DRUGMSG', [AnIEN]);
753 uLastDispenseIEN := AnIEN;
754 uLastDispenseMsg := Piece(x, U, 1);
755 uLastQuantityMsg := Piece(x, U, 2);
756 Result := uLastQuantityMsg;
757 end;
758end;
759
760function RequiresCopay(DispenseDrug: Integer): Boolean;
761begin
762 Result := sCallV('ORWDPS32 SCSTS', [Patient.DFN, DispenseDrug]) = '1';
763end;
764
765procedure LoadFormularyAlt(AList: TStringList; AnIEN: Integer; PSType: Char);
766begin
767 CallV('ORWDPS32 FORMALT', [AnIEN, PSType]);
768 AList.Assign(RPCBrokerV.Results);
769end;
770
771procedure LookupRoute(const AName: string; var ID, Abbreviation: string);
772var
773 x: string;
774begin
775 x := sCallV('ORWDPS32 VALROUTE', [AName]);
776 ID := Piece(x, U, 1);
777 Abbreviation := Piece(x, U, 2);
778end;
779
780function MedIsSupply(AnIEN: Integer): Boolean;
781begin
782 Result := sCallV('ORWDPS32 ISSPLY', [AnIEN]) = '1';
783end;
784
785function MedTypeIsIV(AnIEN: Integer): Boolean;
786begin
787 Result := sCallV('ORWDPS32 MEDISIV', [AnIEN]) = '1';
788end;
789
790function ODForMedIn: TStrings;
791{ Returns init values for inpatient meds dialog. The results must be used immediately. }
792begin
793 CallV('ORWDPS32 DLGSLCT', [PST_UNIT_DOSE]);
794 Result := RPCBrokerV.Results;
795end;
796
797function ODForIVFluids: TStrings;
798{ Returns init values for IV Fluids dialog. The results must be used immediately. }
799begin
800 CallV('ORWDPS32 DLGSLCT', [PST_IV_FLUIDS]);
801 Result := RPCBrokerV.Results;
802end;
803
804function AmountsForIVFluid(AnIEN: Integer; FluidType: Char): string;
805begin
806 Result := sCallV('ORWDPS32 IVAMT', [AnIEN, FluidType]);
807end;
808
809function ODForMedOut: TStrings;
810{ Returns init values for outpatient meds dialog. The results must be used immediately. }
811begin
812 CallV('ORWDPS32 DLGSLCT', [PST_OUTPATIENT]);
813 Result := RPCBrokerV.Results;
814end;
815
816function OIForMedIn(AnIEN: Integer): TStrings;
817{ Returns init values for inpatient meds order item. The results must be used immediately. }
818begin
819 CallV('ORWDPS32 OISLCT', [AnIEN, PST_UNIT_DOSE, Patient.DFN]);
820 Result := RPCBrokerV.Results;
821end;
822
823function OIForMedOut(AnIEN: Integer): TStrings;
824{ Returns init values for outpatient meds order item. The results must be used immediately. }
825begin
826 CallV('ORWDPS32 OISLCT', [AnIEN, PST_OUTPATIENT, Patient.DFN]);
827 Result := RPCBrokerV.Results;
828end;
829
830function RatedDisabilities: string;
831{ Returns a list of rated disabilities, if any, for a patient }
832begin
833 CallV('ORWPCE SCDIS', [Patient.DFN]);
834 Result := RPCBrokerV.Results.Text;
835end;
836
837procedure ValidateIVRate(var x: string);
838begin
839 x := sCallV('ORWDPS32 VALRATE', [x]);
840end;
841
842//function ValidIVRate(const x: string): Boolean;
843//{ returns true if the text entered as the IV rate is valid }
844//begin
845// Result := sCallV('ORWDPS32 VALRATE', [x]) = '1';
846//end;
847
848function ValidSchedule(const x: string; PSType: Char = 'I'): Integer;
849{ returns 1 if schedule is valid, 0 if schedule is not valid, -1 pharmacy routine not there }
850begin
851 Result := StrToIntDef(sCallV('ORWDPS32 VALSCH', [x, PSType]), -1);
852end;
853
854function ValidQuantity(const x: string): Boolean;
855{ returns true if the text entered as the quantity is valid }
856begin
857 Result := sCallV('ORWDPS32 VALQTY', [Trim(x)]) = '1';
858end;
859
860function ODForVitals: TStrings;
861{ Returns init values for vitals dialog. The results must be used immediately. }
862begin
863 CallV('ORWDOR VMSLCT', [nil]);
864 Result := RPCBrokerV.Results;
865end;
866
867initialization
868 uLastDispenseIEN := 0;
869 uLastDispenseMsg := '';
870
871finalization
872 if uMedRoutes <> nil then uMedRoutes.Free;
873
874end.
Note: See TracBrowser for help on using the repository browser.