IBCRBF ;ALB/ARH - RATES: BILL FILE CHARGES ;22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,51,447**;21-MAR-94;Build 80
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ADDRC(IBIFN,IBRVCD,IBBS,IBCHG,IBUNITS,IBCPT,IBDIV,IBAA,IBITYP,IBIPTR,IBCMPNT) ; add a revenue code charge entry to a bill (399,42)
; returns DA of new entry or -1
N X,Y,DA,DLAYGO,DIC,DIE,DR,IBDA,DGXRF1,Z,Z1 S IBDA=-1
;
; START IB*2.0*447 BI ZERO DOLLAR CHANGES
;I ($G(IBCHG)'>0)!('$G(IBUNITS)) G ADDRCQ
I '$G(IBUNITS) G ADDRCQ
; END IB*2.0*447 BI ZERO DOLLAR CHANGES
I $G(^DGCR(399,+$G(IBIFN),0))="" G ADDRCQ
I '$P($G(^DGCR(399.2,+$G(IBRVCD),0)),U,3) G ADDRCQ
I '$P($G(^DGCR(399.1,+$G(IBBS),0)),U,5) G ADDRCQ
S IBCPT=$G(IBCPT) I +IBCPT,$$CPT^ICPTCOD(+IBCPT,DT)<1 G ADDRCQ
S IBDIV=$G(IBDIV) I +IBDIV,'$D(^DG(40.8,+IBDIV,0)) G ADDRCQ
S IBCHG=+$FN(IBCHG,"",2)
;
I $$NOIPINST(IBIFN),$$RCDUP(IBIFN,IBRVCD,IBITYP,IBIPTR,.IBCHG) S IBCHG=+$FN(IBCHG,"",2) G ADDRCQ ; ADDED TO PREVENT DUPLICATE REVENUE CODES IB*2.0*447 BI
;
K DD,DO S DIC("P")=$P(^DD(399,42,0),U,2)
S DLAYGO=399,DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""RC"",",DIC(0)="L",X=IBRVCD D FILE^DICN G:Y<1 ADDRCQ
;
S DR=".02////"_IBCHG_";.03////"_IBUNITS_";.05////"_IBBS
I +IBCPT S DR=DR_";.06////"_IBCPT I +IBDIV S DR=DR_";.07////"_IBDIV
I +$G(IBAA) S DR=DR_";.08////1"
I +$G(IBITYP)>0,IBITYP<10 S DR=DR_";.1////"_IBITYP I +$G(IBIPTR) S DR=DR_";.11////"_IBIPTR
I +$G(IBCMPNT)>0,IBCMPNT<3 S DR=DR_";.12////"_IBCMPNT
I IBITYP=3,IBIPTR D
. N Z
. S Z=+$O(^TMP("IBCRRX",$J,IBIPTR,0))
. I Z S DR=DR_";.15////"_Z K ^TMP("IBCRRX",$J,IBIPTR,Z)
S (DA,IBDA)=+Y,DIE=DIC D ^DIE
;
ADDRCQ Q IBDA
;
DELALLRC(IBIFN) ; delete all charges on the bill that were automatically calculated and added
;
N IBI,DA,DIK,X,Y,DGXRF1,Z,Z1
K ^TMP("IBCRRX",$J)
I +$G(IBIFN) S IBI=0 F S IBI=$O(^DGCR(399,+IBIFN,"RC",IBI)) Q:'IBI D
. N Z0
. S Z0=$G(^DGCR(399,+IBIFN,"RC",IBI,0))
. I '$P(Z0,U,8) Q
. I $$NOIPINST(IBIFN),+$P(Z0,U,16) Q ; Don't delete if MANUALLY EDITED, IB*2.0*447 BI
. ; Capture revenue codes and their relation to prescriptions
. I $P(Z0,U,15) S ^TMP("IBCRRX",$J,+$P(Z0,U,11),$P(Z0,U,15))=""
. ; Be careful changing the name of this array - this is used in index
. ; ADPR - file 399.042, fields .01 and .03 to determine if the RX
. ; procedures should be deleted when the revenue codes are
. S DA(1)=+IBIFN,DA=IBI,DIK="^DGCR(399,"_DA(1)_",""RC""," D ^DIK K DIK
Q
;
RCDUP(IBIFN,IBRVCD,IBITYP,IBIPTR,IBCHG) ; Check for duplicate Revenue Codes for the same Charge Code
; IB*2.0*447 BI
; Inputs: IBIFN - Bill/Claim IEN
; IBIPTR - Charge Code Multiple IEN
; Output: RCDUP - 0=No Duplicate, 1=Duplicate Exists
;
N RCLOOP,RC0
N RCDUP S RCDUP=0
I $G(IBIFN)="" Q RCDUP
S RCLOOP=0 F S RCLOOP=$O(^DGCR(399,IBIFN,"RC",RCLOOP)) Q:+RCLOOP=0!(RCDUP=1) D
. S RC0=$G(^DGCR(399,IBIFN,"RC",RCLOOP,0)) Q:RC0="" Q:'$P(RC0,U,16)
. I $P(RC0,U,1)=IBRVCD,$P(RC0,U,10)=IBITYP,$P(RC0,U,11)=IBIPTR S IBCHG=$P(RC0,U,2),RCDUP=1
Q RCDUP
;
NOIPINST(IBIFN) ; Test for Not Inpatient Institutional.
; Returns a 1 if the claim is not an Inpatient Institutional claim.
Q '($$INPAT^IBCEF(IBIFN)&($P($G(^DGCR(399,+$G(IBIFN),0)),U,27)=1))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRBF 3270 printed Dec 13, 2024@02:18:50 Page 2
IBCRBF ;ALB/ARH - RATES: BILL FILE CHARGES ;22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,51,447**;21-MAR-94;Build 80
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ADDRC(IBIFN,IBRVCD,IBBS,IBCHG,IBUNITS,IBCPT,IBDIV,IBAA,IBITYP,IBIPTR,IBCMPNT) ; add a revenue code charge entry to a bill (399,42)
+1 ; returns DA of new entry or -1
+2 NEW X,Y,DA,DLAYGO,DIC,DIE,DR,IBDA,DGXRF1,Z,Z1
SET IBDA=-1
+3 ;
+4 ; START IB*2.0*447 BI ZERO DOLLAR CHANGES
+5 ;I ($G(IBCHG)'>0)!('$G(IBUNITS)) G ADDRCQ
+6 IF '$GET(IBUNITS)
GOTO ADDRCQ
+7 ; END IB*2.0*447 BI ZERO DOLLAR CHANGES
+8 IF $GET(^DGCR(399,+$GET(IBIFN),0))=""
GOTO ADDRCQ
+9 IF '$PIECE($GET(^DGCR(399.2,+$GET(IBRVCD),0)),U,3)
GOTO ADDRCQ
+10 IF '$PIECE($GET(^DGCR(399.1,+$GET(IBBS),0)),U,5)
GOTO ADDRCQ
+11 SET IBCPT=$GET(IBCPT)
IF +IBCPT
IF $$CPT^ICPTCOD(+IBCPT,DT)<1
GOTO ADDRCQ
+12 SET IBDIV=$GET(IBDIV)
IF +IBDIV
IF '$DATA(^DG(40.8,+IBDIV,0))
GOTO ADDRCQ
+13 SET IBCHG=+$FNUMBER(IBCHG,"",2)
+14 ;
+15 ; ADDED TO PREVENT DUPLICATE REVENUE CODES IB*2.0*447 BI
IF $$NOIPINST(IBIFN)
IF $$RCDUP(IBIFN,IBRVCD,IBITYP,IBIPTR,.IBCHG)
SET IBCHG=+$FNUMBER(IBCHG,"",2)
GOTO ADDRCQ
+16 ;
+17 KILL DD,DO
SET DIC("P")=$PIECE(^DD(399,42,0),U,2)
+18 SET DLAYGO=399
SET DA(1)=IBIFN
SET DIC="^DGCR(399,"_DA(1)_",""RC"","
SET DIC(0)="L"
SET X=IBRVCD
DO FILE^DICN
if Y<1
GOTO ADDRCQ
+19 ;
+20 SET DR=".02////"_IBCHG_";.03////"_IBUNITS_";.05////"_IBBS
+21 IF +IBCPT
SET DR=DR_";.06////"_IBCPT
IF +IBDIV
SET DR=DR_";.07////"_IBDIV
+22 IF +$GET(IBAA)
SET DR=DR_";.08////1"
+23 IF +$GET(IBITYP)>0
IF IBITYP<10
SET DR=DR_";.1////"_IBITYP
IF +$GET(IBIPTR)
SET DR=DR_";.11////"_IBIPTR
+24 IF +$GET(IBCMPNT)>0
IF IBCMPNT<3
SET DR=DR_";.12////"_IBCMPNT
+25 IF IBITYP=3
IF IBIPTR
Begin DoDot:1
+26 NEW Z
+27 SET Z=+$ORDER(^TMP("IBCRRX",$JOB,IBIPTR,0))
+28 IF Z
SET DR=DR_";.15////"_Z
KILL ^TMP("IBCRRX",$JOB,IBIPTR,Z)
End DoDot:1
+29 SET (DA,IBDA)=+Y
SET DIE=DIC
DO ^DIE
+30 ;
ADDRCQ QUIT IBDA
+1 ;
DELALLRC(IBIFN) ; delete all charges on the bill that were automatically calculated and added
+1 ;
+2 NEW IBI,DA,DIK,X,Y,DGXRF1,Z,Z1
+3 KILL ^TMP("IBCRRX",$JOB)
+4 IF +$GET(IBIFN)
SET IBI=0
FOR
SET IBI=$ORDER(^DGCR(399,+IBIFN,"RC",IBI))
if 'IBI
QUIT
Begin DoDot:1
+5 NEW Z0
+6 SET Z0=$GET(^DGCR(399,+IBIFN,"RC",IBI,0))
+7 IF '$PIECE(Z0,U,8)
QUIT
+8 ; Don't delete if MANUALLY EDITED, IB*2.0*447 BI
IF $$NOIPINST(IBIFN)
IF +$PIECE(Z0,U,16)
QUIT
+9 ; Capture revenue codes and their relation to prescriptions
+10 IF $PIECE(Z0,U,15)
SET ^TMP("IBCRRX",$JOB,+$PIECE(Z0,U,11),$PIECE(Z0,U,15))=""
+11 ; Be careful changing the name of this array - this is used in index
+12 ; ADPR - file 399.042, fields .01 and .03 to determine if the RX
+13 ; procedures should be deleted when the revenue codes are
+14 SET DA(1)=+IBIFN
SET DA=IBI
SET DIK="^DGCR(399,"_DA(1)_",""RC"","
DO ^DIK
KILL DIK
End DoDot:1
+15 QUIT
+16 ;
RCDUP(IBIFN,IBRVCD,IBITYP,IBIPTR,IBCHG) ; Check for duplicate Revenue Codes for the same Charge Code
+1 ; IB*2.0*447 BI
+2 ; Inputs: IBIFN - Bill/Claim IEN
+3 ; IBIPTR - Charge Code Multiple IEN
+4 ; Output: RCDUP - 0=No Duplicate, 1=Duplicate Exists
+5 ;
+6 NEW RCLOOP,RC0
+7 NEW RCDUP
SET RCDUP=0
+8 IF $GET(IBIFN)=""
QUIT RCDUP
+9 SET RCLOOP=0
FOR
SET RCLOOP=$ORDER(^DGCR(399,IBIFN,"RC",RCLOOP))
if +RCLOOP=0!(RCDUP=1)
QUIT
Begin DoDot:1
+10 SET RC0=$GET(^DGCR(399,IBIFN,"RC",RCLOOP,0))
if RC0=""
QUIT
if '$PIECE(RC0,U,16)
QUIT
+11 IF $PIECE(RC0,U,1)=IBRVCD
IF $PIECE(RC0,U,10)=IBITYP
IF $PIECE(RC0,U,11)=IBIPTR
SET IBCHG=$PIECE(RC0,U,2)
SET RCDUP=1
End DoDot:1
+12 QUIT RCDUP
+13 ;
NOIPINST(IBIFN) ; Test for Not Inpatient Institutional.
+1 ; Returns a 1 if the claim is not an Inpatient Institutional claim.
+2 QUIT '($$INPAT^IBCEF(IBIFN)&($PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,27)=1))
