IBCNSJ21.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCNSJ21   3574     printed  Feb 18, 2025@23:43:42                                                                                                                                                                                                    Page 2

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

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

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

 +3       ;

NOTES     ; Display any necessary notes to the user.

 +1        NEW IBS

           SET IBS=0

 +2        SET IBIP='$PIECE(IBPLAND,"^",2)

           IF IBIP

               SET IBS=1

               WRITE !,"Please note that this is an Individual Plan."

 +3        IF $PIECE(IBPLAND,"^",11)

               SET IBS=1

               WRITE !,*7,"This plan is currently inactive."

 +4        DO BU

           IF $ORDER(IBBU(0))

               SET IBS=1

               WRITE !,*7,"There are Benefits Used associated with this plan!"

 +5        IF $ORDER(^IBA(355.7,"APP",DFN,IBCDFN,0))

               SET IBS=1

               WRITE !,*7,"This patient has riders associated with this policy!"

 +6        IF $$IR(DFN,IBCDFN)

               SET IBS=1

               WRITE !,*7,"There are insurance reviews associated with this policy."

 +7        if IBS

               WRITE !

 +8        QUIT 

 +9       ;

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

 +1       ;  Input variables required:

 +2       ;         DFN  --  ptr to patient in file #2

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

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

 +5       ;

 +6       ;  Output variable array:

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

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

 +9       ;                  in file #355.5

 +10       NEW DATE,POL

 +11       SET DATE=""

           FOR 

               SET DATE=$ORDER(^IBA(355.5,"APPY",DFN,IBPLAN,DATE))

               if DATE=""

                   QUIT 

               Begin DoDot:1

 +12               SET POL=0

                   FOR 

                       SET POL=$ORDER(^IBA(355.5,"APPY",DFN,IBPLAN,DATE,POL))

                       if 'POL

                           QUIT 

                       IF POL=IBCDFN

                           SET IBBU(-DATE)=$ORDER(^(POL,0))

               End DoDot:1

 +13       QUIT 

 +14      ;

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

 +1       ;  Input variables required:

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

 +3       ;

 +4       ;  Output variable array:

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

 +6       ;

 +7        NEW X

           SET X=""

 +8        FOR 

               SET X=$ORDER(^IBA(355.4,"APY",IBCPOL,X))

               if X=""

                   QUIT 

               SET IBAB(-X)=""

 +9        QUIT 

 +10      ;

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

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

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

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

 +4       ;               0  --  there are not.

 +5        NEW X,Y

           SET X=0

 +6        IF $GET(DFN)

               IF $GET(IBCDFN)

                   SET Y=0

                   FOR 

                       SET Y=$ORDER(^IBT(356.2,"D",DFN,Y))

                       if 'Y

                           QUIT 

                       IF $PIECE($GET(^IBT(356.2,Y,1)),"^",5)=IBCDFN

                           SET X=1

                           QUIT 

 +7        QUIT X

 +8       ;

DMBU      ; Display mergeable benefits used.

 +1        NEW IBMRG

 +2        SET X=0

           FOR 

               SET X=$ORDER(IBAB(X))

               if 'X

                   QUIT 

               SET IBMRG(X)=""

 +3        SET X=0

           FOR 

               SET X=$ORDER(IBBU(X))

               if 'X

                   QUIT 

               SET IBMRG(X)=""

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

 +5        SET X=0

           FOR 

               SET X=$ORDER(IBMRG(X))

               if 'X

                   QUIT 

               Begin DoDot:1

 +6                WRITE !

                   if $DATA(IBBU(X))

                       WRITE ?6,$$DAT2^IBOUTL(X)

                   if $DATA(IBAB(X))

                       WRITE ?40,$$DAT2^IBOUTL(X)

 +7                WRITE ?69

                   IF '$DATA(IBAB(X))

                       WRITE "NO"

                       SET IBMRGN=1

                       QUIT 

 +8                IF '$DATA(IBBU(X))

                       WRITE "-na-"

                       QUIT 

 +9                SET IBMRGF(X)=IBBU(X)

                   WRITE "YES"

               End DoDot:1

 +10       QUIT 

 +11      ;

MD        ; Merge/delete benefits used, if necessary.

 +1        IF $GET(IBMERGE)

               Begin DoDot:1

 +2                WRITE !,"Merging previous benefits used into the new plan... "

 +3                SET IBX=""

                   FOR 

                       SET IBX=$ORDER(IBMRGF(IBX))

                       if IBX=""

                           QUIT 

                       DO MERG^IBCNSJ13(IBCPOL,+IBMRGF(IBX))

                       KILL IBBU(IBX)

 +4                WRITE "done."

               End DoDot:1

 +5       ;

 +6       ; - delete any remaining benefits used

 +7        IF $ORDER(IBBU(0))

               Begin DoDot:1

 +8                WRITE !,"Deleting previous benefits used... "

 +9                SET IBX=""

                   FOR 

                       SET IBX=$ORDER(IBBU(IBX))

                       if IBX=""

                           QUIT 

                       DO DBU^IBCNSJ(IBBU(IBX))

 +10               WRITE "done."

               End DoDot:1

MDQ        QUIT 

 +1       ;

HLSW      ; Reader help for switching plans.

 +1        WRITE !!,"If you wish to change the subscribed-to plan the newly-",$SELECT($GET(IBNEWP):"added",1:"selected")," plan,"

 +2        WRITE !,"enter 'YES'.  Otherwise, enter 'NO'."

 +3        if '$ORDER(IBBU(0))

               QUIT 

 +4        WRITE !!,"If you change the plan for this policy, "

 +5        IF '$GET(IBMERGE)!'$ORDER(IBMRGF(0))

               WRITE "all existing benefits will be deleted."

               QUIT 

 +6        IF '$GET(IBMRGN)

               WRITE "all existing benefits will be merged."

               QUIT 

 +7        WRITE "all transferable benefits",!,"will be merged.  All others will be deleted."

 +8        QUIT