source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBYPPG.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1IBYPPG ;ALB/ARH - IB*2*148 POST INIT: REASONABLE CHARGES V1.2 ; 05/17/01
2 ;;2.0;INTEGRATED BILLING;**148**;21-MAR-94
3 ;
4 Q
5POST ;
6 N IBA
7 S IBA(1)="",IBA(2)=" IB*2*148 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
8 ;
9 ;
10 D CPTINA ; inactivate charges for inactive CPT codes
11 D CSEMPTY ; delete Charge Sets with no charges assigned
12 D ERRORCD ; add error code IB320 to IB Error file (#350.8)
13 ;
14 S IBA(1)="",IBA(2)=" IB*2*148 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
15 Q
16 ;
17 ;
18CPTINA ; inactivate charges for Inactive CPTs
19 N IBA,IBCNT S IBCNT=0
20 S IBA(1)="",IBA(2)=" >> Inactivating Charges for Inactive CPT codes, Please Wait..." D MES^XPDUTL(.IBA) K IBA
21 ;
22 S IBCNT=$$INACTCPT^IBCREC(0) ; inactivate charges for inactive CPT codes
23 ;
24 S IBA(1)=" Done. "_IBCNT_" Charges Inactivated." D MES^XPDUTL(.IBA) K IBA
25 Q
26 ;
27CSEMPTY ; delete Charges Sets with no Charges assigned
28 N IBA,IBCNT S IBCNT=0
29 S IBA(1)="",IBA(2)=" >> Removing Charges Sets that have no Charges Assigned..." D MES^XPDUTL(.IBA) K IBA
30 ;
31 S IBCNT=$$CSEMPTY^IBCRED() ; delete Charge Sets that have no charges
32 ;
33 S IBA(1)=" Done. "_IBCNT_" Charges Sets Removed." D MES^XPDUTL(.IBA) K IBA
34 Q
35 ;
36ERRORCD ; add a new Error Code to #350.8
37 N IBA,IBCODE,IBEMES,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
38 ;
39 S IBCODE="IB320",IBEMES="Clinic Required for Surgical Procedures (10000-69999, 93501-93533)"
40 ;
41 I $O(^IBE(350.8,"AC",IBCODE,0)) Q
42 ;
43 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
44 S IBFN=+Y
45 ;
46 S DR=".02///"_IBEMES_";.03///"_IBCODE_";.04////1;.05////1"
47 S DIE="^IBE(350.8,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
48 ;
49 S IBA(1)="",IBA(2)=" >> Error Code IB320 Added to IB Error File (#350.8) " D MES^XPDUTL(.IBA) K IBA
50 Q
Note: See TracBrowser for help on using the repository browser.