| [613] | 1 | IBCNSUR2 ;ALB/CPM/CMS - MOVE SUBSCRIBERS TO DIFFERENT PLAN (CON'T) ; 09-SEP-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**103,238**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | PL ; Display old plan attributes; allow new plan to be edited
|
|---|
| 7 | N IBP0,DA
|
|---|
| 8 | W @IOF,!!,"Now you may edit specific Plan attributes and Coverage Limitations."
|
|---|
| 9 | W !,"(Plan 1 is the plan subscribers moved from.)"
|
|---|
| 10 | W !,"(Plan 2 is the plan subscribers moved to.)"
|
|---|
| 11 | W !,$TR($J("",71)," ","=")
|
|---|
| 12 | W !,"'Plan 1' Attributes for: ",IBC1N
|
|---|
| 13 | S IBP0=$G(^IBA(355.3,IBP1,0)),DA=+IBP1
|
|---|
| 14 | W !?9,"Plan Name: ",IBP1N,?43,"Plan Number: ",IBP1X
|
|---|
| 15 | W !,$TR($J("",71)," ","-")
|
|---|
| 16 | W !,?19,"TYPE OF PLAN: ",$S($P(IBP0,"^",9):$P($G(^IBE(355.1,+$P(IBP0,"^",9),0)),"^"),1:"<Not Specified")
|
|---|
| 17 | W !,?11,"ELECTRONIC PLAN TYPE: ",$$EXPAND^IBTRE(355.3,.15,$P(IBP0,U,15)) ; TJH *238
|
|---|
| 18 | I $P(IBP0,U,14)]"" W !,?18,"PLAN CATEGORY: ",$$EXPAND^IBTRE(355.3,.14,$P(IBP0,U,14))
|
|---|
| 19 | W !,?9,"PLAN FILING TIME FRAME: ",$P(IBP0,U,13)
|
|---|
| 20 | W !," IS UTILIZATION REVIEW REQUIRED: ",$$YN($P(IBP0,"^",5))
|
|---|
| 21 | W !," AMBULATORY CARE CERTIFICATION: ",$$EXPAND^IBTRE(355.3,.12,$P(IBP0,U,12))
|
|---|
| 22 | W !," IS PRE-CERTIFICATION REQUIRED: ",$$YN($P(IBP0,"^",6))
|
|---|
| 23 | W !,"EXCLUDE PRE-EXISTING CONDITIONS: ",$$YN($P(IBP0,"^",7))
|
|---|
| 24 | W !?12,"BENEFITS ASSIGNABLE: ",$$YN($P(IBP0,"^",8))
|
|---|
| 25 | W !,$TR($J("",71)," ","=")
|
|---|
| 26 | ;
|
|---|
| 27 | W !!,"Editing 'Plan 2' Attributes for: ",IBC2N
|
|---|
| 28 | S IBP0=$G(^IBA(355.3,IBP2,0))
|
|---|
| 29 | W !?9,"Plan Name: ",IBP2N,?43,"Plan Number: ",IBP2X,!
|
|---|
| 30 | ;
|
|---|
| 31 | S DIE="^IBA(355.3,",DA=IBP2
|
|---|
| 32 | S DR=".09;.15;I $P($G(^IBE(355.1,+$P($G(^IBA(355.3,DA,0)),U,9),0)),U,3)'=5 S Y=""@10"";.14;@10;.13;.05;.12;.06:.08"
|
|---|
| 33 | D ^DIE K DA,DIE,DR
|
|---|
| 34 | ;
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | YN(X) ; Resolve the 'Yes/No' value.
|
|---|
| 39 | Q $S($G(X)="":"<Not Specified>",X:"YES",X=0:"NO",1:"<Not Specified>")
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | LIM ; Display/Edit Coverage Limitations.
|
|---|
| 43 | W @IOF,!,$TR($J("",71)," ","=")
|
|---|
| 44 | D LIMDSP(IBC1,IBP1,1)
|
|---|
| 45 | W !,$TR($J("",71)," ","-")
|
|---|
| 46 | D LIMDSP(IBC2,IBP2,2)
|
|---|
| 47 | W !,$TR($J("",71)," ","=")
|
|---|
| 48 | ;
|
|---|
| 49 | ; - does the user wish to edit the plan coverage limitations?
|
|---|
| 50 | S DIR(0)="Y",DIR("A")="Do you wish to edit the 'Plan 2' Coverage Limitations"
|
|---|
| 51 | S DIR("?")="If you wish to edit the coverage limitations for the new plan, enter 'Yes.'"
|
|---|
| 52 | D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT I 'Y G LIMQ
|
|---|
| 53 | ;
|
|---|
| 54 | ; - allow the edit of coverage limitations for plan 2
|
|---|
| 55 | W !!,"Editing 'Plan 2' Coverage Limitations for: ",IBC2N
|
|---|
| 56 | S IBX=$G(^IBA(355.3,IBP2,0))
|
|---|
| 57 | W !?9,"Plan Name: ",IBP2N,?43,"Plan Number: ",IBP2X
|
|---|
| 58 | ;
|
|---|
| 59 | S IBCPOL=IBP2 D EDCOV^IBCNSJ51 K VALMBCK
|
|---|
| 60 | ; The call below is to clean up List Man variables from IBCNSJ51
|
|---|
| 61 | ; the call to FULL^VALM sets variables. Or modify IBCNSJ51
|
|---|
| 62 | S IBROU="IBCNSJ51",IBTOP="T" D EN^VALM(IBROU,IBTOP) K IBROU,IBTOP
|
|---|
| 63 | ;
|
|---|
| 64 | LIMQ Q
|
|---|
| 65 | ;
|
|---|
| 66 | ;
|
|---|
| 67 | LIMDSP(IBC,IBP,IBPNUM) ; Display coverage limitations for a company/plan.
|
|---|
| 68 | N IBCOV,IBCOVD,IBCOVFN,IBCNT,IBP0,IBLEDT,IBLIM,IBLINE,IBX,IB0,IBS
|
|---|
| 69 | W !!," 'Plan ",IBPNUM,"' Coverage Limitations for ",$S(IBPNUM=1:IBC1N,1:IBC2N)
|
|---|
| 70 | S IBP0=$G(^IBA(355.3,IBP,0))
|
|---|
| 71 | W !?9,"Plan Name: ",$S($P(IBP0,U,3)]"":$P(IBP0,U,3),1:"<Not Specified>")
|
|---|
| 72 | W ?43,"Plan Number: ",$S($P(IBP0,U,4)]"":$P(IBP0,U,4),1:"<Not Specified>")
|
|---|
| 73 | W !!," Coverage Effective Date Covered? Limit Comments"
|
|---|
| 74 | W !," -------- -------------- -------- --------------"
|
|---|
| 75 | ;
|
|---|
| 76 | ; - display limitation for each type of coverage
|
|---|
| 77 | S IBLIM=0 F S IBLIM=$O(^IBE(355.31,IBLIM)) Q:'IBLIM S IBCOV=$P($G(^(IBLIM,0)),U) D
|
|---|
| 78 | .S IBCNT=0
|
|---|
| 79 | .S IBLEDT="" F S IBLEDT=$O(^IBA(355.32,"APCD",IBP,IBLIM,IBLEDT)) Q:$S(IBLEDT="":IBCNT,1:0) D Q:IBLEDT=""
|
|---|
| 80 | ..S IBCOVFN=+$O(^IBA(355.32,"APCD",IBP,IBLIM,+IBLEDT,"")),IBCOVD=$G(^IBA(355.32,+IBCOVFN,0))
|
|---|
| 81 | ..S IBCNT=IBCNT+1
|
|---|
| 82 | ..I IBCOVD="" S IBW=" "_$E(IBCOV_$J("",18),1,18)_$J("",19)_"BY DEFAULT" W !,IBW Q
|
|---|
| 83 | ..S IBX=" "_$E($S(IBCNT=1:IBCOV,1:"")_$J("",18),1,18) ;Don't dup category
|
|---|
| 84 | ..S IBX=IBX_" "_$E($$DAT1^IBOUTL($P(IBLEDT,"-",2))_$J("",8),1,8)_$J("",9)_$S($P(IBCOVD,U,4):$S($P(IBCOVD,U,4)<2:"YES"_$J("",8),$P(IBCOVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN "),1:"NO"_$J("",9))_$J("",4)
|
|---|
| 85 | ..W !,IBX
|
|---|
| 86 | ..S (IBS,IB0)=0 F S IB0=$O(^IBA(355.32,IBCOVFN,2,IB0)) Q:'IB0 W:IBS ! W ?54,$G(^(IB0,0)) S IBS=1
|
|---|
| 87 | ;
|
|---|
| 88 | Q
|
|---|
