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

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1IBARXEB ;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
30BQ K IBEXERR Q
31 ;
32ALERT ; -- use kernel alerts
33 ;
34ALERTQ Q
35 ;
36BULL ; -- 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
52BULLQ Q
53 ;
54SEND 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
Note: See TracBrowser for help on using the repository browser.