source: cprs/branches/foia-cprs/CPRS-Chart/BA/UBAGlobals.pas@ 459

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

Adding foia-cprs branch
File size: 41.0 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;
318 i:integer;
319 tempOrderStr:string;
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 thisRec := TBADxRecord.Create;
374 if Assigned(tempDxList) then
375
376 try
377 for i := 0 to (tempDxList.Count - 1) do
378 begin
379 thisRec := TBADxRecord(tempDxList.Items[i]);
380
381 if Assigned(thisRec) then
382 if (thisRec.FOrderID = thisOrderID) then
383 begin
384 thisRec.FBADxCode := thisRecord.FBADxCode;
385 thisRec.FBASecDx1 := thisRecord.FBASecDx1;
386 thisRec.FBASecDx2 := thisRecord.FBASecDx2;
387 thisRec.FBASecDx3 := thisRecord.FBASecDx3;
388 thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors;
389 end;
390 end;
391
392 except
393 on EListError do
394 begin
395 {$ifdef debug}ShowMessage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif}
396 raise;
397 end;
398 end;
399 end;
400end;
401
402procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string);
403 {
404 BAPHII 1.3.1
405 Copy contents of one TBADxRecord to another.
406 If target record does NOT exist, then add it to the Dx list.
407 If target record DOES exist, then change its contents to those of source record.
408 }
409 var
410 thisRecord: TBADxRecord;
411 thatRecord: TBADxRecord;
412 billingInfo: TstringList;
413 orderList: TStringList;
414begin
415 thisRecord := TBADxRecord.Create;
416 thatRecord := TBADxRecord.Create;
417 billingInfo := TStringList.Create;
418 orderList := TStringList.Create;
419 if Assigned(billingInfo) then billingInfo.Clear;
420 if Assigned(orderList) then orderList.Clear;
421
422 if tempDxNodeExists(sourceOrderID) then
423 GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source
424
425 if not tempDxNodeExists(targetOrderID) then
426 begin
427 SimpleAddTempDxList(targetOrderID);
428 orderList.Add(sourceOrderID);
429 billingInfo := rpcRetrieveSelectedOrderInfo(orderList);
430 if billingInfo.Count > 0 then
431 begin
432 thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U +
433 Piece(billingInfo.Strings[0],U,3);
434 thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U +
435 Piece(billingInfo.Strings[0],U,5);
436 thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U +
437 Piece(billingInfo.Strings[0],U,7);
438 thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U +
439 Piece(billingInfo.Strings[0],U,9);
440 if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL;
441 if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ;
442 if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ;
443 if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ;
444
445 end
446 else
447 PutBADxListForOrder(thisRecord, targetOrderID);
448 //copy source data to temporary record
449 with thatRecord do
450 begin
451 FOrderID := targetOrderID;
452 FBADxCode := thisRecord.FBADxCode;
453 FBASecDx1 := thisRecord.FBASecDx1;
454 FBASecDx2 := thisRecord.FBASecDx2;
455 FBASecDx3 := thisRecord.FBASecDx3;
456 PutBADxListForOrder(thatRecord, targetOrderID);
457 end;
458 end;
459end;
460
461
462function GetPrimaryDx(thisOrderID: string) : string;
463{
464BAPHII 1.3.1
465}
466var
467 retVal: TBADxRecord;
468begin
469 retVal := TBADxRecord.Create;
470 GetBADxListForOrder(retVal, thisOrderID);
471 Result := retVal.FBADxCode;
472end;
473
474function AllSelectedDxBlank(const Caller: smallint) : boolean;
475var
476 i: smallint;
477 selectedOrderID: string;
478begin
479 Result := true;
480
481 case Caller of
482 F_ORDERS_SIGN: begin
483 try
484 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
485 if (frmSignOrders.clstOrders.Selected[i]) then
486 begin
487 selectedOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
488 if (tempDxNodeExists(selectedOrderID)) then
489 Result := false;
490 end;
491 except
492 on EListError do
493 begin
494 {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif}
495 raise;
496 end;
497 end;
498 end;
499 F_REVIEW: begin
500 try
501 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
502 if (fReview.frmReview.lstReview.Selected[i]) then
503 begin
504 selectedOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID;
505 if tempDxNodeExists(selectedOrderID) then
506 Result := false;
507 end;
508 except
509 on EListError do
510 begin
511 {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif}
512 raise;
513 end;
514 end;
515 end;
516 end; //case
517end;
518
519function GetDxNodeIndex(thisOrderID: string) : smallint;
520var
521 i: integer;
522 thisRec: TBADxRecord;
523begin
524 Result := 0;
525 thisRec := TBADxRecord.Create;
526
527 if Assigned(tempDxList) then
528
529 try
530 for i := 0 to (tempDxList.Count - 1) do
531 begin
532 thisRec := TBADxRecord(tempDxList.Items[i]);
533 if Assigned(thisRec) then
534 if (thisRec.FOrderID = thisOrderID) then
535 Result := i;
536 end;
537 except
538 on EListError do
539 begin
540 {$ifdef debug}ShowMessage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif}
541 raise;
542 end;
543 end;
544end;
545
546function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean;
547var
548 i: smallint;
549begin
550 Result := false;
551
552 // If the number of Dx's in the lists differs, then bail
553 if (List1.Count <> List2.Count) then
554 begin
555 Result := false;
556 Exit;
557 end;
558
559 List1.Sort;
560 List2.Sort;
561
562 try
563 for i := 0 to (List1.Count - 1) do
564 if (List1.Strings[i] <> List2.Strings[i]) then
565 Result := false
566 else
567 Result := true;
568 except
569 on EListError do
570 begin
571 {$ifdef debug}ShowMessage('EListError in UBAGlobals.DiagnosesMatch()');{$endif}
572 raise;
573 end;
574 end;
575end;
576
577function CountSelectedOrders(const Caller: smallint) : smallint;
578var
579 i: integer;
580 selectedOrders: smallint;
581begin
582 Result := 0;
583 selectedOrders := 0;
584
585 // How many orders selected?
586 case Caller of
587 F_ORDERS_SIGN: begin
588 try
589 for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
590 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
591 Inc(selectedOrders);
592 except
593 on EListError do
594 begin
595 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif}
596 raise;
597 end;
598 end;
599 end;
600 F_REVIEW: begin
601 try
602 for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
603 if (fReview.frmReview.lstReview.Selected[i]) then
604 Inc(selectedOrders);
605 except
606 on EListError do
607 begin
608 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif}
609 raise;
610 end;
611 end;
612 end;
613 end; //case
614
615 Result := selectedOrders;
616
617end;
618
619function CompareOrderDx(const Caller: smallint) : boolean;
620var
621 i: integer;
622 firstSelectedID: string;
623 thisOrderID: string;
624 firstDxRec: TBADxRecord;
625 compareDxRec: TBADxRecord;
626 thisStringList: TStringList;
627 thatStringList: TStringList;
628begin
629 Result := false;
630 firstSelectedID := '';
631 firstDxRec := nil;
632 firstDxRec := TBADxRecord.Create;
633 thisStringList := TStringList.Create;
634 thisStringList.Clear;
635 thatStringList := TStringList.Create;
636 thatStringList.Clear;
637
638 case Caller of
639 F_ORDERS_SIGN: begin
640 try
641 for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do
642 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
643 begin
644 firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
645 Break;
646 end;
647 except
648 on EListError do
649 begin
650 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
651 raise;
652 end;
653 end;
654 end;
655 F_REVIEW: begin
656 try
657 for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do
658 if (fReview.frmReview.lstReview.Selected[i]) then
659 begin
660 firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
661 Break;
662 end;
663 except
664 on EListError do
665 begin
666 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
667 raise;
668 end;
669 end;
670 end;
671 end; //case
672
673 firstDxRec := TBADxRecord.Create;
674 InitializeNewDxRec(firstDxRec);
675 GetBADxListForOrder(firstDxRec, firstSelectedID);
676
677 // first string to compare
678 thisStringList.Add(firstDxRec.FBADxCode);
679 thisStringList.Add(firstDxRec.FBASecDx1);
680 thisStringList.Add(firstDxRec.FBASecDx2);
681 thisStringList.Add(firstDxRec.FBASecDx3);
682
683 case Caller of
684 F_ORDERS_SIGN: begin
685 try
686 for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
687 if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
688 begin
689 thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
690 // If order ID is same as the first selected order, then skip it
691 if thisOrderID = firstSelectedID then
692 Continue
693 else
694 begin
695 compareDxRec := TBADxRecord.Create;
696 InitializeNewDxRec(compareDxRec);
697 GetBADxListForOrder(compareDxRec, thisOrderID);
698
699 thatStringList.Add(compareDxRec.FBADxCode);
700 thatStringList.Add(compareDxRec.FBASecDx1);
701 thatStringList.Add(compareDxRec.FBASecDx2);
702 thatStringList.Add(compareDxRec.FBASecDx3);
703
704 if DiagnosesMatch(thisStringList, thatStringList) then
705 Result := true;
706 end;
707 end;
708 except
709 on EListError do
710 begin
711 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif}
712 raise;
713 end;
714 end;
715 end;
716 F_REVIEW: begin
717 try
718 for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do
719 if (fReview.frmReview.lstReview.Selected[i]) then
720 begin
721 thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID;
722 // If order ID is same as the first selected order, then skip it
723 if thisOrderID = firstSelectedID then
724 Continue
725 else
726 begin
727 compareDxRec := TBADxRecord.Create;
728 InitializeNewDxRec(compareDxRec);
729 GetBADxListForOrder(compareDxRec, thisOrderID);
730
731 thatStringList.Add(compareDxRec.FBADxCode);
732 thatStringList.Add(compareDxRec.FBASecDx1);
733 thatStringList.Add(compareDxRec.FBASecDx2);
734 thatStringList.Add(compareDxRec.FBASecDx3);
735
736 if DiagnosesMatch(thisStringList, thatStringList) then
737 Result := true;
738 end;
739 end;
740 except
741 on EListError do
742 begin
743 {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif}
744 raise;
745 end;
746 end;
747 end;
748 end; //case
749
750 if Assigned(thisStringList) then
751 FreeAndNil(thisStringList);
752
753 if Assigned(thatStringList) then
754 FreeAndNil(thatStringList);
755end;
756
757procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string);
758var
759 i: integer;
760 thisRec: TBADxRecord;
761begin
762 if UBAGlobals.tempDxNodeExists(thisOrderID) then
763 begin
764 thisRec := TBADxRecord.Create;
765
766 if Assigned(tempDxList) then
767 for i := 0 to (tempDxList.Count - 1) do
768 begin
769 thisRec := TBADxRecord(tempDxList.Items[i]);
770
771 if Assigned(thisRec) then
772 if (thisRec.FOrderID = thisOrderID) then
773 begin
774 with thisRetVal do
775 begin
776 FOrderID := thisRec.FOrderID;
777 FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
778 FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
779 FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
780 FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
781 end;
782 end;
783 end;
784 end;
785end;
786
787procedure DestroyDxList;
788var
789 i: integer;
790begin
791 if Assigned(tempDxList) then
792 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
793 TObject(tempDxList[i]).Free;
794
795 tempDxList := nil;
796 FreeAndNil(tempDxList);
797end;
798
799procedure SimpleAddTempDxList(thisOrderID: string);
800var
801 tempDxRec: TBADxRecord;
802begin
803 frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID);
804 UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec));
805end;
806
807procedure SetBADxList;
808var
809 i: smallint;
810begin
811 if not Assigned(UBAGlobals.tempDxList) then
812 begin
813 UBAGlobals.tempDxList := TList.Create;
814 UBAGlobals.tempDxList.Count := 0;
815 end
816 else
817 begin
818 //Kill the old Dx list
819 for i := 0 to pred(UBAGlobals.tempDxList.Count) do
820 TObject(UBAGlobals.tempDxList[i]).Free;
821
822 UBAGlobals.tempDxList := nil;
823
824 //Create new Dx list for newly selected patient
825 if not Assigned(UBAGlobals.tempDxList) then
826 begin
827 UBAGlobals.tempDxList := TList.Create;
828 UBAGlobals.tempDxList.Count := 0;
829 end;
830 end;
831end;
832
833procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string);
834var
835 i: integer;
836 foundRec: TBADxRecord;
837begin
838 if UBAGlobals.tempDxNodeExists(thisOrderID) then
839 begin
840 foundRec := TBADxRecord.Create;
841
842 if Assigned(tempDxList) then
843 try
844 for i := 0 to (tempDxList.Count - 1) do
845 begin
846 foundRec := TBADxRecord(tempDxList.Items[i]);
847
848 if Assigned(thisRec) then
849 if (thisOrderID = foundRec.FOrderID) then
850 begin
851 with foundRec do
852 begin
853 FOrderID := thisRec.FOrderID;
854 FBADxCode := thisRec.FBADxCode;
855 FBASecDx1 := thisRec.FBASecDx1;
856 FBASecDx2 := thisRec.FBASecDx2;
857 FBASecDx3 := thisRec.FBASecDx3;
858 PutBADxListForOrder(foundRec, thisOrderID);
859 end;
860 Break;
861 end;
862 end;
863 except
864 on EListError do
865 begin
866 {$ifdef debug}ShowMessage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif}
867 raise;
868 end;
869 end;
870 end;
871end;
872
873function SecondaryDxFull(thisOrderID: string) : boolean;
874var
875 i: integer;
876 thisRec: TBADxRecord;
877begin
878 Result := false;
879
880 thisRec := TBADxRecord.Create;
881 try
882 for i := 0 to tempDxList.Count - 1 do
883 begin
884 thisRec := TBADxRecord(tempDxList.Items[i]);
885
886 if Assigned(thisRec) then
887 if thisRec.FOrderID = thisOrderID then
888 begin
889 if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then
890 if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then
891 if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then
892 if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then
893 Result := true;
894 end;
895 end;
896 except
897 on EListError do
898 begin
899 {$ifdef debug}ShowMessage('EListError in UBAGlobals.SecondaryDxFull()');{$endif}
900 raise;
901 end;
902 end;
903end;
904
905procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string);
906// Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot
907var
908 thisRec: TBADxRecord;
909 i: integer;
910begin
911 thisRec := TBADxRecord.Create;
912
913 try
914 for i := 0 to tempDxList.Count - 1 do
915 begin
916 thisRec := TBADxRecord(tempDxList.Items[i]);
917
918 if thisRec.FOrderID = thisOrderID then
919 begin
920 if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then
921 thisRec.FBASecDx1 := thisDxCode
922 else
923 if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then
924 thisRec.FBASecDx2 := thisDxCode
925 else
926 if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then
927 thisRec.FBASecDx3 := thisDxCode;
928 end
929 end;
930 except
931 on EListError do
932 begin
933 {$ifdef debug}ShowMessage('EListError in UBAGlobals.AddSecondaryDx()');{$endif}
934 raise;
935 end;
936 end;
937end;
938
939procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec);
940begin
941 with thisDxRec do
942 begin
943 FBAOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
944 FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
945 FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
946 FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
947 FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
948 FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL;
949 end;
950end;
951
952
953procedure InitializeNewDxRec(var thisDxRec: TBADxRecord);
954begin
955 with thisDxRec do
956 begin
957 FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL;
958 FOrderID := UBAConst.DXREC_INIT_FIELD_VAL;
959 FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL;
960 FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL;
961 FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL;
962 FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL;
963 end;
964end;
965
966procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec);
967begin
968 with thisUnsignedRec do
969 begin
970 FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
971 FBASTSFlags := UNSIGNED_REC_INIT_FIELD_VAL;
972 FBADxCode := UNSIGNED_REC_INIT_FIELD_VAL;
973 FBASecDx1 := UNSIGNED_REC_INIT_FIELD_VAL;
974 FBASecDx2 := UNSIGNED_REC_INIT_FIELD_VAL;
975 FBASecDx3 := UNSIGNED_REC_INIT_FIELD_VAL;
976 end;
977end;
978
979procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec);
980begin
981 with thisTFactorsRecIn do
982 begin
983 FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL;
984 FBAEligible := UNSIGNED_REC_INIT_FIELD_VAL;
985 FBATFactors := UNSIGNED_REC_INIT_FIELD_VAL;
986 end;
987end;
988constructor TBAGlobals.Create;
989begin
990 inherited Create;
991end;
992// This procedure is called from uPCE.pas only -- do not delete.....
993procedure TBAGlobals.AddBAPCEDiag(DiagStr:string);
994begin
995 if (BAPCEDiagList.Count <= 0) then
996 BAPCEDiagList.Add('^Encounter Diagnoses');
997
998 BAPCEDiagList.Add(DiagStr);
999end;
1000
1001procedure TBAGlobals.ClearBAPCEDiagList;
1002begin
1003
1004 BAPCEDiagList.Clear;
1005end;
1006
1007constructor TBAPLRec.Create;
1008begin
1009 inherited Create;
1010end;
1011
1012function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList;
1013// StringList used to store DX Codes selected from Encounter Form
1014var
1015 BAVisitStr,BADxIEN: string;
1016 BAFileCat : char;
1017 BAFileDateTimeStr: string;
1018 BAProviderStr, BAProviderName : string;
1019 PList: TStringList;
1020 AList: TStringList;
1021begin
1022// Build Problem List record to be saved for selection.
1023 PLlist := TStringList.Create;
1024 AList := TStringList.Create;
1025 AList.Clear;
1026 PLlist.Clear;
1027 BALocation := Encounter.Location;
1028 BAProviderStr := IntToStr(Encounter.Provider);
1029 BAProviderName := Encounter.ProviderName;
1030 BADxIEN := sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]);
1031 BAPLPt.LoadPatientParams(AList);
1032
1033 //BAPLPt.PtVAMC
1034 PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"');
1035 PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"');
1036 PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"');
1037 PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"');
1038 PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"');
1039 PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"');
1040 PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"');
1041 PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"');
1042 PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"');
1043 PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1044 PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"');
1045 PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"');
1046 PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"');
1047 PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"');
1048 Result := PLlist;
1049
1050end;
1051
1052function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime;
1053var
1054 x, Year: string;
1055begin
1056 { Note: TDateTime cannot store month only or year only dates }
1057 x := FMDateTime + '0000000';
1058 if Length(x) > 12 then x := Copy(x, 1, 12);
1059 if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
1060 Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
1061 x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
1062 Result := StrToDateTime(x);
1063end;
1064
1065{-------------------------- TPLPt Class ----------------------}
1066constructor TBAPLPT.Create(Alist:TStringList);
1067var
1068 i: integer;
1069begin
1070 for i := 0 to AList.Count - 1 do
1071 case i of
1072 0: PtVAMC := Copy(Alist[i],1,999);
1073 1: PtDead := AList[i];
1074 2: PtServiceConnected := (AList[i] = '1');
1075 3: PtAgentOrange := (AList[i] = '1');
1076 4: PtRadiation := (AList[i] = '1');
1077 5: PtEnvironmental := (AList[i] = '1');
1078 6: PtBID := Alist[i];
1079 7: PtHNC := (AList[i] = '1');
1080 8: PtMST := (AList[i] = '1');
1081 end;
1082end;
1083
1084function TBAPLPt.GetGMPDFN(dfn:string;name:string):string;
1085begin
1086 Result := dfn + u + name + u + PtBID + u + PtDead;
1087end;
1088
1089procedure TBAPLPt.LoadPatientParams(AList:TstringList);
1090begin
1091 AList.Assign(rpcInitPt(Patient.DFN));
1092 BAPLPt := TBAPLPt.create(Alist);
1093end;
1094
1095function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ; //*DFN*
1096begin
1097 CallV('ORQQPL INIT PT',[PatientDFN]);
1098 Result := RPCBrokerV.Results;
1099end ;
1100
1101function tempDxNodeExists(thisOrderID: string) : boolean;
1102// Returns true if a node with the specified Order ID exists, false otherwise.
1103var
1104 i: integer;
1105 thisRec: TBADxRecord;
1106begin
1107 Result := false;
1108 thisRec := TBADxRecord.Create;
1109 if Assigned(tempDxList) then
1110 try
1111 for i := 0 to (tempDxList.Count - 1) do
1112 begin
1113 thisRec := TBADxRecord(tempDxList.Items[i]);
1114
1115 if Assigned(thisRec) then
1116 if (thisRec.FOrderID = thisOrderID) then
1117 begin
1118 Result := true;
1119 Break;
1120 end;
1121 end;
1122 except
1123 on EListError do
1124 begin
1125 {$ifdef debug}ShowMessage('EListError in UBAGlobals.tempDxNodeExists()');{$endif}
1126 raise;
1127 end;
1128 end;
1129end;
1130 // HDS00003380
1131function IsUserNurseProvider(pUserID: int64):boolean;
1132begin
1133 Result := False;
1134 if BILLING_AWARE then
1135 begin
1136 if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then
1137 if (uCore.User.OrderRole = OR_NURSE) then
1138 Result := True;
1139 end;
1140end;
1141
1142function GetPatientTFactors(pOrderList:TStringList):String;
1143begin
1144 Result := '';
1145 Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]);
1146end;
1147
1148
1149Initialization
1150 BAPrimaryDxChanged := False;
1151 BAFWarningShown := False;
1152 BAPersonalDX := False;
1153 BAHoldPrimaryDx := DXREC_INIT_FIELD_VAL;
1154 NonBillableOrderList := TStringList.Create;
1155 BAPCEDiagList := TStringList.Create;
1156 OrderListSCEI := TStringList.Create;
1157 BAOrderList := TStringList.Create;
1158 UnSignedOrders := TStringList.Create;
1159 BAOrderIDList := TStringList.Create;
1160 BAUnSignedOrders := TStringList.Create;
1161 BATFHints := TStringList.Create;
1162 BAFactorsRec := TBAFactorsRec.Create;
1163 BAFactorsInRec := TBATreatmentFactorsInRec.Create;
1164 BASelectedList := TStringList.Create;
1165 PLFactorsIndexes := TStringList.Create;
1166 BAtmpOrderList := TStringList.Create;
1167 BACopiedOrderFlags := TStringList.Create; //BAPHII 1.3.2
1168 OrderIDList := TStringList.Create;
1169 BAConsultDxList := TStringList.Create;
1170 BAConsultPLFlags := TStringList.Create;
1171 BANurseConsultOrders := TStringList.Create;
1172 BADeltedOrders := TStringList.Create;
1173 // BAConsultOrdersRequireDx := TStringList.Create;
1174 BAConsultDxList.Clear;
1175 NonBillableOrderList.Clear;
1176 OrderListSCEI.Clear;
1177 UnSignedOrders.Clear;
1178 BAOrderIDList.Clear;
1179 BAUnSignedOrders.Clear;
1180 BATFHints.Clear;
1181 PLFactorsIndexes.Clear;
1182 BASelectedList.Clear;
1183 BAtmpOrderList.Clear;
1184 OrderIDList.Clear;
1185 BAConsultPLFlags.Clear;
1186 BAPCEDiagList.Clear;
1187 BANurseConsultOrders.Clear;
1188 BADeltedOrders.Clear;
1189 //BAConsultOrdersRequireDx.Clear;
1190
1191end.
1192
1193
1194
Note: See TracBrowser for help on using the repository browser.