source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSJ21.m@ 1800

IBCNSJ21 ;ALB/CPM - CHANGE POLICY PLAN (CON'T) ; 12-JAN-95

 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

NOTES ; Display any necessary notes to the user.

 N IBS S IBS=0

 S IBIP='$P(IBPLAND,"^",2) I IBIP S IBS=1 W !,"Please note that this is an Individual Plan."

 I $P(IBPLAND,"^",11) S IBS=1 W !,*7,"This plan is currently inactive."

 D BU I $O(IBBU(0)) S IBS=1 W !,*7,"There are Benefits Used associated with this plan!"

 I $O(^IBA(355.7,"APP",DFN,IBCDFN,0)) S IBS=1 W !,*7,"This patient has riders associated with this policy!"

 I $$IR(DFN,IBCDFN) S IBS=1 W !,*7,"There are insurance reviews associated with this policy."

 W:IBS !

 Q

 ;

BU ; Are there any benefits used for this plan and policy?

 ;  Input variables required:

 ;         DFN  --  ptr to patient in file #2

 ;      IBPLAN  --  ptr to policy plan in file #355.3

 ;      IBCDFN  --  ptr to policy in sub-file #2.312

 ;

 ;  Output variable array:

 ;   IBBU(X)=Y  --  array of benefits used associated with the policy,

 ;                  where X is the benefit year, and Y points to the bu

 ;                  in file #355.5

 N DATE,POL

 S DATE="" F  S DATE=$O(^IBA(355.5,"APPY",DFN,IBPLAN,DATE)) Q:DATE=""  D

 .S POL=0 F  S POL=$O(^IBA(355.5,"APPY",DFN,IBPLAN,DATE,POL)) Q:'POL  I POL=IBCDFN S IBBU(-DATE)=$O(^(POL,0))

 Q

 ;

AB ; Find all Annual Benefits associated with an Insurance Plan.

 ;  Input variables required:

 ;    IBCPOL  --  ptr to proposed plan in file #355.3

 ;

 ;  Output variable array:

 ;   IBAB(X)  --  array of annual benefits, where X is the benefit year

 ;

 N X S X=""

 F  S X=$O(^IBA(355.4,"APY",IBCPOL,X)) Q:X=""  S IBAB(-X)=""

 Q

 ;

IR(DFN,IBCDFN) ; Are there any Insurance reviews associated with the policy?

 ;  Input:     DFN  --  Pointer to the patient in file #2

 ;          IBCDFN  --  Pointer to the policy in file #2.312

 ; Output:       1  --  There are associated insurance reviews, or

 ;               0  --  there are not.

 N X,Y S X=0

 I $G(DFN),$G(IBCDFN) S Y=0 F  S Y=$O(^IBT(356.2,"D",DFN,Y)) Q:'Y  I $P($G(^IBT(356.2,Y,1)),"^",5)=IBCDFN S X=1 Q

 Q X

 ;

DMBU ; Display mergeable benefits used.

 N IBMRG

 S X=0 F  S X=$O(IBAB(X)) Q:'X  S IBMRG(X)=""

 S X=0 F  S X=$O(IBBU(X)) Q:'X  S IBMRG(X)=""

 W !!," Existing Benefit Used Yr",?31,"Annual Benefit for Proposed Plan",?66,"Merge BU?",!

 S X=0 F  S X=$O(IBMRG(X)) Q:'X  D

 .W ! W:$D(IBBU(X)) ?6,$$DAT2^IBOUTL(X) W:$D(IBAB(X)) ?40,$$DAT2^IBOUTL(X)

 .W ?69 I '$D(IBAB(X)) W "NO" S IBMRGN=1 Q

 .I '$D(IBBU(X)) W "-na-" Q

 .S IBMRGF(X)=IBBU(X) W "YES"

 Q

 ;

MD ; Merge/delete benefits used, if necessary.

 I $G(IBMERGE) D

 .W !,"Merging previous benefits used into the new plan... "

 .S IBX="" F  S IBX=$O(IBMRGF(IBX)) Q:IBX=""  D MERG^IBCNSJ13(IBCPOL,+IBMRGF(IBX)) K IBBU(IBX)

 .W "done."

 ;

 ; - delete any remaining benefits used

 I $O(IBBU(0)) D

 .W !,"Deleting previous benefits used... "

 .S IBX="" F  S IBX=$O(IBBU(IBX)) Q:IBX=""  D DBU^IBCNSJ(IBBU(IBX))

 .W "done."

MDQ Q

 ;

HLSW ; Reader help for switching plans.

 W !!,"If you wish to change the subscribed-to plan the newly-",$S($G(IBNEWP):"added",1:"selected")," plan,"

 W !,"enter 'YES'.  Otherwise, enter 'NO'."

 Q:'$O(IBBU(0))

 W !!,"If you change the plan for this policy, "

 I '$G(IBMERGE)!'$O(IBMRGF(0)) W "all existing benefits will be deleted." Q

 I '$G(IBMRGN) W "all existing benefits will be merged." Q

 W "all transferable benefits",!,"will be merged.  All others will be deleted."

 Q