| 1 | IBCU61 ;ALB/AAS - DELETE ENTRIES IN REVENUE CODE MULT. ; 4-MAY-90
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRU61
|
|---|
| 6 | ;
|
|---|
| 7 | ALL ;delete all revenue codes that may have been set up automatically
|
|---|
| 8 | ;ie = $d(^IB(399.5,"d",code ifn))
|
|---|
| 9 | K DA S DA(1)=IBIFN,DA=0 I '$G(IBAUTO) W !,"Removing old Revenue Codes."
|
|---|
| 10 | F DGII=0:0 S DA=$O(^DGCR(399,IBIFN,"RC",DA)) Q:DA<1 S X=$G(^DGCR(399,IBIFN,"RC",DA,0)) D
|
|---|
| 11 | . ;remove revenue codes pre-defined for automatic use AND revenue codes for BASC charges (are automatically created)
|
|---|
| 12 | . I $D(^DGCR(399.5,"D",+$P(X,"^")))!($D(^DGCR(399,"ASC1",+$P(X,U,6),IBIFN)))!(+$P(X,U,8)) W:'$G(IBAUTO) "." D DEL
|
|---|
| 13 | Q
|
|---|
| 14 | DEL S DIK="^DGCR(399,"_DA(1)_",""RC""," D ^DIK L ^DGCR(399,IBIFN):1
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | GVAR ;I $D(PTF),PTF]"",$D(^DGPT(PTF,0)),'$P(^DGPT(PTF,0),"^",6),$D(DGPTUPDT) D UPDT^DGPTUTL S DGPTUPDT="" ;if open, update ptf record
|
|---|
| 18 | S IBND0=$S('$D(^DGCR(399,IBIFN,0)):"",1:^(0))
|
|---|
| 19 | S IBNDU=$S('$D(^DGCR(399,IBIFN,"U")):"",1:^("U"))
|
|---|
| 20 | I '$D(IBIDS(.03)) S IBIDS(.03)=$P(IBND0,"^",3)
|
|---|
| 21 | I '$D(IBIDS(.05)) S IBIDS(.05)=$P(IBND0,"^",5)
|
|---|
| 22 | I '$D(IBIDS(.06)) S IBIDS(.06)=$P(IBND0,"^",6)
|
|---|
| 23 | I '$D(IBIDS(.11)) S IBIDS(.11)=$P(IBND0,"^",11)
|
|---|
| 24 | I '$D(IBIDS(.19)) S IBIDS(.19)=$P(IBND0,"^",19)
|
|---|
| 25 | I '$D(IBIDS(151)) S IBIDS(151)=$S(+IBNDU:+IBNDU,1:IBIDS(.03))
|
|---|
| 26 | I '$D(IBIDS(152)) S IBIDS(152)=$S(+$P(IBNDU,"^",2):$P(IBNDU,"^",2),1:IBIDS(.03))
|
|---|
| 27 | I '$D(IBIDS(101)),IBIDS(.11)="i",$D(^DGCR(399,IBIFN,"M")),+^("M"),$D(^DIC(36,+^("M"),0)) S IBIDS(101)=+^DGCR(399,IBIFN,"M")
|
|---|
| 28 | I IBIDS(.11)="i",'$D(IBIDS(101)) S IBQUIT=1 Q
|
|---|
| 29 | ;I IBIDS(.11)="i" S DGINPAR=$S('$D(^DIC(36,+IBIDS(101),0)):"",1:$P(^(0),"^",6,10))
|
|---|
| 30 | I IBIDS(.11)="i" S DGINPAR=$S('$D(^DIC(36,+IBIDS(101),0)):"",1:$P(^(0),"^",6,15))
|
|---|
| 31 | ;
|
|---|
| 32 | CAT ;check patient bills to see if Means Test. set IBIDS(.11)="y" (yes)
|
|---|
| 33 | ;I IBIDS(.11)="p",$P(^PRCA(430.2,$P(^DGCR(399.3,$P(^DGCR(399,IBIFN,0),"^",7),0),"^",6),0),"^",6)="C" S IBIDS(.11)="c"
|
|---|
| 34 | I IBIDS(.11)="p",$P($$CATN^PRCAFN(+$P(^DGCR(399.3,+$P(^DGCR(399,IBIFN,0),"^",7),0),"^",6)),"^",3)="C" S IBIDS(.11)="y"
|
|---|
| 35 | Q
|
|---|
