IBECUSO ;RLM/DVAMC - TRICARE PHARMACY BILLING OUTPUTS ; 21-AUG-96
;;2.0;INTEGRATED BILLING;**52,240,309,347**;21-MAR-94;Build 24
;
REJ ; Generate the Pharmacy Billing Reject report.
;
; - quit if there are no rejects
I '$O(^IBA(351.52,0)) W !!,"There are no rejects to be printed." G REJQ
;
; - select a device
S %ZIS="QM" D ^%ZIS G:POP REJQ
I $D(IO("Q")) D G REJQ
.S ZTRTN="REJDQ^IBECUSO",ZTDESC="IB - LIST TRICARE PHARMACY BILLING REJECTS"
.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
REJDQ ; Tasked entry point.
;
S (IBPAG,IBQ)=0 D REJHDR
;
; - print rejects
S IBR=0 F S IBR=$O(^IBA(351.52,IBR)) Q:'IBR D Q:IBQ
.S IBR0=$G(^IBA(351.52,IBR,0)),IBR1=$G(^(1))
.Q:'IBR0
.;
.S DFN=$$FILE^IBRXUTL(+IBR0,2),IBRXD=$$RXZERO^IBRXUTL(DFN,+IBR0)
.Q:IBRXD=""
.S IBFDT=$$FDT($P(IBR0,"^"))
.;
.; - display the prescription
.I $Y>(IOSL-4) D PAUSE Q:IBQ D REJHDR
.D REJERR
.;
.; - display errors
.F I=1:1 Q:$P(IBR1,",",I)="" S IBERRP=$P(IBR1,",",I) Q:IBERRP="" D Q:IBQ
..I $Y>(IOSL-2) D PAUSE Q:IBQ D REJHDR,REJERR
..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
..I IBTXT]"" W !?4,IBTXT
;
; - end-of-report pause
D:'IBQ PAUSE
;
REJQ I '$D(ZTQUEUED) D ^%ZISC
K IBFDT,IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT
Q
;
;
REJHDR ; Print the Reject report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1
W !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-14,"IPS Unresolved Reject Report"
W ?(IOM-10),"Page: ",IBPAG,!,$$DASH()
Q
;
REJERR ; Write the prescription and name.
W !!,"RX# ",$P(IBRXD,"^"),", filled on ",$$DAT1^IBOUTL(IBFDT)
W " (",$E($P($G(^DPT(DFN,0)),"^"),1,17)," ",$P($G(^(0)),"^",9),")"
W " rejected because:"
Q
;
DASH() ; Return a dashed line.
Q $TR($J("",IOM)," ","=")
;
PAUSE ; Page break
Q:$E(IOST,1,2)'="C-"
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
Q
;
;
;
TRN ; Generate the Pharmacy Billing Transmission Report
;
; - select dates
K DIR S DIR(0)="D^2960101:"_DT,DIR("A")="Beginning Date:" D ^DIR G:$D(DIRUT) TRNQ S IBBEG=Y
K DIR S DIR(0)="D^"_IBBEG_":"_DT,DIR("A")="Ending Date:" D ^DIR G:$D(DIRUT) TRNQ S IBEND=Y
I IBBEG>IBEND W !,"Beginning data must be before ending date.",! G TRN
;
; - select a device
S %ZIS="QM" D ^%ZIS G:POP TRNQ
I $D(IO("Q")) D G TRNQ
.S ZTRTN="TRNDQ^IBECUSO",ZTDESC="IB - LIST TRICARE PHARMACY BILLING TRANSMISSIONS"
.F I="IBBEG","IBEND" S ZTSAVE(I)=""
.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
TRNDQ ; Tasked entry point.
;
S (IBPAG,IBQ)=0 D TRNHDR
;
; - print transactions
S IBC=0 F S IBC=$O(^IBA(351.5,IBC)) Q:'IBC D Q:IBQ
.S IBCD=$G(^IBA(351.5,IBC,0)),IBCD2=$G(^(2)),IBCD5=$G(^(5)),IBCD6=$G(^(6))
.Q:'IBCD
.S IBD=$$FILE^IBRXUTL(+IBCD,101) I IBD="" S IBD=$$FILE^IBRXUTL(+IBCD,22)
.I IBD<IBBEG Q
.I IBD>IBEND Q
.;
.S IBDPT(0)=$G(^DPT($P(IBCD,"^",2),0)),IBRXD=$$RXZERO^IBRXUTL($P(IBCD,"^",2),+IBCD)
.S IBFDT=$$FDT($P(IBCD,"^"))
.;
.I $Y>(IOSL-5) D PAUSE Q:IBQ D TRNHDR
.D TRNDAT
.D ZERO^IBRXUTL(+$P(IBRXD,"^",6))
.W !," Drug Name: ",$G(^TMP($J,"IBDRUG",+$P(IBRXD,"^",6),.01))
.K ^TMP($J,"IBDRUG")
.;
.W !?5,"Status: ",$S($P(IBCD6,"^")]"":"Reversed",IBCD5]"":"Rejected",1:"Accepted")
.;
.; - display errors
.I IBCD5]"" F I=1:1 S IBERRP=$P(IBCD5,",",I) Q:IBERRP="" D Q:IBQ
..I $Y>(IOSL-2) D PAUSE Q:IBQ D TRNHDR,TRNDAT
..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
..I IBTXT]"" W !?4,IBTXT
.Q:IBCD5]""
.;
.I $Y>(IOSL-3) D PAUSE Q:IBQ D TRNHDR,TRNDAT
.W !,$P(IBCD,"^",4),?15,$J($P(IBCD,"^",5),6),?25,$J($P(IBCD2,"^"),6),?35,$J($P(IBCD2,"^",2),6),?45,$J($P(IBCD2,"^",3),6),?55,$J($P(IBCD2,"^",5),6)
.W !?15,$P(IBCD2,"^",6),?39,$P(IBCD2,"^",7)
.;
.I $P(IBCD6,"^",3)]"" F I=1:1 S IBERRP=$P($P(IBCD6,"^",3),",",I) Q:IBERRP="" D Q:IBQ
..I $Y>(IOSL-2) D PAUSE Q:IBQ D TRNHDR,TRNDAT
..S IBTXT=$$ERRTXT^IBECUS22(IBERRP)
..I IBTXT]"" W !?4,IBTXT
.;
.I $P(IBCD6,"^")]"" D
..I $Y>(IOSL-1) D PAUSE Q:IBQ D TRNHDR,TRNDAT
..W !,"Reversal Authorization # ",$P(IBCD6,"^"),?40,"Reversed by: ",$P($G(^VA(200,+$P(IBCD6,"^",2),0)),"^")
;
; - end-of-report pause
D:'IBQ PAUSE
;
TRNQ I '$D(ZTQUEUED) D ^%ZISC
K IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT,IBBEG,IBEND
K IBC,IBCD,IBCD2,IBCD5,IBCD6,IBDPT,IBD,IBFDT
Q
;
TRNHDR ; Print the Transmission Report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1
W !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-16,"IPS Prescription Status Report"
W ?(IOM-10),"Page: ",IBPAG
W !?(IOM/2)-17 S Y=IBBEG X ^DD("DD") W Y," through " S Y=IBEND X ^DD("DD") W Y
W !,"RX#",?15,"Fill Date",?27,"Patient Name",?62,"Patient SSN"
W !,"NDC",?15,"AWP",?25,"Copay",?35,"Ing Cost",?45,"Fee Paid",?55,"Total PD"
W !?15,"Auth. #",?39,"Message"
W !,"Reject Failure Codes"
W !,$$DASH(),!
Q
;
TRNDAT ; Display basic description information.
W !!,$P(IBRXD,"^"),?15,$$DAT1^IBOUTL(IBFDT)
W ?27,$P(IBDPT(0),"^"),?62,$P(IBDPT(0),"^",9)
Q
;
FDT(X) ; Find the Fill Date for the prescription.
; Input: X -- 1;2 where 1 :> pointer to the rx in file #52, and
; 2 :> pointer to the re-fill in #52.1, or
; 0 if this is the original fill.
N IBRXN,Y,DFN S Y=""
I $G(X)="" G FDTQ
S IBRXN=+X
I $P(X,";",2) S Y=$$SUBFILE^IBRXUTL(IBRXN,$P(X,";",2),52,.01) G FDTQ
S DFN=$$FILE^IBRXUTL(IBRXN,2),Z2=$$RXSEC^IBRXUTL(DFN,IBRXN),Z3=$$RX3^IBRXUTL(DFN,IBRXN)
S Y=$S($P(Z2,"^",2):$P(Z2,"^",2),+Z3:+Z3,$P(Z2,"^",5):$P(Z2,"^",5),1:"")
FDTQ Q Y
;
AWP ;
I '$D(^JADUTIL("AWP UPDATE")) W !,"No updates on file" Q
W !,"Date Quantity"
S A="" F S A=$O(^JADUTIL("AWP UPDATE",A)) Q:'A D
.I A<($P($H,",")-52) K ^JADUTIL("AWP UPDATE",A) Q
.S %H=A D YMD^%DTC S Y=X X ^DD("DD")
.W !,Y," ",^JADUTIL("AWP UPDATE",A)
Q
;
;
;
REM ; Delete rejects.
W !!,"Delete entry from IPS error file"
W !,"Delete RX#: " R JADTA:DTIME Q:JADTA=""!(JADTA="^")
I '$D(^JADREJ(JADTA)) W !,JADTA," is not in the error file." G REM
K ^JADREJ(JADTA) W !,JADTA," has been deleted." G REM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECUSO 6415 printed Nov 22, 2024@17:31:56 Page 2
IBECUSO ;RLM/DVAMC - TRICARE PHARMACY BILLING OUTPUTS ; 21-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,240,309,347**;21-MAR-94;Build 24
+2 ;
REJ ; Generate the Pharmacy Billing Reject report.
+1 ;
+2 ; - quit if there are no rejects
+3 IF '$ORDER(^IBA(351.52,0))
WRITE !!,"There are no rejects to be printed."
GOTO REJQ
+4 ;
+5 ; - select a device
+6 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO REJQ
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="REJDQ^IBECUSO"
SET ZTDESC="IB - LIST TRICARE PHARMACY BILLING REJECTS"
+9 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+10 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO REJQ
+11 ;
+12 USE IO
+13 ;
REJDQ ; Tasked entry point.
+1 ;
+2 SET (IBPAG,IBQ)=0
DO REJHDR
+3 ;
+4 ; - print rejects
+5 SET IBR=0
FOR
SET IBR=$ORDER(^IBA(351.52,IBR))
if 'IBR
QUIT
Begin DoDot:1
+6 SET IBR0=$GET(^IBA(351.52,IBR,0))
SET IBR1=$GET(^(1))
+7 if 'IBR0
QUIT
+8 ;
+9 SET DFN=$$FILE^IBRXUTL(+IBR0,2)
SET IBRXD=$$RXZERO^IBRXUTL(DFN,+IBR0)
+10 if IBRXD=""
QUIT
+11 SET IBFDT=$$FDT($PIECE(IBR0,"^"))
+12 ;
+13 ; - display the prescription
+14 IF $Y>(IOSL-4)
DO PAUSE
if IBQ
QUIT
DO REJHDR
+15 DO REJERR
+16 ;
+17 ; - display errors
+18 FOR I=1:1
if $PIECE(IBR1,",",I)=""
QUIT
SET IBERRP=$PIECE(IBR1,",",I)
if IBERRP=""
QUIT
Begin DoDot:2
+19 IF $Y>(IOSL-2)
DO PAUSE
if IBQ
QUIT
DO REJHDR
DO REJERR
+20 SET IBTXT=$$ERRTXT^IBECUS22(IBERRP)
+21 IF IBTXT]""
WRITE !?4,IBTXT
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+22 ;
+23 ; - end-of-report pause
+24 if 'IBQ
DO PAUSE
+25 ;
REJQ IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 KILL IBFDT,IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT
+2 QUIT
+3 ;
+4 ;
REJHDR ; Print the Reject report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
+3 WRITE !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-14,"IPS Unresolved Reject Report"
+4 WRITE ?(IOM-10),"Page: ",IBPAG,!,$$DASH()
+5 QUIT
+6 ;
REJERR ; Write the prescription and name.
+1 WRITE !!,"RX# ",$PIECE(IBRXD,"^"),", filled on ",$$DAT1^IBOUTL(IBFDT)
+2 WRITE " (",$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,17)," ",$PIECE($GET(^(0)),"^",9),")"
+3 WRITE " rejected because:"
+4 QUIT
+5 ;
DASH() ; Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",IOM)," ","=")
+2 ;
PAUSE ; Page break
+1 if $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+5 QUIT
+6 ;
+7 ;
+8 ;
TRN ; Generate the Pharmacy Billing Transmission Report
+1 ;
+2 ; - select dates
+3 KILL DIR
SET DIR(0)="D^2960101:"_DT
SET DIR("A")="Beginning Date:"
DO ^DIR
if $DATA(DIRUT)
GOTO TRNQ
SET IBBEG=Y
+4 KILL DIR
SET DIR(0)="D^"_IBBEG_":"_DT
SET DIR("A")="Ending Date:"
DO ^DIR
if $DATA(DIRUT)
GOTO TRNQ
SET IBEND=Y
+5 IF IBBEG>IBEND
WRITE !,"Beginning data must be before ending date.",!
GOTO TRN
+6 ;
+7 ; - select a device
+8 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO TRNQ
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="TRNDQ^IBECUSO"
SET ZTDESC="IB - LIST TRICARE PHARMACY BILLING TRANSMISSIONS"
+11 FOR I="IBBEG","IBEND"
SET ZTSAVE(I)=""
+12 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+13 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO TRNQ
+14 ;
+15 USE IO
+16 ;
TRNDQ ; Tasked entry point.
+1 ;
+2 SET (IBPAG,IBQ)=0
DO TRNHDR
+3 ;
+4 ; - print transactions
+5 SET IBC=0
FOR
SET IBC=$ORDER(^IBA(351.5,IBC))
if 'IBC
QUIT
Begin DoDot:1
+6 SET IBCD=$GET(^IBA(351.5,IBC,0))
SET IBCD2=$GET(^(2))
SET IBCD5=$GET(^(5))
SET IBCD6=$GET(^(6))
+7 if 'IBCD
QUIT
+8 SET IBD=$$FILE^IBRXUTL(+IBCD,101)
IF IBD=""
SET IBD=$$FILE^IBRXUTL(+IBCD,22)
+9 IF IBD<IBBEG
QUIT
+10 IF IBD>IBEND
QUIT
+11 ;
+12 SET IBDPT(0)=$GET(^DPT($PIECE(IBCD,"^",2),0))
SET IBRXD=$$RXZERO^IBRXUTL($PIECE(IBCD,"^",2),+IBCD)
+13 SET IBFDT=$$FDT($PIECE(IBCD,"^"))
+14 ;
+15 IF $Y>(IOSL-5)
DO PAUSE
if IBQ
QUIT
DO TRNHDR
+16 DO TRNDAT
+17 DO ZERO^IBRXUTL(+$PIECE(IBRXD,"^",6))
+18 WRITE !," Drug Name: ",$GET(^TMP($JOB,"IBDRUG",+$PIECE(IBRXD,"^",6),.01))
+19 KILL ^TMP($JOB,"IBDRUG")
+20 ;
+21 WRITE !?5,"Status: ",$SELECT($PIECE(IBCD6,"^")]"":"Reversed",IBCD5]"":"Rejected",1:"Accepted")
+22 ;
+23 ; - display errors
+24 IF IBCD5]""
FOR I=1:1
SET IBERRP=$PIECE(IBCD5,",",I)
if IBERRP=""
QUIT
Begin DoDot:2
+25 IF $Y>(IOSL-2)
DO PAUSE
if IBQ
QUIT
DO TRNHDR
DO TRNDAT
+26 SET IBTXT=$$ERRTXT^IBECUS22(IBERRP)
+27 IF IBTXT]""
WRITE !?4,IBTXT
End DoDot:2
if IBQ
QUIT
+28 if IBCD5]""
QUIT
+29 ;
+30 IF $Y>(IOSL-3)
DO PAUSE
if IBQ
QUIT
DO TRNHDR
DO TRNDAT
+31 WRITE !,$PIECE(IBCD,"^",4),?15,$JUSTIFY($PIECE(IBCD,"^",5),6),?25,$JUSTIFY($PIECE(IBCD2,"^"),6),?35,$JUSTIFY($PIECE(IBCD2,"^",2),6),?45,$JUSTIFY($PIECE(IBCD2,"^",3),6),?55,$JUSTIFY($PIECE(IBCD2,"^",5),6)
+32 WRITE !?15,$PIECE(IBCD2,"^",6),?39,$PIECE(IBCD2,"^",7)
+33 ;
+34 IF $PIECE(IBCD6,"^",3)]""
FOR I=1:1
SET IBERRP=$PIECE($PIECE(IBCD6,"^",3),",",I)
if IBERRP=""
QUIT
Begin DoDot:2
+35 IF $Y>(IOSL-2)
DO PAUSE
if IBQ
QUIT
DO TRNHDR
DO TRNDAT
+36 SET IBTXT=$$ERRTXT^IBECUS22(IBERRP)
+37 IF IBTXT]""
WRITE !?4,IBTXT
End DoDot:2
if IBQ
QUIT
+38 ;
+39 IF $PIECE(IBCD6,"^")]""
Begin DoDot:2
+40 IF $Y>(IOSL-1)
DO PAUSE
if IBQ
QUIT
DO TRNHDR
DO TRNDAT
+41 WRITE !,"Reversal Authorization # ",$PIECE(IBCD6,"^"),?40,"Reversed by: ",$PIECE($GET(^VA(200,+$PIECE(IBCD6,"^",2),0)),"^")
End DoDot:2
End DoDot:1
if IBQ
QUIT
+42 ;
+43 ; - end-of-report pause
+44 if 'IBQ
DO PAUSE
+45 ;
TRNQ IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 KILL IBPAG,IBQ,IBR,IBR0,IBR1,IBRXD,DFN,IBERRP,IBTXT,IBBEG,IBEND
+2 KILL IBC,IBCD,IBCD2,IBCD5,IBCD6,IBDPT,IBD,IBFDT
+3 QUIT
+4 ;
TRNHDR ; Print the Transmission Report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
+3 WRITE !,$$DASH(),!,"Date: ",$$DAT1^IBOUTL(DT),?(IOM/2)-16,"IPS Prescription Status Report"
+4 WRITE ?(IOM-10),"Page: ",IBPAG
+5 WRITE !?(IOM/2)-17
SET Y=IBBEG
XECUTE ^DD("DD")
WRITE Y," through "
SET Y=IBEND
XECUTE ^DD("DD")
WRITE Y
+6 WRITE !,"RX#",?15,"Fill Date",?27,"Patient Name",?62,"Patient SSN"
+7 WRITE !,"NDC",?15,"AWP",?25,"Copay",?35,"Ing Cost",?45,"Fee Paid",?55,"Total PD"
+8 WRITE !?15,"Auth. #",?39,"Message"
+9 WRITE !,"Reject Failure Codes"
+10 WRITE !,$$DASH(),!
+11 QUIT
+12 ;
TRNDAT ; Display basic description information.
+1 WRITE !!,$PIECE(IBRXD,"^"),?15,$$DAT1^IBOUTL(IBFDT)
+2 WRITE ?27,$PIECE(IBDPT(0),"^"),?62,$PIECE(IBDPT(0),"^",9)
+3 QUIT
+4 ;
FDT(X) ; Find the Fill Date for the prescription.
+1 ; Input: X -- 1;2 where 1 :> pointer to the rx in file #52, and
+2 ; 2 :> pointer to the re-fill in #52.1, or
+3 ; 0 if this is the original fill.
+4 NEW IBRXN,Y,DFN
SET Y=""
+5 IF $GET(X)=""
GOTO FDTQ
+6 SET IBRXN=+X
+7 IF $PIECE(X,";",2)
SET Y=$$SUBFILE^IBRXUTL(IBRXN,$PIECE(X,";",2),52,.01)
GOTO FDTQ
+8 SET DFN=$$FILE^IBRXUTL(IBRXN,2)
SET Z2=$$RXSEC^IBRXUTL(DFN,IBRXN)
SET Z3=$$RX3^IBRXUTL(DFN,IBRXN)
+9 SET Y=$SELECT($PIECE(Z2,"^",2):$PIECE(Z2,"^",2),+Z3:+Z3,$PIECE(Z2,"^",5):$PIECE(Z2,"^",5),1:"")
FDTQ QUIT Y
+1 ;
AWP ;
+1 IF '$DATA(^JADUTIL("AWP UPDATE"))
WRITE !,"No updates on file"
QUIT
+2 WRITE !,"Date Quantity"
+3 SET A=""
FOR
SET A=$ORDER(^JADUTIL("AWP UPDATE",A))
if 'A
QUIT
Begin DoDot:1
+4 IF A<($PIECE($HOROLOG,",")-52)
KILL ^JADUTIL("AWP UPDATE",A)
QUIT
+5 SET %H=A
DO YMD^%DTC
SET Y=X
XECUTE ^DD("DD")
+6 WRITE !,Y," ",^JADUTIL("AWP UPDATE",A)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
+10 ;
REM ; Delete rejects.
+1 WRITE !!,"Delete entry from IPS error file"
+2 WRITE !,"Delete RX#: "
READ JADTA:DTIME
if JADTA=""!(JADTA="^")
QUIT
+3 IF '$DATA(^JADREJ(JADTA))
WRITE !,JADTA," is not in the error file."
GOTO REM
+4 KILL ^JADREJ(JADTA)
WRITE !,JADTA," has been deleted."
GOTO REM
+5 QUIT
