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

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

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