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