BPSSCRL1 ;AITC/CKB - ECME LOGINFO ;06/01/2017
;;1.0;E CLAIMS MGMT ENGINE;**22,24,28,37**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to $$NCPDPQTY^PSSBPSUT in ICR #4992
; Moved from BPSSCRLG
Q
;
PREPINFO(BPLN,BPDFN,BP36,BP59) ;
;input:
; BPDFN: patient ien #2
; BP36: insurance ien #36
; BP59: ptr to #9002313.59
; returns # of lines
N BPSECME
I '$G(BP59) Q 0
I '$G(BP36) Q 0
I '$G(BPDFN) Q 0
N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
N BPX,BPRXIEN,BPRXN,BPREF,BP1,BPLSTCLM,BPLSTRSP,BPDAT59,BPUSR,BPSTRT,BPHIST,BPQ
N BPDT,BPLN0,BPCNT,DFN,VADM
S DFN=BPDFN D DEM^VADPT
S BP1=$$RXREF^BPSSCRU2(BP59)
S BPRXIEN=$P(BP1,U,1)
S BPRXN=$$RXNUM^BPSSCRU2(+BPRXIEN)
S BPREF=$P(BP1,U,2)
S BPDAT59(0)=$G(^BPST(BP59,0))
;create history
D MKHIST^BPSSCRU5(BP59,.BPHIST)
;
S BPLN0=BPLN
D SETLINE^BPSSCRLG(.BPLN,"Pharmacy ECME Log")
D SETLINE^BPSSCRLG(.BPLN,"")
S BPX=$$RJ^BPSSCR02("Rx #: ",20)_BPRXN_"/"_BPREF
S BPSECME=$$ECMENUM^BPSSCRU2(BP59)
S BPX=BPX_$$RJ^BPSSCR02("ECME #: ",20)_BPSECME
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Drug: ",20)_$$DRGNAM^BPSSCRU2($$GETDRG59^BPSSCRU2(BP59))
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Patient: ",20)
S BPX=BPX_$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN)_" "_$$SSN4^BPSSCRU2(BPDFN),27)
S BPX=BPX_$$LJ^BPSSCR02("DOB: "_$P($G(VADM(3)),"^",2)_"("_$G(VADM(4))_")",20)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Birth Sex: ",20)_$$LJ^BPSSCR02($P($G(VADM(5)),"^",1),10)
S BPX=BPX_"Self-Identified Gender: "_$P($G(VADM(14,5)),"^",1)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Transaction Number: ",20)
S BPX=BPX_$P($G(^BPST(BP59,0)),U,1)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Last Submitted: ",20)
S BPSTRT=$P(BPDAT59(0),U,11) ;@# need to check with analyst if this is a START DATE
I BPSTRT]"" S BPX=BPX_$$DATETIME^BPSSCRU5(BPSTRT)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX=$$RJ^BPSSCR02("Last Submitted By: ",20)
S BPUSR=$P(BPDAT59(0),U,10)
I BPUSR]"" S BPX=BPX_$$GETUSRNM^BPSSCRU1(BPUSR)
D SETLINE^BPSSCRLG(.BPLN,BPX)
;
;latest claim
S BP1=+$O(BPHIST("C",99999999),-1)
I BP1=0 D SETLINE^BPSSCRLG(.BPLN,""),SETLINE^BPSSCRLG(.BPLN,"------ No electronic claims ------") Q BPLN
S BP1=+$O(BPHIST("C",BP1,0))
S BPX=$$RJ^BPSSCR02("Last VA Claim #: ",20)_$P($G(^BPSC(+BP1,0)),U,1)
D SETLINE^BPSSCRLG(.BPLN,BPX)
F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE^BPSSCRLG(.BPLN,"")
;process history
N BPTYPE,BPIEN,BPIENRS
S BPDT=99999999
F S BPDT=$O(BPHIST("C",BPDT),-1) Q:+BPDT=0 D
. S BPIEN=+$O(BPHIST("C",BPDT,0)) Q:BPIEN=""
. D DISPCLM(.BPLN,BP59,BPIEN,+BPHIST("C",BPDT,BPIEN),$P(BPHIST("C",BPDT,BPIEN),U,2),BPDT)
. S BPIENRS=0
. F S BPIENRS=$O(BPHIST("C",BPDT,BPIEN,"R",BPIENRS)) Q:+BPIENRS=0 D
. . D DISPRSP(.BPLN,BP59,BPIENRS,+BPHIST("C",BPDT,BPIEN,"R",BPIENRS),$P(BPHIST("C",BPDT,BPIEN,"R",BPIENRS),U,2),BPDT)
. . D DISPPYR^BPSSCRLG(.BPLN,BPIENRS)
Q BPLN
;
;display claim record
DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ;
N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
N BPX,BPLN0,BPCNT,BPSTR1,BPSTYP2,BPNFLDT,BPUNITS
;
S BPLN0=BPLN
S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
S BPSTR1="Transmission Information ("_BPSTYP2_")(#"_BPIEN02_")"
D SETLINE^BPSSCRLG(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-"))
D SETLINE^BPSSCRLG(.BPLN,"Created on: "_$$CREATEDT^BPSSCRLG(BPIEN02,BPSDTALT))
D SETLINE^BPSSCRLG(.BPLN,"VA Claim ID: "_$P($G(^BPSC(+BPIEN02,0)),U,1))
D SETLINE^BPSSCRLG(.BPLN,"Submitted By: "_$$SUBMTBY^BPSSCRLG(BP57))
D SETLINE^BPSSCRLG(.BPLN,"Transaction Type: "_$$TRTYPE^BPSSCRU5($$TRCODE^BPSSCRLG(BPIEN02)))
D SETLINE^BPSSCRLG(.BPLN,"Date of Service: "_$$DOSCLM^BPSSCRLG(BPIEN02))
;Display Next Available Fill Date - BPS*1.0*15
S BPNFLDT=$$NFLDT^BPSBUTL(BPRXIEN,BPREF,$$RXCOB57^BPSSCRLG(BP57))
D:BPNFLDT SETLINE^BPSSCRLG(.BPLN,"Next Available Fill Date: "_$$FMTE^XLFDT(BPNFLDT,"2ZM"))
D SETLINE^BPSSCRLG(.BPLN,"NDC Code: "_$$LNDC^BPSSCRU5(BPIEN02))
;
S BPUNITS=$$UNITS^BPSSCRLG(BPIEN02)
; if BPUNITS is null get the BPUNITS from the PRESCRIPTION file (#52)
I BPUNITS="( )" S BPUNITS=$$GETUNIT(BPRXIEN,$G(BPREF))
D SETLINE^BPSSCRLG(.BPLN,"Quantity Submitted on Claim: "_$$QTY^BPSSCRLG(BPIEN02)_" "_BPUNITS)
;
D SETLINE^BPSSCRLG(.BPLN,"Days Supply: "_$$DAYSSUPL^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Division: "_$$DIV^BPSSCRLG(BP57))
D SETLINE^BPSSCRLG(.BPLN,"NPI#: "_$$NPI^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Prescriber DEA Number: "_$$PDEA^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"ECME Pharmacy: "_$$DIVNAME^BPSSCRDS($$LDIV^BPSSCRLG(BP57)))
D SETLINE^BPSSCRLG(.BPLN,"Patient Gender Code: "_$$GET1^DIQ(9002313.02,BPIEN02,305,"E"))
D SETLINE^BPSSCRLG(.BPLN,"Total Prescribed Quantity Remaining: "_$$TOTPQR^BPSSCRLG(BPIEN02))
S BPX="Rx Qty: "_$$BILLQTY^BPSSCRLG(BP57)_" "_$$BILLUNT^BPSSCRLG(BP57)
S BPX=BPX_" Unit Cost: "_$$UNTPRICE^BPSSCRLG(BP57)
S BPX=BPX_" Gross Amt Due: "_$$TOTPRICE^BPSSCRLG(BPIEN02)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX="Ingredient Cost: "_$$INGRCST^BPSSCRLG(BPIEN02)
S BPX=BPX_" Dispensing Fee: "_$$DISPFEE^BPSSCRLG(BPIEN02)
D SETLINE^BPSSCRLG(.BPLN,BPX)
S BPX="U&C Charge: "_$$UCCHRG^BPSSCRLG(BPIEN02)
S BPX=BPX_" Admin Fee: "_$$ADMNFEE^BPSSCRLG(BPIEN02)
D SETLINE^BPSSCRLG(.BPLN,BPX)
D SETLINE^BPSSCRLG(.BPLN,"")
D SETLINE^BPSSCRLG(.BPLN,"Insurance Name: "_$$INSUR57^BPSSCRLG(BP57))
D SETLINE^BPSSCRLG(.BPLN,"Group Name: "_$$GRPNM^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Rx Coordination of Benefits: "_$$RXCOB57^BPSSCRLG(BP57))
D SETLINE^BPSSCRLG(.BPLN,"Pharmacy Plan ID: "_$$PHPLANID^BPSSCRLG(BP57))
D SETLINE^BPSSCRLG(.BPLN,"BIN: "_$$BIN^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"PCN: "_$$PCN^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"NCPDP Version: "_$$GETVER^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Group ID: "_$$GRPID^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Cardholder ID: "_$$CRDHLDID^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Patient Relationship Code: "_$$PATRELSH^BPSSCRLG(BPIEN02))
D SETLINE^BPSSCRLG(.BPLN,"Cardholder First Name: "_$$CRDHLDFN^BPSSCRLG(BPIEN02,BP57))
D SETLINE^BPSSCRLG(.BPLN,"Cardholder Last Name: "_$$CRDHLDLN^BPSSCRLG(BPIEN02,BP57))
; BPS*1*22
D SETLINE^BPSSCRLG(.BPLN,"Facility ID Qualifier: "_$$FACIDQ^BPSSCRLG(BPIEN02))
F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE^BPSSCRLG(.BPLN,"")
S BPLN0=BPLN
D SETLINE^BPSSCRLG(.BPLN,"Billing Request Payer Sheet: "_$$B1PYRIEN^BPSSCRU5(BP57))
D SETLINE^BPSSCRLG(.BPLN,"Reversal Payer Sheet: "_$$B2PYRIEN^BPSSCRU5(BP57))
D SETLINE^BPSSCRLG(.BPLN,"VA Claim ID: "_$P($G(^BPSC(+BPIEN02,0)),U,1))
D SETLINE^BPSSCRLG(.BPLN,"")
Q
;
GETUNIT(BPRXIEN,BPREF) ; Return the NCPDP Dispense Unit
; Input: (r) BPRXIEN - Quantity dispensed from the PRESCRIPTION file (#52)
; BPREF - Rx Refill
;0utput: BPUNITS - Billing Quantity (3 decimal places)^NCPDP Dispense Unit (EA, GM or ML)
;
N BPDRUG,BPQTY,BPUNITS,Z
;
; Find NCPDP Dispense Unit from PRESCRIPTION file (#52)
S BPDRUG=$$GET1^DIQ(52,BPRXIEN,6,"I")
S BPQTY=$S($G(BPREF)="":$$GET1^DIQ(52,BPRXIEN,7,"I"),1:$$GET1^DIQ(52.1,BPREF_","_BPRXIEN,1))/1
S Z=$$NCPDPQTY^PSSBPSUT(BPDRUG,BPQTY)
S BPUNITS=$P(Z,"^",2)
Q "("_BPUNITS_")"
;
;display response record
DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ;
N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
N BPX,BPLN0,BPCNT,BPRJCDS,BPRJ,BPSTR1,BPSTYP2,BDUR,BMSG,PTRESP
S BPLN0=BPLN
S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
S BPSTR1="Response Information ("_BPSTYP2_")(#"_BPIEN03_")"
D SETLINE^BPSSCRLG(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-"))
D SETLINE^BPSSCRLG(.BPLN,"Response Received: "_$$RESPREC^BPSSCRLG(BPIEN03,BPSDTALT))
D SETLINE^BPSSCRLG(.BPLN,"Date of Service: "_$$DOSRSP^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Transaction Response Status: "_$$RESPSTAT^BPSSCRU5(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Total Amount Paid: $"_$$TOTAMNT^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Ingredient Cost Paid: $"_$$ICPAID^BPSSCRLG(BPIEN03)_" Dispensing Fee Paid: $"_$$DFPAID^BPSSCRLG(BPIEN03))
S PTRESP=$$PTRESP^BPSSCRLG(BPIEN03) S PTRESP=$S(PTRESP="":"$",PTRESP="0.00":"$0",1:"($"_PTRESP_")")
D SETLINE^BPSSCRLG(.BPLN,"Patient Resp (INS): "_PTRESP)
; BPS*1*22
D SETLINE^BPSSCRLG(.BPLN,"Reconciliation ID: "_$$RECONID^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Reject code(s): ")
D REJCODES^BPSSCRU5(BPIEN03,.BPRJCDS)
S BPRJ=""
F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D
. D SETLINE^BPSSCRLG(.BPLN," "_$$GETRJNAM^BPSSCRU3(BPRJ))
D WRAPLN^BPSSCRU5(.BPLN,$$MESSAGE^BPSSCRLG(BPIEN03),76,"Payer Message: ",5)
D ADDMESS^BPSSCRLG(BPIEN03,1,.BPADDMSG)
S BMSG="" F S BMSG=$O(BPADDMSG(BMSG)) Q:BMSG="" D
. D WRAPLN^BPSSCRU5(.BPLN,BPADDMSG(BMSG),76,$S(BMSG=1:"Payer Additional Message: ",1:" "),5)
D SETLINE^BPSSCRLG(.BPLN,"Reason for Service Code: "_$$DURREAS^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR Text: "_$$DURTEXT^BPSSCRLG(BPIEN03))
D WRAPLN^BPSSCRU5(.BPLN,$$DURADD^BPSSCRLG(BPIEN03),76,"DUR Additional Text: ",5)
; BPS*1*18: Print Claim Log [BPS PRTCL USRSCR CLAIM LOG] (when included in the incoming response)
D SETLINE^BPSSCRLG(.BPLN,"HPID/OEID: "_$$HPID^BPSSCRLG(BPIEN03,BP57))
D SETLINE^BPSSCRLG(.BPLN,"Invalid Provider Data Source: "_$$INVPROV^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Formulary Alternative Eff Date: "_$$FAEDT^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Co-Agent Description: "_$$DCADES^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Unit of Prior Dispensed Quantity: "_$$UPDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy ID Qualifier: "_$$OPIDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy Name: "_$$OPNAM^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy Telephone: "_$$OPTELE^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Prescriber Last Name: "_$$OPLNAM^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Prescriber ID Qualifier: "_$$OPRIDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Prescriber ID: "_$$OPRID^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"Other Prescriber Phone Number: "_$$OPRPH^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Compound Product ID: "_$$CMPPID^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Compound Product ID Qualifier: "_$$CMPPIDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Maximum Daily Dose Quantity: "_$$MAXDDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Maximum Daily Dose Unit: "_$$MAXDDU^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Minimum Daily Dose Quantity: "_$$MINDDQ^BPSSCRLG(BPIEN03))
D SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Minimum Daily Dose Unit: "_$$MINDDU^BPSSCRLG(BPIEN03))
;
F BPCNT=1:1:2 D SETLINE^BPSSCRLG(.BPLN,"")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRL1 11091 printed Nov 22, 2024@17:03:23 Page 2
BPSSCRL1 ;AITC/CKB - ECME LOGINFO ;06/01/2017
+1 ;;1.0;E CLAIMS MGMT ENGINE;**22,24,28,37**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to $$NCPDPQTY^PSSBPSUT in ICR #4992
+5 ; Moved from BPSSCRLG
+6 QUIT
+7 ;
PREPINFO(BPLN,BPDFN,BP36,BP59) ;
+1 ;input:
+2 ; BPDFN: patient ien #2
+3 ; BP36: insurance ien #36
+4 ; BP59: ptr to #9002313.59
+5 ; returns # of lines
+6 NEW BPSECME
+7 IF '$GET(BP59)
QUIT 0
+8 IF '$GET(BP36)
QUIT 0
+9 IF '$GET(BPDFN)
QUIT 0
+10 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
NEW BPSCRLNS
SET BPSCRLNS=17
+11 NEW BPX,BPRXIEN,BPRXN,BPREF,BP1,BPLSTCLM,BPLSTRSP,BPDAT59,BPUSR,BPSTRT,BPHIST,BPQ
+12 NEW BPDT,BPLN0,BPCNT,DFN,VADM
+13 SET DFN=BPDFN
DO DEM^VADPT
+14 SET BP1=$$RXREF^BPSSCRU2(BP59)
+15 SET BPRXIEN=$PIECE(BP1,U,1)
+16 SET BPRXN=$$RXNUM^BPSSCRU2(+BPRXIEN)
+17 SET BPREF=$PIECE(BP1,U,2)
+18 SET BPDAT59(0)=$GET(^BPST(BP59,0))
+19 ;create history
+20 DO MKHIST^BPSSCRU5(BP59,.BPHIST)
+21 ;
+22 SET BPLN0=BPLN
+23 DO SETLINE^BPSSCRLG(.BPLN,"Pharmacy ECME Log")
+24 DO SETLINE^BPSSCRLG(.BPLN,"")
+25 SET BPX=$$RJ^BPSSCR02("Rx #: ",20)_BPRXN_"/"_BPREF
+26 SET BPSECME=$$ECMENUM^BPSSCRU2(BP59)
+27 SET BPX=BPX_$$RJ^BPSSCR02("ECME #: ",20)_BPSECME
+28 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+29 SET BPX=$$RJ^BPSSCR02("Drug: ",20)_$$DRGNAM^BPSSCRU2($$GETDRG59^BPSSCRU2(BP59))
+30 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+31 SET BPX=$$RJ^BPSSCR02("Patient: ",20)
+32 SET BPX=BPX_$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN)_" "_$$SSN4^BPSSCRU2(BPDFN),27)
+33 SET BPX=BPX_$$LJ^BPSSCR02("DOB: "_$PIECE($GET(VADM(3)),"^",2)_"("_$GET(VADM(4))_")",20)
+34 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+35 SET BPX=$$RJ^BPSSCR02("Birth Sex: ",20)_$$LJ^BPSSCR02($PIECE($GET(VADM(5)),"^",1),10)
+36 SET BPX=BPX_"Self-Identified Gender: "_$PIECE($GET(VADM(14,5)),"^",1)
+37 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+38 SET BPX=$$RJ^BPSSCR02("Transaction Number: ",20)
+39 SET BPX=BPX_$PIECE($GET(^BPST(BP59,0)),U,1)
+40 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+41 SET BPX=$$RJ^BPSSCR02("Last Submitted: ",20)
+42 ;@# need to check with analyst if this is a START DATE
SET BPSTRT=$PIECE(BPDAT59(0),U,11)
+43 IF BPSTRT]""
SET BPX=BPX_$$DATETIME^BPSSCRU5(BPSTRT)
+44 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+45 SET BPX=$$RJ^BPSSCR02("Last Submitted By: ",20)
+46 SET BPUSR=$PIECE(BPDAT59(0),U,10)
+47 IF BPUSR]""
SET BPX=BPX_$$GETUSRNM^BPSSCRU1(BPUSR)
+48 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+49 ;
+50 ;latest claim
+51 SET BP1=+$ORDER(BPHIST("C",99999999),-1)
+52 IF BP1=0
DO SETLINE^BPSSCRLG(.BPLN,"")
DO SETLINE^BPSSCRLG(.BPLN,"------ No electronic claims ------")
QUIT BPLN
+53 SET BP1=+$ORDER(BPHIST("C",BP1,0))
+54 SET BPX=$$RJ^BPSSCR02("Last VA Claim #: ",20)_$PIECE($GET(^BPSC(+BP1,0)),U,1)
+55 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+56 FOR BPCNT=BPLN:1:BPLN0+BPSCRLNS
DO SETLINE^BPSSCRLG(.BPLN,"")
+57 ;process history
+58 NEW BPTYPE,BPIEN,BPIENRS
+59 SET BPDT=99999999
+60 FOR
SET BPDT=$ORDER(BPHIST("C",BPDT),-1)
if +BPDT=0
QUIT
Begin DoDot:1
+61 SET BPIEN=+$ORDER(BPHIST("C",BPDT,0))
if BPIEN=""
QUIT
+62 DO DISPCLM(.BPLN,BP59,BPIEN,+BPHIST("C",BPDT,BPIEN),$PIECE(BPHIST("C",BPDT,BPIEN),U,2),BPDT)
+63 SET BPIENRS=0
+64 FOR
SET BPIENRS=$ORDER(BPHIST("C",BPDT,BPIEN,"R",BPIENRS))
if +BPIENRS=0
QUIT
Begin DoDot:2
+65 DO DISPRSP(.BPLN,BP59,BPIENRS,+BPHIST("C",BPDT,BPIEN,"R",BPIENRS),$PIECE(BPHIST("C",BPDT,BPIEN,"R",BPIENRS),U,2),BPDT)
+66 DO DISPPYR^BPSSCRLG(.BPLN,BPIENRS)
End DoDot:2
End DoDot:1
+67 QUIT BPLN
+68 ;
+69 ;display claim record
DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ;
+1 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
NEW BPSCRLNS
SET BPSCRLNS=17
+2 NEW BPX,BPLN0,BPCNT,BPSTR1,BPSTYP2,BPNFLDT,BPUNITS
+3 ;
+4 SET BPLN0=BPLN
+5 SET BPSTYP2=$SELECT(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
+6 SET BPSTR1="Transmission Information ("_BPSTYP2_")(#"_BPIEN02_")"
+7 DO SETLINE^BPSSCRLG(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$LENGTH(BPSTR1),"-"))
+8 DO SETLINE^BPSSCRLG(.BPLN,"Created on: "_$$CREATEDT^BPSSCRLG(BPIEN02,BPSDTALT))
+9 DO SETLINE^BPSSCRLG(.BPLN,"VA Claim ID: "_$PIECE($GET(^BPSC(+BPIEN02,0)),U,1))
+10 DO SETLINE^BPSSCRLG(.BPLN,"Submitted By: "_$$SUBMTBY^BPSSCRLG(BP57))
+11 DO SETLINE^BPSSCRLG(.BPLN,"Transaction Type: "_$$TRTYPE^BPSSCRU5($$TRCODE^BPSSCRLG(BPIEN02)))
+12 DO SETLINE^BPSSCRLG(.BPLN,"Date of Service: "_$$DOSCLM^BPSSCRLG(BPIEN02))
+13 ;Display Next Available Fill Date - BPS*1.0*15
+14 SET BPNFLDT=$$NFLDT^BPSBUTL(BPRXIEN,BPREF,$$RXCOB57^BPSSCRLG(BP57))
+15 if BPNFLDT
DO SETLINE^BPSSCRLG(.BPLN,"Next Available Fill Date: "_$$FMTE^XLFDT(BPNFLDT,"2ZM"))
+16 DO SETLINE^BPSSCRLG(.BPLN,"NDC Code: "_$$LNDC^BPSSCRU5(BPIEN02))
+17 ;
+18 SET BPUNITS=$$UNITS^BPSSCRLG(BPIEN02)
+19 ; if BPUNITS is null get the BPUNITS from the PRESCRIPTION file (#52)
+20 IF BPUNITS="( )"
SET BPUNITS=$$GETUNIT(BPRXIEN,$GET(BPREF))
+21 DO SETLINE^BPSSCRLG(.BPLN,"Quantity Submitted on Claim: "_$$QTY^BPSSCRLG(BPIEN02)_" "_BPUNITS)
+22 ;
+23 DO SETLINE^BPSSCRLG(.BPLN,"Days Supply: "_$$DAYSSUPL^BPSSCRLG(BPIEN02))
+24 DO SETLINE^BPSSCRLG(.BPLN,"Division: "_$$DIV^BPSSCRLG(BP57))
+25 DO SETLINE^BPSSCRLG(.BPLN,"NPI#: "_$$NPI^BPSSCRLG(BPIEN02))
+26 DO SETLINE^BPSSCRLG(.BPLN,"Prescriber DEA Number: "_$$PDEA^BPSSCRLG(BPIEN02))
+27 DO SETLINE^BPSSCRLG(.BPLN,"ECME Pharmacy: "_$$DIVNAME^BPSSCRDS($$LDIV^BPSSCRLG(BP57)))
+28 DO SETLINE^BPSSCRLG(.BPLN,"Patient Gender Code: "_$$GET1^DIQ(9002313.02,BPIEN02,305,"E"))
+29 DO SETLINE^BPSSCRLG(.BPLN,"Total Prescribed Quantity Remaining: "_$$TOTPQR^BPSSCRLG(BPIEN02))
+30 SET BPX="Rx Qty: "_$$BILLQTY^BPSSCRLG(BP57)_" "_$$BILLUNT^BPSSCRLG(BP57)
+31 SET BPX=BPX_" Unit Cost: "_$$UNTPRICE^BPSSCRLG(BP57)
+32 SET BPX=BPX_" Gross Amt Due: "_$$TOTPRICE^BPSSCRLG(BPIEN02)
+33 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+34 SET BPX="Ingredient Cost: "_$$INGRCST^BPSSCRLG(BPIEN02)
+35 SET BPX=BPX_" Dispensing Fee: "_$$DISPFEE^BPSSCRLG(BPIEN02)
+36 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+37 SET BPX="U&C Charge: "_$$UCCHRG^BPSSCRLG(BPIEN02)
+38 SET BPX=BPX_" Admin Fee: "_$$ADMNFEE^BPSSCRLG(BPIEN02)
+39 DO SETLINE^BPSSCRLG(.BPLN,BPX)
+40 DO SETLINE^BPSSCRLG(.BPLN,"")
+41 DO SETLINE^BPSSCRLG(.BPLN,"Insurance Name: "_$$INSUR57^BPSSCRLG(BP57))
+42 DO SETLINE^BPSSCRLG(.BPLN,"Group Name: "_$$GRPNM^BPSSCRLG(BPIEN02))
+43 DO SETLINE^BPSSCRLG(.BPLN,"Rx Coordination of Benefits: "_$$RXCOB57^BPSSCRLG(BP57))
+44 DO SETLINE^BPSSCRLG(.BPLN,"Pharmacy Plan ID: "_$$PHPLANID^BPSSCRLG(BP57))
+45 DO SETLINE^BPSSCRLG(.BPLN,"BIN: "_$$BIN^BPSSCRLG(BPIEN02))
+46 DO SETLINE^BPSSCRLG(.BPLN,"PCN: "_$$PCN^BPSSCRLG(BPIEN02))
+47 DO SETLINE^BPSSCRLG(.BPLN,"NCPDP Version: "_$$GETVER^BPSSCRLG(BPIEN02))
+48 DO SETLINE^BPSSCRLG(.BPLN,"Group ID: "_$$GRPID^BPSSCRLG(BPIEN02))
+49 DO SETLINE^BPSSCRLG(.BPLN,"Cardholder ID: "_$$CRDHLDID^BPSSCRLG(BPIEN02))
+50 DO SETLINE^BPSSCRLG(.BPLN,"Patient Relationship Code: "_$$PATRELSH^BPSSCRLG(BPIEN02))
+51 DO SETLINE^BPSSCRLG(.BPLN,"Cardholder First Name: "_$$CRDHLDFN^BPSSCRLG(BPIEN02,BP57))
+52 DO SETLINE^BPSSCRLG(.BPLN,"Cardholder Last Name: "_$$CRDHLDLN^BPSSCRLG(BPIEN02,BP57))
+53 ; BPS*1*22
+54 DO SETLINE^BPSSCRLG(.BPLN,"Facility ID Qualifier: "_$$FACIDQ^BPSSCRLG(BPIEN02))
+55 FOR BPCNT=BPLN:1:BPLN0+BPSCRLNS
DO SETLINE^BPSSCRLG(.BPLN,"")
+56 SET BPLN0=BPLN
+57 DO SETLINE^BPSSCRLG(.BPLN,"Billing Request Payer Sheet: "_$$B1PYRIEN^BPSSCRU5(BP57))
+58 DO SETLINE^BPSSCRLG(.BPLN,"Reversal Payer Sheet: "_$$B2PYRIEN^BPSSCRU5(BP57))
+59 DO SETLINE^BPSSCRLG(.BPLN,"VA Claim ID: "_$PIECE($GET(^BPSC(+BPIEN02,0)),U,1))
+60 DO SETLINE^BPSSCRLG(.BPLN,"")
+61 QUIT
+62 ;
GETUNIT(BPRXIEN,BPREF) ; Return the NCPDP Dispense Unit
+1 ; Input: (r) BPRXIEN - Quantity dispensed from the PRESCRIPTION file (#52)
+2 ; BPREF - Rx Refill
+3 ;0utput: BPUNITS - Billing Quantity (3 decimal places)^NCPDP Dispense Unit (EA, GM or ML)
+4 ;
+5 NEW BPDRUG,BPQTY,BPUNITS,Z
+6 ;
+7 ; Find NCPDP Dispense Unit from PRESCRIPTION file (#52)
+8 SET BPDRUG=$$GET1^DIQ(52,BPRXIEN,6,"I")
+9 SET BPQTY=$SELECT($GET(BPREF)="":$$GET1^DIQ(52,BPRXIEN,7,"I"),1:$$GET1^DIQ(52.1,BPREF_","_BPRXIEN,1))/1
+10 SET Z=$$NCPDPQTY^PSSBPSUT(BPDRUG,BPQTY)
+11 SET BPUNITS=$PIECE(Z,"^",2)
+12 QUIT "("_BPUNITS_")"
+13 ;
+14 ;display response record
DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ;
+1 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
NEW BPSCRLNS
SET BPSCRLNS=17
+2 NEW BPX,BPLN0,BPCNT,BPRJCDS,BPRJ,BPSTR1,BPSTYP2,BDUR,BMSG,PTRESP
+3 SET BPLN0=BPLN
+4 SET BPSTYP2=$SELECT(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
+5 SET BPSTR1="Response Information ("_BPSTYP2_")(#"_BPIEN03_")"
+6 DO SETLINE^BPSSCRLG(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$LENGTH(BPSTR1),"-"))
+7 DO SETLINE^BPSSCRLG(.BPLN,"Response Received: "_$$RESPREC^BPSSCRLG(BPIEN03,BPSDTALT))
+8 DO SETLINE^BPSSCRLG(.BPLN,"Date of Service: "_$$DOSRSP^BPSSCRLG(BPIEN03))
+9 DO SETLINE^BPSSCRLG(.BPLN,"Transaction Response Status: "_$$RESPSTAT^BPSSCRU5(BPIEN03))
+10 DO SETLINE^BPSSCRLG(.BPLN,"Total Amount Paid: $"_$$TOTAMNT^BPSSCRLG(BPIEN03))
+11 DO SETLINE^BPSSCRLG(.BPLN,"Ingredient Cost Paid: $"_$$ICPAID^BPSSCRLG(BPIEN03)_" Dispensing Fee Paid: $"_$$DFPAID^BPSSCRLG(BPIEN03))
+12 SET PTRESP=$$PTRESP^BPSSCRLG(BPIEN03)
SET PTRESP=$SELECT(PTRESP="":"$",PTRESP="0.00":"$0",1:"($"_PTRESP_")")
+13 DO SETLINE^BPSSCRLG(.BPLN,"Patient Resp (INS): "_PTRESP)
+14 ; BPS*1*22
+15 DO SETLINE^BPSSCRLG(.BPLN,"Reconciliation ID: "_$$RECONID^BPSSCRLG(BPIEN03))
+16 DO SETLINE^BPSSCRLG(.BPLN,"Reject code(s): ")
+17 DO REJCODES^BPSSCRU5(BPIEN03,.BPRJCDS)
+18 SET BPRJ=""
+19 FOR
SET BPRJ=$ORDER(BPRJCDS(BPRJ))
if BPRJ=""
QUIT
Begin DoDot:1
+20 DO SETLINE^BPSSCRLG(.BPLN," "_$$GETRJNAM^BPSSCRU3(BPRJ))
End DoDot:1
+21 DO WRAPLN^BPSSCRU5(.BPLN,$$MESSAGE^BPSSCRLG(BPIEN03),76,"Payer Message: ",5)
+22 DO ADDMESS^BPSSCRLG(BPIEN03,1,.BPADDMSG)
+23 SET BMSG=""
FOR
SET BMSG=$ORDER(BPADDMSG(BMSG))
if BMSG=""
QUIT
Begin DoDot:1
+24 DO WRAPLN^BPSSCRU5(.BPLN,BPADDMSG(BMSG),76,$SELECT(BMSG=1:"Payer Additional Message: ",1:" "),5)
End DoDot:1
+25 DO SETLINE^BPSSCRLG(.BPLN,"Reason for Service Code: "_$$DURREAS^BPSSCRLG(BPIEN03))
+26 DO SETLINE^BPSSCRLG(.BPLN,"DUR Text: "_$$DURTEXT^BPSSCRLG(BPIEN03))
+27 DO WRAPLN^BPSSCRU5(.BPLN,$$DURADD^BPSSCRLG(BPIEN03),76,"DUR Additional Text: ",5)
+28 ; BPS*1*18: Print Claim Log [BPS PRTCL USRSCR CLAIM LOG] (when included in the incoming response)
+29 DO SETLINE^BPSSCRLG(.BPLN,"HPID/OEID: "_$$HPID^BPSSCRLG(BPIEN03,BP57))
+30 DO SETLINE^BPSSCRLG(.BPLN,"Invalid Provider Data Source: "_$$INVPROV^BPSSCRLG(BPIEN03))
+31 DO SETLINE^BPSSCRLG(.BPLN,"Formulary Alternative Eff Date: "_$$FAEDT^BPSSCRLG(BPIEN03))
+32 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Co-Agent Description: "_$$DCADES^BPSSCRLG(BPIEN03))
+33 DO SETLINE^BPSSCRLG(.BPLN,"Unit of Prior Dispensed Quantity: "_$$UPDQ^BPSSCRLG(BPIEN03))
+34 DO SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy ID Qualifier: "_$$OPIDQ^BPSSCRLG(BPIEN03))
+35 DO SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy Name: "_$$OPNAM^BPSSCRLG(BPIEN03))
+36 DO SETLINE^BPSSCRLG(.BPLN,"Other Pharmacy Telephone: "_$$OPTELE^BPSSCRLG(BPIEN03))
+37 DO SETLINE^BPSSCRLG(.BPLN,"Other Prescriber Last Name: "_$$OPLNAM^BPSSCRLG(BPIEN03))
+38 DO SETLINE^BPSSCRLG(.BPLN,"Other Prescriber ID Qualifier: "_$$OPRIDQ^BPSSCRLG(BPIEN03))
+39 DO SETLINE^BPSSCRLG(.BPLN,"Other Prescriber ID: "_$$OPRID^BPSSCRLG(BPIEN03))
+40 DO SETLINE^BPSSCRLG(.BPLN,"Other Prescriber Phone Number: "_$$OPRPH^BPSSCRLG(BPIEN03))
+41 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Compound Product ID: "_$$CMPPID^BPSSCRLG(BPIEN03))
+42 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Compound Product ID Qualifier: "_$$CMPPIDQ^BPSSCRLG(BPIEN03))
+43 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Maximum Daily Dose Quantity: "_$$MAXDDQ^BPSSCRLG(BPIEN03))
+44 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Maximum Daily Dose Unit: "_$$MAXDDU^BPSSCRLG(BPIEN03))
+45 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Minimum Daily Dose Quantity: "_$$MINDDQ^BPSSCRLG(BPIEN03))
+46 DO SETLINE^BPSSCRLG(.BPLN,"DUR/DUE Minimum Daily Dose Unit: "_$$MINDDU^BPSSCRLG(BPIEN03))
+47 ;
+48 FOR BPCNT=1:1:2
DO SETLINE^BPSSCRLG(.BPLN,"")
+49 QUIT
+50 ;
