| [613] | 1 | IBCNSUR ;ALB/CPM/CMS - MOVE SUBSCRIBERS TO DIFFERENT PLAN ;09-SEP-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**103,276**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | EN ; Entry point from option. Main processing loop.
|
|---|
| 7 | 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
|
|---|
| 8 | W !!,?5,"MOVE SUBSCRIBERS OF ONE PLAN TO ANOTHER PLAN"
|
|---|
| 9 | W !,?5,"This option may be used to move subscribers from a selected Plan"
|
|---|
| 10 | W !,?5,"to a different Plan. The plans may be associated with the same"
|
|---|
| 11 | W !,?5,"Insurance Company or a different one. Plan and Annual Benefit"
|
|---|
| 12 | W !,?5,"information may be moved as well. Users of this option should"
|
|---|
| 13 | W !,?5,"be knowledgeable of the VistA Patient Insurance management options."
|
|---|
| 14 | W !
|
|---|
| 15 | W !,?5,"This option also gives the user the option to expire the old plan or"
|
|---|
| 16 | W !,?5,"replace it completely in the patient insurance profile. The reason"
|
|---|
| 17 | W !,?5,"to expire the old plan is intended for use when Insurance groups change"
|
|---|
| 18 | W !,?5,"PBMs for processing electronic Pharmacy claims. By leaving the old"
|
|---|
| 19 | W !,?5,"plan information intact (i.e. do not replace), the user will be able"
|
|---|
| 20 | W !,?5,"to monitor PBM changes that affect the electronic Pharmacy claims."
|
|---|
| 21 | ;
|
|---|
| 22 | W !!,$TR($J("",75)," ","-")
|
|---|
| 23 | S IBSTOP=0 F D PROC^IBCNSUR1 Q:IBSTOP
|
|---|
| 24 | ENQ K IBSTOP
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | PROC ; - Process continuation from IBCNSUR1.
|
|---|
| 28 | ; - display old plan attributes; allow new plan to be edited
|
|---|
| 29 | D PL^IBCNSUR2
|
|---|
| 30 | R !!,?10,"Press any key to continue. ",IBX:DTIME
|
|---|
| 31 | ;
|
|---|
| 32 | ; - display coverage limitations; allow add/edit of plan 2 limitations
|
|---|
| 33 | D LIM^IBCNSUR2
|
|---|
| 34 | ;
|
|---|
| 35 | I $P($G(^IBA(355.3,IBP1,0)),"^",11) W !!,"Please note that ",IBC1N,"'s",!,"plan, subscribers were moved from, is already inactive." G PROCDP
|
|---|
| 36 | ;
|
|---|
| 37 | ; - does the user wish to inactivate the old plan?
|
|---|
| 38 | W !! S DIR(0)="Y",DIR("A")="Do you wish to inactivate "_IBC1N_"'s plan subscribers were moved from"
|
|---|
| 39 | S DIR("?")="If you wish to inactivate the old plan, enter 'Yes' - otherwise, enter 'No.'"
|
|---|
| 40 | D ^DIR K DIR I 'Y W !," <The old plan is still active>" G PROCQ
|
|---|
| 41 | ;
|
|---|
| 42 | D IRACT^IBCNSJ(IBP1,1) W !!,"The plan has been inactivated."
|
|---|
| 43 | ;
|
|---|
| 44 | PROCDP ; - does the user wish to delete the old plan?
|
|---|
| 45 | W !! S DIR(0)="Y",DIR("A")="Do you wish to delete this plan"
|
|---|
| 46 | S DIR("?")="If you wish to delete the old plan, enter 'Yes' - otherwise, enter 'No.'"
|
|---|
| 47 | D ^DIR K DIR I 'Y G PROCQ
|
|---|
| 48 | ;
|
|---|
| 49 | D DEL^IBCNSJ(IBP1) W !!,"The plan has been deleted."
|
|---|
| 50 | ;
|
|---|
| 51 | PROCQ Q
|
|---|
| 52 | ;
|
|---|
| 53 | ;
|
|---|
| 54 | SEL(IBNP) ; Select a company and plan.
|
|---|
| 55 | ; Input: IBNP -- If set to 1, allows adding a new plan and
|
|---|
| 56 | ; -- Screen Inactive Companies
|
|---|
| 57 | ; -- If set to 0, must have at least one group plan
|
|---|
| 58 | ; Output: IBCNS -- Pointer to selected company in file #36
|
|---|
| 59 | ; IBPLAN -- Pointer to selected/added plan in file #355.3
|
|---|
| 60 | ; IBQUIT -- Set to 1 if the user wants to quit.
|
|---|
| 61 | ;
|
|---|
| 62 | N X,Y K DIC,DIR
|
|---|
| 63 | S DIC(0)="QEAMZ",DIC="^DIC(36,"
|
|---|
| 64 | I 'IBNP S DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1)"
|
|---|
| 65 | I IBNP S DIC("S")="I '$P($G(^DIC(36,+Y,0)),U,5)"
|
|---|
| 66 | S DIC("A")="Select INSURANCE COMPANY: "
|
|---|
| 67 | D ^DIC K DIC S IBCNS=+Y
|
|---|
| 68 | I Y<0 W " <No Insurance Company selected>" S IBQUIT=1 G SELQ
|
|---|
| 69 | ;
|
|---|
| 70 | ; - if a new plan may be added, allow adding
|
|---|
| 71 | I IBNP D I (IBPLAN)!(IBQUIT) G SELQ
|
|---|
| 72 | .W !!,"You may add a new Plan at this time or select an existing Plan."
|
|---|
| 73 | .D NEW^IBCNSJ3(IBCNS,.IBPLAN,1)
|
|---|
| 74 | .I 'IBPLAN,'$$ANYGP^IBCNSJ(+IBCNS,0,1) W !!,*7,"Insurance Company receiving subscribers must have a Plan." S IBQUIT=1
|
|---|
| 75 | ;
|
|---|
| 76 | ; - see if user wants to select the plan
|
|---|
| 77 | W !!,"You may select an existing Plan from a list or enter a specific Plan.",!
|
|---|
| 78 | S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to enter a specific plan"
|
|---|
| 79 | S DIR("?")="The look-up facility to select a group plan has been enhanced to use the List Manager. Enter 'NO' if you wish to select a plan from this look-up, or 'YES' to directly enter a plan."
|
|---|
| 80 | D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G SELQ
|
|---|
| 81 | ;
|
|---|
| 82 | ; - invoke the plan look-up
|
|---|
| 83 | I 'Y D G SELQ
|
|---|
| 84 | .W " ..." S IBPLAN=0 D LKP^IBCNSU2(IBCNS,0,0,.IBPLAN,0,1)
|
|---|
| 85 | .I 'IBPLAN W !!,*7,"* No plan selected!",! S IBQUIT=1
|
|---|
| 86 | ;
|
|---|
| 87 | ; - allow a FileMan look-up
|
|---|
| 88 | S DIC("A")="Select a GROUP PLAN: "
|
|---|
| 89 | S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2)"
|
|---|
| 90 | 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>"")"
|
|---|
| 91 | D ^DIC K DIC S IBPLAN=+Y
|
|---|
| 92 | I Y<0 W !!,*7,"* No plan selected!",! S IBQUIT=1
|
|---|
| 93 | ;
|
|---|
| 94 | SELQ K DIRUT,DUOUT,DTOUT,DIROUT
|
|---|
| 95 | Q
|
|---|
