Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSM32

IBCNSM32.m

Go to the documentation of this file.
  1. IBCNSM32 ;ALB/AAS - INSURANCE MANAGEMENT - POLICY EDIT ;23-JAN-95
  1. ;;2.0;INTEGRATED BILLING;**28,40,52,85,103,133,361,371,413**;21-MAR-94;Build 9
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. PATPOL(IBCDFN) ; -- edit patient specific policy info
  1. I '$G(IBCDFN) G PATPOLQ
  1. D SAVEPT^IBCNSP3(DFN,IBCDFN)
  1. D POL^IBCNSU41(DFN)
  1. ;
  1. ; -- give warning if expired or inactive co.
  1. I $P(^DPT(DFN,.312,IBCDFN,0),"^",4),$P(^(0),"^",4)'>DT W !,"WARNING: This appears to be an expired policy!",!
  1. I $P(^DIC(36,+$P(^DPT(DFN,.312,IBCDFN,0),"^"),0),"^",5) W !,*7,"WARNING: This insurance company is INACTIVE!",!
  1. ;
  1. N IBAD,IBDIF,DA,DR,DIC,DIE,DGSENFLG S DGSENFLG=1
  1. L +^DPT(DFN,.312,+IBCDFN):5 I '$T D LOCKED^IBTRCD1 G PATPOLQ
  1. ;
  1. D EDIT^IBCNSP1(DFN,IBCDFN,.IBQUIT) ; IB*371 edit 2.312 subfile data
  1. ;
  1. ; If the 2.312 subfile entry was deleted then unlock and get out
  1. I '$D(^DPT(DFN,.312,IBCDFN,0)) L -^DPT(DFN,.312,+IBCDFN) G PATPOLQ
  1. ;
  1. ; -- if the company was changed, change the policy plan
  1. I $G(IBREG),$G(IBCNS),+$G(^DPT(DFN,.312,IBCDFN,0))'=IBCNS D CHPL
  1. ;
  1. K IBFUTUR
  1. D COMPPT^IBCNSP3(DFN,IBCDFN)
  1. I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN)
  1. L -^DPT(DFN,.312,+IBCDFN)
  1. ;
  1. D FUTURE^IBCNSM31 K Y,IBFUTUR
  1. PATPOLQ Q
  1. ;
  1. CHPL ; Change policy plan if the policy company differs from plan company.
  1. ; Required variable input:
  1. ; DFN -- pointer to the patient in file #2
  1. ; IBCDFN -- pointer to the policy in file #2.312
  1. ; IBCNS -- pointer to the plan company in file #36
  1. ;
  1. N IBBU,IBCNS1,IBCPOL1,IBNEWP1,IBPLAN,IBIP,IBT,X
  1. S X=$G(^DPT(DFN,.312,IBCDFN,0)),IBCNS1=+X
  1. S IBPLAN=$P(X,"^",18),IBIP='$P($G(^IBA(355.3,IBPLAN,0)),"^",2)
  1. W !!,"Since you have changed the Insurance Company to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),","
  1. W !,"you must now change the Insurance Plan to which this veteran"
  1. W !,"is subscribing to one which is offered by this company!",!
  1. ;
  1. ; - warn about benefits used
  1. D BU^IBCNSJ21 I $O(IBBU(0)) D
  1. .W !,"The current policy plan has Benefits Used associated with it!"
  1. .W !,"If you add or select another plan to associate with this policy,"
  1. .W !,"these Benefits Used will be deleted!",!
  1. ;
  1. ; - warn about Individual Plans
  1. I IBIP D
  1. .W !," *** Please note: Since the veteran's current plan is an Individual Plan,"
  1. .W !?21,"this plan will be deleted if you add or select a new"
  1. .W !?21,"plan to associate with this policy.",!
  1. ;
  1. ; - select or add a new plan
  1. S IBCPOL1=$$LK^IBCNSM31(IBCNS1)
  1. I 'IBCPOL1 D NEW^IBCNSJ3(IBCNS1,.IBCPOL1) S:IBCPOL1 IBNEWP1=1
  1. I 'IBCPOL1 D G CHPLQ
  1. .W !!,"A new plan was not added or selected!"
  1. .W !,"Changing the policy company back to ",$E($P($G(^DIC(36,IBCNS,0)),"^"),1,25),"..."
  1. .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
  1. ;
  1. W !!,"Changing the policy plan..."
  1. 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
  1. 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)
  1. ;
  1. ; - delete any dangling benefits used
  1. I $O(IBBU(0)) D
  1. .N IBDAT
  1. .W !!,"Deleting current Benefits Used... "
  1. .S IBDAT="" F S IBDAT=$O(IBBU(IBDAT)) Q:IBDAT="" D DBU^IBCNSJ(IBBU(IBDAT))
  1. ;
  1. ; - repoint all Insurance Reviews to new company
  1. I $$IR^IBCNSJ21(DFN,IBCDFN) D
  1. .W !!,"Repointing all Insurance Reviews to ",$E($P($G(^DIC(36,IBCNS1,0)),"^"),1,25),"... "
  1. .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 "."
  1. ;
  1. S IBCNS=IBCNS1,IBNEWP=$G(IBNEWP1)
  1. CHPLQ Q
  1. ;
  1. PLAN(DFN,IBCDFN,IBCNS) ; Fix policies when identified.
  1. ;
  1. ; This function is invoked from Inactivate Plan or Change Policy Plan,
  1. ; when it is recognized that the policy and plan companies are out
  1. ; of synch. If the user doesn't select a new plan to associate with
  1. ; the policy, the policy company will be changed to the plan company.
  1. ;
  1. ; The input parameters are defined above.
  1. ;
  1. N IBNEWP
  1. I '$G(DFN)!'$G(IBCDFN)!'$G(IBCNS) G PLANQ
  1. W !!,*7,"The policy company and plan company are not the same!!"
  1. W !,"This inconsistency probably occurred in the past when changing"
  1. W !,"the policy company through Screen 5 of Registration."
  1. W !!,"You must resolve this inconsistency. If you do not choose a new plan"
  1. W !,"offered by the policy company, the policy company will be changed to"
  1. W !,"the plan company (",$P($G(^DIC(36,IBCNS,0)),"^"),") ...."
  1. D CHPL
  1. PLANQ Q
  1. HLP ; -- help text for subscriber id
  1. W !,?5,"Enter Medicare Claim Number (Subscriber ID) exactly as it"
  1. W !,?5,"appears on the Medicare Insurance Card including All Characters."
  1. W !,?5,"Valid HICN formats are: 1-3 alpha characters followed by 6 or 9 digits, "
  1. W !,?5,"or 9 digits followed by 1 alpha character optionally followed by another "
  1. W !,?5,"alpha character or 1 digit."
  1. Q