- IB20P791 ;ALB/AJR - RNB UPDATES FOR 2024 ;01/23/2024
- ;;2.0;INTEGRATED BILLING;**791**;21-MAR-94;Build 8
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; This routine is used as a post-init in a KIDS build to
- ; update the CLAIMS TRACKING NON-BILLABLE REASONS file (#356.8).
- Q
- POST ;
- ; Update RNB for 2024 in file #356.8
- ; Start of Install
- N IBZ,U S U="^"
- D BMSG(" IB*2.0*791 Post-Install starting .....")
- D RNB
- D BMSG(" IB*2.0*791 Post-Install is complete.")
- Q
- ;
- RNB ; RNB in fields #.01/piece 1, #.02/piece 2, #.03/piece 3, #.04/piece 4, #.05/piece 5
- N IBA,IBB,IBC,IBCNT,IBCNTA,IBCNTR,IBCNTD,IBCNTM,IBD,IBE,IBF,IBI,IBX,IBY,IBX3,DA,DLAYGO,DIC,DIE,DINUM,DR,X,Y
- S IBCNTA=0
- ;D BMSG(" >> Adding Reason Not Billable (RNB)")
- F IBI=1:1 S IBX=$P($T(NRNB+IBI),";;",2) Q:IBX="Q" D
- . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3),IBD=$P(IBX,U,4)
- . S IBY=" "_IBA_" "_IBB
- . S IBE=IBB_U_IBC_U_IBD_U_IBA
- . S IBF=+$O(^IBE(356.8,"B",IBB,0))
- . I IBF D Q:'IBF
- .. S IBX3=$G(^IBE(356.8,IBF,0)),DA=IBF,IBMS="updated"
- .. I $P(IBX3,U,1,4)=IBE S IBF=0 D MSG(IBY_" not re-added") Q
- . I 'IBF D Q:Y<1
- .. F IBF=100:1 S IBX3=$G(^IBE(356.8,IBF,0)) I IBX3="" S DINUM=IBF Q
- .. S DLAYGO=356.8,DIC="^IBE(356.8,",DIC(0)="L",X=IBB D FILE^DICN
- .. I Y<1 D MSG(" >> ERROR when adding "_IBY_" to the #356.8 file, log a ticket!") Q
- .. S DA=+Y,IBMS=""
- . S DIE="^IBE(356.8,",DR=".02///"_IBC_";.03///"_IBD_";.04///"_IBA D ^DIE
- . S IBCNTA=IBCNTA+1 D MSG(IBY_$S(IBMS'="":" "_IBMS,1:""))
- ;
- ;D BMSG(" >> Inactivating Reason Not Billable (RNB)")
- S IBCNTD=0
- F IBI=1:1 S IBX=$P($T(IRNB+IBI),";;",2) Q:IBX="Q" D
- . S IBA=$P(IBX,U),IBB=$P(IBX,U,2)
- . S IBC=" "_IBA_" "_IBB
- . S IBD=+$O(^IBE(356.8,"B",IBB,0))
- . I 'IBD D MSG(IBC_" not found") Q
- . S IBE=$G(^IBE(356.8,IBD,0)) Q:IBE=""
- . I $P(IBE,U,5) D MSG(IBC_" not re-inactivated") Q
- . S DA=IBD,DIE="^IBE(356.8,",DR=".05///1" D ^DIE
- . S IBCNTD=IBCNTD+1 D MSG(IBC)
- ;
- D BMSG(" >> Reactivating Reason Not Billable (RNB)")
- S IBCNTR=0
- F IBI=1:1 S IBX=$P($T(RARNB+IBI),";;",2) Q:IBX="Q" D
- . S IBA=$P(IBX,U),IBB=$P(IBX,U,2)
- . S IBC=" "_IBA_" "_IBB
- . S IBD=+$O(^IBE(356.8,"B",IBB,0))
- . I 'IBD D MSG(IBC_" not found") Q
- . S IBE=$G(^IBE(356.8,IBD,0)) Q:IBE=""
- . I '$P(IBE,U,5) D MSG(IBC_" not reactivated") Q
- . S DA=IBD,DIE="^IBE(356.8,",DR=".05///@" D ^DIE
- . S IBCNTR=IBCNTR+1 D MSG(IBC)
- D BMSG(" >> Changing Reason Not Billable (RNB)")
- S IBCNTM=0
- F IBI=1:1 S IBX=$P($T(MRNB+IBI),";;",2) Q:IBX="Q" D
- . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3),IBD=$P(IBX,U,4)
- . S IBC=" "_IBA_" "_IBB
- . S IBD=+$O(^IBE(356.8,"B",IBB,0))
- . I 'IBD D MSG(IBC_" not found") Q
- . S IBE=$G(^IBE(356.8,IBD,0)) Q:IBE=""
- . S DA=IBD,DIE="^IBE(356.8,",DR=".02///1;.03///1" D ^DIE
- . S IBCNTM=IBCNTM+1 D MSG(IBC)
- S IBCNT=IBCNTR+IBCNTA+IBCNTD+IBCNTM
- D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in CLAIMS TRACKING NON-BILLABLE REASONS (#356.8) file")
- Q
- ;
- BMSG(IBZ) ;
- D BMES^XPDUTL(IBZ)
- Q
- ;
- MSG(IBZ) ;
- D MES^XPDUTL(IBZ)
- Q
- ;
- NRNB ; RNB code^name^ecme flag^ecme paper flag (2)
- ;;Q
- IRNB ; RNB code^name (2)
- ;;Q
- RARNB ; RNB code^name (15)
- ;;999^OTHER
- ;;Q
- MRNB ; RNB code^name^ecme flag^ecme paper flag (2)
- ;;B99^RX BILLED PAPER CLAIM^1^1
- ;;Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P791 3330 printed Feb 18, 2025@23:31:23 Page 2
- IB20P791 ;ALB/AJR - RNB UPDATES FOR 2024 ;01/23/2024
- +1 ;;2.0;INTEGRATED BILLING;**791**;21-MAR-94;Build 8
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; This routine is used as a post-init in a KIDS build to
- +5 ; update the CLAIMS TRACKING NON-BILLABLE REASONS file (#356.8).
- +6 QUIT
- POST ;
- +1 ; Update RNB for 2024 in file #356.8
- +2 ; Start of Install
- +3 NEW IBZ,U
- SET U="^"
- +4 DO BMSG(" IB*2.0*791 Post-Install starting .....")
- +5 DO RNB
- +6 DO BMSG(" IB*2.0*791 Post-Install is complete.")
- +7 QUIT
- +8 ;
- RNB ; RNB in fields #.01/piece 1, #.02/piece 2, #.03/piece 3, #.04/piece 4, #.05/piece 5
- +1 NEW IBA,IBB,IBC,IBCNT,IBCNTA,IBCNTR,IBCNTD,IBCNTM,IBD,IBE,IBF,IBI,IBX,IBY,IBX3,DA,DLAYGO,DIC,DIE,DINUM,DR,X,Y
- +2 SET IBCNTA=0
- +3 ;D BMSG(" >> Adding Reason Not Billable (RNB)")
- +4 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(NRNB+IBI),";;",2)
- if IBX="Q"
- QUIT
- Begin DoDot:1
- +5 SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- SET IBC=$PIECE(IBX,U,3)
- SET IBD=$PIECE(IBX,U,4)
- +6 SET IBY=" "_IBA_" "_IBB
- +7 SET IBE=IBB_U_IBC_U_IBD_U_IBA
- +8 SET IBF=+$ORDER(^IBE(356.8,"B",IBB,0))
- +9 IF IBF
- Begin DoDot:2
- +10 SET IBX3=$GET(^IBE(356.8,IBF,0))
- SET DA=IBF
- SET IBMS="updated"
- +11 IF $PIECE(IBX3,U,1,4)=IBE
- SET IBF=0
- DO MSG(IBY_" not re-added")
- QUIT
- End DoDot:2
- if 'IBF
- QUIT
- +12 IF 'IBF
- Begin DoDot:2
- +13 FOR IBF=100:1
- SET IBX3=$GET(^IBE(356.8,IBF,0))
- IF IBX3=""
- SET DINUM=IBF
- QUIT
- +14 SET DLAYGO=356.8
- SET DIC="^IBE(356.8,"
- SET DIC(0)="L"
- SET X=IBB
- DO FILE^DICN
- +15 IF Y<1
- DO MSG(" >> ERROR when adding "_IBY_" to the #356.8 file, log a ticket!")
- QUIT
- +16 SET DA=+Y
- SET IBMS=""
- End DoDot:2
- if Y<1
- QUIT
- +17 SET DIE="^IBE(356.8,"
- SET DR=".02///"_IBC_";.03///"_IBD_";.04///"_IBA
- DO ^DIE
- +18 SET IBCNTA=IBCNTA+1
- DO MSG(IBY_$SELECT(IBMS'="":" "_IBMS,1:""))
- End DoDot:1
- +19 ;
- +20 ;D BMSG(" >> Inactivating Reason Not Billable (RNB)")
- +21 SET IBCNTD=0
- +22 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(IRNB+IBI),";;",2)
- if IBX="Q"
- QUIT
- Begin DoDot:1
- +23 SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- +24 SET IBC=" "_IBA_" "_IBB
- +25 SET IBD=+$ORDER(^IBE(356.8,"B",IBB,0))
- +26 IF 'IBD
- DO MSG(IBC_" not found")
- QUIT
- +27 SET IBE=$GET(^IBE(356.8,IBD,0))
- if IBE=""
- QUIT
- +28 IF $PIECE(IBE,U,5)
- DO MSG(IBC_" not re-inactivated")
- QUIT
- +29 SET DA=IBD
- SET DIE="^IBE(356.8,"
- SET DR=".05///1"
- DO ^DIE
- +30 SET IBCNTD=IBCNTD+1
- DO MSG(IBC)
- End DoDot:1
- +31 ;
- +32 DO BMSG(" >> Reactivating Reason Not Billable (RNB)")
- +33 SET IBCNTR=0
- +34 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(RARNB+IBI),";;",2)
- if IBX="Q"
- QUIT
- Begin DoDot:1
- +35 SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- +36 SET IBC=" "_IBA_" "_IBB
- +37 SET IBD=+$ORDER(^IBE(356.8,"B",IBB,0))
- +38 IF 'IBD
- DO MSG(IBC_" not found")
- QUIT
- +39 SET IBE=$GET(^IBE(356.8,IBD,0))
- if IBE=""
- QUIT
- +40 IF '$PIECE(IBE,U,5)
- DO MSG(IBC_" not reactivated")
- QUIT
- +41 SET DA=IBD
- SET DIE="^IBE(356.8,"
- SET DR=".05///@"
- DO ^DIE
- +42 SET IBCNTR=IBCNTR+1
- DO MSG(IBC)
- End DoDot:1
- +43 DO BMSG(" >> Changing Reason Not Billable (RNB)")
- +44 SET IBCNTM=0
- +45 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(MRNB+IBI),";;",2)
- if IBX="Q"
- QUIT
- Begin DoDot:1
- +46 SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- SET IBC=$PIECE(IBX,U,3)
- SET IBD=$PIECE(IBX,U,4)
- +47 SET IBC=" "_IBA_" "_IBB
- +48 SET IBD=+$ORDER(^IBE(356.8,"B",IBB,0))
- +49 IF 'IBD
- DO MSG(IBC_" not found")
- QUIT
- +50 SET IBE=$GET(^IBE(356.8,IBD,0))
- if IBE=""
- QUIT
- +51 SET DA=IBD
- SET DIE="^IBE(356.8,"
- SET DR=".02///1;.03///1"
- DO ^DIE
- +52 SET IBCNTM=IBCNTM+1
- DO MSG(IBC)
- End DoDot:1
- +53 SET IBCNT=IBCNTR+IBCNTA+IBCNTD+IBCNTM
- +54 DO MSG("Total "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in CLAIMS TRACKING NON-BILLABLE REASONS (#356.8) file")
- +55 QUIT
- +56 ;
- BMSG(IBZ) ;
- +1 DO BMES^XPDUTL(IBZ)
- +2 QUIT
- +3 ;
- MSG(IBZ) ;
- +1 DO MES^XPDUTL(IBZ)
- +2 QUIT
- +3 ;
- NRNB ; RNB code^name^ecme flag^ecme paper flag (2)
- +1 ;;Q
- IRNB ; RNB code^name (2)
- +1 ;;Q
- RARNB ; RNB code^name (15)
- +1 ;;999^OTHER
- +2 ;;Q
- MRNB ; RNB code^name^ecme flag^ecme paper flag (2)
- +1 ;;B99^RX BILLED PAPER CLAIM^1^1
- +2 ;;Q