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
|
---|