- IBJTRX ;ALB/ESG - TPJI ePharmacy ECME claim information ;22-Oct-2010
- ;;2.0;INTEGRATED BILLING;**435,452,494,521,617**;21-MAR-94;Build 43
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference to $$CLAIM^BPSBUTL supported by IA# 4719
- ; Reference to BPS RESPONSES file# 9002313.03 supported by IA# 4813
- ; Reference to $$NPI^XUSNPI supported by IA# 4532
- ; Reference to ^BPSVRX supported by IA# 5723
- ;
- Q
- ;
- EN ; -- main entry point for IBJT ECME RESP INFO
- N IBZ,IBRXDATA,IBRXIEN,X,Y
- D FULL^VALM1
- I '$G(IBIFN) W !!,"No Claim Defined!" D PAUSE^VALM1 G EX
- I '$$ISRX^IBCEF1(IBIFN) W !!,"Not available. This is not a Pharmacy Claim." D PAUSE^VALM1 G EX
- I $$ECME^IBTRE(IBIFN)="" W !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim." D PAUSE^VALM1 G EX
- ;
- S IBZ=+$O(^IBA(362.4,"C",IBIFN,0))
- I 'IBZ W !!,"Rx data not found for this claim." D PAUSE^VALM1 G EX
- S IBRXDATA=$G(^IBA(362.4,IBZ,0))
- S IBRXIEN=+$P(IBRXDATA,U,5) ; RX ien ptr file 52
- I 'IBRXIEN W !!,"Rx IEN cannot be determined." D PAUSE^VALM1 G EX
- ;
- D EN^VALM("IBJT ECME RESP INFO")
- EX ;
- S VALMBCK="R"
- Q
- ;
- HDR ; -- header code
- D HDR^IBJTU1(+IBIFN,+DFN,13)
- Q
- ;
- INIT ; -- init variables and list array
- N IBM1,ECME,ECMEAP,RXORG,DOCIEN,PHARMNPI,DOCNPI,RESPIEN,ZR,RSPSUB,ZM,BPSM,BPSMCOB,IBLINE,ZC,ZCTOT,ZCN
- N IBZ,IBRXDATA,IBRXIEN,IBRXFILL,IBCOBN,IBBPS,IB0,IBS,IBHPD,IBVL,IBCPY,IBM0
- K ^TMP("IBJTRX",$J)
- S VALMCNT=0
- ;
- S IBZ=+$O(^IBA(362.4,"C",IBIFN,0))
- S IBRXDATA=$G(^IBA(362.4,IBZ,0))
- S IBRXIEN=+$P(IBRXDATA,U,5) ; RX ien ptr file 52
- S IBRXFILL=+$P(IBRXDATA,U,10) ; rx fill#
- S IBCOBN=+$$COBN^IBCEF(IBIFN) ; current payer sequence #
- S IBBPS=$$CLAIM^BPSBUTL(IBRXIEN,IBRXFILL,IBCOBN) ; DBIA 4719
- ;
- S IBM1=$G(^DGCR(399,IBIFN,"M1"))
- S IB0=$G(^DGCR(399,IBIFN,0))
- S IBS=$G(^DGCR(399,IBIFN,"S"))
- S ECME=$P($P(IBM1,U,8),";",1) ; ECME#
- S ECMEAP=$P(IBM1,U,9) ; ECME approval number
- S RXORG=$$RXSITE^IBCEF73A(IBIFN) ; pharmacy file 4 ien
- S DOCIEN=$$RXAPI1^IBNCPUT1(IBRXIEN,4,"I") ; ien of doctor who wrote the Rx (52,4)
- S (PHARMNPI,DOCNPI)=""
- I RXORG S PHARMNPI=$P($$NPI^XUSNPI("Organization_ID",RXORG),U,1) ; pharmacy NPI
- I DOCIEN S DOCNPI=$P($$NPI^XUSNPI("Individual_ID",DOCIEN),U,1) ; doctor NPI
- I PHARMNPI'>0 S PHARMNPI="No NPI on file"
- I DOCNPI'>0 S DOCNPI="No NPI on file"
- ;
- S RESPIEN=+$P(IBBPS,U,3) ; BPS response file ien
- I RESPIEN D
- . ; IB*2.0*521 - add HPID from response to TPJI screen
- . S IBM0=$G(^DGCR(399,IBIFN,"M")),IBCPY=$S($P(IB0,U,21)="P":$P(IBM0,U),$P(IB0,U,21)="S":$P(IBM0,U,2),1:$P(IBM0,"^",3))
- . I $P($G(^BPSR(RESPIEN,560)),U,8)="01" S IBHPD=$P($G(^BPSR(RESPIEN,560)),U,9) S IBVL=$$HOD^IBCNHUT1(IBHPD,IBCPY)
- . S ZR=RESPIEN_","
- . S RSPSUB=+$O(^BPSR(RESPIEN,1000,0))
- . I RSPSUB D
- .. S ZM=RSPSUB_","_RESPIEN_","
- .. D GETS^DIQ(9002313.0301,ZM,"129;133:137;505;506;507;509;517:520;571;572;2193","IEN","BPSM") ; get selected $ amount fields
- .. D GETS^DIQ(9002313.0301,ZM,"355.01*","IEN","BPSMCOB") ; get cob/other payer data fields
- .. Q
- . Q
- ;
- S IBLINE=$$SETL("",ECME,"ECME No",25,11,1)
- S IBLINE=$$SETL(IBLINE,PHARMNPI,"Pharmacy NPI",14,15,40)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",ECMEAP,"ECME Ap No",25,11,1)
- S IBLINE=$$SETL(IBLINE,DOCNPI,"Provider NPI",14,15,40)
- D SET(IBLINE)
- ; IB*2.0*521 - add validated HPID from response to TPJI screen
- S:$G(IBVL)="" IBVL="^HPID/OEID" S IBLINE=$$SETL("",$G(IBHPD),$P(IBVL,U,2),25,11,1)
- D SET(IBLINE)
- ;
- D SET(" ")
- S IBLINE=$$SETL("",$P(IBRXDATA,U,1)_" / "_IBRXFILL,"Rx No",31,11,1)
- S IBLINE=$$SETL(IBLINE,$$FMTE^XLFDT($P(IBRXDATA,U,3),"2Z"),"Date of Svc",8,15,40)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$RXAPI1^IBNCPUT1(IBRXIEN,6,"E"),"Drug Name",36,11,1)
- S IBLINE=$$SETL(IBLINE,$P(IBRXDATA,U,8),"NDC #",24,15,40)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$AMT(+$P($G(^DGCR(399,IBIFN,"U1")),U,1)),"Billed Amt",36,11,1)
- S IBLINE=$$SETL(IBLINE,$S(IBCOBN=2:"Secondary",IBCOBN=3:"Tertiary",1:"Primary"),"COB",15,15,40)
- D SET(IBLINE)
- ;
- D SET(" ")
- ;
- ; For cancelled bills only, display the IB cancel status, date, and reason (IB*2*494)
- I $P(IB0,U,13)=7 D
- . S IBLINE=$$SETL("","CANCELLED ("_$$FMTE^XLFDT($P(IBS,U,17),"2DZ")_")","IB Status",20,11,1)
- . S IBLINE=$$SETL(IBLINE,$P(IBS,U,19),"Reason",100,6,36)
- . D SET(IBLINE),SET(" ")
- . Q
- ;
- ; if response data is not available, get out here
- ;
- I 'RESPIEN D G INITX
- . D SET(" ECME Response Information is not on file.")
- . D SET(" No further information available for display.")
- . Q
- ;
- S IBLINE=$$SETL("",,"Payment Information",,20,1)
- D SET(IBLINE,"3;2;19")
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,506,"E"))),"Ingredient Cost Paid",15,26,1) D SET(IBLINE)
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,507,"E"))),"Dispensing Fee Paid",15,26,1) D SET(IBLINE)
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,505,"E")),,1),"Patient Resp (Ins)",15,26,1) D SET(IBLINE)
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,509,"E"))),"Expected Payment Amount",15,26,1) D SET(IBLINE)
- ;
- D SET(" ")
- S IBLINE=$$SETL("",,"Patient Responsibility Amounts",,31,1)
- D SET(IBLINE,"3;2;30")
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,517,"E"))),"Deductible",10,13,1)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,572,"E"))),"Coinsurance",10,13,27)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,518,"E"))),"Amount of Copay",9,18,52)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,137,"E"))),"Coverage Gap",10,13,1)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,571,"E"))),"Processor Fee",10,13,27)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,520,"E"))),"Exceed Benefit Max",9,18,52)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,129,"E"))),"Health Plan-funded Assistance Amount",15,39,1)
- D SET(IBLINE)
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,2193,"E"))),"Patient Pay Component Amount",15,39,1)
- D SET(IBLINE)
- ;
- D SET(" ")
- S IBLINE=$$SETL("",,"Product Selection Amounts",,26,1)
- D SET(IBLINE,"3;2;25")
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,519,"E"))),"Prod Sel Amt",12,21,1)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,135,"E"))),"Prod Sel /Non-Pref Formulary",9,33,37)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,134,"E"))),"Prod Sel/Brand Drug",12,21,1)
- S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,136,"E"))),"Prod Sel/Brand Non-Pref Formulary",9,33,37)
- D SET(IBLINE)
- ;
- S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,133,"E"))),"Provider Network Adj",12,21,1)
- D SET(IBLINE)
- ;
- ; Display COB/Other Payer data
- I '$D(BPSMCOB(9002313.035501)) D G INITX
- . D SET(" ")
- . D SET(" No COB/Other Payer Data on file in the ECME Response.")
- . Q
- ;
- S ZC="" F ZCTOT=0:1 S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" ; count how many entries exist
- S ZC="",ZCN=0 F S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" D
- . S ZCN=ZCN+1
- . D SET(" ")
- . S IBLINE="COB/Other Payer ("_ZCN_" of "_ZCTOT_") (from other payer response message)"
- . D SET(" "_IBLINE,"3;2;"_$L(IBLINE))
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,356,"E")),"Other Payer Cardholder ID",40,27,1)
- . D SET(IBLINE)
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,144,"E")),"Other Payer Effective Date",10,27,1)
- . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,145,"E")),"Other Payer Termination Date",10,32,38)
- . D SET(IBLINE)
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,142,"E")),"Other Payer Person Code",6,27,1)
- . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,143,"E")),"Other Payer Pt Relationship Code",9,32,38)
- . D SET(IBLINE)
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,340,"E")),"Other Payer ID (BIN)",24,27,1)
- . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,991,"E")),"Other Payer PCN",9,32,38)
- . D SET(IBLINE)
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,992,"E")),"Other Payer Group ID",40,27,1)
- . D SET(IBLINE)
- . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,127,"E")),"Other Payer Help Desk",40,27,1)
- . D SET(IBLINE)
- . Q
- ;
- INITX ;
- D SET(" "),SET(" ")
- Q
- ;
- VER ; Action to launch the View ePharmacy Rx report
- N BPSVRX
- K ^TMP("BPSVRX-TPJI",$J)
- D FULL^VALM1
- I $G(IBRXDATA)="" W !!,"System error. IBRXDATA missing." D PAUSE^VALM1 G VERX
- ;
- ; save the current TPJI display array data
- M ^TMP("BPSVRX-TPJI",$J,"IBJTCA")=^TMP("IBJTCA",$J)
- M ^TMP("BPSVRX-TPJI",$J,"IBJTRX")=^TMP("IBJTRX",$J)
- M ^TMP("BPSVRX-TPJI",$J,"IBTPJI")=^TMP($J,"IBTPJI")
- ;
- S BPSVRX("RXIEN")=+$P(IBRXDATA,U,5) ; RX ien ptr file 52
- S BPSVRX("FILL#")=+$P(IBRXDATA,U,10) ; rx fill#
- D ^BPSVRX ; DBIA #5723
- ;
- ; After returning from this List Manager report, we need to rebuild
- ; the display array for the TPJI screens because they are killed by the report.
- I '$D(^TMP("IBJTCA",$J)) M ^TMP("IBJTCA",$J)=^TMP("BPSVRX-TPJI",$J,"IBJTCA")
- I '$D(^TMP("IBJTRX",$J)) M ^TMP("IBJTRX",$J)=^TMP("BPSVRX-TPJI",$J,"IBJTRX")
- I '$D(^TMP($J,"IBTPJI")) M ^TMP($J,"IBTPJI")=^TMP("BPSVRX-TPJI",$J,"IBTPJI")
- ;
- VERX ;
- S VALMBCK="R"
- K ^TMP("BPSVRX-TPJI",$J)
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("IBJTRX",$J)
- I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10()
- Q
- ;
- SETL(TEXT,DATA,LABEL,LEND,LENL,COL) ; build line of text
- ; TEXT - existing line of text data
- ; DATA - field data
- ; LABEL - field label
- ; LEND - max length of data
- ; LENL - length of label (label will be right justified so the colons line up)
- ; COL - starting column for insert
- ;
- N D1,STR S D1="",COL=$G(COL,1)
- I $G(LABEL)'="" S D1=$J(LABEL,+$G(LENL))
- I $D(DATA) S D1=D1_": "_$$FO^IBCNEUT1(DATA,+$G(LEND))
- S STR=$$SETSTR^VALM1(D1,$G(TEXT),COL,$L(D1))
- ;
- Q $E(STR,1,80)
- ;
- SET(TEXT,VID) ; set data in variable TEXT into ListMan display
- ; VID is video attribute data of line if any
- ; Format: type;start column;width
- ; type=1 (reverse video)
- ; type=2 (bold)
- ; type=3 (underline)
- ;
- S VALMCNT=VALMCNT+1
- S ^TMP("IBJTRX",$J,VALMCNT,0)=$G(TEXT) ; set text line into display array
- I $G(VID)="" G SETX
- ;
- ; video attributes
- N ON,OFF
- S ON=$S(+VID=1:IORVON,+VID=2:IOINHI,1:IOUON)
- S OFF=$S(+VID=1:IORVOFF,+VID=2:IOINORM,1:IOUOFF)
- D CNTRL^VALM10(VALMCNT,+$P(VID,";",2),+$P(VID,";",3),ON,OFF)
- ;
- SETX ;
- Q
- ;
- AMT(VAL,L,P) ; convert dollar amount to external display
- ; VAL can be a number or the Fileman external version of the number
- ; L is the $J field length (default 8)
- ; P is a flag indicating the number should be enclosed within parentheses
- ; strip $ and spaces
- S VAL=+$TR($G(VAL),"$ ")
- I '$G(L) S L=8
- I $G(P) Q $J($FN(-VAL,"P",2),L+1)
- Q $J(VAL,L,2)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTRX 10956 printed Feb 18, 2025@23:50:33 Page 2
- IBJTRX ;ALB/ESG - TPJI ePharmacy ECME claim information ;22-Oct-2010
- +1 ;;2.0;INTEGRATED BILLING;**435,452,494,521,617**;21-MAR-94;Build 43
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference to $$CLAIM^BPSBUTL supported by IA# 4719
- +5 ; Reference to BPS RESPONSES file# 9002313.03 supported by IA# 4813
- +6 ; Reference to $$NPI^XUSNPI supported by IA# 4532
- +7 ; Reference to ^BPSVRX supported by IA# 5723
- +8 ;
- +9 QUIT
- +10 ;
- EN ; -- main entry point for IBJT ECME RESP INFO
- +1 NEW IBZ,IBRXDATA,IBRXIEN,X,Y
- +2 DO FULL^VALM1
- +3 IF '$GET(IBIFN)
- WRITE !!,"No Claim Defined!"
- DO PAUSE^VALM1
- GOTO EX
- +4 IF '$$ISRX^IBCEF1(IBIFN)
- WRITE !!,"Not available. This is not a Pharmacy Claim."
- DO PAUSE^VALM1
- GOTO EX
- +5 IF $$ECME^IBTRE(IBIFN)=""
- WRITE !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim."
- DO PAUSE^VALM1
- GOTO EX
- +6 ;
- +7 SET IBZ=+$ORDER(^IBA(362.4,"C",IBIFN,0))
- +8 IF 'IBZ
- WRITE !!,"Rx data not found for this claim."
- DO PAUSE^VALM1
- GOTO EX
- +9 SET IBRXDATA=$GET(^IBA(362.4,IBZ,0))
- +10 ; RX ien ptr file 52
- SET IBRXIEN=+$PIECE(IBRXDATA,U,5)
- +11 IF 'IBRXIEN
- WRITE !!,"Rx IEN cannot be determined."
- DO PAUSE^VALM1
- GOTO EX
- +12 ;
- +13 DO EN^VALM("IBJT ECME RESP INFO")
- EX ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 DO HDR^IBJTU1(+IBIFN,+DFN,13)
- +2 QUIT
- +3 ;
- INIT ; -- init variables and list array
- +1 NEW IBM1,ECME,ECMEAP,RXORG,DOCIEN,PHARMNPI,DOCNPI,RESPIEN,ZR,RSPSUB,ZM,BPSM,BPSMCOB,IBLINE,ZC,ZCTOT,ZCN
- +2 NEW IBZ,IBRXDATA,IBRXIEN,IBRXFILL,IBCOBN,IBBPS,IB0,IBS,IBHPD,IBVL,IBCPY,IBM0
- +3 KILL ^TMP("IBJTRX",$JOB)
- +4 SET VALMCNT=0
- +5 ;
- +6 SET IBZ=+$ORDER(^IBA(362.4,"C",IBIFN,0))
- +7 SET IBRXDATA=$GET(^IBA(362.4,IBZ,0))
- +8 ; RX ien ptr file 52
- SET IBRXIEN=+$PIECE(IBRXDATA,U,5)
- +9 ; rx fill#
- SET IBRXFILL=+$PIECE(IBRXDATA,U,10)
- +10 ; current payer sequence #
- SET IBCOBN=+$$COBN^IBCEF(IBIFN)
- +11 ; DBIA 4719
- SET IBBPS=$$CLAIM^BPSBUTL(IBRXIEN,IBRXFILL,IBCOBN)
- +12 ;
- +13 SET IBM1=$GET(^DGCR(399,IBIFN,"M1"))
- +14 SET IB0=$GET(^DGCR(399,IBIFN,0))
- +15 SET IBS=$GET(^DGCR(399,IBIFN,"S"))
- +16 ; ECME#
- SET ECME=$PIECE($PIECE(IBM1,U,8),";",1)
- +17 ; ECME approval number
- SET ECMEAP=$PIECE(IBM1,U,9)
- +18 ; pharmacy file 4 ien
- SET RXORG=$$RXSITE^IBCEF73A(IBIFN)
- +19 ; ien of doctor who wrote the Rx (52,4)
- SET DOCIEN=$$RXAPI1^IBNCPUT1(IBRXIEN,4,"I")
- +20 SET (PHARMNPI,DOCNPI)=""
- +21 ; pharmacy NPI
- IF RXORG
- SET PHARMNPI=$PIECE($$NPI^XUSNPI("Organization_ID",RXORG),U,1)
- +22 ; doctor NPI
- IF DOCIEN
- SET DOCNPI=$PIECE($$NPI^XUSNPI("Individual_ID",DOCIEN),U,1)
- +23 IF PHARMNPI'>0
- SET PHARMNPI="No NPI on file"
- +24 IF DOCNPI'>0
- SET DOCNPI="No NPI on file"
- +25 ;
- +26 ; BPS response file ien
- SET RESPIEN=+$PIECE(IBBPS,U,3)
- +27 IF RESPIEN
- Begin DoDot:1
- +28 ; IB*2.0*521 - add HPID from response to TPJI screen
- +29 SET IBM0=$GET(^DGCR(399,IBIFN,"M"))
- SET IBCPY=$SELECT($PIECE(IB0,U,21)="P":$PIECE(IBM0,U),$PIECE(IB0,U,21)="S":$PIECE(IBM0,U,2),1:$PIECE(IBM0,"^",3))
- +30 IF $PIECE($GET(^BPSR(RESPIEN,560)),U,8)="01"
- SET IBHPD=$PIECE($GET(^BPSR(RESPIEN,560)),U,9)
- SET IBVL=$$HOD^IBCNHUT1(IBHPD,IBCPY)
- +31 SET ZR=RESPIEN_","
- +32 SET RSPSUB=+$ORDER(^BPSR(RESPIEN,1000,0))
- +33 IF RSPSUB
- Begin DoDot:2
- +34 SET ZM=RSPSUB_","_RESPIEN_","
- +35 ; get selected $ amount fields
- DO GETS^DIQ(9002313.0301,ZM,"129;133:137;505;506;507;509;517:520;571;572;2193","IEN","BPSM")
- +36 ; get cob/other payer data fields
- DO GETS^DIQ(9002313.0301,ZM,"355.01*","IEN","BPSMCOB")
- +37 QUIT
- End DoDot:2
- +38 QUIT
- End DoDot:1
- +39 ;
- +40 SET IBLINE=$$SETL("",ECME,"ECME No",25,11,1)
- +41 SET IBLINE=$$SETL(IBLINE,PHARMNPI,"Pharmacy NPI",14,15,40)
- +42 DO SET(IBLINE)
- +43 ;
- +44 SET IBLINE=$$SETL("",ECMEAP,"ECME Ap No",25,11,1)
- +45 SET IBLINE=$$SETL(IBLINE,DOCNPI,"Provider NPI",14,15,40)
- +46 DO SET(IBLINE)
- +47 ; IB*2.0*521 - add validated HPID from response to TPJI screen
- +48 if $GET(IBVL)=""
- SET IBVL="^HPID/OEID"
- SET IBLINE=$$SETL("",$GET(IBHPD),$PIECE(IBVL,U,2),25,11,1)
- +49 DO SET(IBLINE)
- +50 ;
- +51 DO SET(" ")
- +52 SET IBLINE=$$SETL("",$PIECE(IBRXDATA,U,1)_" / "_IBRXFILL,"Rx No",31,11,1)
- +53 SET IBLINE=$$SETL(IBLINE,$$FMTE^XLFDT($PIECE(IBRXDATA,U,3),"2Z"),"Date of Svc",8,15,40)
- +54 DO SET(IBLINE)
- +55 ;
- +56 SET IBLINE=$$SETL("",$$RXAPI1^IBNCPUT1(IBRXIEN,6,"E"),"Drug Name",36,11,1)
- +57 SET IBLINE=$$SETL(IBLINE,$PIECE(IBRXDATA,U,8),"NDC #",24,15,40)
- +58 DO SET(IBLINE)
- +59 ;
- +60 SET IBLINE=$$SETL("",$$AMT(+$PIECE($GET(^DGCR(399,IBIFN,"U1")),U,1)),"Billed Amt",36,11,1)
- +61 SET IBLINE=$$SETL(IBLINE,$SELECT(IBCOBN=2:"Secondary",IBCOBN=3:"Tertiary",1:"Primary"),"COB",15,15,40)
- +62 DO SET(IBLINE)
- +63 ;
- +64 DO SET(" ")
- +65 ;
- +66 ; For cancelled bills only, display the IB cancel status, date, and reason (IB*2*494)
- +67 IF $PIECE(IB0,U,13)=7
- Begin DoDot:1
- +68 SET IBLINE=$$SETL("","CANCELLED ("_$$FMTE^XLFDT($PIECE(IBS,U,17),"2DZ")_")","IB Status",20,11,1)
- +69 SET IBLINE=$$SETL(IBLINE,$PIECE(IBS,U,19),"Reason",100,6,36)
- +70 DO SET(IBLINE)
- DO SET(" ")
- +71 QUIT
- End DoDot:1
- +72 ;
- +73 ; if response data is not available, get out here
- +74 ;
- +75 IF 'RESPIEN
- Begin DoDot:1
- +76 DO SET(" ECME Response Information is not on file.")
- +77 DO SET(" No further information available for display.")
- +78 QUIT
- End DoDot:1
- GOTO INITX
- +79 ;
- +80 SET IBLINE=$$SETL("",,"Payment Information",,20,1)
- +81 DO SET(IBLINE,"3;2;19")
- +82 ;
- +83 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,506,"E"))),"Ingredient Cost Paid",15,26,1)
- DO SET(IBLINE)
- +84 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,507,"E"))),"Dispensing Fee Paid",15,26,1)
- DO SET(IBLINE)
- +85 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,505,"E")),,1),"Patient Resp (Ins)",15,26,1)
- DO SET(IBLINE)
- +86 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,509,"E"))),"Expected Payment Amount",15,26,1)
- DO SET(IBLINE)
- +87 ;
- +88 DO SET(" ")
- +89 SET IBLINE=$$SETL("",,"Patient Responsibility Amounts",,31,1)
- +90 DO SET(IBLINE,"3;2;30")
- +91 ;
- +92 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,517,"E"))),"Deductible",10,13,1)
- +93 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,572,"E"))),"Coinsurance",10,13,27)
- +94 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,518,"E"))),"Amount of Copay",9,18,52)
- +95 DO SET(IBLINE)
- +96 ;
- +97 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,137,"E"))),"Coverage Gap",10,13,1)
- +98 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,571,"E"))),"Processor Fee",10,13,27)
- +99 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,520,"E"))),"Exceed Benefit Max",9,18,52)
- +100 DO SET(IBLINE)
- +101 ;
- +102 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,129,"E"))),"Health Plan-funded Assistance Amount",15,39,1)
- +103 DO SET(IBLINE)
- +104 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,2193,"E"))),"Patient Pay Component Amount",15,39,1)
- +105 DO SET(IBLINE)
- +106 ;
- +107 DO SET(" ")
- +108 SET IBLINE=$$SETL("",,"Product Selection Amounts",,26,1)
- +109 DO SET(IBLINE,"3;2;25")
- +110 ;
- +111 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,519,"E"))),"Prod Sel Amt",12,21,1)
- +112 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,135,"E"))),"Prod Sel /Non-Pref Formulary",9,33,37)
- +113 DO SET(IBLINE)
- +114 ;
- +115 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,134,"E"))),"Prod Sel/Brand Drug",12,21,1)
- +116 SET IBLINE=$$SETL(IBLINE,$$AMT($GET(BPSM(9002313.0301,ZM,136,"E"))),"Prod Sel/Brand Non-Pref Formulary",9,33,37)
- +117 DO SET(IBLINE)
- +118 ;
- +119 SET IBLINE=$$SETL("",$$AMT($GET(BPSM(9002313.0301,ZM,133,"E"))),"Provider Network Adj",12,21,1)
- +120 DO SET(IBLINE)
- +121 ;
- +122 ; Display COB/Other Payer data
- +123 IF '$DATA(BPSMCOB(9002313.035501))
- Begin DoDot:1
- +124 DO SET(" ")
- +125 DO SET(" No COB/Other Payer Data on file in the ECME Response.")
- +126 QUIT
- End DoDot:1
- GOTO INITX
- +127 ;
- +128 ; count how many entries exist
- SET ZC=""
- FOR ZCTOT=0:1
- SET ZC=$ORDER(BPSMCOB(9002313.035501,ZC))
- if ZC=""
- QUIT
- +129 SET ZC=""
- SET ZCN=0
- FOR
- SET ZC=$ORDER(BPSMCOB(9002313.035501,ZC))
- if ZC=""
- QUIT
- Begin DoDot:1
- +130 SET ZCN=ZCN+1
- +131 DO SET(" ")
- +132 SET IBLINE="COB/Other Payer ("_ZCN_" of "_ZCTOT_") (from other payer response message)"
- +133 DO SET(" "_IBLINE,"3;2;"_$LENGTH(IBLINE))
- +134 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,356,"E")),"Other Payer Cardholder ID",40,27,1)
- +135 DO SET(IBLINE)
- +136 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,144,"E")),"Other Payer Effective Date",10,27,1)
- +137 SET IBLINE=$$SETL(IBLINE,$GET(BPSMCOB(9002313.035501,ZC,145,"E")),"Other Payer Termination Date",10,32,38)
- +138 DO SET(IBLINE)
- +139 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,142,"E")),"Other Payer Person Code",6,27,1)
- +140 SET IBLINE=$$SETL(IBLINE,$GET(BPSMCOB(9002313.035501,ZC,143,"E")),"Other Payer Pt Relationship Code",9,32,38)
- +141 DO SET(IBLINE)
- +142 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,340,"E")),"Other Payer ID (BIN)",24,27,1)
- +143 SET IBLINE=$$SETL(IBLINE,$GET(BPSMCOB(9002313.035501,ZC,991,"E")),"Other Payer PCN",9,32,38)
- +144 DO SET(IBLINE)
- +145 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,992,"E")),"Other Payer Group ID",40,27,1)
- +146 DO SET(IBLINE)
- +147 SET IBLINE=$$SETL("",$GET(BPSMCOB(9002313.035501,ZC,127,"E")),"Other Payer Help Desk",40,27,1)
- +148 DO SET(IBLINE)
- +149 QUIT
- End DoDot:1
- +150 ;
- INITX ;
- +1 DO SET(" ")
- DO SET(" ")
- +2 QUIT
- +3 ;
- VER ; Action to launch the View ePharmacy Rx report
- +1 NEW BPSVRX
- +2 KILL ^TMP("BPSVRX-TPJI",$JOB)
- +3 DO FULL^VALM1
- +4 IF $GET(IBRXDATA)=""
- WRITE !!,"System error. IBRXDATA missing."
- DO PAUSE^VALM1
- GOTO VERX
- +5 ;
- +6 ; save the current TPJI display array data
- +7 MERGE ^TMP("BPSVRX-TPJI",$JOB,"IBJTCA")=^TMP("IBJTCA",$JOB)
- +8 MERGE ^TMP("BPSVRX-TPJI",$JOB,"IBJTRX")=^TMP("IBJTRX",$JOB)
- +9 MERGE ^TMP("BPSVRX-TPJI",$JOB,"IBTPJI")=^TMP($JOB,"IBTPJI")
- +10 ;
- +11 ; RX ien ptr file 52
- SET BPSVRX("RXIEN")=+$PIECE(IBRXDATA,U,5)
- +12 ; rx fill#
- SET BPSVRX("FILL#")=+$PIECE(IBRXDATA,U,10)
- +13 ; DBIA #5723
- DO ^BPSVRX
- +14 ;
- +15 ; After returning from this List Manager report, we need to rebuild
- +16 ; the display array for the TPJI screens because they are killed by the report.
- +17 IF '$DATA(^TMP("IBJTCA",$JOB))
- MERGE ^TMP("IBJTCA",$JOB)=^TMP("BPSVRX-TPJI",$JOB,"IBJTCA")
- +18 IF '$DATA(^TMP("IBJTRX",$JOB))
- MERGE ^TMP("IBJTRX",$JOB)=^TMP("BPSVRX-TPJI",$JOB,"IBJTRX")
- +19 IF '$DATA(^TMP($JOB,"IBTPJI"))
- MERGE ^TMP($JOB,"IBTPJI")=^TMP("BPSVRX-TPJI",$JOB,"IBTPJI")
- +20 ;
- VERX ;
- +1 SET VALMBCK="R"
- +2 KILL ^TMP("BPSVRX-TPJI",$JOB)
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("IBJTRX",$JOB)
- +2 IF $DATA(VALMEVL)
- DO CLEAN^VALM10
- DO KILL^VALM10()
- +3 QUIT
- +4 ;
- SETL(TEXT,DATA,LABEL,LEND,LENL,COL) ; build line of text
- +1 ; TEXT - existing line of text data
- +2 ; DATA - field data
- +3 ; LABEL - field label
- +4 ; LEND - max length of data
- +5 ; LENL - length of label (label will be right justified so the colons line up)
- +6 ; COL - starting column for insert
- +7 ;
- +8 NEW D1,STR
- SET D1=""
- SET COL=$GET(COL,1)
- +9 IF $GET(LABEL)'=""
- SET D1=$JUSTIFY(LABEL,+$GET(LENL))
- +10 IF $DATA(DATA)
- SET D1=D1_": "_$$FO^IBCNEUT1(DATA,+$GET(LEND))
- +11 SET STR=$$SETSTR^VALM1(D1,$GET(TEXT),COL,$LENGTH(D1))
- +12 ;
- +13 QUIT $EXTRACT(STR,1,80)
- +14 ;
- SET(TEXT,VID) ; set data in variable TEXT into ListMan display
- +1 ; VID is video attribute data of line if any
- +2 ; Format: type;start column;width
- +3 ; type=1 (reverse video)
- +4 ; type=2 (bold)
- +5 ; type=3 (underline)
- +6 ;
- +7 SET VALMCNT=VALMCNT+1
- +8 ; set text line into display array
- SET ^TMP("IBJTRX",$JOB,VALMCNT,0)=$GET(TEXT)
- +9 IF $GET(VID)=""
- GOTO SETX
- +10 ;
- +11 ; video attributes
- +12 NEW ON,OFF
- +13 SET ON=$SELECT(+VID=1:IORVON,+VID=2:IOINHI,1:IOUON)
- +14 SET OFF=$SELECT(+VID=1:IORVOFF,+VID=2:IOINORM,1:IOUOFF)
- +15 DO CNTRL^VALM10(VALMCNT,+$PIECE(VID,";",2),+$PIECE(VID,";",3),ON,OFF)
- +16 ;
- SETX ;
- +1 QUIT
- +2 ;
- AMT(VAL,L,P) ; convert dollar amount to external display
- +1 ; VAL can be a number or the Fileman external version of the number
- +2 ; L is the $J field length (default 8)
- +3 ; P is a flag indicating the number should be enclosed within parentheses
- +4 ; strip $ and spaces
- +5 SET VAL=+$TRANSLATE($GET(VAL),"$ ")
- +6 IF '$GET(L)
- SET L=8
- +7 IF $GET(P)
- QUIT $JUSTIFY($FNUMBER(-VAL,"P",2),L+1)
- +8 QUIT $JUSTIFY(VAL,L,2)
- +9 ;