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

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1IBAMTED2 ;ALB/GN - RX COPAY TEST EVENT DRIVER - Z06 EXEMPTION PROCESSING ; 6/5/04 2:32pm
2 ;;2.0;INTEGRATED BILLING;**269**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;IB*2*269 add this new API to handle updating IVM converted RX Copay
6 ; Tests via Z06 transmissions.
7 ;
8 ;
9EN N IBAD,IBADDE,IBADD,IBDT,IBEXREA,IBAUTO,IBAX,IBAX1,IBOLDAUT,IBWHER
10 N IBEXERR,IBJOB,IBON,IBAFY,IBATYP,IBBDT,IBCANDT,IBCHRG,IBCODA,IBCODP
11 N IBCRES,IBDEPEN,IBFAC,IBIL,IBL,IBAST,IBLDT,IBN,IBND,IBNN,IBNOW
12 N IBPARNT,IBPARNT1,IBSEQNO,IBSITE,IBUNIT
13 N DA,DR,DIC,DIE,I,J,X,Y,X1
14 ;
15 ;
16 ;check if add and/or delete of a Z06 was performed by ^EASPREC7
17 I DGMTACT="UPL",+DGMTA,'$G(EASZ06D) D ADD
18 I DGMTACT="DEL",+DGMTP,$G(EASZ06D) D DEL
19 Q
20 ;
21ADD ;quit if before start date
22 Q:+$$PLUS^IBARXEU0(+DGMTA)<$$STDATE^IBARXEU
23 ;
24 ;if no patient add patient
25 I '+$G(^IBA(354,DFN,0)) D ADDP^IBAUTL6 I $G(IBEXERR) D ^IBAERR Q
26 ;
27 ;see if last reason is auto type and save date, used by ADDEX tag
28 N IB0 S IB0=$$LSTAC^IBARXEU0(DFN)
29 I $L(+IB0)=2,$P(IB0,"^",2)>+DGMTA S IBOLDAUT=$P(IB0,"^",2)
30 ;
31 ;set IVM converted case to reason: Income>Threshold (Not Exempt)
32 S IBEXREA=$O(^IBE(354.2,"ACODE",110,0))
33 ;
34 ;inactivate most recent exemption test
35 D MOSTR^IBARXEU5(+DGMTA,+IBEXREA)
36 ;
37 ;add new IVM converted test
38 D ADDEX^IBAUTL6(+IBEXREA,+DGMTA,1,1,$G(IBOLDAUT))
39 ;
40 Q
41 ;
42DEL ; Converted Copay test deleted. Now inactivate that exemption for
43 ; that date & update current exemption status for this date
44 ;
45 ;force inactivate entries for deleted date
46 N IBFORCE
47 Q:'$D(^IBA(354.1,"AIVDT",1,DFN,-DGMTP))
48 S IBFORCE=+DGMTP
49 ;
50 ;test in DGMT(408.31) has been deleted at this point, now get
51 ;the last test that remains on file in order to activate it
52 S IBEXREA=$$STATUS^IBARXEU1(DFN,+DGMTP)
53 S IBSTAT=$P($G(^IBE(354.2,+IBEXREA,0)),"^",4)
54 ;
55 ;if last date is older than 1 year, then cancel prior exemption
56 ;cancel prior exemption with a no exemption
57 I $$PLUS^IBARXEU0($P(IBEXREA,"^",2))<DT D Q
58 . D ADDEX^IBAUTL6(+$O(^IBE(354.2,"ACODE",210,0)),+DGMTP)
59 ;
60 ;else, add correct exemption and update current status
61 D ADDEX^IBAUTL6(+IBEXREA,+$P(IBEXREA,"^",2))
62 Q
Note: See TracBrowser for help on using the repository browser.