IBECEA33 ;ALB/CPM-Cancel/Edit/Add... More Add Utilities ; 23-APR-93
;;2.0;INTEGRATED BILLING;**57,52,132,153,167,176,188,618,646,656,677,682,704,769**;21-MAR-94;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;
NOCL ; Find the correct clock from the 'bill from' date.
N IBFLAG,IBECDT,IBECENDT,IBECIEN,IBFLAG1,IBECLDT,IBQRY,IBCLQRY,IBECDT1,IBERRMSG,IBQUIT,IBECSTDT,IBECCLDT,IBOVERLAP
I (IBCLDA&(IBFR>=IBCLDT)),'$$ICN^IBARXMU(DFN) Q ;IB*2.0*769 - Exit if no ICN and active click found
;IB*704 - Run query for Inpatient Copays when no Queried Billing Clock found
S IBFLAG=0,IBECDT=-(IBFR)_".9999" F S IBECDT=$O(^IBE(351,"AIVDT",DFN,IBECDT)) Q:'IBECDT Q:IBFLAG S IBECIEN=$O(^IBE(351,"AIVDT",DFN,IBECDT,";"),-1) I IBECIEN D
.Q:$$GET1^DIQ(351,IBECIEN_",",.04,"I")=3 S IBECENDT=$$GET1^DIQ(351,IBECIEN_",",.1,"I"),IBECENDT=$S(IBECENDT:IBECENDT,1:DT) I IBECENDT>IBFR S IBFLAG=1,IBQRY=$P(^IBE(351,IBECIEN,1),U,5) Q
I 'IBFLAG,IBXA<4,$$ICN^IBARXMU(DFN) W !!,"No local clock found for service date.",!,"Running Billing Clock Query, please wait." D CCBILL^IBECECQ1(DFN,IBFR) S IBCLQRY=1
I IBFLAG,IBXA<4,'$G(IBQRY),$$ICN^IBARXMU(DFN) S IBFLAG="" W !!,"Billing Clock query required for local clock.",!,"Running Billing Clock Query, please wait." D CCBILL^IBECECQ1(DFN,IBFR) S IBCLQRY=1
I IBFLAG,IBXA<4,$G(IBQRY),$$ICN^IBARXMU(DFN),$$GET1^DIQ(351,IBXA,18,"I") S IBFLAG="" D
.W !!,"**********************************WARNING**********************************"
.W !,"The local billing clock is out of sync with other facilities.",!,"Please sync billing clock information before creating a copayment to ensure",!,"copayment billing accuracy."
.S DIR(0)="Y",DIR("A")="Do you still want to add a charge"
.S DIR("?")="Enter 'Y' to continue to add the charge, or 'N' or '^' to quit",DIC("B")="No"
.D ^DIR S:Y<1 IBY=-1
I $G(IBY)=-1 Q
I $G(IBFLAG1),$G(IBERRMSG)="",($G(IBCLQRY)) W !!,"Billing clock query successful and clock has been updated if applicable.",!! S IBY=$S($G(IBECDA):IBECDA,1:$G(IBECIEN)),IBCLDA=IBY I IBY D
.S IBECCLDT=$$GET1^DIQ(351,IBCLDA_",",.1,"I"),IBECENDT=$S(IBECCLDT:IBECCLDT,1:DT)
.S IBECSTDT=$$GET1^DIQ(351,IBCLDA_",",.03,"I")
.I $G(IBECENDT)>=DT,($G(IBFR)>=IBECSTDT) D CLDATA^IBAUTL3 D Q
..W !!," ** Active Billing Clock ** "
..W !!?6,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY
..W !?5,"Closed Date: ",$$DAT1^IBOUTL(IBECCLDT)," ",$$INPT^IBECEAU(IBCLDAY)," 90 Days: $",+IBCLDOL
..S IBQUIT=1
Q:$G(IBQUIT) ;Exit if active clock found
I $G(IBFLAG1),$G(IBERRMSG)["Query results contain inconsistent versioning" D
.W !!! S IBTEXT=IBERRMSG D WRAP^IBECECX1(0,80,.IBTEXT) S IBX=0 F S IBX=$O(IBTEXT(IBX)) Q:'IBX W !,IBTEXT(IBX)
.W !!,"The local billing clock is out of sync with other facility(s) below.",!
.S IBVRNST="" F S IBVRNST=$O(IBECARY(IBVRNST)) Q:IBVRNST="" W !,IBVRNST
.W !!,"Please sync billing clock information before creating a copayment to ensure",!,"copayment billing accuracy.",!! D
..S DIR(0)="Y",DIR("A")="Do you still want to continue",DIR("B")="No" D ^DIR K DIR I +Y<1 S IBQUIT=1
I $G(IBQUIT) S IBY=-1 Q
I '$G(IBFLAG1),$G(IBCLQRY) W !!,"Billing Clock Query was not returned from VDIF and clock could not be synced",!,"with other potential clocks.",! D
.W !,"Please try again later, and if the problem persists, submit a trouble ticket.",!
.S DIR(0)="Y",DIR("A")="Do you still want to continue",DIR("B")="No" D ^DIR K DIR I +Y<1 S IBY=-1 S IBQUIT=1
Q:$G(IBQUIT)
S:'$G(IBY) IBY=-1 ;IB*2*769 - If no clock found for timeframe, set IBY=-1
I $G(IBFLAG1),$G(IBOVERLAP) W !!,"***",IBERRMSG,"***",!! ;IB*2*769 - Overlapping message
N IBCLST,IBALR S IBALR=0
I IBCLDA S IBALR=1 W !!,"The Bill From date is prior to the start of the active clock..."
D CLSTR^IBECEAU1(DFN,IBFR)
I 'IBCLDA D G NOCLQ
.I IBALR W !!,"This patient has no clock which would cover this date. You should use the",!,"Clock Maintenance option to adjust this patient's clocks before proceeding." S IBY=-1 Q
.W !!,"Please note that I cannot find an active or closed clock for this patient",!,"on this date.",!
D CLDATA^IBAUTL3,DED^IBAUTL3 I IBY<0 D NODED^IBECEAU3 G NOCLQ
I IBXA=2,$P($G(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU",IBCLDAY>90 S IBMED=IBMED/2
I IBXA=1,IBCLDAY>90,$G(IBADJMED)'=1 S:$G(IBADJMED)=2 IBMED=IBMED/2 I '$G(IBADJMED) D MED^IBECEA34 G:IBY<0 NOCLQ
S IBLIM=$S($P(IBCLST,"^",10):$P(IBCLST,"^",10),1:$$FMADD^XLFDT(IBCLDT,364))
W !!?5,"This charge will be billed under the following closed clock:"
W !!?6,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY
W !?5,"Closed Date: ",$$DAT1^IBOUTL($P(IBCLST,"^",10))," ",$$INPT^IBECEAU(IBCLDAY)," 90 Days: $",+IBCLDOL
I IBXA=2,IBCLDOL'<IBMED S IBY=-1 W !!?5,"This patient has been billed the full copayment under this billing clock!",!?5,"You cannot add another copay charge starting on this date."
NOCLQ Q
;
OPT ; Check for a C&P exam and determine the outpatient copay rate.
I $$CNP^IBECEAU(DFN,IBFR) D I IBY<0 G OPTQ
.N DIR,DIRUT,DUOUT,DTOUT,Y
.W !!,"This patient had a Compensation & Pension exam on this date."
.S DIR(0)="Y",DIR("A")="Do you still want to add a charge"
.S DIR("?")="Enter 'Y' to continue to add the charge, or 'N' or '^' to quit"
.D ^DIR S:'Y IBY=-1
;
N IBDT,IBX,IBBS,IBTYPE
S (IBDT,IBTO)=IBFR,IBX="O",(IBTYPE,IBUNIT)=1,IBEVDA="*"
D:$G(IBATYP)=74 CHRG^IBECEAU5 D:$G(IBATYP)'=74 TYPE^IBAUTL2
D CTBB^IBECEAU3:IBY>0
OPTQ Q
;
CHTYP ; Ask for the Charge Type
;*** IB*2.0*618 add check for inactive field when building the list of Action Types.
S DIC="^IBE(350.1,",DIC(0)="AEMQZ",D="E",DIC("S")="I '$P($G(^(0)),U,12),$P(^(0),U)'[""MEDICARE"",$P(^(0),U)'[""CHAMPVA SUB""",DIC("A")="Select CHARGE TYPE: "
; IBREBILL array is defined in REBILL^IBECEA4
I $G(IBREBILL("CHRGTYPE"))'="" S DIC("B")=IBREBILL("CHRGTYPE") ; IB*2.0*682
D IX^DIC K DIC S IBATYP=+Y I Y<0 S IBY=-1 W !!,"No CHARGE TYPE entered - transaction cannot be completed." G CHTYPQ
;
; - perform charge type edits
S IBSEQNO=$P(Y(0),"^",5),IBXA=$P(Y(0),"^",11),IBNH=$S(IBXA=1:2,IBXA=9&$$CHKLTCCC:2,1:$P(Y(0),"^",8)["NHCU")
;
;IB*2.0*646/656 Start
;If the action type is DG FEE SERVICE (OPT) its an urgent care visit now and all eligibility checks and clocks can be skipped.
; will convert to new Urgent Care Action type(s) in a future patch
I $P(Y(0),U)="CC URGENT CARE (OPT) NEW" S IBUC=1 G CHTYPQ
;end IB*2.0*646/656
;
I 'IBSEQNO S IBY="-1^IB023" G CHTYPQ
I IBXA=7 G CHTYPQ
I IBXA=6 G:IBCVAEL CHTYPQ W !!,"This patient does not have a Primary Eligibility of CHAMPVA.",! G CHTYP
I 'IBCATC,IBXA'=5,IBXA'=8,IBXA'=9 W !!,"This patient has never been Means Test billable...",!,"You may only select a Pharmacy copay charge type.",! G CHTYP
I +IBEXSTAT,IBXA=5 W !!,"Patient is Exempt from Medication Copayment",!,$P(IBEXSTAT,"^",4),! G CHTYP
I IBLTCST=0,IBXA>7,IBXA<10 W !!,"This patient has no LTC (1010EC) information on file.",!,"You cannot select a LTC charge type.",! G CHTYP
I +IBLTCST=1,IBXA>7,IBXA<10 W !!,"This patient is Exempt from LTC Charges.",! G CHTYP
S:IBXA=2 IBBS=$O(^DGCR(399.1,"AC",IBATYP,0))
I IBXA=3 D
.N DIR,DIRUT,DTOUT,DUOUT,DIROUT,TYPE
.S TYPE=$S(Y(0,0)["NHCU PER DIEM":"N",1:"H")
.S DIR(0)="Y",DIR("A")=" Is this charge for a "_$S(TYPE="N":"CNH",1:"Contract Hospital")_" admission",DIR("B")="NO"
.S DIR("?")="Enter '<CR>' if the charge is for a VA "_$S(TYPE="N":"NHCU",1:"Hospital")_" admission, 'Y' for a "_$S(TYPE="N":"CNH",1:"Contract Hospital")_" admission, or '^' to quit."
.W ! D ^DIR I $D(DIRUT)!$D(DUOUT) S IBY=-1 Q
.I Y S IBNH=2
I IBXA>7,IBXA<10,IBNH'=2 S IBNH=3
CHTYPQ Q
;
CLMSG ; Check the Medicare Deductible and Billing Clock
I 'IBMED S IBCLDT=IBFR D DED^IBAUTL3 I IBY<0 D NODED^IBECEAU3 G CLMSGQ
I "^1^2^"[("^"_IBXA_"^"),IBCLDA,IBFR'<IBCLDT,IBCLDOL'<IBMED S IBY=-1 D
.W !!?5,*7,"This patient has already been billed the Medicare Deductible ($",IBMED,")"
.W !?5,"for his current 90 days of care. If you know this not to be the case,"
.W !?5,"please adjust the billing clock before proceeding."
CLMSGQ Q
;
CHKLTCCC() ; Check to see if the selected Charge Type is an LTC Inpatient CC
;
; Undeclared input: Y(0) - 0 Node of Charge Type entry in file 350.1
; Returns - 0 if not an Community Care LTC type., 1 if it is.
;
Q:Y(0)'["LTC" 0 ; Exit if not an LTC Charge Type
Q:Y(0)["FEE" 1 ; Existing functionality if an old Fee Basis Charge
Q:Y(0)["LTC CC" 1 ; Inpatient LTC CC, LTC CCN, and LTC CC MTF Action Types
Q:Y(0)["LTC CHOICE" 1 ; Inpatient LTC CC, LTC CCN, and LTC CC MTF Action Types
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA33 8655 printed Sep 23, 2025@19:57:34 Page 2
IBECEA33 ;ALB/CPM-Cancel/Edit/Add... More Add Utilities ; 23-APR-93
+1 ;;2.0;INTEGRATED BILLING;**57,52,132,153,167,176,188,618,646,656,677,682,704,769**;21-MAR-94;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
NOCL ; Find the correct clock from the 'bill from' date.
+1 NEW IBFLAG,IBECDT,IBECENDT,IBECIEN,IBFLAG1,IBECLDT,IBQRY,IBCLQRY,IBECDT1,IBERRMSG,IBQUIT,IBECSTDT,IBECCLDT,IBOVERLAP
+2 ;IB*2.0*769 - Exit if no ICN and active click found
IF (IBCLDA&(IBFR>=IBCLDT))
IF '$$ICN^IBARXMU(DFN)
QUIT
+3 ;IB*704 - Run query for Inpatient Copays when no Queried Billing Clock found
+4 SET IBFLAG=0
SET IBECDT=-(IBFR)_".9999"
FOR
SET IBECDT=$ORDER(^IBE(351,"AIVDT",DFN,IBECDT))
if 'IBECDT
QUIT
if IBFLAG
QUIT
SET IBECIEN=$ORDER(^IBE(351,"AIVDT",DFN,IBECDT,";"),-1)
IF IBECIEN
Begin DoDot:1
+5 if $$GET1^DIQ(351,IBECIEN_",",.04,"I")=3
QUIT
SET IBECENDT=$$GET1^DIQ(351,IBECIEN_",",.1,"I")
SET IBECENDT=$SELECT(IBECENDT:IBECENDT,1:DT)
IF IBECENDT>IBFR
SET IBFLAG=1
SET IBQRY=$PIECE(^IBE(351,IBECIEN,1),U,5)
QUIT
End DoDot:1
+6 IF 'IBFLAG
IF IBXA<4
IF $$ICN^IBARXMU(DFN)
WRITE !!,"No local clock found for service date.",!,"Running Billing Clock Query, please wait."
DO CCBILL^IBECECQ1(DFN,IBFR)
SET IBCLQRY=1
+7 IF IBFLAG
IF IBXA<4
IF '$GET(IBQRY)
IF $$ICN^IBARXMU(DFN)
SET IBFLAG=""
WRITE !!,"Billing Clock query required for local clock.",!,"Running Billing Clock Query, please wait."
DO CCBILL^IBECECQ1(DFN,IBFR)
SET IBCLQRY=1
+8 IF IBFLAG
IF IBXA<4
IF $GET(IBQRY)
IF $$ICN^IBARXMU(DFN)
IF $$GET1^DIQ(351,IBXA,18,"I")
SET IBFLAG=""
Begin DoDot:1
+9 WRITE !!,"**********************************WARNING**********************************"
+10 WRITE !,"The local billing clock is out of sync with other facilities.",!,"Please sync billing clock information before creating a copayment to ensure",!,"copayment billing accuracy."
+11 SET DIR(0)="Y"
SET DIR("A")="Do you still want to add a charge"
+12 SET DIR("?")="Enter 'Y' to continue to add the charge, or 'N' or '^' to quit"
SET DIC("B")="No"
+13 DO ^DIR
if Y<1
SET IBY=-1
End DoDot:1
+14 IF $GET(IBY)=-1
QUIT
+15 IF $GET(IBFLAG1)
IF $GET(IBERRMSG)=""
IF ($GET(IBCLQRY))
WRITE !!,"Billing clock query successful and clock has been updated if applicable.",!!
SET IBY=$SELECT($GET(IBECDA):IBECDA,1:$GET(IBECIEN))
SET IBCLDA=IBY
IF IBY
Begin DoDot:1
+16 SET IBECCLDT=$$GET1^DIQ(351,IBCLDA_",",.1,"I")
SET IBECENDT=$SELECT(IBECCLDT:IBECCLDT,1:DT)
+17 SET IBECSTDT=$$GET1^DIQ(351,IBCLDA_",",.03,"I")
+18 IF $GET(IBECENDT)>=DT
IF ($GET(IBFR)>=IBECSTDT)
DO CLDATA^IBAUTL3
Begin DoDot:2
+19 WRITE !!," ** Active Billing Clock ** "
+20 WRITE !!?6,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY
+21 WRITE !?5,"Closed Date: ",$$DAT1^IBOUTL(IBECCLDT)," ",$$INPT^IBECEAU(IBCLDAY)," 90 Days: $",+IBCLDOL
+22 SET IBQUIT=1
End DoDot:2
QUIT
End DoDot:1
+23 ;Exit if active clock found
if $GET(IBQUIT)
QUIT
+24 IF $GET(IBFLAG1)
IF $GET(IBERRMSG)["Query results contain inconsistent versioning"
Begin DoDot:1
+25 WRITE !!!
SET IBTEXT=IBERRMSG
DO WRAP^IBECECX1(0,80,.IBTEXT)
SET IBX=0
FOR
SET IBX=$ORDER(IBTEXT(IBX))
if 'IBX
QUIT
WRITE !,IBTEXT(IBX)
+26 WRITE !!,"The local billing clock is out of sync with other facility(s) below.",!
+27 SET IBVRNST=""
FOR
SET IBVRNST=$ORDER(IBECARY(IBVRNST))
if IBVRNST=""
QUIT
WRITE !,IBVRNST
+28 WRITE !!,"Please sync billing clock information before creating a copayment to ensure",!,"copayment billing accuracy.",!!
Begin DoDot:2
+29 SET DIR(0)="Y"
SET DIR("A")="Do you still want to continue"
SET DIR("B")="No"
DO ^DIR
KILL DIR
IF +Y<1
SET IBQUIT=1
End DoDot:2
End DoDot:1
+30 IF $GET(IBQUIT)
SET IBY=-1
QUIT
+31 IF '$GET(IBFLAG1)
IF $GET(IBCLQRY)
WRITE !!,"Billing Clock Query was not returned from VDIF and clock could not be synced",!,"with other potential clocks.",!
Begin DoDot:1
+32 WRITE !,"Please try again later, and if the problem persists, submit a trouble ticket.",!
+33 SET DIR(0)="Y"
SET DIR("A")="Do you still want to continue"
SET DIR("B")="No"
DO ^DIR
KILL DIR
IF +Y<1
SET IBY=-1
SET IBQUIT=1
End DoDot:1
+34 if $GET(IBQUIT)
QUIT
+35 ;IB*2*769 - If no clock found for timeframe, set IBY=-1
if '$GET(IBY)
SET IBY=-1
+36 ;IB*2*769 - Overlapping message
IF $GET(IBFLAG1)
IF $GET(IBOVERLAP)
WRITE !!,"***",IBERRMSG,"***",!!
+37 NEW IBCLST,IBALR
SET IBALR=0
+38 IF IBCLDA
SET IBALR=1
WRITE !!,"The Bill From date is prior to the start of the active clock..."
+39 DO CLSTR^IBECEAU1(DFN,IBFR)
+40 IF 'IBCLDA
Begin DoDot:1
+41 IF IBALR
WRITE !!,"This patient has no clock which would cover this date. You should use the",!,"Clock Maintenance option to adjust this patient's clocks before proceeding."
SET IBY=-1
QUIT
+42 WRITE !!,"Please note that I cannot find an active or closed clock for this patient",!,"on this date.",!
End DoDot:1
GOTO NOCLQ
+43 DO CLDATA^IBAUTL3
DO DED^IBAUTL3
IF IBY<0
DO NODED^IBECEAU3
GOTO NOCLQ
+44 IF IBXA=2
IF $PIECE($GET(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU"
IF IBCLDAY>90
SET IBMED=IBMED/2
+45 IF IBXA=1
IF IBCLDAY>90
IF $GET(IBADJMED)'=1
if $GET(IBADJMED)=2
SET IBMED=IBMED/2
IF '$GET(IBADJMED)
DO MED^IBECEA34
if IBY<0
GOTO NOCLQ
+46 SET IBLIM=$SELECT($PIECE(IBCLST,"^",10):$PIECE(IBCLST,"^",10),1:$$FMADD^XLFDT(IBCLDT,364))
+47 WRITE !!?5,"This charge will be billed under the following closed clock:"
+48 WRITE !!?6,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY
+49 WRITE !?5,"Closed Date: ",$$DAT1^IBOUTL($PIECE(IBCLST,"^",10))," ",$$INPT^IBECEAU(IBCLDAY)," 90 Days: $",+IBCLDOL
+50 IF IBXA=2
IF IBCLDOL'<IBMED
SET IBY=-1
WRITE !!?5,"This patient has been billed the full copayment under this billing clock!",!?5,"You cannot add another copay charge starting on this date."
NOCLQ QUIT
+1 ;
OPT ; Check for a C&P exam and determine the outpatient copay rate.
+1 IF $$CNP^IBECEAU(DFN,IBFR)
Begin DoDot:1
+2 NEW DIR,DIRUT,DUOUT,DTOUT,Y
+3 WRITE !!,"This patient had a Compensation & Pension exam on this date."
+4 SET DIR(0)="Y"
SET DIR("A")="Do you still want to add a charge"
+5 SET DIR("?")="Enter 'Y' to continue to add the charge, or 'N' or '^' to quit"
+6 DO ^DIR
if 'Y
SET IBY=-1
End DoDot:1
IF IBY<0
GOTO OPTQ
+7 ;
+8 NEW IBDT,IBX,IBBS,IBTYPE
+9 SET (IBDT,IBTO)=IBFR
SET IBX="O"
SET (IBTYPE,IBUNIT)=1
SET IBEVDA="*"
+10 if $GET(IBATYP)=74
DO CHRG^IBECEAU5
if $GET(IBATYP)'=74
DO TYPE^IBAUTL2
+11 if IBY>0
DO CTBB^IBECEAU3
OPTQ QUIT
+1 ;
CHTYP ; Ask for the Charge Type
+1 ;*** IB*2.0*618 add check for inactive field when building the list of Action Types.
+2 SET DIC="^IBE(350.1,"
SET DIC(0)="AEMQZ"
SET D="E"
SET DIC("S")="I '$P($G(^(0)),U,12),$P(^(0),U)'[""MEDICARE"",$P(^(0),U)'[""CHAMPVA SUB"""
SET DIC("A")="Select CHARGE TYPE: "
+3 ; IBREBILL array is defined in REBILL^IBECEA4
+4 ; IB*2.0*682
IF $GET(IBREBILL("CHRGTYPE"))'=""
SET DIC("B")=IBREBILL("CHRGTYPE")
+5 DO IX^DIC
KILL DIC
SET IBATYP=+Y
IF Y<0
SET IBY=-1
WRITE !!,"No CHARGE TYPE entered - transaction cannot be completed."
GOTO CHTYPQ
+6 ;
+7 ; - perform charge type edits
+8 SET IBSEQNO=$PIECE(Y(0),"^",5)
SET IBXA=$PIECE(Y(0),"^",11)
SET IBNH=$SELECT(IBXA=1:2,IBXA=9&$$CHKLTCCC:2,1:$PIECE(Y(0),"^",8)["NHCU")
+9 ;
+10 ;IB*2.0*646/656 Start
+11 ;If the action type is DG FEE SERVICE (OPT) its an urgent care visit now and all eligibility checks and clocks can be skipped.
+12 ; will convert to new Urgent Care Action type(s) in a future patch
+13 IF $PIECE(Y(0),U)="CC URGENT CARE (OPT) NEW"
SET IBUC=1
GOTO CHTYPQ
+14 ;end IB*2.0*646/656
+15 ;
+16 IF 'IBSEQNO
SET IBY="-1^IB023"
GOTO CHTYPQ
+17 IF IBXA=7
GOTO CHTYPQ
+18 IF IBXA=6
if IBCVAEL
GOTO CHTYPQ
WRITE !!,"This patient does not have a Primary Eligibility of CHAMPVA.",!
GOTO CHTYP
+19 IF 'IBCATC
IF IBXA'=5
IF IBXA'=8
IF IBXA'=9
WRITE !!,"This patient has never been Means Test billable...",!,"You may only select a Pharmacy copay charge type.",!
GOTO CHTYP
+20 IF +IBEXSTAT
IF IBXA=5
WRITE !!,"Patient is Exempt from Medication Copayment",!,$PIECE(IBEXSTAT,"^",4),!
GOTO CHTYP
+21 IF IBLTCST=0
IF IBXA>7
IF IBXA<10
WRITE !!,"This patient has no LTC (1010EC) information on file.",!,"You cannot select a LTC charge type.",!
GOTO CHTYP
+22 IF +IBLTCST=1
IF IBXA>7
IF IBXA<10
WRITE !!,"This patient is Exempt from LTC Charges.",!
GOTO CHTYP
+23 if IBXA=2
SET IBBS=$ORDER(^DGCR(399.1,"AC",IBATYP,0))
+24 IF IBXA=3
Begin DoDot:1
+25 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,TYPE
+26 SET TYPE=$SELECT(Y(0,0)["NHCU PER DIEM":"N",1:"H")
+27 SET DIR(0)="Y"
SET DIR("A")=" Is this charge for a "_$SELECT(TYPE="N":"CNH",1:"Contract Hospital")_" admission"
SET DIR("B")="NO"
+28 SET DIR("?")="Enter '<CR>' if the charge is for a VA "_$SELECT(TYPE="N":"NHCU",1:"Hospital")_" admission, 'Y' for a "_$SELECT(TYPE="N":"CNH",1:"Contract Hospital")_" admission, or '^' to quit."
+29 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DUOUT)
SET IBY=-1
QUIT
+30 IF Y
SET IBNH=2
End DoDot:1
+31 IF IBXA>7
IF IBXA<10
IF IBNH'=2
SET IBNH=3
CHTYPQ QUIT
+1 ;
CLMSG ; Check the Medicare Deductible and Billing Clock
+1 IF 'IBMED
SET IBCLDT=IBFR
DO DED^IBAUTL3
IF IBY<0
DO NODED^IBECEAU3
GOTO CLMSGQ
+2 IF "^1^2^"[("^"_IBXA_"^")
IF IBCLDA
IF IBFR'<IBCLDT
IF IBCLDOL'<IBMED
SET IBY=-1
Begin DoDot:1
+3 WRITE !!?5,*7,"This patient has already been billed the Medicare Deductible ($",IBMED,")"
+4 WRITE !?5,"for his current 90 days of care. If you know this not to be the case,"
+5 WRITE !?5,"please adjust the billing clock before proceeding."
End DoDot:1
CLMSGQ QUIT
+1 ;
CHKLTCCC() ; Check to see if the selected Charge Type is an LTC Inpatient CC
+1 ;
+2 ; Undeclared input: Y(0) - 0 Node of Charge Type entry in file 350.1
+3 ; Returns - 0 if not an Community Care LTC type., 1 if it is.
+4 ;
+5 ; Exit if not an LTC Charge Type
if Y(0)'["LTC"
QUIT 0
+6 ; Existing functionality if an old Fee Basis Charge
if Y(0)["FEE"
QUIT 1
+7 ; Inpatient LTC CC, LTC CCN, and LTC CC MTF Action Types
if Y(0)["LTC CC"
QUIT 1
+8 ; Inpatient LTC CC, LTC CCN, and LTC CC MTF Action Types
if Y(0)["LTC CHOICE"
QUIT 1
+9 QUIT 0
