- IBCBULL ;ALB/MJB - MCCR MAILMAN BULLETINS ;14 JUN 88 15:33
- ;;2.0;INTEGRATED BILLING;**124,155**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRBULL
- ; both bulletins are sent to: billing supervisor, person cancelling/disapproving, and respective mail group, if defined
- ; disapproval bulletin is also sent to person who entered the bill
- ;
- BULL S IBFTN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,19),IBFTN=$$FTN^IBCU3(IBFTN)
- K XMY S XMSUB=$S($D(IBCAN):"MAS "_IBFTN_" BILL CANCELLATION BULLETIN",1:"MAS "_IBFTN_" BILL DISAPPROVAL BULLETIN"),XMDUZ=DUZ
- S IBEPAR(1)=$G(^IBE(350.9,1,1)),IB(0)=$S($D(^DGCR(399,IBIFN,0)):^(0),1:"")
- S IB("S")=$G(^DGCR(399,IBIFN,"S"))
- 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
- 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)=""
- S IBTEXT(5,0)="Patient Name: "_IBNAME_" PT ID: "_VA("PID"),IBTEXT(6,0)="",IBTEXT(7,0)="Event Date: "_IBDT
- S:$D(IBCAN) IBTEXT(8,0)="",IBTEXT(9,0)="Reason for cancellation: "_$P(^DGCR(399,IBIFN,"S"),"^",19)
- 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))
- 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
- 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)
- I '$D(IBCAN),$D(J)#2,J'<14 S IBTEXT(J,0)="",IBTEXT((J+1),0)="Other reasons too numerous to mention..."
- ;
- S XMTEXT="IBTEXT(",XMY(DUZ)="",XMY($P(IBEPAR(1),"^",8))="" S:'$D(IBCAN) XMY($P(^DGCR(399,IBIFN,"S"),"^",2))=""
- ;
- ;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)=""
- I $D(IBCAN) S IBGRP=$P($G(^XMB(3.8,+$P($G(IBEPAR(1)),"^",7),0)),"^") I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
- ;
- ;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)=""
- I '$D(IBCAN) S IBGRP=$P($G(^XMB(3.8,+$P($G(IBEPAR(1)),"^",9),0)),"^") I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
- ;
- D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,IB,IBTEXT,IBNAME,IBGRP,IBBNO,IBD,IBDT,IBM,IBFTN,VA("BID"),VA("PID"),I,Y,DIC Q
- Q
- DISAP Q:$P(^DGCR(399,IBIFN,"S"),"^",6)!('$D(IBX3)) S X3=IBX3
- 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:"")
- 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:"")
- D BULL K IBD,IBX3,X3,I Q
- Q
- SET S X1=$S($D(^DGCR(399,+IBIFN,"S")):^("S"),1:""),IB("U1")=$S($D(^DGCR(399,IBIFN,"U1")):^("U1"),1:"") Q:X1']""
- ;IBCBULL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBULL 3099 printed Feb 18, 2025@23:35:25 Page 2
- IBCBULL ;ALB/MJB - MCCR MAILMAN BULLETINS ;14 JUN 88 15:33
- +1 ;;2.0;INTEGRATED BILLING;**124,155**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRBULL
- +5 ; both bulletins are sent to: billing supervisor, person cancelling/disapproving, and respective mail group, if defined
- +6 ; disapproval bulletin is also sent to person who entered the bill
- +7 ;
- BULL SET IBFTN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,19)
- SET IBFTN=$$FTN^IBCU3(IBFTN)
- +1 KILL XMY
- SET XMSUB=$SELECT($DATA(IBCAN):"MAS "_IBFTN_" BILL CANCELLATION BULLETIN",1:"MAS "_IBFTN_" BILL DISAPPROVAL BULLETIN")
- SET XMDUZ=DUZ
- +2 SET IBEPAR(1)=$GET(^IBE(350.9,1,1))
- SET IB(0)=$SELECT($DATA(^DGCR(399,IBIFN,0)):^(0),1:"")
- +3 SET IB("S")=$GET(^DGCR(399,IBIFN,"S"))
- +4 SET DFN=$PIECE(IB(0),U,2)
- DO PID^VADPT6
- SET IBBNO=$PIECE(IB(0),U,1)
- SET IBNAME=$PIECE(^DPT(DFN,0),U)
- SET Y=$PIECE(IB(0),U,3)
- XECUTE ^DD("DD")
- SET IBDT=Y
- +5 SET IBTEXT(1,0)="The following "_IBFTN_" bill has been "_$SELECT($DATA(IBCAN):"cancelled: ",1:"disapproved: ")
- SET IBTEXT(2,0)=""
- SET IBTEXT(3,0)="Bill Number: "_IBBNO
- SET IBTEXT(4,0)=""
- +6 SET IBTEXT(5,0)="Patient Name: "_IBNAME_" PT ID: "_VA("PID")
- SET IBTEXT(6,0)=""
- SET IBTEXT(7,0)="Event Date: "_IBDT
- +7 if $DATA(IBCAN)
- SET IBTEXT(8,0)=""
- SET IBTEXT(9,0)="Reason for cancellation: "_$PIECE(^DGCR(399,IBIFN,"S"),"^",19)
- +8 if $DATA(IBCAN)
- SET IBTEXT(10,0)=""
- SET IBTEXT(11,0)="Status when cancelled: "_$SELECT('$DATA(IBSTAT):"",1:$PIECE($PIECE($PIECE(^DD(399,.13,0),"^",3),IBSTAT_":",2),";",1))
- +9 if $DATA(IBTEXT(11,0))
- SET Y=$PIECE(IB("S"),"^",10)
- SET IBTEXT(11,0)=IBTEXT(11,0)_" - "_$SELECT('Y:"Not passed to AR",1:"Passed to AR on ")
- IF Y
- DO D^DIQ
- SET IBTEXT(11,0)=IBTEXT(11,0)_Y
- +10 if '$DATA(IBCAN)
- SET IBTEXT(8,0)=""
- FOR I=1:1
- if '$DATA(IBD(I))
- QUIT
- SET J=8+I
- if J'<14
- QUIT
- SET IBTEXT(J,0)="Reason for disapproval: "_IBD(I)
- +11 IF '$DATA(IBCAN)
- IF $DATA(J)#2
- IF J'<14
- SET IBTEXT(J,0)=""
- SET IBTEXT((J+1),0)="Other reasons too numerous to mention..."
- +12 ;
- +13 SET XMTEXT="IBTEXT("
- SET XMY(DUZ)=""
- SET XMY($PIECE(IBEPAR(1),"^",8))=""
- if '$DATA(IBCAN)
- SET XMY($PIECE(^DGCR(399,IBIFN,"S"),"^",2))=""
- +14 ;
- +15 ;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)=""
- +16 IF $DATA(IBCAN)
- SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(IBEPAR(1)),"^",7),0)),"^")
- IF IBGRP]""
- SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
- +17 ;
- +18 ;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)=""
- +19 IF '$DATA(IBCAN)
- SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(IBEPAR(1)),"^",9),0)),"^")
- IF IBGRP]""
- SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
- +20 ;
- +21 DO ^XMD
- KILL XMSUB,XMY,XMDUZ,XMTEXT,IB,IBTEXT,IBNAME,IBGRP,IBBNO,IBD,IBDT,IBM,IBFTN,VA("BID"),VA("PID"),I,Y,DIC
- QUIT
- +22 QUIT
- DISAP if $PIECE(^DGCR(399,IBIFN,"S"),"^",6)!('$DATA(IBX3))
- QUIT
- SET X3=IBX3
- +1 IF X3=3
- SET IBD=0
- FOR I=1:1
- SET IBD=$ORDER(^DGCR(399,IBIFN,"D1",IBD))
- if IBD'?1N.N
- QUIT
- SET IBD(I)=^DGCR(399,IBIFN,"D1",IBD,0)
- SET IBD(I)=$SELECT($DATA(^DGCR(399.4,IBD(I),0)):$PIECE(^(0),"^",1),1:"")
- +2 IF X3=6
- SET IBD=0
- FOR I=1:1
- SET IBD=$ORDER(^DGCR(399,IBIFN,"D2",IBD))
- if IBD'?1N.N
- QUIT
- SET IBD(I)=^DGCR(399,IBIFN,"D2",IBD,0)
- SET IBD(I)=$SELECT($DATA(^DGCR(399.4,IBD(I),0)):$PIECE(^(0),"^",1),1:"")
- +3 DO BULL
- KILL IBD,IBX3,X3,I
- QUIT
- +4 QUIT
- SET SET X1=$SELECT($DATA(^DGCR(399,+IBIFN,"S")):^("S"),1:"")
- SET IB("U1")=$SELECT($DATA(^DGCR(399,IBIFN,"U1")):^("U1"),1:"")
- if X1']""
- QUIT
- +1 ;IBCBULL
