| 1 | IBAUTL7 ;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 | ;
|
|---|
| 5 | CURREX(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 | ;
|
|---|
| 24 | CURREXQ Q
|
|---|
| 25 | ;
|
|---|
| 26 | INACT(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
|
|---|
| 38 | INACTQ Q
|
|---|
| 39 | ;
|
|---|
| 40 | DUPL() ; -- 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 | ;
|
|---|
| 48 | ALERT() ; -- use alerts or bulletins
|
|---|
| 49 | ; returns 1 = use alerts
|
|---|
| 50 | ; 0 = use bulletins
|
|---|
| 51 | ;
|
|---|
| 52 | Q $P($G(^IBE(350.9,1,0)),"^",14)
|
|---|
