| [613] | 1 | IBCU6 ;ALB/AAS - UTILITY ROUTINE TO SET BEDSECTIONS/REVENUE CODES FROM PTF DATA ;25 MAY 90
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**14,52,138,245,155**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRU6
|
|---|
| 6 | ;
|
|---|
| 7 | % ;setup variables - needs IBifn
|
|---|
| 8 | ;K IBRSARR D BILL^IBCRBC(IBIFN,.IBRSARR)
|
|---|
| 9 | I $P($G(^DGCR(399,IBIFN,0)),U,13)'=1 Q ; Do not calculate bill charges if bill not in Entered/Not Reviewed status
|
|---|
| 10 | N X S X=$$PRCDIV^IBCU71(IBIFN) I '$D(ZTQUEUED),+X W !,$P(X,U,2) ; update bill default division
|
|---|
| 11 | S X=$$DVTYP^IBCU71(IBIFN) I '$D(ZTQUEUED),$P(X,U,2)'="" W !,$P(X,U,2) ; update bill charge type
|
|---|
| 12 | ;
|
|---|
| 13 | D BILL^IBCRBC(IBIFN) ; calculate bill charges
|
|---|
| 14 | ;
|
|---|
| 15 | D CPTMOD26^IBCU73(IBIFN) ; add cpt modifier 26 to professional bill
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | Q:'$D(^DGCR(399,IBIFN,0)) N IBQUIT S IBQUIT=0 K ^UTILITY($J) D GVAR^IBCU61 Q:IBQUIT
|
|---|
| 19 | I '$D(DFN) S DFN=$P(^DGCR(399,IBIFN,0),"^",2)
|
|---|
| 20 | I IBIDS(.05)<3 S PTF=$P(^DGCR(399,IBIFN,0),"^",8) Q:PTF']"" Q:'$D(^DGPT(PTF,0)) I '$P(^DGPT(PTF,0),"^",6),'$P(^(0),"^",4),'$D(DGPTUPDT) D UPDT^DGPTUTL S DGPTUPDT=""
|
|---|
| 21 | S DGADM=IBIDS(.03),DGPMCA=$O(^DGPM("AMV1",DGADM,DFN,0)) ;find corresponding admission
|
|---|
| 22 | D:$O(^DGCR(399,IBIFN,"RC",0)) ALL^IBCU61
|
|---|
| 23 | ;
|
|---|
| 24 | OPT ;I IBIDS(.05)>2 S DGBILLBS="OUTPATIENT VISIT",DGVISCNT=$S($D(^DGCR(399,IBIFN,"OP",0)):$P(^(0),U,4),1:""),^UTILITY($J,"IB-BS",DGBILLBS)=DGVISCNT G END:DGVISCNT<1 D G END:IBQUIT,3
|
|---|
| 25 | ;.I $D(^DGCR(399,IBIFN,"CP","ASC",1)) D ^IBCU63
|
|---|
| 26 | ;.;I $D(^UTILITY($J,"IB-ASC")) S IBQUIT=1
|
|---|
| 27 | I IBIDS(.05)>2 D G END:(DGVISCNT<1)!IBQUIT,3
|
|---|
| 28 | . S DGBILLBS="OUTPATIENT VISIT",DGVISCNT=$S($D(^DGCR(399,IBIFN,"OP",0)):$P(^(0),U,4),1:""),^UTILITY($J,"IB-BS",DGBILLBS)=DGVISCNT ; visit
|
|---|
| 29 | . I DGVISCNT>0,$D(^DGCR(399,IBIFN,"CP","ASC",1)) D ^IBCU63 ; basc
|
|---|
| 30 | . D SET^IBCSC5A(IBIFN,.IBX) S IBCNT=+$P(IBX,U,2) K IBX I +IBCNT D RX^IBCU63 ; rx refills
|
|---|
| 31 | ;
|
|---|
| 32 | 1 ;build array of movement dates, billable bedsections
|
|---|
| 33 | S DGMOVE=0 F DGII=0:0 S DGMOVE=$O(^DGPT(PTF,"M",DGMOVE)) Q:'DGMOVE D SETU
|
|---|
| 34 | ;
|
|---|
| 35 | 2 ;build array of billable bedsections = los in bedsection
|
|---|
| 36 | ;start with statement covers from date, end with statement covers to date
|
|---|
| 37 | S (DGMVDT,DGMVDTP)=$S($D(IBIDS(151)):IBIDS(151),1:IBIDS(.03)),(DGBS,DGBS1)=""
|
|---|
| 38 | ;
|
|---|
| 39 | S DGMVDT=DGMVDT+.3,IBMVDTE=IBIDS(152)\1
|
|---|
| 40 | I ",2,3,"'[IBIDS(.06) S IBMVDTE=IBMVDTE-.01 I IBIDS(151)=IBIDS(152) S DGMVDT=IBIDS(151)
|
|---|
| 41 | I +DGPMCA S DGII=$$AD^IBCU64(DGPMCA) I ($P(DGII,U,1)\1)=($P(DGII,U,2)\1) S DGMVDT=IBIDS(151),IBMVDTE=IBIDS(152)
|
|---|
| 42 | ;
|
|---|
| 43 | S DGMVDT=DGMVDT-.01 F DGII=0:0 S DGMVDT=$O(^UTILITY($J,"IB-PTF",DGMVDT)) Q:'DGMVDT!(DGMVDTP\1>IBIDS(152)) D SETU1 S DGMVDTP=DGMVDT Q:(DGMVDTP\1)>IBMVDTE
|
|---|
| 44 | ;
|
|---|
| 45 | 3 ;find revenue codes and set up in file.
|
|---|
| 46 | S DGBS=0 I '$D(^DGCR(399,IBIFN,"RC",0)) S ^DGCR(399,IBIFN,"RC",0)="^399.042PA"
|
|---|
| 47 | F DGII=0:0 S DGBS=$O(^UTILITY($J,"IB-BS",DGBS)) Q:DGBS']""!(IBQUIT) S DGBSLOS=^(DGBS),DGBSI=$O(^DGCR(399.1,"B",DGBS,0)) I DGBSI,$D(^DGCR(399.1,DGBSI,0)) D SETREV^IBCU62
|
|---|
| 48 | G END
|
|---|
| 49 | ;
|
|---|
| 50 | SETU ;utility array of all movements by date, billing bedsection
|
|---|
| 51 | ;non-billable bs's must be added to array so their days will not be added to a billable bs
|
|---|
| 52 | S X=^DGPT(PTF,"M",DGMOVE,0)
|
|---|
| 53 | S DGBILLBS=$P($G(^DIC(42.4,+$P(X,U,2),0)),U,5) I DGBILLBS="" S DGBILLBS="UNKNOWN"
|
|---|
| 54 | ;S DGBILLBS=$S('$P(X,U,2):"UNKNOWN",$D(^DIC(42.4,$P(X,U,2),0)):$P(^(0),U,5),1:"UNKNOWN") Q:DGBILLBS=""
|
|---|
| 55 | S ^UTILITY($J,"IB-PTF",$S($P(X,U,10)]"":$P(X,U,10),1:DT),DGBILLBS)=($P(X,U,3)+$P(X,U,4))_"^"_$P(X,U,18)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | SETU1 ;determine los - set utility=los
|
|---|
| 59 | S DGBS=$O(^UTILITY($J,"IB-PTF",DGMVDT,0)) Q:DGBS="UNKNOWN" S:DGBS1="" DGBS1=DGBS
|
|---|
| 60 | S DGEDT=$S(DGMVDT<IBIDS(152):DGMVDT,1:IBIDS(152)),DGBDT=$S(IBIDS(151)>DGMVDTP:IBIDS(151),1:DGMVDTP)
|
|---|
| 61 | S IBTF=$S(IBIDS(152)<(DGMVDT\1):IBIDS(.06),1:1)
|
|---|
| 62 | S X=$$LOS^IBCU64(DGBDT,DGEDT,IBTF,DGPMCA) Q:'X
|
|---|
| 63 | I $D(DGINPAR),$P(DGINPAR,"^")=0,(DGBS1'=DGBS) Q ;only one bedsection allowed by ins co
|
|---|
| 64 | I IBIDS(.11)="c",(DGBS1'=DGBS) Q
|
|---|
| 65 | I $P(^UTILITY($J,"IB-PTF",DGMVDT,DGBS),U,2)=1 Q ;treatment for sc condition
|
|---|
| 66 | S ^UTILITY($J,"IB-BS",DGBS)=+$G(^UTILITY($J,"IB-BS",DGBS))+X
|
|---|
| 67 | Q
|
|---|
| 68 | END I IBIDS(.11)="c" S IBIDS(.11)="p"
|
|---|
| 69 | K ^UTILITY($J),DGMOVE,DGMVDT,DGMVDTP,DGBS,DGBSLOS,DGBSI,DGBILLBS,DGBR,DGREC,DGII,DGJJ,DGKK,DGREVHDR,DGAMNT,DGREV,DGBS1,X,X1,X2,Y,Z,DGINPAR,DR,DIK,DGVISCNT,DGBRN,DGFUNC,DGACTDT,DGRVRCAL,DA,IBIDS,DGREV00
|
|---|
| 70 | K DGLL,DGFND,IBND0,IBNDU,DGPMCA,DGADM,DGEDT,DGBDT,DGMVTP,DGMVT,DGDC,DGNEXT,DGX,DGIFN,IBTF,IBCNT,IBCHK,IBMVDTE
|
|---|
| 71 | Q
|
|---|
