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