BPSRPT9 ;BHAM ISC/BNT - ECME REPORTS ;19-SEPT-08
;;1.0;E CLAIMS MGMT ENGINE;**8,18,20,27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
Q
; Front End for Potential Secondary and Dual Eligible Claims Reports
; Input variable: BPRTYPE -> 8 = Potential Dual Eligible
; 9 = Potential Secondary
;
; Passed variables - The following local variables are passed around the BPSRPT* routines
; and are not passed as parameters but are assumed to be defined:
; BPACREJ,BPAUTREV,BPBEGDT,BPBLINE,BPCCRSN,BPDRGCL,BPDRUG,BPENDDT,BPEXCEL,
; BPINSINF,BPGRPLN,BPMWC,BPNOW,BPPAGE,BPPHARM,BPQ,BPQSTDRG,
; BPRLNRL,BPRTBCK,BPSDATA,BPSUMDET,BPRTYPE
;
EN(BPRTYPE) ;
N BPREJCD,BPRLNRL,BPRPTNAM,BPRTBCK,BPSCR,BPSUMDET,CODE,POS,STAT,X,Y,BPINS,BPARR
N BPSORT,BPCRON,BPSEL,BPS1,BPS2,BPS3,BPS4,BPS5,BPDT,BPPHARM,BPDIVS,BPELIG1,BPSEXCEL
;
;Verify that a valid report has been requested
I ",8,9,"'[(","_$G(BPRTYPE)_",") D EN^DDIOL("<Invalid Menu Definition - Report Undefined>") H 3 Q
;
D EN^DDIOL("SELECTION CRITERIA","","!")
;Prompt for ECME Pharmacy Division(s) (No Default)
;Sets up BPPHARM variable and array, BPPHARM =0 ALL or BPPHARM=1,BPPHARM(ptr) for list
S X=$$SELPHARM^BPSRPT3() I X="^" Q
;
I BPRTYPE=8 S X=$$SELELIG(.BPELIG1) I X="^" Q
;
;Prompt to select Date Range
;Returns (Start Date^End Date)
S BPDT=$$SELDATE() I BPDT="^" Q
;
;Get sort criteria
I $$GETSORT(BPRTYPE)=-1 Q
;
S BPSEXCEL=0
I BPRTYPE=9 S BPSEXCEL=$$SELEXCEL()
;
D DEV("RUN^BPSRPT9",BPRTYPE,BPSEXCEL)
Q
;
RUN ; Process Report - runs in the background or foreground
N BPRPTARR
I BPRTYPE=9 D GETSEC^BPSRPT9A(BPDT,.BPRPTARR,BPSEXCEL) ; Collect Potential Secondary Rx Claims data
I BPRTYPE=8 D GETTRI^BPSRPT9A(BPDT,.BPRPTARR) ; Collect Potential Dual Eligible Claims data
;
U IO
I BPRTYPE=8 D PRNTTRI(.BPRPTARR)
I BPRTYPE=9 D PRNTSEC(.BPRPTARR)
;
D ^%ZISC ; close the device
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
; Print Dual Eligible Report
PRNTTRI(BPARR) ;
N BPG,BPQUIT,CNT,RX,FILL,FILLDT,PATNAME,COB,ELIG,PAYER,INSC,PSRT,PSRTID,SSRT,TSRT,DATA
N SSRTTYP,TSRTTYP
S SSRTTYP=$P($P(BPSORT,U,2),":")
S TSRTTYP=$P($P(BPSORT,U,3),":")
S (BPG,BPQUIT,CNT)=0
;
; if no data found, display header and message and then get out
I '$D(BPARR) D Q
. D HDR(BPRTYPE)
. W !!?5,"No potential claims available for date range"
. Q
;
S PSRT=-DT-1
D HDR(BPRTYPE)
F S PSRT=$O(BPARR(PSRT)) Q:PSRT="" D Q:BPQUIT
. S PSRTID=$S($P($P(BPSORT,U),":")="N":"Patient Name: ",$P($P(BPSORT,U),":")="P":"Payer: ",$P($P(BPSORT,U),":")="S":"Date of Service: ",$P($P(BPSORT,U),":")="O":"Payer Sequence: ",$P($P(BPSORT,U),":")="E":"Patient Eligibility: ",1:"Division: ")
. I PSRT'=0 W !!,PSRTID,$S($P($P(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT)
. S SSRT=-DT-1 F S SSRT=$O(BPARR(PSRT,SSRT)) Q:SSRT="" D Q:BPQUIT
. . I SSRTTYP="D" W !," Division: ",SSRT
. . S TSRT=-DT-1 F S TSRT=$O(BPARR(PSRT,SSRT,TSRT)) Q:TSRT="" D Q:BPQUIT
. . . I TSRTTYP="D" W !," Division: ",TSRT
. . . S CNT=0 F S CNT=$O(BPARR(PSRT,SSRT,TSRT,CNT)) Q:CNT="" D Q:BPQUIT
. . . . S DATA=BPARR(PSRT,SSRT,TSRT,CNT)
. . . . S RX=$P(DATA,U,2),FILL=$P(DATA,U,3),FILLDT=$P(DATA,U,4),PATNAME=$P(DATA,U,5)
. . . . S INSC=0 F S INSC=$O(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC)) Q:INSC="" D
. . . . . S COB=$S(INSC=1:"p",INSC=2:"s",1:"t")
. . . . . S ELIG=$P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U)
. . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. . . . . S PAYER=$E($P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U)_"-"_$P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,2),1,16)
. . . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT
. . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. . . . . W !,RX,?10,FILL,?13,FILLDT,?22,$E(PATNAME,1,15),?38,$P(DATA,U,6),?44,COB,?47,ELIG,?52,PAYER,?69,$P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,3)
. . . . . S ELIG=$S($P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2)]"":$P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2),1:"")
. . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. . . . . I ELIG]"" W !,?47,ELIG
Q
;
; Print Secondary Report
PRNTSEC(BPARR) ;
N BPG,BPQUIT,CNT,INSC,PAYER,PSRT,PSRTID,SSRT,TSRT,DATA,INSDATA,LGFLG1,LGFLG2
N SSRTTYP,TSRTTYP
S SSRTTYP=$P($P(BPSORT,U,2),":")
S TSRTTYP=$P($P(BPSORT,U,3),":")
S (BPG,BPQUIT)=0
;
; if no data found, display header and message and then get out
I '$D(BPARR) D Q
. D HDR(BPRTYPE)
. W !!?5,"No potential secondary Rx claims available for date range"
. Q
;
I BPSEXCEL D PRNTSECE(.BPARR) Q
;
S PSRT=-DT-1
D HDR(BPRTYPE)
F S PSRT=$O(BPARR(PSRT)) Q:PSRT="" D Q:BPQUIT
. S PSRTID=$S($P($P(BPSORT,U),":")="N":"Patient Name: ",$P($P(BPSORT,U),":")="P":"Payer: ",$P($P(BPSORT,U),":")="S":"Date of Service: ",$P($P(BPSORT,U),":")="O":"Payer Sequence: ",1:"Division: ")
. I PSRT'=0 W !!,PSRTID,$S($P($P(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT)
. S SSRT=-DT-1 F S SSRT=$O(BPARR(PSRT,SSRT)) Q:SSRT="" D Q:BPQUIT
. . I SSRTTYP="D" W !," Division: ",SSRT
. . S TSRT=-DT-1 F S TSRT=$O(BPARR(PSRT,SSRT,TSRT)) Q:TSRT="" D Q:BPQUIT
. . . I TSRTTYP="D" W !," Division: ",TSRT
. . . S CNT=0 F S CNT=$O(BPARR(PSRT,SSRT,TSRT,CNT)) Q:CNT="" D Q:BPQUIT
. . . . S DATA=$G(BPARR(PSRT,SSRT,TSRT,CNT))
. . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT
. . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. . . . I DATA]"" W !,$P(DATA,U,2),?11,$P(DATA,U,3),?21,$P(DATA,U,4),?26,$E($P(DATA,U,6),1,10),?37,$P(DATA,U,9),?43,$P(DATA,U,7),?46,$P(DATA,U,5),?55,$E($P(DATA,U,8),1,13),?69,$P(DATA,U,10)
. . . . ;
. . . . ; If the bill# contains "(P)" it is a primary ECME reject, flag it for the legend
. . . . I $P(DATA,U,2)["(P)" S LGFLG1=1
. . . . S INSC=0 F S INSC=$O(BPARR(PSRT,SSRT,TSRT,CNT,INSC)) Q:INSC="" D Q:BPQUIT
. . . . . S INSDATA=BPARR(PSRT,SSRT,TSRT,CNT,INSC)
. . . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT
. . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. . . . . W !,?43,$P(INSDATA,U),?55,$E($P(INSDATA,U,2),1,13),?69,$P(INSDATA,U,3)
. . . . . I $P(INSDATA,U,1)["-" S LGFLG2=1
;
Q:BPQUIT
I '$G(LGFLG1),'$G(LGFLG2) Q
; display the legend at the end of the report
I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT
W !
I $G(LGFLG1) W !,"Bill# ""(P) Rej"" indicates a rejected/closed primary ECME claim"
I $G(LGFLG2) W !,"COB ""-"" indicates a blank COB field in the pt. ins. policy"
Q
;
; Print Secondary Report Excel Format
PRNTSECE(BPARR) ;
N BPSAR,LGFLG1,LGFLG2
W !,"Division^Bill#^RX#^Fill^Patient^PatID^COB^Date^Payers^HPID/OEID"
S BPSAR="BPARR(0)"
F S BPSAR=$Q(@BPSAR) Q:BPSAR="" D
. I $P(@BPSAR,"^",2)["(P)" S LGFLG1=1
. I $P(@BPSAR,"^",7)["-" S LGFLG2=1
. W !,@BPSAR
I $G(LGFLG1) W !,"Bill# ""(P) Rej"" indicates a rejected/closed primary ECME claim"
I $G(LGFLG2) W !,"COB ""-"" indicates a blank COB field in the pt. ins. policy"
Q
;
; Prompt for sort order
GETSORT(BPRTYPE) N DIR,DIRUT,DTOUT,DUOUT,X,Y,BPS1,BPS2,BPS3,BPS4,BPS5,BPSEL
;
S BPSORT="^^",BPCRON=1
S BPS1="N:Patient Name;",BPS2="P:Payer;",BPS3="S:Date Of Service;",BPS4="D:Division;"
I BPRTYPE=8 S BPS5="E:Patient Eligibility;"
;
D EN^DDIOL("SORT CRITERIA","","!")
S BPSEL=BPS1_BPS2_BPS3_BPS4
I BPRTYPE=8 S BPSEL=BPSEL_BPS5
;Set Primary Sort
S DIR(0)="SB^"_BPSEL
S DIR("?")="Enter a code from the list to indicate the Primary sort order."
S DIR("A")="Primary Sort"
S DIR("B")="Division"
D ^DIR K DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1
I BPRTYPE=9 S $P(BPSORT,U)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4)
I BPRTYPE=8 S $P(BPSORT,U)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,Y=$P(BPS4,":"):BPS4,1:BPS5)
I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1
;
;Get Secondary Sort
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S BPSEL=$$SRTORD($P($P(BPSORT,U),":"))
S DIR(0)="SOB^"_BPSEL
S DIR("?")="Enter a code from the list to indicate the Secondary sort order."
S DIR("A")="Secondary Sort"
D ^DIR K DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1
I BPRTYPE=9 S $P(BPSORT,U,2)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4)
I BPRTYPE=8 S $P(BPSORT,U,2)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,Y=$P(BPS4,":"):BPS4,1:BPS5)
I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1
;
;Get Tertiary Sort
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S BPSEL=$$SRTORD($P($P(BPSORT,U,2),":"))
S DIR(0)="SOB^"_BPSEL
S DIR("A")="Tertiary Sort"
S DIR("?")="Enter a code from the list to indicate the Tertiary sort order."
D ^DIR K DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1
I BPRTYPE=9 S $P(BPSORT,U,3)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4)
I BPRTYPE=8 S $P(BPSORT,U,3)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,Y=$P(BPS4,":"):BPS4,1:BPS5)
I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1
Q 0
;
;Ask if Date should be displayed in chronological order
ASKCRON() ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y"
S DIR("A")=" Display oldest date first"
S DIR("B")="YES"
D ^DIR K DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^"
Q Y
;
;Handle the sort order display
SRTORD(Y) ;
I Y="N" S BPS1=""
I Y="P" S BPS2=""
I Y="S" S BPS3=""
I Y="D" S BPS4=""
I BPRTYPE=8,Y="E" S BPS5=""
S BPSEL=BPS1_BPS2_BPS3_BPS4
I BPRTYPE=8 S BPSEL=BPSEL_BPS5
Q BPSEL
;
; Enter Date Range
;
; Return Value -> P1^P2
;
; where P1 = Earliest Date
; = ^ Exit
; P2 = Latest Date
; = blank for Exit
SELDATE() ;
N BPSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
S VAL="",DIR(0)="DA^:DT:EX",DIR("A")="EARLIEST DATE: "
W ! D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
;
I VAL="" D
.S $P(VAL,U)=Y
.S DIR(0)="DA^"_VAL_":DT:EX",DIR("A")=" LATEST DATE: ",DIR("B")="T"
.D ^DIR
.;
.;Check for "^", timeout, or blank entry
.I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
.;
.;Define Entry
.S $P(VAL,U,2)=Y
;
Q VAL
;
;
;Device Selection
;Input: BPR = Routine
; BPRTYPE = Report Type used to identify Task name
; BPSEXCEL = Format output for Excel
DEV(BPR,BPRTYPE,BPSEXCEL) ;
N %ZIS,ZTSK,ZTSAVE,POP,ZTRTN,ZTDESC
S %ZIS="MQ" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. S ZTRTN=BPR,ZTDESC=$$RPTNAME(BPRTYPE),ZTSAVE("BP*")=""
. D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"QUEUED TASK #",ZTSK
D @BPR
Q
;
RPTNAME(BPRTYPE) ;
;Verify that a valid report has been requested
Q $S(BPRTYPE=8:"Potential Claims Report for Dual Eligible",BPRTYPE=9:"Potential Secondary Rx Claims Report",1:"")
;
;Print the report Header
;Input: BPRTYPE = Report Type
HDR(BPRTYPE) ;
; BPG is assumed for page #
Q:BPQUIT
N DIR,X,Y,BPDIV
I $E(IOST,1,2)="C-",BPG S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S BPQUIT=1 K DIRUT,DTOUT,DUOUT Q
S BPG=BPG+1
W @IOF
F X=1:1:IOM W "="
W $$RPTNAME(BPRTYPE)," ",$$FMTE^XLFDT($P(BPDT,U),"2D")," - ",$$FMTE^XLFDT($P(BPDT,U,2),"2D"),?IOM-10," Page: ",BPG
W !,"Selected Divisions: "
I 'BPPHARM W "ALL"
I BPPHARM S X=0 F S X=$O(BPPHARM(X)) Q:X="" W $P(BPPHARM(X),U,2),"; "
I BPRTYPE=8 D
.W !,"Selected Patient Eligibility: "
.I BPELIG1=0 W "ALL" Q
.I $D(BPELIG1("C")) W "CHAMPVA"
.I $D(BPELIG1("C")),$D(BPELIG1("T")) W "; "
.I $D(BPELIG1("T")) W "TRICARE"
W !,"Sorted By: "_$P($P(BPSORT,U),":",2)_" "_$P($P(BPSORT,U,2),":",2)_" "_$P($P(BPSORT,U,3),":",2)
; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
W !,"'*' indicates the HPID/OEID failed validation checks"
; Write header for Potential Secondary Claims Rpt
I BPRTYPE=9 D
. ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. W !,"Bill#",?11,"RX#",?21,"Fill",?26,"Patient",?36,"PatID",?42,"COB",?46,"Date",?55,"Payers",?69,"HPID/OEID",!
; Write header for Potential Dual Eligible Claims Rpt
I BPRTYPE=8 D
. ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
. W !,"RX#",?9,"Fill",?14,"Date",?22,"Patient",?37,"PatID",?43,"COB",?47,"Elig",?53,"Payers",?69,"HPID/OEID",!
F X=1:1:IOM W "-"
Q
;
SELELIG(BPELIG1) ;Select Eligibility Types
N DIR,X
;
S DIR(0)="SO^T:TRICARE;C:CHAMPVA;A:ALL"
S DIR("A")="Display (T)RICARE or (C)HAMPVA or (A)LL Entries"
S DIR("B")="A"
;
S X=$$SELMULTI^BPSOPR(.DIR,.BPELIG1)
Q X
;
SELEXCEL() ; Select whether to capture data for Excel report.
N BPEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S BPEXCEL=0
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D HEXC^BPSRPT4"
;
D ^DIR
K DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
I Y S BPEXCEL=1
;
;Display Excel display message
I BPEXCEL=1 D
.W !!?5,"Before continuing, please set up your terminal to capture the"
.W !?5,"detail report data and save the detail report data in a text file"
.W !?5,"to a local drive. This report may take a while to run."
.W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
.W !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
;
Q BPEXCEL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT9 13590 printed Sep 23, 2025@19:29:04 Page 2
BPSRPT9 ;BHAM ISC/BNT - ECME REPORTS ;19-SEPT-08
+1 ;;1.0;E CLAIMS MGMT ENGINE;**8,18,20,27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; Front End for Potential Secondary and Dual Eligible Claims Reports
+6 ; Input variable: BPRTYPE -> 8 = Potential Dual Eligible
+7 ; 9 = Potential Secondary
+8 ;
+9 ; Passed variables - The following local variables are passed around the BPSRPT* routines
+10 ; and are not passed as parameters but are assumed to be defined:
+11 ; BPACREJ,BPAUTREV,BPBEGDT,BPBLINE,BPCCRSN,BPDRGCL,BPDRUG,BPENDDT,BPEXCEL,
+12 ; BPINSINF,BPGRPLN,BPMWC,BPNOW,BPPAGE,BPPHARM,BPQ,BPQSTDRG,
+13 ; BPRLNRL,BPRTBCK,BPSDATA,BPSUMDET,BPRTYPE
+14 ;
EN(BPRTYPE) ;
+1 NEW BPREJCD,BPRLNRL,BPRPTNAM,BPRTBCK,BPSCR,BPSUMDET,CODE,POS,STAT,X,Y,BPINS,BPARR
+2 NEW BPSORT,BPCRON,BPSEL,BPS1,BPS2,BPS3,BPS4,BPS5,BPDT,BPPHARM,BPDIVS,BPELIG1,BPSEXCEL
+3 ;
+4 ;Verify that a valid report has been requested
+5 IF ",8,9,"'[(","_$GET(BPRTYPE)_",")
DO EN^DDIOL("<Invalid Menu Definition - Report Undefined>")
HANG 3
QUIT
+6 ;
+7 DO EN^DDIOL("SELECTION CRITERIA","","!")
+8 ;Prompt for ECME Pharmacy Division(s) (No Default)
+9 ;Sets up BPPHARM variable and array, BPPHARM =0 ALL or BPPHARM=1,BPPHARM(ptr) for list
+10 SET X=$$SELPHARM^BPSRPT3()
IF X="^"
QUIT
+11 ;
+12 IF BPRTYPE=8
SET X=$$SELELIG(.BPELIG1)
IF X="^"
QUIT
+13 ;
+14 ;Prompt to select Date Range
+15 ;Returns (Start Date^End Date)
+16 SET BPDT=$$SELDATE()
IF BPDT="^"
QUIT
+17 ;
+18 ;Get sort criteria
+19 IF $$GETSORT(BPRTYPE)=-1
QUIT
+20 ;
+21 SET BPSEXCEL=0
+22 IF BPRTYPE=9
SET BPSEXCEL=$$SELEXCEL()
+23 ;
+24 DO DEV("RUN^BPSRPT9",BPRTYPE,BPSEXCEL)
+25 QUIT
+26 ;
RUN ; Process Report - runs in the background or foreground
+1 NEW BPRPTARR
+2 ; Collect Potential Secondary Rx Claims data
IF BPRTYPE=9
DO GETSEC^BPSRPT9A(BPDT,.BPRPTARR,BPSEXCEL)
+3 ; Collect Potential Dual Eligible Claims data
IF BPRTYPE=8
DO GETTRI^BPSRPT9A(BPDT,.BPRPTARR)
+4 ;
+5 USE IO
+6 IF BPRTYPE=8
DO PRNTTRI(.BPRPTARR)
+7 IF BPRTYPE=9
DO PRNTSEC(.BPRPTARR)
+8 ;
+9 ; close the device
DO ^%ZISC
+10 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+11 QUIT
+12 ;
+13 ; Print Dual Eligible Report
PRNTTRI(BPARR) ;
+1 NEW BPG,BPQUIT,CNT,RX,FILL,FILLDT,PATNAME,COB,ELIG,PAYER,INSC,PSRT,PSRTID,SSRT,TSRT,DATA
+2 NEW SSRTTYP,TSRTTYP
+3 SET SSRTTYP=$PIECE($PIECE(BPSORT,U,2),":")
+4 SET TSRTTYP=$PIECE($PIECE(BPSORT,U,3),":")
+5 SET (BPG,BPQUIT,CNT)=0
+6 ;
+7 ; if no data found, display header and message and then get out
+8 IF '$DATA(BPARR)
Begin DoDot:1
+9 DO HDR(BPRTYPE)
+10 WRITE !!?5,"No potential claims available for date range"
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 SET PSRT=-DT-1
+14 DO HDR(BPRTYPE)
+15 FOR
SET PSRT=$ORDER(BPARR(PSRT))
if PSRT=""
QUIT
Begin DoDot:1
+16 SET PSRTID=$SELECT($PIECE(...
SET $PIECE(BPSORT,U),":")="N":"Patient Name: ",$PIECE($PIECE(BPSORT,U),":")="P":"Payer: ",$PIECE($PIECE(BPSORT,U),":")="S":"Date of Service: ",...
... $PIECE($PIECE(BPSORT,U),":")="O":"Payer Sequence: ",$PIECE($PIECE(BPSORT,U),":")="E":"Patient Eligibility: ",1:"Division: ")
+17 IF PSRT'=0
WRITE !!,PSRTID,$SELECT($PIECE($PIECE(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT)
+18 SET SSRT=-DT-1
FOR
SET SSRT=$ORDER(BPARR(PSRT,SSRT))
if SSRT=""
QUIT
Begin DoDot:2
+19 IF SSRTTYP="D"
WRITE !," Division: ",SSRT
+20 SET TSRT=-DT-1
FOR
SET TSRT=$ORDER(BPARR(PSRT,SSRT,TSRT))
if TSRT=""
QUIT
Begin DoDot:3
+21 IF TSRTTYP="D"
WRITE !," Division: ",TSRT
+22 SET CNT=0
FOR
SET CNT=$ORDER(BPARR(PSRT,SSRT,TSRT,CNT))
if CNT=""
QUIT
Begin DoDot:4
+23 SET DATA=BPARR(PSRT,SSRT,TSRT,CNT)
+24 SET RX=$PIECE(DATA,U,2)
SET FILL=$PIECE(DATA,U,3)
SET FILLDT=$PIECE(DATA,U,4)
SET PATNAME=$PIECE(DATA,U,5)
+25 SET INSC=0
FOR
SET INSC=$ORDER(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC))
if INSC=""
QUIT
Begin DoDot:5
+26 SET COB=$SELECT(INSC=1:"p",INSC=2:"s",1:"t")
+27 SET ELIG=$PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U)
+28 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+29 SET PAYER=$EXTRACT($PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U)_"-"_$PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,2),1,16)
+30 IF $Y>(IOSL-4)
DO HDR(BPRTYPE)
if BPQUIT
QUIT
+31 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+32 WRITE !,RX,?10,FILL,?13,FILLDT,?22,$EXTRACT(PATNAME,1,15),?38,$PIECE(DATA,U,6),?44,COB,?47,ELIG,?52,PAYER,?69,$PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,3)
+33 SET ELIG=$SELECT($PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2)]"":$PIECE(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2),1:"")
+34 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+35 IF ELIG]""
WRITE !,?47,ELIG
End DoDot:5
End DoDot:4
if BPQUIT
QUIT
End DoDot:3
if BPQUIT
QUIT
End DoDot:2
if BPQUIT
QUIT
End DoDot:1
if BPQUIT
QUIT
+36 QUIT
+37 ;
+38 ; Print Secondary Report
PRNTSEC(BPARR) ;
+1 NEW BPG,BPQUIT,CNT,INSC,PAYER,PSRT,PSRTID,SSRT,TSRT,DATA,INSDATA,LGFLG1,LGFLG2
+2 NEW SSRTTYP,TSRTTYP
+3 SET SSRTTYP=$PIECE($PIECE(BPSORT,U,2),":")
+4 SET TSRTTYP=$PIECE($PIECE(BPSORT,U,3),":")
+5 SET (BPG,BPQUIT)=0
+6 ;
+7 ; if no data found, display header and message and then get out
+8 IF '$DATA(BPARR)
Begin DoDot:1
+9 DO HDR(BPRTYPE)
+10 WRITE !!?5,"No potential secondary Rx claims available for date range"
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 IF BPSEXCEL
DO PRNTSECE(.BPARR)
QUIT
+14 ;
+15 SET PSRT=-DT-1
+16 DO HDR(BPRTYPE)
+17 FOR
SET PSRT=$ORDER(BPARR(PSRT))
if PSRT=""
QUIT
Begin DoDot:1
+18 SET PSRTID=$SELECT($PIECE($PIECE(BPSORT,U),":")="N":"Patient Name: ",$PIECE($PIECE(BPSORT,U),":")="P":"Payer: ",$PIECE($PIECE(BPSORT,U),":")="S":"Date of Service: ",$PIECE($PIECE(BPSORT,U),":")="O":"Payer Sequence: ",1:"Division: ")
+19 IF PSRT'=0
WRITE !!,PSRTID,$SELECT($PIECE($PIECE(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT)
+20 SET SSRT=-DT-1
FOR
SET SSRT=$ORDER(BPARR(PSRT,SSRT))
if SSRT=""
QUIT
Begin DoDot:2
+21 IF SSRTTYP="D"
WRITE !," Division: ",SSRT
+22 SET TSRT=-DT-1
FOR
SET TSRT=$ORDER(BPARR(PSRT,SSRT,TSRT))
if TSRT=""
QUIT
Begin DoDot:3
+23 IF TSRTTYP="D"
WRITE !," Division: ",TSRT
+24 SET CNT=0
FOR
SET CNT=$ORDER(BPARR(PSRT,SSRT,TSRT,CNT))
if CNT=""
QUIT
Begin DoDot:4
+25 SET DATA=$GET(BPARR(PSRT,SSRT,TSRT,CNT))
+26 IF $Y>(IOSL-4)
DO HDR(BPRTYPE)
if BPQUIT
QUIT
+27 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+28 IF DATA]""
WRITE !,$PIECE(DATA,U,2),?11,$PIECE(DATA,U,3),?21,$PIECE(DATA,U,4),?26,$EXTRACT($PIECE(DATA,U,6),1,10),?37,$PIECE(DATA,U,9),?43,$PIECE(DATA,U,7),?46,$PIECE(DATA,U,5),?55,$EXTRACT($PIECE(DATA,U,8),1,13),?69,$P
IECE(DATA,U,10)
+29 ;
+30 ; If the bill# contains "(P)" it is a primary ECME reject, flag it for the legend
+31 IF $PIECE(DATA,U,2)["(P)"
SET LGFLG1=1
+32 SET INSC=0
FOR
SET INSC=$ORDER(BPARR(PSRT,SSRT,TSRT,CNT,INSC))
if INSC=""
QUIT
Begin DoDot:5
+33 SET INSDATA=BPARR(PSRT,SSRT,TSRT,CNT,INSC)
+34 IF $Y>(IOSL-4)
DO HDR(BPRTYPE)
if BPQUIT
QUIT
+35 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+36 WRITE !,?43,$PIECE(INSDATA,U),?55,$EXTRACT($PIECE(INSDATA,U,2),1,13),?69,$PIECE(INSDATA,U,3)
+37 IF $PIECE(INSDATA,U,1)["-"
SET LGFLG2=1
End DoDot:5
if BPQUIT
QUIT
End DoDot:4
if BPQUIT
QUIT
End DoDot:3
if BPQUIT
QUIT
End DoDot:2
if BPQUIT
QUIT
End DoDot:1
if BPQUIT
QUIT
+38 ;
+39 if BPQUIT
QUIT
+40 IF '$GET(LGFLG1)
IF '$GET(LGFLG2)
QUIT
+41 ; display the legend at the end of the report
+42 IF $Y>(IOSL-4)
DO HDR(BPRTYPE)
if BPQUIT
QUIT
+43 WRITE !
+44 IF $GET(LGFLG1)
WRITE !,"Bill# ""(P) Rej"" indicates a rejected/closed primary ECME claim"
+45 IF $GET(LGFLG2)
WRITE !,"COB ""-"" indicates a blank COB field in the pt. ins. policy"
+46 QUIT
+47 ;
+48 ; Print Secondary Report Excel Format
PRNTSECE(BPARR) ;
+1 NEW BPSAR,LGFLG1,LGFLG2
+2 WRITE !,"Division^Bill#^RX#^Fill^Patient^PatID^COB^Date^Payers^HPID/OEID"
+3 SET BPSAR="BPARR(0)"
+4 FOR
SET BPSAR=$QUERY(@BPSAR)
if BPSAR=""
QUIT
Begin DoDot:1
+5 IF $PIECE(@BPSAR,"^",2)["(P)"
SET LGFLG1=1
+6 IF $PIECE(@BPSAR,"^",7)["-"
SET LGFLG2=1
+7 WRITE !,@BPSAR
End DoDot:1
+8 IF $GET(LGFLG1)
WRITE !,"Bill# ""(P) Rej"" indicates a rejected/closed primary ECME claim"
+9 IF $GET(LGFLG2)
WRITE !,"COB ""-"" indicates a blank COB field in the pt. ins. policy"
+10 QUIT
+11 ;
+12 ; Prompt for sort order
GETSORT(BPRTYPE) NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,BPS1,BPS2,BPS3,BPS4,BPS5,BPSEL
+1 ;
+2 SET BPSORT="^^"
SET BPCRON=1
+3 SET BPS1="N:Patient Name;"
SET BPS2="P:Payer;"
SET BPS3="S:Date Of Service;"
SET BPS4="D:Division;"
+4 IF BPRTYPE=8
SET BPS5="E:Patient Eligibility;"
+5 ;
+6 DO EN^DDIOL("SORT CRITERIA","","!")
+7 SET BPSEL=BPS1_BPS2_BPS3_BPS4
+8 IF BPRTYPE=8
SET BPSEL=BPSEL_BPS5
+9 ;Set Primary Sort
+10 SET DIR(0)="SB^"_BPSEL
+11 SET DIR("?")="Enter a code from the list to indicate the Primary sort order."
+12 SET DIR("A")="Primary Sort"
+13 SET DIR("B")="Division"
+14 DO ^DIR
KILL DIR
+15 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
QUIT -1
+16 IF BPRTYPE=9
SET $PIECE(BPSORT,U)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,1:BPS4)
+17 IF BPRTYPE=8
SET $PIECE(BPSORT,U)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,Y=$PIECE(BPS4,":"):BPS4,1:BPS5)
+18 IF Y="S"
SET BPCRON=$$ASKCRON()
IF BPCRON="^"
QUIT -1
+19 ;
+20 ;Get Secondary Sort
+21 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+22 SET BPSEL=$$SRTORD($PIECE($PIECE(BPSORT,U),":"))
+23 SET DIR(0)="SOB^"_BPSEL
+24 SET DIR("?")="Enter a code from the list to indicate the Secondary sort order."
+25 SET DIR("A")="Secondary Sort"
+26 DO ^DIR
KILL DIR
+27 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
QUIT -1
+28 IF BPRTYPE=9
SET $PIECE(BPSORT,U,2)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,1:BPS4)
+29 IF BPRTYPE=8
SET $PIECE(BPSORT,U,2)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,Y=$PIECE(BPS4,":"):BPS4,1:BPS5)
+30 IF Y="S"
SET BPCRON=$$ASKCRON()
IF BPCRON="^"
QUIT -1
+31 ;
+32 ;Get Tertiary Sort
+33 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+34 SET BPSEL=$$SRTORD($PIECE($PIECE(BPSORT,U,2),":"))
+35 SET DIR(0)="SOB^"_BPSEL
+36 SET DIR("A")="Tertiary Sort"
+37 SET DIR("?")="Enter a code from the list to indicate the Tertiary sort order."
+38 DO ^DIR
KILL DIR
+39 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
QUIT -1
+40 IF BPRTYPE=9
SET $PIECE(BPSORT,U,3)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,1:BPS4)
+41 IF BPRTYPE=8
SET $PIECE(BPSORT,U,3)=$SELECT(Y=$PIECE(BPS1,":"):BPS1,Y=$PIECE(BPS2,":"):BPS2,Y=$PIECE(BPS3,":"):BPS3,Y=$PIECE(BPS4,":"):BPS4,1:BPS5)
+42 IF Y="S"
SET BPCRON=$$ASKCRON()
IF BPCRON="^"
QUIT -1
+43 QUIT 0
+44 ;
+45 ;Ask if Date should be displayed in chronological order
ASKCRON() ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="Y"
+3 SET DIR("A")=" Display oldest date first"
+4 SET DIR("B")="YES"
+5 DO ^DIR
KILL DIR
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($DATA(DIRUT))
QUIT "^"
+7 QUIT Y
+8 ;
+9 ;Handle the sort order display
SRTORD(Y) ;
+1 IF Y="N"
SET BPS1=""
+2 IF Y="P"
SET BPS2=""
+3 IF Y="S"
SET BPS3=""
+4 IF Y="D"
SET BPS4=""
+5 IF BPRTYPE=8
IF Y="E"
SET BPS5=""
+6 SET BPSEL=BPS1_BPS2_BPS3_BPS4
+7 IF BPRTYPE=8
SET BPSEL=BPSEL_BPS5
+8 QUIT BPSEL
+9 ;
+10 ; Enter Date Range
+11 ;
+12 ; Return Value -> P1^P2
+13 ;
+14 ; where P1 = Earliest Date
+15 ; = ^ Exit
+16 ; P2 = Latest Date
+17 ; = blank for Exit
SELDATE() ;
+1 NEW BPSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
+2 SET VAL=""
SET DIR(0)="DA^:DT:EX"
SET DIR("A")="EARLIEST DATE: "
+3 WRITE !
DO ^DIR
+4 ;
+5 ;Check for "^", timeout, or blank entry
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
+7 ;
+8 IF VAL=""
Begin DoDot:1
+9 SET $PIECE(VAL,U)=Y
+10 SET DIR(0)="DA^"_VAL_":DT:EX"
SET DIR("A")=" LATEST DATE: "
SET DIR("B")="T"
+11 DO ^DIR
+12 ;
+13 ;Check for "^", timeout, or blank entry
+14 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
QUIT
+15 ;
+16 ;Define Entry
+17 SET $PIECE(VAL,U,2)=Y
End DoDot:1
+18 ;
+19 QUIT VAL
+20 ;
+21 ;
+22 ;Device Selection
+23 ;Input: BPR = Routine
+24 ; BPRTYPE = Report Type used to identify Task name
+25 ; BPSEXCEL = Format output for Excel
DEV(BPR,BPRTYPE,BPSEXCEL) ;
+1 NEW %ZIS,ZTSK,ZTSAVE,POP,ZTRTN,ZTDESC
+2 SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN=BPR
SET ZTDESC=$$RPTNAME(BPRTYPE)
SET ZTSAVE("BP*")=""
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
WRITE !,"QUEUED TASK #",ZTSK
End DoDot:1
QUIT
+6 DO @BPR
+7 QUIT
+8 ;
RPTNAME(BPRTYPE) ;
+1 ;Verify that a valid report has been requested
+2 QUIT $SELECT(BPRTYPE=8:"Potential Claims Report for Dual Eligible",BPRTYPE=9:"Potential Secondary Rx Claims Report",1:"")
+3 ;
+4 ;Print the report Header
+5 ;Input: BPRTYPE = Report Type
HDR(BPRTYPE) ;
+1 ; BPG is assumed for page #
+2 if BPQUIT
QUIT
+3 NEW DIR,X,Y,BPDIV
+4 IF $EXTRACT(IOST,1,2)="C-"
IF BPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET BPQUIT=1
KILL DIRUT,DTOUT,DUOUT
QUIT
+5 SET BPG=BPG+1
+6 WRITE @IOF
+7 FOR X=1:1:IOM
WRITE "="
+8 WRITE $$RPTNAME(BPRTYPE)," ",$$FMTE^XLFDT($PIECE(BPDT,U),"2D")," - ",$$FMTE^XLFDT($PIECE(BPDT,U,2),"2D"),?IOM-10," Page: ",BPG
+9 WRITE !,"Selected Divisions: "
+10 IF 'BPPHARM
WRITE "ALL"
+11 IF BPPHARM
SET X=0
FOR
SET X=$ORDER(BPPHARM(X))
if X=""
QUIT
WRITE $PIECE(BPPHARM(X),U,2),"; "
+12 IF BPRTYPE=8
Begin DoDot:1
+13 WRITE !,"Selected Patient Eligibility: "
+14 IF BPELIG1=0
WRITE "ALL"
QUIT
+15 IF $DATA(BPELIG1("C"))
WRITE "CHAMPVA"
+16 IF $DATA(BPELIG1("C"))
IF $DATA(BPELIG1("T"))
WRITE "; "
+17 IF $DATA(BPELIG1("T"))
WRITE "TRICARE"
End DoDot:1
+18 WRITE !,"Sorted By: "_$PIECE($PIECE(BPSORT,U),":",2)_" "_$PIECE($PIECE(BPSORT,U,2),":",2)_" "_$PIECE($PIECE(BPSORT,U,3),":",2)
+19 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+20 WRITE !,"'*' indicates the HPID/OEID failed validation checks"
+21 ; Write header for Potential Secondary Claims Rpt
+22 IF BPRTYPE=9
Begin DoDot:1
+23 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+24 WRITE !,"Bill#",?11,"RX#",?21,"Fill",?26,"Patient",?36,"PatID",?42,"COB",?46,"Date",?55,"Payers",?69,"HPID/OEID",!
End DoDot:1
+25 ; Write header for Potential Dual Eligible Claims Rpt
+26 IF BPRTYPE=8
Begin DoDot:1
+27 ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID
+28 WRITE !,"RX#",?9,"Fill",?14,"Date",?22,"Patient",?37,"PatID",?43,"COB",?47,"Elig",?53,"Payers",?69,"HPID/OEID",!
End DoDot:1
+29 FOR X=1:1:IOM
WRITE "-"
+30 QUIT
+31 ;
SELELIG(BPELIG1) ;Select Eligibility Types
+1 NEW DIR,X
+2 ;
+3 SET DIR(0)="SO^T:TRICARE;C:CHAMPVA;A:ALL"
+4 SET DIR("A")="Display (T)RICARE or (C)HAMPVA or (A)LL Entries"
+5 SET DIR("B")="A"
+6 ;
+7 SET X=$$SELMULTI^BPSOPR(.DIR,.BPELIG1)
+8 QUIT X
+9 ;
SELEXCEL() ; Select whether to capture data for Excel report.
+1 NEW BPEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+2 ;
+3 SET BPEXCEL=0
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+5 SET DIR("A")="Do you want to capture report data for an Excel document"
+6 SET DIR("?")="^D HEXC^BPSRPT4"
+7 ;
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT "^"
+11 IF Y
SET BPEXCEL=1
+12 ;
+13 ;Display Excel display message
+14 IF BPEXCEL=1
Begin DoDot:1
+15 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+16 WRITE !?5,"detail report data and save the detail report data in a text file"
+17 WRITE !?5,"to a local drive. This report may take a while to run."
+18 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+19 WRITE !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
End DoDot:1
+20 ;
+21 QUIT BPEXCEL
+22 ;
