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

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