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

IB20P686.m

Go to the documentation of this file.
  1. IB20P686 ;ALB/CXW - REACTIVATE 11 REASONS NOT BILLABLE; 08/12/2020
  1. ;;2.0;INTEGRATED BILLING;**686**;21-MAR-94;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. POST ; Reactivate 11 RNBs that were requested to be deactivated with IB*2.0*673.
  1. N IBZ,U S U="^"
  1. D BMSG(" IB*2.0*686 Post-Install starts .....")
  1. D RNB
  1. D BMSG(" IB*2.0*686 Post-Install is complete.")
  1. Q
  1. ;
  1. RNB ; RNB in INACTIVE fields #.05/piece 5
  1. N IBA,IBB,IBC,IBCNT,IBD,IBE,IBI,IBX,IBY,DA,DIE,DR,X,Y
  1. S IBCNT=0
  1. D BMSG(" >> Reactivating Reason Not Billable (RNB)")
  1. F IBI=1:1 S IBX=$P($T(RARNB+IBI),";;",2) Q:IBX="Q" D
  1. . S IBA=$P(IBX,U),IBB=$P(IBX,U,2)
  1. . S IBC=" "_IBA_" "_IBB
  1. . S IBD=+$O(^IBE(356.8,"B",IBB,0))
  1. . I 'IBD D MSG(IBC_" not found") Q
  1. . S IBE=$G(^IBE(356.8,IBD,0)) Q:IBE=""
  1. . I '$P(IBE,U,5) D MSG(IBC_" not reactivated") Q
  1. . S DA=IBD,DIE="^IBE(356.8,",DR=".05///@" D ^DIE
  1. . S IBCNT=IBCNT+1 D MSG(IBC)
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in CLAIMS TRACKING NON-BILLABLE REASONS (#356.8) file")
  1. Q
  1. ;
  1. BMSG(IBZ) ;
  1. D BMES^XPDUTL(IBZ)
  1. Q
  1. ;
  1. MSG(IBZ) ;
  1. D MES^XPDUTL(IBZ)
  1. Q
  1. ;
  1. RARNB ; RNB code^name (11)
  1. ;;CV13^NO OUTPATIENT COVERAGE
  1. ;;CV14^NO INPATIENT COVERAGE
  1. ;;CV15^NO PHARMACY COVERAGE
  1. ;;CV16^NO DENTAL COVERAGE
  1. ;;CV17^NO MENTAL HEALTH COVERAGE
  1. ;;CV18^NO LTC COVERAGE
  1. ;;CV21^NO VISION COVERAGE
  1. ;;CV22^NO PROSTHETIC COVERAGE
  1. ;;MC01^NON-BILLABLE APPOINTMENT TYPE
  1. ;;MC03^NON-BILLABLE STOP CODE
  1. ;;MC05^NON-BILLABLE CLINIC
  1. ;;Q