IBEFUR ;ALB/ARH - UTILITY: FIND RELATED FIRST AND THIRD PARTY BILLS ; 3/7/00
;;2.0;INTEGRATED BILLING;**130,459,728**;21-MAR-94;Build 14
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Called by Accounts Receivable report option
;
; for a specific Third Party bill, return all related Third Party bills
; matchs with the selected bill are based on: (selected bill is included in list returned)
; 1) Event Date (399,.03), returns all bills with same Event Date
;
; 2) PTF # (399,.08), returns all bills with the same PTF number
; 3) PTF # (399,.08), returns all bills with Outpatient Visit Dates (399,43) within the admission date range
;
; 4) Opt Visit Dates (399,43), returns all bills with one or more matching Opt Visit Dates
; 5) Opt Visit Dates (399,43), returns all bills for any PTF (399,.08) stay covering any of the Opt Visit Dates
;
; 6) Prescriptions (362.4): returns all bills with one or more matching Rx # and fill date
;
; ^TMP("IBRBT", $J, selected bill ifn) = PATIENT HAS ANY RX COVERAGE ON FROM DATE OF BILL (0/1)
; ^TMP("IBRBT", $J, selected bill ifn, matching bill ifn) =
; BILL FROM ^ BILL TO ^ CANCELLED (0/1) ^ AR BILL NUMBER ^
; PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME
;
TPTP(IBIFN) ; given a specific Third Party bill, find all related Third Party Bills
N IB0,DFN,IBEVDT,IBPTF,IBADM,IBDIS,IBOPV,IBPTF1,IBXRF,IBRXN,IBRXDT,IBX Q:'$G(IBIFN)
S IB0=$G(^DGCR(399,+IBIFN,0)) Q:IB0="" S DFN=$P(IB0,U,2),IBEVDT=$P(IB0,U,3),IBPTF=$P(IB0,U,8)
;
K ^TMP("IBRBT",$J,IBIFN) S IBX=$$LN1^IBEFURT(IBIFN) D SAVELN1^IBEFURT(IBIFN,IBX)
;
I +IBEVDT D TPEVDT^IBEFURT(DFN,IBEVDT,IBIFN) ; find all bills with the same Event Date (399,.03)
;
IT I +IBPTF D TPPTF^IBEFURT(IBPTF,IBIFN) ; find all bills with the same PTF number (399,.08)
;
; find any bills with Outpatient Visit Dates within the date range of the admission (PTF)
I +IBPTF S IBADM=$P($G(^DGPT(+IBPTF,0)),U,2),IBDIS=+$G(^DGPT(+IBPTF,70)) S:'IBDIS IBDIS=DT D
. D TPOPV^IBEFURT(DFN,IBADM,IBDIS,IBIFN)
;
OT ; find all bills that have one or more of the same Opt Visit Dates (399,43)
S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX S IBOPV=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) D
. D TPOPV^IBEFURT(DFN,IBOPV,IBOPV,IBIFN)
;
; find any bills for inpatient admissions whose date range includes one or more of the Opt Visit Dates
S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX S IBOPV=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) D
. S IBADM=$$ADM^IBCU64(DFN,IBOPV) I +IBADM S IBPTF1=$P(IBADM,U,4) I +IBPTF1 D
.. D TPPTF^IBEFURT(IBPTF1,IBIFN)
;
RT ; find all bills that have one or more of the same Prescription: same Rx number and fill date (362.4,.01,.03)
S IBXRF="AIFN"_IBIFN,IBRXN="" F S IBRXN=$O(^IBA(362.4,IBXRF,IBRXN)) Q:'IBRXN D
. S IBX=0 F S IBX=$O(^IBA(362.4,IBXRF,IBRXN,IBX)) Q:'IBX S IBRXDT=$P($G(^IBA(362.4,IBX,0)),U,3) D
.. D TPRX^IBEFURT(DFN,IBRXN,IBRXDT,IBIFN)
Q
;
; ==============================================================================================================
;
; Called by Accounts Receivable report option
;
; for a specific Third Party bill, return all related First Party Charges
; only a single record of a charge event is returned, defining the charges current status, although there may
; have been cancellations or updates to the original charge
; o Inpatient Events may have multiple charge events (Copay and Per Diem)
; o Opt and Rx Events have only a single charge event (Copay)
;
; matchs with the selected bill are based on:
; 1) Event Date (399,.03), returns Inpatient charges whose Parent Event (350,.16) has that Event Date (350,.17)
; 2) PTF # (399,.08), returns Outpatient charge for Opt Visits Dates within timeframe of admission
;
; 3) Opt Visit Date (399,43), returns the Outpatient charge for that Event Date (350,.17)
; 4) Opt Visit Date (399,43), returns Inpatient charges for any admission that includes that Opt Visit Date
;
; 5) Rx Record (362.4,.05) and Rx Date (362.4,.03) and Outpatient Pharmacy, returns the Rx charge for the fill
; 6) Opt Visit Date (399,43) and Outpatient Pharmacy, returns any First Party Rx charge on one of the
; selected bills Opt Visit Dates that is not billed on any Third Party bill
;
; ^TMP("IBRBF", $J , selected bill ifn ) = ""
; ^TMP("IBRBF", $J , selected bill ifn , charge ifn) =
; BILL FROM ^ BILL TO ^ CANCELLED? (1/0)^ AR BILL NUMBER ^ TOTAL CHARGE ^ ACTION TYPE (SHORT) ^ # DAYS ON HOLD
;
TPFP(IBIFN) ; given a specific Third Party Bill, find all related First Party Bills
N IBX,IBY,IB0,DFN,IBEVDT,IBPTF,IBADM,IBOPV,IBXRF,IBRXN,IBRXIFN,IBRXDT,IBFROM,IBTO,IBU Q:'$G(IBIFN)
S IB0=$G(^DGCR(399,+IBIFN,0)) Q:IB0="" S DFN=$P(IB0,U,2),IBEVDT=$P(IB0,U,3)
S IBU=$G(^DGCR(399,+IBIFN,"U")),IBFROM=$P(IBU,U),IBTO=$P(IBU,U,2) ; IB*2.0*728
;
K ^TMP("IBRBF",$J,IBIFN) D SAVELN1^IBEFURF(IBIFN)
;
IF ; find all First Party charges for the Inpatient Event Date (Admission Date) on the Third Party bill
D FPINPT1^IBEFURF(DFN,IBFROM,IBTO,IBIFN) ; IB*2.0*728
;
; find any First Party Outpatient charges for Visit Dates within the date range of the admission (PTF)
S IBPTF=$P(IB0,U,8) I +IBPTF S IBADM=$$PTFADM^IBCU64(+IBPTF) I +IBADM S IBADM=$$AD^IBCU64(IBADM) D
. S IBX=$P(IBADM,U,2)\1 I 'IBX S IBX=DT
. D FPOPV^IBEFURF(DFN,+IBADM\1,IBX,IBIFN)
;
OF ; find First Party charges for the Opt Visit Dates on the Third Party Bill
S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX S IBOPV=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) D
. D FPOPV^IBEFURF(DFN,IBOPV,IBOPV,IBIFN)
;
; find any charges for inpatient admissions whose date range includes one or more of the Opt Visit Dates
S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX S IBOPV=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) D
. S IBADM=$$ADM^IBCU64(DFN,IBOPV) I 'IBADM Q
. D FPINPT^IBEFURF(DFN,+IBADM,IBIFN)
;
RF ; find First Party charges for any Rx's on the selected Third Party bill
; based on Rx IFN (52), fill date and fill# (362.4,.05,.03,.1)
N IBRXFL
S IBXRF="AIFN"_IBIFN,IBRXN="" F S IBRXN=$O(^IBA(362.4,IBXRF,IBRXN)) Q:'IBRXN D
. S IBX=0 F S IBX=$O(^IBA(362.4,IBXRF,IBRXN,IBX)) Q:'IBX D
.. S IBY=$G(^IBA(362.4,IBX,0)),IBRXIFN=$P(IBY,U,5),IBRXDT=$P(IBY,U,3),IBRXFL=$P(IBY,U,10) Q:'IBRXIFN
.. D FPRX^IBEFURF(IBRXIFN,IBRXDT,IBIFN,IBRXFL)
;
; find First Party Charges for any RX filled on one of the Third Party bill's Opt Visit Dates
; that is not billed on any Third Party bill
S IBFROM=$G(^DGCR(399,IBIFN,"U")),IBTO=$P(IBFROM,U,2),IBFROM=+IBFROM K IBX
D RXDISP^IBCSC5C(DFN,IBFROM,IBTO,.IBX,"","",1,1) ; get all Rx's for patient in date range
S IBRXN="" F S IBRXN=$O(IBX(IBRXN)) Q:IBRXN="" S IBRXDT=0 F S IBRXDT=$O(IBX(IBRXN,IBRXDT)) Q:'IBRXDT D
. I '$D(^DGCR(399,"AOPV",DFN,IBRXDT,IBIFN)) Q ; rx not on bills opt visit date
. I +$$RXTP^IBEFURT(DFN,IBRXN,IBRXDT) Q ; rx billed on a third party bill
. S IBRXIFN=$P(IBX(IBRXN,IBRXDT),U,1)
. D FPRX^IBEFURF(IBRXIFN,IBRXDT,IBIFN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEFUR 7175 printed Oct 16, 2024@18:22:38 Page 2
IBEFUR ;ALB/ARH - UTILITY: FIND RELATED FIRST AND THIRD PARTY BILLS ; 3/7/00
+1 ;;2.0;INTEGRATED BILLING;**130,459,728**;21-MAR-94;Build 14
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Called by Accounts Receivable report option
+5 ;
+6 ; for a specific Third Party bill, return all related Third Party bills
+7 ; matchs with the selected bill are based on: (selected bill is included in list returned)
+8 ; 1) Event Date (399,.03), returns all bills with same Event Date
+9 ;
+10 ; 2) PTF # (399,.08), returns all bills with the same PTF number
+11 ; 3) PTF # (399,.08), returns all bills with Outpatient Visit Dates (399,43) within the admission date range
+12 ;
+13 ; 4) Opt Visit Dates (399,43), returns all bills with one or more matching Opt Visit Dates
+14 ; 5) Opt Visit Dates (399,43), returns all bills for any PTF (399,.08) stay covering any of the Opt Visit Dates
+15 ;
+16 ; 6) Prescriptions (362.4): returns all bills with one or more matching Rx # and fill date
+17 ;
+18 ; ^TMP("IBRBT", $J, selected bill ifn) = PATIENT HAS ANY RX COVERAGE ON FROM DATE OF BILL (0/1)
+19 ; ^TMP("IBRBT", $J, selected bill ifn, matching bill ifn) =
+20 ; BILL FROM ^ BILL TO ^ CANCELLED (0/1) ^ AR BILL NUMBER ^
+21 ; PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME
+22 ;
TPTP(IBIFN) ; given a specific Third Party bill, find all related Third Party Bills
+1 NEW IB0,DFN,IBEVDT,IBPTF,IBADM,IBDIS,IBOPV,IBPTF1,IBXRF,IBRXN,IBRXDT,IBX
if '$GET(IBIFN)
QUIT
+2 SET IB0=$GET(^DGCR(399,+IBIFN,0))
if IB0=""
QUIT
SET DFN=$PIECE(IB0,U,2)
SET IBEVDT=$PIECE(IB0,U,3)
SET IBPTF=$PIECE(IB0,U,8)
+3 ;
+4 KILL ^TMP("IBRBT",$JOB,IBIFN)
SET IBX=$$LN1^IBEFURT(IBIFN)
DO SAVELN1^IBEFURT(IBIFN,IBX)
+5 ;
+6 ; find all bills with the same Event Date (399,.03)
IF +IBEVDT
DO TPEVDT^IBEFURT(DFN,IBEVDT,IBIFN)
+7 ;
IT ; find all bills with the same PTF number (399,.08)
IF +IBPTF
DO TPPTF^IBEFURT(IBPTF,IBIFN)
+1 ;
+2 ; find any bills with Outpatient Visit Dates within the date range of the admission (PTF)
+3 IF +IBPTF
SET IBADM=$PIECE($GET(^DGPT(+IBPTF,0)),U,2)
SET IBDIS=+$GET(^DGPT(+IBPTF,70))
if 'IBDIS
SET IBDIS=DT
Begin DoDot:1
+4 DO TPOPV^IBEFURT(DFN,IBADM,IBDIS,IBIFN)
End DoDot:1
+5 ;
OT ; find all bills that have one or more of the same Opt Visit Dates (399,43)
+1 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
if 'IBX
QUIT
SET IBOPV=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
Begin DoDot:1
+2 DO TPOPV^IBEFURT(DFN,IBOPV,IBOPV,IBIFN)
End DoDot:1
+3 ;
+4 ; find any bills for inpatient admissions whose date range includes one or more of the Opt Visit Dates
+5 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
if 'IBX
QUIT
SET IBOPV=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
Begin DoDot:1
+6 SET IBADM=$$ADM^IBCU64(DFN,IBOPV)
IF +IBADM
SET IBPTF1=$PIECE(IBADM,U,4)
IF +IBPTF1
Begin DoDot:2
+7 DO TPPTF^IBEFURT(IBPTF1,IBIFN)
End DoDot:2
End DoDot:1
+8 ;
RT ; find all bills that have one or more of the same Prescription: same Rx number and fill date (362.4,.01,.03)
+1 SET IBXRF="AIFN"_IBIFN
SET IBRXN=""
FOR
SET IBRXN=$ORDER(^IBA(362.4,IBXRF,IBRXN))
if 'IBRXN
QUIT
Begin DoDot:1
+2 SET IBX=0
FOR
SET IBX=$ORDER(^IBA(362.4,IBXRF,IBRXN,IBX))
if 'IBX
QUIT
SET IBRXDT=$PIECE($GET(^IBA(362.4,IBX,0)),U,3)
Begin DoDot:2
+3 DO TPRX^IBEFURT(DFN,IBRXN,IBRXDT,IBIFN)
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
+6 ; ==============================================================================================================
+7 ;
+8 ; Called by Accounts Receivable report option
+9 ;
+10 ; for a specific Third Party bill, return all related First Party Charges
+11 ; only a single record of a charge event is returned, defining the charges current status, although there may
+12 ; have been cancellations or updates to the original charge
+13 ; o Inpatient Events may have multiple charge events (Copay and Per Diem)
+14 ; o Opt and Rx Events have only a single charge event (Copay)
+15 ;
+16 ; matchs with the selected bill are based on:
+17 ; 1) Event Date (399,.03), returns Inpatient charges whose Parent Event (350,.16) has that Event Date (350,.17)
+18 ; 2) PTF # (399,.08), returns Outpatient charge for Opt Visits Dates within timeframe of admission
+19 ;
+20 ; 3) Opt Visit Date (399,43), returns the Outpatient charge for that Event Date (350,.17)
+21 ; 4) Opt Visit Date (399,43), returns Inpatient charges for any admission that includes that Opt Visit Date
+22 ;
+23 ; 5) Rx Record (362.4,.05) and Rx Date (362.4,.03) and Outpatient Pharmacy, returns the Rx charge for the fill
+24 ; 6) Opt Visit Date (399,43) and Outpatient Pharmacy, returns any First Party Rx charge on one of the
+25 ; selected bills Opt Visit Dates that is not billed on any Third Party bill
+26 ;
+27 ; ^TMP("IBRBF", $J , selected bill ifn ) = ""
+28 ; ^TMP("IBRBF", $J , selected bill ifn , charge ifn) =
+29 ; BILL FROM ^ BILL TO ^ CANCELLED? (1/0)^ AR BILL NUMBER ^ TOTAL CHARGE ^ ACTION TYPE (SHORT) ^ # DAYS ON HOLD
+30 ;
TPFP(IBIFN) ; given a specific Third Party Bill, find all related First Party Bills
+1 NEW IBX,IBY,IB0,DFN,IBEVDT,IBPTF,IBADM,IBOPV,IBXRF,IBRXN,IBRXIFN,IBRXDT,IBFROM,IBTO,IBU
if '$GET(IBIFN)
QUIT
+2 SET IB0=$GET(^DGCR(399,+IBIFN,0))
if IB0=""
QUIT
SET DFN=$PIECE(IB0,U,2)
SET IBEVDT=$PIECE(IB0,U,3)
+3 ; IB*2.0*728
SET IBU=$GET(^DGCR(399,+IBIFN,"U"))
SET IBFROM=$PIECE(IBU,U)
SET IBTO=$PIECE(IBU,U,2)
+4 ;
+5 KILL ^TMP("IBRBF",$JOB,IBIFN)
DO SAVELN1^IBEFURF(IBIFN)
+6 ;
IF ; find all First Party charges for the Inpatient Event Date (Admission Date) on the Third Party bill
+1 ; IB*2.0*728
DO FPINPT1^IBEFURF(DFN,IBFROM,IBTO,IBIFN)
+2 ;
+3 ; find any First Party Outpatient charges for Visit Dates within the date range of the admission (PTF)
+4 SET IBPTF=$PIECE(IB0,U,8)
IF +IBPTF
SET IBADM=$$PTFADM^IBCU64(+IBPTF)
IF +IBADM
SET IBADM=$$AD^IBCU64(IBADM)
Begin DoDot:1
+5 SET IBX=$PIECE(IBADM,U,2)\1
IF 'IBX
SET IBX=DT
+6 DO FPOPV^IBEFURF(DFN,+IBADM\1,IBX,IBIFN)
End DoDot:1
+7 ;
OF ; find First Party charges for the Opt Visit Dates on the Third Party Bill
+1 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
if 'IBX
QUIT
SET IBOPV=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
Begin DoDot:1
+2 DO FPOPV^IBEFURF(DFN,IBOPV,IBOPV,IBIFN)
End DoDot:1
+3 ;
+4 ; find any charges for inpatient admissions whose date range includes one or more of the Opt Visit Dates
+5 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
if 'IBX
QUIT
SET IBOPV=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
Begin DoDot:1
+6 SET IBADM=$$ADM^IBCU64(DFN,IBOPV)
IF 'IBADM
QUIT
+7 DO FPINPT^IBEFURF(DFN,+IBADM,IBIFN)
End DoDot:1
+8 ;
RF ; find First Party charges for any Rx's on the selected Third Party bill
+1 ; based on Rx IFN (52), fill date and fill# (362.4,.05,.03,.1)
+2 NEW IBRXFL
+3 SET IBXRF="AIFN"_IBIFN
SET IBRXN=""
FOR
SET IBRXN=$ORDER(^IBA(362.4,IBXRF,IBRXN))
if 'IBRXN
QUIT
Begin DoDot:1
+4 SET IBX=0
FOR
SET IBX=$ORDER(^IBA(362.4,IBXRF,IBRXN,IBX))
if 'IBX
QUIT
Begin DoDot:2
+5 SET IBY=$GET(^IBA(362.4,IBX,0))
SET IBRXIFN=$PIECE(IBY,U,5)
SET IBRXDT=$PIECE(IBY,U,3)
SET IBRXFL=$PIECE(IBY,U,10)
if 'IBRXIFN
QUIT
+6 DO FPRX^IBEFURF(IBRXIFN,IBRXDT,IBIFN,IBRXFL)
End DoDot:2
End DoDot:1
+7 ;
+8 ; find First Party Charges for any RX filled on one of the Third Party bill's Opt Visit Dates
+9 ; that is not billed on any Third Party bill
+10 SET IBFROM=$GET(^DGCR(399,IBIFN,"U"))
SET IBTO=$PIECE(IBFROM,U,2)
SET IBFROM=+IBFROM
KILL IBX
+11 ; get all Rx's for patient in date range
DO RXDISP^IBCSC5C(DFN,IBFROM,IBTO,.IBX,"","",1,1)
+12 SET IBRXN=""
FOR
SET IBRXN=$ORDER(IBX(IBRXN))
if IBRXN=""
QUIT
SET IBRXDT=0
FOR
SET IBRXDT=$ORDER(IBX(IBRXN,IBRXDT))
if 'IBRXDT
QUIT
Begin DoDot:1
+13 ; rx not on bills opt visit date
IF '$DATA(^DGCR(399,"AOPV",DFN,IBRXDT,IBIFN))
QUIT
+14 ; rx billed on a third party bill
IF +$$RXTP^IBEFURT(DFN,IBRXN,IBRXDT)
QUIT
+15 SET IBRXIFN=$PIECE(IBX(IBRXN,IBRXDT),U,1)
+16 DO FPRX^IBEFURF(IBRXIFN,IBRXDT,IBIFN)
End DoDot:1
+17 QUIT
