| [613] | 1 | IBARXEU4 ;ALB/AAS - RX COPAY EXEMPTION CHECK IF PREVIOUSLY CANCELED ; 12-JAN-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**34**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | CANDT ; -- set beginning and ending dates
|
|---|
| 6 | ; input dfn =: patient internal number
|
|---|
| 7 | ; ibedt =: end date to cancel
|
|---|
| 8 | ; ibdt =: beging date to cancel
|
|---|
| 9 | ;
|
|---|
| 10 | ; output ibcandt =: begin date^end date to cancel
|
|---|
| 11 | ;
|
|---|
| 12 | N X
|
|---|
| 13 | ;S IBCANDT=IBDT_"^"_IBEDT
|
|---|
| 14 | ;
|
|---|
| 15 | ; -- get last end date
|
|---|
| 16 | S X=+$O(^IBA(354.1,"ACAN",DFN,"")) S:X<0 X=-X D:'X CONV ;never previously cancelled
|
|---|
| 17 | I X,X>IBDT S IBDT=X
|
|---|
| 18 | ;
|
|---|
| 19 | ; -- only cancel back 1 year from today, or eff. legislation max
|
|---|
| 20 | I IBDT<$$MINUS^IBARXEU0(DT) S IBDT=$$MINUS^IBARXEU0(DT)
|
|---|
| 21 | I IBDT<$$STDATE^IBARXEU S IBDT=$$STDATE^IBARXEU
|
|---|
| 22 | S IBCANDT=IBDT_"^"_IBEDT
|
|---|
| 23 | CANDTQ Q
|
|---|
| 24 | ;
|
|---|
| 25 | CONV ; -- see if conversion done
|
|---|
| 26 | N X
|
|---|
| 27 | S X=$G(^IBE(350.9,1,3)) G:$P(X,"^",14) CONVQ ; conversion complete
|
|---|
| 28 | I $P(X,"^",3),DFN<$P(X,"^",4) G CONVQ ; patient already converted
|
|---|
| 29 | ;
|
|---|
| 30 | ; -- need to convert patient on the fly
|
|---|
| 31 | S IBDT=$$STDATE^IBARXEU
|
|---|
| 32 | CONVQ Q
|
|---|
| 33 | ;
|
|---|
| 34 | ARCAN(DFN,IBSTAT,IBDT,IBEDT) ; -- process cancellation with ar logic here
|
|---|
| 35 | ;
|
|---|
| 36 | ; Input =: dfn patient internal entry number
|
|---|
| 37 | ; ibstat patient status from $$rxexmt or $$rxst
|
|---|
| 38 | ; ibdt beginning date to cancel
|
|---|
| 39 | ; ibedt ending date to cancel
|
|---|
| 40 | ;
|
|---|
| 41 | Q:'+IBSTAT ; non-exempt patient
|
|---|
| 42 | ;
|
|---|
| 43 | S:IBEDT>DT IBEDT=DT S:IBDT<$$STDATE^IBARXEU IBDT=$$STDATE^IBARXEU
|
|---|
| 44 | ;
|
|---|
| 45 | ; -- set begin and ending date, check x-ref
|
|---|
| 46 | S X=+$O(^IBA(354.1,"ACAN",DFN,"")) S:X<0 X=-X
|
|---|
| 47 | I X,X>IBDT S IBDT=X
|
|---|
| 48 | ;
|
|---|
| 49 | ; -- end date must be after begin date
|
|---|
| 50 | I IBDT>IBEDT G ARCANQ
|
|---|
| 51 | ;
|
|---|
| 52 | ; -- set begin and ending dates in last entry created
|
|---|
| 53 | D UPCAN
|
|---|
| 54 | ;
|
|---|
| 55 | N IBWHER
|
|---|
| 56 | S ERR=0,IBWHER=17
|
|---|
| 57 | D EN1^PRCAX(DFN,IBDT,IBEDT,.ERR)
|
|---|
| 58 | I ERR]"",+ERR'=ERR S ^TMP("IB-ERROR",$J,DFN)=ERR,IBEXERR=10 S:'$D(IBJOB) IBJOB=11 D ^IBAERR K IBEXERR
|
|---|
| 59 | ARCANQ Q
|
|---|
| 60 | ;
|
|---|
| 61 | UPCAN ; -- update canceled date fields
|
|---|
| 62 | N X2
|
|---|
| 63 | S DIE="^IBA(354.1,",DR=".13////"_IBDT_";.14////"_IBEDT
|
|---|
| 64 | S DA=+$O(^(+$O(^IBA(354.1,"AIVDT",1,DFN,"")),0))
|
|---|
| 65 | S X2=$G(^IBA(354.1,DA,0))
|
|---|
| 66 | I $P(X2,"^",2)'=DFN!($P(X2,"^",14)) G UPCANQ
|
|---|
| 67 | D ^DIE
|
|---|
| 68 | K DIC,DIE,DA,DR,X
|
|---|
| 69 | UPCANQ Q
|
|---|
