source: cprs/trunk/CPRS-Chart/BA/UBAGlobals.pas@ 1724

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

Upgrade to version 27
File size: 40.5 KB
Line 
1 unit UBAGlobals;
2
3{$OPTIMIZATION OFF}
4
5{$define debug}
6
7interface
8
9uses
10 Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, rOrders;
11
12type
13
14 {Problem List Record Used To Add New DX From SignOrders Form }
15 TBAPLRec = class(TObject)
16 constructor Create(PLlist:TStringList);
17 function BuildProblemListDxEntry(pDxCode:string):TStringList;
18 function FMToDateTime(FMDateTime: string): TDateTime;
19
20 end;
21
22 {patient qualifiers}
23 TBAPLPt=class(TObject)
24 PtVAMC:string;
25 PtDead:string;
26 PtBid:string;
27 PtServiceConnected:boolean;
28 PtAgentOrange:boolean;
29 PtRadiation:boolean;
30 PtEnvironmental:boolean;
31 PtHNC:boolean;
32 PtMST:boolean;
33 PtSHAD:boolean;
34 constructor Create(Alist:TStringList);
35 function GetGMPDFN(dfn:string;name:String):string;
36 public
37 function rpcInitPt(const PatientDFN: string): TStrings ;
38 procedure LoadPatientParams(AList:TstringList);
39
40 end;
41
42 TBAGlobals = class(TObject)
43 private
44 FOrderNum: string;
45 protected
46 public
47 constructor Create;
48 published
49 property OrderNum: string read FOrderNum write FOrderNum;
50 procedure AddBAPCEDiag(DiagStr:string);
51 procedure ClearBAPCEDiagList;
52 end;
53
54 TBADxRecord = class(TObject)
55 FExistingRecordID: string;
56 FOrderID: string;
57 FBADxCode: string; //Primary Dx
58 FBASecDx1: string; //Secondary Dx 1
59 FBASecDx2: string; //Secondary Dx 2
60 FBASecDx3: string; //Secondary Dx 3
61 FDxDescCode: string;
62 FDxDesc1: string;
63 FDxDesc2: string;
64 FDxDesc3: string;
65 FTreatmentFactors: string;
66 end;
67
68 TBACopiedOrderFlags = class
69 OrderID: string;
70end;
71
72 TBATreatmentFactorsInRec = class(TObject)
73 FBAOrderID: string;
74 FBAEligible: string;
75 FBATFactors: string;
76 end;
77
78 TBAUnsignedBillingRec = class(TObject)
79 FBAOrderID: string;
80 FBASTSFlags: string;
81 FBADxCode: string;
82 FBASecDx1: string;
83 FBASecDx2: string;
84 FBASecDx3: string;
85 end;
86
87 TBAConsultOrderRec = class(TObject)
88 FBAOrderID: string;
89 FBADxCode: string;
90 FBASecDx1: string;
91 FBASecDx2: string;
92 FBASecDx3: string;
93 FBATreatmentFactors: string;
94 end;
95
96 TBAClearedBillingRec = class(TObject)
97 FBAOrderID: string;
98 FBASTSFlags: string;
99 FBADxCode: string;
100 FBASecDx1: string;
101 FBASecDx2: string;
102 FBASecDx3: string;
103 end;
104
105 TBAFactorsRec = class(TObject)
106 FBAFactorActive : boolean;
107 FBAFactorSC : string;
108 FBAFactorMST : string;
109 FBAFactorAO : string;
110 FBAFactorIR : string;
111 FBAFactorEC : string;
112 FBAFactorHNC : string;
113 FBAFactorCV : string;
114 FBAFactorSHAD : string;
115 end;
116
117 TBAPLFactorsIN = class(TOBject)
118 FPatientID : string; // UProblems.piece 1
119 FBADxText : string; // UProblems.piece 2
120 FBADxCode : string; // UProblems.piece 3
121 FBASC : string; // UProblems.piece 5
122 FBASC_YN : string; // UProblems.piece 6
123 FBATreatFactors : string; //(......)
124 end;
125
126 TBACBStsFlagsIN = class(TOBject) // Y/N/U
127 CB_Sts_Flags :string;
128 // CB_SC :string;
129 CB_AO :string;
130 CB_IR :string;
131 CB_EC :string;
132 CB_MST :string;
133 CB_HNC :string;
134 CB_CV :string;
135 CB_SHAD :string;
136 end;
137
138procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); //BAPHII 1.3.1
139procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); //BAPHII 1.3.1
140function GetPrimaryDx(thisOrderID: string) : string; //BAPHII 1.3.1
141function tempDxNodeExists(thisOrderID: string) : boolean;
142function GetDxNodeIndex(thisOrderID: string) : smallint;
143function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
144function CountSelectedOrders(const Caller: smallint) : smallint;
145function CompareOrderDx(const Caller: smallint) : boolean;
146procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
147procedure DestroyDxList;
148procedure SetBADxList;
149procedure SimpleAddTempDxList(thisOrderID: string);
150procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
151function AllSelectedDxBlank(const Caller: smallint) : boolean;
152function SecondaryDxFull(thisOrderID: string) : boolean;
153procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
154procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
155procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
156procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
157procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
158procedure BACopyOrder(sourceOrderList: TStringList); //BAPHII 1.3.2
159procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); //BAPHII 1.3.2
160procedure CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2
161function GetTFCIForOrder(thisIndex: integer) : string; //BAPHII 1.3.2
162procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
163
164procedure ResetOrderID(fromID: string; toID: string);
165procedure RemoveOrderFromDxList(thisOrderID: string);
166function IsUserNurseProvider(pUserID: int64): boolean;
167function GetPatientTFactors(pOrderList:TStringList): String;
168
169var
170 BAGlobals : TBAGlobals;
171 BAPLPt : TBAPLPt;
172 BAPLRec : TBAPLRec;
173 PLlist : TStringList;
174 BADiagnosisList : TStringList;
175 BALocation : integer;
176 BAPCEDiagList : TStringList;
177 BAOrderIDList : TStringList;
178 tempDxList : TList;
179 globalDxRec : TBADxRecord;
180 UnsignedBillingRec : TBAUnsignedBillingRec;
181 ClearedBillingRec : TBAClearedBillingRec;
182 ConsultOrderRec : TBAConsultOrderRec;
183 BAFactorsInRec : TBATreatmentFactorsInRec;
184 BAFactorsRec : TBAFactorsRec;
185 BAOrderList : TStringList;
186 UpdatedBAOrderList: TStringList;
187 ChangeItemOrderNum: string;
188 i : integer;
189 OrderIDList : TStringList;
190 OrderBillableList : TStrings;
191 BAOrderID : string;
192 BILLING_AWARE : boolean;
193
194 BAtmpOrderList : TStringList;
195 BAFlagsIN : string;
196 BAFlagsOUT : TStringList;
197
198 SourceOrderID : string; //BAPHII 1.3.2
199 TargetOrderID : string; //BAPHII 1.3.2
200 BACopiedOrderFlags: TStringList; //BAPHII 1.3.2
201 BANurseConsultOrders: TStringList;
202
203 // Used to display Dx's on fordersSign and fReview grids
204 Dx1 : string;
205 Dx2 : string;
206 Dx3 : string;
207 Dx4 : string;
208 TFactors : string;
209 SC,AO,IR : string;
210 MST,HNC,CV,SHD,EC : string;
211 PLFactorsIndexes : TStringList;
212 BAHoldPrimaryDx : string; // used to verify primart dx has been changed.
213 BAPrimaryDxChanged: boolean;
214 NonBillableOrderList : TStringList; // contains reference to those selected orders that are non billable
215 OrderListSCEI : TSTringList; // OrderID Exists SCEI are required.
216 UnsignedOrders : TStringList; // List of Orders from fReview when "don't sign" action
217 BAUnSignedOrders : TStringList; // OrderID^StsFlags ie., 12345^NNNNNNN
218 BATFHints : TStringList;
219 BASelectedList : TStringList; // contains list of orders selected for signature.
220 BAConsultDxList: TStringList; // contains dx^code^DxRequired(consults Only) selected for consults.
221 BAConsultPLFlags: TStringList; // orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated.
222 BAFWarningShown: boolean; // flag used to determine if Inactive ICD Code has been shown.
223 BAPersonalDX: boolean;
224 BADeltedOrders: TStringList;
225
226implementation
227
228uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore,
229 VAUtils;
230
231procedure RemoveOrderFromDxList(thisOrderID: string);
232{
233 This routine written for CQ4589. Called from fOrdersDC.ExecuteDCOrders().
234}
235var
236 i: integer;
237begin
238 if tempDxList.Count > 0 then
239 for i := 0 to tempDxList.Count-1 do
240 if tempDxNodeExists(thisOrderID) then
241 if ((TBADxRecord(tempDxList[i]).FOrderID = thisOrderID) and (tempDxList[i] <> nil)) then
242 begin
243 //tempDxList.Items[i] := nil; //remove reference to this item, effectively deleting it from the list (see Delphi help)
244 BACopiedOrderFlags.Clear;
245 UBAGlobals.SourceOrderID := '';
246 UBAGlobals.TargetOrderID := '';
247 tempDxList.Delete(i); //remove this item from the CIDC Dx list
248 end;
249end;
250
251procedure ResetOrderID(fromID: string; toID: string);
252var
253 i: integer;
254begin
255 for i := 0 to tempDxList.Count-1 do
256 begin
257 if TBADxRecord(tempDxList[i]).FOrderID = fromID then
258 TBADxRecord(tempDxList[i]).FOrderID := toID;
259 end;
260end;
261
262function GetTFCIForOrder(thisIndex: integer) : string;
263{
264 Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array.
265}
266begin
267 Result := BACopiedOrderFlags[thisIndex];
268end;
269
270procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string);
271var
272 i: integer;
273begin
274 for i := 0 to tempDxList.Count - 1 do
275 if TBADxRecord(tempDxList[i]).FOrderID = thisTargetOrderID then
276 TBADxRecord(tempDxList[i]).FTreatmentFactors := thisCheckBoxStatus;
277end;
278
279procedure BACopyOrder(sourceOrderList: TStringList);
280{ BAPHII 1.3.2
281 Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators
282}
283var
284 newList,rList: TStringList;
285 i: integer;
286 x: string;
287
288begin
289 newList := TStringList.Create;
290 rList := TSTRingList.Create;
291 newList.Clear;
292 rList.Clear;
293
294 CopyDxRecord(UBAGlobals.SourceOrderID, UBAGlobals.TargetOrderID); //copy dx's to tempDxList record
295 newList.Add(UBAGlobals.SourceOrderID);
296 rList := rpcGetUnsignedOrdersBillingData(newList);
297
298 if RList.Count > 0 then
299 begin
300 for i := 0 to rList.Count-1 do
301 begin
302 x := rList.Strings[i];
303 BACopiedOrderFlags.Add(TargetOrderID + '^' + Piece(x,U,2) );
304 end;
305 end
306 else
307 begin
308 BACopiedOrderFlags.Add(TargetOrderID + '^' + frmSignOrders.GetCheckBoxStatus(sourceOrderID) );
309 end;
310end;
311
312procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string);
313{
314 BAPHII 1.3.2
315}
316var
317 sourceOrderList: TStringList;
318 sourceOrderID: TStringList;
319 targetOrderIDLst: TStringList;
320begin
321 //Retrieve TF's/CI's from SOURCE Order
322 sourceOrderList := TStringList.Create;
323 targetOrderIDLst := TStringList.Create;
324 sourceOrderList.Clear;
325 targetOrderIDLst.Clear;
326 sourceOrderID := TStringList.Create;
327 sourceOrderID.Clear;
328 sourceOrderID.Add(Piece(pSourceOrderID, ';', 1));
329 targetOrderIDLst.Add(pTargetOrderID);
330 { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
331 rpcNonBillableOrders(targetOrderIDLst);
332 if IsOrderBillable(pTargetOrderID) then
333 begin
334 tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
335 BACopyOrder(sourceOrderList);
336 end;
337end;
338
339procedure CopyTreatmentFactorsDxsToRenewedOrder;
340{
341 BAPHII 1.3.2
342}
343var
344 sourceOrderList: TStringList;
345 sourceOrderID: TStringList;
346 targetOrderList: TStringList;
347begin
348 //Retrieve TF's/CI's from SOURCE Order
349 sourceOrderList := TStringList.Create;
350 sourceOrderList.Clear;
351 sourceOrderID := TStringList.Create;
352 sourceOrderID.Clear;
353 targetOrderList := TStringList.Create;
354 targetOrderList.Clear;
355 sourceOrderID.Add(Piece(UBAGlobals.sourceOrderID, ';', 1));
356 { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130}
357 rpcNonBillableOrders(targetOrderList);
358 if IsOrderBillable(UBAGLobals.TargetOrderID) then
359 begin
360 tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]);
361 BACopyOrder(sourceOrderList); //BAPHII 1.3.2
362 end;
363end;
364
365procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string);
366{ //existingRecord //targetOrderID }
367var
368 i: integer;
369 thisRec: TBADxRecord;
370begin
371 if UBAGlobals.tempDxNodeExists(thisOrderID) then
372 begin
373 if Assigned(tempDxList) then
374
375 try
376 for i := 0 to (tempDxList.Count - 1) do
377 begin
378 thisRec := TBADxRecord(tempDxList.Items[i]);
379
380 if Assigned(thisRec) then
381 if (thisRec.FOrderID = thisOrderID) then
382 begin
383 thisRec.FBADxCode := thisRecord.FBADxCode;
384 thisRec.FBASecDx1 := thisRecord.FBASecDx1;
385 thisRec.FBASecDx2 := thisRecord.FBASecDx2;
386 thisRec.FBASecDx3 := thisRecord.FBASecDx3;
387 thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors;
388 end;
389 end;
390
391 except
392 on EListError do
393 begin
394 {$ifdef debug}ShowMsg('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
395 raise;
396 end;
397 end;
398 end;
399end;
400
401procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string);
402 {
403 BAPHII 1.3.1
404 Copy contents of one TBADxRecord to another.
405 If target record does NOT exist, then add it to the Dx list.
406 If target record DOES exist, then change its contents to those of source record.
407 }
408 var
409 thisRecord: TBADxRecord;
410 thatRecord: TBADxRecord;
411 billingInfo: TstringList;
412 orderList: TStringList;
413begin
414 thisRecord := TBADxRecord.Create;
415 thatRecord := TBADxRecord.Create;
416 billingInfo := TStringList.Create;
417 orderList := TStringList.Create;
418 if Assigned(billingInfo) then billingInfo.Clear;
419 if Assigned(orderList) then orderList.Clear;
420
421 if tempDxNodeExists(sourceOrderID) then
422 GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source
423
424 if not tempDxNodeExists(targetOrderID) then
425 begin
426 SimpleAddTempDxList(targetOrderID);
427 orderList.Add(sourceOrderID);
428 billingInfo := rpcRetrieveSelectedOrderInfo(orderList);
429 if billingInfo.Count > 0 then
430 begin
431 thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U +
432 Piece(billingInfo.Strings[0],U,3);
433 thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U +
434 Piece(billingInfo.Strings[0],U,5);
435 thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U +
436 Piece(billingInfo.Strings[0],U,7);
437 thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U +
438 Piece(billingInfo.Strings[0],U,9);
439 if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL;
440 if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ;
441 if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ;
442 if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ;
443
444 end
445 else
446 PutBADxListForOrder(thisRecord, targetOrderID);
447 //copy source data to temporary record
448 with thatRecord do
449 begin
450 FOrderID := targetOrderID;
451 FBADxCode := thisRecord.FBADxCode;
452 FBASecDx1 := thisRecord.FBASecDx1;
453 FBASecDx2 := thisRecord.FBASecDx2;
454 FBASecDx3 := thisRecord.FBASecDx3;
455 PutBADxListForOrder(thatRecord, targetOrderID);
456 end;
457 end;
458end;
459
460
461function GetPrimaryDx(thisOrderID: string) : string;
462{
463BAPHII 1.3.1
464}
465var
466 retVal: TBADxRecord;
467begin
468 retVal := TBADxRecord.Create;
469 GetBADxListForOrder(retVal, thisOrderID);
470 Result := retVal.FBADxCode;
471end;
472
473function AllSelectedDxBlank(const Caller: smallint) : boolean;
474var
475 i: smallint;
476 selectedOrderID: string;
477begin
478 Result := true;
479
480 case Caller of
481 F_ORDERS_SIGN: begin
482 try
483 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
484 if (frmSignOrders.clstOrders.Selected[i]) then
485 begin
486 selectedOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
487 if (tempDxNodeExists(selectedOrderID)) then
488 Result := false;
489 end;
490 except
491 on EListError do
492 begin
493 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
494 raise;
495 end;
496 end;
497 end;
498 F_REVIEW: begin
499 try
500 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
501 if (fReview.frmReview.lstReview.Selected[i]) then
502 begin
503 selectedOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
504 if tempDxNodeExists(selectedOrderID) then
505 Result := false;
506 end;
507 except
508 on EListError do
509 begin
510 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
511 raise;
512 end;
513 end;
514 end;
515 end; //case
516end;
517
518function GetDxNodeIndex(thisOrderID: string) : smallint;
519var
520 i: integer;
521 thisRec: TBADxRecord;
522begin
523 Result := 0;
524
525 if Assigned(tempDxList) then
526
527 try
528 for i := 0 to (tempDxList.Count - 1) do
529 begin
530 thisRec := TBADxRecord(tempDxList.Items[i]);
531 if Assigned(thisRec) then
532 if (thisRec.FOrderID = thisOrderID) then
533 Result := i;
534 end;
535 except
536 on EListError do
537 begin
538 {$ifdef debug}ShowMsg('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
539 raise;
540 end;
541 end;
542end;
543
544function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
545var
546 i: smallint;
547begin
548 Result := false;
549
550 // If the number of Dx's in the lists differs, then bail
551 if (List1.Count <> List2.Count) then
552 begin
553 Result := false;
554 Exit;
555 end;
556
557 List1.Sort;
558 List2.Sort;
559
560 try
561 for i := 0 to (List1.Count - 1) do
562 if (List1.Strings[i] <> List2.Strings[i]) then
563 Result := false
564 else
565 Result := true;
566 except
567 on EListError do
568 begin
569 {$ifdef debug}ShowMsg('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
570 raise;
571 end;
572 end;
573end;
574
575function CountSelectedOrders(const Caller: smallint) : smallint;
576var
577 i: integer;
578 selectedOrders: smallint;
579begin
580 selectedOrders := 0;
581
582 // How many orders selected?
583 case Caller of
584 F_ORDERS_SIGN: begin
585 try
586 for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
587 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
588 Inc(selectedOrders);
589 except
590 on EListError do
591 begin
592 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
593 raise;
594 end;
595 end;
596 end;
597 F_REVIEW: begin
598 try
599 for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
600 if (fReview.frmReview.lstReview.Selected[i]) then
601 Inc(selectedOrders);
602 except
603 on EListError do
604 begin
605 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
606 raise;
607 end;
608 end;
609 end;
610 end; //case
611
612 Result := selectedOrders;
613
614end;
615
616function CompareOrderDx(const Caller: smallint) : boolean;
617var
618 i: integer;
619 firstSelectedID: string;
620 thisOrderID: string;
621 firstDxRec: TBADxRecord;
622 compareDxRec: TBADxRecord;
623 thisStringList: TStringList;
624 thatStringList: TStringList;
625begin
626 Result := false;
627 firstSelectedID := '';
628 firstDxRec := nil;
629 firstDxRec := TBADxRecord.Create;
630 thisStringList := TStringList.Create;
631 thisStringList.Clear;
632 thatStringList := TStringList.Create;
633 thatStringList.Clear;
634
635 case Caller of
636 F_ORDERS_SIGN: begin
637 try
638 for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
639 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
640 begin
641 firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
642 Break;
643 end;
644 except
645 on EListError do
646 begin
647 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
648 raise;
649 end;
650 end;
651 end;
652 F_REVIEW: begin
653 try
654 for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
655 if (fReview.frmReview.lstReview.Selected[i]) then
656 begin
657 firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
658 Break;
659 end;
660 except
661 on EListError do
662 begin
663 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
664 raise;
665 end;
666 end;
667 end;
668 end; //case
669
670 firstDxRec := TBADxRecord.Create;
671 InitializeNewDxRec(firstDxRec);
672 GetBADxListForOrder(firstDxRec, firstSelectedID);
673
674 // first string to compare
675 thisStringList.Add(firstDxRec.FBADxCode);
676 thisStringList.Add(firstDxRec.FBASecDx1);
677 thisStringList.Add(firstDxRec.FBASecDx2);
678 thisStringList.Add(firstDxRec.FBASecDx3);
679
680 case Caller of
681 F_ORDERS_SIGN: begin
682 try
683 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
684 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
685 begin
686 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
687 // If order ID is same as the first selected order, then skip it
688 if thisOrderID = firstSelectedID then
689 Continue
690 else
691 begin
692 compareDxRec := TBADxRecord.Create;
693 InitializeNewDxRec(compareDxRec);
694 GetBADxListForOrder(compareDxRec, thisOrderID);
695
696 thatStringList.Add(compareDxRec.FBADxCode);
697 thatStringList.Add(compareDxRec.FBASecDx1);
698 thatStringList.Add(compareDxRec.FBASecDx2);
699 thatStringList.Add(compareDxRec.FBASecDx3);
700
701 if DiagnosesMatch(thisStringList, thatStringList) then
702 Result := true;
703 end;
704 end;
705 except
706 on EListError do
707 begin
708 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
709 raise;
710 end;
711 end;
712 end;
713 F_REVIEW: begin
714 try
715 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
716 if (fReview.frmReview.lstReview.Selected[i]) then
717 begin
718 thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
719 // If order ID is same as the first selected order, then skip it
720 if thisOrderID = firstSelectedID then
721 Continue
722 else
723 begin
724 compareDxRec := TBADxRecord.Create;
725 InitializeNewDxRec(compareDxRec);
726 GetBADxListForOrder(compareDxRec, thisOrderID);
727
728 thatStringList.Add(compareDxRec.FBADxCode);
729 thatStringList.Add(compareDxRec.FBASecDx1);
730 thatStringList.Add(compareDxRec.FBASecDx2);
731 thatStringList.Add(compareDxRec.FBASecDx3);
732
733 if DiagnosesMatch(thisStringList, thatStringList) then
734 Result := true;
735 end;
736 end;
737 except
738 on EListError do
739 begin
740 {$ifdef debug}ShowMsg('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
741 raise;
742 end;
743 end;
744 end;
745 end; //case
746
747 if Assigned(thisStringList) then
748 FreeAndNil(thisStringList);
749
750 if Assigned(thatStringList) then
751 FreeAndNil(thatStringList);
752end;
753
754procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
755var
756 i: integer;
757 thisRec: TBADxRecord;
758begin
759 if UBAGlobals.tempDxNodeExists(thisOrderID) then
760 begin
761
762 if Assigned(tempDxList) then
763 for i := 0 to (tempDxList.Count - 1) do
764 begin
765 thisRec := TBADxRecord(tempDxList.Items[i]);
766
767 if Assigned(thisRec) then
768 if (thisRec.FOrderID = thisOrderID) then
769 begin
770 with thisRetVal do
771 begin
772 FOrderID := thisRec.FOrderID;
773 FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
774 FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
775 FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
776 FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
777 end;
778 end;
779 end;
780 end;
781end;
782
783procedure DestroyDxList;
784var
785 i: integer;
786begin
787 if Assigned(tempDxList) then
788 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
789 TObject(tempDxList[i]).Free;
790
791 tempDxList := nil;
792 FreeAndNil(tempDxList);
793end;
794
795procedure SimpleAddTempDxList(thisOrderID: string);
796var
797 tempDxRec: TBADxRecord;
798begin
799 frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID);
800 UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec));
801end;
802
803procedure SetBADxList;
804var
805 i: smallint;
806begin
807 if not Assigned(UBAGlobals.tempDxList) then
808 begin
809 UBAGlobals.tempDxList := TList.Create;
810 UBAGlobals.tempDxList.Count := 0;
811 end
812 else
813 begin
814 //Kill the old Dx list
815 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
816 TObject(UBAGlobals.tempDxList[i]).Free;
817
818 UBAGlobals.tempDxList := nil;
819
820 //Create new Dx list for newly selected patient
821 if not Assigned(UBAGlobals.tempDxList) then
822 begin
823 UBAGlobals.tempDxList := TList.Create;
824 UBAGlobals.tempDxList.Count := 0;
825 end;
826 end;
827end;
828
829procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
830var
831 i: integer;
832 foundRec: TBADxRecord;
833begin
834 if UBAGlobals.tempDxNodeExists(thisOrderID) then
835 begin
836 foundRec := TBADxRecord.Create;
837
838 if Assigned(tempDxList) then
839 try
840 for i := 0 to (tempDxList.Count - 1) do
841 begin
842 foundRec := TBADxRecord(tempDxList.Items[i]);
843
844 if Assigned(thisRec) then
845 if (thisOrderID = foundRec.FOrderID) then
846 begin
847 with foundRec do
848 begin
849 FOrderID := thisRec.FOrderID;
850 FBADxCode := thisRec.FBADxCode;
851 FBASecDx1 := thisRec.FBASecDx1;
852 FBASecDx2 := thisRec.FBASecDx2;
853 FBASecDx3 := thisRec.FBASecDx3;
854 PutBADxListForOrder(foundRec, thisOrderID);
855 end;
856 Break;
857 end;
858 end;
859 except
860 on EListError do
861 begin
862 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
863 raise;
864 end;
865 end;
866 end;
867end;
868
869function SecondaryDxFull(thisOrderID: string) : boolean;
870var
871 i: integer;
872 thisRec: TBADxRecord;
873begin
874 Result := false;
875
876 try
877 for i := 0 to tempDxList.Count - 1 do
878 begin
879 thisRec := TBADxRecord(tempDxList.Items[i]);
880
881 if Assigned(thisRec) then
882 if thisRec.FOrderID = thisOrderID then
883 begin
884 if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then
885 if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then
886 if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then
887 if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then
888 Result := true;
889 end;
890 end;
891 except
892 on EListError do
893 begin
894 {$ifdef debug}ShowMsg('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
895 raise;
896 end;
897 end;
898end;
899
900procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
901// Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
902var
903 thisRec: TBADxRecord;
904 i: integer;
905begin
906
907 try
908 for i := 0 to tempDxList.Count - 1 do
909 begin
910 thisRec := TBADxRecord(tempDxList.Items[i]);
911
912 if thisRec.FOrderID = thisOrderID then
913 begin
914 if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then
915 thisRec.FBASecDx1 := thisDxCode
916 else
917 if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then
918 thisRec.FBASecDx2 := thisDxCode
919 else
920 if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then
921 thisRec.FBASecDx3 := thisDxCode;
922 end
923 end;
924 except
925 on EListError do
926 begin
927 {$ifdef debug}ShowMsg('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
928 raise;
929 end;
930 end;
931end;
932
933procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
934begin
935 with thisDxRec do
936 begin
937 FBAOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
938 FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
939 FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
940 FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
941 FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
942 FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL;
943 end;
944end;
945
946
947procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
948begin
949 with thisDxRec do
950 begin
951 FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL;
952 FOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
953 FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
954 FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
955 FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
956 FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
957 end;
958end;
959
960procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
961begin
962 with thisUnsignedRec do
963 begin
964 FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
965 FBASTSFlags := UNSIGNED_REC_INIT_FIELD_VAL;
966 FBADxCode := UNSIGNED_REC_INIT_FIELD_VAL;
967 FBASecDx1 := UNSIGNED_REC_INIT_FIELD_VAL;
968 FBASecDx2 := UNSIGNED_REC_INIT_FIELD_VAL;
969 FBASecDx3 := UNSIGNED_REC_INIT_FIELD_VAL;
970 end;
971end;
972
973procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
974begin
975 with thisTFactorsRecIn do
976 begin
977 FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
978 FBAEligible := UNSIGNED_REC_INIT_FIELD_VAL;
979 FBATFactors := UNSIGNED_REC_INIT_FIELD_VAL;
980 end;
981end;
982constructor TBAGlobals.Create;
983begin
984 inherited Create;
985end;
986// This procedure is called from uPCE.pas only -- do not delete.....
987procedure TBAGlobals.AddBAPCEDiag(DiagStr:string);
988begin
989 if (BAPCEDiagList.Count <= 0) then
990 BAPCEDiagList.Add('^Encounter Diagnoses');
991
992 BAPCEDiagList.Add(DiagStr);
993end;
994
995procedure TBAGlobals.ClearBAPCEDiagList;
996begin
997
998 BAPCEDiagList.Clear;
999end;
1000
1001constructor TBAPLRec.Create;
1002begin
1003 inherited Create;
1004end;
1005
1006function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList;
1007// StringList used to store DX Codes selected from Encounter Form
1008var
1009 BADxIEN: string;
1010 BAProviderStr, BAProviderName : string;
1011 AList: TStringList;
1012begin
1013// Build Problem List record to be saved for selection.
1014 PLlist := TStringList.Create;
1015 AList := TStringList.Create;
1016 AList.Clear;
1017 PLlist.Clear;
1018 BALocation := Encounter.Location;
1019 BAProviderStr := IntToStr(Encounter.Provider);
1020 BAProviderName := Encounter.ProviderName;
1021 BADxIEN := sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]);
1022 BAPLPt.LoadPatientParams(AList);
1023
1024 //BAPLPt.PtVAMC
1025 PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"');
1026 PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"');
1027 PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"');
1028 PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"');
1029 PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"');
1030 PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"');
1031 PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"');
1032 PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"');
1033 PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"');
1034 PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1035 PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1036 PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"');
1037 PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"');
1038 PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"');
1039 Result := PLlist;
1040
1041end;
1042
1043function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime;
1044var
1045 x, Year: string;
1046begin
1047 { Note: TDateTime cannot store month only or year only dates }
1048 x := FMDateTime + '0000000';
1049 if Length(x) > 12 then x := Copy(x, 1, 12);
1050 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
1051 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
1052 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
1053 Result := StrToDateTime(x);
1054end;
1055
1056{-------------------------- TPLPt Class ----------------------}
1057constructor TBAPLPT.Create(Alist:TStringList);
1058var
1059 i: integer;
1060begin
1061 for i := 0 to AList.Count - 1 do
1062 case i of
1063 0: PtVAMC := Copy(Alist[i],1,999);
1064 1: PtDead := AList[i];
1065 2: PtServiceConnected := (AList[i] = '1');
1066 3: PtAgentOrange := (AList[i] = '1');
1067 4: PtRadiation := (AList[i] = '1');
1068 5: PtEnvironmental := (AList[i] = '1');
1069 6: PtBID := Alist[i];
1070 7: PtHNC := (AList[i] = '1');
1071 8: PtMST := (AList[i] = '1');
1072 9: PtSHAD := (AList[i] = '1');
1073 end;
1074end;
1075
1076function TBAPLPt.GetGMPDFN(dfn:string;name:string):string;
1077begin
1078 Result := dfn + u + name + u + PtBID + u + PtDead;
1079end;
1080
1081procedure TBAPLPt.LoadPatientParams(AList:TstringList);
1082begin
1083 FastAssign(rpcInitPt(Patient.DFN), AList);
1084 BAPLPt := TBAPLPt.create(Alist);
1085end;
1086
1087function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ; //*DFN*
1088begin
1089 CallV('ORQQPL INIT PT',[PatientDFN]);
1090 Result := RPCBrokerV.Results;
1091end ;
1092
1093function tempDxNodeExists(thisOrderID: string) : boolean;
1094// Returns true if a node with the specified Order ID exists, false otherwise.
1095var
1096 i: integer;
1097 thisRec: TBADxRecord;
1098begin
1099 Result := false;
1100 if Assigned(tempDxList) then
1101 try
1102 for i := 0 to (tempDxList.Count - 1) do
1103 begin
1104 thisRec := TBADxRecord(tempDxList.Items[i]);
1105
1106 if Assigned(thisRec) then
1107 if (thisRec.FOrderID = thisOrderID) then
1108 begin
1109 Result := true;
1110 Break;
1111 end;
1112 end;
1113 except
1114 on EListError do
1115 begin
1116 {$ifdef debug}ShowMsg('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
1117 raise;
1118 end;
1119 end;
1120end;
1121 // HDS00003380
1122function IsUserNurseProvider(pUserID: int64):boolean;
1123begin
1124 Result := False;
1125 if BILLING_AWARE then
1126 begin
1127 if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then
1128 if (uCore.User.OrderRole = OR_NURSE) then
1129 Result := True;
1130 end;
1131end;
1132
1133function GetPatientTFactors(pOrderList:TStringList):String;
1134begin
1135 Result := '';
1136 Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]);
1137end;
1138
1139
1140Initialization
1141 BAPrimaryDxChanged := False;
1142 BAFWarningShown := False;
1143 BAPersonalDX := False;
1144 BAHoldPrimaryDx := DXREC_INIT_FIELD_VAL;
1145 NonBillableOrderList := TStringList.Create;
1146 BAPCEDiagList := TStringList.Create;
1147 OrderListSCEI := TStringList.Create;
1148 BAOrderList := TStringList.Create;
1149 UnSignedOrders := TStringList.Create;
1150 BAOrderIDList := TStringList.Create;
1151 BAUnSignedOrders := TStringList.Create;
1152 BATFHints := TStringList.Create;
1153 BAFactorsRec := TBAFactorsRec.Create;
1154 BAFactorsInRec := TBATreatmentFactorsInRec.Create;
1155 BASelectedList := TStringList.Create;
1156 PLFactorsIndexes := TStringList.Create;
1157 BAtmpOrderList := TStringList.Create;
1158 BACopiedOrderFlags := TStringList.Create; //BAPHII 1.3.2
1159 OrderIDList := TStringList.Create;
1160 BAConsultDxList := TStringList.Create;
1161 BAConsultPLFlags := TStringList.Create;
1162 BANurseConsultOrders := TStringList.Create;
1163 BADeltedOrders := TStringList.Create;
1164 BAConsultDxList.Clear;
1165 NonBillableOrderList.Clear;
1166 OrderListSCEI.Clear;
1167 UnSignedOrders.Clear;
1168 BAOrderIDList.Clear;
1169 BAUnSignedOrders.Clear;
1170 BATFHints.Clear;
1171 PLFactorsIndexes.Clear;
1172 BASelectedList.Clear;
1173 BAtmpOrderList.Clear;
1174 OrderIDList.Clear;
1175 BAConsultPLFlags.Clear;
1176 BAPCEDiagList.Clear;
1177 BANurseConsultOrders.Clear;
1178 BADeltedOrders.Clear;
1179
1180end.
1181
1182
1183
Note: See TracBrowser for help on using the repository browser.