- IBARXEVT ;ALB/AAS - IB EXEMPTION EVENT DRIVER ; 12-DEC-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % ; -- Invokes items on the IB EXEMPTION EVENT protocol menu
- ; Input =: dfn = patient file ien
- ; ibaction = what is happening, add, chg, del
- ; ibevt = status^status text^reason code^date (from rxst^ibarxeu)
- ; ibevtp = exemption record zeroth node prior to change
- ; ibevta = exemption record zeroth node after change
- ;
- K DTOUT,DIROUT
- ;S X=$O(^ORD(101,"B","IB EXEMPTION EVENTS",0))_";ORD(101," D EN1^XQOR:X
- S X="IB EXEMPTION EVENTS",DIC=101 D EN1^XQOR
- K X,DIC
- Q
- ;
- BEFORE ; -- get prior exemption for date
- ; input =: dfn = patient file ien
- ; ibdt = date of exemption
- ;
- ; output =: ibevtp = zeroth node of exemtpion before action
- ;
- N IBLDT
- ; -- if forcing a more recent effective date to inactive set
- ; before to what is being canceled
- S IBLDT=$S($G(IBOLDAUT)?7N:IBOLDAUT,$G(IBFORCE)?7N:IBFORCE,1:IBDT)
- S IBEVTP=$$LST^IBARXEU0(DFN,IBLDT) ;I IBDT'=+IBEVTP K IBEVTP
- Q
- ;
- AFTER ; -- get exemption after change
- ; input =: dfn = patient file ien
- ; ibdt = date of exemption
- ;
- ; output =: ibevta = zeroth node of exemtpion after action
- ;
- S IBEVTA=$$LST^IBARXEU0(DFN,IBDT) ;I IBDT'=+IBEVTA K IBEVTA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEVT 1468 printed Mar 13, 2025@21:12:17 Page 2
- IBARXEVT ;ALB/AAS - IB EXEMPTION EVENT DRIVER ; 12-DEC-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % ; -- Invokes items on the IB EXEMPTION EVENT protocol menu
- +1 ; Input =: dfn = patient file ien
- +2 ; ibaction = what is happening, add, chg, del
- +3 ; ibevt = status^status text^reason code^date (from rxst^ibarxeu)
- +4 ; ibevtp = exemption record zeroth node prior to change
- +5 ; ibevta = exemption record zeroth node after change
- +6 ;
- +7 KILL DTOUT,DIROUT
- +8 ;S X=$O(^ORD(101,"B","IB EXEMPTION EVENTS",0))_";ORD(101," D EN1^XQOR:X
- +9 SET X="IB EXEMPTION EVENTS"
- SET DIC=101
- DO EN1^XQOR
- +10 KILL X,DIC
- +11 QUIT
- +12 ;
- BEFORE ; -- get prior exemption for date
- +1 ; input =: dfn = patient file ien
- +2 ; ibdt = date of exemption
- +3 ;
- +4 ; output =: ibevtp = zeroth node of exemtpion before action
- +5 ;
- +6 NEW IBLDT
- +7 ; -- if forcing a more recent effective date to inactive set
- +8 ; before to what is being canceled
- +9 SET IBLDT=$SELECT($GET(IBOLDAUT)?7N:IBOLDAUT,$GET(IBFORCE)?7N:IBFORCE,1:IBDT)
- +10 ;I IBDT'=+IBEVTP K IBEVTP
- SET IBEVTP=$$LST^IBARXEU0(DFN,IBLDT)
- +11 QUIT
- +12 ;
- AFTER ; -- get exemption after change
- +1 ; input =: dfn = patient file ien
- +2 ; ibdt = date of exemption
- +3 ;
- +4 ; output =: ibevta = zeroth node of exemtpion after action
- +5 ;
- +6 ;I IBDT'=+IBEVTA K IBEVTA
- SET IBEVTA=$$LST^IBARXEU0(DFN,IBDT)
- +7 QUIT
