| 1 | IBARXEVT ;ALB/AAS - IB EXEMPTION EVENT DRIVER ; 12-DEC-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 | % ; -- Invokes items on the IB EXEMPTION EVENT protocol menu
 | 
|---|
| 6 |  ;    Input  =:  dfn      = patient file ien
 | 
|---|
| 7 |  ;               ibaction = what is happening, add, chg, del
 | 
|---|
| 8 |  ;               ibevt    = status^status text^reason code^date (from rxst^ibarxeu)
 | 
|---|
| 9 |  ;               ibevtp   = exemption record zeroth node prior to change
 | 
|---|
| 10 |  ;               ibevta   = exemption record zeroth node after change
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  K DTOUT,DIROUT
 | 
|---|
| 13 |  ;S X=$O(^ORD(101,"B","IB EXEMPTION EVENTS",0))_";ORD(101," D EN1^XQOR:X
 | 
|---|
| 14 |  S X="IB EXEMPTION EVENTS",DIC=101 D EN1^XQOR
 | 
|---|
| 15 |  K X,DIC
 | 
|---|
| 16 |  Q
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | BEFORE ; -- get prior exemption for date
 | 
|---|
| 19 |  ;    input  =:  dfn    = patient file ien
 | 
|---|
| 20 |  ;               ibdt   = date of exemption
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  ;    output =:  ibevtp = zeroth node of exemtpion before action
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 |  N IBLDT
 | 
|---|
| 25 |  ; -- if forcing a more recent effective date to inactive set
 | 
|---|
| 26 |  ;    before to what is being canceled
 | 
|---|
| 27 |  S IBLDT=$S($G(IBOLDAUT)?7N:IBOLDAUT,$G(IBFORCE)?7N:IBFORCE,1:IBDT)
 | 
|---|
| 28 |  S IBEVTP=$$LST^IBARXEU0(DFN,IBLDT) ;I IBDT'=+IBEVTP K IBEVTP
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 | AFTER ; -- get exemption after change
 | 
|---|
| 32 |  ;    input  =:  dfn    = patient file ien
 | 
|---|
| 33 |  ;               ibdt   = date of exemption
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  ;    output =:  ibevta = zeroth node of exemtpion after action
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  S IBEVTA=$$LST^IBARXEU0(DFN,IBDT) ;I IBDT'=+IBEVTA K IBEVTA
 | 
|---|
| 38 |  Q
 | 
|---|