- 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
