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

IBAMTV2.m

Go to the documentation of this file.
  1. IBAMTV2 ;ALB/CPM - CREATE CHARGES FOR BILLABLE EPISODES ; 01-JUN-94
  1. ;;2.0;INTEGRATED BILLING;**15,153,204**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. BLD ; Create back charges for an array of episodes.
  1. ;
  1. ; Input: IBSTART -- First date that the patient is Means Test billable
  1. ; IBEND -- Last date that the patient is Means Test billable
  1. ; DFN -- Pointer to the patient in file #2
  1. ;
  1. ; ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
  1. ; 1 = adm date for inpatient care
  1. ; visit date for outpatient care
  1. ; 2 = disch/last bill date for inpatient care
  1. ; null for outpatient care
  1. ; 3 = null for inpatient care
  1. ; softlink for outpatient care
  1. ;
  1. S IBJOB=9,(IBWHER,IBY,Y)=1,IBDUZ=$S($G(DUZ):DUZ,1:.5)
  1. D SITE^IBAUTL I Y<1 S IBY=Y G BLDQ
  1. D SERV^IBAUTL2 I IBY<1 G BLDQ
  1. ;
  1. ; - is there an old clock to use?
  1. S IBCLDA=$$OLDCL(DFN,+$O(^TMP("IBAMTV",$J,0)))
  1. I IBCLDA D CLDATA^IBAUTL3,DED^IBAUTL3
  1. ;
  1. ; - bill all episodes of care
  1. S IBEPDT=0 F S IBEPDT=$O(^TMP("IBAMTV",$J,IBEPDT)) Q:'IBEPDT S IBEPSTR=$G(^(IBEPDT)) I IBEPSTR D @$S($P(IBEPSTR,"^",2):"INPT",1:"OPT") Q:IBY<0
  1. I IBY<0 G BLDQ
  1. ;
  1. ; - close clock if over a year old
  1. I IBCLDA,$$FMDIFF^XLFDT(DT,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3
  1. ;
  1. BLDQ I IBY<0 D ^IBAERR1
  1. D KILL1^IBAMTC K IBEPDT,IBEPSTR
  1. Q
  1. ;
  1. ;
  1. INPT ; Bill inpatient care.
  1. S IBEVDA=0
  1. I IBCLDA S IBCLCT=$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT)
  1. S IBBDT=$$FMTH^XLFDT(+IBEPSTR,1)
  1. S IBEDT=$$FMTH^XLFDT($P(IBEPSTR,"^",2),1)-1
  1. D ^IBAUTL4 G:IBY<0 INPTQ
  1. ;
  1. I $G(IBCHPDA) D UPD(IBCHPDA)
  1. I $G(IBCHCDA) D UPD(IBCHCDA)
  1. I IBCLDA D CLUPD^IBAUTL3
  1. I IBEVDA,$D(IBDT) S IBEVCLD=IBDT D @($S($$CLEV():"EVCLOSE",1:"EVUPD")_"^IBAUTL3")
  1. ;
  1. INPTQ K IBCHPDA,IBCHCDA,IBCHG,IBCHFR,IBCHTO,IBCHTOTL,IBBS,IBNH,IBTRAN,IBATYP,IBDATE
  1. K IBEVDA,IBEVDT,IBEVCLD,IBEVCAL,IBEVNEW,IBEVOLD,IBTOTL,IBDESC,IBIL,IBSL
  1. Q
  1. ;
  1. OPT ; Bill the Outpatient copayment.
  1. ; Input: IBEPSTR -- 1^2^3, where
  1. ; 1 => visit date
  1. ; 2 => null
  1. ; 3 => softlink (may be null)
  1. ; DFN -- Pointer to the patient in file #2
  1. ;
  1. N %,IBSTOPDA,IBTYPE
  1. ;
  1. I IBCLDA,$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3 G:IBY<0 OPTQ
  1. I 'IBCLDA S IBCLDT=+IBEPSTR D CLADD^IBAUTL3 G:IBY<0 OPTQ S (IBCLDAY,IBCLDOL)=0
  1. ;
  1. ; - build the charge
  1. I $P(IBEPSTR,"^",3) S IBSL="409.68:"_$P(IBEPSTR,"^",3)
  1. S IBX="O",(IBFR,IBTO,IBDT,IBEVDT)=+IBEPSTR
  1. ;
  1. ; look up the copay tier info
  1. S %=$$GETSC^IBEMTSCU(IBSL,IBEVDT) I % S IBSTOPDA=%
  1. ; get the rate, ibtype = primary or specialty
  1. S IBTYPE=$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3) G:IBTYPE=0 OPTQ
  1. ; if the type is not defined, must be a local created sc, set it to primary
  1. I 'IBTYPE S IBTYPE=1
  1. ;
  1. ;
  1. D TYPE^IBAUTL2 G:IBY<0 OPTQ
  1. S IBUNIT=1,IBEVDA="*"
  1. D ADD^IBECEAU3 G:IBY<0 OPTQ
  1. ;
  1. ; - place charge in the 'review' status
  1. D UPD(IBN)
  1. ;
  1. OPTQ K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG,IBRTED,IBN,IBBS,IBEVDT
  1. Q
  1. ;
  1. ;
  1. OLDCL(DFN,IBDT) ; Can an old billing clock be used?
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. ; IBDT -- Date of first potentially billable episode
  1. ; Output: 0 -- No old billing clock available
  1. ; >0 -- Pointer to old billing clock in file #351
  1. I '$G(DFN) G OLDCLQ
  1. N IBX,IBY,IBZ,IBST S IBST=0
  1. S IBX=-(IBDT+.1) F S IBX=$O(^IBE(351,"AIVDT",DFN,IBX)) Q:'IBX D Q:IBST
  1. .S IBY=0 F S IBY=$O(^IBE(351,"AIVDT",DFN,IBX,IBY)) Q:'IBY D Q:IBST
  1. ..S IBZ=$G(^IBE(351,IBY,0)) Q:'IBZ!($P(IBZ,"^",4)=3)
  1. ..I $$FMDIFF^XLFDT(IBDT,$P(IBZ,"^",3))<365 S IBST=1
  1. OLDCLQ Q +$G(IBY)
  1. ;
  1. UPD(IBN) ; Place the charge in a review status.
  1. ; Input: IBN -- Pointer to the charge in file #350
  1. S DIE="^IB(",DA=IBN,DR=".05////21" D ^DIE K DIE,DA,DR
  1. Q
  1. ;
  1. CLEV() ; Should the event record be closed?
  1. ; Input: variables IBEVDA -- Pointer to event in file #350
  1. ; IBEND -- Last date through which to bill
  1. ; Output: 1 -- yes, close event
  1. ; 0 -- don't close event
  1. N IBX,IBZ S IBX=0
  1. I '$G(IBEVDA)!'$G(IBEND) S IBX=1 G CLEVQ
  1. I IBEND<$$FMADD^XLFDT(DT,-1) S IBX=1 G CLEVQ
  1. S IBZ=+$P($P($G(^IB(IBEVDA,0)),"^",4),":",2),IBZ=$P($G(^DGPM(IBZ,0)),"^",14)
  1. I IBZ,$P($G(^DGPM(IBZ,0)),"^",17) S IBX=1
  1. CLEVQ Q IBX