IBCNSJ4 ;ALB/CPM - INACTIVATE MULTIPLE INSURANCE PLANS ; 20-MAR-95
;;2.0;INTEGRATED BILLING;**28,62,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Inactivate/Delete Multiple Plans
N DFN,IBAB,IBSEL,IBCDFN,IBSUB,IBBUM,IBBUD,IBBUMC
N IBCPOL,IBDAT,IBDATP,IBCDFN1,IBBU,IBABDAT,IBINACTM,Y
W !!,"This process will allow you to transfer subscribers from many insurance"
W !,"plans into one 'master' plan. After the subscribers from each selected"
W !,"plan are transferred to the master plan, the selected plan will be deleted"
W !,"from your system."
W !!,"You should be very careful when you use this tool."
W !!,"You must first select the master plan into which you will transfer all"
W !,"selected plan subscribers. This plan must be an active group plan.",!
;
; - select/display the master plan
S Y=0,IBINACTM=1 D SEL4^IBCNSJ14 G:IBQUIT ENQ
;IB*2.0*516/TAZ - Use HIPAA compliant fields.
;S IBPLAND=$G(^IBA(355.3,IBPLAN,0)) D MSTR ; Patch 516 - baa
S IBPLAND=$G(^IBA(355.3,IBPLAN,0))
S $P(IBPLAND,U,3)=$$GET1^DIQ(355.3,IBPLAN_",",2.01),$P(IBPLAND,U,4)=$$GET1^DIQ(355.3,IBPLAN_",",2.02)
D MSTR
;
; - check annual benefits
S X="" F S X=$O(^IBA(355.4,"APY",IBPLAN,X)) Q:X="" S IBAB(-X)=""
I $D(IBAB) W !!,"Annual Benefits have been established for this plan." G CONT
S DIR(0)="Y",DIR("A")="This plan has no Annual Benefits on file! Do you wish to continue"
S DIR("?")="If you wish to continue with this processing, enter 'YES.' Otherwise, enter 'NO.'"
W ! D ^DIR K DIR I 'Y K DIRUT,DTOUT,DUOUT,DIROUT G ENQ
;
CONT ; - explain next step
I '$D(IBAB) W !!,*7,"Please note that any Benefits Used on file for subscribers who",!,"will be merged into the master plan will be deleted!"
I $D(IBAB) D
.W !!,"Any Benefits Used on file for subscribers who will be merged into the"
.W !,"master plan will also be merged if the master plan has any Annual Benefits"
.W !,"dated in the same year as the Benefits Used. Please note that the"
.W !,"Benefits Used date will be changed to match the date of the Annual Benefit."
;
W !!,"You may now select the plans to be merged into the master plan... (type <CR>)"
R X:DTIME
;
; - allow multiple plans to be selected
K ^TMP($J,"IBSEL") W !," ....hmmm..." D LKP^IBCNSU2(IBCNS,1,1,.IBSEL,0,1) I '$O(^TMP($J,"IBSEL",0)) W !!,"No plans were selected!" G ENQ
D MSTR S (X,Y)=0 F S X=$O(^TMP($J,"IBSEL",X)) Q:'X I X'=IBPLAN S Y=Y+1
W !!,"There ",$S(Y=1:"was ",1:"were "),$S(Y:Y,1:"no")," plan",$E("s",Y'=1)," selected to be merged into the master plan."
G:'Y ENQ
;
; - okay to go?
S DIR(0)="Y",DIR("A")="Okay to merge th"_$S(Y=1:"is",1:"ese")_" plan"_$S(Y=1:"",1:"s")_" into the master plan"
S DIR("?")="If you wish to merge the selected plans into the master plan, enter 'YES.' Otherwise, enter 'NO.'"
W ! D ^DIR K DIR I 'Y K DIRUT,DTOUT,DUOUT,DIROUT G ENQ
;
W !!,"Merging each selected plan into the master plan...",!
S (IBSUB,IBBUD,IBBUM,IBBUMC)=0
S IBCPOL=0 F S IBCPOL=$O(^TMP($J,"IBSEL",IBCPOL)) Q:'IBCPOL I IBCPOL'=IBPLAN D
.W "." K ^TMP($J,"IBSUBS")
.S IBSUB=IBSUB+$$SUBS^IBCNSJ(IBCNS,IBCPOL,0,"^TMP($J,""IBSUBS"")")
.;
.; - move the subscribers and benefits used
.S DFN=0 F S DFN=$O(^TMP($J,"IBSUBS",DFN)) Q:'DFN D
..S IBCDFN=0 F S IBCDFN=$O(^TMP($J,"IBSUBS",DFN,IBCDFN)) Q:'IBCDFN D
...Q:$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)=IBPLAN
...D SWPL^IBCNSJ13(IBPLAN,DFN,IBCDFN)
...;
...; - merge/change/delete previous benefits used
...S IBDAT="" F S IBDAT=$O(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT)) Q:IBDAT="" D
....S IBCDFN1=0 F S IBCDFN1=$O(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT,IBCDFN1)) Q:'IBCDFN1 I IBCDFN1=IBCDFN S IBBU=$O(^(IBCDFN1,0)) D
.....S IBDATP=-IBDAT,IBABDAT=$O(IBAB($E(IBDATP,1,3)_"0000"))
.....I $E(IBABDAT,1,3)'=$E(IBDATP,1,3) S IBBUD=IBBUD+1 D DBU^IBCNSJ(IBBU) Q
.....S IBBUM=IBBUM+1 S:IBABDAT'=IBDATP IBBUMC=IBBUMC+1
.....D MERG^IBCNSJ13(IBPLAN,IBBU,$S(IBABDAT'=IBDATP:IBABDAT,1:0))
.;
.; - delete the plan
.D DEL^IBCNSJ(IBCPOL)
;
W !!,"All selected plans have been deleted."
W !,$S(IBSUB:IBSUB,1:"No")," subscriber",$S(IBSUB=1:" was",1:"s were")," transferred to the master plan."
W !,$S(IBBUD:IBBUD,1:"No")," Benefits Used record",$S(IBBUD=1:" was",1:"s were")," deleted."
W !,$S(IBBUM:IBBUM,1:"No")," Benefits Used record",$S(IBBUM=1:" was",1:"s were")," merged."
I IBBUM W " (",IBBUMC," had the date changed)"
;
ENQ K ^TMP($J,"IBSUBS"),^("IBSEL")
Q
;
;
MSTR ; Display Master Plan Information
W !!?24,"*** M A S T E R P L A N ***"
W !,"Plan Company: ",$P($G(^DIC(36,IBCNS,0)),"^")
W !?3,"Plan Name: ",$S($P(IBPLAND,"^",3)]"":$P(IBPLAND,"^",3),1:"<unspecified>")
W !," Plan Number: ",$S($P(IBPLAND,"^",4)]"":$P(IBPLAND,"^",4),1:"<unspecified>")
Q
;
;
ASK() ; Does the user wish to inactivate multiple plans?
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
S DIR(0)="Y",DIR("A")="Do you wish to delete multiple plans simultaneously"
S DIR("?")="If you wish to transfer subscribers from many duplicate plans into a master plan, enter 'YES.' To inactivate a single plan, enter 'NO.'"
W ! D ^DIR
Q $S($D(DIRUT)!$D(DUOUT):-1,1:+Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ4 5213 printed Oct 16, 2024@18:18 Page 2
IBCNSJ4 ;ALB/CPM - INACTIVATE MULTIPLE INSURANCE PLANS ; 20-MAR-95
+1 ;;2.0;INTEGRATED BILLING;**28,62,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Inactivate/Delete Multiple Plans
+1 NEW DFN,IBAB,IBSEL,IBCDFN,IBSUB,IBBUM,IBBUD,IBBUMC
+2 NEW IBCPOL,IBDAT,IBDATP,IBCDFN1,IBBU,IBABDAT,IBINACTM,Y
+3 WRITE !!,"This process will allow you to transfer subscribers from many insurance"
+4 WRITE !,"plans into one 'master' plan. After the subscribers from each selected"
+5 WRITE !,"plan are transferred to the master plan, the selected plan will be deleted"
+6 WRITE !,"from your system."
+7 WRITE !!,"You should be very careful when you use this tool."
+8 WRITE !!,"You must first select the master plan into which you will transfer all"
+9 WRITE !,"selected plan subscribers. This plan must be an active group plan.",!
+10 ;
+11 ; - select/display the master plan
+12 SET Y=0
SET IBINACTM=1
DO SEL4^IBCNSJ14
if IBQUIT
GOTO ENQ
+13 ;IB*2.0*516/TAZ - Use HIPAA compliant fields.
+14 ;S IBPLAND=$G(^IBA(355.3,IBPLAN,0)) D MSTR ; Patch 516 - baa
+15 SET IBPLAND=$GET(^IBA(355.3,IBPLAN,0))
+16 SET $PIECE(IBPLAND,U,3)=$$GET1^DIQ(355.3,IBPLAN_",",2.01)
SET $PIECE(IBPLAND,U,4)=$$GET1^DIQ(355.3,IBPLAN_",",2.02)
+17 DO MSTR
+18 ;
+19 ; - check annual benefits
+20 SET X=""
FOR
SET X=$ORDER(^IBA(355.4,"APY",IBPLAN,X))
if X=""
QUIT
SET IBAB(-X)=""
+21 IF $DATA(IBAB)
WRITE !!,"Annual Benefits have been established for this plan."
GOTO CONT
+22 SET DIR(0)="Y"
SET DIR("A")="This plan has no Annual Benefits on file! Do you wish to continue"
+23 SET DIR("?")="If you wish to continue with this processing, enter 'YES.' Otherwise, enter 'NO.'"
+24 WRITE !
DO ^DIR
KILL DIR
IF 'Y
KILL DIRUT,DTOUT,DUOUT,DIROUT
GOTO ENQ
+25 ;
CONT ; - explain next step
+1 IF '$DATA(IBAB)
WRITE !!,*7,"Please note that any Benefits Used on file for subscribers who",!,"will be merged into the master plan will be deleted!"
+2 IF $DATA(IBAB)
Begin DoDot:1
+3 WRITE !!,"Any Benefits Used on file for subscribers who will be merged into the"
+4 WRITE !,"master plan will also be merged if the master plan has any Annual Benefits"
+5 WRITE !,"dated in the same year as the Benefits Used. Please note that the"
+6 WRITE !,"Benefits Used date will be changed to match the date of the Annual Benefit."
End DoDot:1
+7 ;
+8 WRITE !!,"You may now select the plans to be merged into the master plan... (type <CR>)"
+9 READ X:DTIME
+10 ;
+11 ; - allow multiple plans to be selected
+12 KILL ^TMP($JOB,"IBSEL")
WRITE !," ....hmmm..."
DO LKP^IBCNSU2(IBCNS,1,1,.IBSEL,0,1)
IF '$ORDER(^TMP($JOB,"IBSEL",0))
WRITE !!,"No plans were selected!"
GOTO ENQ
+13 DO MSTR
SET (X,Y)=0
FOR
SET X=$ORDER(^TMP($JOB,"IBSEL",X))
if 'X
QUIT
IF X'=IBPLAN
SET Y=Y+1
+14 WRITE !!,"There ",$SELECT(Y=1:"was ",1:"were "),$SELECT(Y:Y,1:"no")," plan",$EXTRACT("s",Y'=1)," selected to be merged into the master plan."
+15 if 'Y
GOTO ENQ
+16 ;
+17 ; - okay to go?
+18 SET DIR(0)="Y"
SET DIR("A")="Okay to merge th"_$SELECT(Y=1:"is",1:"ese")_" plan"_$SELECT(Y=1:"",1:"s")_" into the master plan"
+19 SET DIR("?")="If you wish to merge the selected plans into the master plan, enter 'YES.' Otherwise, enter 'NO.'"
+20 WRITE !
DO ^DIR
KILL DIR
IF 'Y
KILL DIRUT,DTOUT,DUOUT,DIROUT
GOTO ENQ
+21 ;
+22 WRITE !!,"Merging each selected plan into the master plan...",!
+23 SET (IBSUB,IBBUD,IBBUM,IBBUMC)=0
+24 SET IBCPOL=0
FOR
SET IBCPOL=$ORDER(^TMP($JOB,"IBSEL",IBCPOL))
if 'IBCPOL
QUIT
IF IBCPOL'=IBPLAN
Begin DoDot:1
+25 WRITE "."
KILL ^TMP($JOB,"IBSUBS")
+26 SET IBSUB=IBSUB+$$SUBS^IBCNSJ(IBCNS,IBCPOL,0,"^TMP($J,""IBSUBS"")")
+27 ;
+28 ; - move the subscribers and benefits used
+29 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"IBSUBS",DFN))
if 'DFN
QUIT
Begin DoDot:2
+30 SET IBCDFN=0
FOR
SET IBCDFN=$ORDER(^TMP($JOB,"IBSUBS",DFN,IBCDFN))
if 'IBCDFN
QUIT
Begin DoDot:3
+31 if $PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)=IBPLAN
QUIT
+32 DO SWPL^IBCNSJ13(IBPLAN,DFN,IBCDFN)
+33 ;
+34 ; - merge/change/delete previous benefits used
+35 SET IBDAT=""
FOR
SET IBDAT=$ORDER(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT))
if IBDAT=""
QUIT
Begin DoDot:4
+36 SET IBCDFN1=0
FOR
SET IBCDFN1=$ORDER(^IBA(355.5,"APPY",DFN,IBCPOL,IBDAT,IBCDFN1))
if 'IBCDFN1
QUIT
IF IBCDFN1=IBCDFN
SET IBBU=$ORDER(^(IBCDFN1,0))
Begin DoDot:5
+37 SET IBDATP=-IBDAT
SET IBABDAT=$ORDER(IBAB($EXTRACT(IBDATP,1,3)_"0000"))
+38 IF $EXTRACT(IBABDAT,1,3)'=$EXTRACT(IBDATP,1,3)
SET IBBUD=IBBUD+1
DO DBU^IBCNSJ(IBBU)
QUIT
+39 SET IBBUM=IBBUM+1
if IBABDAT'=IBDATP
SET IBBUMC=IBBUMC+1
+40 DO MERG^IBCNSJ13(IBPLAN,IBBU,$SELECT(IBABDAT'=IBDATP:IBABDAT,1:0))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+41 ;
+42 ; - delete the plan
+43 DO DEL^IBCNSJ(IBCPOL)
End DoDot:1
+44 ;
+45 WRITE !!,"All selected plans have been deleted."
+46 WRITE !,$SELECT(IBSUB:IBSUB,1:"No")," subscriber",$SELECT(IBSUB=1:" was",1:"s were")," transferred to the master plan."
+47 WRITE !,$SELECT(IBBUD:IBBUD,1:"No")," Benefits Used record",$SELECT(IBBUD=1:" was",1:"s were")," deleted."
+48 WRITE !,$SELECT(IBBUM:IBBUM,1:"No")," Benefits Used record",$SELECT(IBBUM=1:" was",1:"s were")," merged."
+49 IF IBBUM
WRITE " (",IBBUMC," had the date changed)"
+50 ;
ENQ KILL ^TMP($JOB,"IBSUBS"),^("IBSEL")
+1 QUIT
+2 ;
+3 ;
MSTR ; Display Master Plan Information
+1 WRITE !!?24,"*** M A S T E R P L A N ***"
+2 WRITE !,"Plan Company: ",$PIECE($GET(^DIC(36,IBCNS,0)),"^")
+3 WRITE !?3,"Plan Name: ",$SELECT($PIECE(IBPLAND,"^",3)]"":$PIECE(IBPLAND,"^",3),1:"<unspecified>")
+4 WRITE !," Plan Number: ",$SELECT($PIECE(IBPLAND,"^",4)]"":$PIECE(IBPLAND,"^",4),1:"<unspecified>")
+5 QUIT
+6 ;
+7 ;
ASK() ; Does the user wish to inactivate multiple plans?
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to delete multiple plans simultaneously"
+3 SET DIR("?")="If you wish to transfer subscribers from many duplicate plans into a master plan, enter 'YES.' To inactivate a single plan, enter 'NO.'"
+4 WRITE !
DO ^DIR
+5 QUIT $SELECT($DATA(DIRUT)!$DATA(DUOUT):-1,1:+Y)
