source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCU61.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1IBCU61 ;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 ;
7ALL ;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
14DEL S DIK="^DGCR(399,"_DA(1)_",""RC""," D ^DIK L ^DGCR(399,IBIFN):1
15 Q
16 ;
17GVAR ;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 ;
32CAT ;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
Note: See TracBrowser for help on using the repository browser.