Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSJ1

IBCNSJ1.m

Go to the documentation of this file. 
  1. IBCNSJ1 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN ;05-MAY-2015
  1.  ;;2.0;INTEGRATED BILLING;**28,549**; 21-MAR-94;Build 54
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. IA ; 'Inactivate Plan' Action
  1.  ;   Required variable input:
  1.  ;             DFN  --  Pointer to the patient in file #2
  1.  ;          IBPPOL  --  Patient insurance policy definition
  1.  ;
  1.  D FULL^VALM1
  1.  I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D  G IAQ
  1.  . W !!,"Sorry, but you do not have the required privileges to inactivate plans."
  1.  ;
  1.  ;IB*2.0*549 - Added Security Key check
  1.  I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D  Q
  1.  . W !!,"Sorry, but you do not have the required privileges to inactivate plans."
  1.  . D IAQ
  1.  ;
  1.  N IBCNS,IBPLAN,IBPLAND,IBPICK,IBQUIT,X
  1.  S X=+$P($G(IBPPOL),"^",4),X=$G(^DPT(DFN,.312,X,0))
  1.  S IBCNS=+X,IBPLAN=+$P(X,"^",18),(IBPICK,IBQUIT)=0
  1.  I 'IBPLAN D NOPL^IBCNSJ2 G IAQ
  1.  S IBPLAND=$G(^IBA(355.3,+IBPLAN,0))
  1.  I 'IBPLAND W !!,"This plan has no company!  Please contact your IRM for assistance." G IAQ
  1.  I IBCNS'=+IBPLAND D PLAN^IBCNSM32(DFN,+$P($G(IBPPOL),"^",4),+IBPLAND) G IAQ
  1.  ;
  1.  ; - inactivate multiple plans?
  1.  S X=$$ASK^IBCNSJ4 G:X<0 IAQ I X D EN^IBCNSJ4 G IAQ
  1.  ;
  1.  W !!,"This action will allow you to inactivate an insurance plan."
  1.  W !,"Inactivating a plan will inactivate all current subscribers to the plan."
  1.  ;
  1.  ; - main processing loop
  1.  F  D  Q:IBQUIT
  1.  .I IBPICK D SEL^IBCNSJ14 Q:IBQUIT
  1.  .;
  1.  .; - invoke inactivate function
  1.  .S IBPICK=1
  1.  .D INACT(IBCNS,IBPLAN)
  1.  .;
  1.  .; - select and inactivate another plan?
  1.  .S DIR(0)="Y",DIR("A")="Do you wish to inactivate another plan",DIR("?")="To inactivate another plan, answer 'YES.'  Otherwise, answer 'NO.'"
  1.  .W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT I 'Y S IBQUIT=1
  1.  ;
  1. IAQ ;
  1.  D PAUSE^VALM1
  1.  D HDR^IBCNSP,BLD^IBCNSP
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;
  1. INACT(IBCNS,IBPLAN) ; Inactivate an Insurance Plan
  1.  ;  Input:   IBCNS  --  Pointer to the company in file #36 which
  1.  ;          IBPLAN  --  Pointer to the plan in file #355.3
  1.  ;
  1.  N DA,DIK,IBX,IBPLAND,IBNEWP,IBFG
  1.  N DFN,IBACT,IBSUB,IBQUIT,IBCDFN,IBREP,IBCPOL,IBALR,IBMAIL,IBBU,IBARR
  1.  S IBPLAND=$G(^IBA(355.3,IBPLAN,0))
  1.  D DISP
  1.  I 'IBPLAND!(+IBPLAND'=+$G(IBCNS)) W !!,"This is not a valid insurance plan!" G INACTQ
  1.  ;
  1.  ; - is the plan an Individual Plan?
  1.  I '$P(IBPLAND,"^",2) D  G INACTQ
  1.  .W !,"You cannot inactivate an Individual Plan!"
  1.  .W !!,"You must either delete the policy using the 'Delete Policy' action,"
  1.  .W !,"or change the plan to which the patient has subscribed, using the action"
  1.  .W !,"'Change Policy Plan'."
  1.  ;
  1.  ; - handle inactive plans
  1.  S IBACT=$P(IBPLAND,"^",11),IBSUB=$$SUBS^IBCNSJ(IBCNS,IBPLAN,1)
  1.  I IBACT D NOTACT^IBCNSJ11 G INACTQ
  1.  ;
  1.  ; - inactivate plan if there are no plan subscriptions
  1.  I 'IBSUB D NAC^IBCNSJ12(IBPLAN,"There are no subscribers to this plan.  Would you like to inactivate it",1) G INACTQ
  1.  ;
  1.  ; - display plan attributes
  1.  W !,"There are currently subscribers to this plan."
  1.  I $D(^IBA(355.4,"APY",IBPLAN)) W !,*7,"  ** There are Annual Benefits associated with this plan!"
  1.  I $D(^IBA(355.5,"B",IBPLAN)) S IBBU=1 W !,*7,"  ** There are Benefits Used associated with this plan!"
  1.  ;
  1.  ; - should subscriptions to this plan be switched to another plan?
  1.  S DIR(0)="Y",DIR("A")="Would you like to re-point these policies to a new plan",DIR("?")="^D HLRP^IBCNSJ11"
  1.  W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1.  I 'Y D MAIL^IBCNSJ11 G OKAY
  1.  ;
  1.  ; - select or add a new plan to re-point the policies
  1.  S IBREP=1,IBFG=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"",1)>1
  1.  D GETPL^IBCNSJ12
  1.  I 'IBCPOL S IBREP=0 D MAIL^IBCNSJ11 G OKAY
  1.  ;
  1.  ; - alert user that current plan has benefits used
  1.  I $G(IBBU) D BU^IBCNSJ13(.IBQUIT) I IBQUIT G INACTQ
  1.  ;
  1. OKAY ; - okay to inactivate the plan?
  1.  D DISP,NAC^IBCNSJ12(IBPLAN,"  Okay to inactivate this plan",0,.IBQUIT) I IBQUIT G INACTQ
  1.  ;
  1.  ; - if there is no-repointing, send the user the subscription list
  1.  I $G(IBMAIL) D MSG^IBCNSJ12(IBCNS,IBPLAN)
  1.  ;
  1.  ; - re-point existing policies if necessary; allow plan deletion
  1.  I $G(IBREP) D REP^IBCNSJ13(IBCNS,IBCPOL,IBPLAN,$G(IBMERGE)),DEL^IBCNSJ11(IBPLAN)
  1. INACTQ Q
  1.  ;
  1. DISP ; Display plan name/number.
  1.  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>"),!
  1.  Q