IB20P510 ;ALB/CXW - IB*2.0*510 RATE SCHEDULE & NON-BILLABLE REASON ; 09/25/2013
;;2.0;INTEGRATED BILLING;**510**;21-MAR-94;Build 26
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ; Post-install of patch installation
D MES^XPDUTL("IB*2.0*510 Post-Install starts...")
D ADM,RNB
D MES^XPDUTL("IB*2.0*510 Post-Install is complete.")
Q
;
ADM ; Update national rate schedules to file (#363)
N IBADFE,IBADJUST,IBCT,IBDISP,IBEFFDT,IBNM,IBRATY,IBRTN,IBT,IBX,IBY
S IBADFE="",IBCT=0
D MES^XPDUTL(" Updating national rate Schedules with administrative fee:")
F IBX=1:1 S IBT=$P($T(RSF+IBX),";",3) Q:'$L(IBT) D
. S IBNM=$P(IBT,U)
. S IBRATY=$P(IBT,U,2)
. S IBRTN=$O(^DGCR(399.3,"B",IBRATY,0))
. S IBDISP=$P(IBT,U,3)
. S IBADJUST=$P(IBT,U,4)
. S IBEFFDT=$P(IBT,U,5)
. I $$RSEXIST(IBEFFDT,IBNM) D MES^XPDUTL(" >>>"_IBNM_" for "_IBRATY_" already exists") Q
. I 'IBRTN D MES^XPDUTL(" >>>"_IBRATY_" rate type not defined, "_IBNM_" rate schedule not created") Q
. ; latest ien if rate type has multiple
. I $P($G(^DGCR(399.3,+IBRTN,0)),U,3) S IBRTN=$O(^DGCR(399.3,"B",IBRATY,99999),-1)
. I $P($G(^DGCR(399.3,+IBRTN,0)),U,3) D MES^XPDUTL(" >>>"_IBRATY_" rate type not active, "_IBNM_" not created") Q
. ;
. D ENT^IB3PSOU(IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST)
. ;
. I $$RSEXIST(IBEFFDT,IBNM) S IBCT=IBCT+1 D MES^XPDUTL(" >>>"_IBNM_" for "_IBRATY_" rate schedule added")
D MES^XPDUTL(" Total "_IBCT_$S(IBCT=1:" entry",1:" entries")_" updated in the file (#363)")
D MES^XPDUTL(" ")
ADMQ Q
;
RSEXIST(IBEFFDT,IBNM) ; return RS IFN if Rate Schedule exists for Effective Date
N IBX,IBRSFN,IBRS0 S IBX=0
S IBRSFN=0 F S IBRSFN=$O(^IBE(363,IBRSFN)) Q:'IBRSFN D I IBX Q
. S IBRS0=$G(^IBE(363,IBRSFN,0))
. I $P(IBRS0,U,1)=IBNM,$P(IBRS0,U,5)=IBEFFDT S IBX=IBRSFN
Q IBX
;
RNB ; Inactivate existing standard RNB in file (#356.8)
N X,Y,DA,DIE,DR,IBCONM,IBCT,IBNM,IBRNB,IBRNB0,IBT,IBX S IBCT=0
D MES^XPDUTL(" Inactivating entries of Claims Tracking non-billable reasons:")
F IBX=1:1 S IBT=$P($T(OCODE+IBX),";",3) Q:'$L(IBT) D
. S IBCONM=$P(IBT,U,1)_" for "_$P(IBT,U,2)
. S IBNM=$P(IBT,U,2)
. S IBRNB=$O(^IBE(356.8,"B",IBNM,0))
. S IBRNB0=$G(^IBE(356.8,+IBRNB,0))
. I 'IBRNB D MES^XPDUTL(" >>>"_IBCONM_" not found") Q
. I +$P(IBRNB0,U,5) D MES^XPDUTL(" >>>"_IBCONM_" is already inactive") Q
. ; inactivate code and clean up ecme flags
. S DIE="^IBE(356.8,",DA=+IBRNB,DR=".02///@;.03///@;.05///1" D ^DIE
. S IBCT=IBCT+1 D MES^XPDUTL(" >>>"_IBCONM_" inactivated")
D MES^XPDUTL(" Total "_IBCT_$S(IBCT=1:" entry",1:" entries")_" updated in the file (#356.8)")
RNBQ Q
;
RSF ; name^rate type^dispensing fee^adjustment^effective date
;;INELIG-RX^INELIGIBLE^13.18^S X=X+13.18^3130813
;;HMN-RX^HUMANITARIAN^13.18^S X=X+13.18^3130813
;
OCODE ; code^name^ecme flag^ecme paper flag
;;CV25^HDHP PLAN NOT BILLED^1^0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P510 2952 printed Dec 13, 2024@02:03:22 Page 2
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
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ; Post-install of patch installation
+1 DO MES^XPDUTL("IB*2.0*510 Post-Install starts...")
+2 DO ADM
DO RNB
+3 DO MES^XPDUTL("IB*2.0*510 Post-Install is complete.")
+4 QUIT
+5 ;
ADM ; Update national rate schedules to file (#363)
+1 NEW IBADFE,IBADJUST,IBCT,IBDISP,IBEFFDT,IBNM,IBRATY,IBRTN,IBT,IBX,IBY
+2 SET IBADFE=""
SET IBCT=0
+3 DO MES^XPDUTL(" Updating national rate Schedules with administrative fee:")
+4 FOR IBX=1:1
SET IBT=$PIECE($TEXT(RSF+IBX),";",3)
if '$LENGTH(IBT)
QUIT
Begin DoDot:1
+5 SET IBNM=$PIECE(IBT,U)
+6 SET IBRATY=$PIECE(IBT,U,2)
+7 SET IBRTN=$ORDER(^DGCR(399.3,"B",IBRATY,0))
+8 SET IBDISP=$PIECE(IBT,U,3)
+9 SET IBADJUST=$PIECE(IBT,U,4)
+10 SET IBEFFDT=$PIECE(IBT,U,5)
+11 IF $$RSEXIST(IBEFFDT,IBNM)
DO MES^XPDUTL(" >>>"_IBNM_" for "_IBRATY_" already exists")
QUIT
+12 IF 'IBRTN
DO MES^XPDUTL(" >>>"_IBRATY_" rate type not defined, "_IBNM_" rate schedule not created")
QUIT
+13 ; latest ien if rate type has multiple
+14 IF $PIECE($GET(^DGCR(399.3,+IBRTN,0)),U,3)
SET IBRTN=$ORDER(^DGCR(399.3,"B",IBRATY,99999),-1)
+15 IF $PIECE($GET(^DGCR(399.3,+IBRTN,0)),U,3)
DO MES^XPDUTL(" >>>"_IBRATY_" rate type not active, "_IBNM_" not created")
QUIT
+16 ;
+17 DO ENT^IB3PSOU(IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST)
+18 ;
+19 IF $$RSEXIST(IBEFFDT,IBNM)
SET IBCT=IBCT+1
DO MES^XPDUTL(" >>>"_IBNM_" for "_IBRATY_" rate schedule added")
End DoDot:1
+20 DO MES^XPDUTL(" Total "_IBCT_$SELECT(IBCT=1:" entry",1:" entries")_" updated in the file (#363)")
+21 DO MES^XPDUTL(" ")
ADMQ QUIT
+1 ;
RSEXIST(IBEFFDT,IBNM) ; return RS IFN if Rate Schedule exists for Effective Date
+1 NEW IBX,IBRSFN,IBRS0
SET IBX=0
+2 SET IBRSFN=0
FOR
SET IBRSFN=$ORDER(^IBE(363,IBRSFN))
if 'IBRSFN
QUIT
Begin DoDot:1
+3 SET IBRS0=$GET(^IBE(363,IBRSFN,0))
+4 IF $PIECE(IBRS0,U,1)=IBNM
IF $PIECE(IBRS0,U,5)=IBEFFDT
SET IBX=IBRSFN
End DoDot:1
IF IBX
QUIT
+5 QUIT IBX
+6 ;
RNB ; Inactivate existing standard RNB in file (#356.8)
+1 NEW X,Y,DA,DIE,DR,IBCONM,IBCT,IBNM,IBRNB,IBRNB0,IBT,IBX
SET IBCT=0
+2 DO MES^XPDUTL(" Inactivating entries of Claims Tracking non-billable reasons:")
+3 FOR IBX=1:1
SET IBT=$PIECE($TEXT(OCODE+IBX),";",3)
if '$LENGTH(IBT)
QUIT
Begin DoDot:1
+4 SET IBCONM=$PIECE(IBT,U,1)_" for "_$PIECE(IBT,U,2)
+5 SET IBNM=$PIECE(IBT,U,2)
+6 SET IBRNB=$ORDER(^IBE(356.8,"B",IBNM,0))
+7 SET IBRNB0=$GET(^IBE(356.8,+IBRNB,0))
+8 IF 'IBRNB
DO MES^XPDUTL(" >>>"_IBCONM_" not found")
QUIT
+9 IF +$PIECE(IBRNB0,U,5)
DO MES^XPDUTL(" >>>"_IBCONM_" is already inactive")
QUIT
+10 ; inactivate code and clean up ecme flags
+11 SET DIE="^IBE(356.8,"
SET DA=+IBRNB
SET DR=".02///@;.03///@;.05///1"
DO ^DIE
+12 SET IBCT=IBCT+1
DO MES^XPDUTL(" >>>"_IBCONM_" inactivated")
End DoDot:1
+13 DO MES^XPDUTL(" Total "_IBCT_$SELECT(IBCT=1:" entry",1:" entries")_" updated in the file (#356.8)")
RNBQ QUIT
+1 ;
RSF ; name^rate type^dispensing fee^adjustment^effective date
+1 ;;INELIG-RX^INELIGIBLE^13.18^S X=X+13.18^3130813
+2 ;;HMN-RX^HUMANITARIAN^13.18^S X=X+13.18^3130813
+3 ;
OCODE ; code^name^ecme flag^ecme paper flag
+1 ;;CV25^HDHP PLAN NOT BILLED^1^0
+2 ;
