source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAUTL7.m@ 794

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1IBAUTL7 ;AAS/ALB - RX EXEMPTION UTILITY ROUTINE (CONT.) ; 2-NOV-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CURREX(IBSTAT,IBDT) ;update current status if current year
6 ; input : dfn = patient file pointer
7 ; ibdt = internal form of effective date
8 ; ibstat = status = 1 if exempt, 0 if not exempt
9 ;
10 N X,Y,DIC,DIE,DR,DA
11 I $S('$D(DFN):1,'$D(IBSTAT):1,IBSTAT=0:0,IBSTAT=1:0,1:1) G CURREXQ
12 ;
13 ; -- make sure ibdt > old current date
14 S X=+$P($G(^IBA(354,DFN,0)),"^",3)
15 I '$G(IBFORCE),$G(IBOLDAUT)'?7N,X>IBDT G CURREXQ ;only if most recent (I took this out for awhile but don't know why, its needed to keep from updating old over new)
16 ;
17 ; -- not greater than today
18 ;I IBDT>DT G CURREXQ
19 ;
20 S DIE="^IBA(354,",DA=DFN,DR="[IB CURRENT STATUS]" D ^DIE ; set status in billing patient file
21 I $D(Y) S IBEXERR=6,IBWHER=14
22 ;DR=".04////"_IBSTAT_";.03////"_IBDT_";.05////"_IBEXREA
23 ;
24CURREXQ Q
25 ;
26INACT(IBDT) ; -- must inactivate active exemptions before creating new exemption
27 ; should only be called from addex so event driver logic works
28 ;
29 N IBX,X,Y,DA,DR,DIE,DIC
30 S IBX=0 F S IBX=$O(^IBA(354.1,"AIVDT",1,DFN,-IBDT,IBX)) Q:'IBX D
31 .S DA=IBX
32 .I $P($G(^IBA(354.1,DA,0)),"^",10)'=1 Q
33 .I '$D(ZTQUEUED),$D(IBTALK) W:IBTALK<2 !,"Deleting Active flag from current entry" S IBTALK=IBTALK+1
34 .S DA=IBX,DIE="^IBA(354.1,",DR="[IB INACTIVATE EXEMPTION]" D ^DIE K DIC,DIE,DA,DR
35 .I $D(Y) S IBEXERR=7,IBWHER=15
36 .;S IBACTION="CHG"
37 .Q
38INACTQ Q
39 ;
40DUPL() ; -- see if entry is a duplicate
41 N X,Y
42 S X=0
43 S Y=$$LST^IBARXEU0(DFN,IBDT)
44 I IBDT=+Y,+IBEXREA=+$P(Y,"^",5),IBTYPE=$P(Y,"^",3) S X=1
45 Q X
46 ;
47 ;
48ALERT() ; -- use alerts or bulletins
49 ; returns 1 = use alerts
50 ; 0 = use bulletins
51 ;
52 Q $P($G(^IBE(350.9,1,0)),"^",14)
Note: See TracBrowser for help on using the repository browser.