BPSRDT1 ;BHAM ISC/FCS/DRS/FLS/DLF - Turn Around Time Statistics Report ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
N TRANDT,FR,TO,BPSSIZ,BPSTTAT,IEN57,IEN59,IEN,UPDT,SEQ,ENDLOOP,BPSTATIM
N BPSBGN,BPSBTIM,BPSCTIM,BPSEND,BPSETIM,BPSGTIM,BPSRTIM,BPSSTIM
N BPSBDT,BPSCNT,X,Y,BPSQUIT,MES,TYPE,DATA
K ^TMP("BPSRDT1",$J)
;
; Get start/end dates. Quit if no dates entered
D DATE I Y<0 K DTOUT Q
;
; Initialize variables
S TRANDT=FR,BPSSIZ=0,BPSTTAT=0,BPSCNT=0
;
; Quit if no dates in X-ref that match
I '$O(^BPSTL("AH",TRANDT)) G QUIT
;
; Loop through the dates and build temporary list
F S TRANDT=$O(^BPSTL("AH",TRANDT)) Q:TRANDT=""!($P(TRANDT,".")>TO) D
. S IEN57=""
. F S IEN57=$O(^BPSTL("AH",TRANDT,IEN57)) Q:IEN57="" D
.. S IEN59=$P($G(^BPSTL(IEN57,0)),U,1)
.. I 'IEN59 Q
.. ; Sieve out eligibility verification transactions
.. I $P($G(^BPSTL(IEN57,0)),U,15)="E" Q
.. S IEN=$$EXISTS^BPSOSL1(IEN59)
.. I IEN S ^TMP("BPSRDT1",$J,1,IEN59)=IEN
;
; Loop through the temporary list and build second list with turn-around stats
S IEN59=""
F S IEN59=$O(^TMP("BPSRDT1",$J,1,IEN59)) Q:IEN59="" D
. S IEN=$G(^TMP("BPSRDT1",$J,1,IEN59))
. S ENDLOOP=0
. S (BPSBDT,BPSBGN,BPSEND,BPSBTIM,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM,TYPE)=""
. S UPDT=FR F S UPDT=$O(^BPS(9002313.12,IEN,10,"B",UPDT)) Q:UPDT="" D Q:ENDLOOP
.. S SEQ="" F S SEQ=$O(^BPS(9002313.12,IEN,10,"B",UPDT,SEQ)) Q:SEQ="" D Q:ENDLOOP
... S MES=$$UP($P($G(^BPS(9002313.12,IEN,10,SEQ,1)),U,1))
... I MES="" Q
... I MES["BEFORE SUBMIT OF " D
.... S TYPE=$P(MES,"BEFORE SUBMIT OF ",2)
.... S BPSBDT=$P(UPDT,".",1)
.... I BPSBDT>TO S BPSBDT="",ENDLOOP=1 Q
.... S BPSBGN=$$TIME2(UPDT),BPSBTIM=$$TIME(UPDT)
.... S (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)=""
... I ENDLOOP=1 Q
... I BPSBDT,MES["BPSOSU NOW RESUBMIT"!(MES["BPSOSU-NOW RESUBMIT") D
.... S TYPE="Request portion of a Reversal/Resubmit"
.... S BPSBGN=$$TIME2(UPDT),BPSBTIM=$$TIME(UPDT)
.... S (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)=""
... I BPSBGN="" Q
... I MES["INITIATING REVERSAL AND AFTER THAT, CLAIM WILL BE RESUBMITTED" S TYPE="Reversal portion of a Reversal/Resubmit"
... I MES["GATHERING"!(MES["VALIDATING THE BPS TRANSACTION") S BPSGTIM=$$TIME(UPDT)
... I MES["CREATED CLAIM ID" S BPSCTIM=$$TIME(UPDT)
... I MES["BPSECMC2 - CLAIM - SENT"!(MES["BPSECMC2-CLAIM SENT") S BPSSTIM=$$TIME(UPDT)
... I MES["BPSECMC2 - CLAIM - RESPONSE STORED"!(MES["BPSECMC2-RESPONSE STORED") S BPSRTIM=$$TIME(UPDT)
... I MES["CLAIM - END"!(MES["BPSOSU-CLAIM COMPLETE") I BPSBGN D
.... S BPSEND=$$TIME2(UPDT),BPSETIM=$$TIME(UPDT)
.... D LOG
;
; If no data to report, quit
I 'BPSTTAT G QUIT
;
; Loop through list of stats and output
S BPSCNT="",BPSQUIT=0
F S BPSCNT=$O(^TMP("BPSRDT1",$J,2,BPSCNT)) Q:BPSCNT="" D I BPSQUIT=1 Q
. S DATA=$G(^TMP("BPSRDT1",$J,2,BPSCNT)),IEN59=$P(DATA,U,1),TYPE=$P(DATA,U,2)
. S TYPE=$S(TYPE="CLAIM":"Request",TYPE="REVERSAL":"Reversal",1:TYPE)
. W !,"For Prescription",?25,IEN59_" (Rx# "_$$RXAPI1^BPSUTIL1($P(IEN59,"."),.01,"I")_")"
. W !,"Type",?25,TYPE
. W !,"Date",?25,$$FMTE^XLFDT($P(DATA,U,3),"5Z")
. W !,"Begin ",?25,$P(DATA,U,4)
. W !,"Gathering information",?25,$P(DATA,U,5)
. W !,"Claim ID created",?25,$P(DATA,U,6)
. W !,"Claim Sent",?25,$P(DATA,U,7)
. W !,"Response stored ",?25,$P(DATA,U,8)
. W !,"Completed at",?25,$P(DATA,U,9)
. W !,"Turn-around time",?25,$P(DATA,U,10),!
. I BPSCNT#2=0 D
.. R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
.. I '$T!(X["^") S BPSQUIT=1
;
; Write Totals
W !!!,"Total number of claims",?25,BPSSIZ
W !,"Average Turn-around time",?25,BPSTTAT\BPSSIZ,!!
D PRESSANY^BPSOSU5()
;
; Kill scratch global
K ^TMP("BPSRDT1",$J)
Q
;
;
TIME(%) ;
S %=$E($P(%,".",2)_"000000",1,6)
Q $E(%,1,2)_":"_$E(%,3,4)_":"_$E(%,5,6)
;
TIME2(%) ;
Q $P($$FMTH^XLFDT(%),",",2)
;
;
LOG ;
I BPSBGN="" Q
I BPSEND="" Q
S BPSTATIM=$G(BPSEND)-$G(BPSBGN)
;
; Remove negative times (span midnight) and claims more than 20 minutes as anomolies
I BPSTATIM'>0 Q
;I BPSTATIM>1200 Q
S BPSCNT=BPSCNT+1
S ^TMP("BPSRDT1",$J,2,BPSCNT)=IEN59_U_TYPE_U_BPSBDT_U_BPSBTIM_U_BPSGTIM_U_BPSCTIM_U_BPSSTIM_U_BPSRTIM_U_BPSETIM_U_BPSTATIM
S BPSTTAT=BPSTTAT+BPSTATIM
S BPSSIZ=BPSSIZ+1
I TYPE="Reversal/Resubmit" S BPSSIZ=BPSSIZ+1
S (BPSBGN,TYPE)=""
Q
;
DATE ; Ask user the date range
N %DT,VAL,TYPEVAL,X
S %DT="AEP",%DT(0)=-DT,%DT("A")="START WITH DATE: "
S %DT("B")="T-1"
D ^%DT Q:Y<0!($D(DTOUT))
S (%DT(0),FR)=Y
S %DT("A")="GO TO DATE: "
S %DT("B")="T"
D ^%DT Q:Y<0!($D(DTOUT))
S TO=Y
Q
;
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
QUIT ;
W !!,"*** No valid data found ***",!!
D PRESSANY^BPSOSU5()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRDT1 4927 printed Sep 23, 2025@19:28:42 Page 2
BPSRDT1 ;BHAM ISC/FCS/DRS/FLS/DLF - Turn Around Time Statistics Report ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 NEW TRANDT,FR,TO,BPSSIZ,BPSTTAT,IEN57,IEN59,IEN,UPDT,SEQ,ENDLOOP,BPSTATIM
+5 NEW BPSBGN,BPSBTIM,BPSCTIM,BPSEND,BPSETIM,BPSGTIM,BPSRTIM,BPSSTIM
+6 NEW BPSBDT,BPSCNT,X,Y,BPSQUIT,MES,TYPE,DATA
+7 KILL ^TMP("BPSRDT1",$JOB)
+8 ;
+9 ; Get start/end dates. Quit if no dates entered
+10 DO DATE
IF Y<0
KILL DTOUT
QUIT
+11 ;
+12 ; Initialize variables
+13 SET TRANDT=FR
SET BPSSIZ=0
SET BPSTTAT=0
SET BPSCNT=0
+14 ;
+15 ; Quit if no dates in X-ref that match
+16 IF '$ORDER(^BPSTL("AH",TRANDT))
GOTO QUIT
+17 ;
+18 ; Loop through the dates and build temporary list
+19 FOR
SET TRANDT=$ORDER(^BPSTL("AH",TRANDT))
if TRANDT=""!($PIECE(TRANDT,".")>TO)
QUIT
Begin DoDot:1
+20 SET IEN57=""
+21 FOR
SET IEN57=$ORDER(^BPSTL("AH",TRANDT,IEN57))
if IEN57=""
QUIT
Begin DoDot:2
+22 SET IEN59=$PIECE($GET(^BPSTL(IEN57,0)),U,1)
+23 IF 'IEN59
QUIT
+24 ; Sieve out eligibility verification transactions
+25 IF $PIECE($GET(^BPSTL(IEN57,0)),U,15)="E"
QUIT
+26 SET IEN=$$EXISTS^BPSOSL1(IEN59)
+27 IF IEN
SET ^TMP("BPSRDT1",$JOB,1,IEN59)=IEN
End DoDot:2
End DoDot:1
+28 ;
+29 ; Loop through the temporary list and build second list with turn-around stats
+30 SET IEN59=""
+31 FOR
SET IEN59=$ORDER(^TMP("BPSRDT1",$JOB,1,IEN59))
if IEN59=""
QUIT
Begin DoDot:1
+32 SET IEN=$GET(^TMP("BPSRDT1",$JOB,1,IEN59))
+33 SET ENDLOOP=0
+34 SET (BPSBDT,BPSBGN,BPSEND,BPSBTIM,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM,TYPE)=""
+35 SET UPDT=FR
FOR
SET UPDT=$ORDER(^BPS(9002313.12,IEN,10,"B",UPDT))
if UPDT=""
QUIT
Begin DoDot:2
+36 SET SEQ=""
FOR
SET SEQ=$ORDER(^BPS(9002313.12,IEN,10,"B",UPDT,SEQ))
if SEQ=""
QUIT
Begin DoDot:3
+37 SET MES=$$UP($PIECE($GET(^BPS(9002313.12,IEN,10,SEQ,1)),U,1))
+38 IF MES=""
QUIT
+39 IF MES["BEFORE SUBMIT OF "
Begin DoDot:4
+40 SET TYPE=$PIECE(MES,"BEFORE SUBMIT OF ",2)
+41 SET BPSBDT=$PIECE(UPDT,".",1)
+42 IF BPSBDT>TO
SET BPSBDT=""
SET ENDLOOP=1
QUIT
+43 SET BPSBGN=$$TIME2(UPDT)
SET BPSBTIM=$$TIME(UPDT)
+44 SET (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)=""
End DoDot:4
+45 IF ENDLOOP=1
QUIT
+46 IF BPSBDT
IF MES["BPSOSU NOW RESUBMIT"!(MES["BPSOSU-NOW RESUBMIT")
Begin DoDot:4
+47 SET TYPE="Request portion of a Reversal/Resubmit"
+48 SET BPSBGN=$$TIME2(UPDT)
SET BPSBTIM=$$TIME(UPDT)
+49 SET (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)=""
End DoDot:4
+50 IF BPSBGN=""
QUIT
+51 IF MES["INITIATING REVERSAL AND AFTER THAT, CLAIM WILL BE RESUBMITTED"
SET TYPE="Reversal portion of a Reversal/Resubmit"
+52 IF MES["GATHERING"!(MES["VALIDATING THE BPS TRANSACTION")
SET BPSGTIM=$$TIME(UPDT)
+53 IF MES["CREATED CLAIM ID"
SET BPSCTIM=$$TIME(UPDT)
+54 IF MES["BPSECMC2 - CLAIM - SENT"!(MES["BPSECMC2-CLAIM SENT")
SET BPSSTIM=$$TIME(UPDT)
+55 IF MES["BPSECMC2 - CLAIM - RESPONSE STORED"!(MES["BPSECMC2-RESPONSE STORED")
SET BPSRTIM=$$TIME(UPDT)
+56 IF MES["CLAIM - END"!(MES["BPSOSU-CLAIM COMPLETE")
IF BPSBGN
Begin DoDot:4
+57 SET BPSEND=$$TIME2(UPDT)
SET BPSETIM=$$TIME(UPDT)
+58 DO LOG
End DoDot:4
End DoDot:3
if ENDLOOP
QUIT
End DoDot:2
if ENDLOOP
QUIT
End DoDot:1
+59 ;
+60 ; If no data to report, quit
+61 IF 'BPSTTAT
GOTO QUIT
+62 ;
+63 ; Loop through list of stats and output
+64 SET BPSCNT=""
SET BPSQUIT=0
+65 FOR
SET BPSCNT=$ORDER(^TMP("BPSRDT1",$JOB,2,BPSCNT))
if BPSCNT=""
QUIT
Begin DoDot:1
+66 SET DATA=$GET(^TMP("BPSRDT1",$JOB,2,BPSCNT))
SET IEN59=$PIECE(DATA,U,1)
SET TYPE=$PIECE(DATA,U,2)
+67 SET TYPE=$SELECT(TYPE="CLAIM":"Request",TYPE="REVERSAL":"Reversal",1:TYPE)
+68 WRITE !,"For Prescription",?25,IEN59_" (Rx# "_$$RXAPI1^BPSUTIL1($PIECE(IEN59,"."),.01,"I")_")"
+69 WRITE !,"Type",?25,TYPE
+70 WRITE !,"Date",?25,$$FMTE^XLFDT($PIECE(DATA,U,3),"5Z")
+71 WRITE !,"Begin ",?25,$PIECE(DATA,U,4)
+72 WRITE !,"Gathering information",?25,$PIECE(DATA,U,5)
+73 WRITE !,"Claim ID created",?25,$PIECE(DATA,U,6)
+74 WRITE !,"Claim Sent",?25,$PIECE(DATA,U,7)
+75 WRITE !,"Response stored ",?25,$PIECE(DATA,U,8)
+76 WRITE !,"Completed at",?25,$PIECE(DATA,U,9)
+77 WRITE !,"Turn-around time",?25,$PIECE(DATA,U,10),!
+78 IF BPSCNT#2=0
Begin DoDot:2
+79 READ !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
+80 IF '$TEST!(X["^")
SET BPSQUIT=1
End DoDot:2
End DoDot:1
IF BPSQUIT=1
QUIT
+81 ;
+82 ; Write Totals
+83 WRITE !!!,"Total number of claims",?25,BPSSIZ
+84 WRITE !,"Average Turn-around time",?25,BPSTTAT\BPSSIZ,!!
+85 DO PRESSANY^BPSOSU5()
+86 ;
+87 ; Kill scratch global
+88 KILL ^TMP("BPSRDT1",$JOB)
+89 QUIT
+90 ;
+91 ;
TIME(%) ;
+1 SET %=$EXTRACT($PIECE(%,".",2)_"000000",1,6)
+2 QUIT $EXTRACT(%,1,2)_":"_$EXTRACT(%,3,4)_":"_$EXTRACT(%,5,6)
+3 ;
TIME2(%) ;
+1 QUIT $PIECE($$FMTH^XLFDT(%),",",2)
+2 ;
+3 ;
LOG ;
+1 IF BPSBGN=""
QUIT
+2 IF BPSEND=""
QUIT
+3 SET BPSTATIM=$GET(BPSEND)-$GET(BPSBGN)
+4 ;
+5 ; Remove negative times (span midnight) and claims more than 20 minutes as anomolies
+6 IF BPSTATIM'>0
QUIT
+7 ;I BPSTATIM>1200 Q
+8 SET BPSCNT=BPSCNT+1
+9 SET ^TMP("BPSRDT1",$JOB,2,BPSCNT)=IEN59_U_TYPE_U_BPSBDT_U_BPSBTIM_U_BPSGTIM_U_BPSCTIM_U_BPSSTIM_U_BPSRTIM_U_BPSETIM_U_BPSTATIM
+10 SET BPSTTAT=BPSTTAT+BPSTATIM
+11 SET BPSSIZ=BPSSIZ+1
+12 IF TYPE="Reversal/Resubmit"
SET BPSSIZ=BPSSIZ+1
+13 SET (BPSBGN,TYPE)=""
+14 QUIT
+15 ;
DATE ; Ask user the date range
+1 NEW %DT,VAL,TYPEVAL,X
+2 SET %DT="AEP"
SET %DT(0)=-DT
SET %DT("A")="START WITH DATE: "
+3 SET %DT("B")="T-1"
+4 DO ^%DT
if Y<0!($DATA(DTOUT))
QUIT
+5 SET (%DT(0),FR)=Y
+6 SET %DT("A")="GO TO DATE: "
+7 SET %DT("B")="T"
+8 DO ^%DT
if Y<0!($DATA(DTOUT))
QUIT
+9 SET TO=Y
+10 QUIT
+11 ;
UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
QUIT ;
+1 WRITE !!,"*** No valid data found ***",!!
+2 DO PRESSANY^BPSOSU5()
+3 QUIT
