| [613] | 1 | IBARXEU ;AAS/ALB - RX EXEMPTION UTILITY ROUTINE ;2-NOV-92
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**20,222,293**;21-MAR-94;Build 1
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | RXST(DFN,IBDT) ; -- Check rx income exemption status of patient
|
|---|
| 7 | ;
|
|---|
| 8 | ; input = : dfn = patient file pointer
|
|---|
| 9 | ; ibdt = date to check for (optional) default is today
|
|---|
| 10 | ;
|
|---|
| 11 | ; returns : -1 if no data ^text^reason code^reason text^date of test
|
|---|
| 12 | ; 0 if non exempt
|
|---|
| 13 | ; 1 if exempt
|
|---|
| 14 | ;
|
|---|
| 15 | N X,Y,Z,IBX,IBON
|
|---|
| 16 | ;
|
|---|
| 17 | S IBON=$$ON^IBARXEU0 I IBON<1 Q IBON
|
|---|
| 18 | ;
|
|---|
| 19 | S IBX=""
|
|---|
| 20 | I '$G(IBDT) S IBDT=DT
|
|---|
| 21 | I IBDT>DT S IBDT=DT ; no future dates
|
|---|
| 22 | ;
|
|---|
| 23 | ; -- date before legislations
|
|---|
| 24 | I IBDT<$$STDATE S IBX="0^NON-EXEMPT^^Date is Prior to Legislation^" G RXSTQ ; nobody exempt prior to legislation
|
|---|
| 25 | ;
|
|---|
| 26 | ; -- if no data on patient quit
|
|---|
| 27 | S X=$G(^IBA(354,DFN,0))
|
|---|
| 28 | I X=""!('$D(^IBA(354.1,"AP",DFN))) S IBX="-1^UNKNOWN^^Medication Copayment Exemption status never determined" G RXSTQ ; no data return -1
|
|---|
| 29 | ;
|
|---|
| 30 | ; -- use current status if ibdt not less than current test and
|
|---|
| 31 | ; not greater than current test date +365
|
|---|
| 32 | I IBDT'<$P(X,U,3),IBDT'>$$PLUS^IBARXEU0($P(X,U,3)) S IBX=$$IBX^IBARXEU0(DFN,IBDT) G RXSTQ
|
|---|
| 33 | ;
|
|---|
| 34 | ; -- if ibdt not less than current date but greater than
|
|---|
| 35 | ; current test +365 is into future
|
|---|
| 36 | I IBDT'<$P(X,U,3),IBDT>$$PLUS^IBARXEU0($P(X,U,3)) D
|
|---|
| 37 | .S Y=$$LST^IBARXEU0(DFN,IBDT)
|
|---|
| 38 | .;
|
|---|
| 39 | .; -- see if patient was SC>50, can't be updated so don't say previous
|
|---|
| 40 | .I $L($$ACODE^IBARXEU0(Y))<3 S IBX=+$P(X,U,4)_U_$$TEXT^IBARXEU0($P(X,U,4))_U_$$ACODE^IBARXEU0(Y)_U_$$REASON^IBARXEU0(X)_U_$P(X,U,3) Q
|
|---|
| 41 | .;
|
|---|
| 42 | .S IBX=+$P(X,U,4)_U_"Previously "_$$TEXT^IBARXEU0($P(X,U,4))_U_$$ACODE^IBARXEU0(Y)_U_"Requires new exemption. Previously "_$$REASON^IBARXEU0(X)_U_$P(X,U,3)
|
|---|
| 43 | ;
|
|---|
| 44 | ; -- if ibdt less than current date need old exemption data
|
|---|
| 45 | I IBDT<$P(X,U,3) D G RXSTQ
|
|---|
| 46 | .;
|
|---|
| 47 | .; -- find status of prior test
|
|---|
| 48 | .S Y=$$LST^IBARXEU0(DFN,IBDT)
|
|---|
| 49 | .;
|
|---|
| 50 | .; -- no previous data
|
|---|
| 51 | .I Y="" D Q
|
|---|
| 52 | ..S IBX="-1^UNKNOWN^^No data for date requested."
|
|---|
| 53 | ..Q
|
|---|
| 54 | .;
|
|---|
| 55 | .S Z=$G(^IBA(354,DFN,0)),Z=$P(Z,U,5)_U_$P(Z,U,3) ; get status & date
|
|---|
| 56 | .;
|
|---|
| 57 | .; -- if old exemption is current for copay date
|
|---|
| 58 | .I IBDT'>$$PLUS^IBARXEU0(+Y) D Q
|
|---|
| 59 | ..S X=$G(^IBE(354.2,+$P(Y,U,5),0)) ; exemption reason node
|
|---|
| 60 | ..S IBX=+$P(X,U,4)_U_$$TEXT^IBARXEU0($P(X,U,4))_U_$$ACODE^IBARXEU0(Y)_U_$$REASON^IBARXEU0(X)_U_$P(X,U,3)
|
|---|
| 61 | ..Q
|
|---|
| 62 | .;
|
|---|
| 63 | .; -- if ibdt is greater than old exemption + 365
|
|---|
| 64 | .; report previous
|
|---|
| 65 | .I IBDT>$$PLUS^IBARXEU0(+Y) D Q
|
|---|
| 66 | ..S X=$G(^IBE(354.2,+$P(Y,U,5),0)) ;exemption reason node
|
|---|
| 67 | ..;
|
|---|
| 68 | ..; -- see if patient was SC>50, can't be updated so don't say previous
|
|---|
| 69 | ..I $L($$ACODE^IBARXEU0(Y))<3 S IBX=+$P(X,U,4)_U_$$TEXT^IBARXEU0($P(X,U,4))_U_$$ACODE^IBARXEU0(Y)_U_$$REASON^IBARXEU0(X)_U_$P(X,U,3) Q
|
|---|
| 70 | ..;
|
|---|
| 71 | ..S IBX=+$P(X,U,4)_U_"Previously "_$$TEXT^IBARXEU0($P(X,U,4))_U_$$ACODE^IBARXEU0(Y)_U_"Requires new exemption. Previously "_$$REASON^IBARXEU0(X)_U_$P(X,U,3)
|
|---|
| 72 | ..Q
|
|---|
| 73 | .Q
|
|---|
| 74 | ;
|
|---|
| 75 | RXSTQ Q IBX
|
|---|
| 76 | ;
|
|---|
| 77 | DISP(DFN,IBDT,NO,NULL) ; -- formats text to display
|
|---|
| 78 | ; -- input = dfn
|
|---|
| 79 | ; ibdt = date to check for
|
|---|
| 80 | ; no = number of lines to print (1, 2, or 3)
|
|---|
| 81 | ; null = if zero print unknown, if non-zero quit
|
|---|
| 82 | ;
|
|---|
| 83 | I '$G(IBDT) S IBDT=DT
|
|---|
| 84 | I '$D(NULL) S NULL=1
|
|---|
| 85 | I IBDT>DT S IBDT=DT ; no future dates
|
|---|
| 86 | I '$G(NO) S NO=3
|
|---|
| 87 | S X=$$RXST(DFN,IBDT)
|
|---|
| 88 | S IBON=$$ON^IBARXEU0 I IBON<1 S X=IBON
|
|---|
| 89 | I X<0&(NULL) G DISPQ
|
|---|
| 90 | W !,"Medication Copayment Exemption Status: ",$P(X,U,2) G:NO<2 DISPQ
|
|---|
| 91 | W !,$P(X,U,4) G:NO<3 DISPQ
|
|---|
| 92 | I $P(X,U,5) W !,"Last Rx Copay Exemption date: " S Y=$P(X,U,5) D DT^DIQ
|
|---|
| 93 | DISPQ Q
|
|---|
| 94 | ;
|
|---|
| 95 | STDATE() ; -- legislative start date for income exemption
|
|---|
| 96 | Q 2921030
|
|---|
| 97 | ;
|
|---|
| 98 | ;
|
|---|
| 99 | ACTIVE(IBZ) ; -- SCREEN for active field of billing exemptions file
|
|---|
| 100 | ; only one entry per effective date can be active
|
|---|
| 101 | ;
|
|---|
| 102 | N IBX,IBY,T
|
|---|
| 103 | S T=0
|
|---|
| 104 | S IBZ=$S(IBZ=1:IBZ,$E(IBZ)="A":1,1:0)
|
|---|
| 105 | I 'IBZ S T=1 G ACTIVEQ
|
|---|
| 106 | S IBX=$G(^IBA(354.1,DA,0))
|
|---|
| 107 | S IBY=$O(^IBA(354.1,"AIVDT",+$P(IBX,U,3),+$P(IBX,U,2),-$P(IBX,U),0))
|
|---|
| 108 | I 'IBY!(IBY=DA) S T=1
|
|---|
| 109 | W:$D(IBTALK) !!,"Another entry is already Active, You must inactivate it first",!!
|
|---|
| 110 | ACTIVEQ Q T
|
|---|
