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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBCBULL ;ALB/MJB - MCCR MAILMAN BULLETINS ;14 JUN 88 15:33
2 ;;2.0;INTEGRATED BILLING;**124,155**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRBULL
6 ; both bulletins are sent to: billing supervisor, person cancelling/disapproving, and respective mail group, if defined
7 ; disapproval bulletin is also sent to person who entered the bill
8 ;
9BULL S IBFTN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,19),IBFTN=$$FTN^IBCU3(IBFTN)
10 K XMY S XMSUB=$S($D(IBCAN):"MAS "_IBFTN_" BILL CANCELLATION BULLETIN",1:"MAS "_IBFTN_" BILL DISAPPROVAL BULLETIN"),XMDUZ=DUZ
11 S IBEPAR(1)=$G(^IBE(350.9,1,1)),IB(0)=$S($D(^DGCR(399,IBIFN,0)):^(0),1:"")
12 S IB("S")=$G(^DGCR(399,IBIFN,"S"))
13 S DFN=$P(IB(0),U,2) D PID^VADPT6 S IBBNO=$P(IB(0),U,1),IBNAME=$P(^DPT(DFN,0),U),Y=$P(IB(0),U,3) X ^DD("DD") S IBDT=Y
14 S IBTEXT(1,0)="The following "_IBFTN_" bill has been "_$S($D(IBCAN):"cancelled: ",1:"disapproved: "),IBTEXT(2,0)="",IBTEXT(3,0)="Bill Number: "_IBBNO,IBTEXT(4,0)=""
15 S IBTEXT(5,0)="Patient Name: "_IBNAME_" PT ID: "_VA("PID"),IBTEXT(6,0)="",IBTEXT(7,0)="Event Date: "_IBDT
16 S:$D(IBCAN) IBTEXT(8,0)="",IBTEXT(9,0)="Reason for cancellation: "_$P(^DGCR(399,IBIFN,"S"),"^",19)
17 S:$D(IBCAN) IBTEXT(10,0)="",IBTEXT(11,0)="Status when cancelled: "_$S('$D(IBSTAT):"",1:$P($P($P(^DD(399,.13,0),"^",3),IBSTAT_":",2),";",1))
18 S:$D(IBTEXT(11,0)) Y=$P(IB("S"),"^",10),IBTEXT(11,0)=IBTEXT(11,0)_" - "_$S('Y:"Not passed to AR",1:"Passed to AR on ") I Y D D^DIQ S IBTEXT(11,0)=IBTEXT(11,0)_Y
19 S:'$D(IBCAN) IBTEXT(8,0)="" F I=1:1 Q:'$D(IBD(I)) S J=8+I Q:J'<14 S IBTEXT(J,0)="Reason for disapproval: "_IBD(I)
20 I '$D(IBCAN),$D(J)#2,J'<14 S IBTEXT(J,0)="",IBTEXT((J+1),0)="Other reasons too numerous to mention..."
21 ;
22 S XMTEXT="IBTEXT(",XMY(DUZ)="",XMY($P(IBEPAR(1),"^",8))="" S:'$D(IBCAN) XMY($P(^DGCR(399,IBIFN,"S"),"^",2))=""
23 ;
24 ;I $D(IBCAN),IBEPAR(1)]"",$P(IBEPAR(1),U,7)]"" S IBM="" F I=1:1 S IBM=$O(^XMB(3.8,$P(IBEPAR(1),U,7),1,"B",IBM)) Q:IBM="" S:'$D(XMY(IBM)) XMY(IBM)=""
25 I $D(IBCAN) S IBGRP=$P($G(^XMB(3.8,+$P($G(IBEPAR(1)),"^",7),0)),"^") I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
26 ;
27 ;I '$D(IBCAN),IBEPAR(1)]"",$P(IBEPAR(1),U,9)]"" S IBM="" F I=1:1 S IBM=$O(^XMB(3.8,$P(IBEPAR(1),U,9),1,"B",IBM)) Q:IBM="" S:'$D(XMY(IBM)) XMY(IBM)=""
28 I '$D(IBCAN) S IBGRP=$P($G(^XMB(3.8,+$P($G(IBEPAR(1)),"^",9),0)),"^") I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
29 ;
30 D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,IB,IBTEXT,IBNAME,IBGRP,IBBNO,IBD,IBDT,IBM,IBFTN,VA("BID"),VA("PID"),I,Y,DIC Q
31 Q
32DISAP Q:$P(^DGCR(399,IBIFN,"S"),"^",6)!('$D(IBX3)) S X3=IBX3
33 I X3=3 S IBD=0 F I=1:1 S IBD=$O(^DGCR(399,IBIFN,"D1",IBD)) Q:IBD'?1N.N S IBD(I)=^DGCR(399,IBIFN,"D1",IBD,0),IBD(I)=$S($D(^DGCR(399.4,IBD(I),0)):$P(^(0),"^",1),1:"")
34 I X3=6 S IBD=0 F I=1:1 S IBD=$O(^DGCR(399,IBIFN,"D2",IBD)) Q:IBD'?1N.N S IBD(I)=^DGCR(399,IBIFN,"D2",IBD,0),IBD(I)=$S($D(^DGCR(399.4,IBD(I),0)):$P(^(0),"^",1),1:"")
35 D BULL K IBD,IBX3,X3,I Q
36 Q
37SET S X1=$S($D(^DGCR(399,+IBIFN,"S")):^("S"),1:""),IB("U1")=$S($D(^DGCR(399,IBIFN,"U1")):^("U1"),1:"") Q:X1']""
38 ;IBCBULL
Note: See TracBrowser for help on using the repository browser.