- 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 Jan 18, 2025@03:18:33 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 ;