source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSJ1.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: 4.0 KB
Line 
1IBCNSJ1 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN ; 30-DEC-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5IA ; 'Inactivate Plan' Action
6 ; Required variable input:
7 ; DFN -- Pointer to the patient in file #2
8 ; IBPPOL -- Patient insurance policy definition
9 ;
10 D FULL^VALM1
11 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) W !!,"Sorry, but you do not have the required privileges to inactivate plans." G IAQ
12 N IBCNS,IBPLAN,IBPLAND,IBPICK,IBQUIT,X
13 S X=+$P($G(IBPPOL),"^",4),X=$G(^DPT(DFN,.312,X,0))
14 S IBCNS=+X,IBPLAN=+$P(X,"^",18),(IBPICK,IBQUIT)=0
15 I 'IBPLAN D NOPL^IBCNSJ2 G IAQ
16 S IBPLAND=$G(^IBA(355.3,+IBPLAN,0)) I 'IBPLAND W !!,"This plan has no company! Please contact your IRM for assistance." G IAQ
17 I IBCNS'=+IBPLAND D PLAN^IBCNSM32(DFN,+$P($G(IBPPOL),"^",4),+IBPLAND) G IAQ
18 ;
19 ; - inactivate multiple plans?
20 S X=$$ASK^IBCNSJ4 G:X<0 IAQ I X D EN^IBCNSJ4 G IAQ
21 ;
22 W !!,"This action will allow you to inactivate an insurance plan."
23 W !,"Inactivating a plan will inactivate all current subscribers to the plan."
24 ;
25 ; - main processing loop
26 F D Q:IBQUIT
27 .I IBPICK D SEL^IBCNSJ14 Q:IBQUIT
28 .;
29 .; - invoke inactivate function
30 .S IBPICK=1
31 .D INACT(IBCNS,IBPLAN)
32 .;
33 .; - select and inactivate another plan?
34 .S DIR(0)="Y",DIR("A")="Do you wish to inactivate another plan",DIR("?")="To inactivate another plan, answer 'YES.' Otherwise, answer 'NO.'"
35 .W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT I 'Y S IBQUIT=1
36 ;
37IAQ D PAUSE^VALM1
38 D HDR^IBCNSP,BLD^IBCNSP S VALMBCK="R"
39 Q
40 ;
41 ;
42INACT(IBCNS,IBPLAN) ; Inactivate an Insurance Plan
43 ; Input: IBCNS -- Pointer to the company in file #36 which
44 ; IBPLAN -- Pointer to the plan in file #355.3
45 ;
46 N DA,DIK,IBX,IBPLAND,IBNEWP,IBFG
47 N DFN,IBACT,IBSUB,IBQUIT,IBCDFN,IBREP,IBCPOL,IBALR,IBMAIL,IBBU,IBARR
48 S IBPLAND=$G(^IBA(355.3,IBPLAN,0))
49 D DISP
50 I 'IBPLAND!(+IBPLAND'=+$G(IBCNS)) W !!,"This is not a valid insurance plan!" G INACTQ
51 ;
52 ; - is the plan an Individual Plan?
53 I '$P(IBPLAND,"^",2) D G INACTQ
54 .W !,"You cannot inactivate an Individual Plan!"
55 .W !!,"You must either delete the policy using the 'Delete Policy' action,"
56 .W !,"or change the plan to which the patient has subscribed, using the action"
57 .W !,"'Change Policy Plan'."
58 ;
59 ; - handle inactive plans
60 S IBACT=$P(IBPLAND,"^",11),IBSUB=$$SUBS^IBCNSJ(IBCNS,IBPLAN,1)
61 I IBACT D NOTACT^IBCNSJ11 G INACTQ
62 ;
63 ; - inactivate plan if there are no plan subscriptions
64 I 'IBSUB D NAC^IBCNSJ12(IBPLAN,"There are no subscribers to this plan. Would you like to inactivate it",1) G INACTQ
65 ;
66 ; - display plan attributes
67 W !,"There are currently subscribers to this plan."
68 I $D(^IBA(355.4,"APY",IBPLAN)) W !,*7," ** There are Annual Benefits associated with this plan!"
69 I $D(^IBA(355.5,"B",IBPLAN)) S IBBU=1 W !,*7," ** There are Benefits Used associated with this plan!"
70 ;
71 ; - should subscriptions to this plan be switched to another plan?
72 S DIR(0)="Y",DIR("A")="Would you like to re-point these policies to a new plan",DIR("?")="^D HLRP^IBCNSJ11"
73 W ! D ^DIR K DIR,DIRUT,DTOUT,DUOUT,DIROUT
74 I 'Y D MAIL^IBCNSJ11 G OKAY
75 ;
76 ; - select or add a new plan to re-point the policies
77 S IBREP=1,IBFG=$$SUBS^IBCNSJ(IBCNS,IBPLAN,0,"",1)>1
78 D GETPL^IBCNSJ12
79 I 'IBCPOL S IBREP=0 D MAIL^IBCNSJ11 G OKAY
80 ;
81 ; - alert user that current plan has benefits used
82 I $G(IBBU) D BU^IBCNSJ13(.IBQUIT) I IBQUIT G INACTQ
83 ;
84OKAY ; - okay to inactivate the plan?
85 D DISP,NAC^IBCNSJ12(IBPLAN," Okay to inactivate this plan",0,.IBQUIT) I IBQUIT G INACTQ
86 ;
87 ; - if there is no-repointing, send the user the subscription list
88 I $G(IBMAIL) D MSG^IBCNSJ12(IBCNS,IBPLAN)
89 ;
90 ; - re-point existing policies if necessary; allow plan deletion
91 I $G(IBREP) D REP^IBCNSJ13(IBCNS,IBCPOL,IBPLAN,$G(IBMERGE)),DEL^IBCNSJ11(IBPLAN)
92INACTQ Q
93 ;
94DISP ; Display plan name/number.
95 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>"),!
96 Q
Note: See TracBrowser for help on using the repository browser.