Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAMTV

IBAMTV.m

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