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

IBCNSJ5.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. PL ; -- Insurance Company Plan List
  1. D FULL^VALM1 W !!
  1. N VALMY,VALMHDR,IBIND,IBMULT,IBW,IBSEL
  1. S (IBIND,IBMULT)=1,IBW=1,IBSEL=0
  1. D EN^VALM("IBCNS PLAN LIST")
  1. Q
  1. ;
  1. AB ; -- Edit Annual Benefits from insurance company edit OR plan detail edit
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D ABQ
  1. ;
  1. I $D(IBCPOL) D FULL^VALM1,EN^VALM("IBCNS ANNUAL BENEFITS") S VALMBCK="R" G ABQ
  1. D FULL^VALM1
  1. N I,J,IBXX,VALMY,IBCDFN
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
  1. .N IBCPOL
  1. .S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
  1. .Q:IBCPOL=""
  1. .D FULL^VALM1
  1. .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
  1. .K IBCDFN
  1. .D EN^VALM("IBCNS ANNUAL BENEFITS")
  1. .Q
  1. ABQ ; Annual Benefits exit
  1. I $D(IBCPOL) D INIT^IBCNSC4
  1. S VALMBCK=$S($D(IBFASTXT):"Q",1:"R")
  1. K IBFASTXT
  1. Q
  1. ;
  1. IA ; -- (In)activate plan from insurance company edit OR plan detail edit
  1. I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D G IAQ
  1. . W !!,"Sorry, but you do not have the required privileges to inactivate plans."
  1. . D PAUSE^VALM1
  1. ;
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to inactivate plans."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D IAQ
  1. ;
  1. D FULL^VALM1
  1. I $D(IBCPOL) D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL) G IAQ
  1. N I,J,IBXX,VALMY,IBCDFN
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
  1. . N IBCPOL,IBCPND,IBCPND1
  1. . S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
  1. . Q:IBCPOL=""
  1. . D FULL^VALM1
  1. . S IBCPND=$G(^IBA(355.3,IBCPOL,0))
  1. . I '$P(IBCPND,U,2) W !,"You cannot inactivate an individual plan." D PAUSE^VALM1 Q
  1. . K IBCDFN
  1. . D INACT^IBCNSJ1(+$P($G(^IBA(355.3,IBCPOL,0)),U),IBCPOL),PAUSE^VALM1
  1. . S IBCPND1=$G(^IBA(355.3,IBCPOL,0))
  1. . I $P(IBCPND1,U,11)'=$P(IBCPND,U,11)!(IBCPND1="") D
  1. . . D INIT^IBCNSU2 ;Rebuild list if plan changed or deleted
  1. . . N IBCPOLD S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
  1. . . I IBCPOLD'="" D HDR^IBCNSC41
  1. IAQ ; Inactivate Plans exit
  1. I $G(IBCPOL) D ;Rebuild header
  1. . N IBCPOLD
  1. . S IBCPOLD=$G(^IBA(355.3,+$G(IBCPOL),0))
  1. . I IBCPOLD'="" D HDR^IBCNSC41
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. VP ; -- Edit/View Plan
  1. D FULL^VALM1
  1. N IBCND1,IBCDFND,IBCPOL,IBCPOLD,IBXX,VALMY,IBCDFN
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
  1. .S IBCPOL=$G(^TMP("IBCNSJ",$J,"IDX",IBXX,+$O(^TMP("IBCNSJ",$J,"IDX",IBXX,0))))
  1. .Q:IBCPOL=""
  1. .D FULL^VALM1
  1. .K IBCDFN
  1. .D EN^VALM("IBCNS INS CO PLAN DETAIL")
  1. .Q
  1. I '$D(IBFASTXT) D INIT^IBCNSU2
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PC ; Plan comments
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, you do not have the required privileges enter comments"
  1. . W " about this plan."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D PCQ
  1. ;
  1. W !!,"You may now enter comments about this plan."
  1. L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PCQ
  1. S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE
  1. D INIT^IBCNSC4
  1. L -^IBA(355.3,+IBCPOL)
  1. PCQ ; Exit Enter plan comments
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CP ;Change insurance plans
  1. D FULL^VALM1
  1. S DIR(0)="Y",DIR("A")="Do you want to see the list of plans for this insurance company"
  1. 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."
  1. S VALMBCK="R"
  1. D ^DIR K DIR I $D(DIRUT) G CPEX
  1. I Y S VALMBCK="Q" G CPEX
  1. ; MRD;IB*2.0*516 - Display new Group Name and Number fields.
  1. S DIC("S")="I $P(^(0),U)=$G(IBCNS)",DIC="^IBA(355.3,",DIC(0)="AEMQ"
  1. ;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>"")"
  1. 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)"
  1. S DIC("W")=DIC("W")_","" "",$S($P(IBX,U,2):""GROUP"",1:""INDIVIDUAL""),"" "",$S($P(IBX,U,11):""IN"",1:""""),""ACTIVE"""
  1. S DIC("A")="Select "_$P($G(^DIC(36,+$G(IBCNS),0)),U)_" PLAN: "
  1. D ^DIC K DIC
  1. G:Y<0 CPEX S IBCPOL=+Y
  1. D INIT^IBCNSC4
  1. CPEX Q
  1. ;
  1. CV ;Edit coverage limitations from edit patient policy
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. D EDCOV^IBCNSJ51
  1. D BLD^IBCNSP
  1. Q
  1. ;
  1. CV1 ;Edit coverage limitations from edit plan
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges edit Coverage Limitations."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. D EDCOV^IBCNSJ51
  1. D INIT^IBCNSC4
  1. Q
  1. ;
  1. ;IB*2.0*652/TAZ - Add logic for New Plan
  1. NP ;Add a New Plan without subscribers
  1. N DA,DIE,DR,IBCPOL
  1. D FULL^VALM1 W !!
  1. ; Add plan and check for duplicates
  1. D NEW^IBCNSJ3(IBCNS,.IBCPOL,,1,1)
  1. ; If plan not added go to exit
  1. I IBCPOL<1 G NPQ
  1. ;
  1. W !!,"Now you may enter the plan information.",!
  1. ;Edit fields of New Policy
  1. S DIE="^IBA(355.3,",DA=IBCPOL
  1. S DR="S IBAD=$P($G(^IBA(355.3,DA,0)),U,2),Y=$S(IBAD=0:""@55"",IBAD="""":""@1"",1:""@25"");"
  1. 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"");"
  1. S DR=DR_"@60;.14;@65;.16;I '$$FTFV^IBCNSU31(X) S Y=""@66"";.17;@66;.13;.05;.12;.06;.07;.08//YES;"
  1. D ^DIE
  1. ;
  1. NPQ ;
  1. I '$D(IBFASTXT) D INIT^IBCNSU2
  1. S VALMBCK="R"
  1. Q
  1. ;