source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP11.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1IBCNSP11 ;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 ;
5PI ; -- 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 ;
21PI1 ; -- edit plan information from plan edit
22 D FULL^VALM1
23 D PIEDIT(IBCPOL,"","")
24 Q
25 ;
26PIEDIT(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 ;
48CHG ; - 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 ;
53PIC ; - 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
61PIQ1 L -^IBA(355.3,+IBCPOL)
62PIQ S VALMBCK="R"
63 Q
Note: See TracBrowser for help on using the repository browser.