IBCRBF.m

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 ---IBCRBF   3270     printed  Feb 18, 2025@23:45:13                                                                                                                                                                                                      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))