BPSBCKJ ;BHAM ISC/AAT - BPS NIGHTLY BACKGROUND JOB ;02/27/2005
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7,8,22**;JUN 2004;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; The ECME NIGHTLY PROCESS
;
; The list of nightly actions
D AUTOREV ; Auto-Reversals (normal and inpatient)
D MAIN^BPSOSK ; Purge BPS LOG
D TASKMAN^BPSJAREG ; Do automatic registration.
Q
;
AUTOREV ; The Auto-Reverse Procedure
N BDT,BTRAN,BPHARM,BTRAN0,BTRAN1,BTRAN4,BDAYS,BRX,BFIL,BDATE,BNOW,BCLAIM,BRES,BREV,BTEST,REF,BCNT,BTX,X,X1,X2
N BTRAN9,BELIG,BDRUG
;
S BTEST=0 ; Debugging flag 1 - TEST, 0 - LIVE
S BCNT=0 ; Count reversals
;
S REF=$NA(^TMP($J,"BPSBCKJ")) K @REF
;
S (X1,BNOW)=$$DT^XLFDT()
;
;Define number of days to look back - Auto Reverse days can be from 0-31
;To make sure every claim is caught, moving back 45 days
S X2=-45 D C^%DTC S BDT=X
;
;Loop through 'LAST UPDATE' 'AH' index
F S BDT=$O(^BPST("AH",BDT)) Q:'BDT S BTRAN=0 F S BTRAN=$O(^BPST("AH",BDT,BTRAN)) Q:'BTRAN D
. W:BTEST !,"TRAN=",BTRAN," ",?20
. S BTRAN0=$G(^BPST(BTRAN,0)),BTRAN1=$G(^(1)),BTRAN4=$G(^(4)),BTRAN9=$G(^(9))
. I BTRAN0=""!(BTRAN1="") W:BTEST "ZERO OR ONE NODE MISSING" Q
. I '$$PAID^BPSOSQ4(BTRAN) W:BTEST "NOT PAID" Q ; Not paid
. S BPHARM=$P(BTRAN1,U,7) I 'BPHARM W:BTEST "NO BPS PHARM" Q ; BPS PHARMACY
. W:BTEST "BPHARM=",$P($G(^BPS(9002313.56,BPHARM,0)),U,1)," "
. ;
. ;Handle 'Inpatient' Auto-Reversals
. S BREV=$$REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM,BTRAN9) Q:BREV
. ;
. ;Handle Regular Auto-Reversals
. S BDAYS=+$P($G(^BPS(9002313.56,BPHARM,0)),U,9)
. I 'BDAYS W:BTEST "AUTO-REV DISABLED" Q ;disabled
. I $P(BTRAN4,U,1) Q ;Reversal claim exist
. S BCLAIM=$P(BTRAN0,U,4) I 'BCLAIM W:BTEST "NO BCLAIM" Q
. I $P($G(^BPSC(BCLAIM,0)),U,7) W:BTEST "AUTO-REVERSE FLAG" Q
. S BDATE=$P($G(^BPSC(BCLAIM,0)),U,5)
. I 'BDATE S BDATE=$P($G(^BPSC(BCLAIM,0)),U,6)
. S BDATE=$P(BDATE,".")
. I 'BDATE="" W:BTEST "NO DATE" Q
. W:BTEST "DATE=",BDATE," "
. I $$FMDIFF^XLFDT(BNOW,BDATE,1)'>BDAYS W:BTEST "TOO EARLY" Q
. S BRX=$P(BTRAN1,U,11) I 'BRX W:BTEST "NO RX" Q
. S BFIL=$P(BTRAN1,U,1)
. I $$RELDATE(BRX,BFIL) W:BTEST " RELEASED" Q ;released
. S BELIG=$P(BTRAN9,U,4) I BELIG="" W:BTEST "NO ELIGIBILITY" Q
. S BDRUG=$$RXAPI1^BPSUTIL1(BRX,6,"E") I BDRUG="" W:BTEST "NO DRUG" Q
. S BRES=$$REVERSE(BRX,BFIL,BCLAIM,1)
. W:BTEST " *REV CLM=",BCLAIM," STAT=",BRES
. I BRES=0!(BRES=4) D
.. S (BCNT,@REF@(BRES))=$G(@REF@(BRES))+1
.. S @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM_U_BELIG_U_BDRUG
. ; Any notifications to IB?
D BULL(REF) ; Send the bulletin
K @REF
Q
;
;Auto-Reverse Claims for Current Inpatients
;
;20050810;BEE;Phase III - CR11
;
REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM,BTRAN9) ;
N BRX,BFIL,BCLAIM,BDATE,BDRUG,BELIG,BRES,DFN,VAIP
;
;Only process Window fills
S BRX=+$P(BTRAN1,U,11) I BRX=0 Q 0
S BFIL=+$P(BTRAN1,U)
I $$MWC^BPSRPT6(BRX,BFIL)'="W" Q 0
;
;Check for Fill date - Must be equal to T-5
S BCLAIM=$P(BTRAN0,U,4) I 'BCLAIM Q 0
S BDATE=$$FILDATE(BRX,BFIL)
S BDATE=$P(BDATE,".")
I 'BDATE="" Q 0
I $$FMDIFF^XLFDT(BNOW,BDATE,1)'=5 Q 0
;
;Check for current Inpatient
S DFN=+$P(BTRAN0,U,6) I DFN=0 Q 0
D IN5^VADPT
I $G(VAIP(3))="" Q 0
;
S BELIG=$P(BTRAN9,U,4)
S BDRUG=$$RXAPI1^BPSUTIL1(BRX,6,"E")
;
;Auto-Reverse Claim
S BRES=$$REVERSE(BRX,BFIL,BCLAIM,2)
W:BTEST " *REV CLM=",BCLAIM," STAT=",BRES
I BRES=0!(BRES=4) D
. S (BCNT,@REF@(BRES))=$G(@REF@(BRES))+1
. S @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM_U_BELIG_U_BDRUG
Q 1
;
RELDATE(BRX,BFIL) ;Get the Released Date
I BFIL Q $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,17,"I")
Q $$RXAPI1^BPSUTIL1(BRX,31,"I")
;
FILDATE(BRX,BFIL) ;Get the Fill Date
I BFIL Q $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,.01,"I")
Q $$RXAPI1^BPSUTIL1(BRX,22,"I")
;
REVERSE(BRX,BFIL,BCLAIM,BTYPE) ;Auto-Reverse the claim
;PUBLIC BTEST
N BDOS,BRES,BDAT,BMES,BRSN,BPSCOB,BP59
I $G(BTEST) Q 0 ; Test mode
;
; Get Date of Service and set reversal reason
S BDOS=$$DOSDATE^BPSSCRRS(BRX,BFIL)
S BRSN=$S(BTYPE=2:"CURRENT INPATIENT",1:"PRESCRIPTION NOT RELEASED")
;
S BP59=$$CLAIM59^BPSUTIL2(BCLAIM) ;get the BPS TRANSACTION IEN for the claim
S BPSCOB=$$COB59^BPSUTIL2(BP59) ;get COB for the BPS TRANSACTION IEN
;
; Call ECME to process reversal
S BRES=$$EN^BPSNCPDP(BRX,BFIL,BDOS,"AREV","",BRSN,"",,,,BPSCOB)
;
; If successful, log message to the Prescription Activity Log
; and set the auto-reversal flag
S BRES=+BRES,BMES="ECME: AUTO REVERSAL JOB-"_$S(BPSCOB=1:"p",BPSCOB=2:"s",1:"")_$$INSNAME^BPSSCRU6(BP59)
I BRES=0 D
. D ECMEACT^PSOBPSU1(BRX,BFIL,BMES,.5)
. S BDAT(9002313.02,BCLAIM_",",.07)=BTYPE D FILE^DIE("","BDAT")
Q BRES
;
;
BULL(REF) ;Bulletin to the OPECC
;PUBLIC BTEST,DUZ,DT
N XMSUB,XMY,XMTEXT,XMDUZ,BLNUM
;
I BCNT<1,'$G(BTEST),(+$G(@REF@(4)))=0 Q
S BLNUM=0,BCNT=+$G(@REF@(0))
S XMSUB="ECME AUTO-REVERSAL PROCESS"
I $G(BTEST) D T("*** P L E A S E D I S R E G A R D T H I S E M A I L ***"),T(),T("NOT ACTUALLY REVERSED - THIS IS A TEST"),T()
D T("The ECME Nightly Process submitted auto-reversals for the following e-Pharmacy")
D T("prescriptions.")
D T()
D T("TOTAL CLAIMS SUBMITTED FOR AUTO-REVERSALS: "_BCNT)
D T()
D T("Claims Submitted for Auto-Reversals on "_$$DAT(DT)_":") D ARLIST(0,REF)
D T()
S BCNT=+$G(@REF@(4))
I BCNT'=0 D
. D T()
. D T("The ECME Nightly Process attempted to auto-reverse the following claims but")
. D T("could not because the previous request was IN PROGRESS. Please verify that")
. D T("the previous request is not stranded.")
. D T()
. D T("Total number of claims that could not be auto-reversed: "_BCNT)
. D T()
. D T("Claims not auto-reversed on "_$$DAT(DT)_":")
. D ARLIST(4,REF)
. D T()
;
S XMDUZ="BPS PACKAGE",XMTEXT="BTX("
S XMY("G.BPS OPECC")=""
I $G(DUZ)'<1 S XMY(DUZ)=""
D ^XMD
Q
;
T(BTXT) ; Add text to the message
;PUBLIC BLNUM,BTEST
S BLNUM=BLNUM+1,BTX(BLNUM)=$G(BTXT," ")
I $G(BTEST) W !,$G(BTXT)
Q
;
ARLIST(BRES,REF) ;Auto-Rev List
N I,TXT,BCLAIM,BTRAN,Y,BRX,BFIL,BFDATE,BPHARM,BRXN,BPHARMN,BPAT,BPSTAT,BELIG,BDRUG
D T()
D T(" # RX/FILL STATUS DATE ELIG PATIENT BPS PHARM DRUG NAME")
D T("------------------------------------------------------------------------------")
S I=0 F S I=$O(@REF@(BRES,I)) Q:'I D
. S Y=@REF@(BRES,I)
. S BTRAN=$P(Y,U)
. S BCLAIM=$P(Y,U,2)
. S BRX=$P(Y,U,3),BRXN=$$RXAPI1^BPSUTIL1(BRX,.01,"I")
. S BPAT=$P($G(^DPT(+$$RXAPI1^BPSUTIL1(BRX,2,"I"),0)),U)
. S BFIL=$P(Y,U,4)
. S BPHARM=$P(Y,U,5),BPHARMN=$P($G(^BPS(9002313.56,BPHARM,0)),U)
. S BELIG=$P(Y,U,6)
. S BDRUG=$P(Y,U,7)
. S BFDATE=$$FILDATE(BRX,BFIL)
. S BPSTAT=$$MWC^BPSRPT6(BRX,BFIL)_"/"_$S($$RELDATE(BRX,BFIL)]"":"RL",1:"NR")
. S TXT=$J(I,3)_" "_$$J((BRXN_"/"_BFIL),13)_" "_$J(BPSTAT,4)_" "_$$J($$DAT(BFDATE),10)
. S TXT=TXT_$J(BELIG,1)_" "_$$J($E(BPAT,1,18),18)_" "_$J($E(BPHARMN,1,3),3)
. S TXT=TXT_" "_$$J($E(BDRUG,1,18),18)
. D T(TXT)
D T("------------------------------------------------------------------------------")
Q
;
J(TXT,LEN) ;Left justify
Q TXT_$J("",LEN-$L(TXT))
;
DAT(X,Y) ; Convert FM date to displayable (mm/dd/yy) format.
; -- optional output of time, if $g(y)
N DATE,T
S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
I $G(Y) S T="."_$E($P(X,".",2)_"000000",1,7) I T>0 S DATE=DATE_" "_$S($E(T,2,3)>12:$E(T,2,3)-12,$E(T,2,3)="00":"00",1:+$E(T,2,3))_":"_$E(T,4,5)_$S($E(T,2,5)>1200:" pm",1:" am")
Q DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSBCKJ 7649 printed Sep 23, 2025@19:26:54 Page 2
BPSBCKJ ;BHAM ISC/AAT - BPS NIGHTLY BACKGROUND JOB ;02/27/2005
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7,8,22**;JUN 2004;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; The ECME NIGHTLY PROCESS
+1 ;
+2 ; The list of nightly actions
+3 ; Auto-Reversals (normal and inpatient)
DO AUTOREV
+4 ; Purge BPS LOG
DO MAIN^BPSOSK
+5 ; Do automatic registration.
DO TASKMAN^BPSJAREG
+6 QUIT
+7 ;
AUTOREV ; The Auto-Reverse Procedure
+1 NEW BDT,BTRAN,BPHARM,BTRAN0,BTRAN1,BTRAN4,BDAYS,BRX,BFIL,BDATE,BNOW,BCLAIM,BRES,BREV,BTEST,REF,BCNT,BTX,X,X1,X2
+2 NEW BTRAN9,BELIG,BDRUG
+3 ;
+4 ; Debugging flag 1 - TEST, 0 - LIVE
SET BTEST=0
+5 ; Count reversals
SET BCNT=0
+6 ;
+7 SET REF=$NAME(^TMP($JOB,"BPSBCKJ"))
KILL @REF
+8 ;
+9 SET (X1,BNOW)=$$DT^XLFDT()
+10 ;
+11 ;Define number of days to look back - Auto Reverse days can be from 0-31
+12 ;To make sure every claim is caught, moving back 45 days
+13 SET X2=-45
DO C^%DTC
SET BDT=X
+14 ;
+15 ;Loop through 'LAST UPDATE' 'AH' index
+16 FOR
SET BDT=$ORDER(^BPST("AH",BDT))
if 'BDT
QUIT
SET BTRAN=0
FOR
SET BTRAN=$ORDER(^BPST("AH",BDT,BTRAN))
if 'BTRAN
QUIT
Begin DoDot:1
+17 if BTEST
WRITE !,"TRAN=",BTRAN," ",?20
+18 SET BTRAN0=$GET(^BPST(BTRAN,0))
SET BTRAN1=$GET(^(1))
SET BTRAN4=$GET(^(4))
SET BTRAN9=$GET(^(9))
+19 IF BTRAN0=""!(BTRAN1="")
if BTEST
WRITE "ZERO OR ONE NODE MISSING"
QUIT
+20 ; Not paid
IF '$$PAID^BPSOSQ4(BTRAN)
if BTEST
WRITE "NOT PAID"
QUIT
+21 ; BPS PHARMACY
SET BPHARM=$PIECE(BTRAN1,U,7)
IF 'BPHARM
if BTEST
WRITE "NO BPS PHARM"
QUIT
+22 if BTEST
WRITE "BPHARM=",$PIECE($GET(^BPS(9002313.56,BPHARM,0)),U,1)," "
+23 ;
+24 ;Handle 'Inpatient' Auto-Reversals
+25 SET BREV=$$REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM,BTRAN9)
if BREV
QUIT
+26 ;
+27 ;Handle Regular Auto-Reversals
+28 SET BDAYS=+$PIECE($GET(^BPS(9002313.56,BPHARM,0)),U,9)
+29 ;disabled
IF 'BDAYS
if BTEST
WRITE "AUTO-REV DISABLED"
QUIT
+30 ;Reversal claim exist
IF $PIECE(BTRAN4,U,1)
QUIT
+31 SET BCLAIM=$PIECE(BTRAN0,U,4)
IF 'BCLAIM
if BTEST
WRITE "NO BCLAIM"
QUIT
+32 IF $PIECE($GET(^BPSC(BCLAIM,0)),U,7)
if BTEST
WRITE "AUTO-REVERSE FLAG"
QUIT
+33 SET BDATE=$PIECE($GET(^BPSC(BCLAIM,0)),U,5)
+34 IF 'BDATE
SET BDATE=$PIECE($GET(^BPSC(BCLAIM,0)),U,6)
+35 SET BDATE=$PIECE(BDATE,".")
+36 IF 'BDATE=""
if BTEST
WRITE "NO DATE"
QUIT
+37 if BTEST
WRITE "DATE=",BDATE," "
+38 IF $$FMDIFF^XLFDT(BNOW,BDATE,1)'>BDAYS
if BTEST
WRITE "TOO EARLY"
QUIT
+39 SET BRX=$PIECE(BTRAN1,U,11)
IF 'BRX
if BTEST
WRITE "NO RX"
QUIT
+40 SET BFIL=$PIECE(BTRAN1,U,1)
+41 ;released
IF $$RELDATE(BRX,BFIL)
if BTEST
WRITE " RELEASED"
QUIT
+42 SET BELIG=$PIECE(BTRAN9,U,4)
IF BELIG=""
if BTEST
WRITE "NO ELIGIBILITY"
QUIT
+43 SET BDRUG=$$RXAPI1^BPSUTIL1(BRX,6,"E")
IF BDRUG=""
if BTEST
WRITE "NO DRUG"
QUIT
+44 SET BRES=$$REVERSE(BRX,BFIL,BCLAIM,1)
+45 if BTEST
WRITE " *REV CLM=",BCLAIM," STAT=",BRES
+46 IF BRES=0!(BRES=4)
Begin DoDot:2
+47 SET (BCNT,@REF@(BRES))=$GET(@REF@(BRES))+1
+48 SET @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM_U_BELIG_U_BDRUG
End DoDot:2
+49 ; Any notifications to IB?
End DoDot:1
+50 ; Send the bulletin
DO BULL(REF)
+51 KILL @REF
+52 QUIT
+53 ;
+54 ;Auto-Reverse Claims for Current Inpatients
+55 ;
+56 ;20050810;BEE;Phase III - CR11
+57 ;
REVINP(BNOW,BTRAN,BTRAN0,BTRAN1,BPHARM,BTRAN9) ;
+1 NEW BRX,BFIL,BCLAIM,BDATE,BDRUG,BELIG,BRES,DFN,VAIP
+2 ;
+3 ;Only process Window fills
+4 SET BRX=+$PIECE(BTRAN1,U,11)
IF BRX=0
QUIT 0
+5 SET BFIL=+$PIECE(BTRAN1,U)
+6 IF $$MWC^BPSRPT6(BRX,BFIL)'="W"
QUIT 0
+7 ;
+8 ;Check for Fill date - Must be equal to T-5
+9 SET BCLAIM=$PIECE(BTRAN0,U,4)
IF 'BCLAIM
QUIT 0
+10 SET BDATE=$$FILDATE(BRX,BFIL)
+11 SET BDATE=$PIECE(BDATE,".")
+12 IF 'BDATE=""
QUIT 0
+13 IF $$FMDIFF^XLFDT(BNOW,BDATE,1)'=5
QUIT 0
+14 ;
+15 ;Check for current Inpatient
+16 SET DFN=+$PIECE(BTRAN0,U,6)
IF DFN=0
QUIT 0
+17 DO IN5^VADPT
+18 IF $GET(VAIP(3))=""
QUIT 0
+19 ;
+20 SET BELIG=$PIECE(BTRAN9,U,4)
+21 SET BDRUG=$$RXAPI1^BPSUTIL1(BRX,6,"E")
+22 ;
+23 ;Auto-Reverse Claim
+24 SET BRES=$$REVERSE(BRX,BFIL,BCLAIM,2)
+25 if BTEST
WRITE " *REV CLM=",BCLAIM," STAT=",BRES
+26 IF BRES=0!(BRES=4)
Begin DoDot:1
+27 SET (BCNT,@REF@(BRES))=$GET(@REF@(BRES))+1
+28 SET @REF@(BRES,BCNT)=BTRAN_U_BCLAIM_U_BRX_U_BFIL_U_BPHARM_U_BELIG_U_BDRUG
End DoDot:1
+29 QUIT 1
+30 ;
RELDATE(BRX,BFIL) ;Get the Released Date
+1 IF BFIL
QUIT $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,17,"I")
+2 QUIT $$RXAPI1^BPSUTIL1(BRX,31,"I")
+3 ;
FILDATE(BRX,BFIL) ;Get the Fill Date
+1 IF BFIL
QUIT $$RXSUBF1^BPSUTIL1(BRX,52,52.1,+BFIL,.01,"I")
+2 QUIT $$RXAPI1^BPSUTIL1(BRX,22,"I")
+3 ;
REVERSE(BRX,BFIL,BCLAIM,BTYPE) ;Auto-Reverse the claim
+1 ;PUBLIC BTEST
+2 NEW BDOS,BRES,BDAT,BMES,BRSN,BPSCOB,BP59
+3 ; Test mode
IF $GET(BTEST)
QUIT 0
+4 ;
+5 ; Get Date of Service and set reversal reason
+6 SET BDOS=$$DOSDATE^BPSSCRRS(BRX,BFIL)
+7 SET BRSN=$SELECT(BTYPE=2:"CURRENT INPATIENT",1:"PRESCRIPTION NOT RELEASED")
+8 ;
+9 ;get the BPS TRANSACTION IEN for the claim
SET BP59=$$CLAIM59^BPSUTIL2(BCLAIM)
+10 ;get COB for the BPS TRANSACTION IEN
SET BPSCOB=$$COB59^BPSUTIL2(BP59)
+11 ;
+12 ; Call ECME to process reversal
+13 SET BRES=$$EN^BPSNCPDP(BRX,BFIL,BDOS,"AREV","",BRSN,"",,,,BPSCOB)
+14 ;
+15 ; If successful, log message to the Prescription Activity Log
+16 ; and set the auto-reversal flag
+17 SET BRES=+BRES
SET BMES="ECME: AUTO REVERSAL JOB-"_$SELECT(BPSCOB=1:"p",BPSCOB=2:"s",1:"")_$$INSNAME^BPSSCRU6(BP59)
+18 IF BRES=0
Begin DoDot:1
+19 DO ECMEACT^PSOBPSU1(BRX,BFIL,BMES,.5)
+20 SET BDAT(9002313.02,BCLAIM_",",.07)=BTYPE
DO FILE^DIE("","BDAT")
End DoDot:1
+21 QUIT BRES
+22 ;
+23 ;
BULL(REF) ;Bulletin to the OPECC
+1 ;PUBLIC BTEST,DUZ,DT
+2 NEW XMSUB,XMY,XMTEXT,XMDUZ,BLNUM
+3 ;
+4 IF BCNT<1
IF '$GET(BTEST)
IF (+$GET(@REF@(4)))=0
QUIT
+5 SET BLNUM=0
SET BCNT=+$GET(@REF@(0))
+6 SET XMSUB="ECME AUTO-REVERSAL PROCESS"
+7 IF $GET(BTEST)
DO T("*** P L E A S E D I S R E G A R D T H I S E M A I L ***")
DO T()
DO T("NOT ACTUALLY REVERSED - THIS IS A TEST")
DO T()
+8 DO T("The ECME Nightly Process submitted auto-reversals for the following e-Pharmacy")
+9 DO T("prescriptions.")
+10 DO T()
+11 DO T("TOTAL CLAIMS SUBMITTED FOR AUTO-REVERSALS: "_BCNT)
+12 DO T()
+13 DO T("Claims Submitted for Auto-Reversals on "_$$DAT(DT)_":")
DO ARLIST(0,REF)
+14 DO T()
+15 SET BCNT=+$GET(@REF@(4))
+16 IF BCNT'=0
Begin DoDot:1
+17 DO T()
+18 DO T("The ECME Nightly Process attempted to auto-reverse the following claims but")
+19 DO T("could not because the previous request was IN PROGRESS. Please verify that")
+20 DO T("the previous request is not stranded.")
+21 DO T()
+22 DO T("Total number of claims that could not be auto-reversed: "_BCNT)
+23 DO T()
+24 DO T("Claims not auto-reversed on "_$$DAT(DT)_":")
+25 DO ARLIST(4,REF)
+26 DO T()
End DoDot:1
+27 ;
+28 SET XMDUZ="BPS PACKAGE"
SET XMTEXT="BTX("
+29 SET XMY("G.BPS OPECC")=""
+30 IF $GET(DUZ)'<1
SET XMY(DUZ)=""
+31 DO ^XMD
+32 QUIT
+33 ;
T(BTXT) ; Add text to the message
+1 ;PUBLIC BLNUM,BTEST
+2 SET BLNUM=BLNUM+1
SET BTX(BLNUM)=$GET(BTXT," ")
+3 IF $GET(BTEST)
WRITE !,$GET(BTXT)
+4 QUIT
+5 ;
ARLIST(BRES,REF) ;Auto-Rev List
+1 NEW I,TXT,BCLAIM,BTRAN,Y,BRX,BFIL,BFDATE,BPHARM,BRXN,BPHARMN,BPAT,BPSTAT,BELIG,BDRUG
+2 DO T()
+3 DO T(" # RX/FILL STATUS DATE ELIG PATIENT BPS PHARM DRUG NAME")
+4 DO T("------------------------------------------------------------------------------")
+5 SET I=0
FOR
SET I=$ORDER(@REF@(BRES,I))
if 'I
QUIT
Begin DoDot:1
+6 SET Y=@REF@(BRES,I)
+7 SET BTRAN=$PIECE(Y,U)
+8 SET BCLAIM=$PIECE(Y,U,2)
+9 SET BRX=$PIECE(Y,U,3)
SET BRXN=$$RXAPI1^BPSUTIL1(BRX,.01,"I")
+10 SET BPAT=$PIECE($GET(^DPT(+$$RXAPI1^BPSUTIL1(BRX,2,"I"),0)),U)
+11 SET BFIL=$PIECE(Y,U,4)
+12 SET BPHARM=$PIECE(Y,U,5)
SET BPHARMN=$PIECE($GET(^BPS(9002313.56,BPHARM,0)),U)
+13 SET BELIG=$PIECE(Y,U,6)
+14 SET BDRUG=$PIECE(Y,U,7)
+15 SET BFDATE=$$FILDATE(BRX,BFIL)
+16 SET BPSTAT=$$MWC^BPSRPT6(BRX,BFIL)_"/"_$SELECT($$RELDATE(BRX,BFIL)]"":"RL",1:"NR")
+17 SET TXT=$JUSTIFY(I,3)_" "_$$J((BRXN_"/"_BFIL),13)_" "_$JUSTIFY(BPSTAT,4)_" "_$$J($$DAT(BFDATE),10)
+18 SET TXT=TXT_$JUSTIFY(BELIG,1)_" "_$$J($EXTRACT(BPAT,1,18),18)_" "_$JUSTIFY($EXTRACT(BPHARMN,1,3),3)
+19 SET TXT=TXT_" "_$$J($EXTRACT(BDRUG,1,18),18)
+20 DO T(TXT)
End DoDot:1
+21 DO T("------------------------------------------------------------------------------")
+22 QUIT
+23 ;
J(TXT,LEN) ;Left justify
+1 QUIT TXT_$JUSTIFY("",LEN-$LENGTH(TXT))
+2 ;
DAT(X,Y) ; Convert FM date to displayable (mm/dd/yy) format.
+1 ; -- optional output of time, if $g(y)
+2 NEW DATE,T
+3 SET DATE=$SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+4 IF $GET(Y)
SET T="."_$EXTRACT($PIECE(X,".",2)_"000000",1,7)
IF T>0
SET DATE=DATE_" "_$SELECT($EXTRACT(T,2,3)>12:$EXTRACT(T,2,3)-12,$EXTRACT(T,2,3)="00":"00",1:+$EXTRACT(T,2,3))_":"_$EXTRACT(T,4,5)_$SELECT($EXTRACT(T,2,5)>1200:" pm",1:" am")
+5 QUIT DATE
