IBCNSEVT ;ALB/AAS - NEW INSURANCE POLICY EVENT DRIVER ; 12-DEC-92
;;2.0;INTEGRATED BILLING;**6,497**;21-MAR-94;Build 120
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% ; -- Invokes items on the IB NEW INSURANCE EVENT protocol menu
; Input =: dfn = patient file ien
; IBEVTP0 = insurance type zeroth node of policy
; before editing
; IBEVTP1 = insurance type 1 node of policy
; before editing
; IBEVTP2 = insurance type 2 node of policy
; before editing
; IBEVTP3 = insurance type 3 node of policy - IB*2.0*497 (vd)
; before editing
; IBEVTP7 = insurance type 7 node of policy - IB*2.0*497 (vd)
; before editing
; IBEVTA0 = insurance type zeroth node of new policy
; contains effective/expiration dates
; IBEVTA1 = insurance type 1 node of new policy
; contains date added and by whom
; IBEVTA2 = insurance type 2 node of new policy
; IBEVTA3 = insurance type 2 node of new policy - IB*2.0*497 (vd)
; IBEVTA7 = insurance type 2 node of new policy - IB*2.0*497 (vd)
; IBCDFN = internal number of policy as in ^dpt(dfn,
; .312,ibcdfn,0))
; IBEVTACT = flag indicating whether action is add, edit
; or delete
;
;
N DTOUT,DIROUT
;S X=$O(^ORD(101,"B","IBCN NEW INSURANCE EVENTS",0))_";ORD(101," D EN1^XQOR:X
I IBEVTP0=IBEVTA0,IBEVTP1=IBEVTA1,IBEVTP2=IBEVTA2,IBEVTP3=IBEVTA3,IBEVTP7=IBEVTA7 G EVTQ ; IB*2.0*497 (vd)
S X="IBCN NEW INSURANCE EVENTS",DIC=101 D EN1^XQOR
EVTQ K X,DIC,IBEVTP0,IBEVTP1,IBEVTP2,IBEVTA0,IBEVTA1,IBEVTA2,IBEVTACT
K IBEVTP3,IBEVTP7,IBEVTA3,IBEVTA7 ; IB*2.0*497 (vd)
Q
;
BEFORE ; -- get insurance type values before adding/editing
;
I $G(IBNEW) S (IBEVTP0,IBEVTP1,IBEVTP2,IBEVTP3,IBEVTP7)="" G BEFQ ; IB*2.0*497 (vd)
S IBEVTP0=$G(^DPT(DFN,.312,IBCDFN,0))
S IBEVTP1=$G(^DPT(DFN,.312,IBCDFN,1))
S IBEVTP2=$G(^DPT(DFN,.312,IBCDFN,2))
S IBEVTP3=$G(^DPT(DFN,.312,IBCDFN,3)) ; IB*2.0*497 (vd)
S IBEVTP7=$G(^DPT(DFN,.312,IBCDFN,7)) ; IB*2.0*497 (vd)
BEFQ Q
;
AFTER ; -- get insurance type values after adding/editing. set action flag.
; -- get exemption after change
; input =: DFN = patient file ien
;
S IBEVTA0=$G(^DPT(DFN,.312,IBCDFN,0))
S IBEVTA1=$G(^DPT(DFN,.312,IBCDFN,1))
S IBEVTA2=$G(^DPT(DFN,.312,IBCDFN,2))
S IBEVTA3=$G(^DPT(DFN,.312,IBCDFN,3)) ; IB*2.0*497 (vd)
S IBEVTA7=$G(^DPT(DFN,.312,IBCDFN,7)) ; IB*2.0*497 (vd)
I IBEVTP0="",IBEVTA0'="" S IBEVTACT="ADD"
I IBEVTP0'="",IBEVTA0'="" S IBEVTACT="EDT"
I IBEVTP0'="",IBEVTA0="" S IBEVTACT="DEL"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSEVT 2967 printed Sep 23, 2025@19:53:21 Page 2
IBCNSEVT ;ALB/AAS - NEW INSURANCE POLICY EVENT DRIVER ; 12-DEC-92
+1 ;;2.0;INTEGRATED BILLING;**6,497**;21-MAR-94;Build 120
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% ; -- Invokes items on the IB NEW INSURANCE EVENT protocol menu
+1 ; Input =: dfn = patient file ien
+2 ; IBEVTP0 = insurance type zeroth node of policy
+3 ; before editing
+4 ; IBEVTP1 = insurance type 1 node of policy
+5 ; before editing
+6 ; IBEVTP2 = insurance type 2 node of policy
+7 ; before editing
+8 ; IBEVTP3 = insurance type 3 node of policy - IB*2.0*497 (vd)
+9 ; before editing
+10 ; IBEVTP7 = insurance type 7 node of policy - IB*2.0*497 (vd)
+11 ; before editing
+12 ; IBEVTA0 = insurance type zeroth node of new policy
+13 ; contains effective/expiration dates
+14 ; IBEVTA1 = insurance type 1 node of new policy
+15 ; contains date added and by whom
+16 ; IBEVTA2 = insurance type 2 node of new policy
+17 ; IBEVTA3 = insurance type 2 node of new policy - IB*2.0*497 (vd)
+18 ; IBEVTA7 = insurance type 2 node of new policy - IB*2.0*497 (vd)
+19 ; IBCDFN = internal number of policy as in ^dpt(dfn,
+20 ; .312,ibcdfn,0))
+21 ; IBEVTACT = flag indicating whether action is add, edit
+22 ; or delete
+23 ;
+24 ;
+25 NEW DTOUT,DIROUT
+26 ;S X=$O(^ORD(101,"B","IBCN NEW INSURANCE EVENTS",0))_";ORD(101," D EN1^XQOR:X
+27 ; IB*2.0*497 (vd)
IF IBEVTP0=IBEVTA0
IF IBEVTP1=IBEVTA1
IF IBEVTP2=IBEVTA2
IF IBEVTP3=IBEVTA3
IF IBEVTP7=IBEVTA7
GOTO EVTQ
+28 SET X="IBCN NEW INSURANCE EVENTS"
SET DIC=101
DO EN1^XQOR
EVTQ KILL X,DIC,IBEVTP0,IBEVTP1,IBEVTP2,IBEVTA0,IBEVTA1,IBEVTA2,IBEVTACT
+1 ; IB*2.0*497 (vd)
KILL IBEVTP3,IBEVTP7,IBEVTA3,IBEVTA7
+2 QUIT
+3 ;
BEFORE ; -- get insurance type values before adding/editing
+1 ;
+2 ; IB*2.0*497 (vd)
IF $GET(IBNEW)
SET (IBEVTP0,IBEVTP1,IBEVTP2,IBEVTP3,IBEVTP7)=""
GOTO BEFQ
+3 SET IBEVTP0=$GET(^DPT(DFN,.312,IBCDFN,0))
+4 SET IBEVTP1=$GET(^DPT(DFN,.312,IBCDFN,1))
+5 SET IBEVTP2=$GET(^DPT(DFN,.312,IBCDFN,2))
+6 ; IB*2.0*497 (vd)
SET IBEVTP3=$GET(^DPT(DFN,.312,IBCDFN,3))
+7 ; IB*2.0*497 (vd)
SET IBEVTP7=$GET(^DPT(DFN,.312,IBCDFN,7))
BEFQ QUIT
+1 ;
AFTER ; -- get insurance type values after adding/editing. set action flag.
+1 ; -- get exemption after change
+2 ; input =: DFN = patient file ien
+3 ;
+4 SET IBEVTA0=$GET(^DPT(DFN,.312,IBCDFN,0))
+5 SET IBEVTA1=$GET(^DPT(DFN,.312,IBCDFN,1))
+6 SET IBEVTA2=$GET(^DPT(DFN,.312,IBCDFN,2))
+7 ; IB*2.0*497 (vd)
SET IBEVTA3=$GET(^DPT(DFN,.312,IBCDFN,3))
+8 ; IB*2.0*497 (vd)
SET IBEVTA7=$GET(^DPT(DFN,.312,IBCDFN,7))
+9 IF IBEVTP0=""
IF IBEVTA0'=""
SET IBEVTACT="ADD"
+10 IF IBEVTP0'=""
IF IBEVTA0'=""
SET IBEVTACT="EDT"
+11 IF IBEVTP0'=""
IF IBEVTA0=""
SET IBEVTACT="DEL"
+12 QUIT
