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 Dec 13, 2024@02:07:27 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
