IBCNSP11 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT PLAN ;23-JAN-95
;;2.0;INTEGRATED BILLING;**28,43,85,103,137,251,399,516,549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
PI ; -- edit plan information from policy edit
D FULL^VALM1
;
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges to edit Plan Information."
. K DIR
. D PAUSE^VALM1
. S VALMBCK="R"
;
N IBCDFN,IBCPOL
S IBCDFN=$P($G(IBPPOL),"^",4)
;
; - build a plan on the fly if there is not one present
S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
I IBCPOL="" S IBCPOL=$$CHIP^IBCNSU($G(^DPT(DFN,.312,IBCDFN,0))) I IBCPOL D ;Stuff in file
.S DIE="^DPT("_DFN_",.312,",DR=".18////"_IBCPOL
.S DA=IBCDFN,DA(1)=DFN
.D ^DIE
.K DA,DR,DIE,DIC
.Q
D PIEDIT(IBCPOL,DFN,IBCDFN)
Q
;
PI1 ; -- edit plan information from plan edit
D FULL^VALM1
;
;IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges to edit Plan Information."
. K DIR
. D PAUSE^VALM1
. S VALMBCK="R"
;
D PIEDIT(IBCPOL,"","")
Q
;
PIEDIT(IBCPOL,IBDFN,IBCDFN) ;Entry point if already have the plan (IBCPOL)
; -- Edit the plan specific info
; The following parameters are only used when editing plan via the patient policy
; IBDFN = DFN of patient
; IBCDFN = entry # of multiple for policy in .312 nodes of ^DPT
N DIRUT,DTOUT,DUOUT,DIROUT,IBDIF,DA,DR,DIC,DIE,IBCPOLD,IBGRP,IBTL,IBCNSEH,IBSUB
D SAVE^IBCNSP3(IBCPOL)
L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PIQ
S IBCNSEH=$S($G(IBDFN):+$G(^IBE(350.9,1,4)),1:0) D POL^IBCNSEH
S IBCPOLD=$G(^IBA(355.3,IBCPOL,0)),IBGRP=$P(IBCPOLD,"^",2)
I $P(IBCPOLD,"^",11) W !?2,*7,"Please note that this plan is inactive!",!
W !,"This plan is currently defined as a",$S(IBGRP:" Group",1:"n Individual")," Plan."
S IBSUB=$$SUBS^IBCNSJ(+$G(^IBA(355.3,IBCPOL,0)),IBCPOL,0,"",1)
I 'IBGRP,IBSUB>1 W !!,"This Individual Plan has more than one subscriber!" G CHG
I IBGRP,IBSUB>1 W !!,"There is more than one subscriber to this Group Plan. The plan cannot",!,"be changed to an individual plan.",! G PIC
;
; - switch the plan to group/individual
S DIR("A")="Do you wish to change this plan to a"_$S(IBGRP:"n Individual",1:" Group")_" Plan"
S DIR(0)="Y",DIR("?")="Enter 'YES' to change this plan, or enter 'NO' to leave it as is."
D ^DIR K DIR I $D(DIRUT) G PIQ1
I 'Y W !,"No change was made.",! G PIC
;
CHG ; - change the plan type
W !,"Changing the plan to a",$S(IBGRP:"n Individual",1:" Group")," Plan... "
S DIE="^IBA(355.3,",DA=IBCPOL,DR=".02////"_$S(IBGRP:0,1:1)_";.1////"_$S(IBGRP&$G(IBDFN):IBDFN,1:"@")
D ^DIE K DIE,DA,DR W "done.",!
;
PIC ; - edit name/number/type
S IBTL=$S($P($G(^IBA(355.3,IBCPOL,0)),"^",2):"GROUP",1:"INDIVIDUAL")_" PLAN"
S DIE="^IBA(355.3,",DA=IBCPOL
;IB*2.0*516/baa Use HIPAA Compliant fields - .03 to 2.01 .04 to 2.02
;S DR=".03"_IBTL_" NAME;.04"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
S DR="2.01"_IBTL_" NAME;2.02"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
;
D ^DIE K DIC,DIE,DA,DR
D COMP^IBCNSP3(IBCPOL)
I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBDFN) UPDATPT^IBCNSP3(IBDFN,IBCDFN),BLD^IBCNSP D:'$G(IBDFN) INIT^IBCNSC4
PIQ1 L -^IBA(355.3,+IBCPOL)
PIQ S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSP11 3664 printed Dec 13, 2024@02:17:53 Page 2
IBCNSP11 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT PLAN ;23-JAN-95
+1 ;;2.0;INTEGRATED BILLING;**28,43,85,103,137,251,399,516,549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PI ; -- edit plan information from policy edit
+1 DO FULL^VALM1
+2 ;
+3 ;IB*2.0*549 - Added Security Key check
+4 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+5 WRITE !!,*7,"Sorry, but you do not have the required privileges to edit Plan Information."
+6 KILL DIR
+7 DO PAUSE^VALM1
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 ;
+10 NEW IBCDFN,IBCPOL
+11 SET IBCDFN=$PIECE($GET(IBPPOL),"^",4)
+12 ;
+13 ; - build a plan on the fly if there is not one present
+14 SET IBCPOL=$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)
+15 ;Stuff in file
IF IBCPOL=""
SET IBCPOL=$$CHIP^IBCNSU($GET(^DPT(DFN,.312,IBCDFN,0)))
IF IBCPOL
Begin DoDot:1
+16 SET DIE="^DPT("_DFN_",.312,"
SET DR=".18////"_IBCPOL
+17 SET DA=IBCDFN
SET DA(1)=DFN
+18 DO ^DIE
+19 KILL DA,DR,DIE,DIC
+20 QUIT
End DoDot:1
+21 DO PIEDIT(IBCPOL,DFN,IBCDFN)
+22 QUIT
+23 ;
PI1 ; -- edit plan information from plan edit
+1 DO FULL^VALM1
+2 ;
+3 ;IB*2.0*549 - Added Security Key check
+4 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+5 WRITE !!,*7,"Sorry, but you do not have the required privileges to edit Plan Information."
+6 KILL DIR
+7 DO PAUSE^VALM1
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 ;
+10 DO PIEDIT(IBCPOL,"","")
+11 QUIT
+12 ;
PIEDIT(IBCPOL,IBDFN,IBCDFN) ;Entry point if already have the plan (IBCPOL)
+1 ; -- Edit the plan specific info
+2 ; The following parameters are only used when editing plan via the patient policy
+3 ; IBDFN = DFN of patient
+4 ; IBCDFN = entry # of multiple for policy in .312 nodes of ^DPT
+5 NEW DIRUT,DTOUT,DUOUT,DIROUT,IBDIF,DA,DR,DIC,DIE,IBCPOLD,IBGRP,IBTL,IBCNSEH,IBSUB
+6 DO SAVE^IBCNSP3(IBCPOL)
+7 LOCK +^IBA(355.3,+IBCPOL):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO PIQ
+8 SET IBCNSEH=$SELECT($GET(IBDFN):+$GET(^IBE(350.9,1,4)),1:0)
DO POL^IBCNSEH
+9 SET IBCPOLD=$GET(^IBA(355.3,IBCPOL,0))
SET IBGRP=$PIECE(IBCPOLD,"^",2)
+10 IF $PIECE(IBCPOLD,"^",11)
WRITE !?2,*7,"Please note that this plan is inactive!",!
+11 WRITE !,"This plan is currently defined as a",$SELECT(IBGRP:" Group",1:"n Individual")," Plan."
+12 SET IBSUB=$$SUBS^IBCNSJ(+$GET(^IBA(355.3,IBCPOL,0)),IBCPOL,0,"",1)
+13 IF 'IBGRP
IF IBSUB>1
WRITE !!,"This Individual Plan has more than one subscriber!"
GOTO CHG
+14 IF IBGRP
IF IBSUB>1
WRITE !!,"There is more than one subscriber to this Group Plan. The plan cannot",!,"be changed to an individual plan.",!
GOTO PIC
+15 ;
+16 ; - switch the plan to group/individual
+17 SET DIR("A")="Do you wish to change this plan to a"_$SELECT(IBGRP:"n Individual",1:" Group")_" Plan"
+18 SET DIR(0)="Y"
SET DIR("?")="Enter 'YES' to change this plan, or enter 'NO' to leave it as is."
+19 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO PIQ1
+20 IF 'Y
WRITE !,"No change was made.",!
GOTO PIC
+21 ;
CHG ; - change the plan type
+1 WRITE !,"Changing the plan to a",$SELECT(IBGRP:"n Individual",1:" Group")," Plan... "
+2 SET DIE="^IBA(355.3,"
SET DA=IBCPOL
SET DR=".02////"_$SELECT(IBGRP:0,1:1)_";.1////"_$SELECT(IBGRP&$GET(IBDFN):IBDFN,1:"@")
+3 DO ^DIE
KILL DIE,DA,DR
WRITE "done.",!
+4 ;
PIC ; - edit name/number/type
+1 SET IBTL=$SELECT($PIECE($GET(^IBA(355.3,IBCPOL,0)),"^",2):"GROUP",1:"INDIVIDUAL")_" PLAN"
+2 SET DIE="^IBA(355.3,"
SET DA=IBCPOL
+3 ;IB*2.0*516/baa Use HIPAA Compliant fields - .03 to 2.01 .04 to 2.02
+4 ;S DR=".03"_IBTL_" NAME;.04"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
+5 SET DR="2.01"_IBTL_" NAME;2.02"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
+6 ;
+7 DO ^DIE
KILL DIC,DIE,DA,DR
+8 DO COMP^IBCNSP3(IBCPOL)
+9 IF IBDIF
DO UPDATE^IBCNSP3(IBCPOL)
if $GET(IBDFN)
DO UPDATPT^IBCNSP3(IBDFN,IBCDFN)
DO BLD^IBCNSP
if '$GET(IBDFN)
DO INIT^IBCNSC4
PIQ1 LOCK -^IBA(355.3,+IBCPOL)
PIQ SET VALMBCK="R"
+1 QUIT
