IBCNSJ11 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN (CON'T) ; 18-JAN-95
;;Version 2.0 ; INTEGRATED BILLING ;**28,62**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
NOTACT ; Handle plans which have already been inactivated.
; Required variable input:
; IBCNS -- Pointer to company in file #36 offering the plan
; IBPLAN -- Pointer to the plan in file #355.3
; IBSUB -- Flagged high if there are any plan subscriptions
;
N DFN,IBQUIT,IBSUB1,Y
W !,"This plan has already been inactivated!"
S DIR(0)="Y",DIR("A")="Do you wish to reactivate this plan",DIR("?")="To reactivate this plan, answer 'YES.' Otherwise, answer 'NO.'"
W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
I 'Y,IBSUB W !,"There are still subscribers to this plan. The plan cannot be deleted." G NOTACTQ
I 'Y D DEL(IBPLAN) G NOTACTQ
;
; - note that insurance policies will be activated
I IBSUB S IBQUIT=0 D I IBQUIT G NOTACTQ
.W !!,"There are still subscribers to this plan! Reactivating the plan will activate"
.W !,"the policies of these subscribers."
.S DIR(0)="Y",DIR("A")=" Is it okay to continue",DIR("?")="Answer 'YES' to reactivate this plan. Otherwise, answer 'NO.'"
.W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT I 'Y W !,"The plan was not reactivated." S IBQUIT=1 Q
;
; - reactivate the plan
W !,"Reactivating the plan... " D IRACT^IBCNSJ(IBPLAN,0) W "done."
I 'IBSUB W !,"Please note there are no subscribers to this plan." G NOTACTQ
W !,"Updating the 'Covered by Insurance?' field for all plan subscribers... "
K ^TMP($J,"IBSUBS")
S IBSUB1=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"^TMP($J,""IBSUBS"")")
S DFN=0 F S DFN=$O(^TMP($J,"IBSUBS",DFN)) Q:'DFN D COV^IBCNSJ(DFN)
W "done." K ^TMP($J,"IBSUBS")
NOTACTQ Q
;
;
DEL(IBPLAN) ; Want to delete an Insurance Plan?
; Input: IBPLAN -- Pointer to the plan in file #355.3
N DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
S DIR(0)="Y",DIR("A")="There are no subscribers to this plan. Would you like to delete it",DIR("?")="If you wish to delete this inactive plan, answer 'YES.' Otherwise, answer 'NO.'"
W ! D ^DIR I 'Y W !,"The plan was not deleted."
I Y W !,"Deleting the plan... " D DEL^IBCNSJ(IBPLAN) W "done."
Q
;
;
HLRP ; Reader help for repointing policies to a new plan.
W !!,"If you wish to change the subscribed-to plan of ALL policies which are"
W !,"currently associated with this plan, enter 'YES.' Otherwise, enter 'NO.'"
W !!,"You may only repoint all policies to a single plan. If you enter 'NO,'"
W !,"you will receive a mailman message of all the inactivated policies which"
W !,"will result from inactivating the plan, and then you may use the 'Change"
W !,"Policy Plan' action to change the subscribed-to plan on an individual basis."
Q
;
MAIL ; Note that the subscription list will be mailed to the user.
S IBMAIL=1
W !,"The policies will not be re-pointed. You will receive a mail message of"
W !,"all the subscribers to this plan if you choose to inactivate it."
Q
;
REP(IBCNS,IBNEWP,IBOLDP) ; Repoint patient policies from old to new plan
; Input: IBCNS -- Pointer to the company in file #36 which
; offers the plans
; IBNEWP -- Pointer to the new plan in file #355.3
; IBOLDP -- Pointer to the old plan in file #355.3
;
I '$G(IBCNS)!'$G(IBNEWP)!'$G(IBOLDP) G REPQ
N DA,DFN,DIE,DR,IBCDFN
S DFN=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D
.S IBCDFN=0 F S IBCDFN=$O(^DPT("AB",IBCNS,DFN,IBCDFN)) Q:'IBCDFN D
..Q:$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)'=IBOLDP
..S DA=IBCDFN,DA(1)=DFN,DIE="^DPT("_DFN_",.312,",DR=".18////"_IBNEWP
..D ^DIE
REPQ Q
;
DELP ; Delete the newly-added plan.
I $G(IBNEWP) W !,"Deleting the newly-added plan... " D DEL^IBCNSJ(IBCPOL) W "done."
Q
;
HLMT ; Reader help for merging transferrable benefits used.
W !!,"If you want to merge the patient's current benefits used into the"
W !,"newly-proposed plan, enter 'YES'. Otherwise, enter 'NO' and these"
W !,"benefits used will be deleted."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ11 4097 printed Nov 22, 2024@17:27:18 Page 2
IBCNSJ11 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN (CON'T) ; 18-JAN-95
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**28,62**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
NOTACT ; Handle plans which have already been inactivated.
+1 ; Required variable input:
+2 ; IBCNS -- Pointer to company in file #36 offering the plan
+3 ; IBPLAN -- Pointer to the plan in file #355.3
+4 ; IBSUB -- Flagged high if there are any plan subscriptions
+5 ;
+6 NEW DFN,IBQUIT,IBSUB1,Y
+7 WRITE !,"This plan has already been inactivated!"
+8 SET DIR(0)="Y"
SET DIR("A")="Do you wish to reactivate this plan"
SET DIR("?")="To reactivate this plan, answer 'YES.' Otherwise, answer 'NO.'"
+9 WRITE !
DO ^DIR
KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
+10 IF 'Y
IF IBSUB
WRITE !,"There are still subscribers to this plan. The plan cannot be deleted."
GOTO NOTACTQ
+11 IF 'Y
DO DEL(IBPLAN)
GOTO NOTACTQ
+12 ;
+13 ; - note that insurance policies will be activated
+14 IF IBSUB
SET IBQUIT=0
Begin DoDot:1
+15 WRITE !!,"There are still subscribers to this plan! Reactivating the plan will activate"
+16 WRITE !,"the policies of these subscribers."
+17 SET DIR(0)="Y"
SET DIR("A")=" Is it okay to continue"
SET DIR("?")="Answer 'YES' to reactivate this plan. Otherwise, answer 'NO.'"
+18 WRITE !
DO ^DIR
KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
IF 'Y
WRITE !,"The plan was not reactivated."
SET IBQUIT=1
QUIT
End DoDot:1
IF IBQUIT
GOTO NOTACTQ
+19 ;
+20 ; - reactivate the plan
+21 WRITE !,"Reactivating the plan... "
DO IRACT^IBCNSJ(IBPLAN,0)
WRITE "done."
+22 IF 'IBSUB
WRITE !,"Please note there are no subscribers to this plan."
GOTO NOTACTQ
+23 WRITE !,"Updating the 'Covered by Insurance?' field for all plan subscribers... "
+24 KILL ^TMP($JOB,"IBSUBS")
+25 SET IBSUB1=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"^TMP($J,""IBSUBS"")")
+26 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"IBSUBS",DFN))
if 'DFN
QUIT
DO COV^IBCNSJ(DFN)
+27 WRITE "done."
KILL ^TMP($JOB,"IBSUBS")
NOTACTQ QUIT
+1 ;
+2 ;
DEL(IBPLAN) ; Want to delete an Insurance Plan?
+1 ; Input: IBPLAN -- Pointer to the plan in file #355.3
+2 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
+3 SET DIR(0)="Y"
SET DIR("A")="There are no subscribers to this plan. Would you like to delete it"
SET DIR("?")="If you wish to delete this inactive plan, answer 'YES.' Otherwise, answer 'NO.'"
+4 WRITE !
DO ^DIR
IF 'Y
WRITE !,"The plan was not deleted."
+5 IF Y
WRITE !,"Deleting the plan... "
DO DEL^IBCNSJ(IBPLAN)
WRITE "done."
+6 QUIT
+7 ;
+8 ;
HLRP ; Reader help for repointing policies to a new plan.
+1 WRITE !!,"If you wish to change the subscribed-to plan of ALL policies which are"
+2 WRITE !,"currently associated with this plan, enter 'YES.' Otherwise, enter 'NO.'"
+3 WRITE !!,"You may only repoint all policies to a single plan. If you enter 'NO,'"
+4 WRITE !,"you will receive a mailman message of all the inactivated policies which"
+5 WRITE !,"will result from inactivating the plan, and then you may use the 'Change"
+6 WRITE !,"Policy Plan' action to change the subscribed-to plan on an individual basis."
+7 QUIT
+8 ;
MAIL ; Note that the subscription list will be mailed to the user.
+1 SET IBMAIL=1
+2 WRITE !,"The policies will not be re-pointed. You will receive a mail message of"
+3 WRITE !,"all the subscribers to this plan if you choose to inactivate it."
+4 QUIT
+5 ;
REP(IBCNS,IBNEWP,IBOLDP) ; Repoint patient policies from old to new plan
+1 ; Input: IBCNS -- Pointer to the company in file #36 which
+2 ; offers the plans
+3 ; IBNEWP -- Pointer to the new plan in file #355.3
+4 ; IBOLDP -- Pointer to the old plan in file #355.3
+5 ;
+6 IF '$GET(IBCNS)!'$GET(IBNEWP)!'$GET(IBOLDP)
GOTO REPQ
+7 NEW DA,DFN,DIE,DR,IBCDFN
+8 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("AB",IBCNS,DFN))
if 'DFN
QUIT
Begin DoDot:1
+9 SET IBCDFN=0
FOR
SET IBCDFN=$ORDER(^DPT("AB",IBCNS,DFN,IBCDFN))
if 'IBCDFN
QUIT
Begin DoDot:2
+10 if $PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)'=IBOLDP
QUIT
+11 SET DA=IBCDFN
SET DA(1)=DFN
SET DIE="^DPT("_DFN_",.312,"
SET DR=".18////"_IBNEWP
+12 DO ^DIE
End DoDot:2
End DoDot:1
REPQ QUIT
+1 ;
DELP ; Delete the newly-added plan.
+1 IF $GET(IBNEWP)
WRITE !,"Deleting the newly-added plan... "
DO DEL^IBCNSJ(IBCPOL)
WRITE "done."
+2 QUIT
+3 ;
HLMT ; Reader help for merging transferrable benefits used.
+1 WRITE !!,"If you want to merge the patient's current benefits used into the"
+2 WRITE !,"newly-proposed plan, enter 'YES'. Otherwise, enter 'NO' and these"
+3 WRITE !,"benefits used will be deleted."
+4 QUIT
