Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSSCRRJ

BPSSCRRJ.m

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