- 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 Feb 18, 2025@23:33:09 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