| 1 | IBAMTED2 ;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 | ;
|
|---|
| 9 | EN 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 | ;
|
|---|
| 21 | ADD ;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 | ;
|
|---|
| 42 | DEL ; 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
|
|---|
