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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBCNSJ2 ;ALB/CPM - CHANGE POLICY PLAN ; 03-JAN-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CSTP ; 'Change Policy Plan' Action
6 ; Required variable input:
7 ; DFN -- Pointer to the patient in file #2
8 ; IBPPOL -- Patient insurance policy definition
9 ;
10 N DA,DIK,IBCDFN,IBCPOL,IBNEWP,IBX,IBPLAN,IBPLAND,X
11 N IBCNS,IBALR,IBMERGE,IBIP,IBBU,IBAB,IBMRGN,IBMRGF,IBX
12 S IBCDFN=$P($G(IBPPOL),"^",4)
13 I '$G(DFN)!'IBCDFN G CSTPQ
14 D FULL^VALM1
15 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) W !!,"Sorry, but you do not have the required privileges to change the policy plan." G CSTPQ
16 ;
17 S X=$G(^DPT(DFN,.312,IBCDFN,0)) I 'X W !!,"This policy is not valid!" G CSTPQ
18 S IBCNS=+X,IBPLAN=+$P(X,"^",18),IBPLAND=$G(^IBA(355.3,IBPLAN,0))
19 I 'IBPLAN D NOPL G CSTPQ
20 I 'IBPLAND W !!,"This plan has no company! Please contact your IRM for assistance." G CSTPQ
21 I IBCNS'=+IBPLAND D PLAN^IBCNSM32(DFN,IBCDFN,+IBPLAND) G CSTPQ
22 ;
23 ; - introduction
24 W !!,"This action will allow you to change the insurance plan to which the"
25 W !,"veteran is subscribing through this policy."
26 W !!,$S($P(IBPLAND,"^",2):"Group",1:"Individual")," Plan Number: ",$S($P(IBPLAND,"^",4)]"":$P(IBPLAND,"^",4),1:"<not specified>"),?50,"Plan Name: ",$S($P(IBPLAND,"^",3)]"":$P(IBPLAND,"^",3),1:"<not specified>"),!
27 D NOTES^IBCNSJ21
28 ;
29 ; - select or add a new plan for the policy
30 D GETPL^IBCNSJ12
31 I 'IBCPOL W !,"Can't change subscribed-to plan..." G CSTPQ
32 ;
33 ; - last few notes
34 I IBIP W !,*7," *** Please note that this Individual Plan will be deleted if you select",!," to switch plans associated with this policy."
35 I '$O(IBBU(0)) G OK
36 W !,*7,"This patient has Benefits Used associated with his current plan and policy!"
37 D AB^IBCNSJ21 I '$O(IBAB(0)) W !,"The newly proposed subscribed-to plan has no associated Annual Benefits,",!,"so the Benefits Used associated with the current plan will be deleted!" G OK
38 ;
39 ; - display mergeable benefits used
40 D DMBU^IBCNSJ21
41 W !!,"Please note that ",$S('$O(IBMRGF(0)):"no",$G(IBMRGN):"some",1:"all")," Benefits Used are transferable."
42 I $G(IBMRGN) W !,$S('$O(IBMRGF(0)):"All Benefits Used",1:"Note that those Benefits Used which cannot be merged")," will be deleted!"
43 I '$O(IBMRGF(0)) G OK
44 ;
45 ; - merge or delete previous benefits used?
46 S DIR(0)="Y",DIR("A")="Do you want to merge the transferable Benefits Used",DIR("?")="^D HLMT^IBCNSJ11"
47 W ! D ^DIR K DIR I $D(DIRUT) D DELP^IBCNSJ11 G CSTPQ
48 S IBMERGE=Y
49 W !,$S(IBMERGE:"The transferable",1:"All")," Benefits Used will be ",$S(IBMERGE:"merged.",1:"deleted.")
50 ;
51OK ; - okay to switch subscribed-to plan?
52 S DIR(0)="Y",DIR("A")="Okay to change the subscribed-to plan",DIR("?")="^D HLSW^IBCNSJ21"
53 W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
54 I 'Y W !!,"The subscribed-to plan for this policy was not changed.",! D DELP^IBCNSJ11 G CSTPQ
55 ;
56 ; - change plan in policy; adjust 'covered by insurance' field
57 W !!,"Changing the subscribed-to plan... " D SWPL^IBCNSJ13(IBCPOL,DFN,IBCDFN) W "done."
58 ;
59 ; - merge/delete benefits used, if necessary
60 D MD^IBCNSJ21
61 ;
62 ; - delete the previous individual plan, if necessary
63 I IBIP W !,"Deleting the formerly subscribed-to Individual Plan... " D DEL^IBCNSJ(IBPLAN) W "done." G CSTPQ
64 ;
65 ; - if plan no longer has subscribers, say so.
66 I '$$SUBS^IBCNSJ(IBCNS,IBPLAN,1) W !!,"There are no longer any subscribers to the previous plan. You may wish",!,"to inactivate or delete this plan using the 'Inactivate Plan' action."
67 ;
68CSTPQ D PAUSE^VALM1
69 D HDR^IBCNSP,BLD^IBCNSP S VALMBCK="R"
70 Q
71 ;
72NOPL ; Display message if there is no insurance plan.
73 W !!,"There is no plan associated with this policy!"
74 W !!,"Please use the action 'Change Plan Info', which will create a plan"
75 W !,"for the policy."
76 Q
Note: See TracBrowser for help on using the repository browser.