IBYPPF.m

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 ---IBYPPF   1279     printed  Apr 09, 2024@21:12:19                                                                                                                                                                                                      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