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

IB20P510.m

Go to the documentation of this file. 
  1. IB20P510 ;ALB/CXW - IB*2.0*510 RATE SCHEDULE & NON-BILLABLE REASON ; 09/25/2013 
  1.  ;;2.0;INTEGRATED BILLING;**510**;21-MAR-94;Build 26
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. POST ; Post-install of patch installation 
  1.  D MES^XPDUTL("IB*2.0*510 Post-Install starts...")
  1.  D ADM,RNB
  1.  D MES^XPDUTL("IB*2.0*510 Post-Install is complete.")
  1.  Q
  1.  ;
  1. ADM ; Update national rate schedules to file (#363)
  1.  N IBADFE,IBADJUST,IBCT,IBDISP,IBEFFDT,IBNM,IBRATY,IBRTN,IBT,IBX,IBY
  1.  S IBADFE="",IBCT=0
  1.  D MES^XPDUTL("  Updating national rate Schedules with administrative fee:")
  1.  F IBX=1:1 S IBT=$P($T(RSF+IBX),";",3) Q:'$L(IBT)  D
  1.  . S IBNM=$P(IBT,U)
  1.  . S IBRATY=$P(IBT,U,2)
  1.  . S IBRTN=$O(^DGCR(399.3,"B",IBRATY,0))
  1.  . S IBDISP=$P(IBT,U,3)
  1.  . S IBADJUST=$P(IBT,U,4)
  1.  . S IBEFFDT=$P(IBT,U,5)
  1.  . I $$RSEXIST(IBEFFDT,IBNM) D MES^XPDUTL("    >>>"_IBNM_" for "_IBRATY_" already exists") Q
  1.  . I 'IBRTN D MES^XPDUTL("    >>>"_IBRATY_" rate type not defined, "_IBNM_" rate schedule not created") Q
  1.  . ; latest ien if rate type has multiple
  1.  . I $P($G(^DGCR(399.3,+IBRTN,0)),U,3) S IBRTN=$O(^DGCR(399.3,"B",IBRATY,99999),-1)
  1.  . I $P($G(^DGCR(399.3,+IBRTN,0)),U,3) D MES^XPDUTL("    >>>"_IBRATY_" rate type not active, "_IBNM_" not created") Q
  1.  . ;
  1.  . D ENT^IB3PSOU(IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST)
  1.  . ;
  1.  . I $$RSEXIST(IBEFFDT,IBNM) S IBCT=IBCT+1 D MES^XPDUTL("    >>>"_IBNM_" for "_IBRATY_" rate schedule added")
  1.  D MES^XPDUTL("  Total "_IBCT_$S(IBCT=1:" entry",1:" entries")_" updated in the file (#363)")
  1.  D MES^XPDUTL(" ")
  1. ADMQ Q
  1.  ;
  1. RSEXIST(IBEFFDT,IBNM) ; return RS IFN if Rate Schedule exists for Effective Date
  1.  N IBX,IBRSFN,IBRS0 S IBX=0
  1.  S IBRSFN=0 F  S IBRSFN=$O(^IBE(363,IBRSFN))  Q:'IBRSFN  D  I IBX Q
  1.  . S IBRS0=$G(^IBE(363,IBRSFN,0))
  1.  . I $P(IBRS0,U,1)=IBNM,$P(IBRS0,U,5)=IBEFFDT S IBX=IBRSFN
  1.  Q IBX
  1.  ;
  1. RNB ; Inactivate existing standard RNB in file (#356.8)
  1.  N X,Y,DA,DIE,DR,IBCONM,IBCT,IBNM,IBRNB,IBRNB0,IBT,IBX S IBCT=0
  1.  D MES^XPDUTL("  Inactivating entries of Claims Tracking non-billable reasons:")
  1.  F IBX=1:1 S IBT=$P($T(OCODE+IBX),";",3) Q:'$L(IBT)  D
  1.  . S IBCONM=$P(IBT,U,1)_" for "_$P(IBT,U,2)
  1.  . S IBNM=$P(IBT,U,2)
  1.  . S IBRNB=$O(^IBE(356.8,"B",IBNM,0))
  1.  . S IBRNB0=$G(^IBE(356.8,+IBRNB,0))
  1.  . I 'IBRNB D MES^XPDUTL("    >>>"_IBCONM_" not found") Q
  1.  . I +$P(IBRNB0,U,5) D MES^XPDUTL("    >>>"_IBCONM_" is already inactive") Q 
  1.  . ; inactivate code and clean up ecme flags
  1.  . S DIE="^IBE(356.8,",DA=+IBRNB,DR=".02///@;.03///@;.05///1" D ^DIE
  1.  . S IBCT=IBCT+1 D MES^XPDUTL("    >>>"_IBCONM_" inactivated")
  1.  D MES^XPDUTL("  Total "_IBCT_$S(IBCT=1:" entry",1:" entries")_" updated in the file (#356.8)")
  1. RNBQ Q
  1.  ;
  1. RSF ; name^rate type^dispensing fee^adjustment^effective date
  1.  ;;INELIG-RX^INELIGIBLE^13.18^S X=X+13.18^3130813
  1.  ;;HMN-RX^HUMANITARIAN^13.18^S X=X+13.18^3130813
  1.  ;
  1. OCODE ; code^name^ecme flag^ecme paper flag
  1.  ;;CV25^HDHP PLAN NOT BILLED^1^0
  1.  ;