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

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBCNSBL ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ;29-AUG-93
2 ;;2.0;INTEGRATED BILLING;**6,28,103,249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% N IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD
6 ;
7 Q:'$D(IBEVTA0)!('$D(IBEVTA1))!('$D(IBEVTA2))!('$D(IBCDFN))!('$D(IBEVTACT))
8 D:IBEVTACT="ADD" BLTN
9 D:$P($G(IBEVTA1),"^",9)=3 IVM
10 D VNC
11 Q
12 ;
13BLTN ; -- generate bulletin if new policy
14 ;
15 K ^TMP($J,"SDAMA201","GETAPPT")
16 S IBP=$$PT^IBEFUNC(DFN),(OPT,INPT)=0
17 ;
18 ; -- set starting date = latest of 2 years ago, or effective date
19 S START=DT-20000
20 I $P(IBEVTA0,"^",8),$P(IBEVTA0,"^",8)>START S START=$P(IBEVTA0,"^",8)
21 ;
22 S END=DT+.9
23 ;
24 D GETAPPT^SDAMA201(DFN,"1;2","R",START,END,.OPT,"O")
25 S X=$O(^DGPM("APTT1",DFN,START)) I X,(X'>(END+.24)) S INPT=1
26 I $G(^DPT(DFN,.1))'="" D S INPT=1
27 .;
28 .;see if current admission is in claims tracking
29 .S VAINDT=DT+.24 D INP^VADPT
30 .N IBMVAD,IBTRKR,IBRANDOM,DGPMA
31 .S IBMVAD=+VAIN(1),DGPMA=$G(^DGPM(+IBMVAD,0))
32 .I DFN=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2) Q ; quit if already in claims tracking
33 .S IBTRKR=$G(^IBE(350.9,1,6))
34 .I $P(IBTRKR,"^",2)=2 D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1
35 .I $P(IBTRKR,"^",2)=1,$$INSURED^IBCNS1(DFN,+DGPMA) D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1
36 .Q
37 ;
38 S VAINDT=START+.24 D INP^VADPT I $G(VAIN(1)) S INPT=1
39 I 'OPT,'INPT G BQ
40 ;
41 D BULL^IBCNSBL1
42BQ K ^TMP($J,"SDAMA201","GETAPPT")
43 Q
44 ;
45IVM ; -- announce patients who have ivm-identified insurance. input = dfn
46 I $G(^IBA(354,DFN,"IVM")) G IVMQ
47 I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 K IBWHER,IBEXERR,IBADD
48 S DIE="^IBA(354,",DR="50////1",DA=DFN D ^DIE K DIE,DR,DA,DIC
49IVMQ Q
50 ;
51VNC ; -- remove verification of no coverage
52 N DA,DIC,DIE,DR,X,Y
53 I '$G(^IBA(354,DFN,60)) G VNCQ
54 ;
55 ; - delete verification date if the patient has effective policies
56 I $$EPOL^IBCNSM2(DFN) S DA=DFN,DIE="^IBA(354,",DR="60///@" D ^DIE
57VNCQ Q
Note: See TracBrowser for help on using the repository browser.