source: cprs/branches/tmg-cprs/CPRS-Chart/BA/UBAGlobals.pas@ 468

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

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