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

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1IBYPSA2 ;ALB/ARH - IB*2.0*245 POST INIT: INACTIVATE OLD RC CHARGES ; 01-OCT-2003
2 ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
3 ;
4 Q
5 ;
6CHGINA(VERS) ; inactive charges from previous versions of Reasonable Charges
7 ; VERS = version to begin inactivations with (1, 1.1, 1.2, ...)
8 ; - Inactive date added is the first RC Version Inactive date after the effective date of the charge
9 ; - if the charge already has an inactive date less than the Version Inactive Date then no change is made
10 ;
11 N IBA,IBI,IBX,IBSTART,IBENDATE,IBCS,IBCS0,IBBR0,IBXRF,IBITM,IBNEF,IBCI,IBCI0,IBCIEF,IBCIIA,IBNEWIA
12 N DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y,IBCNT S IBCNT=0
13 ;
14 S IBA(1)=" >> Inactivating Existing Reasonable Charges, Please Wait..." D MES^XPDUTL(.IBA) K IBA
15 ;
16 S IBSTART="" I $G(VERS)'="" S IBSTART=$$VERSDT^IBCRHBRV(VERS)
17 S IBENDATE=$$VERSEND^IBCRHBRV
18 ;
19 S IBCS=0 F S IBCS=$O(^IBE(363.1,IBCS)) Q:'IBCS D
20 . S IBCS0=$G(^IBE(363.1,IBCS,0)) Q:IBCS0=""
21 . S IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0)) I $E(IBBR0,1,3)'="RC " Q
22 . ;
23 . S IBXRF="AIVDTS"_IBCS
24 . S IBITM=0 F S IBITM=$O(^IBA(363.2,IBXRF,IBITM)) Q:'IBITM D
25 .. S IBNEF="" F S IBNEF=$O(^IBA(363.2,IBXRF,IBITM,IBNEF)) Q:IBNEF="" Q:-IBNEF<IBSTART D
26 ... ;
27 ... S IBCI=0 F S IBCI=$O(^IBA(363.2,IBXRF,IBITM,IBNEF,IBCI)) Q:'IBCI D
28 .... S IBCI0=$G(^IBA(363.2,IBCI,0)) Q:IBCI0=""
29 .... S IBCIEF=$P(IBCI0,U,3),IBCIIA=$P(IBCI0,U,4),IBNEWIA=""
30 .... ;
31 .... F IBI=2:1 S IBX=+$P(IBENDATE,";",IBI) S IBNEWIA=IBX Q:'IBX Q:IBCIEF'>IBX
32 .... ;
33 .... I 'IBNEWIA Q
34 .... I +IBCIIA,IBCIIA'>IBNEWIA Q
35 .... ;
36 .... S DR=".04////"_+IBNEWIA,DIE="^IBA(363.2,",DA=+IBCI D ^DIE K DIE,DIC,DA,DR,X,Y S IBCNT=IBCNT+1
37 ;
38 S IBA(1)=" Done. "_IBCNT_" existing charges inactivated " D MES^XPDUTL(.IBA) K IBA
39 Q
Note: See TracBrowser for help on using the repository browser.