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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1IBCNSM32 ;ALB/AAS - INSURANCE MANAGEMENT - POLICY EDIT ;23-JAN-95
2 ;;2.0;INTEGRATED BILLING;**28,40,52,85,103,133,361,371**;21-MAR-94;Build 57
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 L +^DPT(DFN,.312,+IBCDFN):5 I '$T D LOCKED^IBTRCD1 G PATPOLQ
16 ;
17 D EDIT^IBCNSP1(DFN,IBCDFN,.IBQUIT) ; IB*371 edit 2.312 subfile data
18 ;
19 ; If the 2.312 subfile entry was deleted then unlock and get out
20 I '$D(^DPT(DFN,.312,IBCDFN,0)) L -^DPT(DFN,.312,+IBCDFN) G PATPOLQ
21 ;
22 ; -- if the company was changed, change the policy plan
23 I $G(IBREG),$G(IBCNS),+$G(^DPT(DFN,.312,IBCDFN,0))'=IBCNS D CHPL
24 ;
25 K IBFUTUR
26 D COMPPT^IBCNSP3(DFN,IBCDFN)
27 I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN)
28 L -^DPT(DFN,.312,+IBCDFN)
29 ;
30 D FUTURE^IBCNSM31 K Y,IBFUTUR
31PATPOLQ Q
32 ;
33CHPL ; Change policy plan if the policy company differs from plan company.
34 ; Required variable input:
35 ; DFN -- pointer to the patient in file #2
36 ; IBCDFN -- pointer to the policy in file #2.312
37 ; IBCNS -- pointer to the plan company in file #36
38 ;
39 N IBBU,IBCNS1,IBCPOL1,IBNEWP1,IBPLAN,IBIP,IBT,X
40 S X=$G(^DPT(DFN,.312,IBCDFN,0)),IBCNS1=+X
41 S IBPLAN=$P(X,"^",18),IBIP='$P($G(^IBA(355.3,IBPLAN,0)),"^",2)
42 W !!,"Since you have changed the Insurance Company to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),","
43 W !,"you must now change the Insurance Plan to which this veteran"
44 W !,"is subscribing to one which is offered by this company!",!
45 ;
46 ; - warn about benefits used
47 D BU^IBCNSJ21 I $O(IBBU(0)) D
48 .W !,"The current policy plan has Benefits Used associated with it!"
49 .W !,"If you add or select another plan to associate with this policy,"
50 .W !,"these Benefits Used will be deleted!",!
51 ;
52 ; - warn about Individual Plans
53 I IBIP D
54 .W !," *** Please note: Since the veteran's current plan is an Individual Plan,"
55 .W !?21,"this plan will be deleted if you add or select a new"
56 .W !?21,"plan to associate with this policy.",!
57 ;
58 ; - select or add a new plan
59 S IBCPOL1=$$LK^IBCNSM31(IBCNS1)
60 I 'IBCPOL1 D NEW^IBCNSJ3(IBCNS1,.IBCPOL1) S:IBCPOL1 IBNEWP1=1
61 I 'IBCPOL1 D G CHPLQ
62 .W !!,"A new plan was not added or selected!"
63 .W !,"Changing the policy company back to ",$E($P($G(^DIC(36,IBCNS,0)),"^"),1,25),"..."
64 .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
65 ;
66 W !!,"Changing the policy plan..."
67 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
68 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)
69 ;
70 ; - delete any dangling benefits used
71 I $O(IBBU(0)) D
72 .N IBDAT
73 .W !!,"Deleting current Benefits Used... "
74 .S IBDAT="" F S IBDA=$O(IBBU(IBDAT)) Q:IBDAT="" D DBU^IBCNSJ(IBBU(IBDAT))
75 ;
76 ; - repoint all Insurance Reviews to new company
77 I $$IR^IBCNSJ21(DFN,IBCDFN) D
78 .W !!,"Repointing all Insurance Reviews to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),"... "
79 .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 "."
80 ;
81 S IBCNS=IBCNS1,IBNEWP=$G(IBNEWP1)
82CHPLQ Q
83 ;
84PLAN(DFN,IBCDFN,IBCNS) ; Fix policies when identified.
85 ;
86 ; This function is invoked from Inactivate Plan or Change Policy Plan,
87 ; when it is recognized that the policy and plan companies are out
88 ; of synch. If the user doesn't select a new plan to associate with
89 ; the policy, the policy company will be changed to the plan company.
90 ;
91 ; The input parameters are defined above.
92 ;
93 N IBNEWP
94 I '$G(DFN)!'$G(IBCDFN)!'$G(IBCNS) G PLANQ
95 W !!,*7,"The policy company and plan company are not the same!!"
96 W !,"This inconsistency probably occurred in the past when changing"
97 W !,"the policy company through Screen 5 of Registration."
98 W !!,"You must resolve this inconsistency. If you do not choose a new plan"
99 W !,"offered by the policy company, the policy company will be changed to"
100 W !,"the plan company (",$P($G(^DIC(36,IBCNS,0)),"^"),") ...."
101 D CHPL
102PLANQ Q
103HLP ; -- help text for subscriber id
104 W !,?5,"Enter Medicare Claim Number (Subscriber ID) exactly as it"
105 W !,?5,"appears on the Medicare Insurance Card including All Characters."
106 W !,?5,"Valid HICN formats are: 1-3 alpha characters followed by 6 or 9 digits, "
107 W !,?5,"or 9 digits followed by 1 alpha character optionally followed by another "
108 W !,?5,"alpha character or 1 digit."
109 Q
Note: See TracBrowser for help on using the repository browser.