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