Routine: IBCU62

IBCU62 ;ALB/AAS - UTILITY ROUTINE TO SET BEDSECTION/REVENUE CODES FROM PTF DATA ; 29-OCT-90

 ;;2.0;INTEGRATED BILLING;**133,447**;21-MAR-94;Build 80

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;MAP TO DGCRU62

SETREV ;find current active revenue codes for bedsection

 S (DGREV,DGBR)=0,DGACTDT=-(IBIDS(151)+.01) K DGFND

 F  S DGACTDT=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT)) Q:'DGACTDT!($D(DGFND))  D

 . F  S DGREV=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV)) Q:'DGREV  D

 .. F  S DGBR=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV,DGBR)) Q:'DGBR  D CHKREV,STORREV:IBCHK

CHKREV ;check if billing rate (dgbr) is active, and use with payer.

 S IBCHK=0

 S DGBRN=^DGCR(399.5,DGBR,0) I '$P(DGBRN,"^",5) Q  ;quit if inactive

 I IBIDS(.11)="i",$P(DGINPAR,"^",2)="",+$P(DGBRN,"^",7) Q  ;quit if non-standard rate

 I IBIDS(.11)'="i",+$P(DGBRN,"^",7) Q  ;non-standard rates only for ins.

 S DGREV00="00"_DGREV I IBIDS(.11)="i",$P(DGINPAR,"^",2)]"",$P(DGINPAR,"^",2)'[$E(DGREV00,$L(DGREV00)-2,$L(DGREV00)) Q  ;quit if revenue code not in exception list

 I $P(DGBRN,U,6)[IBIDS(.11) S:'$D(DGFND) DGFND="" S IBCHK=1 Q

STORREV ;store revenue code in revenue code file

 S X=$P(^DGCR(399.5,DGBR,0),"^",3),DGAMNT=$P(^(0),"^",4),DA(1)=IBIFN,DIC(0)="L",DIC="^DGCR(399,IBIFN,""RC"",",DGFUNC="Adding"

 I $D(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI)) S DA=$O(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI,0)),DGFUNC="Editing" G EDITREV

 D FILE,WRT

FILE ;manually file entry, index with ix1^dik to use compiled x-ref

 I '$D(DGREVHDR) D REVHDR

 I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1

 L ^DGCR(399,IBIFN):1

 S DA=$P(^DGCR(399,IBIFN,"RC",0),"^",3)

 F DGLL=0:0 S DA=DA+1 Q:'$D(^DGCR(399,IBIFN,"RC",DA,0))

 ;S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_$S($D(DGPROC)&($D(DGDIV)):"^"_DGPROC_"^"_DGDIV,1:"")

 S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_"^"_$G(DGPROC)_"^"_$G(DGDIV)_"^"_1

 S ^DGCR(399,IBIFN,"RC",0)=$P(^DGCR(399,IBIFN,"RC",0),"^",1,2)_"^"_DA_"^"_($P(^DGCR(399,IBIFN,"RC",0),"^",4)+1)

 S DIK="^DGCR(399,"_DA(1)_",""RC""," D IX1^DIK L ^DGCR(399,IBIFN):1

EDITREV ;edit revenue code data.

 I '$D(DGREVHDR) D REVHDR

 I $P(^DGCR(399,IBIFN,"RC",DA,0),U,16) Q  ; IB*2.0*447 BI

 I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1

 S DIE=DIC,DA(1)=IBIFN,DR=".02///"_DGAMNT_";.03///"_DGBSLOS_";.05///"_DGBS D ^DIE

WRT ;S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3) W:'$G(IBAUTO) !,DGFUNC,?12,$E(Z,($L(Z)-2),$L(Z)),?24,DGBSLOS,?31,"$",$J(DGAMNT,8,2),?44,DGBS

 S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3)

 W:'$G(IBAUTO) !,DGFUNC,?12,$E(Z,($L(Z)-2),$L(Z)),?24,DGBSLOS,?31,"$",$J(DGAMNT,8,2),?44,DGBS I +$G(DGPROC) W ?65,$P($$CPT^ICPTCOD(+DGPROC),U,2)

REVHDR S DGREVHDR=1 W:'$G(IBAUTO) !,"Updating Revenue Codes",!?10,"REV. CODE",?22,"UNITS",?31,"CHARGE",?44,"BEDSECTION" I $D(DGPROC) W:'$G(IBAUTO) ?65,"PROCEDURE"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCU62   2890     printed  Feb 18, 2025@23:47:07                                                                                                                                                                                                      Page 2

IBCU62    ;ALB/AAS - UTILITY ROUTINE TO SET BEDSECTION/REVENUE CODES FROM PTF DATA ; 29-OCT-90

 +1       ;;2.0;INTEGRATED BILLING;**133,447**;21-MAR-94;Build 80

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;MAP TO DGCRU62

 +5       ;

SETREV    ;find current active revenue codes for bedsection

 +1        SET (DGREV,DGBR)=0

           SET DGACTDT=-(IBIDS(151)+.01)

           KILL DGFND

 +2        FOR

               SET DGACTDT=$ORDER(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT))

               if 'DGACTDT!($DATA(DGFND))

                   QUIT

               Begin DoDot:1

 +3                FOR

                       SET DGREV=$ORDER(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV))

                       if 'DGREV

                           QUIT

                       Begin DoDot:2

 +4                        FOR

                               SET DGBR=$ORDER(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV,DGBR))

                               if 'DGBR

                                   QUIT

                               DO CHKREV

                               if IBCHK

                                   DO STORREV

                       End DoDot:2

               End DoDot:1

 +5        QUIT

