IBCNSJ1 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN ;05-MAY-2015
;;2.0;INTEGRATED BILLING;**28,549**; 21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
IA ; 'Inactivate Plan' Action
; Required variable input:
; DFN -- Pointer to the patient in file #2
; IBPPOL -- Patient insurance policy definition
;
D FULL^VALM1
I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D G IAQ
. W !!,"Sorry, but you do not have the required privileges to inactivate plans."
;
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,"Sorry, but you do not have the required privileges to inactivate plans."
. D IAQ
;
N IBCNS,IBPLAN,IBPLAND,IBPICK,IBQUIT,X
S X=+$P($G(IBPPOL),"^",4),X=$G(^DPT(DFN,.312,X,0))
S IBCNS=+X,IBPLAN=+$P(X,"^",18),(IBPICK,IBQUIT)=0
I 'IBPLAN D NOPL^IBCNSJ2 G IAQ
S IBPLAND=$G(^IBA(355.3,+IBPLAN,0))
I 'IBPLAND W !!,"This plan has no company! Please contact your IRM for assistance." G IAQ
I IBCNS'=+IBPLAND D PLAN^IBCNSM32(DFN,+$P($G(IBPPOL),"^",4),+IBPLAND) G IAQ
;
; - inactivate multiple plans?
S X=$$ASK^IBCNSJ4 G:X<0 IAQ I X D EN^IBCNSJ4 G IAQ
;
W !!,"This action will allow you to inactivate an insurance plan."
W !,"Inactivating a plan will inactivate all current subscribers to the plan."
;
; - main processing loop
F D Q:IBQUIT
.I IBPICK D SEL^IBCNSJ14 Q:IBQUIT
.;
.; - invoke inactivate function
.S IBPICK=1
.D INACT(IBCNS,IBPLAN)
.;
.; - select and inactivate another plan?
.S DIR(0)="Y",DIR("A")="Do you wish to inactivate another plan",DIR("?")="To inactivate another plan, answer 'YES.' Otherwise, answer 'NO.'"
.W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT I 'Y S IBQUIT=1
;
IAQ ;
D PAUSE^VALM1
D HDR^IBCNSP,BLD^IBCNSP
S VALMBCK="R"
Q
;
;
INACT(IBCNS,IBPLAN) ; Inactivate an Insurance Plan
; Input: IBCNS -- Pointer to the company in file #36 which
; IBPLAN -- Pointer to the plan in file #355.3
;
N DA,DIK,IBX,IBPLAND,IBNEWP,IBFG
N DFN,IBACT,IBSUB,IBQUIT,IBCDFN,IBREP,IBCPOL,IBALR,IBMAIL,IBBU,IBARR
S IBPLAND=$G(^IBA(355.3,IBPLAN,0))
D DISP
I 'IBPLAND!(+IBPLAND'=+$G(IBCNS)) W !!,"This is not a valid insurance plan!" G INACTQ
;
; - is the plan an Individual Plan?
I '$P(IBPLAND,"^",2) D G INACTQ
.W !,"You cannot inactivate an Individual Plan!"
.W !!,"You must either delete the policy using the 'Delete Policy' action,"
.W !,"or change the plan to which the patient has subscribed, using the action"
.W !,"'Change Policy Plan'."
;
; - handle inactive plans
S IBACT=$P(IBPLAND,"^",11),IBSUB=$$SUBS^IBCNSJ(IBCNS,IBPLAN,1)
I IBACT D NOTACT^IBCNSJ11 G INACTQ
;
; - inactivate plan if there are no plan subscriptions
I 'IBSUB D NAC^IBCNSJ12(IBPLAN,"There are no subscribers to this plan. Would you like to inactivate it",1) G INACTQ
;
; - display plan attributes
W !,"There are currently subscribers to this plan."
I $D(^IBA(355.4,"APY",IBPLAN)) W !,*7," ** There are Annual Benefits associated with this plan!"
I $D(^IBA(355.5,"B",IBPLAN)) S IBBU=1 W !,*7," ** There are Benefits Used associated with this plan!"
;
; - should subscriptions to this plan be switched to another plan?
S DIR(0)="Y",DIR("A")="Would you like to re-point these policies to a new plan",DIR("?")="^D HLRP^IBCNSJ11"
W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
I 'Y D MAIL^IBCNSJ11 G OKAY
;
; - select or add a new plan to re-point the policies
S IBREP=1,IBFG=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"",1)>1
D GETPL^IBCNSJ12
I 'IBCPOL S IBREP=0 D MAIL^IBCNSJ11 G OKAY
;
; - alert user that current plan has benefits used
I $G(IBBU) D BU^IBCNSJ13(.IBQUIT) I IBQUIT G INACTQ
;
OKAY ; - okay to inactivate the plan?
D DISP,NAC^IBCNSJ12(IBPLAN," Okay to inactivate this plan",0,.IBQUIT) I IBQUIT G INACTQ
;
; - if there is no-repointing, send the user the subscription list
I $G(IBMAIL) D MSG^IBCNSJ12(IBCNS,IBPLAN)
;
; - re-point existing policies if necessary; allow plan deletion
I $G(IBREP) D REP^IBCNSJ13(IBCNS,IBCPOL,IBPLAN,$G(IBMERGE)),DEL^IBCNSJ11(IBPLAN)
INACTQ Q
;
DISP ; Display plan name/number.
W !!,$S($P(IBPLAND,"^",2):"Group",1:"Individual")," Plan Number: ",$S($P(IBPLAND,"^",4)]"":$P(IBPLAND,"^",4),1:"<not specified>"),?50,"Plan Name: ",$S($P(IBPLAND,"^",3)]"":$P(IBPLAND,"^",3),1:"<not specified>"),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ1 4411 printed Dec 13, 2024@02:17:12 Page 2
IBCNSJ1 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN ;05-MAY-2015
+1 ;;2.0;INTEGRATED BILLING;**28,549**; 21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
IA ; 'Inactivate Plan' Action
+1 ; Required variable input:
+2 ; DFN -- Pointer to the patient in file #2
+3 ; IBPPOL -- Patient insurance policy definition
+4 ;
+5 DO FULL^VALM1
+6 IF '$DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))
Begin DoDot:1
+7 WRITE !!,"Sorry, but you do not have the required privileges to inactivate plans."
End DoDot:1
GOTO IAQ
+8 ;
+9 ;IB*2.0*549 - Added Security Key check
+10 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+11 WRITE !!,"Sorry, but you do not have the required privileges to inactivate plans."
+12 DO IAQ
End DoDot:1
QUIT
+13 ;
+14 NEW IBCNS,IBPLAN,IBPLAND,IBPICK,IBQUIT,X
+15 SET X=+$PIECE($GET(IBPPOL),"^",4)
SET X=$GET(^DPT(DFN,.312,X,0))
+16 SET IBCNS=+X
SET IBPLAN=+$PIECE(X,"^",18)
SET (IBPICK,IBQUIT)=0
+17 IF 'IBPLAN
DO NOPL^IBCNSJ2
GOTO IAQ
+18 SET IBPLAND=$GET(^IBA(355.3,+IBPLAN,0))
+19 IF 'IBPLAND
WRITE !!,"This plan has no company! Please contact your IRM for assistance."
GOTO IAQ
+20 IF IBCNS'=+IBPLAND
DO PLAN^IBCNSM32(DFN,+$PIECE($GET(IBPPOL),"^",4),+IBPLAND)
GOTO IAQ
+21 ;
+22 ; - inactivate multiple plans?
+23 SET X=$$ASK^IBCNSJ4
if X<0
GOTO IAQ
IF X
DO EN^IBCNSJ4
GOTO IAQ
+24 ;
+25 WRITE !!,"This action will allow you to inactivate an insurance plan."
+26 WRITE !,"Inactivating a plan will inactivate all current subscribers to the plan."
+27 ;
+28 ; - main processing loop
+29 FOR
Begin DoDot:1
+30 IF IBPICK
DO SEL^IBCNSJ14
if IBQUIT
QUIT
+31 ;
+32 ; - invoke inactivate function
+33 SET IBPICK=1
+34 DO INACT(IBCNS,IBPLAN)
+35 ;
+36 ; - select and inactivate another plan?
+37 SET DIR(0)="Y"
SET DIR("A")="Do you wish to inactivate another plan"
SET DIR("?")="To inactivate another plan, answer 'YES.' Otherwise, answer 'NO.'"
+38 WRITE !
DO ^DIR
KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
IF 'Y
SET IBQUIT=1
End DoDot:1
if IBQUIT
QUIT
+39 ;
IAQ ;
+1 DO PAUSE^VALM1
+2 DO HDR^IBCNSP
DO BLD^IBCNSP
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
+6 ;
INACT(IBCNS,IBPLAN) ; Inactivate an Insurance Plan
+1 ; Input: IBCNS -- Pointer to the company in file #36 which
+2 ; IBPLAN -- Pointer to the plan in file #355.3
+3 ;
+4 NEW DA,DIK,IBX,IBPLAND,IBNEWP,IBFG
+5 NEW DFN,IBACT,IBSUB,IBQUIT,IBCDFN,IBREP,IBCPOL,IBALR,IBMAIL,IBBU,IBARR
+6 SET IBPLAND=$GET(^IBA(355.3,IBPLAN,0))
+7 DO DISP
+8 IF 'IBPLAND!(+IBPLAND'=+$GET(IBCNS))
WRITE !!,"This is not a valid insurance plan!"
GOTO INACTQ
+9 ;
+10 ; - is the plan an Individual Plan?
+11 IF '$PIECE(IBPLAND,"^",2)
Begin DoDot:1
+12 WRITE !,"You cannot inactivate an Individual Plan!"
+13 WRITE !!,"You must either delete the policy using the 'Delete Policy' action,"
+14 WRITE !,"or change the plan to which the patient has subscribed, using the action"
+15 WRITE !,"'Change Policy Plan'."
End DoDot:1
GOTO INACTQ
+16 ;
+17 ; - handle inactive plans
+18 SET IBACT=$PIECE(IBPLAND,"^",11)
SET IBSUB=$$SUBS^IBCNSJ(IBCNS,IBPLAN,1)
+19 IF IBACT
DO NOTACT^IBCNSJ11
GOTO INACTQ
+20 ;
+21 ; - inactivate plan if there are no plan subscriptions
+22 IF 'IBSUB
DO NAC^IBCNSJ12(IBPLAN,"There are no subscribers to this plan. Would you like to inactivate it",1)
GOTO INACTQ
+23 ;
+24 ; - display plan attributes
+25 WRITE !,"There are currently subscribers to this plan."
+26 IF $DATA(^IBA(355.4,"APY",IBPLAN))
WRITE !,*7," ** There are Annual Benefits associated with this plan!"
+27 IF $DATA(^IBA(355.5,"B",IBPLAN))
SET IBBU=1
WRITE !,*7," ** There are Benefits Used associated with this plan!"
+28 ;
+29 ; - should subscriptions to this plan be switched to another plan?
+30 SET DIR(0)="Y"
SET DIR("A")="Would you like to re-point these policies to a new plan"
SET DIR("?")="^D HLRP^IBCNSJ11"
+31 WRITE !
DO ^DIR
KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
+32 IF 'Y
DO MAIL^IBCNSJ11
GOTO OKAY
+33 ;
+34 ; - select or add a new plan to re-point the policies
+35 SET IBREP=1
SET IBFG=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"",1)>1
+36 DO GETPL^IBCNSJ12
+37 IF 'IBCPOL
SET IBREP=0
DO MAIL^IBCNSJ11
GOTO OKAY
+38 ;
+39 ; - alert user that current plan has benefits used
+40 IF $GET(IBBU)
DO BU^IBCNSJ13(.IBQUIT)
IF IBQUIT
GOTO INACTQ
+41 ;
OKAY ; - okay to inactivate the plan?
+1 DO DISP
DO NAC^IBCNSJ12(IBPLAN," Okay to inactivate this plan",0,.IBQUIT)
IF IBQUIT
GOTO INACTQ
+2 ;
+3 ; - if there is no-repointing, send the user the subscription list
+4 IF $GET(IBMAIL)
DO MSG^IBCNSJ12(IBCNS,IBPLAN)
+5 ;
+6 ; - re-point existing policies if necessary; allow plan deletion
+7 IF $GET(IBREP)
DO REP^IBCNSJ13(IBCNS,IBCPOL,IBPLAN,$GET(IBMERGE))
DO DEL^IBCNSJ11(IBPLAN)
INACTQ QUIT
+1 ;
DISP ; Display plan name/number.
+1 WRITE !!,$SELECT($PIECE(IBPLAND,"^",2):"Group",1:"Individual")," Plan Number: ",$SELECT($PIECE(IBPLAND,"^",4)]"":$PIECE(IBPLAND,"^",4),1:"<not specified>"),?50,"Plan Name: ",$SELECT($PIECE(IBPLAND,"^",3)]"":$PIECE(IBPLAND,"^",3),1:"<not specifi
ed>"),!
+2 QUIT
