| 1 | IBATEI1 ;ALB/BGA- TRANSFER PRICING BACKGROUND JOB ; 20-MAR-99
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
|
|---|
| 3 | ;; Per VHA Directive 10-93-142, this routine should not be modified
|
|---|
| 4 | ;
|
|---|
| 5 | BACKGRD ; This is the back ground job that monitors all the entries in 351.61
|
|---|
| 6 | ; If the entry is complete we check to see if there is a closed entry
|
|---|
| 7 | ; in PTF if there is we price the claim and change the status of
|
|---|
| 8 | ; the entry to priced.
|
|---|
| 9 | ;
|
|---|
| 10 | ; do prosthetics first
|
|---|
| 11 | D ^IBATER
|
|---|
| 12 | ;
|
|---|
| 13 | N IBI,IBREC,IBIAT,IBREST,IBPTF,IBTDFN,IBREC,IBDISHG,IBDPM,IBRECN,IBFINDRT,IBTFILE
|
|---|
| 14 | I '$P($G(^IBE(350.9,1,10)),"^",2) Q ; transfer pricing turned off
|
|---|
| 15 | S IBREC="^IBAT(351.61,"_"""AF"""_","_"""C"""_")"
|
|---|
| 16 | F S IBREC=$Q(@IBREC) Q:IBREC=""!($P(IBREC,",",3)'="""C""") D
|
|---|
| 17 | . S IBIAT=$P($P(IBREC,",",4),")")
|
|---|
| 18 | . S IBRECN=$G(^IBAT(351.61,IBIAT,0))
|
|---|
| 19 | . S IBTDFN=$P(IBRECN,U,2)
|
|---|
| 20 | . S IBPTF=$P($G(^IBAT(351.61,+IBIAT,1)),U,7) Q:'IBPTF ;ien ptf
|
|---|
| 21 | . S IBDISHG=$P($G(^IBAT(351.61,+IBIAT,1)),U,8) ; ien 405 discharge date Q:'IBIDSHG
|
|---|
| 22 | . S IBDPM=$P($G(^DGPM(+IBDISHG,0)),U,14) ; pointer to the parent movement
|
|---|
| 23 | . Q:IBDPM<1 ; No Movement Found
|
|---|
| 24 | . ; Inorder to price we need to have a closed PTF
|
|---|
| 25 | . I $P($G(^DGPT(IBPTF,0)),U,6)<1 Q
|
|---|
| 26 | . ; Pass in PTF=IBPTF ; ien DGPM (parent) ; DFN
|
|---|
| 27 | . S IBFINDRT=$$FINDRT^IBATEI(IBPTF,IBDPM,IBTDFN)
|
|---|
| 28 | . Q:'$P(IBFINDRT,U)
|
|---|
| 29 | . I $P(IBFINDRT,U,3)="B" D Q
|
|---|
| 30 | . . ; case of bedsection pass in ien 351.61,"0" for drg, the value of bed section charge
|
|---|
| 31 | . . S IBTFILE=$$INPT^IBATFILE(IBIAT,0,$P(IBFINDRT,U,2),"","","","")
|
|---|
| 32 | . E D
|
|---|
| 33 | . . ; pass in ien 351.61,ien drg,drg value,los,high trim,outlier days,outlier rate
|
|---|
| 34 | . . S IBTFILE=$$INPT^IBATFILE(IBIAT,$P(IBFINDRT,U,3),$P(IBFINDRT,U,2),$P(IBFINDRT,U,4),$P(IBFINDRT,U,5),$P(IBFINDRT,U,6),$P(IBFINDRT,U,7))
|
|---|
| 35 | Q
|
|---|
