IBCNSEVT.m

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 ---IBCNSEVT   2967     printed  Apr 09, 2024@21:16:07                                                                                                                                                                                                    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