IBCNSJ5 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING ; 09-AUG-95
;;2.0;INTEGRATED BILLING;**43,516,549,652**;21-MAR-94;Build 23
;;Per VA Directive 6402, this routine should not be modified.
;
PL ; -- Insurance Company Plan List
D FULL^VALM1 W !!
N VALMY,VALMHDR,IBIND,IBMULT,IBW,IBSEL
S (IBIND,IBMULT)=1,IBW=1,IBSEL=0
D EN^VALM("IBCNS PLAN LIST")
Q
;
AB ; -- Edit Annual Benefits from insurance company edit OR plan detail edit
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
. K DIR
. D PAUSE^VALM1
. D ABQ
;
I $D(IBCPOL) D FULL^VALM1,EN^VALM("IBCNS ANNUAL BENEFITS") S VALMBCK="R" G ABQ
D FULL^VALM1
N I,J,IBXX,VALMY,IBCDFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.N IBCPOL
.S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
.Q:IBCPOL=""
.D FULL^VALM1
.W !!,"Plan Name: ",$$GET1^DIQ(355.3,IBCPOL,2.01)," Number: ",$$GET1^DIQ(355.3,IBCPOL,2.02) ;Get new HIPAA fields - IB*2*516
.K IBCDFN
.D EN^VALM("IBCNS ANNUAL BENEFITS")
.Q
ABQ ; Annual Benefits exit
I $D(IBCPOL) D INIT^IBCNSC4
S VALMBCK=$S($D(IBFASTXT):"Q",1:"R")
K IBFASTXT
Q
;
IA ; -- (In)activate plan from insurance company edit OR plan detail edit
I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D G IAQ
. W !!,"Sorry, but you do not have the required privileges to inactivate plans."
. D PAUSE^VALM1
;
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges to inactivate plans."
. K DIR
. D PAUSE^VALM1
. D IAQ
;
D FULL^VALM1
I $D(IBCPOL) D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL) G IAQ
N I,J,IBXX,VALMY,IBCDFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
. N IBCPOL,IBCPND,IBCPND1
. S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
. Q:IBCPOL=""
. D FULL^VALM1
. S IBCPND=$G(^IBA(355.3,IBCPOL,0))
. I '$P(IBCPND,U,2) W !,"You cannot inactivate an individual plan." D PAUSE^VALM1 Q
. K IBCDFN
. D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL),PAUSE^VALM1
. S IBCPND1=$G(^IBA(355.3,IBCPOL,0))
. I $P(IBCPND1,U,11)'=$P(IBCPND,U,11)!(IBCPND1="") D
. . D INIT^IBCNSU2 ;Rebuild list if plan changed or deleted
. . N IBCPOLD S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
. . I IBCPOLD'="" D HDR^IBCNSC41
IAQ ; Inactivate Plans exit
I $G(IBCPOL) D ;Rebuild header
. N IBCPOLD
. S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
. I IBCPOLD'="" D HDR^IBCNSC41
S VALMBCK="R"
Q
;
VP ; -- Edit/View Plan
D FULL^VALM1
N IBCND1,IBCDFND,IBCPOL,IBCPOLD,IBXX,VALMY,IBCDFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
.Q:IBCPOL=""
.D FULL^VALM1
.K IBCDFN
.D EN^VALM("IBCNS INS CO PLAN DETAIL")
.Q
I '$D(IBFASTXT) D INIT^IBCNSU2
S VALMBCK="R"
Q
;
PC ; Plan comments
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, you do not have the required privileges enter comments"
. W " about this plan."
. K DIR
. D PAUSE^VALM1
. D PCQ
;
W !!,"You may now enter comments about this plan."
L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PCQ
S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE
D INIT^IBCNSC4
L -^IBA(355.3,+IBCPOL)
PCQ ; Exit Enter plan comments
S VALMBCK="R"
Q
;
CP ;Change insurance plans
D FULL^VALM1
S DIR(0)="Y",DIR("A")="Do you want to see the list of plans for this insurance company"
S DIR("?")="Enter 'YES' if you want to use the LIST MANAGER lookup facility on the previous screen to select a plan. Enter 'NO' to select a plan using the standard Fileman lookup."
S VALMBCK="R"
D ^DIR K DIR I $D(DIRUT) G CPEX
I Y S VALMBCK="Q" G CPEX
; MRD;IB*2.0*516 - Display new Group Name and Number fields.
S DIC("S")="I $P(^(0),U)=$G(IBCNS)",DIC="^IBA(355.3,",DIC(0)="AEMQ"
;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,IBX2 S IBX=$G(^(0)),IBX2=$G(^(2)) W "" Name: "",$E($S($P(IBX2,U,1)'="""":$P(IBX2,U,1),1:""<none>"")_$J("""",20),1,20),"" Number: "",$E($S($P(IBX2,U,2)'="""":$P(IBX2,U,2),1:""<none>""),1,14)"
S DIC("W")=DIC("W")_","" "",$S($P(IBX,U,2):""GROUP"",1:""INDIVIDUAL""),"" "",$S($P(IBX,U,11):""IN"",1:""""),""ACTIVE"""
S DIC("A")="Select "_$P($G(^DIC(36,+$G(IBCNS),0)),U)_" PLAN: "
D ^DIC K DIC
G:Y<0 CPEX S IBCPOL=+Y
D INIT^IBCNSC4
CPEX Q
;
CV ;Edit coverage limitations from edit patient policy
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
. K DIR
. D PAUSE^VALM1
. S VALMBCK="R"
D EDCOV^IBCNSJ51
D BLD^IBCNSP
Q
;
CV1 ;Edit coverage limitations from edit plan
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
. K DIR
. D PAUSE^VALM1
. S VALMBCK="R"
D EDCOV^IBCNSJ51
D INIT^IBCNSC4
Q
;
;IB*2.0*652/TAZ - Add logic for New Plan
NP ;Add a New Plan without subscribers
N DA,DIE,DR,IBCPOL
D FULL^VALM1 W !!
; Add plan and check for duplicates
D NEW^IBCNSJ3(IBCNS,.IBCPOL,,1,1)
; If plan not added go to exit
I IBCPOL<1 G NPQ
;
W !!,"Now you may enter the plan information.",!
;Edit fields of New Policy
S DIE="^IBA(355.3,",DA=IBCPOL
S DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");"
S DR=DR_"@1;.02;@25;2.01;2.02;@55;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^(0),U,14)):""@60"",1:""@65"");"
S DR=DR_"@60;.14;@65;.16;I '$$FTFV^IBCNSU31(X) S Y=""@66"";.17;@66;.13;.05;.12;.06;.07;.08//YES;"
D ^DIE
;
NPQ ;
I '$D(IBFASTXT) D INIT^IBCNSU2
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ5 6238 printed Dec 13, 2024@02:17:21 Page 2
IBCNSJ5 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING ; 09-AUG-95
+1 ;;2.0;INTEGRATED BILLING;**43,516,549,652**;21-MAR-94;Build 23
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PL ; -- Insurance Company Plan List
+1 DO FULL^VALM1
WRITE !!
+2 NEW VALMY,VALMHDR,IBIND,IBMULT,IBW,IBSEL
+3 SET (IBIND,IBMULT)=1
SET IBW=1
SET IBSEL=0
+4 DO EN^VALM("IBCNS PLAN LIST")
+5 QUIT
+6 ;
AB ; -- Edit Annual Benefits from insurance company edit OR plan detail edit
+1 ;IB*2.0*549 - Added Security Key check
+2 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+3 WRITE !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
+4 KILL DIR
+5 DO PAUSE^VALM1
+6 DO ABQ
End DoDot:1
QUIT
+7 ;
+8 IF $DATA(IBCPOL)
DO FULL^VALM1
DO EN^VALM("IBCNS ANNUAL BENEFITS")
SET VALMBCK="R"
GOTO ABQ
+9 DO FULL^VALM1
+10 NEW I,J,IBXX,VALMY,IBCDFN
+11 DO EN^VALM2($GET(XQORNOD(0)))
+12 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+13 NEW IBCPOL
+14 SET IBCPOL=$GET(^TMP("IBCNSJ",$JOB,"IDX",IBXX,+$ORDER(^TMP("IBCNSJ",$JOB,"IDX",IBXX,0))))
+15 if IBCPOL=""
QUIT
+16 DO FULL^VALM1
+17 ;Get new HIPAA fields - IB*2*516
WRITE !!,"Plan Name: ",$$GET1^DIQ(355.3,IBCPOL,2.01)," Number: ",$$GET1^DIQ(355.3,IBCPOL,2.02)
+18 KILL IBCDFN
+19 DO EN^VALM("IBCNS ANNUAL BENEFITS")
+20 QUIT
End DoDot:1
ABQ ; Annual Benefits exit
+1 IF $DATA(IBCPOL)
DO INIT^IBCNSC4
+2 SET VALMBCK=$SELECT($DATA(IBFASTXT):"Q",1:"R")
+3 KILL IBFASTXT
+4 QUIT
+5 ;
IA ; -- (In)activate plan from insurance company edit OR plan detail edit
+1 IF '$DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))
Begin DoDot:1
+2 WRITE !!,"Sorry, but you do not have the required privileges to inactivate plans."
+3 DO PAUSE^VALM1
End DoDot:1
GOTO IAQ
+4 ;
+5 ;IB*2.0*549 - Added Security Key check
+6 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+7 WRITE !!,*7,"Sorry, but you do not have the required privileges to inactivate plans."
+8 KILL DIR
+9 DO PAUSE^VALM1
+10 DO IAQ
End DoDot:1
QUIT
+11 ;
+12 DO FULL^VALM1
+13 IF $DATA(IBCPOL)
DO INACT^IBCNSJ1(+$PIECE($GET(^IBA(355.3,IBCPOL,0)),U),IBCPOL)
GOTO IAQ
+14 NEW I,J,IBXX,VALMY,IBCDFN
+15 DO EN^VALM2($GET(XQORNOD(0)))
+16 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+17 NEW IBCPOL,IBCPND,IBCPND1
+18 SET IBCPOL=$GET(^TMP("IBCNSJ",$JOB,"IDX",IBXX,+$ORDER(^TMP("IBCNSJ",$JOB,"IDX",IBXX,0))))
+19 if IBCPOL=""
QUIT
+20 DO FULL^VALM1
+21 SET IBCPND=$GET(^IBA(355.3,IBCPOL,0))
+22 IF '$PIECE(IBCPND,U,2)
WRITE !,"You cannot inactivate an individual plan."
DO PAUSE^VALM1
QUIT
+23 KILL IBCDFN
+24 DO INACT^IBCNSJ1(+$PIECE($GET(^IBA(355.3,IBCPOL,0)),U),IBCPOL)
DO PAUSE^VALM1
+25 SET IBCPND1=$GET(^IBA(355.3,IBCPOL,0))
+26 IF $PIECE(IBCPND1,U,11)'=$PIECE(IBCPND,U,11)!(IBCPND1="")
Begin DoDot:2
+27 ;Rebuild list if plan changed or deleted
DO INIT^IBCNSU2
+28 NEW IBCPOLD
SET IBCPOLD=$GET(^IBA(355.3,+$GET(IBCPOL),0))
+29 IF IBCPOLD'=""
DO HDR^IBCNSC41
End DoDot:2
End DoDot:1
IAQ ; Inactivate Plans exit
+1 ;Rebuild header
IF $GET(IBCPOL)
Begin DoDot:1
+2 NEW IBCPOLD
+3 SET IBCPOLD=$GET(^IBA(355.3,+$GET(IBCPOL),0))
+4 IF IBCPOLD'=""
DO HDR^IBCNSC41
End DoDot:1
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
VP ; -- Edit/View Plan
+1 DO FULL^VALM1
+2 NEW IBCND1,IBCDFND,IBCPOL,IBCPOLD,IBXX,VALMY,IBCDFN
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBCPOL=$GET(^TMP("IBCNSJ",$JOB,"IDX",IBXX,+$ORDER(^TMP("IBCNSJ",$JOB,"IDX",IBXX,0))))
+6 if IBCPOL=""
QUIT
+7 DO FULL^VALM1
+8 KILL IBCDFN
+9 DO EN^VALM("IBCNS INS CO PLAN DETAIL")
+10 QUIT
End DoDot:1
+11 IF '$DATA(IBFASTXT)
DO INIT^IBCNSU2
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
PC ; Plan comments
+1 ;IB*2.0*549 - Added Security Key check
+2 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+3 WRITE !!,*7,"Sorry, you do not have the required privileges enter comments"
+4 WRITE " about this plan."
+5 KILL DIR
+6 DO PAUSE^VALM1
+7 DO PCQ
End DoDot:1
QUIT
+8 ;
+9 WRITE !!,"You may now enter comments about this plan."
+10 LOCK +^IBA(355.3,+IBCPOL):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO PCQ
+11 SET DIE="^IBA(355.3,"
SET DA=IBCPOL
SET DR="11"
DO ^DIE
+12 DO INIT^IBCNSC4
+13 LOCK -^IBA(355.3,+IBCPOL)
PCQ ; Exit Enter plan comments
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
CP ;Change insurance plans
+1 DO FULL^VALM1
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to see the list of plans for this insurance company"
+3 SET DIR("?")="Enter 'YES' if you want to use the LIST MANAGER lookup facility on the previous screen to select a plan. Enter 'NO' to select a plan using the standard Fileman lookup."
+4 SET VALMBCK="R"
+5 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO CPEX
+6 IF Y
SET VALMBCK="Q"
GOTO CPEX
+7 ; MRD;IB*2.0*516 - Display new Group Name and Number fields.
+8 SET DIC("S")="I $P(^(0),U)=$G(IBCNS)"
SET DIC="^IBA(355.3,"
SET DIC(0)="AEMQ"
+9 ;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>"")"
+10 SET DIC("W")="N IBX,IBX2 S IBX=$G(^(0)),IBX2=$G(^(2)) W "" Name: "",$E($S($P(IBX2,U,1)'="""":$P(IBX2,U,1),1:""<none>"")_$J("""",20),1,20),"" Number: "",$E($S($P(IBX2,U,2)'="""":$P(IBX2,U,2),1:""<none>""),1,14)"
+11 SET DIC("W")=DIC("W")_","" "",$S($P(IBX,U,2):""GROUP"",1:""INDIVIDUAL""),"" "",$S($P(IBX,U,11):""IN"",1:""""),""ACTIVE"""
+12 SET DIC("A")="Select "_$PIECE($GET(^DIC(36,+$GET(IBCNS),0)),U)_" PLAN: "
+13 DO ^DIC
KILL DIC
+14 if Y<0
GOTO CPEX
SET IBCPOL=+Y
+15 DO INIT^IBCNSC4
CPEX QUIT
+1 ;
CV ;Edit coverage limitations from edit patient policy
+1 ;IB*2.0*549 - Added Security Key check
+2 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+3 WRITE !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
+4 KILL DIR
+5 DO PAUSE^VALM1
+6 SET VALMBCK="R"
End DoDot:1
QUIT
+7 DO EDCOV^IBCNSJ51
+8 DO BLD^IBCNSP
+9 QUIT
+10 ;
CV1 ;Edit coverage limitations from edit plan
+1 ;IB*2.0*549 - Added Security Key check
+2 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+3 WRITE !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
+4 KILL DIR
+5 DO PAUSE^VALM1
+6 SET VALMBCK="R"
End DoDot:1
QUIT
+7 DO EDCOV^IBCNSJ51
+8 DO INIT^IBCNSC4
+9 QUIT
+10 ;
+11 ;IB*2.0*652/TAZ - Add logic for New Plan
NP ;Add a New Plan without subscribers
+1 NEW DA,DIE,DR,IBCPOL
+2 DO FULL^VALM1
WRITE !!
+3 ; Add plan and check for duplicates
+4 DO NEW^IBCNSJ3(IBCNS,.IBCPOL,,1,1)
+5 ; If plan not added go to exit
+6 IF IBCPOL<1
GOTO NPQ
+7 ;
+8 WRITE !!,"Now you may enter the plan information.",!
+9 ;Edit fields of New Policy
+10 SET DIE="^IBA(355.3,"
SET DA=IBCPOL
+11 SET DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");"
+12 SET DR=DR_"@1;.02;@25;2.01;2.02;@55;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^(0),U,14)):""@60"",1:""@65"");"
+13 SET DR=DR_"@60;.14;@65;.16;I '$$FTFV^IBCNSU31(X) S Y=""@66"";.17;@66;.13;.05;.12;.06;.07;.08//YES;"
+14 DO ^DIE
+15 ;
NPQ ;
+1 IF '$DATA(IBFASTXT)
DO INIT^IBCNSU2
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
