Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBATEI1

IBATEI1.m

Go to the documentation of this file.
  1. IBATEI1 ;ALB/BGA- TRANSFER PRICING BACKGROUND JOB ; 20-MAR-99
  1. ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
  1. ;; Per VHA Directive 10-93-142, this routine should not be modified
  1. ;
  1. 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
  1. ; in PTF if there is we price the claim and change the status of
  1. ; the entry to priced.
  1. ;
  1. ; do prosthetics first
  1. D ^IBATER
  1. ;
  1. N IBI,IBREC,IBIAT,IBREST,IBPTF,IBTDFN,IBREC,IBDISHG,IBDPM,IBRECN,IBFINDRT,IBTFILE
  1. I '$P($G(^IBE(350.9,1,10)),"^",2) Q ; transfer pricing turned off
  1. S IBREC="^IBAT(351.61,"_"""AF"""_","_"""C"""_")"
  1. F S IBREC=$Q(@IBREC) Q:IBREC=""!($P(IBREC,",",3)'="""C""") D
  1. . S IBIAT=$P($P(IBREC,",",4),")")
  1. . S IBRECN=$G(^IBAT(351.61,IBIAT,0))
  1. . S IBTDFN=$P(IBRECN,U,2)
  1. . S IBPTF=$P($G(^IBAT(351.61,+IBIAT,1)),U,7) Q:'IBPTF ;ien ptf
  1. . S IBDISHG=$P($G(^IBAT(351.61,+IBIAT,1)),U,8) ; ien 405 discharge date Q:'IBIDSHG
  1. . S IBDPM=$P($G(^DGPM(+IBDISHG,0)),U,14) ; pointer to the parent movement
  1. . Q:IBDPM<1 ; No Movement Found
  1. . ; Inorder to price we need to have a closed PTF
  1. . I $P($G(^DGPT(IBPTF,0)),U,6)<1 Q
  1. . ; Pass in PTF=IBPTF ; ien DGPM (parent) ; DFN
  1. . S IBFINDRT=$$FINDRT^IBATEI(IBPTF,IBDPM,IBTDFN)
  1. . Q:'$P(IBFINDRT,U)
  1. . I $P(IBFINDRT,U,3)="B" D Q
  1. . . ; case of bedsection pass in ien 351.61,"0" for drg, the value of bed section charge
  1. . . S IBTFILE=$$INPT^IBATFILE(IBIAT,0,$P(IBFINDRT,U,2),"","","","")
  1. . E D
  1. . . ; pass in ien 351.61,ien drg,drg value,los,high trim,outlier days,outlier rate
  1. . . 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))
  1. Q