- IBAERR ;ALB/AAS - INTEGRATED BILLING ERROR PROCESSING ROUTINE ; 14-FEB-91
- ;;2.0; INTEGRATED BILLING ;**7,70,347**; 21-MAR-94;Build 24
- ;;Per VHA Directive 2004-038, 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 File #59."
- 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
- ;
- E4 ; -- send missing number of days charges held bulletin
- K XMY,IBTXT
- S XMSUB="INTEGRATED BILLING BACKGROUND ERROR",XMDUZ="INTEGRATED BILLING PACKAGE"
- S IBTXT(1)="The nightly job to auto-release patient charges on hold did not run."
- S IBTXT(2)="The NUMBER OF DAYS PT CHARGES HELD field of the IB SITE PARAMETERS"
- S IBTXT(3)="file is blank."
- S IBTXT(4)=" "
- S IBTXT(5)="Immediate action required. Select the option 'MCCR Site Parameter"
- S IBTXT(6)="Display/Edit' to enter the required information."
- 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# "_$$FILE^IBRXUTL(+$P($P(IBSAVX(IB),"^"),":",2),.01) 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.
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAERR 5293 printed Jan 18, 2025@03:07:26 Page 2
- IBAERR ;ALB/AAS - INTEGRATED BILLING ERROR PROCESSING ROUTINE ; 14-FEB-91
- +1 ;;2.0; INTEGRATED BILLING ;**7,70,347**; 21-MAR-94;Build 24
- +2 ;;Per VHA Directive 2004-038, 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 File #59."
- +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 ;
- E4 ; -- send missing number of days charges held bulletin
- +1 KILL XMY,IBTXT
- +2 SET XMSUB="INTEGRATED BILLING BACKGROUND ERROR"
- SET XMDUZ="INTEGRATED BILLING PACKAGE"
- +3 SET IBTXT(1)="The nightly job to auto-release patient charges on hold did not run."
- +4 SET IBTXT(2)="The NUMBER OF DAYS PT CHARGES HELD field of the IB SITE PARAMETERS"
- +5 SET IBTXT(3)="file is blank."
- +6 SET IBTXT(4)=" "
- +7 SET IBTXT(5)="Immediate action required. Select the option 'MCCR Site Parameter"
- +8 SET IBTXT(6)="Display/Edit' to enter the required information."
- +9 DO SEND
- +10 QUIT
- +11 ;
- 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# "_$$FILE^IBRXUTL(+$PIECE($PIECE(IBSAVX(IB),"^"),":",2),.01)
- 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.