| 1 | IBARXEB ;ALB/AAS - RX COPAY EXEMPTION BULLETIN PROCESSOR ; 15-JAN-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | % N IBP,IBALERT
|
|---|
| 6 | Q:IBEVTP="" ; no prior exemption
|
|---|
| 7 | Q:IBEVTP=IBEVTA
|
|---|
| 8 | S IBCODA=$$ACODE^IBARXEU0(IBEVTA),IBCODP=$$ACODE^IBARXEU0(IBEVTP)
|
|---|
| 9 | Q:$L(IBCODA)=2 ; -went to automatic exemption
|
|---|
| 10 | ;
|
|---|
| 11 | K IBT
|
|---|
| 12 | I IBCODA=2010 D ; -went to hardship
|
|---|
| 13 | .S IBALERT=1
|
|---|
| 14 | .S IBT(9)="Patient has been given a Hardship Exemption."
|
|---|
| 15 | .Q
|
|---|
| 16 | I IBCODP=2010 D ; -went from hardship
|
|---|
| 17 | .S IBALERT=2
|
|---|
| 18 | .S IBT(9)="Patient's Hardship exemption has been removed."
|
|---|
| 19 | .Q
|
|---|
| 20 | I IBCODA=210,$L(IBCODP)=3,$P(IBEVTP,"^",4)=1 D ; -went to no income data from exempt income
|
|---|
| 21 | .S IBALERT=3
|
|---|
| 22 | .S IBT(9)="Patient's exemption based on Income has expired."
|
|---|
| 23 | .Q
|
|---|
| 24 | ;
|
|---|
| 25 | Q:'$D(IBT) ; no alert needed
|
|---|
| 26 | ;
|
|---|
| 27 | S IBP=$$PT^IBEFUNC(DFN)
|
|---|
| 28 | I $$ALERT^IBAUTL7 D SEND^IBAERR3 G BQ
|
|---|
| 29 | D BULL
|
|---|
| 30 | BQ K IBEXERR Q
|
|---|
| 31 | ;
|
|---|
| 32 | ALERT ; -- use kernel alerts
|
|---|
| 33 | ;
|
|---|
| 34 | ALERTQ Q
|
|---|
| 35 | ;
|
|---|
| 36 | BULL ; -- send bulletin
|
|---|
| 37 | ;
|
|---|
| 38 | S XMSUB="Medication Copayment Exemption Status Change"
|
|---|
| 39 | S IBT(1)="The following Patient's Medication Copayment Exemption Status has changed:"
|
|---|
| 40 | S IBT(2)=" Patient: "_$E($P(IBP,"^")_" ",1,25)_" PT. ID: "_$P(IBP,"^",2)
|
|---|
| 41 | S IBT(3)=""
|
|---|
| 42 | S IBT(4)=" Old Status: "_$E($$TEXT^IBARXEU0($P(IBEVTP,"^",4))_" ",1,10)_" - "_$P($G(^IBE(354.2,+$P(IBEVTP,"^",5),0)),"^")_" Dated "_$$DAT1^IBOUTL(+IBEVTP)
|
|---|
| 43 | S IBT(5)=" New Status: "_$E($$TEXT^IBARXEU0($P(IBEVTA,"^",4))_" ",1,10)_" - "_$P($G(^IBE(354.2,+$P(IBEVTA,"^",5),0)),"^")_" Dated "_$$DAT1^IBOUTL(+IBEVTA)
|
|---|
| 44 | S IBT(6)="" I $D(IBARCAN) S IBT(6)="Past charges were canceled in AR."
|
|---|
| 45 | S IBT(7)=""
|
|---|
| 46 | S IBT(8)=""
|
|---|
| 47 | S IBT(10)=" by: "_$P($G(^VA(200,+$P(IBEVTA,"^",7),0)),"^")_"/"_$S($P(IBEVTA,"^",6)=1:"(System)",1:"(Manual)")
|
|---|
| 48 | S Y=$P(IBEVTA,"^",8) D D^DIQ S IBT(11)=" on: "_$P(Y,"@")_" @ "_$P(Y,"@",2)
|
|---|
| 49 | S IBT(12)="Option: " I $D(XQY0) S IBT(12)=IBT(12)_$P($G(XQY0),"^",2)
|
|---|
| 50 | I $D(ZTQUEUED),$P($G(XQY0),"^",2)="" S IBT(12)=IBT(12)_"Queued Job - "_$G(ZTDESC)
|
|---|
| 51 | D SEND
|
|---|
| 52 | BULLQ Q
|
|---|
| 53 | ;
|
|---|
| 54 | SEND S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
|
|---|
| 55 | K XMY S XMN=0
|
|---|
| 56 | ;S XMY(DUZ)="" ;don't send to user, is annoying to pharmacy.
|
|---|
| 57 | S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",13),0)),"^")
|
|---|
| 58 | I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
|
|---|
| 59 | ;S IBGRP=$P(^IBE(350.9,1,0),"^",9)
|
|---|
| 60 | ;F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
|
|---|
| 61 | D ^XMD
|
|---|
| 62 | K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
|
|---|
| 63 | Q
|
|---|
