IBECEA21 ;ALB/CPM - Cancel/Edit/Add... Edit Prompts ; 19-APR-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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.
;
; 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)," ..."
.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
.D UNIT^IBECEAU2(IBUNITP) Q:IBY<0
.I 'IBH,IBUNIT=IBUNITP W !!,"No change was made!" S IBY=-1 Q
.I IBH D UPCHG^IBECEA22(IBCHG,IBUNIT) S IBY=-1 Q
.W !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
;
; Handle all Inpatient Charges
S IBFRP=+$P(IBND,"^",14),IBTOP=+$P(IBND,"^",15),IBLIM=$S(IBXA=4:DT,1:$$FMADD^XLFDT(DT,-1))
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
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
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
I IBXA=3 S IBDT=IBFR D COST^IBAUTL2 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 I IBCHG+IBDOLP<IBMED W *7," ($",IBCHG,"/day)" 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 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: $",IBCHG,!
.I IBH D CHCL^IBECEA22
;
; - ask for 'Fee Amount'
S IBCLDOLO=IBCLDOL,IBCLDOL=IBCLDOL-IBCHGP S:IBCLDOL<0 IBCLDOL=0
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
I IBH D CHCL^IBECEA22
;
END Q
IBECEA21 ;ALB/CPM - Cancel/Edit/Add... Edit Prompts ; 19-APR-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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 ; Handle Outpatient Charges
+9 IF IBXA=4
Begin DoDot:1
+10 SET (IBFR,IBTO,IBDT)=$PIECE(IBND,"^",14)
SET IBUNIT=IBUNITP
+11 WRITE !,"Re-calculating the OPT copay charge for ",$$DAT1^IBOUTL(IBFR)," ..."
+12 SET IBX="O"
DO TYPE^IBAUTL2
IF IBY<0
QUIT
WRITE " $",IBCHG
+13 IF 'IBH
IF IBCHG=IBCHGP
WRITE !,"This equals the billed amount - this charge cannot be edited."
SET IBY=-1
QUIT
+14 IF IBCHG=IBCHGP
WRITE !,"This charge is ready to be billed."
DO PASS^IBECEA22
SET IBY=-1
QUIT
+15 IF IBH
DO UPCHG^IBECEA22(IBCHG)
SET IBY=-1
QUIT
+16 SET IBCRES=$ORDER(^IBE(350.3,"B","MT CHARGE EDITED",0))
IF 'IBCRES
SET IBCRES=19
+17 WRITE !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
End DoDot:1
GOTO END
+18 ;
+19 ; Handle Pharmacy Copay Charges
+20 IF IBXA=5
Begin DoDot:1
+21 DO UNIT^IBECEAU2(IBUNITP)
IF IBY<0
QUIT
+22 IF 'IBH
IF IBUNIT=IBUNITP
WRITE !!,"No change was made!"
SET IBY=-1
QUIT
+23 IF IBH
DO UPCHG^IBECEA22(IBCHG,IBUNIT)
SET IBY=-1
QUIT
+24 WRITE !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
End DoDot:1
GOTO END
+25 ;
+26 ; Handle all Inpatient Charges
+27 SET IBFRP=+$PIECE(IBND,"^",14)
SET IBTOP=+$PIECE(IBND,"^",15)
SET IBLIM=$SELECT(IBXA=4:DT,1:$$FMADD^XLFDT(DT,-1))
+28 DO CLSTR^IBECEAU1(DFN,IBFRP)
+29 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
+30 DO CLDATA^IBAUTL3
DO DED^IBAUTL3
IF IBY<0
GOTO END
+31 IF IBXA=2
SET IBBS=$ORDER(^DGCR(399.1,"AC",IBATYP,0))
+32 IF IBXA=2
IF $PIECE($GET(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU"
IF IBCLDAY>90
IF IBCHGP'>IBCLDOL
SET IBMED=IBMED/2
+33 WRITE !!," ** ",$SELECT($PIECE(IBCLST,"^",4)=1:"Active",1:"Closed")," Billing Clock **"
+34 WRITE !?2,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY," ",$$INPT^IBECEAU(IBCLDAY)," 90 days: $",IBCLDOL,!
+35 IF IBXA=3
SET IBDAYP=IBCLDAY-IBUNITP
+36 IF IBXA=1!(IBXA=2)
SET IBDOLP=IBCLDOL-IBCHGP
IF IBDOLP<0
SET IBDOLP=0
+37 ;
+38 ; - ask for 'Bill From' date
FR DO FR^IBECEAU2(IBFRP)
IF IBY<0
GOTO END
IF IBFR<IBCLDT
WRITE !!,"The 'Bill From' date cannot preceed the Billing Clock Begin Date.",!
GOTO FR
+1 IF IBXA=3
SET IBDT=IBFR
DO COST^IBAUTL2
IF 'IBCHG
WRITE !!,"Unable to determine the per diem rate. Please check your rate table."
SET IBY=-1
GOTO END
+2 IF IBXA=2
SET IBDT=IBFR
DO COPAY^IBAUTL2
IF IBY<0
GOTO END
IF IBCHG+IBDOLP<IBMED
WRITE *7," ($",IBCHG,"/day)"
GOTO TO
+3 IF IBXA=2
IF IBCHG=IBCHGP
DO CTBB^IBECEAU3
WRITE !!,"No change was made!"
SET IBY=-1
GOTO END
+4 ;
+5 ; - ask for 'Bill To' date
TO DO TO^IBECEAU2(IBTOP)
IF IBY<0
GOTO END
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
+1 SET IBUNIT=$$FMDIFF^XLFDT(IBTO,IBFR)
+2 IF $$FMDIFF^XLFDT(IBTOP,IBFRP)<IBUNITP!(IBFR=IBTO)
SET IBUNIT=IBUNIT+1
+3 IF IBXA>1
Begin DoDot:1
+4 SET IBCHG=IBUNIT*IBCHG
IF IBXA=2
SET IBCHG=$SELECT(IBDOLP+IBCHG>IBMED:IBMED-IBDOLP,1:IBCHG)
+5 IF IBCHG=IBCHGP
DO CTBB^IBECEAU3
WRITE !!,"No change was made!"
SET IBY=-1
QUIT
+6 IF IBXA=2
SET IBDOLA=IBDOLP+IBCHG
SET IBDAYA=0
IF IBXA=3
SET IBDAYA=IBDAYP+IBUNIT
SET IBDOLA=0
+7 WRITE !!,"New charge to be billed: $",IBCHG,!
+8 IF IBH
DO CHCL^IBECEA22
End DoDot:1
GOTO END
+9 ;
+10 ; - ask for 'Fee Amount'
+11 SET IBCLDOLO=IBCLDOL
SET IBCLDOL=IBCLDOL-IBCHGP
IF IBCLDOL<0
SET IBCLDOL=0
+12 DO FEE^IBECEAU2(IBCHGP)
IF IBY<0
GOTO END
+13 IF IBCHG=IBCHGP
WRITE !!,"No change was made!"
SET IBY=-1
GOTO END
+14 SET IBCLDOL=IBCLDOLO
SET IBDOLA=IBDOLP+IBCHG
+15 IF IBH
DO CHCL^IBECEA22
+16 ;
END QUIT
