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