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

IB20P673.m

Go to the documentation of this file.
  1. IB20P673 ;ALB/CXW - MCCR UTILITY/REVENUE/RNB UPDATES FOR 2020 ;04/20/2020
  1. ;;2.0;INTEGRATED BILLING;**673**;21-MAR-94;Build 10
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. POST ;
  1. ; Update value/condition/revenue/RNB for 2020 in files 399.1/399.2/356.8
  1. N IBZ,U S U="^"
  1. D BMSG(" IB*2.0*673 Post-Install starts .....")
  1. D MCR,RVC,RNB
  1. D BMSG(" IB*2.0*673 Post-Install is complete.")
  1. Q
  1. ;
  1. MCR ; Two types of codes
  1. N IBCNT,IBPE,IBFD,IBI,IBX
  1. ; value code flag in field #.18/piece 11
  1. S IBCNT=0,IBPE=11,IBFD=.18
  1. D BMSG(" >> Adding Value Code")
  1. F IBI=1:1 S IBX=$P($T(VALU+IBI),";;",2) Q:IBX="Q" D MFILE
  1. ; condition code flag in field #.22/piece 15
  1. S IBPE=15,IBFD=.22
  1. D BMSG(" >> Adding Condition Code")
  1. F IBI=1:1 S IBX=$P($T(CONU+IBI),";;",2) Q:IBX="Q" D MFILE
  1. ;
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" added to MCCR UTILITY (#399.1) file")
  1. Q
  1. ;
  1. MFILE ; Store in fields
  1. N IBA,IBB,IBC,IBFN,IBMS,IBX3,IBY,DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y
  1. S IBA=$P(IBX,U),IBB=$P(IBX,U,2)
  1. S IBY=" "_IBA_" "_IBB
  1. S IBFN=+$$EXCODE(IBA,IBPE)
  1. I IBFN D Q:'IBFN
  1. . S IBX3=$G(^DGCR(399.1,IBFN,0)),IBC=IBB_U_IBA
  1. . I $P(IBX3,U,1,2)=IBC S IBFN=0 D MSG(IBY_" not re-added") Q
  1. . ; if new code already exists
  1. . S DA=IBFN,IBMS="updated"
  1. I 'IBFN D Q:Y<1
  1. . S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=IBB D FILE^DICN
  1. . I Y<1 D MSG(" >> ERROR when adding "_$S(IBPE=11:"Value",1:"Condition")_" Code #"_IBA_" to the #399.1 file, Log a ticket!") Q
  1. . S DA=+Y,IBMS=""
  1. S DIE="^DGCR(399.1,",DR=".01///"_IBB_";.02///"_IBA_";"_IBFD_"///1" D ^DIE
  1. S IBCNT=IBCNT+1 D MSG(IBY_$S(IBMS'="":" "_IBMS,1:""))
  1. Q
  1. ;
  1. EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
  1. N IBX,IBY S IBY=""
  1. I $G(IBCOD)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"C",IBCOD,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
  1. Q IBY
  1. ;
  1. RVC ; Revenue code in fields #1/piece 2, #2/piece 3, #3/piece 4
  1. N IBA,IBB,IBC,IBCNT,IBD,IBF,IBI,IBMS,IBX,IBY,IBX3,DA,DIE,DR,X,Y
  1. S IBCNT=0
  1. D BMSG(" >> Activating Revenue Code")
  1. F IBI=1:1 S IBX=$P($T(RVCU+IBI),";;",2) Q:IBX="Q" D
  1. . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3)
  1. . S IBY=" "_IBA_" "_IBC,IBD=IBA_U_IBB_U_1_U_IBC
  1. . S IBF=+$O(^DGCR(399.2,"B",IBA,0)) Q:'IBF
  1. . S IBX3=$G(^DGCR(399.2,IBF,0))
  1. . I $P(IBX3,U,1,4)=IBD D MSG(IBY_" not re-activated") Q
  1. . S IBMS=$S($P(IBX3,U,2)="*RESERVED":"added",$P(IBX3,U,4)="*RESERVED":"added",1:"updated")
  1. . ;4 slashes to override the letter if '*' exists
  1. . S DR="1////"_IBB_";3////"_IBC_";2///1"
  1. . S DIE="^DGCR(399.2,",DA=+IBF D ^DIE
  1. . S IBCNT=IBCNT+1 D MSG(IBY)
  1. D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in REVENUE CODE(#399.2) file")
  1. Q
  1. ;
  1. RNB ; RNB in fields #.01/piece 1, #.02/piece 2, #.03/piece 3, #.04/piece 4, #.05/piece 5
  1. N IBA,IBB,IBC,IBCNT,IBD,IBE,IBF,IBI,IBX,IBY,IBX3,DA,DLAYGO,DIC,DIE,DINUM,DR,X,Y
  1. S IBCNT=0
  1. D BMSG(" >> Adding Reason Not Billable (RNB)")
  1. F IBI=1:1 S IBX=$P($T(NRNB+IBI),";;",2) Q:IBX="Q" D
  1. . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3),IBD=$P(IBX,U,4)
  1. . S IBY=" "_IBA_" "_IBB
  1. . S IBE=IBB_U_IBC_U_IBD_U_IBA
  1. . S IBF=+$O(^IBE(356.8,"B",IBB,0))
  1. . I IBF D Q:'IBF
  1. .. ; if new code already exists
  1. .. S IBX3=$G(^IBE(356.8,IBF,0)),DA=IBF,IBMS="updated"
  1. .. I $P(IBX3,U,1,4)=IBE S IBF=0 D MSG(IBY_" not re-added") Q
  1. . I 'IBF D Q:Y<1
  1. .. F IBF=100:1 S IBX3=$G(^IBE(356.8,IBF,0)) I IBX3="" S DINUM=IBF Q
  1. .. S DLAYGO=356.8,DIC="^IBE(356.8,",DIC(0)="L",X=IBB D FILE^DICN
  1. .. I Y<1 D MSG(" >> ERROR when adding "_IBY_" to the #356.8 file, log a ticket!") Q
  1. .. S DA=+Y,IBMS=""
  1. . S DIE="^IBE(356.8,",DR=".02///"_IBC_";.03///"_IBD_";.04///"_IBA D ^DIE
  1. . S IBCNT=IBCNT+1 D MSG(IBY_$S(IBMS'="":" "_IBMS,1:""))
  1. ;
  1. D BMSG(" >> Inactivating Reason Not Billable (RNB)")
  1. F IBI=1:1 S IBX=$P($T(IRNB+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 re-inactivated") Q
  1. . S DA=IBD,DIE="^IBE(356.8,",DR=".05///1" 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. VALU ; Value code^name (2)
  1. ;;87^GENE THERAPY INVOICE COST
  1. ;;90^CELL THERAPY INVOICE COST
  1. ;;Q
  1. CONU ; Condition code^name^update (1)
  1. ;;A7^HOSP SVCS PRVD IN A MBL FAC OR W PORT UNTS
  1. ;;Q
  1. RVCU ; Revenue code^standard abbreviation^description (1)
  1. ;;892^SPECIAL PROCESSED DRUGS^SPECIAL PROCESSED DRUGS
  1. ;;Q
  1. NRNB ; RNB code^name^ecme flag^ecme paper flag (7)
  1. ;;BL10^BILLING LIMITATIONS^0^0
  1. ;;CV30^NO COVERAGE^1^0
  1. ;;CV31^POLICY LIMITATIONS^1^0
  1. ;;DC20^DOCUMENTATION DOES NOT SUPPORT^0^0
  1. ;;MC30^NON-BILLABLE SERVICE^0^0
  1. ;;MN05^MEDICAL NECESSITY^1^0
  1. ;;RX20^RX LIMITATIONS^1^0
  1. ;;Q
  1. IRNB ; RNB code^name (54)
  1. ;;BL01^CHARGES SPLIT
  1. ;;BL08^COMBINED CHARGES
  1. ;;CV02^COVERAGE CANCELED
  1. ;;CV03^HMO POLICY
  1. ;;CV04^OUT OF NETWORK (PPO)
  1. ;;CV11^CONCURRENT CARE
  1. ;;CV12^CUSTODIAL/RESIDENTIAL CARE
  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. ;;DC01^NO DOCUMENTATION
  1. ;;DC02^NO TX PROVIDED/ADVICE ONLY
  1. ;;DC03^UNSIGNED DOCUMENT
  1. ;;DC04^NO DIAGNOSIS/SYMPTOMS IN NOTE
  1. ;;DC05^NO CHIEF COMPLAINT
  1. ;;DC06^NOTE NOT WRITTEN TIMELY
  1. ;;DC07^NO PHYSICIAN ORDER
  1. ;;DC08^NO PLAN OF CARE
  1. ;;DC09^STUDENT NOTE ONLY
  1. ;;DC10^NEW PT/NO HX
  1. ;;DC11^NEW PT/NO EXAM
  1. ;;DC12^NEW PT/NO COMPLEXITY
  1. ;;DC13^EST PT/NO HX/NO EXAM
  1. ;;DC14^EST PT/NO HX/NO COMPLEXITY
  1. ;;DC15^EST PT/NO EXAM/NO COMPLEXITY
  1. ;;MC01^NON-BILLABLE APPOINTMENT TYPE
  1. ;;MC02^REFUSES TO SIGN RELEASE (ROI)
  1. ;;MC03^NON-BILLABLE STOP CODE
  1. ;;MC04^RESEARCH VISIT
  1. ;;MC05^NON-BILLABLE CLINIC
  1. ;;MC08^GLOBAL SURGERY
  1. ;;MC10^DUPLICATE ENCOUNTER
  1. ;;MC11^TELEPHONE ENCOUNTER
  1. ;;MC13^72 HOUR RULE
  1. ;;MC14^RESIDENT SUPERVISION NOT MET
  1. ;;MC15^ANCILLARY PROVIDER AT CBOC
  1. ;;MC20^APPT CANCELLED/PT NOT SEEN
  1. ;;MC21^SEEN BY PROVIDER ON SAME DAY
  1. ;;MC22^NON-BILLABLE DME/PROSTHETIC
  1. ;;MC23^NON-BILLABLE PROCEDURE
  1. ;;MC25^ENCOUNTER DURING INPT STAY
  1. ;;MN01^MED NEC-DX NOT COVERED
  1. ;;MN02^MED NEC-CPT NOT COVERED
  1. ;;MN03^MED NEC-LCD EDIT
  1. ;;MN04^MED NEC-OTHER
  1. ;;RX02^REFILL ON VISIT DATE
  1. ;;RX08^INVALID MULTIPLES PER DAY SUPP
  1. ;;RX14^RX MEDICARE PART D
  1. ;;RX15^RX DISCOUNT CARD
  1. ;;Q