IBCNSBL ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ;29-AUG-93
;;2.0;INTEGRATED BILLING;**6,28,103,249**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% N IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD
;
Q:'$D(IBEVTA0)!('$D(IBEVTA1))!('$D(IBEVTA2))!('$D(IBCDFN))!('$D(IBEVTACT))
D:IBEVTACT="ADD" BLTN
D:$P($G(IBEVTA1),"^",9)=3 IVM
D VNC
Q
;
BLTN ; -- generate bulletin if new policy
;
K ^TMP($J,"SDAMA201","GETAPPT")
S IBP=$$PT^IBEFUNC(DFN),(OPT,INPT)=0
;
; -- set starting date = latest of 2 years ago, or effective date
S START=DT-20000
I $P(IBEVTA0,"^",8),$P(IBEVTA0,"^",8)>START S START=$P(IBEVTA0,"^",8)
;
S END=DT+.9
;
D GETAPPT^SDAMA201(DFN,"1;2","R",START,END,.OPT,"O")
S X=$O(^DGPM("APTT1",DFN,START)) I X,(X'>(END+.24)) S INPT=1
I $G(^DPT(DFN,.1))'="" D S INPT=1
.;
.;see if current admission is in claims tracking
.S VAINDT=DT+.24 D INP^VADPT
.N IBMVAD,IBTRKR,IBRANDOM,DGPMA
.S IBMVAD=+VAIN(1),DGPMA=$G(^DGPM(+IBMVAD,0))
.I DFN=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2) Q ; quit if already in claims tracking
.S IBTRKR=$G(^IBE(350.9,1,6))
.I $P(IBTRKR,"^",2)=2 D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=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
.Q
;
S VAINDT=START+.24 D INP^VADPT I $G(VAIN(1)) S INPT=1
I 'OPT,'INPT G BQ
;
D BULL^IBCNSBL1
BQ K ^TMP($J,"SDAMA201","GETAPPT")
Q
;
IVM ; -- announce patients who have ivm-identified insurance. input = dfn
I $G(^IBA(354,DFN,"IVM")) G IVMQ
I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 K IBWHER,IBEXERR,IBADD
S DIE="^IBA(354,",DR="50////1",DA=DFN D ^DIE K DIE,DR,DA,DIC
IVMQ Q
;
VNC ; -- remove verification of no coverage
N DA,DIC,DIE,DR,X,Y
I '$G(^IBA(354,DFN,60)) G VNCQ
;
; - delete verification date if the patient has effective policies
I $$EPOL^IBCNSM2(DFN) S DA=DFN,DIE="^IBA(354,",DR="60///@" D ^DIE
VNCQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSBL 2054 printed Apr 09, 2024@21:17:05 Page 2
IBCNSBL ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ;29-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**6,28,103,249**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% NEW IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD
+1 ;
+2 if '$DATA(IBEVTA0)!('$DATA(IBEVTA1))!('$DATA(IBEVTA2))!('$DATA(IBCDFN))!('$DATA(IBEVTACT))
QUIT
+3 if IBEVTACT="ADD"
DO BLTN
+4 if $PIECE($GET(IBEVTA1),"^",9)=3
DO IVM
+5 DO VNC
+6 QUIT
+7 ;
BLTN ; -- generate bulletin if new policy
+1 ;
+2 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+3 SET IBP=$$PT^IBEFUNC(DFN)
SET (OPT,INPT)=0
+4 ;
+5 ; -- set starting date = latest of 2 years ago, or effective date
+6 SET START=DT-20000
+7 IF $PIECE(IBEVTA0,"^",8)
IF $PIECE(IBEVTA0,"^",8)>START
SET START=$PIECE(IBEVTA0,"^",8)
+8 ;
+9 SET END=DT+.9
+10 ;
+11 DO GETAPPT^SDAMA201(DFN,"1;2","R",START,END,.OPT,"O")
+12 SET X=$ORDER(^DGPM("APTT1",DFN,START))
IF X
IF (X'>(END+.24))
SET INPT=1
+13 IF $GET(^DPT(DFN,.1))'=""
Begin DoDot:1
+14 ;
+15 ;see if current admission is in claims tracking
+16 SET VAINDT=DT+.24
DO INP^VADPT
+17 NEW IBMVAD,IBTRKR,IBRANDOM,DGPMA
+18 SET IBMVAD=+VAIN(1)
SET DGPMA=$GET(^DGPM(+IBMVAD,0))
+19 ; quit if already in claims tracking
IF DFN=$PIECE($GET(^IBT(356,+$ORDER(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2)
QUIT
+20 SET IBTRKR=$GET(^IBE(350.9,1,6))
+21 IF $PIECE(IBTRKR,"^",2)=2
DO ADM^IBTUTL(IBMVAD,$EXTRACT(+DGPMA,1,12),0,$PIECE(DGPMA,"^",27))
SET IBTADD=1
+22 IF $PIECE(IBTRKR,"^",2)=1
IF $$INSURED^IBCNS1(DFN,+DGPMA)
DO ADM^IBTUTL(IBMVAD,$EXTRACT(+DGPMA,1,12),0,$PIECE(DGPMA,"^",27))
SET IBTADD=1
+23 QUIT
End DoDot:1
SET INPT=1
+24 ;
+25 SET VAINDT=START+.24
DO INP^VADPT
IF $GET(VAIN(1))
SET INPT=1
+26 IF 'OPT
IF 'INPT
GOTO BQ
+27 ;
+28 DO BULL^IBCNSBL1
BQ KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+1 QUIT
+2 ;
IVM ; -- announce patients who have ivm-identified insurance. input = dfn
+1 IF $GET(^IBA(354,DFN,"IVM"))
GOTO IVMQ
+2 IF '$DATA(^IBA(354,DFN))
DO ADDP^IBAUTL6
KILL IBWHER,IBEXERR,IBADD
+3 SET DIE="^IBA(354,"
SET DR="50////1"
SET DA=DFN
DO ^DIE
KILL DIE,DR,DA,DIC
IVMQ QUIT
+1 ;
VNC ; -- remove verification of no coverage
+1 NEW DA,DIC,DIE,DR,X,Y
+2 IF '$GET(^IBA(354,DFN,60))
GOTO VNCQ
+3 ;
+4 ; - delete verification date if the patient has effective policies
+5 IF $$EPOL^IBCNSM2(DFN)
SET DA=DFN
SET DIE="^IBA(354,"
SET DR="60///@"
DO ^DIE
VNCQ QUIT
