- BPSSCRRJ ;ALB/ESG - ECME OPECC Reject Information ;02-SEP-2015
- ;;1.0;E CLAIMS MGMT ENGINE;**20,22,33,37**;JUN 2004;Build 16
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference to $$RXSITE^PSOBPSUT in ICR #4701
- ; Reference to $$GETNDC^PSONDCUT in ICR #4705
- ; Reference to DP^PSORXVW in ICR #4711
- ; Reference to REJCOM^PSOREJU4 in ICR #6227
- ; Reference to MP^PSOREJU4 and PI^PSOREJU4 in ICR #6228
- ; Reference to $$TAXID^IBCEF75 in ICR #6768
- ;
- Q
- ;
- EN ; -- main entry point for BPS OPECC REJECT INFORMATION
- N BPSEL,DFN,PSODFN,BPINSIEN,BPORI59,RXREF,RXIEN,RXFIL,LINE,VALMHDR,RX,FILL
- W "OPECC Reject Information"
- D FULL^VALM1
- S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select a single Rx line.")
- I BPSEL<1 G ENX
- S (DFN,PSODFN)=+$P(BPSEL,U,2) ; patient DFN
- S BPINSIEN=+$P(BPSEL,U,3) ; insurance ien
- S BPORI59=$P(BPSEL,U,4) I 'BPORI59 G ENX ; BPS Transaction ien
- S RXREF=$$RXREF^BPSSCRU2(BPORI59)
- S RXIEN=$P(RXREF,U,1) I 'RXIEN G ENX ; prescription ien
- S RXFIL=$P(RXREF,U,2) ; fill#
- ;
- ; the claim must either be rejected or non-billable to be eligible for this action
- I '$$REJECTED^BPSSCR02(BPORI59),'$$NB^BPSSCR03(BPORI59) D G ENX
- . W !!,"This claim is not a valid selection for the OPECC Reject Information screen."
- . W !,"This screen is for either rejected claims or non-billable claims."
- . D PAUSE^VALM1
- . Q
- ;
- D EN^VALM("BPS OPECC REJECT INFORMATION")
- ENX ;
- S VALMBCK="R"
- Q
- ;
- ;
- INIT ; -- init variables and list array
- ;
- K ^TMP("BPSSCRRJ",$J),^TMP("PSOPI",$J)
- S LINE=0,VALMCNT=0
- S (DFN,PSODFN)=+$P($G(^BPST(BPORI59,0)),U,6)
- ;
- D REJ ; main reject information
- D BPSCOM ; ecme opecc comments
- D PSOCOM ; pso pharmacist comments
- D INS ; insurance information
- ;
- INITX ;
- Q
- ;
- REJ ; main reject information data capture and display
- ;
- N BBTXT,RXCOB,ELIG,STATUS,RESPIEN,BPPOS,BPRJ,BPN,RSPREC,Z,DG,CODE,DESC,BPSNAF,BPPMSG,BPARR,PREFIX,TXTLN,BPADDMSG,PAMSG,TX
- S BBTXT=""
- S RXCOB=+$P($G(^BPST(BPORI59,0)),U,14) I 'RXCOB S RXCOB=1
- I $$BBILL^BPSBUTL(RXIEN,RXFIL,RXCOB) S BBTXT=" BACK-BILL"
- E I $$RESUBMIT^BPSBUTL(RXIEN,RXFIL,RXCOB) S BBTXT=" RESUBMISSION"
- S ELIG=$P($G(^BPST(BPORI59,9)),U,4)
- S ELIG=$S(ELIG="C":"CHAMPVA",ELIG="T":"TRICARE",1:"Veteran")
- D SETLN("REJECT Information ("_ELIG_") "_BBTXT,1,1)
- ;
- ; for non-billable entries display some custom information and get out
- ; most of this section will not work for non-billables because there is no ECME claim or response
- I $$NB^BPSSCR03(BPORI59) D G REJX
- . D SETLN("Current ECME Status: N/A for Non-Billable Entry")
- . D SETLN($$EREJTXT^BPSSCR03(BPORI59))
- . Q
- ;
- ; the rest of this procedure is for a normal rejected claim/response
- ;
- S STATUS=$P($$STATUS^BPSOSRX(RXIEN,RXFIL,,,RXCOB),U,1)
- D SETLN("Current ECME Status: "_STATUS)
- ;
- I '$$GRESPPOS^BPSSCRU3(BPORI59,.RESPIEN,.BPPOS) D G INITX
- . D SETLN("No ECME Response information can be found.")
- . Q
- ;
- I '$G(RESPIEN) D G INITX
- . D SETLN("SYSTEM ERROR: No ECME Response information can be found.")
- . Q
- ;
- ; get the number of rejects on file and the reject codes/descriptions
- K BPRJ S BPN=0
- D GETRJCOD^BPSSCRU3(BPORI59,.BPRJ,.BPN,74,"")
- I BPN D ; if there are rejects
- . S RSPREC=$P($G(^BPSR(RESPIEN,0)),U,2) ; date/time response received
- . D SETLN("Reject"_$S(BPN>1:"s",1:"")_" received from Payer on "_$$FMTE^XLFDT(RSPREC,"5ZPS")_"."),SETLN(" ")
- . D SETLN(" Code Description")
- . S Z=0 F S Z=$O(BPRJ(Z)) Q:'Z D
- .. S DG=$G(BPRJ(Z)),CODE=$P(DG,":",1),DESC=$P(DG,":",2,99)
- .. D SETLN($J(CODE,5)_" - "_DESC)
- .. Q
- . D SETLN(" ")
- . Q
- I 'BPN D SETLN("No Reject Information was found."),SETLN(" ")
- ;
- ; get and display next available fill date from the response file
- S BPSNAF=$$NFLDT^BPSBUTL(RXIEN,RXFIL,RXCOB)
- I BPSNAF'="" D SETLN("Next Avail Fill: "_$$FMTE^XLFDT(BPSNAF,"5DZ"))
- ;
- ; get and display payer message (504-F4)
- S BPPMSG=$$MESSAGE^BPSSCRLG(RESPIEN) ; payer message (504-F4)
- D WRAPTXT(BPPMSG,62,.BPARR)
- S BPN=0 F S BPN=$O(BPARR(BPN)) Q:'BPN D
- . S PREFIX=$S(BPN=1:"Payer Message :",1:"")
- . S TXTLN=$$LJ^XLFSTR(PREFIX,17)_$G(BPARR(BPN,0))
- . D SETLN(TXTLN)
- . Q
- ;
- ; get and display payer additional message (526-FQ)
- K BPADDMSG
- D ADDMESS^BPSSCRLG(RESPIEN,1,.BPADDMSG)
- S PAMSG=""
- S BPN=0 F S BPN=$O(BPADDMSG(BPN)) Q:'BPN S TX=$G(BPADDMSG(BPN)),PAMSG=$S(PAMSG="":TX,1:PAMSG_" "_TX)
- D WRAPTXT(PAMSG,62,.BPARR)
- S BPN=0 F S BPN=$O(BPARR(BPN)) Q:'BPN D
- . S PREFIX=$S(BPN=1:"Payer Addl Msg :",1:"")
- . S TXTLN=$$LJ^XLFSTR(PREFIX,17)_$G(BPARR(BPN,0))
- . D SETLN(TXTLN)
- . Q
- ;
- REJX ;
- D SETLN(" "),SETLN(" ")
- Q
- ;
- BPSCOM ; display full opecc comments here
- N CMTDT,ZN,CDAT,CDATE,CUSER,RXFLG,TXT,CTXT,L,TXTLN
- D SETLN("OPECC COMMENTS",1,1)
- ;
- I '$O(^BPST(BPORI59,11,0)) D SETLN(" There are no comments found for this section.") G BPSCOMX
- ;
- S CMTDT=" " F S CMTDT=$O(^BPST(BPORI59,11,"B",CMTDT),-1) Q:'CMTDT S ZN=" " F S ZN=$O(^BPST(BPORI59,11,"B",CMTDT,ZN),-1) Q:'ZN D
- . S CDAT=$G(^BPST(BPORI59,11,ZN,0))
- . S CDATE=$$FMTE^XLFDT(CMTDT,"2ZMP") ; external date/time of comment
- . S CUSER=$P($G(^VA(200,+$P(CDAT,U,2),0)),U,1) ; user name who entered comment
- . S RXFLG=$S($P(CDAT,U,4):" (Pharm)",1:"") ; flag that says if opecc comment should be displayed on PSO RI screen
- . S TXT=CDATE_RXFLG_" - "_$P(CDAT,U,3)_" ("_CUSER_")"
- . D WRAPTXT(TXT,76,.CTXT)
- . S L=0 F S L=$O(CTXT(L)) Q:'L D
- .. S TXTLN=$S(L=1:"- ",1:" ")_$G(CTXT(L,0))
- .. D SETLN(TXTLN)
- .. Q
- . Q
- ;
- BPSCOMX ;
- D SETLN(" "),SETLN(" ")
- Q
- ;
- PSOCOM ; display the PSO comments from the pharmacist
- N RXCOB,COM,REJ,NUMREJ,REJIEN,REJDESC,COMDT,Z1,CDAT,CDATE,CUSER,TXT,CTXT,L,TXTLN
- ;
- S RXCOB=+$P($G(^BPST(BPORI59,0)),U,14) I 'RXCOB S RXCOB=1
- D REJCOM^PSOREJU4(RXIEN,RXFIL,RXCOB,.COM) ; build the PSO comments array for this Rx/fill/cob (ICR# 6227)
- ;
- D SETLN("PHARMACIST COMMENTS",1,1)
- ;
- S REJ="" F NUMREJ=0:1 S REJ=$O(COM(REJ)) Q:REJ="" ; count the number of reject codes that have PSO comments
- I 'NUMREJ D SETLN(" There are no comments found for this section.") G PSOCOMX
- ;
- S REJ="" F S REJ=$O(COM(REJ)) Q:REJ="" D
- . ;
- . ; if there are 2 or more reject codes that have comments, then display the reject code/description here
- . I NUMREJ>1 D
- .. S REJIEN=+$O(^BPSF(9002313.93,"B",REJ,""),-1) ; reject code internal IEN
- .. S REJDESC=$P($G(^BPSF(9002313.93,REJIEN,0)),U,2) ; reject description
- .. D SETLN(REJ_" - "_REJDESC)
- .. Q
- . ;
- . S COMDT=" " F S COMDT=$O(COM(REJ,COMDT),-1) Q:'COMDT S Z1=" " F S Z1=$O(COM(REJ,COMDT,Z1),-1) Q:'Z1 D
- .. S CDAT=$G(COM(REJ,COMDT,Z1))
- .. S CDATE=$$FMTE^XLFDT($P(CDAT,U,1),"2ZMP")
- .. S CUSER=$P($G(^VA(200,+$P(CDAT,U,2),0)),U,1)
- .. S TXT=CDATE_" - "_$P(CDAT,U,3)_" ("_CUSER_")"
- .. D WRAPTXT(TXT,76,.CTXT)
- .. S L=0 F S L=$O(CTXT(L)) Q:'L D
- ... S TXTLN=$S(L=1:"- ",1:" ")_$G(CTXT(L,0))
- ... D SETLN(TXTLN)
- ... Q
- .. Q
- . ;
- . ; if there are more reject codes, display a blank line here before the next reject code
- . I $O(COM(REJ))'="" D SETLN(" ")
- . Q
- ;
- PSOCOMX ;
- D SETLN(" "),SETLN(" ")
- Q
- ;
- INS ; gather and show insurance information
- N BPSINS,IENS,INSNAME,RXCOB,BPSPOL,BPSEFDT
- S BPSINS=+$$GET1^DIQ(9002313.59,BPORI59,901,"I") I 'BPSINS S BPSINS=1
- S IENS=BPSINS_","_BPORI59_","
- S RXCOB=+$P($G(^BPST(BPORI59,0)),U,14) I 'RXCOB S RXCOB=1
- ;
- S INSNAME=$$LJ^XLFSTR($$GET1^DIQ(9002313.59902,IENS,902.24),32)
- I RXCOB=2 S INSNAME=INSNAME_"Coord. Of Benefits: SECONDARY"
- S BPSPOL=+$$GET1^DIQ(9002313.59902,IENS,902.35,"I") ; pt insurance 2.312 subfile ien
- S BPSEFDT=$S(BPSPOL:+$P($G(^DPT(DFN,.312,BPSPOL,0)),U,8)\1,1:"") ; policy effective date
- I BPSEFDT S BPSEFDT=$$FMTE^XLFDT(BPSEFDT,"5DZ") ; external policy effective date
- ;
- D SETLN("INSURANCE Information",1,1)
- D SETLN("Insurance : "_INSNAME)
- D SETLN("Contact : "_$$GET1^DIQ(9002313.59902,IENS,902.26))
- D SETLN("BIN : "_$$GET1^DIQ(9002313.59902,IENS,902.03))
- D SETLN("PCN : "_$$GET1^DIQ(9002313.59902,IENS,902.04))
- D SETLN("Group Number : "_$$GET1^DIQ(9002313.59902,IENS,902.05))
- D SETLN("Cardholder ID : "_$$GET1^DIQ(9002313.59902,IENS,902.06))
- D SETLN("Effective Date : "_BPSEFDT)
- ;
- INSX ;
- D SETLN(" "),SETLN(" ")
- Q
- ;
- WRAPTXT(X,DIWR,RET) ; wrap text in variable X with right margin DIWR, return in array RET
- N %,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,DN,I,Z
- K ^UTILITY($J,"W"),RET
- S DIWL=1
- D ^DIWP
- M RET=^UTILITY($J,"W",1)
- K ^UTILITY($J,"W")
- WRAPX ;
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("BPSSCRRJ",$J),^TMP("PSOPI",$J)
- Q
- ;
- SETLN(TEXT,REV,UND,HIG) ; set a line into the ListMan array
- I $G(TEXT)="" S TEXT=" "
- I $L(TEXT)>80 S TEXT=$E(TEXT,1,80)
- S LINE=LINE+1
- D SET^VALM10(LINE,TEXT)
- S VALMCNT=LINE
- ;
- I $G(REV) D G SETLNX
- . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM)
- . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
- . Q
- ;
- I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
- ;
- I $G(HIG) D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
- ;
- SETLNX ;
- Q
- ;
- HDR ; -- header code
- N PTINFO
- S VALMHDR(1)=$$DVINFO(RXIEN,RXFIL) ; division, npi, ncpdp data
- S PTINFO=$$PTINFO(RXIEN)
- S VALMHDR(2)=$P(PTINFO,U,1) ; Patient data
- S VALMHDR(3)=$P(PTINFO,U,2) ; Patient sex
- S VALMHDR(4)=$$RXINFO1(RXIEN,RXFIL) ; Rx data part 1
- S VALMHDR(5)=$$RXINFO2(RXIEN,RXFIL) ; Rx data part 2
- Q
- ;
- DVINFO(RX,RFL) ; header division data
- ;Input: (r) RX - Rx IEN (#52)
- ; (o) RFL - Refill #
- N BPSTAXID,DVIEN,DVINFO,NCPNPI
- S DVINFO="Division : "_$E($$GET1^DIQ(9002313.59,BPORI59,11),1,15) ; Pharmacy Division name from BPS Transaction
- ;Display both NPI and NCPDP numbers
- S DVIEN=+$$RXSITE^PSOBPSUT(RX,RFL) ; ICR# 4701
- ;
- ; Check for Controlled Substance Drug and if a BPS Pharmacy for CS has
- ; been defined. If so, use NCPDP# & NPI for the CS Pharmacy.
- S NCPNPI=$$CSNPI^BPSUTIL(RX,RFL)
- ;
- ; If not a Controlled Substance, use NCDPD# & NPI info based on Division.
- I +NCPNPI=-1 S NCPNPI=$$DIVNCPDP^BPSBUTL(DVIEN)
- S $E(DVINFO,28)="NPI: "_$P(NCPNPI,U,2)
- S $E(DVINFO,44)="NCPDP: "_$P(NCPNPI,U,1)
- S BPSTAXID=$P($$TAXID^IBCEF75,U,2) ; ICR# 6768
- S $E(DVINFO,62)="TAX ID: "_$E(BPSTAXID,1,2)_"-"_$E(BPSTAXID,3,$L(BPSTAXID))
- Q DVINFO
- ;
- PTINFO(RX) ; header patient data
- ;Input: (r) RX - Rx IEN (#52)
- N DFN,PTINFO,SEX,SSN4,VADM
- S DFN=+$P($G(^BPST(BPORI59,0)),U,6)
- D DEM^VADPT S SSN4=$P($G(VADM(2)),U,2)
- S PTINFO="Patient : "_$E($G(VADM(1)),1,24)_"("_$E(SSN4,$L(SSN4)-3,$L(SSN4))_")"
- S $E(PTINFO,61)="DOB: "_$P($G(VADM(3)),U,2)_"("_$P($G(VADM(4)),U,1)_")"
- S SEX="Birth Sex: "_$P($G(VADM(5)),U,1)
- S $E(SEX,32)="Self-Identified Gender: "_$E($P($G(VADM(14,5)),U,1),1,24)
- Q PTINFO_U_SEX
- ;
- RXINFO1(RX,FILL) ; header Rx data part 1
- N RXINFO,RXDOS,PSOET
- D GETDAT^BPSBUTL(RX,FILL,,.RXDOS) ; Get Date of Service from BPS CLAIM field 401
- S RXINFO="Rx# : "_$$RXNUM^BPSSCRU2(RX)_"/"_FILL
- S PSOET=$$NB^BPSSCR03(BPORI59) ; TRI/CVA non-billable entry
- S $E(RXINFO,27)="ECME#: "_$S(PSOET:"",1:$P($$CLAIM^BPSBUTL(RX,FILL),U,6))
- S $E(RXINFO,49)="Date of Service: "_$S(PSOET:"",1:$$FMTE^XLFDT(RXDOS)) ; Use DOS from BPS Claims field 401
- Q RXINFO
- ;
- RXINFO2(RX,FILL) ; header Rx data part 2
- N RXINFO,DRG,CMOP
- S DRG=+$$RXAPI1^BPSUTIL1(RX,6,"I") ; drug ien
- S CMOP=$$DRUGDIE^BPSUTIL1(DRG,213,"I") ; cmop dispense field in the Drug file (0/1)
- S RXINFO=$S(CMOP:"CMOP ",1:"")_"Drug"
- S $E(RXINFO,10)=": "_$E($$RXAPI1^BPSUTIL1(RX,6),1,43) ; drug name
- ;
- S $E(RXINFO,56)="NDC Code: "_$$GETNDC^PSONDCUT(RX,FILL) ; ICR# 4705
- Q RXINFO
- ;
- VER ; selection of View ePharmacy Rx from the BPS OPECC reject information screen
- N BPSVRX
- D FULL^VALM1
- S BPSVRX("RXIEN")=$G(RXIEN)
- S BPSVRX("FILL#")=$G(RXFIL)
- D ^BPSVRX
- VERX ;
- S VALMBCK="R"
- Q
- ;
- VIEW ; action for View Rx on the BPS OPECC reject information screen
- N VALMCNT,LINE,VALMHDR,TITLE,PSOVDA,DA,PS,DFN,PSODFN
- S TITLE=VALM("TITLE")
- S (PSOVDA,DA)=RXIEN,PS="REJECT"
- ;
- ; - DO structure used to avoid losing key variables in this routine
- D
- . N RXIEN,RXFIL,BPORI59,TITLE
- . D DP^PSORXVW ; ICR# 4711
- . Q
- ;
- S VALMBCK="R",VALM("TITLE")=TITLE
- Q
- ;
- MP(RXIEN,RXFIL) ; entry point for Medication Profile action on OPECC reject information screen
- N VALMCNT,LINE,VALMHDR,DFN,PSODFN,BPORI59
- D MP^PSOREJU4(RXIEN,RXFIL) ; ICR# 6228
- S VALMBCK="R"
- Q
- ;
- PI(RXIEN,RXFIL) ; entry point for Patient Information action on OPECC reject information screen
- N VALMCNT,LINE,VALMHDR,DFN,PSODFN,BPORI59
- D PI^PSOREJU4(RXIEN,RXFIL) ; ICR# 6228
- S VALMBCK="R"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRRJ 13090 printed Feb 18, 2025@23:19:38 Page 2
- BPSSCRRJ ;ALB/ESG - ECME OPECC Reject Information ;02-SEP-2015
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**20,22,33,37**;JUN 2004;Build 16
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference to $$RXSITE^PSOBPSUT in ICR #4701
- +5 ; Reference to $$GETNDC^PSONDCUT in ICR #4705
- +6 ; Reference to DP^PSORXVW in ICR #4711
- +7 ; Reference to REJCOM^PSOREJU4 in ICR #6227
- +8 ; Reference to MP^PSOREJU4 and PI^PSOREJU4 in ICR #6228
- +9 ; Reference to $$TAXID^IBCEF75 in ICR #6768
- +10 ;
- +11 QUIT
- +12 ;
- EN ; -- main entry point for BPS OPECC REJECT INFORMATION
- +1 NEW BPSEL,DFN,PSODFN,BPINSIEN,BPORI59,RXREF,RXIEN,RXFIL,LINE,VALMHDR,RX,FILL
- +2 WRITE "OPECC Reject Information"
- +3 DO FULL^VALM1
- +4 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select a single Rx line.")
- +5 IF BPSEL<1
- GOTO ENX
- +6 ; patient DFN
- SET (DFN,PSODFN)=+$PIECE(BPSEL,U,2)
- +7 ; insurance ien
- SET BPINSIEN=+$PIECE(BPSEL,U,3)
- +8 ; BPS Transaction ien
- SET BPORI59=$PIECE(BPSEL,U,4)
- IF 'BPORI59
- GOTO ENX
- +9 SET RXREF=$$RXREF^BPSSCRU2(BPORI59)
- +10 ; prescription ien
- SET RXIEN=$PIECE(RXREF,U,1)
- IF 'RXIEN
- GOTO ENX
- +11 ; fill#
- SET RXFIL=$PIECE(RXREF,U,2)
- +12 ;
- +13 ; the claim must either be rejected or non-billable to be eligible for this action
- +14 IF '$$REJECTED^BPSSCR02(BPORI59)
- IF '$$NB^BPSSCR03(BPORI59)
- Begin DoDot:1
- +15 WRITE !!,"This claim is not a valid selection for the OPECC Reject Information screen."
- +16 WRITE !,"This screen is for either rejected claims or non-billable claims."
- +17 DO PAUSE^VALM1
- +18 QUIT
- End DoDot:1
- GOTO ENX
- +19 ;
- +20 DO EN^VALM("BPS OPECC REJECT INFORMATION")
- ENX ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- +4 ;
- INIT ; -- init variables and list array
- +1 ;
- +2 KILL ^TMP("BPSSCRRJ",$JOB),^TMP("PSOPI",$JOB)
- +3 SET LINE=0
- SET VALMCNT=0
- +4 SET (DFN,PSODFN)=+$PIECE($GET(^BPST(BPORI59,0)),U,6)
- +5 ;
- +6 ; main reject information
- DO REJ
- +7 ; ecme opecc comments
- DO BPSCOM
- +8 ; pso pharmacist comments
- DO PSOCOM
- +9 ; insurance information
- DO INS
- +10 ;
- INITX ;
- +1 QUIT
- +2 ;
- REJ ; main reject information data capture and display
- +1 ;
- +2 NEW BBTXT,RXCOB,ELIG,STATUS,RESPIEN,BPPOS,BPRJ,BPN,RSPREC,Z,DG,CODE,DESC,BPSNAF,BPPMSG,BPARR,PREFIX,TXTLN,BPADDMSG,PAMSG,TX
- +3 SET BBTXT=""
- +4 SET RXCOB=+$PIECE($GET(^BPST(BPORI59,0)),U,14)
- IF 'RXCOB
- SET RXCOB=1
- +5 IF $$BBILL^BPSBUTL(RXIEN,RXFIL,RXCOB)
- SET BBTXT=" BACK-BILL"
- +6 IF '$TEST
- IF $$RESUBMIT^BPSBUTL(RXIEN,RXFIL,RXCOB)
- SET BBTXT=" RESUBMISSION"
- +7 SET ELIG=$PIECE($GET(^BPST(BPORI59,9)),U,4)
- +8 SET ELIG=$SELECT(ELIG="C":"CHAMPVA",ELIG="T":"TRICARE",1:"Veteran")
- +9 DO SETLN("REJECT Information ("_ELIG_") "_BBTXT,1,1)
- +10 ;
- +11 ; for non-billable entries display some custom information and get out
- +12 ; most of this section will not work for non-billables because there is no ECME claim or response
- +13 IF $$NB^BPSSCR03(BPORI59)
- Begin DoDot:1
- +14 DO SETLN("Current ECME Status: N/A for Non-Billable Entry")
- +15 DO SETLN($$EREJTXT^BPSSCR03(BPORI59))
- +16 QUIT
- End DoDot:1
- GOTO REJX
- +17 ;
- +18 ; the rest of this procedure is for a normal rejected claim/response
- +19 ;
- +20 SET STATUS=$PIECE($$STATUS^BPSOSRX(RXIEN,RXFIL,,,RXCOB),U,1)
- +21 DO SETLN("Current ECME Status: "_STATUS)
- +22 ;
- +23 IF '$$GRESPPOS^BPSSCRU3(BPORI59,.RESPIEN,.BPPOS)
- Begin DoDot:1
- +24 DO SETLN("No ECME Response information can be found.")
- +25 QUIT
- End DoDot:1
- GOTO INITX
- +26 ;
- +27 IF '$GET(RESPIEN)
- Begin DoDot:1
- +28 DO SETLN("SYSTEM ERROR: No ECME Response information can be found.")
- +29 QUIT
- End DoDot:1
- GOTO INITX
- +30 ;
- +31 ; get the number of rejects on file and the reject codes/descriptions
- +32 KILL BPRJ
- SET BPN=0
- +33 DO GETRJCOD^BPSSCRU3(BPORI59,.BPRJ,.BPN,74,"")
- +34 ; if there are rejects
- IF BPN
- Begin DoDot:1
- +35 ; date/time response received
- SET RSPREC=$PIECE($GET(^BPSR(RESPIEN,0)),U,2)
- +36 DO SETLN("Reject"_$SELECT(BPN>1:"s",1:"")_" received from Payer on "_$$FMTE^XLFDT(RSPREC,"5ZPS")_".")
- DO SETLN(" ")
- +37 DO SETLN(" Code Description")
- +38 SET Z=0
- FOR
- SET Z=$ORDER(BPRJ(Z))
- if 'Z
- QUIT
- Begin DoDot:2
- +39 SET DG=$GET(BPRJ(Z))
- SET CODE=$PIECE(DG,":",1)
- SET DESC=$PIECE(DG,":",2,99)
- +40 DO SETLN($JUSTIFY(CODE,5)_" - "_DESC)
- +41 QUIT
- End DoDot:2
- +42 DO SETLN(" ")
- +43 QUIT
- End DoDot:1
- +44 IF 'BPN
- DO SETLN("No Reject Information was found.")
- DO SETLN(" ")
- +45 ;
- +46 ; get and display next available fill date from the response file
- +47 SET BPSNAF=$$NFLDT^BPSBUTL(RXIEN,RXFIL,RXCOB)
- +48 IF BPSNAF'=""
- DO SETLN("Next Avail Fill: "_$$FMTE^XLFDT(BPSNAF,"5DZ"))
- +49 ;
- +50 ; get and display payer message (504-F4)
- +51 ; payer message (504-F4)
- SET BPPMSG=$$MESSAGE^BPSSCRLG(RESPIEN)
- +52 DO WRAPTXT(BPPMSG,62,.BPARR)
- +53 SET BPN=0
- FOR
- SET BPN=$ORDER(BPARR(BPN))
- if 'BPN
- QUIT
- Begin DoDot:1
- +54 SET PREFIX=$SELECT(BPN=1:"Payer Message :",1:"")
- +55 SET TXTLN=$$LJ^XLFSTR(PREFIX,17)_$GET(BPARR(BPN,0))
- +56 DO SETLN(TXTLN)
- +57 QUIT
- End DoDot:1
- +58 ;
- +59 ; get and display payer additional message (526-FQ)
- +60 KILL BPADDMSG
- +61 DO ADDMESS^BPSSCRLG(RESPIEN,1,.BPADDMSG)
- +62 SET PAMSG=""
- +63 SET BPN=0
- FOR
- SET BPN=$ORDER(BPADDMSG(BPN))
- if 'BPN
- QUIT
- SET TX=$GET(BPADDMSG(BPN))
- SET PAMSG=$SELECT(PAMSG="":TX,1:PAMSG_" "_TX)
- +64 DO WRAPTXT(PAMSG,62,.BPARR)
- +65 SET BPN=0
- FOR
- SET BPN=$ORDER(BPARR(BPN))
- if 'BPN
- QUIT
- Begin DoDot:1
- +66 SET PREFIX=$SELECT(BPN=1:"Payer Addl Msg :",1:"")
- +67 SET TXTLN=$$LJ^XLFSTR(PREFIX,17)_$GET(BPARR(BPN,0))
- +68 DO SETLN(TXTLN)
- +69 QUIT
- End DoDot:1
- +70 ;
- REJX ;
- +1 DO SETLN(" ")
- DO SETLN(" ")
- +2 QUIT
- +3 ;
- BPSCOM ; display full opecc comments here
- +1 NEW CMTDT,ZN,CDAT,CDATE,CUSER,RXFLG,TXT,CTXT,L,TXTLN
- +2 DO SETLN("OPECC COMMENTS",1,1)
- +3 ;
- +4 IF '$ORDER(^BPST(BPORI59,11,0))
- DO SETLN(" There are no comments found for this section.")
- GOTO BPSCOMX
- +5 ;
- +6 SET CMTDT=" "
- FOR
- SET CMTDT=$ORDER(^BPST(BPORI59,11,"B",CMTDT),-1)
- if 'CMTDT
- QUIT
- SET ZN=" "
- FOR
- SET ZN=$ORDER(^BPST(BPORI59,11,"B",CMTDT,ZN),-1)
- if 'ZN
- QUIT
- Begin DoDot:1
- +7 SET CDAT=$GET(^BPST(BPORI59,11,ZN,0))
- +8 ; external date/time of comment
- SET CDATE=$$FMTE^XLFDT(CMTDT,"2ZMP")
- +9 ; user name who entered comment
- SET CUSER=$PIECE($GET(^VA(200,+$PIECE(CDAT,U,2),0)),U,1)
- +10 ; flag that says if opecc comment should be displayed on PSO RI screen
- SET RXFLG=$SELECT($PIECE(CDAT,U,4):" (Pharm)",1:"")
- +11 SET TXT=CDATE_RXFLG_" - "_$PIECE(CDAT,U,3)_" ("_CUSER_")"
- +12 DO WRAPTXT(TXT,76,.CTXT)
- +13 SET L=0
- FOR
- SET L=$ORDER(CTXT(L))
- if 'L
- QUIT
- Begin DoDot:2
- +14 SET TXTLN=$SELECT(L=1:"- ",1:" ")_$GET(CTXT(L,0))
- +15 DO SETLN(TXTLN)
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 ;
- BPSCOMX ;
- +1 DO SETLN(" ")
- DO SETLN(" ")
- +2 QUIT
- +3 ;
- PSOCOM ; display the PSO comments from the pharmacist
- +1 NEW RXCOB,COM,REJ,NUMREJ,REJIEN,REJDESC,COMDT,Z1,CDAT,CDATE,CUSER,TXT,CTXT,L,TXTLN
- +2 ;
- +3 SET RXCOB=+$PIECE($GET(^BPST(BPORI59,0)),U,14)
- IF 'RXCOB
- SET RXCOB=1
- +4 ; build the PSO comments array for this Rx/fill/cob (ICR# 6227)
- DO REJCOM^PSOREJU4(RXIEN,RXFIL,RXCOB,.COM)
- +5 ;
- +6 DO SETLN("PHARMACIST COMMENTS",1,1)
- +7 ;
- +8 ; count the number of reject codes that have PSO comments
- SET REJ=""
- FOR NUMREJ=0:1
- SET REJ=$ORDER(COM(REJ))
- if REJ=""
- QUIT
- +9 IF 'NUMREJ
- DO SETLN(" There are no comments found for this section.")
- GOTO PSOCOMX
- +10 ;
- +11 SET REJ=""
- FOR
- SET REJ=$ORDER(COM(REJ))
- if REJ=""
- QUIT
- Begin DoDot:1
- +12 ;
- +13 ; if there are 2 or more reject codes that have comments, then display the reject code/description here
- +14 IF NUMREJ>1
- Begin DoDot:2
- +15 ; reject code internal IEN
- SET REJIEN=+$ORDER(^BPSF(9002313.93,"B",REJ,""),-1)
- +16 ; reject description
- SET REJDESC=$PIECE($GET(^BPSF(9002313.93,REJIEN,0)),U,2)
- +17 DO SETLN(REJ_" - "_REJDESC)
- +18 QUIT
- End DoDot:2
- +19 ;
- +20 SET COMDT=" "
- FOR
- SET COMDT=$ORDER(COM(REJ,COMDT),-1)
- if 'COMDT
- QUIT
- SET Z1=" "
- FOR
- SET Z1=$ORDER(COM(REJ,COMDT,Z1),-1)
- if 'Z1
- QUIT
- Begin DoDot:2
- +21 SET CDAT=$GET(COM(REJ,COMDT,Z1))
- +22 SET CDATE=$$FMTE^XLFDT($PIECE(CDAT,U,1),"2ZMP")
- +23 SET CUSER=$PIECE($GET(^VA(200,+$PIECE(CDAT,U,2),0)),U,1)
- +24 SET TXT=CDATE_" - "_$PIECE(CDAT,U,3)_" ("_CUSER_")"
- +25 DO WRAPTXT(TXT,76,.CTXT)
- +26 SET L=0
- FOR
- SET L=$ORDER(CTXT(L))
- if 'L
- QUIT
- Begin DoDot:3
- +27 SET TXTLN=$SELECT(L=1:"- ",1:" ")_$GET(CTXT(L,0))
- +28 DO SETLN(TXTLN)
- +29 QUIT
- End DoDot:3
- +30 QUIT
- End DoDot:2
- +31 ;
- +32 ; if there are more reject codes, display a blank line here before the next reject code
- +33 IF $ORDER(COM(REJ))'=""
- DO SETLN(" ")
- +34 QUIT
- End DoDot:1
- +35 ;
- PSOCOMX ;
- +1 DO SETLN(" ")
- DO SETLN(" ")
- +2 QUIT
- +3 ;
- INS ; gather and show insurance information
- +1 NEW BPSINS,IENS,INSNAME,RXCOB,BPSPOL,BPSEFDT
- +2 SET BPSINS=+$$GET1^DIQ(9002313.59,BPORI59,901,"I")
- IF 'BPSINS
- SET BPSINS=1
- +3 SET IENS=BPSINS_","_BPORI59_","
- +4 SET RXCOB=+$PIECE($GET(^BPST(BPORI59,0)),U,14)
- IF 'RXCOB
- SET RXCOB=1
- +5 ;
- +6 SET INSNAME=$$LJ^XLFSTR($$GET1^DIQ(9002313.59902,IENS,902.24),32)
- +7 IF RXCOB=2
- SET INSNAME=INSNAME_"Coord. Of Benefits: SECONDARY"
- +8 ; pt insurance 2.312 subfile ien
- SET BPSPOL=+$$GET1^DIQ(9002313.59902,IENS,902.35,"I")
- +9 ; policy effective date
- SET BPSEFDT=$SELECT(BPSPOL:+$PIECE($GET(^DPT(DFN,.312,BPSPOL,0)),U,8)\1,1:"")
- +10 ; external policy effective date
- IF BPSEFDT
- SET BPSEFDT=$$FMTE^XLFDT(BPSEFDT,"5DZ")
- +11 ;
- +12 DO SETLN("INSURANCE Information",1,1)
- +13 DO SETLN("Insurance : "_INSNAME)
- +14 DO SETLN("Contact : "_$$GET1^DIQ(9002313.59902,IENS,902.26))
- +15 DO SETLN("BIN : "_$$GET1^DIQ(9002313.59902,IENS,902.03))
- +16 DO SETLN("PCN : "_$$GET1^DIQ(9002313.59902,IENS,902.04))
- +17 DO SETLN("Group Number : "_$$GET1^DIQ(9002313.59902,IENS,902.05))
- +18 DO SETLN("Cardholder ID : "_$$GET1^DIQ(9002313.59902,IENS,902.06))
- +19 DO SETLN("Effective Date : "_BPSEFDT)
- +20 ;
- INSX ;
- +1 DO SETLN(" ")
- DO SETLN(" ")
- +2 QUIT
- +3 ;
- WRAPTXT(X,DIWR,RET) ; wrap text in variable X with right margin DIWR, return in array RET
- +1 NEW %,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,DN,I,Z
- +2 KILL ^UTILITY($JOB,"W"),RET
- +3 SET DIWL=1
- +4 DO ^DIWP
- +5 MERGE RET=^UTILITY($JOB,"W",1)
- +6 KILL ^UTILITY($JOB,"W")
- WRAPX ;
- +1 QUIT
- +2 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("BPSSCRRJ",$JOB),^TMP("PSOPI",$JOB)
- +2 QUIT
- +3 ;
- SETLN(TEXT,REV,UND,HIG) ; set a line into the ListMan array
- +1 IF $GET(TEXT)=""
- SET TEXT=" "
- +2 IF $LENGTH(TEXT)>80
- SET TEXT=$EXTRACT(TEXT,1,80)
- +3 SET LINE=LINE+1
- +4 DO SET^VALM10(LINE,TEXT)
- +5 SET VALMCNT=LINE
- +6 ;
- +7 IF $GET(REV)
- Begin DoDot:1
- +8 DO CNTRL^VALM10(LINE,1,$LENGTH(TEXT),IORVON,IOINORM)
- +9 IF $GET(UND)
- DO CNTRL^VALM10(LINE,$LENGTH(TEXT)+1,80,IOUON,IOINORM)
- +10 QUIT
- End DoDot:1
- GOTO SETLNX
- +11 ;
- +12 IF $GET(UND)
- DO CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
- +13 ;
- +14 IF $GET(HIG)
- DO CNTRL^VALM10(LINE,HIG,80,IOINHI_$SELECT($GET(UND):IOUON,1:""),IOINORM)
- +15 ;
- SETLNX ;
- +1 QUIT
- +2 ;
- HDR ; -- header code
- +1 NEW PTINFO
- +2 ; division, npi, ncpdp data
- SET VALMHDR(1)=$$DVINFO(RXIEN,RXFIL)
- +3 SET PTINFO=$$PTINFO(RXIEN)
- +4 ; Patient data
- SET VALMHDR(2)=$PIECE(PTINFO,U,1)
- +5 ; Patient sex
- SET VALMHDR(3)=$PIECE(PTINFO,U,2)
- +6 ; Rx data part 1
- SET VALMHDR(4)=$$RXINFO1(RXIEN,RXFIL)
- +7 ; Rx data part 2
- SET VALMHDR(5)=$$RXINFO2(RXIEN,RXFIL)
- +8 QUIT
- +9 ;
- DVINFO(RX,RFL) ; header division data
- +1 ;Input: (r) RX - Rx IEN (#52)
- +2 ; (o) RFL - Refill #
- +3 NEW BPSTAXID,DVIEN,DVINFO,NCPNPI
- +4 ; Pharmacy Division name from BPS Transaction
- SET DVINFO="Division : "_$EXTRACT($$GET1^DIQ(9002313.59,BPORI59,11),1,15)
- +5 ;Display both NPI and NCPDP numbers
- +6 ; ICR# 4701
- SET DVIEN=+$$RXSITE^PSOBPSUT(RX,RFL)
- +7 ;
- +8 ; Check for Controlled Substance Drug and if a BPS Pharmacy for CS has
- +9 ; been defined. If so, use NCPDP# & NPI for the CS Pharmacy.
- +10 SET NCPNPI=$$CSNPI^BPSUTIL(RX,RFL)
- +11 ;
- +12 ; If not a Controlled Substance, use NCDPD# & NPI info based on Division.
- +13 IF +NCPNPI=-1
- SET NCPNPI=$$DIVNCPDP^BPSBUTL(DVIEN)
- +14 SET $EXTRACT(DVINFO,28)="NPI: "_$PIECE(NCPNPI,U,2)
- +15 SET $EXTRACT(DVINFO,44)="NCPDP: "_$PIECE(NCPNPI,U,1)
- +16 ; ICR# 6768
- SET BPSTAXID=$PIECE($$TAXID^IBCEF75,U,2)
- +17 SET $EXTRACT(DVINFO,62)="TAX ID: "_$EXTRACT(BPSTAXID,1,2)_"-"_$EXTRACT(BPSTAXID,3,$LENGTH(BPSTAXID))
- +18 QUIT DVINFO
- +19 ;
- PTINFO(RX) ; header patient data
- +1 ;Input: (r) RX - Rx IEN (#52)
- +2 NEW DFN,PTINFO,SEX,SSN4,VADM
- +3 SET DFN=+$PIECE($GET(^BPST(BPORI59,0)),U,6)
- +4 DO DEM^VADPT
- SET SSN4=$PIECE($GET(VADM(2)),U,2)
- +5 SET PTINFO="Patient : "_$EXTRACT($GET(VADM(1)),1,24)_"("_$EXTRACT(SSN4,$LENGTH(SSN4)-3,$LENGTH(SSN4))_")"
- +6 SET $EXTRACT(PTINFO,61)="DOB: "_$PIECE($GET(VADM(3)),U,2)_"("_$PIECE($GET(VADM(4)),U,1)_")"
- +7 SET SEX="Birth Sex: "_$PIECE($GET(VADM(5)),U,1)
- +8 SET $EXTRACT(SEX,32)="Self-Identified Gender: "_$EXTRACT($PIECE($GET(VADM(14,5)),U,1),1,24)
- +9 QUIT PTINFO_U_SEX
- +10 ;
- RXINFO1(RX,FILL) ; header Rx data part 1
- +1 NEW RXINFO,RXDOS,PSOET
- +2 ; Get Date of Service from BPS CLAIM field 401
- DO GETDAT^BPSBUTL(RX,FILL,,.RXDOS)
- +3 SET RXINFO="Rx# : "_$$RXNUM^BPSSCRU2(RX)_"/"_FILL
- +4 ; TRI/CVA non-billable entry
- SET PSOET=$$NB^BPSSCR03(BPORI59)
- +5 SET $EXTRACT(RXINFO,27)="ECME#: "_$SELECT(PSOET:"",1:$PIECE($$CLAIM^BPSBUTL(RX,FILL),U,6))
- +6 ; Use DOS from BPS Claims field 401
- SET $EXTRACT(RXINFO,49)="Date of Service: "_$SELECT(PSOET:"",1:$$FMTE^XLFDT(RXDOS))
- +7 QUIT RXINFO
- +8 ;
- RXINFO2(RX,FILL) ; header Rx data part 2
- +1 NEW RXINFO,DRG,CMOP
- +2 ; drug ien
- SET DRG=+$$RXAPI1^BPSUTIL1(RX,6,"I")
- +3 ; cmop dispense field in the Drug file (0/1)
- SET CMOP=$$DRUGDIE^BPSUTIL1(DRG,213,"I")
- +4 SET RXINFO=$SELECT(CMOP:"CMOP ",1:"")_"Drug"
- +5 ; drug name
- SET $EXTRACT(RXINFO,10)=": "_$EXTRACT($$RXAPI1^BPSUTIL1(RX,6),1,43)
- +6 ;
- +7 ; ICR# 4705
- SET $EXTRACT(RXINFO,56)="NDC Code: "_$$GETNDC^PSONDCUT(RX,FILL)
- +8 QUIT RXINFO
- +9 ;
- VER ; selection of View ePharmacy Rx from the BPS OPECC reject information screen
- +1 NEW BPSVRX
- +2 DO FULL^VALM1
- +3 SET BPSVRX("RXIEN")=$GET(RXIEN)
- +4 SET BPSVRX("FILL#")=$GET(RXFIL)
- +5 DO ^BPSVRX
- VERX ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- VIEW ; action for View Rx on the BPS OPECC reject information screen
- +1 NEW VALMCNT,LINE,VALMHDR,TITLE,PSOVDA,DA,PS,DFN,PSODFN
- +2 SET TITLE=VALM("TITLE")
- +3 SET (PSOVDA,DA)=RXIEN
- SET PS="REJECT"
- +4 ;
- +5 ; - DO structure used to avoid losing key variables in this routine
- +6 Begin DoDot:1
- +7 NEW RXIEN,RXFIL,BPORI59,TITLE
- +8 ; ICR# 4711
- DO DP^PSORXVW
- +9 QUIT
- End DoDot:1
- +10 ;
- +11 SET VALMBCK="R"
- SET VALM("TITLE")=TITLE
- +12 QUIT
- +13 ;
- MP(RXIEN,RXFIL) ; entry point for Medication Profile action on OPECC reject information screen
- +1 NEW VALMCNT,LINE,VALMHDR,DFN,PSODFN,BPORI59
- +2 ; ICR# 6228
- DO MP^PSOREJU4(RXIEN,RXFIL)
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- PI(RXIEN,RXFIL) ; entry point for Patient Information action on OPECC reject information screen
- +1 NEW VALMCNT,LINE,VALMHDR,DFN,PSODFN,BPORI59
- +2 ; ICR# 6228
- DO PI^PSOREJU4(RXIEN,RXFIL)
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;