IBAERR ;ALB/AAS - INTEGRATED BILLING ERROR PROCESSING ROUTINE ; 14-FEB-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
% ; -error processor
;
; Quit if the Means Test Nightly Compilation or Discharge job called
; routine IBR directly.
Q:$G(IBJOB)=1!($G(IBJOB)=2)
;
; If Means Test charge, divert control to routine IBAERR1.
I $D(IBNOS),$P($G(^IB(+IBNOS,0)),"^",16) S IBY=Y G ^IBAERR1
;
; -- If copay exemption divert control to routine IBAERR2
I $D(IBEXERR) G ^IBAERR2
;
I $D(ZTQUEUED) D BULL G END
G:+Y>0 END
S X2=$P(Y,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" S X1=$O(^IBE(350.8,"AC",X,0)) I $D(^IBE(350.8,+X1,0)) S X3="E"_$P(^(0),"^",5) D @X3
I $P(Y,"^",3)]"" W !,$P(Y,"^",3)
END K VA,VADM,VAERR
Q
;
E1 W !,$P(^IBE(350.8,+X1,0),"^",2)
Q
;
E2 ;
Q
E3 ; -- Send no service bulletin
K XMY,IBTXT
S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
S IBTXT(1)="Processing of Pharmacy co-pay entries in Integrated Billing has"
S IBTXT(2)="Stopped.",IBTXT(3)=" "
S IBTXT(4)="The Pharmacy Service Pointer does not match any entries in the "
S IBTXT(5)="IB ACTION TYPE file."
S IBTXT(6)=" "
S IBTXT(7)="Immediate action required."
S IBTXT(8)="Check the IB SERVICE/SECTION in the PHARMACY SITE file."
S IBTXT(9)="It must match the SERVICE field for pharmacy action types in the "
S IBTXT(10)="IB ACTION TYPE file. (internal entry number 1 is checked)"
D SEND
Q
;
BULL ; -send error bulletin to group when error occurs in background
;
K XMY,IBTXT
S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
S IBTXT(1)="Processing of entries in Integrated Billing has"
S IBTXT(2)="been suspended "_$S('$D(IBTAG):"while passing to AR the following",IBTAG=2:"while processing new/renew Rxs: ",IBTAG=3:"while canceling: ",1:"while updating:"),IBTXT(3)=" ",IBC=3
I $D(IBSAVX)!($D(IBSAVXU)),'$D(IBNOS) D SAVX
I $D(IBNOS) F IBI=1:1 S IBNOS1=$P(IBNOS,"^",IBI) Q:'IBNOS1 I $D(^IB(IBNOS1,0)) S IBNOD=^(0) D BD
S IBC=IBC+1,IBTXT(IBC)=""
S IBC=IBC+1,IBTXT(IBC)="You should determine if these co-payments have been passed to"
S IBC=IBC+1,IBTXT(IBC)="Accounts Receivable."
S IBC=IBC+1,IBTXT(IBC)="The following error(s) was encountered:",IBC=IBC+1,IBTXT(IBC)=""
D ERRTXT
S IBC=IBC+1,IBTXT(IBC)=""
I $D(IBWHER) S IBC=IBC+1,IBTXT(IBC)=$P($T(IBWHER+IBWHER),";;",2,99)
;
SEND S XMTEXT="IBTXT(",XMY(DUZ)=""
;
S IBGRP=$S($D(^IBE(350.9,1,0)):$P(^(0),"^",9),1:"") F IBI=0:0 S IBI=$O(^XMB(3.8,+IBGRP,1,"B",IBI)) Q:'IBI S XMY(IBI)=""
D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,IBTXT,IBC,IBNOD,IBNOS1,IBI
Q
;
ERRTXT S X2=$P(Y,"^",2) F K=1:1 S X=$P(X2,";",K) Q:X="" S X1=$O(^IBE(350.8,"AC",X,0)),IBC=IBC+1,IBTXT(IBC)=" "_$S($D(^IBE(350.8,+X1,0)):$P(^(0),"^",2),1:"Unknown Error")
I $P(Y,"^",3)]"" S IBC=IBC+1,IBTXT(IBC)=" "_$P(Y,"^",3)
Q
;
BD I IBI=1 S DFN=$P(IBNOD,"^",2),IBATYPN=$S($D(^IBE(350.1,$P(IBNOD,"^",3),0)):$P(^(0),"^"),1:"") D DEM
S IBC=IBC+1,IBTXT(IBC)=" "_$E($P(IBNOD,"^")_" ",1,14)_$E($P(IBNOD,"^",8)_" ",1,24)_$E($P(IBNOD,"^",11)_" ",1,12)_" $"_$P(IBNOD,"^",7)
Q
DEM N X,Y D DEM^VADPT
S IBC=IBC+1,IBTXT(IBC)=" Patient: "_VADM(1)_" Pt. Id: "_VA("PID")_" Type: "_IBATYPN
Q
;
SAVX S IBAX=$S($D(IBSAVXU):IBSAVXU,$D(IBSAVX):IBSAVX,1:"") Q:IBAX=""
S IBATYPN=$S('$P(IBAX,"^",3):"",$D(^IBE(350.1,$P(IBAX,"^",3),0)):$P(^(0),"^",1),1:""),DFN=$P(IBAX,"^",2) D DEM
S IBC=IBC+1,IBTXT(IBC)=" Service: "_$S($D(^DIC(49,+IBAX,0)):$P(^(0),"^"),1:"")
S IBC=IBC+1,IBTXT(IBC)=" User: "_$S($D(^VA(200,+$P(IBAX,"^",4),0)):$P(^(0),"^"),$D(^VA(200,+DUZ,0)):$P(^(0),"^"),1:"")
S IB="" F S IB=$O(IBSAVX(IB)) Q:IB="" D
.K IBARXN I +$P(IBSAVX(IB),"^",1)=52 S IBARXN="Rx# "_$P($G(^PSRX(+$P($P(IBSAVX(IB),"^"),":",2),0)),"^") I $P($P(IBSAVX(IB),"^"),";",2)'="" S IBARXN=IBARXN_"/Refill# "_$P($P($P(IBSAVX(IB),"^"),";",2),":",2)
.S IBC=IBC+1,IBTXT(IBC)=" Entry: "_$S($D(IBARXN):IBARXN,1:$P(IBSAVX(IB),"^",1)) K IBARXN
S IB="" F S IB=$O(IBSAVXU(IB)) Q:IB="" S IBC=IBC+1,IBTXT(IBC)=" Ref No: "_$S($D(^IB(+IB,0)):$P(^(0),"^"),1:"")
Q
;
1 S Y="-1^IB001" Q ;patient eligibility data not calculated
Q
IBWHER ;
;;Error occurred before Integrated Billing entry created, Reprint labels or recancel after correcting error.
;;Error occurred after Integrated Billing entry created but Accounts Receivable not updated.
;;Error occurred during posting to Accounts Receivable. Check to see if amount passed!
;;Error occurred after successful passing of charges to AR, IB entry may not be properly updated.
;;Error occurred during eligibility determination for Co-pay.
IBAERR ;ALB/AAS - INTEGRATED BILLING ERROR PROCESSING ROUTINE ; 14-FEB-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
% ; -error processor
+1 ;
+2 ; Quit if the Means Test Nightly Compilation or Discharge job called
+3 ; routine IBR directly.
+4 IF $GET(IBJOB)=1!($GET(IBJOB)=2)
QUIT
+5 ;
+6 ; If Means Test charge, divert control to routine IBAERR1.
+7 IF $DATA(IBNOS)
IF $PIECE($GET(^IB(+IBNOS,0)),"^",16)
SET IBY=Y
GOTO ^IBAERR1
+8 ;
+9 ; -- If copay exemption divert control to routine IBAERR2
+10 IF $DATA(IBEXERR)
GOTO ^IBAERR2
+11 ;
+12 IF $DATA(ZTQUEUED)
DO BULL
GOTO END
+13 IF +Y>0
GOTO END
+14 SET X2=$PIECE(Y,"^",2)
FOR K=1:1
SET X=$PIECE(X2,";",K)
IF X=""
QUIT
SET X1=$ORDER(^IBE(350.8,"AC",X,0))
IF $DATA(^IBE(350.8,+X1,0))
SET X3="E"_$PIECE(^(0),"^",5)
DO @X3
+15 IF $PIECE(Y,"^",3)]""
WRITE !,$PIECE(Y,"^",3)
END KILL VA,VADM,VAERR
+1 QUIT
+2 ;
E1 WRITE !,$PIECE(^IBE(350.8,+X1,0),"^",2)
+1 QUIT
+2 ;
E2 ;
+1 QUIT
E3 ; -- Send no service bulletin
+1 KILL XMY,IBTXT
+2 SET XMSUB="INTEGRATED BILLING BACKGROUND ERROR"
SET XMDUZ="INTEGRATED BILLING PACKAGE"
+3 SET IBTXT(1)="Processing of Pharmacy co-pay entries in Integrated Billing has"
+4 SET IBTXT(2)="Stopped."
SET IBTXT(3)=" "
+5 SET IBTXT(4)="The Pharmacy Service Pointer does not match any entries in the "
+6 SET IBTXT(5)="IB ACTION TYPE file."
+7 SET IBTXT(6)=" "
+8 SET IBTXT(7)="Immediate action required."
+9 SET IBTXT(8)="Check the IB SERVICE/SECTION in the PHARMACY SITE file."
+10 SET IBTXT(9)="It must match the SERVICE field for pharmacy action types in the "
+11 SET IBTXT(10)="IB ACTION TYPE file. (internal entry number 1 is checked)"
+12 DO SEND
+13 QUIT
+14 ;
BULL ; -send error bulletin to group when error occurs in background
+1 ;
+2 KILL XMY,IBTXT
+3 SET XMSUB="INTEGRATED BILLING BACKGROUND ERROR"
SET XMDUZ="INTEGRATED BILLING PACKAGE"
+4 SET IBTXT(1)="Processing of entries in Integrated Billing has"
+5 SET IBTXT(2)="been suspended "_$SELECT('$DATA(IBTAG):"while passing to AR the following",IBTAG=2:"while processing new/renew Rxs: ",IBTAG=3:"while canceling: ",1:"while updating:")
SET IBTXT(3)=" "
SET IBC=3
+6 IF $DATA(IBSAVX)!($DATA(IBSAVXU))
IF '$DATA(IBNOS)
DO SAVX
+7 IF $DATA(IBNOS)
FOR IBI=1:1
SET IBNOS1=$PIECE(IBNOS,"^",IBI)
IF 'IBNOS1
QUIT
IF $DATA(^IB(IBNOS1,0))
SET IBNOD=^(0)
DO BD
+8 SET IBC=IBC+1
SET IBTXT(IBC)=""
+9 SET IBC=IBC+1
SET IBTXT(IBC)="You should determine if these co-payments have been passed to"
+10 SET IBC=IBC+1
SET IBTXT(IBC)="Accounts Receivable."
+11 SET IBC=IBC+1
SET IBTXT(IBC)="The following error(s) was encountered:"
SET IBC=IBC+1
SET IBTXT(IBC)=""
+12 DO ERRTXT
+13 SET IBC=IBC+1
SET IBTXT(IBC)=""
+14 IF $DATA(IBWHER)
SET IBC=IBC+1
SET IBTXT(IBC)=$PIECE($TEXT(IBWHER+IBWHER),";;",2,99)
+15 ;
SEND SET XMTEXT="IBTXT("
SET XMY(DUZ)=""
+1 ;
+2 SET IBGRP=$SELECT($DATA(^IBE(350.9,1,0)):$PIECE(^(0),"^",9),1:"")
FOR IBI=0:0
SET IBI=$ORDER(^XMB(3.8,+IBGRP,1,"B",IBI))
IF 'IBI
QUIT
SET XMY(IBI)=""
+3 DO ^XMD
KILL XMSUB,XMY,XMDUZ,XMTEXT,IBTXT,IBC,IBNOD,IBNOS1,IBI
+4 QUIT
+5 ;
ERRTXT SET X2=$PIECE(Y,"^",2)
FOR K=1:1
SET X=$PIECE(X2,";",K)
IF X=""
QUIT
SET X1=$ORDER(^IBE(350.8,"AC",X,0))
SET IBC=IBC+1
SET IBTXT(IBC)=" "_$SELECT($DATA(^IBE(350.8,+X1,0)):$PIECE(^(0),"^",2),1:"Unknown Error")
+1 IF $PIECE(Y,"^",3)]""
SET IBC=IBC+1
SET IBTXT(IBC)=" "_$PIECE(Y,"^",3)
+2 QUIT
+3 ;
BD IF IBI=1
SET DFN=$PIECE(IBNOD,"^",2)
SET IBATYPN=$SELECT($DATA(^IBE(350.1,$PIECE(IBNOD,"^",3),0)):$PIECE(^(0),"^"),1:"")
DO DEM
+1 SET IBC=IBC+1
SET IBTXT(IBC)=" "_$EXTRACT($PIECE(IBNOD,"^")_" ",1,14)_$EXTRACT($PIECE(IBNOD,"^",8)_" ",1,24)_$EXTRACT($PIECE(IBNOD,"^",11)_" ",1,12)_" $"_$PIECE(IBNOD,"^",7)
+2 QUIT
DEM NEW X,Y
DO DEM^VADPT
+1 SET IBC=IBC+1
SET IBTXT(IBC)=" Patient: "_VADM(1)_" Pt. Id: "_VA("PID")_" Type: "_IBATYPN
+2 QUIT
+3 ;
SAVX SET IBAX=$SELECT($DATA(IBSAVXU):IBSAVXU,$DATA(IBSAVX):IBSAVX,1:"")
IF IBAX=""
QUIT
+1 SET IBATYPN=$SELECT('$PIECE(IBAX,"^",3):"",$DATA(^IBE(350.1,$PIECE(IBAX,"^",3),0)):$PIECE(^(0),"^",1),1:"")
SET DFN=$PIECE(IBAX,"^",2)
DO DEM
+2 SET IBC=IBC+1
SET IBTXT(IBC)=" Service: "_$SELECT($DATA(^DIC(49,+IBAX,0)):$PIECE(^(0),"^"),1:"")
+3 SET IBC=IBC+1
SET IBTXT(IBC)=" User: "_$SELECT($DATA(^VA(200,+$PIECE(IBAX,"^",4),0)):$PIECE(^(0),"^"),$DATA(^VA(200,+DUZ,0)):$PIECE(^(0),"^"),1:"")
+4 SET IB=""
FOR
SET IB=$ORDER(IBSAVX(IB))
IF IB=""
QUIT
Begin DoDot:1
+5 KILL IBARXN
IF +$PIECE(IBSAVX(IB),"^",1)=52
SET IBARXN="Rx# "_$PIECE($GET(^PSRX(+$PIECE($PIECE(IBSAVX(IB),"^"),":",2),0)),"^")
IF $PIECE($PIECE(IBSAVX(IB),"^"),";",2)'=""
SET IBARXN=IBARXN_"/Refill# "_$PIECE($PIECE($PIECE(IBSAVX(IB),"^"),";",2),":",2)
+6 SET IBC=IBC+1
SET IBTXT(IBC)=" Entry: "_$SELECT($DATA(IBARXN):IBARXN,1:$PIECE(IBSAVX(IB),"^",1))
KILL IBARXN
End DoDot:1
+7 SET IB=""
FOR
SET IB=$ORDER(IBSAVXU(IB))
IF IB=""
QUIT
SET IBC=IBC+1
SET IBTXT(IBC)=" Ref No: "_$SELECT($DATA(^IB(+IB,0)):$PIECE(^(0),"^"),1:"")
+8 QUIT
+9 ;
1 ;patient eligibility data not calculated
SET Y="-1^IB001"
QUIT
+1 QUIT
IBWHER ;
+1 ;;Error occurred before Integrated Billing entry created, Reprint labels or recancel after correcting error.
+2 ;;Error occurred after Integrated Billing entry created but Accounts Receivable not updated.
+3 ;;Error occurred during posting to Accounts Receivable. Check to see if amount passed!
+4 ;;Error occurred after successful passing of charges to AR, IB entry may not be properly updated.
+5 ;;Error occurred during eligibility determination for Co-pay.
