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

IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ; 22-OCT-92
 ;;2.0;INTEGRATED BILLING;**6,28,40,43,52,85,103,361**;21-MAR-94;Build 9
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
% G EN^IBCNSP
 ;
EA ; -- Edit all
 N IBCDFN,IBTRC,IBTRN
 D FULL^VALM1 W !!
 S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" G EAQ
 S IBCNSEH=1 D PAT^IBCNSEH
 ;
 D BEFORE^IBCNSEVT
 D PATPOL^IBCNSM32(IBCDFN)
 D AFTER^IBCNSEVT,^IBCNSEVT
 ;
 ; -- edit policy data
 D POL^IBCNSEH
 D EDPOL^IBCNSM3(IBCDFN)
 ;
 W !! D AI
 ;
EAQ D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
 D BLD^IBCNSP
 S VALMBCK="R"
 Q
 ;
AB ; -- Annual Benefits
 S X=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,X,0)),IBCPOL=+$P($G(^(0)),"^",18)
 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ABQ
 D FULL^VALM1 W !!
 D EN^VALM("IBCNS ANNUAL BENEFITS")
 S VALMBCK="R"
ABQ Q
 ;
BU ; -- Benefits Used
 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,IBCDFN,0)),IBCPOL=+$P($G(^(0)),"^",18)
 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G BUQ
 D FULL^VALM1 W !!
 D EN^VALM("IBCNS BENEFITS USED BY DATE")
 S VALMBCK="R"
BUQ Q
 ;
IT ; -- edit insurance type info from patient policy and plan edit
 D FULL^VALM1 W !!
 N IBCDFN
 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCPOL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ITQ
 D ITEDIT(IBCPOL,IBCDFN)
ITQ S VALMBCK="R" Q
 ;
IT1 ; -- edit insurance type info from patient policy
 D ITEDIT(IBCPOL)
 S VALMBCK="R"
 Q
 ;
ITEDIT(IBCPOL,IBCDFN) ;Edit insurance type info once you have plan (IBCPOL)
 ; IBCDFN = the ifn of the policy multiple for pt in ^DPT, node .312
 ;          only defined for editing via patient policy
 G:'$G(IBCPOL) ITEDITQ
 D SAVE^IBCNSP3(IBCPOL)
 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITEDITQ
 I $G(IBCDFN) S IBCNSEH=+$G(^IBE(350.9,1,4)) D POL^IBCNSEH
 I $P($G(^IBA(355.3,IBCPOL,0)),"^",11) W !?2,*7,"Please note that this plan is inactive!",!
 S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.12;.06;.07;.08"
 D ^DIE K DIC,DIE,DA,DR
 D COMP^IBCNSP3(IBCPOL)
 I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBCDFN) UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP D:'$G(IBCDFN) INIT^IBCNSC4
 L -^IBA(355.3,+IBCPOL)
ITEDITQ Q
 ;
ED ; -- Edit effective dates
 D FULL^VALM1 W !!
 N IBDIF,DA,DR,DIE,DIC
 D BEFORE^IBCNSEVT
 D SAVEPT^IBCNSP3(DFN,IBCDFN)
 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ
 D VARS^IBCNSP3
 S DR="8;3;1.09//;3.04"
 D ^DIE K DIC,DIE,DA,DR
 D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),AFTER^IBCNSEVT,^IBCNSEVT,BLD^IBCNSP
 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
EDQ S VALMBCK="R" Q
 ;
VC ; -- Verify Coverage
 D FULL^VALM1 W !!
 D VFY^IBCNSM2
 D BLD^IBCNSP
 S VALMBCK="R" Q
 ;
SU ; -- Subscriber Update
 D FULL^VALM1 W !!
 ;Patch 40
 N IBDIF,DA,DR,DIC,DIE,DGSENFLG
 S DGSENFLG=1
 D SAVEPT^IBCNSP3(DFN,IBCDFN)
 D VARS^IBCNSP3
 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ
 S DR="6;S IBAD=X;K X I '$$VET^IBCNSU1() S Y=""@10"";17///^S X=$P(^DPT(DFN,0),U);16///^S X=""01"""
 S DR=DR_";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;.2;4.01;4.02;3.01;3.12;3.02;3.03;3.05:3.11"
 D ^DIE K DIC,DIE,DA,DR
 D COMPPT^IBCNSP3(DFN,IBCDFN)
 I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
SUQ S VALMBCK="R" Q
 ;
IC ; -- Insurance Contact Information
 D FULL^VALM1 W !!
 N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
 D AI
 D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP
 S VALMBCK="R" Q
 Q
AI ; -- Add ins. verification entry
 N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
 Q:'$G(DFN)
 Q:'$G(IBCDFN)  S IBQUIT=0
 D AI^IBCNSP02
 Q