CHKREV    ;check if billing rate (dgbr) is active, and use with payer.

 +1        SET IBCHK=0

 +2       ;quit if inactive

           SET DGBRN=^DGCR(399.5,DGBR,0)

           IF '$PIECE(DGBRN,"^",5)

               QUIT

 +3       ;quit if non-standard rate

           IF IBIDS(.11)="i"

               IF $PIECE(DGINPAR,"^",2)=""

                   IF +$PIECE(DGBRN,"^",7)

                       QUIT

 +4       ;non-standard rates only for ins.

           IF IBIDS(.11)'="i"

               IF +$PIECE(DGBRN,"^",7)

                   QUIT

 +5       ;quit if revenue code not in exception list

           SET DGREV00="00"_DGREV

           IF IBIDS(.11)="i"

               IF $PIECE(DGINPAR,"^",2)]""

                   IF $PIECE(DGINPAR,"^",2)'[$EXTRACT(DGREV00,$LENGTH(DGREV00)-2,$LENGTH(DGREV00))

                       QUIT

 +6        IF $PIECE(DGBRN,U,6)[IBIDS(.11)

               if '$DATA(DGFND)

                   SET DGFND=""

               SET IBCHK=1

               QUIT

 +7        QUIT

STORREV   ;store revenue code in revenue code file

 +1        SET X=$PIECE(^DGCR(399.5,DGBR,0),"^",3)

           SET DGAMNT=$PIECE(^(0),"^",4)

           SET DA(1)=IBIFN

           SET DIC(0)="L"

           SET DIC="^DGCR(399,IBIFN,""RC"","

           SET DGFUNC="Adding"

 +2        IF $DATA(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI))

               SET DA=$ORDER(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI,0))

               SET DGFUNC="Editing"

               GOTO EDITREV

 +3        DO FILE

           DO WRT

 +4        QUIT

 +5       ;

FILE      ;manually file entry, index with ix1^dik to use compiled x-ref

 +1        IF '$DATA(DGREVHDR)

               DO REVHDR

 +2        IF IBIDS(.11)="c"

               IF IBIDS(.05)<3

                   SET DGBSLOS=1

 +3        LOCK ^DGCR(399,IBIFN):1

 +4        SET DA=$PIECE(^DGCR(399,IBIFN,"RC",0),"^",3)

 +5        FOR DGLL=0:0

               SET DA=DA+1

               if '$DATA(^DGCR(399,IBIFN,"RC",DA,0))

                   QUIT

 +6       ;S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_$S($D(DGPROC)&($D(DGDIV)):"^"_DGPROC_"^"_DGDIV,1:"")

 +7        SET ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_"^"_$GET(DGPROC)_"^"_$GET(DGDIV)_"^"_1

 +8        SET ^DGCR(399,IBIFN,"RC",0)=$PIECE(^DGCR(399,IBIFN,"RC",0),"^",1,2)_"^"_DA_"^"_($PIECE(^DGCR(399,IBIFN,"RC",0),"^",4)+1)

 +9        SET DIK="^DGCR(399,"_DA(1)_",""RC"","

           DO IX1^DIK

           LOCK ^DGCR(399,IBIFN):1

 +10       QUIT

 +11      ;

EDITREV   ;edit revenue code data.

 +1        IF '$DATA(DGREVHDR)

               DO REVHDR

 +2       ; IB*2.0*447 BI

           IF $PIECE(^DGCR(399,IBIFN,"RC",DA,0),U,16)

               QUIT

 +3        IF IBIDS(.11)="c"

               IF IBIDS(.05)<3

                   SET DGBSLOS=1

 +4        SET DIE=DIC

           SET DA(1)=IBIFN

           SET DR=".02///"_DGAMNT_";.03///"_DGBSLOS_";.05///"_DGBS

           DO ^DIE

 +5       ;

WRT       ;S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3) W:'$G(IBAUTO) !,DGFUNC,?12,$E(Z,($L(Z)-2),$L(Z)),?24,DGBSLOS,?31,"$",$J(DGAMNT,8,2),?44,DGBS

 +1        SET Z="00"_$PIECE(^DGCR(399.5,DGBR,0),"^",3)

 +2        if '$GET(IBAUTO)

               WRITE !,DGFUNC,?12,$EXTRACT(Z,($LENGTH(Z)-2),$LENGTH(Z)),?24,DGBSLOS,?31,"$",$JUSTIFY(DGAMNT,8,2),?44,DGBS

           IF +$GET(DGPROC)

               WRITE ?65,$PIECE($$CPT^ICPTCOD(+DGPROC),U,2)

 +3        QUIT

REVHDR     SET DGREVHDR=1

           if '$GET(IBAUTO)

               WRITE !,"Updating Revenue Codes",!?10,"REV. CODE",?22,"UNITS",?31,"CHARGE",?44,"BEDSECTION"

           IF $DATA(DGPROC)

               if '$GET(IBAUTO)

                   WRITE ?65,"PROCEDURE"

IBCU62.m