BPSRPT1 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,19,20,23,24,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to COLLECT^IBNCPEV3 supported by ICR 6131
;
Q
;
; ECME Report Compile Routine - Looping/Filtering Routine
;
; Input Variables:
; BPRTYPE - Type of Report (1-10)
; BPGLTMP - Temporary storage global
; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array
; of internal pointers of selected pharmacies
; BPSUMDET - (1) Summary or (0) Detail format
; BPINSINF - Set to 0 for all insurances or list of file 36 IENs
; BPMWC - A-ALL,M-Mail,W-Window,C-CMOP Prescriptions
; BPRTBCK - 1-ALL,2-RealTime,3-Backbill Claim Submission,4-PRO Option,5-Resubmission
; BPRLNRL - 1-ALL,2-RELEASED,3-NOT RELEASED
; BPDUP - 0-ALL,S-Duplicate of Approved,D-Duplicate of Paid,Q-Duplicate of Capture
; BPDRUG - DRUG to report on (ptr to #50)
; BPDRGCL - DRUG CLASS to report on (0 for ALL)
; BPBEGDT - Beginning Date
; BPENDDT - Ending Date
; BPCCRSN - Set to 0 for all closed claim reasons or ptr to #356.8
; BPAUTREV - 0-ALL,1-Auto Reversed
; BPACREJ - 0-ALL,1-REJECTED,2-ACCEPTED
; BPNBSTS - Non-Billable Status
; BPELIG1/BPELIG1(x) - Array of multiple eligibilities
; BPALRC - A-All or R:Most recent
;
COLLECT(BPGLTMP) N BP02,BP57,BP59,BPENDDT1,BPLDT02,BPLDT57,X,Y,OK,BPIX
;
;Check Variables
S OK=1
S:'$G(BPBEGDT) BPBEGDT=0
S:'$G(BPENDDT) BPENDDT=9999999
S BPENDDT=BPENDDT+0.9
I $G(BPRTYPE)=""!($G(BPGLTMP)="")!($G(BPPHARM)="")!($G(BPSUMDET)="")!($G(BPINSINF)="")!($G(BPMWC)="")!($G(BPRTBCK)="") S OK=-1 G EXIT
;
; For the Non-Billable Status report, we need to loop through the IB NCPDP EVENT LOG instead
; of BPS Claim/BPS Transaction data
I BPRTYPE=9 Q $$COLLECT^IBNCPEV3(BPBEGDT,BPENDDT,BPMWC,BPRLNRL,BPDRUG,BPDRGCL,BPALRC,.BPPHARM,.BPINSINF,.BPNBSTS,.BPELIG1,BPGLTMP,BPPAT,BPBILL,$G(BPMIN),$G(BPMAX))
;
;Loop through BPS CLAIMS
;
;First look for fill/refill cross reference
;Loop through Date of Service Index in BPS CLAIMS file and find link to
;claim in BPS TRANSACTION. Process earliest Date of Service entry found in
;BPS TRANSACTION
;
;Choose Index to Loop through (different for Closed Claims)
S BPIX="AF" S:BPRTYPE=7 BPIX="AG"
;
S BPLDT02=$S(BPIX="AF":$$FM2YMD(BPBEGDT-0.00001),1:BPBEGDT) S:BPLDT02="" BPLDT02=0
S BPENDDT1=$S(BPIX="AF":$$FM2YMD(BPENDDT),1:BPENDDT_".9999999999") S:BPENDDT1="" BPENDDT1=99999999
F S BPLDT02=+$O(^BPSC(BPIX,BPLDT02)) Q:BPLDT02=0!(BPLDT02>BPENDDT1) D
. S BP02=0 F S BP02=$O(^BPSC(BPIX,BPLDT02,BP02)) Q:+BP02=0 D
. . S BP59=+$O(^BPST("AE",BP02,0))
. . Q:BP59=0
. . I $D(@BPGLTMP@("FILE59",BP59)) Q
. . S @BPGLTMP@("FILE59",BP59)=BPLDT02_"^02"
. . D PROCESS(BP59)
;
;#9002313.59 has only one entry per claim with, which has a date
; of the latest update for the claim
;#9002313.57 has more than one entries per claim and keep all
; changes made the claim
;so we have to go thru #9002313.57 to find the earliest date
;related to the claim to check it against BPBEGDT
S BPLDT57=BPBEGDT-0.00001
F S BPLDT57=+$O(^BPSTL("AH",BPLDT57)) Q:BPLDT57=0!(BPLDT57>BPENDDT) D
. S BP57=0 F S BP57=$O(^BPSTL("AH",BPLDT57,BP57)) Q:+BP57=0 D
. . S BP59=+$G(^BPSTL(BP57,0))
. . I $D(@BPGLTMP@("FILE59",BP59)) Q
. . S @BPGLTMP@("FILE59",BP59)=BPLDT57_"^57"
. . D PROCESS(BP59)
;
;Remove Portion of Scratch Global
EXIT K @BPGLTMP@("FILE59")
Q OK
;
;Convert FB date to YYYYMMDD
FM2YMD(BPFMDT) N Y,Y1
S Y=$E(BPFMDT,2,3),Y1=$E(BPFMDT,1,1) S Y=$S(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
Q:Y Y_$E(BPFMDT,4,7)
Q ""
;
;Process each Entry
;
PROCESS(BP59) ;
N BPBILLED,BPBCK,BPBCKXBPDFN,BPREF,BPPAYBL,BPPLAN,BPREJ,BPRLSDT,BPRX,BPRXDC,BPRXDRG,BPSTATUS,BPSEQ,BPSTOP
N BPDUPREC,BPDUPST,BPDUPPAY,BPSPOS,BPSRESP
;
S BPSEQ=$$COB59^BPSUTIL2(BP59)
;
;Get ABSBRXI - ptr to #52
S BPRX=+$P($G(^BPST(BP59,1)),U,11)
;
;Get ABSBRXR - Prescription Number IEN
S BPREF=+$P($G(^BPST(BP59,1)),U)
;
;Get PATIENT - ptr to #2
S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
;
; Skip eligibility verification transactions
I $P($G(^BPST(BP59,0)),U,15)="E" G XPROC
;
;Check for correct BPS Pharmacy (DIVISION)
I $G(BPPHARM)=1,$$CHKPHRM(BP59)=0 G XPROC
;
;Check for Display 1-ALL,2-RELEASED,3-NOT RELEASED
S BPRLSDT=$$RELEASED(BPRX,BPREF)
I BPRLNRL'=1 I ((BPRLNRL=2)&(BPRLSDT=0))!((BPRLNRL=3)&(BPRLSDT)) G XPROC
;
;Get Status
S BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,BPSEQ)
;
;if REVERSAL
I BPRTYPE=4,BPSTATUS'["REVERSAL" G XPROC ; exclude non-reversed
I BPRTYPE=4,$$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))=1 G XPROC ; exclude closed claims for Reversal Report
;
;if PAYABLE
S BPPAYBL=BPSTATUS["PAYABLE"
I BPRTYPE=1,'BPPAYBL G XPROC ; exclude non-payable
I BPRTYPE=1,BPSTATUS["REVERSAL" G XPROC ; reversed
;
;if REJECTED
S BPREJ=BPSTATUS["REJECTED"
I BPRTYPE=2,BPSTATUS["REVERSAL" G XPROC ; exclude rejected reversals
I BPRTYPE=2,'BPREJ G XPROC ; exclude non-rejected
;
;if SUBMITTED NOT RELEASED exclude released ones
I BPRTYPE=3,BPRLSDT'=0 G XPROC
I BPRTYPE=3,'BPPAYBL G XPROC ; exclude non-payable
;
;Auto Reverse Check
I BPRTYPE=4,BPAUTREV,'$$AUTOREV(BP59) G XPROC
;
;if CLOSED
I BPRTYPE=7,'$$CLSCLM(BP59) G XPROC ;exclude open claims
;I BPRTYPE=7,BPSTATUS'["REJECTED" G XPROC ;exclude non-rejected closed claims
;
;if Spending Account Report, check Pricing Segment for data
I BPRTYPE=8,'$$PRICING^BPSRPT5(BP59) G XPROC
;
;if Recent Transactions, exclude closed claims
I BPRTYPE=5,$$CLSCLM(BP59) G XPROC
;
;If Totals by Date, include only rejects and payables
I BPRTYPE=6,BPSTATUS'["REJECTED",BPSTATUS'["PAYABLE" G XPROC ; Reversed
;
DUP ;If Duplicate Claims Report check TRANSACTION RESPONSE STATUS in file #9002313.0301
; if the Claim has a Duplicate Status, get the Patient Payment Amount
I BPRTYPE=10 D I 'BPDUPREC G XPROC
. S BPDUPREC=0
. D RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
. I (BPSRESP="")!(BPSPOS="") Q
. S BPDUPST=$$GET1^DIQ(9002313.0301,BPSPOS_","_BPSRESP_",",112,"I")
. I BPDUPST="" Q
. I BPDUP=0 I "(,S,D,Q,)"[BPDUPST S BPDUPREC=1
. I BPDUP'=0 I BPDUP[BPDUPST S BPDUPREC=1
. I BPDUPREC S BPDUPPAY=$$GETPPAY^BPSRPT2(BPSRESP,BPSPOS)
;
;Realtime/Backbill/PRO Option/Resubmission Check
S BPBCK=$$RTBCK(BP59)
;
; BPBCK = 1 Backbill / 2 PRO / 5 Resub / 0 Realtime
; BPRTBCK = 3 Backbill / 4 PRO / 5 Resub / 2 Realtime
;
S BPBCKX=$S(BPBCK=1:3,BPBCK=2:4,BPBCK=5:5,BPBCK=0:2,1:"") ;convert to BPRTBCK value
;
; If user doesn't want all transmission types (BPRTBCK'=1),
; then figure out if this transaction is OK
I BPRTBCK'=1,BPRTBCK'[BPBCKX G XPROC
;
;Check for MAIL/WINDOW/CMOP/ALL
I BPMWC'="A",BPMWC'[$$MWC^BPSRPT6(BPRX,BPREF) G XPROC
;
;Check for selected insurance
S BPPLAN=$$INSNAM^BPSRPT6(BP59)
I BPINSINF'=0,'$$CHKINS^BPSSCRCU($P(BPPLAN,U,1),BPINSINF) G XPROC
S BPPLAN=$P(BPPLAN,U,2)
;
;Check for selected drug
S BPRXDRG=$$GETDRUG^BPSRPT6(BPRX)
I BPRXDRG=0 G XPROC
I BPDRUG D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPDRUG,",") I BPRXDRG=$P(BPDRUG,",",I) S BPSTOP=1 Q
;
;Check for selected drug classes
I BPDRGCL'=0 S BPRXDC=$$DRGCLNAM^BPSRPT6($$GETDRGCL^BPSRPT6(BPRXDRG),99) D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPDRGCL,";") I BPRXDC=$P(BPDRGCL,";",I) S BPSTOP=1 Q
;
;Check for selected Close Reason
I BPCCRSN D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPCCRSN,",") I $P(BPCCRSN,",",I)=$P($$CLRSN^BPSRPT7(BP59),U) S BPSTOP=1 Q
;
;Check for Accepted/Rejected
I BPACREJ=1,BPSTATUS'["REJECTED" G XPROC
I BPACREJ=2,BPSTATUS'["ACCEPTED" G XPROC
;
;Check for Specific Reject Code
I BPREJCD'=0 D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPREJCD,",") I $$CKREJ(BP59,$P(BPREJCD,",",I)) S BPSTOP=1 Q
;
;;Check for Eligibility Code
;;I BPELIG'=0,BPELIG'=$$ELIGCODE^BPSSCR05(BP59) G XPROC
;
;Check for Eligibility Codes, when one or more is selected (BPELIG1=1)
I (",1,2,3,4,7,9,10,")[(","_BPRTYPE_","),BPELIG1'=0 S ELIG=$$ELIGCODE^BPSSCR05(BP59) G:$G(ELIG)="" XPROC I '$D(BPELIG1(ELIG)) G XPROC
;
;Check for selected Prescribers
I BPRESC'=0 D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPRESC,",") I $$CKPRESC(BP59,$P(BPRESC,",",I)) S BPSTOP=1 Q
;
;Check for selected Patients
I BPQSTPAT'=0,$G(BPPAT)'="" D I BPSTOP=0 G XPROC
. S BPSTOP=0
. F I=1:1:$L(BPPAT,",") I $P(BPPAT,",",I)=$$GET1^DIQ(9002313.59,BP59,5,"I") S BPSTOP=1 Q
;
; Check for Billed Amount
I $G(BPBILL)'=0 S BPBILLED=$$GET1^DIQ(9002313.59,BP59,505) I (BPBILLED<BPMIN)!(BPBILLED>BPMAX) G XPROC
;
;Check Open/Closed claim
I BPOPCL'=0,((BPOPCL=2)&($$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))=1))!((BPOPCL=1)&($$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))'=1)) G XPROC
;
;Save Entry for Report
D SETTMP^BPSRPT2(BPGLTMP,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,.BPPHARM,BPSUMDET,BPPLAN,BPRLSDT,BPPAYBL,BPREJ,BPRXDRG,$P(BPSTATUS,U),$G(BPDUPST),$G(BPDUPPAY))
;
XPROC Q
;
;Check if selected BPS PHARMACY
;
; Defined Variable: BPPHARM(ptr) - List of BPS Pharmacies to Report on
; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
;
; Returned Value -> 0 = Entry not in list of selected pharmacies
; 1 = Entry is in list of selected pharmacies
CHKPHRM(BP59) N PHARM
S PHARM=+$P($G(^BPST(BP59,1)),"^",7)
S PHARM=$S($D(BPPHARM(PHARM)):1,1:0)
Q PHARM
;
;Determine whether claim is Released or Not Released
;
; Input Variables: BPRX - ptr to PRESCRIPTION (#52)
; BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
;
; Return Value -> 0 = Not Released
; released date = Released
;
RELEASED(BPRX,BPREF) N RDT
;
I BPREF=0 S RDT=$$RXRELDT^BPSRPT6(BPRX)\1
I BPREF'=0 S RDT=$$REFRELDT^BPSRPT6(BPRX,BPREF)\1
Q RDT
;
;Determine if claim was Auto Reversed
;
; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
; Return Value -> 1 = Auto Reversed
; 0 = Not Auto Reversed
;
AUTOREV(BP59) N AR,BP02
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S AR=+$P($G(^BPSC(BP02,0)),U,7)
Q AR
;
;Determine if claim was closed
;
; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
; Return Value -> 1 = Closed
; 0 = Not Closed
;
CLSCLM(BP59) N BP02,CL
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S CL=+$G(^BPSC(BP02,900))
Q CL
;
;Determine whether claim is Realtime or Backbilled or PRO Option or Resubmission
;
; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
; Return Value -> 5 = Resubmission
; 2 = PRO Option
; 1 = Backbilled
; 0 = Realtime
RTBCK(BP59) N BB
S BB=$P($G(^BPST(BP59,12)),U,1)
S BB=$S(BB="BB":1,BB="P2":2,BB="P2S":2,BB="ERES":5,BB="ERWV":5,BB="ERNB":5,1:0)
Q BB
;
;Determine if the Prescriber for claim was one of the Prescribers selected
;
; Input Variables: BPS59 - Lookup to BPS TRANSACTION (#59)
; BPSRESC - string of Prescribers selected separated by a comma
;
; Return Value -> 1 = Prescriber is on the list of selected Prescribers
; 0 = RX and/or Prescriber not found, or the Prescriber for this
; transaction isn't one of the selected Prescribers
;
CKPRESC(BPS59,BPSPRESC) ;
;
N BPSFND,BPSRX,BPSRXPRSC
;
S BPSFND=0 ; Initialize to zero.
;
; get the prescription number ien from the BPS TRANSACTION file
S BPSRX=$$GET1^DIQ(9002313.59,BPS59,1.11,"I")
;
; if the prescription number didn't exist
I BPSRX="" G CKPRESCX
;
; get the prescriber ien from the PRESCRIPTION file
S BPSRXPRSC=$$GET1^DIQ(52,BPSRX,4,"I")
;
; if the prescriber didn't exist BPRESC
I BPSRXPRSC="" G CKPRESCX
;
; The Prescriber for this transaction is one of the Prescribers selected
I BPSPRESC[BPSRXPRSC S BPSFND=1
;
CKPRESCX ;
Q BPSFND
;
;Screen Pause 1
;
; Return variable - BPQ = 0 Continue
; 2 Quit
PAUSE N X
U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2
U IO
Q
;
;Screen Pause 2
;
; Return variable - BPQ = 0 Continue
; 2 Quit
PAUSE2 N X
U IO(0) W !!,"Press RETURN to continue:"
R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2
U IO
Q
;
;Get ECME#
;
;BP59 - ptr to 9002313.59
;output :
;ECME number from 9002313.02
; 7 or 12 digits of the prescription IEN file 52
; or 12 spaces
Q $$ECMENUM^BPSSCRU2(BP59)
;
;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format
;
DATTIM(X) N DATE,BPT,BPM,BPH,BPAP
S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
S BPAP="AM" I BPH>12 S BPH=BPH-12,BPAP="PM" S:$L(BPH)<2 BPH="0"_BPH
I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
Q $G(DATE)
;
;Display RT-Realtime,BB-Backbill,P2-PRO Option, RS-Resubmission or " "
;
RTBCKNAM(BPINDEX) Q $S(BPINDEX=0:"RT",BPINDEX=1:"BB",BPINDEX=2:"P2",BPINDEX=5:"RS",1:" ")
;
;See for Specific Reject Code
;
CKREJ(BP59,BPREJCD) N FREJ,I,REJ,X
S FREJ=0
S X=$$REJTEXT^BPSRPT2(BP59,.REJ)
S X="" F S X=$O(REJ(X)) Q:X="" D Q:FREJ=1
.S REJ=$P($G(REJ(X)),":") Q:REJ=""
.S I="" F S I=$O(^BPSF(9002313.93,"B",REJ,I)) Q:I="" I I=BPREJCD S FREJ=1
Q FREJ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT1 13865 printed Mar 13, 2025@20:57:20 Page 2
BPSRPT1 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,19,20,23,24,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to COLLECT^IBNCPEV3 supported by ICR 6131
+5 ;
+6 QUIT
+7 ;
+8 ; ECME Report Compile Routine - Looping/Filtering Routine
+9 ;
+10 ; Input Variables:
+11 ; BPRTYPE - Type of Report (1-10)
+12 ; BPGLTMP - Temporary storage global
+13 ; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array
+14 ; of internal pointers of selected pharmacies
+15 ; BPSUMDET - (1) Summary or (0) Detail format
+16 ; BPINSINF - Set to 0 for all insurances or list of file 36 IENs
+17 ; BPMWC - A-ALL,M-Mail,W-Window,C-CMOP Prescriptions
+18 ; BPRTBCK - 1-ALL,2-RealTime,3-Backbill Claim Submission,4-PRO Option,5-Resubmission
+19 ; BPRLNRL - 1-ALL,2-RELEASED,3-NOT RELEASED
+20 ; BPDUP - 0-ALL,S-Duplicate of Approved,D-Duplicate of Paid,Q-Duplicate of Capture
+21 ; BPDRUG - DRUG to report on (ptr to #50)
+22 ; BPDRGCL - DRUG CLASS to report on (0 for ALL)
+23 ; BPBEGDT - Beginning Date
+24 ; BPENDDT - Ending Date
+25 ; BPCCRSN - Set to 0 for all closed claim reasons or ptr to #356.8
+26 ; BPAUTREV - 0-ALL,1-Auto Reversed
+27 ; BPACREJ - 0-ALL,1-REJECTED,2-ACCEPTED
+28 ; BPNBSTS - Non-Billable Status
+29 ; BPELIG1/BPELIG1(x) - Array of multiple eligibilities
+30 ; BPALRC - A-All or R:Most recent
+31 ;
COLLECT(BPGLTMP) NEW BP02,BP57,BP59,BPENDDT1,BPLDT02,BPLDT57,X,Y,OK,BPIX
+1 ;
+2 ;Check Variables
+3 SET OK=1
+4 if '$GET(BPBEGDT)
SET BPBEGDT=0
+5 if '$GET(BPENDDT)
SET BPENDDT=9999999
+6 SET BPENDDT=BPENDDT+0.9
+7 IF $GET(BPRTYPE)=""!($GET(BPGLTMP)="")!($GET(BPPHARM)="")!($GET(BPSUMDET)="")!($GET(BPINSINF)="")!($GET(BPMWC)="")!($GET(BPRTBCK)="")
SET OK=-1
GOTO EXIT
+8 ;
+9 ; For the Non-Billable Status report, we need to loop through the IB NCPDP EVENT LOG instead
+10 ; of BPS Claim/BPS Transaction data
+11 IF BPRTYPE=9
QUIT $$COLLECT^IBNCPEV3(BPBEGDT,BPENDDT,BPMWC,BPRLNRL,BPDRUG,BPDRGCL,BPALRC,.BPPHARM,.BPINSINF,.BPNBSTS,.BPELIG1,BPGLTMP,BPPAT,BPBILL,$GET(BPMIN),$GET(BPMAX))
+12 ;
+13 ;Loop through BPS CLAIMS
+14 ;
+15 ;First look for fill/refill cross reference
+16 ;Loop through Date of Service Index in BPS CLAIMS file and find link to
+17 ;claim in BPS TRANSACTION. Process earliest Date of Service entry found in
+18 ;BPS TRANSACTION
+19 ;
+20 ;Choose Index to Loop through (different for Closed Claims)
+21 SET BPIX="AF"
if BPRTYPE=7
SET BPIX="AG"
+22 ;
+23 SET BPLDT02=$SELECT(BPIX="AF":$$FM2YMD(BPBEGDT-0.00001),1:BPBEGDT)
if BPLDT02=""
SET BPLDT02=0
+24 SET BPENDDT1=$SELECT(BPIX="AF":$$FM2YMD(BPENDDT),1:BPENDDT_".9999999999")
if BPENDDT1=""
SET BPENDDT1=99999999
+25 FOR
SET BPLDT02=+$ORDER(^BPSC(BPIX,BPLDT02))
if BPLDT02=0!(BPLDT02>BPENDDT1)
QUIT
Begin DoDot:1
+26 SET BP02=0
FOR
SET BP02=$ORDER(^BPSC(BPIX,BPLDT02,BP02))
if +BP02=0
QUIT
Begin DoDot:2
+27 SET BP59=+$ORDER(^BPST("AE",BP02,0))
+28 if BP59=0
QUIT
+29 IF $DATA(@BPGLTMP@("FILE59",BP59))
QUIT
+30 SET @BPGLTMP@("FILE59",BP59)=BPLDT02_"^02"
+31 DO PROCESS(BP59)
End DoDot:2
End DoDot:1
+32 ;
+33 ;#9002313.59 has only one entry per claim with, which has a date
+34 ; of the latest update for the claim
+35 ;#9002313.57 has more than one entries per claim and keep all
+36 ; changes made the claim
+37 ;so we have to go thru #9002313.57 to find the earliest date
+38 ;related to the claim to check it against BPBEGDT
+39 SET BPLDT57=BPBEGDT-0.00001
+40 FOR
SET BPLDT57=+$ORDER(^BPSTL("AH",BPLDT57))
if BPLDT57=0!(BPLDT57>BPENDDT)
QUIT
Begin DoDot:1
+41 SET BP57=0
FOR
SET BP57=$ORDER(^BPSTL("AH",BPLDT57,BP57))
if +BP57=0
QUIT
Begin DoDot:2
+42 SET BP59=+$GET(^BPSTL(BP57,0))
+43 IF $DATA(@BPGLTMP@("FILE59",BP59))
QUIT
+44 SET @BPGLTMP@("FILE59",BP59)=BPLDT57_"^57"
+45 DO PROCESS(BP59)
End DoDot:2
End DoDot:1
+46 ;
+47 ;Remove Portion of Scratch Global
EXIT KILL @BPGLTMP@("FILE59")
+1 QUIT OK
+2 ;
+3 ;Convert FB date to YYYYMMDD
FM2YMD(BPFMDT) NEW Y,Y1
+1 SET Y=$EXTRACT(BPFMDT,2,3)
SET Y1=$EXTRACT(BPFMDT,1,1)
SET Y=$SELECT(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
+2 if Y
QUIT Y_$EXTRACT(BPFMDT,4,7)
+3 QUIT ""
+4 ;
+5 ;Process each Entry
+6 ;
PROCESS(BP59) ;
+1 NEW BPBILLED,BPBCK,BPBCKXBPDFN,BPREF,BPPAYBL,BPPLAN,BPREJ,BPRLSDT,BPRX,BPRXDC,BPRXDRG,BPSTATUS,BPSEQ,BPSTOP
+2 NEW BPDUPREC,BPDUPST,BPDUPPAY,BPSPOS,BPSRESP
+3 ;
+4 SET BPSEQ=$$COB59^BPSUTIL2(BP59)
+5 ;
+6 ;Get ABSBRXI - ptr to #52
+7 SET BPRX=+$PIECE($GET(^BPST(BP59,1)),U,11)
+8 ;
+9 ;Get ABSBRXR - Prescription Number IEN
+10 SET BPREF=+$PIECE($GET(^BPST(BP59,1)),U)
+11 ;
+12 ;Get PATIENT - ptr to #2
+13 SET BPDFN=+$PIECE($GET(^BPST(BP59,0)),U,6)
+14 ;
+15 ; Skip eligibility verification transactions
+16 IF $PIECE($GET(^BPST(BP59,0)),U,15)="E"
GOTO XPROC
+17 ;
+18 ;Check for correct BPS Pharmacy (DIVISION)
+19 IF $GET(BPPHARM)=1
IF $$CHKPHRM(BP59)=0
GOTO XPROC
+20 ;
+21 ;Check for Display 1-ALL,2-RELEASED,3-NOT RELEASED
+22 SET BPRLSDT=$$RELEASED(BPRX,BPREF)
+23 IF BPRLNRL'=1
IF ((BPRLNRL=2)&(BPRLSDT=0))!((BPRLNRL=3)&(BPRLSDT))
GOTO XPROC
+24 ;
+25 ;Get Status
+26 SET BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,BPSEQ)
+27 ;
+28 ;if REVERSAL
+29 ; exclude non-reversed
IF BPRTYPE=4
IF BPSTATUS'["REVERSAL"
GOTO XPROC
+30 ; exclude closed claims for Reversal Report
IF BPRTYPE=4
IF $$CLOSED02^BPSSCR03($PIECE(^BPST(BP59,0),U,4))=1
GOTO XPROC
+31 ;
+32 ;if PAYABLE
+33 SET BPPAYBL=BPSTATUS["PAYABLE"
+34 ; exclude non-payable
IF BPRTYPE=1
IF 'BPPAYBL
GOTO XPROC
+35 ; reversed
IF BPRTYPE=1
IF BPSTATUS["REVERSAL"
GOTO XPROC
+36 ;
+37 ;if REJECTED
+38 SET BPREJ=BPSTATUS["REJECTED"
+39 ; exclude rejected reversals
IF BPRTYPE=2
IF BPSTATUS["REVERSAL"
GOTO XPROC
+40 ; exclude non-rejected
IF BPRTYPE=2
IF 'BPREJ
GOTO XPROC
+41 ;
+42 ;if SUBMITTED NOT RELEASED exclude released ones
+43 IF BPRTYPE=3
IF BPRLSDT'=0
GOTO XPROC
+44 ; exclude non-payable
IF BPRTYPE=3
IF 'BPPAYBL
GOTO XPROC
+45 ;
+46 ;Auto Reverse Check
+47 IF BPRTYPE=4
IF BPAUTREV
IF '$$AUTOREV(BP59)
GOTO XPROC
+48 ;
+49 ;if CLOSED
+50 ;exclude open claims
IF BPRTYPE=7
IF '$$CLSCLM(BP59)
GOTO XPROC
+51 ;I BPRTYPE=7,BPSTATUS'["REJECTED" G XPROC ;exclude non-rejected closed claims
+52 ;
+53 ;if Spending Account Report, check Pricing Segment for data
+54 IF BPRTYPE=8
IF '$$PRICING^BPSRPT5(BP59)
GOTO XPROC
+55 ;
+56 ;if Recent Transactions, exclude closed claims
+57 IF BPRTYPE=5
IF $$CLSCLM(BP59)
GOTO XPROC
+58 ;
+59 ;If Totals by Date, include only rejects and payables
+60 ; Reversed
IF BPRTYPE=6
IF BPSTATUS'["REJECTED"
IF BPSTATUS'["PAYABLE"
GOTO XPROC
+61 ;
DUP ;If Duplicate Claims Report check TRANSACTION RESPONSE STATUS in file #9002313.0301
+1 ; if the Claim has a Duplicate Status, get the Patient Payment Amount
+2 IF BPRTYPE=10
Begin DoDot:1
+3 SET BPDUPREC=0
+4 DO RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
+5 IF (BPSRESP="")!(BPSPOS="")
QUIT
+6 SET BPDUPST=$$GET1^DIQ(9002313.0301,BPSPOS_","_BPSRESP_",",112,"I")
+7 IF BPDUPST=""
QUIT
+8 IF BPDUP=0
IF "(,S,D,Q,)"[BPDUPST
SET BPDUPREC=1
+9 IF BPDUP'=0
IF BPDUP[BPDUPST
SET BPDUPREC=1
+10 IF BPDUPREC
SET BPDUPPAY=$$GETPPAY^BPSRPT2(BPSRESP,BPSPOS)
End DoDot:1
IF 'BPDUPREC
GOTO XPROC
+11 ;
+12 ;Realtime/Backbill/PRO Option/Resubmission Check
+13 SET BPBCK=$$RTBCK(BP59)
+14 ;
+15 ; BPBCK = 1 Backbill / 2 PRO / 5 Resub / 0 Realtime
+16 ; BPRTBCK = 3 Backbill / 4 PRO / 5 Resub / 2 Realtime
+17 ;
+18 ;convert to BPRTBCK value
SET BPBCKX=$SELECT(BPBCK=1:3,BPBCK=2:4,BPBCK=5:5,BPBCK=0:2,1:"")
+19 ;
+20 ; If user doesn't want all transmission types (BPRTBCK'=1),
+21 ; then figure out if this transaction is OK
+22 IF BPRTBCK'=1
IF BPRTBCK'[BPBCKX
GOTO XPROC
+23 ;
+24 ;Check for MAIL/WINDOW/CMOP/ALL
+25 IF BPMWC'="A"
IF BPMWC'[$$MWC^BPSRPT6(BPRX,BPREF)
GOTO XPROC
+26 ;
+27 ;Check for selected insurance
+28 SET BPPLAN=$$INSNAM^BPSRPT6(BP59)
+29 IF BPINSINF'=0
IF '$$CHKINS^BPSSCRCU($PIECE(BPPLAN,U,1),BPINSINF)
GOTO XPROC
+30 SET BPPLAN=$PIECE(BPPLAN,U,2)
+31 ;
+32 ;Check for selected drug
+33 SET BPRXDRG=$$GETDRUG^BPSRPT6(BPRX)
+34 IF BPRXDRG=0
GOTO XPROC
+35 IF BPDRUG
Begin DoDot:1
+36 SET BPSTOP=0
+37 FOR I=1:1:$LENGTH(BPDRUG,",")
IF BPRXDRG=$PIECE(BPDRUG,",",I)
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+38 ;
+39 ;Check for selected drug classes
+40 IF BPDRGCL'=0
SET BPRXDC=$$DRGCLNAM^BPSRPT6($$GETDRGCL^BPSRPT6(BPRXDRG),99)
Begin DoDot:1
+41 SET BPSTOP=0
+42 FOR I=1:1:$LENGTH(BPDRGCL,";")
IF BPRXDC=$PIECE(BPDRGCL,";",I)
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+43 ;
+44 ;Check for selected Close Reason
+45 IF BPCCRSN
Begin DoDot:1
+46 SET BPSTOP=0
+47 FOR I=1:1:$LENGTH(BPCCRSN,",")
IF $PIECE(BPCCRSN,",",I)=$PIECE($$CLRSN^BPSRPT7(BP59),U)
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+48 ;
+49 ;Check for Accepted/Rejected
+50 IF BPACREJ=1
IF BPSTATUS'["REJECTED"
GOTO XPROC
+51 IF BPACREJ=2
IF BPSTATUS'["ACCEPTED"
GOTO XPROC
+52 ;
+53 ;Check for Specific Reject Code
+54 IF BPREJCD'=0
Begin DoDot:1
+55 SET BPSTOP=0
+56 FOR I=1:1:$LENGTH(BPREJCD,",")
IF $$CKREJ(BP59,$PIECE(BPREJCD,",",I))
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+57 ;
+58 ;;Check for Eligibility Code
+59 ;;I BPELIG'=0,BPELIG'=$$ELIGCODE^BPSSCR05(BP59) G XPROC
+60 ;
+61 ;Check for Eligibility Codes, when one or more is selected (BPELIG1=1)
+62 IF (",1,2,3,4,7,9,10,")[(","_BPRTYPE_",")
IF BPELIG1'=0
SET ELIG=$$ELIGCODE^BPSSCR05(BP59)
if $GET(ELIG)=""
GOTO XPROC
IF '$DATA(BPELIG1(ELIG))
GOTO XPROC
+63 ;
+64 ;Check for selected Prescribers
+65 IF BPRESC'=0
Begin DoDot:1
+66 SET BPSTOP=0
+67 FOR I=1:1:$LENGTH(BPRESC,",")
IF $$CKPRESC(BP59,$PIECE(BPRESC,",",I))
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+68 ;
+69 ;Check for selected Patients
+70 IF BPQSTPAT'=0
IF $GET(BPPAT)'=""
Begin DoDot:1
+71 SET BPSTOP=0
+72 FOR I=1:1:$LENGTH(BPPAT,",")
IF $PIECE(BPPAT,",",I)=$$GET1^DIQ(9002313.59,BP59,5,"I")
SET BPSTOP=1
QUIT
End DoDot:1
IF BPSTOP=0
GOTO XPROC
+73 ;
+74 ; Check for Billed Amount
+75 IF $GET(BPBILL)'=0
SET BPBILLED=$$GET1^DIQ(9002313.59,BP59,505)
IF (BPBILLED<BPMIN)!(BPBILLED>BPMAX)
GOTO XPROC
+76 ;
+77 ;Check Open/Closed claim
+78 IF BPOPCL'=0
IF ((BPOPCL=2)&($$CLOSED02^BPSSCR03($PIECE(^BPST(BP59,0),U,4))=1))!((BPOPCL=1)&($$CLOSED02^BPSSCR03($PIECE(^BPST(BP59,0),U,4))'=1))
GOTO XPROC
+79 ;
+80 ;Save Entry for Report
+81 DO SETTMP^BPSRPT2(BPGLTMP,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,.BPPHARM,BPSUMDET,BPPLAN,BPRLSDT,BPPAYBL,BPREJ,BPRXDRG,$PIECE(BPSTATUS,U),$GET(BPDUPST),$GET(BPDUPPAY))
+82 ;
XPROC QUIT
+1 ;
+2 ;Check if selected BPS PHARMACY
+3 ;
+4 ; Defined Variable: BPPHARM(ptr) - List of BPS Pharmacies to Report on
+5 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
+6 ;
+7 ; Returned Value -> 0 = Entry not in list of selected pharmacies
+8 ; 1 = Entry is in list of selected pharmacies
CHKPHRM(BP59) NEW PHARM
+1 SET PHARM=+$PIECE($GET(^BPST(BP59,1)),"^",7)
+2 SET PHARM=$SELECT($DATA(BPPHARM(PHARM)):1,1:0)
+3 QUIT PHARM
+4 ;
+5 ;Determine whether claim is Released or Not Released
+6 ;
+7 ; Input Variables: BPRX - ptr to PRESCRIPTION (#52)
+8 ; BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
+9 ;
+10 ; Return Value -> 0 = Not Released
+11 ; released date = Released
+12 ;
RELEASED(BPRX,BPREF) NEW RDT
+1 ;
+2 IF BPREF=0
SET RDT=$$RXRELDT^BPSRPT6(BPRX)\1
+3 IF BPREF'=0
SET RDT=$$REFRELDT^BPSRPT6(BPRX,BPREF)\1
+4 QUIT RDT
+5 ;
+6 ;Determine if claim was Auto Reversed
+7 ;
+8 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
+9 ; Return Value -> 1 = Auto Reversed
+10 ; 0 = Not Auto Reversed
+11 ;
AUTOREV(BP59) NEW AR,BP02
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 SET AR=+$PIECE($GET(^BPSC(BP02,0)),U,7)
+3 QUIT AR
+4 ;
+5 ;Determine if claim was closed
+6 ;
+7 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
+8 ; Return Value -> 1 = Closed
+9 ; 0 = Not Closed
+10 ;
CLSCLM(BP59) NEW BP02,CL
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 SET CL=+$GET(^BPSC(BP02,900))
+3 QUIT CL
+4 ;
+5 ;Determine whether claim is Realtime or Backbilled or PRO Option or Resubmission
+6 ;
+7 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
+8 ; Return Value -> 5 = Resubmission
+9 ; 2 = PRO Option
+10 ; 1 = Backbilled
+11 ; 0 = Realtime
RTBCK(BP59) NEW BB
+1 SET BB=$PIECE($GET(^BPST(BP59,12)),U,1)
+2 SET BB=$SELECT(BB="BB":1,BB="P2":2,BB="P2S":2,BB="ERES":5,BB="ERWV":5,BB="ERNB":5,1:0)
+3 QUIT BB
+4 ;
+5 ;Determine if the Prescriber for claim was one of the Prescribers selected
+6 ;
+7 ; Input Variables: BPS59 - Lookup to BPS TRANSACTION (#59)
+8 ; BPSRESC - string of Prescribers selected separated by a comma
+9 ;
+10 ; Return Value -> 1 = Prescriber is on the list of selected Prescribers
+11 ; 0 = RX and/or Prescriber not found, or the Prescriber for this
+12 ; transaction isn't one of the selected Prescribers
+13 ;
CKPRESC(BPS59,BPSPRESC) ;
+1 ;
+2 NEW BPSFND,BPSRX,BPSRXPRSC
+3 ;
+4 ; Initialize to zero.
SET BPSFND=0
+5 ;
+6 ; get the prescription number ien from the BPS TRANSACTION file
+7 SET BPSRX=$$GET1^DIQ(9002313.59,BPS59,1.11,"I")
+8 ;
+9 ; if the prescription number didn't exist
+10 IF BPSRX=""
GOTO CKPRESCX
+11 ;
+12 ; get the prescriber ien from the PRESCRIPTION file
+13 SET BPSRXPRSC=$$GET1^DIQ(52,BPSRX,4,"I")
+14 ;
+15 ; if the prescriber didn't exist BPRESC
+16 IF BPSRXPRSC=""
GOTO CKPRESCX
+17 ;
+18 ; The Prescriber for this transaction is one of the Prescribers selected
+19 IF BPSPRESC[BPSRXPRSC
SET BPSFND=1
+20 ;
CKPRESCX ;
+1 QUIT BPSFND
+2 ;
+3 ;Screen Pause 1
+4 ;
+5 ; Return variable - BPQ = 0 Continue
+6 ; 2 Quit
PAUSE NEW X
+1 USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit:"
+2 READ X:$GET(DTIME)
if '$TEST
SET X="^"
if X["^"
SET BPQ=2
+3 USE IO
+4 QUIT
+5 ;
+6 ;Screen Pause 2
+7 ;
+8 ; Return variable - BPQ = 0 Continue
+9 ; 2 Quit
PAUSE2 NEW X
+1 USE IO(0)
WRITE !!,"Press RETURN to continue:"
+2 READ X:$GET(DTIME)
if '$TEST
SET X="^"
if X["^"
SET BPQ=2
+3 USE IO
+4 QUIT
+5 ;
+6 ;Get ECME#
+7 ;
+8 ;BP59 - ptr to 9002313.59
+9 ;output :
+10 ;ECME number from 9002313.02
+11 ; 7 or 12 digits of the prescription IEN file 52
+12 ; or 12 spaces
+1 QUIT $$ECMENUM^BPSSCRU2(BP59)
+2 ;
+3 ;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format
+4 ;
DATTIM(X) NEW DATE,BPT,BPM,BPH,BPAP
+1 SET DATE=$SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+2 SET BPT=$PIECE(X,".",2)
if $LENGTH(BPT)<4
SET BPT=BPT_$EXTRACT("0000",1,4-$LENGTH(BPT))
+3 SET BPH=$EXTRACT(BPT,1,2)
SET BPM=$EXTRACT(BPT,3,4)
+4 SET BPAP="AM"
IF BPH>12
SET BPH=BPH-12
SET BPAP="PM"
if $LENGTH(BPH)<2
SET BPH="0"_BPH
+5 IF BPT
if 'BPH
SET BPH=12
SET DATE=DATE_" "_BPH_":"_BPM_BPAP
+6 QUIT $GET(DATE)
+7 ;
+8 ;Display RT-Realtime,BB-Backbill,P2-PRO Option, RS-Resubmission or " "
+9 ;
RTBCKNAM(BPINDEX) QUIT $SELECT(BPINDEX=0:"RT",BPINDEX=1:"BB",BPINDEX=2:"P2",BPINDEX=5:"RS",1:" ")
+1 ;
+2 ;See for Specific Reject Code
+3 ;
CKREJ(BP59,BPREJCD) NEW FREJ,I,REJ,X
+1 SET FREJ=0
+2 SET X=$$REJTEXT^BPSRPT2(BP59,.REJ)
+3 SET X=""
FOR
SET X=$ORDER(REJ(X))
if X=""
QUIT
Begin DoDot:1
+4 SET REJ=$PIECE($GET(REJ(X)),":")
if REJ=""
QUIT
+5 SET I=""
FOR
SET I=$ORDER(^BPSF(9002313.93,"B",REJ,I))
if I=""
QUIT
IF I=BPREJCD
SET FREJ=1
End DoDot:1
if FREJ=1
QUIT
+6 QUIT FREJ
