- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSM32.m
r613 r623 1 IBCNSM32 ;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 ; 5 PATPOL(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 31 PATPOLQ Q 32 ; 33 CHPL ; 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) 82 CHPLQ Q 83 ; 84 PLAN(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 102 PLANQ Q 103 HLP ; -- 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 1 IBCNSM32 ;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 ; 5 PATPOL(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 33 PATPOLQ Q 34 ; 35 CHPL ; 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) 84 CHPLQ Q 85 ; 86 PLAN(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 104 PLANQ Q 105 HLP ; -- 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 TracChangeset
for help on using the changeset viewer.
