IBAMTV ;ALB/CPM - BACK-BILLING SUPPORT FOR IVM ; 31-MAY-94
;;2.0;INTEGRATED BILLING;**15,153**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Input: DFN -- Pointer to the patient in file #2
; DGMTP -- Zeroth node of previous MT in file #408.31
; DGMTA -- Zeroth node of verified MT in file #408.31
;
; - begin back-billing from the original completed date.
S IBSTART=$P(DGMTA,"^",7) G:'IBSTART!(IBSTART'<DT) END
S IBEND=$$FMADD^XLFDT(IBSTART\1,364)
S:IBEND'<DT IBEND=$$FMADD^XLFDT(DT,-1)
;
; - build array of episodes of care to be billed
D CARE^IBAMTV1
;
; - analyze the array and build charges
I $D(^TMP("IBAMTV",$J)) D BLD^IBAMTV2
;
; - send a message if any charges need to be reviewed
I '$D(^IB("AJ",DFN)) G END
;
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB="BACK-BILLING OF MEANS TEST CHARGES"
S IBT(1)="A verified Means Test has just been received from the IVM Center."
S IBT(2)="Means Test charges have been back-billed for the following patient:"
S IBT(3)=" " S IBC=3
S IBDUZ=DUZ D PAT^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="Please note that these charges are on hold, pending a manual review before"
S IBC=IBC+1,IBT(IBC)="being passed to Accounts Receivable. Please use the option 'Release Charges"
S IBC=IBC+1,IBT(IBC)="Pending Review' to review the charges and pass them to Accounts Receivable."
D SEND^IBACVA2
;
END K IBDUZ,IBEND,IBSTART,^TMP("IBAMTV",$J)
Q
;
;
CANC ; Cancel Means Test charges if an IVM-verified Means Test is deleted.
; Input: DFN -- Pointer to the patient in file #2
; DGMTP -- Zeroth node of previous MT in file #408.31
; DGMTA -- Zeroth node of verified MT in file #408.31
;
Q:'$$CHECK^IBECEAU
S IBCRES=+$O(^IBE(350.3,"B","MT STATUS CHANGED FROM YES",0))
S:'IBCRES IBCRES=22 S IBJOB=9,IBWHER=30,IBDUZ=DUZ,IBFOUND=0
S IBST=+DGMTA,IBEND=$$FMADD^XLFDT(IBST,364) S:IBEND>DT IBEND=DT
S IBZ="" F S IBZ=$O(^IB("AFDT",DFN,IBZ)) Q:'IBZ I -IBZ'>IBEND S IBZ1=0 F S IBZ1=$O(^IB("AFDT",DFN,IBZ,IBZ1)) Q:'IBZ1 D
.S IBDA=0 F S IBDA=$O(^IB("AF",IBZ1,IBDA)) Q:'IBDA D
..Q:'$D(^IB(IBDA,0)) S IBX=^(0)
..Q:$P(IBX,"^",8)["ADMISSION" ; skip event records
..Q:$P(IBX,"^",9)'=IBDA ; look only at original actions
..S (IBN,IBORIG)=$$LAST^IBECEAU(IBDA),IBND=$G(^IB(IBN,0)),IBND1=$G(^(1))
..I IBN=IBDA&($P(IBX,"^",5)=10)!($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)=2) Q ; already cancelled
..I $P(IBND,"^",15)<IBST!($P(IBND,"^",14)>IBEND) Q ; out of range
..Q:$$BIL^DGMTUB(DFN,$P(IBND,"^",14)) ; still Means Test billable
..D CANCH^IBECEAU4(IBN,IBCRES)
..S IBN=$$LAST^IBECEAU(IBDA),IBND=$G(^IB(IBN,0)),IBX=$G(^IB(IBORIG,0))
..I IBN=IBDA&($P(IBX,"^",5)=10)!($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)=2) S IBFOUND=1 D ADJCL
;
I IBFOUND D CANBULL
K IBCRES,IBST,IBEND,IBZ,IBZ1,IBDA,IBX,IBN,IBND,IBND1,IBJOB,IBWHER,IBDUZ,IBFOUND,IBORIG
Q
;
CANBULL ; Generate the cancellation bulletin.
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB="CANCELLATION OF BACK-BILLED MEANS TEST CHARGES"
S IBT(1)="An IVM-verified Means Test was just deleted for the following patient:"
S IBT(2)=" " S IBC=2
S IBDUZ=DUZ D PAT^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="All back-billed Means Test charges for this patient were cancelled."
S IBC=IBC+1,IBT(IBC)="You should review this patient's Means Test billing history and billing"
S IBC=IBC+1,IBT(IBC)="clock for accuracy, starting on "_$$DAT1^IBOUTL(+DGMTA)_"."
D SEND^IBACVA2
K IBDUZ
Q
;
ADJCL ; Roll back the billing clock for cancelled charges.
; Input: IBX -- Zeroth node of charge which has been cancelled.
; DFN -- Pointer to the patient in file #2
;
N IBCL,IBCLD,IBUN,IBCLDAY,IBCHG,IBCLP,IBAP
Q:$P(IBX,"^",8)["OPT COPAY" ; no adjustments needed for opt copays
S IBCL=$$OLDCL^IBAMTV2(DFN,$P(IBX,"^",14)) Q:'IBCL ; no clock
S IBCLD=$G(^IBE(351,IBCL,0)) Q:'IBCLD
;
; - handle per diem charges
I $P($G(^IBE(350.1,+$P(IBX,"^",3),0)),"^",11)=3 D
.S IBUN=$P(IBX,"^",6),IBCLDAY=$P(IBCLD,"^",9)
.S $P(^IBE(351,IBCL,0),"^",9)=$S(IBCLDAY>IBUN:IBCLDAY-IBUN,1:0) D UPD
;
; - handle inpt copay charges
I $P($G(^IBE(350.1,+$P(IBX,"^",3),0)),"^",11)=2 D
.S IBCHG=$P(IBX,"^",7) Q:'IBCHG
.F IBCLP=8:-1:5 S IBAP=$P(IBCLD,"^",IBCLP) D Q:'IBCHG
..I IBCHG>IBAP S IBCHG=IBCHG-IBAP,$P(^IBE(351,IBCL,0),"^",IBCLP)=0 D UPD Q
..S $P(^IBE(351,IBCL,0),"^",IBCLP)=IBAP-IBCHG,IBCHG=0 D UPD
;
Q
;
UPD ; Update user and edit date on the Billing Clock.
D NOW^%DTC S $P(^IBE(351,IBCL,1),"^",3,4)=DUZ_"^"_%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTV 4658 printed Apr 09, 2024@21:09:57 Page 2
IBAMTV ;ALB/CPM - BACK-BILLING SUPPORT FOR IVM ; 31-MAY-94
+1 ;;2.0;INTEGRATED BILLING;**15,153**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Input: DFN -- Pointer to the patient in file #2
+5 ; DGMTP -- Zeroth node of previous MT in file #408.31
+6 ; DGMTA -- Zeroth node of verified MT in file #408.31
+7 ;
+8 ; - begin back-billing from the original completed date.
+9 SET IBSTART=$PIECE(DGMTA,"^",7)
if 'IBSTART!(IBSTART'<DT)
GOTO END
+10 SET IBEND=$$FMADD^XLFDT(IBSTART\1,364)
+11 if IBEND'<DT
SET IBEND=$$FMADD^XLFDT(DT,-1)
+12 ;
+13 ; - build array of episodes of care to be billed
+14 DO CARE^IBAMTV1
+15 ;
+16 ; - analyze the array and build charges
+17 IF $DATA(^TMP("IBAMTV",$JOB))
DO BLD^IBAMTV2
+18 ;
+19 ; - send a message if any charges need to be reviewed
+20 IF '$DATA(^IB("AJ",DFN))
GOTO END
+21 ;
+22 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+23 SET XMSUB="BACK-BILLING OF MEANS TEST CHARGES"
+24 SET IBT(1)="A verified Means Test has just been received from the IVM Center."
+25 SET IBT(2)="Means Test charges have been back-billed for the following patient:"
+26 SET IBT(3)=" "
SET IBC=3
+27 SET IBDUZ=DUZ
DO PAT^IBAERR1
+28 SET IBC=IBC+1
SET IBT(IBC)=" "
+29 SET IBC=IBC+1
SET IBT(IBC)="Please note that these charges are on hold, pending a manual review before"
+30 SET IBC=IBC+1
SET IBT(IBC)="being passed to Accounts Receivable. Please use the option 'Release Charges"
+31 SET IBC=IBC+1
SET IBT(IBC)="Pending Review' to review the charges and pass them to Accounts Receivable."
+32 DO SEND^IBACVA2
+33 ;
END KILL IBDUZ,IBEND,IBSTART,^TMP("IBAMTV",$JOB)
+1 QUIT
+2 ;
+3 ;
CANC ; Cancel Means Test charges if an IVM-verified Means Test is deleted.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; DGMTP -- Zeroth node of previous MT in file #408.31
+3 ; DGMTA -- Zeroth node of verified MT in file #408.31
+4 ;
+5 if '$$CHECK^IBECEAU
QUIT
+6 SET IBCRES=+$ORDER(^IBE(350.3,"B","MT STATUS CHANGED FROM YES",0))
+7 if 'IBCRES
SET IBCRES=22
SET IBJOB=9
SET IBWHER=30
SET IBDUZ=DUZ
SET IBFOUND=0
+8 SET IBST=+DGMTA
SET IBEND=$$FMADD^XLFDT(IBST,364)
if IBEND>DT
SET IBEND=DT
+9 SET IBZ=""
FOR
SET IBZ=$ORDER(^IB("AFDT",DFN,IBZ))
if 'IBZ
QUIT
IF -IBZ'>IBEND
SET IBZ1=0
FOR
SET IBZ1=$ORDER(^IB("AFDT",DFN,IBZ,IBZ1))
if 'IBZ1
QUIT
Begin DoDot:1
+10 SET IBDA=0
FOR
SET IBDA=$ORDER(^IB("AF",IBZ1,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+11 if '$DATA(^IB(IBDA,0))
QUIT
SET IBX=^(0)
+12 ; skip event records
if $PIECE(IBX,"^",8)["ADMISSION"
QUIT
+13 ; look only at original actions
if $PIECE(IBX,"^",9)'=IBDA
QUIT
+14 SET (IBN,IBORIG)=$$LAST^IBECEAU(IBDA)
SET IBND=$GET(^IB(IBN,0))
SET IBND1=$GET(^(1))
+15 ; already cancelled
IF IBN=IBDA&($PIECE(IBX,"^",5)=10)!($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",5)=2)
QUIT
+16 ; out of range
IF $PIECE(IBND,"^",15)<IBST!($PIECE(IBND,"^",14)>IBEND)
QUIT
+17 ; still Means Test billable
if $$BIL^DGMTUB(DFN,$PIECE(IBND,"^",14))
QUIT
+18 DO CANCH^IBECEAU4(IBN,IBCRES)
+19 SET IBN=$$LAST^IBECEAU(IBDA)
SET IBND=$GET(^IB(IBN,0))
SET IBX=$GET(^IB(IBORIG,0))
+20 IF IBN=IBDA&($PIECE(IBX,"^",5)=10)!($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",5)=2)
SET IBFOUND=1
DO ADJCL
End DoDot:2
End DoDot:1
+21 ;
+22 IF IBFOUND
DO CANBULL
+23 KILL IBCRES,IBST,IBEND,IBZ,IBZ1,IBDA,IBX,IBN,IBND,IBND1,IBJOB,IBWHER,IBDUZ,IBFOUND,IBORIG
+24 QUIT
+25 ;
CANBULL ; Generate the cancellation bulletin.
+1 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+2 SET XMSUB="CANCELLATION OF BACK-BILLED MEANS TEST CHARGES"
+3 SET IBT(1)="An IVM-verified Means Test was just deleted for the following patient:"
+4 SET IBT(2)=" "
SET IBC=2
+5 SET IBDUZ=DUZ
DO PAT^IBAERR1
+6 SET IBC=IBC+1
SET IBT(IBC)=" "
+7 SET IBC=IBC+1
SET IBT(IBC)="All back-billed Means Test charges for this patient were cancelled."
+8 SET IBC=IBC+1
SET IBT(IBC)="You should review this patient's Means Test billing history and billing"
+9 SET IBC=IBC+1
SET IBT(IBC)="clock for accuracy, starting on "_$$DAT1^IBOUTL(+DGMTA)_"."
+10 DO SEND^IBACVA2
+11 KILL IBDUZ
+12 QUIT
+13 ;
ADJCL ; Roll back the billing clock for cancelled charges.
+1 ; Input: IBX -- Zeroth node of charge which has been cancelled.
+2 ; DFN -- Pointer to the patient in file #2
+3 ;
+4 NEW IBCL,IBCLD,IBUN,IBCLDAY,IBCHG,IBCLP,IBAP
+5 ; no adjustments needed for opt copays
if $PIECE(IBX,"^",8)["OPT COPAY"
QUIT
+6 ; no clock
SET IBCL=$$OLDCL^IBAMTV2(DFN,$PIECE(IBX,"^",14))
if 'IBCL
QUIT
+7 SET IBCLD=$GET(^IBE(351,IBCL,0))
if 'IBCLD
QUIT
+8 ;
+9 ; - handle per diem charges
+10 IF $PIECE($GET(^IBE(350.1,+$PIECE(IBX,"^",3),0)),"^",11)=3
Begin DoDot:1
+11 SET IBUN=$PIECE(IBX,"^",6)
SET IBCLDAY=$PIECE(IBCLD,"^",9)
+12 SET $PIECE(^IBE(351,IBCL,0),"^",9)=$SELECT(IBCLDAY>IBUN:IBCLDAY-IBUN,1:0)
DO UPD
End DoDot:1
+13 ;
+14 ; - handle inpt copay charges
+15 IF $PIECE($GET(^IBE(350.1,+$PIECE(IBX,"^",3),0)),"^",11)=2
Begin DoDot:1
+16 SET IBCHG=$PIECE(IBX,"^",7)
if 'IBCHG
QUIT
+17 FOR IBCLP=8:-1:5
SET IBAP=$PIECE(IBCLD,"^",IBCLP)
Begin DoDot:2
+18 IF IBCHG>IBAP
SET IBCHG=IBCHG-IBAP
SET $PIECE(^IBE(351,IBCL,0),"^",IBCLP)=0
DO UPD
QUIT
+19 SET $PIECE(^IBE(351,IBCL,0),"^",IBCLP)=IBAP-IBCHG
SET IBCHG=0
DO UPD
End DoDot:2
if 'IBCHG
QUIT
End DoDot:1
+20 ;
+21 QUIT
+22 ;
UPD ; Update user and edit date on the Billing Clock.
+1 DO NOW^%DTC
SET $PIECE(^IBE(351,IBCL,1),"^",3,4)=DUZ_"^"_%
+2 QUIT
