IBYPPG ;ALB/ARH - IB*2*148 POST INIT: REASONABLE CHARGES V1.2 ; 05/17/01
;;2.0;INTEGRATED BILLING;**148**;21-MAR-94
;
Q
POST ;
N IBA
S IBA(1)="",IBA(2)=" IB*2*148 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
;
;
D CPTINA ; inactivate charges for inactive CPT codes
D CSEMPTY ; delete Charge Sets with no charges assigned
D ERRORCD ; add error code IB320 to IB Error file (#350.8)
;
S IBA(1)="",IBA(2)=" IB*2*148 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
;
CSEMPTY ; delete Charges Sets with no Charges assigned
N IBA,IBCNT S IBCNT=0
S IBA(1)="",IBA(2)=" >> Removing Charges Sets that have no Charges Assigned..." D MES^XPDUTL(.IBA) K IBA
;
S IBCNT=$$CSEMPTY^IBCRED() ; delete Charge Sets that have no charges
;
S IBA(1)=" Done. "_IBCNT_" Charges Sets Removed." D MES^XPDUTL(.IBA) K IBA
Q
;
ERRORCD ; add a new Error Code to #350.8
N IBA,IBCODE,IBEMES,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
;
S IBCODE="IB320",IBEMES="Clinic Required for Surgical Procedures (10000-69999, 93501-93533)"
;
I $O(^IBE(350.8,"AC",IBCODE,0)) Q
;
K DD,DO S DLAYGO=350.8,DIC="^IBE(350.8,",DIC(0)="L",X=IBCODE D FILE^DICN K DIC I Y<1 K X,Y Q
S IBFN=+Y
;
S DR=".02///"_IBEMES_";.03///"_IBCODE_";.04////1;.05////1"
S DIE="^IBE(350.8,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
;
S IBA(1)="",IBA(2)=" >> Error Code IB320 Added to IB Error File (#350.8) " D MES^XPDUTL(.IBA) K IBA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPPG 1828 printed Nov 22, 2024@17:46:27 Page 2
IBYPPG ;ALB/ARH - IB*2*148 POST INIT: REASONABLE CHARGES V1.2 ; 05/17/01
+1 ;;2.0;INTEGRATED BILLING;**148**;21-MAR-94
+2 ;
+3 QUIT
POST ;
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" IB*2*148 Post-Install ....."
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ;
+5 ; inactivate charges for inactive CPT codes
DO CPTINA
+6 ; delete Charge Sets with no charges assigned
DO CSEMPTY
+7 ; add error code IB320 to IB Error file (#350.8)
DO ERRORCD
+8 ;
+9 SET IBA(1)=""
SET IBA(2)=" IB*2*148 Post-Install Complete"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+10 QUIT
+11 ;
+12 ;
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 ;
CSEMPTY ; delete Charges Sets with no Charges assigned
+1 NEW IBA,IBCNT
SET IBCNT=0
+2 SET IBA(1)=""
SET IBA(2)=" >> Removing Charges Sets that have no Charges Assigned..."
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ; delete Charge Sets that have no charges
SET IBCNT=$$CSEMPTY^IBCRED()
+5 ;
+6 SET IBA(1)=" Done. "_IBCNT_" Charges Sets Removed."
DO MES^XPDUTL(.IBA)
KILL IBA
+7 QUIT
+8 ;
ERRORCD ; add a new Error Code to #350.8
+1 NEW IBA,IBCODE,IBEMES,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
+2 ;
+3 SET IBCODE="IB320"
SET IBEMES="Clinic Required for Surgical Procedures (10000-69999, 93501-93533)"
+4 ;
+5 IF $ORDER(^IBE(350.8,"AC",IBCODE,0))
QUIT
+6 ;
+7 KILL DD,DO
SET DLAYGO=350.8
SET DIC="^IBE(350.8,"
SET DIC(0)="L"
SET X=IBCODE
DO FILE^DICN
KILL DIC
IF Y<1
KILL X,Y
QUIT
+8 SET IBFN=+Y
+9 ;
+10 SET DR=".02///"_IBEMES_";.03///"_IBCODE_";.04////1;.05////1"
+11 SET DIE="^IBE(350.8,"
SET DA=+IBFN
DO ^DIE
KILL DIE,DA,DR,X,Y
+12 ;
+13 SET IBA(1)=""
SET IBA(2)=" >> Error Code IB320 Added to IB Error File (#350.8) "
DO MES^XPDUTL(.IBA)
KILL IBA
+14 QUIT
