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

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1IBCNSUX ;ALB/CMS - SPLIT MEDICARE COMBINATION PLANS ; 29-OCT-98
2 ;;2.0;INTEGRATED BILLING;**103**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine shoud not be modified.
4 ;
5 Q
6 ;
7EN ; Entry point from option.
8 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
9 W !!,?5,"SPLIT MEDICARE PART A /PART B COMBINATION PLANS"
10 W !!,?5,"WARNING: CAUTION SHOULD BE TAKEN WHEN USING THIS OPTION!!"
11 W !!,?5,"This option should ONLY be used at sites that have created a"
12 W !,?5,"Medicare, Will Not Reimburse, Insurance Company which has a"
13 W !,?5,"non-standard Group plan associated with it that combines Part A"
14 W !,?5,"and Part B coverage.",!
15 W !,?5,"Make sure the correct plan is selected. This option will create"
16 W !,?5,"a Part B policy for each subscriber and edit the existing policy"
17 W !,?5,"to point it to the standard Medicare Part A policy."
18 W !!,$TR($J("",75)," ","-")
19 ;
20 N IBINS,IBPLAN,IBQUIT,IBWNR,X,Y
21 S IBWNR=$$GETWNR^IBCNSMM1,IBQUIT=0
22 I 'IBWNR W !!,*7,?5,IBWNR G ENQ
23 ;
24 ;I DT>2990301 W !!,*7,?5,"This option cannot be run after March 3, 1999."
25 ;
26 D SEL I IBQUIT G ENQ
27 ;
28 W !,"ALL POLICIES ENTERED FOR THE SELECTED COMBINATION PLAN WILL BE CHANGED"
29 W !,"TO BE ASSOCIATED WITH MEDICARE PART A AND A NEW POLICY CREATED FOR "
30 W !,"MEDICARE PART B. THE COMBINATION PLAN WILL BE DELETED IF EMPTY!"
31 ;
32 D OKAY I IBQUIT G ENQ
33 ;
34 ; -- Ask Device
35 N IBX,%ZIS,ZTRTN,ZTSAVE,ZTDESC
36 W !,?10,"You should send the output to a printer.",!
37 S %ZIS="QM" D ^%ZIS G:POP QUEQ
38 I $D(IO("Q")) K IO("Q") D G QUEQ
39 .F IBX="IBINS","IBPLAN","IBWNR" S ZTSAVE(IBX)=""
40 .S ZTRTN="BEG^IBCNSUX1",ZTDESC="IB - Separate Medicare Combination policies"
41 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
42 ;
43 U IO
44 I $E(IOST,1,2)["C-" W !!,?15,"...... One Moment Please ..."
45 D BEG^IBCNSUX1
46 ;
47QUEQ ; Exit Clean-up
48 W ! D ^%ZISC
49 ;
50ENQ Q
51 ;
52SEL ; Select a MEDICARE company and plan.
53 ; Output: IBINS -- Pointer to selected company in file #36
54 ; IBPLAN -- Pointer to selected/added plan in file #355.3
55 ; IBQUIT -- Set to 1 if the user wants to quit.
56 ;
57 N DA,DIC,DIRUT,DIROUT,DTOUT,DUOUT,DR,IBX,IBY,X,Y,IBSUBS
58 S IBY=$O(^IBE(355.2,"B","MEDICARE",0))
59 S DIC(0)="QEAMZ",DIC="^DIC(36,"
60 S DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1),$P($G(^DIC(36,+Y,0)),U,13)=IBY"
61 S DIC("A")="Select MEDICARE INSURANCE COMPANY: "
62 D ^DIC K DIC S IBINS=+Y
63 I Y<0 W " <No Insurance Company selected>" S IBQUIT=1 G SELQ
64 ;
65SELP ; - select the Combination Plan
66 K DIC
67 S DIC("A")="Select COMBINATION GROUP PLAN: "
68 S DIC="^IBA(355.3,",DIC(0)="AEQMZ"
69 S DIC("S")="I +^(0)=IBINS,$P(^(0),U,2)"
70 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>"")"
71 D ^DIC K DIC S IBPLAN=+Y
72 I IBPLAN=$P(IBWNR,U,3) W !!,?5,*7,"* Cannot select standard Part A plan" G SELP
73 I IBPLAN=$P(IBWNR,U,5) W !!,?5,*7,"* Cannot select standard Part B plan" G SELP
74 I Y<0 W !!,?5,*7,"* No plan selected!",! S IBQUIT=1 G SELQ
75 W !!,"Collecting Subscribers ..."
76 S IBSUBS=$$SUBS^IBCNSJ(IBINS,IBPLAN)
77 W !!,?5,"This plan has ",IBSUBS," subscriber",$S(IBSUBS=1:"",1:"s"),"."
78 W:'IBSUBS !?5,"You must select a plan with subscribers! Please select another plan."
79 W !! I 'IBSUBS G SELP
80 ;
81SELQ Q
82 ;
83OKAY ; -- Ask Okay to Continue
84 ; Returns IBQUIT=1 to exit
85 N DIR,DTOUT,DIROUT,DIRUT,DUOUT,X,Y
86 S DIR(0)="YO",DIR("B")="NO",DIR("A")="Okay to Continue"
87 S DIR("?")="Enter 'Yes' to separate combination policies"
88 W ! D ^DIR
89 I $G(Y)'=1 S IBQUIT=1
90 Q
Note: See TracBrowser for help on using the repository browser.