source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODBase.pas@ 1568

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

Uploading from OR_30_258

File size: 61.5 KB
RevLine 
[459]1unit fODBase;
2
3{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fAutoSz, StdCtrls,
9 ORCtrls, ORFn, uConst, rOrders, rODBase, uCore, ComCtrls, ExtCtrls, Menus, Mask,
10 Buttons, UBAGlobals, UBACore;
11
12type
13 TCtrlInit = class
14 private
15 Name: string;
16 Text: string;
17 ListID: string;
18 List: TStringList;
19 public
20 constructor Create;
21 destructor Destroy; override;
22 end;
23
24 TCtrlInits = class
25 private
26 FDfltList: TList;
27 FOIList: TList;
28 procedure ExtractInits(Src: TStrings; Dest: TList);
29 function FindInitByName(const AName: string): TCtrlInit;
30 public
31 constructor Create;
32 destructor Destroy; override;
33 procedure ClearOI;
34 function DefaultText(const ASection: string): string;
35 procedure LoadDefaults(Src: TStrings);
36 procedure LoadOrderItem(Src: TStrings);
37 procedure SetControl(AControl: TControl; const ASection: string);
38 procedure SetListOnly(AControl: TControl; const ASection: string);
39 procedure SetPopupMenu(AMenu: TPopupMenu; AClickEvent: TNotifyEvent; const ASection: string);
40 function TextOf(const ASection: string): string;
41 end;
42
43 TResponses = class
44 private
45 FDialog: string;
46 FResponseList: TList;
47 FPrompts: TList;
48 FCopyOrder: string;
49 FEditOrder: string;
50 FTransferOrder: string;
51 FDisplayGroup: Integer;
52 FQuickOrder: Integer;
53 FOrderChecks: TStringList;
54 FVarLeading: string;
55 FVarTrailing: string;
56 FEventType: Char;
57 FEventIFN: Integer;
58 FEventName: string;
59 FSpecialty: Integer;
60 FEffective: TFMDateTime;
61 FParentEvent: TParentEvent;
62 FLogTime: TFMDateTime;
63 FViewName: string;
[460]64 FCancel: boolean;
65 FOrderContainsObjects: boolean;
[459]66 function FindResponseByIEN(APromptIEN, AnInstance: Integer): TResponse;
67 function GetOrderText: string;
68 function IENForPrompt(const APromptID: string): Integer;
69 procedure SetDialog(Value: string);
70 procedure SetCopyOrder(const AnID: string);
71 procedure SetEditOrder(const AnID: string);
72 procedure SetQuickOrder(AnIEN: Integer);
73 procedure SetQuickOrderByID(const AnID: string);
74 procedure FormatResponse(var FormattedText: string; var ExcludeText: Boolean;
75 APrompt: TPrompt; const x: string; AnInstance: Integer);
76 function FindPromptByIEN(AnIEN: Integer): TPrompt;
77 procedure AppendChildren(var ParentText: string; ChildPrompts: string; AnInstance: Integer);
78 procedure BuildOCItems(AList: TStringList; var AStartDtTm: string; const AFillerID: string);
79 public
80 constructor Create;
81 destructor Destroy; override;
82 procedure Clear; overload;
83 procedure Clear(const APromptID: string; SaveInstance: Integer = 0); overload;
84 function EValueFor(const APromptID: string; AnInstance: Integer): string;
85 function GetIENForPrompt(const APromptID: string): Integer;
86 function FindResponseByName(const APromptID: string; AnInstance: Integer): TResponse;
[460]87 function PromptExists(const APromptID: string):boolean;
[459]88 function InstanceCount(const APromptID: string): Integer;
89 function IValueFor(const APromptID: string; AnInstance: Integer): string;
90 function NextInstance(const APromptID: string; LastInstance: Integer): Integer;
91 function OrderCRC: string;
92 procedure Remove(const APromptID: string; AnInstance: Integer);
93 procedure SaveQuickOrder(var ANewIEN: Integer; const ADisplayName: string);
94 procedure SaveOrder(var AnOrder: TOrder; DlgIEN: Integer; IsIMOOrder: boolean = False);
95 procedure SetControl(AControl: TControl; const APromptID: string; AnInstance: Integer);
96 procedure SetEventDelay(AnEvent: TOrderDelayEvent);
97 procedure SetPromptFormat(const APromptID, NewFormat: string);
98 procedure Update(const APromptID: string; AnInstance: Integer;
99 const AnIValue, AnEValue: string);
100 property Dialog: string read FDialog write SetDialog;
[460]101 property DisplayGroup: Integer read FDisplayGroup write FDisplayGroup;
[459]102 property CopyOrder: string read FCopyOrder write SetCopyOrder;
103 property EditOrder: string read FEditOrder; // write SetEditOrder;
104 property TransferOrder:string read FTransferOrder write FTransferOrder;
105 property EventType: Char read FEventType;
106 property EventIFN: integer read FEventIFN write FEventIFN;
107 property EventName: string read FEventName write FEventName;
108 property LogTime: TFMDateTime read FLogTime write FLogTime;
109 property QuickOrder: Integer read FQuickOrder write SetQuickOrder;
110 property OrderChecks: TStringList read FOrderChecks write FOrderChecks;
111 property OrderText: string read GetOrderText;
112 property VarLeading: string read FVarLeading write FVarLeading;
113 property VarTrailing: string read FVarTrailing write FVarTrailing;
114 property TheList: TList read FResponseList write FResponseList;
[460]115 property Cancel: boolean read FCancel write FCancel;
116 property OrderContainsObjects: boolean read FOrderContainsObjects write FOrderContainsObjects;
[459]117 end;
118
119 TCallOnExit = procedure;
120
121 TfrmODBase = class(TfrmAutoSz)
122 memOrder: TCaptionMemo;
123 cmdAccept: TButton;
124 cmdQuit: TButton;
125 pnlMessage: TPanel;
126 imgMessage: TImage;
127 memMessage: TRichEdit;
128 procedure cmdQuitClick(Sender: TObject);
129 procedure cmdAcceptClick(Sender: TObject);
130 procedure FormKeyPress(Sender: TObject; var Key: Char);
131 procedure FormCreate(Sender: TObject);
132 procedure FormDestroy(Sender: TObject);
133 procedure FormClose(Sender: TObject; var Action: TCloseAction);
134 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
135 procedure memMessageMouseUp(Sender: TObject; Button: TMouseButton;
136 Shift: TShiftState; X, Y: Integer);
137 procedure pnlMessageExit(Sender: TObject);
138 procedure pnlMessageMouseDown(Sender: TObject; Button: TMouseButton;
139 Shift: TShiftState; X, Y: Integer);
140 procedure pnlMessageMouseMove(Sender: TObject; Shift: TShiftState; X,
141 Y: Integer);
142 private
143 FIsSupply: Boolean;
144 FAbortOrder: Boolean;
145 FAllowQO: Boolean;
146 FAutoAccept: Boolean;
147 FClosing: Boolean;
148 FChanging: Boolean;
149 FDialogIEN: Integer;
150 FDisplayGroup: Integer;
151 FFillerID: string;
152 FFromQuit: Boolean;
153 FAcceptOK: Boolean;
154 FCtrlInits: TCtrlInits;
155 FResponses: TResponses;
156 FPreserve: TList;
157 FRefNum: Integer;
158 FOrderAction: Integer;
159 FKeyVariables: string;
160 FCallOnExit: TCallOnExit;
161 FTestMode: Boolean;
162 FDlgFormID: Integer;
163 FDfltCopay: String;
164 FEvtForPassDischarge: Char;
165 FEvtID : Integer;
166 FEvtType : Char;
167 FEvtName : string;
168 FIncludeOIPI: boolean;
169 FIsIMO: boolean; //imo
170 FMessageClickX: integer;
171 FMessageClickY: integer;
172 function AcceptOrderChecks: Boolean;
173 procedure ClearDialogControls;
174 function GetKeyVariable(const Index: string): string;
175 function GetEffectiveDate: TFMDateTime;
176 procedure SetDisplayGroup(Value: Integer);
177 procedure SetFillerID(const Value: string);
178 procedure DoSetFontSize( FontSize: integer);
179 protected
180 function LESValidationCheck: boolean;
181 procedure InitDialog; virtual;
182 procedure SetDialogIEN(Value: Integer); virtual;
183 procedure Validate(var AnErrMsg: string); virtual;
184 function ValidSave: Boolean;
185 procedure ShowOrderMessage(Show: boolean);
186 public
187 function OrderForInpatient: Boolean;
188 procedure SetDefaultCoPay(AnOrderID: string);
189 procedure OrderMessage(const AMessage: string);
190 procedure PreserveControl(AControl: TControl);
191 procedure SetupDialog(OrderAction: Integer; const ID: string); virtual;
192 procedure SetFontSize( FontSize: integer); virtual;
193 procedure SetKeyVariables(const VarStr: string);
194 procedure TabClose(var CanClose: Boolean);
195 property AbortOrder: Boolean read FAbortOrder write FAbortOrder;
196 property AcceptOK: Boolean read FAcceptOK;
197 property AllowQuickOrder: Boolean read FAllowQO write FAllowQO;
198 property AutoAccept: Boolean read FAutoAccept write FAutoAccept;
199 property CallOnExit: TCallOnExit read FCallOnExit write FCallOnExit;
200 property Changing: Boolean read FChanging write FChanging;
201 property Closing: Boolean read FClosing;
202 property CtrlInits: TCtrlInits read FCtrlInits write FCtrlInits;
203 property DialogIEN: Integer read FDialogIEN write SetDialogIEN;
204 property DisplayGroup: Integer read FDisplayGroup write SetDisplayGroup;
205 property EffectiveDate: TFMDateTime read GetEffectiveDate;
206 property FillerID: string read FFillerID write SetFillerID;
207 property KeyVariable[const Index: string]: string read GetKeyVariable;
208 property RefNum: Integer read FRefNum write FRefNum;
209 property Responses: TResponses read FResponses write FResponses;
210 property TestMode: Boolean read FTestMode write FTestMode;
211 property DlgFormID: Integer read FDlgFormID write FDlgFormID;
212 property DfltCopay: string read FDfltCopay write FDfltCopay;
213 property EvtForPassDischarge: Char read FEvtForPassDischarge write FEvtForPassDischarge;
214 property EvtID: integer read FEvtID write FEvtID;
215 property EvtType: Char read FEvtType write FEvtType;
216 property EvtName: String read FEvtName write FEvtName;
217 property IncludeOIPI: boolean read FIncludeOIPI write FIncludeOIPI;
218 property IsIMO:boolean read FIsIMO write FIsIMO;
219 property IsSupply: boolean read FIsSupply write FIsSupply;
220 end;
221
222var
223 frmODBase: TfrmODBase;
224 XfInToOutNow :boolean = False; // it's used only for transfering Inpatient Meds to OutPatient Med for
225 // immediately release (NO EVENT DELAY)
226 XferOuttoInOnMeds : boolean = False; // it's used only for transfering Outpatient Meds to Inpatient Med for
227 // immediately release (NO EVENT DELAY)
228 ImmdCopyAct: boolean = False;
229 IsUDGroup: boolean = False; // it's only used for copy inpatient med order.
230 DEASig: string; // digital signature
231 DupORIFN: string; // it's used to identify the order number for duplicate orders in order checking
232 NoFresh: boolean = False; // EDO use only
233 SaveAsCurrent: boolean = False; // EDO use only
234 CIDCOkToSave: boolean; // CIDC only, used for consult orders.
235 OrderSource: string = '';
236 EventDefaultOD: integer = 0; // If it's event default dialog?
237 IsTransferAction: boolean = False;
238
239procedure ClearControl(AControl: TControl);
240procedure ResetControl(AControl: TControl);
241
242implementation
243
244{$R *.DFM}
245
246uses fOCAccept, uODBase, rCore, rMisc, fODMessage,
247 fTemplateDialog, uEventHooks, uTemplates, rConsults,fOrders,uOrders,
[460]248 fFrame, uTemplateFields, fClinicWardMeds;
[459]249
250const
251 TX_ACCEPT = 'Accept the following order?' + CRLF + CRLF;
252 TX_ACCEPT_CAP = 'Unsaved Order';
253 TC_ORDERCHECKS = 'Order Checks';
254
255{ Procedures shared with descendent forms }
256
257procedure ClearControl(AControl: TControl);
258{ clears a control, removes text and listbox items }
259begin
260 if AControl is TLabel then with TLabel(AControl) do Caption := ''
261 else if AControl is TStaticText then with TStaticText(AControl) do Caption := ''
262 else if AControl is TButton then with TButton(AControl) do Caption := ''
263 else if AControl is TEdit then with TEdit(AControl) do Text := ''
264 else if AControl is TMemo then with TMemo(AControl) do Clear
265 else if AControl is TRichEdit then with TRichEdit(AControl) do Clear
266 else if AControl is TORListBox then with TORListBox(AControl) do Clear
267 else if AControl is TListBox then with TListBox(AControl) do Clear
268 else if AControl is TORComboBox then with TORComboBox(AControl) do
269 begin
270 Items.Clear;
271 Text := '';
272 end
273 else if AControl is TComboBox then with TComboBox(AControl) do
274 begin
275 Clear;
276 Text := '';
277 end;
278end;
279
280procedure ResetControl(AControl: TControl);
281{ clears text, deselects items, does not remove listbox or combobox items }
282begin
283 if AControl is TLabel then with TLabel(AControl) do Caption := ''
284 else if AControl is TStaticText then with TStaticText(AControl) do Caption := ''
285 else if AControl is TButton then with TButton(AControl) do Caption := ''
286 else if AControl is TEdit then with TEdit(AControl) do Text := ''
287 else if AControl is TMemo then with TMemo(AControl) do Clear
288 else if AControl is TRichEdit then with TRichEdit(AControl) do Clear
289 else if AControl is TListBox then with TListBox(AControl) do ItemIndex := -1
290 else if AControl is TORComboBox then with TORComboBox(AControl) do
291 begin
292 Text := '';
293 ItemIndex := -1;
294 end
295 else if AControl is TComboBox then with TComboBox(AControl) do
296 begin
297 Text := '';
298 ItemIndex := -1;
299 end;
300end;
301
302{ TCtrlInit methods }
303
304constructor TCtrlInit.Create;
305begin
306 List := TStringList.Create;
307end;
308
309destructor TCtrlInit.Destroy;
310begin
311 List.Free;
312 inherited Destroy;
313end;
314
315{ TCtrlInits methods }
316
317constructor TCtrlInits.Create;
318{ create lists to store initial value for dialog and selected orderable item }
319begin
320 FDfltList := TList.Create;
321 FOIList := TList.Create;
322end;
323
324destructor TCtrlInits.Destroy;
325{ free the objects used to store initialization information }
326var
327 i: Integer;
328begin
329 { free the objects in the lists first }
330 with FDfltList do for i := 0 to Count - 1 do TCtrlInit(Items[i]).Free;
331 FDfltList.Free;
332 ClearOI;
333 FOIList.Free;
334 inherited Destroy;
335end;
336
337procedure TCtrlInits.ClearOI;
338{ clears the records in FOIList, but not FDfltList }
339var
340 i: Integer;
341begin
342 with FOIList do for i := 0 to Count - 1 do TCtrlInit(Items[i]).Free;
343 FOIList.Clear;
344end;
345
346procedure TCtrlInits.ExtractInits(Src: TStrings; Dest: TList);
347{ load a list with TCtrlInit records (source strings are those passed from server }
348var
349 i: Integer;
350 ACtrlInit: TCtrlInit;
351begin
352 i := 0;
353 while i < Src.Count do
354 begin
355 if CharAt(Src[i], 1) = '~' then
356 begin
357 ACtrlInit := TCtrlInit.Create;
358 with ACtrlInit do
359 begin
360 Name := Copy(Src[i], 2, Length(Src[i]));
361 List := TStringList.Create;
362 Inc(i);
363 while (i < Src.Count) and (CharAt(Src[i], 1) <> '~') do
364 begin
365 if CharAt(Src[i], 1) = 'i' then List.Add(Copy(Src[i], 2, 255));
366 if CharAt(Src[i], 1) = 't' then List.Add(Copy(Src[i], 2, 255));
367 if CharAt(Src[i], 1) = 'd' then
368 begin
369 Text := Piece(Src[i], U, 2);
370 ListID := Copy(Piece(Src[i], U, 1), 2, 255);
371 end;
372 Inc(i);
373 end; {while i & CharAt...}
374 Dest.Add(ACtrlInit);
375 end; {with ACtrlDflt}
376 end; {if CharAt}
377 end; {while i}
378end;
379
380
381procedure TCtrlInits.LoadDefaults(Src: TStrings);
382{ loads control initialization information for the dialog }
383begin
384 FDfltList.Clear;
385 ExtractInits(Src, FDfltList);
386end;
387
388procedure TCtrlInits.LoadOrderItem(Src: TStrings);
389{ loads control initialization information for the orderable item }
390begin
391 ClearOI;
392 ExtractInits(Src, FOIList);
393end;
394
395function TCtrlInits.FindInitByName(const AName: string): TCtrlInit;
396{ look first in FOIList, then in FDfltList for initial values identified by name (~section) }
397var
398 i: Integer;
399begin
400 Result := nil;
401 with FOIList do
402 for i := 0 to Count - 1 do if TCtrlInit(Items[i]).Name = AName then
403 begin
404 Result := TCtrlInit(Items[i]);
405 break;
406 end;
407 if Result = nil then with FDfltList do
408 for i := 0 to Count - 1 do if TCtrlInit(Items[i]).Name = AName then
409 begin
410 Result := TCtrlInit(Items[i]);
411 break;
412 end;
413end;
414
415procedure TCtrlInits.SetControl(AControl: TControl; const ASection: string);
416{ initializes a control to the information in a section (~section from server) }
417var
418 CtrlInit: TCtrlInit;
419begin
420 ClearControl(AControl);
421 CtrlInit := FindInitByName(ASection);
422 if CtrlInit = nil then Exit;
423 if AControl is TLabel then with TLabel(AControl) do Caption := CtrlInit.Text
424 else if AControl is TStaticText then with TStaticText(AControl) do Caption := CtrlInit.Text
425 else if AControl is TButton then with TButton(AControl) do Caption := CtrlInit.Text
426 else if AControl is TEdit then with TEdit(AControl) do Text := CtrlInit.Text
427 else if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)
428 else if AControl is TRichEdit then with TRichEdit(AControl) do Lines.Assign(CtrlInit.List)
429 else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)
430 else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)
431 else if AControl is TComboBox then with TComboBox(AControl) do
432 begin
433 Items.Assign(CtrlInit.List);
434 Text := CtrlInit.Text;
435 end
436 else if AControl is TORComboBox then with TORComboBox(AControl) do
437 begin
438 Items.Assign(CtrlInit.List);
439 if LongList then InitLongList(Text) else Text := CtrlInit.Text;
440 SelectByID(CtrlInit.ListID);
441 end;
442 { need to add SelectByID for combobox & listbox }
443end;
444
445procedure TCtrlInits.SetListOnly(AControl: TControl; const ASection: string);
446{ assigns list portion to a control from a section (used to set ShortList for meds) }
447var
448 CtrlInit: TCtrlInit;
449begin
450 CtrlInit := FindInitByName(ASection);
451 if CtrlInit = nil then Exit;
452 if AControl is TMemo then with TMemo(AControl) do Lines.Assign(CtrlInit.List)
453 else if AControl is TORListBox then with TORListBox(AControl) do Items.Assign(CtrlInit.List)
454 else if AControl is TListBox then with TListBox(AControl) do Items.Assign(CtrlInit.List)
455 else if AControl is TComboBox then with TComboBox(AControl) do Items.Assign(CtrlInit.List)
456 else if AControl is TORComboBox then with TORComboBox(AControl) do Items.Assign(CtrlInit.List);
457end;
458
459procedure TCtrlInits.SetPopupMenu(AMenu: TPopupMenu; AClickEvent: TNotifyEvent; const ASection: string);
460{ populates a popup menu with items in a list, leaves the maximum text width in Tag }
461var
462 i, MaxWidth: Integer;
463 CtrlInit: TCtrlInit;
464 AMenuItem: TMenuItem;
465begin
466 CtrlInit := FindInitByName(ASection);
467 // clear the current menu entries
468 for i := AMenu.Items.Count - 1 downto 0 do
469 begin
470 AMenuItem := AMenu.Items[i];
471 if AMenuItem <> nil then
472 begin
473 AMenu.Items.Delete(i);
474 AMenuItem.Free;
475 end;
476 end;
477 MaxWidth := 0;
478 for i := 0 to CtrlInit.List.Count - 1 do
479 begin
480 AMenuItem := TMenuItem.Create(Application);
481 AMenuItem.Caption := CtrlInit.List[i];
482 AMenuItem.OnClick := AClickEvent;
483 AMenu.Items.Add(AMenuItem);
484 MaxWidth := HigherOf(MaxWidth, Application.MainForm.Canvas.TextWidth(CtrlInit.List[i]));
485 end;
486 AMenu.Tag := MaxWidth;
487end;
488
489function TCtrlInits.DefaultText(const ASection: string): string;
490var
491 CtrlInit: TCtrlInit;
492begin
493 Result := '';
494 CtrlInit := FindInitByName(ASection);
495 if CtrlInit <> nil then Result := CtrlInit.ListID;
496end;
497
498function TCtrlInits.TextOf(const ASection: string): string;
499var
500 CtrlInit: TCtrlInit;
501begin
502 Result := '';
503 CtrlInit := FindInitByName(ASection);
504 if CtrlInit <> nil then Result := CtrlInit.List.Text;
505end;
506
507{ TResponses methods }
508
509function SortPromptsBySequence(Item1, Item2: Pointer): Integer;
510{ compare function used to sort formatting info by sequence - used by TResponses.SetDialog}
511var
512 Prompt1, Prompt2: TPrompt;
513begin
514 Prompt1 := TPrompt(Item1);
515 Prompt2 := TPrompt(Item2);
516 if Prompt1.Sequence < Prompt2.Sequence then Result := -1
517 else if Prompt1.Sequence > Prompt2.Sequence then Result := 1
518 else Result := 0;
519end;
520
521constructor TResponses.Create;
522begin
523 FResponseList := TList.Create;
524 FPrompts := TList.Create;
525 FOrderChecks := TStringList.Create;
526 FEventType := #0;
527 FParentEvent := TParentEvent.Create;
528 FLogTime := 0;
529end;
530
531destructor TResponses.Destroy;
532{ frees all response objects before freeing list }
533var
534 i: Integer;
535begin
536 Clear;
537 FOrderChecks.Free;
538 FResponseList.Free;
539 with FPrompts do for i := 0 to Count - 1 do TPrompt(Items[i]).Free;
540 FPrompts.Free;
541 inherited Destroy;
542end;
543
544procedure TResponses.Clear;
545{ clears all information in the response multiple }
546var
547 i: Integer;
548begin
549 FVarLeading := '';
550 FVarTrailing := '';
551 FQuickOrder := 0;
552 //FCopyOrder := ''; // don't clear FCopyOrder either?
553 // don't clear FEditOrder or it will cause a new order to be created instead of an edit
554 with FResponseList do for i := 0 to Count - 1 do TResponse(Items[i]).Free;
555 FResponseList.Clear;
556 FOrderChecks.Clear;
557end;
558
559procedure TResponses.Clear(const APromptID: string; SaveInstance: Integer = 0);
560var
561 AResponse: TResponse;
562 i: Integer;
563begin
564 with FResponseList do
565 for i := Count - 1 downto SaveInstance do
566 begin
567 AResponse := TResponse(Items[i]);
568 if AResponse.PromptID = APromptID then
569 begin
570 AResponse.Free;
571 FResponseList.Delete(i);
572 end; {if AResponse}
573 end; {for}
574end;
575
576procedure TResponses.SetDialog(Value: string);
577{ loads formatting information for a dialog }
578var
579 i: Integer;
580begin
581 with FPrompts do for i := 0 to Count - 1 do TPrompt(Items[i]).Free;
582 FPrompts.Clear;
583 FDialog := Value;
584 LoadDialogDefinition(FPrompts, FDialog);
585 FPrompts.Sort(SortPromptsBySequence);
586end;
587
588procedure TResponses.SetCopyOrder(const AnID: string);
589{ sets responses to the values for an order that is created by copying }
[460]590var
591 HasObjects: boolean;
[459]592begin
593 if AnID = '' then
594 begin
595 FCopyOrder := AnID;
596 Exit;
597 end;
598 Clear;
[460]599 LoadResponses(FResponseList, AnID, HasObjects); // Example AnID=C123456;1-3604
[459]600 FCopyOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
[460]601 FOrderContainsObjects := HasObjects;
[459]602end;
603
604procedure TResponses.SetEditOrder(const AnID: string);
605{ sets responses to the values for an order that is about to be edited }
[460]606var
607 HasObjects: boolean;
[459]608begin
609 Clear;
[460]610 LoadResponses(FResponseList, AnID, HasObjects); // Example AnID=X123456;1
[459]611 FEditOrder := Copy(Piece(AnID, '-', 1), 2, Length(AnID));
[460]612 FOrderContainsObjects := HasObjects;
[459]613end;
614
615procedure TResponses.SetQuickOrder(AnIEN: Integer);
616{ sets responses to a quick order value - this is used by the QuickOrder property}
[460]617var
618 HasObjects: boolean;
[459]619begin
620 Clear;
[460]621 LoadResponses(FResponseList, IntToStr(AnIEN), HasObjects); // Example AnIEN=134
[459]622 FQuickOrder := AnIEN;
[460]623 FOrderContainsObjects := HasObjects;
[459]624end;
625
626procedure TResponses.SetQuickOrderByID(const AnID: string);
627{ sets responses to a quick order value }
[460]628var
629 HasObjects: boolean;
[459]630begin
631 Clear;
[460]632 LoadResponses(FResponseList, AnID, HasObjects); // Example AnID=134-3645
[459]633 FQuickOrder := StrToIntDef(Piece(AnID, '-', 1), 0); // 2nd '-' piece is $H seconds
[460]634 FOrderContainsObjects := HasObjects;
[459]635end;
636
637procedure TResponses.BuildOCItems(AList: TStringList; var AStartDtTm: string;
638 const AFillerID: string);
639var
640 i, TheInstance: Integer;
641 OrderableIEN, PkgPart: string;
642begin
643 if EditOrder <> '' then DupORIFN := EditOrder;
644 if CopyOrder <> '' then DupORIFN := CopyOrder;
645 //if {(CopyOrder <> '') or} (EditOrder <> '') then Exit; // only check new orders
646 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
647 if (PromptID = 'ORDERABLE') or (PromptID = 'ADDITIVE') then
648 begin
649 OrderableIEN := IValue;
650 TheInstance := Instance;
651 PkgPart := '';
652 if AFillerID = 'LR' then PkgPart := '^LR^' + IValueFor('SPECIMEN', TheInstance);
653 if (AFillerID = 'PSI') or (AFillerID = 'PSO') or (AFillerID = 'PSH')
654 then PkgPart := U + AFillerID + U + IValueFor('DRUG', TheInstance);
655 // was -- then PkgPart := '^PS^' + IValueFor('DRUG', TheInstance);
656 if AFillerID = 'PSIV' then
657 begin
658 if PromptID = 'ORDERABLE' then PkgPart := '^PSIV^B;' + IValueFor('VOLUME', TheInstance);
659 if PromptID = 'ADDITIVE' then PkgPart := '^PSIV^A';
660 end;
661 AList.Add(OrderableIEN + PkgPart);
662 end;
663 AStartDtTm := IValueFor('START', 1);
664end;
665
666function TResponses.EValueFor(const APromptID: string; AnInstance: Integer): string;
667var
668 i: Integer;
669begin
670 Result := '';
671 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
672 if (PromptID = APromptID) and (Instance = AnInstance) then
673 begin
674 Result := EValue;
675 break;
676 end;
677end;
678
679function TResponses.IValueFor(const APromptID: string; AnInstance: Integer): string;
680var
681 i: Integer;
682begin
683 Result := '';
684 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
685 if (PromptID = APromptID) and (Instance = AnInstance) then
686 begin
687 Result := IValue;
688 break;
689 end;
690end;
691
[460]692function TResponses.PromptExists(const APromptID: string): boolean;
693var
694 i: Integer;
695begin
696 Result := False;
697 with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
698 if (ID = APromptID) then Result := True;
699end;
700
[459]701function TResponses.FindResponseByName(const APromptID: string; AnInstance: Integer): TResponse;
702var
703 i: Integer;
704begin
705 Result := nil;
706 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
707 if (PromptID = APromptID) and (Instance = AnInstance) then
708 begin
709 Result := TResponse(Items[i]);
710 break;
711 end;
712end;
713
714function TResponses.IENForPrompt(const APromptID: string): Integer;
715var
716 i: Integer;
717begin
718 Result := 0;
719 with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
720 if (ID = APromptID) then
721 begin
722 Result := IEN;
723 break;
724 end;
725end;
726
727function TResponses.InstanceCount(const APromptID: string): Integer;
728var
729 i: Integer;
730begin
731 Result := 0;
732 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
733 if (PromptID = APromptID) then Inc(Result);
734end;
735
736function TResponses.NextInstance(const APromptID: string; LastInstance: Integer): Integer;
737var
738 i: Integer;
739begin
740 Result := 0;
741 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
742 if (PromptID = APromptID) and (Instance > LastInstance) and
743 ((Result = 0) or ((Result > 0) and (Instance < Result))) then Result := Instance;
744end;
745
746function TResponses.FindResponseByIEN(APromptIEN, AnInstance: Integer): TResponse;
747var
748 i: Integer;
749begin
750 Result := nil;
751 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
752 if (PromptIEN = APromptIEN) and (Instance = AnInstance) then
753 begin
754 Result := TResponse(Items[i]);
755 break;
756 end;
757end;
758
759procedure TResponses.FormatResponse(var FormattedText: string; var ExcludeText: Boolean;
760 APrompt: TPrompt; const x: string; AnInstance: Integer);
761var
762 AValue: string;
763 PromptIEN: Integer;
764 Related: TResponse;
765begin
766 FormattedText := '';
767 ExcludeText := True;
768 with APrompt do
769 begin
770 if FmtCode = '@' then Exit; // skip this response
771 if CharAt(FmtCode, 1) = '@' then // exclude if related response exists
772 begin
773 PromptIEN := StrToIntDef(Copy(FmtCode, 2, Length(FmtCode)), 0);
774 if (FindResponseByIEN(PromptIEN, AnInstance) <> nil) then Exit;
775 end;
776 if CharAt(FmtCode, 1) = '*' then // include if related response exists
777 begin
778 PromptIEN := StrToIntDef(Copy(FmtCode, 2, Length(FmtCode)), 0);
779 if FindResponseByIEN(PromptIEN, AnInstance) = nil then Exit;
780 end;
781 if CharAt(FmtCode, 1) = '#' then // include if related response = value
782 begin
783 AValue := Copy(FmtCode, Pos('=', FmtCode) + 1, Length(FmtCode));
784 PromptIEN := StrToIntDef(Copy(Piece(FmtCode, '=', 1), 2, Length(FmtCode)), 0);
785 Related := FindResponseByIEN(PromptIEN, AnInstance);
786 if Related = nil then Exit;
787 if not (Related.EValue = AValue) then Exit;
788 end;
789 if CharAt(FmtCode, 1) = '=' then // exclude if related response has same text
790 begin
791 PromptIEN := StrToIntDef(Copy(FmtCode, 2, Length(FmtCode)), 0);
792 Related := FindResponseByIEN(PromptIEN, AnInstance);
793 if (Related <> nil) and ((Pos(Related.EValue, x) > 0) or (Pos(x, Related.EValue) > 0)) then Exit;
794 end;
795 ExcludeText := False;
796 if (Length(x) = 0) or (CompareText(x, Omit) = 0) then Exit;
797 FormattedText := x;
798 if IsChild and (Length(Leading) > 0) and (CharAt(Leading, 1) <> '@')
799 then FormattedText := Leading + ' ' + FormattedText;
800 if IsChild and (Length(Trailing) > 0) and (CharAt(Trailing, 1) <> '@')
801 then FormattedText := FormattedText + ' ' + Trailing;
802 end; {with APrompt}
803end;
804
805function TResponses.FindPromptByIEN(AnIEN: Integer): TPrompt;
806var
807 i: Integer;
808begin
809 Result := nil;
810 with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
811 if IEN = AnIEN then
812 begin
813 Result := TPrompt(Items[i]);
814 break;
815 end;
816end;
817
818procedure TResponses.AppendChildren(var ParentText: string; ChildPrompts: string; AnInstance: Integer);
819var
820 x, Segment: string;
821 Boundary, ChildIEN: Integer;
822 ExcludeText: Boolean;
823 AResponse: TResponse;
824 APrompt: TPrompt;
825begin
826 while Length(ChildPrompts) > 0 do
827 begin
828 Boundary := Pos('~', ChildPrompts);
829 if Boundary = 0 then Boundary := Length(ChildPrompts) + 1;
830 Segment := Copy(ChildPrompts, 1, Boundary - 1);
831 Delete(ChildPrompts, 1, Boundary);
832 ChildIEN := StrToIntDef(Segment, 0);
833 APrompt := FindPromptByIEN(ChildIEN);
834 if APrompt <> nil then
835 begin
836 AResponse := FindResponseByIEN(APrompt.IEN, AnInstance);
837 if AResponse <> nil then
838 begin
839 FormatResponse(x, ExcludeText, APrompt, AResponse.EValue, AnInstance);
840 //x := FormatResponse(APrompt, AResponse.EValue, AnInstance);
841 if not ExcludeText then
842 begin
843 if (Length(ParentText) > 0) and (Length(x) > 0) then ParentText := ParentText + ' ';
844 ParentText := ParentText + x;
845 end; {if not ExcludeText}
846 end; {if AResponse}
847 end; {if APrompt}
848 end; {while Length}
849end; {AppendChildren}
850
851function TResponses.GetOrderText: string;
852{ loop thru the response objects and build the order text }
853var
854 i, AnInstance, NumInstance: Integer;
855 x, Segment: string;
856 ExcludeText, StartNewline: Boolean;
857 AResponse: TResponse;
858 APrompt: TPrompt;
859begin
860 Result := '';
861 with FPrompts do for i := 0 to Count - 1 do
862 begin
863 APrompt := TPrompt(Items[i]);
864 if APrompt.Sequence = 0 then Continue; // skip if prompt not in formatting sequence
865 NumInstance := 0;
866 Segment := '';
867 AnInstance := NextInstance(APrompt.ID, 0);
868 while AnInstance > 0 do
869 begin
870 Inc(NumInstance);
871 AResponse := FindResponseByName(APrompt.ID, AnInstance);
872 FormatResponse(x, ExcludeText, APrompt, AResponse.EValue, AnInstance);
873 //x := FormatResponse(APrompt, AResponse.EValue, AnInstance);
874 if not ExcludeText then
875 begin
876 if Length(APrompt.Children) > 0 then AppendChildren(x, APrompt.Children, AnInstance);
877 if Length(x) > 0 then
878 begin
879 // should the newline property be checked for children, too?
880 if APrompt.NewLine and (Length(Result) > 0) then x := CRLF + x;
881 if NumInstance > 1 then Segment := Segment + ',';
882 if Length(Segment) > 0 then Segment := Segment + ' ';
883 Segment := Segment + x;
884 end; {if Length(x)}
885 end; {if not ExcudeText}
886 AnInstance := NextInstance(APrompt.ID, AnInstance);
887 end; {while AnInstance}
888 if NumInstance > 0 then with APrompt do
889 begin
890 if Length(Segment) > 0 then
891 begin
892 if Copy(Segment, 1, 2) = CRLF then
893 begin
894 Segment := Copy(Segment, 3, Length(Segment));
895 StartNewline := True;
896 end
897 else StartNewline := False;
898 if (Length(Leading) > 0) then
899 begin
900 if (CharAt(Leading, 1) <> '@')
901 then Segment := Leading + ' ' + Segment
902 else Segment := FVarLeading + ' ' + Segment;
903 end; {if Length(Leading)}
904 if StartNewline then Segment := CRLF + Segment;
905 if (Length(Trailing) > 0) then
906 begin
907 if (CharAt(Trailing, 1) <> '@')
908 then Segment := Segment + ' ' + Trailing
909 else Segment := Segment + ' ' + FVarTrailing;
910 end; {if Length(Trailing)}
911 end; {if Length(Segment)}
912 if Length(Result) > 0 then Result := Result + ' ';
913 Result := Result + Segment;
914 end; {with APrompt}
915 end; {with FPrompts}
916end; {GetOrderText}
917
918procedure TResponses.Update(const APromptID: string; AnInstance: Integer;
919 const AnIValue, AnEValue: string);
920{ for a given Prompt,Instance update or create the associated response object }
921var
922 AResponse: TResponse;
923begin
924 AResponse := FindResponseByName(APromptID, AnInstance);
925 if AResponse = nil then
926 begin
927 AResponse := TResponse.Create;
928 AResponse.PromptID := APromptID;
929 AResponse.PromptIEN := IENForPrompt(APromptID);
930 AResponse.Instance := AnInstance;
931 FResponseList.Add(AResponse);
932 end;
933 AResponse.IValue := AnIValue;
934 AResponse.EValue := AnEValue;
935end;
936
937function TResponses.OrderCRC: string;
938const
939 CRC_WIDTH = 8;
940var
941 i: Integer;
942 x: string;
943 tmplst: TStringList;
944begin
945 tmplst := TStringList.Create;
946 try
947 with FResponseList do for i := 0 to Count - 1 do with TResponse(Items[i]) do
948 begin
949 if IValue = TX_WPTYPE then x := EValue else x := IValue;
950 tmplst.Add(IntToStr(PromptIEN) + U + IntToStr(Instance) + U + x);
951 end;
952 Result := IntToHex(CRCForStrings(tmplst), CRC_WIDTH);
953 finally
954 tmplst.Free;
955 end;
956end;
957
958procedure TResponses.Remove(const APromptID: string; AnInstance: Integer);
959var
960 AResponse: TResponse;
961begin
962 AResponse := FindResponseByName(APromptID, AnInstance);
963 if AResponse <> nil then
964 begin
965 FResponseList.Remove(AResponse);
966 AResponse.Free;
967 end;
968end;
969
970procedure TResponses.SaveQuickOrder(var ANewIEN: Integer; const ADisplayName: string);
971begin
972 if FDisplayGroup = ClinDisp then //Clin. Meds share same quick order definition with Inpt. Meds
973 PutQuickOrder(ANewIEN, OrderCRC, ADisplayName, InptDisp, FResponseList)
974 else
975 PutQuickOrder(ANewIEN, OrderCRC, ADisplayName, FDisplayGroup, FResponseList)
976end;
977
978procedure TResponses.SaveOrder(var AnOrder: TOrder; DlgIEN: Integer; IsIMOOrder: boolean);
979var
980 ConstructOrder: TConstructOrder;
981 i,j: integer;
982 QOUDGroup: boolean;
983 NewPtEvtPtr: Integer; // ptr to #100.2
984 APtEvtPtr: string;
985begin
[460]986 //IMOLoc := 0;
[459]987 NewPtEvtPtr := 0;
988 QOUDGroup := False;
989 if FQuickOrder > 0 then
990 begin
991 DlgIEN := FQuickOrder;
992 QOUDGroup := CheckQOGroup( IntToStr(FQuickOrder) );
993 end;
994 AnOrder.EditOf := FEditOrder; // null if new order, otherwise ORIFN of original order
995 with ConstructOrder do
996 begin
997 if XfInToOutNow then
998 DialogName := FDialog + '^O'
999 else DialogName := FDialog;
1000 LeadText := FVarLeading;
1001 TrailText := FVarTrailing;
1002 DGroup := FDisplayGroup;
1003 OrderItem := DlgIEN;
1004 DelayEvent := FEventType;
1005 Specialty := FSpecialty;
1006 Effective := FEffective;
1007 LogTime := FLogTime;
1008 OCList := FOrderChecks;
1009 DigSig := DEASig;
1010 IsIMODialog := IsIMOOrder; //IMO
1011 if IsIMODialog then
1012 DGroup := ClinDisp;
[460]1013 //AGP Change 26.35, 26.41 8518 added text order
1014 //AGP Change 26.55 remove IMO functionality for inpatient
1015 (*if (Patient.Inpatient = true) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
1016 ((ConstructOrder.DialogName = 'PSJ OR PAT OE') or (ConstructOrder.DialogName = 'PSJI OR PAT FLUID OE') or
1017 (ConstructOrder.DialogName = 'OR GXTEXT WORD PROCESSING ORDE')) and
1018 ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
1019 begin
1020 if frmClinicWardMeds.ClinicOrWardLocation(Encounter.location) = Encounter.Location then
1021 begin
1022 ConstructOrder.IsIMODialog := True;
1023 ConstructOrder.DGroup := ClinDisp;
1024 end
1025 else IMOLoc := Patient.Location;
1026 end; *)
1027 //AGP Change 26.51, change logic to set text orders to IMO for outpatients at an outpatient location.
1028 //AGP Text orders are only treated as IMO if the order display group is a nursing display group
1029 if (Patient.Inpatient = False) and (IsValidIMOLoc(encounter.Location,Patient.DFN)=true) and
1030 (((pos('OR GXTEXT WORD PROCESSING ORDE',ConstructOrder.DialogName)>0) and (ConstructOrder.DGroup = NurDisp)) or
1031 ((ConstructOrder.DialogName = 'OR GXMISC GENERAL') and (ConstructOrder.DGroup = NurDisp)) or
1032 ((ConstructOrder.DialogName = 'OR GXTEXT TEXT ONLY ORDER') and (ConstructOrder.DGroup = NurDisp))) and //AGP Change CQ #10757
1033 ((FEditOrder = '') and (Self.FEventName = '') and (Self.FCopyOrder = '')) then
1034 begin
1035 ConstructOrder.IsIMODialog := True;
1036 ConstructOrder.DGroup := ClinDisp;
1037 end;
[459]1038 IsEventDefaultOR := EventDefaultOD;
1039 if IsUDGroup or QOUDGroup then
1040 begin
1041 for i := 0 to FResponseList.Count - 1 do
1042 if UpperCase(TResponse(FResponseList.Items[i]).PromptID) = 'PICKUP' then
1043 begin
1044 FResponseList.Delete(i);
1045 Break;
1046 end;
1047 end;
1048
1049 if SaveAsCurrent then
1050 ConstructOrder.DelayEvent := #0;
1051
1052 ResponseList := FResponseList;
1053 if (FEventIFN>0) and (EventExist(Patient.DFN, FEventIFN)>0) then
1054 begin
1055 APtEvtPtr := IntToStr(EventExist(Patient.DFN, FEventIFN));
1056 PTEventPtr := APtEvtPtr;
[460]1057 //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
[459]1058 PutNewOrder(AnOrder, ConstructOrder, OrderSource);
1059 if not SaveAsCurrent then
1060 begin
1061 AnOrder.EventPtr := PTEventPtr;
1062 AnOrder.EventName := 'Delayed ' + MixedCase(Piece(EventInfo(APtEvtPtr),'^',4));
1063 end;
1064 end
1065 else
1066 begin
[460]1067 //PutNewOrder(AnOrder, ConstructOrder, OrderSource, IMOLoc);
[459]1068 PutNewOrder(AnOrder, ConstructOrder, OrderSource);
1069 if not SaveAsCurrent then
1070 begin
1071 if (FEventIFN > 0) and (FParentEvent.ParentIFN > 0) then
1072 begin
1073 {For a child event, create a parent event in 100.2 first}
1074 SaveEvtForOrder(Patient.DFN, FParentEvent.ParentIFN, AnOrder.ID);
1075 NewPtEvtPtr := EventExist(Patient.DFN, FParentEvent.ParentIFN);
1076 AnOrder.EventPtr := IntToStr(NewPtEvtPtr);
1077 AnOrder.EventName := 'Delayed ' + MixedCase(Piece(EventInfo(IntToStr(NewPtEvtPtr)),'^',4));
1078 {Then create the child event in 100.2}
1079 SaveEvtForOrder(Patient.DFN, FEventIFN, '');
1080 NewPtEvtPtr := EventExist(Patient.DFN, FEventIFN);
1081 end
1082 else if (FEventIFN > 0) and (FParentEvent.ParentIFN = 0) then
1083 begin
1084 SaveEvtForOrder(Patient.DFN, FEventIFN, AnOrder.ID);
1085 NewPtEvtPtr := EventExist(Patient.DFN, FEventIFN);
1086 AnOrder.EventPtr := IntToStr(NewPtEvtPtr);
1087 AnOrder.EventName := 'Delayed ' + MixedCase(Piece(EventInfo(IntToStr(NewPtEvtPtr)),'^',4));
1088 end;
1089 if FEventIFN > 0 then
1090 begin
1091 for j := 1 to frmOrders.lstSheets.Items.Count - 1 do
1092 begin
1093 if FEventIFN = StrToInt( Piece(Piece(frmOrders.lstSheets.Items[j],'^',1),';',1) ) then
1094 begin
1095 frmOrders.lstSheets.Items[j] := IntToStr( NewPtEvtPtr) + '^' + Piece(frmOrders.lstSheets.Items[j],'^',2);
1096 frmOrders.lstSheets.ItemIndex := j;
1097 end;
1098 end;
1099 end;
1100 end;
1101 end;
1102 DEASig := ''; //PKI
1103 end;
1104 AnOrder.EditOf := FEditOrder;
1105{Begin BillingAware}
1106 if rpcGetBAMasterSwStatus then
1107 begin
1108 UBAGlobals.BAOrderID := '';
1109 UBAGlobals.BAOrderID := AnOrder.ID;
1110 end;
1111{Begin BillingAware}
1112end;
1113
1114procedure TResponses.SetControl(AControl: TControl; const APromptID: string; AnInstance: Integer);
1115{ sets the value of a control, uses ID string & instance to find the right response entry }
1116var
1117 i: Integer;
1118 AResponse: TResponse;
1119 IEN: integer;
[460]1120 HasObjects: boolean;
[459]1121
1122 procedure AssignBPText(List: TStrings; const Value: string);
1123 var
1124 tmp, cptn, DocInfo: string;
1125 LType: TTemplateLinkType;
1126
1127 begin
1128 DocInfo := '';
1129 LType := DisplayGroupToLinkType(DisplayGroup);
1130 cptn := 'Reason for Request: ' + EValueFor('ORDERABLE', 1);
1131 tmp := Value;
1132 case LType of
1133 ltConsult: IEN := StrToIntDef(GetServiceIEN(IValueFor('ORDERABLE', 1)),0);
1134 ltProcedure: IEN := StrToIntDef(GetProcedureIEN(IValueFor('ORDERABLE', 1)),0);
1135 else IEN := 0;
1136 end;
[460]1137 ExpandOrderObjects(tmp, HasObjects);
1138 FOrderContainsObjects := FOrderContainsObjects or HasObjects;
[459]1139 if IEN <> 0 then
1140 begin
1141 // template will execute on copy order if commented out (tried to eliminate for CSV v22, RV)
1142 //
1143 //if (Length(tmp) > 0) and (not HasTemplateField(tmp)) then
1144 // CheckBoilerplate4Fields(tmp, cptn)
1145 //else
1146 ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, nil, cptn, DocInfo);
1147 end
1148 else
1149 CheckBoilerplate4Fields(tmp, cptn);
1150 List.Text := tmp;
1151 end;
1152
1153begin
1154 AResponse := FindResponseByName(APromptID, AnInstance);
1155 if AResponse = nil then Exit;
1156 if AControl is TLabel then with TLabel(AControl) do Caption := AResponse.EValue
1157 else if AControl is TStaticText then with TStaticText(AControl) do Caption := AResponse.EValue
1158 else if AControl is TButton then with TButton(AControl) do Caption := AResponse.EValue
1159 else if AControl is TEdit then with TEdit(AControl) do Text := AResponse.EValue
1160 else if AControl is TMaskEdit then with TMaskEdit(AControl) do Text := AResponse.EValue
1161 else if AControl is TCheckBox then with TCheckBox(AControl) do
1162 Checked := (StrToIntDef(AResponse.IValue,0) > 0) or
1163 (UpperCase(AResponse.IValue) = 'Y')
1164 else if AControl is TMemo then with TMemo(AControl) do AssignBPText(Lines, AResponse.EValue)
1165 else if AControl is TRichEdit then with TRichEdit(AControl) do AssignBPText(Lines, AResponse.EValue)
1166 else if AControl is TORListBox then with TORListBox(AControl) do
1167 begin
1168 for i := 0 to Items.Count - 1 do
1169 if Piece(Items[i], U, 1) = AResponse.IValue then ItemIndex := i;
1170 end
1171 else if AControl is TListBox then with TListBox(AControl) do
1172 begin
1173 for i := 0 to Items.Count - 1 do
1174 if Items[i] = AResponse.EValue then ItemIndex := i;
1175 end
1176 else if AControl is TComboBox then with TComboBox(AControl) do
1177 begin
1178 for i := 0 to Items.Count - 1 do
1179 if Items[i] = AResponse.EValue then ItemIndex := i;
1180 Text := AResponse.EValue;
1181 end
1182 else if AControl is TORComboBox then with TORComboBox(AControl) do
1183 begin
1184 if LongList then InitLongList(AResponse.EValue);
1185 SelectByID(AResponse.IValue);
1186 if (not LongList) and (ItemIndex < 0) then Text := AResponse.EValue;
1187 end;
1188end;
1189
1190procedure TResponses.SetEventDelay(AnEvent: TOrderDelayEvent);
1191begin
1192 with AnEvent do if EventType in ['A','D','T','M','O'] then
1193 begin
1194 FEventIFN := EventIFN;
1195 FEventName := EventName;
1196 FEventType := EventType;
1197 FSpecialty := Specialty;
1198 FEffective := Effective;
1199 FViewName := 'Delayed ' + MixedCase(EventName);
1200 FParentEvent := TParentEvent(AnEvent.TheParent);
1201 end;
1202end;
1203
1204procedure TResponses.SetPromptFormat(const APromptID, NewFormat: string);
1205var
1206 i: Integer;
1207begin
1208 with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
1209 if (ID = APromptID) then FmtCode := NewFormat;
1210end;
1211
1212{ Private calls }
1213
1214procedure TfrmODBase.ClearDialogControls;
1215var
1216 i: Integer;
1217begin
1218 FChanging := True;
1219 for i := 0 to ControlCount - 1 do
1220 begin
1221 // need to check if control is container & clear it's children also
1222 if (Controls[i] is TLabel) or (Controls[i] is TButton) or (Controls[i] is TStaticText) then Continue;
1223 if FPreserve.IndexOf(Controls[i]) < 0 then ClearControl(Controls[i]);
1224 end;
1225 FChanging := False;
1226 ShowOrderMessage( False );
1227end;
1228
1229procedure TfrmODBase.SetDisplayGroup(Value: Integer);
1230begin
1231 FDisplayGroup := Value;
1232 Responses.FDisplayGroup := Value;
1233end;
1234
1235procedure TfrmODBase.SetFillerID(const Value: string);
1236var
1237 x: string;
1238begin
1239 FFillerID := Value;
1240 if AddFillerAppID(FFillerID) and OrderChecksEnabled then
1241 begin
1242 StatusText('Order Checking...');
1243 x := OrderChecksOnDisplay(FillerID);
1244 StatusText('');
1245 if Length(x) > 0 then InfoBox(x, TC_ORDERCHECKS, MB_OK);
1246 end;
1247end;
1248
1249{ Protected Calls (used by descendant forms) }
1250
1251procedure TfrmODBase.InitDialog;
1252begin
1253 ClearDialogControls;
1254 Responses.Clear;
1255 FAcceptOK := False;
1256 FAbortOrder := False;
1257end;
1258
1259function TfrmODBase.OrderForInpatient: Boolean;
1260var
1261 AnEventType: Char;
1262begin
1263 AnEventType := OrderEventTypeOnCreate;
1264 // if event type = #0, then it wasn't passed or we're not in create
1265 if AnEventType = #0 then AnEventType := Responses.FEventType;
1266 case AnEventType of
1267 'A','O': Result := True;
1268 'D': Result := False;
1269 'T':
1270 begin
1271 if IsPassEvt1(FEvtID,'T') then Result := False
1272 else Result := True;
1273 end
1274 else Result := Patient.Inpatient;
1275 end;
1276end;
1277
1278procedure TfrmODBase.ShowOrderMessage(Show: boolean);
1279begin
1280 if Show then
1281 begin
1282 pnlMessage.Visible := True;
1283 pnlMessage.BringToFront;
1284 memMessage.TabStop := True;
1285 end
1286 else
1287 begin
1288 pnlMessage.Visible := False;
1289 pnlMessage.SendToBack;
1290 memMessage.TabStop := False;
1291 end;
1292end;
1293
1294procedure TfrmODBase.OrderMessage(const AMessage: string);
1295{Caller needs to set pnlMessage.TabOrder}
1296begin
1297 memMessage.Lines.SetText(PChar(AMessage));
1298 //begin CQ: 2640
1299 memMessage.SelStart := 0; // Put at first character
1300 SendMessage(memMessage.Handle, WM_VSCROLL, SB_TOP, 0);
1301 //End CQ: 2640
1302 ShowOrderMessage(ContainsVisibleChar(AMessage));
1303end;
1304
1305procedure TfrmODBase.PreserveControl(AControl: TControl);
1306begin
1307 FPreserve.Add(AControl);
1308end;
1309
1310procedure TfrmODBase.SetDialogIEN(Value: Integer);
1311begin
1312 FDialogIEN := Value;
1313end;
1314
1315procedure TfrmODBase.SetupDialog(OrderAction: Integer; const ID: string);
1316begin
1317 FOrderAction := OrderAction;
1318 FAbortOrder := False;
1319 case OrderAction of
1320 ORDER_NEW: {nothing};
1321 ORDER_EDIT: Responses.SetEditOrder(ID);
1322 ORDER_COPY: Responses.SetCopyOrder(ID);
1323 ORDER_QUICK: Responses.SetQuickOrderByID(ID);
1324 end;
1325 if Responses.FEventType in ['A','D','T','M','O'] then Caption := Caption + ' (Delayed ' + Responses.FEventName + ')'; // ' (Event Delayed)';
1326 if OrderAction in [ORDER_EDIT, ORDER_COPY] then cmdQuit.Caption := 'Cancel';
1327end;
1328
1329function TfrmODBase.GetEffectiveDate: TFMDateTime;
1330begin
1331 Result := Responses.FEffective;
1332end;
1333
1334function TfrmODBase.GetKeyVariable(const Index: string): string;
1335begin
1336 if UpperCase(Index) = 'LRFZX' then Result := Piece(FKeyVariables, U, 1)
1337 else if UpperCase(Index) = 'LRFSAMP' then Result := Piece(FKeyVariables, U, 2)
1338 else if UpperCase(Index) = 'LRFSPEC' then Result := Piece(FKeyVariables, U, 3)
1339 else if UpperCase(Index) = 'LRFDATE' then Result := Piece(FKeyVariables, U, 4)
1340 else if UpperCase(Index) = 'LRFURG' then Result := Piece(FKeyVariables, U, 5)
1341 else if UpperCase(Index) = 'LRFSCH' then Result := Piece(FKeyVariables, U, 6)
1342 else if UpperCase(Index) = 'PSJNOPC' then Result := Piece(FKeyVariables, U, 7)
1343 else if UpperCase(Index) = 'GMRCNOPD' then Result := Piece(FKeyVariables, U, 8)
1344 else if UpperCase(Index) = 'GMRCNOAT' then Result := Piece(FKeyVariables, U, 9)
1345 else if UpperCase(Index) = 'GMRCREAF' then Result := Piece(FKeyVariables, U, 10)
1346 else Result := '';
1347end;
1348
1349procedure TfrmODBase.SetKeyVariables(const VarStr: string);
1350begin
1351 FKeyVariables := VarStr;
1352end;
1353
1354procedure TfrmODBase.Validate(var AnErrMsg: string);
1355const
1356 TX_OR_DISABLED = 'Ordering has been disabled. Press Quit.';
1357 TX_PAST_START = 'The start date may not be earlier than the present.';
1358 TX_NO_LOCATION = 'A location must be identified.' + CRLF +
1359 '(Select File | Update Provider/Location)';
1360 TX_NO_PROVIDER = 'A provider who is authorized to write orders must be indentified.' + CRLF +
1361 '(Select File | Update Provider/Location)';
1362var
1363 StartStr,x: string;
1364 StartDt: TFMDateTime;
1365begin
1366 AnErrMsg := '';
1367 if User.NoOrdering then AnErrMsg := 'Ordering has been disabled. Press Quit.';
1368 // take this out if we <don't> need to check for earlier start date/times
1369 // should this check be against FMNow??
1370 StartStr := Piece(Responses.IValueFor('START', 1), '.', 1);
1371 if not IsFMDateTime(StartStr)
1372 then StartDt := StrToFMDateTime(StartStr)
1373 else StartDt := StrToFloat(StartStr);
1374 if (StartDt > 0) and (StartDt < FMToday)
1375 then AnErrMsg := 'The start date may not be earlier than the present.';
1376 //frmFrame.UpdatePtInfoOnRefresh;
1377 if (not Patient.Inpatient) and (Responses.EventIFN > 0) then x := ''
1378 else
1379 begin
1380 if Encounter.Location = 0 then AnErrMsg := TX_NO_LOCATION;
1381 end;
1382 if (Encounter.Provider = 0) or (PersonHasKey(Encounter.Provider, 'PROVIDER') = False)
1383 then AnErrMsg := TX_NO_PROVIDER;
[460]1384 if IsPFSSActive and Responses.PromptExists('VISITSTR') then
1385 Responses.Update('VISITSTR', 1, Encounter.VisitStr, Encounter.VisitStr);
[459]1386end;
1387
1388{ Form Calls }
1389
1390procedure TfrmODBase.FormCreate(Sender: TObject);
1391begin
1392 inherited;
1393 memOrder.Color := ReadOnlyColor;
1394 FAcceptOK := False;
1395 FAutoAccept := False;
1396 FChanging := False;
1397 FClosing := False;
1398 FFromQuit := False;
1399 FTestMode := False;
1400 FIncludeOIPI := True;
1401 FEvtForPassDischarge := #0;
1402 FCtrlInits := TCtrlInits.Create;
1403 FResponses := TResponses.Create;
1404 FPreserve := TList.Create;
1405 FIsIMO := False; //imo
1406 FIsSupply := False;
1407 {This next bit is mostly for the font size. It also sets the default size of
1408 order forms if it is not in the database. This is handy if a new user wants
1409 to have large fonts. However, in the general case, this will be resized
1410 through rMisc.SetFormPosition.}
1411 if not AutoSizeDisabled then
1412 ResizeFormToFont(self);
1413 DoSetFontSize(MainFontSize);
1414
1415 imgMessage.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
1416 //if User.NoOrdering then cmdAccept.Enabled := False;
1417 if uCore.User.NoOrdering then cmdAccept.Enabled := False;
1418 FDlgFormID := OrderFormIDOnCreate;
1419 FEvtID := OrderEventIDOnCreate;
1420 FEvtType := OrderEventTypeOnCreate;
1421 FEvtName := OrderEventNameOnCreate;
1422end;
1423
1424procedure TfrmODBase.FormDestroy(Sender: TObject);
1425begin
1426 FCtrlInits.Free;
1427 FResponses.Free;
1428 FPreserve.Free;
1429 //DestroyingOrderDialog;
1430 if Assigned(FCallOnExit) then FCallOnExit;
1431 if (Owner <> nil) and (Owner is TWinControl)
1432 then SendMessage(TWinControl(Owner).Handle, UM_DESTROY, FRefNum, 0);
1433 inherited;
1434end;
1435
1436procedure TfrmODBase.FormKeyPress(Sender: TObject; var Key: Char);
1437{ causes RETURN to be treated as pressing a tab key (need to have user preference) }
1438begin
1439 inherited;
1440 if (Key = #13) and not (ActiveControl is TCustomMemo) then
1441 begin
1442 Key := #0;
1443 Perform(WM_NEXTDLGCTL, 0, 0);
1444 end;
1445end;
1446
1447{ Accept & Quit Buttons }
1448
1449function TfrmODBase.AcceptOrderChecks: Boolean;
1450{ returns True if order was accepted with order checks, false if order should be cancelled }
1451var
1452 StartDtTm: string;
1453 OIList: TStringList;
1454begin
1455 Result := True;
1456 Responses.OrderChecks.Clear;
1457 if not OrderChecksEnabled then Exit;
1458 OIList := TStringList.Create;
1459 try
1460 StatusText('Order Checking...');
1461 Responses.BuildOCItems(OIList, StartDtTm, FillerID);
1462 OrderChecksOnAccept(Responses.OrderChecks, FillerID, StartDtTm, OIList, DupORIFN);
1463 DupORIFN := '';
1464 StatusText('');
1465 Result := AcceptOrderWithChecks(Responses.OrderChecks);
1466 finally
1467 OIList.Free;
1468 end;
1469end;
1470
1471function TfrmODBase.ValidSave: Boolean;
1472const
1473 TX_NO_SAVE = 'This order cannot be saved for the following reason(s):' + CRLF + CRLF;
1474 TX_NO_SAVE_CAP = 'Unable to Save Order';
1475 TX_SAVE_ERR = 'Unexpected error - it was not possible to save this order.';
1476var
1477 ErrMsg: string;
1478 NewOrder: TOrder;
1479 CanSign, OrderAction: Integer;
1480 //thisSourceOrder: TOrder;
1481begin
1482 Result := True;
1483 Validate(ErrMsg);
1484 if Length(ErrMsg) > 0 then
1485 begin
1486 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
1487 Result := False;
1488 Exit;
1489 end;
1490 if not AcceptOrderChecks then
1491 begin
[460]1492 if AskAnotherOrder(DialogIEN) then
1493 InitDialog // ClearDialogControls is in InitDialog
1494 else
1495 begin
1496 ClearDialogControls; // to allow form to close without prompting to save order
1497 Close;
1498 end;
[459]1499 Result := False;
1500 Exit;
1501 end;
1502 if FTestMode then
1503 begin
1504 Result := False;
1505 Exit;
1506 end;
1507 // LES validation checking for changed lab order
1508 if not LESValidationCheck then Exit;
1509 NewOrder := TOrder.Create;
1510
1511 Responses.SaveOrder(NewOrder, DialogIEN, FIsIMO);
1512
1513 if frmOrders.IsDefaultDlg then
1514 begin
1515 frmOrders.EventDefaultOrder := NewOrder.ID;
1516 frmOrders.EvtOrderList.Add(NewOrder.EventPtr + '^' + NewOrder.ID);
1517 frmOrders.IsDefaultDlg := False;
1518 end;
1519 if Length(DfltCopay)>0 then SetDefaultCoPayToNewOrder(NewOrder.ID, DfltCopay);
1520 if (Length(FEvtName)>0) then
1521 begin
1522 NewOrder.EventName := 'Delayed ' + MixedCase(FEvtName);
1523 FEvtName := '';
1524 end;
1525 if not ProcessOrderAcceptEventHook(NewOrder.ID, NewOrder.DGroup) then
1526 begin
1527 if NewOrder.ID <> '' then
1528 begin
1529 if (Encounter.Provider = User.DUZ) and User.CanSignOrders
1530 then CanSign := CH_SIGN_YES
1531 else CanSign := CH_SIGN_NA;
1532 if NewOrder.Signature = OSS_NOT_REQUIRE then CanSign := CH_SIGN_NA;
1533 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, Responses.FViewName, CanSign);
1534
1535 UBAGlobals.TargetOrderID := NewOrder.ID;
1536
1537 if Responses.EditOrder = '' then OrderAction := ORDER_NEW else OrderAction := ORDER_EDIT;
1538 SendMessage(Application.MainForm.Handle, UM_NEWORDER, OrderAction, Integer(NewOrder));
1539 end
1540 else InfoBox(TX_SAVE_ERR, TX_NO_SAVE_CAP, MB_OK);
1541 end;
1542 NewOrder.Free; // free here - recieving forms should get own copy using assign
1543end;
1544
1545procedure TfrmODBase.cmdAcceptClick(Sender: TObject);
1546const
1547 TX_CMPTEVT = ' occurred since you started writing delayed orders. '
1548 + 'The orders that were entered and signed have now been released. '
1549 + 'Any unsigned orders will be released immediately upon signature. '
1550 + #13#13
1551 + 'To write new delayed orders for this event you need to click the write delayed orders button again and select the appropriate event. '
1552 + 'Orders delayed to this same event will remain delayed until the event occurs again.'
1553 + #13#13
1554 + 'The Orders tab will now be refreshed and switched to the Active Orders view. '
1555 + 'If you wish to continue to write active orders for this patient, '
1556 + 'close this message window and continue as usual.';
1557var
1558 theGrpName: string;
1559 alreadyClosed: boolean;
1560begin
1561 FAcceptOK := False;
1562 CIDCOkToSave := False;
1563 alreadyClosed := False;
[460]1564 self.Responses.Cancel := False;
[459]1565 if frmOrders <> nil then
1566 begin
1567 if (frmOrders.TheCurrentView <> nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0) and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
1568 begin
1569 theGrpName := 'Delayed ' + frmOrders.TheCurrentView.EventDelay.EventName;
1570 SaveAsCurrent := True;
1571 end;
1572 end;
1573 if ValidSave then
1574 begin
1575 FAcceptOK := True;
1576 CIDCOkToSave := True;
1577 with Responses do
1578 if not FAutoAccept and (CopyOrder = '') and (EditOrder = '') and (TransferOrder = '')
1579 and AskAnotherOrder(DialogIEN)
1580 then InitDialog // ClearDialogControls is in InitDialog
1581 else
1582 begin
1583 ClearDialogControls; // to allow form to close without prompting to save order
1584 Close;
1585 alreadyClosed := True;
1586 end;
1587 if NoFresh then
1588 begin
1589 if SaveAsCurrent then
1590 begin
1591 SaveAsCurrent := False;
1592 with Responses do
1593 begin
1594 if not alreadyClosed then
1595 begin
1596 ClearDialogControls;
1597 Close;
1598 end;
1599 end;
1600 frmOrders.GroupChangesUpdate(theGrpName);
1601 Exit;
1602 end;
1603 end else
1604 begin
1605 if SaveAsCurrent then
1606 begin
1607 SaveAsCurrent := False;
1608 with Responses do
1609 begin
1610 if not alreadyClosed then
1611 begin
1612 ClearDialogControls;
1613 Close;
1614 end;
1615 end;
1616 frmOrders.GroupChangesUpdate(theGrpName);
1617 //EDONeedRefresh := True;
1618 Exit;
1619 end;
1620 end
1621 end; {if ValidSave}
1622 if SaveAsCurrent then
1623 SaveAsCurrent := False;
1624end;
1625
1626procedure TfrmODBase.cmdQuitClick(Sender: TObject);
1627begin
1628 inherited;
1629 Close;
1630end;
1631
1632procedure TfrmODBase.FormClose(Sender: TObject; var Action: TCloseAction);
1633begin
1634 inherited;
1635 // unlock an order that is being edited if accept wasn't pressed
1636 // this unlock is currently done in ActivateOrderDialog
1637 //with Responses do if (Length(EditOrder) > 0) and (not FAcceptOK) then UnlockOrder(EditOrder);
1638 PopKeyVars;
1639 SaveUserBounds(Self);
1640 FClosing := True;
1641 Action := caFree;
1642 (*
1643 if User.NoOrdering then Exit;
1644 if Length(memOrder.Text) > 0 then
1645 if InfoBox(TX_ACCEPT + memOrder.Text, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
1646 if not ValidSave then
1647 begin
1648 FClosing := False;
1649 Action := caNone;
1650 end;
1651 *)
1652end;
1653
1654procedure TfrmODBase.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1655begin
1656 inherited;
[460]1657 //self.Responses.Cancel := False;
[459]1658 if User.NoOrdering then Exit;
1659 if FAbortOrder then exit;
1660 if FOrderAction in [ORDER_EDIT, ORDER_COPY] then Exit; // don't invoke verify dialog
1661 if FOrderAction = ORDER_QUICK then Exit; // should this be here??
1662 if frmFrame.ContextChanging then
1663 begin
1664 // close any sub-dialogs created by order dialog FIRST!!
1665 exit;
1666 end;
1667 if Length(memOrder.Text) > 0 then
1668 begin
1669 if InfoBox(TX_ACCEPT + memOrder.Text, TX_ACCEPT_CAP, MB_YESNO) = ID_YES
1670 then CanClose := ValidSave
1671 else memOrder.Text := ''; // so don't return False on subsequent CloseQuery
1672 end;
1673end;
1674
1675procedure TfrmODBase.TabClose(var CanClose: Boolean);
1676begin
1677 inherited;
1678 CanClose := True;
1679 if Length(memOrder.Text) > 0 then
1680 if InfoBox(TX_ACCEPT + memOrder.Text, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
1681 if not ValidSave then CanClose := False;
1682 if CanClose then InitDialog;
1683end;
1684
1685procedure TfrmODBase.memMessageMouseUp(Sender: TObject;
1686 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1687begin
1688 inherited;
1689 ShowOrderMessage( False );
1690end;
1691
1692procedure TfrmODBase.SetDefaultCoPay(AnOrderID: string);
1693begin
1694 FDfltCopay := GetDefaultCopay(AnOrderID);
1695end;
1696
1697procedure TfrmODBase.DoSetFontSize( FontSize: integer);
1698begin
1699 if AutoSizeDisabled then
1700 ResizeAnchoredFormToFont( Self )
1701 else
1702 begin
1703 //You get to resize the window yourself!
1704 Font.Size := FontSize;
1705 memMessage.DefAttributes.Size := FontSize;
1706 end;
1707end;
1708
1709procedure TfrmODBase.SetFontSize( FontSize: integer);
1710begin
1711 DoSetFontSize( FontSize );
1712end;
1713
1714function TResponses.GetIENForPrompt(const APromptID: string): Integer;
1715var
1716 i: Integer;
1717begin
1718 Result := 0;
1719 with FPrompts do for i := 0 to Count - 1 do with TPrompt(Items[i]) do
1720 if (ID = APromptID) then
1721 begin
1722 Result := IEN;
1723 break;
1724 end;
1725end;
1726
1727procedure TfrmODBase.pnlMessageExit(Sender: TObject);
1728begin
1729 inherited;
1730 ShowOrderMessage(False);
1731end;
1732
1733procedure TfrmODBase.pnlMessageMouseDown(Sender: TObject;
1734 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1735begin
1736 inherited;
1737 FMessageClickX := X;
1738 FMessageClickY := Y;
1739end;
1740
1741procedure TfrmODBase.pnlMessageMouseMove(Sender: TObject;
1742 Shift: TShiftState; X, Y: Integer);
1743begin
1744 inherited;
1745 if (ssLeft in Shift) then
1746 pnlMessage.SetBounds(pnlMessage.Left + X - FMessageClickX, pnlMessage.Top + Y - FMessageClickY, pnlMessage.Width, pnlMessage.Height);
1747end;
1748
1749function TfrmODBase.LESValidationCheck: boolean;
1750var
1751 idx: integer;
1752 LESGrpList,LESRejectedReason: TStringList;
1753 IsLESOrder: boolean;
1754 TempMSG,LESODInfo: string;
1755begin
1756 Result := True;
1757 if Length(Responses.EditOrder)>1 then
1758 begin
1759 LESGrpList := TStringList.Create;
1760 PiecesToList(GetDispGroupForLES,'^',LESGrpList);
1761 IsLESOrder := False;
1762 for idx:=0 to LESGrpList.Count - 1 do
1763 if StrToIntDef(LESGrpList[idx],0) = Responses.DisplayGroup then
1764 begin
1765 IsLESOrder := True;
1766 Break;
1767 end;
1768 if IsLESOrder then
1769 begin
1770 TempMSG := '';
1771 LESODInfo := Patient.DFN +
1772 '^' + Responses.IValueFor('ORDERABLE',1) +
1773 '^' + IntToStr(Encounter.Location) +
1774 '^' + IntToStr(Encounter.Provider) +
1775 '^' + Responses.IValueFor('START',1);
1776 LESRejectedReason := TStringList.Create;
1777 LESValidationForChangedLabOrder(LESRejectedReason,LESODInfo);
1778 if LESRejectedReason.Count > 0 then
1779 begin
1780 for idx := 0 to LESRejectedReason.Count - 1 do
1781 begin
1782 if Length(LESRejectedReason[idx])>0 then
1783 TempMSG := TempMSG + #13 + LESRejectedReason[idx];
1784 end;
1785 if Length(TempMSG)>0 then
1786 begin
1787 ShowMessage(TempMSG);
1788 Result := False;
1789 end;
1790 end;
1791 end;
1792 end;
1793end;
1794
[460]1795
[459]1796end.
1797
Note: See TracBrowser for help on using the repository browser.