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

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1IBCNSUR ;ALB/CPM/CMS - MOVE SUBSCRIBERS TO DIFFERENT PLAN ;09-SEP-96
2 ;;2.0;INTEGRATED BILLING;**103,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6EN ; Entry point from option. Main processing loop.
7 I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,1:0) W !!?3,"The variable DUZ must be set to an active user code before continuing." G ENQ
8 W !!,?5,"MOVE SUBSCRIBERS OF ONE PLAN TO ANOTHER PLAN"
9 W !,?5,"This option may be used to move subscribers from a selected Plan"
10 W !,?5,"to a different Plan. The plans may be associated with the same"
11 W !,?5,"Insurance Company or a different one. Plan and Annual Benefit"
12 W !,?5,"information may be moved as well. Users of this option should"
13 W !,?5,"be knowledgeable of the VistA Patient Insurance management options."
14 W !
15 W !,?5,"This option also gives the user the option to expire the old plan or"
16 W !,?5,"replace it completely in the patient insurance profile. The reason"
17 W !,?5,"to expire the old plan is intended for use when Insurance groups change"
18 W !,?5,"PBMs for processing electronic Pharmacy claims. By leaving the old"
19 W !,?5,"plan information intact (i.e. do not replace), the user will be able"
20 W !,?5,"to monitor PBM changes that affect the electronic Pharmacy claims."
21 ;
22 W !!,$TR($J("",75)," ","-")
23 S IBSTOP=0 F D PROC^IBCNSUR1 Q:IBSTOP
24ENQ K IBSTOP
25 Q
26 ;
27PROC ; - Process continuation from IBCNSUR1.
28 ; - display old plan attributes; allow new plan to be edited
29 D PL^IBCNSUR2
30 R !!,?10,"Press any key to continue. ",IBX:DTIME
31 ;
32 ; - display coverage limitations; allow add/edit of plan 2 limitations
33 D LIM^IBCNSUR2
34 ;
35 I $P($G(^IBA(355.3,IBP1,0)),"^",11) W !!,"Please note that ",IBC1N,"'s",!,"plan, subscribers were moved from, is already inactive." G PROCDP
36 ;
37 ; - does the user wish to inactivate the old plan?
38 W !! S DIR(0)="Y",DIR("A")="Do you wish to inactivate "_IBC1N_"'s plan subscribers were moved from"
39 S DIR("?")="If you wish to inactivate the old plan, enter 'Yes' - otherwise, enter 'No.'"
40 D ^DIR K DIR I 'Y W !," <The old plan is still active>" G PROCQ
41 ;
42 D IRACT^IBCNSJ(IBP1,1) W !!,"The plan has been inactivated."
43 ;
44PROCDP ; - does the user wish to delete the old plan?
45 W !! S DIR(0)="Y",DIR("A")="Do you wish to delete this plan"
46 S DIR("?")="If you wish to delete the old plan, enter 'Yes' - otherwise, enter 'No.'"
47 D ^DIR K DIR I 'Y G PROCQ
48 ;
49 D DEL^IBCNSJ(IBP1) W !!,"The plan has been deleted."
50 ;
51PROCQ Q
52 ;
53 ;
54SEL(IBNP) ; Select a company and plan.
55 ; Input: IBNP -- If set to 1, allows adding a new plan and
56 ; -- Screen Inactive Companies
57 ; -- If set to 0, must have at least one group plan
58 ; Output: IBCNS -- Pointer to selected company in file #36
59 ; IBPLAN -- Pointer to selected/added plan in file #355.3
60 ; IBQUIT -- Set to 1 if the user wants to quit.
61 ;
62 N X,Y K DIC,DIR
63 S DIC(0)="QEAMZ",DIC="^DIC(36,"
64 I 'IBNP S DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1)"
65 I IBNP S DIC("S")="I '$P($G(^DIC(36,+Y,0)),U,5)"
66 S DIC("A")="Select INSURANCE COMPANY: "
67 D ^DIC K DIC S IBCNS=+Y
68 I Y<0 W " <No Insurance Company selected>" S IBQUIT=1 G SELQ
69 ;
70 ; - if a new plan may be added, allow adding
71 I IBNP D I (IBPLAN)!(IBQUIT) G SELQ
72 .W !!,"You may add a new Plan at this time or select an existing Plan."
73 .D NEW^IBCNSJ3(IBCNS,.IBPLAN,1)
74 .I 'IBPLAN,'$$ANYGP^IBCNSJ(+IBCNS,0,1) W !!,*7,"Insurance Company receiving subscribers must have a Plan." S IBQUIT=1
75 ;
76 ; - see if user wants to select the plan
77 W !!,"You may select an existing Plan from a list or enter a specific Plan.",!
78 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to enter a specific plan"
79 S DIR("?")="The look-up facility to select a group plan has been enhanced to use the List Manager. Enter 'NO' if you wish to select a plan from this look-up, or 'YES' to directly enter a plan."
80 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G SELQ
81 ;
82 ; - invoke the plan look-up
83 I 'Y D G SELQ
84 .W " ..." S IBPLAN=0 D LKP^IBCNSU2(IBCNS,0,0,.IBPLAN,0,1)
85 .I 'IBPLAN W !!,*7,"* No plan selected!",! S IBQUIT=1
86 ;
87 ; - allow a FileMan look-up
88 S DIC("A")="Select a GROUP PLAN: "
89 S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2)"
90 S DIC("W")="N IBX S IBX=$G(^(0)) W "" Name: "",$E($S($P(IBX,U,3)]"""":$P(IBX,U,3),1:""<none>"")_$J("""",20),1,20),"" Number: "",$S($P(IBX,U,4)]"""":$P(IBX,U,4),1:""<none>"")"
91 D ^DIC K DIC S IBPLAN=+Y
92 I Y<0 W !!,*7,"* No plan selected!",! S IBQUIT=1
93 ;
94SELQ K DIRUT,DUOUT,DTOUT,DIROUT
95 Q
Note: See TracBrowser for help on using the repository browser.