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

IBCNSUX.m

Go to the documentation of this file. 
  1. IBCNSUX ;ALB/CMS - SPLIT MEDICARE COMBINATION PLANS ; 29-OCT-98
  1.  ;;2.0;INTEGRATED BILLING;**103,516**;21-MAR-94;Build 123
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; Entry point from option.
  1.  I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,1:0) W !!?3,"The variable DUZ must be set to an active user code before continuing." G ENQ
  1.  W !!,?5,"SPLIT MEDICARE PART A /PART B COMBINATION PLANS"
  1.  W !!,?5,"WARNING: CAUTION SHOULD BE TAKEN WHEN USING THIS OPTION!!"
  1.  W !!,?5,"This option should ONLY be used at sites that have created a"
  1.  W !,?5,"Medicare, Will Not Reimburse, Insurance Company which has a"
  1.  W !,?5,"non-standard Group plan associated with it that combines Part A"
  1.  W !,?5,"and Part B coverage.",!
  1.  W !,?5,"Make sure the correct plan is selected. This option will create"
  1.  W !,?5,"a Part B policy for each subscriber and edit the existing policy"
  1.  W !,?5,"to point it to the standard Medicare Part A policy."
  1.  W !!,$TR($J("",75)," ","-")
  1.  ;
  1.  N IBINS,IBPLAN,IBQUIT,IBWNR,X,Y
  1.  S IBWNR=$$GETWNR^IBCNSMM1,IBQUIT=0
  1.  I 'IBWNR W !!,*7,?5,IBWNR G ENQ
  1.  ;
  1.  ;I DT>2990301 W !!,*7,?5,"This option cannot be run after March 3, 1999."
  1.  ;
  1.  D SEL I IBQUIT G ENQ
  1.  ;
  1.  W !,"ALL POLICIES ENTERED FOR THE SELECTED COMBINATION PLAN WILL BE CHANGED"
  1.  W !,"TO BE ASSOCIATED WITH MEDICARE PART A AND A NEW POLICY CREATED FOR "
  1.  W !,"MEDICARE PART B.  THE COMBINATION PLAN WILL BE DELETED IF EMPTY!"
  1.  ;
  1.  D OKAY I IBQUIT G ENQ
  1.  ;
  1.  ; -- Ask Device
  1.  N IBX,%ZIS,ZTRTN,ZTSAVE,ZTDESC
  1.  W !,?10,"You should send the output to a printer.",!
  1.  S %ZIS="QM" D ^%ZIS G:POP QUEQ
  1.  I $D(IO("Q")) K IO("Q") D  G QUEQ
  1.  .F IBX="IBINS","IBPLAN","IBWNR" S ZTSAVE(IBX)=""
  1.  .S ZTRTN="BEG^IBCNSUX1",ZTDESC="IB - Separate Medicare Combination policies"
  1.  .D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1.  ;
  1.  U IO
  1.  I $E(IOST,1,2)["C-" W !!,?15,"...... One Moment Please ..."
  1.  D BEG^IBCNSUX1
  1.  ;
  1. QUEQ ; Exit Clean-up
  1.  W ! D ^%ZISC
  1.  ;
  1. ENQ Q
  1.  ;
  1. SEL ; Select a MEDICARE company and plan.
  1.  ;  Output:   IBINS  --  Pointer to selected company in file #36
  1.  ;           IBPLAN  --  Pointer to selected/added plan in file #355.3
  1.  ;           IBQUIT  --  Set to 1 if the user wants to quit.
  1.  ;
  1.  N DA,DIC,DIRUT,DIROUT,DTOUT,DUOUT,DR,IBX,IBY,X,Y,IBSUBS
  1.  S IBY=$O(^IBE(355.2,"B","MEDICARE",0))
  1.  S DIC(0)="QEAMZ",DIC="^DIC(36,"
  1.  S DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1),$P($G(^DIC(36,+Y,0)),U,13)=IBY"
  1.  S DIC("A")="Select MEDICARE INSURANCE COMPANY: "
  1.  D ^DIC K DIC S IBINS=+Y
  1.  I Y<0 W "   <No Insurance Company selected>" S IBQUIT=1 G SELQ
  1.  ;
  1. SELP ; - select the Combination Plan
  1.  ; MRD;IB*2.0*516 - Display new Group Name and Number fields.
  1.  K DIC
  1.  S DIC("A")="Select COMBINATION GROUP PLAN: "
  1.  S DIC="^IBA(355.3,",DIC(0)="AEQMZ"
  1.  S DIC("S")="I +^(0)=IBINS,$P(^(0),U,2)"
  1.  ;S DIC("W")="N IBX S IBX=$G(^(0)) W ""   Name: "",$E($S($P(IBX,U,3)]"""":$P(IBX,U,3),1:""<none>"")_$J("""",20),1,20),""   Number: "",$S($P(IBX,U,4)]"""":$P(IBX,U,4),1:""<none>"")"
  1.  S DIC("W")="N IBX S IBX=$G(^(2)) W ""   Name: "",$E($S($P(IBX,U,1)]"""":$P(IBX,U,1),1:""<none>"")_$J("""",20),1,20),""   Number: "",$E($S($P(IBX,U,2)]"""":$P(IBX,U,2),1:""<none>""),1,14)"
  1.  D ^DIC K DIC S IBPLAN=+Y
  1.  I IBPLAN=$P(IBWNR,U,3) W !!,?5,*7,"* Cannot select standard Part A plan" G SELP
  1.  I IBPLAN=$P(IBWNR,U,5) W !!,?5,*7,"* Cannot select standard Part B plan" G SELP
  1.  I Y<0 W !!,?5,*7,"*  No plan selected!",! S IBQUIT=1 G SELQ
  1.  W !!,"Collecting Subscribers ..."
  1.  S IBSUBS=$$SUBS^IBCNSJ(IBINS,IBPLAN)
  1.  W !!,?5,"This plan has ",IBSUBS," subscriber",$S(IBSUBS=1:"",1:"s"),"."
  1.  W:'IBSUBS !?5,"You must select a plan with subscribers!  Please select another plan."
  1.  W !! I 'IBSUBS G SELP
  1.  ;
  1. SELQ Q
  1.  ;
  1. OKAY ; -- Ask Okay to Continue
  1.  ;    Returns IBQUIT=1 to exit
  1.  N DIR,DTOUT,DIROUT,DIRUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("B")="NO",DIR("A")="Okay to Continue"
  1.  S DIR("?")="Enter 'Yes' to separate combination policies"
  1.  W ! D ^DIR
  1.  I $G(Y)'=1 S IBQUIT=1
  1.  Q