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

IBCNSUR2.m

Go to the documentation of this file. 
  1. IBCNSUR2 ;ALB/CPM/CMS - MOVE SUBSCRIBERS TO DIFFERENT PLAN (CON'T) ; 09-SEP-96
  1.  ;;2.0;INTEGRATED BILLING;**103,238,399,595**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. PL ; Display old plan attributes; allow new plan to be edited
  1.  N IBP0,IBX,DA
  1.  W @IOF,!!,"Now you may edit specific Plan attributes and Coverage Limitations."
  1.  W !,"(Plan 1 is the plan subscribers moved from.)"
  1.  W !,"(Plan 2 is the plan subscribers moved to.)"
  1.  W !,$TR($J("",71)," ","=")
  1.  W !,"'Plan 1' Attributes for: ",IBC1N
  1.  S IBP0=$G(^IBA(355.3,IBP1,0)),DA=+IBP1
  1.  W !?9,"Plan Name: ",IBP1N,?43,"Plan Number: ",IBP1X
  1.  W !,$TR($J("",71)," ","-")
  1.  ; IB*2*595/DM display BIN and PCN number when moving subscribers 
  1.  S IBX=$$GET1^DIQ(355.3,IBP1_",","BANKING IDENTIFICATION NUMBER")
  1.  W !,"  BANKING IDENTIFICATION NUMBER:  ",$S(IBX'="":IBX,1:"<Not Specified>")
  1.  S IBX=$$GET1^DIQ(355.3,IBP1_",","PROCESSOR CONTROL NUMBER (PCN)")
  1.  W !," PROCESSOR CONTROL NUMBER (PCN):  ",$S(IBX'="":IBX,1:"<Not Specified>")
  1.  W !,?19,"TYPE OF PLAN:  ",$S($P(IBP0,"^",9):$P($G(^IBE(355.1,+$P(IBP0,"^",9),0)),"^"),1:"<Not Specified>")
  1.  W !,?11,"ELECTRONIC PLAN TYPE:  ",$$EXPAND^IBTRE(355.3,.15,$P(IBP0,U,15)) ; TJH *238
  1.  I $P(IBP0,U,14)]"" W !,?18,"PLAN CATEGORY:  ",$$EXPAND^IBTRE(355.3,.14,$P(IBP0,U,14))
  1.  W !,?9,"PLAN FILING TIME FRAME:  ",$P(IBP0,U,13) I +$P(IBP0,U,16) W "  (",$$FTFN^IBCNSU31(IBP1),")"
  1.  W !," IS UTILIZATION REVIEW REQUIRED:  ",$$YN($P(IBP0,"^",5))
  1.  W !,"  AMBULATORY CARE CERTIFICATION:  ",$$EXPAND^IBTRE(355.3,.12,$P(IBP0,U,12))
  1.  W !,"  IS PRE-CERTIFICATION REQUIRED:  ",$$YN($P(IBP0,"^",6))
  1.  W !,"EXCLUDE PRE-EXISTING CONDITIONS:  ",$$YN($P(IBP0,"^",7))
  1.  W !?12,"BENEFITS ASSIGNABLE:  ",$$YN($P(IBP0,"^",8))
  1.  W !,$TR($J("",71)," ","=")
  1.  ;
  1.  W !!,"Editing 'Plan 2' Attributes for: ",IBC2N
  1.  S IBP0=$G(^IBA(355.3,IBP2,0))
  1.  W !?9,"Plan Name: ",IBP2N,?43,"Plan Number: ",IBP2X,!
  1.  ;
  1.  S DIE="^IBA(355.3,",DA=IBP2
  1.  ; IB*2*595/DM allow users to adjust BIN and PCN number when moving subscribers
  1.  S DR="6.02;6.03;.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;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13;.05;.12;.06:.08"
  1.  D ^DIE K DA,DIE,DR
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. YN(X) ; Resolve the 'Yes/No' value.
  1.  Q $S($G(X)="":"<Not Specified>",X:"YES",X=0:"NO",1:"<Not Specified>")
  1.  ;
  1.  ;
  1. LIM ; Display/Edit Coverage Limitations.
  1.  W @IOF,!,$TR($J("",71)," ","=")
  1.  D LIMDSP(IBC1,IBP1,1)
  1.  W !,$TR($J("",71)," ","-")
  1.  D LIMDSP(IBC2,IBP2,2)
  1.  W !,$TR($J("",71)," ","=")
  1.  ;
  1.  ; - does the user wish to edit the plan coverage limitations?
  1.  S DIR(0)="Y",DIR("A")="Do you wish to edit the 'Plan 2' Coverage Limitations"
  1.  S DIR("?")="If you wish to edit the coverage limitations for the new plan, enter 'Yes.'"
  1.  D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT I 'Y G LIMQ
  1.  ;
  1.  ; - allow the edit of coverage limitations for plan 2
  1.  W !!,"Editing 'Plan 2' Coverage Limitations for: ",IBC2N
  1.  S IBX=$G(^IBA(355.3,IBP2,0))
  1.  W !?9,"Plan Name: ",IBP2N,?43,"Plan Number: ",IBP2X
  1.  ;
  1.  S IBCPOL=IBP2 D EDCOV^IBCNSJ51 K VALMBCK
  1.  ; The call below is to clean up List Man variables from IBCNSJ51
  1.  ; the call to FULL^VALM sets variables. Or modify IBCNSJ51
  1.  S IBROU="IBCNSJ51",IBTOP="T" D EN^VALM(IBROU,IBTOP) K IBROU,IBTOP
  1.  ;
  1. LIMQ Q
  1.  ;
  1.  ;
  1. LIMDSP(IBC,IBP,IBPNUM) ; Display coverage limitations for a company/plan.
  1.  N IBCOV,IBCOVD,IBCOVFN,IBCNT,IBP0,IBLEDT,IBLIM,IBLINE,IBX,IB0,IBS
  1.  W !!," 'Plan ",IBPNUM,"' Coverage Limitations for ",$S(IBPNUM=1:IBC1N,1:IBC2N)
  1.  S IBP0=$G(^IBA(355.3,IBP,0))
  1.  W !?9,"Plan Name: ",$S($P(IBP0,U,3)]"":$P(IBP0,U,3),1:"<Not Specified>")
  1.  W ?43,"Plan Number: ",$S($P(IBP0,U,4)]"":$P(IBP0,U,4),1:"<Not Specified>")
  1.  W !!,"  Coverage            Effective Date   Covered?       Limit Comments"
  1.  W !,"  --------            --------------   --------       --------------"
  1.  ;
  1.  ; - display limitation for each type of coverage
  1.  S IBLIM=0 F  S IBLIM=$O(^IBE(355.31,IBLIM)) Q:'IBLIM  S IBCOV=$P($G(^(IBLIM,0)),U) D
  1.  .S IBCNT=0
  1.  .S IBLEDT="" F  S IBLEDT=$O(^IBA(355.32,"APCD",IBP,IBLIM,IBLEDT)) Q:$S(IBLEDT="":IBCNT,1:0)  D  Q:IBLEDT=""
  1.  ..S IBCOVFN=+$O(^IBA(355.32,"APCD",IBP,IBLIM,+IBLEDT,"")),IBCOVD=$G(^IBA(355.32,+IBCOVFN,0))
  1.  ..S IBCNT=IBCNT+1
  1.  ..I IBCOVD="" S IBW="  "_$E(IBCOV_$J("",18),1,18)_$J("",19)_"BY DEFAULT" W !,IBW Q
  1.  ..S IBX="  "_$E($S(IBCNT=1:IBCOV,1:"")_$J("",18),1,18) ;Don't dup category
  1.  ..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)
  1.  ..W !,IBX
  1.  ..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
  1.  ;
  1.  Q