| [613] | 1 | IBCNSP11 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT PLAN ;23-JAN-95
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**28,43,85,103,137,251**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PI ; -- edit plan information from policy edit
|
|---|
| 6 | D FULL^VALM1
|
|---|
| 7 | N IBCDFN,IBCPOL
|
|---|
| 8 | S IBCDFN=$P($G(IBPPOL),"^",4)
|
|---|
| 9 | ;
|
|---|
| 10 | ; - build a plan on the fly if there is not one present
|
|---|
| 11 | S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
|
|---|
| 12 | I IBCPOL="" S IBCPOL=$$CHIP^IBCNSU($G(^DPT(DFN,.312,IBCDFN,0))) I IBCPOL D ;Stuff in file
|
|---|
| 13 | .S DIE="^DPT("_DFN_",.312,",DR=".18////"_IBCPOL
|
|---|
| 14 | .S DA=IBCDFN,DA(1)=DFN
|
|---|
| 15 | .D ^DIE
|
|---|
| 16 | .K DA,DR,DIE,DIC
|
|---|
| 17 | .Q
|
|---|
| 18 | D PIEDIT(IBCPOL,DFN,IBCDFN)
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | PI1 ; -- edit plan information from plan edit
|
|---|
| 22 | D FULL^VALM1
|
|---|
| 23 | D PIEDIT(IBCPOL,"","")
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PIEDIT(IBCPOL,IBDFN,IBCDFN) ;Entrypoint if already have the plan (IBCPOL)
|
|---|
| 27 | ; -- Edit the plan specific info
|
|---|
| 28 | ; The following parameters are only used when editing plan via the patient policy
|
|---|
| 29 | ; IBDFN = DFN of patient
|
|---|
| 30 | ; IBCDFN = entry # of multiple for policy in .312 nodes of ^DPT
|
|---|
| 31 | N DIRUT,DTOUT,DUOUT,DIROUT,IBDIF,DA,DR,DIC,DIE,IBCPOLD,IBGRP,IBTL,IBCNSEH,IBSUB
|
|---|
| 32 | D SAVE^IBCNSP3(IBCPOL)
|
|---|
| 33 | L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PIQ
|
|---|
| 34 | S IBCNSEH=$S($G(IBDFN):+$G(^IBE(350.9,1,4)),1:0) D POL^IBCNSEH
|
|---|
| 35 | S IBCPOLD=$G(^IBA(355.3,IBCPOL,0)),IBGRP=$P(IBCPOLD,"^",2)
|
|---|
| 36 | I $P(IBCPOLD,"^",11) W !?2,*7,"Please note that this plan is inactive!",!
|
|---|
| 37 | W !,"This plan is currently defined as a",$S(IBGRP:" Group",1:"n Individual")," Plan."
|
|---|
| 38 | S IBSUB=$$SUBS^IBCNSJ(+$G(^IBA(355.3,IBCPOL,0)),IBCPOL,0,"",1)
|
|---|
| 39 | I 'IBGRP,IBSUB>1 W !!,"This Individual Plan has more than one subscriber!" G CHG
|
|---|
| 40 | 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
|
|---|
| 41 | ;
|
|---|
| 42 | ; - switch the plan to group/individual
|
|---|
| 43 | S DIR("A")="Do you wish to change this plan to a"_$S(IBGRP:"n Individual",1:" Group")_" Plan"
|
|---|
| 44 | S DIR(0)="Y",DIR("?")="Enter 'YES' to change this plan, or enter 'NO' to leave it as is."
|
|---|
| 45 | D ^DIR K DIR I $D(DIRUT) G PIQ1
|
|---|
| 46 | I 'Y W !,"No change was made.",! G PIC
|
|---|
| 47 | ;
|
|---|
| 48 | CHG ; - change the plan type
|
|---|
| 49 | W !,"Changing the plan to a",$S(IBGRP:"n Individual",1:" Group")," Plan... "
|
|---|
| 50 | S DIE="^IBA(355.3,",DA=IBCPOL,DR=".02////"_$S(IBGRP:0,1:1)_";.1////"_$S(IBGRP&$G(IBDFN):IBDFN,1:"@")
|
|---|
| 51 | D ^DIE K DIE,DA,DR W "done.",!
|
|---|
| 52 | ;
|
|---|
| 53 | PIC ; - edit name/number/type
|
|---|
| 54 | S IBTL=$S($P($G(^IBA(355.3,IBCPOL,0)),"^",2):"GROUP",1:"INDIVIDUAL")_" PLAN"
|
|---|
| 55 | S DIE="^IBA(355.3,",DA=IBCPOL
|
|---|
| 56 | ;;Daou/EEN - adding BIN (#355.3,6.02) and PCN (#355.3,6.03)
|
|---|
| 57 | 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;.13"
|
|---|
| 58 | D ^DIE K DIC,DIE,DA,DR
|
|---|
| 59 | D COMP^IBCNSP3(IBCPOL)
|
|---|
| 60 | I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBDFN) UPDATPT^IBCNSP3(IBDFN,IBCDFN),BLD^IBCNSP D:'$G(IBDFN) INIT^IBCNSC4
|
|---|
| 61 | PIQ1 L -^IBA(355.3,+IBCPOL)
|
|---|
| 62 | PIQ S VALMBCK="R"
|
|---|
| 63 | Q
|
|---|
