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 Dec 13, 2024@02:09 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
