| [613] | 1 | IBCNSJ1 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN ; 30-DEC-94
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | IA ; 'Inactivate Plan' Action
|
|---|
| 6 | ; Required variable input:
|
|---|
| 7 | ; DFN -- Pointer to the patient in file #2
|
|---|
| 8 | ; IBPPOL -- Patient insurance policy definition
|
|---|
| 9 | ;
|
|---|
| 10 | D FULL^VALM1
|
|---|
| 11 | I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) W !!,"Sorry, but you do not have the required privileges to inactivate plans." G IAQ
|
|---|
| 12 | N IBCNS,IBPLAN,IBPLAND,IBPICK,IBQUIT,X
|
|---|
| 13 | S X=+$P($G(IBPPOL),"^",4),X=$G(^DPT(DFN,.312,X,0))
|
|---|
| 14 | S IBCNS=+X,IBPLAN=+$P(X,"^",18),(IBPICK,IBQUIT)=0
|
|---|
| 15 | I 'IBPLAN D NOPL^IBCNSJ2 G IAQ
|
|---|
| 16 | S IBPLAND=$G(^IBA(355.3,+IBPLAN,0)) I 'IBPLAND W !!,"This plan has no company! Please contact your IRM for assistance." G IAQ
|
|---|
| 17 | I IBCNS'=+IBPLAND D PLAN^IBCNSM32(DFN,+$P($G(IBPPOL),"^",4),+IBPLAND) G IAQ
|
|---|
| 18 | ;
|
|---|
| 19 | ; - inactivate multiple plans?
|
|---|
| 20 | S X=$$ASK^IBCNSJ4 G:X<0 IAQ I X D EN^IBCNSJ4 G IAQ
|
|---|
| 21 | ;
|
|---|
| 22 | W !!,"This action will allow you to inactivate an insurance plan."
|
|---|
| 23 | W !,"Inactivating a plan will inactivate all current subscribers to the plan."
|
|---|
| 24 | ;
|
|---|
| 25 | ; - main processing loop
|
|---|
| 26 | F D Q:IBQUIT
|
|---|
| 27 | .I IBPICK D SEL^IBCNSJ14 Q:IBQUIT
|
|---|
| 28 | .;
|
|---|
| 29 | .; - invoke inactivate function
|
|---|
| 30 | .S IBPICK=1
|
|---|
| 31 | .D INACT(IBCNS,IBPLAN)
|
|---|
| 32 | .;
|
|---|
| 33 | .; - select and inactivate another plan?
|
|---|
| 34 | .S DIR(0)="Y",DIR("A")="Do you wish to inactivate another plan",DIR("?")="To inactivate another plan, answer 'YES.' Otherwise, answer 'NO.'"
|
|---|
| 35 | .W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT I 'Y S IBQUIT=1
|
|---|
| 36 | ;
|
|---|
| 37 | IAQ D PAUSE^VALM1
|
|---|
| 38 | D HDR^IBCNSP,BLD^IBCNSP S VALMBCK="R"
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | INACT(IBCNS,IBPLAN) ; Inactivate an Insurance Plan
|
|---|
| 43 | ; Input: IBCNS -- Pointer to the company in file #36 which
|
|---|
| 44 | ; IBPLAN -- Pointer to the plan in file #355.3
|
|---|
| 45 | ;
|
|---|
| 46 | N DA,DIK,IBX,IBPLAND,IBNEWP,IBFG
|
|---|
| 47 | N DFN,IBACT,IBSUB,IBQUIT,IBCDFN,IBREP,IBCPOL,IBALR,IBMAIL,IBBU,IBARR
|
|---|
| 48 | S IBPLAND=$G(^IBA(355.3,IBPLAN,0))
|
|---|
| 49 | D DISP
|
|---|
| 50 | I 'IBPLAND!(+IBPLAND'=+$G(IBCNS)) W !!,"This is not a valid insurance plan!" G INACTQ
|
|---|
| 51 | ;
|
|---|
| 52 | ; - is the plan an Individual Plan?
|
|---|
| 53 | I '$P(IBPLAND,"^",2) D G INACTQ
|
|---|
| 54 | .W !,"You cannot inactivate an Individual Plan!"
|
|---|
| 55 | .W !!,"You must either delete the policy using the 'Delete Policy' action,"
|
|---|
| 56 | .W !,"or change the plan to which the patient has subscribed, using the action"
|
|---|
| 57 | .W !,"'Change Policy Plan'."
|
|---|
| 58 | ;
|
|---|
| 59 | ; - handle inactive plans
|
|---|
| 60 | S IBACT=$P(IBPLAND,"^",11),IBSUB=$$SUBS^IBCNSJ(IBCNS,IBPLAN,1)
|
|---|
| 61 | I IBACT D NOTACT^IBCNSJ11 G INACTQ
|
|---|
| 62 | ;
|
|---|
| 63 | ; - inactivate plan if there are no plan subscriptions
|
|---|
| 64 | I 'IBSUB D NAC^IBCNSJ12(IBPLAN,"There are no subscribers to this plan. Would you like to inactivate it",1) G INACTQ
|
|---|
| 65 | ;
|
|---|
| 66 | ; - display plan attributes
|
|---|
| 67 | W !,"There are currently subscribers to this plan."
|
|---|
| 68 | I $D(^IBA(355.4,"APY",IBPLAN)) W !,*7," ** There are Annual Benefits associated with this plan!"
|
|---|
| 69 | I $D(^IBA(355.5,"B",IBPLAN)) S IBBU=1 W !,*7," ** There are Benefits Used associated with this plan!"
|
|---|
| 70 | ;
|
|---|
| 71 | ; - should subscriptions to this plan be switched to another plan?
|
|---|
| 72 | S DIR(0)="Y",DIR("A")="Would you like to re-point these policies to a new plan",DIR("?")="^D HLRP^IBCNSJ11"
|
|---|
| 73 | W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
|
|---|
| 74 | I 'Y D MAIL^IBCNSJ11 G OKAY
|
|---|
| 75 | ;
|
|---|
| 76 | ; - select or add a new plan to re-point the policies
|
|---|
| 77 | S IBREP=1,IBFG=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"",1)>1
|
|---|
| 78 | D GETPL^IBCNSJ12
|
|---|
| 79 | I 'IBCPOL S IBREP=0 D MAIL^IBCNSJ11 G OKAY
|
|---|
| 80 | ;
|
|---|
| 81 | ; - alert user that current plan has benefits used
|
|---|
| 82 | I $G(IBBU) D BU^IBCNSJ13(.IBQUIT) I IBQUIT G INACTQ
|
|---|
| 83 | ;
|
|---|
| 84 | OKAY ; - okay to inactivate the plan?
|
|---|
| 85 | D DISP,NAC^IBCNSJ12(IBPLAN," Okay to inactivate this plan",0,.IBQUIT) I IBQUIT G INACTQ
|
|---|
| 86 | ;
|
|---|
| 87 | ; - if there is no-repointing, send the user the subscription list
|
|---|
| 88 | I $G(IBMAIL) D MSG^IBCNSJ12(IBCNS,IBPLAN)
|
|---|
| 89 | ;
|
|---|
| 90 | ; - re-point existing policies if necessary; allow plan deletion
|
|---|
| 91 | I $G(IBREP) D REP^IBCNSJ13(IBCNS,IBCPOL,IBPLAN,$G(IBMERGE)),DEL^IBCNSJ11(IBPLAN)
|
|---|
| 92 | INACTQ Q
|
|---|
| 93 | ;
|
|---|
| 94 | DISP ; Display plan name/number.
|
|---|
| 95 | 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>"),!
|
|---|
| 96 | Q
|
|---|
