IBECEA32 ;ALB/CPM-Cancel/Edit/Add... Add Utilities ; Aug 09, 2023
;;2.0;INTEGRATED BILLING ;**57,188,704**; 21-MAR-94;Build 49
;Per VA Directive 6402, this routine should not be modified
;
CLUPD ; Handle the updating of the billing clock when adding a charge.
I IBXA=5!(IBCLDA&(IBXA=4)) G CLOCKQ
;
; - charge not covered by a clock
I 'IBCLDA D ADD G CLOCKQ
;
; - update existing clock
S IBCLST=^IBE(351,IBCLDA,0)
D CLOCK^IBECEAU(IBCHG,+$P(IBCLST,"^",9),IBUNIT)
CLOCKQ K IBCLST
Q
;
CHMPVA ; Process the CHAMPVA inpatient subsistence charge.
I '$$ON^IBACVA2() W !!,"Sorry! The CHAMPVA billing module is not yet fully installed. You will need",!,"to generate a claim to bill this patient the inpatient subsistence charge." G CHMPVAQ
CHMPEN S IBPM=$$ADSEL^IBECEA31(DFN) I IBPM=-1 G CHMPVAQ
I 'IBPM W !!,"This patient has no admissions on file!",!,"You cannot bill the CHAMPVA inpatient subsistence charge at this time." G CHMPVAQ
S IBSL=+IBPM,IBCVA=$P(IBPM,"^",2),IBPMD=$P(IBPM,"^",3)
I 'IBPMD W !!,"You can only bill admissions which have been discharged!" G CHMPEN
I $$PREV^IBACVA1(DFN,IBCVA,IBSL) W !!,"This admission has already been billed the CHAMPVA inpatient subsistence charge." G CHMPEN
;
; - set input parameters and automatically calculate the charge
S IBBDT=$$FMTH^XLFDT(IBCVA,1),IBEDT=$$FMTH^XLFDT(+$G(^DGPM(IBPMD,0))\1,1)
D BILL^IBACVA1
CHMPVAQ K IBPM,IBSL,IBCVA
Q
;
ADD ; Prompt user to add a new billing clock.
N DIE,DA,DR,DIR,DIRUT,DUOUT,DTOUT,X,Y,IBCCUPDF
W !!,"Since this patient has no active clock to cover this charge, I would like to",!,"set up an active clock as follows:"
W !!?5,"Clock Begin Date: ",$$DAT1^IBOUTL(IBFR),! W:IBXA=1!(IBXA=2) ?4,"1st 90 days copay: $",IBCHG,! W:IBXA=3 ?5,"# Inpatient days: ",IBUNIT,!
S DIR(0)="Y",DIR("A")="Is it okay to set up a new clock with "_$S(IBXA=4:"this",1:"these")_" value"_$E("s",IBXA'=4),DIR("?")="Enter 'Y' or 'YES' to create a new clock, or 'N', 'NO', or '^' to quit."
D ^DIR I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"A new clock will not be established. Be sure this patient's clock is correct." Q
W !!,"Creating a new, active billing clock... "
S IBCLDT=IBFR,IBCCUPDF=1 D CLADD^IBAUTL3 Q:IBY<0
I IBXA'=4 S DIE="^IBE(351,",DA=IBCLDA,DR=$S(IBXA=3:.09,1:.05)_"////"_$S(IBXA=3:IBUNIT,1:IBCHG)_";13////"_DUZ_";14///NOW;16///1" D ^DIE
W "done."
D EN^IBECECU1(DFN,IBCLDA)
Q
;
FEPR ; Issue prompts for Inpatient Fee Services
N DIR,DIRUT,DUOUT,DTOUT,IBCLDT,X,Y
S IBDESC=$S(IBXA=1:"FEE SERVICE (INPT)",1:$P($G(^IBE(350.1,+$G(IBATYP),0)),"^",8))
D FEE^IBECEAU2(0) I IBY>0 D CTBB^IBECEAU3
Q
;
HFEV ; Help for Fee Event Date
W !!,"Please enter the Event Date for this Fee Service (which should be the"
W !,"admission date, and not exceed the Bill From date [",$$DAT1^IBOUTL(IBFR),"]), or '^' to quit."
Q
;
SPEC(X,Y) ; Display messages for special inpatient billing cases.
; Input: X -- has two values:
; 1 --> entering after selecting an admission
; (will need to set IBSIBC)
; 0 --> billing event record exists
; Y -- Pointer to special inpatient billing case in
; file #351.2 (quit if not positive)
Q:'$G(Y)
I $G(X),'$P($G(^IBE(351.2,Y,0)),"^",8) D Q
.S IBSIBC=+IBDG
.W !,"This is a special inpatient billing case! The case will be dispositioned."
W !,*7,"Please note that you are creating a charge for a special inpatient case!!"
S IBSIBC1=Y D DSPL^IBAMTI1(Y)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA32 3523 printed Apr 09, 2024@21:05:18 Page 2
IBECEA32 ;ALB/CPM-Cancel/Edit/Add... Add Utilities ; Aug 09, 2023
+1 ;;2.0;INTEGRATED BILLING ;**57,188,704**; 21-MAR-94;Build 49
+2 ;Per VA Directive 6402, this routine should not be modified
+3 ;
CLUPD ; Handle the updating of the billing clock when adding a charge.
+1 IF IBXA=5!(IBCLDA&(IBXA=4))
GOTO CLOCKQ
+2 ;
+3 ; - charge not covered by a clock
+4 IF 'IBCLDA
DO ADD
GOTO CLOCKQ
+5 ;
+6 ; - update existing clock
+7 SET IBCLST=^IBE(351,IBCLDA,0)
+8 DO CLOCK^IBECEAU(IBCHG,+$PIECE(IBCLST,"^",9),IBUNIT)
CLOCKQ KILL IBCLST
+1 QUIT
+2 ;
CHMPVA ; Process the CHAMPVA inpatient subsistence charge.
+1 IF '$$ON^IBACVA2()
WRITE !!,"Sorry! The CHAMPVA billing module is not yet fully installed. You will need",!,"to generate a claim to bill this patient the inpatient subsistence charge."
GOTO CHMPVAQ
CHMPEN SET IBPM=$$ADSEL^IBECEA31(DFN)
IF IBPM=-1
GOTO CHMPVAQ
+1 IF 'IBPM
WRITE !!,"This patient has no admissions on file!",!,"You cannot bill the CHAMPVA inpatient subsistence charge at this time."
GOTO CHMPVAQ
+2 SET IBSL=+IBPM
SET IBCVA=$PIECE(IBPM,"^",2)
SET IBPMD=$PIECE(IBPM,"^",3)
+3 IF 'IBPMD
WRITE !!,"You can only bill admissions which have been discharged!"
GOTO CHMPEN
+4 IF $$PREV^IBACVA1(DFN,IBCVA,IBSL)
WRITE !!,"This admission has already been billed the CHAMPVA inpatient subsistence charge."
GOTO CHMPEN
+5 ;
+6 ; - set input parameters and automatically calculate the charge
+7 SET IBBDT=$$FMTH^XLFDT(IBCVA,1)
SET IBEDT=$$FMTH^XLFDT(+$GET(^DGPM(IBPMD,0))\1,1)
+8 DO BILL^IBACVA1
CHMPVAQ KILL IBPM,IBSL,IBCVA
+1 QUIT
+2 ;
ADD ; Prompt user to add a new billing clock.
+1 NEW DIE,DA,DR,DIR,DIRUT,DUOUT,DTOUT,X,Y,IBCCUPDF
+2 WRITE !!,"Since this patient has no active clock to cover this charge, I would like to",!,"set up an active clock as follows:"
+3 WRITE !!?5,"Clock Begin Date: ",$$DAT1^IBOUTL(IBFR),!
if IBXA=1!(IBXA=2)
WRITE ?4,"1st 90 days copay: $",IBCHG,!
if IBXA=3
WRITE ?5,"# Inpatient days: ",IBUNIT,!
+4 SET DIR(0)="Y"
SET DIR("A")="Is it okay to set up a new clock with "_$SELECT(IBXA=4:"this",1:"these")_" value"_$EXTRACT("s",IBXA'=4)
SET DIR("?")="Enter 'Y' or 'YES' to create a new clock, or 'N', 'NO', or '^' to quit."
+5 DO ^DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
WRITE !,"A new clock will not be established. Be sure this patient's clock is correct."
QUIT
+6 WRITE !!,"Creating a new, active billing clock... "
+7 SET IBCLDT=IBFR
SET IBCCUPDF=1
DO CLADD^IBAUTL3
if IBY<0
QUIT
+8 IF IBXA'=4
SET DIE="^IBE(351,"
SET DA=IBCLDA
SET DR=$SELECT(IBXA=3:.09,1:.05)_"////"_$SELECT(IBXA=3:IBUNIT,1:IBCHG)_";13////"_DUZ_";14///NOW;16///1"
DO ^DIE
+9 WRITE "done."
+10 DO EN^IBECECU1(DFN,IBCLDA)
+11 QUIT
+12 ;
FEPR ; Issue prompts for Inpatient Fee Services
+1 NEW DIR,DIRUT,DUOUT,DTOUT,IBCLDT,X,Y
+2 SET IBDESC=$SELECT(IBXA=1:"FEE SERVICE (INPT)",1:$PIECE($GET(^IBE(350.1,+$GET(IBATYP),0)),"^",8))
+3 DO FEE^IBECEAU2(0)
IF IBY>0
DO CTBB^IBECEAU3
+4 QUIT
+5 ;
HFEV ; Help for Fee Event Date
+1 WRITE !!,"Please enter the Event Date for this Fee Service (which should be the"
+2 WRITE !,"admission date, and not exceed the Bill From date [",$$DAT1^IBOUTL(IBFR),"]), or '^' to quit."
+3 QUIT
+4 ;
SPEC(X,Y) ; Display messages for special inpatient billing cases.
+1 ; Input: X -- has two values:
+2 ; 1 --> entering after selecting an admission
+3 ; (will need to set IBSIBC)
+4 ; 0 --> billing event record exists
+5 ; Y -- Pointer to special inpatient billing case in
+6 ; file #351.2 (quit if not positive)
+7 if '$GET(Y)
QUIT
+8 IF $GET(X)
IF '$PIECE($GET(^IBE(351.2,Y,0)),"^",8)
Begin DoDot:1
+9 SET IBSIBC=+IBDG
+10 WRITE !,"This is a special inpatient billing case! The case will be dispositioned."
End DoDot:1
QUIT
+11 WRITE !,*7,"Please note that you are creating a charge for a special inpatient case!!"
+12 SET IBSIBC1=Y
DO DSPL^IBAMTI1(Y)
+13 QUIT
