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

IBCNSBL.m

Go to the documentation of this file.
  1. IBCNSBL ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ;29-AUG-93
  1. ;;2.0;INTEGRATED BILLING;**6,28,103,249**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % N IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD
  1. ;
  1. Q:'$D(IBEVTA0)!('$D(IBEVTA1))!('$D(IBEVTA2))!('$D(IBCDFN))!('$D(IBEVTACT))
  1. D:IBEVTACT="ADD" BLTN
  1. D:$P($G(IBEVTA1),"^",9)=3 IVM
  1. D VNC
  1. Q
  1. ;
  1. BLTN ; -- generate bulletin if new policy
  1. ;
  1. K ^TMP($J,"SDAMA201","GETAPPT")
  1. S IBP=$$PT^IBEFUNC(DFN),(OPT,INPT)=0
  1. ;
  1. ; -- set starting date = latest of 2 years ago, or effective date
  1. S START=DT-20000
  1. I $P(IBEVTA0,"^",8),$P(IBEVTA0,"^",8)>START S START=$P(IBEVTA0,"^",8)
  1. ;
  1. S END=DT+.9
  1. ;
  1. D GETAPPT^SDAMA201(DFN,"1;2","R",START,END,.OPT,"O")
  1. S X=$O(^DGPM("APTT1",DFN,START)) I X,(X'>(END+.24)) S INPT=1
  1. I $G(^DPT(DFN,.1))'="" D S INPT=1
  1. .;
  1. .;see if current admission is in claims tracking
  1. .S VAINDT=DT+.24 D INP^VADPT
  1. .N IBMVAD,IBTRKR,IBRANDOM,DGPMA
  1. .S IBMVAD=+VAIN(1),DGPMA=$G(^DGPM(+IBMVAD,0))
  1. .I DFN=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2) Q ; quit if already in claims tracking
  1. .S IBTRKR=$G(^IBE(350.9,1,6))
  1. .I $P(IBTRKR,"^",2)=2 D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1
  1. .I $P(IBTRKR,"^",2)=1,$$INSURED^IBCNS1(DFN,+DGPMA) D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1
  1. .Q
  1. ;
  1. S VAINDT=START+.24 D INP^VADPT I $G(VAIN(1)) S INPT=1
  1. I 'OPT,'INPT G BQ
  1. ;
  1. D BULL^IBCNSBL1
  1. BQ K ^TMP($J,"SDAMA201","GETAPPT")
  1. Q
  1. ;
  1. IVM ; -- announce patients who have ivm-identified insurance. input = dfn
  1. I $G(^IBA(354,DFN,"IVM")) G IVMQ
  1. I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 K IBWHER,IBEXERR,IBADD
  1. S DIE="^IBA(354,",DR="50////1",DA=DFN D ^DIE K DIE,DR,DA,DIC
  1. IVMQ Q
  1. ;
  1. VNC ; -- remove verification of no coverage
  1. N DA,DIC,DIE,DR,X,Y
  1. I '$G(^IBA(354,DFN,60)) G VNCQ
  1. ;
  1. ; - delete verification date if the patient has effective policies
  1. I $$EPOL^IBCNSM2(DFN) S DA=DFN,DIE="^IBA(354,",DR="60///@" D ^DIE
  1. VNCQ Q