source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSM32.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 5.3 KB
Line 
1IBCNSM32 ;ALB/AAS - INSURANCE MANAGEMENT - POLICY EDIT ; 23-JAN-95
2 ;;2.0;INTEGRATED BILLING;**28,40,52,85,103,133,361**;21-MAR-94;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5PATPOL(IBCDFN) ; -- edit patient specific policy info
6 I '$G(IBCDFN) G PATPOLQ
7 D SAVEPT^IBCNSP3(DFN,IBCDFN)
8 D POL^IBCNSU41(DFN)
9 ;
10 ; -- give warning if expired or inactive co.
11 I $P(^DPT(DFN,.312,IBCDFN,0),"^",4),$P(^(0),"^",4)'>DT W !,"WARNING: This appears to be an expired policy!",!
12 I $P(^DIC(36,+$P(^DPT(DFN,.312,IBCDFN,0),"^"),0),"^",5) W !,*7,"WARNING: This insurance company is INACTIVE!",!
13 ;
14 N IBAD,IBDIF,DA,DR,DIC,DIE,DGSENFLG S DGSENFLG=1
15 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN,DA=IBCDFN
16 S DR="S IBAD="""";8;@333;3;D FUTURE^IBCNSM31;6;S IBAD=X;K X I '$$VET^IBCNSU1() S Y=""@10"";17///^S X=$P(^DPT(DFN,0),U);16///^S X=""01"""
17 ;S DR="S IBAD="""";8;@333;3;D FUTURE^IBCNSM31;6;S IBAD=X;I IBAD'=""v"" S Y=""@10"";17"_$S($$VET^IBCNSU1():"///^S X="""_$P(^DPT(DFN,0),U,1)_"""",1:"//"_);16///^S X=""01"""
18 S DR=DR_";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;3.01;3.12;1.09//;I $G(IBREG) S Y=""@99"";.2;4.01;4.02;@99"
19 I $G(IBREG),$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) S DR=".01//;"_DR
20 L +^DPT(DFN,.312,+IBCDFN):5 I '$T D LOCKED^IBTRCD1 G PATPOLQ
21 D ^DIE I $D(Y)!($D(DTOUT)) S IBQUIT=1
22 I '$D(DA) S IBQUIT=1 G PATPOLQ
23 ;
24 ; -- if the company was changed, change the policy plan
25 I $G(IBREG),$G(IBCNS),+$G(^DPT(DFN,.312,IBCDFN,0))'=IBCNS D CHPL
26 ;
27 K IBFUTUR
28 D COMPPT^IBCNSP3(DFN,IBCDFN)
29 I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN)
30 L -^DPT(DFN,.312,+IBCDFN)
31 ;
32 D FUTURE^IBCNSM31 K Y,IBFUTUR
33PATPOLQ Q
34 ;
35CHPL ; Change policy plan if the policy company differs from plan company.
36 ; Required variable input:
37 ; DFN -- pointer to the patient in file #2
38 ; IBCDFN -- pointer to the policy in file #2.312
39 ; IBCNS -- pointer to the plan company in file #36
40 ;
41 N IBBU,IBCNS1,IBCPOL1,IBNEWP1,IBPLAN,IBIP,IBT,X
42 S X=$G(^DPT(DFN,.312,IBCDFN,0)),IBCNS1=+X
43 S IBPLAN=$P(X,"^",18),IBIP='$P($G(^IBA(355.3,IBPLAN,0)),"^",2)
44 W !!,"Since you have changed the Insurance Company to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),","
45 W !,"you must now change the Insurance Plan to which this veteran"
46 W !,"is subscribing to one which is offered by this company!",!
47 ;
48 ; - warn about benefits used
49 D BU^IBCNSJ21 I $O(IBBU(0)) D
50 .W !,"The current policy plan has Benefits Used associated with it!"
51 .W !,"If you add or select another plan to associate with this policy,"
52 .W !,"these Benefits Used will be deleted!",!
53 ;
54 ; - warn about Individual Plans
55 I IBIP D
56 .W !," *** Please note: Since the veteran's current plan is an Individual Plan,"
57 .W !?21,"this plan will be deleted if you add or select a new"
58 .W !?21,"plan to associate with this policy.",!
59 ;
60 ; - select or add a new plan
61 S IBCPOL1=$$LK^IBCNSM31(IBCNS1)
62 I 'IBCPOL1 D NEW^IBCNSJ3(IBCNS1,.IBCPOL1) S:IBCPOL1 IBNEWP1=1
63 I 'IBCPOL1 D G CHPLQ
64 .W !!,"A new plan was not added or selected!"
65 .W !,"Changing the policy company back to ",$E($P($G(^DIC(36,IBCNS,0)),"^"),1,25),"..."
66 .S DIE="^DPT(DFN,.312,",DA(1)=DFN,DA=IBCDFN,DR=".01////"_IBCNS_";1.05///NOW;1.06////"_DUZ D ^DIE K DA,DIE,DR
67 ;
68 W !!,"Changing the policy plan..."
69 S DIE="^DPT(DFN,.312,",DA(1)=DFN,DA=IBCDFN,DR=".18////"_IBCPOL1_";1.05///NOW;1.06////"_DUZ D ^DIE K DA,DIE,DR
70 I IBIP!$G(IBNEWP) W !!,"Deleting the ",$S(IBIP:"current Individual",1:"previously-added")," plan for ",$E($P($G(^DIC(36,IBCNS,0)),"^"),1,25),"..." D DEL^IBCNSJ(IBPLAN)
71 ;
72 ; - delete any dangling benefits used
73 I $O(IBBU(0)) D
74 .N IBDAT
75 .W !!,"Deleting current Benefits Used... "
76 .S IBDAT="" F S IBDA=$O(IBBU(IBDAT)) Q:IBDAT="" D DBU^IBCNSJ(IBBU(IBDAT))
77 ;
78 ; - repoint all Insurance Reviews to new company
79 I $$IR^IBCNSJ21(DFN,IBCDFN) D
80 .W !!,"Repointing all Insurance Reviews to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),"... "
81 .S IBT=0 F S IBT=$O(^IBT(356.2,"D",DFN,IBT)) Q:'IBT I $P($G(^IBT(356.2,IBT,1)),"^",5)=IBCDFN,$P($G(^(0)),"^",8)'=IBCNS1 S DA=IBT,DR=".08////"_IBCNS1,DIE="^IBT(356.2," D ^DIE K DA,DR,DIE W "."
82 ;
83 S IBCNS=IBCNS1,IBNEWP=$G(IBNEWP1)
84CHPLQ Q
85 ;
86PLAN(DFN,IBCDFN,IBCNS) ; Fix policies when identified.
87 ;
88 ; This function is invoked from Inactivate Plan or Change Policy Plan,
89 ; when it is recognized that the policy and plan companies are out
90 ; of synch. If the user doesn't select a new plan to associate with
91 ; the policy, the policy company will be changed to the plan company.
92 ;
93 ; The input parameters are defined above.
94 ;
95 N IBNEWP
96 I '$G(DFN)!'$G(IBCDFN)!'$G(IBCNS) G PLANQ
97 W !!,*7,"The policy company and plan company are not the same!!"
98 W !,"This inconsistency probably occurred in the past when changing"
99 W !,"the policy company through Screen 5 of Registration."
100 W !!,"You must resolve this inconsistency. If you do not choose a new plan"
101 W !,"offered by the policy company, the policy company will be changed to"
102 W !,"the plan company (",$P($G(^DIC(36,IBCNS,0)),"^"),") ...."
103 D CHPL
104PLANQ Q
105HLP ; -- help text for subscriber id
106 W !,?5,"Enter Medicare Claim Number (Subscriber ID) exactly as it"
107 W !,?5,"appears on the Medicare Insurance Card including All Characters."
108 W !,?5,"Valid HICN formats are: 1-3 alpha characters followed by 6 or 9 digits, "
109 W !,?5,"or 9 digits followed by 1 alpha character optionally followed by another "
110 W !,?5,"alpha character or 1 digit."
111 Q
Note: See TracBrowser for help on using the repository browser.