- 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 Feb 18, 2025@23:43:31 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