- 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 Feb 18, 2025@23:43:13 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
