| [613] | 1 | IBCU62 ;ALB/AAS - UTILITY ROUTINE TO SET BEDSECTION/REVENUE CODES FROM PTF DATA ; 29-OCT-90 | 
|---|
|  | 2 | ;;2.0;INTEGRATED BILLING;**133**;21-MAR-94 | 
|---|
|  | 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
|  | 4 | ; | 
|---|
|  | 5 | ;MAP TO DGCRU62 | 
|---|
|  | 6 | ; | 
|---|
|  | 7 | SETREV ;find current active revenue codes for bedsection | 
|---|
|  | 8 | S (DGREV,DGBR)=0,DGACTDT=-(IBIDS(151)+.01) K DGFND | 
|---|
|  | 9 | F  S DGACTDT=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT)) Q:'DGACTDT!($D(DGFND))  D | 
|---|
|  | 10 | . F  S DGREV=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV)) Q:'DGREV  D | 
|---|
|  | 11 | .. F  S DGBR=$O(^DGCR(399.5,"AIVDT",DGBSI,DGACTDT,DGREV,DGBR)) Q:'DGBR  D CHKREV,STORREV:IBCHK | 
|---|
|  | 12 | Q | 
|---|
|  | 13 | CHKREV ;check if billing rate (dgbr) is active, and use with payer. | 
|---|
|  | 14 | S IBCHK=0 | 
|---|
|  | 15 | S DGBRN=^DGCR(399.5,DGBR,0) I '$P(DGBRN,"^",5) Q  ;quit if inactive | 
|---|
|  | 16 | I IBIDS(.11)="i",$P(DGINPAR,"^",2)="",+$P(DGBRN,"^",7) Q  ;quit if non-standard rate | 
|---|
|  | 17 | I IBIDS(.11)'="i",+$P(DGBRN,"^",7) Q  ;non-standard rates only for ins. | 
|---|
|  | 18 | 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 | 
|---|
|  | 19 | I $P(DGBRN,U,6)[IBIDS(.11) S:'$D(DGFND) DGFND="" S IBCHK=1 Q | 
|---|
|  | 20 | Q | 
|---|
|  | 21 | STORREV ;store revenue code in revenue code file | 
|---|
|  | 22 | 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" | 
|---|
|  | 23 | I $D(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI)) S DA=$O(^DGCR(399,IBIFN,"RC","ABS",X,DGBSI,0)),DGFUNC="Editing" G EDITREV | 
|---|
|  | 24 | D FILE,WRT | 
|---|
|  | 25 | Q | 
|---|
|  | 26 | ; | 
|---|
|  | 27 | FILE ;manually file entry, index with ix1^dik to use compiled x-ref | 
|---|
|  | 28 | I '$D(DGREVHDR) D REVHDR | 
|---|
|  | 29 | I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1 | 
|---|
|  | 30 | L ^DGCR(399,IBIFN):1 | 
|---|
|  | 31 | S DA=$P(^DGCR(399,IBIFN,"RC",0),"^",3) | 
|---|
|  | 32 | F DGLL=0:0 S DA=DA+1 Q:'$D(^DGCR(399,IBIFN,"RC",DA,0)) | 
|---|
|  | 33 | ;S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_$S($D(DGPROC)&($D(DGDIV)):"^"_DGPROC_"^"_DGDIV,1:"") | 
|---|
|  | 34 | S ^DGCR(399,IBIFN,"RC",DA,0)=X_"^"_DGAMNT_"^"_DGBSLOS_"^^"_DGBSI_"^"_$G(DGPROC)_"^"_$G(DGDIV)_"^"_1 | 
|---|
|  | 35 | S ^DGCR(399,IBIFN,"RC",0)=$P(^DGCR(399,IBIFN,"RC",0),"^",1,2)_"^"_DA_"^"_($P(^DGCR(399,IBIFN,"RC",0),"^",4)+1) | 
|---|
|  | 36 | S DIK="^DGCR(399,"_DA(1)_",""RC""," D IX1^DIK L ^DGCR(399,IBIFN):1 | 
|---|
|  | 37 | Q | 
|---|
|  | 38 | ; | 
|---|
|  | 39 | EDITREV ;edit revenue code data. | 
|---|
|  | 40 | I '$D(DGREVHDR) D REVHDR | 
|---|
|  | 41 | I IBIDS(.11)="c",IBIDS(.05)<3 S DGBSLOS=1 | 
|---|
|  | 42 | S DIE=DIC,DA(1)=IBIFN,DR=".02///"_DGAMNT_";.03///"_DGBSLOS_";.05///"_DGBS D ^DIE | 
|---|
|  | 43 | ; | 
|---|
|  | 44 | 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 | 
|---|
|  | 45 | S Z="00"_$P(^DGCR(399.5,DGBR,0),"^",3) | 
|---|
|  | 46 | 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) | 
|---|
|  | 47 | Q | 
|---|
|  | 48 | 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" | 
|---|