- 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 Mar 13, 2025@21:22: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)
