BPSRCRI ;BHAM ISC/NSS - ECME REPORTS ;08-FEB-07
;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
;ECME Claims Response Inquiry Report
;
;User input prompts
EN ; Routine entry point
N BPCFILE,BP02,BP03,BPSCR,BPQ,BPX,BPVAX,ZTQUEUED
S BPCFILE=9002313.02
I $D(IOF) W @IOF
W !,"ECME Claims-Response Inquiry Report",!
;
;User selects VA CLAIM ID
S BP02=$$BPIEN(BPCFILE)
I BP02=-1 G EXIT
S BPVAX=$P(BP02,U,2),BP02=+BP02
;
;Select device
I $$DEVICE=-1 G EXIT
;
;Run the reports
D RUNRPT
;
;Prompt user to retrieve Claim IEN
;Input
; BPCFILE (9002313.02) user inputs VA ID#
;Output
; -1 (not found) or File IEN
BPIEN(BPCFILE) ; User is prompted for input, cross-ref "B" lookup
N DIC,Y,DUOUT,DTOUT,DIROUT
S DIC=$$ROOT^DILFD(BPCFILE)
S DIC("A")="Select VA Claim ID: "
S DIC(0)="ABEQ"
D ^DIC
I (Y=-1)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT) Q -1
Q Y
;
;Select the output Device
DEVICE() ;
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
S BPQ=0
S %ZIS="QM"
W !!,"Note: This report contains three separate sections - transaction data, claims"
W !," data, and response data. There will be a page break/form feed after"
W !," each section regardless of the page length specified in the device input.",!
D ^%ZIS
I POP Q -1
S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
I $D(IO("Q")) D S BPQ=-1
. S ZTRTN="RUNRPT^BPSRCRI"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="ECME CLAIMS RESPONSE INQUIRY REPORT"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
U IO
Q BPQ
;
; Print or display the report
RUNRPT ;
N BPLARR,BP57,BP59,BPQ
D BPFLDS ; BPS TRANSACTIONS/LOG OF TRANSACTIONS
D PRNTRPT
Q
;
;Collect data from Transactions file #59 or Transactions Log file #57
BPFLDS ; Build BPLARR array of data
N BPL0,BPL1,BP902
S BP03=0,BPX=""
;Determine if claim is reversal or not
I $D(^BPST("AE",BP02))!($D(^BPSTL("AE",BP02))) D
. S BPX="AE" ;Not a reversal
. S BPLARR(9)=" CLAIM IEN (c): "
. S BPLARR(10)="RESPONSE IEN (c): "
I BPX="",($D(^BPST("AER",BP02))!($D(^BPSTL("AER",BP02)))) D
. S BPX="AER" ;Reversal
. S BPLARR(10)="REVERSAL RESPONSE IEN (c): "
. S BPLARR(9)=" REVERSAL CLAIM IEN (c): "
I BPX="" Q
S (BP57,BP59)=0
S BP59=$O(^BPST(BPX,BP02,""),-1)
I BP59="" S BP59=0
;
I BP59'=0 D ;Find claim in BPS Transactions file
. S BPL0=$G(^BPST(BP59,0)),BPL1=$G(^BPST(BP59,1))
. I BPX="AE" S BP03=$P($G(^BPST(BP59,0)),U,5)
. I BPX="AER" S BP03=$P($G(^BPST(BP59,4)),U,2)
. S BPLARR(4)="PRESCRIPTION #: "_+$$GET1^DIQ(9002313.59,BP59,1.11)
. D GETS^DIQ(9002313.59902,1_","_BP59,"902;902.24;902.27","E","BP902","ERROR")
. S BPLARR(7)=" PLAN NAME: "_$G(BP902(9002313.59902,"1,"_BP59_",",902.24,"E"))
. S BPLARR(8)="PHARMACY PLAN ID: "_$G(BP902(9002313.59902,"1,"_BP59_",",902.27,"E"))
;
I BP59=0 D ;;Find claim in BPS Log of Transactions file
. S BP57=$O(^BPSTL(BPX,BP02,""),-1)
. I BP57="" S BP57=0 Q
. S BPL0=$G(^BPSTL(BP57,0)),BPL1=$G(^BPSTL(BP57,1)),BP59=$P($G(BPL0),U)
. I BPX="AE" S BP03=$P($G(^BPSTL(BP57,0)),U,5)
. I BPX="AER" S BP03=$P($G(^BPSTL(BP57,4)),U,2)
. S BPLARR(4)="PRESCRIPTION #: "_+$$GET1^DIQ(9002313.57,BP57,1.11)
. D GETS^DIQ(9002313.57902,1_","_BP57,"902;902.24;902.27","E","BP902","ERROR")
. S BPLARR(7)=" PLAN NAME: "_$G(BP902(9002313.59902,"1,"_BP57_",",902.24,"E"))
. S BPLARR(8)="PHARMACY PLAN ID: "_$G(BP902(9002313.59902,"1,"_BP57_",",902.27,"E"))
;
I BP59=0,BP57=0 Q
;Build rest of array components
S BPLARR(1)="ENTRY#: "_BP59
S BPLARR(2)="STATUS: "_+$P($G(BPL0),U,2)
S BPX=$P($G(BPL1),U,7)
S BPLARR(3)=" PHARMACY: "_$P($G(^BPS(9002313.56,+BPX,0)),"^")
S BPLARR(5)=" RXI-INTERNAL (c): "_$P($G(BPL1),U,11)
S BPLARR(9)=BPLARR(9)_BP02
S BPLARR(10)=BPLARR(10)_BP03
Q
;
PRNTRPT ; Output the reports
N BPQ,ZTREQ
S BPQ=0
W @IOF
D CHKP(1) I BPQ Q
W "ECME Claims-Response Inquiry Report"
W ?48,"Print Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
W !,"VA CLAIM ID: "_BPVAX,!
D PRTTRANS ; BPS Transaction (or Transaction log) file fields
I 'BPSCR W !,@IOF
E I 'BPQ D PAUSE
Q:BPQ
D PRT02 ; BPS CLAIMS FILE
I 'BPSCR W !,@IOF
E I 'BPQ D PAUSE
Q:BPQ
D PRT03 ; BPS RESPONSE FILE
Q:BPQ
I 'BPSCR W !,@IOF
E I 'BPQ D PAUSE2
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
Q
;
; Display transaction log fields
PRTTRANS ; Print transaction file report
W !,"BPS TRANSACTION/BPS LOG OF TRANSACTION DATA: ",!
I BPX="" W !,"NO TRANSACTION MATCHES FOUND",!! Q
;
;Loop through the array
N BPX
S BPX=0 F S BPX=$O(BPLARR(BPX)) Q:'BPX D I BPQ Q
. D CHKP(1) I BPQ Q
. I BPX=1 W !,BPLARR(BPX) Q
. I BPX#2=0 W ?40,BPLARR(BPX) Q
. W !,BPLARR(BPX)
Q
;
;Run claim file data report #9002313.02
PRT02 ; Claims file output
W !,"BPS CLAIMS FILE DATA: "
N DIC,DR,DA,DIQ,DTOUT,DIRUT
S DIC=$$ROOT^DILFD(BPCFILE),DA=BP02
I $D(IOF) W @IOF
D EN^DIQ
I ($G(DUOUT)=1)!($G(DTOUT)=1) S BPQ=1
Q
;
;Run response file data report #9002313.03
PRT03 ; Response file output
W !!,"BPS RESPONSE FILE DATA: ",!
I BP03=0!(BP03="") W !,"NO RESPONSE FILE DATA FOUND",!! Q
N DIC,DR,DA,DIQ,DTOUT,DIRUT
S DIC=$$ROOT^DILFD(9002313.03),DA=BP03
D EN^DIQ
I ($G(DUOUT)=1)!($G(DTOUT)=1) S BPQ=1
Q
;
;Check for End of Page
; Input variable -> BPLINES - Number of lines from bottom
; CONT - 0 = New Entry, 1 = Continue Entry
CHKP(BPLINES) ;
S BPLINES=BPLINES+1
I $G(BPSCR) S BPLINES=BPLINES+1
I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE Q:$G(BPQ) 0 Q 1
Q 0
;
PAUSE ;
N X
U IO(0)
R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
I '$T S X="^"
I X["^" S BPQ=1
U IO
Q
;
PAUSE2 ;
N X
U IO(0)
R !,"Press RETURN to continue: ",X:DTIME
U IO
Q
;
;EXIT
EXIT ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRCRI 5928 printed Sep 23, 2025@19:28:41 Page 2
BPSRCRI ;BHAM ISC/NSS - ECME REPORTS ;08-FEB-07
+1 ;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;ECME Claims Response Inquiry Report
+7 ;
+8 ;User input prompts
EN ; Routine entry point
+1 NEW BPCFILE,BP02,BP03,BPSCR,BPQ,BPX,BPVAX,ZTQUEUED
+2 SET BPCFILE=9002313.02
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !,"ECME Claims-Response Inquiry Report",!
+5 ;
+6 ;User selects VA CLAIM ID
+7 SET BP02=$$BPIEN(BPCFILE)
+8 IF BP02=-1
GOTO EXIT
+9 SET BPVAX=$PIECE(BP02,U,2)
SET BP02=+BP02
+10 ;
+11 ;Select device
+12 IF $$DEVICE=-1
GOTO EXIT
+13 ;
+14 ;Run the reports
+15 DO RUNRPT
+16 ;
+17 ;Prompt user to retrieve Claim IEN
+18 ;Input
+19 ; BPCFILE (9002313.02) user inputs VA ID#
+20 ;Output
+21 ; -1 (not found) or File IEN
BPIEN(BPCFILE) ; User is prompted for input, cross-ref "B" lookup
+1 NEW DIC,Y,DUOUT,DTOUT,DIROUT
+2 SET DIC=$$ROOT^DILFD(BPCFILE)
+3 SET DIC("A")="Select VA Claim ID: "
+4 SET DIC(0)="ABEQ"
+5 DO ^DIC
+6 IF (Y=-1)!$DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)
QUIT -1
+7 QUIT Y
+8 ;
+9 ;Select the output Device
DEVICE() ;
+1 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
+2 SET BPQ=0
+3 SET %ZIS="QM"
+4 WRITE !!,"Note: This report contains three separate sections - transaction data, claims"
+5 WRITE !," data, and response data. There will be a page break/form feed after"
+6 WRITE !," each section regardless of the page length specified in the device input.",!
+7 DO ^%ZIS
+8 IF POP
QUIT -1
+9 SET BPSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 SET ZTRTN="RUNRPT^BPSRCRI"
+12 SET ZTIO=ION
+13 SET ZTSAVE("*")=""
+14 SET ZTDESC="ECME CLAIMS RESPONSE INQUIRY REPORT"
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
End DoDot:1
SET BPQ=-1
+18 USE IO
+19 QUIT BPQ
+20 ;
+21 ; Print or display the report
RUNRPT ;
+1 NEW BPLARR,BP57,BP59,BPQ
+2 ; BPS TRANSACTIONS/LOG OF TRANSACTIONS
DO BPFLDS
+3 DO PRNTRPT
+4 QUIT
+5 ;
+6 ;Collect data from Transactions file #59 or Transactions Log file #57
BPFLDS ; Build BPLARR array of data
+1 NEW BPL0,BPL1,BP902
+2 SET BP03=0
SET BPX=""
+3 ;Determine if claim is reversal or not
+4 IF $DATA(^BPST("AE",BP02))!($DATA(^BPSTL("AE",BP02)))
Begin DoDot:1
+5 ;Not a reversal
SET BPX="AE"
+6 SET BPLARR(9)=" CLAIM IEN (c): "
+7 SET BPLARR(10)="RESPONSE IEN (c): "
End DoDot:1
+8 IF BPX=""
IF ($DATA(^BPST("AER",BP02))!($DATA(^BPSTL("AER",BP02))))
Begin DoDot:1
+9 ;Reversal
SET BPX="AER"
+10 SET BPLARR(10)="REVERSAL RESPONSE IEN (c): "
+11 SET BPLARR(9)=" REVERSAL CLAIM IEN (c): "
End DoDot:1
+12 IF BPX=""
QUIT
+13 SET (BP57,BP59)=0
+14 SET BP59=$ORDER(^BPST(BPX,BP02,""),-1)
+15 IF BP59=""
SET BP59=0
+16 ;
+17 ;Find claim in BPS Transactions file
IF BP59'=0
Begin DoDot:1
+18 SET BPL0=$GET(^BPST(BP59,0))
SET BPL1=$GET(^BPST(BP59,1))
+19 IF BPX="AE"
SET BP03=$PIECE($GET(^BPST(BP59,0)),U,5)
+20 IF BPX="AER"
SET BP03=$PIECE($GET(^BPST(BP59,4)),U,2)
+21 SET BPLARR(4)="PRESCRIPTION #: "_+$$GET1^DIQ(9002313.59,BP59,1.11)
+22 DO GETS^DIQ(9002313.59902,1_","_BP59,"902;902.24;902.27","E","BP902","ERROR")
+23 SET BPLARR(7)=" PLAN NAME: "_$GET(BP902(9002313.59902,"1,"_BP59_",",902.24,"E"))
+24 SET BPLARR(8)="PHARMACY PLAN ID: "_$GET(BP902(9002313.59902,"1,"_BP59_",",902.27,"E"))
End DoDot:1
+25 ;
+26 ;;Find claim in BPS Log of Transactions file
IF BP59=0
Begin DoDot:1
+27 SET BP57=$ORDER(^BPSTL(BPX,BP02,""),-1)
+28 IF BP57=""
SET BP57=0
QUIT
+29 SET BPL0=$GET(^BPSTL(BP57,0))
SET BPL1=$GET(^BPSTL(BP57,1))
SET BP59=$PIECE($GET(BPL0),U)
+30 IF BPX="AE"
SET BP03=$PIECE($GET(^BPSTL(BP57,0)),U,5)
+31 IF BPX="AER"
SET BP03=$PIECE($GET(^BPSTL(BP57,4)),U,2)
+32 SET BPLARR(4)="PRESCRIPTION #: "_+$$GET1^DIQ(9002313.57,BP57,1.11)
+33 DO GETS^DIQ(9002313.57902,1_","_BP57,"902;902.24;902.27","E","BP902","ERROR")
+34 SET BPLARR(7)=" PLAN NAME: "_$GET(BP902(9002313.59902,"1,"_BP57_",",902.24,"E"))
+35 SET BPLARR(8)="PHARMACY PLAN ID: "_$GET(BP902(9002313.59902,"1,"_BP57_",",902.27,"E"))
End DoDot:1
+36 ;
+37 IF BP59=0
IF BP57=0
QUIT
+38 ;Build rest of array components
+39 SET BPLARR(1)="ENTRY#: "_BP59
+40 SET BPLARR(2)="STATUS: "_+$PIECE($GET(BPL0),U,2)
+41 SET BPX=$PIECE($GET(BPL1),U,7)
+42 SET BPLARR(3)=" PHARMACY: "_$PIECE($GET(^BPS(9002313.56,+BPX,0)),"^")
+43 SET BPLARR(5)=" RXI-INTERNAL (c): "_$PIECE($GET(BPL1),U,11)
+44 SET BPLARR(9)=BPLARR(9)_BP02
+45 SET BPLARR(10)=BPLARR(10)_BP03
+46 QUIT
+47 ;
PRNTRPT ; Output the reports
+1 NEW BPQ,ZTREQ
+2 SET BPQ=0
+3 WRITE @IOF
+4 DO CHKP(1)
IF BPQ
QUIT
+5 WRITE "ECME Claims-Response Inquiry Report"
+6 WRITE ?48,"Print Date: "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+7 WRITE !,"VA CLAIM ID: "_BPVAX,!
+8 ; BPS Transaction (or Transaction log) file fields
DO PRTTRANS
+9 IF 'BPSCR
WRITE !,@IOF
+10 IF '$TEST
IF 'BPQ
DO PAUSE
+11 if BPQ
QUIT
+12 ; BPS CLAIMS FILE
DO PRT02
+13 IF 'BPSCR
WRITE !,@IOF
+14 IF '$TEST
IF 'BPQ
DO PAUSE
+15 if BPQ
QUIT
+16 ; BPS RESPONSE FILE
DO PRT03
+17 if BPQ
QUIT
+18 IF 'BPSCR
WRITE !,@IOF
+19 IF '$TEST
IF 'BPQ
DO PAUSE2
+20 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+21 DO ^%ZISC
+22 QUIT
+23 ;
+24 ; Display transaction log fields
PRTTRANS ; Print transaction file report
+1 WRITE !,"BPS TRANSACTION/BPS LOG OF TRANSACTION DATA: ",!
+2 IF BPX=""
WRITE !,"NO TRANSACTION MATCHES FOUND",!!
QUIT
+3 ;
+4 ;Loop through the array
+5 NEW BPX
+6 SET BPX=0
FOR
SET BPX=$ORDER(BPLARR(BPX))
if 'BPX
QUIT
Begin DoDot:1
+7 DO CHKP(1)
IF BPQ
QUIT
+8 IF BPX=1
WRITE !,BPLARR(BPX)
QUIT
+9 IF BPX#2=0
WRITE ?40,BPLARR(BPX)
QUIT
+10 WRITE !,BPLARR(BPX)
End DoDot:1
IF BPQ
QUIT
+11 QUIT
+12 ;
+13 ;Run claim file data report #9002313.02
PRT02 ; Claims file output
+1 WRITE !,"BPS CLAIMS FILE DATA: "
+2 NEW DIC,DR,DA,DIQ,DTOUT,DIRUT
+3 SET DIC=$$ROOT^DILFD(BPCFILE)
SET DA=BP02
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EN^DIQ
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET BPQ=1
+7 QUIT
+8 ;
+9 ;Run response file data report #9002313.03
PRT03 ; Response file output
+1 WRITE !!,"BPS RESPONSE FILE DATA: ",!
+2 IF BP03=0!(BP03="")
WRITE !,"NO RESPONSE FILE DATA FOUND",!!
QUIT
+3 NEW DIC,DR,DA,DIQ,DTOUT,DIRUT
+4 SET DIC=$$ROOT^DILFD(9002313.03)
SET DA=BP03
+5 DO EN^DIQ
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET BPQ=1
+7 QUIT
+8 ;
+9 ;Check for End of Page
+10 ; Input variable -> BPLINES - Number of lines from bottom
+11 ; CONT - 0 = New Entry, 1 = Continue Entry
CHKP(BPLINES) ;
+1 SET BPLINES=BPLINES+1
+2 IF $GET(BPSCR)
SET BPLINES=BPLINES+1
+3 IF $Y>(IOSL-BPLINES)
if $GET(BPSCR)
DO PAUSE
if $GET(BPQ)
QUIT 0
QUIT 1
+4 QUIT 0
+5 ;
PAUSE ;
+1 NEW X
+2 USE IO(0)
+3 READ !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
+4 IF '$TEST
SET X="^"
+5 IF X["^"
SET BPQ=1
+6 USE IO
+7 QUIT
+8 ;
PAUSE2 ;
+1 NEW X
+2 USE IO(0)
+3 READ !,"Press RETURN to continue: ",X:DTIME
+4 USE IO
+5 QUIT
+6 ;
+7 ;EXIT
EXIT ;
+1 QUIT
+2 ;
