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 Apr 09, 2024@21:34:34 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
