IBYPPF ;ALB/ARH - IB*2*131 POST INIT: CPT 2000 REPLACEMENTS FOR RC V1 ; 05/25/00
;;2.0;INTEGRATED BILLING;**131**;21-MAR-94
;
Q
POST ;
N IBA
S IBA(1)="",IBA(2)=" IB*2*131 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
;
D DEL2000^IBYPPF1 ; delete any existing RC charges for the new codes (site defined)
D ADD2000^IBYPPF1 ; add charges for new CPT codes, replacements for inactivated CPT codes
;
D PDDEL^IBYPPT1 ; delete all Provider Discount Sets and Links (363.34) for RC PROVIDER DISCOUNTS Special Group
D PDADD^IBYPPT1 ; add new Provider Discount Sets and Links (363.34) for RC PROVIDER DISCOUNTS Special Group
;
D CPTINA ; inactivate charges for inactive CPT codes
;
S IBA(1)="",IBA(2)=" IB*2*131 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
Q
;
;
CPTINA ; inactivate charges for Inactive CPTs
N IBA,IBCNT S IBCNT=0
S IBA(1)="",IBA(2)=" >> Inactivating Charges for Inactive CPT codes, Please Wait..." D MES^XPDUTL(.IBA) K IBA
;
S IBCNT=$$INACTCPT^IBCREC(0) ; inactivate charges for inactive CPT codes
;
S IBA(1)=" Done. "_IBCNT_" Charges Inactivated." D MES^XPDUTL(.IBA) K IBA
Q
;
;
;
MSG(X) ;
N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
S IBA(IBX)=$G(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPPF 1279 printed Oct 16, 2024@18:37 Page 2
IBYPPF ;ALB/ARH - IB*2*131 POST INIT: CPT 2000 REPLACEMENTS FOR RC V1 ; 05/25/00
+1 ;;2.0;INTEGRATED BILLING;**131**;21-MAR-94
+2 ;
+3 QUIT
POST ;
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" IB*2*131 Post-Install ....."
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ; delete any existing RC charges for the new codes (site defined)
DO DEL2000^IBYPPF1
+5 ; add charges for new CPT codes, replacements for inactivated CPT codes
DO ADD2000^IBYPPF1
+6 ;
+7 ; delete all Provider Discount Sets and Links (363.34) for RC PROVIDER DISCOUNTS Special Group
DO PDDEL^IBYPPT1
+8 ; add new Provider Discount Sets and Links (363.34) for RC PROVIDER DISCOUNTS Special Group
DO PDADD^IBYPPT1
+9 ;
+10 ; inactivate charges for inactive CPT codes
DO CPTINA
+11 ;
+12 SET IBA(1)=""
SET IBA(2)=" IB*2*131 Post-Install Complete"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+13 QUIT
+14 ;
+15 ;
CPTINA ; inactivate charges for Inactive CPTs
+1 NEW IBA,IBCNT
SET IBCNT=0
+2 SET IBA(1)=""
SET IBA(2)=" >> Inactivating Charges for Inactive CPT codes, Please Wait..."
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ; inactivate charges for inactive CPT codes
SET IBCNT=$$INACTCPT^IBCREC(0)
+5 ;
+6 SET IBA(1)=" Done. "_IBCNT_" Charges Inactivated."
DO MES^XPDUTL(.IBA)
KILL IBA
+7 QUIT
+8 ;
+9 ;
+10 ;
MSG(X) ;
+1 NEW IBX
SET IBX=$ORDER(IBA(999999),-1)
if 'IBX
SET IBX=1
SET IBX=IBX+1
+2 SET IBA(IBX)=$GET(X)
+3 QUIT
