| 1 | IBCRHBRB ;ALB/ARH - RATES: UPLOAD RC V1.4 MOVE LAB CODES ; 06-JAN-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**169**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; move selected Lab procedure RC V1.4 charges from Physician file to Outpatient Facility file
|
|---|
| 6 | ; although the charges are calculated as Physician charges they usually should be billed on the UB-92
|
|---|
| 7 | ;
|
|---|
| 8 | LAB ; move selected RV v1.4 Lab charges from Physician to Facility charge sets
|
|---|
| 9 | N IBXRF,IBOX2,IBOX3,IBPHYS,IBPX2,IBPX3,IBLINE,IBCNT S IBCNT=0
|
|---|
| 10 | ;
|
|---|
| 11 | I $G(^XTMP("IBCR RC SITE","VERSION"))'=1.4 Q
|
|---|
| 12 | ;
|
|---|
| 13 | S IBXRF=$O(^XTMP("IBCR UPLOAD RC ")) I IBXRF'["IBCR UPLOAD RC " Q
|
|---|
| 14 | ;
|
|---|
| 15 | I '$D(ZTQUEUED) W !!,"Moving Lab charges from Physician to Facility Charge Sets ... "
|
|---|
| 16 | ;
|
|---|
| 17 | S IBOX2="Opt Fac",IBOX3=$O(^XTMP(IBXRF,IBOX2,999999999999),-1)
|
|---|
| 18 | ;
|
|---|
| 19 | S IBPHYS="Phys Fee "
|
|---|
| 20 | S IBPX2=IBPHYS F S IBPX2=$O(^XTMP(IBXRF,IBPX2)) Q:IBPX2'[IBPHYS D
|
|---|
| 21 | . S IBPX3="" F S IBPX3=$O(^XTMP(IBXRF,IBPX2,IBPX3)) Q:IBPX3="" D
|
|---|
| 22 | .. S IBLINE=$G(^XTMP(IBXRF,IBPX2,IBPX3)) Q:IBLINE=""
|
|---|
| 23 | .. I '$$MOVE($P(IBLINE,U,1)) Q
|
|---|
| 24 | .. ;
|
|---|
| 25 | .. S IBOX3=IBOX3+1,IBCNT=IBCNT+1
|
|---|
| 26 | .. S $P(^XTMP(IBXRF,IBOX2),U,1)=$P(^XTMP(IBXRF,IBOX2),U,1)+1
|
|---|
| 27 | .. S ^XTMP(IBXRF,IBOX2,IBOX3)=IBLINE
|
|---|
| 28 | .. ;
|
|---|
| 29 | .. S $P(^XTMP(IBXRF,IBPX2),U,1)=$P(^XTMP(IBXRF,IBPX2),U,1)-1
|
|---|
| 30 | .. K ^XTMP(IBXRF,IBPX2,IBPX3)
|
|---|
| 31 | ;
|
|---|
| 32 | I '$D(ZTQUEUED) W IBCNT," charges moved"
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | MOVE(CPT) ; return true if the Lab (8xxxx) code should be moved to the facility charge file
|
|---|
| 36 | ;
|
|---|
| 37 | N IBCPTX,MOVE S MOVE=0
|
|---|
| 38 | I $E($G(CPT))=8,CPT?5N S MOVE=1,IBCPTX=","_$G(CPT)_","
|
|---|
| 39 | I 'MOVE G MOVEQ
|
|---|
| 40 | ;
|
|---|
| 41 | I ",80500,80502,83020,83912,84165,84181,84182,85060,85097,85390,85576,"[IBCPTX S MOVE=0 G MOVEQ
|
|---|
| 42 | I ",86077,86078,86079,86255,86256,86320,86325,86327,86334,87164,87207,"[IBCPTX S MOVE=0 G MOVEQ
|
|---|
| 43 | I ",88141,88291,"[IBCPTX S MOVE=0 G MOVEQ
|
|---|
| 44 | ;
|
|---|
| 45 | I CPT'<88000,CPT'>88130 S MOVE=0 G MOVEQ
|
|---|
| 46 | I CPT'<88160,CPT'>88162 S MOVE=0 G MOVEQ
|
|---|
| 47 | I CPT'<88172,CPT'>88182 S MOVE=0 G MOVEQ
|
|---|
| 48 | I CPT'<88300,CPT'>88372 S MOVE=0 G MOVEQ
|
|---|
| 49 | I CPT'<89060,CPT'>89105 S MOVE=0 G MOVEQ
|
|---|
| 50 | I CPT'<89130,CPT'>89141 S MOVE=0 G MOVEQ
|
|---|
| 51 | MOVEQ Q MOVE
|
|---|
