IBECEA21 ;ALB/CPM-Cancel/Edit/Add... Edit Prompts;19-APR-93
;;2.0;INTEGRATED BILLING;**7,57,167,183,202,312,563**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
; Issue appropriate prompts for each charge type. If the charge
; being edited has not been billed, handle that charge before
; returning to IBECEA2.
;
N IBSTOPDA,IBTYPE,IBGMT
S IBGMT=0
;
; Handle Outpatient Charges
I IBXA=4 D G END
.S (IBFR,IBTO,IBDT)=$P(IBND,"^",14),IBUNIT=IBUNITP
.W !,"Re-calculating the OPT copay charge for ",$$DAT1^IBOUTL(IBFR)," ..."
.;
.; need to look up stop info to populate IBTYPE *167
.S IBSTOPDA=$S($P($P(IBND,"^",4),":")=350:$P(IBND,"^",20),1:$$GETSC^IBEMTSCU($P(IBND,"^",4),$P(IBND,"^",17)))
.S IBTYPE=$S(IBSTOPDA>0:$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3),1:1)
.;
.S IBX="O" D TYPE^IBAUTL2 Q:IBY<0 W " $",IBCHG
.I 'IBH,IBCHG=IBCHGP W !,"This equals the billed amount - this charge cannot be edited." S IBY=-1 Q
.I IBCHG=IBCHGP W !,"This charge is ready to be billed." D PASS^IBECEA22 S IBY=-1 Q
.I IBH D UPCHG^IBECEA22(IBCHG) S IBY=-1 Q
.S IBCRES=$O(^IBE(350.3,"B","MT CHARGE EDITED",0)) S:'IBCRES IBCRES=19
.W !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
;
; Handle Pharmacy Copay Charges
I IBXA=5 D G END
.N IBLIM,IBA,IBB,IBC,IBX,IBODT,IBOCHG,IBOTIER
.S IBOTIER=$P(IBND,"^",22)
.S IBODT=+$S(+$P(IBND,"^",14):$P(IBND,"^",14),1:$P($G(IB(IBN,1)),"^",2))
.S IBOCHG=$P(IBND,"^",7)
.S IBLIM=DT D FR^IBECEAU2(IBODT) Q:IBY<0
.S (IBTO,IBEFDT)=IBFR,IBA=-(IBFR+.9)
.S IBTIER=$$TIER^IBECEAU2($P(IBND,"^",3),IBEFDT,IBOTIER)
.F S IBA=$O(^IBE(350.2,"AIVDT",IBATYP,IBA)) Q:'IBA!($G(IBX)) S IBB=0 F S IBB=$O(^IBE(350.2,"AIVDT",IBATYP,IBA,IBB)) Q:'IBB!($G(IBX)) S IBC=$G(^IBE(350.2,IBB,0)) I IBC]"",$$TIEROK^IBAUTL(IBC),'$P(IBC,"^",5)!($P(IBC,"^",5)>IBFR) S IBX=IBB Q
.D UNIT^IBECEAU2(IBUNITP) Q:IBY<0
.I 'IBH,IBUNIT=IBUNITP,IBODT=IBEFDT,IBOCHG=IBCHG,IBOTIER=IBTIER W !!,"No change was made!" S IBY=-1 Q
.I IBH D UPCHG^IBECEA22(IBCHG,IBUNIT,IBFR,IBTO,IBTIER) S IBY=-1 Q
.W !!,"The original charge will be cancelled and re-billed for $",$J(IBCHG,"",2),"."
;
; Handle all Inpatient Charges
S IBFRP=+$P(IBND,"^",14),IBTOP=+$P(IBND,"^",15),IBLIM=$S(IBXA=3:DT,1:$$FMADD^XLFDT(DT,-1))
S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFRP) ;Check GMT Copayment Status
D CLSTR^IBECEAU1(DFN,IBFRP)
I 'IBCLDA W !!,"I cannot find a billing clock that was effective on ",$$DAT1^IBOUTL(IBFRP),"!",!,"Please adjust this patient's billing clocks before editing this charge." S IBY=-1 Q
D CLDATA^IBAUTL3,DED^IBAUTL3 G:IBY<0 END
;For GMT Patients reduce Medicare Deductible to 20%
I IBGMT>0 S IBMED=$$REDUCE^IBAGMT(IBMED) W !,"Medicare Deductible reduced due to GMT Copayment Status."
S:IBXA=2 IBBS=$O(^DGCR(399.1,"AC",IBATYP,0))
I IBXA=2,$P($G(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU",IBCLDAY>90,IBCHGP'>IBCLDOL S IBMED=IBMED/2
I IBXA=1,IBCLDAY>90 D MED^IBECEA34 G:IBY<0 END
W !!," ** ",$S($P(IBCLST,"^",4)=1:"Active",1:"Closed")," Billing Clock **"
W !?2,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY," ",$$INPT^IBECEAU(IBCLDAY)," 90 days: $",IBCLDOL,!
S:IBXA=3 IBDAYP=IBCLDAY-IBUNITP
I IBXA=1!(IBXA=2) S IBDOLP=IBCLDOL-IBCHGP S:IBDOLP<0 IBDOLP=0
;
; - ask for 'Bill From' date
FR D FR^IBECEAU2(IBFRP) G:IBY<0 END
;
I IBFR<IBCLDT W !!,"The 'Bill From' date cannot preceed the Billing Clock Begin Date.",! G FR
S IBGMTR=0,IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFR) ; GMT Status may change
I IBXA=3 S IBDT=IBFR D COST^IBAUTL2 S:IBGMT>0 IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) I 'IBCHG W !!,"Unable to determine the per diem rate. Please check your rate table." S IBY=-1 G END
I IBXA=2 S IBDT=IBFR D COPAY^IBAUTL2 G:IBY<0 END S:IBGMT>0 IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) I IBCHG+IBDOLP<IBMED W *7," ($",IBCHG,"/day)" W:IBGMTR " GMT Rate" G TO
I IBXA=2,IBCHG=IBCHGP D CTBB^IBECEAU3 W !!,"No change was made!" S IBY=-1 G END
;
; - ask for 'Bill To' date
TO D TO^IBECEAU2(IBTOP) G:IBY<0 END
;
I $P(IBCLST,"^",10),IBTO>$P(IBCLST,"^",10) W !!,"The 'Bill To' date cannot exceed the Billing Clock End Date (",$$DAT1^IBOUTL($P(IBCLST,"^",10)),")." G TO
S IBUNIT=$$FMDIFF^XLFDT(IBTO,IBFR)
I $$FMDIFF^XLFDT(IBTOP,IBFRP)<IBUNITP!(IBFR=IBTO) S IBUNIT=IBUNIT+1
I IBTO'=IBFR,IBXA>0,IBXA<4,$$ISGMTPT^IBAGMT(DFN,IBTO)'=$$ISGMTPT^IBAGMT(DFN,IBFR) W !!,"The patient changed GMT Copayment status during the specified period!",! G TO
I IBXA>1 D G END
. S IBCHG=IBUNIT*IBCHG S:IBXA=2 IBCHG=$S(IBDOLP+IBCHG>IBMED:IBMED-IBDOLP,1:IBCHG)
. I IBCHG=IBCHGP D CTBB^IBECEAU3 W !!,"No change was made!" S IBY=-1 Q
. S:IBXA=2 IBDOLA=IBDOLP+IBCHG,IBDAYA=0 S:IBXA=3 IBDAYA=IBDAYP+IBUNIT,IBDOLA=0
. W !!,"New charge to be billed" W:IBGMTR "(GMT Rate)" W ": $",$J(IBCHG,"",2),!
. I IBH D CHCL^IBECEA22
;
; - ask for 'Fee Amount'
S IBCLDOLO=IBCLDOL,IBCLDOL=IBCLDOL-IBCHGP S:IBCLDOL<0 IBCLDOL=0
I IBGMT>0 S IBGMTR=1 W !,"The patient has GMT Copayment Status! GMT rate must be applied.",!
D FEE^IBECEAU2(IBCHGP) G:IBY<0 END
I IBCHG=IBCHGP W !!,"No change was made!" S IBY=-1 G END
S IBCLDOL=IBCLDOLO,IBDOLA=IBDOLP+IBCHG,IBDAYA=0
I IBH D CHCL^IBECEA22
;
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA21 5229 printed Apr 09, 2024@21:25:46 Page 2
IBECEA21 ;ALB/CPM-Cancel/Edit/Add... Edit Prompts;19-APR-93
+1 ;;2.0;INTEGRATED BILLING;**7,57,167,183,202,312,563**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Issue appropriate prompts for each charge type. If the charge
+5 ; being edited has not been billed, handle that charge before
+6 ; returning to IBECEA2.
+7 ;
+8 NEW IBSTOPDA,IBTYPE,IBGMT
+9 SET IBGMT=0
+10 ;
+11 ; Handle Outpatient Charges
+12 IF IBXA=4
Begin DoDot:1
+13 SET (IBFR,IBTO,IBDT)=$PIECE(IBND,"^",14)
SET IBUNIT=IBUNITP
+14 WRITE !,"Re-calculating the OPT copay charge for ",$$DAT1^IBOUTL(IBFR)," ..."
+15 ;
+16 ; need to look up stop info to populate IBTYPE *167
+17 SET IBSTOPDA=$SELECT($PIECE($PIECE(IBND,"^",4),":")=350:$PIECE(IBND,"^",20),1:$$GETSC^IBEMTSCU($PIECE(IBND,"^",4),$PIECE(IBND,"^",17)))
+18 SET IBTYPE=$SELECT(IBSTOPDA>0:$PIECE($GET(^IBE(352.5,+$GET(IBSTOPDA),0)),"^",3),1:1)
+19 ;
+20 SET IBX="O"
DO TYPE^IBAUTL2
if IBY<0
QUIT
WRITE " $",IBCHG
+21 IF 'IBH
IF IBCHG=IBCHGP
WRITE !,"This equals the billed amount - this charge cannot be edited."
SET IBY=-1
QUIT
+22 IF IBCHG=IBCHGP
WRITE !,"This charge is ready to be billed."
DO PASS^IBECEA22
SET IBY=-1
QUIT
+23 IF IBH
DO UPCHG^IBECEA22(IBCHG)
SET IBY=-1
QUIT
+24 SET IBCRES=$ORDER(^IBE(350.3,"B","MT CHARGE EDITED",0))
if 'IBCRES
SET IBCRES=19
+25 WRITE !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
End DoDot:1
GOTO END
+26 ;
+27 ; Handle Pharmacy Copay Charges
+28 IF IBXA=5
Begin DoDot:1
+29 NEW IBLIM,IBA,IBB,IBC,IBX,IBODT,IBOCHG,IBOTIER
+30 SET IBOTIER=$PIECE(IBND,"^",22)
+31 SET IBODT=+$SELECT(+$PIECE(IBND,"^",14):$PIECE(IBND,"^",14),1:$PIECE($GET(IB(IBN,1)),"^",2))
+32 SET IBOCHG=$PIECE(IBND,"^",7)
+33 SET IBLIM=DT
DO FR^IBECEAU2(IBODT)
if IBY<0
QUIT
+34 SET (IBTO,IBEFDT)=IBFR
SET IBA=-(IBFR+.9)
+35 SET IBTIER=$$TIER^IBECEAU2($PIECE(IBND,"^",3),IBEFDT,IBOTIER)
+36 FOR
SET IBA=$ORDER(^IBE(350.2,"AIVDT",IBATYP,IBA))
if 'IBA!($GET(IBX))
QUIT
SET IBB=0
FOR
SET IBB=$ORDER(^IBE(350.2,"AIVDT",IBATYP,IBA,IBB))
if 'IBB!($GET(IBX))
QUIT
SET IBC=$GET(^IBE(350.2,IBB,0))
IF IBC]""
IF $$TIEROK^IBAUTL(IBC)
IF '$PIECE(IBC,"^",5)!($PIECE(IBC,"^",5)>IBFR)
SET IBX=IBB
QUIT
+37 DO UNIT^IBECEAU2(IBUNITP)
if IBY<0
QUIT
+38 IF 'IBH
IF IBUNIT=IBUNITP
IF IBODT=IBEFDT
IF IBOCHG=IBCHG
IF IBOTIER=IBTIER
WRITE !!,"No change was made!"
SET IBY=-1
QUIT
+39 IF IBH
DO UPCHG^IBECEA22(IBCHG,IBUNIT,IBFR,IBTO,IBTIER)
SET IBY=-1
QUIT
+40 WRITE !!,"The original charge will be cancelled and re-billed for $",$JUSTIFY(IBCHG,"",2),"."
End DoDot:1
GOTO END
+41 ;
+42 ; Handle all Inpatient Charges
+43 SET IBFRP=+$PIECE(IBND,"^",14)
SET IBTOP=+$PIECE(IBND,"^",15)
SET IBLIM=$SELECT(IBXA=3:DT,1:$$FMADD^XLFDT(DT,-1))
+44 ;Check GMT Copayment Status
SET IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFRP)
+45 DO CLSTR^IBECEAU1(DFN,IBFRP)
+46 IF 'IBCLDA
WRITE !!,"I cannot find a billing clock that was effective on ",$$DAT1^IBOUTL(IBFRP),"!",!,"Please adjust this patient's billing clocks before editing this charge."
SET IBY=-1
QUIT
+47 DO CLDATA^IBAUTL3
DO DED^IBAUTL3
if IBY<0
GOTO END
+48 ;For GMT Patients reduce Medicare Deductible to 20%
+49 IF IBGMT>0
SET IBMED=$$REDUCE^IBAGMT(IBMED)
WRITE !,"Medicare Deductible reduced due to GMT Copayment Status."
+50 if IBXA=2
SET IBBS=$ORDER(^DGCR(399.1,"AC",IBATYP,0))
+51 IF IBXA=2
IF $PIECE($GET(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU"
IF IBCLDAY>90
IF IBCHGP'>IBCLDOL
SET IBMED=IBMED/2
+52 IF IBXA=1
IF IBCLDAY>90
DO MED^IBECEA34
if IBY<0
GOTO END
+53 WRITE !!," ** ",$SELECT($PIECE(IBCLST,"^",4)=1:"Active",1:"Closed")," Billing Clock **"
+54 WRITE !?2,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY," ",$$INPT^IBECEAU(IBCLDAY)," 90 days: $",IBCLDOL,!
+55 if IBXA=3
SET IBDAYP=IBCLDAY-IBUNITP
+56 IF IBXA=1!(IBXA=2)
SET IBDOLP=IBCLDOL-IBCHGP
if IBDOLP<0
SET IBDOLP=0
+57 ;
+58 ; - ask for 'Bill From' date
FR DO FR^IBECEAU2(IBFRP)
if IBY<0
GOTO END
+1 ;
+2 IF IBFR<IBCLDT
WRITE !!,"The 'Bill From' date cannot preceed the Billing Clock Begin Date.",!
GOTO FR
+3 ; GMT Status may change
SET IBGMTR=0
SET IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFR)
+4 IF IBXA=3
SET IBDT=IBFR
DO COST^IBAUTL2
if IBGMT>0
SET IBGMTR=1
SET IBCHG=$$REDUCE^IBAGMT(IBCHG)
IF 'IBCHG
WRITE !!,"Unable to determine the per diem rate. Please check your rate table."
SET IBY=-1
GOTO END
+5 IF IBXA=2
SET IBDT=IBFR
DO COPAY^IBAUTL2
if IBY<0
GOTO END
if IBGMT>0
SET IBGMTR=1
SET IBCHG=$$REDUCE^IBAGMT(IBCHG)
IF IBCHG+IBDOLP<IBMED
WRITE *7," ($",IBCHG,"/day)"
if IBGMTR
WRITE " GMT Rate"
GOTO TO
+6 IF IBXA=2
IF IBCHG=IBCHGP
DO CTBB^IBECEAU3
WRITE !!,"No change was made!"
SET IBY=-1
GOTO END
+7 ;
+8 ; - ask for 'Bill To' date
TO DO TO^IBECEAU2(IBTOP)
if IBY<0
GOTO END
+1 ;
+2 IF $PIECE(IBCLST,"^",10)
IF IBTO>$PIECE(IBCLST,"^",10)
WRITE !!,"The 'Bill To' date cannot exceed the Billing Clock End Date (",$$DAT1^IBOUTL($PIECE(IBCLST,"^",10)),")."
GOTO TO
+3 SET IBUNIT=$$FMDIFF^XLFDT(IBTO,IBFR)
+4 IF $$FMDIFF^XLFDT(IBTOP,IBFRP)<IBUNITP!(IBFR=IBTO)
SET IBUNIT=IBUNIT+1
+5 IF IBTO'=IBFR
IF IBXA>0
IF IBXA<4
IF $$ISGMTPT^IBAGMT(DFN,IBTO)'=$$ISGMTPT^IBAGMT(DFN,IBFR)
WRITE !!,"The patient changed GMT Copayment status during the specified period!",!
GOTO TO
+6 IF IBXA>1
Begin DoDot:1
+7 SET IBCHG=IBUNIT*IBCHG
if IBXA=2
SET IBCHG=$SELECT(IBDOLP+IBCHG>IBMED:IBMED-IBDOLP,1:IBCHG)
+8 IF IBCHG=IBCHGP
DO CTBB^IBECEAU3
WRITE !!,"No change was made!"
SET IBY=-1
QUIT
+9 if IBXA=2
SET IBDOLA=IBDOLP+IBCHG
SET IBDAYA=0
if IBXA=3
SET IBDAYA=IBDAYP+IBUNIT
SET IBDOLA=0
+10 WRITE !!,"New charge to be billed"
if IBGMTR
WRITE "(GMT Rate)"
WRITE ": $",$JUSTIFY(IBCHG,"",2),!
+11 IF IBH
DO CHCL^IBECEA22
End DoDot:1
GOTO END
+12 ;
+13 ; - ask for 'Fee Amount'
+14 SET IBCLDOLO=IBCLDOL
SET IBCLDOL=IBCLDOL-IBCHGP
if IBCLDOL<0
SET IBCLDOL=0
+15 IF IBGMT>0
SET IBGMTR=1
WRITE !,"The patient has GMT Copayment Status! GMT rate must be applied.",!
+16 DO FEE^IBECEAU2(IBCHGP)
if IBY<0
GOTO END
+17 IF IBCHG=IBCHGP
WRITE !!,"No change was made!"
SET IBY=-1
GOTO END
+18 SET IBCLDOL=IBCLDOLO
SET IBDOLA=IBDOLP+IBCHG
SET IBDAYA=0
+19 IF IBH
DO CHCL^IBECEA22
+20 ;
END QUIT
